ghc/includes/StgMacros.h

   1 /* -----------------------------------------------------------------------------
   2  * $Id: StgMacros.h,v 1.38 2001/07/24 06:31:35 ken 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
 615 #elif SIZEOF_VOID_P == 8
 616
 617 static inline void ASSIGN_Word64(W_ p_dest[], StgWord64 src)
 618 {
 619         p_dest[0] = src;
 620 }
 621
 622 static inline StgWord64 PK_Word64(W_ p_src[])
 623 {
 624     return p_src[0];
 625 }
 626
 627 static inline void ASSIGN_Int64(W_ p_dest[], StgInt64 src)
 628 {
 629     p_dest[0] = src;
 630 }
 631
 632 static inline StgInt64 PK_Int64(W_ p_src[])
 633 {
 634     return p_src[0];
 635 }
 636
 637 #endif
 638
 639 /* -----------------------------------------------------------------------------
 640    Catch frames
 641    -------------------------------------------------------------------------- */
 642
 643 extern DLL_IMPORT_RTS const StgPolyInfoTable stg_catch_frame_info;
 644
 645 /* -----------------------------------------------------------------------------
 646    Seq frames
 647
 648    A seq frame is very like an update frame, except that it doesn't do
 649    an update...
 650    -------------------------------------------------------------------------- */
 651
 652 extern DLL_IMPORT_RTS const StgPolyInfoTable stg_seq_frame_info;
 653
 654 #define PUSH_SEQ_FRAME(sp)                                      \
 655         {                                                       \
 656                 StgSeqFrame *__frame;                           \
 657                 TICK_SEQF_PUSHED();                             \
 658                 __frame = (StgSeqFrame *)(sp);                  \
 659                 SET_HDR_(__frame,&stg_seq_frame_info,CCCS);     \
 660                 __frame->link = Su;                             \
 661                 Su = (StgUpdateFrame *)__frame;                 \
 662         }
 663
 664 /* -----------------------------------------------------------------------------
 665    Split markers
 666    -------------------------------------------------------------------------- */
 667
 668 #if defined(USE_SPLIT_MARKERS)
 669 #if defined(cygwin32_TARGET_OS) || defined(mingw32_TARGET_OS)
 670 #define __STG_SPLIT_MARKER __asm__("\n___stg_split_marker:");
 671 #else
 672 #define __STG_SPLIT_MARKER __asm__("\n__stg_split_marker:");
 673 #endif
 674 #else
 675 #define __STG_SPLIT_MARKER /* nothing */
 676 #endif
 677
 678 /* -----------------------------------------------------------------------------
 679    Closure and Info Macros with casting.
 680
 681    We don't want to mess around with casts in the generated C code, so
 682    we use these casting versions of the closure/info tables macros.
 683    -------------------------------------------------------------------------- */
 684
 685 #define SET_HDR_(c,info,ccs) \
 686    SET_HDR((StgClosure *)(c),(StgInfoTable *)(info),ccs)
 687
 688 /* -----------------------------------------------------------------------------
 689    Saving context for exit from the STG world, and loading up context
 690    on entry to STG code.
 691
 692    We save all the STG registers (that is, the ones that are mapped to
 693    machine registers) in their places in the TSO.
 694
 695    The stack registers go into the current stack object, and the
 696    current nursery is updated from the heap pointer.
 697
 698    These functions assume that BaseReg is loaded appropriately (if
 699    we have one).
 700    -------------------------------------------------------------------------- */
 701
 702 #if IN_STG_CODE
 703
 704 static __inline__ void
 705 SaveThreadState(void)
 706 {
 707   StgTSO *tso;
 708
 709   /* Don't need to save REG_Base, it won't have changed. */
 710
 711   tso = CurrentTSO;
 712   tso->sp       = Sp;
 713   tso->su       = Su;
 714   CloseNursery(Hp);
 715
 716 #ifdef REG_CurrentTSO
 717   SAVE_CurrentTSO = tso;
 718 #endif
 719 #ifdef REG_CurrentNursery
 720   SAVE_CurrentNursery = CurrentNursery;
 721 #endif
 722 #if defined(PROFILING)
 723   CurrentTSO->prof.CCCS = CCCS;
 724 #endif
 725 }
 726
 727 static __inline__ void
 728 LoadThreadState (void)
 729 {
 730   StgTSO *tso;
 731
 732 #ifdef REG_CurrentTSO
 733   CurrentTSO = SAVE_CurrentTSO;
 734 #endif
 735
 736   tso = CurrentTSO;
 737   Sp    = tso->sp;
 738   Su    = tso->su;
 739   SpLim = (P_)&(tso->stack) + RESERVED_STACK_WORDS;
 740   OpenNursery(Hp,HpLim);
 741
 742 #ifdef REG_CurrentNursery
 743   CurrentNursery = SAVE_CurrentNursery;
 744 #endif
 745 # if defined(PROFILING)
 746   CCCS = CurrentTSO->prof.CCCS;
 747 # endif
 748 }
 749
 750 #endif
 751
 752 /* -----------------------------------------------------------------------------
 753    Module initialisation
 754    -------------------------------------------------------------------------- */
 755
 756 #define PUSH_INIT_STACK(reg_function)           \
 757         *(Sp++) = (W_)reg_function
 758
 759 #define POP_INIT_STACK()                        \
 760         *(--Sp)
 761
 762 #define START_MOD_INIT(reg_mod_name)            \
 763         static int _module_registered = 0;      \
 764         FN_(reg_mod_name) {                     \
 765             FB_;                                \
 766             if (! _module_registered) {         \
 767                 _module_registered = 1;         \
 768                 {
 769             /* extern decls go here, followed by init code */
 770
 771 #define REGISTER_FOREIGN_EXPORT(reg_fe_binder)  \
 772         STGCALL1(getStablePtr,reg_fe_binder)
 773
 774 #define REGISTER_IMPORT(reg_mod_name)           \
 775         PUSH_INIT_STACK(reg_mod_name)
 776
 777 #define END_MOD_INIT()                          \
 778         }};                                     \
 779         JMP_(POP_INIT_STACK());                 \
 780         FE_ }
 781
 782 /* -----------------------------------------------------------------------------
 783    Support for _ccall_GC_ and _casm_GC.
 784    -------------------------------------------------------------------------- */
 785
 786 /*
 787  * Suspending/resuming threads for doing external C-calls (_ccall_GC).
 788  * These functions are defined in rts/Schedule.c.
 789  */
 790 StgInt        suspendThread ( StgRegTable *cap );
 791 StgRegTable * resumeThread  ( StgInt );
 792
 793 #define SUSPEND_THREAD(token)                   \
 794    SaveThreadState();                           \
 795    token = suspendThread(BaseReg);
 796
 797 #ifdef SMP
 798 #define RESUME_THREAD(token)                    \
 799    BaseReg = resumeThread(token);               \
 800    LoadThreadState();
 801 #else
 802 #define RESUME_THREAD(token)                    \
 803    (void)resumeThread(token);                   \
 804    LoadThreadState();
 805 #endif
 806
 807 #endif /* STGMACROS_H */
 808