[project @ 2004-04-05 10:53:52 by simonpj]

[ghc-hetmet.git] / ghc / compiler / codeGen / ClosureInfo.lhs
diff --git a/ghc/compiler/codeGen/ClosureInfo.lhs b/ghc/compiler/codeGen/ClosureInfo.lhs

index 1e438e3..86380ec 100644 (file)
--- a/ghc/compiler/codeGen/ClosureInfo.lhs
+++ b/ghc/compiler/codeGen/ClosureInfo.lhs
@@ -1,5 +1,7 @@
-
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
+%
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+%
+% $Id: ClosureInfo.lhs,v 1.62 2004/03/31 15:23:17 simonmar Exp $
  %
  \section[ClosureInfo]{Data structures which describe closures}
  
  %
  \section[ClosureInfo]{Data structures which describe closures}
  
@@ -9,22 +11,20 @@ the STG paper.
  \begin{code}
  module ClosureInfo (
         ClosureInfo, LambdaFormInfo, SMRep,     -- all abstract
  \begin{code}
  module ClosureInfo (
         ClosureInfo, LambdaFormInfo, SMRep,     -- all abstract
-       StandardFormInfo,
+       StandardFormInfo, ArgDescr(..),
  
  
-       EntryConvention(..),
+       CallingConvention(..),
  
  
-       mkClosureLFInfo, mkConLFInfo, mkSelectorLFInfo, mkVapLFInfo,
-       mkLFImported, mkLFArgument, mkLFLetNoEscape,
-       UpdateFlag,
+       mkClosureLFInfo, mkConLFInfo, mkSelectorLFInfo,
+       mkApLFInfo, mkLFImported, mkLFArgument, mkLFLetNoEscape,
  
  
-       closureSize, closureHdrSize,
-       closureNonHdrSize, closureSizeWithoutFixedHdr,
+       closureSize, closureNonHdrSize,
         closureGoodStuffSize, closurePtrsSize,
         closureGoodStuffSize, closurePtrsSize,
-       slopSize, fitsMinUpdSize,
+       slopSize,
  
  
-       layOutDynClosure, layOutDynCon, layOutStaticClosure,
-       layOutStaticNoFVClosure, layOutPhantomClosure,
-       mkVirtHeapOffsets,
+       layOutDynClosure, layOutStaticClosure, layOutStaticNoFVClosure,
+       layOutDynConstr, layOutStaticConstr,
+       mkVirtHeapOffsets, mkStaticClosure,
  
         nodeMustPointToIt, getEntryConvention, 
         FCode, CgInfoDownwards, CgState, 
  
         nodeMustPointToIt, getEntryConvention, 
         FCode, CgInfoDownwards, CgState, 
@@ -32,240 +32,102 @@ module ClosureInfo (
         blackHoleOnEntry,
  
         staticClosureRequired,
         blackHoleOnEntry,
  
         staticClosureRequired,
-       slowFunEntryCodeRequired, funInfoTableRequired,
-       stdVapRequired, noUpdVapRequired,
-       StgBinderInfo,
  
  
-       closureId, infoTableLabelFromCI, fastLabelFromCI,
-       closureLabelFromCI,
+       closureName, infoTableLabelFromCI,
+       closureLabelFromCI, closureSRT,
         entryLabelFromCI, 
         closureLFInfo, closureSMRep, closureUpdReqd,
         entryLabelFromCI, 
         closureLFInfo, closureSMRep, closureUpdReqd,
-       closureSingleEntry, closureSemiTag, closureType,
-       closureReturnsUnpointedType, getStandardFormThunkInfo,
-       GenStgArg,
+       closureSingleEntry, closureReEntrant, closureSemiTag,
+       closureFunInfo, isStandardFormThunk,
  
         isToplevClosure,
  
         isToplevClosure,
-       closureKind, closureTypeDescr,          -- profiling
+       closureTypeDescr,               -- profiling
+
+       isStaticClosure,
+       allocProfilingMsg,
+       cafBlackHoleClosureInfo, seCafBlackHoleClosureInfo,
  
  
-       isStaticClosure, allocProfilingMsg,
-       blackHoleClosureInfo,
-       maybeSelectorInfo,
+       staticClosureNeedsLink,
  
  
-       dataConLiveness                         -- concurrency
+       mkInfoTable, mkRetInfoTable, mkVecInfoTable,
      ) where
  
      ) where
  
+#include "../includes/config.h"
+#include "../includes/MachDeps.h"
  #include "HsVersions.h"
  
  #include "HsVersions.h"
  
-import AbsCSyn         ( MagicId, node, mkLiveRegsMask,
-                         {- GHC 0.29 only -} AbstractC, CAddrMode
-                       )
+import AbsCSyn         
  import StgSyn
  import CgMonad
  
  import StgSyn
  import CgMonad
  
-import Constants       ( mIN_UPD_SIZE, mIN_SIZE_NonUpdHeapObject,
-                         mAX_SPEC_ALL_PTRS, mAX_SPEC_MIXED_FIELDS,
-                         mAX_SPEC_ALL_NONPTRS,
-                         oTHER_TAG
-                       )
-import CgRetConv       ( assignRegs, dataReturnConvAlg,
-                         DataReturnConvention(..)
-                       )
-import CLabel          ( CLabel, mkStdEntryLabel, mkFastEntryLabel,
-                         mkPhantomInfoTableLabel, mkInfoTableLabel,
-                         mkConInfoTableLabel, mkStaticClosureLabel, 
-                         mkBlackHoleInfoTableLabel, mkVapInfoTableLabel,
-                         mkStaticInfoTableLabel, mkStaticConEntryLabel,
-                         mkConEntryLabel, mkClosureLabel, mkVapEntryLabel
-                       )
-import CmdLineOpts     ( opt_SccProfilingOn, opt_ForConcurrent )
-import HeapOffs                ( intOff, addOff, totHdrSize, varHdrSize,
-                         VirtualHeapOffset, HeapOffset
+import Constants       ( mIN_UPD_SIZE, mIN_SIZE_NonUpdHeapObject )
+import CgRetConv       ( assignRegs )
+import CLabel
+import CmdLineOpts     ( opt_SccProfilingOn, opt_OmitBlackHoling,
+                         opt_Parallel, opt_DoTickyProfiling,
+                         opt_SMP, opt_Unregisterised )
+import Id              ( Id, idType, idArity, idName, idPrimRep )
+import DataCon         ( DataCon, dataConTag, fIRST_TAG, dataConTyCon,
+                         isNullaryDataCon, dataConName
                         )
                         )
-import Id              ( idType, getIdArity,
-                         externallyVisibleId,
-                         dataConTag, fIRST_TAG,
-                         isDataCon, isNullaryDataCon, dataConTyCon,
-                         isTupleCon, DataCon,
-                         GenId{-instance Eq-}, Id
-                       )
-import IdInfo          ( ArityInfo(..) )
-import Maybes          ( maybeToBool )
-import Name            ( getOccString )
-import PprType         ( getTyDescription )
-import PrelInfo                ( maybeCharLikeCon, maybeIntLikeCon )
-import PrimRep         ( getPrimRepSize, separateByPtrFollowness, PrimRep )
+import Name            ( Name, nameUnique, getOccName, getName, getOccString )
+import OccName         ( occNameUserString )
+import PrimRep
  import SMRep           -- all of it
  import SMRep           -- all of it
-import TyCon           ( TyCon, isNewTyCon )
-import Type            ( isUnpointedType, splitForAllTys, splitFunTys, mkFunTys,
-                         splitAlgTyConApp_maybe, applyTys,
-                         Type
-                       )
-import Util            ( isIn, mapAccumL )
+import Type            ( isUnLiftedType, Type, repType, splitTyConApp_maybe )
+import TcType          ( tcSplitSigmaTy )
+import TyCon           ( isFunTyCon, isAbstractTyCon )
+import BasicTypes      ( TopLevelFlag(..), isNotTopLevel, isTopLevel, ipNameName )
+import Util            ( mapAccumL, listLengthCmp, lengthIs )
+import FastString
  import Outputable
  import Outputable
-\end{code}
+import Literal
+import Constants
+import Bitmap
  
  
-The ``wrapper'' data type for closure information:
+import Maybe           ( isJust )
+import DATA_BITS
  
  
-\begin{code}
-data ClosureInfo
-  = MkClosureInfo
-       Id                      -- The thing bound to this closure
-       LambdaFormInfo          -- info derivable from the *source*
-       SMRep                   -- representation used by storage manager
+import TypeRep -- TEMP
  \end{code}
  
  %************************************************************************
  %*                                                                     *
  \end{code}
  
  %************************************************************************
  %*                                                                     *
-\subsection[ClosureInfo-OLD-DOC]{OLD DOCUMENTATION PROBABLY SUPERCEDED BY stg-details}
+\subsection[ClosureInfo-datatypes]{Data types for closure information}
  %*                                                                     *
  %************************************************************************
  
  %*                                                                     *
  %************************************************************************
  
-We can optimise the function-entry code as follows.
-\begin{itemize}
-
-\item  If the ``function'' is not updatable, we can jump directly to its
-       entry code, rather than indirecting via the info pointer in the
-       closure.  (For updatable thunks we must go via the closure, in
-       case it has been updated.)
-
-\item  If the former bullet applies, and the application we are
-       compiling gives the function as many arguments as it needs, we
-       can jump to its fast-entry code.  (This only applies if the
-       function has one or more args, because zero-arg closures have
-       no fast-entry code.)
-
-\item  If the function is a top-level non-constructor or imported, there
-       is no need to make Node point to its closure.  In order for
-       this to be right, we need to ensure that:
-       \begin{itemize}
-       \item   If such closures are updatable then they push their
-               static address in the update frame, not Node. Actually
-               we create a black hole and push its address.
-
-       \item   The arg satisfaction check should load Node before jumping to
-               UpdatePAP.
-
-       \item   Top-level constructor closures need careful handling.  If we are to
-               jump direct to the constructor code, we must load Node first, even
-               though they are top-level.  But if we go to their ``own''
-               standard-entry code (which loads Node and then jumps to the
-               constructor code) we don't need to load Node.
-       \end{itemize}
-\end{itemize}
-
-
-{\em Top level constructors (@mkStaticConEntryInfo@)}
-
-\begin{verbatim}
-       x = {y,ys} \ {} Cons {y,ys}     -- Std form constructor
-\end{verbatim}
-
-x-closure: Cons-info-table, y-closure, ys-closure
-
-x-entry: Node = x-closure; jump( Cons-entry )
-
-x's EntryInfo in its own module:
-\begin{verbatim}
-               Base-label = Cons               -- Not x!!
-               NodeMustPoint = True
-               ClosureClass = Constructor
-\end{verbatim}
-
-       So if x is entered, Node will be set up and
-       we'll jump direct to the Cons code.
-
-x's EntryInfo in another module: (which may not know that x is a constructor)
-\begin{verbatim}
-               Base-label = x                  -- Is x!!
-               NodeMustPoint = False           -- All imported things have False
-               ClosureClass = non-committal
-\end{verbatim}
-
-       If x is entered, we'll jump to x-entry, which will set up Node
-       before jumping to the standard Cons code
-
-{\em Top level non-constructors (@mkStaticEntryInfo@)}
-\begin{verbatim}
-       x = ...
-\end{verbatim}
+Information about a closure, from the code generator's point of view.
  
  
-For updatable thunks, x-entry must push an allocated BH in update frame, not Node.
+A ClosureInfo decribes the info pointer of a closure.  It has
+enough information 
+  a) to construct the info table itself
+  b) to allocate a closure containing that info pointer (i.e.
+       it knows the info table label)
  
  
-For non-zero arity, arg satis check must load Node before jumping to
-       UpdatePAP.
+We make a ClosureInfo for
+       - each let binding (both top level and not)
+       - each data constructor (for its shared static and
+               dynamic info tables)
  
  
-x's EntryInfo in its own module:
-\begin{verbatim}
-               Base-label = x
-               NodeMustPoint = False
-               ClosureClass = whatever
-\end{verbatim}
-
-{\em Inner constructors (@mkConEntryInfo@)}
-
-\begin{verbatim}
-               Base-label = Cons               -- Not x!!
-               NodeMustPoint = True            -- If its arity were zero, it would
-                                               -- have been lifted to top level
-               ClosureClass = Constructor
-\end{verbatim}
-
-{\em Inner non-constructors (@mkEntryInfo@)}
-
-\begin{verbatim}
-               Base-label = x
-               NodeMustPoint = True            -- If no free vars, would have been
-                                               -- lifted to top level
-               ClosureClass = whatever
-\end{verbatim}
-
-{\em Imported}
-
-\begin{verbatim}
-               Nothing,
-       or
-               Base-label = x
-               NodeMustPoint = False
-               ClosureClass = whatever
-\end{verbatim}
-
-==============
-THINK: we could omit making Node point to top-level constructors
-of arity zero; but that might interact nastily with updates.
-==============
-
-
-==========
-The info we need to import for imported things is:
-
-\begin{verbatim}
-       data ImportInfo = UnknownImportInfo
-                       | HnfImport Int         -- Not updatable, arity given
-                                               -- Arity can be zero, for (eg) constrs
-                       | UpdatableImport       -- Must enter via the closure
-\end{verbatim}
-
-ToDo: move this stuff???
-
-\begin{pseudocode}
-mkStaticEntryInfo lbl cl_class
-  = MkEntryInfo lbl False cl_class
-
-mkStaticConEntryInfo lbl
-  = MkEntryInfo lbl True ConstructorClosure
-
-mkEntryInfo lbl cl_class
-  = MkEntryInfo lbl True cl_class
-
-mkConEntryInfo lbl
-  = MkEntryInfo lbl True ConstructorClosure
-\end{pseudocode}
-
-%************************************************************************
-%*                                                                     *
-\subsection[ClosureInfo-datatypes]{Data types for closure information}
-%*                                                                     *
-%************************************************************************
+\begin{code}
+data ClosureInfo
+  = ClosureInfo {
+       closureName   :: !Name,           -- The thing bound to this closure
+       closureLFInfo :: !LambdaFormInfo, -- NOTE: not an LFCon (see below)
+       closureSMRep  :: !SMRep,          -- representation used by storage mgr
+       closureSRT    :: !C_SRT,          -- What SRT applies to this closure
+       closureType   :: !Type,           -- Type of closure (ToDo: remove)
+       closureDescr  :: !String          -- closure description (for profiling)
+    }
+
+  -- constructor closures don't have a unique info table label (they use
+  -- the constructor's info table), and they don't have an SRT.
+  | ConInfo {
+       closureCon       :: !DataCon,
+       closureSMRep     :: !SMRep
+    }
+\end{code}
  
  %************************************************************************
  %*                                                                     *
  
  %************************************************************************
  %*                                                                     *
