X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FRtsAPI.c;h=4ca1225bebf2f0d9729e08388edcffa96d59ddfc;hb=34bfc56e5f2c5374bcc4f67fbd0692f0c14fe029;hp=8d1cfd998607c7ce73274edc1be24296d35ac2e4;hpb=324e96d2ebfcb113cd97c43ef043d591ef87de71;p=ghc-hetmet.git diff --git a/ghc/rts/RtsAPI.c b/ghc/rts/RtsAPI.c index 8d1cfd9..4ca1225 100644 --- a/ghc/rts/RtsAPI.c +++ b/ghc/rts/RtsAPI.c @@ -1,5 +1,4 @@ /* ---------------------------------------------------------------------------- - * $Id: RtsAPI.c,v 1.49 2003/10/01 10:49:07 wolfgang Exp $ * * (c) The GHC Team, 1998-2001 * @@ -76,10 +75,10 @@ rts_mkInt32 (HsInt32 i) HaskellObj rts_mkInt64 (HsInt64 i) { - long long *tmp; + llong *tmp; StgClosure *p = (StgClosure *)allocate(CONSTR_sizeW(0,2)); SET_HDR(p, I64zh_con_info, CCS_SYSTEM); - tmp = (long long*)&(p->payload[0]); + tmp = (llong*)&(p->payload[0]); *tmp = (StgInt64)i; return p; } @@ -126,12 +125,12 @@ rts_mkWord32 (HsWord32 w) HaskellObj rts_mkWord64 (HsWord64 w) { - unsigned long long *tmp; + ullong *tmp; StgClosure *p = (StgClosure *)allocate(CONSTR_sizeW(0,2)); /* see mk_Int8 comment */ SET_HDR(p, W64zh_con_info, CCS_SYSTEM); - tmp = (unsigned long long*)&(p->payload[0]); + tmp = (ullong*)&(p->payload[0]); *tmp = (StgWord64)w; return p; } @@ -431,11 +430,12 @@ rts_evalStableIO (HsStablePtr s, /*out*/HsStablePtr *ret) StgTSO* tso; StgClosure *p, *r; SchedulerStatus stat; + Capability *cap = rtsApiCapability; + rtsApiCapability = NULL; p = (StgClosure *)deRefStablePtr(s); tso = createStrictIOThread(RtsFlags.GcFlags.initialStkSize, p); - stat = scheduleWaitThread(tso,&r,rtsApiCapability); - rtsApiCapability = NULL; + stat = scheduleWaitThread(tso,&r,cap); if (stat == Success && ret != NULL) { ASSERT(r != NULL); @@ -479,13 +479,13 @@ rts_checkSchedStatus ( char* site, SchedulerStatus rc ) case Success: return; case Killed: - prog_belch("%s: uncaught exception",site); + errorBelch("%s: uncaught exception",site); stg_exit(EXIT_FAILURE); case Interrupted: - prog_belch("%s: interrupted", site); + errorBelch("%s: interrupted", site); stg_exit(EXIT_FAILURE); default: - prog_belch("%s: Return code (%d) not ok",(site),(rc)); + errorBelch("%s: Return code (%d) not ok",(site),(rc)); stg_exit(EXIT_FAILURE); } } @@ -494,13 +494,13 @@ void rts_lock() { #ifdef RTS_SUPPORTS_THREADS - ACQUIRE_LOCK(&sched_mutex); + ACQUIRE_LOCK(&sched_mutex); - // we request to get the capability immediately, in order to - // a) stop other threads from using allocate() - // b) wake the current worker thread from awaitEvent() - // (so that a thread started by rts_eval* will start immediately) - grabReturnCapability(&sched_mutex,&rtsApiCapability); + // we request to get the capability immediately, in order to + // a) stop other threads from using allocate() + // b) wake the current worker thread from awaitEvent() + // (so that a thread started by rts_eval* will start immediately) + waitForReturnCapability(&sched_mutex,&rtsApiCapability); #endif } @@ -508,8 +508,9 @@ void rts_unlock() { #ifdef RTS_SUPPORTS_THREADS - if(rtsApiCapability) + if (rtsApiCapability) { releaseCapability(rtsApiCapability); + } rtsApiCapability = NULL; RELEASE_LOCK(&sched_mutex); #endif