[project @ 2001-08-10 08:24:38 by simonmar]
[ghc-hetmet.git] / ghc / rts / Linker.c
index 105739a..1bc11b6 100644 (file)
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Linker.c,v 1.43 2001/06/06 14:03:41 sewardj Exp $
+ * $Id: Linker.c,v 1.55 2001/08/10 08:24:38 simonmar Exp $
  *
  * (c) The GHC Team, 2000
  *
@@ -80,7 +80,30 @@ typedef struct _RtsSymbolVal {
 #else
 
 #define RTS_POSIX_ONLY_SYMBOLS
+
+/* 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(memset)                              \
+      SymX(inet_ntoa)                           \
+      SymX(inet_addr)                           \
+      SymX(htonl)                               \
+      SymX(recvfrom)                            \
+      SymX(listen)                              \
+      SymX(bind)                                \
+      SymX(shutdown)                            \
+      SymX(connect)                             \
+      SymX(htons)                               \
+      SymX(ntohs)                               \
+      SymX(getservbyname)                       \
+      SymX(getservbyport)                       \
+      SymX(getprotobynumber)                    \
+      SymX(getprotobyname)                      \
+      SymX(gethostbyname)                       \
+      SymX(gethostbyaddr)                       \
+      SymX(gethostname)                         \
+      SymX(strcpy)                              \
+      SymX(strncpy)                             \
       SymX(abort)                               \
       Sym(_alloca)                              \
       Sym(isxdigit)                             \
@@ -93,22 +116,10 @@ typedef struct _RtsSymbolVal {
       Sym(iscntrl)                              \
       Sym(isalpha)                              \
       Sym(isalnum)                              \
-      SymX(memset)                              \
-      SymX(strncpy)                             \
-      SymX(strcpy)                              \
       SymX(strcmp)                              \
-      Sym(mktime)                               \
-      Sym(gmtime)                               \
-      Sym(strftime)                             \
-      Sym(localtime)                            \
-      SymX(getenv)                              \
-      SymX(rename)                              \
-      Sym(opendir)                              \
-      Sym(readdir)                              \
-      Sym(closedir)                             \
-      Sym(PrelHandle_stderr_closure)            \
-      Sym(Main_main_closure)                    \
-      Sym(__init_Main)                          \
+      SymX(memmove)                             \
+      SymX(realloc)                             \
+      SymX(malloc)                              \
       SymX(pow)                                 \
       SymX(tanh)                                \
       SymX(cosh)                                \
@@ -122,25 +133,29 @@ typedef struct _RtsSymbolVal {
       SymX(exp)                                 \
       SymX(log)                                 \
       SymX(sqrt)                                \
-      SymX(Sleep)                               \
-      SymX(system)                              \
-      SymX(memchr)                              \
       SymX(memcpy)                              \
-      SymX(memmove)                             \
-      SymX(fprintf)                             \
-      Sym(_imp___iob)                           \
-      Sym(_imp___tzname)                        \
+      Sym(mktime)                               \
       Sym(_imp___timezone)                      \
-      Sym(__udivdi3)                            \
-      SymX(GetProcessTimes)                     \
-      SymX(GetCurrentProcess)                   \
-      SymX(send)                                \
-      SymX(recv)                                \
-      SymX(malloc)                              \
+      Sym(_imp___tzname)                        \
+      Sym(localtime)                            \
+      Sym(gmtime)                               \
+      SymX(getenv)                              \
       SymX(free)                                \
-      SymX(realloc)                             \
-      SymX(_errno)                              \
-      SymX(closesocket)
+      SymX(rename)                              \
+      Sym(opendir)                              \
+      Sym(readdir)                              \
+      Sym(closedir)                             \
+      SymX(GetCurrentProcess)                   \
+      SymX(GetProcessTimes)                     \
+      SymX(CloseHandle)                         \
+      SymX(GetExitCodeProcess)                  \
+      SymX(WaitForSingleObject)                 \
+      SymX(CreateProcessA)                      \
+      Sym(__divdi3)                             \
+      Sym(__udivdi3)                            \
+      Sym(__moddi3)                             \
+      Sym(__umoddi3)                            \
+      SymX(_errno)
 #endif
 
 
@@ -222,6 +237,7 @@ typedef struct _RtsSymbolVal {
       SymX(newArrayzh_fast)                    \
       SymX(unsafeThawArrayzh_fast)             \
       SymX(newByteArrayzh_fast)                        \
+      SymX(newPinnedByteArrayzh_fast)          \
       SymX(newMutVarzh_fast)                   \
       SymX(quotRemIntegerzh_fast)              \
       SymX(quotIntegerzh_fast)                 \
@@ -320,41 +336,6 @@ typedef struct _RtsSymbolVal {
 #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 */
@@ -427,6 +408,7 @@ initLinker( void )
 
 typedef
    struct _OpenedDLL {
+      char*              name;
       struct _OpenedDLL* next;
       HINSTANCE instance;
    } 
@@ -463,33 +445,25 @@ addDLL ( char* path, char* dll_name )
    } else {
       return NULL;
    }
