[project @ 1999-03-11 11:32:22 by simonm]

Save a few bytes by ommitting the static link field on closures with
an empty SRT.

11 files changed, 146 insertions, 104 deletions

diff --git a/ghc/compiler/absCSyn/AbsCSyn.lhs b/ghc/compiler/absCSyn/AbsCSyn.lhs
index da3b412aba..dfaf400f06 100644
--- a/ghc/compiler/absCSyn/AbsCSyn.lhs
+++ b/ghc/compiler/absCSyn/AbsCSyn.lhs
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: AbsCSyn.lhs,v 1.20 1999/03/03 17:41:13 simonm Exp $
+% $Id: AbsCSyn.lhs,v 1.21 1999/03/11 11:32:22 simonm Exp $
 %
 \section[AbstractC]{Abstract C: the last stop before machine code}
 
@@ -185,7 +185,6 @@ stored in a mixed type location.)
 	AbstractC		-- Slow entry point code
 	(Maybe AbstractC)
 				-- Fast entry point code, if any
-	(CLabel,SRT)		-- SRT info
 	String			-- Closure description; NB we can't get this
 				-- from ClosureInfo, because the latter refers 
 				-- to the *right* hand side of a defn, whereas
diff --git a/ghc/compiler/absCSyn/AbsCUtils.lhs b/ghc/compiler/absCSyn/AbsCUtils.lhs
index 3ffafcbc95..e90719c3c8 100644
--- a/ghc/compiler/absCSyn/AbsCUtils.lhs
+++ b/ghc/compiler/absCSyn/AbsCUtils.lhs
@@ -305,11 +305,11 @@ flatAbsC (AbsCStmts s1 s2)
     returnFlt (mkAbsCStmts inline_s1 inline_s2,
 	       mkAbsCStmts top_s1    top_s2)
 
-flatAbsC (CClosureInfoAndCode cl_info slow maybe_fast srt descr)
+flatAbsC (CClosureInfoAndCode cl_info slow maybe_fast descr)
   = flatAbsC slow		`thenFlt` \ (slow_heres, slow_tops) ->
     flat_maybe maybe_fast	`thenFlt` \ (fast_heres, fast_tops) ->
     returnFlt (AbsCNop, mkAbstractCs [slow_tops, fast_tops,
-       CClosureInfoAndCode cl_info slow_heres fast_heres srt descr]
+       CClosureInfoAndCode cl_info slow_heres fast_heres descr]
     )
 
 flatAbsC (CCodeBlock label abs_C)
diff --git a/ghc/compiler/absCSyn/Costs.lhs b/ghc/compiler/absCSyn/Costs.lhs
index 5296a1baf3..3588fe5018 100644
--- a/ghc/compiler/absCSyn/Costs.lhs
+++ b/ghc/compiler/absCSyn/Costs.lhs
@@ -217,7 +217,7 @@ costs absC =
 
    CStaticClosure _ _ _ _    -> nullCosts
 
-   CClosureInfoAndCode _ _ _ _ _ -> nullCosts
+   CClosureInfoAndCode _ _ _ _ -> nullCosts
 
    CRetDirect _ _ _ _	     -> nullCosts
 
diff --git a/ghc/compiler/absCSyn/PprAbsC.lhs b/ghc/compiler/absCSyn/PprAbsC.lhs
index 5aeb8b7c7c..67b22b551f 100644
--- a/ghc/compiler/absCSyn/PprAbsC.lhs
+++ b/ghc/compiler/absCSyn/PprAbsC.lhs
@@ -359,7 +359,7 @@ pprAbsC stmt@(CStaticClosure closure_lbl cl_info cost_centre amodes) _
 		ppLocalnessMacro True{-include dyn-} info_lbl,
 		char ')'
 		],
-	nest 2 (ppr_payload (amodes ++ padding_wds)),
+	nest 2 (ppr_payload (amodes ++ padding_wds ++ static_link_field)),
 	ptext SLIT("};") ]
     }
   where
@@ -378,16 +378,18 @@ pprAbsC stmt@(CStaticClosure closure_lbl cl_info cost_centre amodes) _
       where 
 	rep = getAmodeRep item
 
-    -- always at least one padding word: this is the static link field for
-    -- the garbage collector.
     padding_wds =
 	if not (closureUpdReqd cl_info) then
-	    [mkIntCLit 0]
+	    []
     	else
