[project @ 2000-08-18 15:44:28 by simonmar]
[ghc-hetmet.git] / ghc / rts / StgMiscClosures.hc
index 10d8cd0..4d626ad 100644 (file)
@@ -1,7 +1,7 @@
 /* -----------------------------------------------------------------------------
- * $Id: StgMiscClosures.hc,v 1.26 1999/07/06 16:40:27 sewardj Exp $
+ * $Id: StgMiscClosures.hc,v 1.47 2000/08/02 14:13:28 rrt Exp $
  *
- * (c) The GHC Team, 1998-1999
+ * (c) The GHC Team, 1998-2000
  *
  * Entry code for various built-in closure types.
  *
@@ -9,25 +9,44 @@
 
 #include "Rts.h"
 #include "RtsUtils.h"
+#include "RtsFlags.h"
 #include "StgMiscClosures.h"
 #include "HeapStackCheck.h"   /* for stg_gen_yield */
 #include "Storage.h"
 #include "StoragePriv.h"
-#include "ProfRts.h"
+#include "Profiling.h"
+#include "Prelude.h"
+#include "SMP.h"
+#if defined(GRAN) || defined(PAR)
+# include "GranSimRts.h"      /* for DumpRawGranEvent */
+# include "StgRun.h"   /* for StgReturn and register saving */
+#endif
 
 #ifdef HAVE_STDIO_H
 #include <stdio.h>
 #endif
 
-/* ToDo: make the printing of panics more Win32-friendly, i.e.,
+/* ToDo: make the printing of panics more win32-friendly, i.e.,
  *       pop up some lovely message boxes (as well).
  */
