From 9ac55e08e159d7a4647ab01e7872e69dd762f275 Mon Sep 17 00:00:00 2001
From: simonmar <unknown>
Date: Mon, 4 Dec 2000 12:31:23 +0000
Subject: [PATCH] [project @ 2000-12-04 12:31:19 by simonmar] merge recent
 changes from before-ghci-branch onto the HEAD

---
 ghc/compiler/absCSyn/CLabel.lhs      |    2 +-
 ghc/compiler/absCSyn/CallConv.lhs    |   25 ----
 ghc/compiler/nativeGen/MachCode.lhs  |   28 +++--
 ghc/compiler/nativeGen/StixPrim.lhs  |   11 +-
 ghc/compiler/prelude/primops.txt     |    9 +-
 ghc/compiler/simplCore/Simplify.lhs  |   38 ++++--
 ghc/compiler/simplStg/StgVarInfo.lhs |   14 ++-
 ghc/compiler/typecheck/Inst.lhs      |   10 +-
 ghc/driver/Makefile                  |    2 +-
 ghc/includes/Assembler.h             |    3 +-
 ghc/includes/ClosureMacros.h         |  174 +---------------------------
 ghc/includes/HsFFI.h                 |    2 +-
 ghc/includes/Linker.h                |   28 +++++
 ghc/includes/PrimOps.h               |   47 ++++++--
 ghc/includes/SchedAPI.h              |    2 +-
 ghc/includes/Stg.h                   |    4 +-
 ghc/includes/StgMacros.h             |    2 +-
 ghc/includes/StgMiscClosures.h       |    2 +-
 ghc/includes/Updates.h               |    2 +-
 ghc/lib/std/PrelGHC.hi-boot          |    2 +
 ghc/rts/Exception.h                  |    2 +-
 ghc/rts/Exception.hc                 |    2 +-
 ghc/rts/GC.c                         |   15 ++-
 ghc/rts/Hash.c                       |    2 +-
 ghc/rts/Hash.h                       |    2 +-
 ghc/rts/MBlock.c                     |   43 +------
 ghc/rts/MBlock.h                     |   41 ++++++-
 ghc/rts/PrimOps.hc                   |    2 +-
 ghc/rts/ProfHeap.c                   |    2 +-
 ghc/rts/RtsAPI.c                     |    2 +-
 ghc/rts/RtsFlags.c                   |    2 +-
 ghc/rts/RtsFlags.h                   |    2 +-
 ghc/rts/RtsStartup.c                 |    2 +-
 ghc/rts/Sanity.c                     |    4 +-
 ghc/rts/Schedule.c                   |    2 +-
 ghc/rts/Schedule.h                   |    2 +-
 ghc/rts/Stats.c                      |   10 +-
 ghc/rts/Stats.h                      |    4 +-
 ghc/rts/StgCRun.c                    |    8 +-
 ghc/rts/StgMiscClosures.hc           |   70 +++++------
 ghc/rts/StgStdThunks.hc              |    2 +-
 ghc/rts/Storage.c                    |    2 +-
 ghc/rts/Storage.h                    |  211 +++++++++++++++++++++++++++++++++-
 ghc/rts/StoragePriv.h                |   12 +-
 ghc/rts/Updates.hc                   |    2 +-
 ghc/rts/Weak.c                       |    2 +-
 46 files changed, 494 insertions(+), 363 deletions(-)
 create mode 100644 ghc/includes/Linker.h

diff --git a/ghc/compiler/absCSyn/CLabel.lhs b/ghc/compiler/absCSyn/CLabel.lhs
index 0b0825a..4bebe07 100644
--- a/ghc/compiler/absCSyn/CLabel.lhs
+++ b/ghc/compiler/absCSyn/CLabel.lhs
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: CLabel.lhs,v 1.43 2000/11/20 17:42:00 sewardj Exp $
+% $Id: CLabel.lhs,v 1.44 2000/12/04 12:31:19 simonmar Exp $
 %
 \section[CLabel]{@CLabel@: Information to make C Labels}
 
diff --git a/ghc/compiler/absCSyn/CallConv.lhs b/ghc/compiler/absCSyn/CallConv.lhs
index e38fc46..64e4f4a 100644
--- a/ghc/compiler/absCSyn/CallConv.lhs
+++ b/ghc/compiler/absCSyn/CallConv.lhs
@@ -14,7 +14,6 @@ module CallConv
        , cCallConv
        , defaultCallConv
        , callConvAttribute
-       , decorateExtName
        ) where
 
 #include "HsVersions.h"
@@ -58,27 +57,3 @@ callConvAttribute cc
  | otherwise	       = panic ("callConvAttribute: cannot handle" ++ showSDoc (pprCallConv cc))
 
 \end{code}
-
-For stdcall and Win32, the linker expects to see names of the form 
- 
-   "f@n"
-
-where n is the size (in 8-bit bytes) of the parameter area
-that is pushed onto the stack before invocation. We take
-care of mangling the function name here. 
-
-This name mangler is only used by the x86 native code generator.
-
-\begin{code}
-decorateExtName :: CallConv -> FAST_STRING -> [PrimRep] -> FAST_STRING
-decorateExtName cc fs ps
- | cc /= stdCallConv = fs
- | otherwise	     = fs _APPEND_ (_PK_ ('@':show (size::Int)))
- where
-  size = sum (map (adjustParamSize.getPrimRepSizeInBytes) ps)
-
-  adjustParamSize sz =  paramBoundary * ((sz + paramBoundary - 1) `div` paramBoundary)
-
-  paramBoundary = 4
-
-\end{code}
diff --git a/ghc/compiler/nativeGen/MachCode.lhs b/ghc/compiler/nativeGen/MachCode.lhs
index 8ff6ffe..a586a4a 100644
--- a/ghc/compiler/nativeGen/MachCode.lhs
+++ b/ghc/compiler/nativeGen/MachCode.lhs
@@ -24,7 +24,7 @@ import CLabel		( isAsmTemp, CLabel, labelDynamic )
 import Maybes		( maybeToBool, expectJust )
 import PrimRep		( isFloatingRep, PrimRep(..) )
 import PrimOp		( PrimOp(..) )
