projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
[project @ 2005-12-19 13:08:19 by simonpj]
[ghc-hetmet.git]
/
ghc
/
rts
/
Interpreter.c
diff --git
a/ghc/rts/Interpreter.c
b/ghc/rts/Interpreter.c
index
4599552
..
b31ade0
100644
(file)
--- a/
ghc/rts/Interpreter.c
+++ b/
ghc/rts/Interpreter.c
@@
-57,13
+57,15
@@
#define RETURN_TO_SCHEDULER(todo,retcode) \
SAVE_STACK_POINTERS; \
cap->r.rCurrentTSO->what_next = (todo); \
#define RETURN_TO_SCHEDULER(todo,retcode) \
SAVE_STACK_POINTERS; \
cap->r.rCurrentTSO->what_next = (todo); \
- threadPaused(cap->r.rCurrentTSO); \
- return (retcode);
+ threadPaused(cap,cap->r.rCurrentTSO); \
+ cap->r.rRet = (retcode); \
+ return cap;
#define RETURN_TO_SCHEDULER_NO_PAUSE(todo,retcode) \
#define RETURN_TO_SCHEDULER_NO_PAUSE(todo,retcode) \
- SAVE_STACK_POINTERS; \
- cap->r.rCurrentTSO->what_next = (todo); \
- return (retcode);
+ SAVE_STACK_POINTERS; \
+ cap->r.rCurrentTSO->what_next = (todo); \
+ cap->r.rRet = (retcode); \
+ return cap;
STATIC_INLINE StgPtr
STATIC_INLINE StgPtr
@@
-170,7
+172,7
@@
static StgWord app_ptrs_itbl[] = {
(W_)&stg_ap_pppppp_info,
};
(W_)&stg_ap_pppppp_info,
};
-StgThreadReturnCode
+Capability *
interpretBCO (Capability* cap)
{
// Use of register here is primarily to make it clear to compilers
interpretBCO (Capability* cap)
{
// Use of register here is primarily to make it clear to compilers
@@
-514,7
+516,7
@@
do_apply:
case PAP: {
StgPAP *pap;
case PAP: {
StgPAP *pap;
- nat arity, i;
+ nat i, arity;
pap = (StgPAP *)obj;
pap = (StgPAP *)obj;
@@
-534,7
+536,8
@@
do_apply:
// Shuffle the args for this function down, and put
// the appropriate info table in the gap.
for (i = 0; i < arity; i++) {
// Shuffle the args for this function down, and put
// the appropriate info table in the gap.
for (i = 0; i < arity; i++) {
- Sp[i-1] = Sp[i];
+ Sp[(int)i-1] = Sp[i];
+ // ^^^^^ careful, i-1 might be negative, but i in unsigned
}
Sp[arity-1] = app_ptrs_itbl[n-arity-1];
Sp--;
}
Sp[arity-1] = app_ptrs_itbl[n-arity-1];
Sp--;
@@
-577,8
+580,7
@@
do_apply:
}
case BCO: {
}
case BCO: {
- nat arity;
- int i; // arithmetic involving i might go negative below
+ nat arity, i;
Sp++;
arity = ((StgBCO *)obj)->arity;
Sp++;
arity = ((StgBCO *)obj)->arity;
@@
-591,7
+593,8
@@
do_apply:
// Shuffle the args for this function down, and put
// the appropriate info table in the gap.
for (i = 0; i < arity; i++) {
// Shuffle the args for this function down, and put
// the appropriate info table in the gap.
for (i = 0; i < arity; i++) {
- Sp[i-1] = Sp[i];
+ Sp[(int)i-1] = Sp[i];
+ // ^^^^^ careful, i-1 might be negative, but i in unsigned
}
Sp[arity-1] = app_ptrs_itbl[n-arity-1];
Sp--;
}
Sp[arity-1] = app_ptrs_itbl[n-arity-1];
Sp--;
@@
-1155,7
+1158,7
@@
run_BCO:
}
case bci_CCALL: {
}
case bci_CCALL: {
- StgInt tok;
+ void *tok;
int stk_offset = BCO_NEXT;
int o_itbl = BCO_NEXT;
void(*marshall_fn)(void*) = (void (*)(void*))BCO_LIT(o_itbl);
int stk_offset = BCO_NEXT;
int o_itbl = BCO_NEXT;
void(*marshall_fn)(void*) = (void (*)(void*))BCO_LIT(o_itbl);
@@
-1163,7
+1166,7
@@
run_BCO:
RET_DYN_BITMAP_SIZE + RET_DYN_NONPTR_REGS_SIZE
+ sizeofW(StgRetDyn);
RET_DYN_BITMAP_SIZE + RET_DYN_NONPTR_REGS_SIZE
+ sizeofW(StgRetDyn);
-#ifdef RTS_SUPPORTS_THREADS
+#ifdef THREADED_RTS
// Threaded RTS:
// Arguments on the TSO stack are not good, because garbage
// collection might move the TSO as soon as we call
// Threaded RTS:
// Arguments on the TSO stack are not good, because garbage
// collection might move the TSO as soon as we call
@@
-1194,7
+1197,7
@@
run_BCO:
SAVE_STACK_POINTERS;
tok = suspendThread(&cap->r);
SAVE_STACK_POINTERS;
tok = suspendThread(&cap->r);
-#ifndef RTS_SUPPORTS_THREADS
+#ifndef THREADED_RTS
// Careful:
// suspendThread might have shifted the stack
// around (stack squeezing), so we have to grab the real
// Careful:
// suspendThread might have shifted the stack
// around (stack squeezing), so we have to grab the real
@@
-1216,7
+1219,7
@@
run_BCO:
// Save the Haskell thread's current value of errno
cap->r.rCurrentTSO->saved_errno = errno;
// Save the Haskell thread's current value of errno
cap->r.rCurrentTSO->saved_errno = errno;
-#ifdef RTS_SUPPORTS_THREADS
+#ifdef THREADED_RTS
// Threaded RTS:
// Copy the "arguments", which might include a return value,
// back to the TSO stack. It would of course be enough to
// Threaded RTS:
// Copy the "arguments", which might include a return value,
// back to the TSO stack. It would of course be enough to