-#define DUMP_ERRMSG(msg) STGCALL1(fflush,stdout); STGCALL2(fprintf,stderr,msg)
+#define DUMP_ERRMSG(msg) STGCALL2(fprintf,stderr,msg)
+
+/*
+  Template for the entry code of non-enterable closures.
+*/
+
+#define NON_ENTERABLE_ENTRY_CODE(type)                                 \
+STGFUN(type##_entry)                                                   \
+{                                                                      \
+  FB_                                                                  \
+    DUMP_ERRMSG(#type " object entered!\n");                            \
+    STGCALL1(shutdownHaskellAndExit, EXIT_FAILURE);                    \
+    return NULL;                                                       \
+  FE_                                                                  \
+}
 
 /* -----------------------------------------------------------------------------
    Entry code for an indirection.
-
-   This code assumes R1 is in a register for now.
    -------------------------------------------------------------------------- */
 
 INFO_TABLE(IND_info,IND_entry,1,0,IND,,EF_,0,0);
@@ -47,14 +66,13 @@ STGFUN(IND_STATIC_entry)
 {
     FB_
     TICK_ENT_IND(Node);        /* tick */
-  
     R1.p = (P_) ((StgIndStatic*)R1.p)->indirectee;
     TICK_ENT_VIA_NODE();
     JMP_(ENTRY_CODE(*R1.p));
     FE_
 }
 
-INFO_TABLE(IND_PERM_info,IND_PERM_entry,1,1,IND_PERM,,EF_,0,0);
+INFO_TABLE(IND_PERM_info,IND_PERM_entry,1,1,IND_PERM,,EF_,"IND_PERM","IND_PERM");
 STGFUN(IND_PERM_entry)
 {
     FB_
@@ -173,61 +191,196 @@ STGFUN(CAF_ENTERED_entry)
    waiting for the evaluation of the closure to finish.
    -------------------------------------------------------------------------- */
 
-/* Note: a black hole must be big enough to be overwritten with an
- * indirection/evacuee/catch.  Thus we claim it has 1 non-pointer word of
- * payload (in addition to the pointer word for the blocking queue), which 
- * should be big enough for an old-generation indirection.  
+/* Note: a BLACKHOLE and BLACKHOLE_BQ must be big enough to be
+ * overwritten with an indirection/evacuee/catch.  Thus we claim it
+ * has 1 non-pointer word of payload (in addition to the pointer word
+ * for the blocking queue in a BQ), which should be big enough for an
+ * old-generation indirection. 
  */
 
-INFO_TABLE(BLACKHOLE_info, BLACKHOLE_entry,0,2,BLACKHOLE,,EF_,0,0);
+INFO_TABLE(BLACKHOLE_info, BLACKHOLE_entry,0,2,BLACKHOLE,,EF_,"BLACKHOLE","BLACKHOLE");
 STGFUN(BLACKHOLE_entry)
 {
   FB_
+#if defined(GRAN)
+    /* Before overwriting TSO_LINK */
+    STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1.p /*Node*/);
+#endif
+
+#ifdef SMP
+    {
+      bdescr *bd = Bdescr(R1.p);
+      if (bd->back != (bdescr *)BaseReg) {
+       if (bd->gen->no >= 1 || bd->step->no >= 1) {
+         CMPXCHG(R1.cl->header.info, &BLACKHOLE_info, &WHITEHOLE_info);
+       } else {
+         EXTFUN_RTS(stg_gc_enter_1_hponly);
+         JMP_(stg_gc_enter_1_hponly);
+       }
+      }
+    }
+#endif
     TICK_ENT_BH();
 
-    /* Change the BLACKHOLE into a BLACKHOLE_BQ */
-    ((StgBlockingQueue *)R1.p)->header.info = &BLACKHOLE_BQ_info;
     /* Put ourselves on the blocking queue for this black hole */
-    CurrentTSO->link = (StgTSO *)&END_TSO_QUEUE_closure;
+#if defined(GRAN) || defined(PAR)
+    /* in fact, only difference is the type of the end-of-queue marker! */
+    CurrentTSO->link = END_BQ_QUEUE;
+    ((StgBlockingQueue *)R1.p)->blocking_queue = (StgBlockingQueueElement *)CurrentTSO;
+#else
+    CurrentTSO->link = END_TSO_QUEUE;
     ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
-    CurrentTSO->blocked_on = R1.cl;
+#endif
+    /* jot down why and on what closure we are blocked */
+    CurrentTSO->why_blocked = BlockedOnBlackHole;
+    CurrentTSO->block_info.closure = R1.cl;
+    /* closure is mutable since something has just been added to its BQ */
     recordMutable((StgMutClosure *)R1.cl);
+    /* Change the BLACKHOLE into a BLACKHOLE_BQ */
+    ((StgBlockingQueue *)R1.p)->header.info = &BLACKHOLE_BQ_info;
+
+    /* PAR: dumping of event now done in blockThread -- HWL */
 
     /* stg_gen_block is too heavyweight, use a specialised one */
     BLOCK_NP(1);
+
   FE_
 }
 
-INFO_TABLE(BLACKHOLE_BQ_info, BLACKHOLE_BQ_entry,1,1,BLACKHOLE_BQ,,EF_,0,0);
+INFO_TABLE(BLACKHOLE_BQ_info, BLACKHOLE_BQ_entry,1,1,BLACKHOLE_BQ,,EF_,"BLACKHOLE","BLACKHOLE");
 STGFUN(BLACKHOLE_BQ_entry)
 {
   FB_
+#if defined(GRAN)
+    /* Before overwriting TSO_LINK */
+    STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1.p /*Node*/);
+#endif
+
+#ifdef SMP
+    {
+      bdescr *bd = Bdescr(R1.p);
+      if (bd->back != (bdescr *)BaseReg) {
+       if (bd->gen->no >= 1 || bd->step->no >= 1) {
+         CMPXCHG(R1.cl->header.info, &BLACKHOLE_info, &WHITEHOLE_info);
+       } else {
+         EXTFUN_RTS(stg_gc_enter_1_hponly);
+         JMP_(stg_gc_enter_1_hponly);
+       }
+      }
+    }
+#endif
+
     TICK_ENT_BH();
 
     /* Put ourselves on the blocking queue for this black hole */
-    CurrentTSO->blocked_on = R1.cl;
     CurrentTSO->link = ((StgBlockingQueue *)R1.p)->blocking_queue;
     ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
+    /* jot down why and on what closure we are blocked */
+    CurrentTSO->why_blocked = BlockedOnBlackHole;
+    CurrentTSO->block_info.closure = R1.cl;
+#ifdef SMP
+    ((StgBlockingQueue *)R1.p)->header.info = &BLACKHOLE_BQ_info;
+#endif
+
+    /* PAR: dumping of event now done in blockThread -- HWL */
 
     /* stg_gen_block is too heavyweight, use a specialised one */
     BLOCK_NP(1);
   FE_
 }
 
+/*
+   Revertible black holes are needed in the parallel world, to handle
+   negative acknowledgements of messages containing updatable closures.
+   The idea is that when the original message is transmitted, the closure
+   is turned into a revertible black hole...an object which acts like a
+   black hole when local threads try to enter it, but which can be reverted
+   back to the original closure if necessary.
+
+   It's actually a lot like a blocking queue (BQ) entry, because revertible
+   black holes are initially set up with an empty blocking queue.
+*/
+
+#if defined(PAR) || defined(GRAN)
+
+INFO_TABLE(RBH_info, RBH_entry,1,1,RBH,,EF_,0,0);
+STGFUN(RBH_entry)
+{
+  FB_
+# if defined(GRAN)
+    /* mainly statistics gathering for GranSim simulation */
+    STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1.p /*Node*/);
+# endif
+
+    /* exactly the same as a BLACKHOLE_BQ_entry -- HWL */
+    /* Put ourselves on the blocking queue for this black hole */
+    CurrentTSO->link = ((StgBlockingQueue *)R1.p)->blocking_queue;
+    ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
+    /* jot down why and on what closure we are blocked */
+    CurrentTSO->why_blocked = BlockedOnBlackHole;
+    CurrentTSO->block_info.closure = R1.cl;
+
+    /* PAR: dumping of event now done in blockThread -- HWL */
+
+    /* stg_gen_block is too heavyweight, use a specialised one */
+    BLOCK_NP(1); 
+  FE_
+}
+
+INFO_TABLE(RBH_Save_0_info, RBH_Save_0_entry,0,2,CONSTR,,EF_,0,0);
+NON_ENTERABLE_ENTRY_CODE(RBH_Save_0);
+
+INFO_TABLE(RBH_Save_1_info, RBH_Save_1_entry,1,1,CONSTR,,EF_,0,0);
+NON_ENTERABLE_ENTRY_CODE(RBH_Save_1);
+
+INFO_TABLE(RBH_Save_2_info, RBH_Save_2_entry,2,0,CONSTR,,EF_,0,0);
+NON_ENTERABLE_ENTRY_CODE(RBH_Save_2);
+#endif /* defined(PAR) || defined(GRAN) */
+
 /* identical to BLACKHOLEs except for the infotag */
