[project @ 1999-01-26 16:16:19 by simonm]

- Add specialised closure types (CONSTR_p_n, THUNK_p_n, FUN_p_n)
- Add -T<n> RTS flag to specify the number of steps in younger generations.

3 files changed, 57 insertions, 26 deletions

diff --git a/ghc/compiler/codeGen/CgHeapery.lhs b/ghc/compiler/codeGen/CgHeapery.lhs
index f1a0ef25c9..c3839985dc 100644
--- a/ghc/compiler/codeGen/CgHeapery.lhs
+++ b/ghc/compiler/codeGen/CgHeapery.lhs
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: CgHeapery.lhs,v 1.12 1999/01/21 10:31:56 simonm Exp $
+% $Id: CgHeapery.lhs,v 1.13 1999/01/26 16:16:33 simonm Exp $
 %
 \section[CgHeapery]{Heap management functions}
 
@@ -21,7 +21,7 @@ import CLabel
 import CgMonad
 
 import CgStackery	( getFinalStackHW, mkTaggedStkAmodes, mkTagAssts )
-import SMRep		( fixedHdrSize, getSMRepStr )
+import SMRep		( fixedHdrSize )
 import AbsCUtils	( mkAbstractCs, getAmodeRep )
 import CgUsages		( getVirtAndRealHp, getRealSp, setVirtHp, setRealHp,
 			  initHeapUsage
@@ -446,7 +446,6 @@ allocDynClosure closure_info use_cc blame_cc amodes_with_offsets
 
 	-- GENERATE CC PROFILING MESSAGES
     costCentresC SLIT("CCS_ALLOC") [blame_cc, mkIntCLit closure_size]
-	-- CLitLit (_PK_ type_str) IntRep] -- not necessary? --SDM
 					 		`thenC`
 
 	-- BUMP THE VIRTUAL HEAP POINTER
@@ -457,7 +456,6 @@ allocDynClosure closure_info use_cc blame_cc amodes_with_offsets
   where
     closure_size = closureSize closure_info
     slop_size    = slopSize closure_info
-    type_str     = getSMRepStr (closureSMRep closure_info)
 
 -- Avoid hanging on to anything in the CC field when we're not profiling.
 
diff --git a/ghc/compiler/codeGen/ClosureInfo.lhs b/ghc/compiler/codeGen/ClosureInfo.lhs
index 9e99002671..f64b8dccc9 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.32 1998/12/18 17:40:54 simonpj Exp $
+% $Id: ClosureInfo.lhs,v 1.33 1999/01/26 16:16:33 simonm Exp $
 %
 \section[ClosureInfo]{Data structures which describe closures}
 
@@ -59,7 +59,8 @@ import AbsCSyn		( MagicId, node, VirtualHeapOffset, HeapOffset )
 import StgSyn
 import CgMonad
 