-import CallConv		( cCallConv )
+import CallConv		( cCallConv, stdCallConv )
 import Stix		( getNatLabelNCG, StixTree(..),
 			  StixReg(..), CodeSegment(..), 
                           DestInfo, hasDestInfo,
@@ -2339,11 +2339,14 @@ genCCall fn cconv kind args
     let (sizes, codes) = unzip sizes_n_codes
         tot_arg_size   = sum sizes
 	code2          = concatOL codes
-	call = toOL [
-                  CALL fn__2,
-		  ADD L (OpImm (ImmInt tot_arg_size)) (OpReg esp),
-                  DELTA (delta + tot_arg_size)
-               ]
+	call = toOL (
+                  [CALL (fn__2 tot_arg_size)]
+                  ++
+                  (if cconv == stdCallConv then [] else 
+		   [ADD L (OpImm (ImmInt tot_arg_size)) (OpReg esp)])
+                  ++
+                  [DELTA (delta + tot_arg_size)]
+               )
     in
     setDeltaNat (delta + tot_arg_size) `thenNat` \ _ ->
     returnNat (code2 `appOL` call)
@@ -2353,9 +2356,16 @@ genCCall fn cconv kind args
     -- internally generated names like '.mul,' which don't get an
     -- underscore prefix
     -- ToDo:needed (WDP 96/03) ???
-    fn__2 = case (_HEAD_ fn) of
-	      '.' -> ImmLit (ptext fn)
-	      _   -> ImmLab False (ptext fn)
+    fn_u  = _UNPK_ fn
+    fn__2 tot_arg_size
+       | head fn_u == '.'
+       = ImmLit (text (fn_u ++ stdcallsize tot_arg_size))
+       | otherwise 
+       = ImmLab False (text (fn_u ++ stdcallsize tot_arg_size))
+
+    stdcallsize tot_arg_size
+       | cconv == stdCallConv = '@':show tot_arg_size
+       | otherwise            = ""
 
     arg_size DF = 8
     arg_size F  = 4
diff --git a/ghc/compiler/nativeGen/StixPrim.lhs b/ghc/compiler/nativeGen/StixPrim.lhs
index ffca3c2..accb9fe 100644
--- a/ghc/compiler/nativeGen/StixPrim.lhs
+++ b/ghc/compiler/nativeGen/StixPrim.lhs
@@ -22,6 +22,7 @@ import Constants	( mIN_INTLIKE, mIN_CHARLIKE, uF_UPDATEE, bLOCK_SIZE,
 			  rESERVED_STACK_WORDS )
 import CLabel		( mkIntlikeClosureLabel, mkCharlikeClosureLabel,
 			  mkMAP_FROZEN_infoLabel, mkForeignLabel )
+import CallConv		( cCallConv )
 import Outputable
 import FastTypes
 
@@ -254,6 +255,10 @@ primCode ls WriteByteArrayOp_Word64    rs = primCode_WriteByteArrayOp Word64Rep
 
 ToDo: saving/restoring of volatile regs around ccalls.
 
+JRS, 001113: always do the call of suspendThread and resumeThread as a ccall
+rather than inheriting the calling convention of the thing which we're really
+calling.
+
 \begin{code}
 primCode lhs (CCallOp (CCall (StaticTarget fn) is_asm may_gc cconv)) rhs
   | is_asm = error "ERROR: Native code generator can't handle casm"
@@ -266,8 +271,10 @@ primCode lhs (CCallOp (CCall (StaticTarget fn) is_asm may_gc cconv)) rhs
 	   id  = StReg (StixTemp uniq IntRep)
 
     	   suspend = StAssign IntRep id 
-			(StCall SLIT("suspendThread") cconv IntRep [stgBaseReg])
-	   resume  = StCall SLIT("resumeThread") cconv VoidRep [id]
+			(StCall SLIT("suspendThread") {-no:cconv-} cCallConv
+                                IntRep [stgBaseReg])
+	   resume  = StCall SLIT("resumeThread") {-no:cconv-} cCallConv
+                            VoidRep [id]
 	in
 	returnUs (\xs -> save (suspend : ccall : resume : load xs))
 
diff --git a/ghc/compiler/prelude/primops.txt b/ghc/compiler/prelude/primops.txt
index fb3a522..592f818 100644
--- a/ghc/compiler/prelude/primops.txt
+++ b/ghc/compiler/prelude/primops.txt
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------
--- $Id: primops.txt,v 1.6 2000/11/07 15:21:40 simonmar Exp $
+-- $Id: primops.txt,v 1.7 2000/12/04 12:31:19 simonmar Exp $
 --
 -- Primitive Operations
 --
@@ -51,6 +51,13 @@ primop   IndexOffClosureOp_Ptr  "indexPtrOffClosure#"  GenPrimOp
 primop   IndexOffClosureOp_Word "indexWordOffClosure#"  GenPrimOp
    a -> Int# -> Word#
 
+primop   SetOffClosureOp_Ptr  "setPtrOffClosure#"  GenPrimOp
+   a -> Int# -> b -> (# a #)
+   with strictness = { \ arity -> StrictnessInfo [wwStrict, wwPrim, wwLazy] False }
+
+primop   SetOffClosureOp_Word "setWordOffClosure#"  GenPrimOp
+   a -> Int# -> Word# -> (# a #)
+   with strictness = { \ arity -> StrictnessInfo [wwStrict, wwPrim, wwPrim] False }
 
 ------------------------------------------------------------------------
 --- Addr#                                                            ---
diff --git a/ghc/compiler/simplCore/Simplify.lhs b/ghc/compiler/simplCore/Simplify.lhs
index 9f0c1a3..7af03dc 100644
--- a/ghc/compiler/simplCore/Simplify.lhs
+++ b/ghc/compiler/simplCore/Simplify.lhs
@@ -258,8 +258,8 @@ simplExprF (Note (SCC cc) e) cont
 simplExprF (Note InlineCall e) cont
   = simplExprF e (InlinePlease cont)
 
--- Comments about the InlineMe case 
--- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+--	 Comments about the InlineMe case 
+--	 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 -- Don't inline in the RHS of something that has an
 -- inline pragma.  But be careful that the InScopeEnv that
 -- we return does still have inlinings on!
@@ -275,17 +275,31 @@ simplExprF (Note InlineCall e) cont
 -- the specialised version of g when f is inlined at some call site
 -- (perhaps in some other module).
 
+-- It's also important not to inline a worker back into a wrapper.
+-- A wrapper looks like
+--	wraper = inline_me (\x -> ...worker... )
+-- Normally, the inline_me prevents the worker getting inlined into
+-- the wrapper (initially, the worker's only call site!).  But,
+-- if the wrapper is sure to be called, the strictness analyser will
+-- mark it 'demanded', so when the RHS is simplified, it'll get an ArgOf
+-- continuation.  That's why the keep_inline predicate returns True for
+-- ArgOf continuations.  It shouldn't do any harm not to dissolve the
+-- inline-me note under these circumstances
+
 simplExprF (Note InlineMe e) cont
-  = case cont of
-	Stop _ _ -> 	-- Totally boring continuation
-			-- Don't inline inside an INLINE expression
-		  setBlackList noInlineBlackList (simplExpr e)	`thenSmpl` \ e' ->
-		  rebuild (mkInlineMe e') cont
-
-	other  -> 	-- Dissolve the InlineMe note if there's
-			-- an interesting context of any kind to combine with
-			-- (even a type application -- anything except Stop)
-		  simplExprF e cont	
+  | keep_inline cont		-- Totally boring continuation
+  =				-- Don't inline inside an INLINE expression
+    setBlackList noInlineBlackList (simplExpr e)	`thenSmpl` \ e' ->
+    rebuild (mkInlineMe e') cont
+
+  | otherwise  	-- Dissolve the InlineMe note if there's
+		-- an interesting context of any kind to combine with
+		-- (even a type application -- anything except Stop)
+  = simplExprF e cont
+  where
+    keep_inline (Stop _ _)    = True		-- See notes above
+    keep_inline (ArgOf _ _ _) = True		-- about this predicate
+    keep_inline other	      = False
 
 -- A non-recursive let is dealt with by simplBeta
 simplExprF (Let (NonRec bndr rhs) body) cont
diff --git a/ghc/compiler/simplStg/StgVarInfo.lhs b/ghc/compiler/simplStg/StgVarInfo.lhs
index 624a89c..6ab1841 100644
--- a/ghc/compiler/simplStg/StgVarInfo.lhs
+++ b/ghc/compiler/simplStg/StgVarInfo.lhs
@@ -19,7 +19,8 @@ import VarEnv
 import Var
 import IdInfo		( ArityInfo(..), OccInfo(..) )
 import PrimOp		( PrimOp(..), ccallMayGC )
-import TysWiredIn       ( isForeignObjTy )
+import TysPrim		( foreignObjPrimTyCon )
+import Type		( splitTyConApp_maybe )
 import Maybes		( maybeToBool, orElse )
 import Name		( getOccName )
 import OccName		( occNameUserString )
@@ -414,9 +415,14 @@ call. This only an issue
 \begin{code}
 findLiveArgs :: StgLiveVars -> StgArg -> StgLiveVars
 findLiveArgs lvs (StgVarArg x) 
-   | isForeignObjTy (idType x) = extendVarSet lvs x
-   | otherwise		       = lvs
-findLiveArgs lvs arg	       = lvs
+   | isForeignObjPrimTy (idType x) = extendVarSet lvs x
+   | otherwise		           = lvs
+findLiveArgs lvs arg	           = lvs
+
+isForeignObjPrimTy ty
+   = case splitTyConApp_maybe ty of
+	Just (tycon, _) -> tycon == foreignObjPrimTyCon
+	Nothing		-> False
 \end{code}
 
 
diff --git a/ghc/compiler/typecheck/Inst.lhs b/ghc/compiler/typecheck/Inst.lhs
index 96bc7c1..6342259 100644
--- a/ghc/compiler/typecheck/Inst.lhs
+++ b/ghc/compiler/typecheck/Inst.lhs
@@ -60,7 +60,8 @@ import PprType	( pprPred )
 import Type	( Type, PredType(..), 
 		  isTyVarTy, mkDictTy, mkPredTy,
 		  splitForAllTys, splitSigmaTy, funArgTy,
-		  splitRhoTy, tyVarsOfType, tyVarsOfTypes, tyVarsOfPred,
+		  splitMethodTy, splitRhoTy,
+		  tyVarsOfType, tyVarsOfTypes, tyVarsOfPred,
 		  tidyOpenType, tidyOpenTypes
 		)
 import Subst	( emptyInScopeSet, mkSubst, mkInScopeSet,
@@ -355,9 +356,9 @@ newMethod orig id tys
     let
 	(tyvars, rho) = splitForAllTys (idType id)
 	rho_ty	      = substTy (mkTyVarSubst tyvars tys) rho
-	(theta, tau)  = splitRhoTy rho_ty
+	(pred, tau)  = splitMethodTy rho_ty
     in
-    newMethodWithGivenTy orig id tys theta tau	`thenNF_Tc` \ meth_inst ->
+    newMethodWithGivenTy orig id tys [pred] tau	`thenNF_Tc` \ meth_inst ->
     returnNF_Tc (unitLIE meth_inst, instToId meth_inst)
 
 instOverloadedFun orig v arg_tys theta tau
@@ -553,7 +554,8 @@ pprInst (Dict u pred loc) = pprPred pred <+> show_uniq u
 pprInst m@(Method u id tys theta tau loc)
   = hsep [ppr id, ptext SLIT("at"), 
 	  brackets (interppSP tys) {- ,
-	  ppr theta, ppr tau,
+	  ptext SLIT("theta"), ppr theta,
+	  ptext SLIT("tau"), ppr tau
 	  show_uniq u,
 	  ppr (instToId m) -}]
 
diff --git a/ghc/driver/Makefile b/ghc/driver/Makefile
index 0992da3..7476b38 100644
--- a/ghc/driver/Makefile
+++ b/ghc/driver/Makefile
@@ -1,5 +1,5 @@
 #-----------------------------------------------------------------------------
-# $Id: Makefile,v 1.46 2000/11/21 16:29:26 simonmar Exp $
+# $Id: Makefile,v 1.47 2000/12/04 12:31:20 simonmar Exp $
 #
 
 TOP=..
diff --git a/ghc/includes/Assembler.h b/ghc/includes/Assembler.h
index 270a6ee..e47a533 100644
--- a/ghc/includes/Assembler.h
+++ b/ghc/includes/Assembler.h
@@ -1,6 +1,5 @@
-
 /* -----------------------------------------------------------------------------
- * $Id: Assembler.h,v 1.19 2000/11/13 14:40:36 simonmar Exp $
+ * $Id: Assembler.h,v 1.20 2000/12/04 12:31:20 simonmar Exp $
  *
  * (c) The GHC Team 1994-1998.
  *
diff --git a/ghc/includes/ClosureMacros.h b/ghc/includes/ClosureMacros.h
index 30e3dc4..41d3fd8 100644
--- a/ghc/includes/ClosureMacros.h
+++ b/ghc/includes/ClosureMacros.h
@@ -1,5 +1,5 @@
 /* ----------------------------------------------------------------------------
- * $Id: ClosureMacros.h,v 1.28 2000/11/13 14:40:36 simonmar Exp $
+ * $Id: ClosureMacros.h,v 1.29 2000/12/04 12:31:20 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -21,15 +21,6 @@
 #endif
 
 /* -----------------------------------------------------------------------------
-   Fixed Header Size
-
-   The compiler tries to abstract away from the actual value of this
-   constant.
-   -------------------------------------------------------------------------- */
-
-#define _FHS  sizeof(StgHeader)
-
-/* -----------------------------------------------------------------------------
    Info tables are slammed up against the entry code, and the label
    for the info table is at the *end* of the table itself.  This
    inline function adjusts an info pointer to point to the beginning
@@ -89,169 +80,6 @@ static __inline__ StgFunPtr get_entry(const StgInfoTable *itbl) {
 #endif
 
 /* -----------------------------------------------------------------------------
-   Macros for distinguishing data pointers from code pointers
-   -------------------------------------------------------------------------- */
-/*
- * We use some symbols inserted automatically by the linker to decide
- * whether a pointer points to text, data, or user space.  These tests
- * assume that text is lower in the address space than data, which in
- * turn is lower than user allocated memory.  
- *
- * If this assumption is false (say on some strange architecture) then
- * the tests IS_CODE_PTR and IS_DATA_PTR below will need to be
- * modified (and that should be all that's necessary).
- *
- * _start      } start of read-only text space
- * _etext      } end   of read-only text space
- * _end } end of read-write data space 
- */
-extern StgFun start;
-
-extern void* TEXT_SECTION_END_MARKER_DECL;
-extern void* DATA_SECTION_END_MARKER_DECL;
-
-#if defined(INTERPRETER) || defined(GHCI)
-/* Take into account code sections in dynamically loaded object files. */
-#define IS_CODE_PTR(p) (  ((P_)(p) < (P_)&TEXT_SECTION_END_MARKER) \
-                       || is_dynamically_loaded_code_or_rodata_ptr((char *)p) )
-#define IS_DATA_PTR(p) ( ((P_)(p) >= (P_)&TEXT_SECTION_END_MARKER && \
-                          (P_)(p) < (P_)&DATA_SECTION_END_MARKER) \
-                       || is_dynamically_loaded_rwdata_ptr((char *)p) )
-#define IS_USER_PTR(p) ( ((P_)(p) >= (P_)&DATA_SECTION_END_MARKER) \
-                       && is_not_dynamically_loaded_ptr((char *)p) )
-#else
-#define IS_CODE_PTR(p) ((P_)(p) < (P_)&TEXT_SECTION_END_MARKER)
-#define IS_DATA_PTR(p) ((P_)(p) >= (P_)&TEXT_SECTION_END_MARKER && (P_)(p) < (P_)&DATA_SECTION_END_MARKER)
-#define IS_USER_PTR(p) ((P_)(p) >= (P_)&DATA_SECTION_END_MARKER)
-#endif
-
-
-#ifdef TEXT_BEFORE_HEAP
-# define HEAP_ALLOCED(x)  IS_USER_PTR(x)
-#else
-extern int is_heap_alloced(const void* x);
-# define HEAP_ALLOCED(x)  (is_heap_alloced(x))
-#endif
-
-/* When working with Win32 DLLs, static closures are identified by
-   being prefixed with a zero word. This is needed so that we can
-   distinguish between pointers to static closures and (reversed!)
-   info tables.
-
-   This 'scheme' breaks down for closure tables such as CHARLIKE,
-   so we catch these separately.
-   
-   LOOKS_LIKE_STATIC_CLOSURE() 
-       - discriminates between static closures and info tbls
-         (needed by LOOKS_LIKE_GHC_INFO() below - [Win32 DLLs only.])
-   LOOKS_LIKE_STATIC() 
-       - distinguishes between static and heap allocated data.
- */
-#if defined(ENABLE_WIN32_DLL_SUPPORT) && !defined(INTERPRETER)
-            /* definitely do not enable for mingw DietHEP */
-#define LOOKS_LIKE_STATIC(r) (!(HEAP_ALLOCED(r)))
-
-/* Tiresome predicates needed to check for pointers into the closure tables */
-#define IS_CHARLIKE_CLOSURE(p) \
-    ( (P_)(p) >= (P_)stg_CHARLIKE_closure && \
-      (char*)(p) <= ((char*)stg_CHARLIKE_closure + \
-                     (MAX_CHARLIKE-MIN_CHARLIKE) * sizeof(StgIntCharlikeClosure)) )
-#define IS_INTLIKE_CLOSURE(p) \
-    ( (P_)(p) >= (P_)stg_INTLIKE_closure && \
-      (char*)(p) <= ((char*)stg_INTLIKE_closure + \
-                     (MAX_INTLIKE-MIN_INTLIKE) * sizeof(StgIntCharlikeClosure)) )
-
-#define LOOKS_LIKE_STATIC_CLOSURE(r) (((*(((unsigned long *)(r))-1)) == 0) || IS_CHARLIKE_CLOSURE(r) || IS_INTLIKE_CLOSURE(r))
-#else
-#define LOOKS_LIKE_STATIC(r) IS_DATA_PTR(r)
-#define LOOKS_LIKE_STATIC_CLOSURE(r) IS_DATA_PTR(r)
-#endif
-
-
-/* -----------------------------------------------------------------------------
-   Macros for distinguishing infotables from closures.
-   
-   You'd think it'd be easy to tell an info pointer from a closure pointer:
-   closures live on the heap and infotables are in read only memory.  Right?
-   Wrong!  Static closures live in read only memory and Hugs allocates
-   infotables for constructors on the (writable) C heap.
-
-   ToDo: in the combined Hugs-GHC system, the following are but crude
-   approximations.  This absolutely has to be fixed.
-   -------------------------------------------------------------------------- */
-
-#ifdef INTERPRETER
-#  ifdef USE_MINIINTERPRETER
-     /* yoiks: one of the dreaded pointer equality tests */
-#    define IS_HUGS_CONSTR_INFO(info) \
-            (((StgInfoTable *)(info))->entry == (StgFunPtr)&Hugs_CONSTR_entry)
-#  else
-#    define IS_HUGS_CONSTR_INFO(info) 0 /* ToDo: more than mildly bogus */
-#  endif
-#else
-#  define IS_HUGS_CONSTR_INFO(info) 0 /* ToDo: more than mildly bogus */
-#endif
-
-#ifdef TEXT_BEFORE_HEAP /* needed for mingw DietHEP */
-# define LOOKS_LIKE_GHC_INFO(info) IS_CODE_PTR(info)
-#else
-#  define LOOKS_LIKE_GHC_INFO(info) (!HEAP_ALLOCED(info) \
-                                     && !LOOKS_LIKE_STATIC_CLOSURE(info))
-#endif
-
-/* -----------------------------------------------------------------------------
-   Macros for calculating how big a closure will be (used during allocation)
-   -------------------------------------------------------------------------- */
-
-/* ToDo: replace unsigned int by nat.  The only fly in the ointment is that
- * nat comes from Rts.h which many folk dont include.  Sigh!
- */
-static __inline__ StgOffset AP_sizeW    ( unsigned int n_args )              
-{ return sizeofW(StgAP_UPD) + n_args; }
-
-static __inline__ StgOffset PAP_sizeW   ( unsigned int n_args )              
-{ return sizeofW(StgPAP)    + n_args; }
-
-static __inline__ StgOffset CONSTR_sizeW( unsigned int p, unsigned int np )  
-{ return sizeofW(StgHeader) + p + np; }
-
-static __inline__ StgOffset BCO_sizeW   ( unsigned int p, unsigned int np, unsigned int is ) 
-{ return sizeofW(StgBCO) + p + np + (is+sizeof(StgWord)-1)/sizeof(StgWord); }
-
-static __inline__ StgOffset THUNK_SELECTOR_sizeW ( void )                    
-{ return sizeofW(StgHeader) + MIN_UPD_SIZE; }
-
-static __inline__ StgOffset BLACKHOLE_sizeW ( void )                    
-{ return sizeofW(StgHeader) + MIN_UPD_SIZE; }
-
-static __inline__ StgOffset CAF_sizeW ( void )                    
-{ return sizeofW(StgCAF); }
-
-/* --------------------------------------------------------------------------
- * Sizes of closures
- * ------------------------------------------------------------------------*/
-
-static __inline__ StgOffset sizeW_fromITBL( const StgInfoTable* itbl ) 
-{ return sizeofW(StgClosure) 
-       + sizeofW(StgPtr)  * itbl->layout.payload.ptrs 
-       + sizeofW(StgWord) * itbl->layout.payload.nptrs; }
-
-static __inline__ StgOffset pap_sizeW( StgPAP* x )
-{ return PAP_sizeW(x->n_args); }
-
-static __inline__ StgOffset arr_words_sizeW( StgArrWords* x )
-{ return sizeofW(StgArrWords) + x->words; }
-
-static __inline__ StgOffset mut_arr_ptrs_sizeW( StgMutArrPtrs* x )
-{ return sizeofW(StgMutArrPtrs) + x->ptrs; }
-
-static __inline__ StgWord bco_sizeW( StgBCO* bco )
-{ return BCO_sizeW(bco->n_ptrs,bco->n_words,bco->n_instrs); }
-
-static __inline__ StgWord tso_sizeW ( StgTSO *tso )
-{ return TSO_STRUCT_SIZEW + tso->stack_size; }
-
-/* -----------------------------------------------------------------------------
    Macros for building closures
    -------------------------------------------------------------------------- */
 
