[project @ 2001-02-07 11:48:10 by simonmar]
[ghc-hetmet.git] / ghc / rts / Linker.c
index 7bfc7c6..73df9c0 100644 (file)
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Linker.c,v 1.7 2001/01/10 17:21:18 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
@@ -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,6 +139,9 @@ 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)             \
@@ -136,8 +151,9 @@ static int ocResolve_PEi386     ( ObjectCode* oc );
       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)                    \
@@ -193,6 +209,7 @@ static int ocResolve_PEi386     ( ObjectCode* oc );
       SymX(__int_encodeFloat)                  \
       SymX(__int_encodeDouble)                 \
       SymX(__gmpz_cmp_si)                      \
+      SymX(__gmpz_cmp_ui)                      \
       SymX(__gmpz_cmp)                         \
       SymX(__gmpn_gcd_1)                       \
       SymX(prog_argv)                          \
@@ -217,7 +234,16 @@ static int ocResolve_PEi386     ( ObjectCode* oc );
       SymX(PatErrorHdrHook)                    \
       SymX(defaultsHook)                       \
       SymX(PreTraceHook)                       \
-      SymX(PostTraceHook)
+      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 */
@@ -345,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);
@@ -357,7 +383,10 @@ loadObj( char *path )
    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;
@@ -379,9 +408,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");
@@ -389,9 +418,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");
@@ -417,9 +446,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");
@@ -437,9 +466,10 @@ resolveObjs( void )
 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
@@ -448,26 +478,35 @@ unloadObj( char *path )
            { 
                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 
@@ -478,7 +517,7 @@ unloadObj( char *path )
 */
       
 
-#if defined(cygwin32_TARGET_OS)
+#if defined(OBJFORMAT_PEi386)
 
 
 
@@ -1092,14 +1131,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
@@ -1333,6 +1372,7 @@ ocGetNames_ELF ( ObjectCode* oc )
       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 */
@@ -1459,7 +1499,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.
@@ -1484,7 +1524,7 @@ 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);
@@ -1493,7 +1533,7 @@ is_dynamically_loaded_code_or_rodata_ptr ( char* p )
 
 
 int
-is_dynamically_loaded_rwdata_ptr ( char* p )
+is_dynamically_loaded_rwdata_ptr ( void* p )
 {
    SectionKind sk = lookupSection(p);
    ASSERT (sk != SECTIONKIND_NOINFOAVAIL);
@@ -1502,7 +1542,7 @@ is_dynamically_loaded_rwdata_ptr ( char* p )
 
 
 int
-is_not_dynamically_loaded_ptr ( char* p )
+is_not_dynamically_loaded_ptr ( void* p )
 {
    SectionKind sk = lookupSection(p);
    ASSERT (sk != SECTIONKIND_NOINFOAVAIL);