All --
I am attaching a .patch file that contains the patch, and a .txt file
that describes the patch.
Have fun, but be sure you are home by 11.
Regards,
-- Gregor
_____________________________________________________________________
/ Inspiration >> Innovation >> Excellence (TM) \
Gregor N. Purdy [EMAIL PROTECTED]
Focus Research, Inc. http://www.focusresearch.com/
8080 Beckett Center Drive #203 513-860-3570 vox
West Chester, OH 45069 513-860-3579 fax
\_____________________________________________________________________/
[[EMAIL PROTECTED]]$ ping osama.taliban.af
PING osama.taliban.af (68.69.65.68) from 20.1.9.11 : 56(84) bytes of
data.
>From 85.83.77.67: Time to live exceeded
Welcome to the Just-in-Time Predereferencing Patch!
This patch implements a "predereferencing" mode for parrot. That means that
a lot of the dereferencing you see in DO_OP and in the opfuncs is done up
front (really, JIT) rather than as and each time we execute each op in the
byte code stream.
This works by creating an array of void pointers with the same number of
elements as the byte code array. This array starts out life zero-initialized.
Each time we go to execute an op, we check first to see if we have a NULL
pointer at *cur_opcode. If so, we know we haven't done our predereferencing
yet (this is the JIT part), so we call the prederef() function with sufficient
args that it can go look up opfunc pointers and op arg types and put the opfunc
and arg pointers at cur_opcode[0] .. cur_opcode[N - 1], where N is the number
of args (counding the op itself as one arg).
We assume that sizeof(INTVAL) <= sizeof(void *), so we can continue to have
inline INTVAL constants.
I've been getting about a 22% speed increase over vanila code path when I
compile with -O0. Advantage decreases at -O9 here. I tested with mops.pbc,
and also by temporarily putting the -P flag in Parrot/Test.pm and running
all the tests. So, this code is as correct as the test suite can detect.
Here's how it plays out in the code:
* New script ops2c-prederef.pl
Copy-paste code reuse from ops2c.pl. Modified to expect the args to give
a void ** cur_opcode and to return a void **.
* Modified ops2c.pl
* opfuncs are now static. Who needs to call them by name from outside,
anyway? They are accessed via the opfunc table.
* Some MACRO stuff to make things work whether we prederef or not. It
may be possible to get rid of these some day if other folks agree
that we should be using CODE object pointers + offsets as our PC
rather than raw pointers to either opcode_t's or (void *)'s
(depending on prederef mode or no).
* core.ops modified to be usable to build both kinds of opfuncs. For now,
this means:
* calls to push_generic_entry(... cur_opcode ...) were changed to
push_generic_entry(... CUR_OPCODE ...), where CUR_OPCODE is a
macro that does the right thing in both kinds of ops.c files.
This is applicable to the bsr op. If we treated destinations as
(Code PMC + local offset) rather than as pointer-to-memory-somewhere,
this wouldn't be a big deal. We may need to do that at some point
anyway, so that when you jump around and return not only do you have
the right PC (pointer, today), but you also have the thread/interpreter
knowing what chunk of bytecode it is in at all times (assuming we'll
allow reflection, as in ops that query or affect the current CODE PMC).
* runinterp was modified. Instead of copying the top-level PackFile struct
and blasting its byte_code pointer, we simply call runops on the new
interp, passing in the pointer to the current interp's code and the
offset into that code at which to start (this last arg used to be a
pointer PC, now its an offset PC).
* include/parrot/op.h
* new typedef for prederef opfuncs (they return void **)
* include/parrot/interp_guts.h
* New DO_OP_PREDEREF() macro described above.
* include/parrot/interpreter.h
* New prototype of runops() -- see below.
* resume_addr field changed to resume_flag and resume_offset pair of fields.
We might be resuming from interp using prederef to one not or vice-versa,
so pointers between the two don't play nice together. Offsets are beautiful.
* New PARROT_PREDEREF_FLAG constant
* interpreter.c
* include "parrot/oplib/core_ops_prederef.h"
* prederef() function described above.
* runops_prederef() runops variant. Uses DO_OP_PREDEREF() macro as its core.
* runops() modified to take size_t CODE-relative offset PC rather than
pointer PC. This made other things workable and doesn't seem to have lost
anything important (IMO).
* test_main.c
* New flag '-P' to enable predereferencing.
* Makefile modified to build core_ops_prederef.c from core.ops via
ops2c-prederef.pl.
BTW, also added missing $(INC)/interp_guts.h to H_FILES.
Added core_ops_prederef$(O) to O_FILES
Index: .cvsignore
===================================================================
RCS file: /home/perlcvs/parrot/.cvsignore,v
retrieving revision 1.10
diff -a -u -r1.10 .cvsignore
--- .cvsignore 11 Dec 2001 12:03:40 -0000 1.10
+++ .cvsignore 11 Dec 2001 15:16:38 -0000
@@ -1,4 +1,5 @@
core_ops.c
+core_ops_prederef.c
Makefile
pdump
parrot
Index: Makefile.in
===================================================================
RCS file: /home/perlcvs/parrot/Makefile.in,v
retrieving revision 1.66
diff -a -u -r1.66 Makefile.in
--- Makefile.in 11 Dec 2001 03:58:42 -0000 1.66
+++ Makefile.in 11 Dec 2001 15:16:38 -0000
@@ -6,15 +6,16 @@
H_FILES = $(INC)/config.h $(INC)/exceptions.h $(INC)/io.h $(INC)/op.h \
$(INC)/register.h $(INC)/string.h $(INC)/events.h $(INC)/interpreter.h \
$(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)/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 \
+$(INC)/interp_guts.h
CLASS_O_FILES = classes/default$(O) classes/perlint$(O) classes/perlstring$(O) \
classes/perlnum$(O) classes/perlundef$(O)
O_FILES = global_setup$(O) interpreter$(O) parrot$(O) register$(O) \
-core_ops$(O) memory$(O) packfile$(O) stacks$(O) string$(O) encoding$(O) \
+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) \
encodings/singlebyte$(O) encodings/utf8$(O) encodings/utf16$(O) \
encodings/utf32$(O) chartypes/unicode$(O) chartypes/usascii$(O) resources$(O) \
@@ -113,6 +114,11 @@
core_ops.c $(INC)/oplib/core_ops.h: core.ops vtable.ops ops2c.pl
$(PERL) ops2c.pl core.ops vtable.ops
+core_ops_prederef$(O): $(H_FILES) core_ops_prederef.c
+
+core_ops_prederef.c $(INC)/oplib/core_ops_prederef.h: core.ops vtable.ops
+ops2c-prederef.pl
+ $(PERL) ops2c-prederef.pl core.ops vtable.ops
+
vtable.ops: make_vtable_ops.pl
$(PERL) make_vtable_ops.pl > vtable.ops
@@ -132,9 +138,9 @@
clean:
$(RM_F) *$(O) chartypes/*$(O) encodings/*$(O)
- $(RM_F) *.s core_ops.c $(TEST_PROG) $(PDISASM) $(PDUMP)
+ $(RM_F) *.s core_ops.c core_ops_prederef.c $(TEST_PROG) $(PDISASM) $(PDUMP)
$(RM_F) $(INC)/vtable.h
- $(RM_F) $(INC)/oplib/core_ops.h
+ $(RM_F) $(INC)/oplib/core_ops.h $(INC)/oplib/core_ops_prederef.h
$(RM_F) vtable.ops
$(RM_F) $(TEST_PROG) $(PDISASM) $(PDUMP)
$(RM_F) t/op/*.pasm t/op/*.pbc t/op/*.out
Index: core.ops
===================================================================
RCS file: /home/perlcvs/parrot/core.ops,v
retrieving revision 1.45
diff -a -u -r1.45 core.ops
--- core.ops 11 Dec 2001 04:00:58 -0000 1.45
+++ core.ops 11 Dec 2001 15:16:39 -0000
@@ -2128,7 +2128,7 @@
=cut
MANUAL_OP bsr(i|ic) {
- push_generic_entry(interpreter, &interpreter->control_stack_top, cur_opcode + 2,
STACK_ENTRY_DESTINATION, NULL);
+ push_generic_entry(interpreter, &interpreter->control_stack_top, CUR_OPCODE + 2,
+STACK_ENTRY_DESTINATION, NULL);
RETREL($1);
}
@@ -2183,10 +2183,8 @@
=cut
AUTO_OP runinterp(p, i|ic) {
- struct PackFile local_file;
- memcpy(&local_file, interpreter->code, sizeof(struct PackFile));
- local_file.byte_code = (char *)(cur_opcode + $2);
- runops($1->data, &local_file);
+ struct Parrot_Interp * new_interp = (struct Parrot_Interp *)$1->data;
+ runops(new_interp, interpreter->code, REL_PC + $2);
}
########################################
Index: interpreter.c
===================================================================
RCS file: /home/perlcvs/parrot/interpreter.c,v
retrieving revision 1.35
diff -a -u -r1.35 interpreter.c
--- interpreter.c 6 Dec 2001 17:48:58 -0000 1.35
+++ interpreter.c 11 Dec 2001 15:16:39 -0000
@@ -13,6 +13,7 @@
#include "parrot/parrot.h"
#include "parrot/interp_guts.h"
#include "parrot/oplib/core_ops.h"
+#include "parrot/oplib/core_ops_prederef.h"
#include "parrot/runops_cores.h"
@@ -74,21 +75,122 @@
}
+/*=for api interpreter prederef
+ */
+
+prederef_op_func_t
+prederef(opcode_t * pc, void ** pc_prederef, struct Parrot_Interp * interpreter)
+{
+ op_info_t * opinfo = &core_opinfo_prederef[*pc];
+ int i;
+
+ for (i = 0; i < opinfo->arg_count; i++) {
+ switch (opinfo->types[i]) {
+ case PARROT_ARG_OP:
+ pc_prederef[i] = (void *)core_opfunc_prederef[pc[i]];
+ break;
+
+ case PARROT_ARG_I:
+ pc_prederef[i] = (void *)&interpreter->int_reg->registers[pc[i]];
+ break;
+
+ case PARROT_ARG_N:
+ pc_prederef[i] = (void *)&interpreter->num_reg->registers[pc[i]];
+ break;
+
+ case PARROT_ARG_P:
+ pc_prederef[i] = (void *)&interpreter->pmc_reg->registers[pc[i]];
+ break;
+
+ case PARROT_ARG_S:
+ pc_prederef[i] = (void *)&interpreter->string_reg->registers[pc[i]];
+ break;
+
+ case PARROT_ARG_IC:
+ pc_prederef[i] = (void *)pc[i];
+ break;
+
+ case PARROT_ARG_NC:
+ pc_prederef[i] = (void
+*)&interpreter->code->const_table->constants[pc[i]]->number;
+ break;
+
+ case PARROT_ARG_PC:
+/* pc_prederef[i] = (void
+*)&interpreter->code->const_table->constants[pc[i]]->pmc; */
+ fprintf(stderr, "PMC constants not yet supported!\n");
+ exit(1);
+ break;
+
+ case PARROT_ARG_SC:
+ pc_prederef[i] = (void
+*)&interpreter->code->const_table->constants[pc[i]]->string;
+ break;
+
+ default:
+ break;
+ }
+
+ if (opinfo->types[i] != PARROT_ARG_IC && pc_prederef[i] == 0) {
+ fprintf(stderr, "Prederef generated a NULL pointer for arg of type %d!\n",
+opinfo->types[i]);
+ exit(1);
+ }
+ }
+
+
+ return (prederef_op_func_t)pc_prederef[0];
+}
+
+
+/*=for api interpreter runops_prederef
+ */
+void
+runops_prederef (struct Parrot_Interp *interpreter, opcode_t * pc, void **
+pc_prederef) {
+ opcode_t * code_start;
+ INTVAL code_size;
+ opcode_t * code_end;
+ void ** code_start_prederef;
+
+ check_fingerprint(interpreter);
+
+ code_start = (opcode_t *)interpreter->code->byte_code;
+ code_size = interpreter->code->byte_code_size;
+ code_end = (opcode_t *)(interpreter->code->byte_code + code_size);
+
+ code_start_prederef = pc_prederef;
+
+ while (pc_prederef) {
+ DO_OP_PREDEREF(pc, pc_prederef, interpreter);
+
+ if (pc_prederef == 0) {
+ pc = 0;
+ }
+ else {
+ pc = code_start + (pc_prederef - code_start_prederef);
+ }
+ }
+
+ if (pc && (pc < code_start || pc >= code_end)) {
+ fprintf(stderr, "Error: Control left bounds of byte-code block (now at
+location %d)!\n", (int) (pc - code_start));
+ exit(1);
+ }
+}
+
+
/*=for api interpreter runops
* run parrot operations until the program is complete
*/
void
-runops (struct Parrot_Interp *interpreter, struct PackFile * code) {
+runops (struct Parrot_Interp *interpreter, struct PackFile * code, size_t offset) {
opcode_t * (*core)(struct Parrot_Interp *, opcode_t *);
- interpreter->code = code;
- interpreter->resume_addr = (opcode_t *)interpreter->code->byte_code;
+ interpreter->code = code;
+ interpreter->resume_offset = offset;
+ interpreter->resume_flag = 1;
- while (interpreter->resume_addr) {
+ while (interpreter->resume_flag) {
int which = 0;
- opcode_t * pc = interpreter->resume_addr;
+ opcode_t * pc = (opcode_t *)interpreter->code->byte_code +
+interpreter->resume_offset;
- interpreter->resume_addr = (opcode_t *)NULL;
+ interpreter->resume_offset = 0;
+ interpreter->resume_flag = 0;
which |= interpreter->flags & PARROT_BOUNDS_FLAG ? 0x01 : 0x00;
which |= interpreter->flags & PARROT_PROFILE_FLAG ? 0x02 : 0x00;
@@ -108,7 +210,23 @@
}
}
- runops_generic(core, interpreter, pc);
+ if ((interpreter->flags & PARROT_PREDEREF_FLAG) != 0) {
+ size_t offset = pc - (opcode_t *)interpreter->code->byte_code;
+
+ if (!interpreter->prederef_code) {
+ interpreter->prederef_code = (void
+**)calloc(interpreter->code->byte_code_size, sizeof(void *));
+ }
+
+ runops_prederef(interpreter, pc, interpreter->prederef_code + offset);
+ }
+ else {
+ runops_generic(core, interpreter, pc);
+ }
+ }
+
+ if (interpreter->prederef_code) {
+ free(interpreter->prederef_code);
+ interpreter->prederef_code = NULL;
}
}
@@ -201,7 +319,10 @@
interpreter->code = (struct PackFile *)NULL;
interpreter->profile = (INTVAL *)NULL;
- interpreter->resume_addr = (opcode_t *)NULL;
+ interpreter->resume_flag = 0;
+ interpreter->resume_offset = 0;
+
+ interpreter->prederef_code = (void **)NULL;
return interpreter;
}
Index: ops2c-prederef.pl
===================================================================
RCS file: ops2c-prederef.pl
diff -N ops2c-prederef.pl
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ ops2c-prederef.pl 11 Dec 2001 15:16:39 -0000
@@ -0,0 +1,292 @@
+#! /usr/bin/perl -w
+#
+# ops2c-prederef.pl
+#
+# Generate a C header and source file from the operation definitions in
+# an .ops file.
+#
+# This variant produces opfuncs that expect the args to be predereferenced
+# by the crystalizing loader and called from the crystalized runops.
+#
+
+use strict;
+use Parrot::OpsFile;
+
+sub Usage {
+ print STDERR <<_EOF_;
+usage: $0 input.ops [input2.ops ...]\n";
+_EOF_
+ exit 1;
+}
+
+#
+# Process command-line argument:
+#
+
+Usage() unless @ARGV;
+
+my $file = 'core.ops';
+
+my $base = $file;
+$base =~ s/\.ops$//;
+
+my $incdir = "include/parrot/oplib";
+my $include = "parrot/oplib/${base}_ops_prederef.h";
+my $header = "include/$include";
+my $source = "${base}_ops_prederef.c";
+
+
+#
+# Read the input file:
+#
+$file = shift @ARGV;
+die "$0: Could not read ops file '$file'!\n" unless -e $file;
+
+my $ops = new Parrot::OpsFile $file;
+
+for $file (@ARGV) {
+ die "$0: Could not read ops file '$file'!\n" unless -e $file;
+ my $temp_ops = new Parrot::OpsFile $file;
+ for(@{$temp_ops->{OPS}}) {
+ push @{$ops->{OPS}},$_;
+ }
+}
+my $cur_code = 0;
+for(@{$ops->{OPS}}) {
+ $_->{CODE}=$cur_code++;
+}
+
+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 "ops2c.pl: Could not mkdir $incdir $!!\n";
+}
+
+open HEADER, ">$header"
+ or die "ops2c.pl: Could not open header file '$header' for writing: $!!\n";
+
+open SOURCE, ">$source"
+ or die "ops2c.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"
+
+
+extern INTVAL ${base}_numops_prederef;
+
+extern prederef_op_func_t ${base}_opfunc_prederef[$num_entries];
+extern op_info_t ${base}_opinfo_prederef[$num_entries];
+
+END_C
+
+print SOURCE $preamble;
+print SOURCE <<END_C;
+#include "$include"
+
+#define opcode_t void *
+#define REL_PC ((size_t)(cur_opcode - interpreter->prederef_code))
+#define CUR_OPCODE (((opcode_t *)interpreter->code->byte_code) + REL_PC)
+
+END_C
+
+print SOURCE $ops->preamble;
+
+
+#
+# Iterate over the ops, appending HEADER and SOURCE fragments:
+#
+
+my @op_funcs;
+my @op_func_table;
+my $index = 0;
+
+foreach my $op ($ops->ops) {
+ my $func_name = $op->func_name . "_prederef";
+ my $arg_types = "void **, struct Parrot_Interp *";
+ my $prototype = "void ** $func_name ($arg_types)";
+ my $args = "void * cur_opcode[], struct Parrot_Interp * interpreter";
+ my $definition = "void **\n$func_name ($args)";
+ my $source = $op->source(\&map_ret_abs, \&map_ret_rel, \&map_arg,
+\&map_res_abs, \&map_res_rel);
+
+ print HEADER "$prototype;\n";
+
+ push @op_func_table, sprintf(" %-50s /* %6ld */\n", "$func_name,", $index++);
+ push @op_funcs, "$definition {\n$source}\n\n";
+}
+
+print SOURCE <<END_C;
+
+/*
+** Op Function Definitions:
+*/
+
+END_C
+
+print SOURCE @op_funcs;
+
+
+print SOURCE <<END_C;
+
+INTVAL ${base}_numops_prederef = $num_ops;
+
+/*
+** Op Function Table:
+*/
+
+prederef_op_func_t ${base}_opfunc_prederef[$num_entries] = {
+END_C
+
+print SOURCE @op_func_table;
+
+#
+# Finish the SOURCE file's array initializer:
+#
+
+print SOURCE <<END_C;
+ NULL
+};
+
+END_C
+
+#
+# Op Info Table:
+#
+
+print SOURCE <<END_C;
+
+/*
+** Op Info Table:
+*/
+
+op_info_t ${base}_opinfo_prederef[$num_entries] = {
+END_C
+
+$index = 0;
+
+foreach my $op ($ops->ops) {
+ my $type = sprintf("PARROT_%s_OP", uc $op->type);
+ my $name = $op->name;
+ my $full_name = $op->full_name;
+ my $func_name = $op->func_name;
+ my $body = $op->body;
+ my $arg_count = $op->size;
+ my $arg_types = "{ " . join(", ", map { sprintf("PARROT_ARG_%s", uc $_) }
+$op->arg_types) . " }";
+
+ print SOURCE <<END_C;
+ { /* $index */
+ $type,
+ "$name",
+ "$full_name",
+ "$func_name",
+ "", /* TODO: Put the body here */
+ $arg_count,
+ $arg_types
+ },
+END_C
+
+ $index++;
+}
+
+print SOURCE <<END_C;
+};
+
+END_C
+
+exit 0;
+
+
+#
+# map_ret_abs()
+#
+
+sub map_ret_abs
+{
+ my ($addr) = @_;
+ return "return $addr";
+}
+
+
+#
+# map_ret_rel()
+#
+
+sub map_ret_rel
+{
+ my ($offset) = @_;
+ return "return cur_opcode + $offset";
+}
+
+
+#
+# map_arg()
+#
+
+sub map_arg
+{
+ my ($type, $num, $self) = @_;
+
+ my %arg_maps = (
+ 'op' => "cur_opcode[%ld]",
+
+ 'i' => "(*(INTVAL *)cur_opcode[%ld])",
+ 'n' => "(*(FLOATVAL *)cur_opcode[%ld])",
+ 'p' => "(*(PMC **)cur_opcode[%ld])",
+ 's' => "(*(STRING **)cur_opcode[%ld])",
+
+ 'ic' => "(*(INTVAL *)&cur_opcode[%ld])",
+ 'nc' => "(*(FLOATVAL *)cur_opcode[%ld])",
+ 'pc' => "%ld /* ERROR: Don't know how to handle PMC constants yet! */",
+ 'sc' => "(*(STRING **)cur_opcode[%ld])",
+ );
+
+ die "Unrecognized type '$type' for num '$num' in opcode @{[$self->full_name]}"
+unless exists $arg_maps{$type};
+
+ return sprintf($arg_maps{$type}, $num);
+}
+
+
+#
+# map_res_rel()
+#
+
+sub map_res_rel
+{
+ my ($offset) = @_;
+ return "interpreter->resume_offset = REL_PC + $offset; interpreter->resume_flag =
+1";
+}
+
+
+#
+# map_res_abs()
+#
+
+sub map_res_abs
+{
+ my ($addr) = @_;
+ return "interpreter->resume_offset = $addr; interpreter->resume_flag = 1";
+}
+
+
Index: ops2c.pl
===================================================================
RCS file: /home/perlcvs/parrot/ops2c.pl,v
retrieving revision 1.5
diff -a -u -r1.5 ops2c.pl
--- ops2c.pl 25 Nov 2001 08:40:06 -0000 1.5
+++ ops2c.pl 11 Dec 2001 15:16:39 -0000
@@ -90,6 +90,9 @@
print HEADER <<END_C;
#include "parrot/parrot.h"
+#define REL_PC ((size_t)(cur_opcode - (opcode_t *)interpreter->code->byte_code))
+#define CUR_OPCODE cur_opcode
+
extern INTVAL ${base}_numops;
extern op_func_t ${base}_opfunc[$num_entries];
@@ -105,23 +108,14 @@
print SOURCE $ops->preamble;
-print SOURCE <<END_C;
-
-INTVAL ${base}_numops = $num_ops;
-
-/*
-** Op Function Table:
-*/
-
-op_func_t ${base}_opfunc[$num_entries] = {
-END_C
-
#
# Iterate over the ops, appending HEADER and SOURCE fragments:
#
my @op_funcs;
+my @op_func_table;
+
my $index = 0;
foreach my $op ($ops->ops) {
@@ -129,31 +123,48 @@
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 $definition = "static opcode_t *\n$func_name ($args)";
my $source = $op->source(\&map_ret_abs, \&map_ret_rel, \&map_arg,
\&map_res_abs, \&map_res_rel);
- print HEADER "$prototype;\n";
- print SOURCE sprintf(" %-22s /* %6ld */\n", "$func_name,", $index++);
+# print HEADER "$prototype;\n";
- push @op_funcs, "$definition {\n$source}\n\n";
+ push @op_func_table, sprintf(" %-50s /* %6ld */\n", "$func_name,", $index++);
+ push @op_funcs, "$definition {\n$source}\n\n";
}
+print SOURCE <<END_C;
+
+/*
+** Op Function Definitions:
+*/
+
+END_C
+
+print SOURCE @op_funcs;
+
#
# Finish the SOURCE file's array initializer:
#
print SOURCE <<END_C;
- NULL
-};
+INTVAL ${base}_numops = $num_ops;
/*
-** Op Function Definitions:
+** Op Function Table:
*/
+op_func_t ${base}_opfunc[$num_entries] = {
END_C
-print SOURCE @op_funcs;
+print SOURCE @op_func_table;
+
+print SOURCE <<END_C;
+ NULL
+};
+
+
+END_C
#
@@ -260,7 +271,7 @@
sub map_res_rel
{
my ($offset) = @_;
- return "interpreter->resume_addr = cur_opcode + $offset";
+ return "interpreter->resume_offset = REL_PC + $offset; interpreter->resume_flag =
+1";
}
@@ -271,7 +282,7 @@
sub map_res_abs
{
my ($addr) = @_;
- return "interpreter->resume_addr = $addr";
+ return "interpreter->resume_offset = $addr; interpreter->resume_flag = 1";
}
Index: test_main.c
===================================================================
RCS file: /home/perlcvs/parrot/test_main.c,v
retrieving revision 1.20
diff -a -u -r1.20 test_main.c
--- test_main.c 6 Dec 2001 17:48:58 -0000 1.20
+++ test_main.c 11 Dec 2001 15:16:39 -0000
@@ -22,22 +22,29 @@
int profiling;
int tracing;
int debugging;
+ int predereferencing;
struct Parrot_Interp *interpreter;
init_world();
/*
- ** Look for the '-d' debugging, '-b' bounds checking,
- ** '-p' profiling and '-t' tracing switches.
+ ** Look for the switches:
+ **
+ ** -d debugging
+ ** -b bounds checking
+ ** -p profiling
+ ** -P predereferencing
+ ** -t tracing
**
** We really should use getopt, but are we allowed?
*/
- flags = 0;
- bounds_checking = 0;
- profiling = 0;
- tracing = 0;
- debugging = 0;
+ flags = 0;
+ bounds_checking = 0;
+ profiling = 0;
+ tracing = 0;
+ debugging = 0;
+ predereferencing = 0;
while (argc > 1 && argv[1][0] == '-') {
if (argv[1][1] == 'b' && argv[1][2] == '\0') {
@@ -54,6 +61,13 @@
}
argc--;
}
+ else if (argv[1][1] == 'P' && argv[1][2] == '\0') {
+ predereferencing = 1;
+ for(i = 2; i < argc; i++) {
+ argv[i-1] = argv[i];
+ }
+ argc--;
+ }
else if (argv[1][1] == 't' && argv[1][2] == '\0') {
tracing = 1;
for(i = 2; i < argc; i++) {
@@ -88,6 +102,10 @@
flags |= PARROT_PROFILE_FLAG;
}
+ if (predereferencing) {
+ flags |= PARROT_PREDEREF_FLAG;
+ }
+
if (tracing) {
flags |= PARROT_TRACE_FLAG;
}
@@ -142,7 +160,7 @@
** Run the interpreter loop:
*/
- runops(interpreter, pf);
+ runops(interpreter, pf, 0);
/*
** If any profile information was gathered, print it out:
Index: include/parrot/interp_guts.h
===================================================================
RCS file: /home/perlcvs/parrot/include/parrot/interp_guts.h,v
retrieving revision 1.1
diff -a -u -r1.1 interp_guts.h
--- include/parrot/interp_guts.h 14 Oct 2001 00:43:50 -0000 1.1
+++ include/parrot/interp_guts.h 11 Dec 2001 15:16:39 -0000
@@ -7,5 +7,9 @@
#define DO_OP(PC,INTERP) PC = ((INTERP->opcode_funcs)[*PC])(PC,INTERP);
+#define DO_OP_PREDEREF(PC,PC_PDR,INTERP) \
+ if (*PC_PDR == 0) *PC_PDR = prederef(PC, PC_PDR, INTERP); \
+ PC_PDR = ((prederef_op_func_t)*PC_PDR)(PC_PDR, INTERP);
+
#endif /* INTERP_GUTS_H */
Index: include/parrot/interpreter.h
===================================================================
RCS file: /home/perlcvs/parrot/include/parrot/interpreter.h,v
retrieving revision 1.14
diff -a -u -r1.14 interpreter.h
--- include/parrot/interpreter.h 6 Dec 2001 17:48:59 -0000 1.14
+++ include/parrot/interpreter.h 11 Dec 2001 15:16:40 -0000
@@ -42,14 +42,19 @@
that signal that runops
should do something */
INTVAL * profile; /* The array where we keep the profile
counters */
- opcode_t * resume_addr;
+
+ INTVAL resume_flag;
+ size_t resume_offset;
+
struct PackFile * code; /* The code we are executing */
+ void ** prederef_code; /* The predereferenced code */
};
-#define PARROT_DEBUG_FLAG 0x01 /* We're debugging */
-#define PARROT_TRACE_FLAG 0x02 /* We're tracing execution */
-#define PARROT_BOUNDS_FLAG 0x04 /* We're tracking byte code bounds */
-#define PARROT_PROFILE_FLAG 0x08 /* We're gathering profile information */
+#define PARROT_DEBUG_FLAG 0x01 /* We're debugging */
+#define PARROT_TRACE_FLAG 0x02 /* We're tracing execution */
+#define PARROT_BOUNDS_FLAG 0x04 /* We're tracking byte code bounds */
+#define PARROT_PROFILE_FLAG 0x08 /* We're gathering profile information */
+#define PARROT_PREDEREF_FLAG 0x10 /* We're using the prederef runops */
#define PCONST(i) PF_CONST(interpreter->code, (i))
#define PNCONST PF_NCONST(interpreter->code)
@@ -61,7 +66,7 @@
runops_generic();
void
-runops(struct Parrot_Interp *, struct PackFile *);
+runops(struct Parrot_Interp *, struct PackFile *, size_t offset);
#endif
Index: include/parrot/op.h
===================================================================
RCS file: /home/perlcvs/parrot/include/parrot/op.h,v
retrieving revision 1.1
diff -a -u -r1.1 op.h
--- include/parrot/op.h 14 Oct 2001 00:43:50 -0000 1.1
+++ include/parrot/op.h 11 Dec 2001 15:16:40 -0000
@@ -41,6 +41,7 @@
/* NOTE: Sure wish we could put the types here... */
typedef opcode_t *(*op_func_t)();
+typedef void **(*prederef_op_func_t)();
/*
Index: include/parrot/oplib/.cvsignore
===================================================================
RCS file: /home/perlcvs/parrot/include/parrot/oplib/.cvsignore,v
retrieving revision 1.2
diff -a -u -r1.2 .cvsignore
--- include/parrot/oplib/.cvsignore 18 Oct 2001 14:18:16 -0000 1.2
+++ include/parrot/oplib/.cvsignore 11 Dec 2001 15:16:40 -0000
@@ -1 +1,2 @@
*_ops.h
+*_ops_prederef.h