diff --git a/ghc/includes/HsFFI.h b/ghc/includes/HsFFI.h
index ebee19c..33b76ff 100644
--- a/ghc/includes/HsFFI.h
+++ b/ghc/includes/HsFFI.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: HsFFI.h,v 1.10 2000/11/14 14:47:23 simonmar Exp $
+ * $Id: HsFFI.h,v 1.11 2000/12/04 12:31:20 simonmar Exp $
  *
  * (c) The GHC Team, 2000
  *
diff --git a/ghc/includes/Linker.h b/ghc/includes/Linker.h
new file mode 100644
index 0000000..35b08ba
--- /dev/null
+++ b/ghc/includes/Linker.h
@@ -0,0 +1,28 @@
+/* -----------------------------------------------------------------------------
+ * $Id: Linker.h,v 1.2 2000/12/04 12:31:20 simonmar Exp $
+ *
+ * (c) The GHC Team, 2000
+ *
+ * RTS Object Linker
+ *
+ * ---------------------------------------------------------------------------*/
+
+#ifndef LINKER_H
+#define LINKER_H
+
+/* initialize the object linker */
+void initLinker( void );
+
+/* lookup a symbol in the hash table */
+void *lookupSymbol( char *lbl );
+
+/* delete an object from the pool */
+HsInt unloadObj( char *path );
+
+/* add an obj (populate the global symbol table, but don't resolve yet) */
+HsInt loadObj( char *path );
+
+/* resolve all the currently unlinked objects in memory */
+HsInt resolveObjs( void );
+
+#endif /* LINKER_H */
diff --git a/ghc/includes/PrimOps.h b/ghc/includes/PrimOps.h
index cf467a4..c4aa989 100644
--- a/ghc/includes/PrimOps.h
+++ b/ghc/includes/PrimOps.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: PrimOps.h,v 1.67 2000/11/13 14:40:36 simonmar Exp $
+ * $Id: PrimOps.h,v 1.68 2000/12/04 12:31:20 simonmar Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
@@ -29,18 +29,47 @@
         } while (again);                                                \
    } while (0)
 
