[project @ 2003-02-12 23:38:23 by wolfgang]

[ghc-hetmet.git] / ghc / rts / Interpreter.c

diff --git a/ghc/rts/Interpreter.c b/ghc/rts/Interpreter.c
index cbbbc29..0df0f99 100644 (file)
--- a/ghc/rts/Interpreter.c
+++ b/ghc/rts/Interpreter.c
@@ -672,12 +672,8 @@ run_BCO_return:
        Sp--; Sp[0] = (W_)&stg_enter_info;
        RETURN_TO_SCHEDULER(ThreadInterpret, HeapOverflow);
     }
-    
-    // "Standard" stack check
-    if (Sp - (INTERP_STACK_CHECK_THRESH+1) < SpLim) {
-       Sp--; Sp[0] = (W_)&stg_enter_info;
-       RETURN_TO_SCHEDULER(ThreadInterpret, StackOverflow);
-    }
+    // Stack checks aren't necessary at return points, the stack use
+    // is aggregated into the enclosing function entry point.
     goto run_BCO;
     
 run_BCO_return_unboxed:
@@ -685,11 +681,8 @@ run_BCO_return_unboxed:
     if (doYouWantToGC()) {
        RETURN_TO_SCHEDULER(ThreadInterpret, HeapOverflow);
     }
-    
-    // "Standard" stack check
-    if (Sp - (INTERP_STACK_CHECK_THRESH+1) < SpLim) {
-       RETURN_TO_SCHEDULER(ThreadInterpret, StackOverflow);
-    }
+    // Stack checks aren't necessary at return points, the stack use
+    // is aggregated into the enclosing function entry point.
     goto run_BCO;
     
 run_BCO_fun:
@@ -709,8 +702,8 @@ run_BCO_fun:
        RETURN_TO_SCHEDULER(ThreadInterpret, HeapOverflow);
     }
     
-    // "Standard" stack check
-    if (Sp - (INTERP_STACK_CHECK_THRESH+1) < SpLim) {
+    // Stack check
+    if (Sp - INTERP_STACK_CHECK_THRESH < SpLim) {
        Sp -= 2; 
        Sp[1] = (W_)obj; 
        Sp[0] = (W_)&stg_apply_interp_info; // placeholder, really
@@ -766,15 +759,19 @@ run_BCO:
 
        switch (BCO_NEXT) {
 
-       case bci_STKCHECK: 
-       {
-           // An explicit stack check; we hope these will be rare.
+       case bci_STKCHECK: {
+           // Explicit stack check at the beginning of a function
+           // *only* (stack checks in case alternatives are
+           // propagated to the enclosing function).
            int stk_words_reqd = BCO_NEXT + 1;
            if (Sp - stk_words_reqd < SpLim) {
-               Sp--; Sp[0] = (W_)obj;
+               Sp -= 2; 
+               Sp[1] = (W_)obj; 
+               Sp[0] = (W_)&stg_apply_interp_info;
                RETURN_TO_SCHEDULER(ThreadInterpret, StackOverflow);
+           } else {
+               goto nextInsn;
            }
-           goto nextInsn;
        }
 
        case bci_PUSH_L: {
@@ -1161,15 +1158,62 @@ run_BCO:
            int o_itbl                = BCO_NEXT;
            void(*marshall_fn)(void*) = (void (*)(void*))BCO_LIT(o_itbl);
 
-           // Shift the stack pointer down to the next relevant stack
-           // frame during the call.  See comment in ByteCodeGen.lhs.
-           Sp += stk_offset;
+#ifdef RTS_SUPPORTS_THREADS
+           // Threaded RTS:
+           // Arguments on the TSO stack are not good, because garbage
+           // collection might move the TSO as soon as we call
+           // suspendThread below.
+
+           W_ arguments[stk_offset];
+           
+           memcpy(arguments, Sp, sizeof(W_) * stk_offset);
+#endif
+               
+           // There are a bunch of non-ptr words on the stack (the
+           // ccall args, the ccall fun address and space for the
+           // result), which we need to cover with an info table
+           // since we might GC during this call.
+           //
+           // We know how many (non-ptr) words there are before the
+           // next valid stack frame: it is the stk_offset arg to the
+           // CCALL instruction.   So we build a RET_DYN stack frame
+           // on the stack frame to describe this chunk of stack.
+           //
+           Sp -= RET_DYN_SIZE + sizeofW(StgRetDyn);
+           ((StgRetDyn *)Sp)->liveness = ALL_NON_PTRS | N_NONPTRS(stk_offset);
+           ((StgRetDyn *)Sp)->info = (StgInfoTable *)&stg_gc_gen_info;
+
            SAVE_STACK_POINTERS;
            tok = suspendThread(&cap->r,rtsFalse);
-           marshall_fn ( (void*)(& Sp[-stk_offset] ) );
+
+#ifndef RTS_SUPPORTS_THREADS
+           // Careful:
+           // suspendThread might have shifted the stack
+           // around (stack squeezing), so we have to grab the real
+           // Sp out of the TSO to find the ccall args again.
+
+           marshall_fn ( (void*)(cap->r.rCurrentTSO->sp + RET_DYN_SIZE + sizeofW(StgRetDyn)) );
+#else
+           // Threaded RTS:
+           // We already made a malloced copy of the arguments above.
+
+           marshall_fn ( arguments );
+#endif
+
+           // And restart the thread again, popping the RET_DYN frame.
            cap = (Capability *)((void *)resumeThread(tok,rtsFalse) - sizeof(StgFunTable));
            LOAD_STACK_POINTERS;
-           Sp -= stk_offset;
+           Sp += RET_DYN_SIZE + sizeofW(StgRetDyn);
+
+           
+#ifdef RTS_SUPPORTS_THREADS
+           // Threaded RTS:
+           // Copy the "arguments", which might include a return value,
+           // back to the TSO stack. It would of course be enough to
+           // just copy the return value, but we don't know the offset.
+           memcpy(Sp, arguments, sizeof(W_) * stk_offset);
+#endif
+
            goto nextInsn;
        }