#endif
#include "Rts.h"
-#include "RtsFlags.h"
#include "HsFFI.h"
+
+#include "sm/Storage.h"
+#include "Stats.h"
#include "Hash.h"
-#include "Linker.h"
#include "LinkerInternals.h"
#include "RtsUtils.h"
-#include "Schedule.h"
-#include "Sparks.h"
-#include "RtsTypeable.h"
-#include "Timer.h"
+#include "Trace.h"
+#include "StgPrimFloat.h" // for __int_encodeFloat etc.
+#include "Stable.h"
+
+#if !defined(mingw32_HOST_OS)
+#include "posix/Signals.h"
+#endif
+
+#if defined(mingw32_HOST_OS)
+// get protos for is*()
+#include <ctype.h>
+#endif
#ifdef HAVE_SYS_TYPES_H
#include <sys/types.h>
#include <stdlib.h>
#include <string.h>
+#include <stdio.h>
+#include <assert.h>
#ifdef HAVE_SYS_STAT_H
#include <sys/stat.h>
#include <sys/wait.h>
#endif
-#if defined(ia64_HOST_ARCH) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS) || defined(netbsd_HOST_OS) || defined(openbsd_HOST_OS)
+#if defined(ia64_HOST_ARCH) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS) || defined(dragonfly_HOST_OS) || defined(netbsd_HOST_OS) || defined(openbsd_HOST_OS)
#define USE_MMAP
#include <fcntl.h>
#include <sys/mman.h>
-#if defined(linux_HOST_OS) || defined(freebsd_HOST_OS) || defined(netbsd_HOST_OS) || defined(openbsd_HOST_OS)
+#if defined(linux_HOST_OS) || defined(freebsd_HOST_OS) || defined(dragonfly_HOST_OS) || defined(netbsd_HOST_OS) || defined(openbsd_HOST_OS)
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
#endif
-#if defined(linux_HOST_OS) || defined(solaris2_HOST_OS) || defined(freebsd_HOST_OS) || defined(netbsd_HOST_OS) || defined(openbsd_HOST_OS)
+#if defined(linux_HOST_OS) || defined(solaris2_HOST_OS) || defined(freebsd_HOST_OS) || defined(dragonfly_HOST_OS) || defined(netbsd_HOST_OS) || defined(openbsd_HOST_OS)
# define OBJFORMAT_ELF
+# include <regex.h> // regex is already used by dlopen() so this is OK
+ // to use here without requiring an additional lib
#elif defined(cygwin32_HOST_OS) || defined (mingw32_HOST_OS)
# define OBJFORMAT_PEi386
# include <windows.h>
# include <math.h>
#elif defined(darwin_HOST_OS)
# define OBJFORMAT_MACHO
+# include <regex.h>
# include <mach-o/loader.h>
# include <mach-o/nlist.h>
# include <mach-o/reloc.h>
static int ocVerifyImage_PEi386 ( ObjectCode* oc );
static int ocGetNames_PEi386 ( ObjectCode* oc );
static int ocResolve_PEi386 ( ObjectCode* oc );
+static void *lookupSymbolInDLLs ( unsigned char *lbl );
+static void zapTrailingAtSign ( unsigned char *sym );
#elif defined(OBJFORMAT_MACHO)
static int ocVerifyImage_MachO ( ObjectCode* oc );
static int ocGetNames_MachO ( ObjectCode* oc );
*/
#define X86_64_ELF_NONPIC_HACK 1
+/* Link objects into the lower 2Gb on x86_64. GHC assumes the
+ * small memory model on this architecture (see gcc docs,
+ * -mcmodel=small).
+ *
+ * MAP_32BIT not available on OpenBSD/amd64
+ */
+#if defined(x86_64_HOST_ARCH) && defined(MAP_32BIT)
+#define TRY_MAP_32BIT MAP_32BIT
+#else
+#define TRY_MAP_32BIT 0
+#endif
+
+/*
+ * Due to the small memory model (see above), on x86_64 we have to map
+ * all our non-PIC object files into the low 2Gb of the address space
+ * (why 2Gb and not 4Gb? Because all addresses must be reachable
+ * using a 32-bit signed PC-relative offset). On Linux we can do this
+ * using the MAP_32BIT flag to mmap(), however on other OSs
+ * (e.g. *BSD, see #2063, and also on Linux inside Xen, see #2512), we
+ * can't do this. So on these systems, we have to pick a base address
+ * in the low 2Gb of the address space and try to allocate memory from
+ * there.
+ *
+ * We pick a default address based on the OS, but also make this
+ * configurable via an RTS flag (+RTS -xm)
+ */
+#if defined(x86_64_HOST_ARCH)
+
+#if defined(MAP_32BIT)
+// Try to use MAP_32BIT
+#define MMAP_32BIT_BASE_DEFAULT 0
+#else
+// A guess: 1Gb.
+#define MMAP_32BIT_BASE_DEFAULT 0x40000000
+#endif
+
+static void *mmap_32bit_base = (void *)MMAP_32BIT_BASE_DEFAULT;
+#endif
+
+/* MAP_ANONYMOUS is MAP_ANON on some systems, e.g. OpenBSD */
+#if !defined(MAP_ANONYMOUS) && defined(MAP_ANON)
+#define MAP_ANONYMOUS MAP_ANON
+#endif
+
/* -----------------------------------------------------------------------------
* Built-in symbols from the RTS
*/
void *addr;
} RtsSymbolVal;
-#if !defined(PAR)
-#define Maybe_Stable_Names SymI_HasProto(mkWeakzh_fast) \
- SymI_HasProto(makeStableNamezh_fast) \
- SymI_HasProto(finalizzeWeakzh_fast)
-#else
-/* These are not available in GUM!!! -- HWL */
-#define Maybe_Stable_Names
-#endif
+#define Maybe_Stable_Names SymI_HasProto(stg_mkWeakzh) \
+ SymI_HasProto(stg_mkWeakForeignEnvzh) \
+ SymI_HasProto(stg_makeStableNamezh) \
+ SymI_HasProto(stg_finalizzeWeakzh)
#if !defined (mingw32_HOST_OS)
#define RTS_POSIX_ONLY_SYMBOLS \
+ SymI_HasProto(__hscore_get_saved_termios) \
+ SymI_HasProto(__hscore_set_saved_termios) \
SymI_HasProto(shutdownHaskellAndSignal) \
- SymI_NeedsProto(lockFile) \
- SymI_NeedsProto(unlockFile) \
+ SymI_HasProto(lockFile) \
+ SymI_HasProto(unlockFile) \
SymI_HasProto(signal_handlers) \
SymI_HasProto(stg_sig_install) \
SymI_NeedsProto(nocldstop)
#define RTS_MINGW_GETTIMEOFDAY_SYM /**/
#endif
+#if HAVE___MINGW_VFPRINTF
+#define RTS___MINGW_VFPRINTF_SYM SymI_HasProto(__mingw_vfprintf)
+#else
+#define RTS___MINGW_VFPRINTF_SYM /**/
+#endif
+
/* These are statically linked from the mingw libraries into the ghc
executable, so we have to employ this hack. */
#define RTS_MINGW_ONLY_SYMBOLS \
- SymI_HasProto(asyncReadzh_fast) \
- SymI_HasProto(asyncWritezh_fast) \
- SymI_HasProto(asyncDoProczh_fast) \
+ SymI_HasProto(stg_asyncReadzh) \
+ SymI_HasProto(stg_asyncWritezh) \
+ SymI_HasProto(stg_asyncDoProczh) \
SymI_HasProto(memset) \
SymI_HasProto(inet_ntoa) \
SymI_HasProto(inet_addr) \
SymI_HasProto(strncpy) \
SymI_HasProto(abort) \
SymI_NeedsProto(_alloca) \
- SymI_NeedsProto(isxdigit) \
- SymI_NeedsProto(isupper) \
- SymI_NeedsProto(ispunct) \
- SymI_NeedsProto(islower) \
- SymI_NeedsProto(isspace) \
- SymI_NeedsProto(isprint) \
- SymI_NeedsProto(isdigit) \
- SymI_NeedsProto(iscntrl) \
- SymI_NeedsProto(isalpha) \
- SymI_NeedsProto(isalnum) \
+ SymI_HasProto(isxdigit) \
+ SymI_HasProto(isupper) \
+ SymI_HasProto(ispunct) \
+ SymI_HasProto(islower) \
+ SymI_HasProto(isspace) \
+ SymI_HasProto(isprint) \
+ SymI_HasProto(isdigit) \
+ SymI_HasProto(iscntrl) \
+ SymI_HasProto(isalpha) \
+ SymI_HasProto(isalnum) \
+ SymI_HasProto(isascii) \
+ RTS___MINGW_VFPRINTF_SYM \
SymI_HasProto(strcmp) \
SymI_HasProto(memmove) \
SymI_HasProto(realloc) \
SymI_HasProto(expf) \
SymI_HasProto(logf) \
SymI_HasProto(sqrtf) \
+ SymI_HasProto(erf) \
+ SymI_HasProto(erfc) \
+ SymI_HasProto(erff) \
+ SymI_HasProto(erfcf) \
SymI_HasProto(memcpy) \
SymI_HasProto(rts_InstallConsoleEvent) \
SymI_HasProto(rts_ConsoleHandlerDone) \
#if !defined(mingw32_HOST_OS)
#define RTS_USER_SIGNALS_SYMBOLS \
- SymI_HasProto(setIOManagerPipe)
+ SymI_HasProto(setIOManagerPipe) \
+ SymI_HasProto(ioManagerWakeup) \
+ SymI_HasProto(ioManagerSync) \
+ SymI_HasProto(blockUserSignals) \
+ SymI_HasProto(unblockUserSignals)
#else
#define RTS_USER_SIGNALS_SYMBOLS \
+ SymI_HasProto(ioManagerWakeup) \
SymI_HasProto(sendIOManagerEvent) \
SymI_HasProto(readIOManagerEvent) \
SymI_HasProto(getIOManagerEvent) \
SymI_HasProto(stg_ap_pppppp_ret)
#endif
-/* On Windows, we link libgmp.a statically into libHSrts.dll */
-#ifdef mingw32_HOST_OS
-#define GMP_SYMS \
- SymI_HasProto(__gmpz_cmp) \
- SymI_HasProto(__gmpz_cmp_si) \
- SymI_HasProto(__gmpz_cmp_ui) \
- SymI_HasProto(__gmpz_get_si) \
- SymI_HasProto(__gmpz_get_ui)
+/* Modules compiled with -ticky may mention ticky counters */
+/* This list should marry up with the one in $(TOP)/includes/stg/Ticky.h */
+#define RTS_TICKY_SYMBOLS \
+ SymI_NeedsProto(ticky_entry_ctrs) \
+ SymI_NeedsProto(top_ct) \
+ \
+ SymI_HasProto(ENT_VIA_NODE_ctr) \
+ SymI_HasProto(ENT_STATIC_THK_ctr) \
+ SymI_HasProto(ENT_DYN_THK_ctr) \
+ SymI_HasProto(ENT_STATIC_FUN_DIRECT_ctr) \
+ SymI_HasProto(ENT_DYN_FUN_DIRECT_ctr) \
+ SymI_HasProto(ENT_STATIC_CON_ctr) \
+ SymI_HasProto(ENT_DYN_CON_ctr) \
+ SymI_HasProto(ENT_STATIC_IND_ctr) \
+ SymI_HasProto(ENT_DYN_IND_ctr) \
+ SymI_HasProto(ENT_PERM_IND_ctr) \
+ SymI_HasProto(ENT_PAP_ctr) \
+ SymI_HasProto(ENT_AP_ctr) \
+ SymI_HasProto(ENT_AP_STACK_ctr) \
+ SymI_HasProto(ENT_BH_ctr) \
+ SymI_HasProto(UNKNOWN_CALL_ctr) \
+ SymI_HasProto(SLOW_CALL_v_ctr) \
+ SymI_HasProto(SLOW_CALL_f_ctr) \
+ SymI_HasProto(SLOW_CALL_d_ctr) \
+ SymI_HasProto(SLOW_CALL_l_ctr) \
+ SymI_HasProto(SLOW_CALL_n_ctr) \
+ SymI_HasProto(SLOW_CALL_p_ctr) \
+ SymI_HasProto(SLOW_CALL_pv_ctr) \
+ SymI_HasProto(SLOW_CALL_pp_ctr) \
+ SymI_HasProto(SLOW_CALL_ppv_ctr) \
+ SymI_HasProto(SLOW_CALL_ppp_ctr) \
+ SymI_HasProto(SLOW_CALL_pppv_ctr) \
+ SymI_HasProto(SLOW_CALL_pppp_ctr) \
+ SymI_HasProto(SLOW_CALL_ppppp_ctr) \
+ SymI_HasProto(SLOW_CALL_pppppp_ctr) \
+ SymI_HasProto(SLOW_CALL_OTHER_ctr) \
+ SymI_HasProto(ticky_slow_call_unevald) \
+ SymI_HasProto(SLOW_CALL_ctr) \
+ SymI_HasProto(MULTI_CHUNK_SLOW_CALL_ctr) \
+ SymI_HasProto(MULTI_CHUNK_SLOW_CALL_CHUNKS_ctr) \
+ SymI_HasProto(KNOWN_CALL_ctr) \
+ SymI_HasProto(KNOWN_CALL_TOO_FEW_ARGS_ctr) \
+ SymI_HasProto(KNOWN_CALL_EXTRA_ARGS_ctr) \
+ SymI_HasProto(SLOW_CALL_FUN_TOO_FEW_ctr) \
+ SymI_HasProto(SLOW_CALL_FUN_CORRECT_ctr) \
+ SymI_HasProto(SLOW_CALL_FUN_TOO_MANY_ctr) \
+ SymI_HasProto(SLOW_CALL_PAP_TOO_FEW_ctr) \
+ SymI_HasProto(SLOW_CALL_PAP_CORRECT_ctr) \
+ SymI_HasProto(SLOW_CALL_PAP_TOO_MANY_ctr) \
+ SymI_HasProto(SLOW_CALL_UNEVALD_ctr) \
+ SymI_HasProto(UPDF_OMITTED_ctr) \
+ SymI_HasProto(UPDF_PUSHED_ctr) \
+ SymI_HasProto(CATCHF_PUSHED_ctr) \
+ SymI_HasProto(UPDF_RCC_PUSHED_ctr) \
+ SymI_HasProto(UPDF_RCC_OMITTED_ctr) \
+ SymI_HasProto(UPD_SQUEEZED_ctr) \
+ SymI_HasProto(UPD_CON_IN_NEW_ctr) \
+ SymI_HasProto(UPD_CON_IN_PLACE_ctr) \
+ SymI_HasProto(UPD_PAP_IN_NEW_ctr) \
+ SymI_HasProto(UPD_PAP_IN_PLACE_ctr) \
+ SymI_HasProto(ALLOC_HEAP_ctr) \
+ SymI_HasProto(ALLOC_HEAP_tot) \
+ SymI_HasProto(ALLOC_FUN_ctr) \
+ SymI_HasProto(ALLOC_FUN_adm) \
+ SymI_HasProto(ALLOC_FUN_gds) \
+ SymI_HasProto(ALLOC_FUN_slp) \
+ SymI_HasProto(UPD_NEW_IND_ctr) \
+ SymI_HasProto(UPD_NEW_PERM_IND_ctr) \
+ SymI_HasProto(UPD_OLD_IND_ctr) \
+ SymI_HasProto(UPD_OLD_PERM_IND_ctr) \
+ SymI_HasProto(UPD_BH_UPDATABLE_ctr) \
+ SymI_HasProto(UPD_BH_SINGLE_ENTRY_ctr) \
+ SymI_HasProto(UPD_CAF_BH_UPDATABLE_ctr) \
+ SymI_HasProto(UPD_CAF_BH_SINGLE_ENTRY_ctr) \
+ SymI_HasProto(GC_SEL_ABANDONED_ctr) \
+ SymI_HasProto(GC_SEL_MINOR_ctr) \
+ SymI_HasProto(GC_SEL_MAJOR_ctr) \
+ SymI_HasProto(GC_FAILED_PROMOTION_ctr) \
+ SymI_HasProto(ALLOC_UP_THK_ctr) \
+ SymI_HasProto(ALLOC_SE_THK_ctr) \
+ SymI_HasProto(ALLOC_THK_adm) \
+ SymI_HasProto(ALLOC_THK_gds) \
+ SymI_HasProto(ALLOC_THK_slp) \
+ SymI_HasProto(ALLOC_CON_ctr) \
+ SymI_HasProto(ALLOC_CON_adm) \
+ SymI_HasProto(ALLOC_CON_gds) \
+ SymI_HasProto(ALLOC_CON_slp) \
+ SymI_HasProto(ALLOC_TUP_ctr) \
+ SymI_HasProto(ALLOC_TUP_adm) \
+ SymI_HasProto(ALLOC_TUP_gds) \
+ SymI_HasProto(ALLOC_TUP_slp) \
+ SymI_HasProto(ALLOC_BH_ctr) \
+ SymI_HasProto(ALLOC_BH_adm) \
+ SymI_HasProto(ALLOC_BH_gds) \
+ SymI_HasProto(ALLOC_BH_slp) \
+ SymI_HasProto(ALLOC_PRIM_ctr) \
+ SymI_HasProto(ALLOC_PRIM_adm) \
+ SymI_HasProto(ALLOC_PRIM_gds) \
+ SymI_HasProto(ALLOC_PRIM_slp) \
+ SymI_HasProto(ALLOC_PAP_ctr) \
+ SymI_HasProto(ALLOC_PAP_adm) \
+ SymI_HasProto(ALLOC_PAP_gds) \
+ SymI_HasProto(ALLOC_PAP_slp) \
+ SymI_HasProto(ALLOC_TSO_ctr) \
+ SymI_HasProto(ALLOC_TSO_adm) \
+ SymI_HasProto(ALLOC_TSO_gds) \
+ SymI_HasProto(ALLOC_TSO_slp) \
+ SymI_HasProto(RET_NEW_ctr) \
+ SymI_HasProto(RET_OLD_ctr) \
+ SymI_HasProto(RET_UNBOXED_TUP_ctr) \
+ SymI_HasProto(RET_SEMI_loads_avoided)
+
+
+// On most platforms, the garbage collector rewrites references
+// to small integer and char objects to a set of common, shared ones.
+//
+// We don't do this when compiling to Windows DLLs at the moment because
+// it doesn't support cross package data references well.
+//
+#if defined(__PIC__) && defined(mingw32_HOST_OS)
+#define RTS_INTCHAR_SYMBOLS
#else
-#define GMP_SYMS \
- SymE_HasProto(__gmpz_cmp) \
- SymE_HasProto(__gmpz_cmp_si) \
- SymE_HasProto(__gmpz_cmp_ui) \
- SymE_HasProto(__gmpz_get_si) \
- SymE_HasProto(__gmpz_get_ui)
+#define RTS_INTCHAR_SYMBOLS \
+ SymI_HasProto(stg_CHARLIKE_closure) \
+ SymI_HasProto(stg_INTLIKE_closure)
#endif
+
#define RTS_SYMBOLS \
Maybe_Stable_Names \
+ RTS_TICKY_SYMBOLS \
SymI_HasProto(StgReturn) \
SymI_HasProto(stg_enter_info) \
SymI_HasProto(stg_gc_void_info) \
SymI_HasProto(OnExitHook) \
SymI_HasProto(OutOfHeapHook) \
SymI_HasProto(StackOverflowHook) \
- SymI_HasProto(__encodeDouble) \
- SymI_HasProto(__encodeFloat) \
SymI_HasProto(addDLL) \
- GMP_SYMS \
SymI_HasProto(__int_encodeDouble) \
SymI_HasProto(__word_encodeDouble) \
SymI_HasProto(__2Int_encodeDouble) \
SymI_HasProto(__int_encodeFloat) \
SymI_HasProto(__word_encodeFloat) \
- SymI_HasProto(andIntegerzh_fast) \
- SymI_HasProto(atomicallyzh_fast) \
+ SymI_HasProto(stg_atomicallyzh) \
SymI_HasProto(barf) \
SymI_HasProto(debugBelch) \
SymI_HasProto(errorBelch) \
- SymI_HasProto(asyncExceptionsBlockedzh_fast) \
- SymI_HasProto(blockAsyncExceptionszh_fast) \
- SymI_HasProto(catchzh_fast) \
- SymI_HasProto(catchRetryzh_fast) \
- SymI_HasProto(catchSTMzh_fast) \
- SymI_HasProto(checkzh_fast) \
+ SymI_HasProto(sysErrorBelch) \
+ SymI_HasProto(stg_asyncExceptionsBlockedzh) \
+ SymI_HasProto(stg_blockAsyncExceptionszh) \
+ SymI_HasProto(stg_catchzh) \
+ SymI_HasProto(stg_catchRetryzh) \
+ SymI_HasProto(stg_catchSTMzh) \
+ SymI_HasProto(stg_checkzh) \
SymI_HasProto(closure_flags) \
SymI_HasProto(cmp_thread) \
- SymI_HasProto(cmpIntegerzh_fast) \
- SymI_HasProto(cmpIntegerIntzh_fast) \
- SymI_HasProto(complementIntegerzh_fast) \
SymI_HasProto(createAdjustor) \
- SymI_HasProto(decodeDoublezh_fast) \
- SymI_HasProto(decodeFloatzh_fast) \
- SymI_HasProto(decodeDoublezu2Intzh_fast) \
- SymI_HasProto(decodeFloatzuIntzh_fast) \
+ SymI_HasProto(stg_decodeDoublezu2Intzh) \
+ SymI_HasProto(stg_decodeFloatzuIntzh) \
SymI_HasProto(defaultsHook) \
- SymI_HasProto(delayzh_fast) \
- SymI_HasProto(deRefWeakzh_fast) \
- SymI_HasProto(deRefStablePtrzh_fast) \
+ SymI_HasProto(stg_delayzh) \
+ SymI_HasProto(stg_deRefWeakzh) \
+ SymI_HasProto(stg_deRefStablePtrzh) \
SymI_HasProto(dirty_MUT_VAR) \
- SymI_HasProto(divExactIntegerzh_fast) \
- SymI_HasProto(divModIntegerzh_fast) \
- SymI_HasProto(forkzh_fast) \
- SymI_HasProto(forkOnzh_fast) \
+ SymI_HasProto(stg_forkzh) \
+ SymI_HasProto(stg_forkOnzh) \
SymI_HasProto(forkProcess) \
SymI_HasProto(forkOS_createThread) \
SymI_HasProto(freeHaskellFunctionPtr) \
- SymI_HasProto(freeStablePtr) \
SymI_HasProto(getOrSetTypeableStore) \
- SymI_HasProto(gcdIntegerzh_fast) \
- SymI_HasProto(gcdIntegerIntzh_fast) \
- SymI_HasProto(gcdIntzh_fast) \
+ SymI_HasProto(getOrSetGHCConcSignalHandlerStore) \
+ SymI_HasProto(getOrSetGHCConcPendingEventsStore) \
+ SymI_HasProto(getOrSetGHCConcPendingDelaysStore) \
+ SymI_HasProto(getOrSetGHCConcIOManagerThreadStore) \
+ SymI_HasProto(getOrSetGHCConcProddingStore) \
SymI_HasProto(genSymZh) \
SymI_HasProto(genericRaise) \
SymI_HasProto(getProgArgv) \
SymI_HasProto(hs_free_stable_ptr) \
SymI_HasProto(hs_free_fun_ptr) \
SymI_HasProto(hs_hpc_rootModule) \
+ SymI_HasProto(hs_hpc_module) \
SymI_HasProto(initLinker) \
- SymI_HasProto(unpackClosurezh_fast) \
- SymI_HasProto(getApStackValzh_fast) \
- SymI_HasProto(getSparkzh_fast) \
- SymI_HasProto(int2Integerzh_fast) \
- SymI_HasProto(integer2Intzh_fast) \
- SymI_HasProto(integer2Wordzh_fast) \
- SymI_HasProto(isCurrentThreadBoundzh_fast) \
- SymI_HasProto(isDoubleDenormalized) \
- SymI_HasProto(isDoubleInfinite) \
- SymI_HasProto(isDoubleNaN) \
- SymI_HasProto(isDoubleNegativeZero) \
- SymI_HasProto(isEmptyMVarzh_fast) \
- SymI_HasProto(isFloatDenormalized) \
- SymI_HasProto(isFloatInfinite) \
- SymI_HasProto(isFloatNaN) \
- SymI_HasProto(isFloatNegativeZero) \
- SymI_HasProto(killThreadzh_fast) \
+ SymI_HasProto(stg_unpackClosurezh) \
+ SymI_HasProto(stg_getApStackValzh) \
+ SymI_HasProto(stg_getSparkzh) \
+ SymI_HasProto(stg_isCurrentThreadBoundzh) \
+ SymI_HasProto(stg_isEmptyMVarzh) \
+ SymI_HasProto(stg_killThreadzh) \
SymI_HasProto(loadObj) \
SymI_HasProto(insertStableSymbol) \
SymI_HasProto(insertSymbol) \
SymI_HasProto(lookupSymbol) \
- SymI_HasProto(makeStablePtrzh_fast) \
- SymI_HasProto(minusIntegerzh_fast) \
- SymI_HasProto(mkApUpd0zh_fast) \
- SymI_HasProto(myThreadIdzh_fast) \
- SymI_HasProto(labelThreadzh_fast) \
- SymI_HasProto(newArrayzh_fast) \
- SymI_HasProto(newBCOzh_fast) \
- SymI_HasProto(newByteArrayzh_fast) \
+ SymI_HasProto(stg_makeStablePtrzh) \
+ SymI_HasProto(stg_mkApUpd0zh) \
+ SymI_HasProto(stg_myThreadIdzh) \
+ SymI_HasProto(stg_labelThreadzh) \
+ SymI_HasProto(stg_newArrayzh) \
+ SymI_HasProto(stg_newBCOzh) \
+ SymI_HasProto(stg_newByteArrayzh) \
SymI_HasProto_redirect(newCAF, newDynCAF) \
- SymI_HasProto(newMVarzh_fast) \
- SymI_HasProto(newMutVarzh_fast) \
- SymI_HasProto(newTVarzh_fast) \
- SymI_HasProto(noDuplicatezh_fast) \
- SymI_HasProto(atomicModifyMutVarzh_fast) \
- SymI_HasProto(newPinnedByteArrayzh_fast) \
+ SymI_HasProto(stg_newMVarzh) \
+ SymI_HasProto(stg_newMutVarzh) \
+ SymI_HasProto(stg_newTVarzh) \
+ SymI_HasProto(stg_noDuplicatezh) \
+ SymI_HasProto(stg_atomicModifyMutVarzh) \
+ SymI_HasProto(stg_newPinnedByteArrayzh) \
+ SymI_HasProto(stg_newAlignedPinnedByteArrayzh) \
SymI_HasProto(newSpark) \
- SymI_HasProto(orIntegerzh_fast) \
SymI_HasProto(performGC) \
SymI_HasProto(performMajorGC) \
- SymI_HasProto(plusIntegerzh_fast) \
SymI_HasProto(prog_argc) \
SymI_HasProto(prog_argv) \
- SymI_HasProto(putMVarzh_fast) \
- SymI_HasProto(quotIntegerzh_fast) \
- SymI_HasProto(quotRemIntegerzh_fast) \
- SymI_HasProto(raisezh_fast) \
- SymI_HasProto(raiseIOzh_fast) \
- SymI_HasProto(readTVarzh_fast) \
- SymI_HasProto(readTVarIOzh_fast) \
- SymI_HasProto(remIntegerzh_fast) \
- SymI_HasProto(resetNonBlockingFd) \
+ SymI_HasProto(stg_putMVarzh) \
+ SymI_HasProto(stg_raisezh) \
+ SymI_HasProto(stg_raiseIOzh) \
+ SymI_HasProto(stg_readTVarzh) \
+ SymI_HasProto(stg_readTVarIOzh) \
SymI_HasProto(resumeThread) \
SymI_HasProto(resolveObjs) \
- SymI_HasProto(retryzh_fast) \
+ SymI_HasProto(stg_retryzh) \
SymI_HasProto(rts_apply) \
SymI_HasProto(rts_checkSchedStatus) \
SymI_HasProto(rts_eval) \
SymI_HasProto(rts_mkWord32) \
SymI_HasProto(rts_mkWord64) \
SymI_HasProto(rts_unlock) \
+ SymI_HasProto(rts_unsafeGetMyCapability) \
SymI_HasProto(rtsSupportsBoundThreads) \
- SymI_HasProto(__hscore_get_saved_termios) \
- SymI_HasProto(__hscore_set_saved_termios) \
SymI_HasProto(setProgArgv) \
SymI_HasProto(startupHaskell) \
SymI_HasProto(shutdownHaskell) \
SymI_HasProto(stable_ptr_table) \
SymI_HasProto(stackOverflow) \
SymI_HasProto(stg_CAF_BLACKHOLE_info) \
- SymI_HasProto(awakenBlockedQueue) \
+ SymI_HasProto(stg_BLACKHOLE_info) \
+ SymI_HasProto(__stg_EAGER_BLACKHOLE_info) \
+ SymI_HasProto(stg_BLOCKING_QUEUE_CLEAN_info) \
+ SymI_HasProto(stg_BLOCKING_QUEUE_DIRTY_info) \
SymI_HasProto(startTimer) \
- SymI_HasProto(stg_CHARLIKE_closure) \
SymI_HasProto(stg_MVAR_CLEAN_info) \
SymI_HasProto(stg_MVAR_DIRTY_info) \
SymI_HasProto(stg_IND_STATIC_info) \
- SymI_HasProto(stg_INTLIKE_closure) \
+ SymI_HasProto(stg_ARR_WORDS_info) \
SymI_HasProto(stg_MUT_ARR_PTRS_DIRTY_info) \
SymI_HasProto(stg_MUT_ARR_PTRS_FROZEN_info) \
SymI_HasProto(stg_MUT_ARR_PTRS_FROZEN0_info) \
SymI_HasProto(stg_sel_8_upd_info) \
SymI_HasProto(stg_sel_9_upd_info) \
SymI_HasProto(stg_upd_frame_info) \
+ SymI_HasProto(stg_bh_upd_frame_info) \
SymI_HasProto(suspendThread) \
- SymI_HasProto(takeMVarzh_fast) \
- SymI_HasProto(threadStatuszh_fast) \
- SymI_HasProto(timesIntegerzh_fast) \
- SymI_HasProto(tryPutMVarzh_fast) \
- SymI_HasProto(tryTakeMVarzh_fast) \
- SymI_HasProto(unblockAsyncExceptionszh_fast) \
+ SymI_HasProto(stg_takeMVarzh) \
+ SymI_HasProto(stg_threadStatuszh) \
+ SymI_HasProto(stg_tryPutMVarzh) \
+ SymI_HasProto(stg_tryTakeMVarzh) \
+ SymI_HasProto(stg_unblockAsyncExceptionszh) \
SymI_HasProto(unloadObj) \
- SymI_HasProto(unsafeThawArrayzh_fast) \
- SymI_HasProto(waitReadzh_fast) \
- SymI_HasProto(waitWritezh_fast) \
- SymI_HasProto(word2Integerzh_fast) \
- SymI_HasProto(writeTVarzh_fast) \
- SymI_HasProto(xorIntegerzh_fast) \
- SymI_HasProto(yieldzh_fast) \
+ SymI_HasProto(stg_unsafeThawArrayzh) \
+ SymI_HasProto(stg_waitReadzh) \
+ SymI_HasProto(stg_waitWritezh) \
+ SymI_HasProto(stg_writeTVarzh) \
+ SymI_HasProto(stg_yieldzh) \
SymI_NeedsProto(stg_interp_constr_entry) \
+ SymI_HasProto(alloc_blocks_lim) \
+ SymI_HasProto(g0) \
+ SymI_HasProto(allocate) \
SymI_HasProto(allocateExec) \
SymI_HasProto(freeExec) \
SymI_HasProto(getAllocations) \
SymI_NeedsProto(rts_stop_on_exception) \
SymI_HasProto(stopTimer) \
SymI_HasProto(n_capabilities) \
- RTS_USER_SIGNALS_SYMBOLS
+ SymI_HasProto(stg_traceCcszh) \
+ SymI_HasProto(stg_traceEventzh) \
+ RTS_USER_SIGNALS_SYMBOLS \
+ RTS_INTCHAR_SYMBOLS
-#ifdef SUPPORT_LONG_LONGS
-#define RTS_LONG_LONG_SYMS \
- SymI_HasProto(int64ToIntegerzh_fast) \
- SymI_HasProto(word64ToIntegerzh_fast)
-#else
-#define RTS_LONG_LONG_SYMS /* nothing */
-#endif
// 64-bit support functions in libgcc.a
#if defined(__GNUC__) && SIZEOF_VOID_P <= 4
SymI_NeedsProto(__muldi3) \
SymI_NeedsProto(__ashldi3) \
SymI_NeedsProto(__ashrdi3) \
- SymI_NeedsProto(__lshrdi3) \
- SymI_NeedsProto(__eprintf)
-#elif defined(ia64_HOST_ARCH)
-#define RTS_LIBGCC_SYMBOLS \
- SymI_NeedsProto(__divdi3) \
- SymI_NeedsProto(__udivdi3) \
- SymI_NeedsProto(__moddi3) \
- SymI_NeedsProto(__umoddi3) \
- SymI_NeedsProto(__divsf3) \
- SymI_NeedsProto(__divdf3)
+ SymI_NeedsProto(__lshrdi3)
#else
#define RTS_LIBGCC_SYMBOLS
#endif
#define SymI_HasProto_redirect(vvv,xxx) /**/
RTS_SYMBOLS
RTS_RET_SYMBOLS
-RTS_LONG_LONG_SYMS
RTS_POSIX_ONLY_SYMBOLS
RTS_MINGW_ONLY_SYMBOLS
RTS_CYGWIN_ONLY_SYMBOLS
static RtsSymbolVal rtsSyms[] = {
RTS_SYMBOLS
RTS_RET_SYMBOLS
- RTS_LONG_LONG_SYMS
RTS_POSIX_ONLY_SYMBOLS
RTS_MINGW_ONLY_SYMBOLS
RTS_CYGWIN_ONLY_SYMBOLS
#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
static void *dl_prog_handle;
+static regex_t re_invalid;
+static regex_t re_realso;
+#ifdef THREADED_RTS
+static Mutex dl_mutex; // mutex to protect dlopen/dlerror critical section
+#endif
#endif
void
initLinker( void )
{
RtsSymbolVal *sym;
+#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
+ int compileResult;
+#endif
/* Make initLinker idempotent, so we can call it
before evey relevant operation; that means we
linker_init_done = 1;
}
+#if defined(THREADED_RTS) && (defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO))
+ initMutex(&dl_mutex);
+#endif
stablehash = allocStrHashTable();
symhash = allocStrHashTable();
# else
dl_prog_handle = dlopen(NULL, RTLD_LAZY);
# endif /* RTLD_DEFAULT */
+
+ compileResult = regcomp(&re_invalid,
+ "(([^ \t()])+\\.so([^ \t:()])*):([ \t])*invalid ELF header",
+ REG_EXTENDED);
+ ASSERT( compileResult == 0 );
+ compileResult = regcomp(&re_realso,
+ "GROUP *\\( *(([^ )])+)",
+ REG_EXTENDED);
+ ASSERT( compileResult == 0 );
# endif
+
+#if defined(x86_64_HOST_ARCH)
+ if (RtsFlags.MiscFlags.linkerMemBase != 0) {
+ // User-override for mmap_32bit_base
+ mmap_32bit_base = (void*)RtsFlags.MiscFlags.linkerMemBase;
+ }
+#endif
+
+#if defined(mingw32_HOST_OS)
+ /*
+ * These two libraries cause problems when added to the static link,
+ * but are necessary for resolving symbols in GHCi, hence we load
+ * them manually here.
+ */
+ addDLL("msvcrt");
+ addDLL("kernel32");
+#endif
+}
+
+void
+exitLinker( void ) {
+#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
+ if (linker_init_done == 1) {
+ regfree(&re_invalid);
+ regfree(&re_realso);
+#ifdef THREADED_RTS
+ closeMutex(&dl_mutex);
+#endif
+ }
+#endif
}
/* -----------------------------------------------------------------------------
static OpenedDLL* opened_dlls = NULL;
#endif
-const char *
-addDLL( char *dll_name )
-{
# if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
- /* ------------------- ELF DLL loader ------------------- */
- void *hdl;
- const char *errmsg;
- initLinker();
+static char *
+internal_dlopen(const char *dll_name)
+{
+ void *hdl;
+ char *errmsg, *errmsg_copy;
// omitted: RTLD_NOW
// see http://www.haskell.org/pipermail/cvs-ghc/2007-September/038570.html
- hdl= dlopen(dll_name, RTLD_LAZY | RTLD_GLOBAL);
+ IF_DEBUG(linker,
+ debugBelch("internal_dlopen: dll_name = '%s'\n", dll_name));
+
+ //-------------- Begin critical section ------------------
+ // This critical section is necessary because dlerror() is not
+ // required to be reentrant (see POSIX -- IEEE Std 1003.1-2008)
+ // Also, the error message returned must be copied to preserve it
+ // (see POSIX also)
+ ACQUIRE_LOCK(&dl_mutex);
+ hdl = dlopen(dll_name, RTLD_LAZY | RTLD_GLOBAL);
+
+ errmsg = NULL;
if (hdl == NULL) {
/* dlopen failed; return a ptr to the error msg. */
errmsg = dlerror();
if (errmsg == NULL) errmsg = "addDLL: unknown error";
- return errmsg;
- } else {
+ errmsg_copy = stgMallocBytes(strlen(errmsg)+1, "addDLL");
+ strcpy(errmsg_copy, errmsg);
+ errmsg = errmsg_copy;
+ }
+ RELEASE_LOCK(&dl_mutex);
+ //--------------- End critical section -------------------
+
+ return errmsg;
+}
+# endif
+
+const char *
+addDLL( char *dll_name )
+{
+# if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
+ /* ------------------- ELF DLL loader ------------------- */
+
+#define NMATCH 5
+ regmatch_t match[NMATCH];
+ char *errmsg;
+ FILE* fp;
+ size_t match_length;
+#define MAXLINE 1000
+ char line[MAXLINE];
+ int result;
+
+ initLinker();
+
+ IF_DEBUG(linker, debugBelch("addDLL: dll_name = '%s'\n", dll_name));
+ errmsg = internal_dlopen(dll_name);
+
+ if (errmsg == NULL) {
return NULL;
}
- /*NOTREACHED*/
+
+ // GHC Trac ticket #2615
+ // On some systems (e.g., Gentoo Linux) dynamic files (e.g. libc.so)
+ // contain linker scripts rather than ELF-format object code. This
+ // code handles the situation by recognizing the real object code
+ // file name given in the linker script.
+ //
+ // If an "invalid ELF header" error occurs, it is assumed that the
+ // .so file contains a linker script instead of ELF object code.
+ // In this case, the code looks for the GROUP ( ... ) linker
+ // directive. If one is found, the first file name inside the
+ // parentheses is treated as the name of a dynamic library and the
+ // code attempts to dlopen that file. If this is also unsuccessful,
+ // an error message is returned.
+
+ // see if the error message is due to an invalid ELF header
+ IF_DEBUG(linker, debugBelch("errmsg = '%s'\n", errmsg));
+ result = regexec(&re_invalid, errmsg, (size_t) NMATCH, match, 0);
+ IF_DEBUG(linker, debugBelch("result = %i\n", result));
+ if (result == 0) {
+ // success -- try to read the named file as a linker script
+ match_length = (size_t) stg_min((match[1].rm_eo - match[1].rm_so),
+ MAXLINE-1);
+ strncpy(line, (errmsg+(match[1].rm_so)),match_length);
+ line[match_length] = '\0'; // make sure string is null-terminated
+ IF_DEBUG(linker, debugBelch ("file name = '%s'\n", line));
+ if ((fp = fopen(line, "r")) == NULL) {
+ return errmsg; // return original error if open fails
+ }
+ // try to find a GROUP ( ... ) command
+ while (fgets(line, MAXLINE, fp) != NULL) {
+ IF_DEBUG(linker, debugBelch("input line = %s", line));
+ if (regexec(&re_realso, line, (size_t) NMATCH, match, 0) == 0) {
+ // success -- try to dlopen the first named file
+ IF_DEBUG(linker, debugBelch("match%s\n",""));
+ line[match[1].rm_eo] = '\0';
+ errmsg = internal_dlopen(line+match[1].rm_so);
+ break;
+ }
+ // if control reaches here, no GROUP ( ... ) directive was found
+ // and the original error message is returned to the caller
+ }
+ fclose(fp);
+ }
+ return errmsg;
# elif defined(OBJFORMAT_PEi386)
/* ------------------- Win32 DLL loader ------------------- */
}
# endif /* HAVE_DLFCN_H */
# elif defined(OBJFORMAT_PEi386)
- OpenedDLL* o_dll;
void* sym;
- for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
- /* debugBelch("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) {
- /*debugBelch("found %s in %s\n", lbl+1,o_dll->name);*/
- return sym;
- }
- }
- sym = GetProcAddress(o_dll->instance, lbl);
- if (sym != NULL) {
- /*debugBelch("found %s in %s\n", lbl,o_dll->name);*/
- return sym;
- }
- }
+
+ sym = lookupSymbolInDLLs((unsigned char*)lbl);
+ if (sym != NULL) { return sym; };
+
+ // Also try looking up the symbol without the @N suffix. Some
+ // DLLs have the suffixes on their symbols, some don't.
+ zapTrailingAtSign ( (unsigned char*)lbl );
+ sym = lookupSymbolInDLLs((unsigned char*)lbl);
+ if (sym != NULL) { return sym; };
return NULL;
+
# else
ASSERT(2+2 == 5);
return NULL;
}
#endif
-#ifdef ia64_HOST_ARCH
-static unsigned int PLTSize(void);
+#ifdef USE_MMAP
+#define ROUND_UP(x,size) ((x + size - 1) & ~(size - 1))
+
+static void *
+mmapForLinker (size_t bytes, nat flags, int fd)
+{
+ void *map_addr = NULL;
+ void *result;
+ int pagesize, size;
+ static nat fixed = 0;
+
+ pagesize = getpagesize();
+ size = ROUND_UP(bytes, pagesize);
+
+#if defined(x86_64_HOST_ARCH)
+mmap_again:
+
+ if (mmap_32bit_base != 0) {
+ map_addr = mmap_32bit_base;
+ }
+#endif
+
+ result = mmap(map_addr, size, PROT_EXEC|PROT_READ|PROT_WRITE,
+ MAP_PRIVATE|TRY_MAP_32BIT|fixed|flags, fd, 0);
+
+ if (result == MAP_FAILED) {
+ sysErrorBelch("mmap %lu bytes at %p",(lnat)size,map_addr);
+ errorBelch("Try specifying an address with +RTS -xm<addr> -RTS");
+ stg_exit(EXIT_FAILURE);
+ }
+
+#if defined(x86_64_HOST_ARCH)
+ if (mmap_32bit_base != 0) {
+ if (result == map_addr) {
+ mmap_32bit_base = (StgWord8*)map_addr + size;
+ } else {
+ if ((W_)result > 0x80000000) {
+ // oops, we were given memory over 2Gb
+#if defined(freebsd_HOST_OS) || defined(dragonfly_HOST_OS)
+ // Some platforms require MAP_FIXED. This is normally
+ // a bad idea, because MAP_FIXED will overwrite
+ // existing mappings.
+ munmap(result,size);
+ fixed = MAP_FIXED;
+ goto mmap_again;
+#else
+ barf("loadObj: failed to mmap() memory below 2Gb; asked for %lu bytes at %p. Try specifying an address with +RTS -xm<addr> -RTS", size, map_addr, result);
+#endif
+ } else {
+ // hmm, we were given memory somewhere else, but it's
+ // still under 2Gb so we can use it. Next time, ask
+ // for memory right after the place we just got some
+ mmap_32bit_base = (StgWord8*)result + size;
+ }
+ }
+ } else {
+ if ((W_)result > 0x80000000) {
+ // oops, we were given memory over 2Gb
+ // ... try allocating memory somewhere else?;
+ debugTrace(DEBUG_linker,"MAP_32BIT didn't work; gave us %lu bytes at 0x%p", bytes, result);
+ munmap(result, size);
+
+ // Set a base address and try again... (guess: 1Gb)
+ mmap_32bit_base = (void*)0x40000000;
+ goto mmap_again;
+ }
+ }
#endif
+ return result;
+}
+#endif // USE_MMAP
+
/* -----------------------------------------------------------------------------
* Load an obj (populate the global symbol table, but don't resolve yet)
*
{
ObjectCode* oc;
struct stat st;
- int r, n;
+ int r;
#ifdef USE_MMAP
- int fd, pagesize;
- void *map_addr = NULL;
+ int fd;
#else
FILE *f;
#endif
objects = oc;
#ifdef USE_MMAP
-#define ROUND_UP(x,size) ((x + size - 1) & ~(size - 1))
-
/* On many architectures malloc'd memory isn't executable, so we need to use mmap. */
#if defined(openbsd_HOST_OS)
if (fd == -1)
barf("loadObj: can't open `%s'", path);
- pagesize = getpagesize();
-
-#ifdef ia64_HOST_ARCH
- /* The PLT needs to be right before the object */
- n = ROUND_UP(PLTSize(), pagesize);
- oc->plt = mmap(NULL, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, -1, 0);
- if (oc->plt == MAP_FAILED)
- barf("loadObj: can't allocate PLT");
-
- oc->pltIndex = 0;
- map_addr = oc->plt + n;
-#endif
-
- n = ROUND_UP(oc->fileSize, pagesize);
-
- /* Link objects into the lower 2Gb on x86_64. GHC assumes the
- * small memory model on this architecture (see gcc docs,
- * -mcmodel=small).
- *
- * MAP_32BIT not available on OpenBSD/amd64
- */
-#if defined(x86_64_HOST_ARCH) && defined(MAP_32BIT)
-#define EXTRA_MAP_FLAGS MAP_32BIT
-#else
-#define EXTRA_MAP_FLAGS 0
-#endif
-
- /* MAP_ANONYMOUS is MAP_ANON on some systems, e.g. OpenBSD */
-#if !defined(MAP_ANONYMOUS) && defined(MAP_ANON)
-#define MAP_ANONYMOUS MAP_ANON
-#endif
-
- oc->image = mmap(map_addr, n, PROT_EXEC|PROT_READ|PROT_WRITE,
- MAP_PRIVATE|EXTRA_MAP_FLAGS, fd, 0);
- if (oc->image == MAP_FAILED)
- barf("loadObj: can't map `%s'", path);
+ oc->image = mmapForLinker(oc->fileSize, 0, fd);
close(fd);
#else /* !USE_MMAP */
-
/* load the image into memory */
f = fopen(path, "rb");
if (!f)
oc->image = stgMallocBytes(oc->fileSize, "loadObj(image)");
# endif
- n = fread ( oc->image, 1, oc->fileSize, f );
- if (n != oc->fileSize)
- barf("loadObj: error whilst reading `%s'", path);
-
+ {
+ int n;
+ n = fread ( oc->image, 1, oc->fileSize, f );
+ if (n != oc->fileSize)
+ barf("loadObj: error whilst reading `%s'", path);
+ }
fclose(f);
#endif /* USE_MMAP */
*/
if( m > n ) // we need to allocate more pages
{
- oc->symbol_extras = mmap (NULL, sizeof(SymbolExtra) * count,
- PROT_EXEC|PROT_READ|PROT_WRITE,
- MAP_PRIVATE|MAP_ANONYMOUS|EXTRA_MAP_FLAGS,
- 0, 0);
- if (oc->symbol_extras == MAP_FAILED)
- {
- errorBelch( "Unable to mmap() for jump islands\n" );
- return 0;
- }
-#ifdef x86_64_HOST_ARCH
- if ((StgWord)oc->symbol_extras > 0x80000000)
- {
- barf("mmap() returned memory outside 2Gb");
- }
-#endif
+ oc->symbol_extras = mmapForLinker(sizeof(SymbolExtra) * count,
+ MAP_ANONYMOUS, -1);
}
else
{
{
if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
UInt32 strtab_offset = * (UInt32*)(name+4);
- strncpy ( dst, strtab+strtab_offset, dstSize );
+ strncpy ( (char*)dst, (char*)strtab+strtab_offset, dstSize );
dst[dstSize-1] = 0;
} else {
int i = 0;
*/
newstr = stgMallocBytes(9, "cstring_from_COFF_symbol_name");
ASSERT(newstr);
- strncpy(newstr,name,8);
+ strncpy((char*)newstr,(char*)name,8);
newstr[8] = 0;
return newstr;
}
/* Just compares the short names (first 8 chars) */
static COFF_section *
-findPEi386SectionCalled ( ObjectCode* oc, char* name )
+findPEi386SectionCalled ( ObjectCode* oc, UChar* name )
{
int i;
COFF_header* hdr
# undef my_isdigit
}
+static void *
+lookupSymbolInDLLs ( UChar *lbl )
+{
+ OpenedDLL* o_dll;
+ void *sym;
+
+ for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
+ /* debugBelch("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, (char*)(lbl+1));
+ if (sym != NULL) {
+ /*debugBelch("found %s in %s\n", lbl+1,o_dll->name);*/
+ return sym;
+ }
+ }
+ sym = GetProcAddress(o_dll->instance, (char*)lbl);
+ if (sym != NULL) {
+ /*debugBelch("found %s in %s\n", lbl,o_dll->name);*/
+ return sym;
+ }
+ }
+ return NULL;
+}
+
static int
ocVerifyImage_PEi386 ( ObjectCode* oc )
COFF_section* sectab_i
= (COFF_section*)
myindex ( sizeof_COFF_section, sectab, i );
- if (0 != strcmp(sectab_i->Name, ".bss")) continue;
+ if (0 != strcmp((char*)sectab_i->Name, ".bss")) continue;
/* sof 10/05: the PE spec text isn't too clear regarding what
* the SizeOfRawData field is supposed to hold for object
* file sections containing just uninitialized data -- for executables,
kind = SECTIONKIND_CODE_OR_RODATA;
# endif
- if (0==strcmp(".text",sectab_i->Name) ||
- 0==strcmp(".rdata",sectab_i->Name)||
- 0==strcmp(".rodata",sectab_i->Name))
+ if (0==strcmp(".text",(char*)sectab_i->Name) ||
+ 0==strcmp(".rdata",(char*)sectab_i->Name)||
+ 0==strcmp(".rodata",(char*)sectab_i->Name))
kind = SECTIONKIND_CODE_OR_RODATA;
- if (0==strcmp(".data",sectab_i->Name) ||
- 0==strcmp(".bss",sectab_i->Name))
+ if (0==strcmp(".data",(char*)sectab_i->Name) ||
+ 0==strcmp(".bss",(char*)sectab_i->Name))
kind = SECTIONKIND_RWDATA;
ASSERT(sectab_i->SizeOfRawData == 0 || sectab_i->VirtualSize == 0);
if (kind == SECTIONKIND_OTHER
/* Ignore sections called which contain stabs debugging
information. */
- && 0 != strcmp(".stab", sectab_i->Name)
- && 0 != strcmp(".stabstr", sectab_i->Name)
+ && 0 != strcmp(".stab", (char*)sectab_i->Name)
+ && 0 != strcmp(".stabstr", (char*)sectab_i->Name)
/* ignore constructor section for now */
- && 0 != strcmp(".ctors", sectab_i->Name)
+ && 0 != strcmp(".ctors", (char*)sectab_i->Name)
/* ignore section generated from .ident */
- && 0!= strcmp("/4", sectab_i->Name)
+ && 0!= strcmp("/4", (char*)sectab_i->Name)
/* ignore unknown section that appeared in gcc 3.4.5(?) */
- && 0!= strcmp(".reloc", sectab_i->Name)
+ && 0!= strcmp(".reloc", (char*)sectab_i->Name)
) {
errorBelch("Unknown PEi386 section name `%s' (while processing: %s)", sectab_i->Name, oc->fileName);
return 0;
IF_DEBUG(linker, debugBelch("addSymbol %p `%s'\n", addr,sname);)
ASSERT(i >= 0 && i < oc->n_symbols);
/* cstring_from_COFF_symbol_name always succeeds. */
- oc->symbols[i] = sname;
- ghciInsertStrHashTable(oc->fileName, symhash, sname, addr);
+ oc->symbols[i] = (char*)sname;
+ ghciInsertStrHashTable(oc->fileName, symhash, (char*)sname, addr);
} else {
# if 0
debugBelch(
/* ToDo: should be variable-sized? But is at least safe in the
sense of buffer-overrun-proof. */
- char symbol[1000];
+ UChar symbol[1000];
/* debugBelch("resolving for %s\n", oc->fileName); */
hdr = (COFF_header*)(oc->image);
/* Ignore sections called which contain stabs debugging
information. */
- if (0 == strcmp(".stab", sectab_i->Name)
- || 0 == strcmp(".stabstr", sectab_i->Name)
- || 0 == strcmp(".ctors", sectab_i->Name))
+ if (0 == strcmp(".stab", (char*)sectab_i->Name)
+ || 0 == strcmp(".stabstr", (char*)sectab_i->Name)
+ || 0 == strcmp(".ctors", (char*)sectab_i->Name))
continue;
if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
+ sym->Value);
} else {
copyName ( sym->Name, strtab, symbol, 1000-1 );
- S = (UInt32) lookupSymbol( symbol );
+ S = (UInt32) lookupSymbol( (char*)symbol );
if ((void*)S != NULL) goto foundit;
- zapTrailingAtSign ( symbol );
- S = (UInt32) lookupSymbol( symbol );
- if ((void*)S != NULL) goto foundit;
- /* Newline first because the interactive linker has printed "linking..." */
- errorBelch("\n%s: unknown symbol `%s'", oc->fileName, symbol);
+ errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
return 0;
foundit:;
}
#elif defined(x86_64_HOST_ARCH)
# define ELF_TARGET_X64_64
# define ELF_64BIT
-#elif defined (ia64_HOST_ARCH)
-# define ELF_TARGET_IA64 /* Used inside <elf.h> */
-# define ELF_64BIT
-# define ELF_FUNCTION_DESC /* calling convention uses function descriptors */
-# define ELF_NEED_GOT /* needs Global Offset Table */
-# define ELF_NEED_PLT /* needs Procedure Linkage Tables */
#endif
#if !defined(openbsd_HOST_OS)
#endif
#ifdef ELF_NEED_PLT
-#ifdef ia64_HOST_ARCH
-static void ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value);
-static void ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc);
-
-static unsigned char plt_code[] =
-{
- /* taken from binutils bfd/elfxx-ia64.c */
- 0x0b, 0x78, 0x00, 0x02, 0x00, 0x24, /* [MMI] addl r15=0,r1;; */
- 0x00, 0x41, 0x3c, 0x30, 0x28, 0xc0, /* ld8 r16=[r15],8 */
- 0x01, 0x08, 0x00, 0x84, /* mov r14=r1;; */
- 0x11, 0x08, 0x00, 0x1e, 0x18, 0x10, /* [MIB] ld8 r1=[r15] */
- 0x60, 0x80, 0x04, 0x80, 0x03, 0x00, /* mov b6=r16 */
- 0x60, 0x00, 0x80, 0x00 /* br.few b6;; */
-};
-
-/* If we can't get to the function descriptor via gp, take a local copy of it */
-#define PLT_RELOC(code, target) { \
- Elf64_Sxword rel_value = target - gp_val; \
- if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff)) \
- ia64_reloc_gprel22((Elf_Addr)code, copyFunctionDesc(target)); \
- else \
- ia64_reloc_gprel22((Elf_Addr)code, target); \
- }
-#endif
typedef struct {
unsigned char code[sizeof(plt_code)];
return ptr;
}
-#if defined(ia64_HOST_ARCH)
-static Elf_Addr
-findElfSegment ( void* objImage, Elf_Addr vaddr )
-{
- char* ehdrC = (char*)objImage;
- Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
- Elf_Phdr* phdr = (Elf_Phdr*)(ehdrC + ehdr->e_phoff);
- Elf_Addr segaddr = 0;
- int i;
-
- for (i = 0; i < ehdr->e_phnum; i++) {
- segaddr = phdr[i].p_vaddr;
- if ((vaddr >= segaddr) && (vaddr < segaddr + phdr[i].p_memsz))
- break;
- }
- return segaddr;
-}
-#endif
-
static int
ocVerifyImage_ELF ( ObjectCode* oc )
{
# if defined(sparc_HOST_ARCH)
Elf_Word* pP = (Elf_Word*)P;
Elf_Word w1, w2;
-# elif defined(ia64_HOST_ARCH)
- Elf64_Xword *pP = (Elf64_Xword *)P;
- Elf_Addr addr;
# elif defined(powerpc_HOST_ARCH)
Elf_Sword delta;
# endif
w1 |= w2;
*pP = w1;
break;
+
/* According to the Sun documentation:
R_SPARC_UA32
This relocation type resembles R_SPARC_32, except it refers to an
unaligned word. That is, the word to be relocated must be treated
as four separate bytes with arbitrary alignment, not as a word
aligned according to the architecture requirements.
-
- (JRS: which means that freeloading on the R_SPARC_32 case
- is probably wrong, but hey ...)
*/
case R_SPARC_UA32:
+ w2 = (Elf_Word)value;
+
+ // SPARC doesn't do misaligned writes of 32 bit words,
+ // so we have to do this one byte-at-a-time.
+ char *pPc = (char*)pP;
+ pPc[0] = (char) ((Elf_Word)(w2 & 0xff000000) >> 24);
+ pPc[1] = (char) ((Elf_Word)(w2 & 0x00ff0000) >> 16);
+ pPc[2] = (char) ((Elf_Word)(w2 & 0x0000ff00) >> 8);
+ pPc[3] = (char) ((Elf_Word)(w2 & 0x000000ff));
+ break;
+
case R_SPARC_32:
w2 = (Elf_Word)value;
*pP = w2;
break;
-# elif defined(ia64_HOST_ARCH)
- case R_IA64_DIR64LSB:
- case R_IA64_FPTR64LSB:
- *pP = value;
- break;
- case R_IA64_PCREL64LSB:
- *pP = value - P;
- break;
- case R_IA64_SEGREL64LSB:
- addr = findElfSegment(ehdrC, value);
- *pP = value - addr;
- break;
- case R_IA64_GPREL22:
- ia64_reloc_gprel22(P, value);
- break;
- case R_IA64_LTOFF22:
- case R_IA64_LTOFF22X:
- case R_IA64_LTOFF_FPTR22:
- addr = allocateGOTEntry(value);
- ia64_reloc_gprel22(P, addr);
- break;
- case R_IA64_PCREL21B:
- ia64_reloc_pcrel21(P, S, oc);
- break;
- case R_IA64_LDXMOV:
- /* This goes with R_IA64_LTOFF22X and points to the load to
- * convert into a move. We don't implement relaxation. */
- break;
# elif defined(powerpc_HOST_ARCH)
case R_PPC_ADDR16_LO:
*(Elf32_Half*) P = value;
}
/*
- * IA64 specifics
- * Instructions are 41 bits long, packed into 128 bit bundles with a 5-bit template
- * at the front. The following utility functions pack and unpack instructions, and
- * take care of the most common relocations.
- */
-
-#ifdef ia64_HOST_ARCH
-
-static Elf64_Xword
-ia64_extract_instruction(Elf64_Xword *target)
-{
- Elf64_Xword w1, w2;
- int slot = (Elf_Addr)target & 3;
- target = (Elf_Addr)target & ~3;
-
- w1 = *target;
- w2 = *(target+1);
-
- switch (slot)
- {
- case 0:
- return ((w1 >> 5) & 0x1ffffffffff);
- case 1:
- return (w1 >> 46) | ((w2 & 0x7fffff) << 18);
- case 2:
- return (w2 >> 23);
- default:
- barf("ia64_extract_instruction: invalid slot %p", target);
- }
-}
-
-static void
-ia64_deposit_instruction(Elf64_Xword *target, Elf64_Xword value)
-{
- int slot = (Elf_Addr)target & 3;
- target = (Elf_Addr)target & ~3;
-
- switch (slot)
- {
- case 0:
- *target |= value << 5;
- break;
- case 1:
- *target |= value << 46;
- *(target+1) |= value >> 18;
- break;
- case 2:
- *(target+1) |= value << 23;
- break;
- }
-}
-
-static void
-ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value)
-{
- Elf64_Xword instruction;
- Elf64_Sxword rel_value;
-
- rel_value = value - gp_val;
- if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff))
- barf("GP-relative data out of range (address = 0x%lx, gp = 0x%lx)", value, gp_val);
-
- instruction = ia64_extract_instruction((Elf64_Xword *)target);
- instruction |= (((rel_value >> 0) & 0x07f) << 13) /* imm7b */
- | (((rel_value >> 7) & 0x1ff) << 27) /* imm9d */
- | (((rel_value >> 16) & 0x01f) << 22) /* imm5c */
- | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
- ia64_deposit_instruction((Elf64_Xword *)target, instruction);
-}
-
-static void
-ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc)
-{
- Elf64_Xword instruction;
- Elf64_Sxword rel_value;
- Elf_Addr entry;
-
- entry = allocatePLTEntry(value, oc);
-
- rel_value = (entry >> 4) - (target >> 4);
- if ((rel_value > 0xfffff) || (rel_value < -0xfffff))
- barf("PLT entry too far away (entry = 0x%lx, target = 0x%lx)", entry, target);
-
- instruction = ia64_extract_instruction((Elf64_Xword *)target);
- instruction |= ((rel_value & 0xfffff) << 13) /* imm20b */
- | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
- ia64_deposit_instruction((Elf64_Xword *)target, instruction);
-}
-
-#endif /* ia64 */
-
-/*
* PowerPC & X86_64 ELF specifics
*/
char *thingPtr = image + sect->offset + reloc->r_address;
uint64_t thing;
- uint64_t value;
+ /* We shouldn't need to initialise this, but gcc on OS X 64 bit
+ complains that it may be used uninitialized if we don't */
+ uint64_t value = 0;
uint64_t baseValue;
int type = reloc->r_type;
|| scat->r_type == PPC_RELOC_HI16_SECTDIFF
|| scat->r_type == PPC_RELOC_HA16_SECTDIFF)
#else
- else if(scat->r_type == GENERIC_RELOC_SECTDIFF)
+ else if(scat->r_type == GENERIC_RELOC_SECTDIFF
+ || scat->r_type == GENERIC_RELOC_LOCAL_SECTDIFF)
#endif
{
struct scattered_relocation_info *pair =
}
#endif
else
- continue; // ignore the others
+ {
+ barf ("Don't know how to handle this Mach-O "
+ "scattered relocation entry: "
+ "object file %s; entry type %ld; "
+ "address %#lx\n",
+ oc->fileName, scat->r_type, scat->r_address);
+ return 0;
+ }
#ifdef powerpc_HOST_ARCH
if(scat->r_type == GENERIC_RELOC_VANILLA
|| scat->r_type == PPC_RELOC_SECTDIFF)
#else
if(scat->r_type == GENERIC_RELOC_VANILLA
- || scat->r_type == GENERIC_RELOC_SECTDIFF)
+ || scat->r_type == GENERIC_RELOC_SECTDIFF
+ || scat->r_type == GENERIC_RELOC_LOCAL_SECTDIFF)
#endif
{
*wordPtr = word;
}
#endif
}
+ else
+ {
+ barf("Can't handle Mach-O scattered relocation entry "
+ "with this r_length tag: "
+ "object file %s; entry type %ld; "
+ "r_length tag %ld; address %#lx\n",
+ oc->fileName, scat->r_type, scat->r_length,
+ scat->r_address);
+ return 0;
+ }
+ }
+ else /* scat->r_pcrel */
+ {
+ barf("Don't know how to handle *PC-relative* Mach-O "
+ "scattered relocation entry: "
+ "object file %s; entry type %ld; address %#lx\n",
+ oc->fileName, scat->r_type, scat->r_address);
+ return 0;
}
- continue; // FIXME: I hope it's OK to ignore all the others.
}
- else
+ else /* !(relocs[i].r_address & R_SCATTERED) */
{
struct relocation_info *reloc = &relocs[i];
if(reloc->r_pcrel && !reloc->r_extern)
word = (word & 0x03FFFFFC) | ((word & 0x02000000) ? 0xFC000000 : 0);
}
#endif
+ else
+ {
+ barf("Can't handle this Mach-O relocation entry "
+ "(not scattered): "
+ "object file %s; entry type %ld; address %#lx\n",
+ oc->fileName, reloc->r_type, reloc->r_address);
+ return 0;
+ }
if(!reloc->r_extern)
{
}
#endif
}
- barf("\nunknown relocation %d",reloc->r_type);
- return 0;
+ else
+ {
+ barf("Can't handle Mach-O relocation entry (not scattered) "
+ "with this r_length tag: "
+ "object file %s; entry type %ld; "
+ "r_length tag %ld; address %#lx\n",
+ oc->fileName, reloc->r_type, reloc->r_length,
+ reloc->r_address);
+ return 0;
+ }
}
#endif
}
* Yuck.
*/
+extern void* symbolsWithoutUnderscore[];
+
static void machoInitSymbolsWithoutUnderscore()
{
- extern void* symbolsWithoutUnderscore[];
void **p = symbolsWithoutUnderscore;
__asm__ volatile(".globl _symbolsWithoutUnderscore\n.data\n_symbolsWithoutUnderscore:");
-#undef Sym
+#undef SymI_NeedsProto
#define SymI_NeedsProto(x) \
__asm__ volatile(".long " # x);
__asm__ volatile(".text");
-#undef Sym
+#undef SymI_NeedsProto
#define SymI_NeedsProto(x) \
ghciInsertStrHashTable("(GHCi built-in symbols)", symhash, #x, *p++);
RTS_MACHO_NOUNDERLINE_SYMBOLS
-#undef Sym
+#undef SymI_NeedsProto
}
#endif
projects / ghc-hetmet.git / blobdiff