[project @ 2000-12-04 12:31:19 by simonmar]

merge recent changes from before-ghci-branch onto the HEAD

ghc/compiler/absCSyn/CLabel.lhs

 %
 % (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}
 

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}

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

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))
 

ghc/compiler/prelude/primops.txt

 -----------------------------------------------------------------------
--- $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#                                                            ---

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

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}
 
 

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) -}]
 

ghc/driver/Makefile

 #-----------------------------------------------------------------------------
-# $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=..

ghc/includes/Assembler.h

-
 /* -----------------------------------------------------------------------------
- * $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.
  *

ghc/includes/ClosureMacros.h

 /* ----------------------------------------------------------------------------
- * $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
  *
@@ -20,15 +20,6 @@
 #define TEXT_BEFORE_HEAP 1
 #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
@@ -88,169 +79,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
    -------------------------------------------------------------------------- */

ghc/includes/HsFFI.h

 /* -----------------------------------------------------------------------------
- * $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
  *

ghc/includes/Linker.h

+/* -----------------------------------------------------------------------------
+ * $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 */

ghc/includes/PrimOps.h

 /* -----------------------------------------------------------------------------
- * $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
 
 /* -----------------------------------------------------------------------------

ghc/includes/SchedAPI.h

 /* -----------------------------------------------------------------------------
- * $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
  *

ghc/includes/Stg.h

 /* -----------------------------------------------------------------------------
- * $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;

ghc/includes/StgMacros.h

 /* -----------------------------------------------------------------------------
- * $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
  *

ghc/includes/StgMiscClosures.h

 /* -----------------------------------------------------------------------------
- * $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
  *

ghc/includes/Updates.h

 /* -----------------------------------------------------------------------------
- * $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
  *

ghc/lib/std/PrelGHC.hi-boot

@@ -343,6 +343,8 @@ __export PrelGHC
 
   indexPtrOffClosurezh
   indexWordOffClosurezh
+  setPtrOffClosurezh
+  setWordOffClosurezh
 
   reallyUnsafePtrEqualityzh