[project @ 2000-07-08 19:35:42 by panne]
[ghc-hetmet.git] / ghc / includes / StgMacros.h
index 8ca1f91..1aef572 100644 (file)
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: StgMacros.h,v 1.16 1999/11/05 12:28:05 simonmar Exp $
+ * $Id: StgMacros.h,v 1.27 2000/07/08 19:35:42 panne Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
 #define ED_            extern
 #define EDD_           extern DLLIMPORT 
 #define ED_RO_         extern const
-#define ID_            extern
-#define ID_RO_         extern const
+#define ID_            static
+#define ID_RO_         static const
 #define EI_             extern INFO_TBL_CONST StgInfoTable
 #define EDI_            extern DLLIMPORT INFO_TBL_CONST StgInfoTable
-#define II_             extern INFO_TBL_CONST StgInfoTable
+#define II_             static INFO_TBL_CONST StgInfoTable
 #define EC_            extern StgClosure
 #define EDC_           extern DLLIMPORT StgClosure
-#define IC_            extern StgClosure
+#define IC_            static StgClosure
 #define ECP_(x)                extern const StgClosure *(x)[]
 #define EDCP_(x)       extern DLLIMPORT StgClosure *(x)[]
-#define ICP_(x)                extern const StgClosure *(x)[]
+#define ICP_(x)                static const StgClosure *(x)[]
 
 /* -----------------------------------------------------------------------------
    Stack Tagging.
    words in the block.
    -------------------------------------------------------------------------- */
 
-#ifndef DEBUG_EXTRA
 #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,
-    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;
 
-#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; }
 
@@ -174,6 +138,7 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; }
        }
        
 #define HP_CHK(headroom,ret,r,layout,tag_assts)                        \
+        DO_GRAN_ALLOCATE(headroom)                              \
        if ((Hp += headroom) > HpLim) {                         \
            EXTFUN_RTS(stg_chk_##layout);                       \
            tag_assts                                           \
@@ -182,6 +147,7 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; }
        }
 
 #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) { \
            EXTFUN_RTS(stg_chk_##layout);                       \
            tag_assts                                           \
@@ -201,6 +167,10 @@ 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').
 
+   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.
    -------------------------------------------------------------------------- */
 
@@ -212,6 +182,7 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; }
        }
 
 #define HP_CHK_NP(headroom,ptrs,tag_assts)                     \
+        DO_GRAN_ALLOCATE(headroom)                              \
        if ((Hp += (headroom)) > HpLim) {                       \
            EXTFUN_RTS(stg_gc_enter_##ptrs);                    \
             tag_assts                                          \
@@ -219,6 +190,7 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; }
        }
 
 #define HP_CHK_SEQ_NP(headroom,ptrs,tag_assts)                 \
+        DO_GRAN_ALLOCATE(headroom)                              \
        if ((Hp += (headroom)) > HpLim) {                       \
            EXTFUN_RTS(stg_gc_seq_##ptrs);                      \
             tag_assts                                          \
@@ -226,6 +198,7 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; }
        }
 
 #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) { \
            EXTFUN_RTS(stg_gc_enter_##ptrs);                    \
             tag_assts                                          \
@@ -236,6 +209,7 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; }
 /* 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) {                       \
            EXTFUN_RTS(lbl);                                    \
             tag_assts                                          \
@@ -377,6 +351,25 @@ EF_(stg_gen_block);
     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->what_next = ThreadEnterGHC;        \
+  R1.i = ThreadBlocked;                          \
+  JMP_(StgReturn);                               
+#endif
+
 /* -----------------------------------------------------------------------------
    CCall_GC needs to push a dummy stack frame containing the contents
    of volatile registers and variables.  
@@ -418,13 +411,33 @@ EDI_(stg_gen_chk_info);
 
 #ifdef EAGER_BLACKHOLING
 #  ifdef SMP
-#    define UPD_BH_UPDATABLE(info)             \
-        TICK_UPD_BH_UPDATABLE();               \
-        LOCK_THUNK(info);                      \
+#    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();            \
-        LOCK_THUNK(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)             \
@@ -439,7 +452,7 @@ EDI_(stg_gen_chk_info);
 #  define UPD_BH_SINGLE_ENTRY(thunk) /* nothing */
 #endif /* EAGER_BLACKHOLING */
 
-#define UPD_FRAME_UPDATEE(p)  (((StgUpdateFrame *)(p))->updatee)
+#define UPD_FRAME_UPDATEE(p)  ((P_)(((StgUpdateFrame *)(p))->updatee))
 #define UPDATE_SU_FROM_UPD_FRAME(p) (Su=((StgUpdateFrame *)(p))->link)
 
 /* -----------------------------------------------------------------------------
@@ -632,9 +645,9 @@ extern DLL_IMPORT_DATA const StgPolyInfoTable seq_frame_info;
    -------------------------------------------------------------------------- */
 
 #if defined(USE_SPLIT_MARKERS)
-#define __STG_SPLIT_MARKER(n) FN_(__stg_split_marker##n) { }
+#define __STG_SPLIT_MARKER __asm__("\n__stg_split_marker:");
 #else
-#define __STG_SPLIT_MARKER(n) /* nothing */
+#define __STG_SPLIT_MARKER /* nothing */
 #endif
 
 /* -----------------------------------------------------------------------------
@@ -661,20 +674,23 @@ extern DLL_IMPORT_DATA const StgPolyInfoTable seq_frame_info;
    we have one).
    -------------------------------------------------------------------------- */
 
-#ifdef IN_STG_CODE
+#if IN_STG_CODE
 
 static __inline__ void
 SaveThreadState(void)
 {
+  StgTSO *tso;
+
   /* Don't need to save REG_Base, it won't have changed. */
 
-  CurrentTSO->sp       = Sp;
-  CurrentTSO->su       = Su;
-  CurrentTSO->splim    = SpLim;
+  tso = CurrentTSO;
+  tso->sp       = Sp;
+  tso->su       = Su;
+  tso->splim    = SpLim;
   CloseNursery(Hp);
 
 #ifdef REG_CurrentTSO
-  SAVE_CurrentTSO = CurrentTSO;
+  SAVE_CurrentTSO = tso;
 #endif
 #ifdef REG_CurrentNursery
   SAVE_CurrentNursery = CurrentNursery;
@@ -687,14 +703,18 @@ SaveThreadState(void)
 static __inline__ void 
 LoadThreadState (void)
 {
-  Sp    = CurrentTSO->sp;
-  Su    = CurrentTSO->su;
-  SpLim = CurrentTSO->splim;
-  OpenNursery(Hp,HpLim);
+  StgTSO *tso;
 
 #ifdef REG_CurrentTSO
   CurrentTSO = SAVE_CurrentTSO;
 #endif
+
+  tso = CurrentTSO;
+  Sp    = tso->sp;
+  Su    = tso->su;
+  SpLim = tso->splim;
+  OpenNursery(Hp,HpLim);
+
 #ifdef REG_CurrentNursery
   CurrentNursery = SAVE_CurrentNursery;
 #endif
@@ -706,6 +726,38 @@ LoadThreadState (void)
 #endif
 
 /* -----------------------------------------------------------------------------
+   Module initialisation
+   -------------------------------------------------------------------------- */
+
+#define PUSH_INIT_STACK(reg_function)          \
+       *(Sp++) = (W_)reg_function
+
+#define POP_INIT_STACK()                       \
+       *(--Sp)
+
+#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.
    -------------------------------------------------------------------------- */