From 63e510b508399d603045b3a628a3d765ca36ff8b Mon Sep 17 00:00:00 2001 From: simonpj Date: Wed, 11 Dec 2002 16:55:06 +0000 Subject: [PATCH] [project @ 2002-12-11 16:55:04 by simonpj] Tidy up info table generation --- ghc/compiler/codeGen/ClosureInfo.lhs | 16 ++-- ghc/compiler/codeGen/SMRep.lhs | 145 +++++++++++----------------------- ghc/compiler/ghci/ByteCodeItbls.lhs | 5 +- 3 files changed, 59 insertions(+), 107 deletions(-) diff --git a/ghc/compiler/codeGen/ClosureInfo.lhs b/ghc/compiler/codeGen/ClosureInfo.lhs index a237173..2cfa43f 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.54 2002/12/11 15:36:28 simonmar Exp $ +% $Id: ClosureInfo.lhs,v 1.55 2002/12/11 16:55:04 simonpj Exp $ % \section[ClosureInfo]{Data structures which describe closures} @@ -518,11 +518,11 @@ chooseSMRep is_static lf_info tot_wds ptr_wds 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 -> CONSTR_NOCAF - | otherwise -> CONSTR - LFReEntrant _ _ _ _ -> FUN - LFThunk _ _ _ (SelectorThunk _) _ -> THUNK_SELECTOR - LFThunk _ _ _ _ _ -> THUNK + LFCon con | is_static && ptr_wds == 0 -> ConstrNoCaf + | otherwise -> Constr + LFReEntrant _ _ _ _ -> Fun + LFThunk _ _ _ (SelectorThunk _) _ -> ThunkSelector + LFThunk _ _ _ _ _ -> Thunk _ -> panic "getClosureType" \end{code} @@ -801,8 +801,8 @@ staticClosureNeedsLink (ConInfo { closureSMRep = sm_rep, closureCon = con }) where not_nocaf_constr = case sm_rep of - GenericRep _ _ _ CONSTR_NOCAF -> False - _other -> True + GenericRep _ _ _ ConstrNoCaf -> False + _other -> True \end{code} Avoiding generating entries and info tables diff --git a/ghc/compiler/codeGen/SMRep.lhs b/ghc/compiler/codeGen/SMRep.lhs index d6199a0..6838287 100644 --- a/ghc/compiler/codeGen/SMRep.lhs +++ b/ghc/compiler/codeGen/SMRep.lhs @@ -11,39 +11,14 @@ module SMRep ( SMRep(..), ClosureType(..), isStaticRep, fixedHdrSize, arrWordsHdrSize, arrPtrsHdrSize, - stdItblSize, retItblSize - -#ifndef OMIT_NATIVE_CODEGEN - , getSMRepClosureTypeInt - , cONSTR - , cONSTR_1_0 - , cONSTR_0_1 - , cONSTR_2_0 - , cONSTR_1_1 - , cONSTR_0_2 - , cONSTR_STATIC - , cONSTR_NOCAF_STATIC - , fUN - , fUN_1_0 - , fUN_0_1 - , fUN_2_0 - , fUN_1_1 - , fUN_0_2 - , fUN_STATIC - , tHUNK - , tHUNK_1_0 - , tHUNK_0_1 - , tHUNK_2_0 - , tHUNK_1_1 - , tHUNK_0_2 - , tHUNK_STATIC - , tHUNK_SELECTOR + stdItblSize, retItblSize, + getSMRepClosureTypeInt + , rET_SMALL , rET_VEC_SMALL , rET_BIG , rET_VEC_BIG - , bLACKHOLE -#endif + ) where #include "HsVersions.h" @@ -73,11 +48,11 @@ data SMRep data ClosureType -- Corresponds 1-1 with the varieties of closures -- implemented by the RTS. Compare with ghc/includes/ClosureTypes.h - = CONSTR - | CONSTR_NOCAF - | FUN - | THUNK - | THUNK_SELECTOR + = Constr + | ConstrNoCaf + | Fun + | Thunk + | ThunkSelector \end{code} Size of a closure header. @@ -111,7 +86,7 @@ retItblSize :: Int{-words-} retItblSize = stdItblSize + rET_ITBL_SIZE profItblSize :: Int{-words-} -profItblSize | opt_SccProfilingOn = pROF_ITBL_SIZE +profItblSize | opt_SccProfilingOn = pROF_ITBL_SIZE | otherwise = 0 granItblSize :: Int{-words-} @@ -120,7 +95,7 @@ granItblSize | opt_GranMacros = gRAN_ITBL_SIZE tickyItblSize :: Int{-words-} tickyItblSize | opt_DoTickyProfiling = tICKY_ITBL_SIZE - | otherwise = 0 + | otherwise = 0 \end{code} \begin{code} @@ -130,70 +105,46 @@ isStaticRep BlackHoleRep = False \end{code} \begin{code} +#include "../includes/ClosureTypes.h" +-- Defines CONSTR, CONSTR_1_0 etc + getSMRepClosureTypeInt :: SMRep -> Int -getSMRepClosureTypeInt (GenericRep False 1 0 CONSTR) = cONSTR_1_0 -getSMRepClosureTypeInt (GenericRep False 0 1 CONSTR) = cONSTR_0_1 -getSMRepClosureTypeInt (GenericRep False 2 0 CONSTR) = cONSTR_2_0 -getSMRepClosureTypeInt (GenericRep False 1 1 CONSTR) = cONSTR_1_1 -getSMRepClosureTypeInt (GenericRep False 0 2 CONSTR) = cONSTR_0_2 -getSMRepClosureTypeInt (GenericRep False _ _ CONSTR) = cONSTR - -getSMRepClosureTypeInt (GenericRep False 1 0 FUN) = fUN_1_0 -getSMRepClosureTypeInt (GenericRep False 0 1 FUN) = fUN_0_1 -getSMRepClosureTypeInt (GenericRep False 2 0 FUN) = fUN_2_0 -getSMRepClosureTypeInt (GenericRep False 1 1 FUN) = fUN_1_1 -getSMRepClosureTypeInt (GenericRep False 0 2 FUN) = fUN_0_2 -getSMRepClosureTypeInt (GenericRep False _ _ FUN) = fUN - -getSMRepClosureTypeInt (GenericRep False 1 0 THUNK) = tHUNK_1_0 -getSMRepClosureTypeInt (GenericRep False 0 1 THUNK) = tHUNK_0_1 -getSMRepClosureTypeInt (GenericRep False 2 0 THUNK) = tHUNK_2_0 -getSMRepClosureTypeInt (GenericRep False 1 1 THUNK) = tHUNK_1_1 -getSMRepClosureTypeInt (GenericRep False 0 2 THUNK) = tHUNK_0_2 -getSMRepClosureTypeInt (GenericRep False _ _ THUNK) = tHUNK - -getSMRepClosureTypeInt (GenericRep False _ _ THUNK_SELECTOR) = tHUNK_SELECTOR - -getSMRepClosureTypeInt (GenericRep True _ _ CONSTR) = cONSTR_STATIC -getSMRepClosureTypeInt (GenericRep True _ _ CONSTR_NOCAF) = cONSTR_NOCAF_STATIC -getSMRepClosureTypeInt (GenericRep True _ _ FUN) = fUN_STATIC -getSMRepClosureTypeInt (GenericRep True _ _ THUNK) = tHUNK_STATIC - -getSMRepClosureTypeInt BlackHoleRep = bLACKHOLE +getSMRepClosureTypeInt (GenericRep False 1 0 Constr) = CONSTR_1_0 +getSMRepClosureTypeInt (GenericRep False 0 1 Constr) = CONSTR_0_1 +getSMRepClosureTypeInt (GenericRep False 2 0 Constr) = CONSTR_2_0 +getSMRepClosureTypeInt (GenericRep False 1 1 Constr) = CONSTR_1_1 +getSMRepClosureTypeInt (GenericRep False 0 2 Constr) = CONSTR_0_2 +getSMRepClosureTypeInt (GenericRep False _ _ Constr) = CONSTR + +getSMRepClosureTypeInt (GenericRep False 1 0 Fun) = FUN_1_0 +getSMRepClosureTypeInt (GenericRep False 0 1 Fun) = FUN_0_1 +getSMRepClosureTypeInt (GenericRep False 2 0 Fun) = FUN_2_0 +getSMRepClosureTypeInt (GenericRep False 1 1 Fun) = FUN_1_1 +getSMRepClosureTypeInt (GenericRep False 0 2 Fun) = FUN_0_2 +getSMRepClosureTypeInt (GenericRep False _ _ Fun) = FUN + +getSMRepClosureTypeInt (GenericRep False 1 0 Thunk) = THUNK_1_0 +getSMRepClosureTypeInt (GenericRep False 0 1 Thunk) = THUNK_0_1 +getSMRepClosureTypeInt (GenericRep False 2 0 Thunk) = THUNK_2_0 +getSMRepClosureTypeInt (GenericRep False 1 1 Thunk) = THUNK_1_1 +getSMRepClosureTypeInt (GenericRep False 0 2 Thunk) = THUNK_0_2 +getSMRepClosureTypeInt (GenericRep False _ _ Thunk) = THUNK + +getSMRepClosureTypeInt (GenericRep False _ _ ThunkSelector) = THUNK_SELECTOR + +getSMRepClosureTypeInt (GenericRep True _ _ Constr) = CONSTR_STATIC +getSMRepClosureTypeInt (GenericRep True _ _ ConstrNoCaf) = CONSTR_NOCAF_STATIC +getSMRepClosureTypeInt (GenericRep True _ _ Fun) = FUN_STATIC +getSMRepClosureTypeInt (GenericRep True _ _ Thunk) = THUNK_STATIC + +getSMRepClosureTypeInt BlackHoleRep = BLACKHOLE getSMRepClosureTypeInt rep = panic "getSMRepClosureTypeInt" --- Just the ones we need: - -#include "../includes/ClosureTypes.h" - -cONSTR = (CONSTR :: Int) -cONSTR_1_0 = (CONSTR_1_0 :: Int) -cONSTR_0_1 = (CONSTR_0_1 :: Int) -cONSTR_2_0 = (CONSTR_2_0 :: Int) -cONSTR_1_1 = (CONSTR_1_1 :: Int) -cONSTR_0_2 = (CONSTR_0_2 :: Int) -cONSTR_STATIC = (CONSTR_STATIC :: Int) -cONSTR_NOCAF_STATIC = (CONSTR_NOCAF_STATIC :: Int) -fUN = (FUN :: Int) -fUN_1_0 = (FUN_1_0 :: Int) -fUN_0_1 = (FUN_0_1 :: Int) -fUN_2_0 = (FUN_2_0 :: Int) -fUN_1_1 = (FUN_1_1 :: Int) -fUN_0_2 = (FUN_0_2 :: Int) -fUN_STATIC = (FUN_STATIC :: Int) -tHUNK = (THUNK :: Int) -tHUNK_1_0 = (THUNK_1_0 :: Int) -tHUNK_0_1 = (THUNK_0_1 :: Int) -tHUNK_2_0 = (THUNK_2_0 :: Int) -tHUNK_1_1 = (THUNK_1_1 :: Int) -tHUNK_0_2 = (THUNK_0_2 :: Int) -tHUNK_STATIC = (THUNK_STATIC :: Int) -tHUNK_SELECTOR = (THUNK_SELECTOR :: Int) -rET_SMALL = (RET_SMALL :: Int) -rET_VEC_SMALL = (RET_VEC_SMALL :: Int) -rET_BIG = (RET_BIG :: Int) -rET_VEC_BIG = (RET_VEC_BIG :: Int) -bLACKHOLE = (BLACKHOLE :: Int) +-- We export these ones +rET_SMALL = (RET_SMALL :: Int) +rET_VEC_SMALL = (RET_VEC_SMALL :: Int) +rET_BIG = (RET_BIG :: Int) +rET_VEC_BIG = (RET_VEC_BIG :: Int) \end{code} diff --git a/ghc/compiler/ghci/ByteCodeItbls.lhs b/ghc/compiler/ghci/ByteCodeItbls.lhs index 4473ccf..5325f8f 100644 --- a/ghc/compiler/ghci/ByteCodeItbls.lhs +++ b/ghc/compiler/ghci/ByteCodeItbls.lhs @@ -66,8 +66,9 @@ mkITbl tc dcs = tyConDataCons tc n = tyConFamilySize tc -cONSTR :: Int -cONSTR = 1 -- as defined in ghc/includes/ClosureTypes.h +#include "../includes/ClosureTypes.h" +cONSTR :: Int -- Defined in ClosureTypes.h +cONSTR = CONSTR -- Assumes constructors are numbered from zero, not one make_constr_itbls :: [DataCon] -> IO ItblEnv -- 1.7.10.4