-#define indexWordOffClosurezh(r,a,i)                                    \
-   do { StgClosure* tmp = (StgClosure*)(a);                             \
-        CHASE_INDIRECTIONS(tmp);                                        \
-        r = ((W_ *)tmp)[i];                                             \
+#define indexWordOffClosurezh(r,a,i)		\
+   do { StgClosure* tmp = (StgClosure*)(a);	\
+        CHASE_INDIRECTIONS(tmp);		\
+        r = ((P_)tmp)[i];			\
    } while (0)
 
-#define indexPtrOffClosurezh(r,a,i)                                     \
-   do { StgClosure* tmp = (StgClosure*)(a);                             \
-        CHASE_INDIRECTIONS(tmp);                                        \
-        r = ((P_ *)tmp)[i];                                             \
+#define indexDoubleOffClosurezh(r,a,i)		\
+   do { StgClosure* tmp = (StgClosure*)(a);	\
+        CHASE_INDIRECTIONS(tmp);		\
+        r = PK_DBL(((P_)tmp + i);		\
+   } while (0)
+
+#define indexPtrOffClosurezh(r,a,i)		\
+   do { StgClosure* tmp = (StgClosure*)(a);	\
+        CHASE_INDIRECTIONS(tmp);		\
+        r = ((P_ *)tmp)[i];			\
+   } while (0)					\
+
+#define setWordOffClosurezh(r,a,i,b)		\
+   do { StgClosure* tmp = (StgClosure*)(a);	\
+        CHASE_INDIRECTIONS(tmp);		\
+        ((P_)tmp)[i] = b;			\
+        r = (P_)tmp;				\
    } while (0)
 
+#define setDoubleOffClosurezh(r,a,i,b)		\
+   do { StgClosure* tmp = (StgClosure*)(a);	\
+        CHASE_INDIRECTIONS(tmp);		\
+        ASSIGN_DBL((P_)tmp + i, b);		\
+        r = (P_)tmp;				\
+   } while (0)
+
+#define setPtrOffClosurezh(r,a,i,b)		\
+   do { StgClosure* tmp = (StgClosure*)(a);	\
+        CHASE_INDIRECTIONS(tmp);		\
+        ((P_ *)tmp)[i] = b;			\
+        r = (P_)tmp;				\
+   } while (0)
+
+#else
+
 #endif
 
 /* -----------------------------------------------------------------------------
diff --git a/ghc/includes/SchedAPI.h b/ghc/includes/SchedAPI.h
index 6757a5e..809d53c 100644
--- a/ghc/includes/SchedAPI.h
+++ b/ghc/includes/SchedAPI.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: SchedAPI.h,v 1.11 2000/11/13 14:40:36 simonmar Exp $
+ * $Id: SchedAPI.h,v 1.12 2000/12/04 12:31:20 simonmar Exp $
  *
  * (c) The GHC Team 1998
  *
diff --git a/ghc/includes/Stg.h b/ghc/includes/Stg.h
index fca8f31..4c891b7 100644
--- a/ghc/includes/Stg.h
+++ b/ghc/includes/Stg.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Stg.h,v 1.33 2000/11/07 17:05:47 simonmar Exp $
+ * $Id: Stg.h,v 1.34 2000/12/04 12:31:20 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -213,6 +213,8 @@ typedef StgWord64       LW_;
 /* Runtime-system hooks */
 #include "Hooks.h"
 
+#include "HsFFI.h"
+
 /* Misc stuff without a home */
 DLL_IMPORT_RTS extern char **prog_argv;	/* so we can get at these from Haskell */
 DLL_IMPORT_RTS extern int    prog_argc;
diff --git a/ghc/includes/StgMacros.h b/ghc/includes/StgMacros.h
index 698e7d7..444a5c2 100644
--- a/ghc/includes/StgMacros.h
+++ b/ghc/includes/StgMacros.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: StgMacros.h,v 1.36 2000/11/13 14:40:36 simonmar Exp $
+ * $Id: StgMacros.h,v 1.37 2000/12/04 12:31:20 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
diff --git a/ghc/includes/StgMiscClosures.h b/ghc/includes/StgMiscClosures.h
index 1037838..5e87573 100644
--- a/ghc/includes/StgMiscClosures.h
+++ b/ghc/includes/StgMiscClosures.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: StgMiscClosures.h,v 1.22 2000/11/13 14:40:36 simonmar Exp $
+ * $Id: StgMiscClosures.h,v 1.23 2000/12/04 12:31:20 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
diff --git a/ghc/includes/Updates.h b/ghc/includes/Updates.h
index 8b5ff8e..77a18d1 100644
--- a/ghc/includes/Updates.h
+++ b/ghc/includes/Updates.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Updates.h,v 1.20 2000/11/13 14:40:36 simonmar Exp $
+ * $Id: Updates.h,v 1.21 2000/12/04 12:31:20 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
diff --git a/ghc/lib/std/PrelGHC.hi-boot b/ghc/lib/std/PrelGHC.hi-boot
index 52c6148..e64caba 100644
--- a/ghc/lib/std/PrelGHC.hi-boot
+++ b/ghc/lib/std/PrelGHC.hi-boot
@@ -343,6 +343,8 @@ __export PrelGHC
 
   indexPtrOffClosurezh
   indexWordOffClosurezh
+  setPtrOffClosurezh
+  setWordOffClosurezh
 
   reallyUnsafePtrEqualityzh
 
diff --git a/ghc/rts/Exception.h b/ghc/rts/Exception.h
index 3e150f9..da214d6 100644
--- a/ghc/rts/Exception.h
+++ b/ghc/rts/Exception.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Exception.h,v 1.3 2000/11/13 14:40:37 simonmar Exp $
+ * $Id: Exception.h,v 1.4 2000/12/04 12:31:20 simonmar Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
diff --git a/ghc/rts/Exception.hc b/ghc/rts/Exception.hc
index 688ef58..564420e 100644
--- a/ghc/rts/Exception.hc
+++ b/ghc/rts/Exception.hc
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Exception.hc,v 1.17 2000/11/14 12:53:29 simonmar Exp $
+ * $Id: Exception.hc,v 1.18 2000/12/04 12:31:20 simonmar Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
diff --git a/ghc/rts/GC.c b/ghc/rts/GC.c
index 4fa1d38..a732d6d 100644
--- a/ghc/rts/GC.c
+++ b/ghc/rts/GC.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: GC.c,v 1.89 2000/11/20 11:19:21 simonmar Exp $
+ * $Id: GC.c,v 1.90 2000/12/04 12:31:20 simonmar Exp $
  *
  * (c) The GHC Team 1998-1999
  *
@@ -37,6 +37,7 @@
 #include "Sanity.h"
 #include "GC.h"
 #include "BlockAlloc.h"
+#include "MBlock.h"
 #include "Main.h"
 #include "ProfHeap.h"
 #include "SchedAPI.h"
@@ -3459,6 +3460,18 @@ threadSqueezeStack(StgTSO *tso)
 #if (!defined(LAZY_BLACKHOLING)) && defined(DEBUG)
           fprintf(stderr,"Unexpected lazy BHing required at 0x%04x\n",(int)bh);
 #endif
+#ifdef DEBUG
+	  /* zero out the slop so that the sanity checker can tell
+	   * where the next closure is.
+	   */
+	  { 
+	      StgInfoTable *info = get_itbl(bh);
+	      nat np = info->layout.payload.ptrs, nw = info->layout.payload.nptrs, i;
+	      for (i = np; i < np + nw; i++) {
+		  ((StgClosure *)bh)->payload[i] = 0;
+	      }
+	  }
+#endif
 	  SET_INFO(bh,&stg_BLACKHOLE_info);
 	}
       }
diff --git a/ghc/rts/Hash.c b/ghc/rts/Hash.c
index e1cc0a3..876ba50 100644
--- a/ghc/rts/Hash.c
+++ b/ghc/rts/Hash.c
@@ -1,5 +1,5 @@
 /*-----------------------------------------------------------------------------
- * $Id: Hash.c,v 1.2 2000/10/06 15:34:29 simonmar Exp $
+ * $Id: Hash.c,v 1.3 2000/12/04 12:31:21 simonmar Exp $
  *
  * (c) The AQUA Project, Glasgow University, 1995-1998
  * (c) The GHC Team, 1999
diff --git a/ghc/rts/Hash.h b/ghc/rts/Hash.h
index a946bb9..7babfa0 100644
--- a/ghc/rts/Hash.h
+++ b/ghc/rts/Hash.h
@@ -1,5 +1,5 @@
 /*-----------------------------------------------------------------------------
- * $Id: Hash.h,v 1.3 2000/10/06 15:34:29 simonmar Exp $
+ * $Id: Hash.h,v 1.4 2000/12/04 12:31:21 simonmar Exp $
  *
  * (c) The GHC Team, 1999
  *
diff --git a/ghc/rts/MBlock.c b/ghc/rts/MBlock.c
index eae83d2..3c7fcaf 100644
--- a/ghc/rts/MBlock.c
+++ b/ghc/rts/MBlock.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: MBlock.c,v 1.18 2000/09/06 11:12:07 rrt Exp $
+ * $Id: MBlock.c,v 1.19 2000/12/04 12:31:21 simonmar Exp $
  *
  * (c) The GHC Team 1998-1999
  *
@@ -39,45 +39,6 @@
 #include <windows.h>
 #endif
 
-#if freebsd2_TARGET_OS || freebsd_TARGET_OS
-/* Executable is loaded from      0x0
- * Shared libraries are loaded at 0x2000000
- * Stack is at the top of the address space.  The kernel probably owns
- * 0x8000000 onwards, so we'll pick 0x5000000.
- */
-#define ASK_FOR_MEM_AT 0x50000000
-
-#elif netbsd_TARGET_OS
-/* NetBSD i386 shared libs are at 0x40000000
- */
-#define ASK_FOR_MEM_AT 0x50000000
-#elif openbsd_TARGET_OS
-#define ASK_FOR_MEM_AT 0x50000000
-#elif linux_TARGET_OS
-/* Any ideas?
- */
-#define ASK_FOR_MEM_AT 0x50000000
-
-#elif solaris2_TARGET_OS
-/* guess */
-#define ASK_FOR_MEM_AT 0x50000000
-
-#elif osf3_TARGET_OS
-/* guess */
-#define ASK_FOR_MEM_AT 0x50000000
-
-#elif hpux_TARGET_OS
-/* guess */
-#define ASK_FOR_MEM_AT 0x50000000
-
-#elif _WIN32
-/* doesn't matter, we use a reserve/commit algorithm */
-
-#else
-#error Dont know where to get memory from on this architecture
-/* ToDo: memory locations on other architectures */
-#endif
-
 lnat mblocks_allocated = 0;
 
 void *
@@ -90,7 +51,7 @@ getMBlock(void)
 void *
 getMBlocks(nat n)
 {
-  static caddr_t next_request = (caddr_t)ASK_FOR_MEM_AT;
+  static caddr_t next_request = (caddr_t)HEAP_BASE;
   caddr_t ret;
   lnat size = MBLOCK_SIZE * n;
  
diff --git a/ghc/rts/MBlock.h b/ghc/rts/MBlock.h
index fc23a1e..75ead18 100644
--- a/ghc/rts/MBlock.h
+++ b/ghc/rts/MBlock.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: MBlock.h,v 1.6 1999/05/04 10:19:16 sof Exp $
+ * $Id: MBlock.h,v 1.7 2000/12/04 12:31:21 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -15,3 +15,42 @@ extern int is_heap_alloced(const void* p);
 
 extern void * getMBlock(void);
 extern void * getMBlocks(nat n);
+
+#if freebsd2_TARGET_OS || freebsd_TARGET_OS
+/* Executable is loaded from      0x0
+ * Shared libraries are loaded at 0x2000000
+ * Stack is at the top of the address space.  The kernel probably owns
+ * 0x8000000 onwards, so we'll pick 0x5000000.
+ */
+#define HEAP_BASE 0x50000000
+
+#elif netbsd_TARGET_OS
+/* NetBSD i386 shared libs are at 0x40000000
+ */
+#define HEAP_BASE 0x50000000
+#elif openbsd_TARGET_OS
+#define HEAP_BASE 0x50000000
+#elif linux_TARGET_OS
+/* Any ideas?
+ */
+#define HEAP_BASE 0x50000000
+
+#elif solaris2_TARGET_OS
+/* guess */
+#define HEAP_BASE 0x50000000
+
+#elif osf3_TARGET_OS
+/* guess */
+#define HEAP_BASE 0x50000000
+
+#elif hpux_TARGET_OS
+/* guess */
+#define HEAP_BASE 0x50000000
+
+#elif _WIN32
+/* doesn't matter, we use a reserve/commit algorithm */
+
+#else
+#error Dont know where to get memory from on this architecture
+/* ToDo: memory locations on other architectures */
+#endif
diff --git a/ghc/rts/PrimOps.hc b/ghc/rts/PrimOps.hc
index 5b13303..f70d745 100644
--- a/ghc/rts/PrimOps.hc
+++ b/ghc/rts/PrimOps.hc
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: PrimOps.hc,v 1.59 2000/11/16 12:49:05 simonmar Exp $
+ * $Id: PrimOps.hc,v 1.60 2000/12/04 12:31:21 simonmar Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
diff --git a/ghc/rts/ProfHeap.c b/ghc/rts/ProfHeap.c
index 6792a11..4deb31f 100644
--- a/ghc/rts/ProfHeap.c
+++ b/ghc/rts/ProfHeap.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: ProfHeap.c,v 1.18 2000/11/13 14:40:37 simonmar Exp $
+ * $Id: ProfHeap.c,v 1.19 2000/12/04 12:31:21 simonmar Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
diff --git a/ghc/rts/RtsAPI.c b/ghc/rts/RtsAPI.c
index 765ace9..1cb0aee 100644
--- a/ghc/rts/RtsAPI.c
+++ b/ghc/rts/RtsAPI.c
@@ -1,5 +1,5 @@
 /* ----------------------------------------------------------------------------
- * $Id: RtsAPI.c,v 1.22 2000/11/13 14:40:37 simonmar Exp $
+ * $Id: RtsAPI.c,v 1.23 2000/12/04 12:31:21 simonmar Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
diff --git a/ghc/rts/RtsFlags.c b/ghc/rts/RtsFlags.c
index 3dc773f..01b2ec0 100644
--- a/ghc/rts/RtsFlags.c
+++ b/ghc/rts/RtsFlags.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: RtsFlags.c,v 1.33 2000/11/01 11:41:47 simonmar Exp $
+ * $Id: RtsFlags.c,v 1.34 2000/12/04 12:31:21 simonmar Exp $
  *
  * (c) The AQUA Project, Glasgow University, 1994-1997
  * (c) The GHC Team, 1998-1999
diff --git a/ghc/rts/RtsFlags.h b/ghc/rts/RtsFlags.h
index 192ac61..feef33b 100644
--- a/ghc/rts/RtsFlags.h
+++ b/ghc/rts/RtsFlags.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: RtsFlags.h,v 1.28 2000/11/01 11:41:47 simonmar Exp $
+ * $Id: RtsFlags.h,v 1.29 2000/12/04 12:31:21 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
diff --git a/ghc/rts/RtsStartup.c b/ghc/rts/RtsStartup.c
index 705f72a..7ec1216 100644
--- a/ghc/rts/RtsStartup.c
+++ b/ghc/rts/RtsStartup.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: RtsStartup.c,v 1.44 2000/11/01 11:41:47 simonmar Exp $
+ * $Id: RtsStartup.c,v 1.45 2000/12/04 12:31:21 simonmar Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
diff --git a/ghc/rts/Sanity.c b/ghc/rts/Sanity.c
index f147694..6cf9bc4 100644
--- a/ghc/rts/Sanity.c
+++ b/ghc/rts/Sanity.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Sanity.c,v 1.22 2000/11/13 14:40:37 simonmar Exp $
+ * $Id: Sanity.c,v 1.23 2000/12/04 12:31:21 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -499,7 +499,7 @@ checkHeap(bdescr *bd, StgPtr start)
 
 	/* skip over slop */
 	while (p < bd->free &&
-	       (*p == 0 || !LOOKS_LIKE_GHC_INFO((void*)*p))) { p++; } 
+	       (*p < 0x1000 || !LOOKS_LIKE_GHC_INFO((void*)*p))) { p++; } 
       }
       bd = bd->link;
       if (bd != NULL) {
diff --git a/ghc/rts/Schedule.c b/ghc/rts/Schedule.c
index 944b223..f0c6019 100644
--- a/ghc/rts/Schedule.c
+++ b/ghc/rts/Schedule.c
@@ -1,5 +1,5 @@
 /* ---------------------------------------------------------------------------
- * $Id: Schedule.c,v 1.82 2000/11/13 14:42:16 simonmar Exp $
+ * $Id: Schedule.c,v 1.83 2000/12/04 12:31:21 simonmar Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
diff --git a/ghc/rts/Schedule.h b/ghc/rts/Schedule.h
index ffcc04c..e7b51ba 100644
--- a/ghc/rts/Schedule.h
+++ b/ghc/rts/Schedule.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Schedule.h,v 1.20 2000/11/13 14:40:37 simonmar Exp $
+ * $Id: Schedule.h,v 1.21 2000/12/04 12:31:21 simonmar Exp $
  *
  * (c) The GHC Team 1998-1999
  *
diff --git a/ghc/rts/Stats.c b/ghc/rts/Stats.c
index d621192..f8768db 100644
--- a/ghc/rts/Stats.c
+++ b/ghc/rts/Stats.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Stats.c,v 1.21 2000/07/17 15:15:40 rrt Exp $
+ * $Id: Stats.c,v 1.22 2000/12/04 12:31:21 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -643,3 +643,11 @@ stat_describe_gens(void)
   }
   fprintf(stderr,"\n");
 }
+
+/* -----------------------------------------------------------------------------
+   Stats available via a programmatic interface, so eg. GHCi can time
+   each compilation and expression evaluation.
+   -------------------------------------------------------------------------- */
+
+extern HsInt getAllocations( void ) 
+{ return (HsInt)(total_allocated * sizeof(W_)); }
diff --git a/ghc/rts/Stats.h b/ghc/rts/Stats.h
index 7db318d..a5e1c8e 100644
--- a/ghc/rts/Stats.h
+++ b/ghc/rts/Stats.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Stats.h,v 1.8 1999/11/09 15:46:58 simonmar Exp $
+ * $Id: Stats.h,v 1.9 2000/12/04 12:31:21 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -25,3 +25,5 @@ extern void      initStats(void);
 extern void      stat_describe_gens(void);
 extern double    mut_user_time_during_GC(void);
 extern double    mut_user_time(void);
+
+extern HsInt     getAllocations( void );
diff --git a/ghc/rts/StgCRun.c b/ghc/rts/StgCRun.c
index 129cd23..be58430 100644
--- a/ghc/rts/StgCRun.c
+++ b/ghc/rts/StgCRun.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: StgCRun.c,v 1.22 2000/11/13 14:53:27 simonmar Exp $
+ * $Id: StgCRun.c,v 1.23 2000/12/04 12:31:21 simonmar Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
@@ -322,7 +322,11 @@ StgRun(StgFunPtr f, StgRegTable *basereg) {
 StgThreadReturnCode
 StgRun(StgFunPtr f, StgRegTable *basereg) {
 
-    StgChar space[RESERVED_C_STACK_BYTES];
+    unsigned char space[RESERVED_C_STACK_BYTES];
+#if 0
+    register void *i7 __asm__("%i7");
+    ((void **)(space))[100] = i7;
+#endif
     f();
     __asm__ volatile (
 	    ".align 4\n"		
diff --git a/ghc/rts/StgMiscClosures.hc b/ghc/rts/StgMiscClosures.hc
index 0d43ee9..99111f1 100644
--- a/ghc/rts/StgMiscClosures.hc
+++ b/ghc/rts/StgMiscClosures.hc
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: StgMiscClosures.hc,v 1.51 2000/11/14 12:49:57 simonmar Exp $
+ * $Id: StgMiscClosures.hc,v 1.52 2000/12/04 12:31:21 simonmar Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
@@ -78,12 +78,13 @@ FN_(stg_mci_constr8_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),7)); FE_ }
 /* Since this stuff is ostensibly in some other module, we need
    to supply an __init_ function.
 */
-EF_(__init_MCIzumakezuconstr);
+EXTFUN(__init_MCIzumakezuconstr);
 START_MOD_INIT(__init_MCIzumakezuconstr)
 END_MOD_INIT()
 
 
 INFO_TABLE(mci_make_constr_info,   mci_make_constr_entry,   0,0,FUN_STATIC,static,EF_,0,0);
+INFO_TABLE(mci_make_constr0_info,  mci_make_constr0_entry,  0,0,FUN_STATIC,static,EF_,0,0);
 INFO_TABLE(mci_make_constrI_info,  mci_make_constrI_entry,  0,0,FUN_STATIC,static,EF_,0,0);
 INFO_TABLE(mci_make_constrP_info,  mci_make_constrP_entry,  0,0,FUN_STATIC,static,EF_,0,0);
 INFO_TABLE(mci_make_constrPP_info, mci_make_constrPP_entry, 0,0,FUN_STATIC,static,EF_,0,0);
@@ -93,6 +94,10 @@ SET_STATIC_HDR(MCIzumakezuconstr_mcizumakezuconstr_closure,
                mci_make_constr_info,0,,EI_)
    ,{ /* payload */ }
 };
