* round up to the nearest word for the size of the array.
*/
-newByteArrayzh_fast
+stg_newByteArrayzh
{
W_ words, payload_words, n, p;
- MAYBE_GC(NO_PTRS,newByteArrayzh_fast);
+ MAYBE_GC(NO_PTRS,stg_newByteArrayzh);
n = R1;
payload_words = ROUNDUP_BYTES_TO_WDS(n);
words = BYTES_TO_WDS(SIZEOF_StgArrWords) + payload_words;
- ("ptr" p) = foreign "C" allocateLocal(MyCapability() "ptr",words) [];
+ ("ptr" p) = foreign "C" allocate(MyCapability() "ptr",words) [];
TICK_ALLOC_PRIM(SIZEOF_StgArrWords,WDS(payload_words),0);
SET_HDR(p, stg_ARR_WORDS_info, W_[CCCS]);
StgArrWords_words(p) = payload_words;
#define BA_ALIGN 16
#define BA_MASK (BA_ALIGN-1)
-newPinnedByteArrayzh_fast
+stg_newPinnedByteArrayzh
{
W_ words, bytes, payload_words, p;
- MAYBE_GC(NO_PTRS,newPinnedByteArrayzh_fast);
+ MAYBE_GC(NO_PTRS,stg_newPinnedByteArrayzh);
bytes = R1;
/* payload_words is what we will tell the profiler we had to allocate */
payload_words = ROUNDUP_BYTES_TO_WDS(bytes);
/* Now we convert to a number of words: */
words = ROUNDUP_BYTES_TO_WDS(bytes);
- ("ptr" p) = foreign "C" allocatePinned(words) [];
+ ("ptr" p) = foreign "C" allocatePinned(MyCapability() "ptr", words) [];
TICK_ALLOC_PRIM(SIZEOF_StgArrWords,WDS(payload_words),0);
/* Now we need to move p forward so that the payload is aligned
RET_P(p);
}
-newAlignedPinnedByteArrayzh_fast
+stg_newAlignedPinnedByteArrayzh
{
W_ words, bytes, payload_words, p, alignment;
- MAYBE_GC(NO_PTRS,newAlignedPinnedByteArrayzh_fast);
+ MAYBE_GC(NO_PTRS,stg_newAlignedPinnedByteArrayzh);
bytes = R1;
alignment = R2;
/* Now we convert to a number of words: */
words = ROUNDUP_BYTES_TO_WDS(bytes);
- ("ptr" p) = foreign "C" allocatePinned(words) [];
+ ("ptr" p) = foreign "C" allocatePinned(MyCapability() "ptr", words) [];
TICK_ALLOC_PRIM(SIZEOF_StgArrWords,WDS(payload_words),0);
/* Now we need to move p forward so that the payload is aligned
RET_P(p);
}
-newArrayzh_fast
+stg_newArrayzh
{
W_ words, n, init, arr, p;
/* Args: R1 = words, R2 = initialisation value */
n = R1;
- MAYBE_GC(R2_PTR,newArrayzh_fast);
+ MAYBE_GC(R2_PTR,stg_newArrayzh);
words = BYTES_TO_WDS(SIZEOF_StgMutArrPtrs) + n;
- ("ptr" arr) = foreign "C" allocateLocal(MyCapability() "ptr",words) [R2];
+ ("ptr" arr) = foreign "C" allocate(MyCapability() "ptr",words) [R2];
TICK_ALLOC_PRIM(SIZEOF_StgMutArrPtrs, WDS(n), 0);
SET_HDR(arr, stg_MUT_ARR_PTRS_DIRTY_info, W_[CCCS]);
RET_P(arr);
}
-unsafeThawArrayzh_fast
+stg_unsafeThawArrayzh
{
// SUBTLETY TO DO WITH THE OLD GEN MUTABLE LIST
//
MutVar primitives
-------------------------------------------------------------------------- */
-newMutVarzh_fast
+stg_newMutVarzh
{
W_ mv;
/* Args: R1 = initialisation value */
- ALLOC_PRIM( SIZEOF_StgMutVar, R1_PTR, newMutVarzh_fast);
+ ALLOC_PRIM( SIZEOF_StgMutVar, R1_PTR, stg_newMutVarzh);
mv = Hp - SIZEOF_StgMutVar + WDS(1);
SET_HDR(mv,stg_MUT_VAR_DIRTY_info,W_[CCCS]);
RET_P(mv);
}
-atomicModifyMutVarzh_fast
+stg_atomicModifyMutVarzh
{
W_ mv, f, z, x, y, r, h;
/* Args: R1 :: MutVar#, R2 :: a -> (a,b) */
#define SIZE (THUNK_2_SIZE + THUNK_1_SIZE + THUNK_1_SIZE)
- HP_CHK_GEN_TICKY(SIZE, R1_PTR & R2_PTR, atomicModifyMutVarzh_fast);
+ HP_CHK_GEN_TICKY(SIZE, R1_PTR & R2_PTR, stg_atomicModifyMutVarzh);
mv = R1;
f = R2;
STRING(stg_weak_msg,"New weak pointer at %p\n")
-mkWeakzh_fast
+stg_mkWeakzh
{
/* R1 = key
R2 = value
R3 = stg_NO_FINALIZER_closure;
}
- ALLOC_PRIM( SIZEOF_StgWeak, R1_PTR & R2_PTR & R3_PTR, mkWeakzh_fast );
+ ALLOC_PRIM( SIZEOF_StgWeak, R1_PTR & R2_PTR & R3_PTR, stg_mkWeakzh );
w = Hp - SIZEOF_StgWeak + WDS(1);
SET_HDR(w, stg_WEAK_info, W_[CCCS]);
RET_P(w);
}
-mkWeakForeignEnvzh_fast
+stg_mkWeakForeignEnvzh
{
/* R1 = key
R2 = value
flag = R5;
eptr = R6;
- ALLOC_PRIM( SIZEOF_StgWeak, R1_PTR & R2_PTR, mkWeakForeignEnvzh_fast );
+ ALLOC_PRIM( SIZEOF_StgWeak, R1_PTR & R2_PTR, stg_mkWeakForeignEnvzh );
w = Hp - SIZEOF_StgWeak + WDS(1);
SET_HDR(w, stg_WEAK_info, W_[CCCS]);
payload_words = 4;
words = BYTES_TO_WDS(SIZEOF_StgArrWords) + payload_words;
- ("ptr" p) = foreign "C" allocateLocal(MyCapability() "ptr", words) [];
+ ("ptr" p) = foreign "C" allocate(MyCapability() "ptr", words) [];
TICK_ALLOC_PRIM(SIZEOF_StgArrWords,WDS(payload_words),0);
SET_HDR(p, stg_ARR_WORDS_info, W_[CCCS]);
RET_P(w);
}
-finalizzeWeakzh_fast
+stg_finalizzeWeakzh
{
/* R1 = weak ptr
*/
}
}
-deRefWeakzh_fast
+stg_deRefWeakzh
{
/* R1 = weak ptr */
W_ w, code, val;
Floating point operations.
-------------------------------------------------------------------------- */
-decodeFloatzuIntzh_fast
+stg_decodeFloatzuIntzh
{
W_ p;
F_ arg;
W_ mp_tmp1;
W_ mp_tmp_w;
- STK_CHK_GEN( WDS(2), NO_PTRS, decodeFloatzuIntzh_fast );
+ STK_CHK_GEN( WDS(2), NO_PTRS, stg_decodeFloatzuIntzh );
mp_tmp1 = Sp - WDS(1);
mp_tmp_w = Sp - WDS(2);
RET_NN(W_[mp_tmp1], W_[mp_tmp_w]);
}
-decodeDoublezu2Intzh_fast
+stg_decodeDoublezu2Intzh
{
D_ arg;
W_ p;
W_ mp_result1;
W_ mp_result2;
- STK_CHK_GEN( WDS(4), NO_PTRS, decodeDoublezu2Intzh_fast );
+ STK_CHK_GEN( WDS(4), NO_PTRS, stg_decodeDoublezu2Intzh );
mp_tmp1 = Sp - WDS(1);
mp_tmp2 = Sp - WDS(2);
* Concurrency primitives
* -------------------------------------------------------------------------- */
-forkzh_fast
+stg_forkzh
{
/* args: R1 = closure to spark */
- MAYBE_GC(R1_PTR, forkzh_fast);
+ MAYBE_GC(R1_PTR, stg_forkzh);
W_ closure;
W_ threadid;
RET_P(threadid);
}
-forkOnzh_fast
+stg_forkOnzh
{
/* args: R1 = cpu, R2 = closure to spark */
- MAYBE_GC(R2_PTR, forkOnzh_fast);
+ MAYBE_GC(R2_PTR, stg_forkOnzh);
W_ cpu;
W_ closure;
RET_P(threadid);
}
-yieldzh_fast
+stg_yieldzh
{
jump stg_yield_noregs;
}
-myThreadIdzh_fast
+stg_myThreadIdzh
{
/* no args. */
RET_P(CurrentTSO);
}
-labelThreadzh_fast
+stg_labelThreadzh
{
/* args:
R1 = ThreadId#
jump %ENTRY_CODE(Sp(0));
}
-isCurrentThreadBoundzh_fast
+stg_isCurrentThreadBoundzh
{
/* no args */
W_ r;
RET_N(r);
}
-threadStatuszh_fast
+stg_threadStatuszh
{
/* args: R1 :: ThreadId# */
W_ tso;
frame = Sp;
trec = StgTSO_trec(CurrentTSO);
- ("ptr" outer) = foreign "C" stmGetEnclosingTRec(trec "ptr") [];
+ outer = StgTRecHeader_enclosing_trec(trec);
(r) = foreign "C" stmCommitNestedTransaction(MyCapability() "ptr", trec "ptr") [];
if (r != 0) {
/* Succeeded (either first branch or second branch) */
frame = Sp;
trec = StgTSO_trec(CurrentTSO);
result = R1;
- ("ptr" outer) = foreign "C" stmGetEnclosingTRec(trec "ptr") [];
+ outer = StgTRecHeader_enclosing_trec(trec);
if (outer == NO_TREC) {
/* First time back at the atomically frame -- pick up invariants */
W_ r, frame, trec, outer;
frame = Sp;
trec = StgTSO_trec(CurrentTSO);
- ("ptr" outer) = foreign "C" stmGetEnclosingTRec(trec "ptr") [];
+ outer = StgTRecHeader_enclosing_trec(trec);
(r) = foreign "C" stmCommitNestedTransaction(MyCapability() "ptr", trec "ptr") [];
if (r != 0) {
/* Commit succeeded */
// Primop definition ------------------------------------------------------------
-atomicallyzh_fast
+stg_atomicallyzh
{
W_ frame;
W_ old_trec;
W_ new_trec;
// stmStartTransaction may allocate
- MAYBE_GC (R1_PTR, atomicallyzh_fast);
+ MAYBE_GC (R1_PTR, stg_atomicallyzh);
/* Args: R1 = m :: STM a */
- STK_CHK_GEN(SIZEOF_StgAtomicallyFrame + WDS(1), R1_PTR, atomicallyzh_fast);
+ STK_CHK_GEN(SIZEOF_StgAtomicallyFrame + WDS(1), R1_PTR, stg_atomicallyzh);
old_trec = StgTSO_trec(CurrentTSO);
/* Nested transactions are not allowed; raise an exception */
if (old_trec != NO_TREC) {
R1 = base_ControlziExceptionziBase_nestedAtomically_closure;
- jump raisezh_fast;
+ jump stg_raisezh;
}
/* Set up the atomically frame */
}
-catchSTMzh_fast
+stg_catchSTMzh
{
W_ frame;
/* Args: R1 :: STM a */
/* Args: R2 :: Exception -> STM a */
- STK_CHK_GEN(SIZEOF_StgCatchSTMFrame + WDS(1), R1_PTR & R2_PTR, catchSTMzh_fast);
+ STK_CHK_GEN(SIZEOF_StgCatchSTMFrame + WDS(1), R1_PTR & R2_PTR, stg_catchSTMzh);
/* Set up the catch frame */
Sp = Sp - SIZEOF_StgCatchSTMFrame;
}
-catchRetryzh_fast
+stg_catchRetryzh
{
W_ frame;
W_ new_trec;
W_ trec;
// stmStartTransaction may allocate
- MAYBE_GC (R1_PTR & R2_PTR, catchRetryzh_fast);
+ MAYBE_GC (R1_PTR & R2_PTR, stg_catchRetryzh);
/* Args: R1 :: STM a */
/* Args: R2 :: STM a */
- STK_CHK_GEN(SIZEOF_StgCatchRetryFrame + WDS(1), R1_PTR & R2_PTR, catchRetryzh_fast);
+ STK_CHK_GEN(SIZEOF_StgCatchRetryFrame + WDS(1), R1_PTR & R2_PTR, stg_catchRetryzh);
/* Start a nested transaction within which to run the first code */
trec = StgTSO_trec(CurrentTSO);
}
-retryzh_fast
+stg_retryzh
{
W_ frame_type;
W_ frame;
W_ outer;
W_ r;
- MAYBE_GC (NO_PTRS, retryzh_fast); // STM operations may allocate
+ MAYBE_GC (NO_PTRS, stg_retryzh); // STM operations may allocate
// Find the enclosing ATOMICALLY_FRAME or CATCH_RETRY_FRAME
retry_pop_stack:
Sp = StgTSO_sp(CurrentTSO);
frame = Sp;
trec = StgTSO_trec(CurrentTSO);
- ("ptr" outer) = foreign "C" stmGetEnclosingTRec(trec "ptr") [];
+ outer = StgTRecHeader_enclosing_trec(trec);
if (frame_type == CATCH_RETRY_FRAME) {
// The retry reaches a CATCH_RETRY_FRAME before the atomic frame
foreign "C" stmFreeAbortedTRec(MyCapability() "ptr", trec "ptr") [];
trec = outer;
StgTSO_trec(CurrentTSO) = trec;
- ("ptr" outer) = foreign "C" stmGetEnclosingTRec(trec "ptr") [];
+ outer = StgTRecHeader_enclosing_trec(trec);
}
ASSERT(outer == NO_TREC);
}
-checkzh_fast
+stg_checkzh
{
W_ trec, closure;
/* Args: R1 = invariant closure */
- MAYBE_GC (R1_PTR, checkzh_fast);
+ MAYBE_GC (R1_PTR, stg_checkzh);
trec = StgTSO_trec(CurrentTSO);
closure = R1;
}
-newTVarzh_fast
+stg_newTVarzh
{
W_ tv;
W_ new_value;
/* Args: R1 = initialisation value */
- MAYBE_GC (R1_PTR, newTVarzh_fast);
+ MAYBE_GC (R1_PTR, stg_newTVarzh);
new_value = R1;
("ptr" tv) = foreign "C" stmNewTVar(MyCapability() "ptr", new_value "ptr") [];
RET_P(tv);
}
-readTVarzh_fast
+stg_readTVarzh
{
W_ trec;
W_ tvar;
/* Args: R1 = TVar closure */
- MAYBE_GC (R1_PTR, readTVarzh_fast); // Call to stmReadTVar may allocate
+ MAYBE_GC (R1_PTR, stg_readTVarzh); // Call to stmReadTVar may allocate
trec = StgTSO_trec(CurrentTSO);
tvar = R1;
("ptr" result) = foreign "C" stmReadTVar(MyCapability() "ptr", trec "ptr", tvar "ptr") [];
RET_P(result);
}
-readTVarIOzh_fast
+stg_readTVarIOzh
{
W_ result;
RET_P(result);
}
-writeTVarzh_fast
+stg_writeTVarzh
{
W_ trec;
W_ tvar;
/* Args: R1 = TVar closure */
/* R2 = New value */
- MAYBE_GC (R1_PTR & R2_PTR, writeTVarzh_fast); // Call to stmWriteTVar may allocate
+ MAYBE_GC (R1_PTR & R2_PTR, stg_writeTVarzh); // Call to stmWriteTVar may allocate
trec = StgTSO_trec(CurrentTSO);
tvar = R1;
new_value = R2;
*
* -------------------------------------------------------------------------- */
-isEmptyMVarzh_fast
+stg_isEmptyMVarzh
{
/* args: R1 = MVar closure */
}
}
-newMVarzh_fast
+stg_newMVarzh
{
/* args: none */
W_ mvar;
- ALLOC_PRIM ( SIZEOF_StgMVar, NO_PTRS, newMVarzh_fast );
+ ALLOC_PRIM ( SIZEOF_StgMVar, NO_PTRS, stg_newMVarzh );
mvar = Hp - SIZEOF_StgMVar + WDS(1);
SET_HDR(mvar,stg_MVAR_DIRTY_info,W_[CCCS]);
StgTSO_sp(tso) = StgTSO_sp(tso) + WDS(3); \
lval = W_[StgTSO_sp(tso) - WDS(1)];
-takeMVarzh_fast
+stg_takeMVarzh
{
W_ mvar, val, info, tso;
tso = StgMVar_head(mvar);
PerformPut(tso,StgMVar_value(mvar));
- if (TO_W_(StgTSO_flags(tso)) & TSO_DIRTY == 0) {
+ if (TO_W_(StgTSO_dirty(tso)) == 0) {
foreign "C" dirty_TSO(MyCapability() "ptr", tso "ptr") [];
}
}
-tryTakeMVarzh_fast
+stg_tryTakeMVarzh
{
W_ mvar, val, info, tso;
/* actually perform the putMVar for the thread that we just woke up */
tso = StgMVar_head(mvar);
PerformPut(tso,StgMVar_value(mvar));
- if (TO_W_(StgTSO_flags(tso)) & TSO_DIRTY == 0) {
+ if (TO_W_(StgTSO_dirty(tso)) == 0) {
foreign "C" dirty_TSO(MyCapability() "ptr", tso "ptr") [];
}
}
-putMVarzh_fast
+stg_putMVarzh
{
W_ mvar, val, info, tso;
/* actually perform the takeMVar */
tso = StgMVar_head(mvar);
PerformTake(tso, val);
- if (TO_W_(StgTSO_flags(tso)) & TSO_DIRTY == 0) {
+ if (TO_W_(StgTSO_dirty(tso)) == 0) {
foreign "C" dirty_TSO(MyCapability() "ptr", tso "ptr") [];
}
}
-tryPutMVarzh_fast
+stg_tryPutMVarzh
{
W_ mvar, info, tso;
/* actually perform the takeMVar */
tso = StgMVar_head(mvar);
PerformTake(tso, R2);
- if (TO_W_(StgTSO_flags(tso)) & TSO_DIRTY == 0) {
+ if (TO_W_(StgTSO_dirty(tso)) == 0) {
foreign "C" dirty_TSO(MyCapability() "ptr", tso "ptr") [];
}
Stable pointer primitives
------------------------------------------------------------------------- */
-makeStableNamezh_fast
+stg_makeStableNamezh
{
W_ index, sn_obj;
- ALLOC_PRIM( SIZEOF_StgStableName, R1_PTR, makeStableNamezh_fast );
+ ALLOC_PRIM( SIZEOF_StgStableName, R1_PTR, stg_makeStableNamezh );
(index) = foreign "C" lookupStableName(R1 "ptr") [];
}
-makeStablePtrzh_fast
+stg_makeStablePtrzh
{
/* Args: R1 = a */
W_ sp;
- MAYBE_GC(R1_PTR, makeStablePtrzh_fast);
+ MAYBE_GC(R1_PTR, stg_makeStablePtrzh);
("ptr" sp) = foreign "C" getStablePtr(R1 "ptr") [];
RET_N(sp);
}
-deRefStablePtrzh_fast
+stg_deRefStablePtrzh
{
/* Args: R1 = the stable ptr */
W_ r, sp;
Bytecode object primitives
------------------------------------------------------------------------- */
-newBCOzh_fast
+stg_newBCOzh
{
/* R1 = instrs
R2 = literals
words = BYTES_TO_WDS(SIZEOF_StgBCO) + StgArrWords_words(bitmap_arr);
bytes = WDS(words);
- ALLOC_PRIM( bytes, R1_PTR&R2_PTR&R3_PTR&R5_PTR, newBCOzh_fast );
+ ALLOC_PRIM( bytes, R1_PTR&R2_PTR&R3_PTR&R5_PTR, stg_newBCOzh );
bco = Hp - bytes + WDS(1);
SET_HDR(bco, stg_BCO_info, W_[CCCS]);
}
-mkApUpd0zh_fast
+stg_mkApUpd0zh
{
// R1 = the BCO# for the AP
//
ASSERT(%INFO_TYPE(%GET_STD_INFO(R1)) == HALF_W_(BCO) &&
StgBCO_arity(R1) == HALF_W_(0));
- HP_CHK_GEN_TICKY(SIZEOF_StgAP, R1_PTR, mkApUpd0zh_fast);
+ HP_CHK_GEN_TICKY(SIZEOF_StgAP, R1_PTR, stg_mkApUpd0zh);
TICK_ALLOC_UP_THK(0, 0);
CCCS_ALLOC(SIZEOF_StgAP);
RET_P(ap);
}
-unpackClosurezh_fast
+stg_unpackClosurezh
{
/* args: R1 = closure to analyze */
// TODO: Consider the absence of ptrs or nonptrs as a special case ?
nptrs_arr_sz = SIZEOF_StgArrWords + WDS(nptrs);
ptrs_arr_sz = SIZEOF_StgMutArrPtrs + WDS(ptrs);
- ALLOC_PRIM (ptrs_arr_sz + nptrs_arr_sz, R1_PTR, unpackClosurezh_fast);
+ ALLOC_PRIM (ptrs_arr_sz + nptrs_arr_sz, R1_PTR, stg_unpackClosurezh);
W_ clos;
clos = UNTAG(R1);
} \
W_[blocked_queue_tl] = tso;
-waitReadzh_fast
+stg_waitReadzh
{
/* args: R1 */
#ifdef THREADED_RTS
#endif
}
-waitWritezh_fast
+stg_waitWritezh
{
/* args: R1 */
#ifdef THREADED_RTS
}
-STRING(stg_delayzh_malloc_str, "delayzh_fast")
-delayzh_fast
+STRING(stg_delayzh_malloc_str, "stg_delayzh")
+stg_delayzh
{
#ifdef mingw32_HOST_OS
W_ ares;
#ifdef mingw32_HOST_OS
-STRING(stg_asyncReadzh_malloc_str, "asyncReadzh_fast")
-asyncReadzh_fast
+STRING(stg_asyncReadzh_malloc_str, "stg_asyncReadzh")
+stg_asyncReadzh
{
W_ ares;
CInt reqID;
#endif
}
-STRING(stg_asyncWritezh_malloc_str, "asyncWritezh_fast")
-asyncWritezh_fast
+STRING(stg_asyncWritezh_malloc_str, "stg_asyncWritezh")
+stg_asyncWritezh
{
W_ ares;
CInt reqID;
#endif
}
-STRING(stg_asyncDoProczh_malloc_str, "asyncDoProczh_fast")
-asyncDoProczh_fast
+STRING(stg_asyncDoProczh_malloc_str, "stg_asyncDoProczh")
+stg_asyncDoProczh
{
W_ ares;
CInt reqID;
// evaluation by the current thread are also under evaluation by
// another thread. It relies on *both* threads doing noDuplicate#;
// the second one will get blocked if they are duplicating some work.
-noDuplicatezh_fast
+stg_noDuplicatezh
{
SAVE_THREAD_STATE();
ASSERT(StgTSO_what_next(CurrentTSO) == ThreadRunGHC::I16);
}
}
-getApStackValzh_fast
+stg_getApStackValzh
{
W_ ap_stack, offset, val, ok;
// Write the cost center stack of the first argument on stderr; return
// the second. Possibly only makes sense for already evaluated
// things?
-traceCcszh_fast
+stg_traceCcszh
{
W_ ccs;
ENTER();
}
-getSparkzh_fast
+stg_getSparkzh
{
W_ spark;
}
#endif
}
+
+stg_traceEventzh
+{
+ W_ msg;
+ msg = R1;
+#if defined(TRACING) || defined(DEBUG)
+ foreign "C" traceUserMsg(MyCapability() "ptr", msg "ptr") [];
+#endif
+ jump %ENTRY_CODE(Sp(0));
+}
projects / ghc-hetmet.git / blobdiff