[project @ 2001-01-29 17:23:40 by simonmar]
[ghc-hetmet.git] / ghc / rts / Linker.c
index ad35ae8..bbfdc37 100644 (file)
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Linker.c,v 1.5 2000/12/14 15:19:48 sewardj Exp $
+ * $Id: Linker.c,v 1.15 2001/01/29 17:23:41 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
@@ -78,11 +90,11 @@ typedef struct _ObjectCode {
 /* 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 );
@@ -127,22 +139,28 @@ 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)                  \
@@ -152,25 +170,11 @@ static int ocResolve_PEi386     ( ObjectCode* oc );
       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)             \
@@ -184,7 +188,30 @@ static int ocResolve_PEi386     ( ObjectCode* oc );
       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)                 \
@@ -195,9 +222,71 @@ static int ocResolve_PEi386     ( ObjectCode* oc );
       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);
@@ -218,6 +307,7 @@ RTS_SYMBOLS
 
 static SymbolVal rtsSyms[] = {
       RTS_SYMBOLS
+      RTS_LONG_LONG_SYMS
       { 0, 0 } /* sentinel */
 };
 
@@ -281,9 +371,9 @@ loadObj( char *path )
 
    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);
@@ -315,9 +405,9 @@ loadObj( char *path )
    }
 
    /* 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");
@@ -325,9 +415,9 @@ loadObj( char *path )
    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");
@@ -353,9 +443,9 @@ resolveObjs( void )
 
     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");
@@ -403,7 +493,7 @@ unloadObj( char *path )
 }
 
 /* --------------------------------------------------------------------------
- * PEi386 specifics (cygwin32)
+ * PEi386 specifics (Win32 targets)
  * ------------------------------------------------------------------------*/
 
 /* The information for this linker comes from 
@@ -414,7 +504,7 @@ unloadObj( char *path )
 */
       
 
-#if defined(cygwin32_TARGET_OS)
+#if defined(OBJFORMAT_PEi386)
 
 
 
@@ -1028,14 +1118,14 @@ ocResolve_PEi386 ( ObjectCode* oc, int verb )
    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
@@ -1395,7 +1485,7 @@ ocResolve_ELF ( ObjectCode* oc )
 }
 
 
-#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.
@@ -1403,7 +1493,7 @@ ocResolve_ELF ( ObjectCode* oc )
  * Used by the garbage collector when walking the stack.
  * -------------------------------------------------------------------------- */
 
-SectionKind
+static __inline__ SectionKind
 lookupSection ( void* addr )
 {
    int          i;
@@ -1420,28 +1510,28 @@ lookupSection ( void* addr )
 }
 
 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);
 }