[project @ 2003-02-10 10:41:52 by simonmar]
[ghc-hetmet.git] / ghc / rts / Linker.c
index 261caf1..e1d1480 100644 (file)
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Linker.c,v 1.105 2002/10/12 23:12:08 wolfgang Exp $
+ * $Id: Linker.c,v 1.113 2003/02/10 10:41:52 simonmar Exp $
  *
  * (c) The GHC Team, 2000, 2001
  *
@@ -76,6 +76,9 @@
 /* Hash table mapping symbol names to Symbol */
 static /*Str*/HashTable *symhash;
 
+/* List of currently loaded objects */
+ObjectCode *objects = NULL;    /* initially empty */
+
 #if defined(OBJFORMAT_ELF)
 static int ocVerifyImage_ELF    ( ObjectCode* oc );
 static int ocGetNames_ELF       ( ObjectCode* oc );
@@ -292,40 +295,40 @@ typedef struct _RtsSymbolVal {
       Maybe_ForeignObj                         \
       Maybe_Stable_Names                       \
       Sym(StgReturn)                           \
-      Sym(init_stack)                          \
-      SymX(__stg_chk_0)                                \
-      SymX(__stg_chk_1)                                \
-      SymX(stg_chk_2)                          \
-      SymX(stg_chk_3)                          \
-      SymX(stg_chk_4)                          \
-      SymX(stg_chk_5)                          \
-      SymX(stg_chk_6)                          \
-      SymX(stg_chk_7)                          \
-      SymX(stg_chk_8)                          \
-      Sym(stg_enterStackTop)                   \
-      SymX(stg_gc_d1)                          \
-      SymX(stg_gc_l1)                          \
+      SymX(stg_enter_info)                     \
+      SymX(stg_enter_ret)                      \
+      SymX(stg_gc_void_info)                   \
       SymX(__stg_gc_enter_1)                   \
-      SymX(stg_gc_enter_2)                     \
-      SymX(stg_gc_enter_3)                     \
-      SymX(stg_gc_enter_4)                     \
-      SymX(stg_gc_enter_5)                     \
-      SymX(stg_gc_enter_6)                     \
-      SymX(stg_gc_enter_7)                     \
-      SymX(stg_gc_enter_8)                     \
-      SymX(stg_gc_f1)                          \
       SymX(stg_gc_noregs)                      \
-      SymX(stg_gc_seq_1)                       \
-      SymX(stg_gc_unbx_r1)                     \
+      SymX(stg_gc_unpt_r1_info)                        \
       SymX(stg_gc_unpt_r1)                     \
-      SymX(stg_gc_ut_0_1)                      \
-      SymX(stg_gc_ut_1_0)                      \
-      SymX(stg_gen_chk)                                \
+      SymX(stg_gc_unbx_r1_info)                        \
+      SymX(stg_gc_unbx_r1)                     \
+      SymX(stg_gc_f1_info)                     \
+      SymX(stg_gc_f1)                          \
+      SymX(stg_gc_d1_info)                     \
+      SymX(stg_gc_d1)                          \
+      SymX(stg_gc_l1_info)                     \
+      SymX(stg_gc_l1)                          \
+      SymX(__stg_gc_fun)                       \
+      SymX(stg_gc_fun_info)                    \
+      SymX(stg_gc_fun_ret)                     \
+      SymX(stg_gc_gen)                         \
+      SymX(stg_gc_gen_info)                    \
+      SymX(stg_gc_gen_hp)                      \
+      SymX(stg_gc_ut)                          \
+      SymX(stg_gen_yield)                      \
+      SymX(stg_yield_noregs)                   \
       SymX(stg_yield_to_interpreter)           \
+      SymX(stg_gen_block)                      \
+      SymX(stg_block_noregs)                   \
+      SymX(stg_block_1)                                \
+      SymX(stg_block_takemvar)                 \
+      SymX(stg_block_putmvar)                  \
+      SymX(stg_seq_frame_info)                 \
       SymX(ErrorHdrHook)                       \
       MAIN_CAP_SYM                              \
       SymX(MallocFailHook)                     \
-      SymX(NoRunnableThreadsHook)              \
       SymX(OnExitHook)                         \
       SymX(OutOfHeapHook)                      \
       SymX(PatErrorHdrHook)                    \
@@ -388,9 +391,10 @@ typedef struct _RtsSymbolVal {
       SymX(newArrayzh_fast)                    \
       SymX(newBCOzh_fast)                      \
       SymX(newByteArrayzh_fast)                        \
-      SymX(newCAF)                             \
+      SymX_redirect(newCAF, newDynCAF)         \
       SymX(newMVarzh_fast)                     \
       SymX(newMutVarzh_fast)                   \
+      SymX(atomicModifyMutVarzh_fast)          \
       SymX(newPinnedByteArrayzh_fast)          \
       SymX(orIntegerzh_fast)                   \
       SymX(performGC)                          \
@@ -417,10 +421,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)                       \
@@ -431,6 +437,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)                         \
@@ -438,8 +445,11 @@ typedef struct _RtsSymbolVal {
       SymX(rts_mkWord32)                       \
       SymX(rts_mkWord64)                       \
       SymX(rts_mkWord8)                                \
+      SymX(rts_unlock)                         \
       SymX(run_queue_hd)                       \
       SymX(setProgArgv)                                \
+      SymX(startupHaskell)                     \
+      SymX(shutdownHaskell)                    \
       SymX(shutdownHaskellAndExit)             \
       SymX(stable_ptr_table)                   \
       SymX(stackOverflow)                      \
@@ -450,6 +460,35 @@ typedef struct _RtsSymbolVal {
       SymX(stg_INTLIKE_closure)                        \
       SymX(stg_MUT_ARR_PTRS_FROZEN_info)       \
       SymX(stg_WEAK_info)                       \
+      SymX(stg_ap_v_info)                      \
+      SymX(stg_ap_f_info)                      \
+      SymX(stg_ap_d_info)                      \
+      SymX(stg_ap_l_info)                      \
+      SymX(stg_ap_n_info)                      \
+      SymX(stg_ap_p_info)                      \
+      SymX(stg_ap_pv_info)                     \
+      SymX(stg_ap_pp_info)                     \
+      SymX(stg_ap_ppv_info)                    \
+      SymX(stg_ap_ppp_info)                    \
+      SymX(stg_ap_pppp_info)                   \
+      SymX(stg_ap_ppppp_info)                  \
+      SymX(stg_ap_pppppp_info)                 \
+      SymX(stg_ap_ppppppp_info)                        \
+      SymX(stg_ap_0_ret)                       \
+      SymX(stg_ap_v_ret)                       \
+      SymX(stg_ap_f_ret)                       \
+      SymX(stg_ap_d_ret)                       \
+      SymX(stg_ap_l_ret)                       \
+      SymX(stg_ap_n_ret)                       \
+      SymX(stg_ap_p_ret)                       \
+      SymX(stg_ap_pv_ret)                      \
+      SymX(stg_ap_pp_ret)                      \
+      SymX(stg_ap_ppv_ret)                     \
+      SymX(stg_ap_ppp_ret)                     \
+      SymX(stg_ap_pppp_ret)                    \
+      SymX(stg_ap_ppppp_ret)                   \
+      SymX(stg_ap_pppppp_ret)                  \
+      SymX(stg_ap_ppppppp_ret)                 \
       SymX(stg_ap_1_upd_info)                  \
       SymX(stg_ap_2_upd_info)                  \
       SymX(stg_ap_3_upd_info)                  \
@@ -475,9 +514,7 @@ typedef struct _RtsSymbolVal {
       SymX(stg_sel_7_upd_info)                 \
       SymX(stg_sel_8_upd_info)                 \
       SymX(stg_sel_9_upd_info)                 \
-      SymX(stg_seq_frame_info)                 \
       SymX(stg_upd_frame_info)                 \
-      SymX(__stg_update_PAP)                   \
       SymX(suspendThread)                      \
       SymX(takeMVarzh_fast)                    \
       SymX(timesIntegerzh_fast)                        \
@@ -520,6 +557,7 @@ typedef struct _RtsSymbolVal {
 /* entirely bogus claims about types of these symbols */
 #define Sym(vvv)  extern void (vvv);
 #define SymX(vvv) /**/
+#define SymX_redirect(vvv,xxx) /**/
 RTS_SYMBOLS
 RTS_LONG_LONG_SYMS
 RTS_EXTRA_SYMBOLS
@@ -528,6 +566,7 @@ RTS_MINGW_ONLY_SYMBOLS
 RTS_CYGWIN_ONLY_SYMBOLS
 #undef Sym
 #undef SymX
+#undef SymX_redirect
 
 #ifdef LEADING_UNDERSCORE
 #define MAYBE_LEADING_UNDERSCORE_STR(s) ("_" s)
@@ -539,6 +578,12 @@ RTS_CYGWIN_ONLY_SYMBOLS
                     (void*)(&(vvv)) },
 #define SymX(vvv) Sym(vvv)
 
+// SymX_redirect allows us to redirect references to one symbol to
+// another symbol.  See newCAF/newDynCAF for an example.
+#define SymX_redirect(vvv,xxx) \
+    { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
+      (void*)(&(xxx)) },
+
 static RtsSymbolVal rtsSyms[] = {
       RTS_SYMBOLS
       RTS_LONG_LONG_SYMS
@@ -815,14 +860,16 @@ void ghci_enquire ( char* addr )
       for (i = 0; i < oc->n_symbols; i++) {
          sym = oc->symbols[i];
          if (sym == NULL) continue;
-         /* fprintf(stderr, "enquire %p %p\n", sym, oc->lochash); */
+         // fprintf(stderr, "enquire %p %p\n", sym, oc->lochash);
          a = NULL;
-         if (oc->lochash != NULL)
+         if (oc->lochash != NULL) {
             a = lookupStrHashTable(oc->lochash, sym);
-         if (a == NULL)
+        }
+         if (a == NULL) {
             a = lookupStrHashTable(symhash, sym);
+        }
          if (a == NULL) {
-            /* fprintf(stderr, "ghci_enquire: can't find %s\n", sym); */
+            // fprintf(stderr, "ghci_enquire: can't find %s\n", sym);
          }
          else if (addr-DELTA <= a && a <= addr+DELTA) {
             fprintf(stderr, "%p + %3d  ==  `%s'\n", addr, a - addr, sym);