[project @ 2002-12-19 14:33:22 by simonmar]

Terrible hack to restore CAF handling behaviour in GHCi (it's
currently broken).

The story used to be this: in newCAF(), if the CAF is in dynamically
loaded code, then we save the CAF's info ptr in a spare slot in the
closure, and add the CAF to the caf_list.  The GC will retain
everything on the caf_list.  At any point the CAFs can all be reverted
by replacing their info pointers from the saved copies.

CAFs need to be retained for GHCi because they might be required in a
future execution; an optimisation would be to avoid retaining the CAFs
if we're in "revert mode"; i.e. the CAFs are all going to be reverted
after execution anyway.  Also, this only applies to CAFs in compiled
code; CAFs in interpreted code are currently always retained.

Anyway, the old story is harder now that I removed the code that
checks whether a pointer is dynamically loaded or not (:-)).  Rather
than re-instate that code, I created a new version of newCAF
(newDynCAF), and arranged that the dynamic linker redirects any
references to newCAF to point to newDynCAF instead.  The result is
more efficient than before, and takes less code.

diff --git a/ghc/rts/Linker.c b/ghc/rts/Linker.c
index ab58223..f27f144 100644 (file)
--- a/ghc/rts/Linker.c
+++ b/ghc/rts/Linker.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Linker.c,v 1.107 2002/12/11 15:36:42 simonmar Exp $
+ * $Id: Linker.c,v 1.108 2002/12/19 14:33:22 simonmar Exp $
  *
  * (c) The GHC Team, 2000, 2001
  *
@@ -393,7 +393,7 @@ 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)          \
@@ -553,6 +553,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
@@ -572,6 +573,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

diff --git a/ghc/rts/Storage.c b/ghc/rts/Storage.c
index f20ea5c..137796f 100644 (file)
--- a/ghc/rts/Storage.c
+++ b/ghc/rts/Storage.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Storage.c,v 1.72 2002/12/13 19:17:02 wolfgang Exp $
+ * $Id: Storage.c,v 1.73 2002/12/19 14:33:23 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -269,15 +269,9 @@ newCAF(StgClosure* caf)
    */
   ACQUIRE_SM_LOCK;
 
-  if (0 /*TODO: is_dynamically_loaded_rwdata_ptr((StgPtr)caf)*/) {
-      ((StgIndStatic *)caf)->saved_info  = (StgInfoTable *)caf->header.info;
-      ((StgIndStatic *)caf)->static_link = caf_list;
-      caf_list = caf;
-  } else {
-      ((StgIndStatic *)caf)->saved_info = NULL;
-      ((StgMutClosure *)caf)->mut_link = oldest_gen->mut_once_list;
-      oldest_gen->mut_once_list = (StgMutClosure *)caf;
-  }
+  ((StgIndStatic *)caf)->saved_info = NULL;
+  ((StgMutClosure *)caf)->mut_link = oldest_gen->mut_once_list;
+  oldest_gen->mut_once_list = (StgMutClosure *)caf;
 
   RELEASE_SM_LOCK;
 
@@ -291,6 +285,25 @@ newCAF(StgClosure* caf)
 #endif /* PAR */
 }
 
+// An alternate version of newCaf which is used for dynamically loaded
+// object code in GHCi.  In this case we want to retain *all* CAFs in
+// the object code, because they might be demanded at any time from an
+// expression evaluated on the command line.
+//
+// The linker hackily arranges that references to newCaf from dynamic
+// code end up pointing to newDynCAF.
+void
+newDynCAF(StgClosure *caf)
+{
+    ACQUIRE_SM_LOCK;
+
+    ((StgIndStatic *)caf)->saved_info  = (StgInfoTable *)caf->header.info;
+    ((StgIndStatic *)caf)->static_link = caf_list;
+    caf_list = caf;
+
+    RELEASE_SM_LOCK;
+}
+
 /* -----------------------------------------------------------------------------
    Nursery management.
    -------------------------------------------------------------------------- */

diff --git a/ghc/rts/StoragePriv.h b/ghc/rts/StoragePriv.h
index 59f065f..556c612 100644 (file)
--- a/ghc/rts/StoragePriv.h
+++ b/ghc/rts/StoragePriv.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: StoragePriv.h,v 1.23 2002/12/11 15:36:54 simonmar Exp $
+ * $Id: StoragePriv.h,v 1.24 2002/12/19 14:33:23 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -21,6 +21,7 @@ extern step *g0s0;
 extern generation *oldest_gen;
 
 extern void newCAF(StgClosure*);
+extern void newDynCAF(StgClosure *);
 
 extern void move_TSO(StgTSO *src, StgTSO *dest);
 extern StgTSO *relocate_stack(StgTSO *dest, ptrdiff_t diff);