Commit 0f92da17 authored by sewardj's avatar sewardj
Browse files

[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.
parent 8a20e269
# --------------------------------------------------------------------------- #
# $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"
......
......@@ -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 );
......@@ -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;
}
......
......@@ -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 );
......
......@@ -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"
......
......@@ -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.
......
......@@ -9,8 +9,8 @@
* included in the distribution.
*
* $RCSfile: storage.c,v $