ghc/includes/StgMacros.h

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