/* -----------------------------------------------------------------------------
- * $Id: Linker.c,v 1.45 2001/06/25 09:44:10 rrt Exp $
+ * $Id: Linker.c,v 1.56 2001/08/13 14:34:40 simonmar Exp $
*
* (c) The GHC Team, 2000
*
#else
#define RTS_POSIX_ONLY_SYMBOLS
+
+/* These are statically linked from the mingw libraries into the ghc
+ executable, so we have to employ this hack. */
#define RTS_MINGW_ONLY_SYMBOLS \
+ SymX(memset) \
+ SymX(inet_ntoa) \
+ SymX(inet_addr) \
+ SymX(htonl) \
+ SymX(recvfrom) \
+ SymX(listen) \
+ SymX(bind) \
+ SymX(shutdown) \
+ SymX(connect) \
+ SymX(htons) \
+ SymX(ntohs) \
+ SymX(getservbyname) \
+ SymX(getservbyport) \
+ SymX(getprotobynumber) \
+ SymX(getprotobyname) \
+ SymX(gethostbyname) \
+ SymX(gethostbyaddr) \
+ SymX(gethostname) \
+ SymX(strcpy) \
+ SymX(strncpy) \
SymX(abort) \
Sym(_alloca) \
Sym(isxdigit) \
Sym(iscntrl) \
Sym(isalpha) \
Sym(isalnum) \
- SymX(memset) \
- SymX(strncpy) \
- SymX(strcpy) \
SymX(strcmp) \
- SymX(strerror) \
- Sym(mktime) \
- Sym(gmtime) \
- Sym(strftime) \
- Sym(localtime) \
- SymX(getenv) \
- SymX(rename) \
- Sym(opendir) \
- Sym(readdir) \
- Sym(closedir) \
- Sym(PrelHandle_stderr_closure) \
- Sym(Main_main_closure) \
- Sym(__init_Main) \
+ SymX(memmove) \
+ SymX(realloc) \
+ SymX(malloc) \
SymX(pow) \
SymX(tanh) \
SymX(cosh) \
SymX(exp) \
SymX(log) \
SymX(sqrt) \
- SymX(Sleep) \
- SymX(system) \
- SymX(memchr) \
SymX(memcpy) \
- SymX(memmove) \
- SymX(fprintf) \
- Sym(_imp___iob) \
- Sym(_imp___tzname) \
+ Sym(mktime) \
Sym(_imp___timezone) \
- Sym(__udivdi3) \
- SymX(GetProcessTimes) \
- SymX(GetCurrentProcess) \
- SymX(read) \
- SymX(write) \
- SymX(open) \
- SymX(close) \
- SymX(send) \
- SymX(recv) \
- SymX(malloc) \
+ Sym(_imp___tzname) \
+ Sym(localtime) \
+ Sym(gmtime) \
+ SymX(getenv) \
SymX(free) \
- SymX(realloc) \
- SymX(fstat) \
- SymX(stat) \
- Sym(ftime) \
- SymX(isatty) \
- SymX(lseek) \
- SymX(access) \
- Sym(setmode) \
- SymX(chmod) \
- SymX(chdir) \
- SymX(getcwd) \
- SymX(unlink) \
- SymX(rmdir) \
- SymX(mkdir) \
- SymX(CreateProcessA) \
- SymX(WaitForSingleObject) \
- SymX(GetExitCodeProcess) \
+ SymX(rename) \
+ Sym(opendir) \
+ Sym(readdir) \
+ Sym(closedir) \
+ SymX(GetCurrentProcess) \
+ SymX(GetProcessTimes) \
SymX(CloseHandle) \
- SymX(_errno) \
- SymX(closesocket)
+ SymX(GetExitCodeProcess) \
+ SymX(WaitForSingleObject) \
+ SymX(CreateProcessA) \
+ Sym(__divdi3) \
+ Sym(__udivdi3) \
+ Sym(__moddi3) \
+ Sym(__umoddi3) \
+ SymX(_errno)
#endif
SymX(newArrayzh_fast) \
SymX(unsafeThawArrayzh_fast) \
SymX(newByteArrayzh_fast) \
+ SymX(newPinnedByteArrayzh_fast) \
SymX(newMutVarzh_fast) \
SymX(quotRemIntegerzh_fast) \
SymX(quotIntegerzh_fast) \
#define RTS_LONG_LONG_SYMS /* nothing */
#else
#define RTS_LONG_LONG_SYMS \
- SymX(stg_gtWord64) \
- SymX(stg_geWord64) \
- SymX(stg_eqWord64) \
- SymX(stg_neWord64) \
- SymX(stg_ltWord64) \
- SymX(stg_leWord64) \
- SymX(stg_gtInt64) \
- SymX(stg_geInt64) \
- SymX(stg_eqInt64) \
- SymX(stg_neInt64) \
- SymX(stg_ltInt64) \
- SymX(stg_leInt64) \
- SymX(stg_remWord64) \
- SymX(stg_quotWord64) \
- SymX(stg_remInt64) \
- SymX(stg_quotInt64) \
- SymX(stg_negateInt64) \
- SymX(stg_plusInt64) \
- SymX(stg_minusInt64) \
- SymX(stg_timesInt64) \
- SymX(stg_and64) \
- SymX(stg_or64) \
- SymX(stg_xor64) \
- SymX(stg_not64) \
- SymX(stg_shiftL64) \
- SymX(stg_shiftRL64) \
- SymX(stg_iShiftL64) \
- SymX(stg_iShiftRL64) \
- SymX(stg_iShiftRA64) \
- SymX(stg_intToInt64) \
- SymX(stg_int64ToInt) \
- SymX(stg_int64ToWord64) \
- SymX(stg_wordToWord64) \
- SymX(stg_word64ToWord) \
- SymX(stg_word64ToInt64) \
SymX(int64ToIntegerzh_fast) \
SymX(word64ToIntegerzh_fast)
#endif /* SUPPORT_LONG_LONGS */
typedef
struct _OpenedDLL {
+ char* name;
struct _OpenedDLL* next;
HINSTANCE instance;
}
} else {
return NULL;
}
- ASSERT(0); /*NOTREACHED*/
+ /*NOTREACHED*/
+
# elif defined(OBJFORMAT_PEi386)
/* Add this DLL to the list of DLLs in which to search for symbols.
- The first time through, also add the executable to the list,
- since we need to search that too. The path argument is ignored. */
+ The path argument is ignored. */
char* buf;
OpenedDLL* o_dll;
HINSTANCE instance;
- /* fprintf(stderr, "addDLL %s\n", dll_name ); */
-#if 0
- /* Later ... can't figure out why this doesn't work. So retain the
- RTS_MINGW_ONLY_SYMBOLS hack for the time being. */
- if (opened_dlls == NULL) {
- /* First time through ... */
- instance = GetModuleHandle(NULL);
- if (instance == NULL)
- return "addDLL: can't get handle to the executable";
- o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL-init" );
- o_dll->instance = instance;
- o_dll->next = opened_dlls;
- opened_dlls = o_dll;
+ /* fprintf(stderr, "\naddDLL; path=`%s', dll_name = `%s'\n", path, dll_name); */
+
+ /* See if we've already got it, and ignore if so. */
+ for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
+ if (0 == strcmp(o_dll->name, dll_name))
+ return NULL;
}
-#endif
- buf = stgMallocBytes(strlen(dll_name) + 10, "addDll");
+ buf = stgMallocBytes(strlen(dll_name) + 10, "addDLL");
sprintf(buf, "%s.DLL", dll_name);
instance = LoadLibrary(buf);
free(buf);
}
o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
+ o_dll->name = stgMallocBytes(1+strlen(dll_name), "addDLL");
+ strcpy(o_dll->name, dll_name);
o_dll->instance = instance;
o_dll->next = opened_dlls;
opened_dlls = o_dll;
OpenedDLL* o_dll;
void* sym;
for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
+ /* fprintf(stderr, "look in %s for %s\n", o_dll->name, lbl); */
+ if (lbl[0] == '_') {
+ /* HACK: if the name has an initial underscore, try stripping
+ it off & look that up first. I've yet to verify whether there's
+ a Rule that governs whether an initial '_' *should always* be
+ stripped off when mapping from import lib name to the DLL name.
+ */
+ sym = GetProcAddress(o_dll->instance, (lbl+1));
+ if (sym != NULL) return sym;
+ }
sym = GetProcAddress(o_dll->instance, lbl);
if (sym != NULL) return sym;
}
return NULL;
+# else
+ ASSERT(2+2 == 5);
+ return NULL;
# endif
} else {
return val;
COFF_section* sectab;
COFF_symbol* symtab;
UChar* strtab;
- fprintf(stderr, "\nLOADING %s\n", oc->fileName);
+ /* fprintf(stderr, "\nLOADING %s\n", oc->fileName); */
hdr = (COFF_header*)(oc->image);
sectab = (COFF_section*) (
((UChar*)(oc->image))
kind = SECTIONKIND_CODE_OR_RODATA;
#endif
- if (0==strcmp(".text",sectab_i->Name))
+ if (0==strcmp(".text",sectab_i->Name) ||
+ 0==strcmp(".rodata",sectab_i->Name))
kind = SECTIONKIND_CODE_OR_RODATA;
if (0==strcmp(".data",sectab_i->Name) ||
0==strcmp(".bss",sectab_i->Name))
COFF_section* section_sym
= findPEi386SectionCalled ( oc, sym->Name );
if (!section_sym) {
- fprintf ( stderr, "bad section = `%s'\n", sym->Name );
- barf("Can't find abovementioned PEi386 section");
+ belch("%s: can't find section `%s'", oc->fileName, sym->Name);
return 0;
}
S = ((UInt32)(oc->image))
if ((void*)S == NULL)
(void*)S = lookupSymbol( symbol );
if (S == 0) {
- belch("ocResolve_PEi386: %s: unknown symbol `%s'",
- oc->fileName, symbol);
+ belch("%s: unknown symbol `%s'", oc->fileName, symbol);
return 0;
}
}
*pP = S - ((UInt32)pP) - 4;
break;
default:
- fprintf(stderr,
- "unhandled PEi386 relocation type %d\n",
- reltab_j->Type);
- barf("unhandled PEi386 relocation type");
+ belch("%s: unhandled PEi386 relocation type %d",
+ oc->fileName, reltab_j->Type);
return 0;
}
}
}
- /* fprintf(stderr, "completed %s\n", oc->fileName); */
+ IF_DEBUG(linker, belch("completed %s", oc->fileName));
return 1;
}
#if defined(sparc_TARGET_ARCH)
# define ELF_TARGET_SPARC /* Used inside <elf.h> */
+#elif defined(i386_TARGET_ARCH)
+# define ELF_TARGET_386 /* Used inside <elf.h> */
#endif
+/* There is a similar case for IA64 in the Solaris2 headers if this
+ * ever becomes relevant.
+ */
#include <elf.h>
ehdr->e_ident[EI_MAG1] != ELFMAG1 ||
ehdr->e_ident[EI_MAG2] != ELFMAG2 ||
ehdr->e_ident[EI_MAG3] != ELFMAG3) {
- belch("ocVerifyImage_ELF: not an ELF header");
+ belch("%s: not an ELF header", oc->fileName);
return 0;
}
IF_DEBUG(linker,belch( "Is an ELF header" ));
if (ehdr->e_ident[EI_CLASS] != ELFCLASS32) {
- belch("ocVerifyImage_ELF: not 32 bit ELF" );
+ belch("%s: not 32 bit ELF", oc->fileName);
return 0;
}
if (ehdr->e_ident[EI_DATA] == ELFDATA2MSB) {
IF_DEBUG(linker,belch( "Is big-endian" ));
} else {
- belch("ocVerifyImage_ELF: unknown endiannness");
+ belch("%s: unknown endiannness", oc->fileName);
return 0;
}
if (ehdr->e_type != ET_REL) {
- belch("ocVerifyImage_ELF: not a relocatable object (.o) file");
+ belch("%s: not a relocatable object (.o) file", oc->fileName);
return 0;
}
IF_DEBUG(linker, belch( "Is a relocatable object (.o) file" ));
case EM_386: IF_DEBUG(linker,belch( "x86" )); break;
case EM_SPARC: IF_DEBUG(linker,belch( "sparc" )); break;
default: IF_DEBUG(linker,belch( "unknown" ));
- belch("ocVerifyImage_ELF: unknown architecture");
+ belch("%s: unknown architecture", oc->fileName);
return 0;
}
shdr = (Elf32_Shdr*) (ehdrC + ehdr->e_shoff);
if (ehdr->e_shstrndx == SHN_UNDEF) {
- belch("ocVerifyImage_ELF: no section header string table");
+ belch("%s: no section header string table", oc->fileName);
return 0;
} else {
IF_DEBUG(linker,belch( "Section header string table is section %d",
}
}
if (nstrtab != 1) {
- belch("ocVerifyImage_ELF: no string tables, or too many");
+ belch("%s: no string tables, or too many", oc->fileName);
return 0;
}
shdr[i].sh_size % sizeof(Elf32_Sym)
));
if (0 != shdr[i].sh_size % sizeof(Elf32_Sym)) {
- belch("ocVerifyImage_ELF: non-integral number of symbol table entries");
+ belch("%s: non-integral number of symbol table entries", oc->fileName);
return 0;
}
for (j = 0; j < nent; j++) {
}
if (nsymtabs == 0) {
- belch("ocVerifyImage_ELF: didn't find any symbol tables");
+ belch("%s: didn't find any symbol tables", oc->fileName);
return 0;
}
ASSERT(symhash != NULL);
if (!strtab) {
- belch("ocGetNames_ELF: no strtab");
+ belch("%s: no strtab", oc->fileName);
return 0;
}
/* Do ELF relocations which lack an explicit addend. All x86-linux
relocations appear to be of this form. */
-static int do_Elf32_Rel_relocations ( ObjectCode* oc, char* ehdrC,
- Elf32_Shdr* shdr, int shnum,
- Elf32_Sym* stab, char* strtab )
+static int
+do_Elf32_Rel_relocations ( ObjectCode* oc, char* ehdrC,
+ Elf32_Shdr* shdr, int shnum,
+ Elf32_Sym* stab, char* strtab )
{
int j;
char *symbol;
(void*)S = lookupSymbol( symbol );
}
if (!S) {
- barf("do_Elf32_Rel_relocations: %s: unknown symbol `%s'",
- oc->fileName, symbol);
+ belch("%s: unknown symbol `%s'", oc->fileName, symbol);
+ return 0;
}
IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
}
case R_386_PC32: *pP = S + A - P; break;
# endif
default:
- fprintf(stderr, "unhandled ELF relocation(Rel) type %d\n",
- ELF32_R_TYPE(info));
- barf("do_Elf32_Rel_relocations: unhandled ELF relocation type");
+ belch("%s: unhandled ELF relocation(Rel) type %d\n",
+ oc->fileName, ELF32_R_TYPE(info));
return 0;
}
/* Do ELF relocations for which explicit addends are supplied.
sparc-solaris relocations appear to be of this form. */
-static int do_Elf32_Rela_relocations ( ObjectCode* oc, char* ehdrC,
- Elf32_Shdr* shdr, int shnum,
- Elf32_Sym* stab, char* strtab )
+static int
+do_Elf32_Rela_relocations ( ObjectCode* oc, char* ehdrC,
+ Elf32_Shdr* shdr, int shnum,
+ Elf32_Sym* stab, char* strtab )
{
int j;
char *symbol;
(void*)S = lookupSymbol( symbol );
}
if (!S) {
- barf("do_Elf32_Rela_relocations: %s: unknown symbol `%s'",
- oc->fileName, symbol);
+ belch("%s: unknown symbol `%s'", oc->fileName, symbol);
+ return 0;
/*
S = 0x11223344;
fprintf ( stderr, "S %p A %p S+A %p S+A-P %p\n",S,A,S+A,S+A-P);
break;
# endif
default:
- fprintf(stderr, "unhandled ELF relocation(RelA) type %d\n",
- ELF32_R_TYPE(info));
- barf("do_Elf32_Rela_relocations: unhandled ELF relocation type");
+ belch("%s: unhandled ELF relocation(RelA) type %d\n",
+ oc->fileName, ELF32_R_TYPE(info));
return 0;
}
strtab = findElfSection ( ehdrC, SHT_STRTAB );
if (stab == NULL || strtab == NULL) {
- belch("ocResolve_ELF: can't find string or symbol table");
+ belch("%s: can't find string or symbol table", oc->fileName);
return 0;
}
projects / ghc-hetmet.git / blobdiff