Make allocatePinned use local storage, and other refactorings
[ghc-hetmet.git] / rts / Linker.c
index 6ef0a21..2412864 100644 (file)
 #include <sys/wait.h>
 #endif
 
-#if defined(ia64_HOST_ARCH) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS) || defined(netbsd_HOST_OS) || defined(openbsd_HOST_OS)
+#if defined(ia64_HOST_ARCH) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS) || defined(dragonfly_HOST_OS) || defined(netbsd_HOST_OS) || defined(openbsd_HOST_OS)
 #define USE_MMAP
 #include <fcntl.h>
 #include <sys/mman.h>
 
-#if defined(linux_HOST_OS) || defined(freebsd_HOST_OS) || defined(netbsd_HOST_OS) || defined(openbsd_HOST_OS)
+#if defined(linux_HOST_OS) || defined(freebsd_HOST_OS) || defined(dragonfly_HOST_OS) || defined(netbsd_HOST_OS) || defined(openbsd_HOST_OS)
 #ifdef HAVE_UNISTD_H
 #include <unistd.h>
 #endif
@@ -76,7 +76,7 @@
 
 #endif
 
-#if defined(linux_HOST_OS) || defined(solaris2_HOST_OS) || defined(freebsd_HOST_OS) || defined(netbsd_HOST_OS) || defined(openbsd_HOST_OS)
+#if defined(linux_HOST_OS) || defined(solaris2_HOST_OS) || defined(freebsd_HOST_OS) || defined(dragonfly_HOST_OS) || defined(netbsd_HOST_OS) || defined(openbsd_HOST_OS)
 #  define OBJFORMAT_ELF
 #elif defined(cygwin32_HOST_OS) || defined (mingw32_HOST_OS)
 #  define OBJFORMAT_PEi386
@@ -423,6 +423,10 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(expf)                                \
       SymI_HasProto(logf)                                \
       SymI_HasProto(sqrtf)                               \
+      SymI_HasProto(erf)                                \
+      SymI_HasProto(erfc)                                \
+      SymI_HasProto(erff)                                \
+      SymI_HasProto(erfcf)                               \
       SymI_HasProto(memcpy)                              \
       SymI_HasProto(rts_InstallConsoleEvent)             \
       SymI_HasProto(rts_ConsoleHandlerDone)              \
