All:
Here's a list of the things I've been doing:
* Added ops2cgc.pl which generates core_cg_ops.c and core_cg_ops.h from
core.ops, and modified Makefile.in to use it. In core_cg_ops.c resides
cg_core which has an array with the addresses of the label of each opcode
and starts the execution "jumping" to the address in array[*cur_opcode].
* Modified interpreter.c to include core_cg_ops.h
* Modified runcore_ops.c to discard the actual dispatching method and call
cg_core, but left everything else untouched so that -b,-p and -t keep
working.
* Modified pbc2c.pl to use computed goto when handling jump or ret, may be
I can modified this once again not to define the array with the addresses
if it's not going to be used but I don't think that in real life a program
won't use jump or ret, am I right?
Hope some one find this usefull.
Actual dispatcher:
#./test_prog examples/assembly/mops.pbc
Iterations: 100000000
Estimated ops: 300000000
Elapsed time: 22.642827
M op/s: 13.249229
Actual dispatcher -O3:
#./test_prog examples/assembly/mops.pbc
Iterations: 100000000
Estimated ops: 300000000
Elapsed time: 14.651587
M op/s: 20.475598
With this patch:
#./test_prog examples/assembly/mops.pbc
Iterations: 100000000
Estimated ops: 300000000
Elapsed time: 8.398673
M op/s: 35.719929
With this patch and -O3:
#./test_prog examples/assembly/mops.pbc
Iterations: 100000000
Estimated ops: 300000000
Elapsed time: 4.554578
M op/s: 65.867792
With -O3:
#./mops
Iterations: 100000000
Estimated ops: 300000000
Elapsed time: 1.023564
M op/s: 293.093515
#java -Xint mops
Iterations: 100000000
Estimated ops: 300000000
Elapsed time: 9.705000042915344
M op/s: 30.911900945224637
Daniel Grunblatt.
Index: Makefile.in
===================================================================
RCS file: /home/perlcvs/parrot/Makefile.in,v
retrieving revision 1.43
diff -u -r1.43 Makefile.in
--- Makefile.in 2001/11/02 12:11:15 1.43
+++ Makefile.in 2001/11/04 01:05:01
@@ -8,14 +8,15 @@
$(INC)/memory.h $(INC)/parrot.h $(INC)/stacks.h $(INC)/packfile.h \
$(INC)/global_setup.h $(INC)/vtable.h $(INC)/oplib/core_ops.h \
$(INC)/runops_cores.h $(INC)/trace.h $(INC)/oplib/vtable_ops.h \
-$(INC)/pmc.h $(INC)/resources.h $(INC)/platform.h
+$(INC)/pmc.h $(INC)/resources.h $(INC)/platform.h $(INC)/oplib/core_cg_ops.h
+
O_FILES = global_setup$(O) interpreter$(O) parrot$(O) register$(O) \
core_ops$(O) memory$(O) packfile$(O) stacks$(O) string$(O) encoding$(O) \
chartype$(O) runops_cores$(O) trace$(O) vtable_ops$(O) classes/intclass$(O) \
encodings/singlebyte$(O) encodings/utf8$(O) encodings/utf16$(O) \
encodings/utf32$(O) chartypes/unicode$(O) chartypes/usascii$(O) resources$(O) \
-platform$(O)
+platform$(O) core_cg_ops$(O)
#DO NOT ADD C COMPILER FLAGS HERE
#Add them in Configure.pl--look for the
@@ -101,6 +102,11 @@
stacks$(O): $(H_FILES)
+core_cg_ops$(O): $(H_FILES) core_ops.c
+
+core_cg_ops.c $(INC)/oplib/core_cg_ops.h: core.ops ops2cgc.pl
+ $(PERL) ops2cgc.pl core.ops
+
core_ops$(O): $(H_FILES) core_ops.c
core_ops.c $(INC)/oplib/core_ops.h: core.ops ops2c.pl
@@ -130,8 +136,9 @@
cd docs; make
clean:
- $(RM_F) *$(O) *.s core_ops.c $(TEST_PROG) $(PDISASM) $(PDUMP)
+ $(RM_F) *$(O) *.s core_cg_ops.c core_ops.c $(TEST_PROG) $(PDISASM) $(PDUMP)
$(RM_F) $(INC)/vtable.h
+ $(RM_F) $(INC)/oplib/core_cg_ops.h
$(RM_F) $(INC)/oplib/core_ops.h
$(RM_F) $(INC)/oplib/vtable_ops.h vtable_ops.c vtable.ops
$(RM_F) $(TEST_PROG) $(PDISASM) $(PDUMP)
Index: interpreter.c
===================================================================
RCS file: /home/perlcvs/parrot/interpreter.c,v
retrieving revision 1.33
diff -u -r1.33 interpreter.c
--- interpreter.c 2001/10/26 18:58:02 1.33
+++ interpreter.c 2001/11/04 01:05:01
@@ -13,6 +13,7 @@
#include "parrot/parrot.h"
#include "parrot/interp_guts.h"
#include "parrot/oplib/core_ops.h"
+#include "parrot/oplib/core_cg_ops.h"
#include "parrot/runops_cores.h"
Index: pbc2c.pl
===================================================================
RCS file: /home/perlcvs/parrot/pbc2c.pl,v
retrieving revision 1.3
diff -u -r1.3 pbc2c.pl
--- pbc2c.pl 2001/10/24 13:03:42 1.3
+++ pbc2c.pl 2001/11/04 01:05:02
@@ -65,9 +65,11 @@
# compile_byte_code()
#
-my $pc;
+my $pc = 1;
+my $op;
my $new_pc = 1;
my @args = ();
+my @pcs = ();
sub compile_byte_code {
my ($pf) = @_;
@@ -85,11 +87,59 @@
int
main(int argc, char **argv) {
- int i;
+ int cur_opcode;
struct Parrot_Interp * interpreter;
struct PackFile_Constant * c;
struct PackFile * pf;
+END_C
+ my $cursor = 0;
+ my $length = length($pf->byte_code);
+
+ my $offset=0;
+
+ my $op_code;
+ my @addr;
+ my @source;
+
+ while ($offset + sizeof('op') <= $length) {
+ foreach ($pc..$new_pc-2) {
+ push @addr, " NULL,\n";
+ }
+ $pc = $new_pc;
+ push @addr, " &&PC_$pc,\n";
+ $op_code = unpack "x$offset l", $pf->byte_code;
+ $op = $ops->op($op_code);
+ $offset += sizeof('op');
+ $new_pc = $pc + $op->size;
+
+ @args = ();
+ foreach (1 .. scalar($op->arg_types) - 1) {
+ die "$0: Premature end of bytecode in argument.\n"
+ if ($offset + sizeof('op')) > $length;
+ my $arg = unpack "x$offset l", $pf->byte_code;
+ $offset += sizeof('op');
+ push @args, $arg;
+ }
+
+ my $source = $op->source(\&map_ret_abs, \&map_ret_rel, \&map_arg,
+\&map_res_abs, \&map_res_rel);
+ if ($source =~ m/cur_opcode/) {
+ $source =~ s/cur_opcode \+ (\d+)/(opcode_t *)(cur_opcode + $1)/g;
+ $source = "cur_opcode = " . $pc . ";\n" . $source;
+ }
+ push @source, sprintf("PC_%d: /* %s */\n{\n%s}\n\n", $pc, $op->full_name,
+$source);
+ }
+
+ print <<END_C;
+ static void *pc_l[] = {
+ &&PC_0,
+END_C
+
+ print @addr;
+ print <<END_C;
+ NULL
+ };
+
init_world();
interpreter = make_interpreter();
@@ -98,7 +148,6 @@
interpreter->code = pf;
END_C
-
for(my $i = 0; $i < $nconst; $i++) {
my $const = $pf->const_table->constant($i);
my $value = $const->value;
@@ -133,43 +182,15 @@
END_C
}
- my $cursor = 0;
- my $length = length($pf->byte_code);
-
- my $offset=0;
-
- my $op_code;
- my $op;
-
- while ($offset + sizeof('op') <= $length) {
- $pc = $new_pc;
- $op_code = unpack "x$offset l", $pf->byte_code;
- $op = $ops->op($op_code);
- $offset += sizeof('op');
- $new_pc = $pc + $op->size;
-
- @args = ();
-
- foreach (1 .. scalar($op->arg_types) - 1) {
- die "$0: Premature end of bytecode in argument.\n"
- if ($offset + sizeof('op')) > $length;
- my $arg = unpack "x$offset l", $pf->byte_code;
- $offset += sizeof('op');
- push @args, $arg;
- }
- my $source = $op->source(\&map_ret_abs, \&map_ret_rel, \&map_arg,
\&map_res_abs, \&map_res_rel);
-
- printf("PC_%d: { /* %s */\n%s}\n\n", $pc, $op->full_name, $source);
- }
-
+ print @source;
print <<END_C;
-
-PC_$new_pc:
PC_0: {
exit(0);
}
+
+
return 0;
}
END_C
@@ -186,7 +207,11 @@
{
my ($addr) = @_;
#print STDERR "pbcc: map_ret_abs($addr)\n";
- return sprintf("goto PC_%d", $addr);
+ if ($op->full_name eq 'ret') {
+ return sprintf("goto *pc_l[(int)dest]");
+ } else {
+ return sprintf("goto PC_%d", $addr);
+ }
}
@@ -198,7 +223,11 @@
{
my ($offset) = @_;
#print STDERR "pbcc: map_ret_rel($offset)\n";
- return sprintf("goto PC_%d", $pc + $offset);
+ if ($op->full_name eq 'jump_i') {
+ return sprintf("goto *pc_l[" . $pc . "+" . $offset . "]");
+ } else {
+ return sprintf("goto PC_%d", $pc + $offset);
+ }
}
Index: runops_cores.c
===================================================================
RCS file: /home/perlcvs/parrot/runops_cores.c,v
retrieving revision 1.2
diff -u -r1.2 runops_cores.c
--- runops_cores.c 2001/10/19 01:43:00 1.2
+++ runops_cores.c 2001/11/04 01:05:02
@@ -36,7 +36,7 @@
opcode_t *
runops_t0p0b0_core (struct Parrot_Interp *interpreter, opcode_t * pc) {
- while (pc) { DO_OP(pc, interpreter); }
+ cg_core(pc, interpreter);
return pc;
}
#! /usr/bin/perl -w
#
# ops2cgc.pl
#
# Generate a C header and source file from the operation definitions in
# an .ops file.
#
use strict;
use Parrot::OpsFile;
#
# Process command-line argument:
#
if (@ARGV != 1) {
die "ops2cgc.pl: usage: perl ops2cgc.pl input.ops\n";
}
my $file = $ARGV[0];
my $base = $file;
$base =~ s/\.ops$//;
my $incdir = "include/parrot/oplib";
my $include = "parrot/oplib/${base}_cg_ops.h";
my $header = "include/$include";
my $source = "${base}_cg_ops.c";
#
# Read the input file:
#
my $ops = new Parrot::OpsFile $file;
die "ops2cgc.pl: Could not read ops file '$file'!\n" unless $ops;
my $num_ops = scalar $ops->ops;
my $num_entries = $num_ops + 1; # For trailing NULL
#
# Open the output files:
#
if (! -d $incdir) {
mkdir($incdir, 0755) or die "ops2cgc.pl: Could not mkdir $incdir $!!\n";
}
open HEADER, ">$header"
or die "ops2cgc.pl: Could not open header file '$header' for writing: $!!\n";
open SOURCE, ">$source"
or die "ops2cgc.pl: Could not open source file '$source' for writing: $!!\n";
#
# Print the preamble for the HEADER and SOURCE files:
#
my $preamble = <<END_C;
/*
** !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
**
** This file is generated automatically from '$file'.
** Any changes made here will be lost!
*/
END_C
print HEADER $preamble;
print HEADER <<END_C;
#include "parrot/parrot.h"
opcode_t *cg_core(opcode_t *, struct Parrot_Interp *);
END_C
print SOURCE $preamble;
print SOURCE <<END_C;
#include "$include"
opcode_t *
cg_core(opcode_t *cur_opcode, struct Parrot_Interp *interpreter)
{
static void *ops_addr[] = {
END_C
#
# Iterate over the ops, appending SOURCE fragments:
#
my @op_source;
my $index = 0;
foreach my $op ($ops->ops) {
my $definition = "PC_$index:";
my $source = $op->source(\&map_cg_abs, \&map_cg_rel, \&map_arg, \&map_res_abs,
\&map_res_rel);
print SOURCE " &&PC_" . $index++ . ",\n";
push @op_source, "$definition /* " . $op->func_name . " */\n{\n$source}\n\n";
}
#
# Finish the array and stat the execution:
#
print SOURCE <<END_C;
NULL
};
goto *ops_addr[*cur_opcode];
END_C
#
# Dump the source:
#
print SOURCE @op_source;
print SOURCE <<END_C;
};
END_C
#
# map_cg_abs()
#
sub map_cg_abs
{
my ($addr) = @_;
if ($addr eq '0') {
return "return (0);"
} else {
return "goto *ops_addr[*(cur_opcode = $addr)]";
}
}
#
# map_cg_rel()
#
sub map_cg_rel
{
my ($offset) = @_;
return "goto *ops_addr[*(cur_opcode += $offset)]";
}
#
# map_arg()
#
sub map_arg
{
my ($type, $num) = @_;
my %arg_maps = (
'op' => "cur_opcode[%ld]",
'i' => "interpreter->int_reg->registers[cur_opcode[%ld]]",
'n' => "interpreter->num_reg->registers[cur_opcode[%ld]]",
'p' => "interpreter->pmc_reg->registers[cur_opcode[%ld]]",
's' => "interpreter->string_reg->registers[cur_opcode[%ld]]",
'ic' => "cur_opcode[%ld]",
'nc' => "interpreter->code->const_table->constants[cur_opcode[%ld]]->number",
'pc' => "%ld /* ERROR: Don't know how to handle PMC constants yet! */",
'sc' => "interpreter->code->const_table->constants[cur_opcode[%ld]]->string",
);
die "Unrecognized type '$type' for num '$num'" unless exists $arg_maps{$type};
return sprintf($arg_maps{$type}, $num);
}
#
# map_res_rel()
#
sub map_res_rel
{
my ($offset) = @_;
return "interpreter->resume_addr = cur_opcode + $offset";
}
#
# map_res_abs()
#
sub map_res_abs
{
my ($addr) = @_;
return "interpreter->resume_addr = $addr";
}
