ghc/includes/StgMacros.h

   1 /* -----------------------------------------------------------------------------
   2  * $Id: StgMacros.h,v 1.21 2000/03/08 17:48:26 simonmar Exp $
   3  *
   4  * (c) The GHC Team, 1998-1999
   5  *
   6  * Macros used for writing STG-ish C code.
   7  *
   8  * ---------------------------------------------------------------------------*/
   9
  10 #ifndef STGMACROS_H
  11 #define STGMACROS_H
  12
  13 /* -----------------------------------------------------------------------------
  14   The following macros create function headers.
  15
  16   Each basic block is represented by a C function with no arguments.
  17   We therefore always begin with either
  18
  19   extern F_ f(void)
  20
  21   or
  22
  23   static F_ f(void)
  24
  25   The macros can be used either to define the function itself, or to provide
  26   prototypes (by following with a ';').
  27
  28   Note: the various I*_ shorthands in the second block below are used to
  29   declare forward references to local symbols. These shorthands *have* to
  30   use the 'extern' type specifier and not 'static'. The reason for this is
  31   that 'static' declares a reference as being a static/local variable,
  32   and *not* as a forward reference to a static variable.
  33
  34   This might seem obvious, but it had me stumped as to why my info tables
  35   were suddenly all filled with 0s.
  36
  37     -- sof 1/99
  38
  39   --------------------------------------------------------------------------- */
  40
  41 #define STGFUN(f)       StgFunPtr f(void)
  42 #define EXTFUN(f)       extern StgFunPtr f(void)
  43 #define EXTFUN_RTS(f)   extern DLL_IMPORT_RTS StgFunPtr f(void)
  44 #define FN_(f)          F_ f(void)
  45 #define IFN_(f)         static F_ f(void)
  46 #define IF_(f)          static F_ f(void)
  47 #define EF_(f)          extern F_ f(void)
  48 #define EDF_(f)         extern DLLIMPORT F_ f(void)
  49
  50 #define ED_             extern
  51 #define EDD_            extern DLLIMPORT
  52 #define ED_RO_          extern const
  53 #define ID_             extern
  54 #define ID_RO_          extern const
  55 #define EI_             extern INFO_TBL_CONST StgInfoTable
  56 #define EDI_            extern DLLIMPORT INFO_TBL_CONST StgInfoTable
  57 #define II_             extern INFO_TBL_CONST StgInfoTable
  58 #define EC_             extern StgClosure
  59 #define EDC_            extern DLLIMPORT StgClosure
  60 #define IC_             extern StgClosure
  61 #define ECP_(x)         extern const StgClosure *(x)[]
  62 #define EDCP_(x)        extern DLLIMPORT StgClosure *(x)[]
  63 #define ICP_(x)         extern const StgClosure *(x)[]
  64
  65 /* -----------------------------------------------------------------------------
  66    Stack Tagging.
  67
  68    For a  block of non-pointer words on the stack, we precede the
  69    block with a small-integer tag giving the number of non-pointer
  70    words in the block.
  71    -------------------------------------------------------------------------- */
  72
  73 #define ARGTAG_MAX 16           /* probably arbitrary */
  74 #define ARG_TAG(n)  (n)
  75 #define ARG_SIZE(n) (StgWord)n
  76
  77 typedef enum {
  78     REALWORLD_TAG = 0,
  79     INT_TAG       = sizeofW(StgInt),
  80     INT64_TAG     = sizeofW(StgInt64),
  81     WORD_TAG      = sizeofW(StgWord),
  82     ADDR_TAG      = sizeofW(StgAddr),
  83     CHAR_TAG      = sizeofW(StgChar),
  84     FLOAT_TAG     = sizeofW(StgFloat),
  85     DOUBLE_TAG    = sizeofW(StgDouble),
  86     STABLE_TAG    = sizeofW(StgWord),
  87 } StackTag;
  88
  89 static inline int IS_ARG_TAG( StgWord p );
  90 static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; }
  91
  92 /* -----------------------------------------------------------------------------
  93    Argument checks.
  94
  95    If (Sp + <n_args>) > Su { JMP_(stg_update_PAP); }
  96
  97    Sp points to the topmost used word on the stack, and Su points to
  98    the most recently pushed update frame.
  99
 100    Remember that <n_args> must include any tagging of unboxed values.
 101
 102    ARGS_CHK_LOAD_NODE is for top-level functions, whose entry
 103    convention doesn't require that Node is loaded with a pointer to
 104    the closure.  Thus we must load node before calling stg_updatePAP if
 105    the argument check fails.
 106    -------------------------------------------------------------------------- */
 107
 108 #define ARGS_CHK(n)                             \
 109         if ((P_)(Sp + (n)) > (P_)Su) {          \
 110                 JMP_(stg_update_PAP);           \
 111         }
 112
 113 #define ARGS_CHK_LOAD_NODE(n,closure)           \
 114         if ((P_)(Sp + (n)) > (P_)Su) {          \
 115                 R1.p = (P_)closure;             \
 116                 JMP_(stg_update_PAP);           \
 117         }
 118
 119 /* -----------------------------------------------------------------------------
 120    Heap/Stack Checks.
 121
 122    When failing a check, we save a return address on the stack and
 123    jump to a pre-compiled code fragment that saves the live registers
 124    and returns to the scheduler.
 125
 126    The return address in most cases will be the beginning of the basic
 127    block in which the check resides, since we need to perform the check
 128    again on re-entry because someone else might have stolen the resource
 129    in the meantime.
 130    ------------------------------------------------------------------------- */
 131
 132 #define STK_CHK(headroom,ret,r,layout,tag_assts)                \
 133         if (Sp - headroom < SpLim) {                            \
 134             EXTFUN_RTS(stg_chk_##layout);                       \
 135             tag_assts                                           \
 136             (r) = (P_)ret;                                      \
 137             JMP_(stg_chk_##layout);                             \
 138         }
 139
 140 #define HP_CHK(headroom,ret,r,layout,tag_assts)                 \
 141         DO_GRAN_ALLOCATE(headroom)                              \
 142         if ((Hp += headroom) > HpLim) {                         \
 143             EXTFUN_RTS(stg_chk_##layout);                       \
 144             tag_assts                                           \
 145             (r) = (P_)ret;                                      \
 146             JMP_(stg_chk_##layout);                             \
 147         }
 148
 149 #define HP_STK_CHK(stk_headroom,hp_headroom,ret,r,layout,tag_assts) \
 150         DO_GRAN_ALLOCATE(hp_headroom)                              \
 151         if (Sp - stk_headroom < SpLim || (Hp += hp_headroom) > HpLim) { \
 152             EXTFUN_RTS(stg_chk_##layout);                       \
 153             tag_assts                                           \
 154             (r) = (P_)ret;                                      \
 155             JMP_(stg_chk_##layout);                             \
 156         }
 157
 158 /* -----------------------------------------------------------------------------
 159    A Heap Check in a case alternative are much simpler: everything is
 160    on the stack and covered by a liveness mask already, and there is
 161    even a return address with an SRT info table there as well.
 162
 163    Just push R1 and return to the scheduler saying 'EnterGHC'
 164
 165    {STK,HP,HP_STK}_CHK_NP are the various checking macros for
 166    bog-standard case alternatives, thunks, and non-top-level
 167    functions.  In all these cases, node points to a closure that we
 168    can just enter to restart the heap check (the NP stands for 'node points').
 169
 170    In the NP case GranSim absolutely has to check whether the current node
 171    resides on the current processor. Otherwise a FETCH event has to be
 172    scheduled. All that is done in GranSimFetch. -- HWL
 173
 174    HpLim points to the LAST WORD of valid allocation space.
 175    -------------------------------------------------------------------------- */
 176
 177 #define STK_CHK_NP(headroom,ptrs,tag_assts)                     \
 178         if ((Sp - (headroom)) < SpLim) {                        \
 179             EXTFUN_RTS(stg_gc_enter_##ptrs);                    \
 180             tag_assts                                           \
 181             JMP_(stg_gc_enter_##ptrs);                          \
 182         }
 183
 184 #define HP_CHK_NP(headroom,ptrs,tag_assts)                      \
 185         DO_GRAN_ALLOCATE(headroom)                              \
 186         if ((Hp += (headroom)) > HpLim) {                       \
 187             EXTFUN_RTS(stg_gc_enter_##ptrs);                    \
 188             tag_assts                                           \
 189             JMP_(stg_gc_enter_##ptrs);                          \
 190         }
 191
 192 #define HP_CHK_SEQ_NP(headroom,ptrs,tag_assts)                  \
 193         DO_GRAN_ALLOCATE(headroom)                              \
 194         if ((Hp += (headroom)) > HpLim) {                       \
 195             EXTFUN_RTS(stg_gc_seq_##ptrs);                      \
 196             tag_assts                                           \
 197             JMP_(stg_gc_seq_##ptrs);                            \
 198         }
 199
 200 #define HP_STK_CHK_NP(stk_headroom, hp_headroom, ptrs, tag_assts) \
 201         DO_GRAN_ALLOCATE(hp_headroom)                              \
 202         if ((Sp - (stk_headroom)) < SpLim || (Hp += (hp_headroom)) > HpLim) { \
 203             EXTFUN_RTS(stg_gc_enter_##ptrs);                    \
 204             tag_assts                                           \
 205             JMP_(stg_gc_enter_##ptrs);                          \
 206         }
 207
 208
 209 /* Heap checks for branches of a primitive case / unboxed tuple return */
 210
 211 #define GEN_HP_CHK_ALT(headroom,lbl,tag_assts)                  \
 212         DO_GRAN_ALLOCATE(headroom)                              \
 213         if ((Hp += (headroom)) > HpLim) {                       \
 214             EXTFUN_RTS(lbl);                                    \
 215             tag_assts                                           \
 216             JMP_(lbl);                                          \
 217         }
 218
 219 #define HP_CHK_NOREGS(headroom,tag_assts) \
 220     GEN_HP_CHK_ALT(headroom,stg_gc_noregs,tag_assts);
 221 #define HP_CHK_UNPT_R1(headroom,tag_assts)  \
 222     GEN_HP_CHK_ALT(headroom,stg_gc_unpt_r1,tag_assts);
 223 #define HP_CHK_UNBX_R1(headroom,tag_assts)  \
 224     GEN_HP_CHK_ALT(headroom,stg_gc_unbx_r1,tag_assts);
 225 #define HP_CHK_F1(headroom,tag_assts)       \
 226     GEN_HP_CHK_ALT(headroom,stg_gc_f1,tag_assts);
 227 #define HP_CHK_D1(headroom,tag_assts)       \
 228     GEN_HP_CHK_ALT(headroom,stg_gc_d1,tag_assts);
 229
 230 #define HP_CHK_L1(headroom,tag_assts)       \
 231     GEN_HP_CHK_ALT(headroom,stg_gc_d1,tag_assts);
 232
 233 #define HP_CHK_UT_ALT(headroom, ptrs, nptrs, r, ret, tag_assts) \
 234     GEN_HP_CHK_ALT(headroom, stg_gc_ut_##ptrs##_##nptrs, \
 235                      tag_assts r = (P_)ret;)
 236
 237 /* -----------------------------------------------------------------------------
 238    Generic Heap checks.
 239
 240    These are slow, but have the advantage of being usable in a variety
 241    of situations.
 242
 243    The one restriction is that any relevant SRTs must already be pointed
 244    to from the stack.  The return address doesn't need to have an info
 245    table attached: hence it can be any old code pointer.
 246
 247    The liveness mask is a logical 'XOR' of NO_PTRS and zero or more
 248    Rn_PTR constants defined below.  All registers will be saved, but
 249    the garbage collector needs to know which ones contain pointers.
 250
 251    Good places to use a generic heap check:
 252
 253         - case alternatives (the return address with an SRT is already
 254           on the stack).
 255
 256         - primitives (no SRT required).
 257
 258    The stack layout is like this:
 259
 260           DblReg1-2
 261           FltReg1-4
 262           R1-8
 263           return address
 264           liveness mask
 265           stg_gen_chk_info
 266
 267    so the liveness mask depends on the size of an StgDouble (FltRegs
 268    and R<n> are guaranteed to be 1 word in size).
 269
 270    -------------------------------------------------------------------------- */
 271
 272 /* VERY MAGIC CONSTANTS!
 273  * must agree with code in HeapStackCheck.c, stg_gen_chk
 274  */
 275
 276 #if SIZEOF_DOUBLE > SIZEOF_VOID_P
 277 #define ALL_NON_PTRS   0xffff
 278 #else /* SIZEOF_DOUBLE == SIZEOF_VOID_P */
 279 #define ALL_NON_PTRS   0x3fff
 280 #endif
 281
 282 #define LIVENESS_MASK(ptr_regs)  (ALL_NON_PTRS ^ (ptr_regs))
 283
 284 #define NO_PTRS   0
 285 #define R1_PTR    1<<0
 286 #define R2_PTR    1<<1
 287 #define R3_PTR    1<<2
 288 #define R4_PTR    1<<3
 289 #define R5_PTR    1<<4
 290 #define R6_PTR    1<<5
 291 #define R7_PTR    1<<6
 292 #define R8_PTR    1<<7
 293
 294 #define HP_CHK_GEN(headroom,liveness,reentry,tag_assts) \
 295    if ((Hp += (headroom)) > HpLim ) {                   \
 296         EF_(stg_gen_chk);                               \
 297         tag_assts                                       \
 298         R9.w = (W_)LIVENESS_MASK(liveness);             \
 299         R10.w = (W_)reentry;                            \
 300         JMP_(stg_gen_chk);                              \
 301    }
 302
 303 #define HP_CHK_GEN_TICKY(headroom,liveness,reentry,tag_assts)   \
 304    HP_CHK_GEN(headroom,liveness,reentry,tag_assts);             \
 305    TICK_ALLOC_HEAP_NOCTR(headroom)
 306
 307 #define STK_CHK_GEN(headroom,liveness,reentry,tag_assts)        \
 308    if ((Sp - (headroom)) < SpLim) {                             \
 309         EF_(stg_gen_chk);                                       \
 310         tag_assts                                               \
 311         R9.w = (W_)LIVENESS_MASK(liveness);                     \
 312         R10.w = (W_)reentry;                                    \
 313         JMP_(stg_gen_chk);                                      \
 314    }
 315
 316 #define MAYBE_GC(liveness,reentry)              \
 317    if (doYouWantToGC()) {                       \
 318         EF_(stg_gen_hp);                        \
 319         R9.w = (W_)LIVENESS_MASK(liveness);     \
 320         R10.w = (W_)reentry;                    \
 321         JMP_(stg_gen_hp);                       \
 322    }
 323
 324 /* -----------------------------------------------------------------------------
 325    Voluntary Yields/Blocks
 326
 327    We only have a generic version of this at the moment - if it turns
 328    out to be slowing us down we can make specialised ones.
 329    -------------------------------------------------------------------------- */
 330
 331 EF_(stg_gen_yield);
 332 EF_(stg_gen_block);
 333
 334 #define YIELD(liveness,reentry)                 \
 335   {                                             \
 336    R9.w  = (W_)LIVENESS_MASK(liveness);         \
 337    R10.w = (W_)reentry;                         \
 338    JMP_(stg_gen_yield);                         \
 339   }
 340
 341 #define BLOCK(liveness,reentry)                 \
 342   {                                             \
 343    R9.w  = (W_)LIVENESS_MASK(liveness);         \
 344    R10.w = (W_)reentry;                         \
 345    JMP_(stg_gen_block);                         \
 346   }
 347
 348 #define BLOCK_NP(ptrs)                          \
 349   {                                             \
 350     EF_(stg_block_##ptrs);                      \
 351     JMP_(stg_block_##ptrs);                     \
 352   }
 353
 354 #if defined(PAR)
 355 /*
 356   Similar to BLOCK_NP but separates the saving of the thread state from the
 357   actual jump via an StgReturn
 358 */
 359
 360 #define SAVE_THREAD_STATE(ptrs)                  \
 361   ASSERT(ptrs==1);                               \
 362   Sp -= 1;                                       \
 363   Sp[0] = R1.w;                                  \
 364   SaveThreadState();
 365
 366 #define THREAD_RETURN(ptrs)                      \
 367   ASSERT(ptrs==1);                               \
 368   CurrentTSO->whatNext = ThreadEnterGHC;         \
 369   R1.i = ThreadBlocked;                          \
 370   JMP_(StgReturn);
 371 #endif
 372
 373 /* -----------------------------------------------------------------------------
 374    CCall_GC needs to push a dummy stack frame containing the contents
 375    of volatile registers and variables.
 376
 377    We use a RET_DYN frame the same as for a dynamic heap check.
 378    ------------------------------------------------------------------------- */
 379
 380 #if COMPILING_RTS
 381 EI_(stg_gen_chk_info);
 382 #else
 383 EDI_(stg_gen_chk_info);
 384 #endif
 385 /* -----------------------------------------------------------------------------
 386    Vectored Returns
 387
 388    RETVEC(p,t) where 'p' is a pointer to the info table for a
 389    vectored return address, returns the address of the return code for
 390    tag 't'.
 391
 392    Return vectors are placed in *reverse order* immediately before the info
 393    table for the return address.  Hence the formula for computing the
 394    actual return address is (addr - sizeof(InfoTable) - tag - 1).
 395    The extra subtraction of one word is because tags start at zero.
 396    -------------------------------------------------------------------------- */
 397
 398 #ifdef TABLES_NEXT_TO_CODE
 399 #define RET_VEC(p,t) (*((P_)(p) - sizeofW(StgInfoTable) - t - 1))
 400 #else
 401 #define RET_VEC(p,t) (((StgInfoTable *)p)->vector[t])
 402 #endif
 403
 404 /* -----------------------------------------------------------------------------
 405    Misc
 406    -------------------------------------------------------------------------- */
 407
 408
 409 /* set the tag register (if we have one) */
 410 #define SET_TAG(t)  /* nothing */
 411
 412 #ifdef EAGER_BLACKHOLING
 413 #  ifdef SMP
 414 #    define UPD_BH_UPDATABLE(info)                              \
 415         TICK_UPD_BH_UPDATABLE();                                \
 416         {                                                       \
 417           bdescr *bd = Bdescr(R1.p);                            \
 418           if (bd->back != (bdescr *)BaseReg) {                  \
 419              if (bd->gen->no >= 1 || bd->step->no >= 1) {       \
 420                  LOCK_THUNK(info);                              \
 421              } else {                                           \
 422                  EXTFUN_RTS(stg_gc_enter_1_hponly);             \
 423                  JMP_(stg_gc_enter_1_hponly);                   \
 424              }                                                  \
 425           }                                                     \
 426         }                                                       \
 427         SET_INFO(R1.cl,&BLACKHOLE_info)
 428 #    define UPD_BH_SINGLE_ENTRY(info)                           \
 429         TICK_UPD_BH_SINGLE_ENTRY();                             \
 430         {                                                       \
 431           bdescr *bd = Bdescr(R1.p);                            \
 432           if (bd->back != (bdescr *)BaseReg) {                  \
 433              if (bd->gen->no >= 1 || bd->step->no >= 1) {       \
 434                  LOCK_THUNK(info);                              \
 435              } else {                                           \
 436                  EXTFUN_RTS(stg_gc_enter_1_hponly);             \
 437                  JMP_(stg_gc_enter_1_hponly);                   \
 438              }                                                  \
 439           }                                                     \
 440         }                                                       \
 441         SET_INFO(R1.cl,&BLACKHOLE_info)
 442 #  else
 443 #    define UPD_BH_UPDATABLE(info)              \
 444         TICK_UPD_BH_UPDATABLE();                \
 445         SET_INFO(R1.cl,&BLACKHOLE_info)
 446 #    define UPD_BH_SINGLE_ENTRY(info)           \
 447         TICK_UPD_BH_SINGLE_ENTRY();             \
 448         SET_INFO(R1.cl,&SE_BLACKHOLE_info)
 449 #  endif
 450 #else /* !EAGER_BLACKHOLING */
 451 #  define UPD_BH_UPDATABLE(thunk)    /* nothing */
 452 #  define UPD_BH_SINGLE_ENTRY(thunk) /* nothing */
 453 #endif /* EAGER_BLACKHOLING */
 454
 455 #define UPD_FRAME_UPDATEE(p)  (((StgUpdateFrame *)(p))->updatee)
 456 #define UPDATE_SU_FROM_UPD_FRAME(p) (Su=((StgUpdateFrame *)(p))->link)
 457
 458 /* -----------------------------------------------------------------------------
 459    Moving Floats and Doubles
 460
 461    ASSIGN_FLT is for assigning a float to memory (usually the
 462               stack/heap).  The memory address is guaranteed to be
 463               StgWord aligned (currently == sizeof(long)).
 464
 465    PK_FLT     is for pulling a float out of memory.  The memory is
 466               guaranteed to be StgWord aligned.
 467    -------------------------------------------------------------------------- */
 468
 469 static inline void        ASSIGN_FLT (W_ [], StgFloat);
 470 static inline StgFloat    PK_FLT     (W_ []);
 471
 472 #if ALIGNMENT_FLOAT <= ALIGNMENT_LONG
 473
 474 static inline void     ASSIGN_FLT(W_ p_dest[], StgFloat src) { *(StgFloat *)p_dest = src; }
 475 static inline StgFloat PK_FLT    (W_ p_src[])                { return *(StgFloat *)p_src; }
 476
 477 #else  /* ALIGNMENT_FLOAT > ALIGNMENT_UNSIGNED_INT */
 478
 479 static inline void ASSIGN_FLT(W_ p_dest[], StgFloat src)
 480 {
 481     float_thing y;
 482     y.f = src;
 483     *p_dest = y.fu;
 484 }
 485
 486 static inline StgFloat PK_FLT(W_ p_src[])
 487 {
 488     float_thing y;
 489     y.fu = *p_src;
 490     return(y.f);
 491 }
 492
 493 #endif /* ALIGNMENT_FLOAT > ALIGNMENT_LONG */
 494
 495 #if ALIGNMENT_DOUBLE <= ALIGNMENT_LONG
 496
 497 static inline void        ASSIGN_DBL (W_ [], StgDouble);
 498 static inline StgDouble   PK_DBL     (W_ []);
 499
 500 static inline void      ASSIGN_DBL(W_ p_dest[], StgDouble src) { *(StgDouble *)p_dest = src; }
 501 static inline StgDouble PK_DBL    (W_ p_src[])                 { return *(StgDouble *)p_src; }
 502
 503 #else   /* ALIGNMENT_DOUBLE > ALIGNMENT_LONG */
 504
 505 /* Sparc uses two floating point registers to hold a double.  We can
 506  * write ASSIGN_DBL and PK_DBL by directly accessing the registers
 507  * independently - unfortunately this code isn't writable in C, we
 508  * have to use inline assembler.
 509  */
 510 #if sparc_TARGET_ARCH
 511
 512 #define ASSIGN_DBL(dst0,src) \
 513     { StgPtr dst = (StgPtr)(dst0); \
 514       __asm__("st %2,%0\n\tst %R2,%1" : "=m" (((P_)(dst))[0]), \
 515         "=m" (((P_)(dst))[1]) : "f" (src)); \
 516     }
 517
 518 #define PK_DBL(src0) \
 519     ( { StgPtr src = (StgPtr)(src0); \
 520         register double d; \
 521       __asm__("ld %1,%0\n\tld %2,%R0" : "=f" (d) : \
 522         "m" (((P_)(src))[0]), "m" (((P_)(src))[1])); d; \
 523     } )
 524
 525 #else /* ! sparc_TARGET_ARCH */
 526
 527 static inline void        ASSIGN_DBL (W_ [], StgDouble);
 528 static inline StgDouble   PK_DBL     (W_ []);
 529
 530 typedef struct
 531   { StgWord dhi;
 532     StgWord dlo;
 533   } unpacked_double;
 534
 535 typedef union
 536   { StgDouble d;
 537     unpacked_double du;
 538   } double_thing;
 539
 540 static inline void ASSIGN_DBL(W_ p_dest[], StgDouble src)
 541 {
 542     double_thing y;
 543     y.d = src;
 544     p_dest[0] = y.du.dhi;
 545     p_dest[1] = y.du.dlo;
 546 }
 547
 548 /* GCC also works with this version, but it generates
 549    the same code as the previous one, and is not ANSI
 550
 551 #define ASSIGN_DBL( p_dest, src ) \
 552         *p_dest = ((double_thing) src).du.dhi; \
 553         *(p_dest+1) = ((double_thing) src).du.dlo \
 554 */
 555
 556 static inline StgDouble PK_DBL(W_ p_src[])
 557 {
 558     double_thing y;
 559     y.du.dhi = p_src[0];
 560     y.du.dlo = p_src[1];
 561     return(y.d);
 562 }
 563
 564 #endif /* ! sparc_TARGET_ARCH */
 565
 566 #endif /* ALIGNMENT_DOUBLE > ALIGNMENT_UNSIGNED_INT */
 567
 568 #ifdef SUPPORT_LONG_LONGS
 569
 570 typedef struct
 571   { StgWord dhi;
 572     StgWord dlo;
 573   } unpacked_double_word;
 574
 575 typedef union
 576   { StgInt64 i;
 577     unpacked_double_word iu;
 578   } int64_thing;
 579
 580 typedef union
 581   { StgWord64 w;
 582     unpacked_double_word wu;
 583   } word64_thing;
 584
 585 static inline void ASSIGN_Word64(W_ p_dest[], StgWord64 src)
 586 {
 587     word64_thing y;
 588     y.w = src;
 589     p_dest[0] = y.wu.dhi;
 590     p_dest[1] = y.wu.dlo;
 591 }
 592
 593 static inline StgWord64 PK_Word64(W_ p_src[])
 594 {
 595     word64_thing y;
 596     y.wu.dhi = p_src[0];
 597     y.wu.dlo = p_src[1];
 598     return(y.w);
 599 }
 600
 601 static inline void ASSIGN_Int64(W_ p_dest[], StgInt64 src)
 602 {
 603     int64_thing y;
 604     y.i = src;
 605     p_dest[0] = y.iu.dhi;
 606     p_dest[1] = y.iu.dlo;
 607 }
 608
 609 static inline StgInt64 PK_Int64(W_ p_src[])
 610 {
 611     int64_thing y;
 612     y.iu.dhi = p_src[0];
 613     y.iu.dlo = p_src[1];
 614     return(y.i);
 615 }
 616 #endif
 617
 618 /* -----------------------------------------------------------------------------
 619    Catch frames
 620    -------------------------------------------------------------------------- */
 621
 622 extern DLL_IMPORT_DATA const StgPolyInfoTable catch_frame_info;
 623
 624 /* -----------------------------------------------------------------------------
 625    Seq frames
 626
 627    A seq frame is very like an update frame, except that it doesn't do
 628    an update...
 629    -------------------------------------------------------------------------- */
 630
 631 extern DLL_IMPORT_DATA const StgPolyInfoTable seq_frame_info;
 632
 633 #define PUSH_SEQ_FRAME(sp)                                      \
 634         {                                                       \
 635                 StgSeqFrame *__frame;                           \
 636                 TICK_SEQF_PUSHED();                             \
 637                 __frame = (StgSeqFrame *)(sp);                  \
 638                 SET_HDR_(__frame,&seq_frame_info,CCCS);         \
 639                 __frame->link = Su;                             \
 640                 Su = (StgUpdateFrame *)__frame;                 \
 641         }
 642
 643 /* -----------------------------------------------------------------------------
 644    Split markers
 645    -------------------------------------------------------------------------- */
 646
 647 #if defined(USE_SPLIT_MARKERS)
 648 #define __STG_SPLIT_MARKER(n) FN_(__stg_split_marker##n) { }
 649 #else
 650 #define __STG_SPLIT_MARKER(n) /* nothing */
 651 #endif
 652
 653 /* -----------------------------------------------------------------------------
 654    Closure and Info Macros with casting.
 655
 656    We don't want to mess around with casts in the generated C code, so
 657    we use these casting versions of the closure/info tables macros.
 658    -------------------------------------------------------------------------- */
 659
 660 #define SET_HDR_(c,info,ccs) \
 661    SET_HDR((StgClosure *)(c),(StgInfoTable *)(info),ccs)
 662
 663 /* -----------------------------------------------------------------------------
 664    Saving context for exit from the STG world, and loading up context
 665    on entry to STG code.
 666
 667    We save all the STG registers (that is, the ones that are mapped to
 668    machine registers) in their places in the TSO.
 669
 670    The stack registers go into the current stack object, and the
 671    current nursery is updated from the heap pointer.
 672
 673    These functions assume that BaseReg is loaded appropriately (if
 674    we have one).
 675    -------------------------------------------------------------------------- */
 676
 677 #if IN_STG_CODE
 678
 679 static __inline__ void
 680 SaveThreadState(void)
 681 {
 682   /* Don't need to save REG_Base, it won't have changed. */
 683
 684   CurrentTSO->sp       = Sp;
 685   CurrentTSO->su       = Su;
 686   CurrentTSO->splim    = SpLim;
 687   CloseNursery(Hp);
 688
 689 #ifdef REG_CurrentTSO
 690   SAVE_CurrentTSO = CurrentTSO;
 691 #endif
 692 #ifdef REG_CurrentNursery
 693   SAVE_CurrentNursery = CurrentNursery;
 694 #endif
 695 #if defined(PROFILING)
 696   CurrentTSO->prof.CCCS = CCCS;
 697 #endif
 698 }
 699
 700 static __inline__ void
 701 LoadThreadState (void)
 702 {
 703   Sp    = CurrentTSO->sp;
 704   Su    = CurrentTSO->su;
 705   SpLim = CurrentTSO->splim;
 706   OpenNursery(Hp,HpLim);
 707
 708 #ifdef REG_CurrentTSO
 709   CurrentTSO = SAVE_CurrentTSO;
 710 #endif
 711 #ifdef REG_CurrentNursery
 712   CurrentNursery = SAVE_CurrentNursery;
 713 #endif
 714 # if defined(PROFILING)
 715   CCCS = CurrentTSO->prof.CCCS;
 716 # endif
 717 }
 718
 719 #endif
 720
 721 /* -----------------------------------------------------------------------------
 722    Module initialisation
 723    -------------------------------------------------------------------------- */
 724
 725 extern F_ *init_stack;
 726
 727 #define PUSH_INIT_STACK(reg_function)           \
 728         *(init_stack++) = (F_)reg_function
 729
 730 #define POP_INIT_STACK()                        \
 731         *(--init_stack)
 732
 733 #define START_MOD_INIT(reg_mod_name)            \
 734         static int _module_registered = 0;      \
 735         FN_(reg_mod_name) {                     \
 736             FB_;                                \
 737             if (! _module_registered) {         \
 738                 _module_registered = 1;         \
 739                 {
 740             /* extern decls go here, followed by init code */
 741
 742 #define REGISTER_FOREIGN_EXPORT(reg_fe_binder)  \
 743         STGCALL1(getStablePtr,reg_fe_binder)
 744
 745 #define REGISTER_IMPORT(reg_mod_name)           \
 746         do { EF_(reg_mod_name);                 \
 747           PUSH_INIT_STACK(reg_mod_name) ;       \
 748         } while (0)
 749
 750 #define END_MOD_INIT()                          \
 751         }};                                     \
 752         JMP_(POP_INIT_STACK());                 \
 753         FE_ }
 754
 755 /* -----------------------------------------------------------------------------
 756    Support for _ccall_GC_ and _casm_GC.
 757    -------------------------------------------------------------------------- */
 758
 759 /*
 760  * Suspending/resuming threads for doing external C-calls (_ccall_GC).
 761  * These functions are defined in rts/Schedule.c.
 762  */
 763 StgInt        suspendThread ( StgRegTable *cap );
 764 StgRegTable * resumeThread  ( StgInt );
 765
 766 #define SUSPEND_THREAD(token)                   \
 767    SaveThreadState();                           \
 768    token = suspendThread(BaseReg);
 769
 770 #ifdef SMP
 771 #define RESUME_THREAD(token)                    \
 772    BaseReg = resumeThread(token);               \
 773    LoadThreadState();
 774 #else
 775 #define RESUME_THREAD(token)                    \
 776    (void)resumeThread(token);                   \
 777    LoadThreadState();
 778 #endif
 779
 780 #endif /* STGMACROS_H */
 781