X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FInterpreter.c;h=cd7ab131edcc918e05a9e2ca4aeedde27c2b8297;hb=423d477bfecd490de1449c59325c8776f91d7aac;hp=96ba3b890832b8aa8b75336439751187b84e55b6;hpb=1da232fccdd01edac72180682540c4d5b5ba71ea;p=ghc-hetmet.git diff --git a/ghc/rts/Interpreter.c b/ghc/rts/Interpreter.c index 96ba3b8..cd7ab13 100644 --- 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 /* for memcpy */ +#ifdef HAVE_ERRNO_H +#include +#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,