Commit 0bffc410 authored by simonmar's avatar simonmar

[project @ 2002-12-11 15:36:20 by simonmar]

Merge the eval-apply-branch on to the HEAD
------------------------------------------

This is a change to GHC's evaluation model in order to ultimately make
GHC more portable and to reduce complexity in some areas.

At some point we'll update the commentary to describe the new state of
the RTS.  Pending that, the highlights of this change are:

  - No more Su.  The Su register is gone, update frames are one
    word smaller.

  - Slow-entry points and arg checks are gone.  Unknown function calls
    are handled by automatically-generated RTS entry points (AutoApply.hc,
    generated by the program in utils/genapply).

  - The stack layout is stricter: there are no "pending arguments" on
    the stack any more, the stack is always strictly a sequence of
    stack frames.

    This means that there's no need for LOOKS_LIKE_GHC_INFO() or
    LOOKS_LIKE_STATIC_CLOSURE() any more, and GHC doesn't need to know
    how to find the boundary between the text and data segments (BIG WIN!).

  - A couple of nasty hacks in the mangler caused by the neet to
    identify closure ptrs vs. info tables have gone away.

  - Info tables are a bit more complicated.  See InfoTables.h for the
    details.

  - As a side effect, GHCi can now deal with polymorphic seq.  Some bugs
    in GHCi which affected primitives and unboxed tuples are now
    fixed.

  - Binary sizes are reduced by about 7% on x86.  Performance is roughly
    similar, some programs get faster while some get slower.  I've seen
    GHCi perform worse on some examples, but haven't investigated
    further yet (GHCi performance *should* be about the same or better
    in theory).

  - Internally the code generator is rather better organised.  I've moved
    info-table generation from the NCG into the main codeGen where it is
    shared with the C back-end; info tables are now emitted as arrays
    of words in both back-ends.  The NCG is one step closer to being able
    to support profiling.

