Commit 51464cf3 authored by sewardj's avatar sewardj

[project @ 2000-03-14 14:34:47 by sewardj]

Update Hugs so as to work with the new way of referencing Prelude
symbols from the RTS.  The main action is in fixupRTStoPreludeRefs()
in rts/Prelude.c.
parent 716d91c2
...@@ -9,8 +9,8 @@ ...@@ -9,8 +9,8 @@
* included in the distribution. * included in the distribution.
* *
* $RCSfile: connect.h,v $ * $RCSfile: connect.h,v $
* $Revision: 1.28 $ * $Revision: 1.29 $
* $Date: 2000/03/13 11:37:16 $ * $Date: 2000/03/14 14:34:47 $
* ------------------------------------------------------------------------*/ * ------------------------------------------------------------------------*/
/* -------------------------------------------------------------------------- /* --------------------------------------------------------------------------
...@@ -703,6 +703,8 @@ extern Bool processInterfaces ( Void ); ...@@ -703,6 +703,8 @@ extern Bool processInterfaces ( Void );
extern Void getFileSize ( String, Long * ); extern Void getFileSize ( String, Long * );
extern Void ifLinkConstrItbl ( Name n ); extern Void ifLinkConstrItbl ( Name n );
extern Void hi_o_namesFromSrcName ( String,String*,String* oName ); extern Void hi_o_namesFromSrcName ( String,String*,String* oName );
extern void* lookupObjName ( char* );
extern String getExtraObjectInfo ( String primaryObjectName, extern String getExtraObjectInfo ( String primaryObjectName,
String extraFileName, String extraFileName,
Int* extraFileSize ); Int* extraFileSize );
......
...@@ -9,8 +9,8 @@ ...@@ -9,8 +9,8 @@
* included in the distribution. * included in the distribution.
* *
* $RCSfile: hugs.c,v $ * $RCSfile: hugs.c,v $
* $Revision: 1.42 $ * $Revision: 1.43 $
* $Date: 2000/03/13 11:37:16 $ * $Date: 2000/03/14 14:34:47 $
* ------------------------------------------------------------------------*/ * ------------------------------------------------------------------------*/
#include <setjmp.h> #include <setjmp.h>
...@@ -94,7 +94,6 @@ static Void local browse ( Void ); ...@@ -94,7 +94,6 @@ static Void local browse ( Void );
* Machine dependent code for Hugs interpreter: * Machine dependent code for Hugs interpreter:
* ------------------------------------------------------------------------*/ * ------------------------------------------------------------------------*/
Bool combined = TRUE;
#include "machdep.c" #include "machdep.c"
#ifdef WANT_TIMER #ifdef WANT_TIMER
...@@ -112,8 +111,10 @@ static Bool addType = FALSE; /* TRUE => print type with value */ ...@@ -112,8 +111,10 @@ static Bool addType = FALSE; /* TRUE => print type with value */
static Bool useDots = RISCOS; /* TRUE => use dots in progress */ static Bool useDots = RISCOS; /* TRUE => use dots in progress */
static Bool quiet = FALSE; /* TRUE => don't show progress */ static Bool quiet = FALSE; /* TRUE => don't show progress */
static Bool lastWasObject = FALSE; static Bool lastWasObject = FALSE;
Bool preludeLoaded = FALSE; Bool preludeLoaded = FALSE;
Bool debugSC = FALSE; Bool debugSC = FALSE;
Bool combined = TRUE;
typedef typedef
struct { struct {
......
...@@ -7,8 +7,8 @@ ...@@ -7,8 +7,8 @@
* Hugs version 1.4, December 1997 * Hugs version 1.4, December 1997
* *
* $RCSfile: interface.c,v $ * $RCSfile: interface.c,v $
* $Revision: 1.38 $ * $Revision: 1.39 $
* $Date: 2000/03/13 11:37:16 $ * $Date: 2000/03/14 14:34:47 $
* ------------------------------------------------------------------------*/ * ------------------------------------------------------------------------*/
#include "prelude.h" #include "prelude.h"
...@@ -163,7 +163,6 @@ static Bool allTypesKnown ( Type type, ...@@ -163,7 +163,6 @@ static Bool allTypesKnown ( Type type,
static List ifTyvarsIn ( Type ); static List ifTyvarsIn ( Type );
static Type tvsToOffsets ( Int,Type,List ); static Type tvsToOffsets ( Int,Type,List );
static Type conidcellsToTycons ( Int,Type ); static Type conidcellsToTycons ( Int,Type );
static void* lookupObjName ( char* );
...@@ -2594,6 +2593,7 @@ Type type; { ...@@ -2594,6 +2593,7 @@ Type type; {
Sym(CAF_UNENTERED_entry) \ Sym(CAF_UNENTERED_entry) \
Sym(stg_yield_to_Hugs) \ Sym(stg_yield_to_Hugs) \
Sym(StgReturn) \ Sym(StgReturn) \
Sym(init_stack) \
\ \
/* needed by libHS_cbits */ \ /* needed by libHS_cbits */ \
SymX(malloc) \ SymX(malloc) \
...@@ -2716,6 +2716,9 @@ OSym rtsTab[] ...@@ -2716,6 +2716,9 @@ OSym rtsTab[]
#undef SymX #undef SymX
void init_stack;
/* A kludge to assist Win32 debugging. */ /* A kludge to assist Win32 debugging. */
char* nameFromStaticOPtr ( void* ptr ) char* nameFromStaticOPtr ( void* ptr )
{ {
...@@ -2727,7 +2730,7 @@ char* nameFromStaticOPtr ( void* ptr ) ...@@ -2727,7 +2730,7 @@ char* nameFromStaticOPtr ( void* ptr )
} }
static void* lookupObjName ( char* nm ) void* lookupObjName ( char* nm )
{ {
int k; int k;
char* pp; char* pp;
...@@ -2749,14 +2752,27 @@ static void* lookupObjName ( char* nm ) ...@@ -2749,14 +2752,27 @@ static void* lookupObjName ( char* nm )
a = lookupOExtraTabName ( nm ); a = lookupOExtraTabName ( nm );
if (a) return a; if (a) return a;
/* if not an RTS name, look in the
relevant module's object symbol table
*/
# if LEADING_UNDERSCORE # if LEADING_UNDERSCORE
first_real_char = 1; first_real_char = 1;
# else # else
first_real_char = 0; first_real_char = 0;
# endif # endif
/* Maybe it's an __init_Module thing? */
if (strlen(nm2+first_real_char) > 7
&& strncmp(nm2+first_real_char, "__init_", 7)==0) {
t = unZcodeThenFindText(nm2+first_real_char+7);
if (t == findText("PrelGHC")) return (4+NULL); /* kludge */
m = findModule(t);
if (isNull(m)) goto not_found;
a = lookupOTabName ( m, nm );
if (a) return a;
goto not_found;
}
/* if not an RTS name, look in the
relevant module's object symbol table
*/
pp = strchr(nm2+first_real_char, '_'); pp = strchr(nm2+first_real_char, '_');
if (!pp || !isupper(nm2[first_real_char])) goto not_found; if (!pp || !isupper(nm2[first_real_char])) goto not_found;
*pp = 0; *pp = 0;
...@@ -2771,7 +2787,7 @@ static void* lookupObjName ( char* nm ) ...@@ -2771,7 +2787,7 @@ static void* lookupObjName ( char* nm )
fprintf ( stderr, fprintf ( stderr,
"lookupObjName: can't resolve name `%s'\n", "lookupObjName: can't resolve name `%s'\n",
nm ); nm );
assert(4-4); assert(4-4);
return NULL; return NULL;
} }
......
...@@ -9,8 +9,8 @@ ...@@ -9,8 +9,8 @@
* included in the distribution. * included in the distribution.
* *
* $RCSfile: link.c,v $ * $RCSfile: link.c,v $
* $Revision: 1.50 $ * $Revision: 1.51 $
* $Date: 2000/03/13 11:37:16 $ * $Date: 2000/03/14 14:34:47 $
* ------------------------------------------------------------------------*/ * ------------------------------------------------------------------------*/
#include "prelude.h" #include "prelude.h"
...@@ -522,6 +522,7 @@ Int what; { ...@@ -522,6 +522,7 @@ Int what; {
linkPreludeTC(); linkPreludeTC();
linkPreludeCM(); linkPreludeCM();
linkPrimNames(); linkPrimNames();
fixupRTStoPreludeRefs ( lookupObjName );
nameUnpackString = linkName("hugsprimUnpackString"); nameUnpackString = linkName("hugsprimUnpackString");
namePMFail = linkName("hugsprimPmFail"); namePMFail = linkName("hugsprimPmFail");
...@@ -663,6 +664,7 @@ assert(nonNull(namePMFail)); ...@@ -663,6 +664,7 @@ assert(nonNull(namePMFail));
setCurrModule(modulePrelude); setCurrModule(modulePrelude);
} else { } else {
fixupRTStoPreludeRefs(NULL);
modulePrelude = newModule(textPrelude); modulePrelude = newModule(textPrelude);
setCurrModule(modulePrelude); setCurrModule(modulePrelude);
......
...@@ -5,8 +5,8 @@ ...@@ -5,8 +5,8 @@
* Copyright (c) 1994-1998. * Copyright (c) 1994-1998.
* *
* $RCSfile: Evaluator.c,v $ * $RCSfile: Evaluator.c,v $
* $Revision: 1.39 $ * $Revision: 1.40 $
* $Date: 2000/03/13 13:00:00 $ * $Date: 2000/03/14 14:34:47 $
* ---------------------------------------------------------------------------*/ * ---------------------------------------------------------------------------*/
#include "Rts.h" #include "Rts.h"
...@@ -921,7 +921,7 @@ StgThreadReturnCode enter( Capability* cap, StgClosure* obj0 ) ...@@ -921,7 +921,7 @@ StgThreadReturnCode enter( Capability* cap, StgClosure* obj0 )
{ {
StgClosure* o; StgClosure* o;
SSS; o = (StgClosure*)grabHpNonUpd(Izh_sizeW); LLL; SSS; o = (StgClosure*)grabHpNonUpd(Izh_sizeW); LLL;
SET_HDR(o,&Izh_con_info,??); SET_HDR(o,Izh_con_info,??);
payloadWord(o,0) = xPopTaggedInt(); payloadWord(o,0) = xPopTaggedInt();
IF_DEBUG(evaluator, IF_DEBUG(evaluator,
fprintf(stderr,"\tBuilt "); fprintf(stderr,"\tBuilt ");
...@@ -978,7 +978,7 @@ StgThreadReturnCode enter( Capability* cap, StgClosure* obj0 ) ...@@ -978,7 +978,7 @@ StgThreadReturnCode enter( Capability* cap, StgClosure* obj0 )
{ {
StgClosure* o; StgClosure* o;
SSS; o = (StgClosure*)grabHpNonUpd(Wzh_sizeW); LLL; SSS; o = (StgClosure*)grabHpNonUpd(Wzh_sizeW); LLL;
SET_HDR(o,&Wzh_con_info,??); SET_HDR(o,Wzh_con_info,??);
payloadWord(o,0) = xPopTaggedWord(); payloadWord(o,0) = xPopTaggedWord();
IF_DEBUG(evaluator, IF_DEBUG(evaluator,
fprintf(stderr,"\tBuilt "); fprintf(stderr,"\tBuilt ");
...@@ -1017,7 +1017,7 @@ StgThreadReturnCode enter( Capability* cap, StgClosure* obj0 ) ...@@ -1017,7 +1017,7 @@ StgThreadReturnCode enter( Capability* cap, StgClosure* obj0 )
{ {
StgClosure* o; StgClosure* o;
SSS; o = (StgClosure*)grabHpNonUpd(Azh_sizeW); LLL; SSS; o = (StgClosure*)grabHpNonUpd(Azh_sizeW); LLL;
SET_HDR(o,&Azh_con_info,??); SET_HDR(o,Azh_con_info,??);
payloadPtr(o,0) = xPopTaggedAddr(); payloadPtr(o,0) = xPopTaggedAddr();
IF_DEBUG(evaluator, IF_DEBUG(evaluator,
fprintf(stderr,"\tBuilt "); fprintf(stderr,"\tBuilt ");
...@@ -1050,7 +1050,7 @@ StgThreadReturnCode enter( Capability* cap, StgClosure* obj0 ) ...@@ -1050,7 +1050,7 @@ StgThreadReturnCode enter( Capability* cap, StgClosure* obj0 )
{ {
StgClosure* o; StgClosure* o;
SSS; o = (StgClosure*)grabHpNonUpd(Czh_sizeW); LLL; SSS; o = (StgClosure*)grabHpNonUpd(Czh_sizeW); LLL;
SET_HDR(o,&Czh_con_info,??); SET_HDR(o,Czh_con_info,??);
payloadWord(o,0) = xPopTaggedChar(); payloadWord(o,0) = xPopTaggedChar();
xPushPtr(stgCast(StgPtr,o)); xPushPtr(stgCast(StgPtr,o));
IF_DEBUG(evaluator, IF_DEBUG(evaluator,
...@@ -1083,7 +1083,7 @@ StgThreadReturnCode enter( Capability* cap, StgClosure* obj0 ) ...@@ -1083,7 +1083,7 @@ StgThreadReturnCode enter( Capability* cap, StgClosure* obj0 )
{ {
StgClosure* o; StgClosure* o;
SSS; o = (StgClosure*)grabHpNonUpd(Fzh_sizeW); LLL; SSS; o = (StgClosure*)grabHpNonUpd(Fzh_sizeW); LLL;
SET_HDR(o,&Fzh_con_info,??); SET_HDR(o,Fzh_con_info,??);
ASSIGN_FLT(&payloadWord(o,0),xPopTaggedFloat()); ASSIGN_FLT(&payloadWord(o,0),xPopTaggedFloat());
IF_DEBUG(evaluator, IF_DEBUG(evaluator,
fprintf(stderr,"\tBuilt "); fprintf(stderr,"\tBuilt ");
...@@ -1122,7 +1122,7 @@ StgThreadReturnCode enter( Capability* cap, StgClosure* obj0 ) ...@@ -1122,7 +1122,7 @@ StgThreadReturnCode enter( Capability* cap, StgClosure* obj0 )
{ {
StgClosure* o; StgClosure* o;
SSS; o = (StgClosure*)grabHpNonUpd(Dzh_sizeW); LLL; SSS; o = (StgClosure*)grabHpNonUpd(Dzh_sizeW); LLL;
SET_HDR(o,&Dzh_con_info,??); SET_HDR(o,Dzh_con_info,??);
ASSIGN_DBL(&payloadWord(o,0),xPopTaggedDouble()); ASSIGN_DBL(&payloadWord(o,0),xPopTaggedDouble());
IF_DEBUG(evaluator, IF_DEBUG(evaluator,
fprintf(stderr,"\tBuilt "); fprintf(stderr,"\tBuilt ");
...@@ -1148,7 +1148,7 @@ StgThreadReturnCode enter( Capability* cap, StgClosure* obj0 ) ...@@ -1148,7 +1148,7 @@ StgThreadReturnCode enter( Capability* cap, StgClosure* obj0 )
{ {
StgClosure* o; StgClosure* o;
SSS; o = (StgClosure*)grabHpNonUpd(Stablezh_sizeW); LLL; SSS; o = (StgClosure*)grabHpNonUpd(Stablezh_sizeW); LLL;
SET_HDR(o,&StablePtr_con_info,??); SET_HDR(o,StablePtr_con_info,??);
payloadWord(o,0) = xPopTaggedStable(); payloadWord(o,0) = xPopTaggedStable();
IF_DEBUG(evaluator, IF_DEBUG(evaluator,
fprintf(stderr,"\tBuilt "); fprintf(stderr,"\tBuilt ");
......
/* ----------------------------------------------------------------------------- /* -----------------------------------------------------------------------------
* $Id: Prelude.c,v 1.1 2000/03/14 11:11:40 simonmar Exp $ * $Id: Prelude.c,v 1.2 2000/03/14 14:34:47 sewardj Exp $
* *
* (c) The GHC Team, 1998-2000 * (c) The GHC Team, 1998-2000
* *
...@@ -11,7 +12,6 @@ ...@@ -11,7 +12,6 @@
#include "Prelude.h" #include "Prelude.h"
#if defined(INTERPRETER) #if defined(INTERPRETER)
const StgClosure *ind_True_static_closure; const StgClosure *ind_True_static_closure;
const StgClosure *ind_False_static_closure; const StgClosure *ind_False_static_closure;
const StgClosure *ind_unpackCString_closure; const StgClosure *ind_unpackCString_closure;
...@@ -38,42 +38,133 @@ const StgInfoTable *ind_W64zh_con_info; ...@@ -38,42 +38,133 @@ const StgInfoTable *ind_W64zh_con_info;
const StgInfoTable *ind_StablePtr_static_info; const StgInfoTable *ind_StablePtr_static_info;
const StgInfoTable *ind_StablePtr_con_info; const StgInfoTable *ind_StablePtr_con_info;
INFO_TABLE_CONSTR(hugs_standalone_Czh_con_info,Hugs_CONSTR_entry,
0,sizeofW(StgChar),0,CONSTR,,EF_,0,0);
INFO_TABLE_CONSTR(hugs_standalone_Izh_con_info,Hugs_CONSTR_entry,
0,sizeofW(StgInt),0,CONSTR,,EF_,0,0);
INFO_TABLE_CONSTR(hugs_standalone_I64zh_con_info,Hugs_CONSTR_entry,
0,sizeofW(StgInt64),0,CONSTR,,EF_,0,0);
INFO_TABLE_CONSTR(hugs_standalone_W64zh_con_info,Hugs_CONSTR_entry,
0,sizeofW(StgWord64),0,CONSTR,,EF_,0,0);
INFO_TABLE_CONSTR(hugs_standalone_Fzh_con_info,Hugs_CONSTR_entry,
0,sizeofW(StgFloat),0,CONSTR,,EF_,0,0);
INFO_TABLE_CONSTR(hugs_standalone_Dzh_con_info,Hugs_CONSTR_entry,
0,sizeofW(StgDouble),0,CONSTR,,EF_,0,0);
INFO_TABLE_CONSTR(hugs_standalone_Azh_con_info,Hugs_CONSTR_entry,
0,sizeofW(StgAddr),0,CONSTR,,EF_,0,0);
INFO_TABLE_CONSTR(hugs_standalone_Wzh_con_info,Hugs_CONSTR_entry,
0,sizeofW(StgWord),0,CONSTR,,EF_,0,0);
INFO_TABLE_CONSTR(hugs_standalone_StablePtr_con_info,Hugs_CONSTR_entry,
0,sizeofW(StgStablePtr),0,CONSTR,,EF_,0,0);
INFO_TABLE_CONSTR(hugs_standalone_Czh_static_info,Hugs_CONSTR_entry,
0,sizeofW(StgChar),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
INFO_TABLE_CONSTR(hugs_standalone_Izh_static_info,Hugs_CONSTR_entry,
0,sizeofW(StgInt),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
INFO_TABLE_CONSTR(hugs_standalone_I64zh_static_info,Hugs_CONSTR_entry,
0,sizeofW(StgInt64),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
INFO_TABLE_CONSTR(hugs_standalone_Fzh_static_info,Hugs_CONSTR_entry,
0,sizeofW(StgFloat),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
INFO_TABLE_CONSTR(hugs_standalone_Dzh_static_info,Hugs_CONSTR_entry,
0,sizeofW(StgDouble),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
INFO_TABLE_CONSTR(hugs_standalone_Azh_static_info,Hugs_CONSTR_entry,
0,sizeofW(StgAddr),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
INFO_TABLE_CONSTR(hugs_standalone_Wzh_static_info,Hugs_CONSTR_entry,
0,sizeofW(StgWord),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
INFO_TABLE_CONSTR(hugs_standalone_StablePtr_static_info,Hugs_CONSTR_entry,
0,sizeofW(StgStablePtr),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
#endif #endif
void
fixupPreludeRefs(void) /* Fix up references to various Prelude symbols. For Hugs, we
pass either NULL, to denote standalone mode, or the address of
a lookup function which finds the specified symbol in the
compiled Prelude which Hugs has just loaded.
In combined mode, call here when POSTPREL is signalled in link.c
(since before that point, there are no symbols to link to).
In standalone mode, call here at any time, preferably as early
as possible -- when PREPREL is signalled.
At the moment, standalone mode does not link True, False,
PutFullMVar or NonTermination. That might change (if we
implement them in the Hugs standalone Prelude), but then
we (1) need a way to ask hugs the address of the BCOs, and
(2) this can only be done at POSTPREL time.
*/
void fixupRTStoPreludeRefs ( void*(*ask_hugs_dynamic_linker)(char*) )
{ {
#ifdef INTERPRETER #if defined(INTERPRETER)
ind_True_static_closure = True_static_closure; if (ask_hugs_dynamic_linker == NULL) {
ind_False_static_closure = False_static_closure;
ind_unpackCString_closure = ind_unpackCString_closure; /* Hugs standalone mode. */
ind_stackOverflow_closure = stackOverflow_closure; ind_True_static_closure = NULL; /* True_static_closure; */
ind_heapOverflow_closure = heapOverflow_closure; ind_False_static_closure = NULL; /* False_static_closure; */
ind_PutFullMVar_static_closure = PutFullMVar_static_closure; ind_PutFullMVar_static_closure = NULL; /* PutFullMVar_static_closure; */
ind_NonTermination_static_closure = NonTermination_static_closure; ind_NonTermination_static_closure = NULL; /* NonTermination_static_closure; */
ind_mainIO_closure = mainIO_closure; ind_unpackCString_closure = NULL; /* unpackCString_closure; */
ind_Czh_static_info = Czh_static_info; ind_stackOverflow_closure = stackOverflow_closure;
ind_Izh_static_info = Izh_static_info; ind_heapOverflow_closure = heapOverflow_closure;
ind_Fzh_static_info = Fzh_static_info;
ind_Dzh_static_info = Dzh_static_info; ind_Czh_static_info = &hugs_standalone_Czh_static_info;
ind_Azh_static_info = Azh_static_info; ind_Izh_static_info = &hugs_standalone_Izh_static_info;
ind_Wzh_static_info = Wzh_static_info; ind_Fzh_static_info = &hugs_standalone_Fzh_static_info;
ind_Czh_con_info = Czh_con_info; ind_Dzh_static_info = &hugs_standalone_Dzh_static_info;
ind_Izh_con_info = Izh_con_info; ind_Azh_static_info = &hugs_standalone_Azh_static_info;
ind_Fzh_con_info = Fzh_con_info; ind_Wzh_static_info = &hugs_standalone_Wzh_static_info;
ind_Dzh_con_info = Dzh_con_info; ind_Czh_con_info = &hugs_standalone_Czh_con_info;
ind_Azh_con_info = Azh_con_info; ind_Izh_con_info = &hugs_standalone_Izh_con_info;
ind_Wzh_con_info = Wzh_con_info; ind_Fzh_con_info = &hugs_standalone_Fzh_con_info;
ind_I64zh_con_info = I64zh_con_info; ind_Dzh_con_info = &hugs_standalone_Dzh_con_info;
ind_W64zh_con_info = W64zh_con_info; ind_Azh_con_info = &hugs_standalone_Azh_con_info;
ind_StablePtr_static_info = StablePtr_static_info; ind_Wzh_con_info = &hugs_standalone_Wzh_con_info;
ind_StablePtr_con_info = StablePtr_con_info; ind_I64zh_con_info = &hugs_standalone_I64zh_con_info;
ind_W64zh_con_info = &hugs_standalone_W64zh_con_info;
ind_StablePtr_static_info = &hugs_standalone_StablePtr_static_info;
ind_StablePtr_con_info = &hugs_standalone_StablePtr_con_info;
} else {
/* Hugs combined mode. */
void*(*ask)(char*) = ask_hugs_dynamic_linker;
ind_True_static_closure
= ask("PrelBase_True_static_closure");
ind_False_static_closure
= ask("PrelBase_False_static_closure");
ind_PutFullMVar_static_closure
= ask("PrelException_PutFullMVar_static_closure");
ind_NonTermination_static_closure
= ask("PrelException_NonTermination_static_closure");
ind_unpackCString_closure = ask("PrelPack_unpackCString_closure");
ind_stackOverflow_closure = ask("PrelException_stackOverflow_closure");
ind_heapOverflow_closure = ask("PrelException_heapOverflow_closure");
ind_Czh_static_info = ask("PrelBase_Czh_static_info");
ind_Izh_static_info = ask("PrelBase_Izh_static_info");
ind_Fzh_static_info = ask("PrelFloat_Fzh_static_info");
ind_Dzh_static_info = ask("PrelFloat_Dzh_static_info");
ind_Azh_static_info = ask("PrelAddr_Azh_static_info");
ind_Wzh_static_info = ask("PrelAddr_Wzh_static_info");
ind_Czh_con_info = ask("PrelBase_Czh_con_info");
ind_Izh_con_info = ask("PrelBase_Izh_con_info");
ind_Fzh_con_info = ask("PrelFloat_Fzh_con_info");
ind_Dzh_con_info = ask("PrelFloat_Dzh_con_info");
ind_Azh_con_info = ask("PrelAddr_Azh_con_info");
ind_Wzh_con_info = ask("PrelAddr_Wzh_con_info");
ind_I64zh_con_info = ask("PrelAddr_I64zh_con_info");
ind_W64zh_con_info = ask("PrelAddr_W64zh_con_info");
ind_StablePtr_static_info = ask("PrelStable_StablePtr_static_info");
ind_StablePtr_con_info = ask("PrelStable_StablePtr_con_info");
}
#endif #endif
/* When the RTS and Prelude live in separate DLLs, /* When the RTS and Prelude live in separate DLLs,
we need to patch up the char- and int-like tables we need to patch up the char- and int-like tables
that the RTS keep after both DLLs have been loaded, that the RTS keeps after both DLLs have been loaded,
filling in the tables with references to where the filling in the tables with references to where the
static info tables have been loaded inside the running static info tables have been loaded inside the running
process. process.
......
/* ----------------------------------------------------------------------------- /* -----------------------------------------------------------------------------
* $Id: Prelude.h,v 1.3 2000/03/14 09:55:05 simonmar Exp $ * $Id: Prelude.h,v 1.4 2000/03/14 14:34:47 sewardj Exp $
* *
* (c) The GHC Team, 1998-2000 * (c) The GHC Team, 1998-2000
* *
...@@ -78,7 +78,6 @@ extern const StgClosure *ind_stackOverflow_closure; ...@@ -78,7 +78,6 @@ extern const StgClosure *ind_stackOverflow_closure;
extern const StgClosure *ind_heapOverflow_closure; extern const StgClosure *ind_heapOverflow_closure;
extern const StgClosure *ind_PutFullMVar_static_closure; extern const StgClosure *ind_PutFullMVar_static_closure;
extern const StgClosure *ind_NonTermination_static_closure; extern const StgClosure *ind_NonTermination_static_closure;
extern const StgClosure *ind_mainIO_closure;
extern const StgInfoTable *ind_Czh_static_info; extern const StgInfoTable *ind_Czh_static_info;
extern const StgInfoTable *ind_Izh_static_info; extern const StgInfoTable *ind_Izh_static_info;
...@@ -119,11 +118,10 @@ extern const StgInfoTable *ind_StablePtr_con_info; ...@@ -119,11 +118,10 @@ extern const StgInfoTable *ind_StablePtr_con_info;
#define I64zh_con_info ind_I64zh_con_info #define I64zh_con_info ind_I64zh_con_info
#define StablePtr_static_info ind_StablePtr_static_info #define StablePtr_static_info ind_StablePtr_static_info
#define StablePtr_con_info ind_StablePtr_con_info #define StablePtr_con_info ind_StablePtr_con_info
#define mainIO_closure ind_mainIO_closure
#define unpackCString_closure ind_unpackCString_closure #define unpackCString_closure ind_unpackCString_closure
#endif #endif
void fixupPreludeRefs(void); void fixupRTStoPreludeRefs( void*(*)(char*) );
#endif /* PRELUDE_H */ #endif /* PRELUDE_H */
/* ----------------------------------------------------------------------------- /* -----------------------------------------------------------------------------
* $Id: RtsStartup.c,v 1.33 2000/03/14 09:55:05 simonmar Exp $ * $Id: RtsStartup.c,v 1.34 2000/03/14 14:34:47 sewardj Exp $
* *
* (c) The GHC Team, 1998-2000 * (c) The GHC Team, 1998-2000
* *
...@@ -21,7 +21,7 @@ ...@@ -21,7 +21,7 @@
#include "Ticky.h" #include "Ticky.h"
#include "StgRun.h" #include "StgRun.h"
#include "StgStartup.h" #include "StgStartup.h"
#include "Prelude.h" /* fixupPreludeRefs */ #include "Prelude.h" /* fixupRTStoPreludeRefs */
#if defined(PROFILING) || defined(DEBUG) #if defined(PROFILING) || defined(DEBUG)
# include "ProfRts.h" # include "ProfRts.h"
...@@ -157,8 +157,13 @@ startupHaskell(int argc, char *argv[]) ...@@ -157,8 +157,13 @@ startupHaskell(int argc, char *argv[])
init_default_handlers(); init_default_handlers();
#endif #endif
/* Initialise pointers from the RTS to the prelude */ #if !defined(INTERPRETER)
fixupPreludeRefs(); /* Initialise pointers from the RTS to the prelude.
Only for compiled code -- the interpreter
will call this itself later, so don't do so now.
*/
fixupRTStoPreludeRefs(NULL);
#endif
/* Record initialization times */ /* Record initialization times */
end_init(); end_init();
...@@ -180,7 +185,7 @@ startupHaskell(int argc, char *argv[]) ...@@ -180,7 +185,7 @@ startupHaskell(int argc, char *argv[])
- we supply a unique integer to each statically declared cost - we supply a unique integer to each statically declared cost
centre and cost centre stack in the program. centre and cost centre stack in the program.
<