From 0f92da1735e3bfbf90aa89f5ddf4b83c89e8a1a7 Mon Sep 17 00:00:00 2001
From: sewardj <unknown>
Date: Mon, 20 Dec 1999 16:55:28 +0000
Subject: [PATCH] [project @ 1999-12-20 16:55:26 by sewardj] * Fix silly bugs
in new linker, object.[ch].
* Allow modules to have arbitrary numbers of "extra" object files
as well as their primary object file. Initial requirement is
that Prelude needs libHS_cbits.o/.dll as well as Prelude.o
module(m).object is the primary object
module(m).objectExtras are the extra objects
module(m).objectExtraNames :: [Text] are their names.
Modify machdep.c to assume that extra objects for module M
live in the same directory as M's primary object.
* Stuff 130ish symbol names into the RTS symbol table, enough
so that the whole Prelude can be linked. That includes symbols
in the C library needed by libHS_cbits. This is very hacky
and needs to be fixed properly.
---
ghc/interpreter/Makefile | 4 +-
ghc/interpreter/connect.h | 8 +-
ghc/interpreter/interface.c | 301 ++++++++++++++++++++++++++++--------
ghc/interpreter/link.c | 8 +-
ghc/interpreter/machdep.c | 41 ++++-
ghc/interpreter/object.c | 42 ++---
ghc/interpreter/storage.c | 37 +++--
ghc/interpreter/storage.h | 12 +-
8 files changed, 343 insertions(+), 110 deletions(-)
diff --git a/ghc/interpreter/Makefile b/ghc/interpreter/Makefile
index 1fbc5c4b10d0..e7b29bdad063 100644
--- a/ghc/interpreter/Makefile
+++ b/ghc/interpreter/Makefile
@@ -1,6 +1,6 @@
# --------------------------------------------------------------------------- #
-# $Id: Makefile,v 1.23 1999/12/17 16:34:08 sewardj Exp $ #
+# $Id: Makefile,v 1.24 1999/12/20 16:55:26 sewardj Exp $ #
# --------------------------------------------------------------------------- #
TOP = ..
@@ -49,7 +49,7 @@ hugs: $(C_OBJS) ../rts/Sanity.o ../rts/Assembler.o ../rts/Disassembler.o \
../rts/Evaluator.o ../rts/ForeignCall.o ../rts/GC.o ../rts/Printer.o \
../rts/StgCRun.o
$(CC) -o $@ $(CC_OPTS) $^ $(GHC_LIBS_NEEDED) \
- -lbfd -liberty $(LIB_READLINE) $(LIB_DL) -lm
+ -lbfd -liberty $(LIB_READLINE) $(LIB_DL) -lgmp -lm
nHandle$(DYN_EXT): nHandle.c
ifeq "$(TARGETPLATFORM)" "i386-unknown-cygwin32"
diff --git a/ghc/interpreter/connect.h b/ghc/interpreter/connect.h
index f16f7479706b..ff99e1ef6eaf 100644
--- a/ghc/interpreter/connect.h
+++ b/ghc/interpreter/connect.h
@@ -8,8 +8,8 @@
* included in the distribution.
*
* $RCSfile: connect.h,v $
- * $Revision: 1.21 $
- * $Date: 1999/12/10 15:59:43 $
+ * $Revision: 1.22 $
+ * $Date: 1999/12/20 16:55:26 $
* ------------------------------------------------------------------------*/
/* --------------------------------------------------------------------------
@@ -565,4 +565,6 @@ extern List /* of ZTriple(I_INTERFACE,
extern Void hi_o_namesFromSrcName Args((String,String*,String* oName));
extern Cell parseInterface Args((String,Long));
-
+extern String getExtraObjectInfo ( String primaryObjectName,
+ String extraFileName,
+ Int* extraFileSize );
diff --git a/ghc/interpreter/interface.c b/ghc/interpreter/interface.c
index 1a1b52652c87..321ec98aec2a 100644
--- a/ghc/interpreter/interface.c
+++ b/ghc/interpreter/interface.c
@@ -7,8 +7,8 @@
* Hugs version 1.4, December 1997
*
* $RCSfile: interface.c,v $
- * $Revision: 1.13 $
- * $Date: 1999/12/17 16:34:08 $
+ * $Revision: 1.14 $
+ * $Date: 1999/12/20 16:55:26 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
@@ -957,49 +957,74 @@ void startGHCModule_errMsg ( char* msg )
void* startGHCModule_clientLookup ( char* sym )
{
+ /* fprintf ( stderr, "CLIENTLOOKUP %s\n", sym ); */
return lookupObjName ( sym );
}
-Void startGHCModule ( Text mname, Int sizeObj, Text nameObj )
+ObjectCode* startGHCModule_partial_load ( String objNm, Int objSz )
{
- Module m = findModule(mname);
-
- if (isNull(m)) {
- m = newModule(mname);
- fprintf ( stderr, "startGHCIface: name %16s objsize %d\n",
- textToStr(mname), sizeObj );
- } else {
- if (module(m).fake) {
- module(m).fake = FALSE;
- } else {
- ERRMSG(0) "Module \"%s\" already loaded", textToStr(mname)
- EEND;
- }
- }
-
- module(m).object
- = ocNew ( startGHCModule_errMsg,
- startGHCModule_clientLookup,
- textToStr(nameObj),
- sizeObj );
+ ObjectCode* oc
+ = ocNew ( startGHCModule_errMsg,
+ startGHCModule_clientLookup,
+ objNm, objSz );
- if (!module(m).object) {
- ERRMSG(0) "Object loading failed for module \"%s\"",
- textToStr(mname)
+ if (!oc) {
+ ERRMSG(0) "Storage allocation for object file \"%s\" failed", objNm
EEND;
}
-
- if (!ocVerifyImage(module(m).object,VERBOSE)) {
- ERRMSG(0) "Validation of object file \"%s\" failed",
- textToStr(nameObj)
+ if (!ocLoadImage(oc,VERBOSE)) {
+ ERRMSG(0) "Reading of object file \"%s\" failed", objNm
EEND;
}
-
- if (!ocGetNames(module(m).object,VERBOSE)) {
- ERRMSG(0) "Reading of symbol names in object file \"%s\" failed",
- textToStr(nameObj)
+ if (!ocVerifyImage(oc,VERBOSE)) {
+ ERRMSG(0) "Validation of object file \"%s\" failed", objNm
EEND;
}
+ if (!ocGetNames(oc,0||VERBOSE)) {
+ ERRMSG(0) "Reading of symbol names in object file \"%s\" failed", objNm
+ EEND;
+ }
+ return oc;
+}
+
+Void startGHCModule ( Text mname, Int sizeObj, Text nameObj )
+{
+ List xts;
+ Module m = findModule(mname);
+
+ if (isNull(m)) {
+ m = newModule(mname);
+ fprintf ( stderr, "startGHCIface: name %16s objsize %d\n",
+ textToStr(mname), sizeObj );
+ } else {
+ if (module(m).fake) {
+ module(m).fake = FALSE;
+ } else {
+ ERRMSG(0) "Module \"%s\" already loaded", textToStr(mname)
+ EEND;
+ }
+ }
+
+ /* Get hold of the primary object for the module. */
+ module(m).object
+ = startGHCModule_partial_load ( textToStr(nameObj), sizeObj );
+
+ /* and any extras ... */
+ for (xts = module(m).objectExtraNames; nonNull(xts); xts=tl(xts)) {
+ Int size;
+ ObjectCode* oc;
+ Text xtt = hd(xts);
+ String nm = getExtraObjectInfo ( textToStr(nameObj),
+ textToStr(xtt),
+ &size );
+ if (size == -1) {
+ ERRMSG(0) "Can't find extra object file \"%s\"", nm
+ EEND;
+ }
+ oc = startGHCModule_partial_load ( nm, size );
+ oc->next = module(m).objectExtras;
+ module(m).objectExtras = oc;
+ }
}
@@ -1031,11 +1056,12 @@ Void startGHCModule ( Text mname, Int sizeObj, Text nameObj )
Void finishGHCModule ( Cell root )
{
/* root :: I_INTERFACE */
- Cell iface = unap(I_INTERFACE,root);
- ConId iname = zfst(iface);
- Module mod = findModule(textOf(iname));
- List exlist_list = NIL;
- List t;
+ Cell iface = unap(I_INTERFACE,root);
+ ConId iname = zfst(iface);
+ Module mod = findModule(textOf(iname));
+ List exlist_list = NIL;
+ List t;
+ ObjectCode* oc;
fprintf(stderr, "begin finishGHCModule %s\n", textToStr(textOf(iname)));
@@ -1171,8 +1197,13 @@ Void finishGHCModule ( Cell root )
}
/* Last, but by no means least ... */
- if (!ocResolve(module(mod).object,VERBOSE))
+ if (!ocResolve(module(mod).object,0||VERBOSE))
internal("finishGHCModule: object resolution failed");
+
+ for (oc=module(mod).objectExtras; oc; oc=oc->next) {
+ if (!ocResolve(oc, 0||VERBOSE))
+ internal("finishGHCModule: extra object resolution failed");
+ }
}
@@ -1833,7 +1864,7 @@ static Void finishGHCInstance ( Inst in )
assert (currentModule==inst(in).mod);
/* inst(in).c is, prior to finishGHCInstance, a ConId or Tuple,
- since beginGHCInstance couldn't possibly have resolved it to
+ since startGHCInstance couldn't possibly have resolved it to
a Class at that point. We convert it to a Class now.
*/
c = inst(in).c;
@@ -2136,33 +2167,161 @@ Type type; {
* General object symbol query stuff
* ------------------------------------------------------------------------*/
-/* entirely bogus claims about types of these symbols */
-extern int stg_gc_enter_1;
-extern int stg_chk_0;
-extern int stg_chk_1;
-extern int stg_update_PAP;
-extern int __ap_2_upd_info;
-extern int MainRegTable;
-extern int Upd_frame_info;
-extern int CAF_BLACKHOLE_info;
-extern int IND_STATIC_info;
-extern int newCAF;
+#define EXTERN_SYMS \
+ Sym(stg_gc_enter_1) \
+ Sym(stg_gc_noregs) \
+ Sym(stg_gc_seq_1) \
+ Sym(stg_gc_d1) \
+ Sym(stg_chk_0) \
+ Sym(stg_chk_1) \
+ Sym(stg_gen_chk) \
+ Sym(stg_exit) \
+ Sym(stg_update_PAP) \
+ Sym(stg_error_entry) \
+ Sym(__ap_2_upd_info) \
+ Sym(__ap_3_upd_info) \
+ Sym(__ap_4_upd_info) \
+ Sym(__ap_5_upd_info) \
+ Sym(__ap_6_upd_info) \
+ Sym(__sel_0_upd_info) \
+ Sym(__sel_1_upd_info) \
+ Sym(__sel_2_upd_info) \
+ Sym(__sel_3_upd_info) \
+ Sym(__sel_4_upd_info) \
+ Sym(__sel_5_upd_info) \
+ Sym(__sel_6_upd_info) \
+ Sym(__sel_7_upd_info) \
+ Sym(__sel_8_upd_info) \
+ Sym(__sel_9_upd_info) \
+ Sym(__sel_10_upd_info) \
+ Sym(__sel_11_upd_info) \
+ Sym(__sel_12_upd_info) \
+ Sym(MainRegTable) \
+ Sym(Upd_frame_info) \
+ Sym(seq_frame_info) \
+ Sym(CAF_BLACKHOLE_info) \
+ Sym(IND_STATIC_info) \
+ Sym(EMPTY_MVAR_info) \
+ Sym(MUT_ARR_PTRS_FROZEN_info) \
+ Sym(newCAF) \
+ Sym(putMVarzh_fast) \
+ Sym(newMVarzh_fast) \
+ Sym(takeMVarzh_fast) \
+ Sym(catchzh_fast) \
+ Sym(raisezh_fast) \
+ Sym(delayzh_fast) \
+ Sym(yieldzh_fast) \
+ Sym(killThreadzh_fast) \
+ Sym(waitReadzh_fast) \
+ Sym(waitWritezh_fast) \
+ Sym(CHARLIKE_closure) \
+ Sym(suspendThread) \
+ Sym(resumeThread) \
+ Sym(stackOverflow) \
+ Sym(int2Integerzh_fast) \
+ Sym(stg_gc_unbx_r1) \
+ Sym(ErrorHdrHook) \
+ Sym(makeForeignObjzh_fast) \
+ Sym(__encodeDouble) \
+ Sym(decodeDoublezh_fast) \
+ Sym(isDoubleNaN) \
+ Sym(isDoubleInfinite) \
+ Sym(isDoubleDenormalized) \
+ Sym(isDoubleNegativeZero) \
+ Sym(__encodeFloat) \
+ Sym(decodeFloatzh_fast) \
+ Sym(isFloatNaN) \
+ Sym(isFloatInfinite) \
+ Sym(isFloatDenormalized) \
+ Sym(isFloatNegativeZero) \
+ Sym(__int_encodeFloat) \
+ Sym(__int_encodeDouble) \
+ Sym(mpz_cmp_si) \
+ Sym(mpz_cmp) \
+ Sym(newArrayzh_fast) \
+ Sym(unsafeThawArrayzh_fast) \
+ Sym(newDoubleArrayzh_fast) \
+ Sym(newFloatArrayzh_fast) \
+ Sym(newAddrArrayzh_fast) \
+ Sym(newWordArrayzh_fast) \
+ Sym(newIntArrayzh_fast) \
+ Sym(newCharArrayzh_fast) \
+ Sym(newMutVarzh_fast) \
+ Sym(quotRemIntegerzh_fast) \
+ Sym(divModIntegerzh_fast) \
+ Sym(timesIntegerzh_fast) \
+ Sym(minusIntegerzh_fast) \
+ Sym(plusIntegerzh_fast) \
+ Sym(addr2Integerzh_fast) \
+ Sym(mkWeakzh_fast) \
+ Sym(prog_argv) \
+ Sym(prog_argc) \
+ Sym(resetNonBlockingFd) \
+ \
+ /* needed by libHS_cbits */ \
+ SymX(malloc) \
+ Sym(__errno_location) \
+ SymX(close) \
+ Sym(__xstat) \
+ Sym(__fxstat) \
+ Sym(__lxstat) \
+ Sym(mkdir) \
+ SymX(close) \
+ Sym(opendir) \
+ Sym(closedir) \
+ Sym(readdir) \
+ Sym(tcgetattr) \
+ Sym(tcsetattr) \
+ SymX(isatty) \
+ SymX(read) \
+ SymX(lseek) \
+ SymX(write) \
+ Sym(getrusage) \
+ Sym(gettimeofday) \
+ SymX(realloc) \
+ SymX(getcwd) \
+ SymX(free) \
+ SymX(strcpy) \
+ SymX(select) \
+ Sym(fcntl) \
+ SymX(stderr) \
+ SymX(fprintf) \
+ SymX(exit) \
+ Sym(open) \
+ SymX(unlink) \
+ SymX(memcpy) \
+ SymX(memchr) \
+ SymX(rmdir) \
+ SymX(rename) \
+ SymX(chdir) \
+ Sym(localtime) \
+ Sym(strftime) \
+ SymX(vfork) \
+ SymX(execl) \
+ SymX(_exit) \
+ Sym(waitpid) \
+ Sym(tzname) \
+ Sym(timezone) \
+ Sym(mktime) \
+ Sym(gmtime) \
+
+/* entirely bogus claims about types of these symbols */
+#define Sym(vvv) extern int vvv;
+#define SymX(vvv) /* nothing */
+EXTERN_SYMS
+#undef Sym
+#undef SymX
+
+#define Sym(vvv) { #vvv, &vvv },
+#define SymX(vvv) { #vvv, &vvv },
OSym rtsTab[]
= {
- { "stg_gc_enter_1", &stg_gc_enter_1 },
- { "stg_chk_0", &stg_chk_0 },
- { "stg_chk_1", &stg_chk_1 },
- { "stg_update_PAP", &stg_update_PAP },
- { "__ap_2_upd_info", &__ap_2_upd_info },
- { "MainRegTable", &MainRegTable },
- { "Upd_frame_info", &Upd_frame_info },
- { "CAF_BLACKHOLE_info", &CAF_BLACKHOLE_info },
- { "IND_STATIC_info", &IND_STATIC_info },
- { "newCAF", &newCAF },
+ EXTERN_SYMS
{0,0}
};
-
+#undef Sym
+#undef SymX
void* lookupObjName ( char* nm )
{
@@ -2176,20 +2335,25 @@ void* lookupObjName ( char* nm )
nm2[199] = 0;
strncpy(nm2,nm,200);
- // first see if it's an RTS name
+ /* first see if it's an RTS name */
for (k = 0; rtsTab[k].nm; k++)
if (0==strcmp(nm2,rtsTab[k].nm))
return rtsTab[k].ad;
- // if not an RTS name, look in the
- // relevant module's object symbol table
+ /* perhaps an extra-symbol ? */
+ a = lookupOExtraTabName ( nm );
+ if (a) return a;
+
+ /* if not an RTS name, look in the
+ relevant module's object symbol table
+ */
pp = strchr(nm2, '_');
- if (!pp) goto not_found;
+ if (!pp || !isupper(nm2[0])) goto not_found;
*pp = 0;
t = unZcodeThenFindText(nm2);
m = findModule(t);
if (isNull(m)) goto not_found;
-fprintf(stderr, " %%%% %s\n", nm );
+
a = lookupOTabName ( m, nm ); /* RATIONALISE */
if (a) return a;
@@ -2197,6 +2361,7 @@ fprintf(stderr, " %%%% %s\n", nm );
fprintf ( stderr,
"lookupObjName: can't resolve name `%s'\n",
nm );
+assert(4-4);
return NULL;
}
diff --git a/ghc/interpreter/link.c b/ghc/interpreter/link.c
index 47d1e59e2509..8d7ff5de1ce5 100644
--- a/ghc/interpreter/link.c
+++ b/ghc/interpreter/link.c
@@ -9,8 +9,8 @@
* included in the distribution.
*
* $RCSfile: link.c,v $
- * $Revision: 1.22 $
- * $Date: 1999/12/16 16:34:42 $
+ * $Revision: 1.23 $
+ * $Date: 1999/12/20 16:55:27 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
@@ -498,6 +498,10 @@ break;
if (combined) {
+ modulePrelude = findFakeModule(textPrelude);
+ module(modulePrelude).objectExtraNames
+ = singleton(findText("libHS_cbits"));
+
nameMkC = addWiredInBoxingTycon("PrelBase","Char", "C#",1,0,CHAR_REP );
nameMkI = addWiredInBoxingTycon("PrelBase","Int", "I#",1,0,INT_REP );
nameMkW = addWiredInBoxingTycon("PrelAddr","Word", "W#",1,0,WORD_REP );
diff --git a/ghc/interpreter/machdep.c b/ghc/interpreter/machdep.c
index 369fc45a3581..f8536ca8b64a 100644
--- a/ghc/interpreter/machdep.c
+++ b/ghc/interpreter/machdep.c
@@ -13,8 +13,8 @@
* included in the distribution.
*
* $RCSfile: machdep.c,v $
- * $Revision: 1.17 $
- * $Date: 1999/12/10 15:59:48 $
+ * $Revision: 1.18 $
+ * $Date: 1999/12/20 16:55:27 $
* ------------------------------------------------------------------------*/
#ifdef HAVE_SIGNAL_H
@@ -771,6 +771,43 @@ Bool findFilesForModule (
}
+/* If the primaryObjectName for is (eg)
+ /foo/bar/PrelSwamp.o
+ and the extraFileName is (eg)
+ swampy_cbits
+ and DLL_ENDING is set to .o
+ return
+ /foo/bar/swampy_cbits.o
+ and set *extraFileSize to its size, or -1 if not avail
+*/
+String getExtraObjectInfo ( String primaryObjectName,
+ String extraFileName,
+ Int* extraFileSize )
+{
+ Time xTime;
+ Long xSize;
+ String xtra;
+
+ Int i = strlen(primaryObjectName)-1;
+ while (i >= 0 && primaryObjectName[i] != SLASH) i--;
+ if (i == -1) return extraFileName;
+ i++;
+ xtra = malloc ( i+3+strlen(extraFileName)+strlen(DLL_ENDING) );
+ if (!xtra) internal("deriveExtraObjectName: malloc failed");
+ strncpy ( xtra, primaryObjectName, i );
+ xtra[i] = 0;
+ strcat ( xtra, extraFileName );
+ strcat ( xtra, DLL_ENDING );
+
+ *extraFileSize = -1;
+ if (readable(xtra)) {
+ getFileInfo ( xtra, &xTime, &xSize );
+ *extraFileSize = xSize;
+ }
+ return xtra;
+}
+
+
/* --------------------------------------------------------------------------
* Substitute old value of path into empty entries in new path
* eg substPath("a:b:c::d:e","x:y:z") = "a:b:c:x:y:z:d:e"
diff --git a/ghc/interpreter/object.c b/ghc/interpreter/object.c
index f3426d6911ca..d77cd4ae29c0 100644
--- a/ghc/interpreter/object.c
+++ b/ghc/interpreter/object.c
@@ -16,6 +16,7 @@
#include <stdlib.h>
#include <string.h>
#include <assert.h>
+#include "config.h" /* for linux_TARGET_OS etc */
#include "object.h"
@@ -115,7 +116,7 @@ int ocVerifyImage ( ObjectCode* oc, int verb )
# endif
if (verb) fprintf(stderr, "ocVerifyImage: done, status = %d", ret);
- if (ret) oc->status==OBJECT_VERIFIED;
+ if (ret) oc->status = OBJECT_VERIFIED;
return ret;
}
@@ -133,7 +134,7 @@ int ocGetNames ( ObjectCode* oc, int verb )
return 0;
# endif
if (verb) fprintf(stderr, "ocGetNames: done, status = %d\n", ret);
- if (ret) oc->status==OBJECT_HAVENAMES;
+ if (ret) oc->status = OBJECT_HAVENAMES;
return ret;
}
@@ -151,7 +152,7 @@ int ocResolve ( ObjectCode* oc, int verb )
return 0;
# endif
if (verb) fprintf(stderr, "ocResolve: done, status = %d\n", ret);
- if (ret) oc->status==OBJECT_RESOLVED;
+ if (ret) oc->status = OBJECT_RESOLVED;
return ret;
}
@@ -318,13 +319,16 @@ static char* hackyAppend ( char* s1, char* s2 )
* ELF specifics
* ------------------------------------------------------------------------*/
+#define FALSE 0
+#define TRUE 1
+
#if defined(linux_TARGET_OS) || defined(solaris2_TARGET_OS)
#include <elf.h>
static char* findElfSection ( void* objImage, Elf32_Word sh_type )
{
- Int i;
+ int i;
char* ehdrC = (char*)objImage;
Elf32_Ehdr* ehdr = ( Elf32_Ehdr*)ehdrC;
Elf32_Shdr* shdr = (Elf32_Shdr*) (ehdrC + ehdr->e_shoff);
@@ -519,17 +523,17 @@ static int ocGetNames_ELF ( ObjectCode* oc, int verb )
for (i = 0; i < ehdr->e_shnum; i++) {
/* make a HugsDLSection entry for relevant sections */
- DLSect kind = HUGS_DL_SECTION_OTHER;
+ OSectionKind kind = HUGS_SECTIONKIND_OTHER;
if (0==strcmp(".data",sh_strtab+shdr[i].sh_name) ||
0==strcmp(".data1",sh_strtab+shdr[i].sh_name))
- kind = HUGS_DL_SECTION_RWDATA;
+ kind = HUGS_SECTIONKIND_RWDATA;
if (0==strcmp(".text",sh_strtab+shdr[i].sh_name) ||
0==strcmp(".rodata",sh_strtab+shdr[i].sh_name) ||
0==strcmp(".rodata1",sh_strtab+shdr[i].sh_name))
- kind = HUGS_DL_SECTION_CODE_OR_RODATA;
- if (kind != HUGS_DL_SECTION_OTHER)
- addDLSect (
- m,
+ kind = HUGS_SECTIONKIND_CODE_OR_RODATA;
+ if (kind != HUGS_SECTIONKIND_OTHER)
+ addSection (
+ oc,
ehdrC + shdr[i].sh_offset,
ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1,
kind
@@ -546,8 +550,8 @@ static int ocGetNames_ELF ( ObjectCode* oc, int verb )
)
&&
( ELF32_ST_TYPE(stab[j].st_info)==STT_FUNC ||
- ELF32_ST_TYPE(stab[j].st_info)==STT_OBJECT ||
- ELF32_ST_TYPE(stab[j].st_info)==STT_NOTYPE)
+ ELF32_ST_TYPE(stab[j].st_info)==STT_OBJECT)
+ /* || ELF32_ST_TYPE(stab[j].st_info)==STT_NOTYPE */
) {
char* nm = strtab + stab[j].st_name;
char* ad = ehdrC
@@ -557,13 +561,13 @@ static int ocGetNames_ELF ( ObjectCode* oc, int verb )
assert(ad);
if (verb)
fprintf(stderr, "addOTabName: %10p %s %s\n",
- ad, textToStr(module(m).text), nm );
+ ad, oc->objFileName, nm );
addSymbol ( oc, nm, ad );
}
- //else fprintf(stderr, "skipping `%s'\n", strtab + stab[j].st_name );
+ else fprintf(stderr, "skipping `%s'\n", strtab + stab[j].st_name );
}
-
}
+ return TRUE;
}
@@ -592,9 +596,9 @@ static int ocResolve_ELF ( ObjectCode* oc, int verb )
for (i = 0; i < ehdr->e_shnum; i++) {
if (shdr[i].sh_type == SHT_REL ) {
Elf32_Rel* rtab = (Elf32_Rel*) (ehdrC + shdr[i].sh_offset);
- Int nent = shdr[i].sh_size / sizeof(Elf32_Rel);
- Int target_shndx = shdr[i].sh_info;
- Int symtab_shndx = shdr[i].sh_link;
+ int nent = shdr[i].sh_size / sizeof(Elf32_Rel);
+ int target_shndx = shdr[i].sh_info;
+ int symtab_shndx = shdr[i].sh_link;
stab = (Elf32_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
targ = (Elf32_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
if (verb)
@@ -628,7 +632,7 @@ static int ocResolve_ELF ( ObjectCode* oc, int verb )
/* No? Perhaps it's a named symbol in this file. */
strcpy ( symbol, strtab+stab[ ELF32_R_SYM(info)].st_name );
if (verb) fprintf ( stderr, "`%s' ", symbol );
- S = (Elf32_Addr)lookupSymbol ( oc, symbol );
+ S = (Elf32_Addr)ocLookupSym ( oc, symbol );
if (!S) {
/* No? Ok, too hard. Hand the problem to the client.
And if that fails, we're outta options.
diff --git a/ghc/interpreter/storage.c b/ghc/interpreter/storage.c
index 9b4b67e1979b..f4380ed23937 100644
--- a/ghc/interpreter/storage.c
+++ b/ghc/interpreter/storage.c
@@ -9,8 +9,8 @@
* included in the distribution.
*
* $RCSfile: storage.c,v $
- * $Revision: 1.27 $
- * $Date: 1999/12/17 16:34:08 $
+ * $Revision: 1.28 $
+ * $Date: 1999/12/20 16:55:27 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
@@ -1329,14 +1329,16 @@ Text t; {
ERRMSG(0) "Module storage space exhausted"
EEND;
}
- module(moduleHw).text = t; /* clear new module record */
- module(moduleHw).qualImports = NIL;
- module(moduleHw).fake = FALSE;
- module(moduleHw).exports = NIL;
- module(moduleHw).tycons = NIL;
- module(moduleHw).names = NIL;
- module(moduleHw).classes = NIL;
- module(moduleHw).object = NULL;
+ module(moduleHw).text = t; /* clear new module record */
+ module(moduleHw).qualImports = NIL;
+ module(moduleHw).fake = FALSE;
+ module(moduleHw).exports = NIL;
+ module(moduleHw).tycons = NIL;
+ module(moduleHw).names = NIL;
+ module(moduleHw).classes = NIL;
+ module(moduleHw).object = NULL;
+ module(moduleHw).objectExtras = NULL;
+ module(moduleHw).objectExtraNames = NIL;
return moduleHw++;
}
@@ -1440,6 +1442,20 @@ void* lookupOTabName ( Module m, char* sym )
}
+void* lookupOExtraTabName ( char* sym )
+{
+ ObjectCode* oc;
+ Module m;
+ for (m = MODMIN; m < moduleHw; m++) {
+ for (oc = module(m).objectExtras; oc; oc=oc->next) {
+ void* ad = ocLookupSym ( oc, sym );
+ if (ad) return ad;
+ }
+ }
+ return NULL;
+}
+
+
OSectionKind lookupSection ( void* ad )
{
int i;
@@ -2965,6 +2981,7 @@ Int what; {
mark(module(i).classes);
mark(module(i).exports);
mark(module(i).qualImports);
+ mark(module(i).objectExtraNames);
}
end("Modules", moduleHw-MODMIN);
diff --git a/ghc/interpreter/storage.h b/ghc/interpreter/storage.h
index 393188a1330e..b56b965eb262 100644
--- a/ghc/interpreter/storage.h
+++ b/ghc/interpreter/storage.h
@@ -10,8 +10,8 @@
* included in the distribution.
*
* $RCSfile: storage.h,v $
- * $Revision: 1.22 $
- * $Date: 1999/12/17 16:34:08 $
+ * $Revision: 1.23 $
+ * $Date: 1999/12/20 16:55:28 $
* ------------------------------------------------------------------------*/
/* --------------------------------------------------------------------------
@@ -516,8 +516,12 @@ struct Module {
/* TRUE if module exists only via GHC primop defn; usually FALSE */
Bool fake;
- /* One or more object file descriptors. */
+ /* The primary object file for this module. */
ObjectCode* object;
+
+ /* And any extras it might need. */
+ ObjectCode* objectExtras;
+ List objectExtraNames; /* :: [Text] -- names of extras */
};
@@ -536,7 +540,7 @@ extern char* nameFromOPtr Args((void*));
extern void addSection Args((Module,void*,void*,OSectionKind));
extern OSectionKind lookupSection Args((void*));
-
+extern void* lookupOExtraTabName ( char* sym );
#define isPrelude(m) (m==modulePrelude)
--
GitLab