[project @ 2000-03-14 09:55:05 by simonmar]

Handle references from the RTS to the Prelude in a more consistent
way.

	- For statically-linked binaries, nothing has changed.

	- For the interpreter, refs from the RTS to the Prelude
	  are now indirected.  The indirections need to be
	  filled in at some point during startup by calling
	  fixupPreludeRefs (in Prelude.c).

	- The CHARLIKE and INTLIKE tables are now handled in
	  the same way for both Hugs and DLLs.

Hugs will be broken for a short while until Julian sorts out the Hugs
parts of this change.

diff --git a/ghc/rts/Main.c b/ghc/rts/Main.c
index 154eaa4..e5e00c7 100644 (file)
--- a/ghc/rts/Main.c
+++ b/ghc/rts/Main.c
@@ -1,7 +1,7 @@
 /* -----------------------------------------------------------------------------
- * $Id: Main.c,v 1.17 2000/03/13 10:53:55 simonmar Exp $
+ * $Id: Main.c,v 1.18 2000/03/14 09:55:05 simonmar Exp $
  *
- * (c) The GHC Team 1998-1999
+ * (c) The GHC Team 1998-2000
  *
  * Main function for a standalone Haskell program.
  *
@@ -80,7 +80,7 @@ int main(int argc, char *argv[])
       fprintf(stderr, "Main Thread Started ...\n");
 
       /* ToDo: Dump event for the main thread */