@@ -273,61 +135,59 @@ mkConEntryInfo lbl
  %*                                                                     *
  %************************************************************************
  
  %*                                                                     *
  %************************************************************************
  
+Information about an identifier, from the code generator's point of
+view.  Every identifier is bound to a LambdaFormInfo in the
+environment, which gives the code generator enough info to be able to
+tail call or return that identifier.
+
+Note that a closure is usually bound to an identifier, so a
+ClosureInfo contains a LambdaFormInfo.
+
  \begin{code}
  data LambdaFormInfo
  \begin{code}
  data LambdaFormInfo
-  = LFReEntrant                -- Reentrant closure; used for PAPs too
-       Bool            -- True if top level
-       Int             -- Arity
-       Bool            -- True <=> no fvs
+  = LFReEntrant                -- Reentrant closure (a function)
+       TopLevelFlag    -- True if top level
+       !Int            -- Arity
+       !Bool           -- True <=> no fvs
+       ArgDescr        -- Argument descriptor (should reall be in ClosureInfo)
  
    | LFCon              -- Constructor
  
    | LFCon              -- Constructor
-       DataCon         -- The constructor (may be specialised)
-       Bool            -- True <=> zero arity
-
-  | LFTuple            -- Tuples
-       DataCon         -- The tuple constructor (may be specialised)
-       Bool            -- True <=> zero arity
+       DataCon         -- The constructor
  
    | LFThunk            -- Thunk (zero arity)
  
    | LFThunk            -- Thunk (zero arity)
-       Bool            -- True <=> top level
-       Bool            -- True <=> no free vars
-       Bool            -- True <=> updatable (i.e., *not* single-entry)
+       TopLevelFlag
+       !Bool           -- True <=> no free vars
+       !Bool           -- True <=> updatable (i.e., *not* single-entry)
         StandardFormInfo
         StandardFormInfo
+       !Bool           -- True <=> *might* be a function type
  
  
-  | LFArgument         -- Used for function arguments.  We know nothing about
-                       -- this closure.  Treat like updatable "LFThunk"...
-
-  | LFImported         -- Used for imported things.  We know nothing about this
-                       -- closure.  Treat like updatable "LFThunk"...
+  | LFUnknown          -- Used for function arguments and imported things.
+                       --  We know nothing about  this closure.  Treat like
+                       -- updatable "LFThunk"...
                         -- Imported things which we do know something about use
                         -- one of the other LF constructors (eg LFReEntrant for
                         -- known functions)
                         -- Imported things which we do know something about use
                         -- one of the other LF constructors (eg LFReEntrant for
                         -- known functions)
+       !Bool           -- True <=> *might* be a function type
  
    | LFLetNoEscape      -- See LetNoEscape module for precise description of
                         -- these "lets".
  
    | LFLetNoEscape      -- See LetNoEscape module for precise description of
                         -- these "lets".
-       Int             -- arity;
-       StgLiveVars-- list of variables live in the RHS of the let.
-                       -- (ToDo: maybe not used)
+       !Int            -- arity;
  
    | LFBlackHole                -- Used for the closures allocated to hold the result
                         -- of a CAF.  We want the target of the update frame to
                         -- be in the heap, so we make a black hole to hold it.
  
    | LFBlackHole                -- Used for the closures allocated to hold the result
                         -- of a CAF.  We want the target of the update frame to
                         -- be in the heap, so we make a black hole to hold it.
+        CLabel          -- Flavour (info label, eg CAF_BLACKHOLE_info).
  
  
-  -- This last one is really only for completeness;
-  -- it isn't actually used for anything interesting
-  {- | LFIndirection -}
  
  data StandardFormInfo  -- Tells whether this thunk has one of a small number
                         -- of standard forms
  
    = NonStandardThunk   -- No, it isn't
  
  
  data StandardFormInfo  -- Tells whether this thunk has one of a small number
                         -- of standard forms
  
    = NonStandardThunk   -- No, it isn't
  
- | SelectorThunk
-       Id                      -- Scrutinee
-       DataCon                 -- Constructor
-       Int                     -- 0-origin offset of ak within the "goods" of constructor
-                       -- (Recall that the a1,...,an may be laid out in the heap
-                       --  in a non-obvious order.)
+  | SelectorThunk
+       Int                     -- 0-origin offset of ak within the "goods" of 
+                       -- constructor (Recall that the a1,...,an may be laid
+                       -- out in the heap in a non-obvious order.)
  
  {- A SelectorThunk is of form
  
  
  {- A SelectorThunk is of form
  
@@ -335,39 +195,20 @@ data StandardFormInfo     -- Tells whether this thunk has one of a small number
         con a1,..,an -> ak
  
     and the constructor is from a single-constr type.
         con a1,..,an -> ak
  
     and the constructor is from a single-constr type.
-   If we can't convert the heap-offset of the selectee into an Int, e.g.,
-   it's "GEN_VHS+i", we just give up.
  -}
  
  -}
  