-INFO_TABLE(CAF_BLACKHOLE_info, CAF_BLACKHOLE_entry,0,2,CAF_BLACKHOLE,,EF_,0,0);
+INFO_TABLE(CAF_BLACKHOLE_info, CAF_BLACKHOLE_entry,0,2,CAF_BLACKHOLE,,EF_,"CAF_BLACKHOLE","CAF_BLACKHOLE");
 STGFUN(CAF_BLACKHOLE_entry)
 {
   FB_
+#if defined(GRAN)
+    /* mainly statistics gathering for GranSim simulation */
+    STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1.p /*Node*/);
+#endif
+
+#ifdef SMP
+    {
+      bdescr *bd = Bdescr(R1.p);
+      if (bd->back != (bdescr *)BaseReg) {
+       if (bd->gen->no >= 1 || bd->step->no >= 1) {
+         CMPXCHG(R1.cl->header.info, &CAF_BLACKHOLE_info, &WHITEHOLE_info);
+       } else {
+         EXTFUN_RTS(stg_gc_enter_1_hponly);
+         JMP_(stg_gc_enter_1_hponly);
+       }
+      }
+    }
+#endif
+
     TICK_ENT_BH();
 
-    /* Change the BLACKHOLE into a BLACKHOLE_BQ */
-    ((StgBlockingQueue *)R1.p)->header.info = &BLACKHOLE_BQ_info;
     /* Put ourselves on the blocking queue for this black hole */