-      status = rts_evalIO((StgClosure *)&mainIO_closure, NULL);
+      status = rts_evalIO(mainIO_closure, NULL);
     } else {
       /* Just to show we're alive */
       IF_PAR_DEBUG(verbose,
@@ -94,12 +94,12 @@ int main(int argc, char *argv[])
 #  elif defined(GRAN)
 
     /* ToDo: Dump event for the main thread */
-    status = rts_evalIO((StgClosure *)&mainIO_closure, NULL);
+    status = rts_evalIO(mainIO_closure, NULL);
 
 #  else /* !PAR && !GRAN */
 
     /* ToDo: want to start with a larger stack size */
-    status = rts_evalIO((StgClosure *)&mainIO_closure, NULL);
+    status = rts_evalIO((StgClosure *)mainIO_closure, NULL);
 
 #  endif /* !PAR && !GRAN */
 

diff --git a/ghc/rts/Prelude.h b/ghc/rts/Prelude.h
index 0e3aeec..4965dd6 100644 (file)
--- a/ghc/rts/Prelude.h
+++ b/ghc/rts/Prelude.h
@@ -1,7 +1,7 @@
 /* -----------------------------------------------------------------------------
- * $Id: Prelude.h,v 1.2 2000/03/13 13:00:00 sewardj Exp $
+ * $Id: Prelude.h,v 1.3 2000/03/14 09:55:05 simonmar Exp $
  *
- * (c) The GHC Team, 1998-1999
+ * (c) The GHC Team, 1998-2000
  *
  * Prelude identifiers that we sometimes need to refer to in the RTS.
  *
@@ -10,11 +10,11 @@
 #ifndef PRELUDE_H
 #define PRELUDE_H
 
-#ifdef COMPILING_RTS
+/* Define canonical names so we can abstract away from the actual
+ * module these names are defined in.
+ */
 
-#ifdef COMPILER
-extern DLL_IMPORT const StgClosure PrelBase_Z91Z93_static_closure;
-extern DLL_IMPORT const StgClosure PrelBase_Z40Z41_static_closure;
+#ifndef INTERPRETER
 extern DLL_IMPORT const StgClosure PrelBase_True_static_closure;
 extern DLL_IMPORT const StgClosure PrelBase_False_static_closure;
 extern DLL_IMPORT const StgClosure PrelPack_unpackCString_closure;
@@ -41,66 +41,89 @@ extern DLL_IMPORT const StgInfoTable PrelAddr_W64zh_con_info;
 extern DLL_IMPORT const StgInfoTable PrelStable_StablePtr_static_info;
 extern DLL_IMPORT const StgInfoTable PrelStable_StablePtr_con_info;
 
-/* Define canonical names so we can abstract away from the actual
- * module these names are defined in.
- */
-
-#define Nil_closure            PrelBase_ZMZN_static_closure
-#define Unit_closure           PrelBase_Z0T_static_closure
-#define True_closure           PrelBase_True_static_closure
-#define False_closure          PrelBase_False_static_closure
-#define stackOverflow_closure  PrelException_stackOverflow_closure
-#define heapOverflow_closure   PrelException_heapOverflow_closure
-#define PutFullMVar_closure    PrelException_PutFullMVar_static_closure
-#define NonTermination_closure PrelException_NonTermination_static_closure
-#define Czh_static_info        PrelBase_Czh_static_info
-#define Izh_static_info        PrelBase_Izh_static_info
-#define Fzh_static_info        PrelFloat_Fzh_static_info
-#define Dzh_static_info        PrelFloat_Dzh_static_info
-#define Azh_static_info        PrelAddr_Azh_static_info
-#define Wzh_static_info        PrelAddr_Wzh_static_info
-#define Czh_con_info           PrelBase_Czh_con_info
-#define Izh_con_info           PrelBase_Izh_con_info
-#define Fzh_con_info           PrelFloat_Fzh_con_info
-#define Dzh_con_info           PrelFloat_Dzh_con_info
-#define Azh_con_info           PrelAddr_Azh_con_info
-#define Wzh_con_info           PrelAddr_Wzh_con_info
-#define W64zh_con_info         PrelAddr_W64zh_con_info
-#define I64zh_con_info         PrelAddr_I64zh_con_info
-#define StablePtr_static_info  PrelStable_StablePtr_static_info
-#define StablePtr_con_info     PrelStable_StablePtr_con_info
-
-#define mainIO_closure         PrelMain_mainIO_closure
-#define unpackCString_closure  PrelPack_unpackCString_closure
+#define True_closure           (&PrelBase_True_static_closure)
+#define False_closure          (&PrelBase_False_static_closure)
+#define stackOverflow_closure  (&PrelException_stackOverflow_closure)
+#define heapOverflow_closure   (&PrelException_heapOverflow_closure)
+#define PutFullMVar_closure    (&PrelException_PutFullMVar_static_closure)
+#define NonTermination_closure (&PrelException_NonTermination_static_closure)
+#define Czh_static_info        (&PrelBase_Czh_static_info)
+#define Izh_static_info        (&PrelBase_Izh_static_info)
+#define Fzh_static_info        (&PrelFloat_Fzh_static_info)
+#define Dzh_static_info        (&PrelFloat_Dzh_static_info)
+#define Azh_static_info        (&PrelAddr_Azh_static_info)
+#define Wzh_static_info        (&PrelAddr_Wzh_static_info)
+#define Czh_con_info           (&PrelBase_Czh_con_info)
+#define Izh_con_info           (&PrelBase_Izh_con_info)
+#define Fzh_con_info           (&PrelFloat_Fzh_con_info)
+#define Dzh_con_info           (&PrelFloat_Dzh_con_info)
+#define Azh_con_info           (&PrelAddr_Azh_con_info)
+#define Wzh_con_info           (&PrelAddr_Wzh_con_info)
+#define W64zh_con_info         (&PrelAddr_W64zh_con_info)
+#define I64zh_con_info         (&PrelAddr_I64zh_con_info)
+#define StablePtr_static_info  (&PrelStable_StablePtr_static_info)
+#define StablePtr_con_info     (&PrelStable_StablePtr_con_info)
+#define mainIO_closure         (&PrelMain_mainIO_closure)
+#define unpackCString_closure  (&PrelPack_unpackCString_closure)
 
-#else /* INTERPRETER, I guess */
+#else /* INTERPRETER */
 
-extern const StgInfoTable Czh_con_info;
-extern const StgInfoTable Izh_con_info;
-extern const StgInfoTable I64zh_con_info;
-extern const StgInfoTable Fzh_con_info;
-extern const StgInfoTable Dzh_con_info;
-extern const StgInfoTable Azh_con_info;
-extern const StgInfoTable Wzh_con_info;
-extern const StgInfoTable StablePtr_con_info;
-
-extern const StgInfoTable Czh_static_info;
-extern const StgInfoTable Izh_static_info;
-extern const StgInfoTable I64zh_static_info;
-extern const StgInfoTable Fzh_static_info;
-extern const StgInfoTable Dzh_static_info;
-extern const StgInfoTable Azh_static_info;
-extern const StgInfoTable Wzh_static_info;
-extern const StgInfoTable StablePtr_static_info;
+/* We need indirections to the Prelude stuff, because we can't link
+ * these symbols statically.
+ */
+extern const StgClosure *ind_True_static_closure;
+extern const StgClosure *ind_False_static_closure;
+extern const StgClosure *ind_unpackCString_closure;
+extern const StgClosure *ind_stackOverflow_closure;
+extern const StgClosure *ind_heapOverflow_closure;
+extern const StgClosure *ind_PutFullMVar_static_closure;
+extern const StgClosure *ind_NonTermination_static_closure;
+extern const StgClosure *ind_mainIO_closure;
 
-#define W64zh_con_info        I64zh_con_info
-#define W64zh_static_info     I64zh_con_info
+extern const StgInfoTable *ind_Czh_static_info;
+extern const StgInfoTable *ind_Izh_static_info;
+extern const StgInfoTable *ind_Fzh_static_info;
+extern const StgInfoTable *ind_Dzh_static_info;
+extern const StgInfoTable *ind_Azh_static_info;
+extern const StgInfoTable *ind_Wzh_static_info;
+extern const StgInfoTable *ind_Czh_con_info;
+extern const StgInfoTable *ind_Izh_con_info;
+extern const StgInfoTable *ind_Fzh_con_info;
+extern const StgInfoTable *ind_Dzh_con_info;
+extern const StgInfoTable *ind_Azh_con_info;
+extern const StgInfoTable *ind_Wzh_con_info;
+extern const StgInfoTable *ind_I64zh_con_info;
+extern const StgInfoTable *ind_W64zh_con_info;
+extern const StgInfoTable *ind_StablePtr_static_info;
+extern const StgInfoTable *ind_StablePtr_con_info;
 
-#define PutFullMVar_closure    PrelException_PutFullMVar_static_closure
-extern const StgInfoTable PutFullMVar_closure;
+#define True_closure           ind_True_static_closure
+#define False_closure          ind_False_static_closure
+#define stackOverflow_closure  ind_stackOverflow_closure
+#define heapOverflow_closure   ind_heapOverflow_closure
+#define PutFullMVar_closure    ind_PutFullMVar_static_closure
+#define NonTermination_closure ind_NonTermination_static_closure
+#define Czh_static_info        ind_Czh_static_info
+#define Izh_static_info        ind_Izh_static_info
+#define Fzh_static_info        ind_Fzh_static_info
+#define Dzh_static_info        ind_Dzh_static_info
+#define Azh_static_info        ind_Azh_static_info
+#define Wzh_static_info        ind_Wzh_static_info
+#define Czh_con_info           ind_Czh_con_info
+#define Izh_con_info           ind_Izh_con_info
+#define Fzh_con_info           ind_Fzh_con_info
+#define Dzh_con_info           ind_Dzh_con_info
+#define Azh_con_info           ind_Azh_con_info
+#define Wzh_con_info           ind_Wzh_con_info
+#define W64zh_con_info         ind_W64zh_con_info
+#define I64zh_con_info         ind_I64zh_con_info
+#define StablePtr_static_info  ind_StablePtr_static_info
+#define StablePtr_con_info     ind_StablePtr_con_info
+#define mainIO_closure         ind_mainIO_closure
+#define unpackCString_closure  ind_unpackCString_closure
 
 #endif
 
-#endif /* COMPILING_RTS */
+void fixupPreludeRefs(void);
 
 #endif /* PRELUDE_H */

diff --git a/ghc/rts/PrimOps.hc b/ghc/rts/PrimOps.hc
index 2355569..2322861 100644 (file)
--- a/ghc/rts/PrimOps.hc
+++ b/ghc/rts/PrimOps.hc
@@ -1,7 +1,7 @@
 /* -----------------------------------------------------------------------------
- * $Id: PrimOps.hc,v 1.45 2000/03/13 13:00:00 sewardj Exp $
+ * $Id: PrimOps.hc,v 1.46 2000/03/14 09:55:05 simonmar Exp $
  *
- * (c) The GHC Team, 1998-1999
+ * (c) The GHC Team, 1998-2000
  *
  * Primitive functions / data
  *
@@ -908,7 +908,7 @@ FN_(putMVarzh_fast)
     fprintf(stderr, "fatal: put on a full MVar in Hugs; aborting\n" );
     exit(1);
 #else
-    R1.cl = (StgClosure *)&PutFullMVar_closure;
+    R1.cl = (StgClosure *)PutFullMVar_closure;
     JMP_(raisezh_fast);
 #endif
   }

diff --git a/ghc/rts/RtsAPI.c b/ghc/rts/RtsAPI.c
index 0009fb6..4d5b403 100644 (file)
--- a/ghc/rts/RtsAPI.c
+++ b/ghc/rts/RtsAPI.c
@@ -1,7 +1,7 @@
 /* ----------------------------------------------------------------------------
- * $Id: RtsAPI.c,v 1.11 2000/03/13 10:53:56 simonmar Exp $
+ * $Id: RtsAPI.c,v 1.12 2000/03/14 09:55:05 simonmar Exp $
  *
- * (c) The GHC Team, 1998-1999
+ * (c) The GHC Team, 1998-2000
  *
  * API for invoking Haskell functions via the RTS
  *
@@ -22,7 +22,7 @@ HaskellObj
 rts_mkChar (char c)
 {
   StgClosure *p = (StgClosure *)allocate(CONSTR_sizeW(0,1));
-  p->header.info = (const StgInfoTable*)&Czh_con_info;
+  p->header.info = Czh_con_info;
   p->payload[0]  = (StgClosure *)((StgInt)c);
   return p;
 }
@@ -31,7 +31,7 @@ HaskellObj
 rts_mkInt (int i)
 {
   StgClosure *p = (StgClosure *)allocate(CONSTR_sizeW(0,1));
-  p->header.info = (const StgInfoTable*)&Izh_con_info;
+  p->header.info = Izh_con_info;
   p->payload[0]  = (StgClosure *)(StgInt)i;
   return p;
 }
@@ -44,7 +44,7 @@ rts_mkInt8 (int i)
      instead of the one for Int8, but the types have identical
      representation.
   */
-  p->header.info = (const StgInfoTable*)&Izh_con_info;
+  p->header.info = Izh_con_info;
   /* Make sure we mask out the bits above the lowest 8 */
   p->payload[0]  = (StgClosure *)(StgInt)((unsigned)i & 0xff);
   return p;
@@ -58,7 +58,7 @@ rts_mkInt16 (int i)
      instead of the one for Int8, but the types have identical
      representation.
   */
-  p->header.info = (const StgInfoTable*)&Izh_con_info;
+  p->header.info = Izh_con_info;
   /* Make sure we mask out the relevant bits */
   p->payload[0]  = (StgClosure *)(StgInt)((unsigned)i & 0xffff);
   return p;
@@ -69,7 +69,7 @@ rts_mkInt32 (int i)
 {
   StgClosure *p = (StgClosure *)allocate(CONSTR_sizeW(0,1));
   /* see mk_Int8 comment */
-  p->header.info = (const StgInfoTable*)&Izh_con_info;
+  p->header.info = Izh_con_info;
   p->payload[0]  = (StgClosure *)(StgInt)i;
   return p;
 }
@@ -80,7 +80,7 @@ rts_mkInt64 (long long int i)
   long long *tmp;
   StgClosure *p = (StgClosure *)allocate(CONSTR_sizeW(0,2));
   /* see mk_Int8 comment */
-  p->header.info = (const StgInfoTable*)&I64zh_con_info;
+  p->header.info = I64zh_con_info;
   tmp  = (long long*)&(p->payload[0]);
   *tmp = (StgInt64)i;
   return p;
@@ -90,7 +90,7 @@ HaskellObj
 rts_mkWord (unsigned int i)
 {
   StgClosure *p = (StgClosure *)allocate(CONSTR_sizeW(0,1));
-  p->header.info = (const StgInfoTable*)&Wzh_con_info;
+  p->header.info = Wzh_con_info;
   p->payload[0]  = (StgClosure *)(StgWord)i;
   return p;
 }
@@ -100,7 +100,7 @@ rts_mkWord8 (unsigned int w)
 {
   /* see rts_mkInt* comments */
   StgClosure *p = (StgClosure *)allocate(CONSTR_sizeW(0,1));
-  p->header.info = (const StgInfoTable*)&Wzh_con_info;
+  p->header.info = Wzh_con_info;
   p->payload[0]  = (StgClosure *)(StgWord)(w & 0xff);
   return p;
 }
@@ -110,7 +110,7 @@ rts_mkWord16 (unsigned int w)
 {
   /* see rts_mkInt* comments */
   StgClosure *p = (StgClosure *)allocate(CONSTR_sizeW(0,1));
-  p->header.info = (const StgInfoTable*)&Wzh_con_info;
+  p->header.info = Wzh_con_info;
   p->payload[0]  = (StgClosure *)(StgWord)(w & 0xffff);
   return p;
 }
@@ -120,7 +120,7 @@ rts_mkWord32 (unsigned int w)
 {
   /* see rts_mkInt* comments */
   StgClosure *p = (StgClosure *)allocate(CONSTR_sizeW(0,1));
-  p->header.info = (const StgInfoTable*)&Wzh_con_info;
+  p->header.info = Wzh_con_info;
   p->payload[0]  = (StgClosure *)(StgWord)w;
   return p;
 }
@@ -132,7 +132,7 @@ rts_mkWord64 (unsigned long long w)
 
   StgClosure *p = (StgClosure *)allocate(CONSTR_sizeW(0,2));
   /* see mk_Int8 comment */
-  p->header.info = (const StgInfoTable*)&W64zh_con_info;
+  p->header.info = W64zh_con_info;
   tmp  = (unsigned long long*)&(p->payload[0]);
   *tmp = (StgWord64)w;
   return p;
@@ -142,7 +142,7 @@ HaskellObj
 rts_mkFloat (float f)
 {
   StgClosure *p = (StgClosure *)allocate(CONSTR_sizeW(0,1));
-  p->header.info = (const StgInfoTable*)&Fzh_con_info;
+  p->header.info = Fzh_con_info;
   ASSIGN_FLT((P_)p->payload, (StgFloat)f);
   return p;
 }
@@ -151,7 +151,7 @@ HaskellObj
 rts_mkDouble (double d)
 {
   StgClosure *p = (StgClosure *)allocate(CONSTR_sizeW(0,sizeofW(StgDouble)));
-  p->header.info = (const StgInfoTable*)&Dzh_con_info;
+  p->header.info = Dzh_con_info;
   ASSIGN_DBL((P_)p->payload, (StgDouble)d);
   return p;
 }
@@ -160,7 +160,7 @@ HaskellObj
 rts_mkStablePtr (StgStablePtr s)
 {
   StgClosure *p = (StgClosure *)allocate(sizeofW(StgHeader)+1);
-  p->header.info = (const StgInfoTable*)&StablePtr_con_info;
+  p->header.info = StablePtr_con_info;
   p->payload[0]  = (StgClosure *)s;
   return p;
 }
@@ -169,7 +169,7 @@ HaskellObj
 rts_mkAddr (void *a)
 {
   StgClosure *p = (StgClosure *)allocate(sizeofW(StgHeader)+1);
-  p->header.info = (const StgInfoTable*)&Azh_con_info;
+  p->header.info = Azh_con_info;
   p->payload[0]  = (StgClosure *)a;
   return p;
 }
@@ -179,16 +179,16 @@ HaskellObj
 rts_mkBool (int b)
 {
   if (b) {
-    return (StgClosure *)&True_closure;
+    return (StgClosure *)True_closure;
   } else {
-    return (StgClosure *)&False_closure;
+    return (StgClosure *)False_closure;
   }
 }
 
 HaskellObj
 rts_mkString (char *s)
 {
-  return rts_apply((StgClosure *)&unpackCString_closure, rts_mkAddr(s));
+  return rts_apply((StgClosure *)unpackCString_closure, rts_mkAddr(s));
 }
 #endif /* COMPILER */
 
@@ -210,8 +210,8 @@ rts_apply (HaskellObj f, HaskellObj arg)
 char
 rts_getChar (HaskellObj p)
 {
-  if ( p->header.info == (const StgInfoTable*)&Czh_con_info || 
-       p->header.info == (const StgInfoTable*)&Czh_static_info) {
+  if ( p->header.info == Czh_con_info || 
+       p->header.info == Czh_static_info) {
     return (char)(StgWord)(p->payload[0]);
   } else {
     barf("getChar: not a Char");
@@ -222,8 +222,8 @@ int
 rts_getInt (HaskellObj p)
 {
   if ( 1 ||
-       p->header.info == (const StgInfoTable*)&Izh_con_info || 
-       p->header.info == (const StgInfoTable*)&Izh_static_info ) {
+       p->header.info == Izh_con_info || 
+       p->header.info == Izh_static_info ) {
     return (int)(p->payload[0]);
   } else {
     barf("getInt: not an Int");
@@ -234,8 +234,8 @@ int
 rts_getInt32 (HaskellObj p)
 {
   if ( 1 ||
-       p->header.info == (const StgInfoTable*)&Izh_con_info || 
-       p->header.info == (const StgInfoTable*)&Izh_static_info ) {
+       p->header.info == Izh_con_info || 
+       p->header.info == Izh_static_info ) {
     return (int)(p->payload[0]);
   } else {
     barf("getInt: not an Int");
@@ -246,8 +246,8 @@ unsigned int
 rts_getWord (HaskellObj p)
 {
   if ( 1 || /* see above comment */
-       p->header.info == (const StgInfoTable*)&Wzh_con_info ||
-       p->header.info == (const StgInfoTable*)&Wzh_static_info ) {
+       p->header.info == Wzh_con_info ||
+       p->header.info == Wzh_static_info ) {
     return (unsigned int)(p->payload[0]);
   } else {
     barf("getWord: not a Word");
@@ -258,8 +258,8 @@ unsigned int
 rts_getWord32 (HaskellObj p)
 {
   if ( 1 || /* see above comment */
-       p->header.info == (const StgInfoTable*)&Wzh_con_info ||
-       p->header.info == (const StgInfoTable*)&Wzh_static_info ) {
+       p->header.info == Wzh_con_info ||
+       p->header.info == Wzh_static_info ) {
     return (unsigned int)(p->payload[0]);
   } else {
     barf("getWord: not a Word");
@@ -269,8 +269,8 @@ rts_getWord32 (HaskellObj p)
 float
 rts_getFloat (HaskellObj p)
 {
-  if ( p->header.info == (const StgInfoTable*)&Fzh_con_info || 
-       p->header.info == (const StgInfoTable*)&Fzh_static_info ) {
+  if ( p->header.info == Fzh_con_info || 
+       p->header.info == Fzh_static_info ) {
     return (float)(PK_FLT((P_)p->payload));
   } else {
     barf("getFloat: not a Float");
@@ -280,8 +280,8 @@ rts_getFloat (HaskellObj p)
 double
 rts_getDouble (HaskellObj p)
 {
-  if ( p->header.info == (const StgInfoTable*)&Dzh_con_info || 
-       p->header.info == (const StgInfoTable*)&Dzh_static_info ) {
+  if ( p->header.info == Dzh_con_info || 
+       p->header.info == Dzh_static_info ) {
     return (double)(PK_DBL((P_)p->payload));
   } else {
     barf("getDouble: not a Double");
@@ -291,8 +291,8 @@ rts_getDouble (HaskellObj p)
 StgStablePtr
 rts_getStablePtr (HaskellObj p)
 {
-  if ( p->header.info == (const StgInfoTable*)&StablePtr_con_info || 
-       p->header.info == (const StgInfoTable*)&StablePtr_static_info ) {
+  if ( p->header.info == StablePtr_con_info || 
+       p->header.info == StablePtr_static_info ) {
     return (StgStablePtr)(p->payload[0]);
   } else {
     barf("getStablePtr: not a StablePtr");
@@ -302,8 +302,8 @@ rts_getStablePtr (HaskellObj p)
 void *
 rts_getAddr (HaskellObj p)
 {
-  if ( p->header.info == (const StgInfoTable*)&Azh_con_info || 
-       p->header.info == (const StgInfoTable*)&Azh_static_info ) {
+  if ( p->header.info == Azh_con_info || 
+       p->header.info == Azh_static_info ) {
   
     return (void *)(p->payload[0]);
   } else {
@@ -315,9 +315,9 @@ rts_getAddr (HaskellObj p)
 int
 rts_getBool (HaskellObj p)
 {
-  if (p == &True_closure) {
+  if (p == True_closure) {
     return 1;
-  } else if (p == &False_closure) {
+  } else if (p == False_closure) {
     return 0;
   } else {
     barf("getBool: not a Bool");

diff --git a/ghc/rts/RtsStartup.c b/ghc/rts/RtsStartup.c
index e02426a..07605fc 100644 (file)
--- a/ghc/rts/RtsStartup.c
+++ b/ghc/rts/RtsStartup.c
@@ -1,7 +1,7 @@
 /* -----------------------------------------------------------------------------
- * $Id: RtsStartup.c,v 1.32 2000/03/09 11:49:34 simonmar Exp $
+ * $Id: RtsStartup.c,v 1.33 2000/03/14 09:55:05 simonmar Exp $
  *
- * (c) The GHC Team, 1998-1999
+ * (c) The GHC Team, 1998-2000
  *
  * Main function for a standalone Haskell program.
  *
@@ -21,6 +21,7 @@
 #include "Ticky.h"
 #include "StgRun.h"
 #include "StgStartup.h"
+#include "Prelude.h"           /* fixupPreludeRefs */
 
 #if defined(PROFILING) || defined(DEBUG)
 # include "ProfRts.h"
@@ -53,10 +54,6 @@ static void initModules ( void );
 void
 startupHaskell(int argc, char *argv[])
 {
-#ifdef ENABLE_WIN32_DLL_SUPPORT
-    int i;
-#endif
-
     /* To avoid repeated initialisations of the RTS */
    if (rts_has_started_up)
      return;
@@ -160,21 +157,9 @@ startupHaskell(int argc, char *argv[])
     init_default_handlers();
 #endif
  
-    /* When the RTS and Prelude live in separate DLLs,
-       we need to patch up the char- and int-like tables
-       that the RTS keep after both DLLs have been loaded,
-       filling in the tables with references to where the
-       static info tables have been loaded inside the running
-       process.
-    */
-#ifdef ENABLE_WIN32_DLL_SUPPORT
-    for(i=0;i<=255;i++)
-       (CHARLIKE_closure[i]).header.info = (const StgInfoTable*)&Czh_static_info;
-
-    for(i=0;i<=32;i++)
-       (INTLIKE_closure[i]).header.info = (const StgInfoTable*)&Izh_static_info;
-       
-#endif
+    /* Initialise pointers from the RTS to the prelude */
+    fixupPreludeRefs();
+
     /* Record initialization times */
     end_init();
 }

diff --git a/ghc/rts/Schedule.c b/ghc/rts/Schedule.c
index a425fc2..e3100ef 100644 (file)
--- a/ghc/rts/Schedule.c
+++ b/ghc/rts/Schedule.c
@@ -1,5 +1,5 @@
 /* ---------------------------------------------------------------------------
- * $Id: Schedule.c,v 1.51 2000/03/13 10:53:56 simonmar Exp $
+ * $Id: Schedule.c,v 1.52 2000/03/14 09:55:05 simonmar Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
@@ -1622,7 +1622,7 @@ threadStackOverflow(StgTSO *tso)
     exit(1);
 #else
     /* Send this thread the StackOverflow exception */
-    raiseAsync(tso, (StgClosure *)&stackOverflow_closure);
+    raiseAsync(tso, (StgClosure *)stackOverflow_closure);
 #endif
     return tso;
   }

diff --git a/ghc/rts/StgMiscClosures.hc b/ghc/rts/StgMiscClosures.hc
index 5e966c3..064142d 100644 (file)
--- a/ghc/rts/StgMiscClosures.hc
+++ b/ghc/rts/StgMiscClosures.hc
@@ -1,7 +1,7 @@
 /* -----------------------------------------------------------------------------
- * $Id: StgMiscClosures.hc,v 1.37 2000/03/13 10:53:55 simonmar Exp $
+ * $Id: StgMiscClosures.hc,v 1.38 2000/03/14 09:55:05 simonmar Exp $
  *
- * (c) The GHC Team, 1998-1999
+ * (c) The GHC Team, 1998-2000
  *
  * Entry code for various built-in closure types.
  *
@@ -774,31 +774,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.  
 
@@ -807,7 +782,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
@@ -819,8 +794,8 @@ 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)                                                \