-   ASSERT(0); /*NOTREACHED*/
+   /*NOTREACHED*/
+
 #  elif defined(OBJFORMAT_PEi386)
 
    /* Add this DLL to the list of DLLs in which to search for symbols.
-      The first time through, also add the executable to the list,
-      since we need to search that too.  The path argument is ignored. */
+      The path argument is ignored. */
    char*      buf;
    OpenedDLL* o_dll;
    HINSTANCE  instance;
-   /* fprintf(stderr, "addDLL %s\n", dll_name ); */
 
-#if 0
-   /* Later ... can't figure out why this doesn't work.  So retain the
-      RTS_MINGW_ONLY_SYMBOLS hack for the time being.  */
-   if (opened_dlls == NULL) {
-      /* First time through ... */
-      instance = GetModuleHandle(NULL);
-      if (instance == NULL)
-         return "addDLL: can't get handle to the executable";
-      o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL-init" );
-      o_dll->instance = instance;
-      o_dll->next     = opened_dlls;
-      opened_dlls     = o_dll;
+   /* fprintf(stderr, "\naddDLL; path=`%s', dll_name = `%s'\n", path, dll_name); */
+
+   /* See if we've already got it, and ignore if so. */
+   for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
+      if (0 == strcmp(o_dll->name, dll_name))
+         return NULL;
    }
-#endif
 
-   buf = stgMallocBytes(strlen(dll_name) + 10, "addDll");
+   buf = stgMallocBytes(strlen(dll_name) + 10, "addDLL");
    sprintf(buf, "%s.DLL", dll_name);
    instance = LoadLibrary(buf);
    free(buf);
@@ -499,6 +473,8 @@ addDLL ( char* path, char* dll_name )
    }
 
    o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
+   o_dll->name     = stgMallocBytes(1+strlen(dll_name), "addDLL");
+   strcpy(o_dll->name, dll_name);
    o_dll->instance = instance;
    o_dll->next     = opened_dlls;
    opened_dlls     = o_dll;
@@ -525,12 +501,24 @@ lookupSymbol( char *lbl )
 #       elif defined(OBJFORMAT_PEi386)
         OpenedDLL* o_dll;
         void* sym;
-        ASSERT(2+2 == 5);
         for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
+           /* fprintf(stderr, "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) return sym;
+          }
            sym = GetProcAddress(o_dll->instance, lbl);
            if (sym != NULL) return sym;
         }
         return NULL;
+#       else
+        ASSERT(2+2 == 5);
+        return NULL;
 #       endif
     } else {
        return val;
@@ -956,7 +944,7 @@ ocVerifyImage_PEi386 ( ObjectCode* oc )
    COFF_section* sectab;
    COFF_symbol*  symtab;
    UChar*        strtab;
-
+   /* fprintf(stderr, "\nLOADING %s\n", oc->fileName); */
    hdr = (COFF_header*)(oc->image);
    sectab = (COFF_section*) (
                ((UChar*)(oc->image)) 
@@ -1180,6 +1168,7 @@ ocGetNames_PEi386 ( ObjectCode* oc )
          addr = ((UChar*)(oc->image))
                 + (sectabent->PointerToRawData
                    + symtab_i->Value);
+         /* fprintf(stderr,"addSymbol %p `%s'\n", addr,sname); */
          IF_DEBUG(linker, belch("addSymbol %p `%s'\n", addr,sname);)
          ASSERT(i >= 0 && i < oc->n_symbols);
          oc->symbols[i] = sname;
@@ -1204,7 +1193,7 @@ ocGetNames_PEi386 ( ObjectCode* oc )
       COFF_section* sectab_i
          = (COFF_section*)
            myindex ( sizeof_COFF_section, sectab, i );
-      IF_DEBUG(linker, belchf("section name = %s\n", sectab_i->Name ));
+      IF_DEBUG(linker, belch("section name = %s\n", sectab_i->Name ));
 
 #if 0
       /* I'm sure this is the Right Way to do it.  However, the 
@@ -1216,7 +1205,8 @@ ocGetNames_PEi386 ( ObjectCode* oc )
          kind = SECTIONKIND_CODE_OR_RODATA;
 #endif
 
-      if (0==strcmp(".text",sectab_i->Name))
+      if (0==strcmp(".text",sectab_i->Name) ||
+          0==strcmp(".rodata",sectab_i->Name))
          kind = SECTIONKIND_CODE_OR_RODATA;
       if (0==strcmp(".data",sectab_i->Name) ||
           0==strcmp(".bss",sectab_i->Name))
@@ -1382,7 +1372,12 @@ ocResolve_PEi386 ( ObjectCode* oc )
 
 #if defined(sparc_TARGET_ARCH)
 #  define ELF_TARGET_SPARC  /* Used inside <elf.h> */
+#elif defined(i386_TARGET_ARCH)
+#  define ELF_TARGET_386    /* Used inside <elf.h> */
 #endif
+/* There is a similar case for IA64 in the Solaris2 headers if this
+ * ever becomes relevant.
+ */
 
 #include <elf.h>