-    CurrentTSO->link = (StgTSO *)&END_TSO_QUEUE_closure;
+#if defined(GRAN) || defined(PAR)
+    /* in fact, only difference is the type of the end-of-queue marker! */
+    CurrentTSO->link = END_BQ_QUEUE;
+    ((StgBlockingQueue *)R1.p)->blocking_queue = (StgBlockingQueueElement *)CurrentTSO;
+#else
+    CurrentTSO->link = END_TSO_QUEUE;
     ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
-    CurrentTSO->blocked_on = R1.cl;
+#endif
+    /* jot down why and on what closure we are blocked */
+    CurrentTSO->why_blocked = BlockedOnBlackHole;
+    CurrentTSO->block_info.closure = R1.cl;
+    /* closure is mutable since something has just been added to its BQ */
     recordMutable((StgMutClosure *)R1.cl);
+    /* Change the CAF_BLACKHOLE into a BLACKHOLE_BQ */
+    ((StgBlockingQueue *)R1.p)->header.info = &BLACKHOLE_BQ_info;
+
+    /* PAR: dumping of event now done in blockThread -- HWL */
 
     /* stg_gen_block is too heavyweight, use a specialised one */
     BLOCK_NP(1);
@@ -239,10 +392,8 @@ INFO_TABLE(SE_BLACKHOLE_info, SE_BLACKHOLE_entry,0,2,SE_BLACKHOLE,,EF_,0,0);
 STGFUN(SE_BLACKHOLE_entry)
 {
   FB_
-    STGCALL1(fflush,stdout);                                           
     STGCALL3(fprintf,stderr,"SE_BLACKHOLE at %p entered!\n",R1.p);
-    STGCALL1(raiseError, errorHandler);
-    stg_exit(EXIT_FAILURE); /* not executed */
+    STGCALL1(shutdownHaskellAndExit,EXIT_FAILURE);
   FE_
 }
 