-  | VapThunk
-       Id                      -- Function
-       [StgArg]                -- Args
-       Bool                    -- True <=> the function is not top-level, so
-                               -- must be stored in the thunk too
+  | ApThunk 
+       Int             -- arity
  
  
-{- A VapThunk is of form
+{- An ApThunk is of form
  
  
-       f a1 ... an
+       x1 ... xn
  
  
-   where f is a known function, with arity n
-   So for this thunk we can use the label for f's heap-entry
-   info table (generated when f's defn was dealt with),
-   rather than generating a one-off info table and entry code
-   for this one thunk.
+   The code for the thunk just pushes x2..xn on the stack and enters x1.
+   There are a few of these (for 1 <= n <= MAX_SPEC_AP_SIZE) pre-compiled
+   in the RTS to save space.
  -}
  
  -}
  
-
-mkLFArgument   = LFArgument
-mkLFBlackHole  = LFBlackHole
-mkLFLetNoEscape = LFLetNoEscape
-
-mkLFImported :: Id -> LambdaFormInfo
-mkLFImported id
-  = case getIdArity id of
-      ArityExactly 0   -> LFThunk True{-top-lev-} True{-no fvs-}
-                                  True{-updatable-} NonStandardThunk
-      ArityExactly n   -> LFReEntrant True n True  -- n > 0
-      other            -> LFImported   -- Not sure of exact arity
  \end{code}
  
  %************************************************************************
  \end{code}
  
  %************************************************************************
@@ -379,42 +220,61 @@ mkLFImported id
  @mkClosureLFInfo@ figures out the appropriate LFInfo for the closure.
  
  \begin{code}
  @mkClosureLFInfo@ figures out the appropriate LFInfo for the closure.
  
  \begin{code}
-mkClosureLFInfo :: Bool        -- True of top level
+mkClosureLFInfo :: Id          -- The binder
+               -> TopLevelFlag -- True of top level
                 -> [Id]         -- Free vars
                 -> UpdateFlag   -- Update flag
                 -> [Id]         -- Args
                 -> LambdaFormInfo
  
                 -> [Id]         -- Free vars
                 -> UpdateFlag   -- Update flag
                 -> [Id]         -- Args
                 -> LambdaFormInfo
  
-mkClosureLFInfo top fvs upd_flag args@(_:_)  -- Non-empty args
-  = LFReEntrant top (length args) (null fvs)
-
-mkClosureLFInfo top fvs ReEntrant []
-  = LFReEntrant top 0 (null fvs)
+mkClosureLFInfo bndr top fvs upd_flag args@(_:_) -- Non-empty args
+  = LFReEntrant top (length args) (null fvs) (mkArgDescr (getName bndr) args)
  
  
-mkClosureLFInfo top fvs upd_flag []
-  = LFThunk top (null fvs) (isUpdatable upd_flag) NonStandardThunk
-
-isUpdatable ReEntrant   = False
-isUpdatable SingleEntry = False
-isUpdatable Updatable   = True
+mkClosureLFInfo bndr top fvs upd_flag []
+  = ASSERT( not updatable || not (isUnLiftedType id_ty) )
+    LFThunk top (null fvs) updatable NonStandardThunk 
+       (might_be_a_function id_ty)
+  where
+       updatable = isUpdatable upd_flag
+       id_ty = idType bndr
+
+might_be_a_function :: Type -> Bool
+might_be_a_function ty
+  | Just (tc,_) <- splitTyConApp_maybe (repType ty), 
+    not (isFunTyCon tc) && not (isAbstractTyCon tc) = False
+       -- don't forget to check for abstract types, which might
+       -- be functions too.
+  | otherwise = True
  \end{code}
  
  @mkConLFInfo@ is similar, for constructors.
  
  \begin{code}
  mkConLFInfo :: DataCon -> LambdaFormInfo
  \end{code}
  
  @mkConLFInfo@ is similar, for constructors.
  
  \begin{code}
  mkConLFInfo :: DataCon -> LambdaFormInfo
+mkConLFInfo con = LFCon con
  
  
-mkConLFInfo con
-  = -- the isNullaryDataCon will do this: ASSERT(isDataCon con)
-    (if isTupleCon con then LFTuple else LFCon) con (isNullaryDataCon con)
+mkSelectorLFInfo id offset updatable
+  = LFThunk NotTopLevel False updatable (SelectorThunk offset) 
+       (might_be_a_function (idType id))
  
  
-mkSelectorLFInfo scrutinee con offset
-  = LFThunk False False True (SelectorThunk scrutinee con offset)
-
-mkVapLFInfo fvs upd_flag fun_id args fun_in_vap
-  = LFThunk False (null fvs) (isUpdatable upd_flag) (VapThunk fun_id args fun_in_vap)
+mkApLFInfo id upd_flag arity
+  = LFThunk NotTopLevel (arity == 0) (isUpdatable upd_flag) (ApThunk arity)
+       (might_be_a_function (idType id))
  \end{code}
  
  \end{code}
  
+Miscellaneous LF-infos.
+
+\begin{code}
+mkLFArgument id = LFUnknown (might_be_a_function (idType id))
+
+mkLFLetNoEscape = LFLetNoEscape
+
+mkLFImported :: Id -> LambdaFormInfo
+mkLFImported id
+  = case idArity id of
+      n | n > 0 -> LFReEntrant TopLevel n True (panic "arg_descr")  -- n > 0
+      other -> mkLFArgument id -- Not sure of exact arity
+\end{code}
  
  %************************************************************************
  %*                                                                     *
  
  %************************************************************************
  %*                                                                     *
@@ -424,51 +284,44 @@ mkVapLFInfo fvs upd_flag fun_id args fun_in_vap
  
  \begin{code}
  closureSize :: ClosureInfo -> HeapOffset
  
  \begin{code}
  closureSize :: ClosureInfo -> HeapOffset
-closureSize cl_info@(MkClosureInfo _ _ sm_rep)
-  = totHdrSize sm_rep `addOff` (intOff (closureNonHdrSize cl_info))
-
-closureSizeWithoutFixedHdr :: ClosureInfo -> HeapOffset
-closureSizeWithoutFixedHdr cl_info@(MkClosureInfo _ _ sm_rep)
-  = varHdrSize sm_rep `addOff` (intOff (closureNonHdrSize cl_info))
-
-closureHdrSize :: ClosureInfo -> HeapOffset
-closureHdrSize (MkClosureInfo _ _ sm_rep)
-  = totHdrSize sm_rep
+closureSize cl_info = fixedHdrSize + closureNonHdrSize cl_info
  
  closureNonHdrSize :: ClosureInfo -> Int
  
  closureNonHdrSize :: ClosureInfo -> Int
-closureNonHdrSize cl_info@(MkClosureInfo _ lf_info sm_rep)
-  = tot_wds + computeSlopSize tot_wds sm_rep (closureUpdReqd cl_info) --ToDo: pass lf_info?
+closureNonHdrSize cl_info
+  = tot_wds + computeSlopSize tot_wds 
+                             (closureSMRep cl_info)
+                             (closureNeedsUpdSpace cl_info) 
    where
      tot_wds = closureGoodStuffSize cl_info
  
    where
      tot_wds = closureGoodStuffSize cl_info
  
+-- we leave space for an update if either (a) the closure is updatable
+-- or (b) it is a static thunk.  This is because a static thunk needs
+-- a static link field in a predictable place (after the slop), regardless
+-- of whether it is updatable or not.
+closureNeedsUpdSpace (ClosureInfo { closureLFInfo = 
+                                       LFThunk TopLevel _ _ _ _ }) = True
+closureNeedsUpdSpace cl_info = closureUpdReqd cl_info
+
+slopSize :: ClosureInfo -> Int
+slopSize cl_info
+  = computeSlopSize (closureGoodStuffSize cl_info)
+                   (closureSMRep cl_info)
+                   (closureNeedsUpdSpace cl_info)
+
  closureGoodStuffSize :: ClosureInfo -> Int
  closureGoodStuffSize :: ClosureInfo -> Int
-closureGoodStuffSize (MkClosureInfo _ _ sm_rep)
-  = let (ptrs, nonptrs) = sizes_from_SMRep sm_rep
+closureGoodStuffSize cl_info
+  = let (ptrs, nonptrs) = sizes_from_SMRep (closureSMRep cl_info)
      in ptrs + nonptrs
  
  closurePtrsSize :: ClosureInfo -> Int
      in ptrs + nonptrs
  
  closurePtrsSize :: ClosureInfo -> Int
-closurePtrsSize (MkClosureInfo _ _ sm_rep)
-  = let (ptrs, _) = sizes_from_SMRep sm_rep
+closurePtrsSize cl_info
+  = let (ptrs, _) = sizes_from_SMRep (closureSMRep cl_info)
      in ptrs
  
  -- not exported:
      in ptrs
  
  -- not exported:
-sizes_from_SMRep (SpecialisedRep k ptrs nonptrs _)   = (ptrs, nonptrs)
-sizes_from_SMRep (GenericRep       ptrs nonptrs _)   = (ptrs, nonptrs)
-sizes_from_SMRep (BigTupleRep      ptrs)            = (ptrs, 0)
-sizes_from_SMRep (MuTupleRep       ptrs)            = (ptrs, 0)
-sizes_from_SMRep (DataRep               nonptrs)     = (0, nonptrs)
-sizes_from_SMRep BlackHoleRep                       = (0, 0)
-sizes_from_SMRep (StaticRep        ptrs nonptrs)     = (ptrs, nonptrs)
-#ifdef DEBUG
-sizes_from_SMRep PhantomRep      = panic "sizes_from_SMRep: PhantomRep"
-sizes_from_SMRep DynamicRep      = panic "sizes_from_SMRep: DynamicRep"
-#endif
-\end{code}
-
-\begin{code}
-fitsMinUpdSize :: ClosureInfo -> Bool
-fitsMinUpdSize (MkClosureInfo _ _ BlackHoleRep) = True
-fitsMinUpdSize cl_info = isSpecRep (closureSMRep cl_info) && closureNonHdrSize cl_info <= mIN_UPD_SIZE
+sizes_from_SMRep :: SMRep -> (Int,Int)
+sizes_from_SMRep (GenericRep _ ptrs nonptrs _)   = (ptrs, nonptrs)
+sizes_from_SMRep BlackHoleRep                   = (0, 0)
  \end{code}
  
  Computing slop size.  WARNING: this looks dodgy --- it has deep
  \end{code}
  
  Computing slop size.  WARNING: this looks dodgy --- it has deep
@@ -481,8 +334,6 @@ Slop Requirements:
  Updateable closures must be @mIN_UPD_SIZE@.
         \begin{itemize}
         \item
  Updateable closures must be @mIN_UPD_SIZE@.
         \begin{itemize}
         \item
-       Cons cell requires 2 words
-       \item
         Indirections require 1 word
         \item
         Appels collector indirections 2 words
         Indirections require 1 word
         \item
         Appels collector indirections 2 words
@@ -496,119 +347,150 @@ must be @mIN_SIZE_NonUpdHeapObject@.
  Copying collector forward pointer requires 1 word
  
  THEREFORE: @mIN_SIZE_NonUpdHeapObject = 1@
  Copying collector forward pointer requires 1 word
  
  THEREFORE: @mIN_SIZE_NonUpdHeapObject = 1@
-
-\item
-@SpecialisedRep@ closures closures may require slop:
-       \begin{itemize}
-       \item
-       @ConstantRep@ and @CharLikeRep@ closures always use the address of
-       a static closure. They are never allocated or
-       collected (eg hold forwarding pointer) hence never any slop.
-
-       \item
-       @IntLikeRep@ are never updatable.
-       May need slop to be collected (as they will be size 1 or more
-       this probably has no affect)
-
-       \item
-       @SpecRep@ may be updateable and will be collectable
-
-       \item
-       @StaticRep@ may require slop if updatable. Non-updatable ones are OK.
-
-       \item
-       @GenericRep@ closures will always be larger so never require slop.
-       \end{itemize}
-
-       ***** ToDo: keep an eye on this!
  \end{itemize}
  
  \end{itemize}
  
-\begin{code}
-slopSize cl_info@(MkClosureInfo _ lf_info sm_rep)
-  = computeSlopSize (closureGoodStuffSize cl_info) sm_rep (closureUpdReqd cl_info)
+Static closures have an extra ``static link field'' at the end, but we
+don't bother taking that into account here.
  
  
+\begin{code}
  computeSlopSize :: Int -> SMRep -> Bool -> Int
  
  computeSlopSize :: Int -> SMRep -> Bool -> Int
  
-computeSlopSize tot_wds (SpecialisedRep ConstantRep _ _ _) _
-  = 0
-computeSlopSize tot_wds (SpecialisedRep CharLikeRep _ _ _) _
-  = 0
-
-computeSlopSize tot_wds (SpecialisedRep _ _ _ _) True  -- Updatable
-  = max 0 (mIN_UPD_SIZE - tot_wds)
-computeSlopSize tot_wds (StaticRep _ _) True           -- Updatable
-  = max 0 (mIN_UPD_SIZE - tot_wds)
-computeSlopSize tot_wds BlackHoleRep _                 -- Updatable
+computeSlopSize tot_wds (GenericRep _ _ _ _) True              -- Updatable
    = max 0 (mIN_UPD_SIZE - tot_wds)
  
    = max 0 (mIN_UPD_SIZE - tot_wds)
  
-computeSlopSize tot_wds (SpecialisedRep _ _ _ _) False -- Not updatable
-  = max 0 (mIN_SIZE_NonUpdHeapObject - tot_wds)
+computeSlopSize tot_wds (GenericRep True _ _ _) False  -- Non updatable
+  = 0                                                  -- Static
+
+computeSlopSize tot_wds (GenericRep False _ _ _) False -- Non updatable
+  = max 0 (mIN_SIZE_NonUpdHeapObject - tot_wds)                -- Dynamic
  
  
-computeSlopSize tot_wds other_rep _                    -- Any other rep
-  = 0
+computeSlopSize tot_wds BlackHoleRep _                 -- Updatable
+  = max 0 (mIN_UPD_SIZE - tot_wds)
  \end{code}
  
  %************************************************************************
  %*                                                                     *
  \end{code}
  
  %************************************************************************
  %*                                                                     *
-\subsection[layOutDynClosure]{Lay out a dynamic closure}
+\subsection[layOutDynClosure]{Lay out a closure}
  %*                                                                     *
  %************************************************************************
  
  \begin{code}
  layOutDynClosure, layOutStaticClosure
  %*                                                                     *
  %************************************************************************
  
  \begin{code}
  layOutDynClosure, layOutStaticClosure
-       :: Id                       -- STG identifier w/ which this closure assoc'd
-       -> (a -> PrimRep)           -- function w/ which to be able to get a PrimRep
+       :: Id                       -- STG identifier of this closure
+       -> (a -> PrimRep)           -- how to get a PrimRep for the fields
+       -> [a]                      -- the "things" being layed out
+       -> LambdaFormInfo           -- what sort of closure it is
+       -> C_SRT                    -- its SRT
+       -> String                   -- closure description
+       -> (ClosureInfo,            -- info about the closure
+           [(a, VirtualHeapOffset)])   -- things w/ offsets pinned on them
+
+layOutDynClosure    = layOutClosure False
+layOutStaticClosure = layOutClosure True
+
+layOutStaticNoFVClosure id lf_info srt_info descr
+  = fst (layOutClosure True id (panic "kind_fn") [] lf_info srt_info descr)
+
+layOutClosure
+       :: Bool                     -- True <=> static closure
+       -> Id                       -- STG identifier of this closure
+       -> (a -> PrimRep)           -- how to get a PrimRep for the fields
         -> [a]                      -- the "things" being layed out
         -> LambdaFormInfo           -- what sort of closure it is
         -> [a]                      -- the "things" being layed out
         -> LambdaFormInfo           -- what sort of closure it is
+       -> C_SRT                    -- its SRT
+       -> String                   -- closure description
         -> (ClosureInfo,            -- info about the closure
             [(a, VirtualHeapOffset)])   -- things w/ offsets pinned on them
  
         -> (ClosureInfo,            -- info about the closure
             [(a, VirtualHeapOffset)])   -- things w/ offsets pinned on them
  
-layOutDynClosure name kind_fn things lf_info
-  = (MkClosureInfo name lf_info sm_rep,
+layOutClosure is_static id kind_fn things lf_info srt_info descr
+  = (ClosureInfo { closureName = name, 
+                  closureLFInfo = lf_info,
+                  closureSMRep = sm_rep, 
+                  closureSRT = srt_info,
+                  closureType = idType id,
+                  closureDescr = descr },
       things_w_offsets)
    where
       things_w_offsets)
    where
+    name = idName id
      (tot_wds,           -- #ptr_wds + #nonptr_wds
       ptr_wds,           -- #ptr_wds
      (tot_wds,           -- #ptr_wds + #nonptr_wds
       ptr_wds,           -- #ptr_wds
-     things_w_offsets) = mkVirtHeapOffsets sm_rep kind_fn things
-    sm_rep = chooseDynSMRep lf_info tot_wds ptr_wds
+     things_w_offsets) = mkVirtHeapOffsets kind_fn things
+    sm_rep = chooseSMRep is_static lf_info tot_wds ptr_wds
  
  
-layOutStaticClosure name kind_fn things lf_info
-  = (MkClosureInfo name lf_info (StaticRep ptr_wds (tot_wds - ptr_wds)),
-     things_w_offsets)
+
+layOutDynConstr, layOutStaticConstr
+       :: DataCon      
+       -> (a -> PrimRep)
+       -> [a]
+       -> (ClosureInfo,
+           [(a,VirtualHeapOffset)])
+
+layOutDynConstr    = layOutConstr False
+layOutStaticConstr = layOutConstr True
+
+layOutConstr is_static data_con kind_fn args
+   = (ConInfo { closureSMRep = sm_rep,
+               closureCon = data_con },
+      things_w_offsets)
    where
      (tot_wds,           -- #ptr_wds + #nonptr_wds
       ptr_wds,           -- #ptr_wds
    where
      (tot_wds,           -- #ptr_wds + #nonptr_wds
       ptr_wds,           -- #ptr_wds
-     things_w_offsets) = mkVirtHeapOffsets (StaticRep bot bot) kind_fn things
-    bot = panic "layoutStaticClosure"
-
-layOutStaticNoFVClosure :: Id -> LambdaFormInfo -> ClosureInfo
-layOutStaticNoFVClosure name lf_info
-  = MkClosureInfo name lf_info (StaticRep ptr_wds nonptr_wds)
- where
-  -- I am very uncertain that this is right - it will show up when testing
-  -- my dynamic loading code.  ADR
-  -- (If it's not right, we'll have to grab the kinds of the arguments from
-  --  somewhere.)
-  ptr_wds = 0
-  nonptr_wds = 0
-
-layOutPhantomClosure :: Id -> LambdaFormInfo -> ClosureInfo
-layOutPhantomClosure name lf_info = MkClosureInfo name lf_info PhantomRep
+     things_w_offsets) = mkVirtHeapOffsets kind_fn args
+    sm_rep = chooseSMRep is_static (mkConLFInfo data_con) tot_wds ptr_wds
  \end{code}
  
  \end{code}
  
-A wrapper for when used with data constructors:
+%************************************************************************
+%*                                                                     *
+\subsection[mkStaticClosure]{Make a static closure}
+%*                                                                     *
+%************************************************************************
+
+Make a static closure, adding on any extra padding needed for CAFs,
+and adding a static link field if necessary.
+
  \begin{code}
  \begin{code}
-layOutDynCon :: DataCon
-            -> (a -> PrimRep)
-            -> [a]
-            -> (ClosureInfo, [(a,VirtualHeapOffset)])
-
-layOutDynCon con kind_fn args
-  = ASSERT(isDataCon con)
-    layOutDynClosure con kind_fn args (mkConLFInfo con)
+mkStaticClosure lbl cl_info ccs fields cafrefs
+  | opt_SccProfilingOn =
+            CStaticClosure
+               lbl
+               cl_info
+               (mkCCostCentreStack ccs)
+               all_fields
+  | otherwise =
+            CStaticClosure
+               lbl
+               cl_info
+               (panic "absent cc")
+               all_fields
+
+   where
+    all_fields = fields ++ padding_wds ++ static_link_field
+
+    upd_reqd = closureUpdReqd cl_info
+
+    -- for the purposes of laying out the static closure, we consider all
+    -- thunks to be "updatable", so that the static link field is always
+    -- in the same place.
+    padding_wds
+       | not upd_reqd = []
+       | otherwise    = replicate n (mkIntCLit 0) -- a bunch of 0s
+       where n = max 0 (mIN_UPD_SIZE - length fields)
+
+       -- We always have a static link field for a thunk, it's used to
+       -- save the closure's info pointer when we're reverting CAFs
+       -- (see comment in Storage.c)
+    static_link_field
+       | upd_reqd || staticClosureNeedsLink cl_info = [static_link_value]
+       | otherwise                                  = []
+
+       -- for a static constructor which has NoCafRefs, we set the
+       -- static link field to a non-zero value so the garbage
+       -- collector will ignore it.
+    static_link_value
+       | cafrefs       = mkIntCLit 0
+       | otherwise     = mkIntCLit 1
  \end{code}
  
  \end{code}
  
-
  %************************************************************************
  %*                                                                     *
  \subsection[SMreps]{Choosing SM reps}
  %************************************************************************
  %*                                                                     *
  \subsection[SMreps]{Choosing SM reps}
@@ -616,44 +498,35 @@ layOutDynCon con kind_fn args
  %************************************************************************
  
  \begin{code}
  %************************************************************************
  
  \begin{code}
-chooseDynSMRep
-       :: LambdaFormInfo
+chooseSMRep
+       :: Bool                 -- True <=> static closure
+       -> LambdaFormInfo
         -> Int -> Int           -- Tot wds, ptr wds
         -> SMRep
  
         -> Int -> Int           -- Tot wds, ptr wds
         -> SMRep
  
-chooseDynSMRep lf_info tot_wds ptr_wds
+chooseSMRep is_static lf_info tot_wds ptr_wds
    = let
    = let
-        nonptr_wds = tot_wds - ptr_wds
-
-        updatekind = case lf_info of
-            LFThunk _ _ upd _  -> if upd then SMUpdatable else SMSingleEntry
-            LFBlackHole        -> SMUpdatable
-            _                  -> SMNormalForm
+        nonptr_wds   = tot_wds - ptr_wds
+        closure_type = getClosureType is_static tot_wds ptr_wds lf_info
      in
      in
-    if (nonptr_wds == 0 && ptr_wds <= mAX_SPEC_ALL_PTRS)
-           || (tot_wds <= mAX_SPEC_MIXED_FIELDS)
-           || (ptr_wds == 0 && nonptr_wds <= mAX_SPEC_ALL_NONPTRS) then
-       let
-         spec_kind  = case lf_info of
+    GenericRep is_static ptr_wds nonptr_wds closure_type       
  
  
-          (LFTuple _ True) -> ConstantRep
+-- we *do* get non-updatable top-level thunks sometimes.  eg. f = g
+-- gets compiled to a jump to g (if g has non-zero arity), instead of
+-- messing around with update frames and PAPs.  We set the closure type
+-- to FUN_STATIC in this case.
  
  
-          (LFTuple _ _)  -> SpecRep
-
-          (LFCon _ True) -> ConstantRep
-
-          (LFCon con _ ) -> if maybeCharLikeCon con then CharLikeRep
-                            else if maybeIntLikeCon con then IntLikeRep
-                            else SpecRep
-
-          _              -> SpecRep
-       in
-       SpecialisedRep spec_kind ptr_wds nonptr_wds updatekind
-    else
-       GenericRep ptr_wds nonptr_wds updatekind
+getClosureType :: Bool -> Int -> Int -> LambdaFormInfo -> ClosureType
+getClosureType is_static tot_wds ptr_wds lf_info
+  = case lf_info of
+       LFCon con | is_static && ptr_wds == 0   -> ConstrNoCaf
+                 | otherwise                   -> Constr
+       LFReEntrant _ _ _ _                     -> Fun
+       LFThunk _ _ _ (SelectorThunk _) _       -> ThunkSelector
+       LFThunk _ _ _ _ _                       -> Thunk
+       _ -> panic "getClosureType"
  \end{code}
  
  \end{code}
  
-
  %************************************************************************
  %*                                                                     *
  \subsection[mkVirtHeapOffsets]{Assigning heap offsets in a closure}
  %************************************************************************
  %*                                                                     *
  \subsection[mkVirtHeapOffsets]{Assigning heap offsets in a closure}
@@ -665,29 +538,28 @@ smaller offsets than the unboxed things, and furthermore, the offsets in
  the result list
  
  \begin{code}
  the result list
  
  \begin{code}
-mkVirtHeapOffsets :: SMRep     -- Representation to be used by storage manager
-         -> (a -> PrimRep)     -- To be able to grab kinds;
+mkVirtHeapOffsets :: 
+         (a -> PrimRep)        -- To be able to grab kinds;
                                 --      w/ a kind, we can find boxedness
           -> [a]                -- Things to make offsets for
           -> (Int,              -- *Total* number of words allocated
               Int,              -- Number of words allocated for *pointers*
               [(a, VirtualHeapOffset)])
                                 --      w/ a kind, we can find boxedness
           -> [a]                -- Things to make offsets for
           -> (Int,              -- *Total* number of words allocated
               Int,              -- Number of words allocated for *pointers*
               [(a, VirtualHeapOffset)])
-                               -- Things with their offsets from start of object
-                               --      in order of increasing offset
+                               -- Things with their offsets from start of 
+                               --  object in order of increasing offset
  
  -- First in list gets lowest offset, which is initial offset + 1.
  
  
  -- First in list gets lowest offset, which is initial offset + 1.
  
-mkVirtHeapOffsets sm_rep kind_fun things
+mkVirtHeapOffsets kind_fun things
    = let (ptrs, non_ptrs)             = separateByPtrFollowness kind_fun things
         (wds_of_ptrs, ptrs_w_offsets) = mapAccumL computeOffset 0 ptrs
         (tot_wds, non_ptrs_w_offsets) = mapAccumL computeOffset wds_of_ptrs non_ptrs
      in
         (tot_wds, wds_of_ptrs, ptrs_w_offsets ++ non_ptrs_w_offsets)
    where
    = let (ptrs, non_ptrs)             = separateByPtrFollowness kind_fun things
         (wds_of_ptrs, ptrs_w_offsets) = mapAccumL computeOffset 0 ptrs
         (tot_wds, non_ptrs_w_offsets) = mapAccumL computeOffset wds_of_ptrs non_ptrs
      in
         (tot_wds, wds_of_ptrs, ptrs_w_offsets ++ non_ptrs_w_offsets)
    where
-    offset_of_first_word = totHdrSize sm_rep
      computeOffset wds_so_far thing
        = (wds_so_far + (getPrimRepSize . kind_fun) thing,
      computeOffset wds_so_far thing
        = (wds_so_far + (getPrimRepSize . kind_fun) thing,
-        (thing, (offset_of_first_word `addOff` (intOff wds_so_far)))
+        (thing, fixedHdrSize + wds_so_far)
         )
  \end{code}
  
         )
  \end{code}
  
@@ -702,14 +574,12 @@ Be sure to see the stg-details notes about these...
  \begin{code}
  nodeMustPointToIt :: LambdaFormInfo -> FCode Bool
  nodeMustPointToIt lf_info
  \begin{code}
  nodeMustPointToIt :: LambdaFormInfo -> FCode Bool
  nodeMustPointToIt lf_info
-  = let
-       do_profiling = opt_SccProfilingOn
-    in
-    case lf_info of
-       LFReEntrant top arity no_fvs -> returnFC (
-           not no_fvs ||   -- Certainly if it has fvs we need to point to it
  
  
-           not top -- If it is not top level we will point to it
+  = case lf_info of
+       LFReEntrant top _ no_fvs _ -> returnFC (
+           not no_fvs ||   -- Certainly if it has fvs we need to point to it
+           isNotTopLevel top
+                   -- If it is not top level we will point to it
                     --   We can have a \r closure with no_fvs which
                     --   is not top level as special case cgRhsClosure
                     --   has been dissabled in favour of let floating
                     --   We can have a \r closure with no_fvs which
                     --   is not top level as special case cgRhsClosure
                     --   has been dissabled in favour of let floating
@@ -719,8 +589,7 @@ nodeMustPointToIt lf_info
                 -- the  not top  case above ensures this is ok.
             )
  
                 -- the  not top  case above ensures this is ok.
             )
  
-       LFCon   _ zero_arity -> returnFC True
-       LFTuple _ zero_arity -> returnFC True
+       LFCon _ -> returnFC True
  
         -- Strictly speaking, the above two don't need Node to point
         -- to it if the arity = 0.  But this is a *really* unlikely
  
         -- Strictly speaking, the above two don't need Node to point
         -- to it if the arity = 0.  But this is a *really* unlikely
@@ -733,8 +602,8 @@ nodeMustPointToIt lf_info
         -- having Node point to the result of an update.  SLPJ
         -- 27/11/92.
  
         -- having Node point to the result of an update.  SLPJ
         -- 27/11/92.
  
-       LFThunk _ no_fvs updatable NonStandardThunk
-         -> returnFC (updatable || not no_fvs || do_profiling)
+       LFThunk _ no_fvs updatable NonStandardThunk _
+         -> returnFC (updatable || not no_fvs || opt_SccProfilingOn)
  
           -- For the non-updatable (single-entry case):
           --
  
           -- For the non-updatable (single-entry case):
           --
@@ -743,21 +612,15 @@ nodeMustPointToIt lf_info
           -- or profiling (in which case we need to recover the cost centre
           --             from inside it)
  
           -- or profiling (in which case we need to recover the cost centre
           --             from inside it)
  
-       LFThunk _ no_fvs updatable some_standard_form_thunk
+       LFThunk _ no_fvs updatable some_standard_form_thunk _
           -> returnFC True
           -- Node must point to any standard-form thunk.
           -> returnFC True
           -- Node must point to any standard-form thunk.
-         -- For example,
-         --            x = f y
-         -- generates a Vap thunk for (f y), and even if y is a global
-         -- variable we must still make Node point to the thunk before entering it
-         -- because that's what the standard-form code expects.
-
-       LFArgument  -> returnFC True
-       LFImported  -> returnFC True
-       LFBlackHole -> returnFC True
+
+       LFUnknown _   -> returnFC True
+       LFBlackHole _ -> returnFC True
                     -- BH entry may require Node to point
  
                     -- BH entry may require Node to point
  
-       LFLetNoEscape _ _ -> returnFC False
+       LFLetNoEscape _ -> returnFC False
  \end{code}
  
  The entry conventions depend on the type of closure being entered,
  \end{code}
  
  The entry conventions depend on the type of closure being entered,
@@ -789,113 +652,158 @@ When black-holing, single-entry closures could also be entered via node
  (rather than directly) to catch double-entry.
  
  \begin{code}
  (rather than directly) to catch double-entry.
  
  \begin{code}
-data EntryConvention
-  = ViaNode                            -- The "normal" convention
+data CallingConvention
+  = EnterIt                            -- no args, not a function
  
  
-  | StdEntry CLabel                    -- Jump to this code, with args on stack
-            (Maybe CLabel)             -- possibly setting infoptr to this
+  | JumpToIt CLabel                    -- no args, not a function, but we
+                                       -- know what its entry code is
  
  
-  | DirectEntry                        -- Jump directly to code, with args in regs
+  | ReturnIt                           -- it's a function, but we have
+                                       -- zero args to apply to it, so just
+                                       -- return it.
+
+  | SlowCall                           -- Unknown fun, or known fun with
+                                       -- too few args.
+
+  | DirectEntry                        -- Jump directly, with args in regs
         CLabel                          --   The code label
         Int                             --   Its arity
         CLabel                          --   The code label
         Int                             --   Its arity
-       [MagicId]                       --   Its register assignments (possibly empty)
+       [MagicId]                       --   Its register assignments 
+                                       --      (possibly empty)
  
  
-getEntryConvention :: Id               -- Function being applied
+getEntryConvention :: Name             -- Function being applied
                    -> LambdaFormInfo    -- Its info
                    -> [PrimRep]         -- Available arguments
                    -> LambdaFormInfo    -- Its info
                    -> [PrimRep]         -- Available arguments
-                  -> FCode EntryConvention
+                  -> FCode CallingConvention
  
  
-getEntryConvention id lf_info arg_kinds
+getEntryConvention name lf_info arg_kinds
   =  nodeMustPointToIt lf_info  `thenFC` \ node_points ->
   =  nodeMustPointToIt lf_info  `thenFC` \ node_points ->
-    let
-       is_concurrent = opt_ForConcurrent
-    in
      returnFC (
  
      returnFC (
  
-    if (node_points && is_concurrent) then ViaNode else
+    -- if we're parallel, then we must always enter via node.  The reason
+    -- is that the closure may have been fetched since we allocated it.
+
+    if (node_points && opt_Parallel) then EnterIt else
+
+    -- Commented out by SDM after futher thoughts:
+    --   - the only closure type that can be blackholed is a thunk
+    --   - we already enter thunks via node (unless the closure is
+    --     non-updatable, in which case why is it being re-entered...)
  
      case lf_info of
  
  
      case lf_info of
  
-       LFReEntrant _ arity _ ->
-           if arity == 0 || (length arg_kinds) < arity then
-               StdEntry (mkStdEntryLabel id) Nothing
+       LFReEntrant _ arity _ _ ->
+           if null arg_kinds then
+               if arity == 0 then
+                  EnterIt              -- a non-updatable thunk
+               else 
+                  ReturnIt             -- no args at all
+           else if listLengthCmp arg_kinds arity == LT then
+               SlowCall                -- not enough args
             else
             else
-               DirectEntry (mkFastEntryLabel id arity) arity arg_regs
+               DirectEntry (mkEntryLabel name) arity arg_regs
           where
           where
-           (arg_regs, _) = assignRegs live_regs (take arity arg_kinds)
-           live_regs = if node_points then [node] else []
-
-       LFCon con zero_arity
-                         -> let itbl = if zero_arity then
-                                       mkPhantomInfoTableLabel con
-                                       else
-                                       mkConInfoTableLabel con
-                            in
-                            --false:ASSERT (null arg_kinds)    -- Should have no args (meaning what?)
-                            StdEntry (mkConEntryLabel con) (Just itbl)
-
-       LFTuple tup zero_arity
-                         -> --false:ASSERT (null arg_kinds)    -- Should have no args (meaning what?)
-                            StdEntry (mkConEntryLabel tup) (Just (mkConInfoTableLabel tup))
-
-       LFThunk _ _ updatable std_form_info
-         -> if updatable
-            then ViaNode
-            else StdEntry (thunkEntryLabel id std_form_info updatable) Nothing
-
-       LFArgument  -> ViaNode
-       LFImported  -> ViaNode
-       LFBlackHole -> ViaNode  -- Presumably the black hole has by now
-                               -- been updated, but we don't know with
-                               -- what, so we enter via Node
-
-       LFLetNoEscape arity _
-         -> ASSERT(arity == length arg_kinds)
-            DirectEntry (mkStdEntryLabel id) arity arg_regs
+           (arg_regs, _) = assignRegs [node] (take arity arg_kinds)
+               -- we don't use node to pass args now (SDM)
+
+       LFCon con
+           | isNullaryDataCon con
+             -- a real constructor.  Don't bother entering it, just jump
+             -- to the constructor entry code directly.
+                         -> --false:ASSERT (null arg_kinds)    
+                            -- Should have no args (meaning what?)
+                            JumpToIt (mkStaticConEntryLabel (dataConName con))
+
+            | otherwise {- not nullary -}
+                         -> --false:ASSERT (null arg_kinds)    
+                            -- Should have no args (meaning what?)
+                            JumpToIt (mkConEntryLabel (dataConName con))
+
+       LFThunk _ _ updatable std_form_info is_fun
+         -- must always "call" a function-typed thing, cannot just enter it
+         | is_fun -> SlowCall
+         | updatable || opt_DoTickyProfiling  -- to catch double entry
+               || opt_SMP  -- always enter via node on SMP, since the
+                           -- thunk might have been blackholed in the 
+                           -- meantime.
+            -> ASSERT(null arg_kinds) EnterIt
+         | otherwise
+            -> ASSERT(null arg_kinds) 
+               JumpToIt (thunkEntryLabel name std_form_info updatable)
+
+       LFUnknown True  -> SlowCall -- might be a function
+       LFUnknown False -> ASSERT2 (null arg_kinds, ppr name <+> ppr arg_kinds) EnterIt -- not a function
+
+       LFBlackHole _ -> SlowCall -- Presumably the black hole has by now
+                                 -- been updated, but we don't know with
+                                 -- what, so we slow call it
+
+       LFLetNoEscape 0
+         -> JumpToIt (mkReturnPtLabel (nameUnique name))
+
+       LFLetNoEscape arity
+         -> if (not (arg_kinds `lengthIs` arity)) then pprPanic "let-no-escape: " (ppr name <+> ppr arity) else
+            DirectEntry (mkReturnPtLabel (nameUnique name)) arity arg_regs
          where
          where
-           (arg_regs, _) = assignRegs live_regs arg_kinds
-           live_regs     = if node_points then [node] else []
+           (arg_regs, _) = assignRegs [] arg_kinds
+           -- node never points to a LetNoEscape, see above --SDM
+           --live_regs     = if node_points then [node] else []
      )
  
      )
  
-blackHoleOnEntry :: Bool       -- No-black-holing flag
-                -> ClosureInfo
-                -> Bool
+blackHoleOnEntry :: ClosureInfo -> Bool
  
  -- Static closures are never themselves black-holed.
  
  -- Static closures are never themselves black-holed.
--- Updatable ones will be overwritten with a CAFList cell, which points to a black hole;
--- Single-entry ones have no fvs to plug, and we trust they don't form part of a loop.
+-- Updatable ones will be overwritten with a CAFList cell, which points to a 
+-- black hole;
+-- Single-entry ones have no fvs to plug, and we trust they don't form part 
+-- of a loop.
  
  
-blackHoleOnEntry no_black_holing (MkClosureInfo _ _ (StaticRep _ _)) = False
+blackHoleOnEntry ConInfo{} = False
+blackHoleOnEntry (ClosureInfo { closureLFInfo = lf_info, closureSMRep = rep })
+  | isStaticRep rep
+  = False      -- Never black-hole a static closure
  
  
-blackHoleOnEntry no_black_holing (MkClosureInfo _ lf_info _)
+  | otherwise
    = case lf_info of
    = case lf_info of
-       LFReEntrant _ _ _         -> False
-       LFThunk _ no_fvs updatable _
+       LFReEntrant _ _ _ _       -> False
+       LFLetNoEscape _           -> False
+       LFThunk _ no_fvs updatable _ _
           -> if updatable
           -> if updatable
-            then not no_black_holing
-            else not no_fvs
+            then not opt_OmitBlackHoling
+            else opt_DoTickyProfiling || not no_fvs
+                  -- the former to catch double entry,
+                  -- and the latter to plug space-leaks.  KSW/SDM 1999-04.
+
         other -> panic "blackHoleOnEntry"       -- Should never happen
  
         other -> panic "blackHoleOnEntry"       -- Should never happen
  
-getStandardFormThunkInfo
-       :: LambdaFormInfo
-       -> Maybe [StgArg]               -- Nothing    => not a standard-form thunk
-                                       -- Just atoms => a standard-form thunk with payload atoms
+isStandardFormThunk :: LambdaFormInfo -> Bool
  
  
-getStandardFormThunkInfo (LFThunk _ _ _ (SelectorThunk scrutinee _ _))
-  = --trace "Selector thunk: missed opportunity to save info table + code"
-    Nothing
-       -- Just [StgVarArg scrutinee]
-       -- We can't save the info tbl + code until we have a way to generate
-       -- a fixed family thereof.
+isStandardFormThunk (LFThunk _ _ _ (SelectorThunk _) _) = True
+isStandardFormThunk (LFThunk _ _ _ (ApThunk _) _)      = True
+isStandardFormThunk other_lf_info                      = False
  
  
-getStandardFormThunkInfo (LFThunk _ _ _ (VapThunk fun_id args fun_in_payload))
-  | fun_in_payload = Just (StgVarArg fun_id : args)
-  | otherwise     = Just args
+\end{code}
  
  
-getStandardFormThunkInfo other_lf_info = Nothing
+-----------------------------------------------------------------------------
+SRT-related stuff
  
  
-maybeSelectorInfo (MkClosureInfo _ (LFThunk _ _ _ (SelectorThunk _ con offset)) _) = Just (con,offset)
-maybeSelectorInfo _ = Nothing
+\begin{code}
+staticClosureNeedsLink :: ClosureInfo -> Bool
+-- A static closure needs a link field to aid the GC when traversing
+-- the static closure graph.  But it only needs such a field if either
+--     a) it has an SRT
+--     b) it's a constructor with one or more pointer fields
+-- In case (b), the constructor's fields themselves play the role
+-- of the SRT.
+staticClosureNeedsLink (ClosureInfo { closureSRT = srt })
+  = needsSRT srt
+staticClosureNeedsLink (ConInfo { closureSMRep = sm_rep, closureCon = con })
+  = not (isNullaryDataCon con) && not_nocaf_constr
+  where
+    not_nocaf_constr = 
+       case sm_rep of 
+          GenericRep _ _ _ ConstrNoCaf -> False
+          _other                       -> True
  \end{code}
  
  Avoiding generating entries and info tables
  \end{code}
  
  Avoiding generating entries and info tables
