[project @ 2000-03-08 17:48:24 by simonmar]
[ghc-hetmet.git] / ghc / includes / StgMacros.h
index d17d4ad..1e28474 100644 (file)
@@ -1,5 +1,7 @@
 /* -----------------------------------------------------------------------------
 /* -----------------------------------------------------------------------------
- * $Id: StgMacros.h,v 1.3 1999/01/21 10:31:43 simonm Exp $
+ * $Id: StgMacros.h,v 1.21 2000/03/08 17:48:26 simonmar Exp $
+ *
+ * (c) The GHC Team, 1998-1999
  *
  * Macros used for writing STG-ish C code.
  *
  *
  * Macros used for writing STG-ish C code.
  *
 
   The macros can be used either to define the function itself, or to provide
   prototypes (by following with a ';').
 
   The macros can be used either to define the function itself, or to provide
   prototypes (by following with a ';').
+
+  Note: the various I*_ shorthands in the second block below are used to
+  declare forward references to local symbols. These shorthands *have* to
+  use the 'extern' type specifier and not 'static'. The reason for this is
+  that 'static' declares a reference as being a static/local variable,
+  and *not* as a forward reference to a static variable.
+
+  This might seem obvious, but it had me stumped as to why my info tables
+  were suddenly all filled with 0s.
+
+    -- sof 1/99 
+
   --------------------------------------------------------------------------- */
 
 #define STGFUN(f)       StgFunPtr f(void)
   --------------------------------------------------------------------------- */
 
 #define STGFUN(f)       StgFunPtr f(void)
-#define STATICFUN(f)    static StgFunPtr f(void)
 #define EXTFUN(f)      extern StgFunPtr f(void)
 #define EXTFUN(f)      extern StgFunPtr f(void)
-
+#define EXTFUN_RTS(f)  extern DLL_IMPORT_RTS StgFunPtr f(void)
 #define FN_(f)         F_ f(void)
 #define IFN_(f)                static F_ f(void)
 #define IF_(f)         static F_ f(void)
 #define EF_(f)         extern F_ f(void)
 #define FN_(f)         F_ f(void)
 #define IFN_(f)                static F_ f(void)
 #define IF_(f)         static F_ f(void)
 #define EF_(f)         extern F_ f(void)
+#define EDF_(f)                extern DLLIMPORT F_ f(void)
+
 #define ED_            extern
 #define ED_            extern
+#define EDD_           extern DLLIMPORT 
 #define ED_RO_         extern const
 #define ID_            extern
 #define ID_RO_         extern const
 #define ED_RO_         extern const
 #define ID_            extern
 #define ID_RO_         extern const
-#define EI_             extern const StgInfoTable
-#define II_             extern const StgInfoTable
+#define EI_             extern INFO_TBL_CONST StgInfoTable
+#define EDI_            extern DLLIMPORT INFO_TBL_CONST StgInfoTable
+#define II_             extern INFO_TBL_CONST StgInfoTable
 #define EC_            extern StgClosure
 #define EC_            extern StgClosure
+#define EDC_           extern DLLIMPORT StgClosure
 #define IC_            extern StgClosure
 #define IC_            extern StgClosure
+#define ECP_(x)                extern const StgClosure *(x)[]
+#define EDCP_(x)       extern DLLIMPORT StgClosure *(x)[]
+#define ICP_(x)                extern const StgClosure *(x)[]
 
 /* -----------------------------------------------------------------------------
    Stack Tagging.
 
 /* -----------------------------------------------------------------------------
    Stack Tagging.
    words in the block.
    -------------------------------------------------------------------------- */
 
    words in the block.
    -------------------------------------------------------------------------- */
 
-#ifndef DEBUG_EXTRA
 #define ARGTAG_MAX 16          /* probably arbitrary */
 #define ARG_TAG(n)  (n)
 #define ARGTAG_MAX 16          /* probably arbitrary */
 #define ARG_TAG(n)  (n)
