And now, with the patch
Michael
--
Michael Fischer 7.5 million years to run
[EMAIL PROTECTED] printf "%d", 0x2a;
-- deep thought
diff -ur parrot/Configure.pl dispatcher-11-04/Configure.pl
--- parrot/Configure.pl Fri Nov 2 07:11:15 2001
+++ dispatcher-11-04/Configure.pl Sun Nov 4 12:26:21 2001
@@ -91,6 +91,8 @@
numlow => '(~0xfff)',
strlow => '(~0xfff)',
pmclow => '(~0xfff)',
+
+ do_op_t => 'func',
platform => 'linux',
cp => 'cp',
@@ -118,6 +120,16 @@
prompt("How big would you like integers to be?", 'iv');
prompt("And your floats?", 'nv');
prompt("What is your native opcode type?", 'opcode_t');
+prompt("Opcode dispatch by switch or function ('switch' or 'goto' or 'func')",
+ 'do_op_t');
+
+if ($c{do_opt_t} eq 'goto' and $c{cc} !~ /gcc/i ) {
+ my $not_portable = "
+'goto' opcode dispatch available only with gcc (for now).
+Please rerun and select either 'func' or 'switch'. Sorry\n";
+ die $not_portable;
+}
+
unless( $c{debugging} ) {
$c{ld_debug} = ' ';
diff -ur parrot/Makefile.in dispatcher-11-04/Makefile.in
--- parrot/Makefile.in Fri Nov 2 07:11:15 2001
+++ dispatcher-11-04/Makefile.in Sun Nov 4 12:26:15 2001
@@ -29,6 +29,7 @@
PERL = ${perl}
TEST_PROG = test_prog${exe}
PDUMP = pdump${exe}
+DO_OP_T = ${do_op_t}
.c$(O):
$(CC) $(CFLAGS) ${ld_out}$@ -c $<
@@ -104,13 +105,13 @@
core_ops$(O): $(H_FILES) core_ops.c
core_ops.c $(INC)/oplib/core_ops.h: core.ops ops2c.pl
- $(PERL) ops2c.pl core.ops
+ $(PERL) ops2c.pl -t $(DO_OP_T) core.ops
vtable.ops: make_vtable_ops.pl
$(PERL) make_vtable_ops.pl > vtable.ops
vtable_ops.c $(INC)/oplib/vtable_ops.h: vtable.ops ops2c.pl
- $(PERL) ops2c.pl vtable.ops
+ $(PERL) ops2c.pl -t $(DO_OP_T) vtable.ops
$(INC)/config.h: Configure.pl config_h.in
$(PERL) Configure.pl
diff -ur parrot/interpreter.c dispatcher-11-04/interpreter.c
--- parrot/interpreter.c Fri Oct 26 14:58:02 2001
+++ dispatcher-11-04/interpreter.c Sun Nov 4 12:26:32 2001
@@ -11,7 +11,6 @@
*/
#include "parrot/parrot.h"
-#include "parrot/interp_guts.h"
#include "parrot/oplib/core_ops.h"
#include "parrot/runops_cores.h"
diff -ur parrot/ops2c.pl dispatcher-11-04/ops2c.pl
--- parrot/ops2c.pl Wed Oct 17 20:21:03 2001
+++ dispatcher-11-04/ops2c.pl Sun Nov 4 12:26:39 2001
@@ -1,15 +1,26 @@
#! /usr/bin/perl -w
+
+# vim: expandtab shiftwidth=4 ts=4:
#
# ops2c.pl
#
-# Generate a C header and source file from the operation definitions in
+# Generate a C header and source file from the operation definitions in,
# an .ops file.
#
use strict;
use Parrot::OpsFile;
+use Getopt::Std;
+
+use vars qw($opt_t);
+getopts('t:');
+die "You didn't specifiy how you want DO_OP written!\n
+Use the -t ['func' | 'switch' | 'goto' ] flag, please\n"
+unless $opt_t eq 'func' or $opt_t eq 'switch' or $opt_t eq 'goto';
+my $dispatch = $opt_t;
+
#
# Process command-line argument:
#
@@ -106,19 +117,49 @@
#
my @op_funcs;
+
+my %switch;
+my %goto;
+
my $index = 0;
+my @switch_source_subs = (
+ \&map_ret_abs_switch,
+ \&map_ret_rel_switch,
+ \&map_arg_switch,
+ \&map_res_abs_switch,
+ \&map_res_rel_switch
+ );
+my @goto_source_subs = (
+ \&map_ret_abs_goto,
+ \&map_ret_rel_goto,
+ \&map_arg_switch,
+ \&map_res_abs_goto,
+ \&map_res_rel_goto
+ );
+my @func_source_subs = (
+ \&map_ret_abs,
+ \&map_ret_rel,
+ \&map_arg,
+ \&map_res_abs,
+ \&map_res_rel);
+
foreach my $op ($ops->ops) {
my $func_name = $op->func_name;
my $arg_types = "opcode_t *, struct Parrot_Interp *";
my $prototype = "opcode_t * $func_name ($arg_types)";
my $args = "opcode_t cur_opcode[], struct Parrot_Interp * interpreter";
my $definition = "opcode_t *\n$func_name ($args)";
- my $source = $op->source(\&map_ret_abs, \&map_ret_rel, \&map_arg,
\&map_res_abs, \&map_res_rel);
-
+ my $source = $op->source(@func_source_subs);
+ my $sw_source = $op->source(@switch_source_subs);
+ my $gt_source = $op->source(@goto_source_subs);
print HEADER "$prototype;\n";
print SOURCE sprintf(" %-22s /* %6ld */\n", "$func_name,", $index++);
+ my $idx = $op->{CODE};
+ $switch{$idx} = "{\n$sw_source}\n";
+ $goto{$func_name} = "{\n$gt_source\ngoto *goto_map[*pc];\n}\n\n";
+
push @op_funcs, "$definition {\n$source}\n\n";
}
@@ -139,6 +180,82 @@
print SOURCE @op_funcs;
+#
+# if we are working on core.ops, worry about switch/goto
+# if we are working on vtable, skip it...
+#
+
+if ( $file !~ /vtable/ ) {
+
+ #my $do_op_header = "include/parrot/do_op.h";
+ my $do_op_header = "include/parrot/do_op.h";
+
+ open DO_OP_H, ">$do_op_header"
+ or die "Couldn't write to $do_op_header: $!\n";
+
+ print DO_OP_H <<END;
+$preamble
+#ifndef DO_OP_H
+#define DO_OP_H
+
+#include <math.h>
+#include<sys/time.h>
+END
+
+ if ($dispatch eq 'switch' ) {
+
+ print DO_OP_H "#define DO_OP(pc,interpreter) do { \\\n";
+ print DO_OP_H "switch(*pc) { \\\n";
+
+ for my $label (sort {$a <=> $b} keys %switch) {
+ $switch{$label} =~ s/\n/ \\\n/g;
+ # stupid way cur_opcode survives in bsr_i and bsr_ic
+ $switch{$label} =~ s/cur_opcode/pc/;
+ print DO_OP_H "case $label: \\\n", "$switch{$label}";
+ }
+
+ print DO_OP_H "} \\\n";
+ print DO_OP_H "} while(0);\n"
+ }
+
+ elsif ($dispatch eq 'goto') {
+ print DO_OP_H "void goto_op_dispatch(opcode_t * pc, struct Parrot_Interp *
+interpreter)\n{\n";
+ print DO_OP_H "\n";
+
+ print DO_OP_H "const static void * goto_map[] = {\n";
+ for my $label (keys %goto) {
+ print DO_OP_H "&&" . "$label,\n";
+ }
+ print DO_OP_H "};\n"; # close the array
+
+ # print goto setup
+ print DO_OP_H "while (1) {\n\n";
+ print DO_OP_H "goto *goto_map[*pc];\n";
+
+ for my $label (keys %goto) {
+ print DO_OP_H "$label:\n";
+ # stupid way cur_opcode survives in bsr_i and bsr_ic
+ $goto{$label} =~ s/cur_opcode/pc/;
+ print DO_OP_H "$goto{$label}\n";
+ # map funcs should turn 'returns' into pc += 4, etc.
+ # print DO_OP_H "goto *goto_map[*pc];\n";
+ }
+ # close the function
+ print DO_OP_H "} /* end while(1) */ \n} /* end goto_op_dispatch */\n\n";
+
+ print DO_OP_H "#define DO_OP(pc,interpreter)
+goto_op_dispatch((pc),(interpreter))\n";
+
+ }
+ else { # regular function pointer dispatch
+ print DO_OP_H "
+ #define DO_OP(PC,INTERP) PC = ((INTERP->opcode_funcs)[*PC])(PC,INTERP);
+ ";
+ }
+
+ print DO_OP_H "#endif /* DO_OP_H */\n";
+ close DO_OP_H;
+
+} # end if ( we are doing core.ops )
#
# Op Info Table:
@@ -190,24 +307,45 @@
#
# map_ret_abs()
#
-
sub map_ret_abs
{
my ($addr) = @_;
return "return $addr";
}
+sub map_ret_abs_switch
+{
+ my ($addr) = @_;
+ return "pc = $addr;\nbreak;\n";
+}
+
+sub map_ret_abs_goto
+{
+ my ($addr) = @_;
+ return "pc = $addr;\n";
+}
#
# map_ret_rel()
#
-
sub map_ret_rel
{
my ($offset) = @_;
return "return cur_opcode + $offset";
}
+sub map_ret_rel_switch
+{
+ my ($offset) = @_;
+ return "pc += $offset;\nbreak;\n";
+}
+
+sub map_ret_rel_goto
+{
+ my ($offset) = @_;
+ return "pc += $offset;\n";
+}
+
#
# map_arg()
@@ -236,26 +374,67 @@
return sprintf($arg_maps{$type}, $num);
}
+sub map_arg_switch
+{
+ my ($type, $num) = @_;
+
+ my %arg_maps = (
+ 'op' => "pc[%ld]",
+
+ 'i' => "interpreter->int_reg->registers[pc[%ld]]",
+ 'n' => "interpreter->num_reg->registers[pc[%ld]]",
+ 'p' => "interpreter->pmc_reg->registers[pc[%ld]]",
+ 's' => "interpreter->string_reg->registers[pc[%ld]]",
+
+ 'ic' => "pc[%ld]",
+ 'nc' => "interpreter->code->const_table->constants[pc[%ld]]->number",
+ 'pc' => "%ld /* ERROR: Don't know how to handle PMC constants yet! */",
+ 'sc' => "interpreter->code->const_table->constants[pc[%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";
}
+sub map_res_rel_switch
+{
+ my ($offset) = @_;
+ return "interpreter->resume_addr = pc + $offset;\nbreak;\n";
+}
+
+
+sub map_res_rel_goto
+{
+ my ($offset) = @_;
+ return "interpreter->resume_addr = pc + $offset;\n";
+}
+
#
# map_res_abs()
#
-
sub map_res_abs
{
my ($addr) = @_;
return "interpreter->resume_addr = $addr";
}
+sub map_res_abs_swich
+{
+ my ($addr) = @_;
+ return "interpreter->resume_addr = $addr;\nbreak;\n";
+}
+sub map_res_abs_goto
+{
+ my ($addr) = @_;
+ return "interpreter->resume_addr = $addr;\n";
+}
diff -ur parrot/runops_cores.c dispatcher-11-04/runops_cores.c
--- parrot/runops_cores.c Thu Oct 18 21:43:00 2001
+++ dispatcher-11-04/runops_cores.c Sun Nov 4 12:26:27 2001
@@ -12,7 +12,7 @@
#include "parrot/runops_cores.h"
-#include "parrot/interp_guts.h"
+#include "parrot/do_op.h"
const runops_core_f runops_cores[8] = {
runops_t0p0b0_core,