@@ -959,91 +867,19 @@ have closure, info table, and entry code.]
         to use an error label in the info table to substitute for the absent
         slow entry code.
  
         to use an error label in the info table to substitute for the absent
         slow entry code.
  
-* Standard vap-entry code
-  Standard vap-entry info table
-       Needed iff we have any updatable thunks of the standard vap-entry shape.
-
-* Single-update vap-entry code
-  Single-update vap-entry info table
-       Needed iff we have any non-updatable thunks of the
-       standard vap-entry shape.
-
-
  \begin{code}
  staticClosureRequired
  \begin{code}
  staticClosureRequired
-       :: Id
+       :: Name
         -> StgBinderInfo
         -> LambdaFormInfo
         -> Bool
         -> StgBinderInfo
         -> LambdaFormInfo
         -> Bool
-staticClosureRequired binder (StgBinderInfo arg_occ unsat_occ _ _ _)
-                     (LFReEntrant top_level _ _)       -- It's a function
-  = ASSERT( top_level )                        -- Assumption: it's a top-level, no-free-var binding
-    arg_occ            -- There's an argument occurrence
-    || unsat_occ       -- There's an unsaturated call
-    || externallyVisibleId binder
+staticClosureRequired binder bndr_info
+                     (LFReEntrant top_level _ _ _)     -- It's a function
+  = ASSERT( isTopLevel top_level )
+       -- Assumption: it's a top-level, no-free-var binding
+       not (satCallsOnly bndr_info)
  
  staticClosureRequired binder other_binder_info other_lf_info = True
  
  staticClosureRequired binder other_binder_info other_lf_info = True
