Remove vectored returns.

[ghc-hetmet.git] / rts / Linker.c

diff --git a/rts/Linker.c b/rts/Linker.c
index 4aca397..42ae177 100644 (file)
--- a/rts/Linker.c
+++ b/rts/Linker.c
@@ -10,7 +10,7 @@
 #include "PosixSource.h"
 #endif
 
 #include "PosixSource.h"
 #endif
 

-/* Linux needs _GNU_SOURCE to get RTLD_DEFAULT from <dlfcn.h> and 
+/* Linux needs _GNU_SOURCE to get RTLD_DEFAULT from <dlfcn.h> and

    MREMAP_MAYMOVE from <sys/mman.h>.
  */
 #ifdef __linux__
    MREMAP_MAYMOVE from <sys/mman.h>.
  */
 #ifdef __linux__

@@ -25,8 +25,8 @@
 #include "LinkerInternals.h"
 #include "RtsUtils.h"
 #include "Schedule.h"
 #include "LinkerInternals.h"
 #include "RtsUtils.h"
 #include "Schedule.h"

-#include "Storage.h"

 #include "Sparks.h"
 #include "Sparks.h"

+#include "RtsTypeable.h"

 
 #ifdef HAVE_SYS_TYPES_H
 #include <sys/types.h>
 
 #ifdef HAVE_SYS_TYPES_H
 #include <sys/types.h>

@@ -92,16 +92,8 @@
 /* Hash table mapping symbol names to Symbol */
 static /*Str*/HashTable *symhash;
 
 /* Hash table mapping symbol names to Symbol */
 static /*Str*/HashTable *symhash;
 

-typedef struct {
-  void *addr;
-} rootEntry;
-

 /* Hash table mapping symbol names to StgStablePtr */
 static /*Str*/HashTable *stablehash;
 /* Hash table mapping symbol names to StgStablePtr */
 static /*Str*/HashTable *stablehash;

-rootEntry *root_ptr_table = NULL;
-static rootEntry *root_ptr_free = NULL;
-
-static unsigned int RPT_size = 0;

 
 /* List of currently loaded objects */
 ObjectCode *objects = NULL;    /* initially empty */
 
 /* List of currently loaded objects */
 ObjectCode *objects = NULL;    /* initially empty */

