[project @ 2003-05-30 09:06:24 by simonmar]
[ghc-hetmet.git] / ghc / rts / Linker.c
index 47c04e9..7d9a550 100644 (file)
@@ -1,7 +1,7 @@
 /* -----------------------------------------------------------------------------
- * $Id: Linker.c,v 1.112 2003/01/29 09:54:32 simonmar Exp $
+ * $Id: Linker.c,v 1.120 2003/05/30 09:06:24 simonmar Exp $
  *
- * (c) The GHC Team, 2000, 2001
+ * (c) The GHC Team, 2000-2003
  *
  * RTS Object Linker
  *
@@ -59,7 +59,7 @@
 #include <sys/mman.h>
 #endif
 
-#if defined(linux_TARGET_OS) || defined(solaris2_TARGET_OS) || defined(freebsd_TARGET_OS)
+#if defined(linux_TARGET_OS) || defined(solaris2_TARGET_OS) || defined(freebsd_TARGET_OS) || defined(netbsd_TARGET_OS)
 #  define OBJFORMAT_ELF
 #elif defined(cygwin32_TARGET_OS) || defined (mingw32_TARGET_OS)
 #  define OBJFORMAT_PEi386
@@ -91,6 +91,8 @@ static int ocResolve_PEi386     ( ObjectCode* oc );
 static int ocVerifyImage_MachO    ( ObjectCode* oc );
 static int ocGetNames_MachO       ( ObjectCode* oc );
 static int ocResolve_MachO        ( ObjectCode* oc );
+
+static void machoInitSymbolsWithoutUnderscore( void );
 #endif
 
 /* -----------------------------------------------------------------------------
@@ -203,11 +205,7 @@ typedef struct _RtsSymbolVal {
       SymX(uname)                               \
       SymX(unlink)                              \
       SymX(utime)                               \
-      SymX(waitpid)                             \
-      Sym(__divdi3)                             \
-      Sym(__udivdi3)                            \
-      Sym(__moddi3)                             \
-      Sym(__umoddi3)
+      SymX(waitpid)
 
 #elif !defined(mingw32_TARGET_OS)
 #define RTS_MINGW_ONLY_SYMBOLS /**/
