import Constants ( mIN_UPD_SIZE )
import CallConv ( CallConv, callConvAttribute, cCallConv )
import CLabel ( externallyVisibleCLabel, mkErrorStdEntryLabel,
- isReadOnly, needsCDecl, pprCLabel,
- mkReturnInfoLabel, mkReturnPtLabel,
+ needsCDecl, pprCLabel,
+ mkReturnInfoLabel, mkReturnPtLabel, mkClosureTblLabel,
+ mkStaticClosureLabel,
CLabel, CLabelType(..), labelType, labelDynamic
)
import CStrings ( stringToC )
import FiniteMap ( addToFM, emptyFM, lookupFM, FiniteMap )
import Const ( Literal(..) )
+import TyCon ( tyConDataCons )
+import Name ( NamedThing(..) )
+import DataCon ( DataCon{-instance NamedThing-} )
import Maybes ( maybeToBool, catMaybes )
import PrimOp ( primOpNeedsWrapper, pprPrimOp, PrimOp(..) )
import PrimRep ( isFloatingRep, PrimRep(..), getPrimRepSize, showPrimRep )
(hcat [text jmp_lit, target, pp_paren_semi ])
where
target = case return_info of
- DirectReturn -> hcat [char '(', pprAmode am, rparen]
+ DirectReturn -> hcat [ptext SLIT("ENTRY_CODE"), lparen,
+ 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 */")
the_op = ppr_op_call non_void_results non_void_args
-- liveness mask is *in* the non_void_args
in
- case (ppr_vol_regs vol_regs) of { (pp_saves, pp_restores) ->
if primOpNeedsWrapper op then
+ case (ppr_vol_regs vol_regs) of { (pp_saves, pp_restores) ->
vcat [ pp_saves,
the_op,
pp_restores
]
+ }
else
the_op
- }
where
ppr_op_call results args
= hcat [ pprPrimOp op, lparen,
$$ nest 2 (hcat (punctuate comma (map pp_closure_lbl closures)))
<> ptext SLIT("};")
}
- where
- pp_closure_lbl lbl
- | labelDynamic lbl = text "DLL_SRT_ENTRY" <> parens (pprCLabel lbl)
- | otherwise = char '&' <> pprCLabel lbl
pprAbsC stmt@(CBitmap lbl mask) c
= vcat [
= 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,
}
-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 ]
ppLocalnessMacro True{-include dyn-} info_lbl,
char ')'
],
- nest 2 (ppr_payload (amodes ++ padding_wds)),
+ nest 2 (ppr_payload (amodes ++ padding_wds ++ static_link_field)),
ptext SLIT("};") ]
}
where
where
rep = getAmodeRep item
- -- always at least one padding word: this is the static link field for
- -- the garbage collector.
padding_wds =
if not (closureUpdReqd cl_info) then
- [mkIntCLit 0]
+ []
else
- case 1 + (max 0 (mIN_UPD_SIZE - length amodes)) of { still_needed ->
+ case max 0 (mIN_UPD_SIZE - length amodes) of { still_needed ->
nOfThem still_needed (mkIntCLit 0) } -- a bunch of 0s
-pprAbsC stmt@(CClosureInfoAndCode cl_info slow maybe_fast srt cl_descr) _
+ static_link_field
+ | staticClosureNeedsLink cl_info = [mkIntCLit 0]
+ | otherwise = []
+
+pprAbsC stmt@(CClosureInfoAndCode cl_info slow maybe_fast cl_descr) _
= vcat [
hcat [
ptext SLIT("INFO_TABLE"),
is_constr = maybeToBool maybe_tag
(Just tag) = maybe_tag
- needs_srt = has_srt srt && needsSRT cl_info
+ needs_srt = infoTblNeedsSRT cl_info
+ srt = getSRTInfo cl_info
size = closureNonHdrSize cl_info
pp_descr = hcat [char '"', text (stringToC cl_descr), char '"']
pp_type = hcat [char '"', text (stringToC (closureTypeDescr cl_info)), char '"']
+pprAbsC stmt@(CClosureTbl tycon) _
+ = vcat (
+ ptext SLIT("CLOSURE_TBL") <>
+ lparen <> pprCLabel (mkClosureTblLabel tycon) <> rparen :
+ punctuate comma (
+ map (pp_closure_lbl . mkStaticClosureLabel . getName) (tyConDataCons tycon)
+ )
+ ) $$ ptext SLIT("};")
+
pprAbsC stmt@(CRetDirect uniq code srt liveness) _
= vcat [
hcat [
LvLarge _ -> SLIT("RET_BIG")
pprAbsC stmt@(CRetVector label amodes srt liveness) _
- = vcat [
- pp_vector,
+ = case (pprTempAndExternDecls stmt) of { (_, pp_exts) ->
+ vcat [
+ pp_exts,
hcat [
- ptext SLIT(" }"), comma, ptext SLIT("\n VEC_INFO_TABLE"),
- lparen,
- pp_liveness liveness, comma, -- bitmap liveness mask
- pp_srt_info srt, -- SRT
- ptext type_str, -- or big, depending on the size
- -- of the liveness mask.
- rparen
- ],
- text "};"
+ ptext SLIT("VEC_INFO_") <> int size,
+ lparen,
+ pprCLabel label, comma,
+ pp_liveness liveness, comma, -- bitmap liveness mask
+ pp_srt_info srt, -- SRT
+ ptext type_str, comma,
+ ppLocalness label, comma
+ ],
+ nest 2 (sep (punctuate comma (map ppr_item amodes))),
+ text ");"
]
+ }
where
- pp_vector =
- case (pprTempAndExternDecls stmt) of { (_, pp_exts) ->
- vcat [
- pp_exts,
- hcat [ppLocalness label,
- ptext SLIT(" vec_info_"), int size, space,
- pprCLabel label, text "= { {"
- ],
- nest 2 (sep (punctuate comma (map ppr_item (reverse amodes))))
- ] }
-
ppr_item item = (<>) (text "(F_) ") (ppr_amode item)
size = length amodes
\begin{code}
ppLocalness label
- = (<>) static const
- where
- static = if (externallyVisibleCLabel label)
+ = if (externallyVisibleCLabel label)
then empty
else ptext SLIT("static ")
- const = if not (isReadOnly label)
- then empty
- else ptext SLIT("const")
-- Horrible macros for declaring the types and locality of labels (see
-- StgMacros.h).
visiblity_prefix,
dyn_prefix,
case label_type of
- ClosureType -> ptext SLIT("C_")
- CodeType -> ptext SLIT("F_")
- InfoTblType -> ptext SLIT("I_")
- DataType -> ptext SLIT("D_") <>
- if isReadOnly clabel
- then ptext SLIT("RO_")
- else empty
+ ClosureType -> ptext SLIT("C_")
+ CodeType -> ptext SLIT("F_")
+ InfoTblType -> ptext SLIT("I_")
+ ClosureTblType -> ptext SLIT("CP_")
+ DataType -> ptext SLIT("D_")
]
where
is_visible = externallyVisibleCLabel clabel
\end{code}
\begin{code}
+pp_closure_lbl lbl
+ | labelDynamic lbl = text "DLL_SRT_ENTRY" <> parens (pprCLabel lbl)
+ | otherwise = char '&' <> pprCLabel lbl
+\end{code}
+
+\begin{code}
if_profiling pretty
= if opt_SccProfilingOn
then pretty
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))
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
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}
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
-- ToDo: strictly speaking, should chk "cost_centre" amode
= ppr_decls_Amodes amodes
-ppr_decls_AbsC (CClosureInfoAndCode cl_info slow maybe_fast _ _)
+ppr_decls_AbsC (CClosureInfoAndCode cl_info slow maybe_fast _)
= ppr_decls_Amodes [entry_lbl] `thenTE` \ p1 ->
ppr_decls_AbsC slow `thenTE` \ p2 ->
(case maybe_fast of
\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)
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
projects / ghc-hetmet.git / blobdiff