+SET_STATIC_HDR(MCIzumakezuconstr_mcizumakezuconstr0_closure,
+               mci_make_constr0_info,0,,EI_)
+   ,{ /* payload */ }
+};
 SET_STATIC_HDR(MCIzumakezuconstr_mcizumakezuconstrI_closure,
                mci_make_constrI_info,0,,EI_)
    ,{ /* payload */ }
@@ -112,7 +117,7 @@ SET_STATIC_HDR(MCIzumakezuconstr_mcizumakezuconstrPPP_closure,
 
 
 /* Make a constructor with no args. */
-STGFUN(mci_make_constr_entry)
+STGFUN(mci_make_constr0_entry)
 {
   nat size, np, nw;
   StgClosure* con;
@@ -221,7 +226,7 @@ STGFUN(mci_make_constrPP_entry)
     Sp = Sp +2; /* Zap the Addr# arg */
     R1.cl = con;
 
-    JMP_(ENTRY_CODE(GET_INFO(R1.cl)));
+    JMP_(GET_ENTRY(R1.cl));
   FE_
 }
 
@@ -235,35 +240,27 @@ STGFUN(mci_make_constrPPP_entry)
   FE_
 }
 
-#if 0
 /* It would be nice if this worked, but it doesn't.  Yet. */
 STGFUN(mci_make_constr_entry)
 {
-  nat size, np, nw_heap, nw_really, w;
+  nat size, np, nw_heap, nw_really, i;
   StgClosure* con;
   StgInfoTable* itbl;
-  W_* r;
   FB_
-    itbl      = ((StgInfoTable**)Sp)[0];
-STGCALL3(fprintf,stderr,"mmc: itbl = %d\n",itbl);
-
-STGCALL3(fprintf,stderr,"mmc: sp-4 = %d\n", ((W_*)Sp)[-4] );
-STGCALL3(fprintf,stderr,"mmc: sp-3 = %d\n", ((W_*)Sp)[-3] );
-STGCALL3(fprintf,stderr,"mmc: sp-2 = %d\n", ((W_*)Sp)[-2] );
-STGCALL3(fprintf,stderr,"mmc: sp-1 = %d\n", ((W_*)Sp)[-1] );
-STGCALL3(fprintf,stderr,"mmc: sp+0 = %d\n", ((W_*)Sp)[0] );
-STGCALL3(fprintf,stderr,"mmc: sp+1 = %d\n", ((W_*)Sp)[1] );
-STGCALL3(fprintf,stderr,"mmc: sp+2 = %d\n", ((W_*)Sp)[2] );
-STGCALL3(fprintf,stderr,"mmc: sp+3 = %d\n", ((W_*)Sp)[3] );
-STGCALL3(fprintf,stderr,"mmc: sp+4 = %d\n", ((W_*)Sp)[4] );
-    np        = itbl->layout.payload.ptrs;
-    nw_really = itbl->layout.payload.nptrs;
-    nw_heap   = stg_max(nw_really, MIN_NONUPD_SIZE-np);
+    /* Sp[0] should be the tag for the itbl */
+    itbl      = ((StgInfoTable**)Sp)[1];
+
+    np        = INFO_PTR_TO_STRUCT(itbl)->layout.payload.ptrs;
+    nw_really = INFO_PTR_TO_STRUCT(itbl)->layout.payload.nptrs;
+
+    nw_heap   = stg_max((int)nw_really, MIN_NONUPD_SIZE-np);
     size      = CONSTR_sizeW( np, nw_heap );
 
-    /* The total number of words to copy off the stack is np + nw.
-       That doesn't include tag words, tho.
-    */
+#if 0
+     fprintf(stderr, "np = %d, nw_really = %d, nw_heap = %d, size = %d\n",
+	    np, nw_really, nw_heap, size);
+#endif
+
     HP_CHK_GEN_TICKY(size, NO_PTRS, mci_make_constr_entry, );
     TICK_ALLOC_PRIM(sizeofW(StgHeader), size-sizeofW(StgHeader), 0);
     CCS_ALLOC(CCCS,size); /* ccs prof */
@@ -271,30 +268,17 @@ STGCALL3(fprintf,stderr,"mmc: sp+4 = %d\n", ((W_*)Sp)[4] );
     con = (StgClosure*)(Hp + 1 - size);
     SET_HDR(con, itbl,CCCS);
 
-    /* Copy into the closure. */
-    w = 0;
-    r = Sp+1;
-    while (1) {
-       if (w == np + nw) break;
-       ASSERT(w < np + nw);
-       if (IS_ARG_TAG(*r)) { 
-          nat n = *r++;
-          for (; n > 0; n--)
-             con->payload[w++] = (StgClosure*)(*r++);
-       } else {
-          con->payload[w++] = (StgClosure*)(*r++);
-       }
-       ASSERT((P_)r <= (P_)Su);
+    /* set the pointer fields */
+    for (i = 0; i < np; i++) {
+	con->payload[i] = &stg_dummy_ret_closure;
     }
 
-    /* Remove all the args we've used. */
-    Sp = r;
+    Sp += 2;
 
     R1.cl = con;
-    JMP_(ENTRY_CODE(R1.cl));
+    JMP_(GET_ENTRY(R1.cl));
   FE_
 }
-#endif
 
 #endif /* GHCI */
 
diff --git a/ghc/rts/StgStdThunks.hc b/ghc/rts/StgStdThunks.hc
index d25fcd5..befa414 100644
--- a/ghc/rts/StgStdThunks.hc
+++ b/ghc/rts/StgStdThunks.hc
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: StgStdThunks.hc,v 1.13 2000/11/14 12:51:51 simonmar Exp $
+ * $Id: StgStdThunks.hc,v 1.14 2000/12/04 12:31:21 simonmar Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
diff --git a/ghc/rts/Storage.c b/ghc/rts/Storage.c
index 382acd3..c126334 100644
--- a/ghc/rts/Storage.c
+++ b/ghc/rts/Storage.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Storage.c,v 1.28 2000/11/13 14:40:37 simonmar Exp $
+ * $Id: Storage.c,v 1.29 2000/12/04 12:31:22 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
diff --git a/ghc/rts/Storage.h b/ghc/rts/Storage.h
index aae36f4..5795c4f 100644
--- a/ghc/rts/Storage.h
+++ b/ghc/rts/Storage.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Storage.h,v 1.17 2000/11/13 14:40:37 simonmar Exp $
+ * $Id: Storage.h,v 1.18 2000/12/04 12:31:22 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -128,6 +128,7 @@ recordOldToNewPtrs(StgMutClosure *p)
   }
 }
 