-import Constants	( mIN_UPD_SIZE, mIN_SIZE_NonUpdHeapObject )
+import Constants	( mIN_UPD_SIZE, mIN_SIZE_NonUpdHeapObject,
+			  mAX_SPEC_FUN_SIZE, mAX_SPEC_THUNK_SIZE, mAX_SPEC_CONSTR_SIZE )
 import CgRetConv	( assignRegs )
 import CLabel		( CLabel, mkStdEntryLabel, mkFastEntryLabel,
 			  mkInfoTableLabel,
@@ -393,18 +394,19 @@ layOutStaticClosure name kind_fn things lf_info
     (tot_wds,		 -- #ptr_wds + #nonptr_wds
      ptr_wds,		 -- #ptr_wds
      things_w_offsets) = mkVirtHeapOffsets (StaticRep bot bot bot) kind_fn things
+
     -- constructors with no pointer fields will definitely be NOCAF things.
     -- this is a compromise until we can generate both kinds of constructor
     -- (a normal static kind and the NOCAF_STATIC kind).
     closure_type = case lf_info of
 			LFCon _ _ | ptr_wds == 0 -> CONSTR_NOCAF
-			_ -> getClosureType lf_info
+			_ -> getStaticClosureType lf_info
 
     bot = panic "layoutStaticClosure"
 
 layOutStaticNoFVClosure :: Name -> LambdaFormInfo -> ClosureInfo
 layOutStaticNoFVClosure name lf_info
-  = MkClosureInfo name lf_info (StaticRep 0 0 (getClosureType lf_info))
+  = MkClosureInfo name lf_info (StaticRep 0 0 (getStaticClosureType lf_info))
 \end{code}
 
 %************************************************************************
@@ -422,24 +424,48 @@ chooseDynSMRep
 chooseDynSMRep lf_info tot_wds ptr_wds
   = let
 	 nonptr_wds = tot_wds - ptr_wds
-	 closure_type = getClosureType lf_info
+	 closure_type = getClosureType tot_wds ptr_wds nonptr_wds lf_info
     in
     case lf_info of
 	LFTuple _ True -> ConstantRep
 	LFCon _ True   -> ConstantRep
 	_	       -> GenericRep ptr_wds nonptr_wds closure_type	
 
-getClosureType :: LambdaFormInfo -> ClosureType
-getClosureType lf_info =
+getStaticClosureType :: LambdaFormInfo -> ClosureType
+getStaticClosureType lf_info =
     case lf_info of
         LFCon con True       -> CONSTR_NOCAF
-	LFCon con False      -> CONSTR 
+	LFCon con False      -> CONSTR
   	LFReEntrant _ _ _ _  -> FUN
 	LFTuple _ _	     -> CONSTR
 	LFThunk _ _ _ _ (SelectorThunk _) -> THUNK_SELECTOR
 	LFThunk _ _ _ _ _    -> THUNK
 	_                    -> panic "getClosureType"
-		-- ToDo: could be anything else here?
+
+getClosureType :: Int -> Int -> Int -> LambdaFormInfo -> ClosureType
+getClosureType tot_wds ptrs nptrs lf_info =
+    case lf_info of
+        LFCon con True       -> CONSTR_NOCAF
+
+	LFCon con False 
+		| tot_wds > 0 && tot_wds <= mAX_SPEC_CONSTR_SIZE -> CONSTR_p_n ptrs nptrs
+		| otherwise -> CONSTR
+
+  	LFReEntrant _ _ _ _ 
+		| tot_wds > 0 && tot_wds <= mAX_SPEC_FUN_SIZE -> FUN_p_n ptrs nptrs
+		| otherwise -> FUN
+
+	LFTuple _ _
+		| tot_wds > 0 && tot_wds <= mAX_SPEC_CONSTR_SIZE -> CONSTR_p_n ptrs nptrs
+		| otherwise -> CONSTR
+
+	LFThunk _ _ _ _ (SelectorThunk _) -> THUNK_SELECTOR
+
+	LFThunk _ _ _ _ _
+		| tot_wds > 0 && tot_wds <= mAX_SPEC_THUNK_SIZE -> THUNK_p_n ptrs nptrs
+		| otherwise -> THUNK
+
+	_                    -> panic "getClosureType"
 \end{code}
 
 %************************************************************************
diff --git a/ghc/compiler/codeGen/SMRep.lhs b/ghc/compiler/codeGen/SMRep.lhs
index fe463172c6..9a36a339b5 100644
--- a/ghc/compiler/codeGen/SMRep.lhs
+++ b/ghc/compiler/codeGen/SMRep.lhs
@@ -10,7 +10,7 @@ Other modules should access this info through ClosureInfo.
 module SMRep (
 	SMRep(..), ClosureType(..),
 	isConstantRep, isStaticRep,
-	fixedHdrSize, arrHdrSize, fixedItblSize, getSMRepStr, getClosureTypeStr
+	fixedHdrSize, arrHdrSize, fixedItblSize, pprSMRep
 
 #ifndef OMIT_NATIVE_CODEGEN
 	, getSMRepClosureTypeInt
@@ -67,9 +67,12 @@ data SMRep
 
 data ClosureType
     = CONSTR
+    | CONSTR_p_n Int Int
     | CONSTR_NOCAF
     | FUN
+    | FUN_p_n Int Int
     | THUNK
+    | THUNK_p_n Int Int
     | THUNK_SELECTOR
   deriving (Eq,Ord)
 
@@ -135,18 +138,22 @@ instance Text SMRep where
 	   ConstantRep				 -> "")
 
 instance Outputable SMRep where
-    ppr rep = text (show rep)
-
-getSMRepStr (GenericRep _ _ t) 	   = getClosureTypeStr t
-getSMRepStr (StaticRep _ _ t)  	   = getClosureTypeStr t ++ "_STATIC"
-getSMRepStr ConstantRep        	   = "CONSTR_NOCAF_STATIC"
-getSMRepStr BlackHoleRep       	   = "BLACKHOLE"
-
-getClosureTypeStr CONSTR	   = "CONSTR"
-getClosureTypeStr CONSTR_NOCAF	   = "CONSTR_NOCAF"
-getClosureTypeStr FUN		   = "FUN"
-getClosureTypeStr THUNK		   = "THUNK"
-getClosureTypeStr THUNK_SELECTOR   = "THUNK_SELECTOR"
+    ppr rep = pprSMRep rep
+
+pprSMRep :: SMRep -> SDoc
+pprSMRep (GenericRep _ _ t) 	= pprClosureType t
+pprSMRep (StaticRep _ _ t)  	= pprClosureType t <> ptext SLIT("_STATIC")
+pprSMRep ConstantRep        	= ptext SLIT("CONSTR_NOCAF_STATIC")
+pprSMRep BlackHoleRep       	= ptext SLIT("BLACKHOLE")
+
+pprClosureType CONSTR	   	= ptext SLIT("CONSTR")
+pprClosureType (CONSTR_p_n p n) = ptext SLIT("CONSTR_") <> int p <> char '_' <> int n
+pprClosureType CONSTR_NOCAF	= ptext SLIT("CONSTR_NOCAF")
+pprClosureType FUN		= ptext SLIT("FUN")
+pprClosureType (FUN_p_n p n)	= ptext SLIT("FUN_") <> int p <> char '_' <> int n
+pprClosureType THUNK		= ptext SLIT("THUNK")
+pprClosureType (THUNK_p_n p n)  = ptext SLIT("THUNK_") <> int p <> char '_' <> int n
+pprClosureType THUNK_SELECTOR   = ptext SLIT("THUNK_SELECTOR")
 
 #ifndef OMIT_NATIVE_CODEGEN
 getSMRepClosureTypeInt :: SMRep -> Int