projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Monadify typecheck/TcEnv: use do, return, applicative, standard monad functions
[ghc-hetmet.git]
/
rts
/
PrimOps.cmm
diff --git
a/rts/PrimOps.cmm
b/rts/PrimOps.cmm
index
4cce586
..
06628b9
100644
(file)
--- a/
rts/PrimOps.cmm
+++ b/
rts/PrimOps.cmm
@@
-28,6
+28,7
@@
#include "Cmm.h"
#ifdef __PIC__
#include "Cmm.h"
#ifdef __PIC__
+#ifndef mingw32_HOST_OS
import __gmpz_init;
import __gmpz_add;
import __gmpz_sub;
import __gmpz_init;
import __gmpz_add;
import __gmpz_sub;
@@
-44,10
+45,13
@@
import __gmpz_and;
import __gmpz_xor;
import __gmpz_ior;
import __gmpz_com;
import __gmpz_xor;
import __gmpz_ior;
import __gmpz_com;
+#endif
import base_GHCziIOBase_NestedAtomically_closure;
import pthread_mutex_lock;
import pthread_mutex_unlock;
#endif
import base_GHCziIOBase_NestedAtomically_closure;
import pthread_mutex_lock;
import pthread_mutex_unlock;
#endif
+import EnterCriticalSection;
+import LeaveCriticalSection;
/*-----------------------------------------------------------------------------
Array Primitives
/*-----------------------------------------------------------------------------
Array Primitives
@@
-229,7
+233,7
@@
atomicModifyMutVarzh_fast
HP_CHK_GEN_TICKY(SIZE, R1_PTR & R2_PTR, atomicModifyMutVarzh_fast);
#if defined(THREADED_RTS)
HP_CHK_GEN_TICKY(SIZE, R1_PTR & R2_PTR, atomicModifyMutVarzh_fast);
#if defined(THREADED_RTS)
- foreign "C" ACQUIRE_LOCK(atomic_modify_mutvar_mutex "ptr") [R1,R2];
+ ACQUIRE_LOCK(atomic_modify_mutvar_mutex "ptr") [R1,R2];
#endif
x = StgMutVar_var(R1);
#endif
x = StgMutVar_var(R1);
@@
-260,7
+264,7
@@
atomicModifyMutVarzh_fast
StgThunk_payload(r,0) = z;
#if defined(THREADED_RTS)
StgThunk_payload(r,0) = z;
#if defined(THREADED_RTS)
- foreign "C" RELEASE_LOCK(atomic_modify_mutvar_mutex "ptr") [];
+ RELEASE_LOCK(atomic_modify_mutvar_mutex "ptr") [];
#endif
RET_P(r);
#endif
RET_P(r);
@@
-918,6
+922,12
@@
forkzh_fast
("ptr" threadid) = foreign "C" createIOThread( MyCapability() "ptr",
RtsFlags_GcFlags_initialStkSize(RtsFlags),
closure "ptr") [];
("ptr" threadid) = foreign "C" createIOThread( MyCapability() "ptr",
RtsFlags_GcFlags_initialStkSize(RtsFlags),
closure "ptr") [];
+
+ /* start blocked if the current thread is blocked */
+ StgTSO_flags(threadid) =
+ StgTSO_flags(threadid) | (StgTSO_flags(CurrentTSO) &
+ (TSO_BLOCKEX::I32 | TSO_INTERRUPTIBLE::I32));
+
foreign "C" scheduleThread(MyCapability() "ptr", threadid "ptr") [];
// switch at the earliest opportunity
foreign "C" scheduleThread(MyCapability() "ptr", threadid "ptr") [];
// switch at the earliest opportunity
@@
-941,6
+951,12
@@
forkOnzh_fast
("ptr" threadid) = foreign "C" createIOThread( MyCapability() "ptr",
RtsFlags_GcFlags_initialStkSize(RtsFlags),
closure "ptr") [];
("ptr" threadid) = foreign "C" createIOThread( MyCapability() "ptr",
RtsFlags_GcFlags_initialStkSize(RtsFlags),
closure "ptr") [];
+
+ /* start blocked if the current thread is blocked */
+ StgTSO_flags(threadid) =
+ StgTSO_flags(threadid) | (StgTSO_flags(CurrentTSO) &
+ (TSO_BLOCKEX::I32 | TSO_INTERRUPTIBLE::I32));
+
foreign "C" scheduleThreadOn(MyCapability() "ptr", cpu, threadid "ptr") [];
// switch at the earliest opportunity
foreign "C" scheduleThreadOn(MyCapability() "ptr", cpu, threadid "ptr") [];
// switch at the earliest opportunity
@@
-1443,7
+1459,7
@@
isEmptyMVarzh_fast
{
/* args: R1 = MVar closure */
{
/* args: R1 = MVar closure */
- if (GET_INFO(R1) == stg_EMPTY_MVAR_info) {
+ if (StgMVar_value(R1) == stg_END_TSO_QUEUE_closure) {
RET_N(1);
} else {
RET_N(0);
RET_N(1);
} else {
RET_N(0);
@@
-1458,7
+1474,8
@@
newMVarzh_fast
ALLOC_PRIM ( SIZEOF_StgMVar, NO_PTRS, newMVarzh_fast );
mvar = Hp - SIZEOF_StgMVar + WDS(1);
ALLOC_PRIM ( SIZEOF_StgMVar, NO_PTRS, newMVarzh_fast );
mvar = Hp - SIZEOF_StgMVar + WDS(1);
- SET_HDR(mvar,stg_EMPTY_MVAR_info,W_[CCCS]);
+ SET_HDR(mvar,stg_MVAR_DIRTY_info,W_[CCCS]);
+ // MVARs start dirty: generation 0 has no mutable list
StgMVar_head(mvar) = stg_END_TSO_QUEUE_closure;
StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure;
StgMVar_value(mvar) = stg_END_TSO_QUEUE_closure;
StgMVar_head(mvar) = stg_END_TSO_QUEUE_closure;
StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure;
StgMVar_value(mvar) = stg_END_TSO_QUEUE_closure;
@@
-1493,11
+1510,15
@@
takeMVarzh_fast
#else
info = GET_INFO(mvar);
#endif
#else
info = GET_INFO(mvar);
#endif
+
+ if (info == stg_MVAR_CLEAN_info) {
+ foreign "C" dirty_MVAR(BaseReg "ptr", mvar "ptr");
+ }
/* If the MVar is empty, put ourselves on its blocking queue,
* and wait until we're woken up.
*/
/* If the MVar is empty, put ourselves on its blocking queue,
* and wait until we're woken up.
*/
- if (info == stg_EMPTY_MVAR_info) {
+ if (StgMVar_value(mvar) == stg_END_TSO_QUEUE_closure) {
if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
StgMVar_head(mvar) = CurrentTSO;
} else {
if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
StgMVar_head(mvar) = CurrentTSO;
} else {
@@
-1541,7
+1562,9
@@
takeMVarzh_fast
}
#if defined(THREADED_RTS)
}
#if defined(THREADED_RTS)
- unlockClosure(mvar, stg_FULL_MVAR_info);
+ unlockClosure(mvar, stg_MVAR_DIRTY_info);
+#else
+ SET_INFO(mvar,stg_MVAR_DIRTY_info);
#endif
RET_P(val);
}
#endif
RET_P(val);
}
@@
-1551,9
+1574,9
@@
takeMVarzh_fast
StgMVar_value(mvar) = stg_END_TSO_QUEUE_closure;
#if defined(THREADED_RTS)
StgMVar_value(mvar) = stg_END_TSO_QUEUE_closure;
#if defined(THREADED_RTS)
- unlockClosure(mvar, stg_EMPTY_MVAR_info);
+ unlockClosure(mvar, stg_MVAR_DIRTY_info);
#else
#else
- SET_INFO(mvar,stg_EMPTY_MVAR_info);
+ SET_INFO(mvar,stg_MVAR_DIRTY_info);
#endif
RET_P(val);
#endif
RET_P(val);
@@
-1575,9
+1598,9
@@
tryTakeMVarzh_fast
info = GET_INFO(mvar);
#endif
info = GET_INFO(mvar);
#endif
- if (info == stg_EMPTY_MVAR_info) {
+ if (StgMVar_value(mvar) == stg_END_TSO_QUEUE_closure) {
#if defined(THREADED_RTS)
#if defined(THREADED_RTS)
- unlockClosure(mvar, stg_EMPTY_MVAR_info);
+ unlockClosure(mvar, info);
#endif
/* HACK: we need a pointer to pass back,
* so we abuse NO_FINALIZER_closure
#endif
/* HACK: we need a pointer to pass back,
* so we abuse NO_FINALIZER_closure
@@
-1585,6
+1608,10
@@
tryTakeMVarzh_fast
RET_NP(0, stg_NO_FINALIZER_closure);
}
RET_NP(0, stg_NO_FINALIZER_closure);
}
+ if (info == stg_MVAR_CLEAN_info) {
+ foreign "C" dirty_MVAR(BaseReg "ptr", mvar "ptr");
+ }
+
/* we got the value... */
val = StgMVar_value(mvar);
/* we got the value... */
val = StgMVar_value(mvar);
@@
-1614,7
+1641,9
@@
tryTakeMVarzh_fast
StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure;
}
#if defined(THREADED_RTS)
StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure;
}
#if defined(THREADED_RTS)
- unlockClosure(mvar, stg_FULL_MVAR_info);
+ unlockClosure(mvar, stg_MVAR_DIRTY_info);
+#else
+ SET_INFO(mvar,stg_MVAR_DIRTY_info);
#endif
}
else
#endif
}
else
@@
-1622,9
+1651,9
@@
tryTakeMVarzh_fast
/* No further putMVars, MVar is now empty */
StgMVar_value(mvar) = stg_END_TSO_QUEUE_closure;
#if defined(THREADED_RTS)
/* No further putMVars, MVar is now empty */
StgMVar_value(mvar) = stg_END_TSO_QUEUE_closure;
#if defined(THREADED_RTS)
- unlockClosure(mvar, stg_EMPTY_MVAR_info);
+ unlockClosure(mvar, stg_MVAR_DIRTY_info);
#else
#else
- SET_INFO(mvar,stg_EMPTY_MVAR_info);
+ SET_INFO(mvar,stg_MVAR_DIRTY_info);
#endif
}
#endif
}
@@
-1645,7
+1674,11
@@
putMVarzh_fast
info = GET_INFO(mvar);
#endif
info = GET_INFO(mvar);
#endif
- if (info == stg_FULL_MVAR_info) {
+ if (info == stg_MVAR_CLEAN_info) {
+ foreign "C" dirty_MVAR(BaseReg "ptr", mvar "ptr");
+ }
+
+ if (StgMVar_value(mvar) != stg_END_TSO_QUEUE_closure) {
if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
StgMVar_head(mvar) = CurrentTSO;
} else {
if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
StgMVar_head(mvar) = CurrentTSO;
} else {
@@
-1684,7
+1717,9
@@
putMVarzh_fast
}
#if defined(THREADED_RTS)
}
#if defined(THREADED_RTS)
- unlockClosure(mvar, stg_EMPTY_MVAR_info);
+ unlockClosure(mvar, stg_MVAR_DIRTY_info);
+#else
+ SET_INFO(mvar,stg_MVAR_DIRTY_info);
#endif
jump %ENTRY_CODE(Sp(0));
}
#endif
jump %ENTRY_CODE(Sp(0));
}
@@
-1694,9
+1729,9
@@
putMVarzh_fast
StgMVar_value(mvar) = R2;
#if defined(THREADED_RTS)
StgMVar_value(mvar) = R2;
#if defined(THREADED_RTS)
- unlockClosure(mvar, stg_FULL_MVAR_info);
+ unlockClosure(mvar, stg_MVAR_DIRTY_info);
#else
#else
- SET_INFO(mvar,stg_FULL_MVAR_info);
+ SET_INFO(mvar,stg_MVAR_DIRTY_info);
#endif
jump %ENTRY_CODE(Sp(0));
}
#endif
jump %ENTRY_CODE(Sp(0));
}
@@
-1718,13
+1753,17
@@
tryPutMVarzh_fast
info = GET_INFO(mvar);
#endif
info = GET_INFO(mvar);
#endif
- if (info == stg_FULL_MVAR_info) {
+ if (StgMVar_value(mvar) != stg_END_TSO_QUEUE_closure) {
#if defined(THREADED_RTS)
#if defined(THREADED_RTS)
- unlockClosure(mvar, stg_FULL_MVAR_info);
+ unlockClosure(mvar, info);
#endif
RET_N(0);
}
#endif
RET_N(0);
}
+ if (info == stg_MVAR_CLEAN_info) {
+ foreign "C" dirty_MVAR(BaseReg "ptr", mvar "ptr");
+ }
+
if (StgMVar_head(mvar) != stg_END_TSO_QUEUE_closure) {
/* There are takeMVar(s) waiting: wake up the first one
if (StgMVar_head(mvar) != stg_END_TSO_QUEUE_closure) {
/* There are takeMVar(s) waiting: wake up the first one
@@
-1750,7
+1789,9
@@
tryPutMVarzh_fast
}
#if defined(THREADED_RTS)
}
#if defined(THREADED_RTS)
- unlockClosure(mvar, stg_EMPTY_MVAR_info);
+ unlockClosure(mvar, stg_MVAR_DIRTY_info);
+#else
+ SET_INFO(mvar,stg_MVAR_DIRTY_info);
#endif
}
else
#endif
}
else
@@
-1759,9
+1800,9
@@
tryPutMVarzh_fast
StgMVar_value(mvar) = R2;
#if defined(THREADED_RTS)
StgMVar_value(mvar) = R2;
#if defined(THREADED_RTS)
- unlockClosure(mvar, stg_FULL_MVAR_info);
+ unlockClosure(mvar, stg_MVAR_DIRTY_info);
#else
#else
- SET_INFO(mvar,stg_FULL_MVAR_info);
+ SET_INFO(mvar,stg_MVAR_DIRTY_info);
#endif
}
#endif
}
@@
-1969,7
+2010,7
@@
waitReadzh_fast
{
/* args: R1 */
#ifdef THREADED_RTS
{
/* args: R1 */
#ifdef THREADED_RTS
- foreign "C" barf("waitRead# on threaded RTS");
+ foreign "C" barf("waitRead# on threaded RTS") never returns;
#else
ASSERT(StgTSO_why_blocked(CurrentTSO) == NotBlocked::I16);
#else
ASSERT(StgTSO_why_blocked(CurrentTSO) == NotBlocked::I16);
@@
-1986,7
+2027,7
@@
waitWritezh_fast
{
/* args: R1 */
#ifdef THREADED_RTS
{
/* args: R1 */
#ifdef THREADED_RTS
- foreign "C" barf("waitWrite# on threaded RTS");
+ foreign "C" barf("waitWrite# on threaded RTS") never returns;
#else
ASSERT(StgTSO_why_blocked(CurrentTSO) == NotBlocked::I16);
#else
ASSERT(StgTSO_why_blocked(CurrentTSO) == NotBlocked::I16);
@@
-2011,7
+2052,7
@@
delayzh_fast
#endif
#ifdef THREADED_RTS
#endif
#ifdef THREADED_RTS
- foreign "C" barf("delay# on threaded RTS");
+ foreign "C" barf("delay# on threaded RTS") never returns;
#else
/* args: R1 (microsecond delay amount) */
#else
/* args: R1 (microsecond delay amount) */
@@
-2077,7
+2118,7
@@
asyncReadzh_fast
CInt reqID;
#ifdef THREADED_RTS
CInt reqID;
#ifdef THREADED_RTS
- foreign "C" barf("asyncRead# on threaded RTS");
+ foreign "C" barf("asyncRead# on threaded RTS") never returns;
#else
/* args: R1 = fd, R2 = isSock, R3 = len, R4 = buf */
#else
/* args: R1 = fd, R2 = isSock, R3 = len, R4 = buf */
@@
-2105,7
+2146,7
@@
asyncWritezh_fast
CInt reqID;
#ifdef THREADED_RTS
CInt reqID;
#ifdef THREADED_RTS
- foreign "C" barf("asyncWrite# on threaded RTS");
+ foreign "C" barf("asyncWrite# on threaded RTS") never returns;
#else
/* args: R1 = fd, R2 = isSock, R3 = len, R4 = buf */
#else
/* args: R1 = fd, R2 = isSock, R3 = len, R4 = buf */
@@
-2133,7
+2174,7
@@
asyncDoProczh_fast
CInt reqID;
#ifdef THREADED_RTS
CInt reqID;
#ifdef THREADED_RTS
- foreign "C" barf("asyncDoProc# on threaded RTS");
+ foreign "C" barf("asyncDoProc# on threaded RTS") never returns;
#else
/* args: R1 = proc, R2 = param */
#else
/* args: R1 = proc, R2 = param */