On Wed, Feb 13, 2002 at 10:43:38PM -0500, Jason Gloudon wrote:
> The type changes in struct Packfile break the pointer math used in a few places
> to calculate the address of the end of the loaded byte code. This causes
> segfaults in build_asm in jit.c when using -j. It also breaks the bounds
> checking on opcode address in runops_slow_core.
>
> The patch adds the necessary cast to correct the code_end calculations.
Personally, I think it makes much more sense to have everything
outside of the packfile think in terms of opcode_t*, not char*. The
following untested but straightforward patch eliminates all typecasts
from the relevant chunks of code. And adds them back in to pdump.c, at
the points where it really is meant to be converting a char* array to
an opcode_t* array.
Oh, oops. Except it collided with my previously submitted but
unapplied patch to fix the parsing of complex control-flow macros like
goto ADDRESS(( branch ? expr OFFSET($2) : expr NEXT() )). I did that
one to fix something with the jit, I seem to recall. Well, they're
rolled together here, let me know if you want me to split them apart.
The casting patch is all the files in this patch except Op.pm, and
contains only the macro redefinitions in C.pm and CPrederef.pm.
Index: pdump.c
===================================================================
RCS file: /home/perlcvs/parrot/pdump.c,v
retrieving revision 1.8
diff -a -u -r1.8 pdump.c
--- pdump.c 1 Jan 2002 19:49:11 -0000 1.8
+++ pdump.c 14 Feb 2002 19:09:22 -0000
@@ -16,7 +16,7 @@
main(int argc, char **argv) {
struct stat file_stat;
int fd;
- char * packed;
+ opcode_t * packed;
size_t packed_size;
struct PackFile * pf;
struct Parrot_Interp *interpreter = make_interpreter(0);
@@ -43,7 +43,7 @@
packed_size = file_stat.st_size;
#ifndef HAS_HEADER_SYSMMAN
- packed = mem_sys_allocate(packed_size);
+ packed = (opcode_t *) mem_sys_allocate(packed_size);
if (!packed) {
printf("Can't allocate, code %i\n", errno);
@@ -52,7 +52,7 @@
read(fd, (void*)packed, packed_size);
#else
- packed = mmap(0, packed_size, PROT_READ, MAP_SHARED, fd, (off_t)0);
+ packed = (opcode_t *) mmap(0, packed_size, PROT_READ, MAP_SHARED, fd, (off_t)0);
if (!packed) {
printf("Can't mmap, code %i\n", errno);
Index: interpreter.c
===================================================================
RCS file: /home/perlcvs/parrot/interpreter.c,v
retrieving revision 1.69
diff -a -u -r1.69 interpreter.c
--- interpreter.c 14 Feb 2002 05:53:58 -0000 1.69
+++ interpreter.c 14 Feb 2002 19:09:24 -0000
@@ -61,14 +61,14 @@
runops_generic (opcode_t * (*core)(struct Parrot_Interp *, opcode_t *),
struct Parrot_Interp *interpreter, opcode_t * pc) {
opcode_t * code_start;
- UINTVAL code_size;
+ UINTVAL code_size; /* in opcodes */
opcode_t * code_end;
check_fingerprint(interpreter);
- code_start = (opcode_t *)interpreter->code->byte_code;
- code_size = interpreter->code->byte_code_size;
- code_end = (opcode_t *)((char *)interpreter->code->byte_code + code_size);
+ code_start = interpreter->code->byte_code;
+ code_size = interpreter->code->byte_code_size / sizeof(opcode_t);
+ code_end = interpreter->code->byte_code + code_size;
pc = core(interpreter, pc);
@@ -286,15 +286,15 @@
runops_jit (struct Parrot_Interp *interpreter, opcode_t * pc) {
#ifdef HAS_JIT
opcode_t * code_start;
- UINTVAL code_size;
+ UINTVAL code_size; /* in opcodes */
opcode_t * code_end;
jit_f jit_code;
check_fingerprint(interpreter);
- code_start = (opcode_t *)interpreter->code->byte_code;
- code_size = interpreter->code->byte_code_size;
- code_end = (opcode_t *)((char *)interpreter->code->byte_code + code_size);
+ code_start = interpreter->code->byte_code;
+ code_size = interpreter->code->byte_code_size / sizeof(opcode_t);
+ code_end = interpreter->code->byte_code + code_size;
jit_code = build_asm(interpreter, pc, code_start, code_end);
#ifdef ALPHA
@@ -337,15 +337,15 @@
runops_prederef (struct Parrot_Interp *interpreter, opcode_t * pc,
void ** pc_prederef) {
opcode_t * code_start;
- UINTVAL code_size;
+ UINTVAL code_size; /* in opcodes */
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 *)((char *)interpreter->code->byte_code + code_size);
+ code_start = interpreter->code->byte_code;
+ code_size = interpreter->code->byte_code_size / sizeof(opcode_t);
+ code_end = interpreter->code->byte_code + code_size;
code_start_prederef = pc_prederef;
Index: runops_cores.c
===================================================================
RCS file: /home/perlcvs/parrot/runops_cores.c,v
retrieving revision 1.12
diff -a -u -r1.12 runops_cores.c
--- runops_cores.c 14 Feb 2002 05:53:58 -0000 1.12
+++ runops_cores.c 14 Feb 2002 19:09:24 -0000
@@ -42,14 +42,14 @@
opcode_t *
runops_slow_core (struct Parrot_Interp *interpreter, opcode_t * pc) {
opcode_t * code_start;
- INTVAL code_size;
+ INTVAL code_size; /* in opcodes */
opcode_t * code_end;
opcode_t * lastpc = NULL;
FLOATVAL starttime = 0;
- code_start = (opcode_t *)interpreter->code->byte_code;
- code_size = interpreter->code->byte_code_size;
- code_end = (opcode_t *)((char *)interpreter->code->byte_code + code_size);
+ code_start = interpreter->code->byte_code;
+ code_size = interpreter->code->byte_code_size / sizeof(opcode_t);
+ code_end = interpreter->code->byte_code + code_size;
if (interpreter->flags & PARROT_TRACE_FLAG) {
trace_op(interpreter, code_start, code_end, pc);
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 14 Feb 2002 19:09:24 -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 14 Feb 2002 19:09:25 -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/C.pm
===================================================================
RCS file: /home/perlcvs/parrot/lib/Parrot/OpTrans/C.pm,v
retrieving revision 1.4
diff -a -u -r1.4 C.pm
--- lib/Parrot/OpTrans/C.pm 28 Jan 2002 06:03:20 -0000 1.4
+++ lib/Parrot/OpTrans/C.pm 14 Feb 2002 19:09:25 -0000
@@ -21,7 +21,7 @@
sub defines
{
return <<END;
-#define REL_PC ((size_t)(cur_opcode - (opcode_t *)interpreter->code->byte_code))
+#define REL_PC ((size_t)(cur_opcode - interpreter->code->byte_code))
#define CUR_OPCODE cur_opcode
END
}
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 14 Feb 2002 19:09:26 -0000
@@ -23,7 +23,26 @@
{
return <<END;
#define REL_PC ((size_t)(cur_opcode - interpreter->prederef_code))
-#define CUR_OPCODE (((opcode_t *)interpreter->code->byte_code) + REL_PC)
+#define CUR_OPCODE (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 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 - interpreter->code->byte_code;
+ return interpreter->prederef_code + offset_in_ops;
+}
+
END
}
@@ -48,7 +67,18 @@
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))";
+}
+
+# expr_address
+#
+# Same logic as expr_pop
+#
+
+sub expr_address
+{
+ my ($self, $addr) = @_;
+ return "opcode_to_prederef(interpreter, $addr)";
}
# expr_offset and goto_offset