-	    case 1 + (max 0 (mIN_UPD_SIZE - length amodes)) of { still_needed ->
+	    case max 0 (mIN_UPD_SIZE - length amodes) of { still_needed ->
 	    nOfThem still_needed (mkIntCLit 0) } -- a bunch of 0s
 
-pprAbsC stmt@(CClosureInfoAndCode cl_info slow maybe_fast srt cl_descr) _
+    static_link_field
+	| staticClosureNeedsLink cl_info = [mkIntCLit 0]
+	| otherwise 			 = []
+
+pprAbsC stmt@(CClosureInfoAndCode cl_info slow maybe_fast cl_descr) _
   = vcat [
 	hcat [
 	     ptext SLIT("INFO_TABLE"),
@@ -435,7 +437,8 @@ pprAbsC stmt@(CClosureInfoAndCode cl_info slow maybe_fast srt cl_descr) _
     is_constr = maybeToBool maybe_tag
     (Just tag) = maybe_tag
 
-    needs_srt = has_srt srt && needsSRT cl_info
+    needs_srt = infoTblNeedsSRT cl_info
+    srt = getSRTInfo cl_info
 
     size = closureNonHdrSize cl_info
 
@@ -1461,7 +1464,7 @@ ppr_decls_AbsC (CStaticClosure closure_lbl closure_info cost_centre amodes)
 	-- ToDo: strictly speaking, should chk "cost_centre" amode
   = ppr_decls_Amodes amodes
 
-ppr_decls_AbsC (CClosureInfoAndCode cl_info slow maybe_fast _ _)
+ppr_decls_AbsC (CClosureInfoAndCode cl_info slow maybe_fast _)
   = ppr_decls_Amodes [entry_lbl]	    	`thenTE` \ p1 ->
     ppr_decls_AbsC slow				`thenTE` \ p2 ->
     (case maybe_fast of
diff --git a/ghc/compiler/codeGen/CgClosure.lhs b/ghc/compiler/codeGen/CgClosure.lhs
index c1ddff2d3d..fbd57ad999 100644
--- a/ghc/compiler/codeGen/CgClosure.lhs
+++ b/ghc/compiler/codeGen/CgClosure.lhs
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: CgClosure.lhs,v 1.24 1999/03/02 14:34:36 sof Exp $
+% $Id: CgClosure.lhs,v 1.25 1999/03/11 11:32:25 simonm Exp $
 %
 \section[CgClosure]{Code generation for closures}
 
@@ -72,13 +72,12 @@ They should have no free variables.
 cgTopRhsClosure :: Id
 		-> CostCentreStack	-- Optional cost centre annotation
 		-> StgBinderInfo
-	 	-> SRT
 		-> [Id]		-- Args
 		-> StgExpr
 		-> LambdaFormInfo
 		-> FCode (Id, CgIdInfo)
 
-cgTopRhsClosure id ccs binder_info srt args body lf_info
+cgTopRhsClosure id ccs binder_info args body lf_info
   = 	-- LAY OUT THE OBJECT
     let
 	closure_info = layOutStaticNoFVClosure name lf_info
@@ -107,7 +106,7 @@ cgTopRhsClosure id ccs binder_info srt args body lf_info
     							`thenC`
 
 	-- GENERATE THE INFO TABLE (IF NECESSARY)
-    forkClosureBody (closureCodeBody binder_info srt closure_info
+    forkClosureBody (closureCodeBody binder_info closure_info
 					 ccs args body)
 
     ) `thenC`
@@ -132,7 +131,6 @@ cgStdRhsClosure
 	:: Id
 	-> CostCentreStack	-- Optional cost centre annotation
 	-> StgBinderInfo
-	-> SRT			-- SRT info
 	-> [Id]			-- Free vars
 	-> [Id]			-- Args
 	-> StgExpr
@@ -140,7 +138,7 @@ cgStdRhsClosure
 	-> [StgArg]		-- payload
 	-> FCode (Id, CgIdInfo)
 
-cgStdRhsClosure binder cc binder_info srt fvs args body lf_info payload
+cgStdRhsClosure binder cc binder_info fvs args body lf_info payload
 		-- AHA!  A STANDARD-FORM THUNK
   = (
 	-- LAY OUT THE OBJECT
@@ -169,14 +167,13 @@ Here's the general case.
 cgRhsClosure	:: Id
 		-> CostCentreStack	-- Optional cost centre annotation
 		-> StgBinderInfo
-		-> SRT			-- SRT info
 		-> [Id]			-- Free vars
 		-> [Id]			-- Args
 		-> StgExpr
 		-> LambdaFormInfo
 		-> FCode (Id, CgIdInfo)
 
-cgRhsClosure binder cc binder_info srt fvs args body lf_info
+cgRhsClosure binder cc binder_info fvs args body lf_info
   = (
   	-- LAY OUT THE OBJECT
 	--
@@ -223,7 +220,7 @@ cgRhsClosure binder cc binder_info srt fvs args body lf_info
 		nopC)					`thenC`
 
 		-- Compile the body
-	    closureCodeBody binder_info srt closure_info cc args body
+	    closureCodeBody binder_info closure_info cc args body
     )	`thenC`
 
 	-- BUILD THE OBJECT
@@ -245,7 +242,6 @@ cgRhsClosure binder cc binder_info srt fvs args body lf_info
 
 \begin{code}
 closureCodeBody :: StgBinderInfo
-		-> SRT
 		-> ClosureInfo	   -- Lots of information about this closure
 		-> CostCentreStack -- Optional cost centre attached to closure
 		-> [Id]
@@ -260,14 +256,13 @@ no argument satisfaction check, so fast and slow entry-point labels
 are the same.
 
 \begin{code}
-closureCodeBody binder_info srt closure_info cc [] body
+closureCodeBody binder_info closure_info cc [] body
   = -- thunks cannot have a primitive type!
     getAbsC body_code 	`thenFC` \ body_absC ->
     moduleName		`thenFC` \ mod_name ->
-    getSRTLabel		`thenFC` \ srt_label ->
 
     absC (CClosureInfoAndCode closure_info body_absC Nothing
-			      (srt_label, srt) (cl_descr mod_name))
+			      (cl_descr mod_name))
   where
     cl_descr mod_name = closureDescription mod_name (closureName closure_info)
 
@@ -291,7 +286,7 @@ argSatisfactionCheck (by calling fetchAndReschedule).  There info if
 Node points to closure is available. -- HWL
 
 \begin{code}
-closureCodeBody binder_info srt closure_info cc all_args body
+closureCodeBody binder_info closure_info cc all_args body
   = getEntryConvention name lf_info
 		       (map idPrimRep all_args)		`thenFC` \ entry_conv ->
 
@@ -408,7 +403,6 @@ closureCodeBody binder_info srt closure_info cc all_args body
 				`thenFC` \ slow_abs_c ->
     forkAbsC fast_entry_code	`thenFC` \ fast_abs_c ->
     moduleName			`thenFC` \ mod_name ->
-    getSRTLabel			`thenFC` \ srt_label ->
 
 	-- Now either construct the info table, or put the fast code in alone
 	-- (We never have slow code without an info table)
@@ -417,7 +411,7 @@ closureCodeBody binder_info srt closure_info cc all_args body
     absC (
       if info_table_needed then
 	CClosureInfoAndCode closure_info slow_abs_c (Just fast_abs_c)
-			(srt_label, srt) (cl_descr mod_name)
+			(cl_descr mod_name)
       else
 	CCodeBlock fast_label fast_abs_c
     )
diff --git a/ghc/compiler/codeGen/CgConTbls.lhs b/ghc/compiler/codeGen/CgConTbls.lhs
index d2fddad519..6e4a1493c1 100644
--- a/ghc/compiler/codeGen/CgConTbls.lhs
+++ b/ghc/compiler/codeGen/CgConTbls.lhs
@@ -138,13 +138,9 @@ genConInfo comp_info tycon data_con
     closure_code = if zero_arity_con then 
 			AbsCNop 
 		   else 
-			CClosureInfoAndCode closure_info body Nothing 
-			   srt_info con_descr
+			CClosureInfoAndCode closure_info body Nothing con_descr
 
-    srt_info = (error "genConInfo: no srt label", NoSRT)
-
-    static_code  = CClosureInfoAndCode static_ci body Nothing 
-			srt_info con_descr
+    static_code  = CClosureInfoAndCode static_ci body Nothing con_descr
 
     tag	    	 = dataConTag data_con
 
diff --git a/ghc/compiler/codeGen/CgExpr.lhs b/ghc/compiler/codeGen/CgExpr.lhs
index ddf179dffe..9dbe3a2212 100644
--- a/ghc/compiler/codeGen/CgExpr.lhs
+++ b/ghc/compiler/codeGen/CgExpr.lhs
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: CgExpr.lhs,v 1.19 1999/01/14 17:58:46 sof Exp $
+% $Id: CgExpr.lhs,v 1.20 1999/03/11 11:32:26 simonm Exp $
 %
 %********************************************************
 %*							*
@@ -303,7 +303,7 @@ mkRhsClosure	bndr cc	bi srt
   && maybeToBool maybe_offset			-- Selectee is a component of the tuple
   && offset_into_int <= mAX_SPEC_SELECTEE_SIZE	-- Offset is small enough
   = ASSERT(is_single_constructor)
-    cgStdRhsClosure bndr cc bi srt [the_fv] [] body lf_info [StgVarArg the_fv]
+    cgStdRhsClosure bndr cc bi [the_fv] [] body lf_info [StgVarArg the_fv]
   where
     lf_info 		  = mkSelectorLFInfo (idType bndr) offset_into_int 
 				(isUpdatable upd_flag)
@@ -345,7 +345,7 @@ mkRhsClosure 	bndr cc bi srt
  	&& arity <= mAX_SPEC_AP_SIZE 
 
  		   -- Ha! an Ap thunk
-	= cgStdRhsClosure bndr cc bi srt fvs [] body lf_info payload
+	= cgStdRhsClosure bndr cc bi fvs [] body lf_info payload
 
    where
 	lf_info = mkApLFInfo (idType bndr) upd_flag arity
@@ -359,8 +359,11 @@ The default case
 ~~~~~~~~~~~~~~~~
 \begin{code}
 mkRhsClosure bndr cc bi srt fvs upd_flag args body
-  = cgRhsClosure bndr cc bi srt fvs args body lf_info
-  where lf_info = mkClosureLFInfo bndr NotTopLevel fvs upd_flag args
+  = getSRTLabel		`thenFC` \ srt_label ->
+    let lf_info = 
+	  mkClosureLFInfo bndr NotTopLevel fvs upd_flag args srt_label srt
+    in
+    cgRhsClosure bndr cc bi fvs args body lf_info
 \end{code}
 
 
diff --git a/ghc/compiler/codeGen/ClosureInfo.lhs b/ghc/compiler/codeGen/ClosureInfo.lhs
index c02317d8a0..7a6ff6f074 100644
--- a/ghc/compiler/codeGen/ClosureInfo.lhs
+++ b/ghc/compiler/codeGen/ClosureInfo.lhs
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: ClosureInfo.lhs,v 1.34 1999/03/04 17:52:08 simonm Exp $
+% $Id: ClosureInfo.lhs,v 1.35 1999/03/11 11:32:27 simonm Exp $
 %
 \section[ClosureInfo]{Data structures which describe closures}
 
@@ -50,7 +50,10 @@ module ClosureInfo (
 	allocProfilingMsg,
 	blackHoleClosureInfo,
 	maybeSelectorInfo,
-	needsSRT
+
+	infoTblNeedsSRT,
+	staticClosureNeedsLink,
+	getSRTInfo
     ) where
 
 #include "HsVersions.h"
@@ -118,6 +121,8 @@ data LambdaFormInfo
 	TopLevelFlag	-- True if top level
 	!Int		-- Arity
 	!Bool		-- True <=> no fvs
+	CLabel		-- SRT label
+	SRT		-- SRT info
 
   | LFCon		-- Constructor
 	DataCon		-- The constructor
@@ -133,6 +138,8 @@ data LambdaFormInfo
 	!Bool		-- True <=> no free vars
 	Bool		-- True <=> updatable (i.e., *not* single-entry)
 	StandardFormInfo
+	CLabel		-- SRT label
+	SRT		-- SRT info
 
   | LFArgument		-- Used for function arguments.  We know nothing about
 			-- this closure.  Treat like updatable "LFThunk"...
@@ -199,20 +206,23 @@ mkClosureLFInfo :: Id		-- The binder
 		-> [Id]		-- Free vars
 		-> UpdateFlag 	-- Update flag
 		-> [Id] 	-- Args
+		-> CLabel	-- SRT label
+		-> SRT		-- SRT info
 		-> LambdaFormInfo
 
-mkClosureLFInfo bndr top fvs upd_flag args@(_:_)  -- Non-empty args
-  = LFReEntrant (idType bndr) top (length args) (null fvs)
+mkClosureLFInfo bndr top fvs upd_flag args@(_:_) srt_label srt -- Non-empty args
+  = LFReEntrant (idType bndr) top (length args) (null fvs) srt_label srt
 
-mkClosureLFInfo bndr top fvs ReEntrant []
-  = LFReEntrant (idType bndr) top 0 (null fvs)
+mkClosureLFInfo bndr top fvs ReEntrant [] srt_label srt
+  = LFReEntrant (idType bndr) top 0 (null fvs) srt_label srt
 
-mkClosureLFInfo bndr top fvs upd_flag []
+mkClosureLFInfo bndr top fvs upd_flag [] srt_label srt
 #ifdef DEBUG
   | isUnLiftedType ty = pprPanic "mkClosureLFInfo" (ppr bndr <+> ppr ty)
 #endif
   | otherwise
   = LFThunk ty top (null fvs) (isUpdatable upd_flag) NonStandardThunk
+	srt_label srt
   where
     ty = idType bndr
 \end{code}
@@ -228,10 +238,14 @@ mkConLFInfo con
 
 mkSelectorLFInfo rhs_ty offset updatable
   = LFThunk rhs_ty NotTopLevel False updatable (SelectorThunk offset)
+	(error "mkSelectorLFInfo: no srt label")
+	(error "mkSelectorLFInfo: no srt")
 
 mkApLFInfo rhs_ty upd_flag arity
   = LFThunk rhs_ty NotTopLevel (arity == 0) (isUpdatable upd_flag) 
 	(ApThunk arity)
+	(error "mkApLFInfo: no srt label")
+	(error "mkApLFInfo: no srt")
 \end{code}
 
 Miscellaneous LF-infos.
@@ -247,7 +261,11 @@ mkLFImported id
       ArityExactly 0	-> LFThunk (idType id)
 				TopLevel True{-no fvs-}
 				True{-updatable-} NonStandardThunk
+				(error "mkLFImported: no srt label") 
+				(error "mkLFImported: no srt")
       ArityExactly n	-> LFReEntrant (idType id) TopLevel n True  -- n > 0
+				(error "mkLFImported: no srt label") 
+				(error "mkLFImported: no srt")
       other	   	-> LFImported	-- Not sure of exact arity
 \end{code}
 
@@ -434,14 +452,14 @@ chooseDynSMRep lf_info tot_wds ptr_wds
 getStaticClosureType :: LambdaFormInfo -> ClosureType
 getStaticClosureType lf_info =
     case lf_info of
-        LFCon con True        -> CONSTR_NOCAF
-	LFCon con False       -> CONSTR
-  	LFReEntrant _ _ _ _   -> FUN
-	LFTuple _ _	      -> CONSTR
-	LFThunk _ _ _ _ (SelectorThunk _) -> THUNK_SELECTOR
-	LFThunk _ _ _ True _  -> THUNK
-	LFThunk _ _ _ False _ -> FUN
-	_                     -> panic "getClosureType"
+        LFCon con True            -> CONSTR_NOCAF
+	LFCon con False           -> CONSTR
+  	LFReEntrant _ _ _ _ _ _   -> FUN
+	LFTuple _ _	          -> CONSTR
+	LFThunk _ _ _ _ (SelectorThunk _) _ _ -> THUNK_SELECTOR
+	LFThunk _ _ _ True  _ _ _ -> THUNK
+	LFThunk _ _ _ False _ _ _ -> FUN
+	_                         -> panic "getClosureType"
 
 -- 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
@@ -457,7 +475,7 @@ getClosureType tot_wds ptrs nptrs lf_info =
 		| tot_wds > 0 && tot_wds <= mAX_SPEC_CONSTR_SIZE -> CONSTR_p_n ptrs nptrs
 		| otherwise -> CONSTR
 
-  	LFReEntrant _ _ _ _ 
+  	LFReEntrant _ _ _ _ _ _
 		| tot_wds > 0 && tot_wds <= mAX_SPEC_FUN_SIZE -> FUN_p_n ptrs nptrs
 		| otherwise -> FUN
 
@@ -465,9 +483,9 @@ getClosureType tot_wds ptrs nptrs lf_info =
 		| tot_wds > 0 && tot_wds <= mAX_SPEC_CONSTR_SIZE -> CONSTR_p_n ptrs nptrs
 		| otherwise -> CONSTR
 
-	LFThunk _ _ _ _ (SelectorThunk _) -> THUNK_SELECTOR
+	LFThunk _ _ _ _ (SelectorThunk _) _ _ -> THUNK_SELECTOR
 
-	LFThunk _ _ _ _ _
+	LFThunk _ _ _ _ _ _ _
 		| tot_wds > 0 && tot_wds <= mAX_SPEC_THUNK_SIZE -> THUNK_p_n ptrs nptrs
 		| otherwise -> THUNK
 
@@ -523,7 +541,7 @@ nodeMustPointToIt :: LambdaFormInfo -> FCode Bool
 nodeMustPointToIt lf_info
 
   = case lf_info of
-	LFReEntrant ty top arity no_fvs -> returnFC (
+	LFReEntrant ty top arity no_fvs _ _ -> returnFC (
 	    not no_fvs ||   -- Certainly if it has fvs we need to point to it
 	    case top of { TopLevel -> False; _ -> True }
 		    -- If it is not top level we will point to it
@@ -550,7 +568,7 @@ nodeMustPointToIt lf_info
 	-- having Node point to the result of an update.  SLPJ
 	-- 27/11/92.
 
-	LFThunk _ _ no_fvs updatable NonStandardThunk
+	LFThunk _ _ no_fvs updatable NonStandardThunk _ _
 	  -> returnFC (updatable || not no_fvs || opt_SccProfilingOn)
 
 	  -- For the non-updatable (single-entry case):
@@ -560,7 +578,7 @@ nodeMustPointToIt lf_info
 	  -- 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.
 
@@ -633,7 +651,7 @@ getEntryConvention name lf_info arg_kinds
 
     case lf_info of
 
-	LFReEntrant _ _ arity _ ->
+	LFReEntrant _ _ arity _ _ _ ->
 	    if arity == 0 || (length arg_kinds) < arity then
 		StdEntry (mkStdEntryLabel name)
 	    else
@@ -659,7 +677,7 @@ getEntryConvention name lf_info arg_kinds
 			     -- Should have no args (meaning what?)
 			     StdEntry (mkConEntryLabel (dataConName tup))
 
-	LFThunk _ _ _ updatable std_form_info
+	LFThunk _ _ _ updatable std_form_info _ _
 	  -> if updatable
 	     then ViaNode
 	     else StdEntry (thunkEntryLabel name std_form_info updatable)
@@ -694,9 +712,9 @@ blackHoleOnEntry (MkClosureInfo _ _ (StaticRep _ _ _)) = False
 
 blackHoleOnEntry (MkClosureInfo _ lf_info _)
   = case lf_info of
-	LFReEntrant _ _ _ _	  -> False
+	LFReEntrant _ _ _ _ _ _	  -> False
 	LFLetNoEscape _		  -> False
-	LFThunk _ _ no_fvs updatable _
+	LFThunk _ _ no_fvs updatable _ _ _
 	  -> if updatable
 	     then not opt_OmitBlackHoling
 	     else not no_fvs
@@ -704,23 +722,45 @@ blackHoleOnEntry (MkClosureInfo _ lf_info _)
 
 isStandardFormThunk :: LambdaFormInfo -> Bool
 
-isStandardFormThunk (LFThunk _ _ _ _ (SelectorThunk _)) = True
-isStandardFormThunk (LFThunk _ _ _ _ (ApThunk _)) 	= True
-isStandardFormThunk other_lf_info 			= False
+isStandardFormThunk (LFThunk _ _ _ _ (SelectorThunk _) _ _) = True
+isStandardFormThunk (LFThunk _ _ _ _ (ApThunk _) _ _)	    = True
+isStandardFormThunk other_lf_info 			    = False
 
 maybeSelectorInfo (MkClosureInfo _ (LFThunk _ _ _ _
-			(SelectorThunk offset)) _) = Just offset
+			(SelectorThunk offset) _ _) _) = Just offset
 maybeSelectorInfo _ = Nothing
+\end{code}
+
+-----------------------------------------------------------------------------
+SRT-related stuff
 
--- Does this thunk's info table have an SRT?
 
-needsSRT :: ClosureInfo -> Bool
-needsSRT (MkClosureInfo _ info _) =
+\begin{code}
+infoTblNeedsSRT :: ClosureInfo -> Bool
+infoTblNeedsSRT (MkClosureInfo _ info _) =
   case info of
-    LFThunk _ _ _ _ (SelectorThunk _) -> False 	-- not for selectors
-    LFThunk _ _ _ _ _   -> True
-    LFReEntrant _ _ _ _ -> True
+    LFThunk _ _ _ _ _ _ NoSRT   -> False
+    LFThunk _ _ _ _ _ _ _       -> True
+
+    LFReEntrant _ _ _ _ _ NoSRT -> False
+    LFReEntrant _ _ _ _ _ _     -> True
+
     _ -> False
+
+staticClosureNeedsLink :: ClosureInfo -> Bool
+staticClosureNeedsLink (MkClosureInfo _ info _) =
+  case info of
+    LFThunk _ _ _ _ _ _ NoSRT   -> False
+    LFReEntrant _ _ _ _ _ NoSRT -> False
+    LFCon _ True                -> False -- zero arity constructors
+    _ -> True
+
+getSRTInfo :: ClosureInfo -> (CLabel, SRT)
+getSRTInfo  (MkClosureInfo _ info _) =
+  case info of
+    LFThunk _ _ _ _ _ lbl srt   -> (lbl,srt)
+    LFReEntrant _ _ _ _ lbl srt -> (lbl,srt)
+    _ -> panic "getSRTInfo"
 \end{code}
 
 Avoiding generating entries and info tables
@@ -791,7 +831,7 @@ staticClosureRequired
 	-> LambdaFormInfo
 	-> Bool
 staticClosureRequired binder (StgBinderInfo arg_occ unsat_occ _ _ _)
-		      (LFReEntrant _ top_level _ _)	-- It's a function
+		      (LFReEntrant _ top_level _ _ _ _)	-- It's a function
   = ASSERT( case top_level of { TopLevel -> True; other -> False } )
 	-- Assumption: it's a top-level, no-free-var binding
     arg_occ 		-- There's an argument occurrence
@@ -821,7 +861,7 @@ funInfoTableRequired
 	-> LambdaFormInfo
 	-> Bool
 funInfoTableRequired  binder (StgBinderInfo arg_occ unsat_occ _ _ _)
-		     (LFReEntrant _ top_level _ _)
+		     (LFReEntrant _ top_level _ _ _ _)
   = (case top_level of { NotTopLevel -> True; TopLevel -> False })
     || arg_occ 		-- There's an argument occurrence
     || unsat_occ	-- There's an unsaturated call
@@ -852,7 +892,7 @@ closureLFInfo (MkClosureInfo _ lf_info _) = lf_info
 
 closureUpdReqd :: ClosureInfo -> Bool
 
-closureUpdReqd (MkClosureInfo _ (LFThunk _ _ _ upd _) _) = upd
+closureUpdReqd (MkClosureInfo _ (LFThunk _ _ _ upd _ _ _) _) = upd
 closureUpdReqd (MkClosureInfo _ 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.
@@ -860,7 +900,7 @@ closureUpdReqd other_closure			       = False
 
 closureSingleEntry :: ClosureInfo -> Bool
 
-closureSingleEntry (MkClosureInfo _ (LFThunk _ _ _ upd _) _) = not upd
+closureSingleEntry (MkClosureInfo _ (LFThunk _ _ _ upd _ _ _) _) = not upd
 closureSingleEntry other_closure			   = False
 \end{code}
 
@@ -879,8 +919,8 @@ isToplevClosure :: ClosureInfo -> Bool
 
 isToplevClosure (MkClosureInfo _ lf_info _)
   = case lf_info of
-      LFReEntrant _ TopLevel _ _ -> True
-      LFThunk _ TopLevel _ _ _   -> True
+      LFReEntrant _ TopLevel _ _ _ _ -> True
+      LFThunk _ TopLevel _ _ _ _ _   -> True
       other -> False
 \end{code}
 
@@ -895,7 +935,7 @@ Label generation.
 
 \begin{code}
 fastLabelFromCI :: ClosureInfo -> CLabel
-fastLabelFromCI (MkClosureInfo name (LFReEntrant _ _ arity _) _)
+fastLabelFromCI (MkClosureInfo name (LFReEntrant _ _ arity _ _ _) _)
   = mkFastEntryLabel name arity
 
 fastLabelFromCI (MkClosureInfo name _ _)
@@ -909,10 +949,10 @@ infoTableLabelFromCI (MkClosureInfo id lf_info rep)
 
 	LFBlackHole     -> mkBlackHoleInfoTableLabel
 
-	LFThunk _ _ _ upd_flag (SelectorThunk offset) -> 
+	LFThunk _ _ _ upd_flag (SelectorThunk offset) _ _ -> 
 		mkSelectorInfoLabel upd_flag offset
 
-	LFThunk _ _ _ upd_flag (ApThunk arity) -> 
+	LFThunk _ _ _ upd_flag (ApThunk arity) _ _ -> 
 		mkApInfoTableLabel upd_flag arity
 
 	other -> {-NO: if isStaticRep rep
@@ -945,7 +985,7 @@ closureLabelFromCI (MkClosureInfo id _ other_rep)   = mkClosureLabel id
 entryLabelFromCI :: ClosureInfo -> CLabel
 entryLabelFromCI (MkClosureInfo id lf_info rep)
   = case lf_info of
-	LFThunk _ _ _ upd_flag std_form_info -> thunkEntryLabel id std_form_info upd_flag
+	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
@@ -966,10 +1006,10 @@ allocProfilingMsg :: ClosureInfo -> FAST_STRING
 
 allocProfilingMsg (MkClosureInfo _ lf_info _)
   = case lf_info of
-      LFReEntrant _ _ _ _	-> SLIT("TICK_ALLOC_FUN")
+      LFReEntrant _ _ _ _ _ _	-> SLIT("TICK_ALLOC_FUN")
       LFCon _ _			-> SLIT("TICK_ALLOC_CON")
       LFTuple _ _		-> SLIT("TICK_ALLOC_CON")
-      LFThunk _ _ _ _ _		-> SLIT("TICK_ALLOC_THK")
+      LFThunk _ _ _ _ _ _ _     -> SLIT("TICK_ALLOC_THK")
       LFBlackHole		-> SLIT("TICK_ALLOC_BH")
       LFImported		-> panic "TICK_ALLOC_IMP"
 \end{code}
@@ -999,9 +1039,9 @@ in the closure info using @closureTypeDescr@.
 
 \begin{code}
 closureTypeDescr :: ClosureInfo -> String
-closureTypeDescr (MkClosureInfo name (LFThunk ty _ _ _ _) _)
+closureTypeDescr (MkClosureInfo name (LFThunk ty _ _ _ _ _ _) _)
   = getTyDescription ty
-closureTypeDescr (MkClosureInfo name (LFReEntrant ty _ _ _) _)
+closureTypeDescr (MkClosureInfo name (LFReEntrant ty _ _ _ _ _) _)
   = getTyDescription ty
 closureTypeDescr (MkClosureInfo name lf _)
   = showSDoc (ppr name)
diff --git a/ghc/compiler/codeGen/CodeGen.lhs b/ghc/compiler/codeGen/CodeGen.lhs
index 6d388277fb..c6d94f465d 100644
--- a/ghc/compiler/codeGen/CodeGen.lhs
+++ b/ghc/compiler/codeGen/CodeGen.lhs
@@ -183,7 +183,9 @@ cgTopRhs bndr (StgRhsCon cc con args)
 
 cgTopRhs bndr (StgRhsClosure cc bi srt fvs upd_flag args body)
   = ASSERT(null fvs) -- There should be no free variables
-    forkStatics (cgTopRhsClosure bndr cc bi srt args body lf_info)
-  where
-    lf_info = mkClosureLFInfo bndr TopLevel [{-no fvs-}] upd_flag args
+    getSRTLabel `thenFC` \srt_label ->
+    let lf_info = 
+	  mkClosureLFInfo bndr TopLevel [{-no fvs-}] upd_flag args srt_label srt
+    in
+    forkStatics (cgTopRhsClosure bndr cc bi args body lf_info)
 \end{code}
diff --git a/ghc/compiler/nativeGen/AbsCStixGen.lhs b/ghc/compiler/nativeGen/AbsCStixGen.lhs
index 08dce9fe37..1588f3c89c 100644
--- a/ghc/compiler/nativeGen/AbsCStixGen.lhs
+++ b/ghc/compiler/nativeGen/AbsCStixGen.lhs
@@ -23,7 +23,8 @@ import SMRep		( fixedItblSize,
 import Constants   	( mIN_UPD_SIZE )
 import CLabel           ( CLabel, mkReturnInfoLabel, mkReturnPtLabel )
 import ClosureInfo	( infoTableLabelFromCI, entryLabelFromCI,
-			  fastLabelFromCI, closureUpdReqd
+			  fastLabelFromCI, closureUpdReqd,
+			  staticClosureNeedsLink
 			)
 import Const		( Literal(..) )
 import Maybes	    	( maybeToBool )
@@ -97,7 +98,7 @@ Here we handle top-level things, like @CCodeBlock@s and
 			 LvSmall _ -> rET_SMALL
 			 LvLarge _ -> rET_BIG
 
- gentopcode stmt@(CClosureInfoAndCode cl_info slow Nothing _ _)
+ gentopcode stmt@(CClosureInfoAndCode cl_info slow Nothing _)
 
   | slow_is_empty
   = genCodeInfoTable stmt		`thenUs` \ itbl ->
@@ -112,7 +113,7 @@ Here we handle top-level things, like @CCodeBlock@s and
     slow_is_empty = not (maybeToBool (nonemptyAbsC slow))
     slow_lbl = entryLabelFromCI cl_info
 
- gentopcode stmt@(CClosureInfoAndCode cl_info slow (Just fast) _ _) =
+ gentopcode stmt@(CClosureInfoAndCode cl_info slow (Just fast) _) =
  -- ToDo: what if this is empty? ------------------------^^^^
     genCodeInfoTable stmt		`thenUs` \ itbl ->
     gencode slow			`thenUs` \ slow_code ->
@@ -171,14 +172,17 @@ Here we handle top-level things, like @CCodeBlock@s and
   where
     table = StData PtrRep [StCLbl (infoTableLabelFromCI cl_info)] : 
 	    map (\amode -> StData (getAmodeRep amode) [a2stix amode]) amodes ++
-	    [StData PtrRep padding_wds]
+	    [StData PtrRep (padding_wds ++ static_link)]
 
     -- always at least one padding word: this is the static link field
     -- for the garbage collector.
     padding_wds = if closureUpdReqd cl_info then
-    	    		take (1 + max 0 (mIN_UPD_SIZE - length amodes)) zeros
+    	    		take (max 0 (mIN_UPD_SIZE - length amodes)) zeros
     	   	  else
-    	    		[StInt 0]
+    	    		[]
+
+    static_link | staticClosureNeedsLink cl_info = [StInt 0]
+	        | otherwise                      = []
 
     zeros = StInt 0 : zeros
 
diff --git a/ghc/compiler/nativeGen/StixInfo.lhs b/ghc/compiler/nativeGen/StixInfo.lhs
index 28e20cae24..b72675f185 100644
--- a/ghc/compiler/nativeGen/StixInfo.lhs
+++ b/ghc/compiler/nativeGen/StixInfo.lhs
@@ -13,7 +13,8 @@ import CLabel		( CLabel )
 import StgSyn		( SRT(..) )
 import ClosureInfo	( closurePtrsSize,
 			  closureNonHdrSize, closureSMRep,
-			  infoTableLabelFromCI
+			  infoTableLabelFromCI,
+			  infoTblNeedsSRT, getSRTInfo
 			)
 import PrimRep		( PrimRep(..) )
 import SMRep		( SMRep(..), getSMRepClosureTypeInt )
@@ -33,15 +34,14 @@ genCodeInfoTable
     :: AbstractC
     -> UniqSM StixTreeList
 
-genCodeInfoTable (CClosureInfoAndCode cl_info _ _ srt cl_descr)
+genCodeInfoTable (CClosureInfoAndCode cl_info _ _ cl_descr)
   = returnUs (\xs -> StData PtrRep table : StLabel info_lbl : xs)
 
     where
 	info_lbl = infoTableLabelFromCI cl_info
 
-	table = case srt_len of 
-		   0 -> rest_of_table
-		   _ -> srt_label : rest_of_table
+	table | infoTblNeedsSRT cl_info	= srt_label : rest_of_table
+	      | otherwise               = rest_of_table
 
 	rest_of_table = 
 		[
@@ -62,7 +62,8 @@ genCodeInfoTable (CClosureInfoAndCode cl_info _ _ srt cl_descr)
 		    (fromInt closure_type `shiftL` 8) .|.
 		    (fromInt srt_len `shiftL` 16)
 #endif	     
-	     
+	srt = getSRTInfo cl_info	     
+
 	(srt_label,srt_len) = 
 	     case srt of
 		(lbl, NoSRT) -> (StInt 0, 0)