X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FInterpreter.c;h=cc18059f22828c17f3d6b5d1062d9835e713a96d;hb=f802680892c2c555bb887ac3317890042be144c3;hp=63719ad37e1a860cf7b23b8167bba97eb5309759;hpb=a5687b3b04c2e404a5ed5bf56ba4e7a10f7d115a;p=ghc-hetmet.git

diff --git a/ghc/rts/Interpreter.c b/ghc/rts/Interpreter.c
index 63719ad..cc18059 100644
--- a/ghc/rts/Interpreter.c
+++ b/ghc/rts/Interpreter.c
@@ -26,6 +26,11 @@
 #include "Disassembler.h"
 #include "Interpreter.h"
 
+#include <string.h>     /* for memcpy */
+#ifdef HAVE_ERRNO_H
+#include <errno.h>
+#endif
+
 
 /* --------------------------------------------------------------------------
  * The bytecode interpreter
@@ -58,13 +63,13 @@
    return (retcode);
 
 
-static inline StgPtr
+STATIC_INLINE StgPtr
 allocate_UPD (int n_words)
 {
    return allocate(stg_max(sizeofW(StgHeader)+MIN_UPD_SIZE, n_words));
 }
 
-static inline StgPtr
+STATIC_INLINE StgPtr
 allocate_NONUPD (int n_words)
 {
     return allocate(stg_max(sizeofW(StgHeader)+MIN_NONUPD_SIZE, n_words));
@@ -1157,6 +1162,9 @@ run_BCO:
 	    int stk_offset            = BCO_NEXT;
 	    int o_itbl                = BCO_NEXT;
 	    void(*marshall_fn)(void*) = (void (*)(void*))BCO_LIT(o_itbl);
+	    int ret_dyn_size = 
+		RET_DYN_BITMAP_SIZE + RET_DYN_NONPTR_REGS_SIZE
+		+ sizeofW(StgRetDyn);
 
 #ifdef RTS_SUPPORTS_THREADS
 	    // Threaded RTS:
@@ -1168,7 +1176,10 @@ run_BCO:
 	    
 	    memcpy(arguments, Sp, sizeof(W_) * stk_offset);
 #endif
-		
+
+	    // Restore the Haskell thread's current value of errno
+	    errno = cap->r.rCurrentTSO->saved_errno;
+
 	    // 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
@@ -1179,7 +1190,7 @@ run_BCO:
 	    // 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);
+	    Sp -= ret_dyn_size;
 	    ((StgRetDyn *)Sp)->liveness = ALL_NON_PTRS | N_NONPTRS(stk_offset);
 	    ((StgRetDyn *)Sp)->info = (StgInfoTable *)&stg_gc_gen_info;
 
@@ -1192,20 +1203,22 @@ run_BCO:
 	    // 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)) );
+	    marshall_fn ( (void*)(cap->r.rCurrentTSO->sp + ret_dyn_size) );
 #else
 	    // Threaded RTS:
-	    // We already made a malloced copy of the arguments above.
+	    // We already made a 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));
+	    cap = (Capability *)((void *)((unsigned char*)resumeThread(tok,rtsFalse) - sizeof(StgFunTable)));
 	    LOAD_STACK_POINTERS;
-	    Sp += RET_DYN_SIZE + sizeofW(StgRetDyn);
-
+	    Sp += ret_dyn_size;
 	    
+	    // Save the Haskell thread's current value of errno
+	    cap->r.rCurrentTSO->saved_errno = errno;
+		
 #ifdef RTS_SUPPORTS_THREADS
 	    // Threaded RTS:
 	    // Copy the "arguments", which might include a return value,