ghc/includes/StgMacros.h

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