On Thu, Feb 07, 2002 at 01:15:44AM -0500, Josh Wilmes wrote:
>
> +sub goto_address {
> + return "return NULL; /* THIS IS BROKEN, but this op is for pbc2c.pl, so pre
> deref isn't used yet. */";
> +}
> +
Hrm. I don't like that much, because my .ops file uses the goto
ADDRESS() form for several things. Here's a much more extensive patch
that fixes it to work properly, and deletes a bazillion casts as well.
It also points to the question "can we make the byte_code be an
opcode_t* already?"
Oh, and it makes some of the formatting prettier, so it's gotta be
good.
Index: lib/Parrot/Op.pm
===================================================================
RCS file: /home/perlcvs/parrot/lib/Parrot/Op.pm,v
retrieving revision 1.6
diff -a -u -r1.6 Op.pm
--- lib/Parrot/Op.pm 30 Jan 2002 23:19:46 -0000 1.6
+++ lib/Parrot/Op.pm 7 Feb 2002 20:10:53 -0000
@@ -162,6 +162,45 @@
return $body;
}
+sub _substitute {
+ my $self = shift;
+ local $_ = shift;
+ my $trans = shift;
+
+ s/{{([a-z]+)\@([^{]*?)}}/ $trans->access_arg($1, $2, $self); /me;
+ s/{{\@([^{]*?)}}/ $trans->access_arg($self->arg_type($1), $1, $self); /me;
+
+ s/{{=0,=([^{]*?)}}/ $trans->restart_address($1) . "; {{=0}}"; /me;
+ s/{{=0,\+=([^{]*?)}}/ $trans->restart_offset($1) . "; {{=0}}"; /me;
+ s/{{=0,-=([^{]*?)}}/ $trans->restart_offset(-$1) . "; {{=0}}"; /me;
+
+ s/{{=\*}}/ $trans->goto_pop(); /me;
+
+ s/{{\+=([^{]*?)}}/ $trans->goto_offset($1); /me;
+ s/{{-=([^{]*?)}}/ $trans->goto_offset(-$1); /me;
+ s/{{=([^*][^{]*?)}}/ $trans->goto_address($1); /me;
+
+ s/{{\^\+([^{]*?)}}/ $trans->expr_offset($1); /me;
+ s/{{\^-([^{]*?)}}/ $trans->expr_offset(-$1); /me;
+ s/{{\^([^{]*?)}}/ $trans->expr_address($1); /me;
+
+ return $_;
+}
+
+# Correctly handle nested substitions for {{...}} by making sure the ...
+# never contains '{', and repeating over the whole string until no more
+# substitutions can be made.
+sub rewrite_body {
+ my ($self, $body, $trans) = @_;
+
+ while (1) {
+ my $new_body = $self->_substitute($body, $trans);
+ last if $body eq $new_body;
+ $body = $new_body;
+ }
+
+ return $body;
+}
#
# source()
@@ -170,27 +209,7 @@
sub source
{
my ($self, $trans) = @_;
-
- my $full_body = $self->full_body;
-
- $full_body =~ s/{{([a-z]+)\@(.*?)}}/ $trans->access_arg($1, $2, $self); /mge;
- $full_body =~ s/{{\@(.*?)}}/ $trans->access_arg($self->arg_type($1), $1, $self);
/mge;
-
- $full_body =~ s/{{=0,=(.*?)}}/ $trans->restart_address($1) . "; " .
$trans->goto_address(0); /mge;
- $full_body =~ s/{{=0,\+=(.*?)}}/ $trans->restart_offset($1) . "; " .
$trans->goto_address(0); /mge;
- $full_body =~ s/{{=0,-=(.*?)}}/ $trans->restart_offset(-$1) . "; " .
$trans->goto_address(0); /mge;
-
- $full_body =~ s/{{=\*}}/ $trans->goto_pop(); /mge; # NOTE: MUST BE FIRST
-
- $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;
+ return $self->rewrite_body($self->full_body, $trans);
}
Index: lib/Parrot/OpsFile.pm
===================================================================
RCS file: /home/perlcvs/parrot/lib/Parrot/OpsFile.pm,v
retrieving revision 1.16
diff -a -u -r1.16 OpsFile.pm
--- lib/Parrot/OpsFile.pm 30 Jan 2002 23:19:46 -0000 1.16
+++ lib/Parrot/OpsFile.pm 7 Feb 2002 20:10:54 -0000
@@ -283,24 +283,24 @@
$jumps ||= $body =~ s/\bgoto\s+OFFSET\(\( (.*?) \)\)/{{+=$1}}/mg;
$jumps ||= $body =~ s/\bgoto\s+ADDRESS\(\( (.*?) \)\)/{{=$1}}/mg;
- $body =~ s/\bexpr\s+OFFSET\(\( (.*?) \)\)/{{^+$1}}/mg;
- $body =~ s/\bexpr\s+ADDRESS\(\( (.*?) \)\)/{{^$1}}/mg;
+ $body =~ s/\bexpr\s+OFFSET\(\( (.*?) \)\)/{{^+$1}}/mg;
+ $body =~ s/\bexpr\s+ADDRESS\(\( (.*?) \)\)/{{^$1}}/mg;
$jumps ||= $body =~ s/\bgoto\s+OFFSET\((.*?)\)/{{+=$1}}/mg;
- $body =~ s/\bgoto\s+NEXT\(\)/{{+=$op_size}}/mg;
+ $body =~ s/\bgoto\s+NEXT\(\)/{{+=$op_size}}/mg;
$jumps ||= $body =~ s/\bgoto\s+ADDRESS\((.*?)\)/{{=$1}}/mg;
$jumps ||= $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/\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/\bHALT\(\)/{{=0}}/mg;
+ $body =~ s/\bHALT\(\)/{{=0}}/mg;
$jumps ||= $body =~ s/\brestart\s+OFFSET\((.*?)\)/{{=0,+=$1}}/mg;
- $body =~ s/\brestart\s+NEXT\(\)/{{=0,+=$op_size}}/mg;
+ $body =~ s/\brestart\s+NEXT\(\)/{{=0,+=$op_size}}/mg;
- $body =~ s/\$(\d+)/{{\@$1}}/mg;
+ $body =~ s/\$(\d+)/{{\@$1}}/mg;
$op->body(qq{#line $line "$file"\n}.$body);
@@ -388,15 +388,10 @@
s/goto\s+POP\(\)/{{=*}}/mg;
s/HALT\(\)/{{=0}}/mg;
- #borrowed from Parrot::Op
- s/{{=\*}}/ $trans->goto_pop(); /mge;
- 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;
+ # FIXME: This ought to throw errors when attempting to rewrite $n
+ # argument accesses and other things that make no sense in the
+ # preamble.
+ $_ = Parrot::Op->rewrite_body($_, $trans);
}
return $_;
Index: lib/Parrot/OpTrans/CPrederef.pm
===================================================================
RCS file: /home/perlcvs/parrot/lib/Parrot/OpTrans/CPrederef.pm,v
retrieving revision 1.5
diff -a -u -r1.5 CPrederef.pm
--- lib/Parrot/OpTrans/CPrederef.pm 15 Jan 2002 16:10:46 -0000 1.5
+++ lib/Parrot/OpTrans/CPrederef.pm 7 Feb 2002 20:10:54 -0000
@@ -24,6 +24,25 @@
return <<END;
#define REL_PC ((size_t)(cur_opcode - interpreter->prederef_code))
#define CUR_OPCODE (((opcode_t *)interpreter->code->byte_code) + REL_PC)
+
+static inline opcode_t* prederef_to_opcode(struct Parrot_Interp* interpreter,
+ void** prederef_addr)
+{
+ ssize_t offset_in_ops;
+ if (prederef_addr == NULL) return NULL;
+ offset_in_ops = prederef_addr - interpreter->prederef_code;
+ return (opcode_t*) interpreter->code->byte_code + offset_in_ops;
+}
+
+static inline void** opcode_to_prederef(struct Parrot_Interp* interpreter,
+ opcode_t* opcode_addr)
+{
+ ssize_t offset_in_ops;
+ if (opcode_addr == NULL) return NULL;
+ offset_in_ops = opcode_addr - (opcode_t*) interpreter->code->byte_code;
+ return interpreter->prederef_code + offset_in_ops;
+}
+
END
}
@@ -48,7 +67,13 @@
sub expr_pop
{
my ($self) = @_;
- return "(((opcode_t *)pop_dest(interpreter) - (opcode_t
*)interpreter->code->byte_code) + interpreter->prederef_code)";
+ return "opcode_to_prederef(interpreter, pop_dest(interpreter))";
+}
+
+sub expr_address
+{
+ my ($self, $addr) = @_;
+ return "opcode_to_prederef(interpreter, $addr)";
}
# expr_offset and goto_offset
@@ -67,6 +92,11 @@
sub goto_offset {
my ($self, $offset) = @_;
return "return cur_opcode + $offset";
+}
+
+sub goto_address {
+ my ($self, $addr) = @_;
+ return "return opcode_to_prederef(interpreter, $addr)";
}
#