This has all been fairly thoroughly tested, but no doubt I've messed
up the commit in some way.
parent a63622cc
...@@ -58,9 +58,11 @@ name = Util.global (value) :: IORef (ty); \ ...@@ -58,9 +58,11 @@ name = Util.global (value) :: IORef (ty); \
#define ASSERT(e) if (not (e)) then (assertPanic __FILE__ __LINE__) else #define ASSERT(e) if (not (e)) then (assertPanic __FILE__ __LINE__) else
#define ASSERT2(e,msg) if (not (e)) then (assertPprPanic __FILE__ __LINE__ (msg)) else #define ASSERT2(e,msg) if (not (e)) then (assertPprPanic __FILE__ __LINE__ (msg)) else
#define WARN( e, msg ) (warnPprTrace (e) __FILE__ __LINE__ (msg)) #define WARN( e, msg ) (warnPprTrace (e) __FILE__ __LINE__ (msg))
#define ASSERTM(e) ASSERT(e) do
#else #else
#define ASSERT(e) #define ASSERT(e)
#define ASSERT2(e,msg) #define ASSERT2(e,msg)
#define ASSERTM(e)
#define WARN(e,msg) #define WARN(e,msg)
#endif #endif
......
% %
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
% %
% $Id: AbsCSyn.lhs,v 1.50 2002/09/13 15:02:25 simonpj Exp $ % $Id: AbsCSyn.lhs,v 1.51 2002/12/11 15:36:21 simonmar Exp $
% %
\section[AbstractC]{Abstract C: the last stop before machine code} \section[AbstractC]{Abstract C: the last stop before machine code}
...@@ -191,6 +191,7 @@ stored in a mixed type location.) ...@@ -191,6 +191,7 @@ stored in a mixed type location.)
-- *** the next three [or so...] are DATA (those above are CODE) *** -- *** the next three [or so...] are DATA (those above are CODE) ***
| CStaticClosure | CStaticClosure
CLabel -- The closure's label
ClosureInfo -- Todo: maybe info_lbl & closure_lbl instead? ClosureInfo -- Todo: maybe info_lbl & closure_lbl instead?
CAddrMode -- cost centre identifier to place in closure CAddrMode -- cost centre identifier to place in closure
[CAddrMode] -- free vars; ptrs, then non-ptrs. [CAddrMode] -- free vars; ptrs, then non-ptrs.
...@@ -198,18 +199,12 @@ stored in a mixed type location.) ...@@ -198,18 +199,12 @@ stored in a mixed type location.)
| CSRT CLabel [CLabel] -- SRT declarations: basically an array of | CSRT CLabel [CLabel] -- SRT declarations: basically an array of
-- pointers to static closures. -- pointers to static closures.
| CBitmap CLabel LivenessMask -- A bitmap to be emitted if and only if | CBitmap Liveness -- A bitmap to be emitted if and only if
-- it is larger than a target machine word. -- it is larger than a target machine word.
| CClosureInfoAndCode | CClosureInfoAndCode
ClosureInfo -- Explains placement and layout of closure ClosureInfo -- Explains placement and layout of closure
AbstractC -- Slow entry point code AbstractC -- Entry point code
(Maybe AbstractC)
-- Fast entry point code, if any
String -- Closure description; NB we can't get this
-- from ClosureInfo, because the latter refers
-- to the *right* hand side of a defn, whereas
-- the "description" refers to *left* hand side
| CRetVector -- A labelled block of static data | CRetVector -- A labelled block of static data
CLabel CLabel
...@@ -260,14 +255,10 @@ macros. An example is @STK_CHK@, which checks for stack-space ...@@ -260,14 +255,10 @@ macros. An example is @STK_CHK@, which checks for stack-space
overflow. This enumeration type lists all such macros: overflow. This enumeration type lists all such macros:
\begin{code} \begin{code}
data CStmtMacro data CStmtMacro
= ARGS_CHK -- arg satisfaction check = UPD_CAF -- update CAF closure with indirection
| ARGS_CHK_LOAD_NODE -- arg check for top-level functions
| UPD_CAF -- update CAF closure with indirection
| UPD_BH_UPDATABLE -- eager backholing | UPD_BH_UPDATABLE -- eager backholing
| UPD_BH_SINGLE_ENTRY -- more eager blackholing | UPD_BH_SINGLE_ENTRY -- more eager blackholing
| PUSH_UPD_FRAME -- push update frame | PUSH_UPD_FRAME -- push update frame
| PUSH_SEQ_FRAME -- push seq frame
| UPDATE_SU_FROM_UPD_FRAME -- pull Su out of the update frame
| SET_TAG -- set TagReg if it exists | SET_TAG -- set TagReg if it exists
-- dataToTag# primop -- *only* used in unregisterised builds. -- dataToTag# primop -- *only* used in unregisterised builds.
-- (see AbsCUtils.dsCOpStmt) -- (see AbsCUtils.dsCOpStmt)
...@@ -293,11 +284,10 @@ data CCheckMacro ...@@ -293,11 +284,10 @@ data CCheckMacro
= HP_CHK_NP -- heap/stack checks when = HP_CHK_NP -- heap/stack checks when
| STK_CHK_NP -- node points to the closure | STK_CHK_NP -- node points to the closure
| HP_STK_CHK_NP | HP_STK_CHK_NP
| HP_CHK_SEQ_NP -- for 'seq' style case alternatives
| HP_CHK -- heap/stack checks when | HP_CHK_FUN -- heap/stack checks when
| STK_CHK -- node doesn't point | STK_CHK_FUN -- node doesn't point
| HP_STK_CHK | HP_STK_CHK_FUN
-- case alternative heap checks: -- case alternative heap checks:
| HP_CHK_NOREGS -- no registers live | HP_CHK_NOREGS -- no registers live
...@@ -306,9 +296,8 @@ data CCheckMacro ...@@ -306,9 +296,8 @@ data CCheckMacro
| HP_CHK_F1 -- FloatReg1 (only) is live | HP_CHK_F1 -- FloatReg1 (only) is live
| HP_CHK_D1 -- DblReg1 (only) is live | HP_CHK_D1 -- DblReg1 (only) is live
| HP_CHK_L1 -- LngReg1 (only) is live | HP_CHK_L1 -- LngReg1 (only) is live
| HP_CHK_UT_ALT -- unboxed tuple return.
| HP_CHK_GEN -- generic heap check | HP_CHK_UNBX_TUPLE -- unboxed tuple heap check
\end{code} \end{code}
\item[@CCallProfCtrMacro@:] \item[@CCallProfCtrMacro@:]
...@@ -469,7 +458,7 @@ bitmap to C compilation time (or rather, C preprocessing time). ...@@ -469,7 +458,7 @@ bitmap to C compilation time (or rather, C preprocessing time).
\begin{code} \begin{code}
type LivenessMask = [BitSet] type LivenessMask = [BitSet]
data Liveness = Liveness CLabel LivenessMask data Liveness = Liveness CLabel !Int LivenessMask
\end{code} \end{code}
%************************************************************************ %************************************************************************
...@@ -515,7 +504,6 @@ data MagicId ...@@ -515,7 +504,6 @@ data MagicId
-- STG registers -- STG registers
| Sp -- Stack ptr; points to last occupied stack location. | Sp -- Stack ptr; points to last occupied stack location.
| Su -- Stack update frame pointer
| SpLim -- Stack limit | SpLim -- Stack limit
| Hp -- Heap ptr; points to last occupied heap location. | Hp -- Heap ptr; points to last occupied heap location.
| HpLim -- Heap limit register | HpLim -- Heap limit register
...@@ -545,7 +533,6 @@ instance Eq MagicId where ...@@ -545,7 +533,6 @@ instance Eq MagicId where
where where
tag BaseReg = (_ILIT(0) :: FastInt) tag BaseReg = (_ILIT(0) :: FastInt)
tag Sp = _ILIT(1) tag Sp = _ILIT(1)
tag Su = _ILIT(2)
tag SpLim = _ILIT(3) tag SpLim = _ILIT(3)
tag Hp = _ILIT(4) tag Hp = _ILIT(4)
tag HpLim = _ILIT(5) tag HpLim = _ILIT(5)
......
...@@ -144,7 +144,6 @@ magicIdPrimRep (FloatReg _) = FloatRep ...@@ -144,7 +144,6 @@ magicIdPrimRep (FloatReg _) = FloatRep
magicIdPrimRep (DoubleReg _) = DoubleRep magicIdPrimRep (DoubleReg _) = DoubleRep
magicIdPrimRep (LongReg kind _) = kind magicIdPrimRep (LongReg kind _) = kind
magicIdPrimRep Sp = PtrRep magicIdPrimRep Sp = PtrRep
magicIdPrimRep Su = PtrRep
magicIdPrimRep SpLim = PtrRep magicIdPrimRep SpLim = PtrRep
magicIdPrimRep Hp = PtrRep magicIdPrimRep Hp = PtrRep
magicIdPrimRep HpLim = PtrRep magicIdPrimRep HpLim = PtrRep
...@@ -320,11 +319,10 @@ flatAbsC (AbsCStmts s1 s2) ...@@ -320,11 +319,10 @@ flatAbsC (AbsCStmts s1 s2)
returnFlt (mkAbsCStmts inline_s1 inline_s2, returnFlt (mkAbsCStmts inline_s1 inline_s2,
mkAbsCStmts top_s1 top_s2) mkAbsCStmts top_s1 top_s2)
flatAbsC (CClosureInfoAndCode cl_info slow maybe_fast descr) flatAbsC (CClosureInfoAndCode cl_info entry)
= flatAbsC slow `thenFlt` \ (slow_heres, slow_tops) -> = flatAbsC entry `thenFlt` \ (entry_heres, entry_tops) ->
flat_maybe maybe_fast `thenFlt` \ (fast_heres, fast_tops) -> returnFlt (AbsCNop, mkAbstractCs [entry_tops,
returnFlt (AbsCNop, mkAbstractCs [slow_tops, fast_tops, CClosureInfoAndCode cl_info entry_heres]
CClosureInfoAndCode cl_info slow_heres fast_heres descr]
) )
flatAbsC (CCodeBlock lbl abs_C) flatAbsC (CCodeBlock lbl abs_C)
...@@ -418,10 +416,10 @@ flatAbsC (CSequential abcs) ...@@ -418,10 +416,10 @@ flatAbsC (CSequential abcs)
-- Some statements only make sense at the top level, so we always float -- Some statements only make sense at the top level, so we always float
-- them. This probably isn't necessary. -- them. This probably isn't necessary.
flatAbsC stmt@(CStaticClosure _ _ _) = returnFlt (AbsCNop, stmt) flatAbsC stmt@(CStaticClosure _ _ _ _) = returnFlt (AbsCNop, stmt)
flatAbsC stmt@(CClosureTbl _) = returnFlt (AbsCNop, stmt) flatAbsC stmt@(CClosureTbl _) = returnFlt (AbsCNop, stmt)
flatAbsC stmt@(CSRT _ _) = returnFlt (AbsCNop, stmt) flatAbsC stmt@(CSRT _ _) = returnFlt (AbsCNop, stmt)
flatAbsC stmt@(CBitmap _ _) = returnFlt (AbsCNop, stmt) flatAbsC stmt@(CBitmap _) = returnFlt (AbsCNop, stmt)
flatAbsC stmt@(CCostCentreDecl _ _) = returnFlt (AbsCNop, stmt) flatAbsC stmt@(CCostCentreDecl _ _) = returnFlt (AbsCNop, stmt)
flatAbsC stmt@(CCostCentreStackDecl _) = returnFlt (AbsCNop, stmt) flatAbsC stmt@(CCostCentreStackDecl _) = returnFlt (AbsCNop, stmt)
flatAbsC stmt@(CSplitMarker) = returnFlt (AbsCNop, stmt) flatAbsC stmt@(CSplitMarker) = returnFlt (AbsCNop, stmt)
......
% %
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % (c) The University of Glasgow, 1992-2002
%
% $Id: CLabel.lhs,v 1.55 2002/09/13 15:02:26 simonpj Exp $
% %
\section[CLabel]{@CLabel@: Information to make C Labels} \section[CLabel]{@CLabel@: Information to make C Labels}
...@@ -12,8 +10,8 @@ module CLabel ( ...@@ -12,8 +10,8 @@ module CLabel (
mkClosureLabel, mkClosureLabel,
mkSRTLabel, mkSRTLabel,
mkInfoTableLabel, mkInfoTableLabel,
mkStdEntryLabel, mkEntryLabel,
mkFastEntryLabel, mkSlowEntryLabel,
mkConEntryLabel, mkConEntryLabel,
mkStaticConEntryLabel, mkStaticConEntryLabel,
mkRednCountsLabel, mkRednCountsLabel,
...@@ -62,6 +60,9 @@ module CLabel ( ...@@ -62,6 +60,9 @@ module CLabel (
mkSelectorInfoLabel, mkSelectorInfoLabel,
mkSelectorEntryLabel, mkSelectorEntryLabel,
mkRtsApplyInfoLabel,
mkRtsApplyEntryLabel,
mkForeignLabel, mkForeignLabel,
mkCC_Label, mkCCS_Label, mkCC_Label, mkCCS_Label,
...@@ -149,20 +150,17 @@ data CLabel ...@@ -149,20 +150,17 @@ data CLabel
\begin{code} \begin{code}
data IdLabelInfo data IdLabelInfo
= Closure -- Label for (static???) closure = Closure -- Label for (static???) closure
| SRT -- Static reference table | SRT -- Static reference table
| InfoTbl -- Info tables for closures; always read-only
| InfoTbl -- Info table for a closure; always read-only | Entry -- entry point
| Slow -- slow entry point
| EntryStd -- Thunk, or "slow", code entry point
| EntryFast Int -- entry pt when no arg satisfaction chk needed;
-- Int is the arity of the function (to be
-- encoded into the name)
-- Ticky-ticky counting -- Ticky-ticky counting
| RednCounts -- Label of place to keep reduction-count info for | RednCounts -- Label of place to keep reduction-count info for
-- this Id -- this Id
| Bitmap -- A bitmap (function or case return)
deriving (Eq, Ord) deriving (Eq, Ord)
data DataConLabelInfo data DataConLabelInfo
...@@ -178,13 +176,12 @@ data CaseLabelInfo ...@@ -178,13 +176,12 @@ data CaseLabelInfo
| CaseVecTbl | CaseVecTbl
| CaseAlt ConTag | CaseAlt ConTag
| CaseDefault | CaseDefault
| CaseBitmap
deriving (Eq, Ord) deriving (Eq, Ord)
data RtsLabelInfo data RtsLabelInfo
= RtsShouldNeverHappenCode = RtsShouldNeverHappenCode
| RtsBlackHoleInfoTbl FastString -- black hole with info table name | RtsBlackHoleInfoTbl LitString -- black hole with info table name
| RtsUpdInfo -- upd_frame_info | RtsUpdInfo -- upd_frame_info
| RtsSeqInfo -- seq_frame_info | RtsSeqInfo -- seq_frame_info
...@@ -206,12 +203,16 @@ data RtsLabelInfo ...@@ -206,12 +203,16 @@ data RtsLabelInfo
| RtsModuleRegd | RtsModuleRegd
| RtsApplyInfoLabel LitString
| RtsApplyEntryLabel LitString
deriving (Eq, Ord) deriving (Eq, Ord)
-- Label Type: for generating C declarations. -- Label Type: for generating C declarations.
data CLabelType data CLabelType
= InfoTblType = RetInfoTblType
| InfoTblType
| ClosureType | ClosureType
| VecTblType | VecTblType
| ClosureTblType | ClosureTblType
...@@ -222,11 +223,10 @@ data CLabelType ...@@ -222,11 +223,10 @@ data CLabelType
\begin{code} \begin{code}
mkClosureLabel id = IdLabel id Closure mkClosureLabel id = IdLabel id Closure
mkSRTLabel id = IdLabel id SRT mkSRTLabel id = IdLabel id SRT
mkInfoTableLabel id = IdLabel id InfoTbl mkInfoTableLabel id = IdLabel id InfoTbl
mkStdEntryLabel id = IdLabel id EntryStd mkEntryLabel id = IdLabel id Entry
mkFastEntryLabel id arity = ASSERT(arity > 0) mkSlowEntryLabel id = IdLabel id Slow
IdLabel id (EntryFast arity) mkBitmapLabel id = IdLabel id Bitmap
mkRednCountsLabel id = IdLabel id RednCounts mkRednCountsLabel id = IdLabel id RednCounts
mkStaticInfoTableLabel con = DataConLabel con StaticInfoTbl mkStaticInfoTableLabel con = DataConLabel con StaticInfoTbl
...@@ -240,7 +240,7 @@ mkReturnInfoLabel uniq = CaseLabel uniq CaseReturnInfo ...@@ -240,7 +240,7 @@ mkReturnInfoLabel uniq = CaseLabel uniq CaseReturnInfo
mkVecTblLabel uniq = CaseLabel uniq CaseVecTbl mkVecTblLabel uniq = CaseLabel uniq CaseVecTbl
mkAltLabel uniq tag = CaseLabel uniq (CaseAlt tag) mkAltLabel uniq tag = CaseLabel uniq (CaseAlt tag)
mkDefaultLabel uniq = CaseLabel uniq CaseDefault mkDefaultLabel uniq = CaseLabel uniq CaseDefault
mkBitmapLabel uniq = CaseLabel uniq CaseBitmap
mkClosureTblLabel tycon = TyConLabel tycon mkClosureTblLabel tycon = TyConLabel tycon
...@@ -266,10 +266,10 @@ mkMAP_FROZEN_infoLabel = RtsLabel (Rts_Info "stg_MUT_ARR_PTRS_FROZEN_info") ...@@ -266,10 +266,10 @@ mkMAP_FROZEN_infoLabel = RtsLabel (Rts_Info "stg_MUT_ARR_PTRS_FROZEN_info")
mkEMPTY_MVAR_infoLabel = RtsLabel (Rts_Info "stg_EMPTY_MVAR_info") mkEMPTY_MVAR_infoLabel = RtsLabel (Rts_Info "stg_EMPTY_MVAR_info")
mkTopTickyCtrLabel = RtsLabel RtsTopTickyCtr mkTopTickyCtrLabel = RtsLabel RtsTopTickyCtr
mkBlackHoleInfoTableLabel = RtsLabel (RtsBlackHoleInfoTbl FSLIT("stg_BLACKHOLE_info")) mkBlackHoleInfoTableLabel = RtsLabel (RtsBlackHoleInfoTbl SLIT("stg_BLACKHOLE_info"))
mkCAFBlackHoleInfoTableLabel = RtsLabel (RtsBlackHoleInfoTbl FSLIT("stg_CAF_BLACKHOLE_info")) mkCAFBlackHoleInfoTableLabel = RtsLabel (RtsBlackHoleInfoTbl SLIT("stg_CAF_BLACKHOLE_info"))
mkSECAFBlackHoleInfoTableLabel = if opt_DoTickyProfiling then mkSECAFBlackHoleInfoTableLabel = if opt_DoTickyProfiling then
RtsLabel (RtsBlackHoleInfoTbl FSLIT("stg_SE_CAF_BLACKHOLE_info")) RtsLabel (RtsBlackHoleInfoTbl SLIT("stg_SE_CAF_BLACKHOLE_info"))
else -- RTS won't have info table unless -ticky is on else -- RTS won't have info table unless -ticky is on
panic "mkSECAFBlackHoleInfoTableLabel requires -ticky" panic "mkSECAFBlackHoleInfoTableLabel requires -ticky"
mkRtsPrimOpLabel primop = RtsLabel (RtsPrimOp primop) mkRtsPrimOpLabel primop = RtsLabel (RtsPrimOp primop)
...@@ -291,6 +291,11 @@ mkForeignLabel str is_dynamic = ForeignLabel str is_dynamic ...@@ -291,6 +291,11 @@ mkForeignLabel str is_dynamic = ForeignLabel str is_dynamic
mkCC_Label cc = CC_Label cc mkCC_Label cc = CC_Label cc
mkCCS_Label ccs = CCS_Label ccs mkCCS_Label ccs = CCS_Label ccs
-- Std RTS application routines
mkRtsApplyInfoLabel = RtsLabel . RtsApplyInfoLabel
mkRtsApplyEntryLabel = RtsLabel . RtsApplyEntryLabel
\end{code} \end{code}
\begin{code} \begin{code}
...@@ -312,6 +317,10 @@ Declarations for direct return points are needed, because they may be ...@@ -312,6 +317,10 @@ Declarations for direct return points are needed, because they may be
let-no-escapes, which can be recursive. let-no-escapes, which can be recursive.
\begin{code} \begin{code}
-- don't bother declaring SRT & Bitmap labels, we always make sure
-- they are defined before use.
needsCDecl (IdLabel _ SRT) = False
needsCDecl (IdLabel _ Bitmap) = False
needsCDecl (IdLabel _ _) = True needsCDecl (IdLabel _ _) = True
needsCDecl (CaseLabel _ CaseReturnPt) = True needsCDecl (CaseLabel _ CaseReturnPt) = True
needsCDecl (DataConLabel _ _) = True needsCDecl (DataConLabel _ _) = True
...@@ -354,27 +363,36 @@ externallyVisibleCLabel (CC_Label _) = False -- not strictly true ...@@ -354,27 +363,36 @@ externallyVisibleCLabel (CC_Label _) = False -- not strictly true
externallyVisibleCLabel (CCS_Label _) = False -- not strictly true externallyVisibleCLabel (CCS_Label _) = False -- not strictly true
\end{code} \end{code}
For generating correct types in label declarations... For generating correct types in label declarations, and also for
deciding whether the C compiler would like us to use '&' before the
label to get its address:
\begin{code} \begin{code}
labelType :: CLabel -> CLabelType labelType :: CLabel -> CLabelType
labelType (RtsLabel (RtsBlackHoleInfoTbl _)) = InfoTblType labelType (RtsLabel (RtsBlackHoleInfoTbl _)) = InfoTblType
labelType (RtsLabel (RtsSelectorInfoTbl _ _)) = InfoTblType labelType (RtsLabel (RtsSelectorInfoTbl _ _)) = InfoTblType
labelType (RtsLabel (RtsApInfoTbl _ _)) = InfoTblType labelType (RtsLabel (RtsApInfoTbl _ _)) = InfoTblType
labelType (RtsLabel RtsUpdInfo) = InfoTblType labelType (RtsLabel RtsUpdInfo) = RetInfoTblType
labelType (RtsLabel RtsSeqInfo) = RetInfoTblType
labelType (RtsLabel RtsTopTickyCtr) = CodeType -- XXX
labelType (RtsLabel (Rts_Info _)) = InfoTblType labelType (RtsLabel (Rts_Info _)) = InfoTblType
labelType (CaseLabel _ CaseReturnInfo) = InfoTblType labelType (RtsLabel (RtsApplyInfoLabel _)) = RetInfoTblType
labelType (RtsLabel (RtsApplyEntryLabel _)) = CodeType
labelType (CaseLabel _ CaseReturnInfo) = RetInfoTblType
labelType (CaseLabel _ CaseReturnPt) = CodeType labelType (CaseLabel _ CaseReturnPt) = CodeType
labelType (CaseLabel _ CaseVecTbl) = VecTblType labelType (CaseLabel _ CaseVecTbl) = VecTblType
labelType (TyConLabel _) = ClosureTblType labelType (TyConLabel _) = ClosureTblType
labelType (ModuleInitLabel _ _) = CodeType labelType (ModuleInitLabel _ _) = CodeType
labelType (PlainModuleInitLabel _) = CodeType labelType (PlainModuleInitLabel _) = CodeType
labelType (CC_Label _) = CodeType -- hack
labelType (CCS_Label _) = CodeType -- hack
labelType (IdLabel _ info) = labelType (IdLabel _ info) =
case info of case info of
InfoTbl -> InfoTblType InfoTbl -> InfoTblType
Closure -> ClosureType Closure -> ClosureType
_ -> CodeType Bitmap -> DataType
_ -> CodeType
labelType (DataConLabel _ info) = labelType (DataConLabel _ info) =
case info of case info of
...@@ -429,6 +447,7 @@ internal names. <type> is one of the following: ...@@ -429,6 +447,7 @@ internal names. <type> is one of the following:
info Info table info Info table
srt Static reference table srt Static reference table
entry Entry code entry Entry code
slow Slow entry code (if any)
ret Direct return address ret Direct return address
vtbl Vector table vtbl Vector table
<n>_alt Case alternative (tag n) <n>_alt Case alternative (tag n)
...@@ -471,8 +490,6 @@ pprCLbl (CaseLabel u (CaseAlt tag)) ...@@ -471,8 +490,6 @@ pprCLbl (CaseLabel u (CaseAlt tag))
= hcat [pprUnique u, pp_cSEP, int tag, pp_cSEP, ptext SLIT("alt")] = hcat [pprUnique u, pp_cSEP, int tag, pp_cSEP, ptext SLIT("alt")]
pprCLbl (CaseLabel u CaseDefault) pprCLbl (CaseLabel u CaseDefault)
= hcat [pprUnique u, pp_cSEP, ptext SLIT("dflt")] = hcat [pprUnique u, pp_cSEP, ptext SLIT("dflt")]
pprCLbl (CaseLabel u CaseBitmap)
= hcat [pprUnique u, pp_cSEP, ptext SLIT("btm")]
pprCLbl (RtsLabel RtsShouldNeverHappenCode) = ptext SLIT("NULL") pprCLbl (RtsLabel RtsShouldNeverHappenCode) = ptext SLIT("NULL")
-- used to be stg_error_entry but Windows can't have DLL entry points as static -- used to be stg_error_entry but Windows can't have DLL entry points as static
...@@ -488,7 +505,7 @@ pprCLbl (RtsLabel (Rts_Code str)) = text str ...@@ -488,7 +505,7 @@ pprCLbl (RtsLabel (Rts_Code str)) = text str
pprCLbl (RtsLabel RtsTopTickyCtr) = ptext SLIT("top_ct") pprCLbl (RtsLabel RtsTopTickyCtr) = ptext SLIT("top_ct")
pprCLbl (RtsLabel (RtsBlackHoleInfoTbl info)) = ftext info pprCLbl (RtsLabel (RtsBlackHoleInfoTbl info)) = ptext info
pprCLbl (RtsLabel (RtsSelectorInfoTbl upd_reqd offset)) pprCLbl (RtsLabel (RtsSelectorInfoTbl upd_reqd offset))
= hcat [ptext SLIT("stg_sel_"), text (show offset), = hcat [ptext SLIT("stg_sel_"), text (show offset),
...@@ -518,6 +535,12 @@ pprCLbl (RtsLabel (RtsApEntry upd_reqd arity)) ...@@ -518,6 +535,12 @@ pprCLbl (RtsLabel (RtsApEntry upd_reqd arity))
else SLIT("_noupd_entry")) else SLIT("_noupd_entry"))
] ]
pprCLbl (RtsLabel (RtsApplyInfoLabel fs))
= ptext SLIT("stg_ap_") <> ptext fs <> ptext SLIT("_info")
pprCLbl (RtsLabel (RtsApplyEntryLabel fs))
= ptext SLIT("stg_ap_") <> ptext fs <> ptext SLIT("_ret")
pprCLbl (RtsLabel (RtsPrimOp primop)) pprCLbl (RtsLabel (RtsPrimOp primop))
= ppr primop <> ptext SLIT("_fast") = ppr primop <> ptext SLIT("_fast")
...@@ -549,11 +572,11 @@ ppIdFlavor x = pp_cSEP <> ...@@ -549,11 +572,11 @@ ppIdFlavor x = pp_cSEP <>
(case x of (case x of
Closure -> ptext SLIT("closure") Closure -> ptext SLIT("closure")
SRT -> ptext SLIT("srt") SRT -> ptext SLIT("srt")
InfoTbl -> ptext SLIT("info") InfoTbl -> ptext SLIT("info")
EntryStd -> ptext SLIT("entry") Entry -> ptext SLIT("entry")
EntryFast arity -> --false:ASSERT (arity > 0) Slow -> ptext SLIT("slow")
(<>) (ptext SLIT("fast")) (int arity)
RednCounts -> ptext SLIT("ct") RednCounts -> ptext SLIT("ct")
Bitmap -> ptext SLIT("btm")
) )
ppConFlavor x = pp_cSEP <> ppConFlavor x = pp_cSEP <>
...@@ -564,4 +587,3 @@ ppConFlavor x = pp_cSEP <> ...@@ -564,4 +587,3 @@ ppConFlavor x = pp_cSEP <>
StaticInfoTbl -> ptext SLIT("static_info") StaticInfoTbl -> ptext SLIT("static_info")
) )
\end{code} \end{code}
% %
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
% %
% $Id: Costs.lhs,v 1.31 2002/01/02 12:32:19 simonmar Exp $ % $Id: Costs.lhs,v 1.32 2002/12/11 15:36:22 simonmar Exp $
% %
% Only needed in a GranSim setup -- HWL % Only needed in a GranSim setup -- HWL
% --------------------------------------------------------------------------- % ---------------------------------------------------------------------------
...@@ -217,13 +217,13 @@ costs absC = ...@@ -217,13 +217,13 @@ costs absC =
CCallTypedef _ _ _ _ _ -> nullCosts CCallTypedef _ _ _ _ _ -> nullCosts
CStaticClosure _ _ _ -> nullCosts CStaticClosure _ _ _ _ -> nullCosts
CSRT _ _ -> nullCosts CSRT _ _ -> nullCosts
CBitmap _ _ -> nullCosts CBitmap _ -> nullCosts
CClosureInfoAndCode _ _ _ _ -> nullCosts CClosureInfoAndCode _ _ -> nullCosts
CRetVector _ _ _ _ -> nullCosts CRetVector _ _ _ _ -> nullCosts
...@@ -309,15 +309,10 @@ stmtMacroCosts :: CStmtMacro -> [CAddrMode] -> CostRes ...@@ -309,15 +309,10 @@ stmtMacroCosts :: CStmtMacro -> [CAddrMode] -> CostRes
stmtMacroCosts macro modes = stmtMacroCosts macro modes =
case macro of case macro of
ARGS_CHK_LOAD_NODE -> Cost (2, 1, 0, 0, 0) {- StgMacros.lh -}
-- p=probability of PAP (instead of AP): + p*(3,1,0,0,0)
ARGS_CHK -> Cost (2, 1, 0, 0, 0) {- StgMacros.lh -}
UPD_CAF -> Cost (7, 0, 1, 3, 0) {- SMupdate.lh -} UPD_CAF -> Cost (7, 0, 1, 3, 0) {- SMupdate.lh -}
UPD_BH_UPDATABLE -> Cost (3, 0, 0, 1, 0) {- SMupdate.lh -} UPD_BH_UPDATABLE -> Cost (3, 0, 0, 1, 0) {- SMupdate.lh -}
UPD_BH_SINGLE_ENTRY -> Cost (3, 0, 0, 1, 0) {- SMupdate.lh -} UPD_BH_SINGLE_ENTRY -> Cost (3, 0, 0, 1, 0) {- SMupdate.lh -}
PUSH_UPD_FRAME -> Cost (3, 0, 0, 4, 0) {- Updates.h -} PUSH_UPD_FRAME -> Cost (3, 0, 0, 4, 0) {- Updates.h -}
PUSH_SEQ_FRAME -> Cost (2, 0, 0, 3, 0) {- StgMacros.h !-}
UPDATE_SU_FROM_UPD_FRAME -> Cost (1, 0, 1, 0, 0) {- StgMacros.h !-}
SET_TAG -> nullCosts {- COptRegs.lh -} SET_TAG -> nullCosts {- COptRegs.lh -}
GRAN_FETCH -> nullCosts {- GrAnSim bookkeeping -} GRAN_FETCH -> nullCosts {- GrAnSim bookkeeping -}
GRAN_RESCHEDULE -> nullCosts {- GrAnSim bookkeeping -} GRAN_RESCHEDULE -> nullCosts {- GrAnSim bookkeeping -}
......
This diff is collapsed.
...@@ -23,7 +23,7 @@ module CgBindery ( ...@@ -23,7 +23,7 @@ module CgBindery (
getCAddrModeAndInfo, getCAddrMode, getCAddrModeAndInfo, getCAddrMode,
getCAddrModeIfVolatile, getVolatileRegs, getCAddrModeIfVolatile, getVolatileRegs,
buildLivenessMask, buildContLivenessMask buildContLivenessMask
) where ) where
#include "HsVersions.h" #include "HsVersions.h"
...@@ -32,7 +32,7 @@ import AbsCSyn ...@@ -32,7 +32,7 @@ import AbsCSyn
import CgMonad import CgMonad
import CgUsages ( getHpRelOffset, getSpRelOffset, getRealSp ) import CgUsages ( getHpRelOffset, getSpRelOffset, getRealSp )
import CgStackery ( freeStackSlots ) import CgStackery ( freeStackSlots, getStackFrame )
import CLabel ( mkClosureLabel, import CLabel ( mkClosureLabel,
mkBitmapLabel, pprCLabel ) mkBitmapLabel, pprCLabel )
import ClosureInfo ( mkLFImported, mkLFArgument, LambdaFormInfo ) import ClosureInfo ( mkLFImported, mkLFArgument, LambdaFormInfo )
...@@ -44,7 +44,7 @@ import VarEnv ...@@ -44,7 +44,7 @@ import VarEnv
import VarSet ( varSetElems ) import VarSet ( varSetElems )
import Literal ( Literal ) import Literal ( Literal )
import Maybes ( catMaybes, maybeToBool, seqMaybe ) import Maybes ( catMaybes, maybeToBool, seqMaybe )
import Name ( isInternalName, NamedThing(..) ) import Name ( Name, isInternalName, NamedThing(..) )
#ifdef DEBUG #ifdef DEBUG
import PprAbsC ( pprAmode ) import PprAbsC ( pprAmode )
#endif #endif
...@@ -85,7 +85,7 @@ data VolatileLoc ...@@ -85,7 +85,7 @@ data VolatileLoc
| TempVarLoc Unique | TempVarLoc Unique
| RegLoc MagicId -- in one of the magic registers | RegLoc MagicId -- in one of the magic registers
-- (probably {Int,Float,Char,etc}Reg -- (probably {Int,Float,Char,etc}Reg)
| VirHpLoc VirtualHeapOffset -- Hp+offset (address of closure) | VirHpLoc VirtualHeapOffset -- Hp+offset (address of closure)
...@@ -361,7 +361,7 @@ bindNewToStack :: (Id, VirtualSpOffset) -> Code ...@@ -361,7 +361,7 @@ bindNewToStack :: (Id, VirtualSpOffset) -> Code
bindNewToStack (name, offset) bindNewToStack (name, offset)
= addBindC name info = addBindC name info
where where
info = MkCgIdInfo name NoVolatileLoc (VirStkLoc offset) mkLFArgument info = MkCgIdInfo name NoVolatileLoc (VirStkLoc offset) (mkLFArgument name)
bindNewToNode :: Id -> VirtualHeapOffset -> LambdaFormInfo -> Code bindNewToNode :: Id -> VirtualHeapOffset -> LambdaFormInfo -> Code
bindNewToNode name offset lf_info bindNewToNode name offset lf_info
...@@ -374,7 +374,7 @@ bindNewToNode name offset lf_info ...@@ -374,7 +374,7 @@ bindNewToNode name offset lf_info
-- temporary. -- temporary.
bindNewToTemp :: Id -> FCode CAddrMode bindNewToTemp :: Id -> FCode CAddrMode
bindNewToTemp name bindNewToTemp name
= let (temp_amode, id_info) = newTempAmodeAndIdInfo name mkLFArgument = let (temp_amode, id_info) = newTempAmodeAndIdInfo name (mkLFArgument name)
-- This is used only for things we don't know -- This is used only for things we don't know
-- anything about; values returned by a case statement, -- anything about; values returned by a case statement,
-- for example. -- for example.
...@@ -392,7 +392,7 @@ bindArgsToRegs :: [Id] -> [MagicId] -> Code ...@@ -392,7 +392,7 @@ bindArgsToRegs :: [Id] -> [MagicId] -> Code