@@ -250,10 +401,18 @@ INFO_TABLE(SE_CAF_BLACKHOLE_info, SE_CAF_BLACKHOLE_entry,0,2,SE_CAF_BLACKHOLE,,E
 STGFUN(SE_CAF_BLACKHOLE_entry)
 {
   FB_
-    STGCALL1(fflush,stdout);                                           
     STGCALL3(fprintf,stderr,"SE_CAF_BLACKHOLE at %p entered!\n",R1.p);
-    STGCALL1(raiseError, errorHandler);
-    stg_exit(EXIT_FAILURE); /* not executed */
+    STGCALL1(shutdownHaskellAndExit,EXIT_FAILURE);
+  FE_
+}
+#endif
+
+#ifdef SMP
+INFO_TABLE(WHITEHOLE_info, WHITEHOLE_entry,0,2,CONSTR_NOCAF_STATIC,,EF_,0,0);
+STGFUN(WHITEHOLE_entry)
+{
+  FB_
+     JMP_(GET_ENTRY(R1.cl));
   FE_
 }
 #endif
@@ -261,7 +420,7 @@ STGFUN(SE_CAF_BLACKHOLE_entry)
 /* -----------------------------------------------------------------------------
    The code for a BCO returns to the scheduler
    -------------------------------------------------------------------------- */
-INFO_TABLE(BCO_info,BCO_entry,0,0,BCO,,EF_,0,0);
+INFO_TABLE(BCO_info,BCO_entry,0,0,BCO,,EF_,"BCO","BCO");
 EF_(BCO_entry) {                               
   FB_  
     Sp -= 1;
@@ -273,19 +432,10 @@ EF_(BCO_entry) {
 /* -----------------------------------------------------------------------------
    Some static info tables for things that don't get entered, and
    therefore don't need entry code (i.e. boxed but unpointed objects)
+   NON_ENTERABLE_ENTRY_CODE now defined at the beginning of the file
    -------------------------------------------------------------------------- */
 
-#define NON_ENTERABLE_ENTRY_CODE(type)                                 \
-STGFUN(type##_entry)                                                   \
-{                                                                      \
-  FB_                                                                  \
-    DUMP_ERRMSG(#type " object entered!\n");                            \
-    STGCALL1(raiseError, errorHandler);                                        \
-    stg_exit(EXIT_FAILURE); /* not executed */                         \
-  FE_                                                                  \
-}
-
-INFO_TABLE(TSO_info, TSO_entry, 0,0,TSO,,EF_,0,0);
+INFO_TABLE(TSO_info, TSO_entry, 0,0,TSO,,EF_,"TSO","TSO");
 NON_ENTERABLE_ENTRY_CODE(TSO);
 
 /* -----------------------------------------------------------------------------
@@ -304,10 +454,10 @@ NON_ENTERABLE_ENTRY_CODE(EVACUATED);
    live weak pointers with dead ones).
    -------------------------------------------------------------------------- */
 
-INFO_TABLE(WEAK_info,WEAK_entry,0,4,WEAK,,EF_,0,0);
+INFO_TABLE(WEAK_info,WEAK_entry,0,4,WEAK,,EF_,"WEAK","WEAK");
 NON_ENTERABLE_ENTRY_CODE(WEAK);
 
-INFO_TABLE_CONSTR(DEAD_WEAK_info,DEAD_WEAK_entry,0,1,0,CONSTR,,EF_,0,0);
+INFO_TABLE_CONSTR(DEAD_WEAK_info,DEAD_WEAK_entry,0,1,0,CONSTR,,EF_,"DEAD_WEAK","DEAD_WEAK");
 NON_ENTERABLE_ENTRY_CODE(DEAD_WEAK);
 
 /* -----------------------------------------------------------------------------
@@ -321,20 +471,20 @@ INFO_TABLE_CONSTR(NO_FINALIZER_info,NO_FINALIZER_entry,0,0,0,CONSTR_NOCAF_STATIC
 NON_ENTERABLE_ENTRY_CODE(NO_FINALIZER);
 
 SET_STATIC_HDR(NO_FINALIZER_closure,NO_FINALIZER_info,0/*CC*/,,EI_)
-};
+, /*payload*/{} };
 
 /* -----------------------------------------------------------------------------
    Foreign Objects are unlifted and therefore never entered.
    -------------------------------------------------------------------------- */
 
-INFO_TABLE(FOREIGN_info,FOREIGN_entry,0,1,FOREIGN,,EF_,0,0);
+INFO_TABLE(FOREIGN_info,FOREIGN_entry,0,1,FOREIGN,,EF_,"FOREIGN","FOREIGN");
 NON_ENTERABLE_ENTRY_CODE(FOREIGN);
 
 /* -----------------------------------------------------------------------------
    Stable Names are unlifted too.
    -------------------------------------------------------------------------- */
 
-INFO_TABLE(STABLE_NAME_info,STABLE_NAME_entry,0,1,STABLE_NAME,,EF_,0,0);
+INFO_TABLE(STABLE_NAME_info,STABLE_NAME_entry,0,1,STABLE_NAME,,EF_,"STABLE_NAME","STABLE_NAME");
 NON_ENTERABLE_ENTRY_CODE(STABLE_NAME);
 
 /* -----------------------------------------------------------------------------
@@ -344,10 +494,10 @@ NON_ENTERABLE_ENTRY_CODE(STABLE_NAME);
    and entry code for each type.
    -------------------------------------------------------------------------- */
 
-INFO_TABLE(FULL_MVAR_info,FULL_MVAR_entry,4,0,MVAR,,EF_,0,0);
+INFO_TABLE(FULL_MVAR_info,FULL_MVAR_entry,4,0,MVAR,,EF_,"MVAR","MVAR");
 NON_ENTERABLE_ENTRY_CODE(FULL_MVAR);
 
-INFO_TABLE(EMPTY_MVAR_info,EMPTY_MVAR_entry,4,0,MVAR,,EF_,0,0);
+INFO_TABLE(EMPTY_MVAR_info,EMPTY_MVAR_entry,4,0,MVAR,,EF_,"MVAR","MVAR");
 NON_ENTERABLE_ENTRY_CODE(EMPTY_MVAR);
 
 /* -----------------------------------------------------------------------------
@@ -361,7 +511,7 @@ INFO_TABLE_CONSTR(END_TSO_QUEUE_info,END_TSO_QUEUE_entry,0,0,0,CONSTR_NOCAF_STAT
 NON_ENTERABLE_ENTRY_CODE(END_TSO_QUEUE);
 
 SET_STATIC_HDR(END_TSO_QUEUE_closure,END_TSO_QUEUE_info,0/*CC*/,,EI_)
-};
+, /*payload*/{} };
 
 /* -----------------------------------------------------------------------------
    Mutable lists
@@ -375,12 +525,25 @@ INFO_TABLE_CONSTR(END_MUT_LIST_info,END_MUT_LIST_entry,0,0,0,CONSTR_NOCAF_STATIC
 NON_ENTERABLE_ENTRY_CODE(END_MUT_LIST);
 
 SET_STATIC_HDR(END_MUT_LIST_closure,END_MUT_LIST_info,0/*CC*/,,EI_)
