ghc/includes/StgMacros.h

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