+#ifndef DEBUG
 #define updateWithIndirection(info, p1, p2)				\
   {									\
     bdescr *bd;								\
@@ -135,18 +136,51 @@ recordOldToNewPtrs(StgMutClosure *p)
     bd = Bdescr((P_)p1);						\
     if (bd->gen->no == 0) {						\
       ((StgInd *)p1)->indirectee = p2;					\
-      SET_INFO(p1,&stg_IND_info);						\
+      SET_INFO(p1,&stg_IND_info);					\
       TICK_UPD_NEW_IND();						\
     } else {								\
       ((StgIndOldGen *)p1)->indirectee = p2;				\
-      if (info != &stg_BLACKHOLE_BQ_info) {					\
+      if (info != &stg_BLACKHOLE_BQ_info) {				\
         ((StgIndOldGen *)p1)->mut_link = bd->gen->mut_once_list;	\
         bd->gen->mut_once_list = (StgMutClosure *)p1;			\
       }									\
-      SET_INFO(p1,&stg_IND_OLDGEN_info);					\
+      SET_INFO(p1,&stg_IND_OLDGEN_info);				\
       TICK_UPD_OLD_IND();						\
     }									\
   }
+#else
+
+/* In the DEBUG case, we also zero out the slop of the old closure,
+ * so that the sanity checker can tell where the next closure is.
+ */
+#define updateWithIndirection(info, p1, p2)				\
+  {									\
+    bdescr *bd;								\
+									\
+    bd = Bdescr((P_)p1);						\
+    if (bd->gen->no == 0) {						\
+      ((StgInd *)p1)->indirectee = p2;					\
+      SET_INFO(p1,&stg_IND_info);					\
+      TICK_UPD_NEW_IND();						\
+    } else {								\
+      if (info != &stg_BLACKHOLE_BQ_info) {				\
+	{ 								\
+          StgInfoTable *inf = get_itbl(p1);				\
+	  nat np = inf->layout.payload.ptrs,				\
+	      nw = inf->layout.payload.nptrs, i;			\
+	  for (i = np; i < np + nw; i++) {				\
+	     ((StgClosure *)p1)->payload[i] = 0;			\
+          }								\
+        }								\
+        ((StgIndOldGen *)p1)->mut_link = bd->gen->mut_once_list;	\
+        bd->gen->mut_once_list = (StgMutClosure *)p1;			\
+      }									\
+      ((StgIndOldGen *)p1)->indirectee = p2;				\
+      SET_INFO(p1,&stg_IND_OLDGEN_info);				\
+      TICK_UPD_OLD_IND();						\
+    }									\
+  }
+#endif
 
 #if defined(TICKY_TICKY) || defined(PROFILING)
 static inline void
@@ -173,7 +207,6 @@ updateWithPermIndirection(const StgInfoTable *info, StgClosure *p1, StgClosure *
 
 /* -----------------------------------------------------------------------------
    The CAF table - used to let us revert CAFs
-
    -------------------------------------------------------------------------- */
 
 #if defined(INTERPRETER)
@@ -196,5 +229,173 @@ void printMutOnceList(generation *gen);
 void printMutableList(generation *gen);
 #endif DEBUG
 
+/* -----------------------------------------------------------------------------
+   Macros for distinguishing data pointers from code pointers
+   -------------------------------------------------------------------------- */
+/*
+ * We use some symbols inserted automatically by the linker to decide
+ * whether a pointer points to text, data, or user space.  These tests
+ * assume that text is lower in the address space than data, which in
+ * turn is lower than user allocated memory.  
+ *
+ * If this assumption is false (say on some strange architecture) then
+ * the tests IS_CODE_PTR and IS_DATA_PTR below will need to be
+ * modified (and that should be all that's necessary).
+ *
+ * _start      } start of read-only text space
+ * _etext      } end   of read-only text space
+ * _end } end of read-write data space 
+ */
+extern StgFun start;
+
+extern void* TEXT_SECTION_END_MARKER_DECL;
+extern void* DATA_SECTION_END_MARKER_DECL;
+
+#if defined(INTERPRETER) || defined(GHCI)
+/* Take into account code sections in dynamically loaded object files. */
+#define IS_CODE_PTR(p) (  ((P_)(p) < (P_)&TEXT_SECTION_END_MARKER) \
+                       || is_dynamically_loaded_code_or_rodata_ptr((char *)p) )
+#define IS_DATA_PTR(p) ( ((P_)(p) >= (P_)&TEXT_SECTION_END_MARKER && \
+                          (P_)(p) < (P_)&DATA_SECTION_END_MARKER) \
+                       || is_dynamically_loaded_rwdata_ptr((char *)p) )
+#define IS_USER_PTR(p) ( ((P_)(p) >= (P_)&DATA_SECTION_END_MARKER) \
+                       && is_not_dynamically_loaded_ptr((char *)p) )
+#else
+#define IS_CODE_PTR(p) ((P_)(p) < (P_)&TEXT_SECTION_END_MARKER)
+#define IS_DATA_PTR(p) ((P_)(p) >= (P_)&TEXT_SECTION_END_MARKER && (P_)(p) < (P_)&DATA_SECTION_END_MARKER)
+#define IS_USER_PTR(p) ((P_)(p) >= (P_)&DATA_SECTION_END_MARKER)
+#endif
+
+/* The HEAP_ALLOCED test below is called FOR EVERY SINGLE CLOSURE
+ * during GC.  It needs to be FAST.
+ */
+#ifdef TEXT_BEFORE_HEAP
+# define HEAP_ALLOCED(x)  ((StgPtr)(x) >= (StgPtr)(HEAP_BASE))
+#else
+extern int is_heap_alloced(const void* x);
+# define HEAP_ALLOCED(x)  (is_heap_alloced(x))
+#endif
+
+/* When working with Win32 DLLs, static closures are identified by
+   being prefixed with a zero word. This is needed so that we can
+   distinguish between pointers to static closures and (reversed!)
+   info tables.
+
+   This 'scheme' breaks down for closure tables such as CHARLIKE,
+   so we catch these separately.
+   
+   LOOKS_LIKE_STATIC_CLOSURE() 
+       - discriminates between static closures and info tbls
+         (needed by LOOKS_LIKE_GHC_INFO() below - [Win32 DLLs only.])
+   LOOKS_LIKE_STATIC() 
+       - distinguishes between static and heap allocated data.
+ */
+#if defined(ENABLE_WIN32_DLL_SUPPORT) && !defined(INTERPRETER)
+            /* definitely do not enable for mingw DietHEP */
+#define LOOKS_LIKE_STATIC(r) (!(HEAP_ALLOCED(r)))
+
+/* Tiresome predicates needed to check for pointers into the closure tables */
+#define IS_CHARLIKE_CLOSURE(p) \
+    ( (P_)(p) >= (P_)stg_CHARLIKE_closure && \
+      (char*)(p) <= ((char*)stg_CHARLIKE_closure + \
+                     (MAX_CHARLIKE-MIN_CHARLIKE) * sizeof(StgIntCharlikeClosure)) )
+#define IS_INTLIKE_CLOSURE(p) \
+    ( (P_)(p) >= (P_)stg_INTLIKE_closure && \
+      (char*)(p) <= ((char*)stg_INTLIKE_closure + \
+                     (MAX_INTLIKE-MIN_INTLIKE) * sizeof(StgIntCharlikeClosure)) )
+
+#define LOOKS_LIKE_STATIC_CLOSURE(r) (((*(((unsigned long *)(r))-1)) == 0) || IS_CHARLIKE_CLOSURE(r) || IS_INTLIKE_CLOSURE(r))
+#else
+#define LOOKS_LIKE_STATIC(r) IS_DATA_PTR(r)
+#define LOOKS_LIKE_STATIC_CLOSURE(r) IS_DATA_PTR(r)
+#endif
+
+
+/* -----------------------------------------------------------------------------
+   Macros for distinguishing infotables from closures.
+   
+   You'd think it'd be easy to tell an info pointer from a closure pointer:
+   closures live on the heap and infotables are in read only memory.  Right?
+   Wrong!  Static closures live in read only memory and Hugs allocates
+   infotables for constructors on the (writable) C heap.
+   -------------------------------------------------------------------------- */
+
+#ifdef INTERPRETER
+#  ifdef USE_MINIINTERPRETER
+     /* yoiks: one of the dreaded pointer equality tests */
+#    define IS_HUGS_CONSTR_INFO(info) \
+            (((StgInfoTable *)(info))->entry == (StgFunPtr)&Hugs_CONSTR_entry)
+#  else
+#    define IS_HUGS_CONSTR_INFO(info) 0 /* ToDo: more than mildly bogus */
+#  endif
+#elif GHCI
+   /* not accurate by any means, but stops the assertions failing... */
+#  define IS_HUGS_CONSTR_INFO(info)  IS_USER_PTR(info)
+#else
+#  define IS_HUGS_CONSTR_INFO(info) 0 /* ToDo: more than mildly bogus */
+#endif
+
+/* LOOKS_LIKE_GHC_INFO is called moderately often during GC, but
+ * Certainly not as often as HEAP_ALLOCED.
+ */
+#ifdef TEXT_BEFORE_HEAP /* needed for mingw DietHEP */
+# define LOOKS_LIKE_GHC_INFO(info) IS_CODE_PTR(info)
+#else
+# define LOOKS_LIKE_GHC_INFO(info) (!HEAP_ALLOCED(info) \
+                                    && !LOOKS_LIKE_STATIC_CLOSURE(info))
+#endif
+
+/* -----------------------------------------------------------------------------
+   Macros for calculating how big a closure will be (used during allocation)
+   -------------------------------------------------------------------------- */
+
+/* ToDo: replace unsigned int by nat.  The only fly in the ointment is that
+ * nat comes from Rts.h which many folk dont include.  Sigh!
+ */
+static __inline__ StgOffset AP_sizeW    ( unsigned int n_args )              
+{ return sizeofW(StgAP_UPD) + n_args; }
+
+static __inline__ StgOffset PAP_sizeW   ( unsigned int n_args )              
+{ return sizeofW(StgPAP)    + n_args; }
+
+static __inline__ StgOffset CONSTR_sizeW( unsigned int p, unsigned int np )  
+{ return sizeofW(StgHeader) + p + np; }
+
+static __inline__ StgOffset BCO_sizeW   ( unsigned int p, unsigned int np, unsigned int is ) 
+{ return sizeofW(StgBCO) + p + np + (is+sizeof(StgWord)-1)/sizeof(StgWord); }
+
+static __inline__ StgOffset THUNK_SELECTOR_sizeW ( void )                    
+{ return sizeofW(StgHeader) + MIN_UPD_SIZE; }
+
+static __inline__ StgOffset BLACKHOLE_sizeW ( void )                    
+{ return sizeofW(StgHeader) + MIN_UPD_SIZE; }
+
+static __inline__ StgOffset CAF_sizeW ( void )                    
+{ return sizeofW(StgCAF); }
+
+/* --------------------------------------------------------------------------
+ * Sizes of closures
+ * ------------------------------------------------------------------------*/
+
+static __inline__ StgOffset sizeW_fromITBL( const StgInfoTable* itbl ) 
+{ return sizeofW(StgClosure) 
+       + sizeofW(StgPtr)  * itbl->layout.payload.ptrs 
+       + sizeofW(StgWord) * itbl->layout.payload.nptrs; }
+
+static __inline__ StgOffset pap_sizeW( StgPAP* x )
+{ return PAP_sizeW(x->n_args); }
+
+static __inline__ StgOffset arr_words_sizeW( StgArrWords* x )
+{ return sizeofW(StgArrWords) + x->words; }
+
+static __inline__ StgOffset mut_arr_ptrs_sizeW( StgMutArrPtrs* x )
+{ return sizeofW(StgMutArrPtrs) + x->ptrs; }
+
+static __inline__ StgWord bco_sizeW( StgBCO* bco )
+{ return BCO_sizeW(bco->n_ptrs,bco->n_words,bco->n_instrs); }
+
+static __inline__ StgWord tso_sizeW ( StgTSO *tso )
+{ return TSO_STRUCT_SIZEW + tso->stack_size; }
+
 #endif STORAGE_H
 
