X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=rts%2FRtsAPI.c;h=8fcf8ce81207e6cc3b7752d2ae88c0ea4175ce33;hp=54d1e7567282544e54a67b29cb5b84e92505cf5e;hb=e5c3b478b3cd1707cf122833822f44b2ac09b8e9;hpb=3a886477def20cfaaacb87a784917b5c6a3238b0 diff --git a/rts/RtsAPI.c b/rts/RtsAPI.c index 54d1e75..8fcf8ce 100644 --- a/rts/RtsAPI.c +++ b/rts/RtsAPI.c @@ -28,7 +28,7 @@ HaskellObj rts_mkChar (Capability *cap, HsChar c) { - StgClosure *p = (StgClosure *)allocateLocal(cap, CONSTR_sizeW(0,1)); + StgClosure *p = (StgClosure *)allocate(cap, CONSTR_sizeW(0,1)); SET_HDR(p, Czh_con_info, CCS_SYSTEM); p->payload[0] = (StgClosure *)(StgWord)(StgChar)c; return p; @@ -37,7 +37,7 @@ rts_mkChar (Capability *cap, HsChar c) HaskellObj rts_mkInt (Capability *cap, HsInt i) { - StgClosure *p = (StgClosure *)allocateLocal(cap,CONSTR_sizeW(0,1)); + StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1)); SET_HDR(p, Izh_con_info, CCS_SYSTEM); p->payload[0] = (StgClosure *)(StgInt)i; return p; @@ -46,7 +46,7 @@ rts_mkInt (Capability *cap, HsInt i) HaskellObj rts_mkInt8 (Capability *cap, HsInt8 i) { - StgClosure *p = (StgClosure *)allocateLocal(cap,CONSTR_sizeW(0,1)); + StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1)); SET_HDR(p, I8zh_con_info, CCS_SYSTEM); /* Make sure we mask out the bits above the lowest 8 */ p->payload[0] = (StgClosure *)(StgInt)i; @@ -56,7 +56,7 @@ rts_mkInt8 (Capability *cap, HsInt8 i) HaskellObj rts_mkInt16 (Capability *cap, HsInt16 i) { - StgClosure *p = (StgClosure *)allocateLocal(cap,CONSTR_sizeW(0,1)); + StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1)); SET_HDR(p, I16zh_con_info, CCS_SYSTEM); /* Make sure we mask out the relevant bits */ p->payload[0] = (StgClosure *)(StgInt)i; @@ -66,7 +66,7 @@ rts_mkInt16 (Capability *cap, HsInt16 i) HaskellObj rts_mkInt32 (Capability *cap, HsInt32 i) { - StgClosure *p = (StgClosure *)allocateLocal(cap,CONSTR_sizeW(0,1)); + StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1)); SET_HDR(p, I32zh_con_info, CCS_SYSTEM); p->payload[0] = (StgClosure *)(StgInt)i; return p; @@ -75,7 +75,7 @@ rts_mkInt32 (Capability *cap, HsInt32 i) HaskellObj rts_mkInt64 (Capability *cap, HsInt64 i) { - StgClosure *p = (StgClosure *)allocateLocal(cap,CONSTR_sizeW(0,2)); + StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,2)); SET_HDR(p, I64zh_con_info, CCS_SYSTEM); ASSIGN_Int64((P_)&(p->payload[0]), i); return p; @@ -84,7 +84,7 @@ rts_mkInt64 (Capability *cap, HsInt64 i) HaskellObj rts_mkWord (Capability *cap, HsWord i) { - StgClosure *p = (StgClosure *)allocateLocal(cap,CONSTR_sizeW(0,1)); + StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1)); SET_HDR(p, Wzh_con_info, CCS_SYSTEM); p->payload[0] = (StgClosure *)(StgWord)i; return p; @@ -94,7 +94,7 @@ HaskellObj rts_mkWord8 (Capability *cap, HsWord8 w) { /* see rts_mkInt* comments */ - StgClosure *p = (StgClosure *)allocateLocal(cap,CONSTR_sizeW(0,1)); + StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1)); SET_HDR(p, W8zh_con_info, CCS_SYSTEM); p->payload[0] = (StgClosure *)(StgWord)(w & 0xff); return p; @@ -104,7 +104,7 @@ HaskellObj rts_mkWord16 (Capability *cap, HsWord16 w) { /* see rts_mkInt* comments */ - StgClosure *p = (StgClosure *)allocateLocal(cap,CONSTR_sizeW(0,1)); + StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1)); SET_HDR(p, W16zh_con_info, CCS_SYSTEM); p->payload[0] = (StgClosure *)(StgWord)(w & 0xffff); return p; @@ -114,7 +114,7 @@ HaskellObj rts_mkWord32 (Capability *cap, HsWord32 w) { /* see rts_mkInt* comments */ - StgClosure *p = (StgClosure *)allocateLocal(cap,CONSTR_sizeW(0,1)); + StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1)); SET_HDR(p, W32zh_con_info, CCS_SYSTEM); p->payload[0] = (StgClosure *)(StgWord)(w & 0xffffffff); return p; @@ -123,7 +123,7 @@ rts_mkWord32 (Capability *cap, HsWord32 w) HaskellObj rts_mkWord64 (Capability *cap, HsWord64 w) { - StgClosure *p = (StgClosure *)allocateLocal(cap,CONSTR_sizeW(0,2)); + StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,2)); /* see mk_Int8 comment */ SET_HDR(p, W64zh_con_info, CCS_SYSTEM); ASSIGN_Word64((P_)&(p->payload[0]), w); @@ -134,7 +134,7 @@ rts_mkWord64 (Capability *cap, HsWord64 w) HaskellObj rts_mkFloat (Capability *cap, HsFloat f) { - StgClosure *p = (StgClosure *)allocateLocal(cap,CONSTR_sizeW(0,1)); + StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1)); SET_HDR(p, Fzh_con_info, CCS_SYSTEM); ASSIGN_FLT((P_)p->payload, (StgFloat)f); return p; @@ -143,7 +143,7 @@ rts_mkFloat (Capability *cap, HsFloat f) HaskellObj rts_mkDouble (Capability *cap, HsDouble d) { - StgClosure *p = (StgClosure *)allocateLocal(cap,CONSTR_sizeW(0,sizeofW(StgDouble))); + StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,sizeofW(StgDouble))); SET_HDR(p, Dzh_con_info, CCS_SYSTEM); ASSIGN_DBL((P_)p->payload, (StgDouble)d); return p; @@ -152,7 +152,7 @@ rts_mkDouble (Capability *cap, HsDouble d) HaskellObj rts_mkStablePtr (Capability *cap, HsStablePtr s) { - StgClosure *p = (StgClosure *)allocateLocal(cap,sizeofW(StgHeader)+1); + StgClosure *p = (StgClosure *)allocate(cap,sizeofW(StgHeader)+1); SET_HDR(p, StablePtr_con_info, CCS_SYSTEM); p->payload[0] = (StgClosure *)s; return p; @@ -161,7 +161,7 @@ rts_mkStablePtr (Capability *cap, HsStablePtr s) HaskellObj rts_mkPtr (Capability *cap, HsPtr a) { - StgClosure *p = (StgClosure *)allocateLocal(cap,sizeofW(StgHeader)+1); + StgClosure *p = (StgClosure *)allocate(cap,sizeofW(StgHeader)+1); SET_HDR(p, Ptr_con_info, CCS_SYSTEM); p->payload[0] = (StgClosure *)a; return p; @@ -170,7 +170,7 @@ rts_mkPtr (Capability *cap, HsPtr a) HaskellObj rts_mkFunPtr (Capability *cap, HsFunPtr a) { - StgClosure *p = (StgClosure *)allocateLocal(cap,sizeofW(StgHeader)+1); + StgClosure *p = (StgClosure *)allocate(cap,sizeofW(StgHeader)+1); SET_HDR(p, FunPtr_con_info, CCS_SYSTEM); p->payload[0] = (StgClosure *)a; return p; @@ -197,7 +197,7 @@ rts_apply (Capability *cap, HaskellObj f, HaskellObj arg) { StgThunk *ap; - ap = (StgThunk *)allocateLocal(cap,sizeofW(StgThunk) + 2); + ap = (StgThunk *)allocate(cap,sizeofW(StgThunk) + 2); SET_HDR(ap, (StgInfoTable *)&stg_ap_2_upd_info, CCS_SYSTEM); ap->payload[0] = f; ap->payload[1] = arg; @@ -375,8 +375,8 @@ rts_getBool (HaskellObj p) -------------------------------------------------------------------------- */ INLINE_HEADER void pushClosure (StgTSO *tso, StgWord c) { - tso->sp--; - tso->sp[0] = (W_) c; + tso->stackobj->sp--; + tso->stackobj->sp[0] = (W_) c; } StgTSO * @@ -394,7 +394,6 @@ createIOThread (Capability *cap, nat stack_size, StgClosure *closure) { StgTSO *t; t = createThread (cap, stack_size); - pushClosure(t, (W_)&stg_noforceIO_info); pushClosure(t, (W_)&stg_ap_v_info); pushClosure(t, (W_)closure); pushClosure(t, (W_)&stg_enter_info); @@ -510,7 +509,7 @@ rts_evalLazyIO_ (Capability *cap, HaskellObj p, unsigned int stack_size, void rts_checkSchedStatus (char* site, Capability *cap) { - SchedulerStatus rc = cap->running_task->stat; + SchedulerStatus rc = cap->running_task->incall->stat; switch (rc) { case Success: return; @@ -529,7 +528,7 @@ rts_checkSchedStatus (char* site, Capability *cap) SchedulerStatus rts_getSchedStatus (Capability *cap) { - return cap->running_task->stat; + return cap->running_task->incall->stat; } Capability * @@ -538,16 +537,16 @@ rts_lock (void) Capability *cap; Task *task; - if (running_finalizers) { + task = newBoundTask(); + + if (task->running_finalizers) { errorBelch("error: a C finalizer called back into Haskell.\n" " This was previously allowed, but is disallowed in GHC 6.10.2 and later.\n" - " To create finalizers that may call back into Haskll, use\n" + " To create finalizers that may call back into Haskell, use\n" " Foreign.Concurrent.newForeignPtr instead of Foreign.newForeignPtr."); stg_exit(EXIT_FAILURE); } - task = newBoundTask(); - cap = NULL; waitForReturnCapability(&cap, task); return (Capability *)cap;