-};
+, /*payload*/{} };
 
 INFO_TABLE(MUT_CONS_info, MUT_CONS_entry, 1, 1, MUT_VAR, , EF_, 0, 0);
 NON_ENTERABLE_ENTRY_CODE(MUT_CONS);
 
 /* -----------------------------------------------------------------------------
+   Exception lists
+   -------------------------------------------------------------------------- */
+
+INFO_TABLE_CONSTR(END_EXCEPTION_LIST_info,END_EXCEPTION_LIST_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,0,0);
+NON_ENTERABLE_ENTRY_CODE(END_EXCEPTION_LIST);
+
+SET_STATIC_HDR(END_EXCEPTION_LIST_closure,END_EXCEPTION_LIST_info,0/*CC*/,,EI_)
+, /*payload*/{} };
+
+INFO_TABLE(EXCEPTION_CONS_info, EXCEPTION_CONS_entry, 1, 1, CONSTR, , EF_, 0, 0);
+NON_ENTERABLE_ENTRY_CODE(EXCEPTION_CONS);
+
+/* -----------------------------------------------------------------------------
    Arrays
 
    These come in two basic flavours: arrays of data (StgArrWords) and arrays of
@@ -396,7 +559,7 @@ NON_ENTERABLE_ENTRY_CODE(MUT_CONS);
    -------------------------------------------------------------------------- */
 
 #define ArrayInfo(type)                                        \
