[project @ 2004-08-13 13:04:50 by simonmar]

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

diff --git a/ghc/rts/Interpreter.c b/ghc/rts/Interpreter.c
index 96ba3b8..cd7ab13 100644 (file)
--- a/ghc/rts/Interpreter.c
+++ b/ghc/rts/Interpreter.c
@@ -4,12 +4,7 @@
  * Copyright (c) The GHC Team, 1994-2002.
  * ---------------------------------------------------------------------------*/
 
-#if !defined(SMP)
 #include "PosixSource.h"
-#else
-/* Hack and slash.. */
-#include "Stg.h"
-#endif
 #include "Rts.h"
 #include "RtsAPI.h"
 #include "RtsUtils.h"
@@ -20,12 +15,18 @@
 #include "Storage.h"
 #include "Updates.h"
 #include "Sanity.h"
+#include "Liveness.h"
 
 #include "Bytecodes.h"
 #include "Printer.h"
 #include "Disassembler.h"
 #include "Interpreter.h"
 
+#include <string.h>     /* for memcpy */
+#ifdef HAVE_ERRNO_H
+#include <errno.h>
+#endif
+
 
 /* --------------------------------------------------------------------------
  * The bytecode interpreter
@@ -58,13 +59,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));
@@ -160,7 +161,6 @@ static StgWord app_ptrs_itbl[] = {
     (W_)&stg_ap_pppp_info,
     (W_)&stg_ap_ppppp_info,
     (W_)&stg_ap_pppppp_info,
-    (W_)&stg_ap_ppppppp_info
 };
 
 StgThreadReturnCode
@@ -395,9 +395,6 @@ do_return:
        if (info == (StgInfoTable *)&stg_ap_pppppp_info) {
            n = 6; m = 6; goto do_apply;
        }
-       if (info == (StgInfoTable *)&stg_ap_ppppppp_info) {
-           n = 7; m = 7; goto do_apply;
-       }
        goto do_return_unrecognised;
     }
 
@@ -810,7 +807,7 @@ run_BCO:
 
        case bci_PUSH_ALTS: {
            int o_bco  = BCO_NEXT;
-           Sp[-2] = (W_)&stg_ctoi_ret_R1p_info;
+           Sp[-2] = (W_)&stg_ctoi_R1p_info;
            Sp[-1] = BCO_PTR(o_bco);
            Sp -= 2;
            goto nextInsn;
@@ -818,7 +815,7 @@ run_BCO:
 
        case bci_PUSH_ALTS_P: {
            int o_bco  = BCO_NEXT;
-           Sp[-2] = (W_)&stg_ctoi_ret_R1unpt_info;
+           Sp[-2] = (W_)&stg_ctoi_R1unpt_info;
            Sp[-1] = BCO_PTR(o_bco);
            Sp -= 2;
            goto nextInsn;
@@ -826,7 +823,7 @@ run_BCO:
 
        case bci_PUSH_ALTS_N: {
            int o_bco  = BCO_NEXT;
-           Sp[-2] = (W_)&stg_ctoi_ret_R1n_info;
+           Sp[-2] = (W_)&stg_ctoi_R1n_info;
            Sp[-1] = BCO_PTR(o_bco);
            Sp -= 2;
            goto nextInsn;
@@ -834,7 +831,7 @@ run_BCO:
 
        case bci_PUSH_ALTS_F: {
            int o_bco  = BCO_NEXT;
-           Sp[-2] = (W_)&stg_ctoi_ret_F1_info;
+           Sp[-2] = (W_)&stg_ctoi_F1_info;
            Sp[-1] = BCO_PTR(o_bco);
            Sp -= 2;
            goto nextInsn;
@@ -842,7 +839,7 @@ run_BCO:
 
        case bci_PUSH_ALTS_D: {
            int o_bco  = BCO_NEXT;
-           Sp[-2] = (W_)&stg_ctoi_ret_D1_info;
+           Sp[-2] = (W_)&stg_ctoi_D1_info;
            Sp[-1] = BCO_PTR(o_bco);
            Sp -= 2;
            goto nextInsn;
@@ -850,7 +847,7 @@ run_BCO:
 
        case bci_PUSH_ALTS_L: {
            int o_bco  = BCO_NEXT;
-           Sp[-2] = (W_)&stg_ctoi_ret_L1_info;
+           Sp[-2] = (W_)&stg_ctoi_L1_info;
            Sp[-1] = BCO_PTR(o_bco);
            Sp -= 2;
            goto nextInsn;
@@ -858,7 +855,7 @@ run_BCO:
 
        case bci_PUSH_ALTS_V: {
            int o_bco  = BCO_NEXT;
-           Sp[-2] = (W_)&stg_ctoi_ret_V_info;
+           Sp[-2] = (W_)&stg_ctoi_V_info;
            Sp[-1] = BCO_PTR(o_bco);
            Sp -= 2;
            goto nextInsn;
@@ -897,9 +894,6 @@ run_BCO:
        case bci_PUSH_APPLY_PPPPPP:
            Sp--; Sp[0] = (W_)&stg_ap_pppppp_info;
            goto nextInsn;
-       case bci_PUSH_APPLY_PPPPPPP:
-           Sp--; Sp[0] = (W_)&stg_ap_ppppppp_info;
-           goto nextInsn;
            
        case bci_PUSH_UBX: {
            int i;
@@ -1013,7 +1007,7 @@ run_BCO:
            int discr  = BCO_NEXT;
            int failto = BCO_NEXT;
            StgClosure* con = (StgClosure*)Sp[0];
-           if (constrTag(con) >= discr) {
+           if (GET_TAG(con) >= discr) {
                bciPtr = failto;
            }
            goto nextInsn;
@@ -1023,7 +1017,7 @@ run_BCO:
            int discr  = BCO_NEXT;
            int failto = BCO_NEXT;
            StgClosure* con = (StgClosure*)Sp[0];
-           if (constrTag(con) != discr) {
+           if (GET_TAG(con) != discr) {
                bciPtr = failto;
            }
            goto nextInsn;
@@ -1172,6 +1166,9 @@ 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
@@ -1183,11 +1180,11 @@ run_BCO:
            // on the stack frame to describe this chunk of stack.
            //
            Sp -= ret_dyn_size;
-           ((StgRetDyn *)Sp)->liveness = ALL_NON_PTRS | N_NONPTRS(stk_offset);
+           ((StgRetDyn *)Sp)->liveness = NO_PTRS | N_NONPTRS(stk_offset);
            ((StgRetDyn *)Sp)->info = (StgInfoTable *)&stg_gc_gen_info;
 
            SAVE_STACK_POINTERS;
-           tok = suspendThread(&cap->r,rtsFalse);
+           tok = suspendThread(&cap->r);
 
 #ifndef RTS_SUPPORTS_THREADS
            // Careful:
@@ -1198,16 +1195,19 @@ run_BCO:
            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) - sizeof(StgFunTable)));
            LOAD_STACK_POINTERS;
            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,