-#define ARG_SIZE(n) stgCast(StgWord,n)
+#define ARG_SIZE(n) (StgWord)n
 
 typedef enum {
     REALWORLD_TAG = 0,
 
 typedef enum {
     REALWORLD_TAG = 0,
-    INT_TAG    = sizeofW(StgInt), 
-    INT64_TAG  = sizeofW(StgInt64), 
-    WORD_TAG   = sizeofW(StgWord), 
-    ADDR_TAG   = sizeofW(StgAddr), 
-    CHAR_TAG   = sizeofW(StgChar),
-    FLOAT_TAG  = sizeofW(StgFloat), 
-    DOUBLE_TAG = sizeofW(StgDouble), 
-    STABLE_TAG = sizeofW(StgWord), 
+    INT_TAG       = sizeofW(StgInt), 
+    INT64_TAG     = sizeofW(StgInt64), 
+    WORD_TAG      = sizeofW(StgWord), 
+    ADDR_TAG      = sizeofW(StgAddr), 
+    CHAR_TAG      = sizeofW(StgChar),
+    FLOAT_TAG     = sizeofW(StgFloat), 
+    DOUBLE_TAG    = sizeofW(StgDouble), 
+    STABLE_TAG    = sizeofW(StgWord), 
 } StackTag;
 
 } StackTag;
 