-INFO_TABLE(type##_info, type##_entry, 0, 0, type, , EF_,0,0);
+INFO_TABLE(type##_info, type##_entry, 0, 0, type, , EF_,"" # type "","" # type "");
 
 ArrayInfo(ARR_WORDS);
 NON_ENTERABLE_ENTRY_CODE(ARR_WORDS);
@@ -411,7 +574,7 @@ NON_ENTERABLE_ENTRY_CODE(MUT_ARR_PTRS_FROZEN);
    Mutable Variables
    -------------------------------------------------------------------------- */
 
-INFO_TABLE(MUT_VAR_info, MUT_VAR_entry, 1, 1, MUT_VAR, , EF_, 0, 0);
+INFO_TABLE(MUT_VAR_info, MUT_VAR_entry, 1, 1, MUT_VAR, , EF_, "MUT_VAR", "MUT_VAR");
 NON_ENTERABLE_ENTRY_CODE(MUT_VAR);
 
 /* -----------------------------------------------------------------------------
@@ -420,16 +583,17 @@ NON_ENTERABLE_ENTRY_CODE(MUT_VAR);
    This is used for filling in vector-table entries that can never happen,
    for instance.
    -------------------------------------------------------------------------- */
-
+/* No longer used; we use NULL, because a) it never happens, right? and b)
+   Windows doesn't like DLL entry points being used as static initialisers
 STGFUN(stg_error_entry)                                                        \
 {                                                                      \
   FB_                                                                  \
     DUMP_ERRMSG("fatal: stg_error_entry");                              \
-    STGCALL1(raiseError, errorHandler);                                        \
-    exit(EXIT_FAILURE); /* not executed */                             \
+    STGCALL1(shutdownHaskellAndExit, EXIT_FAILURE);                    \
+    return NULL;                                                       \
   FE_                                                                  \
 }
-
+*/
 /* -----------------------------------------------------------------------------
    Dummy return closure
  
@@ -448,8 +612,8 @@ FN_(dummy_ret_entry)
   JMP_(ENTRY_CODE(ret_addr));
   FE_
 }
-SET_STATIC_HDR(dummy_ret_closure,dummy_ret_info,CCS_DONTZuCARE,,EI_)
-};
+SET_STATIC_HDR(dummy_ret_closure,dummy_ret_info,CCS_DONT_CARE,,EI_)
+, /*payload*/{} };
 
 /* -----------------------------------------------------------------------------
     Strict IO application - performing an IO action and entering its result.
@@ -464,6 +628,7 @@ SET_STATIC_HDR(dummy_ret_closure,dummy_ret_info,CCS_DONTZuCARE,,EI_)
 
  * -------------------------------------------------------------------------- */
 
+#ifdef REG_R1
 INFO_TABLE_SRT_BITMAP(forceIO_ret_info,forceIO_ret_entry,0,0,0,0,RET_SMALL,,EF_,0,0);
 FN_(forceIO_ret_entry)
 {
@@ -473,9 +638,22 @@ FN_(forceIO_ret_entry)
   PUSH_SEQ_FRAME(Sp);
   JMP_(GET_ENTRY(R1.cl));
 }
+#else
+INFO_TABLE_SRT_BITMAP(forceIO_ret_info,forceIO_ret_entry,0,0,0,0,RET_SMALL,,EF_,0,0);
+FN_(forceIO_ret_entry)
+{
+  StgClosure *rval;
+  FB_
+  rval = (StgClosure *)Sp[0];
+  Sp += 2;
+  Sp -= sizeofW(StgSeqFrame);
+  PUSH_SEQ_FRAME(Sp);
+  R1.cl = rval;
+  JMP_(GET_ENTRY(R1.cl));
+}
+#endif
 
-
-INFO_TABLE(forceIO_info,forceIO_entry,1,0,FUN,,EF_,0,0);
+INFO_TABLE(forceIO_info,forceIO_entry,1,0,FUN_STATIC,,EF_,0,0);
 FN_(forceIO_entry)
 {
   FB_
@@ -489,8 +667,8 @@ FN_(forceIO_entry)
   JMP_(GET_ENTRY(R1.cl));
   FE_
 }
