[project @ 2001-02-11 17:51:07 by simonmar]

Bite the bullet and make GHCi support non-optional in the RTS.  GHC
4.11 should be able to build GHCi without any additional tweaks now.

- the Linker is split into two parts: LinkerBasic.c, containing the
  routines required by the rest of the RTS, and Linker.c, containing
  the linker proper, which is not referred to from the rest of the RTS.
  Only Linker.c requires -ldl, so programs which don't make use of the
  linker (everything except GHC, in other words) won't need -ldl.

ghc/includes/Closures.h

 /* ----------------------------------------------------------------------------
- * $Id: Closures.h,v 1.25 2001/01/29 17:23:41 simonmar Exp $
+ * $Id: Closures.h,v 1.26 2001/02/11 17:51:08 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -189,9 +189,7 @@ typedef struct {
     StgHeader     header;
     StgClosure   *indirectee;
     StgClosure   *static_link;
-#ifdef GHCI
     struct _StgInfoTable *saved_info;
-#endif
 } StgIndStatic;
 
 typedef struct {

ghc/includes/StgMiscClosures.h

 /* -----------------------------------------------------------------------------
- * $Id: StgMiscClosures.h,v 1.34 2001/02/09 13:09:17 simonmar Exp $
+ * $Id: StgMiscClosures.h,v 1.35 2001/02/11 17:51:08 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -34,9 +34,7 @@ STGFUN(stg_SE_CAF_BLACKHOLE_entry);
 #if defined(PAR) || defined(GRAN)
 STGFUN(stg_RBH_entry);
 #endif
-#ifdef GHCI
 STGFUN(stg_BCO_entry);
-#endif
 STGFUN(stg_EVACUATED_entry);
 STGFUN(stg_FOREIGN_entry);
 STGFUN(stg_WEAK_entry);

ghc/rts/Disassembler.c

@@ -5,11 +5,11 @@
  * Copyright (c) 1994-1998.
  *
  * $RCSfile: Disassembler.c,v $
- * $Revision: 1.18 $
- * $Date: 2001/01/05 15:24:28 $
+ * $Revision: 1.19 $
+ * $Date: 2001/02/11 17:51:07 $
  * ---------------------------------------------------------------------------*/
 
-#ifdef GHCI
+#ifdef DEBUG
 
 #include "Rts.h"
 #include "RtsAPI.h"
@@ -190,4 +190,4 @@ void disassemble( StgBCO *bco )
    ASSERT(pc == nbcs+1);
 }
 
-#endif /* GHCI */
+#endif /* DEBUG */

ghc/rts/Disassembler.h

 
 /* -----------------------------------------------------------------------------
- * $Id: Disassembler.h,v 1.6 2000/12/20 14:47:22 sewardj Exp $
+ * $Id: Disassembler.h,v 1.7 2001/02/11 17:51:07 simonmar Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
@@ -8,7 +8,7 @@
  *
  * ---------------------------------------------------------------------------*/
 
-#ifdef GHCI
+#ifdef DEBUG
 
 extern int  disInstr   ( StgBCO *bco, int pc );
 extern void disassemble( StgBCO *bco );

ghc/rts/GC.c

 /* -----------------------------------------------------------------------------
- * $Id: GC.c,v 1.95 2001/02/08 18:04:49 sewardj Exp $
+ * $Id: GC.c,v 1.96 2001/02/11 17:51:07 simonmar Exp $
  *
  * (c) The GHC Team 1998-1999
  *
@@ -53,10 +53,8 @@
 #  include "ParallelDebug.h"
 # endif
 #endif
-#if defined(GHCI)
-# include "HsFFI.h"
-# include "Linker.h"
-#endif
+#include "HsFFI.h"
+#include "Linker.h"
 #if defined(RTS_GTK_FRONTPANEL)
 #include "FrontPanel.h"
 #endif
@@ -164,10 +162,8 @@ static void         scavenge_mut_once_list  ( generation *g );
 static void         gcCAFs                  ( void );
 #endif
 
-#ifdef GHCI
 void revertCAFs   ( void );
 void scavengeCAFs ( void );
-#endif
 
 //@node Garbage Collect, Weak Pointers, Static function declarations
 //@subsection Garbage Collect
@@ -390,9 +386,7 @@ void GarbageCollect ( void (*get_roots)(void), rtsBool force_major_gc )
     }
   }
 
-#ifdef GHCI
   scavengeCAFs();
-#endif
 
   /* follow all the roots that the application knows about.
    */