@@ -501,10 +505,13 @@ typedef struct _RtsSymbolVal {
 #if !defined(mingw32_HOST_OS)
 #define RTS_USER_SIGNALS_SYMBOLS \
    SymI_HasProto(setIOManagerPipe) \
-   SymI_NeedsProto(blockUserSignals) \
-   SymI_NeedsProto(unblockUserSignals)
+   SymI_HasProto(ioManagerWakeup) \
+   SymI_HasProto(ioManagerSync) \
+   SymI_HasProto(blockUserSignals) \
+   SymI_HasProto(unblockUserSignals)
 #else
 #define RTS_USER_SIGNALS_SYMBOLS     \
+   SymI_HasProto(ioManagerWakeup) \
    SymI_HasProto(sendIOManagerEvent) \
    SymI_HasProto(readIOManagerEvent) \
    SymI_HasProto(getIOManagerEvent)  \
@@ -549,8 +556,137 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(stg_ap_pppppp_ret)
 #endif
 
+/* Modules compiled with -ticky may mention ticky counters */
+/* This list should marry up with the one in $(TOP)/includes/stg/Ticky.h */
+#define RTS_TICKY_SYMBOLS                       \
+      SymI_NeedsProto(ticky_entry_ctrs)         \
+      SymI_NeedsProto(top_ct)                   \
+                                                \
+      SymI_HasProto(ENT_VIA_NODE_ctr)          \
+      SymI_HasProto(ENT_STATIC_THK_ctr)                \
+      SymI_HasProto(ENT_DYN_THK_ctr)           \
+      SymI_HasProto(ENT_STATIC_FUN_DIRECT_ctr) \
+      SymI_HasProto(ENT_DYN_FUN_DIRECT_ctr)    \
+      SymI_HasProto(ENT_STATIC_CON_ctr)                \
+      SymI_HasProto(ENT_DYN_CON_ctr)           \
+      SymI_HasProto(ENT_STATIC_IND_ctr)                \
+      SymI_HasProto(ENT_DYN_IND_ctr)           \
+      SymI_HasProto(ENT_PERM_IND_ctr)          \
+      SymI_HasProto(ENT_PAP_ctr)               \
+      SymI_HasProto(ENT_AP_ctr)                        \
+      SymI_HasProto(ENT_AP_STACK_ctr)          \
+      SymI_HasProto(ENT_BH_ctr)                        \
+      SymI_HasProto(UNKNOWN_CALL_ctr)          \
+      SymI_HasProto(SLOW_CALL_v_ctr)           \
+      SymI_HasProto(SLOW_CALL_f_ctr)           \
+      SymI_HasProto(SLOW_CALL_d_ctr)           \
+      SymI_HasProto(SLOW_CALL_l_ctr)           \
+      SymI_HasProto(SLOW_CALL_n_ctr)           \
+      SymI_HasProto(SLOW_CALL_p_ctr)           \
+      SymI_HasProto(SLOW_CALL_pv_ctr)          \
+      SymI_HasProto(SLOW_CALL_pp_ctr)          \
+      SymI_HasProto(SLOW_CALL_ppv_ctr)         \
+      SymI_HasProto(SLOW_CALL_ppp_ctr)         \
+      SymI_HasProto(SLOW_CALL_pppv_ctr)                \
+      SymI_HasProto(SLOW_CALL_pppp_ctr)                \
+      SymI_HasProto(SLOW_CALL_ppppp_ctr)               \
+      SymI_HasProto(SLOW_CALL_pppppp_ctr)              \
+      SymI_HasProto(SLOW_CALL_OTHER_ctr)               \
+      SymI_HasProto(ticky_slow_call_unevald)            \
+      SymI_HasProto(SLOW_CALL_ctr)                     \
+      SymI_HasProto(MULTI_CHUNK_SLOW_CALL_ctr)         \
+      SymI_HasProto(MULTI_CHUNK_SLOW_CALL_CHUNKS_ctr)  \
+      SymI_HasProto(KNOWN_CALL_ctr)                    \
+      SymI_HasProto(KNOWN_CALL_TOO_FEW_ARGS_ctr)       \
+      SymI_HasProto(KNOWN_CALL_EXTRA_ARGS_ctr)         \
+      SymI_HasProto(SLOW_CALL_FUN_TOO_FEW_ctr)         \
+      SymI_HasProto(SLOW_CALL_FUN_CORRECT_ctr)         \
+      SymI_HasProto(SLOW_CALL_FUN_TOO_MANY_ctr)                \
+      SymI_HasProto(SLOW_CALL_PAP_TOO_FEW_ctr)         \
+      SymI_HasProto(SLOW_CALL_PAP_CORRECT_ctr)         \
+      SymI_HasProto(SLOW_CALL_PAP_TOO_MANY_ctr)                \
+      SymI_HasProto(SLOW_CALL_UNEVALD_ctr)             \
+      SymI_HasProto(UPDF_OMITTED_ctr)          \
+      SymI_HasProto(UPDF_PUSHED_ctr)           \
+      SymI_HasProto(CATCHF_PUSHED_ctr)         \
+      SymI_HasProto(UPDF_RCC_PUSHED_ctr)       \
+      SymI_HasProto(UPDF_RCC_OMITTED_ctr)      \
+      SymI_HasProto(UPD_SQUEEZED_ctr)          \
+      SymI_HasProto(UPD_CON_IN_NEW_ctr)                \
+      SymI_HasProto(UPD_CON_IN_PLACE_ctr)      \
+      SymI_HasProto(UPD_PAP_IN_NEW_ctr)                \
+      SymI_HasProto(UPD_PAP_IN_PLACE_ctr)      \
+      SymI_HasProto(ALLOC_HEAP_ctr)            \
+      SymI_HasProto(ALLOC_HEAP_tot)             \
+      SymI_HasProto(ALLOC_FUN_ctr)             \
+      SymI_HasProto(ALLOC_FUN_adm)              \
+      SymI_HasProto(ALLOC_FUN_gds)              \
+      SymI_HasProto(ALLOC_FUN_slp)              \
+      SymI_HasProto(UPD_NEW_IND_ctr)           \
+      SymI_HasProto(UPD_NEW_PERM_IND_ctr)      \
+      SymI_HasProto(UPD_OLD_IND_ctr)           \
+      SymI_HasProto(UPD_OLD_PERM_IND_ctr)              \
+      SymI_HasProto(UPD_BH_UPDATABLE_ctr)              \
+      SymI_HasProto(UPD_BH_SINGLE_ENTRY_ctr)           \
+      SymI_HasProto(UPD_CAF_BH_UPDATABLE_ctr)          \
+      SymI_HasProto(UPD_CAF_BH_SINGLE_ENTRY_ctr)       \
+      SymI_HasProto(GC_SEL_ABANDONED_ctr)              \
+      SymI_HasProto(GC_SEL_MINOR_ctr)          \
+      SymI_HasProto(GC_SEL_MAJOR_ctr)          \
+      SymI_HasProto(GC_FAILED_PROMOTION_ctr)   \
+      SymI_HasProto(ALLOC_UP_THK_ctr)          \
+      SymI_HasProto(ALLOC_SE_THK_ctr)          \
+      SymI_HasProto(ALLOC_THK_adm)             \
+      SymI_HasProto(ALLOC_THK_gds)             \
+      SymI_HasProto(ALLOC_THK_slp)             \
+      SymI_HasProto(ALLOC_CON_ctr)             \
+      SymI_HasProto(ALLOC_CON_adm)             \
+      SymI_HasProto(ALLOC_CON_gds)             \
+      SymI_HasProto(ALLOC_CON_slp)             \
+      SymI_HasProto(ALLOC_TUP_ctr)             \
+      SymI_HasProto(ALLOC_TUP_adm)             \
+      SymI_HasProto(ALLOC_TUP_gds)             \
+      SymI_HasProto(ALLOC_TUP_slp)             \
+      SymI_HasProto(ALLOC_BH_ctr)              \
+      SymI_HasProto(ALLOC_BH_adm)              \
+      SymI_HasProto(ALLOC_BH_gds)              \
+      SymI_HasProto(ALLOC_BH_slp)              \
+      SymI_HasProto(ALLOC_PRIM_ctr)            \
+      SymI_HasProto(ALLOC_PRIM_adm)            \
+      SymI_HasProto(ALLOC_PRIM_gds)            \
+      SymI_HasProto(ALLOC_PRIM_slp)            \
+      SymI_HasProto(ALLOC_PAP_ctr)             \
+      SymI_HasProto(ALLOC_PAP_adm)             \
+      SymI_HasProto(ALLOC_PAP_gds)             \
+      SymI_HasProto(ALLOC_PAP_slp)             \
+      SymI_HasProto(ALLOC_TSO_ctr)             \
+      SymI_HasProto(ALLOC_TSO_adm)             \
+      SymI_HasProto(ALLOC_TSO_gds)             \
+      SymI_HasProto(ALLOC_TSO_slp)             \
+      SymI_HasProto(RET_NEW_ctr)               \
+      SymI_HasProto(RET_OLD_ctr)               \
+      SymI_HasProto(RET_UNBOXED_TUP_ctr)       \
+      SymI_HasProto(RET_SEMI_loads_avoided)
+
+
+// On most platforms, the garbage collector rewrites references
+//     to small integer and char objects to a set of common, shared ones.
+//
+// We don't do this when compiling to Windows DLLs at the moment because
+//     it doesn't support cross package data references well.
+//
+#if defined(__PIC__) && defined(mingw32_HOST_OS)
+#define RTS_INTCHAR_SYMBOLS
+#else
+#define RTS_INTCHAR_SYMBOLS                            \
+      SymI_HasProto(stg_CHARLIKE_closure)              \
+      SymI_HasProto(stg_INTLIKE_closure)               
+#endif
+
+
 #define RTS_SYMBOLS                                    \
       Maybe_Stable_Names                               \
+      RTS_TICKY_SYMBOLS                                 \
       SymI_HasProto(StgReturn)                         \
       SymI_HasProto(stg_enter_info)                    \
       SymI_HasProto(stg_gc_void_info)                  \
@@ -618,7 +754,11 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(forkOS_createThread)               \
       SymI_HasProto(freeHaskellFunctionPtr)            \
       SymI_HasProto(getOrSetTypeableStore)             \
-      SymI_HasProto(getOrSetSignalHandlerStore)                \
+      SymI_HasProto(getOrSetGHCConcSignalHandlerStore)         \
+      SymI_HasProto(getOrSetGHCConcPendingEventsStore)         \
+      SymI_HasProto(getOrSetGHCConcPendingDelaysStore)         \
+      SymI_HasProto(getOrSetGHCConcIOManagerThreadStore)       \
+      SymI_HasProto(getOrSetGHCConcProddingStore)              \
       SymI_HasProto(genSymZh)                          \
       SymI_HasProto(genericRaise)                      \
       SymI_HasProto(getProgArgv)                       \
@@ -728,11 +868,9 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(stg_CAF_BLACKHOLE_info)            \
       SymI_HasProto(__stg_EAGER_BLACKHOLE_info)                \
       SymI_HasProto(startTimer)                         \
-      SymI_HasProto(stg_CHARLIKE_closure)              \
       SymI_HasProto(stg_MVAR_CLEAN_info)               \
       SymI_HasProto(stg_MVAR_DIRTY_info)               \
       SymI_HasProto(stg_IND_STATIC_info)               \
-      SymI_HasProto(stg_INTLIKE_closure)               \
       SymI_HasProto(stg_ARR_WORDS_info)                 \
       SymI_HasProto(stg_MUT_ARR_PTRS_DIRTY_info)       \
       SymI_HasProto(stg_MUT_ARR_PTRS_FROZEN_info)      \
@@ -805,9 +943,8 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(stg_writeTVarzh)                   \
       SymI_HasProto(stg_yieldzh)                        \
       SymI_NeedsProto(stg_interp_constr_entry)          \
-      SymI_HasProto(alloc_blocks)                       \
       SymI_HasProto(alloc_blocks_lim)                   \
-      SymI_HasProto(allocateLocal)                      \
+      SymI_HasProto(allocate)                           \
       SymI_HasProto(allocateExec)                      \
       SymI_HasProto(freeExec)                          \
       SymI_HasProto(getAllocations)                     \
@@ -819,7 +956,9 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(stopTimer)                         \
       SymI_HasProto(n_capabilities)                    \
       SymI_HasProto(stg_traceCcszh)                     \
-      RTS_USER_SIGNALS_SYMBOLS
+      SymI_HasProto(stg_traceEventzh)                   \
+      RTS_USER_SIGNALS_SYMBOLS                         \
+      RTS_INTCHAR_SYMBOLS
 
 
 // 64-bit support functions in libgcc.a
@@ -1284,7 +1423,7 @@ mmap_again:
        } else {
            if ((W_)result > 0x80000000) {
                // oops, we were given memory over 2Gb
-#if defined(freebsd_HOST_OS)
+#if defined(freebsd_HOST_OS) || defined(dragonfly_HOST_OS)
                // Some platforms require MAP_FIXED.  This is normally
                // a bad idea, because MAP_FIXED will overwrite
                // existing mappings.
@@ -3998,7 +4137,8 @@ static int relocateSection(
                        || scat->r_type == PPC_RELOC_HI16_SECTDIFF
                        || scat->r_type == PPC_RELOC_HA16_SECTDIFF)
 #else
-                    else if(scat->r_type == GENERIC_RELOC_SECTDIFF)
+                    else if(scat->r_type == GENERIC_RELOC_SECTDIFF
+                        || scat->r_type == GENERIC_RELOC_LOCAL_SECTDIFF)
 #endif
                    {
                        struct scattered_relocation_info *pair =
@@ -4053,15 +4193,23 @@ static int relocateSection(
                         i++;
                     }
  #endif
-                    else
-                       continue;  // ignore the others
-
+                    else 
+                    {
+                       barf ("Don't know how to handle this Mach-O "
+                             "scattered relocation entry: "
+                              "object file %s; entry type %ld; "
+                              "address %#lx\n", 
+                              oc->fileName, scat->r_type, scat->r_address);
+                        return 0;
+                     }
+                     
 #ifdef powerpc_HOST_ARCH
                     if(scat->r_type == GENERIC_RELOC_VANILLA
                         || scat->r_type == PPC_RELOC_SECTDIFF)
 #else
                     if(scat->r_type == GENERIC_RELOC_VANILLA
-                        || scat->r_type == GENERIC_RELOC_SECTDIFF)
+                        || scat->r_type == GENERIC_RELOC_SECTDIFF
+                        || scat->r_type == GENERIC_RELOC_LOCAL_SECTDIFF)
 #endif
                     {
                         *wordPtr = word;
@@ -4082,11 +4230,28 @@ static int relocateSection(
                     }
 #endif
                }
+               else
+               {
+                   barf("Can't handle Mach-O scattered relocation entry "
+                        "with this r_length tag: "
+                         "object file %s; entry type %ld; "
+                         "r_length tag %ld; address %#lx\n", 
+                         oc->fileName, scat->r_type, scat->r_length,
+                         scat->r_address);
+                    return 0;
+               }
            }
-
-           continue; // FIXME: I hope it's OK to ignore all the others.
+           else /* scat->r_pcrel */
+           {
+               barf("Don't know how to handle *PC-relative* Mach-O "
+                    "scattered relocation entry: "
+                     "object file %s; entry type %ld; address %#lx\n", 
+                     oc->fileName, scat->r_type, scat->r_address);
+               return 0;
+            }
+      
        }
-       else
+       else /* !(relocs[i].r_address & R_SCATTERED) */
        {
            struct relocation_info *reloc = &relocs[i];
            if(reloc->r_pcrel && !reloc->r_extern)
@@ -4131,6 +4296,14 @@ static int relocateSection(
                    word = (word & 0x03FFFFFC) | ((word & 0x02000000) ? 0xFC000000 : 0);
                }
 #endif
+                else
+                {
+                    barf("Can't handle this Mach-O relocation entry "
+                        "(not scattered): "
+                         "object file %s; entry type %ld; address %#lx\n", 
+                         oc->fileName, reloc->r_type, reloc->r_address);
+                    return 0;
+                }
 
                if(!reloc->r_extern)
                {
@@ -4222,8 +4395,16 @@ static int relocateSection(
                }
 #endif
             }
-           barf("\nunknown relocation %d",reloc->r_type);
-           return 0;
+            else
+            {
+                barf("Can't handle Mach-O relocation entry (not scattered) "
+                      "with this r_length tag: "
+                      "object file %s; entry type %ld; "
+                      "r_length tag %ld; address %#lx\n", 
+                      oc->fileName, reloc->r_type, reloc->r_length,
+                      reloc->r_address);
+                return 0;
+           }
        }
 #endif
     }