Attached is a patch to implement computed-goto on gcc, taken from the original post by Daniel Grunblatt: http:[EMAIL PROTECTED]/msg06255.html
Changes since his original patch: + works with the current codebase + handles all jumps properly, and passes all tests (I'm not sure, but I don't believe the original did this) + updated to reflect the precedent set by prederef in terms of naming and code conventions Note, that some of the configure.pl and makefile.in hackery is done so that this file doesn't get compiled all the time. Not sure if there's a better way to do this, as I'm not really a configure/makefile expert. Relevant mops.pasm times on this 1ghz machine: MSVC normal dispatch: 30.35 Mops/sec GCC normal dispatch: 14.61 Mops/sec GCC computed goto: 41.74 Mops/sec Enjoy, Mike Lambert
? parrot/ops2cgc.pl
? parrot/testcomputedgoto_c.in
Index: parrot/.cvsignore
===================================================================
RCS file: /cvs/public/parrot/.cvsignore,v
retrieving revision 1.14
diff -u -r1.14 .cvsignore
--- parrot/.cvsignore 8 Jan 2002 17:24:29 -0000 1.14
+++ parrot/.cvsignore 27 Mar 2002 07:50:27 -0000
@@ -1,5 +1,6 @@
blib
config.opt
+core_ops_cg.c
core_ops.c
core_ops_prederef.c
Makefile
Index: parrot/Configure.pl
===================================================================
RCS file: /cvs/public/parrot/Configure.pl,v
retrieving revision 1.101
diff -u -r1.101 Configure.pl
--- parrot/Configure.pl 19 Mar 2002 22:53:57 -0000 1.101
+++ parrot/Configure.pl 27 Mar 2002 07:50:27 -0000
@@ -238,6 +238,17 @@
cp => 'cp',
slash => '/',
+ cg_h => '$(INC)/oplib/core_ops_cg.h',
+ cg_c => <<'EOF',
+core_ops_cg$(O): $(GENERAL_H_FILES) core_ops_cg.c
+
+core_ops_cg.c $(INC)/oplib/core_ops_cg.h: $(OPS_FILES) ops2cgc.pl
+lib/Parrot/OpsFile.pm lib/Parrot/Op.pm
+ $(PERL) ops2cgc.pl CGoto $(OPS_FILES)
+EOF
+ cg_o => 'core_ops_cg$(O)',
+ cg_r => '$(RM_F) $(INC)/oplib/core_ops_cg.h core_ops_cg.c',
+ cg_flag => '-DHAVE_COMPUTED_GOTO',
+
VERSION => $parrot_version,
MAJOR => $parrot_version[0],
MINOR => $parrot_version[1],
@@ -690,6 +701,32 @@
unlink("include/parrot/vtable.h");
}
+
+# and now test if we can use computed goto
+print <<"END";
+
+Still everything ok, let's check if we can use computed goto,
+don't worry if you see some errors, it will be all right,
+This could take a bit...
+END
+
+{
+ buildfile("testcomputedgoto_c");
+ my $test = system("$c{cc} $c{ccflags} -o testcomputedgoto$c{exe}
+testcomputedgoto.c");
+
+ if ($test != 0) {
+ $c{"cg_h"}='';
+ $c{"cg_c"}='';
+ $c{"cg_o"}='';
+ $c{"cg_r"}='';
+ $c{"cg_flag"}='';
+ }
+
+ unlink('testcomputedgoto.c', "testcomputedgoto$c{exe}", "testcomputedgoto$c{o}");
+}
+
+# rewrite the Makefile with the updated info
+buildfile("Makefile");
#
# Rewrite the config file with the updated info
Index: parrot/MANIFEST
===================================================================
RCS file: /cvs/public/parrot/MANIFEST,v
retrieving revision 1.133
diff -u -r1.133 MANIFEST
--- parrot/MANIFEST 24 Mar 2002 21:10:49 -0000 1.133
+++ parrot/MANIFEST 27 Mar 2002 07:50:27 -0000
@@ -246,6 +246,7 @@
misc.c
obscure.ops
ops2c.pl
+ops2cgc.pl
ops2pm.pl
optimizer.pl
packdump.c
@@ -292,6 +293,7 @@
test_c.in
test_gnuc.c
test_main.c
+testcomputedgoto_c.in
testparrotfuncptr.c
testparrotsizes_c.in
trace.c
Index: parrot/MANIFEST.SKIP
===================================================================
RCS file: /cvs/public/parrot/MANIFEST.SKIP,v
retrieving revision 1.2
diff -u -r1.2 MANIFEST.SKIP
--- parrot/MANIFEST.SKIP 21 Mar 2002 23:39:49 -0000 1.2
+++ parrot/MANIFEST.SKIP 27 Mar 2002 07:50:27 -0000
@@ -16,6 +16,7 @@
^include/parrot/jit_struct\.h$
^include/parrot/oplib/core_ops\.h$
^include/parrot/oplib/core_ops_prederef\.h$
+^include/parrot/oplib/core_ops_cg\.h$
^core_ops\.c$
^core_ops_prederef\.c$
Index: parrot/Makefile.in
===================================================================
RCS file: /cvs/public/parrot/Makefile.in,v
retrieving revision 1.141
diff -u -r1.141 Makefile.in
--- parrot/Makefile.in 21 Mar 2002 23:47:22 -0000 1.141
+++ parrot/Makefile.in 27 Mar 2002 07:50:27 -0000
@@ -65,7 +65,7 @@
$(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)/oplib/core_ops_prederef.h $(INC)/runops_cores.h $(INC)/trace.h \
-$(INC)/pmc.h $(INC)/key.h $(INC)/resources.h $(INC)/platform.h \
+$(INC)/pmc.h $(INC)/key.h $(INC)/resources.h $(INC)/platform.h ${cg_h} \
$(INC)/interp_guts.h ${jit_h} $(INC)/rx.h $(INC)/rxstacks.h \
$(INC)/embed.h $(INC)/warnings.h $(INC)/misc.h
@@ -87,7 +87,7 @@
core_ops$(O) core_ops_prederef$(O) memory$(O) packfile$(O) stacks$(O) \
string$(O) encoding$(O) chartype$(O) runops_cores$(O) trace$(O) pmc$(O) key$(O) \
platform$(O) ${jit_o} resources$(O) rx$(O) rxstacks$(O) embed$(O) warnings$(O) \
-misc$(O)
+misc$(O) ${cg_o}
O_FILES = $(INTERP_O_FILES) $(IO_O_FILES) $(CLASS_O_FILES) $(ENCODING_O_FILES)
$(CHARTYPE_O_FILES)
@@ -103,7 +103,7 @@
#
###############################################################################
-CFLAGS = ${ccflags} ${cc_warn} ${cc_debug} ${cc_inc} ${cc_hasjit}
+CFLAGS = ${ccflags} ${cc_warn} ${cc_debug} ${cc_inc} ${cc_hasjit} ${cg_flag}
LDFLAGS = ${ldflags} ${ld_debug}
C_LIBS = ${libs}
@@ -352,6 +352,8 @@
core_ops_prederef.c $(INC)/oplib/core_ops_prederef.h: $(OPS_FILES) ops2c.pl
lib/Parrot/OpsFile.pm lib/Parrot/Op.pm
$(PERL) ops2c.pl CPrederef $(OPS_FILES)
+${cg_c}
+
warnings$(O): $(H_FILES)
misc$(O): $(H_FILES)
@@ -422,6 +424,7 @@
###############################################################################
clean: testclean
+ ${cg_r}
$(RM_F) $(O_FILES)
$(RM_F) *.s
$(RM_F) $(FLUID_FILES)
Index: parrot/core.ops
===================================================================
RCS file: /cvs/public/parrot/core.ops,v
retrieving revision 1.113
diff -u -r1.113 core.ops
--- parrot/core.ops 22 Mar 2002 20:24:02 -0000 1.113
+++ parrot/core.ops 27 Mar 2002 07:50:28 -0000
@@ -572,6 +572,7 @@
=cut
inline op set_keyed (out PMC, in PMC, in PMC, in PMC) {
+/*
KEY_PAIR src_key_p, dest_key_p;
KEY src_key, dest_key;
@@ -580,6 +581,7 @@
$1->vtable->set_pmc_keyed(interpreter,
$1, $2 ? &src_key : NULL, $3, $4 ? &dest_key : NULL);
+*/
goto NEXT();
}
Index: parrot/interpreter.c
===================================================================
RCS file: /cvs/public/parrot/interpreter.c,v
retrieving revision 1.80
diff -u -r1.80 interpreter.c
--- parrot/interpreter.c 16 Mar 2002 17:38:45 -0000 1.80
+++ parrot/interpreter.c 27 Mar 2002 07:50:29 -0000
@@ -17,6 +17,9 @@
#ifdef HAS_JIT
# include "parrot/jit.h"
#endif
+#ifdef HAVE_COMPUTED_GOTO
+# include "parrot/oplib/core_cg_ops.h"
+#endif
/*=for api interpreter check_fingerprint
Index: parrot/pbc2c.pl
===================================================================
RCS file: /cvs/public/parrot/pbc2c.pl,v
retrieving revision 1.20
diff -u -r1.20 pbc2c.pl
--- parrot/pbc2c.pl 19 Mar 2002 23:23:30 -0000 1.20
+++ parrot/pbc2c.pl 27 Mar 2002 07:50:29 -0000
@@ -77,7 +77,7 @@
sub compile_byte_code {
my ($pf, $file_name) = @_;
my ($byte_code);
- my $pc;
+ my $pc = 1;
my $new_pc = 0;
my $offset=0;
my $op_code;
@@ -104,14 +104,14 @@
# of control flow changing opcodes including the possible targets of ret
# opcodes
while ($offset + sizeof('op') <= $length) {
- my ($src, $is_branch);
+ my ($src, $is_branch);
$pc = $new_pc;
- $op_code = unpack "x$offset l", $pf->byte_code;
+ $op_code = unpack "x$offset l", $pf->byte_code;
$op = $ops->op($op_code) || die "Can't find an op for opcode
$op_code\n";
- $offset += sizeof('op');
- push @pc_list, $pc;
- $opcodes{$pc}->{op} = $op;
+ $offset += sizeof('op');
+ push @pc_list, $pc;
+ $opcodes{$pc}->{op} = $op;
$new_pc = $pc + $op->size;
@args = ();
@@ -123,53 +123,52 @@
$offset += sizeof('op');
push @args, $arg;
}
- push @{$opcodes{$pc}->{args}}, @args;
+ push @{$opcodes{$pc}->{args}}, @args;
$src = $op->full_body();
- # The regexes here correspond to the rewriting rules for the various
- # forms of goto recognized by Parrot/OpsFile.pm and Parrot/Op.pm
+ # The regexes here correspond to the rewriting rules for the various
+ # forms of goto recognized by Parrot/OpsFile.pm and Parrot/Op.pm
- # absolute address goto
- while($src =~ /{{=(.*?)}}/g){
- my $offset = $1;
- $is_branch = 1;
- }
- # relative branch
- while($src =~ /{{(\-|\+)=(.*?)}}/g){
- my $dir = $1;
- my $forward_off = $2;
-
- # Substitute constant branch values
- if($forward_off =~ /\@(\d+)/){
- $forward_off = $args[$1 - 1]
- if $op->arg_type($1) eq 'ic';
- }
-
- if($forward_off =~ /^-?\d+$/){
- $forward_off = -$forward_off if $dir eq '-';
-
- if($forward_off != $op->size){
- $leaders{$forward_off + $pc} = 1;
- $is_branch = 1;
- }
- }
- else {
- $is_branch = 1;
- }
- }
+ # absolute address goto
+ while($src =~ /{{=(.*?)}}/g){
+ my $offset = $1;
+ $is_branch = 1;
+ }
+ # relative branch
+ while($src =~ /{{(\-|\+)=(.*?)}}/g){
+ my $dir = $1;
+ my $forward_off = $2;
+
+ # Substitute constant branch values
+ if($forward_off =~ /\@(\d+)/){
+ $forward_off = $args[$1 - 1] if $op->arg_type($1) eq 'ic';
+ }
+
+ if($forward_off =~ /^-?\d+$/){
+ $forward_off = -$forward_off if $dir eq '-';
+
+ if($forward_off != $op->size){
+ $leaders{$forward_off + $pc} = 1;
+ $is_branch = 1;
+ }
+ }
+ else {
+ $is_branch = 1;
+ }
+ }
- $leaders{$new_pc} = 1 if $is_branch;
+ $leaders{$new_pc} = 1 if $is_branch;
}
my $enternative;
FINDENTERN:
foreach my $cur_op (@$Parrot::OpLib::core::ops) {
- if($cur_op->full_name eq 'enternative'){
- $enternative = pack_op($cur_op->code);
- last FINDENTERN;
- }
+ if($cur_op->full_name eq 'enternative'){
+ $enternative = pack_op($cur_op->code);
+ last FINDENTERN;
+ }
}
die "Could not locate enternative op!\n" unless defined $enternative;
@@ -183,15 +182,15 @@
substr($byte_code, 0, sizeof('op')) = $enternative;
while (@pc_list) {
- my $instr_pc = shift @pc_list;
- # block leader found, start new block
- if(exists $leaders{$instr_pc}) {
- substr($byte_code, $instr_pc, sizeof('op')) = $enternative;
- push @blocks, [$instr_pc ];
- }
- else {
- push @{$blocks[-1]}, $instr_pc;
- }
+ my $instr_pc = shift @pc_list;
+ # block leader found, start new block
+ if(exists $leaders{$instr_pc}) {
+ substr($byte_code, $instr_pc, sizeof('op')) = $enternative;
+ push @blocks, [$instr_pc ];
+ }
+ else {
+ push @{$blocks[-1]}, $instr_pc;
+ }
}
print<<END_C;
@@ -207,9 +206,9 @@
$offset = 0;
while($offset < length($byte_code)){
- print join(',', unpack("c*", substr($byte_code, $offset, 20)));
- print ",\n";
- $offset += 20;
+ print join(',', unpack("c*", substr($byte_code, $offset, 20)));
+ print ",\n";
+ $offset += 20;
}
print "};";
@@ -217,6 +216,7 @@
int
main(int argc, char **argv) {
+ int cur_opcode;
struct Parrot_Interp * interpreter;
struct PackFile * pf;
@@ -228,8 +228,8 @@
if( !PackFile_unpack(interpreter, pf, program_code,
(opcode_t)sizeof(program_code)) ) {
- printf( "Can't unpack.\n" );
- return 1;
+ printf( "Can't unpack.\n" );
+ return 1;
}
interpreter->code = pf;
runops(interpreter, pf, 0);
Index: parrot/runops_cores.c
===================================================================
RCS file: /cvs/public/parrot/runops_cores.c,v
retrieving revision 1.14
diff -u -r1.14 runops_cores.c
--- parrot/runops_cores.c 5 Mar 2002 05:17:14 -0000 1.14
+++ parrot/runops_cores.c 27 Mar 2002 07:50:30 -0000
@@ -15,6 +15,10 @@
#include "parrot/interp_guts.h"
+#ifdef HAVE_COMPUTED_GOTO
+# include "parrot/oplib/core_ops_cg.h"
+#endif
+
/*=for api interpreter runops_fast_core
* run parrot operations until the program is complete
*
@@ -26,9 +30,13 @@
opcode_t *
runops_fast_core(struct Parrot_Interp *interpreter, opcode_t *pc)
{
+#ifdef HAVE_COMPUTED_GOTO
+ pc = cg_core(pc, interpreter);
+#else
while (pc) {
DO_OP(pc, interpreter);
}
+#endif
return pc;
}
Index: parrot/include/parrot/oplib/.cvsignore
===================================================================
RCS file: /cvs/public/parrot/include/parrot/oplib/.cvsignore,v
retrieving revision 1.3
diff -u -r1.3 .cvsignore
--- parrot/include/parrot/oplib/.cvsignore 13 Dec 2001 12:12:45 -0000 1.3
+++ parrot/include/parrot/oplib/.cvsignore 27 Mar 2002 07:50:30 -0000
@@ -1,2 +1,3 @@
*_ops.h
*_ops_prederef.h
+*_ops_cg.h
Index: parrot/lib/Parrot/OpTrans/CGoto.pm
===================================================================
RCS file: /cvs/public/parrot/lib/Parrot/OpTrans/CGoto.pm,v
retrieving revision 1.6
diff -u -r1.6 CGoto.pm
--- parrot/lib/Parrot/OpTrans/CGoto.pm 16 Feb 2002 04:38:18 -0000 1.6
+++ parrot/lib/Parrot/OpTrans/CGoto.pm 27 Mar 2002 07:50:30 -0000
@@ -16,6 +16,7 @@
sub defines
{
return <<END;
+#define REL_PC ((size_t)(cur_opcode - interpreter->code->byte_code))
#define CUR_OPCODE cur_opcode
END
}
@@ -75,13 +76,17 @@
{
my ($self, $addr) = @_;
#print STDERR "pbcc: map_ret_abs($addr)\n";
- return "cur_opcode = $addr;\ngoto switch_label";
+ if ($addr eq '0') {
+ return "return (0);"
+ } else {
+ return "goto *ops_addr[*(cur_opcode = $addr)]";
+ }
}
sub expr_offset {
my ($self, $offset) = @_;
- return sprintf("&&PC_%d", $self->pc + $offset);
+ return "cur_opcode + $offset";
}
#
@@ -91,12 +96,7 @@
sub goto_offset
{
my ($self, $offset) = @_;
- if ($offset =~ /^-?\d+$/) {
- return sprintf("goto PC_%d", $self->pc + $offset);
- } else {
- return sprintf("cur_opcode = &&PC_%d; cur_opcode += %s; goto switch_label",
$self->pc, $offset);
- }
-#print STDERR "pbcc: map_ret_rel($offset)\n";
+ return "goto *ops_addr[*(cur_opcode += $offset)]";
}
@@ -107,7 +107,7 @@
sub goto_pop
{
my ($self) = @_;
- return "goto *pop_dest(interpreter)";
+ return "opcode_t* pop_addr = (opcode_t*)pop_dest(interpreter);\ncur_opcode =
+pop_addr;goto *ops_addr[*(pop_addr)]";
}
#
@@ -115,22 +115,26 @@
#
my %arg_maps = (
- 'i' => "interpreter->int_reg.registers[%ld]",
- 'n' => "interpreter->num_reg.registers[%ld]",
- 'p' => "interpreter->pmc_reg.registers[%ld]",
- 's' => "interpreter->string_reg.registers[%ld]",
+ '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' => "%ld",
- 'nc' => "interpreter->code->const_table->constants[%ld]->number",
+ '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[%ld]->string",
+ 'sc' => "interpreter->code->const_table->constants[cur_opcode[%ld]]->string",
);
sub access_arg
{
my ($self, $type, $num, $op) = @_;
#print STDERR "pbcc: map_arg($type, $num)\n";
- return sprintf($arg_maps{$type}, $self->arg($num - 1));
+ die "Unrecognized type '$type' for num '$num'" unless exists $arg_maps{$type};
+
+ return sprintf($arg_maps{$type}, $num );
}
@@ -141,7 +145,7 @@
sub restart_address
{
my ($self, $addr) = @_;
- die "pbc2c.pl: Cannot handle RESUME ops!";
+ return "interpreter->resume_offset = $addr; interpreter->resume_flag = 1";
}
@@ -152,9 +156,8 @@
sub restart_offset
{
my ($self, $offset) = @_;
- die "pbc2c.pl: Cannot handle RESUME ops!";
+ return "interpreter->resume_offset = REL_PC + $offset; interpreter->resume_flag =
+1";
}
-
1;
/*
* testcomputedgoto.c - figure out if we can use computed goto
*
* This file is automatically generated by Configure
* from testcomputedgoto_c.in.
*/
int main(int argc, char **argv) {
static void *ptr = &&LABEL;
int a;
goto *ptr;
LABEL: {
a = 1;
}
return 0;
}
ops2cgc.pl
Description: ops2cgc.pl
