Commit 6d35596c authored by simonmar's avatar simonmar

[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.
parent 57d614b4
/* ----------------------------------------------------------------------------
* $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 {
......
/* -----------------------------------------------------------------------------
* $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);
......
......@@ -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 */
/* -----------------------------------------------------------------------------
* $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 );
......
/* -----------------------------------------------------------------------------
* $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.
......
......@@ -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 */
/* -----------------------------------------------------------------------------
* $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 */
/* -----------------------------------------------------------------------------
* $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);
}
/* -----------------------------------------------------------------------------
* $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;
/* -----------------------------------------------------------------------------
* $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
......
/* -----------------------------------------------------------------------------
* $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");
......
/* -----------------------------------------------------------------------------
* $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();
......
/* ---------------------------------------------------------------------------
* $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");
}
......
/* -----------------------------------------------------------------------------
* $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.
......
/* -----------------------------------------------------------------------------
* $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);
}
......
/* -----------------------------------------------------------------------------
* $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);