@@ -333,6 +325,7 @@ typedef struct _RtsSymbolVal {
       Sym(mktime)                               \
       Sym(_imp___timezone)                      \
       Sym(_imp___tzname)                        \
       Sym(mktime)                               \
       Sym(_imp___timezone)                      \
       Sym(_imp___tzname)                        \

+      Sym(_imp__tzname)                         \

       Sym(_imp___iob)                           \
       Sym(_imp___osver)                         \
       Sym(localtime)                            \
       Sym(_imp___iob)                           \
       Sym(_imp___osver)                         \
       Sym(localtime)                            \

@@ -404,7 +397,11 @@ typedef struct _RtsSymbolVal {
 #define RTS_USER_SIGNALS_SYMBOLS \
    SymX(setIOManagerPipe)
 #else
 #define RTS_USER_SIGNALS_SYMBOLS \
    SymX(setIOManagerPipe)
 #else

-#define RTS_USER_SIGNALS_SYMBOLS /* nothing */
+#define RTS_USER_SIGNALS_SYMBOLS \
+   SymX(sendIOManagerEvent) \
+   SymX(readIOManagerEvent) \
+   SymX(getIOManagerEvent) \
+   SymX(console_handler)

 #endif
 
 #ifdef TABLES_NEXT_TO_CODE
 #endif
 
 #ifdef TABLES_NEXT_TO_CODE

@@ -460,7 +457,6 @@ typedef struct _RtsSymbolVal {
       SymX(stg_block_1)                                \
       SymX(stg_block_takemvar)                 \
       SymX(stg_block_putmvar)                  \
       SymX(stg_block_1)                                \
       SymX(stg_block_takemvar)                 \
       SymX(stg_block_putmvar)                  \

-      SymX(stg_seq_frame_info)                 \

       MAIN_CAP_SYM                              \
       SymX(MallocFailHook)                     \
       SymX(OnExitHook)                         \
       MAIN_CAP_SYM                              \
       SymX(MallocFailHook)                     \
       SymX(OnExitHook)                         \

@@ -486,6 +482,7 @@ typedef struct _RtsSymbolVal {
       SymX(catchzh_fast)                       \
       SymX(catchRetryzh_fast)                  \
       SymX(catchSTMzh_fast)                    \
       SymX(catchzh_fast)                       \
       SymX(catchRetryzh_fast)                  \
       SymX(catchSTMzh_fast)                    \

+      SymX(checkzh_fast)                        \

       SymX(closure_flags)                       \
       SymX(cmp_thread)                         \
       SymX(cmpIntegerzh_fast)                  \
       SymX(closure_flags)                       \
       SymX(cmp_thread)                         \
       SymX(cmpIntegerzh_fast)                  \

@@ -507,6 +504,7 @@ typedef struct _RtsSymbolVal {
       SymX(forkOS_createThread)                        \
       SymX(freeHaskellFunctionPtr)             \
       SymX(freeStablePtr)                      \
       SymX(forkOS_createThread)                        \
       SymX(freeHaskellFunctionPtr)             \
       SymX(freeStablePtr)                      \

+      SymX(getOrSetTypeableStore)              \

       SymX(gcdIntegerzh_fast)                  \
       SymX(gcdIntegerIntzh_fast)               \
       SymX(gcdIntzh_fast)                      \
       SymX(gcdIntegerzh_fast)                  \
       SymX(gcdIntegerIntzh_fast)               \
       SymX(gcdIntzh_fast)                      \

@@ -522,6 +520,8 @@ typedef struct _RtsSymbolVal {
       SymX(hs_free_stable_ptr)                 \
       SymX(hs_free_fun_ptr)                    \
       SymX(initLinker)                         \
       SymX(hs_free_stable_ptr)                 \
       SymX(hs_free_fun_ptr)                    \
       SymX(initLinker)                         \

+      SymX(infoPtrzh_fast)                      \
+      SymX(closurePayloadzh_fast)               \

       SymX(int2Integerzh_fast)                 \
       SymX(integer2Intzh_fast)                 \
       SymX(integer2Wordzh_fast)                        \
       SymX(int2Integerzh_fast)                 \
       SymX(integer2Intzh_fast)                 \
       SymX(integer2Wordzh_fast)                        \

@@ -699,15 +699,8 @@ typedef struct _RtsSymbolVal {
       SymX(xorIntegerzh_fast)                  \
       SymX(yieldzh_fast)                        \
       SymX(stg_interp_constr_entry)             \
       SymX(xorIntegerzh_fast)                  \
       SymX(yieldzh_fast)                        \
       SymX(stg_interp_constr_entry)             \

-      SymX(stg_interp_constr1_entry)            \
-      SymX(stg_interp_constr2_entry)            \
-      SymX(stg_interp_constr3_entry)            \
-      SymX(stg_interp_constr4_entry)            \
-      SymX(stg_interp_constr5_entry)            \
-      SymX(stg_interp_constr6_entry)            \
-      SymX(stg_interp_constr7_entry)            \
-      SymX(stg_interp_constr8_entry)            \
-      SymX(stgMallocBytesRWX)                   \
+      SymX(allocateExec)                       \
+      SymX(freeExec)                           \

       SymX(getAllocations)                      \
       SymX(revertCAFs)                          \
       SymX(RtsFlags)                            \
       SymX(getAllocations)                      \
       SymX(revertCAFs)                          \
       SymX(RtsFlags)                            \

@@ -793,6 +786,7 @@ static RtsSymbolVal rtsSyms[] = {
       RTS_POSIX_ONLY_SYMBOLS
       RTS_MINGW_ONLY_SYMBOLS
       RTS_CYGWIN_ONLY_SYMBOLS
       RTS_POSIX_ONLY_SYMBOLS
       RTS_MINGW_ONLY_SYMBOLS
       RTS_CYGWIN_ONLY_SYMBOLS

+      RTS_DARWIN_ONLY_SYMBOLS

       RTS_LIBGCC_SYMBOLS
 #if defined(darwin_HOST_OS) && defined(i386_HOST_ARCH)
       // dyld stub code contains references to this,
       RTS_LIBGCC_SYMBOLS
 #if defined(darwin_HOST_OS) && defined(i386_HOST_ARCH)
       // dyld stub code contains references to this,

@@ -804,97 +798,11 @@ static RtsSymbolVal rtsSyms[] = {
 };
 
 
 };
 
 

-/* -----------------------------------------------------------------------------
- * Utilities for handling root pointers.
- * -------------------------------------------------------------------------- */
-
-
-#define INIT_RPT_SIZE 64
-
-STATIC_INLINE void
-initFreeList(rootEntry *table, nat n, rootEntry *free)
-{
-  rootEntry *p;
-
-  for (p = table + n - 1; p >= table; p--) {
-    p->addr   = (P_)free;
-    free = p;
-  }
-  root_ptr_free = table;
-}
-
-void
-initRootPtrTable(void)
-{
-  if (RPT_size > 0)
-    return;
-
-  RPT_size = INIT_RPT_SIZE;
-  root_ptr_table = stgMallocBytes(RPT_size * sizeof(rootEntry),
-                                    "initRootPtrTable");
-
-  initFreeList(root_ptr_table,INIT_RPT_SIZE,NULL);
-}
-
-
-void
-enlargeRootPtrTable(void)
-{
-  nat old_RPT_size = RPT_size;
-
-  // 2nd and subsequent times
-  RPT_size *= 2;
-  root_ptr_table =
-    stgReallocBytes(root_ptr_table,
-                    RPT_size * sizeof(rootEntry),
-                    "enlargeRootPtrTable");
-
-  initFreeList(root_ptr_table + old_RPT_size, old_RPT_size, NULL);
-}
-
-static void
-addRootObject(void *addr)
-{
-  StgWord rt;
-  initRootPtrTable();
-  if (root_ptr_free == NULL) {
-    enlargeRootPtrTable();
-  }
-
-  rt = root_ptr_free - root_ptr_table;
-  root_ptr_free  = (rootEntry*)(root_ptr_free->addr);
-  root_ptr_table[rt].addr = addr;
-}
-
-/* -----------------------------------------------------------------------------
- * Treat root pointers as roots for the garbage collector.
- * -------------------------------------------------------------------------- */
-
-void
-markRootPtrTable(evac_fn evac)
-{
-  rootEntry *p, *end_root_ptr_table;
-  StgPtr q;
-
-  end_root_ptr_table = &root_ptr_table[RPT_size];
-
-  for (p = root_ptr_table; p < end_root_ptr_table; p++) {
-    q = p->addr;
-
-    if (q && (q < (P_)root_ptr_table || q >= (P_)end_root_ptr_table)) {
-        evac((StgClosure **)p->addr);
-    }
-  }
-}
-
-/* -----------------------------------------------------------------------------
- * End of utilities for handling root pointers.
- * -------------------------------------------------------------------------- */
-

 
 /* -----------------------------------------------------------------------------
  * Insert symbols into hash tables, checking for duplicates.
  */
 
 /* -----------------------------------------------------------------------------
  * Insert symbols into hash tables, checking for duplicates.
  */

+

 static void ghciInsertStrHashTable ( char* obj_name,
                                      HashTable *table,
                                      char* key,
 static void ghciInsertStrHashTable ( char* obj_name,
                                      HashTable *table,
                                      char* key,

@@ -924,8 +832,6 @@ static void ghciInsertStrHashTable ( char* obj_name,
    );
    exit(1);
 }
    );
    exit(1);
 }

-
-

 /* -----------------------------------------------------------------------------
  * initialize the object linker
  */
 /* -----------------------------------------------------------------------------
  * initialize the object linker
  */

@@ -937,11 +843,6 @@ static int linker_init_done = 0 ;
 static void *dl_prog_handle;
 #endif
 
 static void *dl_prog_handle;
 #endif
 

-/* dlopen(NULL,..) doesn't work so we grab libc explicitly */
-#if defined(openbsd_HOST_OS)
-static void *dl_libc_handle;
-#endif
-

 void
 initLinker( void )
 {
 void
 initLinker( void )
 {

@@ -971,9 +872,6 @@ initLinker( void )
     dl_prog_handle = RTLD_DEFAULT;
 #   else
     dl_prog_handle = dlopen(NULL, RTLD_LAZY);
     dl_prog_handle = RTLD_DEFAULT;
 #   else
     dl_prog_handle = dlopen(NULL, RTLD_LAZY);

-#   if defined(openbsd_HOST_OS)
-    dl_libc_handle = dlopen("libc.so", RTLD_LAZY);
-#   endif

 #   endif /* RTLD_DEFAULT */
 #   endif
 }
 #   endif /* RTLD_DEFAULT */
 #   endif
 }

@@ -1124,10 +1022,7 @@ lookupSymbol( char *lbl )
 
     if (val == NULL) {
 #       if defined(OBJFORMAT_ELF)
 
     if (val == NULL) {
 #       if defined(OBJFORMAT_ELF)

-#      if defined(openbsd_HOST_OS)
-       val = dlsym(dl_prog_handle, lbl);
-       return (val != NULL) ? val : dlsym(dl_libc_handle,lbl);
-#      elif defined(x86_64_HOST_ARCH)
+#      if defined(x86_64_HOST_ARCH)

        val = dlsym(dl_prog_handle, lbl);
        if (val >= (void *)0x80000000) {
            void *new_val;
        val = dlsym(dl_prog_handle, lbl);
        if (val >= (void *)0x80000000) {
            void *new_val;

@@ -1137,7 +1032,7 @@ lookupSymbol( char *lbl )
        } else {
            return val;
        }
        } else {
            return val;
        }

-#      else /* not openbsd */
+#      else

        return dlsym(dl_prog_handle, lbl);
 #      endif
 #       elif defined(OBJFORMAT_MACHO)
        return dlsym(dl_prog_handle, lbl);
 #      endif
 #       elif defined(OBJFORMAT_MACHO)

@@ -1257,13 +1152,12 @@ loadObj( char *path )
    void *map_addr = NULL;
 #else
    FILE *f;
    void *map_addr = NULL;
 #else
    FILE *f;

-   int misalignment;

 #endif
    initLinker();
 
    /* debugBelch("loadObj %s\n", path ); */
 
 #endif
    initLinker();
 
    /* debugBelch("loadObj %s\n", path ); */
 

-   /* Check that we haven't already loaded this object. 
+   /* Check that we haven't already loaded this object.

       Ignore requests to load multiple times */
    {
        ObjectCode *o;
       Ignore requests to load multiple times */
    {
        ObjectCode *o;

@@ -1353,7 +1247,7 @@ loadObj( char *path )
 #define EXTRA_MAP_FLAGS 0
 #endif
 
 #define EXTRA_MAP_FLAGS 0
 #endif
 

-   oc->image = mmap(map_addr, n, PROT_EXEC|PROT_READ|PROT_WRITE, 
+   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);
                    MAP_PRIVATE|EXTRA_MAP_FLAGS, fd, 0);
    if (oc->image == MAP_FAILED)
       barf("loadObj: can't map `%s'", path);

@@ -1367,7 +1261,12 @@ loadObj( char *path )
    if (!f)
        barf("loadObj: can't read `%s'", path);
 
    if (!f)
        barf("loadObj: can't read `%s'", path);
 

-#ifdef darwin_HOST_OS
+#   if defined(mingw32_HOST_OS)
+       // TODO: We would like to use allocateExec here, but allocateExec
+       //       cannot currently allocate blocks large enough.
+    oc->image = VirtualAlloc(NULL, oc->fileSize, MEM_RESERVE | MEM_COMMIT,
+                             PAGE_EXECUTE_READWRITE);
+#   elif defined(darwin_HOST_OS)

     // In a Mach-O .o file, all sections can and will be misaligned
     // if the total size of the headers is not a multiple of the
     // desired alignment. This is fine for .o files that only serve
     // In a Mach-O .o file, all sections can and will be misaligned
     // if the total size of the headers is not a multiple of the
     // desired alignment. This is fine for .o files that only serve

@@ -1377,15 +1276,13 @@ loadObj( char *path )
     // We calculate the correct alignment from the header before
     // reading the file, and then we misalign oc->image on purpose so
     // that the actual sections end up aligned again.
     // We calculate the correct alignment from the header before
     // reading the file, and then we misalign oc->image on purpose so
     // that the actual sections end up aligned again.

-   misalignment = machoGetMisalignment(f);
-   oc->misalignment = misalignment;
-#else
-   misalignment = 0;
-#endif
+   oc->misalignment = machoGetMisalignment(f);
+   oc->image = stgMallocBytes(oc->fileSize + oc->misalignment, "loadObj(image)");
+   oc->image += oc->misalignment;
+#  else
+   oc->image = stgMallocBytes(oc->fileSize, "loadObj(image)");
+#  endif

 
 

-   oc->image = stgMallocBytes(oc->fileSize + misalignment, "loadObj(image)");
-   oc->image += misalignment;
-   

    n = fread ( oc->image, 1, oc->fileSize, f );
    if (n != oc->fileSize)
       barf("loadObj: error whilst reading `%s'", path);
    n = fread ( oc->image, 1, oc->fileSize, f );
    if (n != oc->fileSize)
       barf("loadObj: error whilst reading `%s'", path);

@@ -1498,9 +1395,13 @@ unloadObj( char *path )
                prev->next = oc->next;
            }
 
                prev->next = oc->next;
            }
 

-           /* We're going to leave this in place, in case there are
-              any pointers from the heap into it: */
-           /* stgFree(oc->image); */
+           // We're going to leave this in place, in case there are
+           // any pointers from the heap into it:
+               // #ifdef mingw32_HOST_OS
+               //  VirtualFree(oc->image);
+               // #else
+           //  stgFree(oc->image);
+           // #endif

            stgFree(oc->fileName);
            stgFree(oc->symbols);
            stgFree(oc->sections);
            stgFree(oc->fileName);
            stgFree(oc->symbols);
            stgFree(oc->sections);

@@ -1575,7 +1476,7 @@ static void addSection ( ObjectCode* oc, SectionKind kind,
 
 /*
   ocAllocateJumpIslands
 
 /*
   ocAllocateJumpIslands

-  
+

   Allocate additional space at the end of the object file image to make room
   for jump islands.
   
   Allocate additional space at the end of the object file image to make room
   for jump islands.
   

@@ -2280,6 +2181,8 @@ ocGetNames_PEi386 ( ObjectCode* oc )
           && 0 != strcmp(".stabstr", sectab_i->Name)
           /* ignore constructor section for now */
           && 0 != strcmp(".ctors", sectab_i->Name)
           && 0 != strcmp(".stabstr", sectab_i->Name)
           /* ignore constructor section for now */
           && 0 != strcmp(".ctors", sectab_i->Name)

+          /* ignore section generated from .ident */
+          && 0!= strcmp("/4", sectab_i->Name)

          ) {
          errorBelch("Unknown PEi386 section name `%s' (while processing: %s)", sectab_i->Name, oc->fileName);
          return 0;
          ) {
          errorBelch("Unknown PEi386 section name `%s' (while processing: %s)", sectab_i->Name, oc->fileName);
          return 0;

@@ -2497,14 +2400,14 @@ ocResolve_PEi386 ( ObjectCode* oc )
                    + sym->Value);
          } else {
             copyName ( sym->Name, strtab, symbol, 1000-1 );
                    + sym->Value);
          } else {
             copyName ( sym->Name, strtab, symbol, 1000-1 );

-            (void*)S = lookupLocalSymbol( oc, symbol );
+            S = (UInt32) lookupLocalSymbol( oc, symbol );

             if ((void*)S != NULL) goto foundit;
             if ((void*)S != NULL) goto foundit;

-            (void*)S = lookupSymbol( symbol );
+            S = (UInt32) lookupSymbol( symbol );

             if ((void*)S != NULL) goto foundit;
             zapTrailingAtSign ( symbol );
             if ((void*)S != NULL) goto foundit;
             zapTrailingAtSign ( symbol );

-            (void*)S = lookupLocalSymbol( oc, symbol );
+            S = (UInt32) lookupLocalSymbol( oc, symbol );

             if ((void*)S != NULL) goto foundit;
             if ((void*)S != NULL) goto foundit;

-            (void*)S = lookupSymbol( 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);
             if ((void*)S != NULL) goto foundit;
            /* Newline first because the interactive linker has printed "linking..." */
             errorBelch("\n%s: unknown symbol `%s'", oc->fileName, symbol);

@@ -3288,7 +3191,6 @@ do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC,
               S = (Elf_Addr)S_tmp;
             } else {
               stableVal = deRefStablePtr( stablePtr );
               S = (Elf_Addr)S_tmp;
             } else {
               stableVal = deRefStablePtr( stablePtr );

-              addRootObject((void*)P);

               S_tmp = stableVal;
               S = (Elf_Addr)S_tmp;
             }
               S_tmp = stableVal;
               S = (Elf_Addr)S_tmp;
             }

@@ -4449,3 +4351,4 @@ static int machoGetMisalignment( FILE * f )
 }
 
 #endif
 }
 
 #endif

+