-SET_STATIC_HDR(forceIO_closure,forceIO_info,CCS_DONTZuCARE,,EI_)
-};
+SET_STATIC_HDR(forceIO_closure,forceIO_info,CCS_DONT_CARE,,EI_)
+, /*payload*/{} };
 
 
 /* -----------------------------------------------------------------------------
@@ -529,31 +707,6 @@ VEC_POLY_INFO_TABLE(ret_bco,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO,
 
 #endif /* INTERPRETER */
 
-#ifndef COMPILER
-
-INFO_TABLE_CONSTR(Czh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgChar),0,CONSTR,,EF_,0,0);
-INFO_TABLE_CONSTR(Izh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgInt),0,CONSTR,,EF_,0,0);
-INFO_TABLE_CONSTR(I64zh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgInt64),0,CONSTR,,EF_,0,0);
-INFO_TABLE_CONSTR(Fzh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgFloat),0,CONSTR,,EF_,0,0);
-INFO_TABLE_CONSTR(Dzh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgDouble),0,CONSTR,,EF_,0,0);
-INFO_TABLE_CONSTR(Azh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgAddr),0,CONSTR,,EF_,0,0);
-INFO_TABLE_CONSTR(Wzh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgWord),0,CONSTR,,EF_,0,0);
-INFO_TABLE_CONSTR(StablePtr_con_info,Hugs_CONSTR_entry,0,sizeofW(StgStablePtr),0,CONSTR,,EF_,0,0);
-
-/* These might seem redundant but {I,C}zh_static_info are used in
- * {INT,CHAR}LIKE and the rest are used in RtsAPI.c
- */
-INFO_TABLE_CONSTR(Czh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgChar),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
-INFO_TABLE_CONSTR(Izh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgInt),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
-INFO_TABLE_CONSTR(I64zh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgInt64),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
-INFO_TABLE_CONSTR(Fzh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgFloat),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
-INFO_TABLE_CONSTR(Dzh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgDouble),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
-INFO_TABLE_CONSTR(Azh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgAddr),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
-INFO_TABLE_CONSTR(Wzh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgWord),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
-INFO_TABLE_CONSTR(StablePtr_static_info,Hugs_CONSTR_entry,0,sizeofW(StgStablePtr),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
-
-#endif /* !defined(COMPILER) */
-
 /* -----------------------------------------------------------------------------
    CHARLIKE and INTLIKE closures.  
 
@@ -562,7 +715,7 @@ INFO_TABLE_CONSTR(StablePtr_static_info,Hugs_CONSTR_entry,0,sizeofW(StgStablePtr
    replace them with references to the static objects.
    -------------------------------------------------------------------------- */
 
-#ifdef ENABLE_WIN32_DLL_SUPPORT
+#if defined(INTERPRETER) || defined(ENABLE_WIN32_DLL_SUPPORT)
 /*
  * When sticking the RTS in a DLL, we delay populating the
  * Charlike and Intlike tables until load-time, which is only
@@ -574,21 +727,21 @@ static INFO_TBL_CONST StgInfoTable izh_static_info;
 #define Char_hash_static_info czh_static_info
 #define Int_hash_static_info izh_static_info
 #else
-#define Char_hash_static_info Czh_static_info
-#define Int_hash_static_info Izh_static_info
+#define Char_hash_static_info PrelBase_Czh_static_info
+#define Int_hash_static_info PrelBase_Izh_static_info
 #endif
 
 #define CHARLIKE_HDR(n)                                                \
        {                                                       \
          STATIC_HDR(Char_hash_static_info, /* C# */            \
-                        CCS_DONTZuCARE),                       \
+                        CCS_DONT_CARE),                        \
           data : n                                             \
        }
                                             
 #define INTLIKE_HDR(n)                                         \
        {                                                       \
          STATIC_HDR(Int_hash_static_info,  /* I# */            \
-                        CCS_DONTZuCARE),                       \
+                        CCS_DONT_CARE),                        \
           data : n                                             \
        }