Author: leo
Date: Thu Feb 9 03:15:30 2006
New Revision: 11479
Modified:
trunk/compilers/imcc/instructions.c
trunk/src/inter_call.c
trunk/t/pmc/exception.t
Log:
Register allocation - fix [perl #38459]
* The register alligator din't assign a register to the message of a
get_results opcode used in exception handlers, *if* the message was
unused. This is fixed now.
* assert register index is non-negative in argument passsing
* create a test case for that
Modified: trunk/compilers/imcc/instructions.c
==============================================================================
--- trunk/compilers/imcc/instructions.c (original)
+++ trunk/compilers/imcc/instructions.c Thu Feb 9 03:15:30 2006
@@ -234,8 +234,19 @@ instruction_writes(Instruction* ins, Sym
* but for the register allocator, the effect matters, thus
* postpone the effect after the invoke
*/
- if (ins->opnum == PARROT_OP_get_results_pc)
+ if (ins->opnum == PARROT_OP_get_results_pc) {
+ /* but only, if it isn't the get_results opcode of
+ * an exception_handler, which doesn't have
+ * a call next
+ */
+ if (ins->next && (ins->next->type & ITPCCSUB))
+ return 0;
+ for (i = 0; i < ins->n_r; i++) {
+ if (ins->r[i] == r)
+ return 1;
+ }
return 0;
+ }
else if (ins->type & ITPCCSUB) {
ins = ins->prev;
/* can't used pcc_sub->ret due to bug #38406
Modified: trunk/src/inter_call.c
==============================================================================
--- trunk/src/inter_call.c (original)
+++ trunk/src/inter_call.c Thu Feb 9 03:15:30 2006
@@ -865,6 +865,7 @@ process_args(Interp *interpreter, struct
st->dest.sig & PARROT_ARG_SLURPY_ARRAY) {
/* create array */
idx = st->dest.u.op.pc[st->dest.i];
+ assert(idx >= 0);
create_slurpy_ar(interpreter, st, idx);
}
/* positional src -> named src */
@@ -919,6 +920,7 @@ process_args(Interp *interpreter, struct
case CALL_STATE_POS_NAMED:
Parrot_convert_arg(interpreter, st);
idx = st->dest.u.op.pc[st->dest.i];
+ assert(idx >= 0);
store_arg(st, idx);
break;
case CALL_STATE_NAMED_NAMED_OPT:
@@ -928,6 +930,7 @@ process_args(Interp *interpreter, struct
opt_flag = 1;
store_opt:
idx = st->dest.u.op.pc[st->dest.i];
+ assert(idx >= 0);
store_arg(st, idx);
/* :opt_flag is truely optional */
if (!next_arg(interpreter, &st->dest)) {
@@ -943,6 +946,7 @@ store_opt:
}
--st->params;
idx = st->dest.u.op.pc[st->dest.i];
+ assert(idx >= 0);
CTX_REG_INT(st->dest.ctx, idx) = opt_flag;
if (!(state & CALL_STATE_x_NAMED))
st->dest.mode |= CALL_STATE_NEXT_ARG;
@@ -1037,6 +1041,7 @@ Parrot_store_arg(Interp *interpreter, st
return 0;
assert(st->dest.mode & CALL_STATE_OP);
idx = st->dest.u.op.pc[st->dest.i];
+ assert(idx >= 0);
switch (st->dest.sig & PARROT_ARG_TYPE_MASK) {
case PARROT_ARG_INTVAL:
CTX_REG_INT(st->dest.ctx, idx) = UVal_int(st->val);
Modified: trunk/t/pmc/exception.t
==============================================================================
--- trunk/t/pmc/exception.t (original)
+++ trunk/t/pmc/exception.t Thu Feb 9 03:15:30 2006
@@ -6,7 +6,7 @@ use strict;
use warnings;
use lib qw( . lib ../lib ../../lib );
use Test::More;
-use Parrot::Test tests => 28;
+use Parrot::Test tests => 29;
=head1 NAME
@@ -76,6 +76,27 @@ Exception
just pining
OUTPUT
+output_is(<<'CODE', <<'OUTPUT', "get_results - be sure registers are ok");
+# see also #38459
+ print "main\n"
+ new P0, .Integer
+ push_eh handler
+ new P1, .Exception
+ set P1[0], "just pining"
+ throw P1
+ print "not reached\n"
+ end
+handler:
+ get_results "(0,0)", P1, S0
+ inc P0
+ print "ok\n"
+ end
+
+CODE
+main
+ok
+OUTPUT
+
pir_output_is(<<'CODE', <<'OUTPUT', ".get_results() - PIR");
.sub main :main
print "main\n"