diff --git a/ghc/rts/StoragePriv.h b/ghc/rts/StoragePriv.h
index e2b0120..bcd221c 100644
--- a/ghc/rts/StoragePriv.h
+++ b/ghc/rts/StoragePriv.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: StoragePriv.h,v 1.12 2000/11/13 14:40:37 simonmar Exp $
+ * $Id: StoragePriv.h,v 1.13 2000/12/04 12:31:22 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -71,4 +71,14 @@ extern void memInventory(void);
 extern void checkSanity(nat N);
 #endif
 
+/* 
+ * These three are used by the garbage collector when we have
+ * dynamically-linked object modules.  (see ClosureMacros.h,
+ * IS_CODE_PTR etc.). 
+ * Defined in Linker.c.
+ */
+int is_dynamically_loaded_code_or_rodata_ptr ( char* p );
+int is_dynamically_loaded_rwdata_ptr ( char* p );
+int is_not_dynamically_loaded_ptr ( char* p );
+
 #endif /* STORAGEPRIV_H */
diff --git a/ghc/rts/Updates.hc b/ghc/rts/Updates.hc
index 4e3b046..39c1c28 100644
--- a/ghc/rts/Updates.hc
+++ b/ghc/rts/Updates.hc
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Updates.hc,v 1.30 2000/11/14 12:47:38 simonmar Exp $
+ * $Id: Updates.hc,v 1.31 2000/12/04 12:31:22 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
diff --git a/ghc/rts/Weak.c b/ghc/rts/Weak.c
index 7cbf989..91a2fc0 100644
--- a/ghc/rts/Weak.c
+++ b/ghc/rts/Weak.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Weak.c,v 1.16 2000/11/13 14:40:37 simonmar Exp $
+ * $Id: Weak.c,v 1.17 2000/12/04 12:31:22 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
-- 
1.7.10.4