ghc/includes/StgMacros.h

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