ghc/includes/StgMacros.h

   1 /* -----------------------------------------------------------------------------
   2  * $Id: StgMacros.h,v 1.51 2003/04/22 16:25:08 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         |-- GET_PTRS(liveness) words
 234           some nonpointers      |-- GET_NONPTRS(liveness) words
 235
 236           L1                    \
 237           D1-2                  |-- RET_DYN_NONPTR_REGS_SIZE words
 238           F1-4                  /
 239
 240           R1-8                  |-- RET_DYN_BITMAP_SIZE words
 241
 242           return address        \
 243           liveness mask         |-- StgRetDyn structure
 244           stg_gen_chk_info      /
 245
 246    we assume that the size of a double is always 2 pointers (wasting a
 247    word when it is only one pointer, but avoiding lots of #ifdefs).
 248
 249    -------------------------------------------------------------------------- */
 250
 251 // VERY MAGIC CONSTANTS!
 252 // must agree with code in HeapStackCheck.c, stg_gen_chk
 253 //
 254 #define RET_DYN_BITMAP_SIZE 8
 255 #define RET_DYN_NONPTR_REGS_SIZE 10
 256 #define ALL_NON_PTRS 0xff
 257
 258 #define LIVENESS_MASK(ptr_regs)  (ALL_NON_PTRS ^ (ptr_regs))
 259
 260 // We can have up to 255 pointers and 255 nonpointers in the stack
 261 // frame.
 262 #define N_NONPTRS(n)  ((n)<<16)
 263 #define N_PTRS(n)     ((n)<<24)
 264
 265 #define GET_NONPTRS(l) ((l)>>16 & 0xff)
 266 #define GET_PTRS(l)    ((l)>>24 & 0xff)
 267 #define GET_LIVENESS(l) ((l) & 0xffff)
 268
 269 #define NO_PTRS   0
 270 #define R1_PTR    1<<0
 271 #define R2_PTR    1<<1
 272 #define R3_PTR    1<<2
 273 #define R4_PTR    1<<3
 274 #define R5_PTR    1<<4
 275 #define R6_PTR    1<<5
 276 #define R7_PTR    1<<6
 277 #define R8_PTR    1<<7
 278
 279 #define HP_CHK_UNBX_TUPLE(headroom,liveness,code)       \
 280    if ((Hp += (headroom)) > HpLim ) {                   \
 281         HpAlloc = (headroom);                           \
 282         code                                            \
 283         R9.w = (W_)LIVENESS_MASK(liveness);             \
 284         JMP_(stg_gc_ut);                                \
 285     }
 286
 287 #define HP_CHK_GEN(headroom,liveness,reentry)                   \
 288    if ((Hp += (headroom)) > HpLim ) {                           \
 289         HpAlloc = (headroom);                                   \
 290         R9.w = (W_)LIVENESS_MASK(liveness);                     \
 291         R10.w = (W_)reentry;                                    \
 292         JMP_(stg_gc_gen);                                       \
 293     }
 294
 295 #define HP_CHK_GEN_TICKY(headroom,liveness,reentry)     \
 296    HP_CHK_GEN(headroom,liveness,reentry);               \
 297    TICK_ALLOC_HEAP_NOCTR(headroom)
 298
 299 #define STK_CHK_GEN(headroom,liveness,reentry)  \
 300    if ((Sp - (headroom)) < SpLim) {                             \
 301         R9.w = (W_)LIVENESS_MASK(liveness);                     \
 302         R10.w = (W_)reentry;                                    \
 303         JMP_(stg_gc_gen);                                       \
 304    }
 305
 306 #define MAYBE_GC(liveness,reentry)              \
 307    if (doYouWantToGC()) {                       \
 308         R9.w = (W_)LIVENESS_MASK(liveness);     \
 309         R10.w = (W_)reentry;                    \
 310         JMP_(stg_gc_gen_hp);                    \
 311    }
 312
 313 /* -----------------------------------------------------------------------------
 314    Voluntary Yields/Blocks
 315
 316    We only have a generic version of this at the moment - if it turns
 317    out to be slowing us down we can make specialised ones.
 318    -------------------------------------------------------------------------- */
 319
 320 EXTFUN_RTS(stg_gen_yield);
 321 EXTFUN_RTS(stg_gen_block);
 322
 323 #define YIELD(liveness,reentry)                 \
 324   {                                             \
 325    R9.w  = (W_)LIVENESS_MASK(liveness);         \
 326    R10.w = (W_)reentry;                         \
 327    JMP_(stg_gen_yield);                         \
 328   }
 329
 330 #define BLOCK(liveness,reentry)                 \
 331   {                                             \
 332    R9.w  = (W_)LIVENESS_MASK(liveness);         \
 333    R10.w = (W_)reentry;                         \
 334    JMP_(stg_gen_block);                         \
 335   }
 336
 337 #define BLOCK_NP(ptrs)                          \
 338   {                                             \
 339     EXTFUN_RTS(stg_block_##ptrs);                       \
 340     JMP_(stg_block_##ptrs);                     \
 341   }
 342
 343 #if defined(PAR)
 344 /*
 345   Similar to BLOCK_NP but separates the saving of the thread state from the
 346   actual jump via an StgReturn
 347 */
 348
 349 #define SAVE_THREAD_STATE(ptrs)                  \
 350   ASSERT(ptrs==1);                               \
 351   Sp -= 1;                                       \
 352   Sp[0] = R1.w;                                  \
 353   SaveThreadState();
 354
 355 #define THREAD_RETURN(ptrs)                      \
 356   ASSERT(ptrs==1);                               \
 357   CurrentTSO->what_next = ThreadEnterGHC;        \
 358   R1.i = ThreadBlocked;                          \
 359   JMP_(StgReturn);
 360 #endif
 361
 362 /* -----------------------------------------------------------------------------
 363    CCall_GC needs to push a dummy stack frame containing the contents
 364    of volatile registers and variables.
 365
 366    We use a RET_DYN frame the same as for a dynamic heap check.
 367    ------------------------------------------------------------------------- */
 368
 369 /* -----------------------------------------------------------------------------
 370    Vectored Returns
 371
 372    RETVEC(p,t) where 'p' is a pointer to the info table for a
 373    vectored return address, returns the address of the return code for
 374    tag 't'.
 375
 376    Return vectors are placed in *reverse order* immediately before the info
 377    table for the return address.  Hence the formula for computing the
 378    actual return address is (addr - sizeof(RetInfoTable) - tag - 1).
 379    The extra subtraction of one word is because tags start at zero.
 380    -------------------------------------------------------------------------- */
 381
 382 #ifdef TABLES_NEXT_TO_CODE
 383 #define RET_VEC(p,t) (*((P_)(p) - sizeofW(StgRetInfoTable) - t - 1))
 384 #else
 385 #define RET_VEC(p,t) (((StgRetInfoTable *)p)->vector[t])
 386 #endif
 387
 388 /* -----------------------------------------------------------------------------
 389    Misc
 390    -------------------------------------------------------------------------- */
 391
 392
 393 /* set the tag register (if we have one) */
 394 #define SET_TAG(t)  /* nothing */
 395
 396 #ifdef EAGER_BLACKHOLING
 397 #  ifdef SMP
 398 #    define UPD_BH_UPDATABLE(info)                              \
 399         TICK_UPD_BH_UPDATABLE();                                \
 400         {                                                       \
 401           bdescr *bd = Bdescr(R1.p);                            \
 402           if (bd->u.back != (bdescr *)BaseReg) {                \
 403              if (bd->gen_no >= 1 || bd->step->no >= 1) {        \
 404                  LOCK_THUNK(info);                              \
 405              } else {                                           \
 406                  EXTFUN_RTS(stg_gc_enter_1_hponly);             \
 407                  JMP_(stg_gc_enter_1_hponly);                   \
 408              }                                                  \
 409           }                                                     \
 410         }                                                       \
 411         SET_INFO(R1.cl,&stg_BLACKHOLE_info)
 412 #    define UPD_BH_SINGLE_ENTRY(info)                           \
 413         TICK_UPD_BH_SINGLE_ENTRY();                             \
 414         {                                                       \
 415           bdescr *bd = Bdescr(R1.p);                            \
 416           if (bd->u.back != (bdescr *)BaseReg) {                \
 417              if (bd->gen_no >= 1 || bd->step->no >= 1) {        \
 418                  LOCK_THUNK(info);                              \
 419              } else {                                           \
 420                  EXTFUN_RTS(stg_gc_enter_1_hponly);             \
 421                  JMP_(stg_gc_enter_1_hponly);                   \
 422              }                                                  \
 423           }                                                     \
 424         }                                                       \
 425         SET_INFO(R1.cl,&stg_BLACKHOLE_info)
 426 #  else
 427 #   ifndef PROFILING
 428 #    define UPD_BH_UPDATABLE(info)              \
 429         TICK_UPD_BH_UPDATABLE();                \
 430         SET_INFO(R1.cl,&stg_BLACKHOLE_info)
 431 #    define UPD_BH_SINGLE_ENTRY(info)           \
 432         TICK_UPD_BH_SINGLE_ENTRY();             \
 433         SET_INFO(R1.cl,&stg_SE_BLACKHOLE_info)
 434 #   else
 435 // An object is replaced by a blackhole, so we fill the slop with zeros.
 436 //
 437 // Todo: maybe use SET_HDR() and remove LDV_recordCreate()?
 438 //
 439 #    define UPD_BH_UPDATABLE(info)              \
 440         TICK_UPD_BH_UPDATABLE();                \
 441         LDV_recordDead_FILL_SLOP_DYNAMIC(R1.cl);               \
 442         SET_INFO(R1.cl,&stg_BLACKHOLE_info);    \
 443         LDV_recordCreate(R1.cl)
 444 #    define UPD_BH_SINGLE_ENTRY(info)           \
 445         TICK_UPD_BH_SINGLE_ENTRY();             \
 446         LDV_recordDead_FILL_SLOP_DYNAMIC(R1.cl);               \
 447         SET_INFO(R1.cl,&stg_SE_BLACKHOLE_info)  \
 448         LDV_recordCreate(R1.cl)
 449 #   endif /* PROFILING */
 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
 458 /* -----------------------------------------------------------------------------
 459    Moving Floats and Doubles
 460
 461    ASSIGN_FLT is for assigning a float to memory (usually the
 462               stack/heap).  The memory address is guaranteed to be
 463               StgWord aligned (currently == sizeof(void *)).
 464
 465    PK_FLT     is for pulling a float out of memory.  The memory is
 466               guaranteed to be StgWord aligned.
 467    -------------------------------------------------------------------------- */
 468
 469 static inline void        ASSIGN_FLT (W_ [], StgFloat);
 470 static inline StgFloat    PK_FLT     (W_ []);
 471
 472 #if ALIGNMENT_FLOAT <= ALIGNMENT_LONG
 473
 474 static inline void     ASSIGN_FLT(W_ p_dest[], StgFloat src) { *(StgFloat *)p_dest = src; }
 475 static inline StgFloat PK_FLT    (W_ p_src[])                { return *(StgFloat *)p_src; }
 476
 477 #else  /* ALIGNMENT_FLOAT > ALIGNMENT_UNSIGNED_INT */
 478
 479 static inline void ASSIGN_FLT(W_ p_dest[], StgFloat src)
 480 {
 481     float_thing y;
 482     y.f = src;
 483     *p_dest = y.fu;
 484 }
 485
 486 static inline StgFloat PK_FLT(W_ p_src[])
 487 {
 488     float_thing y;
 489     y.fu = *p_src;
 490     return(y.f);
 491 }
 492
 493 #endif /* ALIGNMENT_FLOAT > ALIGNMENT_LONG */
 494
 495 #if ALIGNMENT_DOUBLE <= ALIGNMENT_LONG
 496
 497 static inline void        ASSIGN_DBL (W_ [], StgDouble);
 498 static inline StgDouble   PK_DBL     (W_ []);
 499
 500 static inline void      ASSIGN_DBL(W_ p_dest[], StgDouble src) { *(StgDouble *)p_dest = src; }
 501 static inline StgDouble PK_DBL    (W_ p_src[])                 { return *(StgDouble *)p_src; }
 502
 503 #else   /* ALIGNMENT_DOUBLE > ALIGNMENT_LONG */
 504
 505 /* Sparc uses two floating point registers to hold a double.  We can
 506  * write ASSIGN_DBL and PK_DBL by directly accessing the registers
 507  * independently - unfortunately this code isn't writable in C, we
 508  * have to use inline assembler.
 509  */
 510 #if sparc_TARGET_ARCH
 511
 512 #define ASSIGN_DBL(dst0,src) \
 513     { StgPtr dst = (StgPtr)(dst0); \
 514       __asm__("st %2,%0\n\tst %R2,%1" : "=m" (((P_)(dst))[0]), \
 515         "=m" (((P_)(dst))[1]) : "f" (src)); \
 516     }
 517
 518 #define PK_DBL(src0) \
 519     ( { StgPtr src = (StgPtr)(src0); \
 520         register double d; \
 521       __asm__("ld %1,%0\n\tld %2,%R0" : "=f" (d) : \
 522         "m" (((P_)(src))[0]), "m" (((P_)(src))[1])); d; \
 523     } )
 524
 525 #else /* ! sparc_TARGET_ARCH */
 526
 527 static inline void        ASSIGN_DBL (W_ [], StgDouble);
 528 static inline StgDouble   PK_DBL     (W_ []);
 529
 530 typedef struct
 531   { StgWord dhi;
 532     StgWord dlo;
 533   } unpacked_double;
 534
 535 typedef union
 536   { StgDouble d;
 537     unpacked_double du;
 538   } double_thing;
 539
 540 static inline void ASSIGN_DBL(W_ p_dest[], StgDouble src)
 541 {
 542     double_thing y;
 543     y.d = src;
 544     p_dest[0] = y.du.dhi;
 545     p_dest[1] = y.du.dlo;
 546 }
 547
 548 /* GCC also works with this version, but it generates
 549    the same code as the previous one, and is not ANSI
 550
 551 #define ASSIGN_DBL( p_dest, src ) \
 552         *p_dest = ((double_thing) src).du.dhi; \
 553         *(p_dest+1) = ((double_thing) src).du.dlo \
 554 */
 555
 556 static inline StgDouble PK_DBL(W_ p_src[])
 557 {
 558     double_thing y;
 559     y.du.dhi = p_src[0];
 560     y.du.dlo = p_src[1];
 561     return(y.d);
 562 }
 563
 564 #endif /* ! sparc_TARGET_ARCH */
 565
 566 #endif /* ALIGNMENT_DOUBLE > ALIGNMENT_UNSIGNED_INT */
 567
 568 #ifdef SUPPORT_LONG_LONGS
 569
 570 typedef struct
 571   { StgWord dhi;
 572     StgWord dlo;
 573   } unpacked_double_word;
 574
 575 typedef union
 576   { StgInt64 i;
 577     unpacked_double_word iu;
 578   } int64_thing;
 579
 580 typedef union
 581   { StgWord64 w;
 582     unpacked_double_word wu;
 583   } word64_thing;
 584
 585 static inline void ASSIGN_Word64(W_ p_dest[], StgWord64 src)
 586 {
 587     word64_thing y;
 588     y.w = src;
 589     p_dest[0] = y.wu.dhi;
 590     p_dest[1] = y.wu.dlo;
 591 }
 592
 593 static inline StgWord64 PK_Word64(W_ p_src[])
 594 {
 595     word64_thing y;
 596     y.wu.dhi = p_src[0];
 597     y.wu.dlo = p_src[1];
 598     return(y.w);
 599 }
 600
 601 static inline void ASSIGN_Int64(W_ p_dest[], StgInt64 src)
 602 {
 603     int64_thing y;
 604     y.i = src;
 605     p_dest[0] = y.iu.dhi;
 606     p_dest[1] = y.iu.dlo;
 607 }
 608
 609 static inline StgInt64 PK_Int64(W_ p_src[])
 610 {
 611     int64_thing y;
 612     y.iu.dhi = p_src[0];
 613     y.iu.dlo = p_src[1];
 614     return(y.i);
 615 }
 616
 617 #elif SIZEOF_VOID_P == 8
 618
 619 static inline void ASSIGN_Word64(W_ p_dest[], StgWord64 src)
 620 {
 621         p_dest[0] = src;
 622 }
 623
 624 static inline StgWord64 PK_Word64(W_ p_src[])
 625 {
 626     return p_src[0];
 627 }
 628
 629 static inline void ASSIGN_Int64(W_ p_dest[], StgInt64 src)
 630 {
 631     p_dest[0] = src;
 632 }
 633
 634 static inline StgInt64 PK_Int64(W_ p_src[])
 635 {
 636     return p_src[0];
 637 }
 638
 639 #endif
 640
 641 /* -----------------------------------------------------------------------------
 642    Catch frames
 643    -------------------------------------------------------------------------- */
 644
 645 extern DLL_IMPORT_RTS const StgPolyInfoTable stg_catch_frame_info;
 646
 647 /* -----------------------------------------------------------------------------
 648    Split markers
 649    -------------------------------------------------------------------------- */
 650
 651 #if defined(USE_SPLIT_MARKERS)
 652 #if defined(LEADING_UNDERSCORE)
 653 #define __STG_SPLIT_MARKER __asm__("\n___stg_split_marker:");
 654 #else
 655 #define __STG_SPLIT_MARKER __asm__("\n__stg_split_marker:");
 656 #endif
 657 #else
 658 #define __STG_SPLIT_MARKER /* nothing */
 659 #endif
 660
 661 /* -----------------------------------------------------------------------------
 662    Closure and Info Macros with casting.
 663
 664    We don't want to mess around with casts in the generated C code, so
 665    we use this casting versions of the closure macro.
 666
 667    This version of SET_HDR also includes CCS_ALLOC for profiling - the
 668    reason we don't use two separate macros is that the cost centre
 669    field is sometimes a non-simple expression and we want to share its
 670    value between SET_HDR and CCS_ALLOC.
 671    -------------------------------------------------------------------------- */
 672
 673 #define SET_HDR_(c,info,ccs,size)                               \
 674   {                                                             \
 675       CostCentreStack *tmp = (ccs);                             \
 676       SET_HDR((StgClosure *)(c),(StgInfoTable *)(info),tmp);    \
 677       CCS_ALLOC(tmp,size);                                      \
 678   }
 679
 680 /* -----------------------------------------------------------------------------
 681    Saving context for exit from the STG world, and loading up context
 682    on entry to STG code.
 683
 684    We save all the STG registers (that is, the ones that are mapped to
 685    machine registers) in their places in the TSO.
 686
 687    The stack registers go into the current stack object, and the
 688    current nursery is updated from the heap pointer.
 689
 690    These functions assume that BaseReg is loaded appropriately (if
 691    we have one).
 692    -------------------------------------------------------------------------- */
 693
 694 #if IN_STG_CODE
 695
 696 static __inline__ void
 697 SaveThreadState(void)
 698 {
 699   StgTSO *tso;
 700
 701   /* Don't need to save REG_Base, it won't have changed. */
 702
 703   tso = CurrentTSO;
 704   tso->sp       = Sp;
 705   CloseNursery(Hp);
 706
 707 #ifdef REG_CurrentTSO
 708   SAVE_CurrentTSO = tso;
 709 #endif
 710 #ifdef REG_CurrentNursery
 711   SAVE_CurrentNursery = CurrentNursery;
 712 #endif
 713 #if defined(PROFILING)
 714   CurrentTSO->prof.CCCS = CCCS;
 715 #endif
 716 }
 717
 718 static __inline__ void
 719 LoadThreadState (void)
 720 {
 721   StgTSO *tso;
 722
 723 #ifdef REG_CurrentTSO
 724   CurrentTSO = SAVE_CurrentTSO;
 725 #endif
 726
 727   tso = CurrentTSO;
 728   Sp    = tso->sp;
 729   SpLim = (P_)&(tso->stack) + RESERVED_STACK_WORDS;
 730   OpenNursery(Hp,HpLim);
 731
 732 #ifdef REG_CurrentNursery
 733   CurrentNursery = SAVE_CurrentNursery;
 734 #endif
 735 # if defined(PROFILING)
 736   CCCS = CurrentTSO->prof.CCCS;
 737 # endif
 738 }
 739
 740 #endif
 741
 742 /* -----------------------------------------------------------------------------
 743    Module initialisation
 744
 745    The module initialisation code looks like this, roughly:
 746
 747         FN(__stginit_Foo) {
 748           JMP_(__stginit_Foo_1_p)
 749         }
 750
 751         FN(__stginit_Foo_1_p) {
 752         ...
 753         }
 754
 755    We have one version of the init code with a module version and the
 756    'way' attached to it.  The version number helps to catch cases
 757    where modules are not compiled in dependency order before being
 758    linked: if a module has been compiled since any modules which depend on
 759    it, then the latter modules will refer to a different version in their
 760    init blocks and a link error will ensue.
 761
 762    The 'way' suffix helps to catch cases where modules compiled in different
 763    ways are linked together (eg. profiled and non-profiled).
 764
 765    We provide a plain, unadorned, version of the module init code
 766    which just jumps to the version with the label and way attached.  The
 767    reason for this is that when using foreign exports, the caller of
 768    startupHaskell() must supply the name of the init function for the "top"
 769    module in the program, and we don't want to require that this name
 770    has the version and way info appended to it.
 771    -------------------------------------------------------------------------- */
 772
 773 #define PUSH_INIT_STACK(reg_function)           \
 774         *(Sp++) = (W_)reg_function
 775
 776 #define POP_INIT_STACK()                        \
 777         *(--Sp)
 778
 779 #define MOD_INIT_WRAPPER(label,real_init)       \
 780
 781
 782 #define START_MOD_INIT(plain_lbl, real_lbl)     \
 783         static int _module_registered = 0;      \
 784         EF_(real_lbl);                          \
 785         FN_(plain_lbl) {                        \
 786             FB_                                 \
 787             JMP_(real_lbl);                     \
 788             FE_                                 \
 789         }                                       \
 790         FN_(real_lbl) {                 \
 791             FB_;                                \
 792             if (! _module_registered) {         \
 793                 _module_registered = 1;         \
 794                 {
 795             /* extern decls go here, followed by init code */
 796
 797 #define REGISTER_FOREIGN_EXPORT(reg_fe_binder)  \
 798         STGCALL1(getStablePtr,reg_fe_binder)
 799
 800 #define REGISTER_IMPORT(reg_mod_name)           \
 801         PUSH_INIT_STACK(reg_mod_name)
 802
 803 #define END_MOD_INIT()                          \
 804         }};                                     \
 805         JMP_(POP_INIT_STACK());                 \
 806         FE_ }
 807
 808 /* -----------------------------------------------------------------------------
 809    Support for _ccall_GC_ and _casm_GC.
 810    -------------------------------------------------------------------------- */
 811
 812 /*
 813  * Suspending/resuming threads for doing external C-calls (_ccall_GC).
 814  * These functions are defined in rts/Schedule.c.
 815  */
 816 StgInt        suspendThread ( StgRegTable *, rtsBool);
 817 StgRegTable * resumeThread  ( StgInt, rtsBool );
 818
 819 #define SUSPEND_THREAD(token,threaded)          \
 820    SaveThreadState();                           \
 821    token = suspendThread(BaseReg,threaded);
 822
 823 #ifdef SMP
 824 #define RESUME_THREAD(token,threaded)           \
 825     BaseReg = resumeThread(token,threaded);     \
 826     LoadThreadState();
 827 #else
 828 #define RESUME_THREAD(token,threaded)           \
 829    (void)resumeThread(token,threaded);          \
 830    LoadThreadState();
 831 #endif
 832
 833 #endif /* STGMACROS_H */
 834