Commit a5f77999 authored by simonmar's avatar simonmar
Browse files

[project @ 1999-06-24 13:04:13 by simonmar]

- Implement update-in-place in certain very specialised circumstances
- Clean up abstract C a bit
- Speed up pretty-printing absC a bit.
parent 36c2d7c8
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: AbsCSyn.lhs,v 1.23 1999/05/13 17:30:52 simonm Exp $
% $Id: AbsCSyn.lhs,v 1.24 1999/06/24 13:04:13 simonmar Exp $
%
\section[AbstractC]{Abstract C: the last stop before machine code}
......@@ -47,7 +47,7 @@ import CLabel
import Constants ( mAX_Vanilla_REG, mAX_Float_REG,
mAX_Double_REG, spRelToInt )
import CostCentre ( CostCentre, CostCentreStack )
import Const ( mkMachInt, Literal )
import Const ( mkMachInt, Literal(..) )
import PrimRep ( PrimRep(..) )
import PrimOp ( PrimOp )
import Unique ( Unique )
......@@ -114,7 +114,7 @@ stored in a mixed type location.)
| CInitHdr -- to initialise the header of a closure (both fixed/var parts)
ClosureInfo
RegRelative -- address of the info ptr
CAddrMode -- address of the info ptr
CAddrMode -- cost centre to place in closure
-- CReg CurCostCentre or CC_HDR(R1.p{-Node-})
......@@ -232,13 +232,13 @@ data CStmtMacro
| UPD_BH_SINGLE_ENTRY -- more eager blackholing
| 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
| GRAN_FETCH -- for GrAnSim only -- HWL
| GRAN_RESCHEDULE -- for GrAnSim only -- HWL
| GRAN_FETCH_AND_RESCHEDULE -- for GrAnSim only -- HWL
| THREAD_CONTEXT_SWITCH -- for GrAnSim only -- HWL
| GRAN_YIELD -- for GrAnSim only -- HWL
deriving Text
\end{code}
Heap/Stack checks. There are far too many of these.
......@@ -265,7 +265,6 @@ data CCheckMacro
| HP_CHK_UT_ALT -- unboxed tuple return.
| HP_CHK_GEN -- generic heap check
deriving Text
\end{code}
\item[@CCallProfCtrMacro@:]
......@@ -300,11 +299,6 @@ data CAddrMode
| CReg MagicId -- To replace (CAddr MagicId 0)
| CTableEntry -- CVal should be generalized to allow this
CAddrMode -- Base
CAddrMode -- Offset
PrimRep -- For casting
| CTemp !Unique !PrimRep -- Temporary locations
-- ``Temporaries'' correspond to local variables in C, and registers in
-- native code.
......@@ -320,8 +314,8 @@ data CAddrMode
-- specified small integer. It is guaranteed to be in
-- the range mIN_INTLIKE..mAX_INTLIKE
| CString FAST_STRING -- The address of the null-terminated string
| CLit Literal
| CLitLit FAST_STRING -- completely literal literal: just spit this String
-- into the C output
PrimRep
......@@ -348,7 +342,7 @@ data CExprMacro
= ENTRY_CODE
| ARG_TAG -- stack argument tagging
| GET_TAG -- get current constructor tag
deriving(Text)
| UPD_FRAME_UPDATEE
\end{code}
......@@ -358,6 +352,9 @@ Convenience functions:
mkIntCLit :: Int -> CAddrMode
mkIntCLit i = CLit (mkMachInt (toInteger i))
mkCString :: FAST_STRING -> CAddrMode
mkCString s = CLit (MachStr s)
mkCCostCentre :: CostCentre -> CAddrMode
mkCCostCentre cc = CLbl (mkCC_Label cc) DataPtrRep
......@@ -376,6 +373,8 @@ data RegRelative
= HpRel FAST_INT -- }
| SpRel FAST_INT -- }- offsets in StgWords
| NodeRel FAST_INT -- }
| CIndex CAddrMode CAddrMode PrimRep -- pointer arithmetic :-)
-- CIndex a b k === (k*)a[b]
data ReturnInfo
= DirectReturn -- Jump directly, if possible
......@@ -400,7 +399,7 @@ nodeRel IBOX(off) = NodeRel off
%************************************************************************
%* *
\subsection[RegRelative]{@RegRelatives@: ???}
\subsection[Liveness]{Liveness Masks}
%* *
%************************************************************************
......
......@@ -155,14 +155,10 @@ getAmodeRep (CTemp uniq kind) = kind
getAmodeRep (CLbl label kind) = kind
getAmodeRep (CCharLike _) = PtrRep
getAmodeRep (CIntLike _) = PtrRep
getAmodeRep (CString _) = PtrRep
getAmodeRep (CLit lit) = literalPrimRep lit
getAmodeRep (CLitLit _ kind) = kind
getAmodeRep (CTableEntry _ _ kind) = kind
getAmodeRep (CMacroExpr kind _ _) = kind
#ifdef DEBUG
getAmodeRep (CJoinPoint _) = panic "getAmodeRep:CJoinPoint"
#endif
\end{code}
@mixedTypeLocn@ tells whether an amode identifies an ``StgWord''
......
......@@ -117,7 +117,7 @@ costs absC =
CAssign (CReg _) (CTemp _ _) -> Cost (1,0,0,0,0)
CAssign (CReg _) (CAddr _) -> Cost (1,0,0,0,0) -- typ.: add %reg1,<adr>,%reg2
CAssign (CReg _) source_m -> addrModeCosts source_m Rhs
CAssign target_m source_m -> addrModeCosts target_m Lhs +
addrModeCosts source_m Rhs
......@@ -242,16 +242,9 @@ addrModeCosts addr_mode side =
CVal _ _ -> if lhs then Cost (0, 0, 0, 1, 0)
else Cost (0, 0, 1, 0, 0)
CAddr _ -> if lhs then Cost (0, 0, 0, 1, 0) -- ??unchecked
else Cost (0, 0, 1, 0, 0)
CReg _ -> nullCosts {- loading from, storing to reg is free ! -}
{- for costing CReg->Creg ops see special -}
{- case in costs fct -}
CTableEntry base_mode offset_mode kind ->
addrModeCosts base_mode side +
addrModeCosts offset_mode side +
Cost (1,0,1,0,0)
CTemp _ _ -> nullCosts {- if lhs then Cost (0, 0, 0, 1, 0)
else Cost (0, 0, 1, 0, 0) -}
......@@ -272,9 +265,6 @@ addrModeCosts addr_mode side =
CIntLike mode -> if lhs then Cost (0, 0, 0, 1, 0)
else Cost (0, 0, 1, 0, 0)
CString _ -> if lhs then Cost (0, 0, 0, 1, 0)
else Cost (0, 0, 1, 0, 0)
CLit _ -> if lhs then nullCosts -- should never occur
else Cost (1, 0, 0, 0, 0) -- typ.: mov lit,%reg
......@@ -326,7 +316,7 @@ stmtMacroCosts macro modes =
GRAN_FETCH_AND_RESCHEDULE -> nullCosts {- GrAnSim bookkeeping -}
GRAN_YIELD -> nullCosts {- GrAnSim bookkeeping -- added SOF -}
THREAD_CONTEXT_SWITCH -> nullCosts {- GrAnSim bookkeeping -}
_ -> trace ("Costs.stmtMacroCosts: "++show macro) nullCosts
_ -> trace ("Costs.stmtMacroCosts") nullCosts
-- ---------------------------------------------------------------------------
......
......@@ -147,7 +147,7 @@ pprAbsC (CReturn am return_info) c
pprAmode am, rparen]
DynamicVectoredReturn am' -> mk_vector (pprAmode am')
StaticVectoredReturn n -> mk_vector (int n) -- Always positive
mk_vector x = hcat [text "RET_VEC", char '(', pprAmode am, comma,
mk_vector x = hcat [ptext SLIT("RET_VEC"), char '(', pprAmode am, comma,
x, rparen ]
pprAbsC (CSplitMarker) _ = ptext SLIT("/* SPLIT */")
......@@ -271,12 +271,12 @@ pprAbsC (CSimultaneous abs_c) c
= hcat [ptext SLIT("{{"), pprAbsC abs_c c, ptext SLIT("}}")]
pprAbsC (CCheck macro as code) c
= hcat [text (show macro), lparen,
= hcat [ptext (cCheckMacroText macro), lparen,
hcat (punctuate comma (map ppr_amode as)), comma,
pprAbsC code c, pp_paren_semi
]
pprAbsC (CMacroStmt macro as) _
= hcat [text (show macro), lparen,
= hcat [ptext (cStmtMacroText macro), lparen,
hcat (punctuate comma (map ppr_amode as)),pp_paren_semi] -- no casting
pprAbsC (CCallProfCtrMacro op as) _
= hcat [ptext op, lparen,
......@@ -338,9 +338,9 @@ pprAbsC (CCodeBlock label abs_C) _
}
pprAbsC (CInitHdr cl_info reg_rel cost_centre) _
pprAbsC (CInitHdr cl_info amode cost_centre) _
= hcat [ ptext SLIT("SET_HDR_"), char '(',
ppr_amode (CAddr reg_rel), comma,
ppr_amode amode, comma,
pprCLabelAddr info_lbl, comma,
if_profiling (pprAmode cost_centre),
pp_paren_semi ]
......@@ -1036,13 +1036,13 @@ pprAssign Word64Rep dest@(CVal reg_rel _) src
Lastly, the question is: will the C compiler think the types of the
two sides of the assignment match?
We assume that the types will match
if neither side is a @CVal@ addressing mode for any register
which can point into the heap or B stack.
We assume that the types will match if neither side is a
@CVal@ addressing mode for any register which can point into
the heap or stack.
Why? Because the heap and B stack are used to store miscellaneous things,
whereas the A stack, temporaries, registers, etc., are only used for things
of fixed type.
Why? Because the heap and stack are used to store miscellaneous
things, whereas the temporaries, registers, etc., are only used for
things of fixed type.
\begin{code}
pprAssign kind (CReg (VanillaReg _ dest)) (CReg (VanillaReg _ src))
......@@ -1144,9 +1144,6 @@ ppr_amode (CCharLike ch)
ppr_amode (CIntLike int)
= hcat [ptext SLIT("INTLIKE_CLOSURE"), char '(', pprAmode int, rparen ]
ppr_amode (CString str) = hcat [char '"', text (stringToC (_UNPK_ str)), char '"']
-- ToDo: are these *used* for anything?
ppr_amode (CLit lit) = pprBasicLit lit
ppr_amode (CLitLit str _) = ptext str
......@@ -1154,17 +1151,50 @@ ppr_amode (CLitLit str _) = ptext str
ppr_amode (CJoinPoint _)
= panic "ppr_amode: CJoinPoint"
ppr_amode (CTableEntry base index kind)
= hcat [text "((", pprPrimKind kind, text " *)(",
ppr_amode base, text "))[(I_)(", ppr_amode index,
ptext SLIT(")]")]
ppr_amode (CMacroExpr pk macro as)
= parens (pprPrimKind pk) <+>
parens (text (show macro) <>
= parens (pprPrimKind pk) <>
parens (ptext (cExprMacroText macro) <>
parens (hcat (punctuate comma (map pprAmode as))))
\end{code}
\begin{code}
cExprMacroText ENTRY_CODE = SLIT("ENTRY_CODE")
cExprMacroText ARG_TAG = SLIT("ARG_TAG")
cExprMacroText GET_TAG = SLIT("GET_TAG")
cExprMacroText UPD_FRAME_UPDATEE = SLIT("UPD_FRAME_UPDATEE")
cStmtMacroText ARGS_CHK = SLIT("ARGS_CHK")
cStmtMacroText ARGS_CHK_LOAD_NODE = SLIT("ARGS_CHK_LOAD_NODE")
cStmtMacroText UPD_CAF = SLIT("UPD_CAF")
cStmtMacroText UPD_BH_UPDATABLE = SLIT("UPD_BH_UPDATABLE")
cStmtMacroText UPD_BH_SINGLE_ENTRY = SLIT("UPD_BH_SINGLE_ENTRY")
cStmtMacroText PUSH_UPD_FRAME = SLIT("PUSH_UPD_FRAME")
cStmtMacroText PUSH_SEQ_FRAME = SLIT("PUSH_SEQ_FRAME")
cStmtMacroText UPDATE_SU_FROM_UPD_FRAME = SLIT("UPDATE_SU_FROM_UPD_FRAME")
cStmtMacroText SET_TAG = SLIT("SET_TAG")
cStmtMacroText GRAN_FETCH = SLIT("GRAN_FETCH")
cStmtMacroText GRAN_RESCHEDULE = SLIT("GRAN_RESCHEDULE")
cStmtMacroText GRAN_FETCH_AND_RESCHEDULE= SLIT("GRAN_FETCH_AND_RESCHEDULE")
cStmtMacroText THREAD_CONTEXT_SWITCH = SLIT("THREAD_CONTEXT_SWITCH")
cStmtMacroText GRAN_YIELD = SLIT("GRAN_YIELD")
cCheckMacroText HP_CHK_NP = SLIT("HP_CHK_NP")
cCheckMacroText STK_CHK_NP = SLIT("STK_CHK_NP")
cCheckMacroText HP_STK_CHK_NP = SLIT("HP_STK_CHK_NP")
cCheckMacroText HP_CHK_SEQ_NP = SLIT("HP_CHK_SEQ_NP")
cCheckMacroText HP_CHK = SLIT("HP_CHK")
cCheckMacroText STK_CHK = SLIT("STK_CHK")
cCheckMacroText HP_STK_CHK = SLIT("HP_STK_CHK")
cCheckMacroText HP_CHK_NOREGS = SLIT("HP_CHK_NOREGS")
cCheckMacroText HP_CHK_UNPT_R1 = SLIT("HP_CHK_UNPT_R1")
cCheckMacroText HP_CHK_UNBX_R1 = SLIT("HP_CHK_UNBX_R1")
cCheckMacroText HP_CHK_F1 = SLIT("HP_CHK_F1")
cCheckMacroText HP_CHK_D1 = SLIT("HP_CHK_D1")
cCheckMacroText HP_CHK_L1 = SLIT("HP_CHK_L1")
cCheckMacroText HP_CHK_UT_ALT = SLIT("HP_CHK_UT_ALT")
cCheckMacroText HP_CHK_GEN = SLIT("HP_CHK_GEN")
\end{code}
%************************************************************************
%* *
\subsection[ppr-liveness-masks]{Liveness Masks}
......@@ -1223,6 +1253,11 @@ pprRegRelative sign_wanted (NodeRel o)
else
(pp_Node, Just (addPlusSign sign_wanted (int off)))
pprRegRelative sign_wanted (CIndex base offset kind)
= ( hcat [text "((", pprPrimKind kind, text " *)(", ppr_amode base, text "))"]
, Just (hcat [if sign_wanted then char '+' else empty,
text "(I_)(", ppr_amode offset, ptext SLIT(")")])
)
\end{code}
@pprMagicId@ just prints the register name. @VanillaReg@ registers are
......@@ -1491,10 +1526,11 @@ ppr_decls_AbsC (CRetVector _ amodes _ _) = ppr_decls_Amodes amodes
\begin{code}
ppr_decls_Amode :: CAddrMode -> TeM (Maybe SDoc, Maybe SDoc)
ppr_decls_Amode (CVal (CIndex base offset _) _) = ppr_decls_Amodes [base,offset]
ppr_decls_Amode (CAddr (CIndex base offset _)) = ppr_decls_Amodes [base,offset]
ppr_decls_Amode (CVal _ _) = returnTE (Nothing, Nothing)
ppr_decls_Amode (CAddr _) = returnTE (Nothing, Nothing)
ppr_decls_Amode (CReg _) = returnTE (Nothing, Nothing)
ppr_decls_Amode (CString _) = returnTE (Nothing, Nothing)
ppr_decls_Amode (CLit _) = returnTE (Nothing, Nothing)
ppr_decls_Amode (CLitLit _ _) = returnTE (Nothing, Nothing)
......@@ -1522,11 +1558,6 @@ ppr_decls_Amode (CLbl label kind)
returnTE (Nothing,
if label_seen then Nothing else Just (pprExternDecl False{-not in an SRT decl-} label))
ppr_decls_Amode (CTableEntry base index _)
= ppr_decls_Amode base `thenTE` \ p1 ->
ppr_decls_Amode index `thenTE` \ p2 ->
returnTE (maybe_vcat [p1, p2])
ppr_decls_Amode (CMacroExpr _ _ amodes)
= ppr_decls_Amodes amodes
......
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: CgCase.lhs,v 1.32 1999/06/22 07:59:59 simonpj Exp $
% $Id: CgCase.lhs,v 1.33 1999/06/24 13:04:16 simonmar Exp $
%
%********************************************************
%* *
......@@ -154,7 +154,7 @@ cgCase (StgCon (PrimOp op) args res_ty)
TagToEnumOp -> only arg_amodes
_ -> CTemp (mkBuiltinUnique 1) IntRep
closure = CTableEntry (CLbl (mkClosureTblLabel tycon) PtrRep) tag_amode PtrRep
closure = CVal (CIndex (CLbl (mkClosureTblLabel tycon) PtrRep) tag_amode PtrRep) PtrRep
in
case op of {
......
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: CgClosure.lhs,v 1.32 1999/06/08 15:56:46 simonmar Exp $
% $Id: CgClosure.lhs,v 1.33 1999/06/24 13:04:17 simonmar Exp $
%
\section[CgClosure]{Code generation for closures}
......@@ -372,21 +372,17 @@ closureCodeBody binder_info closure_info cc all_args body
fast_entry_code
= profCtrC SLIT("TICK_ENT_FUN_DIRECT") [
mkIntCLit stg_arity -- total # of args
{- CLbl (mkRednCountsLabel name) PtrRep,
CString (_PK_ (showSDoc (ppr name))),
CLbl (mkRednCountsLabel name) PtrRep,
mkCString (_PK_ (showSDoc (ppr name))),
mkIntCLit stg_arity, -- total # of args
mkIntCLit sp_stk_args, -- # passed on stk
CString (_PK_ (map (showTypeCategory . idType) all_args)),
CString SLIT(""), CString SLIT("")
-}
mkCString (_PK_ (map (showTypeCategory . idType) all_args))
] `thenC`
-- Nuked for now; see comment at end of file
-- CString (_PK_ (show_wrapper_name wrapper_maybe)),
-- CString (_PK_ (show_wrapper_arg_kinds wrapper_maybe))
] `thenC`
-- Bind args to regs/stack as appropriate, and
-- record expected position of sps.
......@@ -638,13 +634,13 @@ setupUpdate closure_info code
link_caf seCafBlackHoleClosureInfo `thenFC` \ _ -> nopC
else
nopC) `thenC`
profCtrC SLIT("TICK_UPD_CAF_BH_SINGLE_ENTRY") [CString cl_name] `thenC`
profCtrC SLIT("TICK_UPD_CAF_BH_SINGLE_ENTRY") [mkCString cl_name] `thenC`
profCtrC SLIT("TICK_UPDF_OMITTED") [] `thenC`
code
(True ,False) -> pushUpdateFrame (CReg node) code
(True ,True ) -> -- blackhole the (updatable) CAF:
link_caf cafBlackHoleClosureInfo `thenFC` \ update_closure ->
profCtrC SLIT("TICK_UPD_CAF_BH_UPDATABLE") [CString cl_name] `thenC`
profCtrC SLIT("TICK_UPD_CAF_BH_UPDATABLE") [mkCString cl_name] `thenC`
pushUpdateFrame update_closure code
where
cl_name :: FAST_STRING
......
......@@ -26,18 +26,21 @@ import CgBindery ( getArgAmodes, bindNewToNode,
idInfoToAmode, stableAmodeIdInfo,
heapIdInfo, CgIdInfo, bindNewToStack
)
import CgStackery ( mkTaggedVirtStkOffsets, freeStackSlots )
import CgUsages ( getRealSp, getVirtSp, setRealAndVirtualSp )
import CgStackery ( mkTaggedVirtStkOffsets, freeStackSlots,
updateFrameSize
)
import CgUsages ( getRealSp, getVirtSp, setRealAndVirtualSp,
getSpRelOffset )
import CgClosure ( cgTopRhsClosure )
import CgRetConv ( assignRegs )
import Constants ( mAX_INTLIKE, mIN_INTLIKE )
import CgHeapery ( allocDynClosure )
import Constants ( mAX_INTLIKE, mIN_INTLIKE, mIN_UPD_SIZE )
import CgHeapery ( allocDynClosure, inPlaceAllocDynClosure )
import CgTailCall ( performReturn, mkStaticAlgReturnCode, doTailCall,
mkUnboxedTupleReturnCode )
import CLabel ( mkClosureLabel, mkStaticClosureLabel )
import ClosureInfo ( mkClosureLFInfo, mkConLFInfo, mkLFArgument,
layOutDynCon, layOutDynClosure,
layOutStaticClosure
layOutStaticClosure, closureSize
)
import CostCentre ( currentOrSubsumedCCS, dontCareCCS, CostCentreStack,
currentCCS )
......@@ -49,7 +52,8 @@ import Name ( nameModule, isLocallyDefinedName )
import Module ( isDynamicModule )
import Const ( Con(..), Literal(..), isLitLitLit )
import PrelInfo ( maybeCharLikeCon, maybeIntLikeCon )
import PrimRep ( PrimRep(..) )
import PrimRep ( PrimRep(..), isFollowableRep )
import Unique ( Uniquable(..) )
import Util
import Panic ( assertPanic, trace )
\end{code}
......@@ -286,7 +290,7 @@ cgReturnDataCon con amodes all_zero_size_args
case sequel of
CaseAlts _ (Just (alts, Just (maybe_deflt_binder, (_,deflt_lbl))))
CaseAlts _ (Just (alts, Just (Nothing, (_,deflt_lbl))))
| not (dataConTag con `is_elem` map fst alts)
->
-- Special case! We're returning a constructor to the default case
......@@ -299,27 +303,57 @@ cgReturnDataCon con amodes all_zero_size_args
-- In this case,
-- if the default is a non-bind-default (ie does not use y),
-- then we should simply jump to the default join point;
--
-- if the default is a bind-default (ie does use y), we
-- should return the constructor in the heap,
-- pointed to by Node.
case maybe_deflt_binder of
Just binder ->
ASSERT(not (isUnboxedTupleCon con))
buildDynCon binder currentCCS con amodes all_zero_size_args
`thenFC` \ idinfo ->
profCtrC SLIT("TICK_RET_NEW") [mkIntCLit (length amodes)] `thenC`
idInfoToAmode PtrRep idinfo `thenFC` \ amode ->
performReturn (move_to_reg amode node) jump_to_join_point
Nothing ->
performReturn AbsCNop {- No reg assts -} jump_to_join_point
performReturn AbsCNop {- No reg assts -} jump_to_join_point
where
is_elem = isIn "cgReturnDataCon"
jump_to_join_point sequel = absC (CJump (CLbl deflt_lbl CodePtrRep))
-- Ignore the sequel: we've already looked at it above
-- If the sequel is an update frame, we might be able to
-- do update in place...
UpdateCode
| not all_zero_size_args -- no nullary constructors, please
&& not (maybeCharLikeCon con) -- no chars please (these are all static)
&& not (any isFollowableRep (map getAmodeRep amodes))
-- no ptrs please (generational gc...)
&& closureSize closure_info <= mIN_UPD_SIZE
-- don't know the real size of the
-- thunk, so assume mIN_UPD_SIZE
-> -- get a new temporary and make it point to the updatee
let
uniq = getUnique con
temp = CTemp uniq PtrRep
in
getSpRelOffset args_sp `thenFC` \ sp_rel ->
absC (CAssign temp
(CMacroExpr PtrRep UPD_FRAME_UPDATEE [CAddr sp_rel]))
`thenC`
-- stomp all over it with the new constructor
inPlaceAllocDynClosure closure_info temp (CReg CurCostCentre) stuff
`thenC`
-- don't forget to update Su from the update frame
absC (CMacroStmt UPDATE_SU_FROM_UPD_FRAME [CAddr sp_rel]) `thenC`
-- set Node to point to the closure being returned
-- (can't be done earlier: node might conflict with amodes)
absC (CAssign (CReg node) temp) `thenC`
-- pop the update frame off the stack, and do the proper
-- return.
let new_sp = args_sp - updateFrameSize in
setEndOfBlockInfo (EndOfBlockInfo new_sp (OnStack new_sp)) $
performReturn (AbsCNop) (mkStaticAlgReturnCode con)
where (closure_info, stuff)
= layOutDynClosure (dataConName con)
getAmodeRep amodes lf_info
lf_info = mkConLFInfo con
other_sequel -- The usual case
| isUnboxedTupleCon con ->
......
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: CgExpr.lhs,v 1.27 1999/06/09 14:28:38 simonmar Exp $
% $Id: CgExpr.lhs,v 1.28 1999/06/24 13:04:18 simonmar Exp $
%
%********************************************************
%* *
......@@ -133,9 +133,9 @@ cgExpr (StgCon (PrimOp TagToEnumOp) [arg] res_ty)
absC (CAssign dyn_tag amode) `thenC`
performReturn (
CAssign (CReg node)
(CTableEntry
(CVal (CIndex
(CLbl (mkClosureTblLabel tycon) PtrRep)
dyn_tag PtrRep))
dyn_tag PtrRep) PtrRep))
(\ sequel -> mkDynamicAlgReturnCode tycon dyn_tag sequel)
where
dyn_tag = CTemp (mkBuiltinUnique 0) IntRep
......@@ -177,9 +177,9 @@ cgExpr x@(StgCon (PrimOp op) args res_ty)
-- about to return anyway.
dyn_tag = CTemp (mkBuiltinUnique 0) IntRep
closure_lbl = CTableEntry
closure_lbl = CVal (CIndex
(CLbl (mkClosureTblLabel tycon) PtrRep)
dyn_tag PtrRep
dyn_tag PtrRep) PtrRep
\end{code}
......
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: CgHeapery.lhs,v 1.17 1999/05/26 14:12:13 simonmar Exp $
% $Id: CgHeapery.lhs,v 1.18 1999/06/24 13:04:19 simonmar Exp $
%
\section[CgHeapery]{Heap management functions}
\begin{code}
module CgHeapery (
fastEntryChecks, altHeapCheck, thunkChecks,
allocDynClosure
allocDynClosure, inPlaceAllocDynClosure
-- new functions, basically inserting macro calls into Code -- HWL
,fetchAndReschedule, yield
......@@ -468,11 +468,42 @@ allocDynClosure closure_info use_cc blame_cc amodes_with_offsets
where
closure_size = closureSize closure_info
slop_size = slopSize closure_info
\end{code}
Occasionally we can update a closure in place instead of allocating
new space for it. This is the function that does the business, assuming:
- node points to the closure to be overwritten
- the new closure doesn't contain any pointers if we're
using a generational collector.
\begin{code}
inPlaceAllocDynClosure
:: ClosureInfo
-> CAddrMode -- Pointer to beginning of closure
-> CAddrMode -- Cost Centre to stick in the object
-> [(CAddrMode, VirtualHeapOffset)] -- Offsets from start of the object
-- ie Info ptr has offset zero.
-> Code
inPlaceAllocDynClosure closure_info head use_cc amodes_with_offsets
= let -- do_move IS THE ASSIGNMENT FUNCTION
do_move (amode, offset_from_start)
= CAssign (CVal (CIndex head (mkIntCLit offset_from_start) WordRep)
(getAmodeRep amode))
amode
in
-- GENERATE THE CODE
absC ( mkAbstractCs (
[ CInitHdr closure_info head use_cc ]
++ (map do_move amodes_with_offsets)))
-- Avoid hanging on to anything in the CC field when we're not profiling.
cInitHdr closure_info amode cc
| opt_SccProfilingOn = CInitHdr closure_info amode cc
| otherwise = CInitHdr closure_info amode (panic "absent cc")
| opt_SccProfilingOn = CInitHdr closure_info (CAddr amode) cc
| otherwise = CInitHdr closure_info (CAddr amode) (panic "absent cc")
\end{code}
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: CgStackery.lhs,v 1.11 1999/06/08 15:56:47 simonmar Exp $
% $Id: CgStackery.lhs,v 1.12 1999/06/24 13:04:20 simonmar Exp $
%
\section[CgStackery]{Stack management functions}
......@@ -13,7 +13,8 @@ module CgStackery (
allocStack, allocPrimStack, allocStackTop, deAllocStackTop,
adjustStackHW, getFinalStackHW,
mkTaggedVirtStkOffsets, mkTaggedStkAmodes, mkTagAssts,
freeStackSlots, dataStackSlots, addFreeSlots
freeStackSlots, dataStackSlots, addFreeSlots,
updateFrameSize, seqFrameSize
) where
#include "HsVersions.h"
......@@ -24,7 +25,10 @@ import AbsCSyn
import CgUsages ( getRealSp )
import AbsCUtils ( mkAbstractCs, mkAbsCStmts, getAmodeRep )
import PrimRep ( getPrimRepSize, PrimRep(..), isFollowableRep )
import CmdLineOpts ( opt_SccProfilingOn )
import Panic ( panic )
import Constants ( uF_SIZE, sCC_UF_SIZE, sEQ_FRAME_SIZE, sCC_SEQ_FRAME_SIZE )
import IOExts ( trace )
\end{code}
......@@ -219,6 +223,13 @@ getFinalStackHW fcode info_down (MkCgState absC binds usages) = state1
(MkCgState _ _ ((_,_,_, hwSp), _)) = state1
\end{code}
\begin{code}
updateFrameSize | opt_SccProfilingOn = sCC_UF_SIZE
| otherwise = uF_SIZE
seqFrameSize | opt_SccProfilingOn = sCC_SEQ_FRAME_SIZE
| otherwise = sEQ_FRAME_SIZE
\end{code}
%************************************************************************
%* *
......
......@@ -11,9 +11,8 @@ module CgUpdate ( pushUpdateFrame, reserveSeqFrame, pushSeqFrame ) where
import CgMonad
import AbsCSyn