/* -----------------------------------------------------------------------------
- * $Id: Linker.c,v 1.4 2000/12/14 10:36:49 sewardj Exp $
+ * $Id: Linker.c,v 1.18 2001/02/06 14:44:53 simonmar Exp $
*
* (c) The GHC Team, 2000
*
#include "Hash.h"
#include "Linker.h"
#include "RtsUtils.h"
+#include "StoragePriv.h"
-/* These two are POSIX headers */
+#ifdef HAVE_SYS_TYPES_H
#include <sys/types.h>
+#endif
+
+#ifdef HAVE_SYS_STAT_H
#include <sys/stat.h>
+#endif
-/* ToDo: configure this */
+#ifdef HAVE_DLFCN_H
#include <dlfcn.h>
+#endif
#ifdef GHCI /* endif is right at end of file */
+#if defined(linux_TARGET_OS) || defined(solaris2_TARGET_OS) || defined(freebsd_TARGET_OS)
+#define OBJFORMAT_ELF
+#elif defined(cygwin32_TARGET_OS) || defined (mingw32_TARGET_OS)
+#define OBJFORMAT_PEi386
+#endif
+
/* A bucket in the symbol hash-table. Primarily, maps symbol names to
* absolute addresses. All symbols from a given module are linked
* together, so they can be freed at the same time. There's also a
/* List of currently loaded objects */
ObjectCode *objects;
-#if defined(linux_TARGET_OS) || defined(solaris2_TARGET_OS)
+#if defined(OBJFORMAT_ELF)
static int ocVerifyImage_ELF ( ObjectCode* oc );
static int ocGetNames_ELF ( ObjectCode* oc );
static int ocResolve_ELF ( ObjectCode* oc );
-#elif defined(cygwin32_TARGET_OS)
+#elif defined(OBJFORMAT_PEi386)
static int ocVerifyImage_PEi386 ( ObjectCode* oc );
static int ocGetNames_PEi386 ( ObjectCode* oc );
static int ocResolve_PEi386 ( ObjectCode* oc );
SymX(stg_sel_10_upd_info) \
SymX(stg_sel_11_upd_info) \
SymX(stg_sel_12_upd_info) \
+ SymX(stg_sel_13_upd_info) \
+ SymX(stg_sel_14_upd_info) \
+ SymX(stg_sel_15_upd_info) \
SymX(stg_upd_frame_info) \
SymX(stg_seq_frame_info) \
SymX(stg_CAF_BLACKHOLE_info) \
SymX(stg_IND_STATIC_info) \
SymX(stg_EMPTY_MVAR_info) \
SymX(stg_MUT_ARR_PTRS_FROZEN_info) \
+ SymX(stg_WEAK_info) \
SymX(stg_CHARLIKE_closure) \
SymX(stg_INTLIKE_closure) \
- SymX(stg_CAF_UNENTERED_entry) \
SymX(newCAF) \
+ SymX(newBCOzh_fast) \
+ SymX(mkApUpd0zh_fast) \
SymX(putMVarzh_fast) \
SymX(newMVarzh_fast) \
SymX(takeMVarzh_fast) \
SymX(tryTakeMVarzh_fast) \
SymX(catchzh_fast) \
SymX(raisezh_fast) \
+ SymX(forkzh_fast) \
SymX(delayzh_fast) \
SymX(yieldzh_fast) \
SymX(killThreadzh_fast) \
SymX(resumeThread) \
SymX(stackOverflow) \
SymX(int2Integerzh_fast) \
- SymX(ErrorHdrHook) \
+ SymX(word2Integerzh_fast) \
SymX(mkForeignObjzh_fast) \
SymX(__encodeDouble) \
SymX(decodeDoublezh_fast) \
- SymX(isDoubleNaN) \
- SymX(isDoubleInfinite) \
- SymX(isDoubleDenormalized) \
- SymX(isDoubleNegativeZero) \
- SymX(__encodeFloat) \
SymX(decodeFloatzh_fast) \
- SymX(isFloatNaN) \
- SymX(isFloatInfinite) \
- SymX(isFloatDenormalized) \
- SymX(isFloatNegativeZero) \
- SymX(__int_encodeFloat) \
- SymX(__int_encodeDouble) \
- SymX(__gmpz_cmp_si) \
- SymX(__gmpz_cmp) \
- SymX(__gmpn_gcd_1) \
SymX(gcdIntegerzh_fast) \
SymX(newArrayzh_fast) \
SymX(unsafeThawArrayzh_fast) \
SymX(timesIntegerzh_fast) \
SymX(minusIntegerzh_fast) \
SymX(plusIntegerzh_fast) \
+ SymX(andIntegerzh_fast) \
+ SymX(orIntegerzh_fast) \
+ SymX(xorIntegerzh_fast) \
+ SymX(complementIntegerzh_fast) \
SymX(mkWeakzh_fast) \
+ SymX(makeStableNamezh_fast) \
+ SymX(finalizzeWeakzh_fast) \
+ SymX(blockAsyncExceptionszh_fast) \
+ SymX(unblockAsyncExceptionszh_fast) \
+ SymX(isDoubleNaN) \
+ SymX(isDoubleInfinite) \
+ SymX(isDoubleDenormalized) \
+ SymX(isDoubleNegativeZero) \
+ SymX(__encodeFloat) \
+ SymX(isFloatNaN) \
+ SymX(isFloatInfinite) \
+ SymX(isFloatDenormalized) \
+ SymX(isFloatNegativeZero) \
+ SymX(__int_encodeFloat) \
+ SymX(__int_encodeDouble) \
+ SymX(__gmpz_cmp_si) \
+ SymX(__gmpz_cmp_ui) \
+ SymX(__gmpz_cmp) \
+ SymX(__gmpn_gcd_1) \
SymX(prog_argv) \
SymX(prog_argc) \
SymX(resetNonBlockingFd) \
SymX(stable_ptr_table) \
SymX(shutdownHaskellAndExit) \
Sym(stg_enterStackTop) \
- Sym(stg_yield_to_Hugs) \
+ Sym(stg_yield_to_interpreter) \
Sym(StgReturn) \
Sym(init_stack) \
- SymX(blockAsyncExceptionszh_fast) \
- SymX(unblockAsyncExceptionszh_fast) \
- Sym(__init_PrelGHC)
+ SymX(cmp_thread) \
+ Sym(__init_PrelGHC) \
+ SymX(freeHaskellFunctionPtr) \
+ SymX(OnExitHook) \
+ SymX(ErrorHdrHook) \
+ SymX(NoRunnableThreadsHook) \
+ SymX(StackOverflowHook) \
+ SymX(OutOfHeapHook) \
+ SymX(MallocFailHook) \
+ SymX(PatErrorHdrHook) \
+ SymX(defaultsHook) \
+ SymX(PreTraceHook) \
+ SymX(PostTraceHook) \
+ SymX(stg_sig_install) \
+ Sym(nocldstop) \
+ SymX(createAdjustor) \
+ SymX(rts_mkInt) \
+ SymX(rts_mkStablePtr) \
+ SymX(rts_apply) \
+ SymX(rts_evalIO) \
+ SymX(rts_checkSchedStatus) \
+ SymX(rts_getInt)
+
+#ifndef SUPPORT_LONG_LONGS
+#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 */
/* entirely bogus claims about types of these symbols */
#define Sym(vvv) extern void (vvv);
static SymbolVal rtsSyms[] = {
RTS_SYMBOLS
+ RTS_LONG_LONG_SYMS
{ 0, 0 } /* sentinel */
};
oc = stgMallocBytes(sizeof(ObjectCode), "loadObj(oc)");
-# if defined(linux_TARGET_OS) || defined(solaris2_TARGET_OS)
+# if defined(OBJFORMAT_ELF)
oc->formatName = "ELF";
-# elif defined(cygwin32_TARGET_OS)
+# elif defined(OBJFORMAT_PEi386)
oc->formatName = "PEi386";
# else
free(oc);
r = stat(path, &st);
if (r == -1) { return 0; }
- oc->fileName = path;
+ /* sigh, stdup() isn't a POSIX function, so do it the long way */
+ oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
+ strcpy(oc->fileName, path);
+
oc->fileSize = st.st_size;
oc->image = stgMallocBytes( st.st_size, "loadObj(image)" );
oc->symbols = NULL;
}
/* verify the in-memory image */
-# if defined(linux_TARGET_OS) || defined(solaris2_TARGET_OS)
+# if defined(OBJFORMAT_ELF)
r = ocVerifyImage_ELF ( oc );
-# elif defined(cygwin32_TARGET_OS)
+# elif defined(OBJFORMAT_PEi386)
r = ocVerifyImage_PEi386 ( oc );
# else
barf("loadObj: no verify method");
if (!r) { return r; }
/* build the symbol list for this image */
-# if defined(linux_TARGET_OS) || defined(solaris2_TARGET_OS)
+# if defined(OBJFORMAT_ELF)
r = ocGetNames_ELF ( oc );
-# elif defined(cygwin32_TARGET_OS)
+# elif defined(OBJFORMAT_PEi386)
r = ocGetNames_PEi386 ( oc );
# else
barf("loadObj: no getNames method");
for (oc = objects; oc; oc = oc->next) {
if (oc->status != OBJECT_RESOLVED) {
-# if defined(linux_TARGET_OS) || defined(solaris2_TARGET_OS)
+# if defined(OBJFORMAT_ELF)
r = ocResolve_ELF ( oc );
-# elif defined(cygwin32_TARGET_OS)
+# elif defined(OBJFORMAT_PEi386)
r = ocResolve_PEi386 ( oc );
# else
barf("link: not implemented on this platform");
HsInt
unloadObj( char *path )
{
- ObjectCode *oc;
+ ObjectCode *oc, *prev;
- for (oc = objects; oc; oc = oc->next) {
+ prev = NULL;
+ for (oc = objects; oc; prev = oc, oc = oc->next) {
if (!strcmp(oc->fileName,path)) {
/* Remove all the mappings for the symbols within this
{
SymbolVal *s;
for (s = oc->symbols; s < oc->symbols + oc->n_symbols; s++) {
- removeStrHashTable(symhash, s->lbl, NULL);
+ if (s->lbl != NULL) {
+ removeStrHashTable(symhash, s->lbl, NULL);
+ }
}
}
+ if (prev == NULL) {
+ objects = oc->next;
+ } else {
+ prev->next = oc->next;
+ }
+
/* We're going to leave this in place, in case there are
any pointers from the heap into it: */
/* free(oc->image); */
+ free(oc->fileName);
free(oc->symbols);
free(oc->sections);
free(oc);
return 1;
}
}
-
+
belch("unloadObj: can't find `%s' to unload", path);
return 0;
}
/* --------------------------------------------------------------------------
- * PEi386 specifics (cygwin32)
+ * PEi386 specifics (Win32 targets)
* ------------------------------------------------------------------------*/
/* The information for this linker comes from
*/
-#if defined(cygwin32_TARGET_OS)
+#if defined(OBJFORMAT_PEi386)
return TRUE;
}
-#endif /* defined(cygwin32_TARGET_OS) */
+#endif /* defined(OBJFORMAT_PEi386) */
/* --------------------------------------------------------------------------
- * ELF specifics (Linux, Solaris)
+ * ELF specifics
* ------------------------------------------------------------------------*/
-#if defined(linux_TARGET_OS) || defined(solaris2_TARGET_OS)
+#if defined(OBJFORMAT_ELF)
#define FALSE 0
#define TRUE 1
stab = (Elf32_Sym*) (ehdrC + shdr[i].sh_offset);
nent = shdr[i].sh_size / sizeof(Elf32_Sym);
oc->symbols = malloc(nent * sizeof(SymbolVal));
+ oc->n_symbols = nent;
for (j = 0; j < nent; j++) {
if ( ( ELF32_ST_BIND(stab[j].st_info)==STB_GLOBAL /* ||
ELF32_ST_BIND(stab[j].st_info)==STB_LOCAL */
}
-#endif /* defined(linux_TARGET_OS) || defined(solaris2_TARGET_OS) */
+#endif /* ELF */
/* -----------------------------------------------------------------------------
* Look up an address to discover whether it is in text or data space.
* Used by the garbage collector when walking the stack.
* -------------------------------------------------------------------------- */
-SectionKind
+static __inline__ SectionKind
lookupSection ( void* addr )
{
int i;
}
int
-is_dynamically_loaded_code_or_rodata_ptr ( char* p )
+is_dynamically_loaded_code_or_rodata_ptr ( void* p )
{
SectionKind sk = lookupSection(p);
- assert (sk != SECTIONKIND_NOINFOAVAIL);
+ ASSERT (sk != SECTIONKIND_NOINFOAVAIL);
return (sk == SECTIONKIND_CODE_OR_RODATA);
}
int
-is_dynamically_loaded_rwdata_ptr ( char* p )
+is_dynamically_loaded_rwdata_ptr ( void* p )
{
SectionKind sk = lookupSection(p);
- assert (sk != SECTIONKIND_NOINFOAVAIL);
+ ASSERT (sk != SECTIONKIND_NOINFOAVAIL);
return (sk == SECTIONKIND_RWDATA);
}
int
-is_not_dynamically_loaded_ptr ( char* p )
+is_not_dynamically_loaded_ptr ( void* p )
{
SectionKind sk = lookupSection(p);
- assert (sk != SECTIONKIND_NOINFOAVAIL);
+ ASSERT (sk != SECTIONKIND_NOINFOAVAIL);
return (sk == SECTIONKIND_OTHER);
}
projects / ghc-hetmet.git / blobdiff