This patch adds a few more macros for .ops files to use. In addition
to the existing
goto OFFSET(...)
goto ADDRESS(...)
goto POP()
goto NEXT()
it adds
expr OFFSET(...)
expr ADDRESS(...)
expr POP()
expr NEXT()
This is intended mainly for use in helper functions in .ops files, but
also for ops that need to eg push the address of the next opcode onto
a stack. The only place this currently happens (outside of my private
code) is in the bsr opcode, which previously hardcoded the
computation.
This patch also makes ops2c.pl move the CUR_OPCODE #define a bit
higher in the generated file so that it can be used by static
functions in the preamble.
Finally, I ran into a parentheses matching problem -- should goto
OFFSET(...) rewrite
\bgoto\s+OFFSET\((.*)\)
or
\bgoto\s+OFFSET\((.*?)\)
It was done inconsistently for the different calculations, and of
course neither are correct because you really want matching
parentheses. But that seems like too much bother. (Currently, there's
only one place that uses anything other than $n in the parentheses,
and that's the enternative() op.) So I made them all .*? but emulated
recent POD by also allowing (( ... )) (that's two parenthesis with a
space padding the body.)
The generated core_ops.c and core_ops_prederef.c files after this
patch are identical except for the CUR_OPCODE and REL_PC macros
getting moved a little higher, and the bsr in the regular path (not
prederef) uses 'CUR_OPCODE' instead of the hardcoded 'cur_opcode'.
In summary, this is a big wad of meaningless changes for the current
code. But it will make adding some opcodes easier in the future, and
cleans up a small nit in the current bsr.
Index: ops2c.pl
===================================================================
RCS file: /home/perlcvs/parrot/ops2c.pl,v
retrieving revision 1.14
diff -a -u -r1.14 ops2c.pl
--- ops2c.pl 14 Jan 2002 20:03:52 -0000 1.14
+++ ops2c.pl 14 Jan 2002 20:47:55 -0000
@@ -124,6 +124,8 @@
print SOURCE <<END_C;
#include "$include"
+${defines}
+
END_C
print SOURCE $ops->preamble($trans);
@@ -153,8 +155,6 @@
}
print SOURCE <<END_C;
-
-${defines}
/*
** Op Function Definitions:
Index: core.ops
===================================================================
RCS file: /home/perlcvs/parrot/core.ops,v
retrieving revision 1.78
diff -a -u -r1.78 core.ops
--- core.ops 14 Jan 2002 20:03:52 -0000 1.78
+++ core.ops 14 Jan 2002 20:47:59 -0000
@@ -2402,7 +2402,7 @@
=cut
inline op bsr (in INT) {
- stack_push(interpreter, interpreter->control_stack, CUR_OPCODE + 2,
STACK_ENTRY_DESTINATION, NULL);
+ stack_push(interpreter, interpreter->control_stack, expr NEXT(),
+STACK_ENTRY_DESTINATION, NULL);
goto OFFSET($1);
}
@@ -2478,7 +2478,7 @@
}
op enternative() {
- goto ADDRESS(run_native(interpreter, CUR_OPCODE, (opcode_t
*)interpreter->code->byte_code));
+ goto ADDRESS(( run_native(interpreter, CUR_OPCODE, (opcode_t
+*)interpreter->code->byte_code) ));
}
########################################
Index: Parrot/Op.pm
===================================================================
RCS file: /home/perlcvs/parrot/Parrot/Op.pm,v
retrieving revision 1.4
diff -a -u -r1.4 Op.pm
--- Parrot/Op.pm 31 Dec 2001 17:14:10 -0000 1.4
+++ Parrot/Op.pm 14 Jan 2002 20:47:59 -0000
@@ -163,9 +163,13 @@
$full_body =~ s/{{=\*}}/ $trans->goto_pop(); /mge; # NOTE: MUST BE FIRST
- $full_body =~ s/{{=(.*?)}}/ $trans->goto_address($1); /mge;
$full_body =~ s/{{\+=(.*?)}}/ $trans->goto_offset($1); /mge;
$full_body =~ s/{{-=(.*?)}}/ $trans->goto_offset(-$1); /mge;
+ $full_body =~ s/{{=(.*?)}}/ $trans->goto_address($1); /mge;
+
+ $full_body =~ s/{{\^\+(.*?)}}/ $trans->expr_offset($1); /mge;
+ $full_body =~ s/{{\^-(.*?)}}/ $trans->expr_offset(-$1); /mge;
+ $full_body =~ s/{{\^(.*?)}}/ $trans->expr_address($1); /mge;
return $full_body;
}
Index: Parrot/OpTrans.pm
===================================================================
RCS file: /home/perlcvs/parrot/Parrot/OpTrans.pm,v
retrieving revision 1.3
diff -a -u -r1.3 OpTrans.pm
--- Parrot/OpTrans.pm 1 Jan 2002 03:43:12 -0000 1.3
+++ Parrot/OpTrans.pm 14 Jan 2002 20:48:00 -0000
@@ -15,5 +15,28 @@
# The type for the array of opcodes. Usually it's an array opcode_t, but the
# prederef runops core uses an array of void* to do its clever tricks.
sub opsarraytype { return 'opcode_t' };
+
+# Default implementation of the goto_X methods is gen_goto(expr_X())
+
+sub gen_goto {
+ my ($self, $where_str) = @_;
+ return "return $where_str";
+}
+
+sub goto_address {
+ my $self = shift;
+ return $self->gen_goto($self->expr_address(@_));
+}
+
+sub goto_offset {
+ my $self = shift;
+ return $self->gen_goto($self->expr_offset(@_));
+}
+
+sub goto_pop {
+ my ($self) = @_;
+ return $self->gen_goto($self->expr_pop(@_));
+}
+
1;
Index: Parrot/OpsFile.pm
===================================================================
RCS file: /home/perlcvs/parrot/Parrot/OpsFile.pm,v
retrieving revision 1.14
diff -a -u -r1.14 OpsFile.pm
--- Parrot/OpsFile.pm 8 Jan 2002 16:33:31 -0000 1.14
+++ Parrot/OpsFile.pm 14 Jan 2002 20:48:00 -0000
@@ -173,7 +173,7 @@
foreach my $arg (@args) {
my ($use, $type) = $arg =~ m/^(in|out|inout)\s+(INT|NUM|STR|PMC)$/i;
- die "Unrecognized arg format '$arg'!" unless defined($use) and defined($type);
+ die "Unrecognized arg format '$arg' in '$_'!" unless defined($use) and
+defined($type);
$type = lc substr($type, 0, 1);
@@ -255,6 +255,9 @@
# goto NEXT() {{+=S}} PC' = PC + S Where S is op size
# goto ADDRESS(X) {{=X}} PC' = X Used for absolute jumps
# goto POP() {{=*}} PC' = <pop> Pop address off control stack
+ # expr OFFSET(X) {{^+X}} PC + X Relative address
+ # expr NEXT() {{^+S}} PC + S Where S is op size
+ # expr ADDRESS(X) {{^X}} X Absolute address
#
# HALT() {{=0}} PC' = 0 Halts run_ops loop, no resume
#
@@ -263,6 +266,13 @@
#
# $X {{@X}} Argument X $0 is opcode, $1 is first arg
#
+ # For ease of parsing, if the argument to one of the above
+ # notations in a .ops file contains parentheses, then double the
+ # enclosing parentheses and add a space around the argument,
+ # like so:
+ #
+ # goto OFFSET(( (void*)interpreter->happy_place ))
+ #
# Later transformations turn the Op body notations into C code, based
# on the mode of operation (function calls, switch statements, gotos
# with labels, etc.).
@@ -270,15 +280,24 @@
# TODO: Complain about using, e.g. $3 in an op with only 2 args.
#
- $body =~ s/goto\s+OFFSET\((.*)\)/{{+=$1}}/mg;
- $body =~ s/goto\s+NEXT\(\)/{{+=$op_size}}/mg;
- $body =~ s/goto\s+ADDRESS\((.*)\)/{{=$1}}/mg;
- $body =~ s/goto\s+POP\(\)/{{=*}}/mg;
+ $body =~ s/\bgoto\s+OFFSET\(\( (.*?) \)\)/{{+=$1}}/mg;
+ $body =~ s/\bgoto\s+ADDRESS\(\( (.*?) \)\)/{{=$1}}/mg;
+ $body =~ s/\bexpr\s+OFFSET\(\( (.*?) \)\)/{{^+$1}}/mg;
+ $body =~ s/\bexpr\s+ADDRESS\(\( (.*?) \)\)/{{^$1}}/mg;
+
+ $body =~ s/\bgoto\s+OFFSET\((.*?)\)/{{+=$1}}/mg;
+ $body =~ s/\bgoto\s+NEXT\(\)/{{+=$op_size}}/mg;
+ $body =~ s/\bgoto\s+ADDRESS\((.*?)\)/{{=$1}}/mg;
+ $body =~ s/\bgoto\s+POP\(\)/{{=*}}/mg;
+ $body =~ s/\bexpr\s+OFFSET\((.*?)\)/{{^+$1}}/mg;
+ $body =~ s/\bexpr\s+NEXT\(\)/{{^+$op_size}}/mg;
+ $body =~ s/\bexpr\s+ADDRESS\((.*?)\)/{{^$1}}/mg;
+ $body =~ s/\bexpr\s+POP\(\)/{{^*}}/mg;
- $body =~ s/HALT\(\)/{{=0}}/mg;
+ $body =~ s/\bHALT\(\)/{{=0}}/mg;
- $body =~ s/restart\s+OFFSET\((.*)\)/{{=0,+=$1}}/mg;
- $body =~ s/restart\s+NEXT\(\)/{{=0,+=$op_size}}/mg;
+ $body =~ s/\brestart\s+OFFSET\((.*?)\)/{{=0,+=$1}}/mg;
+ $body =~ s/\brestart\s+NEXT\(\)/{{=0,+=$op_size}}/mg;
$body =~ s/\$(\d+)/{{\@$1}}/mg;
@@ -371,6 +390,10 @@
s/{{=(.*?)}}/ $trans->goto_address($1); /mge;
s/{{\+=(.*?)}}/ $trans->goto_offset($1); /mge;
s/{{-=(.*?)}}/ $trans->goto_offset(-$1); /mge;
+ s/{{\^\*}}/ $trans->expr_pop(); /mge;
+ s/{{\^(.*?)}}/ $trans->expr_address($1); /mge;
+ s/{{\^\+(.*?)}}/$trans->expr_offset($1); /mge;
+ s/{{\^-(.*?)}}/ $trans->expr_offset(-$1); /mge;
}
return $_;
Index: Parrot/OpTrans/C.pm
===================================================================
RCS file: /home/perlcvs/parrot/Parrot/OpTrans/C.pm,v
retrieving revision 1.2
diff -a -u -r1.2 C.pm
--- Parrot/OpTrans/C.pm 24 Dec 2001 03:46:53 -0000 1.2
+++ Parrot/OpTrans/C.pm 14 Jan 2002 20:48:00 -0000
@@ -26,39 +26,25 @@
END
}
+sub gen_goto {
+ my ($self, $where_str) = @_;
+ return "return $where_str";
+}
-#
-# goto_address()
-#
-
-sub goto_address
-{
+sub expr_address {
my ($self, $addr) = @_;
- return "return $addr";
+ return $addr;
}
-
-#
-# goto_offset()
-#
-
-sub goto_offset
-{
- my ($self, $offset) = @_;
- return "return cur_opcode + $offset";
+sub expr_offset {
+ my ($self, $offset) = @_;
+ return "cur_opcode + $offset";
}
-
-#
-# goto_pop()
-#
-
-sub goto_pop
-{
- my ($self) = @_;
- return "return pop_dest(interpreter)";
+sub expr_pop {
+ my ($self) = @_;
+ return "pop_dest(interpreter)";
}
-
#
# access_arg()
Index: Parrot/OpTrans/CGoto.pm
===================================================================
RCS file: /home/perlcvs/parrot/Parrot/OpTrans/CGoto.pm,v
retrieving revision 1.3
diff -a -u -r1.3 CGoto.pm
--- Parrot/OpTrans/CGoto.pm 11 Jan 2002 17:50:36 -0000 1.3
+++ Parrot/OpTrans/CGoto.pm 14 Jan 2002 20:48:00 -0000
@@ -67,7 +67,6 @@
return $self->{ARGS}[shift];
}
-
#
# goto_address()
#
@@ -79,6 +78,11 @@
return "cur_opcode = $addr;\ngoto switch_label";
}
+
+sub expr_offset {
+ my ($self, $offset) = @_;
+ return sprintf("&&PC_%d", $self->pc + $offset);
+}
#
# goto_offset()
Index: Parrot/OpTrans/CPrederef.pm
===================================================================
RCS file: /home/perlcvs/parrot/Parrot/OpTrans/CPrederef.pm,v
retrieving revision 1.4
diff -a -u -r1.4 CPrederef.pm
--- Parrot/OpTrans/CPrederef.pm 13 Jan 2002 08:47:55 -0000 1.4
+++ Parrot/OpTrans/CPrederef.pm 14 Jan 2002 20:48:00 -0000
@@ -1,6 +1,8 @@
#
# CPrederef.pm
#
+# Inherits from C.pm
+#
use strict;
#use warnings;
@@ -9,7 +11,8 @@
use Parrot::OpTrans;
use vars qw(@ISA);
-@ISA = qw(Parrot::OpTrans);
+use Parrot::OpTrans::C;
+@ISA = qw(Parrot::OpTrans::C);
#
@@ -36,40 +39,36 @@
sub opsarraytype { return 'void *' };
-
+# expr_pop
#
-# goto_address()
+# Addresses on the stack are pointers into the bytecode array, and so
+# must be converted to pointers into the prederef array.
#
-sub goto_address
+sub expr_pop
{
- my ($self, $addr) = @_;
- return "return $addr";
+ my ($self) = @_;
+ return "(((opcode_t *)pop_dest(interpreter) - (opcode_t
+*)interpreter->code->byte_code) + interpreter->prederef_code)";
}
-
+# expr_offset and goto_offset
#
-# goto_offset()
+# CPrederef is funky in that expr OFFSET(n) uses a pointer to the
+# original bytecode, but goto OFFSET(n) returns a pointer into the
+# prederef array. (see expr_pop, above, for a description of why this
+# works.)
#
-sub goto_offset
-{
- my ($self, $offset) = @_;
- return "return cur_opcode + $offset";
+sub expr_offset {
+ my ($self, $offset) = @_;
+ return "CUR_OPCODE + $offset";
}
-
-#
-# goto_pop()
-#
-
-sub goto_pop
-{
- my ($self) = @_;
- return "return (((opcode_t *)pop_dest(interpreter) - (opcode_t
*)interpreter->code->byte_code) + interpreter->prederef_code)";
+sub goto_offset {
+ my ($self, $offset) = @_;
+ return "return cur_opcode + $offset";
}
-
#
# access_arg()
#
@@ -97,29 +96,6 @@
return sprintf($arg_maps{$type}, $num);
}
-
-
-#
-# restart_offset()
-#
-
-sub restart_offset
-{
- my ($self, $offset) = @_;
- return "interpreter->resume_offset = REL_PC + $offset; interpreter->resume_flag =
1";
-}
-
-
-#
-# restart_address()
-#
-
-sub restart_address
-{
- my ($self, $addr) = @_;
- return "interpreter->resume_offset = $addr; interpreter->resume_flag = 1";
-}
-
1;