-
-slowFunEntryCodeRequired       -- Assumption: it's a function, not a thunk.
-       :: Id
-       -> StgBinderInfo
-       -> EntryConvention
-       -> Bool
-slowFunEntryCodeRequired binder (StgBinderInfo arg_occ unsat_occ _ _ _) entry_conv
-  = arg_occ            -- There's an argument occurrence
-    || unsat_occ       -- There's an unsaturated call
-    || externallyVisibleId binder
-    || (case entry_conv of { DirectEntry _ _ _ -> False; other -> True })
-           {- The last case deals with the parallel world; a function usually
-              as a DirectEntry convention, but if it doesn't we must generate slow-entry code -}
-
-slowFunEntryCodeRequired binder NoStgBinderInfo _ = True
-
-funInfoTableRequired
-       :: Id
-       -> StgBinderInfo
-       -> LambdaFormInfo
-       -> Bool
-funInfoTableRequired  binder (StgBinderInfo arg_occ unsat_occ _ _ _)
-                    (LFReEntrant top_level _ _)
-  = not top_level
-    || arg_occ                 -- There's an argument occurrence
-    || unsat_occ       -- There's an unsaturated call
-    || externallyVisibleId binder
-
-funInfoTableRequired other_binder_info binder other_lf_info = True
-
--- We need the vector-apply entry points for a function if
--- there's a vector-apply occurrence in this module
-
-stdVapRequired, noUpdVapRequired :: StgBinderInfo -> Bool
-
-stdVapRequired binder_info
-  = case binder_info of
-      StgBinderInfo _ _ std_vap_occ _ _ -> std_vap_occ
-      _                                        -> False
-
-noUpdVapRequired binder_info
-  = case binder_info of
-      StgBinderInfo _ _ _ no_upd_vap_occ _ -> no_upd_vap_occ
-      _                                           -> False
-\end{code}
-
-@lfArity@ extracts the arity of a function from its LFInfo
-
-\begin{code}
-{- Not needed any more
-
-lfArity_maybe (LFReEntrant _ arity _) = Just arity
-
--- Removed SLPJ March 97. I don't believe these two; 
--- LFCon is used for construcor *applications*, not constructors!
---
--- lfArity_maybe (LFCon con _)       = Just (dataConArity con)
--- lfArity_maybe (LFTuple con _)             = Just (dataConArity con)
-
-lfArity_maybe other                  = Nothing
--}
  \end{code}
  
  %************************************************************************
  \end{code}
  
  %************************************************************************
@@ -1055,270 +891,456 @@ lfArity_maybe other                  = Nothing
  \begin{code}
  
  isStaticClosure :: ClosureInfo -> Bool
  \begin{code}
  
  isStaticClosure :: ClosureInfo -> Bool
-isStaticClosure  (MkClosureInfo _ _ rep) = isStaticRep  rep
-
-closureId :: ClosureInfo -> Id
-closureId (MkClosureInfo id _ _) = id
-
-closureSMRep :: ClosureInfo -> SMRep
-closureSMRep (MkClosureInfo _ _ sm_rep) = sm_rep
-
-closureLFInfo :: ClosureInfo -> LambdaFormInfo
-closureLFInfo (MkClosureInfo _ lf_info _) = lf_info
+isStaticClosure cl_info = isStaticRep (closureSMRep cl_info)
  
  closureUpdReqd :: ClosureInfo -> Bool
  
  closureUpdReqd :: ClosureInfo -> Bool
-
-closureUpdReqd (MkClosureInfo _ (LFThunk _ _ upd _) _) = upd
-closureUpdReqd (MkClosureInfo _ LFBlackHole _)         = True
+closureUpdReqd (ClosureInfo { closureLFInfo = LFThunk _ _ upd _ _ }) = upd
+closureUpdReqd (ClosureInfo { closureLFInfo = LFBlackHole _ })     = True
         -- Black-hole closures are allocated to receive the results of an
         -- alg case with a named default... so they need to be updated.
         -- Black-hole closures are allocated to receive the results of an
         -- alg case with a named default... so they need to be updated.
-closureUpdReqd other_closure                          = False
+closureUpdReqd other_closure = False
  
  closureSingleEntry :: ClosureInfo -> Bool
  
  closureSingleEntry :: ClosureInfo -> Bool
-
-closureSingleEntry (MkClosureInfo _ (LFThunk _ _ upd _) _) = not upd
-closureSingleEntry other_closure                          = False
-\end{code}
-
-Note: @closureType@ returns appropriately specialised tycon and
-datacons.
-\begin{code}
-closureType :: ClosureInfo -> Maybe (TyCon, [Type], [Id])
-
--- First, a turgid special case.  When we are generating the
--- standard code and info-table for Vaps (which is done when the function
--- defn is encountered), we don't have a convenient Id to hand whose
--- type is that of (f x y z).  So we need to figure out the type
--- rather than take it from the Id. The Id is probably just "f"!
-
-closureType (MkClosureInfo id (LFThunk _ _ _ (VapThunk fun_id args _)) _)
-  = splitAlgTyConApp_maybe (fun_result_ty (length args) (idType fun_id))
-
-closureType (MkClosureInfo id lf _) = splitAlgTyConApp_maybe (idType id)
-\end{code}
-
-@closureReturnsUnpointedType@ is used to check whether a closure, {\em
-once it has eaten its arguments}, returns an unboxed type.  For
-example, the closure for a function:
-\begin{verbatim}
-       f :: Int -> Int#
-\end{verbatim}
-returns an unboxed type.  This is important when dealing with stack
-overflow checks.
-\begin{code}
-closureReturnsUnpointedType :: ClosureInfo -> Bool
-
-closureReturnsUnpointedType (MkClosureInfo fun_id (LFReEntrant _ arity _) _)
-  = isUnpointedType (fun_result_ty arity (idType fun_id))
-
-closureReturnsUnpointedType other_closure = False
-       -- All non-function closures aren't functions,
-       -- and hence are boxed, since they are heap alloc'd
-
--- fun_result_ty is a disgusting little bit of code that finds the result
--- type of a function application.  It looks "through" new types.
--- We don't have type args available any more, so we are pretty cavilier,
--- and quite possibly plain wrong. Let's hope it doesn't matter if we are!
-
-fun_result_ty arity ty
-  | arity <= n_arg_tys
-  = mkFunTys (drop arity arg_tys) res_ty
-
-  | otherwise
-  = case splitAlgTyConApp_maybe res_ty of
-      Nothing -> pprPanic "fun_result_ty:" (hsep [int arity,
-                                                 ppr ty])
-
-      Just (tycon, tycon_arg_tys, [con]) | isNewTyCon tycon
-          -> fun_result_ty (arity - n_arg_tys) rep_ty
-          where
-             ([rep_ty], _) = splitFunTys (applyTys (idType con) tycon_arg_tys)
-      Just _ ->
-           pprPanic "fun_result_ty:" (hsep [int arity,
-                                           ppr ty,
-                                           ppr res_ty])
-  where
-     (_, rho_ty)       = splitForAllTys ty
-     (arg_tys, res_ty)  = splitFunTys rho_ty
-     n_arg_tys         = length arg_tys
-\end{code}
-
-\begin{code}
-closureSemiTag :: ClosureInfo -> Int
-
-closureSemiTag (MkClosureInfo _ lf_info _)
-  = case lf_info of
-      LFCon data_con _ -> dataConTag data_con - fIRST_TAG
-      LFTuple _ _      -> 0
-      _                       -> fromInteger oTHER_TAG
+closureSingleEntry (ClosureInfo { closureLFInfo = LFThunk _ _ upd _ _}) = not upd
+closureSingleEntry other_closure = False
+
+closureReEntrant :: ClosureInfo -> Bool
+closureReEntrant (ClosureInfo { closureLFInfo = LFReEntrant _ _ _ _ }) = True
+closureReEntrant other_closure = False
+
+closureSemiTag :: ClosureInfo -> Maybe Int
+closureSemiTag (ConInfo { closureCon = data_con })
+      = Just (dataConTag data_con - fIRST_TAG)
+closureSemiTag _ = Nothing
+
+closureFunInfo :: ClosureInfo -> Maybe (Int, ArgDescr)
+closureFunInfo (ClosureInfo { closureLFInfo = LFReEntrant _ arity _ arg_desc})
+  = Just (arity, arg_desc)
+closureFunInfo _
+  = Nothing
  \end{code}
  
  \begin{code}
  isToplevClosure :: ClosureInfo -> Bool
  \end{code}
  
  \begin{code}
  isToplevClosure :: ClosureInfo -> Bool
-
-isToplevClosure (MkClosureInfo _ lf_info _)
+isToplevClosure (ClosureInfo { closureLFInfo = lf_info })
    = case lf_info of
    = case lf_info of
-      LFReEntrant top _ _ -> top
-      LFThunk top _ _ _   -> top
-      _ -> panic "ClosureInfo:isToplevClosure"
+      LFReEntrant TopLevel _ _ _ -> True
+      LFThunk TopLevel _ _ _ _   -> True
+      other -> False
+isToplevClosure _ = False
  \end{code}
  
  Label generation.
  
  \begin{code}
  \end{code}
  
  Label generation.
  
  \begin{code}
-fastLabelFromCI :: ClosureInfo -> CLabel
-fastLabelFromCI (MkClosureInfo id lf_info _)
-{-     [SLPJ Changed March 97]
-        (was ok, but is the only call to lfArity, 
-         and the id should guarantee to have the correct arity in it.
-
-  = case lfArity_maybe lf_info of
-       Just arity -> 
--}
-  = case getIdArity id of
-       ArityExactly arity -> mkFastEntryLabel id arity
-       other              -> pprPanic "fastLabelFromCI" (ppr id)
-
  infoTableLabelFromCI :: ClosureInfo -> CLabel
  infoTableLabelFromCI :: ClosureInfo -> CLabel
-infoTableLabelFromCI (MkClosureInfo id lf_info rep)
+infoTableLabelFromCI (ClosureInfo { closureName = name,
+                                   closureLFInfo = lf_info, 
+                                   closureSMRep = rep })
    = case lf_info of
    = case lf_info of
-       LFCon con _     -> mkConInfoPtr con rep
-       LFTuple tup _   -> mkConInfoPtr tup rep
+       LFBlackHole info -> info
  
  
-       LFBlackHole     -> mkBlackHoleInfoTableLabel
+       LFThunk _ _ upd_flag (SelectorThunk offset) _ -> 
+               mkSelectorInfoLabel upd_flag offset
  
  
-       LFThunk _ _ upd_flag (VapThunk fun_id args _) -> mkVapInfoTableLabel fun_id upd_flag
-                                       -- Use the standard vap info table
-                                       -- for the function, rather than a one-off one
-                                       -- for this particular closure
+       LFThunk _ _ upd_flag (ApThunk arity) _ -> 
+               mkApInfoTableLabel upd_flag arity
  
  
-{-     For now, we generate individual info table and entry code for selector thunks,
-       so their info table should be labelled in the standard way.
-       The only special thing about them is that the info table has a field which
-       tells the GC that it really is a selector.
+       LFThunk{}      -> mkInfoTableLabel name
  
  
-       Later, perhaps, we'll have some standard RTS code for selector-thunk info tables,
-       in which case this line will spring back to life.
+       LFReEntrant _ _ _ (ArgGen _ _) -> mkInfoTableLabel name
+       LFReEntrant _ _ _ _             -> mkInfoTableLabel name
  
  
-       LFThunk _ _ upd_flag (SelectorThunk _ _ offset) -> mkSelectorInfoTableLabel upd_flag offset
-                                       -- Ditto for selectors
--}
+       other -> panic "infoTableLabelFromCI"
+
+infoTableLabelFromCI (ConInfo { closureCon = con, closureSMRep = rep })
+  =  mkConInfoPtr con rep
  
  
-       other -> {-NO: if isStaticRep rep
-                then mkStaticInfoTableLabel id
-                else -} mkInfoTableLabel id
  
  
-mkConInfoPtr :: Id -> SMRep -> CLabel
+mkConInfoPtr :: DataCon -> SMRep -> CLabel
  mkConInfoPtr con rep
  mkConInfoPtr con rep
-  = ASSERT(isDataCon con)
-    case rep of
-      PhantomRep    -> mkPhantomInfoTableLabel con
-      StaticRep _ _ -> mkStaticInfoTableLabel  con
-      _                    -> mkConInfoTableLabel     con
+  | isStaticRep rep = mkStaticInfoTableLabel  name
+  | otherwise      = mkConInfoTableLabel     name
+  where
+    name = dataConName con
  
  
-mkConEntryPtr :: Id -> SMRep -> CLabel
+mkConEntryPtr :: DataCon -> SMRep -> CLabel
  mkConEntryPtr con rep
  mkConEntryPtr con rep
-  = ASSERT(isDataCon con)
-    case rep of
-      StaticRep _ _ -> mkStaticConEntryLabel con
-      _                    -> mkConEntryLabel con
-
+  | isStaticRep rep = mkStaticConEntryLabel (dataConName con)
+  | otherwise       = mkConEntryLabel       (dataConName con)
  
  
-closureLabelFromCI (MkClosureInfo id _ rep) 
-       | isConstantRep rep
-       = mkStaticClosureLabel id
-       -- This case catches those pesky static closures for nullary constructors
-
-closureLabelFromCI (MkClosureInfo id _ other_rep)   = mkClosureLabel id
+closureLabelFromCI (ClosureInfo { closureName = nm }) = mkClosureLabel nm
+closureLabelFromCI _ = panic "closureLabelFromCI"
  
  entryLabelFromCI :: ClosureInfo -> CLabel
  
  entryLabelFromCI :: ClosureInfo -> CLabel
-entryLabelFromCI (MkClosureInfo id lf_info rep)
+entryLabelFromCI (ClosureInfo { closureName = id, 
+                               closureLFInfo = lf_info, 
+                               closureSMRep = rep })
    = case lf_info of
    = case lf_info of
-       LFThunk _ _ upd_flag std_form_info -> thunkEntryLabel id std_form_info upd_flag
-       LFCon con _                        -> mkConEntryPtr con rep
-       LFTuple tup _                      -> mkConEntryPtr tup rep
-       other                              -> mkStdEntryLabel id
+       LFThunk _ _ upd_flag std_form_info _ -> 
+               thunkEntryLabel id std_form_info upd_flag
+       other -> mkEntryLabel id
+
+entryLabelFromCI (ConInfo { closureCon = con, closureSMRep = rep })
+  = mkConEntryPtr con rep
+
  
  -- thunkEntryLabel is a local help function, not exported.  It's used from both
  -- entryLabelFromCI and getEntryConvention.
  
  -- thunkEntryLabel is a local help function, not exported.  It's used from both
  -- entryLabelFromCI and getEntryConvention.
--- I don't think it needs to deal with the SelectorThunk case
--- Well, it's falling over now, so I've made it deal with it.  (JSM)
  
  
-thunkEntryLabel thunk_id (VapThunk fun_id args _) is_updatable
-  = mkVapEntryLabel fun_id is_updatable
+thunkEntryLabel thunk_id (ApThunk arity) is_updatable
+  = mkApEntryLabel is_updatable arity
+thunkEntryLabel thunk_id (SelectorThunk offset) upd_flag
+  = mkSelectorEntryLabel upd_flag offset
  thunkEntryLabel thunk_id _ is_updatable
  thunkEntryLabel thunk_id _ is_updatable
-  = mkStdEntryLabel thunk_id
+  = mkEntryLabel thunk_id
  \end{code}
  
  \begin{code}
  \end{code}
  
  \begin{code}
-allocProfilingMsg :: ClosureInfo -> FAST_STRING
-
-allocProfilingMsg (MkClosureInfo _ lf_info _)
+allocProfilingMsg :: ClosureInfo -> FastString
+allocProfilingMsg ConInfo{} = FSLIT("TICK_ALLOC_CON")
+allocProfilingMsg ClosureInfo{ closureLFInfo = lf_info }
    = case lf_info of
    = case lf_info of
-      LFReEntrant _ _ _                -> SLIT("ALLOC_FUN")
-      LFCon _ _                        -> SLIT("ALLOC_CON")
-      LFTuple _ _              -> SLIT("ALLOC_CON")
-      LFThunk _ _ _ _          -> SLIT("ALLOC_THK")
-      LFBlackHole              -> SLIT("ALLOC_BH")
-      LFImported               -> panic "ALLOC_IMP"
+      LFReEntrant _ _ _ _   -> FSLIT("TICK_ALLOC_FUN")
+      LFThunk _ _ True _ _  -> FSLIT("TICK_ALLOC_UP_THK")  -- updatable
+      LFThunk _ _ False _ _ -> FSLIT("TICK_ALLOC_SE_THK")  -- nonupdatable
+      LFBlackHole _        -> FSLIT("TICK_ALLOC_BH")
+      _                            -> panic "allocProfilingMsg"
  \end{code}
  
  We need a black-hole closure info to pass to @allocDynClosure@ when we
  \end{code}
  
  We need a black-hole closure info to pass to @allocDynClosure@ when we
-want to allocate the black hole on entry to a CAF.
+want to allocate the black hole on entry to a CAF.  These are the only
+ways to build an LFBlackHole, maintaining the invariant that it really
+is a black hole and not something else.
  
  \begin{code}
  
  \begin{code}
-blackHoleClosureInfo (MkClosureInfo id _ _)
-  = MkClosureInfo id LFBlackHole BlackHoleRep
+cafBlackHoleClosureInfo (ClosureInfo { closureName = nm,
+                                      closureType = ty })
+  = ClosureInfo { closureName   = nm,
+                 closureLFInfo = LFBlackHole mkCAFBlackHoleInfoTableLabel,
+                 closureSMRep  = BlackHoleRep,
+                 closureSRT    = NoC_SRT,
+                 closureType   = ty,
+                 closureDescr  = "" }
+cafBlackHoleClosureInfo _ = panic "cafBlackHoleClosureInfo"
+
+seCafBlackHoleClosureInfo (ClosureInfo { closureName = nm,
+                                        closureType = ty })
+  = ClosureInfo { closureName   = nm,
+                 closureLFInfo = LFBlackHole mkSECAFBlackHoleInfoTableLabel,
+                 closureSMRep  = BlackHoleRep,
+                 closureSRT    = NoC_SRT,
+                 closureType   = ty,
+                 closureDescr  = ""  }
+seCafBlackHoleClosureInfo _ = panic "seCafBlackHoleClosureInfo"
  \end{code}
  
  \end{code}
  
-The register liveness when returning from a constructor.  For
-simplicity, we claim just [node] is live for all but PhantomRep's.  In
-truth, this means that non-constructor info tables also claim node,
-but since their liveness information is never used, we don't care.
+%************************************************************************
+%*                                                                     *
+\subsection[ClosureInfo-Profiling-funs]{Misc functions about for profiling info.}
+%*                                                                     *
+%************************************************************************
+
+Profiling requires two pieces of information to be determined for
+each closure's info table --- description and type.
+
+The description is stored directly in the @CClosureInfoTable@ when the
+info table is built.
+
+The type is determined from the type information stored with the @Id@
+in the closure info using @closureTypeDescr@.
  
  \begin{code}
  
  \begin{code}
-dataConLiveness (MkClosureInfo con _ PhantomRep)
-  = case (dataReturnConvAlg con) of
-      ReturnInRegs regs -> mkLiveRegsMask regs
-      ReturnInHeap -> panic "dataConLiveness:PhantomRep in heap???"
+closureTypeDescr :: ClosureInfo -> String
+closureTypeDescr (ClosureInfo { closureType = ty })
+  = getTyDescription ty
+closureTypeDescr (ConInfo { closureCon = data_con })
+  = occNameUserString (getOccName (dataConTyCon data_con))
+
+getTyDescription :: Type -> String
+getTyDescription ty
+  = case (tcSplitSigmaTy ty) of { (_, _, tau_ty) ->
+    case tau_ty of
+      TyVarTy _                     -> "*"
+      AppTy fun _                   -> getTyDescription fun
+      FunTy _ res                   -> '-' : '>' : fun_result res
+      NewTcApp tycon _              -> getOccString tycon
+      TyConApp tycon _              -> getOccString tycon
+      NoteTy (FTVNote _) ty  -> getTyDescription ty
+      NoteTy (SynNote ty1) _ -> getTyDescription ty1
+      PredTy sty            -> getPredTyDescription sty
+      ForAllTy _ ty          -> getTyDescription ty
+    }
+  where
+    fun_result (FunTy _ res) = '>' : fun_result res
+    fun_result other        = getTyDescription other
  
  
-dataConLiveness _ = mkLiveRegsMask [node]
+getPredTyDescription (ClassP cl tys) = getOccString cl
+getPredTyDescription (IParam ip ty)  = getOccString (ipNameName ip)
  \end{code}
  
  %************************************************************************
  %*                                                                     *
  \end{code}
  
  %************************************************************************
  %*                                                                     *
-\subsection[ClosureInfo-Profiling-funs]{Misc functions about for profiling info.}
+\subsection{Making argument bitmaps}
  %*                                                                     *
  %************************************************************************
  
  %*                                                                     *
  %************************************************************************
  
-Profiling requires three pices of information to be determined for
-each closure's info table --- kind, description and type.
+\begin{code}
+-- bring in ARG_P, ARG_N, etc.
+#include "../includes/StgFun.h"
+
+data ArgDescr
+  = ArgSpec
+       !Int            -- ARG_P, ARG_N, ...
+  | ArgGen 
+       CLabel          -- label for a slow-entry point
+       Liveness        -- the arg bitmap: describes pointedness of arguments
+
+mkArgDescr :: Name -> [Id] -> ArgDescr
+mkArgDescr nm args = argDescr nm (filter nonVoidRep (map idPrimRep args))
+  where nonVoidRep VoidRep = False
+       nonVoidRep _ = True
+
+argDescr nm [PtrRep]    = ArgSpec ARG_P
+argDescr nm [FloatRep]  = ArgSpec ARG_F
+argDescr nm [DoubleRep] = ArgSpec ARG_D
+argDescr nm [r] | is64BitRep r  = ArgSpec ARG_L
+argDescr nm [r] | isNonPtrRep r = ArgSpec ARG_N
+
+argDescr nm [r1,r2] | isNonPtrRep r1 && isNonPtrRep r2 = ArgSpec ARG_NN
+argDescr nm [r1,PtrRep] | isNonPtrRep r1 = ArgSpec ARG_NP
+argDescr nm [PtrRep,r1] | isNonPtrRep r1 = ArgSpec ARG_PN
+argDescr nm [PtrRep,PtrRep] = ArgSpec ARG_PP
+
+argDescr nm [r1,r2,r3] | isNonPtrRep r1 && isNonPtrRep r2 && isNonPtrRep r3 = ArgSpec ARG_NNN
+argDescr nm [r1,r2,PtrRep] | isNonPtrRep r1 && isNonPtrRep r2 = ArgSpec ARG_NNP
+argDescr nm [r1,PtrRep,r2] | isNonPtrRep r1 && isNonPtrRep r2 = ArgSpec ARG_NPN
+argDescr nm [r1,PtrRep,PtrRep] | isNonPtrRep r1 = ArgSpec ARG_NPP
+argDescr nm [PtrRep,r1,r2] | isNonPtrRep r1 && isNonPtrRep r2 = ArgSpec ARG_PNN
+argDescr nm [PtrRep,r1,PtrRep] | isNonPtrRep r1 = ArgSpec ARG_PNP
+argDescr nm [PtrRep,PtrRep,r1] | isNonPtrRep r1 = ArgSpec ARG_PPN
+argDescr nm [PtrRep,PtrRep,PtrRep] = ArgSpec ARG_PPP
+
+argDescr nm [PtrRep,PtrRep,PtrRep,PtrRep] = ArgSpec ARG_PPPP
+argDescr nm [PtrRep,PtrRep,PtrRep,PtrRep,PtrRep] = ArgSpec ARG_PPPPP
+argDescr nm [PtrRep,PtrRep,PtrRep,PtrRep,PtrRep,PtrRep] = ArgSpec ARG_PPPPPP
+
+argDescr name reps = ArgGen (mkSlowEntryLabel name) liveness
+ where bitmap = argBits reps
+       lbl = mkBitmapLabel name
+       liveness = Liveness lbl (length bitmap) (mkBitmap bitmap) 
+
+argBits [] = []
+argBits (rep : args)
+  | isFollowableRep rep = False : argBits args
+  | otherwise = take (getPrimRepSize rep) (repeat True) ++ argBits args
+\end{code}
  
  
-The description is stored directly in the @CClosureInfoTable@ when the
-info table is built.
  
  
-The kind is determined from the @LambdaForm@ stored in the closure
-info using @closureKind@.
+%************************************************************************
+%*                                                                     *
+\subsection{Generating info tables}
+%*                                                                     *
+%************************************************************************
  
  
-The type is determined from the type information stored with the @Id@
-in the closure info using @closureTypeDescr@.
+Here we make a concrete info table, represented as a list of CAddrMode
+(it can't be simply a list of Word, because the SRT field is
+represented by a label+offset expression).
  
  \begin{code}
  
  \begin{code}
-closureKind :: ClosureInfo -> String
+mkInfoTable :: ClosureInfo -> [CAddrMode]
+mkInfoTable cl_info
+ | tablesNextToCode = extra_bits ++ std_info
+ | otherwise        = std_info ++ extra_bits
+ where
+    std_info = mkStdInfoTable entry_amode
+                 ty_descr_amode cl_descr_amode cl_type srt_len layout_amode
+
+    entry_amode = CLbl (entryLabelFromCI cl_info) CodePtrRep 
+
+    closure_descr = 
+       case cl_info of
+         ClosureInfo { closureDescr = descr } -> descr
+         ConInfo { closureCon = con } -> occNameUserString (getOccName con)
+
+    ty_descr_amode = CLit (MachStr (mkFastString (closureTypeDescr cl_info)))
+    cl_descr_amode = CLit (MachStr (mkFastString closure_descr))
+
+    cl_type = getSMRepClosureTypeInt (closureSMRep cl_info)
+
+    srt = closureSRT cl_info        
+    needs_srt = needsSRT srt
+
+    semi_tag = closureSemiTag cl_info
+    is_con = isJust semi_tag
+
+    (srt_label,srt_len)
+       | Just tag <- semi_tag = (mkIntCLit 0, fromIntegral tag) -- constructor
+       | otherwise = 
+         case srt of
+           NoC_SRT -> (mkIntCLit 0, 0)
+           C_SRT lbl off bitmap -> 
+             (CAddr (CIndex (CLbl lbl DataPtrRep) (mkIntCLit off) WordRep),
+              bitmap)
+
+    ptrs  = closurePtrsSize cl_info
+    nptrs = size - ptrs
+    size  = closureNonHdrSize cl_info
+
+    layout_info :: StgWord
+#ifdef WORDS_BIGENDIAN
+    layout_info = (fromIntegral ptrs `shiftL` hALF_WORD) .|. fromIntegral nptrs
+#else 
+    layout_info = (fromIntegral ptrs) .|. (fromIntegral nptrs `shiftL` hALF_WORD)
+#endif      
+
+    layout_amode = mkWordCLit layout_info
+
+    extra_bits
+       | is_fun    = fun_extra_bits
+       | is_con    = []
+       | needs_srt = [srt_label]
+       | otherwise = []
+
+    maybe_fun_stuff = closureFunInfo cl_info
+    is_fun = isJust maybe_fun_stuff
+    (Just (arity, arg_descr)) = maybe_fun_stuff
+
+    fun_extra_bits
+       | tablesNextToCode = reg_fun_extra_bits
+       | otherwise        = reverse reg_fun_extra_bits
+
+    reg_fun_extra_bits
+       | ArgGen slow_lbl liveness <- arg_descr
+               = [
+                  CLbl slow_lbl CodePtrRep, 
+                  livenessToAddrMode liveness,
+                  srt_label,
+                  fun_amode
+                 ]
+       | needs_srt = [srt_label, fun_amode]
+       | otherwise = [fun_amode]
+
+#ifdef WORDS_BIGENDIAN
+    fun_desc = (fromIntegral fun_type `shiftL` hALF_WORD) .|. fromIntegral arity
+#else 
+    fun_desc = (fromIntegral fun_type) .|. (fromIntegral arity `shiftL` hALF_WORD)
+#endif
  
  
-closureKind (MkClosureInfo _ lf _)
-  = case lf of
-      LFReEntrant _ n _                -> if n > 0 then "FN_K" else "THK_K"
-      LFCon _ _                        -> "CON_K"
-      LFTuple _ _              -> "CON_K"
-      LFThunk _ _ _ _          -> "THK_K"
-      LFBlackHole              -> "THK_K" -- consider BHs as thunks for the moment... (ToDo?)
-      LFImported               -> panic "IMP_KIND"
+    fun_amode = mkWordCLit fun_desc
+
+    fun_type = case arg_descr of
+               ArgSpec n -> n
+               ArgGen _ (Liveness _ size _)
+                       | size <= mAX_SMALL_BITMAP_SIZE -> ARG_GEN
+                       | otherwise                     -> ARG_GEN_BIG
+
+-- Return info tables come in two flavours: direct returns and
+-- vectored returns.
+
+mkRetInfoTable :: CLabel -> C_SRT -> Liveness -> [CAddrMode]
+mkRetInfoTable entry_lbl srt liveness
+ = mkBitmapInfoTable (CLbl entry_lbl CodePtrRep) srt liveness []
+
+mkVecInfoTable :: [CAddrMode] -> C_SRT -> Liveness -> [CAddrMode]
+mkVecInfoTable vector srt liveness
+ = mkBitmapInfoTable zero_amode srt liveness vector
+
+mkBitmapInfoTable
+   :: CAddrMode
+   -> C_SRT -> Liveness
+   -> [CAddrMode]
+   -> [CAddrMode]
+mkBitmapInfoTable entry_amode srt liveness vector
+ | tablesNextToCode = extra_bits ++ std_info
+ | otherwise        = std_info ++ extra_bits
+ where
+   std_info = mkStdInfoTable entry_amode zero_amode zero_amode 
+               cl_type srt_len liveness_amode
+
+   liveness_amode = livenessToAddrMode liveness
+
+   (srt_label,srt_len) =
+         case srt of
+           NoC_SRT -> (mkIntCLit 0, 0)
+           C_SRT lbl off bitmap -> 
+                   (CAddr (CIndex (CLbl lbl DataPtrRep) (mkIntCLit off) WordRep),
+                    bitmap)
+
+   cl_type = case (null vector, isBigLiveness liveness) of
+               (True, True)   -> rET_BIG
+               (True, False)  -> rET_SMALL
+               (False, True)  -> rET_VEC_BIG
+               (False, False) -> rET_VEC_SMALL
+
+   srt_bit | needsSRT srt || not (null vector) = [srt_label]
+          | otherwise = []
+
+   extra_bits | tablesNextToCode = reverse vector ++ srt_bit
+              | otherwise        = srt_bit ++ vector
+
+-- The standard bits of an info table.  This part of the info table
+-- corresponds to the StgInfoTable type defined in InfoTables.h.
+
+mkStdInfoTable
+   :: CAddrMode                                -- entry label
+   -> CAddrMode                                -- closure type descr (profiling)
+   -> CAddrMode                                -- closure descr (profiling)
+   -> Int                              -- closure type
+   -> StgHalfWord                      -- SRT length
+   -> CAddrMode                                -- layout field
+   -> [CAddrMode]
+mkStdInfoTable entry_lbl type_descr closure_descr cl_type srt_len layout_amode
+ = std_info
+ where  
+    std_info
+       | tablesNextToCode = std_info'
+       | otherwise        = entry_lbl : std_info'
+
+    std_info' =
+         -- par info
+         prof_info ++
+         -- ticky info
+         -- debug info
+         [layout_amode] ++
+         CLit (MachWord (fromIntegral type_info)) :
+         []
+
+    prof_info 
+       | opt_SccProfilingOn = [ type_descr, closure_descr ]
+       | otherwise = []
+
+    -- sigh: building up the info table is endian-dependent.
+    -- ToDo: do this using .byte and .word directives.
+    type_info :: StgWord
+#ifdef WORDS_BIGENDIAN
+    type_info = (fromIntegral cl_type `shiftL` hALF_WORD) .|.
+               (fromIntegral srt_len)
+#else 
+    type_info = (fromIntegral cl_type) .|.
+               (fromIntegral srt_len `shiftL` hALF_WORD)
+#endif
  
  
-closureTypeDescr :: ClosureInfo -> String
-closureTypeDescr (MkClosureInfo id lf _)
-  = if (isDataCon id) then                      -- DataCon has function types
-       getOccString (dataConTyCon id)           -- We want the TyCon not the ->
-    else
-       getTyDescription (idType id)
+isBigLiveness (Liveness _ size _) = size > mAX_SMALL_BITMAP_SIZE
+
+livenessToAddrMode :: Liveness -> CAddrMode
+livenessToAddrMode (Liveness lbl size bits)
+       | size <= mAX_SMALL_BITMAP_SIZE = small
+       | otherwise = CLbl lbl DataPtrRep
+       where
+         small = mkWordCLit (fromIntegral size .|. (small_bits `shiftL` bITMAP_BITS_SHIFT))
+         small_bits = case bits of 
+                       []  -> 0
+                       [b] -> fromIntegral b
+                       _   -> panic "livenessToAddrMode"
+
+zero_amode = mkIntCLit 0
+
+-- IA64 mangler doesn't place tables next to code
+tablesNextToCode :: Bool
+#ifdef ia64_TARGET_ARCH
+tablesNextToCode = False
+#else
+tablesNextToCode = not opt_Unregisterised
+#endif
  \end{code}
  \end{code}