-#else /* DEBUG_EXTRA */
-
-typedef enum {
-    ILLEGAL_TAG,
-    REALWORLD_TAG,
-    INT_TAG    ,
-    INT64_TAG  ,
-    WORD_TAG   ,
-    ADDR_TAG   ,
-    CHAR_TAG   ,
-    FLOAT_TAG  ,
-    DOUBLE_TAG ,
-    STABLE_TAG ,
-    ARGTAG_MAX = DOUBLE_TAG
-} StackTag;
-
-/* putting this in a .h file generates many copies - but its only a 
- * debugging build.
- */
-static StgWord stg_arg_size[] = {
-    [REALWORLD_TAG] = 0,
-    [INT_TAG   ] = sizeofW(StgInt), 
-    [INT64_TAG ] = sizeofW(StgInt64), 
-    [WORD_TAG  ] = sizeofW(StgWord), 
-    [ADDR_TAG  ] = sizeofW(StgAddr), 
-    [CHAR_TAG  ] = sizeofW(StgChar),
-    [FLOAT_TAG ] = sizeofW(StgFloat), 
-    [DOUBLE_TAG] = sizeofW(StgDouble),
-    [STABLE_TAG] = sizeofW(StgWord)
-};
-
-#define ARG_SIZE(tag) stg_arg_size[stgCast(StgWord,tag)]
-
-#endif /* DEBUG_EXTRA */
-
 static inline int IS_ARG_TAG( StgWord p );
 static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; }
 
 /* -----------------------------------------------------------------------------
    Argument checks.
    
 static inline int IS_ARG_TAG( StgWord p );
 static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; }
 
 /* -----------------------------------------------------------------------------
    Argument checks.
    
-   If (Sp + <n_args>) > Su { JMP_(stg_updatePAP); }
+   If (Sp + <n_args>) > Su { JMP_(stg_update_PAP); }
    
    Sp points to the topmost used word on the stack, and Su points to
    the most recently pushed update frame.
    
    Sp points to the topmost used word on the stack, and Su points to
    the most recently pushed update frame.
@@ -146,29 +131,29 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; }
 
 #define STK_CHK(headroom,ret,r,layout,tag_assts)               \
        if (Sp - headroom < SpLim) {                            \
 
 #define STK_CHK(headroom,ret,r,layout,tag_assts)               \
        if (Sp - headroom < SpLim) {                            \
-           EXTFUN(stg_chk_##layout);                           \
+           EXTFUN_RTS(stg_chk_##layout);                       \
            tag_assts                                           \
            (r) = (P_)ret;                                      \
            JMP_(stg_chk_##layout);                             \
        }
        
 #define HP_CHK(headroom,ret,r,layout,tag_assts)                        \
            tag_assts                                           \
            (r) = (P_)ret;                                      \
            JMP_(stg_chk_##layout);                             \
        }
        
 #define HP_CHK(headroom,ret,r,layout,tag_assts)                        \
+        DO_GRAN_ALLOCATE(headroom)                              \
        if ((Hp += headroom) > HpLim) {                         \
        if ((Hp += headroom) > HpLim) {                         \
-           EXTFUN(stg_chk_##layout);                           \
+           EXTFUN_RTS(stg_chk_##layout);                       \
            tag_assts                                           \
            (r) = (P_)ret;                                      \
            JMP_(stg_chk_##layout);                             \
            tag_assts                                           \
            (r) = (P_)ret;                                      \
            JMP_(stg_chk_##layout);                             \
-       }                                                       \
-        TICK_ALLOC_HEAP(headroom);
+       }
 
 #define HP_STK_CHK(stk_headroom,hp_headroom,ret,r,layout,tag_assts) \
 
 #define HP_STK_CHK(stk_headroom,hp_headroom,ret,r,layout,tag_assts) \
+        DO_GRAN_ALLOCATE(hp_headroom)                              \
        if (Sp - stk_headroom < SpLim || (Hp += hp_headroom) > HpLim) { \
        if (Sp - stk_headroom < SpLim || (Hp += hp_headroom) > HpLim) { \
-           EXTFUN(stg_chk_##layout);                           \
+           EXTFUN_RTS(stg_chk_##layout);                       \
            tag_assts                                           \
            (r) = (P_)ret;                                      \
            JMP_(stg_chk_##layout);                             \
            tag_assts                                           \
            (r) = (P_)ret;                                      \
            JMP_(stg_chk_##layout);                             \
-       }                                                       \
-        TICK_ALLOC_HEAP(hp_headroom);
+       }
 
 /* -----------------------------------------------------------------------------
    A Heap Check in a case alternative are much simpler: everything is
 
 /* -----------------------------------------------------------------------------
    A Heap Check in a case alternative are much simpler: everything is
@@ -182,49 +167,54 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; }
    functions.  In all these cases, node points to a closure that we
    can just enter to restart the heap check (the NP stands for 'node points').
 
    functions.  In all these cases, node points to a closure that we
    can just enter to restart the heap check (the NP stands for 'node points').
 
+   In the NP case GranSim absolutely has to check whether the current node 
+   resides on the current processor. Otherwise a FETCH event has to be
+   scheduled. All that is done in GranSimFetch. -- HWL
+
    HpLim points to the LAST WORD of valid allocation space.
    -------------------------------------------------------------------------- */
 
 #define STK_CHK_NP(headroom,ptrs,tag_assts)                    \
        if ((Sp - (headroom)) < SpLim) {                        \
    HpLim points to the LAST WORD of valid allocation space.
    -------------------------------------------------------------------------- */
 
 #define STK_CHK_NP(headroom,ptrs,tag_assts)                    \
        if ((Sp - (headroom)) < SpLim) {                        \
-           EXTFUN(stg_gc_enter_##ptrs);                        \
+           EXTFUN_RTS(stg_gc_enter_##ptrs);                    \
             tag_assts                                          \
            JMP_(stg_gc_enter_##ptrs);                          \
        }
 
 #define HP_CHK_NP(headroom,ptrs,tag_assts)                     \
             tag_assts                                          \
            JMP_(stg_gc_enter_##ptrs);                          \
        }
 
 #define HP_CHK_NP(headroom,ptrs,tag_assts)                     \
+        DO_GRAN_ALLOCATE(headroom)                              \
        if ((Hp += (headroom)) > HpLim) {                       \
        if ((Hp += (headroom)) > HpLim) {                       \
-           EXTFUN(stg_gc_enter_##ptrs);                        \
+           EXTFUN_RTS(stg_gc_enter_##ptrs);                    \
             tag_assts                                          \
            JMP_(stg_gc_enter_##ptrs);                          \
             tag_assts                                          \
            JMP_(stg_gc_enter_##ptrs);                          \
-       }                                                       \
-        TICK_ALLOC_HEAP(headroom);
+       }
 
 #define HP_CHK_SEQ_NP(headroom,ptrs,tag_assts)                 \
 
 #define HP_CHK_SEQ_NP(headroom,ptrs,tag_assts)                 \
+        DO_GRAN_ALLOCATE(headroom)                              \
        if ((Hp += (headroom)) > HpLim) {                       \
        if ((Hp += (headroom)) > HpLim) {                       \
-           EXTFUN(stg_gc_seq_##ptrs);                          \
+           EXTFUN_RTS(stg_gc_seq_##ptrs);                      \
             tag_assts                                          \
            JMP_(stg_gc_seq_##ptrs);                            \
             tag_assts                                          \
            JMP_(stg_gc_seq_##ptrs);                            \
-       }                                                       \
-        TICK_ALLOC_HEAP(headroom);
+       }
 
 #define HP_STK_CHK_NP(stk_headroom, hp_headroom, ptrs, tag_assts) \
 
 #define HP_STK_CHK_NP(stk_headroom, hp_headroom, ptrs, tag_assts) \
+        DO_GRAN_ALLOCATE(hp_headroom)                              \
        if ((Sp - (stk_headroom)) < SpLim || (Hp += (hp_headroom)) > HpLim) { \
        if ((Sp - (stk_headroom)) < SpLim || (Hp += (hp_headroom)) > HpLim) { \
-           EXTFUN(stg_gc_enter_##ptrs);                        \
+           EXTFUN_RTS(stg_gc_enter_##ptrs);                    \
             tag_assts                                          \
            JMP_(stg_gc_enter_##ptrs);                          \
             tag_assts                                          \
            JMP_(stg_gc_enter_##ptrs);                          \
-       }                                                       \
-        TICK_ALLOC_HEAP(hp_headroom);
+       }
+
 
 /* Heap checks for branches of a primitive case / unboxed tuple return */
 
 #define GEN_HP_CHK_ALT(headroom,lbl,tag_assts)                 \
 
 /* Heap checks for branches of a primitive case / unboxed tuple return */
 
 #define GEN_HP_CHK_ALT(headroom,lbl,tag_assts)                 \
+        DO_GRAN_ALLOCATE(headroom)                              \
        if ((Hp += (headroom)) > HpLim) {                       \
        if ((Hp += (headroom)) > HpLim) {                       \
-           EXTFUN(lbl);                                        \
+           EXTFUN_RTS(lbl);                                    \
             tag_assts                                          \
            JMP_(lbl);                                          \
             tag_assts                                          \
            JMP_(lbl);                                          \
-       }                                                       \
-        TICK_ALLOC_HEAP(headroom);
+       }
 
 #define HP_CHK_NOREGS(headroom,tag_assts) \
     GEN_HP_CHK_ALT(headroom,stg_gc_noregs,tag_assts);
 
 #define HP_CHK_NOREGS(headroom,tag_assts) \
     GEN_HP_CHK_ALT(headroom,stg_gc_noregs,tag_assts);
@@ -308,8 +298,11 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; }
        R9.w = (W_)LIVENESS_MASK(liveness);             \
         R10.w = (W_)reentry;                           \
         JMP_(stg_gen_chk);                             \
        R9.w = (W_)LIVENESS_MASK(liveness);             \
         R10.w = (W_)reentry;                           \
         JMP_(stg_gen_chk);                             \
-   }                                                   \
-   TICK_ALLOC_HEAP(headroom);
+   }
+
+#define HP_CHK_GEN_TICKY(headroom,liveness,reentry,tag_assts)  \
+   HP_CHK_GEN(headroom,liveness,reentry,tag_assts);            \
+   TICK_ALLOC_HEAP_NOCTR(headroom)
 
 #define STK_CHK_GEN(headroom,liveness,reentry,tag_assts)       \
    if ((Sp - (headroom)) < SpLim) {                            \
 
 #define STK_CHK_GEN(headroom,liveness,reentry,tag_assts)       \
    if ((Sp - (headroom)) < SpLim) {                            \
@@ -318,8 +311,7 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; }
        R9.w = (W_)LIVENESS_MASK(liveness);                     \
         R10.w = (W_)reentry;                                   \
         JMP_(stg_gen_chk);                                     \
        R9.w = (W_)LIVENESS_MASK(liveness);                     \
         R10.w = (W_)reentry;                                   \
         JMP_(stg_gen_chk);                                     \
-   }                                                           \
-   TICK_ALLOC_HEAP(headroom);
+   }
 
 #define MAYBE_GC(liveness,reentry)             \
    if (doYouWantToGC()) {                      \
 
 #define MAYBE_GC(liveness,reentry)             \
    if (doYouWantToGC()) {                      \
@@ -336,9 +328,11 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; }
    out to be slowing us down we can make specialised ones.
    -------------------------------------------------------------------------- */
 
    out to be slowing us down we can make specialised ones.
    -------------------------------------------------------------------------- */
 
+EF_(stg_gen_yield);
+EF_(stg_gen_block);
+
 #define YIELD(liveness,reentry)                        \
   {                                            \
 #define YIELD(liveness,reentry)                        \
   {                                            \
-   EF_(stg_gen_yield);                         \
    R9.w  = (W_)LIVENESS_MASK(liveness);                \
    R10.w = (W_)reentry;                                \
    JMP_(stg_gen_yield);                                \
    R9.w  = (W_)LIVENESS_MASK(liveness);                \
    R10.w = (W_)reentry;                                \
    JMP_(stg_gen_yield);                                \
@@ -346,7 +340,6 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; }
 
 #define BLOCK(liveness,reentry)                        \
   {                                            \
 
 #define BLOCK(liveness,reentry)                        \
   {                                            \
-   EF_(stg_gen_block);                         \
    R9.w  = (W_)LIVENESS_MASK(liveness);                \
    R10.w = (W_)reentry;                                \
    JMP_(stg_gen_block);                                \
    R9.w  = (W_)LIVENESS_MASK(liveness);                \
    R10.w = (W_)reentry;                                \
    JMP_(stg_gen_block);                                \
@@ -354,10 +347,29 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; }
 
 #define BLOCK_NP(ptrs)                         \
   {                                            \
 
 #define BLOCK_NP(ptrs)                         \
   {                                            \
-    EF_(stg_bock_##ptrs);                      \
+    EF_(stg_block_##ptrs);                     \
     JMP_(stg_block_##ptrs);                    \
   }
 
     JMP_(stg_block_##ptrs);                    \
   }
 
+#if defined(PAR)
+/*
+  Similar to BLOCK_NP but separates the saving of the thread state from the
+  actual jump via an StgReturn
+*/
+
+#define SAVE_THREAD_STATE(ptrs)                  \
+  ASSERT(ptrs==1);                               \
+  Sp -= 1;                                       \
+  Sp[0] = R1.w;                                  \
+  SaveThreadState();                             
+
+#define THREAD_RETURN(ptrs)                      \
+  ASSERT(ptrs==1);                               \
+  CurrentTSO->whatNext = ThreadEnterGHC;         \
+  R1.i = ThreadBlocked;                          \
+  JMP_(StgReturn);                               
+#endif
+
 /* -----------------------------------------------------------------------------
    CCall_GC needs to push a dummy stack frame containing the contents
    of volatile registers and variables.  
 /* -----------------------------------------------------------------------------
    CCall_GC needs to push a dummy stack frame containing the contents
    of volatile registers and variables.  
@@ -365,8 +377,11 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; }
    We use a RET_DYN frame the same as for a dynamic heap check.
    ------------------------------------------------------------------------- */
 
    We use a RET_DYN frame the same as for a dynamic heap check.
    ------------------------------------------------------------------------- */
 
+#if COMPILING_RTS
 EI_(stg_gen_chk_info);
 EI_(stg_gen_chk_info);
-
+#else
+EDI_(stg_gen_chk_info);
+#endif
 /* -----------------------------------------------------------------------------
    Vectored Returns
 
 /* -----------------------------------------------------------------------------
    Vectored Returns
 
@@ -380,22 +395,65 @@ EI_(stg_gen_chk_info);
    The extra subtraction of one word is because tags start at zero.
    -------------------------------------------------------------------------- */
 
    The extra subtraction of one word is because tags start at zero.
    -------------------------------------------------------------------------- */
 
-#ifdef USE_MINIINTERPRETER
-#define RET_VEC(p,t) ((*(stgCast(StgInfoTable*,p)->vector))[t])
-#else
+#ifdef TABLES_NEXT_TO_CODE
 #define RET_VEC(p,t) (*((P_)(p) - sizeofW(StgInfoTable) - t - 1))
 #define RET_VEC(p,t) (*((P_)(p) - sizeofW(StgInfoTable) - t - 1))
+#else
+#define RET_VEC(p,t) (((StgInfoTable *)p)->vector[t])
 #endif
 
 /* -----------------------------------------------------------------------------
    Misc
    -------------------------------------------------------------------------- */
 
 #endif
 
 /* -----------------------------------------------------------------------------
    Misc
    -------------------------------------------------------------------------- */
 
+
 /* set the tag register (if we have one) */
 #define SET_TAG(t)  /* nothing */
 
 /* set the tag register (if we have one) */
 #define SET_TAG(t)  /* nothing */
 
-/* don't do eager blackholing for now */
-#define UPD_BH_UPDATABLE(thunk)  /* nothing */
-#define UPD_BH_SINGLE_ENTRY(thunk)  /* nothing */
+#ifdef EAGER_BLACKHOLING
+#  ifdef SMP
+#    define UPD_BH_UPDATABLE(info)                             \
+        TICK_UPD_BH_UPDATABLE();                               \
+        {                                                      \
+         bdescr *bd = Bdescr(R1.p);                            \
+          if (bd->back != (bdescr *)BaseReg) {                 \
+             if (bd->gen->no >= 1 || bd->step->no >= 1) {      \
+                LOCK_THUNK(info);                              \
+             } else {                                          \
+                EXTFUN_RTS(stg_gc_enter_1_hponly);             \
+                JMP_(stg_gc_enter_1_hponly);                   \
+             }                                                 \
+          }                                                    \
+       }                                                       \
+        SET_INFO(R1.cl,&BLACKHOLE_info)
+#    define UPD_BH_SINGLE_ENTRY(info)                          \
+        TICK_UPD_BH_SINGLE_ENTRY();                            \
+        {                                                      \
+         bdescr *bd = Bdescr(R1.p);                            \
+          if (bd->back != (bdescr *)BaseReg) {                 \
+             if (bd->gen->no >= 1 || bd->step->no >= 1) {      \
+                LOCK_THUNK(info);                              \
+             } else {                                          \
+                EXTFUN_RTS(stg_gc_enter_1_hponly);             \
+                JMP_(stg_gc_enter_1_hponly);                   \
+             }                                                 \
+          }                                                    \
+       }                                                       \
+        SET_INFO(R1.cl,&BLACKHOLE_info)
+#  else
+#    define UPD_BH_UPDATABLE(info)             \
+        TICK_UPD_BH_UPDATABLE();               \
+        SET_INFO(R1.cl,&BLACKHOLE_info)
+#    define UPD_BH_SINGLE_ENTRY(info)          \
+        TICK_UPD_BH_SINGLE_ENTRY();            \
+        SET_INFO(R1.cl,&SE_BLACKHOLE_info)
+#  endif
+#else /* !EAGER_BLACKHOLING */
+#  define UPD_BH_UPDATABLE(thunk)    /* nothing */
+#  define UPD_BH_SINGLE_ENTRY(thunk) /* nothing */
+#endif /* EAGER_BLACKHOLING */
+
+#define UPD_FRAME_UPDATEE(p)  (((StgUpdateFrame *)(p))->updatee)
+#define UPDATE_SU_FROM_UPD_FRAME(p) (Su=((StgUpdateFrame *)(p))->link)
 
 /* -----------------------------------------------------------------------------
    Moving Floats and Doubles
 
 /* -----------------------------------------------------------------------------
    Moving Floats and Doubles
@@ -451,12 +509,15 @@ static inline StgDouble PK_DBL    (W_ p_src[])                 { return *(StgDou
  */
 #if sparc_TARGET_ARCH
 
  */
 #if sparc_TARGET_ARCH
 
-#define ASSIGN_DBL(dst,src) \
+#define ASSIGN_DBL(dst0,src) \
+    { StgPtr dst = (StgPtr)(dst0); \
       __asm__("st %2,%0\n\tst %R2,%1" : "=m" (((P_)(dst))[0]), \
       __asm__("st %2,%0\n\tst %R2,%1" : "=m" (((P_)(dst))[0]), \
-       "=m" (((P_)(dst))[1]) : "f" (src));
+       "=m" (((P_)(dst))[1]) : "f" (src)); \
+    }
 
 
-#define PK_DBL(src) \
-    ( { register double d; \
+#define PK_DBL(src0) \
+    ( { StgPtr src = (StgPtr)(src0); \
+        register double d; \
       __asm__("ld %1,%0\n\tld %2,%R0" : "=f" (d) : \
        "m" (((P_)(src))[0]), "m" (((P_)(src))[1])); d; \
     } )
       __asm__("ld %1,%0\n\tld %2,%R0" : "=f" (d) : \
        "m" (((P_)(src))[0]), "m" (((P_)(src))[1])); d; \
     } )
@@ -517,11 +578,11 @@ typedef union
   } int64_thing;
 
 typedef union
   } int64_thing;
 
 typedef union
-  { StgNat64 w;
+  { StgWord64 w;
     unpacked_double_word wu;
   } word64_thing;
 
     unpacked_double_word wu;
   } word64_thing;
 
-static inline void ASSIGN_Word64(W_ p_dest[], StgNat64 src)
+static inline void ASSIGN_Word64(W_ p_dest[], StgWord64 src)
 {
     word64_thing y;
     y.w = src;
 {
     word64_thing y;
     y.w = src;
@@ -529,7 +590,7 @@ static inline void ASSIGN_Word64(W_ p_dest[], StgNat64 src)
     p_dest[1] = y.wu.dlo;
 }
 
     p_dest[1] = y.wu.dlo;
 }
 
-static inline StgNat64 PK_Word64(W_ p_src[])
+static inline StgWord64 PK_Word64(W_ p_src[])
 {
     word64_thing y;
     y.wu.dhi = p_src[0];
 {
     word64_thing y;
     y.wu.dhi = p_src[0];
@@ -558,7 +619,7 @@ static inline StgInt64 PK_Int64(W_ p_src[])
    Catch frames
    -------------------------------------------------------------------------- */
 
    Catch frames
    -------------------------------------------------------------------------- */
 
-extern const StgPolyInfoTable catch_frame_info;
+extern DLL_IMPORT_DATA const StgPolyInfoTable catch_frame_info;
 
 /* -----------------------------------------------------------------------------
    Seq frames
 
 /* -----------------------------------------------------------------------------
    Seq frames
@@ -567,7 +628,7 @@ extern const StgPolyInfoTable catch_frame_info;
    an update...
    -------------------------------------------------------------------------- */
 
    an update...
    -------------------------------------------------------------------------- */
 
-extern const StgPolyInfoTable seq_frame_info;
+extern DLL_IMPORT_DATA const StgPolyInfoTable seq_frame_info;
 
 #define PUSH_SEQ_FRAME(sp)                                     \
        {                                                       \
 
 #define PUSH_SEQ_FRAME(sp)                                     \
        {                                                       \
@@ -606,10 +667,15 @@ extern const StgPolyInfoTable seq_frame_info;
    We save all the STG registers (that is, the ones that are mapped to
    machine registers) in their places in the TSO.  
 
    We save all the STG registers (that is, the ones that are mapped to
    machine registers) in their places in the TSO.  
 
-   The stack registers go into the current stack object, and the heap
-   registers are saved in global locations.
+   The stack registers go into the current stack object, and the
+   current nursery is updated from the heap pointer.
+
+   These functions assume that BaseReg is loaded appropriately (if
+   we have one).
    -------------------------------------------------------------------------- */
 
    -------------------------------------------------------------------------- */
 
+#if IN_STG_CODE
+
 static __inline__ void
 SaveThreadState(void)
 {
 static __inline__ void
 SaveThreadState(void)
 {
@@ -620,6 +686,12 @@ SaveThreadState(void)
   CurrentTSO->splim    = SpLim;
   CloseNursery(Hp);
 
   CurrentTSO->splim    = SpLim;
   CloseNursery(Hp);
 
+#ifdef REG_CurrentTSO
+  SAVE_CurrentTSO = CurrentTSO;
+#endif
+#ifdef REG_CurrentNursery
+  SAVE_CurrentNursery = CurrentNursery;
+#endif
 #if defined(PROFILING)
   CurrentTSO->prof.CCCS = CCCS;
 #endif
 #if defined(PROFILING)
   CurrentTSO->prof.CCCS = CCCS;
 #endif
@@ -628,19 +700,82 @@ SaveThreadState(void)
 static __inline__ void 
 LoadThreadState (void)
 {
 static __inline__ void 
 LoadThreadState (void)
 {
-#ifdef REG_Base
-  BaseReg = &MainRegTable;
-#endif
-
   Sp    = CurrentTSO->sp;
   Su    = CurrentTSO->su;
   SpLim = CurrentTSO->splim;
   OpenNursery(Hp,HpLim);
 
   Sp    = CurrentTSO->sp;
   Su    = CurrentTSO->su;
   SpLim = CurrentTSO->splim;
   OpenNursery(Hp,HpLim);
 
+#ifdef REG_CurrentTSO
+  CurrentTSO = SAVE_CurrentTSO;
+#endif
+#ifdef REG_CurrentNursery
+  CurrentNursery = SAVE_CurrentNursery;
+#endif
 # if defined(PROFILING)
   CCCS = CurrentTSO->prof.CCCS;
 # endif
 }
 
 # if defined(PROFILING)
   CCCS = CurrentTSO->prof.CCCS;
 # endif
 }
 
+#endif
+
+/* -----------------------------------------------------------------------------
+   Module initialisation
+   -------------------------------------------------------------------------- */
+
+extern F_ *init_stack;
+
+#define PUSH_INIT_STACK(reg_function)          \
+       *(init_stack++) = (F_)reg_function
+
+#define POP_INIT_STACK()                       \
+       *(--init_stack)
+
+#define START_MOD_INIT(reg_mod_name)           \
+       static int _module_registered = 0;      \
+       FN_(reg_mod_name) {                     \
+           FB_;                                \
+           if (! _module_registered) {         \
+               _module_registered = 1;         \
+               { 
+           /* extern decls go here, followed by init code */
+
+#define REGISTER_FOREIGN_EXPORT(reg_fe_binder) \
+        STGCALL1(getStablePtr,reg_fe_binder)
+       
+#define REGISTER_IMPORT(reg_mod_name)          \
+       do { EF_(reg_mod_name);                 \
+         PUSH_INIT_STACK(reg_mod_name) ;       \
+       } while (0)
+       
+#define END_MOD_INIT()                         \
+        }};                                    \
+       JMP_(POP_INIT_STACK());                 \
+       FE_ }
+
+/* -----------------------------------------------------------------------------
+   Support for _ccall_GC_ and _casm_GC.
+   -------------------------------------------------------------------------- */
+
+/* 
+ * Suspending/resuming threads for doing external C-calls (_ccall_GC).
+ * These functions are defined in rts/Schedule.c.
+ */
+StgInt        suspendThread ( StgRegTable *cap );
+StgRegTable * resumeThread  ( StgInt );
+
+#define SUSPEND_THREAD(token)                  \
+   SaveThreadState();                          \
+   token = suspendThread(BaseReg);
+
+#ifdef SMP
+#define RESUME_THREAD(token)                   \
+   BaseReg = resumeThread(token);              \
+   LoadThreadState();
+#else
+#define RESUME_THREAD(token)                   \
+   (void)resumeThread(token);                  \
+   LoadThreadState();
+#endif
+
 #endif /* STGMACROS_H */
 
 #endif /* STGMACROS_H */