@@ -216,9 +214,20 @@ typedef struct _RtsSymbolVal {
 #define RTS_POSIX_ONLY_SYMBOLS  /**/
 #define RTS_CYGWIN_ONLY_SYMBOLS /**/
 
+/* Extra syms gen'ed by mingw-2's gcc-3.2: */
+#if __GNUC__>=3
+#define RTS_MINGW_EXTRA_SYMS                    \
+      Sym(_imp____mb_cur_max)                   \
+      Sym(_imp___pctype)            
+#else
+#define RTS_MINGW_EXTRA_SYMS
+#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                  \
+      SymX(asyncReadzh_fast)                   \
+      SymX(asyncWritezh_fast)                  \
       SymX(memset)                              \
       SymX(inet_ntoa)                           \
       SymX(inet_addr)                           \
@@ -278,11 +287,8 @@ typedef struct _RtsSymbolVal {
       Sym(opendir)                              \
       Sym(readdir)                              \
       Sym(rewinddir)                            \
-      Sym(closedir)                             \
-      Sym(__divdi3)                             \
-      Sym(__udivdi3)                            \
-      Sym(__moddi3)                             \
-      Sym(__umoddi3)
+      RTS_MINGW_EXTRA_SYMS                      \
+      Sym(closedir)
 #endif
 
 #ifndef SMP
@@ -421,10 +427,12 @@ typedef struct _RtsSymbolVal {
       SymX(rts_getInt)                         \
       SymX(rts_getInt32)                       \
       SymX(rts_getPtr)                         \
+      SymX(rts_getFunPtr)                      \
       SymX(rts_getStablePtr)                   \
       SymX(rts_getThreadId)                    \
       SymX(rts_getWord)                                \
       SymX(rts_getWord32)                      \
+      SymX(rts_lock)                           \
       SymX(rts_mkBool)                         \
       SymX(rts_mkChar)                         \
       SymX(rts_mkDouble)                       \
@@ -435,6 +443,7 @@ typedef struct _RtsSymbolVal {
       SymX(rts_mkInt64)                                \
       SymX(rts_mkInt8)                         \
       SymX(rts_mkPtr)                          \
+      SymX(rts_mkFunPtr)                       \
       SymX(rts_mkStablePtr)                    \
       SymX(rts_mkString)                       \
       SymX(rts_mkWord)                         \
@@ -442,6 +451,7 @@ typedef struct _RtsSymbolVal {
       SymX(rts_mkWord32)                       \
       SymX(rts_mkWord64)                       \
       SymX(rts_mkWord8)                                \
+      SymX(rts_unlock)                         \
       SymX(run_queue_hd)                       \
       SymX(setProgArgv)                                \
       SymX(startupHaskell)                     \
@@ -532,12 +542,9 @@ typedef struct _RtsSymbolVal {
 #define RTS_LONG_LONG_SYMS /* nothing */
 #endif
 
-#ifdef ia64_TARGET_ARCH
-/* force these symbols to be present */
-#define RTS_EXTRA_SYMBOLS                      \
-      Sym(__divsf3)
-#elif defined(powerpc_TARGET_ARCH)
-#define RTS_EXTRA_SYMBOLS                      \
+// 64-bit support functions in libgcc.a
+#if defined(__GNUC__) && SIZEOF_VOID_P <= 4
+#define RTS_LIBGCC_SYMBOLS                     \
       Sym(__divdi3)                             \
       Sym(__udivdi3)                            \
       Sym(__moddi3)                             \
@@ -547,9 +554,26 @@ typedef struct _RtsSymbolVal {
       Sym(__lshrdi3)                           \
       Sym(__eprintf)
 #else
+#define RTS_LIBGCC_SYMBOLS
+#endif
+
+#ifdef ia64_TARGET_ARCH
+/* force these symbols to be present */
+#define RTS_EXTRA_SYMBOLS                      \
+      Sym(__divsf3)
+#else
 #define RTS_EXTRA_SYMBOLS /* nothing */
 #endif
 
+#ifdef darwin_TARGET_OS
+      // Symbols that don't have a leading underscore
+      // on Mac OS X. They have to receive special treatment,
+      // see machoInitSymbolsWithoutUnderscore()
+#define RTS_MACHO_NOUNDERLINE_SYMBOLS          \
+      Sym(saveFP)                              \
+      Sym(restFP)
+#endif
+
 /* entirely bogus claims about types of these symbols */
 #define Sym(vvv)  extern void (vvv);
 #define SymX(vvv) /**/
@@ -560,6 +584,7 @@ RTS_EXTRA_SYMBOLS
 RTS_POSIX_ONLY_SYMBOLS
 RTS_MINGW_ONLY_SYMBOLS
 RTS_CYGWIN_ONLY_SYMBOLS
+RTS_LIBGCC_SYMBOLS
 #undef Sym
 #undef SymX
 #undef SymX_redirect
@@ -587,6 +612,7 @@ static RtsSymbolVal rtsSyms[] = {
       RTS_POSIX_ONLY_SYMBOLS
       RTS_MINGW_ONLY_SYMBOLS
       RTS_CYGWIN_ONLY_SYMBOLS
+      RTS_LIBGCC_SYMBOLS
       { 0, 0 } /* sentinel */
 };
 
@@ -654,6 +680,10 @@ initLinker( void )
        ghciInsertStrHashTable("(GHCi built-in symbols)",
                                symhash, sym->lbl, sym->addr);
     }
+#   if defined(OBJFORMAT_MACHO)
+    machoInitSymbolsWithoutUnderscore();
+#   endif
+
 #   if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
     dl_prog_handle = dlopen(NULL, RTLD_LAZY);
 #   endif
@@ -749,13 +779,13 @@ addDLL( char *dll_name )
         sprintf(buf, "%s.DRV", dll_name);      // KAA: allow loading of drivers (like winspool.drv)
         instance = LoadLibrary(buf);
         if (instance == NULL) {
-               free(buf);
+               stgFree(buf);
 
            /* LoadLibrary failed; return a ptr to the error msg. */
            return "addDLL: unknown error";
         }
    }
-   free(buf);
+   stgFree(buf);
 
    /* Add this DLL to the list of DLLs in which to search for symbols. */
    o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
@@ -931,7 +961,7 @@ loadObj( char *path )
 #  elif defined(OBJFORMAT_MACHO)
    oc->formatName = "Mach-O";
 #  else
-   free(oc);
+   stgFree(oc);
    barf("loadObj: not implemented on this platform");
 #  endif
 
@@ -1096,14 +1126,14 @@ unloadObj( char *path )
 
            /* 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);
+           /* stgFree(oc->image); */
+           stgFree(oc->fileName);
+           stgFree(oc->symbols);
+           stgFree(oc->sections);
            /* The local hash table should have been freed at the end
                of the ocResolve_ call on it. */
             ASSERT(oc->lochash == NULL);
-           free(oc);
+           stgFree(oc);
            return 1;
        }
     }
@@ -2935,7 +2965,7 @@ static int ocVerifyImage_MachO(ObjectCode* oc)
     return 1;
 }
 
-static void resolveImports(
+static int resolveImports(
     ObjectCode* oc,
     char *image,
     struct symtab_command *symLC,
@@ -2961,15 +2991,17 @@ static void resolveImports(
            addr = lookupSymbol(nm);
        if(!addr)
        {
-           fprintf(stderr, "not found: %s\n", nm);
-           abort();
+           belch("\n%s: unknown symbol `%s'", oc->fileName, nm);
+           return 0;
        }
        ASSERT(addr);
        ((void**)(image + sect->offset))[i] = addr;
     }
+    
+    return 1;
 }
 
-static void relocateSection(char *image, 
+static int relocateSection(char *image, 
     struct symtab_command *symLC, struct nlist *nlist,
     struct section* sections, struct section *sect)
 {
@@ -2977,9 +3009,9 @@ static void relocateSection(char *image,
     int i,n;
     
     if(!strcmp(sect->sectname,"__la_symbol_ptr"))
-       return;
+       return 1;
     else if(!strcmp(sect->sectname,"__nl_symbol_ptr"))
-       return;
+       return 1;
 
     n = sect->nreloc;
     relocs = (struct relocation_info*) (image + sect->reloff);
@@ -3009,9 +3041,9 @@ static void relocateSection(char *image,
            if(reloc->r_pcrel && !reloc->r_extern)
                continue;
                
-           if(!reloc->r_pcrel && reloc->r_length == 2)
+           if(reloc->r_length == 2)
            {
-               unsigned long word;
+               unsigned long word = 0;
 
                unsigned long* wordPtr = (unsigned long*) (image + sect->offset + reloc->r_address);
                
@@ -3034,6 +3066,12 @@ static void relocateSection(char *image,
                    word = ((unsigned short*) wordPtr)[1] << 16;
                    word += ((short)relocs[i+1].r_address & (short)0xFFFF);
                }
+               else if(reloc->r_type == PPC_RELOC_BR24)
+               {
+                   word = *wordPtr;
+                   word = (word & 0x03FFFFFC) | (word & 0x02000000) ? 0xFC000000 : 0;
+               }
+
 
                if(!reloc->r_extern)
                {
@@ -3049,7 +3087,14 @@ static void relocateSection(char *image,
                    struct nlist *symbol = &nlist[reloc->r_symbolnum];
                    char *nm = image + symLC->stroff + symbol->n_un.n_strx;
                    word = (unsigned long) (lookupSymbol(nm));
-                   ASSERT(word);
+                   if(!word)
+                   {
+                       belch("\nunknown symbol `%s'", nm);
+                       return 0;
+                   }
+                   
+                   if(reloc->r_pcrel)
+                       word -= ((long)image) + sect->offset + reloc->r_address;
                }
                
                if(reloc->r_type == GENERIC_RELOC_VANILLA)
@@ -3073,13 +3118,17 @@ static void relocateSection(char *image,
                        + ((word & (1<<15)) ? 1 : 0);
                    i++; continue;
                }
-               continue;
+               else if(reloc->r_type == PPC_RELOC_BR24)
+               {
+                   *wordPtr = (*wordPtr & 0xFC000003) | (word & 0x03FFFFFC);
+                   continue;
+               }
            }
-           fprintf(stderr, "unknown reloc\n");
-           abort();
-           ASSERT(2 + 2 == 5);
+           barf("\nunknown relocation %d",reloc->r_type);
+           return 0;
        }
     }
+    return 1;
 }
 
 static int ocGetNames_MachO(ObjectCode* oc)
@@ -3239,13 +3288,16 @@ static int ocResolve_MachO(ObjectCode* oc)
     indirectSyms = (unsigned long*) (image + dsymLC->indirectsymoff);
 
     if(la_ptrs)
-       resolveImports(oc,image,symLC,la_ptrs,indirectSyms,nlist);
+       if(!resolveImports(oc,image,symLC,la_ptrs,indirectSyms,nlist))
+           return 0;
     if(nl_ptrs)
-       resolveImports(oc,image,symLC,nl_ptrs,indirectSyms,nlist);
+       if(!resolveImports(oc,image,symLC,nl_ptrs,indirectSyms,nlist))
+           return 0;
     
     for(i=0;i<segLC->nsects;i++)
     {
-       relocateSection(image,symLC,nlist,sections,&sections[i]);
+       if(!relocateSection(image,symLC,nlist,sections,&sections[i]))
+           return 0;
     }
 
     /* Free the local symbol table; we won't need it again. */
@@ -3254,4 +3306,25 @@ static int ocResolve_MachO(ObjectCode* oc)
     return 1;
 }
 
+/*
+ * The Mach-O object format uses leading underscores. But not everywhere.
+ * There is a small number of runtime support functions defined in
+ * libcc_dynamic.a whose name does not have a leading underscore.
+ * As a consequence, we can't get their address from C code.
+ * We have to use inline assembler just to take the address of a function.
+ * Yuck.
+ */
+
+static void machoInitSymbolsWithoutUnderscore()
+{
+    void *p;
+
+#undef Sym    
+#define Sym(x)                                         \
+    __asm__ ("lis %0,hi16(" #x ")\n\tori %0,%0,lo16(" #x ")" : "=r" (p));      \
+    ghciInsertStrHashTable("(GHCi built-in symbols)", symhash, #x, p);
+    
+    RTS_MACHO_NOUNDERLINE_SYMBOLS
+
+}
 #endif