@@ -743,8 +737,10 @@ void GarbageCollect ( void (*get_roots)(void), rtsBool force_major_gc )
   }
 
  /* mark the garbage collected CAFs as dead */
-#if defined(DEBUG) && !defined(GHCI)
-  if (major_gc) { gcCAFs(); } /* doesn't work w/ GHCI */
+#if 0 /* doesn't work at the moment */
+#if defined(DEBUG)
+  if (major_gc) { gcCAFs(); }
+#endif
 #endif
   
   /* zero the scavenged static object list */
@@ -1525,14 +1521,12 @@ loop:
     return q;
 
   case IND_STATIC:
-#ifdef GHCI
     /* a revertible CAF - it'll be on the CAF list, so don't do
      * anything with it here (we'll scavenge it later).
      */
     if (((StgIndStatic *)q)->saved_info != NULL) {
        return q;
     }
-#endif
     if (major_gc && IND_STATIC_LINK((StgClosure *)q) == NULL) {
        IND_STATIC_LINK((StgClosure *)q) = static_objects;
        static_objects = (StgClosure *)q;
@@ -3022,14 +3016,14 @@ zero_mutable_list( StgMutClosure *first )
    Reverting CAFs
    -------------------------------------------------------------------------- */
 
-#ifdef GHCI
-
 void
 revertCAFs( void )
 {
     StgIndStatic *c;
 
-    for (c = (StgIndStatic *)caf_list; c != NULL; c = (StgIndStatic *)c->static_link) {
+    for (c = (StgIndStatic *)caf_list; c != NULL; 
+	 c = (StgIndStatic *)c->static_link) 
+    {
 	c->header.info = c->saved_info;
 	c->saved_info = NULL;
 	/* could, but not necessary: c->static_link = NULL; */
@@ -3043,13 +3037,13 @@ scavengeCAFs( void )
     StgIndStatic *c;
 
     evac_gen = 0;
-    for (c = (StgIndStatic *)caf_list; c != NULL; c = (StgIndStatic *)c->static_link) {
+    for (c = (StgIndStatic *)caf_list; c != NULL; 
+	 c = (StgIndStatic *)c->static_link) 
+    {
 	c->indirectee = evacuate(c->indirectee);
     }
 }
 
-#endif /* GHCI */
-
 /* -----------------------------------------------------------------------------
    Sanity code for CAF garbage collection.
 

ghc/rts/Interpreter.c

@@ -5,12 +5,10 @@
  * Copyright (c) 1994-2000.
  *
  * $RCSfile: Interpreter.c,v $
- * $Revision: 1.16 $
- * $Date: 2001/02/06 12:09:42 $
+ * $Revision: 1.17 $
+ * $Date: 2001/02/11 17:51:07 $
  * ---------------------------------------------------------------------------*/
 
-#ifdef GHCI
-
 #include "Rts.h"
 #include "RtsAPI.h"
 #include "RtsUtils.h"
@@ -771,5 +769,3 @@ StgThreadReturnCode interpretBCO ( Capability* cap )
 
     barf("fallen off end of object-type switch in interpretBCO()");
 }
-
-#endif /* GHCI */

ghc/rts/Linker.c

 /* -----------------------------------------------------------------------------
- * $Id: Linker.c,v 1.21 2001/02/11 13:13:37 simonmar Exp $
+ * $Id: Linker.c,v 1.22 2001/02/11 17:51:07 simonmar Exp $
  *
  * (c) The GHC Team, 2000
  *
@@ -12,6 +12,7 @@
 #include "HsFFI.h"
 #include "Hash.h"
 #include "Linker.h"
+#include "LinkerInternals.h"
 #include "RtsUtils.h"
 #include "StoragePriv.h"
 
@@ -27,69 +28,15 @@
 #include <dlfcn.h>
 #endif
 
-#ifdef GHCI /* endif is right at end of file */
-
 #if defined(linux_TARGET_OS) || defined(solaris2_TARGET_OS) || defined(freebsd_TARGET_OS)
 #define OBJFORMAT_ELF
 #elif defined(cygwin32_TARGET_OS) || defined (mingw32_TARGET_OS)
 #define OBJFORMAT_PEi386
 #endif
 
-/* A bucket in the symbol hash-table.  Primarily, maps symbol names to
- * absolute addresses.  All symbols from a given module are linked
- * together, so they can be freed at the same time.  There's also a
- * bucket link field for the hash table.
- */
-typedef struct _SymbolVal {
-    char   *lbl;
-    void   *addr;
-} SymbolVal;
-
-typedef enum { OBJECT_LOADED, OBJECT_RESOLVED } OStatus;
-
-/* Indication of section kinds for loaded objects.  Needed by
-   the GC for deciding whether or not a pointer on the stack
-   is a code pointer.
-*/
-typedef enum { SECTIONKIND_CODE_OR_RODATA,
-               SECTIONKIND_RWDATA,
-               SECTIONKIND_OTHER,
-               SECTIONKIND_NOINFOAVAIL } 
-   SectionKind;
-
-typedef struct { void* start; void* end; SectionKind kind; } 
-   Section;
-
-/* Top-level structure for an object module.  One of these is allocated
- * for each object file in use.
- */
-typedef struct _ObjectCode {
-    OStatus   status;
-    char*     fileName;
-    int       fileSize;
-    char*     formatName;            /* eg "ELF32", "DLL", "COFF", etc. */
-
-    SymbolVal *symbols;
-    int       n_symbols;
-
-    /* ptr to malloc'd lump of memory holding the obj file */
-    void*     image;
-
-    /* The section-kind entries for this object module.  Dynamically expands. */
-    Section*  sections;
-    int       n_sections;
-    
-    /* Allow a chain of these things */
-    struct _ObjectCode * next;
-} ObjectCode;
-
-
 /* Hash table mapping symbol names to Symbol */
 /*Str*/HashTable *symhash;
 
-/* List of currently loaded objects */
-ObjectCode *objects;
-
 #if defined(OBJFORMAT_ELF)
 static int ocVerifyImage_ELF    ( ObjectCode* oc );
 static int ocGetNames_ELF       ( ObjectCode* oc );
@@ -1634,53 +1581,3 @@ ocResolve_ELF ( ObjectCode* oc )
 
 
 #endif /* ELF */
-
-/* -----------------------------------------------------------------------------
- * Look up an address to discover whether it is in text or data space.
- *
- * Used by the garbage collector when walking the stack.
- * -------------------------------------------------------------------------- */
-
-static __inline__ SectionKind
-lookupSection ( void* addr )
-{
-   int          i;
-   ObjectCode*  oc;
-   
-   for ( oc = objects; oc; oc = oc->next ) {
-       for (i = 0; i < oc->n_sections; i++) {
-	   if (oc->sections[i].start <= addr 
-	       && addr <= oc->sections[i].end)
-	       return oc->sections[i].kind;
-       }
-   }
-   return SECTIONKIND_OTHER;
-}
-
-int
-is_dynamically_loaded_code_or_rodata_ptr ( void* p )
-{
-   SectionKind sk = lookupSection(p);
-   ASSERT (sk != SECTIONKIND_NOINFOAVAIL);
-   return (sk == SECTIONKIND_CODE_OR_RODATA);
-}
-
-
-int
-is_dynamically_loaded_rwdata_ptr ( void* p )
-{
-   SectionKind sk = lookupSection(p);
-   ASSERT (sk != SECTIONKIND_NOINFOAVAIL);
-   return (sk == SECTIONKIND_RWDATA);
-}
-
-
-int
-is_not_dynamically_loaded_ptr ( void* p )
-{
-   SectionKind sk = lookupSection(p);
-   ASSERT (sk != SECTIONKIND_NOINFOAVAIL);
-   return (sk == SECTIONKIND_OTHER);
-}
-
-#endif /* GHCI */

ghc/rts/LinkerBasic.c

+/* -----------------------------------------------------------------------------
+ * $Id: LinkerBasic.c,v 1.1 2001/02/11 17:51:07 simonmar Exp $
+ *
+ * (c) The GHC Team, 2000
+ *
+ * RTS Object Linker
+ *
+ * ---------------------------------------------------------------------------*/
+
+#include "Rts.h"
+#include "StoragePriv.h"
+#include "LinkerInternals.h"
+
+/* List of currently loaded objects */
+ObjectCode *objects = NULL;	/* initially empty */
+
+/* -----------------------------------------------------------------------------
+ * Look up an address to discover whether it is in text or data space.
+ *
+ * Used by the garbage collector when walking the stack.
+ * -------------------------------------------------------------------------- */
+
+static __inline__ SectionKind
+lookupSection ( void* addr )
+{
+   int          i;
+   ObjectCode*  oc;
+   
+   for ( oc = objects; oc; oc = oc->next ) {
+       for (i = 0; i < oc->n_sections; i++) {
+	   if (oc->sections[i].start <= addr 
+	       && addr <= oc->sections[i].end)
+	       return oc->sections[i].kind;
+       }
+   }
+   return SECTIONKIND_OTHER;
+}
+
+int
+is_dynamically_loaded_code_or_rodata_ptr ( void* p )
+{
+   SectionKind sk = lookupSection(p);
+   ASSERT (sk != SECTIONKIND_NOINFOAVAIL);
+   return (sk == SECTIONKIND_CODE_OR_RODATA);
+}
+
+
+int
+is_dynamically_loaded_rwdata_ptr ( void* p )
+{
+   SectionKind sk = lookupSection(p);
+   ASSERT (sk != SECTIONKIND_NOINFOAVAIL);
+   return (sk == SECTIONKIND_RWDATA);
+}
+
+
+int
+is_not_dynamically_loaded_ptr ( void* p )
+{
+   SectionKind sk = lookupSection(p);
+   ASSERT (sk != SECTIONKIND_NOINFOAVAIL);
+   return (sk == SECTIONKIND_OTHER);
+}

ghc/rts/LinkerInternals.h

+/* -----------------------------------------------------------------------------
+ * $Id: LinkerInternals.h,v 1.1 2001/02/11 17:51:07 simonmar Exp $
+ *
+ * (c) The GHC Team, 2000
+ *
+ * RTS Object Linker
+ *
+ * ---------------------------------------------------------------------------*/
+
+/* A bucket in the symbol hash-table.  Primarily, maps symbol names to
+ * absolute addresses.  All symbols from a given module are linked
+ * together, so they can be freed at the same time.  There's also a
+ * bucket link field for the hash table.
+ */
+typedef struct _SymbolVal {
+    char   *lbl;
+    void   *addr;
+} SymbolVal;
+
+typedef enum { OBJECT_LOADED, OBJECT_RESOLVED } OStatus;
+
+/* Indication of section kinds for loaded objects.  Needed by
+   the GC for deciding whether or not a pointer on the stack
+   is a code pointer.
+*/
+typedef enum { SECTIONKIND_CODE_OR_RODATA,
+               SECTIONKIND_RWDATA,
+               SECTIONKIND_OTHER,
+               SECTIONKIND_NOINFOAVAIL } 
+   SectionKind;
+
+typedef struct { void* start; void* end; SectionKind kind; } 
+   Section;
+
+/* Top-level structure for an object module.  One of these is allocated
+ * for each object file in use.
+ */
+typedef struct _ObjectCode {
+    OStatus   status;
+    char*     fileName;
+    int       fileSize;
+    char*     formatName;            /* eg "ELF32", "DLL", "COFF", etc. */
+
+    SymbolVal *symbols;
+    int       n_symbols;
+
+    /* ptr to malloc'd lump of memory holding the obj file */
+    void*     image;
+
+    /* The section-kind entries for this object module.  Dynamically expands. */
+    Section*  sections;
+    int       n_sections;
+    
+    /* Allow a chain of these things */
+    struct _ObjectCode * next;
+} ObjectCode;
+
+extern ObjectCode *objects;

ghc/rts/PrimOps.hc

 /* -----------------------------------------------------------------------------
- * $Id: PrimOps.hc,v 1.70 2001/02/09 13:09:16 simonmar Exp $
+ * $Id: PrimOps.hc,v 1.71 2001/02/11 17:51:07 simonmar Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
@@ -1011,7 +1011,6 @@ FN_(makeStableNamezh_fast)
    Bytecode object primitives
    -------------------------------------------------------------------------  */
 
-#ifdef GHCI
 FN_(newBCOzh_fast)
 {
   /* R1.p = instrs
@@ -1057,7 +1056,6 @@ FN_(mkApUpd0zh_fast)
   RET_P(ap);
   FE_
 }
-#endif
 
 /* -----------------------------------------------------------------------------
    Thread I/O blocking primitives

ghc/rts/Printer.c

 /* -----------------------------------------------------------------------------
- * $Id: Printer.c,v 1.35 2001/02/09 13:09:16 simonmar Exp $
+ * $Id: Printer.c,v 1.36 2001/02/11 17:51:08 simonmar Exp $
  *
  * (c) The GHC Team, 1994-2000.
  *
@@ -82,11 +82,9 @@ void printClosure( StgClosure *obj )
     switch ( get_itbl(obj)->type ) {
     case INVALID_OBJECT:
             barf("Invalid object");
-#ifdef GHCI
     case BCO:
             disassemble( (StgBCO*)obj );
             break;
-#endif
 
     case AP_UPD:
         {
@@ -345,7 +343,6 @@ StgPtr printStackObj( StgPtr sp )
     } else {
         StgClosure* c = (StgClosure*)(*sp);
         printPtr((StgPtr)*sp);
-#ifdef GHCI
         if (c == (StgClosure*)&stg_ctoi_ret_R1p_info) {
            fprintf(stderr, "\t\t\tstg_ctoi_ret_R1p_info\n" );
 	} else
@@ -358,7 +355,6 @@ StgPtr printStackObj( StgPtr sp )
         if (c == (StgClosure*)&stg_ctoi_ret_D1_info) {
            fprintf(stderr, "\t\t\tstg_ctoi_ret_D1_info\n" );
 	} else
-#endif
         if (get_itbl(c)->type == BCO) {
            fprintf(stderr, "\t\t\t");
            fprintf(stderr, "BCO(...)\n"); 

ghc/rts/RtsStartup.c

 /* -----------------------------------------------------------------------------
- * $Id: RtsStartup.c,v 1.48 2001/02/09 13:09:16 simonmar Exp $
+ * $Id: RtsStartup.c,v 1.49 2001/02/11 17:51:08 simonmar Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
@@ -22,11 +22,8 @@
 #include "StgRun.h"
 #include "StgStartup.h"
 #include "Prelude.h"		/* fixupRTStoPreludeRefs */
-
-#ifdef GHCI
 #include "HsFFI.h"
 #include "Linker.h"
-#endif
 
 #if defined(RTS_GTK_FRONTPANEL)
 #include "FrontPanel.h"
@@ -152,11 +149,6 @@ startupHaskell(int argc, char *argv[], void (*init_root)(void))
     /* initialize the storage manager */
     initStorage();
 
-    /* initialise the object linker, if necessary */
-#ifdef GHCI
-    initLinker();
-#endif
-
     /* initialise the stable pointer table */
     initStablePtrTable();
 

ghc/rts/Schedule.c

 /* ---------------------------------------------------------------------------
- * $Id: Schedule.c,v 1.89 2001/02/09 13:09:16 simonmar Exp $
+ * $Id: Schedule.c,v 1.90 2001/02/11 17:51:08 simonmar Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
@@ -877,25 +877,18 @@ schedule( void )
     switch (cap->rCurrentTSO->what_next) {
     case ThreadKilled:
     case ThreadComplete:
-      /* Thread already finished, return to scheduler. */
-      ret = ThreadFinished;
-      break;
+	/* Thread already finished, return to scheduler. */
+	ret = ThreadFinished;
+	break;
     case ThreadEnterGHC:
-      ret = StgRun((StgFunPtr) stg_enterStackTop, cap);
-      break;
+	ret = StgRun((StgFunPtr) stg_enterStackTop, cap);
+	break;
     case ThreadRunGHC:
-      ret = StgRun((StgFunPtr) stg_returnToStackTop, cap);
-      break;
+	ret = StgRun((StgFunPtr) stg_returnToStackTop, cap);
+	break;
     case ThreadEnterInterp:
-#ifdef GHCI
-      {
-	 IF_DEBUG(scheduler,sched_belch("entering interpreter"));
-	 ret = interpretBCO(cap);
-         break;
-      }
-#else
-      barf("Panic: entered a BCO but no bytecode interpreter in this build");
-#endif
+	ret = interpretBCO(cap);
+	break;
     default:
       barf("schedule: invalid what_next field");
     }

ghc/rts/StgMiscClosures.hc

 /* -----------------------------------------------------------------------------
- * $Id: StgMiscClosures.hc,v 1.63 2001/02/08 14:36:21 simonmar Exp $
+ * $Id: StgMiscClosures.hc,v 1.64 2001/02/11 17:51:08 simonmar Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
@@ -51,8 +51,6 @@ STGFUN(stg_##type##_entry)							\
    Support for the bytecode interpreter.
    -------------------------------------------------------------------------- */
 
-#ifdef GHCI
-
 /* 9 bits of return code for constructors created by the interpreter. */
 FN_(stg_interp_constr_entry) 
 { 
@@ -256,8 +254,6 @@ STGFUN(stg_BCO_entry) {
   FE_
 }
 
-#endif /* GHCI */
-
 
 /* -----------------------------------------------------------------------------
    Entry code for an indirection.

ghc/rts/Storage.c

 /* -----------------------------------------------------------------------------
- * $Id: Storage.c,v 1.35 2001/01/31 11:04:29 simonmar Exp $
+ * $Id: Storage.c,v 1.36 2001/02/11 17:51:08 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -249,7 +249,6 @@ newCAF(StgClosure* caf)
    */
   ACQUIRE_LOCK(&sm_mutex);
 
-#ifdef GHCI
   if (is_dynamically_loaded_rwdata_ptr((StgPtr)caf)) {
       ((StgIndStatic *)caf)->saved_info  = (StgInfoTable *)caf->header.info;
       ((StgIndStatic *)caf)->static_link = caf_list;
@@ -259,11 +258,6 @@ newCAF(StgClosure* caf)
       ((StgMutClosure *)caf)->mut_link = oldest_gen->mut_once_list;
       oldest_gen->mut_once_list = (StgMutClosure *)caf;
   }
-#else
-  ASSERT( ((StgMutClosure*)caf)->mut_link == NULL );
-  ((StgMutClosure *)caf)->mut_link = oldest_gen->mut_once_list;
-  oldest_gen->mut_once_list = (StgMutClosure *)caf;
-#endif
 
   RELEASE_LOCK(&sm_mutex);
 }

ghc/rts/Storage.h

 /* -----------------------------------------------------------------------------
- * $Id: Storage.h,v 1.28 2001/02/09 13:09:16 simonmar Exp $
+ * $Id: Storage.h,v 1.29 2001/02/11 17:51:08 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -81,11 +81,6 @@ extern void PleaseStopAllocating(void);
 extern void   GarbageCollect(void (*get_roots)(void),rtsBool force_major_gc);