Skip to content

GitLab

GHC
GHC
Commit 51464cf3 authored by sewardj's avatar sewardj
Browse files
Options

[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
Hide whitespace changes
Inline Side-by-side
Showing with 179 additions and 64 deletions
ghc/interpreter/connect.h
View file @ 51464cf3
......@@ -9,8 +9,8 @@
* included in the distribution.
*
* $RCSfile: connect.h,v $
* $Revision: 1.28 $
* $Date: 2000/03/13 11:37:16 $
* $Revision: 1.29 $
* $Date: 2000/03/14 14:34:47 $
* ------------------------------------------------------------------------*/
/* --------------------------------------------------------------------------
......@@ -703,6 +703,8 @@ extern Bool processInterfaces ( Void );
extern Void getFileSize ( String, Long * );
extern Void ifLinkConstrItbl ( Name n );
extern Void hi_o_namesFromSrcName ( String,String*,String* oName );
extern void* lookupObjName ( char* );
extern String getExtraObjectInfo ( String primaryObjectName,
String extraFileName,
Int* extraFileSize );
......
ghc/interpreter/hugs.c
View file @ 51464cf3
......@@ -9,8 +9,8 @@
* included in the distribution.
*
* $RCSfile: hugs.c,v $
* $Revision: 1.42 $
* $Date: 2000/03/13 11:37:16 $
* $Revision: 1.43 $
* $Date: 2000/03/14 14:34:47 $
* ------------------------------------------------------------------------*/
#include <setjmp.h>
......@@ -94,7 +94,6 @@ static Void local browse ( Void );
* Machine dependent code for Hugs interpreter:
* ------------------------------------------------------------------------*/
Bool combined = TRUE;
#include "machdep.c"
#ifdef WANT_TIMER
......@@ -112,8 +111,10 @@ static Bool addType = FALSE; /* TRUE => print type with value */
static Bool useDots = RISCOS; /* TRUE => use dots in progress */
static Bool quiet = FALSE; /* TRUE => don't show progress */
static Bool lastWasObject = FALSE;
Bool preludeLoaded = FALSE;
Bool debugSC = FALSE;
Bool combined = TRUE;
typedef
struct {
......
ghc/interpreter/interface.c
View file @ 51464cf3
......@@ -7,8 +7,8 @@
* Hugs version 1.4, December 1997
*
* $RCSfile: interface.c,v $
* $Revision: 1.38 $
* $Date: 2000/03/13 11:37:16 $
* $Revision: 1.39 $
* $Date: 2000/03/14 14:34:47 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
......@@ -163,7 +163,6 @@ static Bool allTypesKnown ( Type type,
static List ifTyvarsIn ( Type );
static Type tvsToOffsets ( Int,Type,List );
static Type conidcellsToTycons ( Int,Type );
static void* lookupObjName ( char* );
......@@ -2594,6 +2593,7 @@ Type type; {
Sym(CAF_UNENTERED_entry) \
Sym(stg_yield_to_Hugs) \
Sym(StgReturn) \
Sym(init_stack) \
\
/* needed by libHS_cbits */ \
SymX(malloc) \
......@@ -2716,6 +2716,9 @@ OSym rtsTab[]
#undef SymX
void init_stack;
/* A kludge to assist Win32 debugging. */
char* nameFromStaticOPtr ( void* ptr )
{
......@@ -2727,7 +2730,7 @@ char* nameFromStaticOPtr ( void* ptr )
}
static void* lookupObjName ( char* nm )
void* lookupObjName ( char* nm )
{
int k;
char* pp;
......@@ -2749,14 +2752,27 @@ static void* lookupObjName ( char* nm )
a = lookupOExtraTabName ( nm );
if (a) return a;
/* if not an RTS name, look in the
relevant module's object symbol table
*/
# if LEADING_UNDERSCORE
first_real_char = 1;
# else
first_real_char = 0;
# 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, '_');
if (!pp || !isupper(nm2[first_real_char])) goto not_found;
*pp = 0;
......@@ -2771,7 +2787,7 @@ static void* lookupObjName ( char* nm )
fprintf ( stderr,
"lookupObjName: can't resolve name `%s'\n",
nm );
assert(4-4);
assert(4-4);
return NULL;
}
......
ghc/interpreter/link.c
View file @ 51464cf3
......@@ -9,8 +9,8 @@
* included in the distribution.
*
* $RCSfile: link.c,v $
* $Revision: 1.50 $
* $Date: 2000/03/13 11:37:16 $
* $Revision: 1.51 $
* $Date: 2000/03/14 14:34:47 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
......@@ -522,6 +522,7 @@ Int what; {
linkPreludeTC();
linkPreludeCM();
linkPrimNames();
fixupRTStoPreludeRefs ( lookupObjName );
nameUnpackString = linkName("hugsprimUnpackString");
namePMFail = linkName("hugsprimPmFail");
......@@ -663,6 +664,7 @@ assert(nonNull(namePMFail));
setCurrModule(modulePrelude);
} else {
fixupRTStoPreludeRefs(NULL);
modulePrelude = newModule(textPrelude);
setCurrModule(modulePrelude);
......
ghc/rts/Evaluator.c
View file @ 51464cf3
......@@ -5,8 +5,8 @@
* Copyright (c) 1994-1998.
*
* $RCSfile: Evaluator.c,v $
* $Revision: 1.39 $
* $Date: 2000/03/13 13:00:00 $
* $Revision: 1.40 $
* $Date: 2000/03/14 14:34:47 $
* ---------------------------------------------------------------------------*/
#include "Rts.h"
......@@ -921,7 +921,7 @@ StgThreadReturnCode enter( Capability* cap, StgClosure* obj0 )
{
StgClosure* o;
SSS; o = (StgClosure*)grabHpNonUpd(Izh_sizeW); LLL;
SET_HDR(o,&Izh_con_info,??);
SET_HDR(o,Izh_con_info,??);
payloadWord(o,0) = xPopTaggedInt();
IF_DEBUG(evaluator,
fprintf(stderr,"\tBuilt ");
......@@ -978,7 +978,7 @@ StgThreadReturnCode enter( Capability* cap, StgClosure* obj0 )
{
StgClosure* o;
SSS; o = (StgClosure*)grabHpNonUpd(Wzh_sizeW); LLL;
SET_HDR(o,&Wzh_con_info,??);
SET_HDR(o,Wzh_con_info,??);
payloadWord(o,0) = xPopTaggedWord();
IF_DEBUG(evaluator,
fprintf(stderr,"\tBuilt ");
......@@ -1017,7 +1017,7 @@ StgThreadReturnCode enter( Capability* cap, StgClosure* obj0 )
{
StgClosure* o;
SSS; o = (StgClosure*)grabHpNonUpd(Azh_sizeW); LLL;
SET_HDR(o,&Azh_con_info,??);
SET_HDR(o,Azh_con_info,??);
payloadPtr(o,0) = xPopTaggedAddr();
IF_DEBUG(evaluator,
fprintf(stderr,"\tBuilt ");
......@@ -1050,7 +1050,7 @@ StgThreadReturnCode enter( Capability* cap, StgClosure* obj0 )
{
StgClosure* o;
SSS; o = (StgClosure*)grabHpNonUpd(Czh_sizeW); LLL;
SET_HDR(o,&Czh_con_info,??);
SET_HDR(o,Czh_con_info,??);
payloadWord(o,0) = xPopTaggedChar();
xPushPtr(stgCast(StgPtr,o));
IF_DEBUG(evaluator,
......@@ -1083,7 +1083,7 @@ StgThreadReturnCode enter( Capability* cap, StgClosure* obj0 )
{
StgClosure* o;
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());
IF_DEBUG(evaluator,
fprintf(stderr,"\tBuilt ");
......@@ -1122,7 +1122,7 @@ StgThreadReturnCode enter( Capability* cap, StgClosure* obj0 )
{
StgClosure* o;
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());
IF_DEBUG(evaluator,
fprintf(stderr,"\tBuilt ");
......@@ -1148,7 +1148,7 @@ StgThreadReturnCode enter( Capability* cap, StgClosure* obj0 )
{
StgClosure* o;
SSS; o = (StgClosure*)grabHpNonUpd(Stablezh_sizeW); LLL;
SET_HDR(o,&StablePtr_con_info,??);
SET_HDR(o,StablePtr_con_info,??);
payloadWord(o,0) = xPopTaggedStable();
IF_DEBUG(evaluator,
fprintf(stderr,"\tBuilt ");
......
ghc/rts/Prelude.c
View file @ 51464cf3
/* -----------------------------------------------------------------------------
* $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
*
......@@ -11,7 +12,6 @@
#include "Prelude.h"
#if defined(INTERPRETER)
const StgClosure *ind_True_static_closure;
const StgClosure *ind_False_static_closure;
const StgClosure *ind_unpackCString_closure;
......@@ -38,42 +38,133 @@ const StgInfoTable *ind_W64zh_con_info;
const StgInfoTable *ind_StablePtr_static_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
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
ind_True_static_closure = True_static_closure;
ind_False_static_closure = False_static_closure;
ind_unpackCString_closure = ind_unpackCString_closure;
ind_stackOverflow_closure = stackOverflow_closure;
ind_heapOverflow_closure = heapOverflow_closure;
ind_PutFullMVar_static_closure = PutFullMVar_static_closure;
ind_NonTermination_static_closure = NonTermination_static_closure;
ind_mainIO_closure = mainIO_closure;
ind_Czh_static_info = Czh_static_info;
ind_Izh_static_info = Izh_static_info;
ind_Fzh_static_info = Fzh_static_info;
ind_Dzh_static_info = Dzh_static_info;
ind_Azh_static_info = Azh_static_info;
ind_Wzh_static_info = Wzh_static_info;
ind_Czh_con_info = Czh_con_info;
ind_Izh_con_info = Izh_con_info;
ind_Fzh_con_info = Fzh_con_info;
ind_Dzh_con_info = Dzh_con_info;
ind_Azh_con_info = Azh_con_info;
ind_Wzh_con_info = Wzh_con_info;
ind_I64zh_con_info = I64zh_con_info;
ind_W64zh_con_info = W64zh_con_info;
ind_StablePtr_static_info = StablePtr_static_info;
ind_StablePtr_con_info = StablePtr_con_info;
#if defined(INTERPRETER)
if (ask_hugs_dynamic_linker == NULL) {
/* Hugs standalone mode. */
ind_True_static_closure = NULL; /* True_static_closure; */
ind_False_static_closure = NULL; /* False_static_closure; */
ind_PutFullMVar_static_closure = NULL; /* PutFullMVar_static_closure; */
ind_NonTermination_static_closure = NULL; /* NonTermination_static_closure; */
ind_unpackCString_closure = NULL; /* unpackCString_closure; */
ind_stackOverflow_closure = stackOverflow_closure;
ind_heapOverflow_closure = heapOverflow_closure;
ind_Czh_static_info = &hugs_standalone_Czh_static_info;
ind_Izh_static_info = &hugs_standalone_Izh_static_info;
ind_Fzh_static_info = &hugs_standalone_Fzh_static_info;
ind_Dzh_static_info = &hugs_standalone_Dzh_static_info;
ind_Azh_static_info = &hugs_standalone_Azh_static_info;
ind_Wzh_static_info = &hugs_standalone_Wzh_static_info;
ind_Czh_con_info = &hugs_standalone_Czh_con_info;
ind_Izh_con_info = &hugs_standalone_Izh_con_info;
ind_Fzh_con_info = &hugs_standalone_Fzh_con_info;
ind_Dzh_con_info = &hugs_standalone_Dzh_con_info;
ind_Azh_con_info = &hugs_standalone_Azh_con_info;
ind_Wzh_con_info = &hugs_standalone_Wzh_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
/* 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,
that the RTS keeps 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.
......
ghc/rts/Prelude.h
View file @ 51464cf3
/* -----------------------------------------------------------------------------
* $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
*
......@@ -78,7 +78,6 @@ 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;
extern const StgInfoTable *ind_Czh_static_info;
extern const StgInfoTable *ind_Izh_static_info;
......@@ -119,11 +118,10 @@ extern const StgInfoTable *ind_StablePtr_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
void fixupPreludeRefs(void);
void fixupRTStoPreludeRefs( void*(*)(char*) );
#endif /* PRELUDE_H */
ghc/rts/RtsStartup.c
View file @ 51464cf3
/* -----------------------------------------------------------------------------
* $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
*
......@@ -21,7 +21,7 @@
#include "Ticky.h"
#include "StgRun.h"
#include "StgStartup.h"
#include "Prelude.h" /* fixupPreludeRefs */
#include "Prelude.h" /* fixupRTStoPreludeRefs */
#if defined(PROFILING) || defined(DEBUG)
# include "ProfRts.h"
......@@ -157,8 +157,13 @@ startupHaskell(int argc, char *argv[])
init_default_handlers();
#endif
/* Initialise pointers from the RTS to the prelude */
fixupPreludeRefs();
#if !defined(INTERPRETER)
/* 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 */
end_init();
......@@ -180,7 +185,7 @@ startupHaskell(int argc, char *argv[])
- we supply a unique integer to each statically declared cost
centre and cost centre stack in the program.
The code generator inserts a small function "__init_<moddule>" in each
The code generator inserts a small function "__init_<module>" in each
module and calls the registration functions in each of the modules
it imports. So, if we call "__init_Main", each reachable module in the
program will be registered.
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment