From: sewardj Date: Tue, 7 Aug 2001 09:02:02 +0000 (+0000) Subject: [project @ 2001-08-07 09:02:02 by sewardj] X-Git-Tag: Approximately_9120_patches~1351 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=2b8f3628a54ff86c9e70acf038afd60cbf3fb074;p=ghc-hetmet.git [project @ 2001-08-07 09:02:02 by sewardj] Do suspendThread/resumeThread round ccalls so that ccall_gc is supported. --- diff --git a/ghc/rts/Interpreter.c b/ghc/rts/Interpreter.c index c249c76..cb78cdd 100644 --- a/ghc/rts/Interpreter.c +++ b/ghc/rts/Interpreter.c @@ -5,8 +5,8 @@ * Copyright (c) 1994-2000. * * $RCSfile: Interpreter.c,v $ - * $Revision: 1.26 $ - * $Date: 2001/08/03 15:05:52 $ + * $Revision: 1.27 $ + * $Date: 2001/08/07 09:02:02 $ * ---------------------------------------------------------------------------*/ #include "Rts.h" @@ -54,13 +54,18 @@ #define BCO_LIT(n) (W_)literals[n] #define BCO_ITBL(n) itbls[n] -#define LOAD_STACK_POINTERS \ - iSp = cap->rCurrentTSO->sp; iSu = cap->rCurrentTSO->su; +#define LOAD_STACK_POINTERS \ + iSp = cap->rCurrentTSO->sp; \ + iSu = cap->rCurrentTSO->su; \ + /* We don't change this ... */ \ + iSpLim = cap->rCurrentTSO->stack + RESERVED_STACK_WORDS; + -#define SAVE_STACK_POINTERS \ - cap->rCurrentTSO->sp = iSp; cap->rCurrentTSO->su = iSu; +#define SAVE_STACK_POINTERS \ + cap->rCurrentTSO->sp = iSp; \ + cap->rCurrentTSO->su = iSu; -#define RETURN(retcode) \ +#define RETURN(retcode) \ SAVE_STACK_POINTERS; return retcode; @@ -169,9 +174,6 @@ StgThreadReturnCode interpretBCO ( Capability* cap ) LOAD_STACK_POINTERS; - /* We don't change this ... */ - iSpLim = cap->rCurrentTSO->stack + RESERVED_STACK_WORDS; - /* Main object-entering loop. Object to be entered is on top of stack. */ nextEnter: @@ -762,9 +764,14 @@ StgThreadReturnCode interpretBCO ( Capability* cap ) } } case bci_CCALL: { + StgInt tok; int o_itbl = BCO_NEXT; void(*marshall_fn)(void*) = (void (*)(void*))BCO_LIT(o_itbl); + SAVE_STACK_POINTERS; + tok = suspendThread(cap); marshall_fn ( (void*)(& StackWord(0) ) ); + cap = resumeThread(tok); + LOAD_STACK_POINTERS; goto nextInsn; } case bci_JMP: {