From: simonmar Date: Tue, 14 Mar 2000 09:55:05 +0000 (+0000) Subject: [project @ 2000-03-14 09:55:05 by simonmar] X-Git-Tag: Approximately_9120_patches~4987 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=3ddfe34ba0b8b1c0721841c73d0c671e43a600ac;p=ghc-hetmet.git [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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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) \