projects
/
ghc-hetmet.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
3dc2953
)
FIX #1925: the interpreter was not maintaining tag bits correctly
author
Simon Marlow
<simonmar@microsoft.com>
Tue, 27 Nov 2007 12:26:14 +0000
(12:26 +0000)
committer
Simon Marlow
<simonmar@microsoft.com>
Tue, 27 Nov 2007 12:26:14 +0000
(12:26 +0000)
See comment for details
rts/Interpreter.c
patch
|
blob
|
history
diff --git
a/rts/Interpreter.c
b/rts/Interpreter.c
index
6e70de8
..
0ca8ddf
100644
(file)
--- a/
rts/Interpreter.c
+++ b/
rts/Interpreter.c
@@
-189,7
+189,7
@@
interpretBCO (Capability* cap)
// that these entities are non-aliasable.
register StgPtr Sp; // local state -- stack pointer
register StgPtr SpLim; // local state -- stack lim pointer
// that these entities are non-aliasable.
register StgPtr Sp; // local state -- stack pointer
register StgPtr SpLim; // local state -- stack lim pointer
- register StgClosure* obj;
+ register StgClosure *tagged_obj = 0, *obj;
nat n, m;
LOAD_STACK_POINTERS;
nat n, m;
LOAD_STACK_POINTERS;
@@
-241,10
+241,10
@@
interpretBCO (Capability* cap)
// Evaluate the object on top of the stack.
eval:
// Evaluate the object on top of the stack.
eval:
- obj = (StgClosure*)Sp[0]; Sp++;
+ tagged_obj = (StgClosure*)Sp[0]; Sp++;
eval_obj:
eval_obj:
- obj = UNTAG_CLOSURE(obj);
+ obj = UNTAG_CLOSURE(tagged_obj);
INTERP_TICK(it_total_evals);
IF_DEBUG(interpreter,
INTERP_TICK(it_total_evals);
IF_DEBUG(interpreter,
@@
-268,7
+268,7
@@
eval_obj:
case IND_OLDGEN_PERM:
case IND_STATIC:
{
case IND_OLDGEN_PERM:
case IND_STATIC:
{
- obj = ((StgInd*)obj)->indirectee;
+ tagged_obj = ((StgInd*)obj)->indirectee;
goto eval_obj;
}
goto eval_obj;
}
@@
-308,7
+308,7
@@
eval_obj:
// Stack check
if (Sp - (words+sizeofW(StgUpdateFrame)) < SpLim) {
Sp -= 2;
// Stack check
if (Sp - (words+sizeofW(StgUpdateFrame)) < SpLim) {
Sp -= 2;
- Sp[1] = (W_)obj;
+ Sp[1] = (W_)tagged_obj;
Sp[0] = (W_)&stg_enter_info;
RETURN_TO_SCHEDULER(ThreadInterpret, StackOverflow);
}
Sp[0] = (W_)&stg_enter_info;
RETURN_TO_SCHEDULER(ThreadInterpret, StackOverflow);
}
@@
-351,16
+351,17
@@
eval_obj:
printObj(obj);
);
Sp -= 2;
printObj(obj);
);
Sp -= 2;
- Sp[1] = (W_)obj;
+ Sp[1] = (W_)tagged_obj;
Sp[0] = (W_)&stg_enter_info;
RETURN_TO_SCHEDULER_NO_PAUSE(ThreadRunGHC, ThreadYielding);
}
}
// ------------------------------------------------------------------------
Sp[0] = (W_)&stg_enter_info;
RETURN_TO_SCHEDULER_NO_PAUSE(ThreadRunGHC, ThreadYielding);
}
}
// ------------------------------------------------------------------------
- // We now have an evaluated object (obj). The next thing to
+ // We now have an evaluated object (tagged_obj). The next thing to
// do is return it to the stack frame on top of the stack.
do_return:
// do is return it to the stack frame on top of the stack.
do_return:
+ obj = UNTAG_CLOSURE(tagged_obj);
ASSERT(closure_HNF(obj));
IF_DEBUG(interpreter,
ASSERT(closure_HNF(obj));
IF_DEBUG(interpreter,
@@
-421,8
+422,16
@@
do_return:
case UPDATE_FRAME:
// Returning to an update frame: do the update, pop the update
// frame, and continue with the next stack frame.
case UPDATE_FRAME:
// Returning to an update frame: do the update, pop the update
// frame, and continue with the next stack frame.
+ //
+ // NB. we must update with the *tagged* pointer. Some tags
+ // are not optional, and if we omit the tag bits when updating
+ // then bad things can happen (albeit very rarely). See #1925.
+ // What happened was an indirection was created with an
+ // untagged pointer, and this untagged pointer was propagated
+ // to a PAP by the GC, violating the invariant that PAPs
+ // always contain a tagged pointer to the function.
INTERP_TICK(it_retto_UPDATE);
INTERP_TICK(it_retto_UPDATE);
- UPD_IND(((StgUpdateFrame *)Sp)->updatee, obj);
+ UPD_IND(((StgUpdateFrame *)Sp)->updatee, tagged_obj);
Sp += sizeofW(StgUpdateFrame);
goto do_return;
Sp += sizeofW(StgUpdateFrame);
goto do_return;
@@
-432,6
+441,8
@@
do_return:
INTERP_TICK(it_retto_BCO);
Sp--;
Sp[0] = (W_)obj;
INTERP_TICK(it_retto_BCO);
Sp--;
Sp[0] = (W_)obj;
+ // NB. return the untagged object; the bytecode expects it to
+ // be untagged. XXX this doesn't seem right.
obj = (StgClosure*)Sp[2];
ASSERT(get_itbl(obj)->type == BCO);
goto run_BCO_return;
obj = (StgClosure*)Sp[2];
ASSERT(get_itbl(obj)->type == BCO);
goto run_BCO_return;
@@
-446,7
+457,7
@@
do_return:
printStackChunk(Sp,cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size);
);
Sp -= 2;
printStackChunk(Sp,cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size);
);
Sp -= 2;
- Sp[1] = (W_)obj;
+ Sp[1] = (W_)tagged_obj;
Sp[0] = (W_)&stg_enter_info;
RETURN_TO_SCHEDULER_NO_PAUSE(ThreadRunGHC, ThreadYielding);
}
Sp[0] = (W_)&stg_enter_info;
RETURN_TO_SCHEDULER_NO_PAUSE(ThreadRunGHC, ThreadYielding);
}
@@
-519,6
+530,7
@@
do_return_unboxed:
// Application...
do_apply:
// Application...
do_apply:
+ ASSERT(obj == UNTAG_CLOSURE(tagged_obj));
// we have a function to apply (obj), and n arguments taking up m
// words on the stack. The info table (stg_ap_pp_info or whatever)
// is on top of the arguments on the stack.
// we have a function to apply (obj), and n arguments taking up m
// words on the stack. The info table (stg_ap_pp_info or whatever)
// is on top of the arguments on the stack.
@@
-582,7
+594,7
@@
do_apply:
for (i = 0; i < m; i++) {
new_pap->payload[pap->n_args + i] = (StgClosure *)Sp[i];
}
for (i = 0; i < m; i++) {
new_pap->payload[pap->n_args + i] = (StgClosure *)Sp[i];
}
- obj = (StgClosure *)new_pap;
+ tagged_obj = (StgClosure *)new_pap;
Sp += m;
goto do_return;
}
Sp += m;
goto do_return;
}
@@
-624,7
+636,7
@@
do_apply:
for (i = 0; i < m; i++) {
pap->payload[i] = (StgClosure *)Sp[i];
}
for (i = 0; i < m; i++) {
pap->payload[i] = (StgClosure *)Sp[i];
}
- obj = (StgClosure *)pap;
+ tagged_obj = (StgClosure *)pap;
Sp += m;
goto do_return;
}
Sp += m;
goto do_return;
}
@@
-634,7
+646,7
@@
do_apply:
default:
defer_apply_to_sched:
Sp -= 2;
default:
defer_apply_to_sched:
Sp -= 2;
- Sp[1] = (W_)obj;
+ Sp[1] = (W_)tagged_obj;
Sp[0] = (W_)&stg_enter_info;
RETURN_TO_SCHEDULER_NO_PAUSE(ThreadRunGHC, ThreadYielding);
}
Sp[0] = (W_)&stg_enter_info;
RETURN_TO_SCHEDULER_NO_PAUSE(ThreadRunGHC, ThreadYielding);
}
@@
-1264,7
+1276,7
@@
run_BCO:
goto eval;
case bci_RETURN:
goto eval;
case bci_RETURN:
- obj = (StgClosure *)Sp[0];
+ tagged_obj = (StgClosure *)Sp[0];
Sp++;
goto do_return;
Sp++;
goto do_return;