ghc/includes/StgMacros.h

   1 /* -----------------------------------------------------------------------------
   2  * $Id: StgMacros.h,v 1.49 2002/10/12 23:19:54 wolfgang 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 EXTINFO_RTS     extern DLL_IMPORT_RTS INFO_TBL_CONST StgInfoTable
  51 #define ED_             extern
  52 #define EDD_            extern DLLIMPORT
  53 #define ED_RO_          extern const
  54 #define ID_             static
  55 #define ID_RO_          static const
  56 #define EI_             extern INFO_TBL_CONST StgInfoTable
  57 #define EDI_            extern DLLIMPORT INFO_TBL_CONST StgInfoTable
  58 #define II_             static INFO_TBL_CONST StgInfoTable
  59 #define EC_             extern StgClosure
  60 #define EDC_            extern DLLIMPORT StgClosure
  61 #define IC_             static StgClosure
  62 #define ECP_(x)         extern const StgClosure *(x)[]
  63 #define EDCP_(x)        extern DLLIMPORT StgClosure *(x)[]
  64 #define ICP_(x)         static const StgClosure *(x)[]
  65
  66 /* -----------------------------------------------------------------------------
  67    Stack Tagging.
  68
  69    For a  block of non-pointer words on the stack, we precede the
  70    block with a small-integer tag giving the number of non-pointer
  71    words in the block.
  72    -------------------------------------------------------------------------- */
  73
  74 #define ARGTAG_MAX 16           /* probably arbitrary */
  75 #define ARG_TAG(n)  (n)
  76 #define ARG_SIZE(n) (StgWord)n
  77
  78 typedef enum {
  79     REALWORLD_TAG = 0,
  80     INT_TAG       = sizeofW(StgInt),
  81     INT64_TAG     = sizeofW(StgInt64),
  82     WORD_TAG      = sizeofW(StgWord),
  83     ADDR_TAG      = sizeofW(StgAddr),
  84     CHAR_TAG      = sizeofW(StgChar),
  85     FLOAT_TAG     = sizeofW(StgFloat),
  86     DOUBLE_TAG    = sizeofW(StgDouble),
  87     STABLE_TAG    = sizeofW(StgWord),
  88 } StackTag;
  89
  90 static inline int IS_ARG_TAG( StgWord p );
  91 static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; }
  92
  93 /* -----------------------------------------------------------------------------
  94    Argument checks.
  95
  96    If (Sp + <n_args>) > Su { JMP_(stg_update_PAP); }
  97
  98    Sp points to the topmost used word on the stack, and Su points to
  99    the most recently pushed update frame.
 100
 101    Remember that <n_args> must include any tagging of unboxed values.
 102
 103    ARGS_CHK_LOAD_NODE is for top-level functions, whose entry
 104    convention doesn't require that Node is loaded with a pointer to
 105    the closure.  Thus we must load node before calling stg_updatePAP if
 106    the argument check fails.
 107    -------------------------------------------------------------------------- */
 108
 109 #define ARGS_CHK(n)                             \
 110         if ((P_)(Sp + (n)) > (P_)Su) {          \
 111                 JMP_(stg_update_PAP);           \
 112         }
 113
 114 #define ARGS_CHK_LOAD_NODE(n,closure)           \
 115         if ((P_)(Sp + (n)) > (P_)Su) {          \
 116                 R1.p = (P_)closure;             \
 117                 JMP_(stg_update_PAP);           \
 118         }
 119
 120 /* -----------------------------------------------------------------------------
 121    Heap/Stack Checks.
 122
 123    When failing a check, we save a return address on the stack and
 124    jump to a pre-compiled code fragment that saves the live registers
 125    and returns to the scheduler.
 126
 127    The return address in most cases will be the beginning of the basic
 128    block in which the check resides, since we need to perform the check
 129    again on re-entry because someone else might have stolen the resource
 130    in the meantime.
 131    ------------------------------------------------------------------------- */
 132
 133 #define STK_CHK(headroom,ret,r,layout,tag_assts)                \
 134         if (Sp - headroom < SpLim) {                            \
 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             HpAlloc = (headroom);                               \
 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 ((Hp += hp_headroom) > HpLim || Sp - stk_headroom < SpLim) { \
 152             HpAlloc = (hp_headroom);                            \
 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             tag_assts                                           \
 180             JMP_(stg_gc_enter_##ptrs);                          \
 181         }
 182
 183 #define HP_CHK_NP(headroom,ptrs,tag_assts)                      \
 184         DO_GRAN_ALLOCATE(headroom)                              \
 185         if ((Hp += (headroom)) > HpLim) {                       \
 186             HpAlloc = (headroom);                               \
 187             tag_assts                                           \
 188             JMP_(stg_gc_enter_##ptrs);                          \
 189         }
 190
 191 #define HP_CHK_SEQ_NP(headroom,ptrs,tag_assts)                  \
 192         DO_GRAN_ALLOCATE(headroom)                              \
 193         if ((Hp += (headroom)) > HpLim) {                       \
 194             HpAlloc = (headroom);                               \
 195             tag_assts                                           \
 196             JMP_(stg_gc_seq_##ptrs);                            \
 197         }
 198
 199 #define HP_STK_CHK_NP(stk_headroom, hp_headroom, ptrs, tag_assts) \
 200         DO_GRAN_ALLOCATE(hp_headroom)                              \
 201         if ((Hp += (hp_headroom)) > HpLim || (Sp - (stk_headroom)) < SpLim) { \
 202             HpAlloc = (hp_headroom);                            \
 203             tag_assts                                           \
 204             JMP_(stg_gc_enter_##ptrs);                          \
 205         }
 206
 207
 208 /* Heap checks for branches of a primitive case / unboxed tuple return */
 209
 210 #define GEN_HP_CHK_ALT(headroom,lbl,tag_assts)                  \
 211         DO_GRAN_ALLOCATE(headroom)                              \
 212         if ((Hp += (headroom)) > HpLim) {                       \
 213             EXTFUN_RTS(lbl);                                    \
 214             HpAlloc = (headroom);                               \
 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_l1,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         HpAlloc = (headroom);                           \
 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         tag_assts                                               \
 310         R9.w = (W_)LIVENESS_MASK(liveness);                     \
 311         R10.w = (W_)reentry;                                    \
 312         JMP_(stg_gen_chk);                                      \
 313    }
 314
 315 #define MAYBE_GC(liveness,reentry)              \
 316    if (doYouWantToGC()) {                       \
 317         R9.w = (W_)LIVENESS_MASK(liveness);     \
 318         R10.w = (W_)reentry;                    \
 319         JMP_(stg_gen_hp);                       \
 320    }
 321
 322 /* -----------------------------------------------------------------------------
 323    Voluntary Yields/Blocks
 324
 325    We only have a generic version of this at the moment - if it turns
 326    out to be slowing us down we can make specialised ones.
 327    -------------------------------------------------------------------------- */
 328
 329 EXTFUN_RTS(stg_gen_yield);
 330 EXTFUN_RTS(stg_gen_block);
 331
 332 #define YIELD(liveness,reentry)                 \
 333   {                                             \
 334    R9.w  = (W_)LIVENESS_MASK(liveness);         \
 335    R10.w = (W_)reentry;                         \
 336    JMP_(stg_gen_yield);                         \
 337   }
 338
 339 #define BLOCK(liveness,reentry)                 \
 340   {                                             \
 341    R9.w  = (W_)LIVENESS_MASK(liveness);         \
 342    R10.w = (W_)reentry;                         \
 343    JMP_(stg_gen_block);                         \
 344   }
 345
 346 #define BLOCK_NP(ptrs)                          \
 347   {                                             \
 348     EXTFUN_RTS(stg_block_##ptrs);                       \
 349     JMP_(stg_block_##ptrs);                     \
 350   }
 351
 352 #if defined(PAR)
 353 /*
 354   Similar to BLOCK_NP but separates the saving of the thread state from the
 355   actual jump via an StgReturn
 356 */
 357
 358 #define SAVE_THREAD_STATE(ptrs)                  \
 359   ASSERT(ptrs==1);                               \
 360   Sp -= 1;                                       \
 361   Sp[0] = R1.w;                                  \
 362   SaveThreadState();
 363
 364 #define THREAD_RETURN(ptrs)                      \
 365   ASSERT(ptrs==1);                               \
 366   CurrentTSO->what_next = ThreadEnterGHC;        \
 367   R1.i = ThreadBlocked;                          \
 368   JMP_(StgReturn);
 369 #endif
 370
 371 /* -----------------------------------------------------------------------------
 372    CCall_GC needs to push a dummy stack frame containing the contents
 373    of volatile registers and variables.
 374
 375    We use a RET_DYN frame the same as for a dynamic heap check.
 376    ------------------------------------------------------------------------- */
 377
 378 EXTINFO_RTS(stg_gen_chk_info);
 379
 380 /* -----------------------------------------------------------------------------
 381    Vectored Returns
 382
 383    RETVEC(p,t) where 'p' is a pointer to the info table for a
 384    vectored return address, returns the address of the return code for
 385    tag 't'.
 386
 387    Return vectors are placed in *reverse order* immediately before the info
 388    table for the return address.  Hence the formula for computing the
 389    actual return address is (addr - sizeof(InfoTable) - tag - 1).
 390    The extra subtraction of one word is because tags start at zero.
 391    -------------------------------------------------------------------------- */
 392
 393 #ifdef TABLES_NEXT_TO_CODE
 394 #define RET_VEC(p,t) (*((P_)(p) - sizeofW(StgInfoTable) - t - 1))
 395 #else
 396 #define RET_VEC(p,t) (((StgInfoTable *)p)->vector[t])
 397 #endif
 398
 399 /* -----------------------------------------------------------------------------
 400    Misc
 401    -------------------------------------------------------------------------- */
 402
 403
 404 /* set the tag register (if we have one) */
 405 #define SET_TAG(t)  /* nothing */
 406
 407 #ifdef EAGER_BLACKHOLING
 408 #  ifdef SMP
 409 #    define UPD_BH_UPDATABLE(info)                              \
 410         TICK_UPD_BH_UPDATABLE();                                \
 411         {                                                       \
 412           bdescr *bd = Bdescr(R1.p);                            \
 413           if (bd->u.back != (bdescr *)BaseReg) {                \
 414              if (bd->gen_no >= 1 || bd->step->no >= 1) {        \
 415                  LOCK_THUNK(info);                              \
 416              } else {                                           \
 417                  EXTFUN_RTS(stg_gc_enter_1_hponly);             \
 418                  JMP_(stg_gc_enter_1_hponly);                   \
 419              }                                                  \
 420           }                                                     \
 421         }                                                       \
 422         SET_INFO(R1.cl,&stg_BLACKHOLE_info)
 423 #    define UPD_BH_SINGLE_ENTRY(info)                           \
 424         TICK_UPD_BH_SINGLE_ENTRY();                             \
 425         {                                                       \
 426           bdescr *bd = Bdescr(R1.p);                            \
 427           if (bd->u.back != (bdescr *)BaseReg) {                \
 428              if (bd->gen_no >= 1 || bd->step->no >= 1) {        \
 429                  LOCK_THUNK(info);                              \
 430              } else {                                           \
 431                  EXTFUN_RTS(stg_gc_enter_1_hponly);             \
 432                  JMP_(stg_gc_enter_1_hponly);                   \
 433              }                                                  \
 434           }                                                     \
 435         }                                                       \
 436         SET_INFO(R1.cl,&stg_BLACKHOLE_info)
 437 #  else
 438 #   ifndef PROFILING
 439 #    define UPD_BH_UPDATABLE(info)              \
 440         TICK_UPD_BH_UPDATABLE();                \
 441         SET_INFO(R1.cl,&stg_BLACKHOLE_info)
 442 #    define UPD_BH_SINGLE_ENTRY(info)           \
 443         TICK_UPD_BH_SINGLE_ENTRY();             \
 444         SET_INFO(R1.cl,&stg_SE_BLACKHOLE_info)
 445 #   else
 446 // An object is replaced by a blackhole, so we fill the slop with zeros.
 447 //
 448 // Todo: maybe use SET_HDR() and remove LDV_recordCreate()?
 449 //
 450 #    define UPD_BH_UPDATABLE(info)              \
 451         TICK_UPD_BH_UPDATABLE();                \
 452         LDV_recordDead_FILL_SLOP_DYNAMIC(R1.cl);               \
 453         SET_INFO(R1.cl,&stg_BLACKHOLE_info);    \
 454         LDV_recordCreate(R1.cl)
 455 #    define UPD_BH_SINGLE_ENTRY(info)           \
 456         TICK_UPD_BH_SINGLE_ENTRY();             \
 457         LDV_recordDead_FILL_SLOP_DYNAMIC(R1.cl);               \
 458         SET_INFO(R1.cl,&stg_SE_BLACKHOLE_info)  \
 459         LDV_recordCreate(R1.cl)
 460 #   endif /* PROFILING */
 461 #  endif
 462 #else /* !EAGER_BLACKHOLING */
 463 #  define UPD_BH_UPDATABLE(thunk)    /* nothing */
 464 #  define UPD_BH_SINGLE_ENTRY(thunk) /* nothing */
 465 #endif /* EAGER_BLACKHOLING */
 466
 467 #define UPD_FRAME_UPDATEE(p)  ((P_)(((StgUpdateFrame *)(p))->updatee))
 468 #define UPDATE_SU_FROM_UPD_FRAME(p) (Su=((StgUpdateFrame *)(p))->link)
 469
 470 /* -----------------------------------------------------------------------------
 471    Moving Floats and Doubles
 472
 473    ASSIGN_FLT is for assigning a float to memory (usually the
 474               stack/heap).  The memory address is guaranteed to be
 475               StgWord aligned (currently == sizeof(long)).
 476
 477    PK_FLT     is for pulling a float out of memory.  The memory is
 478               guaranteed to be StgWord aligned.
 479    -------------------------------------------------------------------------- */
 480
 481 static inline void        ASSIGN_FLT (W_ [], StgFloat);
 482 static inline StgFloat    PK_FLT     (W_ []);
 483
 484 #if ALIGNMENT_FLOAT <= ALIGNMENT_LONG
 485
 486 static inline void     ASSIGN_FLT(W_ p_dest[], StgFloat src) { *(StgFloat *)p_dest = src; }
 487 static inline StgFloat PK_FLT    (W_ p_src[])                { return *(StgFloat *)p_src; }
 488
 489 #else  /* ALIGNMENT_FLOAT > ALIGNMENT_UNSIGNED_INT */
 490
 491 static inline void ASSIGN_FLT(W_ p_dest[], StgFloat src)
 492 {
 493     float_thing y;
 494     y.f = src;
 495     *p_dest = y.fu;
 496 }
 497
 498 static inline StgFloat PK_FLT(W_ p_src[])
 499 {
 500     float_thing y;
 501     y.fu = *p_src;
 502     return(y.f);
 503 }
 504
 505 #endif /* ALIGNMENT_FLOAT > ALIGNMENT_LONG */
 506
 507 #if ALIGNMENT_DOUBLE <= ALIGNMENT_LONG
 508
 509 static inline void        ASSIGN_DBL (W_ [], StgDouble);
 510 static inline StgDouble   PK_DBL     (W_ []);
 511
 512 static inline void      ASSIGN_DBL(W_ p_dest[], StgDouble src) { *(StgDouble *)p_dest = src; }
 513 static inline StgDouble PK_DBL    (W_ p_src[])                 { return *(StgDouble *)p_src; }
 514
 515 #else   /* ALIGNMENT_DOUBLE > ALIGNMENT_LONG */
 516
 517 /* Sparc uses two floating point registers to hold a double.  We can
 518  * write ASSIGN_DBL and PK_DBL by directly accessing the registers
 519  * independently - unfortunately this code isn't writable in C, we
 520  * have to use inline assembler.
 521  */
 522 #if sparc_TARGET_ARCH
 523
 524 #define ASSIGN_DBL(dst0,src) \
 525     { StgPtr dst = (StgPtr)(dst0); \
 526       __asm__("st %2,%0\n\tst %R2,%1" : "=m" (((P_)(dst))[0]), \
 527         "=m" (((P_)(dst))[1]) : "f" (src)); \
 528     }
 529
 530 #define PK_DBL(src0) \
 531     ( { StgPtr src = (StgPtr)(src0); \
 532         register double d; \
 533       __asm__("ld %1,%0\n\tld %2,%R0" : "=f" (d) : \
 534         "m" (((P_)(src))[0]), "m" (((P_)(src))[1])); d; \
 535     } )
 536
 537 #else /* ! sparc_TARGET_ARCH */
 538
 539 static inline void        ASSIGN_DBL (W_ [], StgDouble);
 540 static inline StgDouble   PK_DBL     (W_ []);
 541
 542 typedef struct
 543   { StgWord dhi;
 544     StgWord dlo;
 545   } unpacked_double;
 546
 547 typedef union
 548   { StgDouble d;
 549     unpacked_double du;
 550   } double_thing;
 551
 552 static inline void ASSIGN_DBL(W_ p_dest[], StgDouble src)
 553 {
 554     double_thing y;
 555     y.d = src;
 556     p_dest[0] = y.du.dhi;
 557     p_dest[1] = y.du.dlo;
 558 }
 559
 560 /* GCC also works with this version, but it generates
 561    the same code as the previous one, and is not ANSI
 562
 563 #define ASSIGN_DBL( p_dest, src ) \
 564         *p_dest = ((double_thing) src).du.dhi; \
 565         *(p_dest+1) = ((double_thing) src).du.dlo \
 566 */
 567
 568 static inline StgDouble PK_DBL(W_ p_src[])
 569 {
 570     double_thing y;
 571     y.du.dhi = p_src[0];
 572     y.du.dlo = p_src[1];
 573     return(y.d);
 574 }
 575
 576 #endif /* ! sparc_TARGET_ARCH */
 577
 578 #endif /* ALIGNMENT_DOUBLE > ALIGNMENT_UNSIGNED_INT */
 579
 580 #ifdef SUPPORT_LONG_LONGS
 581
 582 typedef struct
 583   { StgWord dhi;
 584     StgWord dlo;
 585   } unpacked_double_word;
 586
 587 typedef union
 588   { StgInt64 i;
 589     unpacked_double_word iu;
 590   } int64_thing;
 591
 592 typedef union
 593   { StgWord64 w;
 594     unpacked_double_word wu;
 595   } word64_thing;
 596
 597 static inline void ASSIGN_Word64(W_ p_dest[], StgWord64 src)
 598 {
 599     word64_thing y;
 600     y.w = src;
 601     p_dest[0] = y.wu.dhi;
 602     p_dest[1] = y.wu.dlo;
 603 }
 604
 605 static inline StgWord64 PK_Word64(W_ p_src[])
 606 {
 607     word64_thing y;
 608     y.wu.dhi = p_src[0];
 609     y.wu.dlo = p_src[1];
 610     return(y.w);
 611 }
 612
 613 static inline void ASSIGN_Int64(W_ p_dest[], StgInt64 src)
 614 {
 615     int64_thing y;
 616     y.i = src;
 617     p_dest[0] = y.iu.dhi;
 618     p_dest[1] = y.iu.dlo;
 619 }
 620
 621 static inline StgInt64 PK_Int64(W_ p_src[])
 622 {
 623     int64_thing y;
 624     y.iu.dhi = p_src[0];
 625     y.iu.dlo = p_src[1];
 626     return(y.i);
 627 }
 628
 629 #elif SIZEOF_VOID_P == 8
 630
 631 static inline void ASSIGN_Word64(W_ p_dest[], StgWord64 src)
 632 {
 633         p_dest[0] = src;
 634 }
 635
 636 static inline StgWord64 PK_Word64(W_ p_src[])
 637 {
 638     return p_src[0];
 639 }
 640
 641 static inline void ASSIGN_Int64(W_ p_dest[], StgInt64 src)
 642 {
 643     p_dest[0] = src;
 644 }
 645
 646 static inline StgInt64 PK_Int64(W_ p_src[])
 647 {
 648     return p_src[0];
 649 }
 650
 651 #endif
 652
 653 /* -----------------------------------------------------------------------------
 654    Catch frames
 655    -------------------------------------------------------------------------- */
 656
 657 extern DLL_IMPORT_RTS const StgPolyInfoTable stg_catch_frame_info;
 658
 659 /* -----------------------------------------------------------------------------
 660    Seq frames
 661
 662    A seq frame is very like an update frame, except that it doesn't do
 663    an update...
 664    -------------------------------------------------------------------------- */
 665
 666 extern DLL_IMPORT_RTS const StgPolyInfoTable stg_seq_frame_info;
 667
 668 #define PUSH_SEQ_FRAME(sp)                                      \
 669         {                                                       \
 670                 StgSeqFrame *__frame;                           \
 671                 TICK_SEQF_PUSHED();                             \
 672                 __frame = (StgSeqFrame *)(sp);                  \
 673                 SET_HDR((StgClosure *)__frame,(StgInfoTable *)&stg_seq_frame_info,CCCS);\
 674                 __frame->link = Su;                             \
 675                 Su = (StgUpdateFrame *)__frame;                 \
 676         }
 677
 678 /* -----------------------------------------------------------------------------
 679    Split markers
 680    -------------------------------------------------------------------------- */
 681
 682 #if defined(USE_SPLIT_MARKERS)
 683 #if defined(LEADING_UNDERSCORE)
 684 #define __STG_SPLIT_MARKER __asm__("\n___stg_split_marker:");
 685 #else
 686 #define __STG_SPLIT_MARKER __asm__("\n__stg_split_marker:");
 687 #endif
 688 #else
 689 #define __STG_SPLIT_MARKER /* nothing */
 690 #endif
 691
 692 /* -----------------------------------------------------------------------------
 693    Closure and Info Macros with casting.
 694
 695    We don't want to mess around with casts in the generated C code, so
 696    we use this casting versions of the closure macro.
 697
 698    This version of SET_HDR also includes CCS_ALLOC for profiling - the
 699    reason we don't use two separate macros is that the cost centre
 700    field is sometimes a non-simple expression and we want to share its
 701    value between SET_HDR and CCS_ALLOC.
 702    -------------------------------------------------------------------------- */
 703
 704 #define SET_HDR_(c,info,ccs,size)                               \
 705   {                                                             \
 706       CostCentreStack *tmp = (ccs);                             \
 707       SET_HDR((StgClosure *)(c),(StgInfoTable *)(info),tmp);    \
 708       CCS_ALLOC(tmp,size);                                      \
 709   }
 710
 711 /* -----------------------------------------------------------------------------
 712    Saving context for exit from the STG world, and loading up context
 713    on entry to STG code.
 714
 715    We save all the STG registers (that is, the ones that are mapped to
 716    machine registers) in their places in the TSO.
 717
 718    The stack registers go into the current stack object, and the
 719    current nursery is updated from the heap pointer.
 720
 721    These functions assume that BaseReg is loaded appropriately (if
 722    we have one).
 723    -------------------------------------------------------------------------- */
 724
 725 #if IN_STG_CODE
 726
 727 static __inline__ void
 728 SaveThreadState(void)
 729 {
 730   StgTSO *tso;
 731
 732   /* Don't need to save REG_Base, it won't have changed. */
 733
 734   tso = CurrentTSO;
 735   tso->sp       = Sp;
 736   tso->su       = Su;
 737   CloseNursery(Hp);
 738
 739 #ifdef REG_CurrentTSO
 740   SAVE_CurrentTSO = tso;
 741 #endif
 742 #ifdef REG_CurrentNursery
 743   SAVE_CurrentNursery = CurrentNursery;
 744 #endif
 745 #if defined(PROFILING)
 746   CurrentTSO->prof.CCCS = CCCS;
 747 #endif
 748 }
 749
 750 static __inline__ void
 751 LoadThreadState (void)
 752 {
 753   StgTSO *tso;
 754
 755 #ifdef REG_CurrentTSO
 756   CurrentTSO = SAVE_CurrentTSO;
 757 #endif
 758
 759   tso = CurrentTSO;
 760   Sp    = tso->sp;
 761   Su    = tso->su;
 762   SpLim = (P_)&(tso->stack) + RESERVED_STACK_WORDS;
 763   OpenNursery(Hp,HpLim);
 764
 765 #ifdef REG_CurrentNursery
 766   CurrentNursery = SAVE_CurrentNursery;
 767 #endif
 768 # if defined(PROFILING)
 769   CCCS = CurrentTSO->prof.CCCS;
 770 # endif
 771 }
 772
 773 #endif
 774
 775 /* -----------------------------------------------------------------------------
 776    Module initialisation
 777
 778    The module initialisation code looks like this, roughly:
 779
 780         FN(__stginit_Foo) {
 781           JMP_(__stginit_Foo_1_p)
 782         }
 783
 784         FN(__stginit_Foo_1_p) {
 785         ...
 786         }
 787
 788    We have one version of the init code with a module version and the
 789    'way' attached to it.  The version number helps to catch cases
 790    where modules are not compiled in dependency order before being
 791    linked: if a module has been compiled since any modules which depend on
 792    it, then the latter modules will refer to a different version in their
 793    init blocks and a link error will ensue.
 794
 795    The 'way' suffix helps to catch cases where modules compiled in different
 796    ways are linked together (eg. profiled and non-profiled).
 797
 798    We provide a plain, unadorned, version of the module init code
 799    which just jumps to the version with the label and way attached.  The
 800    reason for this is that when using foreign exports, the caller of
 801    startupHaskell() must supply the name of the init function for the "top"
 802    module in the program, and we don't want to require that this name
 803    has the version and way info appended to it.
 804    -------------------------------------------------------------------------- */
 805
 806 #define PUSH_INIT_STACK(reg_function)           \
 807         *(Sp++) = (W_)reg_function
 808
 809 #define POP_INIT_STACK()                        \
 810         *(--Sp)
 811
 812 #define MOD_INIT_WRAPPER(label,real_init)       \
 813
 814
 815 #define START_MOD_INIT(plain_lbl, real_lbl)     \
 816         static int _module_registered = 0;      \
 817         EF_(real_lbl);                          \
 818         FN_(plain_lbl) {                        \
 819             FB_                                 \
 820             JMP_(real_lbl);                     \
 821             FE_                                 \
 822         }                                       \
 823         FN_(real_lbl) {                 \
 824             FB_;                                \
 825             if (! _module_registered) {         \
 826                 _module_registered = 1;         \
 827                 {
 828             /* extern decls go here, followed by init code */
 829
 830 #define REGISTER_FOREIGN_EXPORT(reg_fe_binder)  \
 831         STGCALL1(getStablePtr,reg_fe_binder)
 832
 833 #define REGISTER_IMPORT(reg_mod_name)           \
 834         PUSH_INIT_STACK(reg_mod_name)
 835
 836 #define END_MOD_INIT()                          \
 837         }};                                     \
 838         JMP_(POP_INIT_STACK());                 \
 839         FE_ }
 840
 841 /* -----------------------------------------------------------------------------
 842    Support for _ccall_GC_ and _casm_GC.
 843    -------------------------------------------------------------------------- */
 844
 845 /*
 846  * Suspending/resuming threads for doing external C-calls (_ccall_GC).
 847  * These functions are defined in rts/Schedule.c.
 848  */
 849 StgInt        suspendThread ( StgRegTable *, rtsBool);
 850 StgRegTable * resumeThread  ( StgInt, rtsBool );
 851
 852 #define SUSPEND_THREAD(token,threaded)          \
 853    SaveThreadState();                           \
 854    token = suspendThread(BaseReg,threaded);
 855
 856 #ifdef SMP
 857 #define RESUME_THREAD(token,threaded)           \
 858     BaseReg = resumeThread(token,threaded);     \
 859     LoadThreadState();
 860 #else
 861 #define RESUME_THREAD(token,threaded)           \
 862    (void)resumeThread(token,threaded);          \
 863    LoadThreadState();
 864 #endif
 865
 866 #endif /* STGMACROS_H */
 867