1 /* -----------------------------------------------------------------------------
2 * $Id: PrimOps.hc,v 1.13 1999/02/05 16:02:45 simonm Exp $
4 * (c) The GHC Team, 1998-1999
6 * Primitive functions / data
8 * ---------------------------------------------------------------------------*/
15 #include "StgStartup.h"
20 #include "BlockAlloc.h" /* tmp */
21 #include "StablePriv.h"
25 classes CCallable and CReturnable don't really exist, but the
26 compiler insists on generating dictionaries containing references
27 to GHC_ZcCCallable_static_info etc., so we provide dummy symbols
31 W_ GHC_ZCCCallable_static_info[0];
32 W_ GHC_ZCCReturnable_static_info[0];
34 #ifndef aix_TARGET_OS /* AIX gives link errors with this as a const (RO assembler section) */
37 StgClosure *PrelBase_Bool_closure_tbl[] = {
42 /* -----------------------------------------------------------------------------
43 Macros for Hand-written primitives.
44 -------------------------------------------------------------------------- */
47 * Horrible macros for returning unboxed tuples.
49 * How an unboxed tuple is returned depends on two factors:
50 * - the number of real registers we have available
51 * - the boxedness of the returned fields.
53 * To return an unboxed tuple from a primitive operation, we have macros
54 * RET_<layout> where <layout> describes the boxedness of each field of the
55 * unboxed tuple: N indicates a non-pointer field, and P indicates a pointer.
57 * We only define the cases actually used, to avoid having too much
58 * garbage in this section. Warning: any bugs in here will be hard to
62 /*------ All Regs available */
64 # define RET_P(a) R1.w = (W_)(a); JMP_(ENTRY_CODE(Sp[0]));
65 # define RET_N(a) RET_P(a)
67 # define RET_PP(a,b) R1.w = (W_)(a); R2.w = (W_)(b); JMP_(ENTRY_CODE(Sp[0]));
68 # define RET_NN(a,b) RET_PP(a,b)
69 # define RET_NP(a,b) RET_PP(a,b)
71 # define RET_PPP(a,b,c) \
72 R1.w = (W_)(a); R2.w = (W_)(b); R3.w = (W_)(c); JMP_(ENTRY_CODE(Sp[0]));
73 # define RET_NNP(a,b,c) RET_PPP(a,b,c)
75 # define RET_NNNP(a,b,c,d) \
76 R1.w = (W_)(a); R2.w = (W_)(b); R3.w = (W_)(c); R4.w = (W_)d; \
77 JMP_(ENTRY_CODE(Sp[0]));
79 # define RET_NNPNNP(a,b,c,d,e,f) \
80 R1.w = (W_)(a); R2.w = (W_)(b); R3.w = (W_)(c); \
81 R4.w = (W_)(d); R5.w = (W_)(e); R6.w = (W_)(f); \
82 JMP_(ENTRY_CODE(Sp[0]));
86 #if defined(REG_R7) || defined(REG_R6) || defined(REG_R5) || \
87 defined(REG_R4) || defined(REG_R3) || defined(REG_R2)
88 # error RET_n macros not defined for this setup.
91 /*------ 1 Register available */
93 # define RET_P(a) R1.w = (W_)(a); JMP_(ENTRY_CODE(Sp[0]));
94 # define RET_N(a) RET_P(a)
96 # define RET_PP(a,b) R1.w = (W_)(a); Sp[-1] = (W_)(b); Sp -= 1; \
97 JMP_(ENTRY_CODE(Sp[1]));
98 # define RET_NN(a,b) R1.w = (W_)(a); Sp[-1] = (W_)(b); Sp -= 2; \
99 JMP_(ENTRY_CODE(Sp[2]));
100 # define RET_NP(a,b) RET_PP(a,b)
102 # define RET_PPP(a,b,c) \
103 R1.w = (W_)(a); Sp[-2] = (W_)(b); Sp[-1] = (W_)(c); Sp -= 2; \
104 JMP_(ENTRY_CODE(Sp[2]));
105 # define RET_NNP(a,b,c) \
106 R1.w = (W_)(a); Sp[-2] = (W_)(b); Sp[-1] = (W_)(c); Sp -= 3; \
107 JMP_(ENTRY_CODE(Sp[3]));
109 # define RET_NNNP(a,b,c,d) \
111 /* Sp[-5] = ARGTAG(1); */ \
113 /* Sp[-3] = ARGTAG(1); */ \
117 JMP_(ENTRY_CODE(Sp[5]));
119 # define RET_NNPNNP(a,b,c,d,e,f) \
123 /* Sp[-3] = ARGTAG(1); */ \
125 /* Sp[-5] = ARGTAG(1); */ \
128 /* Sp[-8] = ARGTAG(1); */ \
130 JMP_(ENTRY_CODE(Sp[8]));
132 #else /* 0 Regs available */
134 #define PUSH_P(o,x) Sp[-o] = (W_)(x)
135 #define PUSH_N(o,x) Sp[1-o] = (W_)(x); /* Sp[-o] = ARGTAG(1) */
136 #define PUSHED(m) Sp -= (m); JMP_(ENTRY_CODE(Sp[m]));
138 /* Here's how to construct these macros:
140 * N = number of N's in the name;
141 * P = number of P's in the name;
143 * while (nonNull(name)) {
144 * if (nextChar == 'P') {
155 # define RET_P(a) PUSH_P(1,a); PUSHED(1)
156 # define RET_N(a) PUSH_N(2,a); PUSHED(2)
158 # define RET_PP(a,b) PUSH_P(2,a); PUSH_P(1,b); PUSHED(2)
159 # define RET_NN(a,b) PUSH_N(4,a); PUSH_N(2,b); PUSHED(4)
160 # define RET_NP(a,b) PUSH_N(3,a); PUSH_P(1,b); PUSHED(3)
162 # define RET_PPP(a,b,c) PUSH_P(3,a); PUSH_P(2,b); PUSH_P(1,c); PUSHED(3)
163 # define RET_NNP(a,b,c) PUSH_N(6,a); PUSH_N(4,b); PUSH_N(2,c); PUSHED(6)
165 # define RET_NNNP(a,b,c,d) PUSH_N(7,a); PUSH_N(5,b); PUSH_N(3,c); PUSH_P(1,d); PUSHED(7)
166 # define RET_NNPNNP(a,b,c,d,e,f) PUSH_N(10,a); PUSH_N(8,b); PUSH_P(6,c); PUSH_N(5,d); PUSH_N(3,e); PUSH_P(1,f); PUSHED(10)
173 /*-----------------------------------------------------------------------------
176 Basically just new*Array - the others are all inline macros.
178 The size arg is always passed in R1, and the result returned in R1.
180 The slow entry point is for returning from a heap check, the saved
181 size argument must be re-loaded from the stack.
182 -------------------------------------------------------------------------- */
184 /* for objects that are *less* than the size of a word, make sure we
185 * round up to the nearest word for the size of the array.
188 #define BYTES_TO_STGWORDS(n) ((n) + sizeof(W_) - 1)/sizeof(W_)
190 #define newByteArray(ty,scale) \
191 FN_(new##ty##Arrayzh_fast) \
193 W_ stuff_size, size, n; \
196 MAYBE_GC(NO_PTRS,new##ty##Arrayzh_fast); \
198 stuff_size = BYTES_TO_STGWORDS(n*scale); \
199 size = sizeofW(StgArrWords)+ stuff_size; \
200 p = (StgArrWords *)RET_STGCALL1(P_,allocate,size); \
201 TICK_ALLOC_PRIM(sizeofW(StgArrWords),stuff_size,0); \
202 SET_HDR(p, &ARR_WORDS_info, CCCS); \
203 p->words = stuff_size; \
204 TICK_RET_UNBOXED_TUP(1) \
209 newByteArray(Char, sizeof(C_))
210 newByteArray(Int, sizeof(I_));
211 newByteArray(Word, sizeof(W_));
212 newByteArray(Addr, sizeof(P_));
213 newByteArray(Float, sizeof(StgFloat));
214 newByteArray(Double, sizeof(StgDouble));
215 newByteArray(StablePtr, sizeof(StgStablePtr));
225 MAYBE_GC(R2_PTR,newArrayzh_fast);
227 size = sizeofW(StgMutArrPtrs) + n;
228 arr = (StgMutArrPtrs *)RET_STGCALL1(P_, allocate, size);
229 TICK_ALLOC_PRIM(sizeofW(StgMutArrPtrs), n, 0);
231 SET_HDR(arr,&MUT_ARR_PTRS_info,CCCS);
235 for (p = (P_)arr + sizeofW(StgMutArrPtrs);
236 p < (P_)arr + size; p++) {
240 TICK_RET_UNBOXED_TUP(1);
245 FN_(newMutVarzh_fast)
248 /* Args: R1.p = initialisation value */
251 HP_CHK_GEN(sizeofW(StgMutVar), R1_PTR, newMutVarzh_fast,);
252 TICK_ALLOC_PRIM(sizeofW(StgHeader)+1,1, 0); /* hack, dependent on rep. */
253 CCS_ALLOC(CCCS,sizeofW(StgMutVar));
255 mv = (StgMutVar *)(Hp-sizeofW(StgMutVar)+1);
256 SET_HDR(mv,&MUT_VAR_info,CCCS);
259 TICK_RET_UNBOXED_TUP(1);
264 /* -----------------------------------------------------------------------------
265 Foreign Object Primitives
267 -------------------------------------------------------------------------- */
270 FN_(makeForeignObjzh_fast)
272 /* R1.p = ptr to foreign object,
274 StgForeignObj *result;
277 HP_CHK_GEN(sizeofW(StgForeignObj), NO_PTRS, makeForeignObjzh_fast,);
278 TICK_ALLOC_PRIM(sizeofW(StgHeader),
279 sizeofW(StgForeignObj)-sizeofW(StgHeader), 0);
280 CCS_ALLOC(CCCS,sizeofW(StgForeignObj)); /* ccs prof */
282 result = (StgForeignObj *) (Hp + 1 - sizeofW(StgForeignObj));
283 SET_HDR(result,&FOREIGN_info,CCCS);
286 /* returns (# s#, ForeignObj# #) */
287 TICK_RET_UNBOXED_TUP(1);
293 /* -----------------------------------------------------------------------------
294 Weak Pointer Primitives
295 -------------------------------------------------------------------------- */
308 HP_CHK_GEN(sizeofW(StgWeak), R1_PTR|R2_PTR|R3_PTR, mkWeakzh_fast,);
309 TICK_ALLOC_PRIM(sizeofW(StgHeader)+1, // +1 is for the link field
310 sizeofW(StgWeak)-sizeofW(StgHeader)-1, 0);
311 CCS_ALLOC(CCCS,sizeofW(StgWeak)); /* ccs prof */
313 w = (StgWeak *) (Hp + 1 - sizeofW(StgWeak));
314 SET_HDR(w, &WEAK_info, CCCS);
319 w->finaliser = R3.cl;
321 w->finaliser = &NO_FINALISER_closure;
324 w->link = weak_ptr_list;
326 IF_DEBUG(weak, fprintf(stderr,"New weak pointer at %p\n",w));
328 TICK_RET_UNBOXED_TUP(1);
333 FN_(finaliseWeakzh_fast)
339 TICK_RET_UNBOXED_TUP(0);
342 if (w->finaliser != &NO_FINALISER_closure) {
344 STGCALL2(createGenThread, RtsFlags.GcFlags.initialStkSize, w->finaliser);
346 STGCALL2(createIOThread, RtsFlags.GcFlags.initialStkSize, w->finaliser);
349 w->header.info = &DEAD_WEAK_info;
351 JMP_(ENTRY_CODE(Sp[0]));
357 /* -----------------------------------------------------------------------------
358 Arbitrary-precision Integer operations.
359 -------------------------------------------------------------------------- */
361 FN_(int2Integerzh_fast)
363 /* arguments: R1 = Int# */
365 I_ val, s; /* to avoid aliasing */
366 StgArrWords* p; /* address of array result */
370 HP_CHK_GEN(sizeofW(StgArrWords)+1, NO_PTRS, int2Integerzh_fast,);
371 TICK_ALLOC_PRIM(sizeofW(StgArrWords),1,0);
372 CCS_ALLOC(CCCS,sizeofW(StgArrWords)+1); /* ccs prof */
374 p = stgCast(StgArrWords*,Hp)-1;
375 SET_ARR_HDR(p, &ARR_WORDS_info, CCCS, 1);
377 /* mpz_set_si is inlined here, makes things simpler */
381 } else if (val > 0) {
388 /* returns (# alloc :: Int#,
393 TICK_RET_UNBOXED_TUP(3);
398 FN_(word2Integerzh_fast)
400 /* arguments: R1 = Word# */
402 W_ val; /* to avoid aliasing */
404 StgArrWords* p; /* address of array result */
408 HP_CHK_GEN(sizeofW(StgArrWords)+1, NO_PTRS, word2Integerzh_fast,)
409 TICK_ALLOC_PRIM(sizeofW(StgArrWords),1,0);
410 CCS_ALLOC(CCCS,sizeofW(StgArrWords)+1); /* ccs prof */
412 p = stgCast(StgArrWords*,Hp)-1;
413 SET_ARR_HDR(p, &ARR_WORDS_info, CCCS, 1);
422 /* returns (# alloc :: Int#,
427 TICK_RET_UNBOXED_TUP(3);
432 FN_(addr2Integerzh_fast)
438 MAYBE_GC(NO_PTRS,addr2Integerzh_fast);
440 /* args: R1 :: Addr# */
443 /* Perform the operation */
444 if (RET_STGCALL3(int, mpz_init_set_str,&result,(str),/*base*/10))
447 TICK_RET_UNBOXED_TUP(3);
448 RET_NNP(result._mp_alloc, result._mp_size,
449 result._mp_d - sizeofW(StgArrWords));
454 * 'long long' primops for converting to/from Integers.
457 #ifdef SUPPORT_LONG_LONGS
459 FN_(int64ToIntegerzh_fast)
461 /* arguments: L1 = Int64# */
463 StgInt64 val; /* to avoid aliasing */
465 I_ s,a, neg, words_needed;
466 StgArrWords* p; /* address of array result */
472 if ( val >= 0x100000000LL || val <= -0x100000000LL ) {
475 /* minimum is one word */
478 HP_CHK_GEN(sizeofW(StgArrWords)+words_needed, NO_PTRS, int64ToIntegerzh_fast,)
479 TICK_ALLOC_PRIM(sizeofW(StgArrWords),words_needed,0);
480 CCS_ALLOC(CCCS,sizeofW(StgArrWords)+words_needed); /* ccs prof */
482 p = stgCast(StgArrWords*,(Hp-words_needed+1))-1;
483 SET_ARR_HDR(p, &ARR_WORDS_info, CCCS, words_needed);
492 hi = (W_)((LW_)val / 0x100000000ULL);
498 } else if ( val != 0 ) {
501 } else /* val==0 */ {
504 s = ( neg ? -s : s );
506 /* returns (# alloc :: Int#,
511 TICK_RET_UNBOXED_TUP(3);
516 FN_(word64ToIntegerzh_fast)
518 /* arguments: L1 = Word64# */
520 StgNat64 val; /* to avoid aliasing */
523 StgArrWords* p; /* address of array result */
527 if ( val >= 0x100000000ULL ) {
532 HP_CHK_GEN(sizeofW(StgArrWords)+words_needed, NO_PTRS, word64ToIntegerzh_fast,)
533 TICK_ALLOC_PRIM(sizeofW(StgArrWords),words_needed,0);
534 CCS_ALLOC(CCCS,sizeofW(StgArrWords)+words_needed); /* ccs prof */
536 p = stgCast(StgArrWords*,(Hp-words_needed+1))-1;
537 SET_ARR_HDR(p, &ARR_WORDS_info, CCCS, words_needed);
541 hi = (W_)((LW_)val / 0x100000000ULL);
542 if ( val >= 0x100000000ULL ) {
546 } else if ( val != 0 ) {
549 } else /* val==0 */ {
553 /* returns (# alloc :: Int#,
558 TICK_RET_UNBOXED_TUP(3);
564 #endif /* HAVE_LONG_LONG */
566 /* ToDo: this is shockingly inefficient */
568 #define GMP_TAKE2_RET1(name,mp_fun) \
571 MP_INT arg1, arg2, result; \
577 /* call doYouWantToGC() */ \
578 MAYBE_GC(R3_PTR | R6_PTR, name); \
582 d1 = stgCast(StgArrWords*,R3.p); \
585 d2 = stgCast(StgArrWords*,R6.p); \
587 arg1._mp_alloc = (a1); \
588 arg1._mp_size = (s1); \
589 arg1._mp_d = (unsigned long int *) (BYTE_ARR_CTS(d1)); \
590 arg2._mp_alloc = (a2); \
591 arg2._mp_size = (s2); \
592 arg2._mp_d = (unsigned long int *) (BYTE_ARR_CTS(d2)); \
594 STGCALL1(mpz_init,&result); \
596 /* Perform the operation */ \
597 STGCALL3(mp_fun,&result,&arg1,&arg2); \
599 TICK_RET_UNBOXED_TUP(3); \
600 RET_NNP(result._mp_alloc, \
602 result._mp_d-sizeofW(StgArrWords)); \
606 #define GMP_TAKE2_RET2(name,mp_fun) \
609 MP_INT arg1, arg2, result1, result2; \
615 /* call doYouWantToGC() */ \
616 MAYBE_GC(R3_PTR | R6_PTR, name); \
620 d1 = stgCast(StgArrWords*,R3.p); \
623 d2 = stgCast(StgArrWords*,R6.p); \
625 arg1._mp_alloc = (a1); \
626 arg1._mp_size = (s1); \
627 arg1._mp_d = (unsigned long int *) (BYTE_ARR_CTS(d1)); \
628 arg2._mp_alloc = (a2); \
629 arg2._mp_size = (s2); \
630 arg2._mp_d = (unsigned long int *) (BYTE_ARR_CTS(d2)); \
632 STGCALL1(mpz_init,&result1); \
633 STGCALL1(mpz_init,&result2); \
635 /* Perform the operation */ \
636 STGCALL4(mp_fun,&result1,&result2,&arg1,&arg2); \
638 TICK_RET_UNBOXED_TUP(6); \
639 RET_NNPNNP(result1._mp_alloc, \
641 result1._mp_d-sizeofW(StgArrWords), \
644 result2._mp_d-sizeofW(StgArrWords)); \
648 GMP_TAKE2_RET1(plusIntegerzh_fast, mpz_add);
649 GMP_TAKE2_RET1(minusIntegerzh_fast, mpz_sub);
650 GMP_TAKE2_RET1(timesIntegerzh_fast, mpz_mul);
651 GMP_TAKE2_RET1(gcdIntegerzh_fast, mpz_gcd);
653 GMP_TAKE2_RET2(quotRemIntegerzh_fast, mpz_tdiv_qr);
654 GMP_TAKE2_RET2(divModIntegerzh_fast, mpz_fdiv_qr);
656 #ifndef FLOATS_AS_DOUBLES
657 FN_(decodeFloatzh_fast)
665 /* arguments: F1 = Float# */
668 HP_CHK_GEN(sizeof(StgArrWords)+1, NO_PTRS, decodeFloatzh_fast,);
669 TICK_ALLOC_PRIM(sizeofW(StgArrWords),1,0);
670 CCS_ALLOC(CCCS,sizeofW(StgArrWords)+1); /* ccs prof */
672 /* Be prepared to tell Lennart-coded __decodeFloat */
673 /* where mantissa._mp_d can be put (it does not care about the rest) */
674 p = stgCast(StgArrWords*,Hp)-1;
675 SET_ARR_HDR(p,&ARR_WORDS_info,CCCS,1)
676 mantissa._mp_d = (void *)BYTE_ARR_CTS(p);
678 /* Perform the operation */
679 STGCALL3(__decodeFloat,&mantissa,&exponent,arg);
681 /* returns: (R1 = Int# (expn), R2 = Int#, R3 = Int#, R4 = ByteArray#) */
682 TICK_RET_UNBOXED_TUP(4);
683 RET_NNNP(exponent,mantissa._mp_alloc,mantissa._mp_size,p);
686 #endif /* !FLOATS_AS_DOUBLES */
688 #define DOUBLE_MANTISSA_SIZE (sizeof(StgDouble)/sizeof(W_))
689 #define ARR_SIZE (sizeof(StgArrWords) + DOUBLE_MANTISSA_SIZE)
691 FN_(decodeDoublezh_fast)
698 /* arguments: D1 = Double# */
701 HP_CHK_GEN(ARR_SIZE, NO_PTRS, decodeDoublezh_fast,);
702 TICK_ALLOC_PRIM(sizeof(StgArrWords),DOUBLE_MANTISSA_SIZE,0);
703 CCS_ALLOC(CCCS,ARR_SIZE); /* ccs prof */
705 /* Be prepared to tell Lennart-coded __decodeDouble */
706 /* where mantissa.d can be put (it does not care about the rest) */
707 p = stgCast(StgArrWords*,Hp-ARR_SIZE+1);
708 SET_ARR_HDR(p, &ARR_WORDS_info, CCCS, DOUBLE_MANTISSA_SIZE);
709 mantissa._mp_d = (void *)BYTE_ARR_CTS(p);
711 /* Perform the operation */
712 STGCALL3(__decodeDouble,&mantissa,&exponent,arg);
714 /* returns: (R1 = Int# (expn), R2 = Int#, R3 = Int#, R4 = ByteArray#) */
715 TICK_RET_UNBOXED_TUP(4);
716 RET_NNNP(exponent,mantissa._mp_alloc,mantissa._mp_size,p);
720 /* -----------------------------------------------------------------------------
721 * Concurrency primitives
722 * -------------------------------------------------------------------------- */
727 /* args: R1 = closure to spark */
729 if (closure_SHOULD_SPARK(stgCast(StgClosure*,R1.p))) {
731 MAYBE_GC(R1_PTR, forkzh_fast);
733 /* create it right now, return ThreadID in R1 */
734 R1.t = RET_STGCALL2(StgTSO *, createIOThread,
735 RtsFlags.GcFlags.initialStkSize, R1.cl);
737 /* switch at the earliest opportunity */
741 JMP_(ENTRY_CODE(Sp[0]));
745 FN_(killThreadzh_fast)
748 /* args: R1.p = TSO to kill */
750 /* The thread is dead, but the TSO sticks around for a while. That's why
751 * we don't have to explicitly remove it from any queues it might be on.
753 STGCALL1(deleteThread, (StgTSO *)R1.p);
755 /* We might have killed ourselves. In which case, better return to the
758 if ((StgTSO *)R1.p == CurrentTSO) {
759 JMP_(stg_stop_thread_entry); /* leave semi-gracefully */
762 JMP_(ENTRY_CODE(Sp[0]));
773 HP_CHK_GEN(sizeofW(StgMVar), NO_PTRS, newMVarzh_fast,);
774 TICK_ALLOC_PRIM(sizeofW(StgMutVar)-1, // consider head,tail,link as admin wds
776 CCS_ALLOC(CCCS,sizeofW(StgMVar)); /* ccs prof */
778 mvar = (StgMVar *) (Hp - sizeofW(StgMVar) + 1);
779 SET_INFO(mvar,&EMPTY_MVAR_info);
780 mvar->head = mvar->tail = (StgTSO *)&END_TSO_QUEUE_closure;
781 mvar->value = (StgClosure *)&END_TSO_QUEUE_closure;
783 TICK_RET_UNBOXED_TUP(1);
794 /* args: R1 = MVar closure */
796 mvar = (StgMVar *)R1.p;
798 /* If the MVar is empty, put ourselves on its blocking queue,
799 * and wait until we're woken up.
801 if (GET_INFO(mvar) != &FULL_MVAR_info) {
802 if (mvar->head == (StgTSO *)&END_TSO_QUEUE_closure) {
803 mvar->head = CurrentTSO;
805 mvar->tail->link = CurrentTSO;
807 CurrentTSO->link = (StgTSO *)&END_TSO_QUEUE_closure;
808 mvar->tail = CurrentTSO;
810 BLOCK(R1_PTR, takeMVarzh_fast);
813 SET_INFO(mvar,&EMPTY_MVAR_info);
815 mvar->value = (StgClosure *)&END_TSO_QUEUE_closure;
817 TICK_RET_UNBOXED_TUP(1);
828 /* args: R1 = MVar, R2 = value */
830 mvar = (StgMVar *)R1.p;
831 if (GET_INFO(mvar) == &FULL_MVAR_info) {
833 fprintf(stderr, "putMVar#: MVar already full.\n");
834 stg_exit(EXIT_FAILURE);
837 SET_INFO(mvar,&FULL_MVAR_info);
840 /* wake up the first thread on the queue,
841 * it will continue with the takeMVar operation and mark the MVar
845 if (tso != (StgTSO *)&END_TSO_QUEUE_closure) {
846 PUSH_ON_RUN_QUEUE(tso);
847 mvar->head = tso->link;
848 tso->link = (StgTSO *)&END_TSO_QUEUE_closure;
849 if (mvar->head == (StgTSO *)&END_TSO_QUEUE_closure) {
850 mvar->tail = (StgTSO *)&END_TSO_QUEUE_closure;
854 /* ToDo: yield here for better communication performance? */
855 JMP_(ENTRY_CODE(Sp[0]));
859 /* -----------------------------------------------------------------------------
860 Stable pointer primitives
861 ------------------------------------------------------------------------- */
863 FN_(makeStableNamezh_fast)
866 StgStableName *sn_obj;
869 HP_CHK_GEN(sizeofW(StgStableName), R1_PTR, makeStableNamezh_fast,);
870 TICK_ALLOC_PRIM(sizeofW(StgHeader),
871 sizeofW(StgStableName)-sizeofW(StgHeader), 0);
872 CCS_ALLOC(CCCS,sizeofW(StgStableName)); /* ccs prof */
874 index = RET_STGCALL1(StgWord,lookupStableName,R1.p);
876 sn_obj = (StgStableName *) (Hp - sizeofW(StgStableName) + 1);
877 sn_obj->header.info = &STABLE_NAME_info;
880 TICK_RET_UNBOXED_TUP(1);
884 #endif /* COMPILER */