From: simonmar Date: Thu, 21 Apr 2005 15:28:20 +0000 (+0000) Subject: [project @ 2005-04-21 15:28:20 by simonmar] X-Git-Tag: Initial_conversion_from_CVS_complete~711 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=effd3425cfd597b1f0e71f7486ae2cffcbf081a7;p=ghc-hetmet.git [project @ 2005-04-21 15:28:20 by simonmar] SMP: thunks get an extra header word so that the payload doesn't occupy the same space as the updated value. This is the sum total of the changes to compiler/, which are pleasingly few. --- diff --git a/ghc/compiler/codeGen/CgClosure.lhs b/ghc/compiler/codeGen/CgClosure.lhs index 401da80..b7cef40 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.68 2005/03/31 10:16:34 simonmar Exp $ +% $Id: CgClosure.lhs,v 1.69 2005/04/21 15:28:20 simonmar Exp $ % \section[CgClosure]{Code generation for closures} @@ -119,7 +119,8 @@ cgStdRhsClosure bndr cc bndr_info fvs args body lf_info payload { -- LAY OUT THE OBJECT amodes <- getArgAmodes payload ; mod_name <- moduleName - ; let (tot_wds, ptr_wds, amodes_w_offsets) = mkVirtHeapOffsets amodes + ; let (tot_wds, ptr_wds, amodes_w_offsets) + = mkVirtHeapOffsets (isLFThunk lf_info) amodes descr = closureDescription mod_name (idName bndr) closure_info = mkClosureInfo False -- Not static @@ -170,7 +171,9 @@ cgRhsClosure bndr cc bndr_info srt fvs upd_flag args body = do ; srt_info <- getSRTInfo name srt ; mod_name <- moduleName ; let bind_details :: [(CgIdInfo, VirtualHpOffset)] - (tot_wds, ptr_wds, bind_details) = mkVirtHeapOffsets (map add_rep fv_infos) + (tot_wds, ptr_wds, bind_details) + = mkVirtHeapOffsets (isLFThunk lf_info) (map add_rep fv_infos) + add_rep info = (cgIdInfoArgRep info, info) descr = closureDescription mod_name name diff --git a/ghc/compiler/codeGen/CgHeapery.lhs b/ghc/compiler/codeGen/CgHeapery.lhs index 8227689..66bc6f5 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.45 2005/03/31 10:16:34 simonmar Exp $ +% $Id: CgHeapery.lhs,v 1.46 2005/04/21 15:28:20 simonmar Exp $ % \section[CgHeapery]{Heap management functions} @@ -40,7 +40,8 @@ import ClosureInfo ( closureSize, staticClosureNeedsLink, nodeMustPointToIt, closureLFInfo, ClosureInfo ) import SMRep ( CgRep(..), cgRepSizeW, separateByPtrFollowness, - WordOff, fixedHdrSize, isVoidArg, primRepToCgRep ) + WordOff, fixedHdrSize, thunkHdrSize, + isVoidArg, primRepToCgRep ) import Cmm ( CmmLit(..), CmmStmt(..), CmmExpr(..), GlobalReg(..), CmmReg(..), hpReg, nodeReg, spReg ) @@ -140,7 +141,7 @@ layOutConstr is_static dflags data_con args where (tot_wds, -- #ptr_wds + #nonptr_wds ptr_wds, -- #ptr_wds - things_w_offsets) = mkVirtHeapOffsets args + things_w_offsets) = mkVirtHeapOffsets False{-not a thunk-} args \end{code} @mkVirtHeapOffsets@ always returns boxed things with smaller offsets @@ -149,7 +150,8 @@ list \begin{code} mkVirtHeapOffsets - :: [(CgRep,a)] -- Things to make offsets for + :: Bool -- True <=> is a thunk + -> [(CgRep,a)] -- Things to make offsets for -> (WordOff, -- _Total_ number of words allocated WordOff, -- Number of words allocated for *pointers* [(a, VirtualHpOffset)]) @@ -158,7 +160,7 @@ mkVirtHeapOffsets -- First in list gets lowest offset, which is initial offset + 1. -mkVirtHeapOffsets things +mkVirtHeapOffsets is_thunk things = let non_void_things = filterOut (isVoidArg . fst) things (ptrs, non_ptrs) = separateByPtrFollowness non_void_things (wds_of_ptrs, ptrs_w_offsets) = mapAccumL computeOffset 0 ptrs @@ -166,8 +168,11 @@ mkVirtHeapOffsets things in (tot_wds, wds_of_ptrs, ptrs_w_offsets ++ non_ptrs_w_offsets) where + hdr_size | is_thunk = thunkHdrSize + | otherwise = fixedHdrSize + computeOffset wds_so_far (rep, thing) - = (wds_so_far + cgRepSizeW rep, (thing, fixedHdrSize + wds_so_far)) + = (wds_so_far + cgRepSizeW rep, (thing, hdr_size + wds_so_far)) \end{code} @@ -227,6 +232,7 @@ mkStaticClosureFields cl_info ccs caf_refs payload | caf_refs = mkIntCLit 0 | otherwise = mkIntCLit 1 + mkStaticClosure :: CLabel -> CostCentreStack -> [CmmLit] -> [CmmLit] -> [CmmLit] -> [CmmLit] -> [CmmLit] mkStaticClosure info_lbl ccs payload padding_wds static_link_field saved_info_field diff --git a/ghc/compiler/codeGen/ClosureInfo.lhs b/ghc/compiler/codeGen/ClosureInfo.lhs index a0b18eb..423f429 100644 --- a/ghc/compiler/codeGen/ClosureInfo.lhs +++ b/ghc/compiler/codeGen/ClosureInfo.lhs @@ -29,8 +29,8 @@ module ClosureInfo ( closureName, infoTableLabelFromCI, closureLabelFromCI, closureSRT, - closureLFInfo, closureSMRep, closureUpdReqd, - closureNeedsUpdSpace, + closureLFInfo, isLFThunk,closureSMRep, closureUpdReqd, + closureNeedsUpdSpace, closureIsThunk, closureSingleEntry, closureReEntrant, isConstrClosure_maybe, closureFunInfo, isStandardFormThunk, isKnownFun, @@ -297,6 +297,16 @@ mkLFImported id other -> mkLFArgument id -- Not sure of exact arity \end{code} +\begin{code} +isLFThunk :: LambdaFormInfo -> Bool +isLFThunk (LFThunk _ _ _ _ _) = True +isLFThunk (LFBlackHole _) = True + -- return True for a blackhole: this function is used to determine + -- whether to use the thunk header in SMP mode, and a blackhole + -- must have one. +isLFThunk _ = False +\end{code} + %************************************************************************ %* * Building ClosureInfos @@ -343,30 +353,21 @@ mkConInfo dflags is_static data_con tot_wds ptr_wds \begin{code} closureSize :: ClosureInfo -> WordOff -closureSize cl_info = fixedHdrSize + closureNonHdrSize cl_info +closureSize cl_info = hdr_size + closureNonHdrSize cl_info + where hdr_size | closureIsThunk cl_info = thunkHdrSize + | otherwise = fixedHdrSize + -- All thunks use thunkHdrSize, even if they are non-updatable. + -- this is because we don't have separate closure types for + -- updatable vs. non-updatable thunks, so the GC can't tell the + -- difference. If we ever have significant numbers of non- + -- updatable thunks, it might be worth fixing this. closureNonHdrSize :: ClosureInfo -> WordOff closureNonHdrSize cl_info - = tot_wds + computeSlopSize tot_wds - (closureSMRep cl_info) - (closureNeedsUpdSpace cl_info) + = tot_wds + computeSlopSize tot_wds 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 -> WordOff -slopSize cl_info - = computeSlopSize (closureGoodStuffSize cl_info) - (closureSMRep cl_info) - (closureNeedsUpdSpace cl_info) - closureGoodStuffSize :: ClosureInfo -> WordOff closureGoodStuffSize cl_info = let (ptrs, nonptrs) = sizes_from_SMRep (closureSMRep cl_info) @@ -388,43 +389,51 @@ knowledge of what the storage manager does with the various representations... Slop Requirements: -\begin{itemize} -\item -Updateable closures must be @mIN_UPD_SIZE@. - \begin{itemize} - \item - Indirections require 1 word - \item - Appels collector indirections 2 words - \end{itemize} -THEREFORE: @mIN_UPD_SIZE = 2@. - -\item -Collectable closures which are allocated in the heap -must be @mIN_SIZE_NonUpdHeapObject@. -Copying collector forward pointer requires 1 word + - Updatable closures must be mIN_UPD_SIZE. -THEREFORE: @mIN_SIZE_NonUpdHeapObject = 1@ -\end{itemize} + - Heap-resident Closures must be mIN_SIZE_NonUpdHeapObject + (to make room for an StgEvacuated during GC). -Static closures have an extra ``static link field'' at the end, but we -don't bother taking that into account here. +In SMP mode, we don't play the mIN_UPD_SIZE game. Instead, every +thunk gets an extra padding word in the header, which takes the +the updated value. \begin{code} -computeSlopSize :: WordOff -> SMRep -> Bool -> WordOff +slopSize cl_info = computeSlopSize payload_size cl_info + where payload_size = closureGoodStuffSize cl_info -computeSlopSize tot_wds (GenericRep _ _ _ _) True -- Updatable - = max 0 (mIN_UPD_SIZE - tot_wds) - -computeSlopSize tot_wds (GenericRep True _ _ _) False -- Non updatable - = 0 -- Static +computeSlopSize :: WordOff -> ClosureInfo -> WordOff +computeSlopSize payload_size cl_info + = max 0 (minPayloadSize smrep updatable - payload_size) + where + smrep = closureSMRep cl_info + updatable = closureNeedsUpdSpace cl_info -computeSlopSize tot_wds (GenericRep False _ _ _) False -- Non updatable - = max 0 (mIN_SIZE_NonUpdHeapObject - tot_wds) -- Dynamic +-- 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 -computeSlopSize tot_wds BlackHoleRep _ -- Updatable - = max 0 (mIN_UPD_SIZE - tot_wds) +minPayloadSize :: SMRep -> Bool -> WordOff +minPayloadSize smrep updatable + = case smrep of + BlackHoleRep -> min_upd_size + GenericRep _ _ _ _ | updatable -> min_upd_size + GenericRep True _ _ _ -> 0 -- static + GenericRep False _ _ _ -> mIN_SIZE_NonUpdHeapObject + -- ^^^^^___ dynamic + where + min_upd_size + | opt_SMP = ASSERT(mIN_SIZE_NonUpdHeapObject <= + sIZEOF_StgSMPThunkHeader) + 0 -- check that we already have enough + -- room for mIN_SIZE_NonUpdHeapObject, + -- due to the extra header word in SMP + | otherwise = mIN_UPD_SIZE \end{code} %************************************************************************ @@ -766,11 +775,19 @@ isStaticClosure :: ClosureInfo -> Bool isStaticClosure cl_info = isStaticRep (closureSMRep cl_info) closureUpdReqd :: ClosureInfo -> Bool -closureUpdReqd (ClosureInfo { closureLFInfo = LFThunk _ _ upd _ _ }) = upd -closureUpdReqd (ClosureInfo { closureLFInfo = LFBlackHole _ }) = True +closureUpdReqd ClosureInfo{ closureLFInfo = lf_info } = lfUpdatable lf_info +closureUpdReqd ConInfo{} = False + +lfUpdatable :: LambdaFormInfo -> Bool +lfUpdatable (LFThunk _ _ upd _ _) = upd +lfUpdatable (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. -closureUpdReqd other_closure = False +lfUpdatable _ = False + +closureIsThunk :: ClosureInfo -> Bool +closureIsThunk ClosureInfo{ closureLFInfo = lf_info } = isLFThunk lf_info +closureIsThunk ConInfo{} = False closureSingleEntry :: ClosureInfo -> Bool closureSingleEntry (ClosureInfo { closureLFInfo = LFThunk _ _ upd _ _}) = not upd diff --git a/ghc/compiler/codeGen/SMRep.lhs b/ghc/compiler/codeGen/SMRep.lhs index da446b6..b0b1b14 100644 --- a/ghc/compiler/codeGen/SMRep.lhs +++ b/ghc/compiler/codeGen/SMRep.lhs @@ -28,7 +28,7 @@ module SMRep ( SMRep(..), ClosureType(..), isStaticRep, fixedHdrSize, arrWordsHdrSize, arrPtrsHdrSize, - profHdrSize, + profHdrSize, thunkHdrSize, tablesNextToCode, smRepClosureType, smRepClosureTypeInt, @@ -43,7 +43,7 @@ import Type ( Type, typePrimRep, PrimRep(..) ) import TyCon ( TyCon, tyConPrimRep ) import MachOp-- ( MachRep(..), MachHint(..), wordRep ) import StaticFlags ( opt_SccProfilingOn, opt_GranMacros, - opt_Unregisterised ) + opt_Unregisterised, opt_SMP ) import Constants import Outputable @@ -285,6 +285,13 @@ arrWordsHdrSize = fixedHdrSize*wORD_SIZE + sIZEOF_StgArrWords_NoHdr arrPtrsHdrSize :: ByteOff arrPtrsHdrSize = fixedHdrSize*wORD_SIZE + sIZEOF_StgMutArrPtrs_NoHdr + +-- Thunks have an extra header word on SMP, so the update doesn't +-- splat the payload. +thunkHdrSize :: WordOff +thunkHdrSize | opt_SMP = fixedHdrSize + smp_hdr + | otherwise = fixedHdrSize + where smp_hdr = sIZEOF_StgSMPThunkHeader `quot` wORD_SIZE \end{code} \begin{code}