mkClosureLFInfo, mkConLFInfo, mkSelectorLFInfo, mkVapLFInfo,
mkLFImported, mkLFArgument, mkLFLetNoEscape,
+ UpdateFlag,
closureSize, closureHdrSize,
closureNonHdrSize, closureSizeWithoutFixedHdr,
layOutStaticNoFVClosure, layOutPhantomClosure,
mkVirtHeapOffsets,
- nodeMustPointToIt, getEntryConvention,
- blackHoleOnEntry, lfArity_maybe,
+ nodeMustPointToIt, getEntryConvention,
+ SYN_IE(FCode), CgInfoDownwards, CgState,
+
+ blackHoleOnEntry,
staticClosureRequired,
slowFunEntryCodeRequired, funInfoTableRequired,
stdVapRequired, noUpdVapRequired,
+ StgBinderInfo,
closureId, infoTableLabelFromCI, fastLabelFromCI,
closureLabelFromCI,
closureLFInfo, closureSMRep, closureUpdReqd,
closureSingleEntry, closureSemiTag, closureType,
closureReturnsUnboxedType, getStandardFormThunkInfo,
+ GenStgArg,
isToplevClosure,
closureKind, closureTypeDescr, -- profiling
) where
IMP_Ubiq(){-uitous-}
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ <= 201
IMPORT_DELOOPER(AbsCLoop) -- here for paranoia-checking
+#endif
-import AbsCSyn
+import AbsCSyn ( MagicId, node, mkLiveRegsMask,
+ {- GHC 0.29 only -} AbstractC, CAddrMode
+ )
import StgSyn
import CgMonad
import CgRetConv ( assignRegs, dataReturnConvAlg,
DataReturnConvention(..)
)
-import CLabel ( mkStdEntryLabel, mkFastEntryLabel,
+import CLabel ( CLabel, mkStdEntryLabel, mkFastEntryLabel,
mkPhantomInfoTableLabel, mkInfoTableLabel,
- mkConInfoTableLabel,
+ mkConInfoTableLabel, mkStaticClosureLabel,
mkBlackHoleInfoTableLabel, mkVapInfoTableLabel,
mkStaticInfoTableLabel, mkStaticConEntryLabel,
mkConEntryLabel, mkClosureLabel, mkVapEntryLabel
)
import CmdLineOpts ( opt_SccProfilingOn, opt_ForConcurrent )
import HeapOffs ( intOff, addOff, totHdrSize, varHdrSize,
- SYN_IE(VirtualHeapOffset)
+ SYN_IE(VirtualHeapOffset), HeapOffset
)
import Id ( idType, getIdArity,
externallyVisibleId,
dataConTag, fIRST_TAG,
- isDataCon, isNullaryDataCon, dataConTyCon, dataConArity,
+ isDataCon, isNullaryDataCon, dataConTyCon,
isTupleCon, SYN_IE(DataCon),
- GenId{-instance Eq-}
+ GenId{-instance Eq-}, SYN_IE(Id)
)
import IdInfo ( ArityInfo(..) )
import Maybes ( maybeToBool )
import Name ( getOccString )
-import PprStyle ( PprStyle(..) )
+import Outputable ( PprStyle(..), Outputable(..) )
import PprType ( getTyDescription, GenType{-instance Outputable-} )
import Pretty --ToDo:rm
import PrelInfo ( maybeCharLikeTyCon, maybeIntLikeTyCon )
-import PrimRep ( getPrimRepSize, separateByPtrFollowness )
+import PrimRep ( getPrimRepSize, separateByPtrFollowness, PrimRep )
import SMRep -- all of it
import TyCon ( TyCon{-instance NamedThing-} )
-import Type ( isPrimType, expandTy, splitForAllTy, splitFunTyExpandingDictsAndPeeking,
- mkFunTys, maybeAppSpecDataTyConExpandingDicts
+import Type ( isPrimType, splitFunTyExpandingDictsAndPeeking,
+ mkFunTys, maybeAppSpecDataTyConExpandingDicts,
+ SYN_IE(Type)
)
import Util ( isIn, mapAccumL, panic, pprPanic, assertPanic )
\end{code}
-- having Node point to the result of an update. SLPJ
-- 27/11/92.
- LFThunk _ no_fvs updatable _
+ LFThunk _ no_fvs updatable NonStandardThunk
-> returnFC (updatable || not no_fvs || do_profiling)
-- For the non-updatable (single-entry case):
-- or profiling (in which case we need to recover the cost centre
-- from inside it)
+ LFThunk _ no_fvs updatable some_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
slowFunEntryCodeRequired -- Assumption: it's a function, not a thunk.
:: Id
-> StgBinderInfo
+ -> EntryConvention
-> Bool
-slowFunEntryCodeRequired binder (StgBinderInfo arg_occ unsat_occ _ _ _)
+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
- {- HAS FREE VARS AND IS PARALLEL WORLD -}
+ || (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
+slowFunEntryCodeRequired binder NoStgBinderInfo _ = True
funInfoTableRequired
:: Id
@lfArity@ extracts the arity of a function from its LFInfo
\begin{code}
+{- Not needed any more
+
lfArity_maybe (LFReEntrant _ arity _) = Just arity
-lfArity_maybe (LFCon con _) = Just (dataConArity con)
-lfArity_maybe (LFTuple con _) = Just (dataConArity con)
+
+-- 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}
%************************************************************************
(arg_tys, res_ty) = splitFunTyExpandingDictsAndPeeking (idType id)
in
-- ASSERT(arity >= 0 && length arg_tys >= arity)
- (if (arity >= 0 && length arg_tys >= arity) then (\x->x) else pprPanic "fun_result_ty:" (ppCat [ppInt arity, ppr PprShowAll id, ppr PprDebug (idType id)])) $
+ (if (arity >= 0 && length arg_tys >= arity) then (\x->x) else pprPanic "fun_result_ty:" (hsep [int arity, ppr PprShowAll id, ppr PprDebug (idType id)])) $
mkFunTys (drop arity arg_tys) res_ty
\end{code}
\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 -> mkFastEntryLabel id arity
- other -> pprPanic "fastLabelFromCI" (ppr PprDebug id)
+ Just arity ->
+-}
+ = case getIdArity id of
+ ArityExactly arity -> mkFastEntryLabel id arity
+ other -> pprPanic "fastLabelFromCI" (ppr PprDebug id)
infoTableLabelFromCI :: ClosureInfo -> CLabel
infoTableLabelFromCI (MkClosureInfo id lf_info rep)
_ -> mkConEntryLabel con
-closureLabelFromCI (MkClosureInfo id _ _) = mkClosureLabel id
+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
entryLabelFromCI :: ClosureInfo -> CLabel
entryLabelFromCI (MkClosureInfo id lf_info rep)
projects / ghc-hetmet.git / blobdiff