)
import Constants ( mIN_UPD_SIZE )
-import CallConv ( CallConv, callConvAttribute )
-import CLabel ( externallyVisibleCLabel, mkErrorStdEntryLabel,
+import CallConv ( callConvAttribute )
+import CLabel ( externallyVisibleCLabel,
needsCDecl, pprCLabel,
mkReturnInfoLabel, mkReturnPtLabel, mkClosureTblLabel,
- mkClosureLabel,
+ mkClosureLabel, mkErrorStdEntryLabel,
CLabel, CLabelType(..), labelType, labelDynamic
)
-import CmdLineOpts ( opt_SccProfilingOn, opt_EmitCExternDecls, opt_GranMacros )
+import CmdLineOpts ( opt_SccProfilingOn, opt_GranMacros )
import CostCentre ( pprCostCentreDecl, pprCostCentreStackDecl )
import Costs ( costs, addrModeCosts, CostRes(..), Side(..) )
-import CStrings ( stringToC, pprCLabelString )
+import CStrings ( pprStringInCStyle, pprCLabelString )
import FiniteMap ( addToFM, emptyFM, lookupFM, FiniteMap )
import Literal ( Literal(..) )
import TyCon ( tyConDataCons )
import Name ( NamedThing(..) )
-import DataCon ( DataCon{-instance NamedThing-}, dataConWrapId )
+import DataCon ( dataConWrapId )
import Maybes ( maybeToBool, catMaybes )
-import PrimOp ( primOpNeedsWrapper, pprPrimOp, pprCCallOp,
- PrimOp(..), CCall(..), CCallTarget(..) )
-import PrimRep ( isFloatingRep, PrimRep(..), getPrimRepSize, showPrimRep )
+import PrimOp ( primOpNeedsWrapper, pprCCallOp,
+ PrimOp(..), CCall(..), CCallTarget(..), isDynamicTarget )
+import PrimRep ( isFloatingRep, PrimRep(..), getPrimRepSize )
import SMRep ( pprSMRep )
import Unique ( pprUnique, Unique{-instance NamedThing-} )
import UniqSet ( emptyUniqSet, elementOfUniqSet,
import StgSyn ( SRT(..) )
import BitSet ( intBS )
import Outputable
+import GlaExts
import Util ( nOfThem )
-import Addr ( Addr )
import ST
-import MutableArray
infixr 9 `thenTE`
\end{code}
mk_vector x = hcat [ptext SLIT("RET_VEC"), char '(', pprAmode am, comma,
x, rparen ]
-pprAbsC (CSplitMarker) _ = ptext SLIT("/* SPLIT */")
+pprAbsC (CSplitMarker) _ = ptext SLIT("__STG_SPLIT_MARKER")
-- we optimise various degenerate cases of CSwitches.
the_op
where
ppr_op_call results args
- = hcat [ pprPrimOp op, lparen,
+ = hcat [ ppr op, lparen,
hcat (punctuate comma (map ppr_op_result results)),
if null results || null args then empty else comma,
hcat (punctuate comma (map pprAmode args)),
ccall_res_ty =
case non_void_results of
[] -> ptext SLIT("void")
- [amode] -> text (showPrimRep (getAmodeRep amode))
+ [amode] -> ppr (getAmodeRep amode)
_ -> panic "pprAbsC{CCallTypedef}: ccall_res_ty"
ccall_decl_ty_args
| is_tdef = tail ccall_arg_tys
| otherwise = ccall_arg_tys
- ccall_arg_tys = map (text.showPrimRep.getAmodeRep) non_void_args
+ ccall_arg_tys = map (ppr . getAmodeRep) non_void_args
-- the first argument will be the "I/O world" token (a VoidRep)
-- all others should be non-void
where
rep = getAmodeRep item
- padding_wds =
- if not (closureUpdReqd cl_info) then
- []
- else
- case max 0 (mIN_UPD_SIZE - length amodes) of { still_needed ->
- nOfThem still_needed (mkIntCLit 0) } -- a bunch of 0s
+ upd_reqd = closureUpdReqd cl_info
+ padding_wds
+ | not upd_reqd = []
+ | otherwise = case max 0 (mIN_UPD_SIZE - length amodes) of { still_needed ->
+ nOfThem still_needed (mkIntCLit 0) } -- a bunch of 0s
+
+ -- always have a static link field, it's used to save the closure's
+ -- info pointer when we're reverting CAFs (see comment in Storage.c)
static_link_field
- | staticClosureNeedsLink cl_info = [mkIntCLit 0]
- | otherwise = []
+ | upd_reqd || staticClosureNeedsLink cl_info = [mkIntCLit 0]
+ | otherwise = []
pprAbsC stmt@(CClosureInfoAndCode cl_info slow maybe_fast cl_descr) _
= vcat [
type_str = pprSMRep (closureSMRep cl_info)
- pp_descr = hcat [char '"', text (stringToC cl_descr), char '"']
- pp_type = hcat [char '"', text (stringToC (closureTypeDescr cl_info)), char '"']
+ pp_descr = pprStringInCStyle cl_descr
+ pp_type = pprStringInCStyle (closureTypeDescr cl_info)
pprAbsC stmt@(CClosureTbl tycon) _
= vcat (
\end{code}
\begin{code}
-has_srt (_, NoSRT) = False
-has_srt _ = True
-
pp_srt_info srt =
case srt of
(lbl, NoSRT) ->
(local_arg_decls, pp_non_void_args)
= unzip [ ppr_casm_arg a i | (a,i) <- non_void_args `zip` [1..] ]
- ccall_arg_tys = map (text.showPrimRep.getAmodeRep) non_void_args
-
- ccall_res_ty =
- case non_void_results of
- [] -> ptext SLIT("void")
- [amode] -> text (showPrimRep (getAmodeRep amode))
- _ -> panic "pprCCall: ccall_res_ty"
-
- ccall_fun_ty =
- ptext SLIT("_ccall_fun_ty") <>
- case op_str of
- DynamicTarget u -> ppr u
- _ -> empty
-
(declare_local_vars, local_vars, assign_results)
= ppr_casm_results non_void_results
- (StaticTarget asm_str) = op_str
- is_dynamic =
- case op_str of
- StaticTarget _ -> False
- DynamicTarget _ -> True
-
casm_str = if is_asm then _UNPK_ asm_str else ccall_str
+ StaticTarget asm_str = op_str -- Must be static if it's a casm
-- Remainder only used for ccall
- fun_name
- | is_dynamic = parens (parens (ccall_fun_ty) <> text "%0")
- | otherwise = ptext asm_str
+ fun_name = case op_str of
+ DynamicTarget u -> parens (parens (ptext SLIT("_ccall_fun_ty") <> ppr u) <> text "%0")
+ StaticTarget st -> pprCLabelString st
ccall_str = showSDoc
(hcat [
text "));"
])
- ccall_fun_args
- | is_dynamic = tail ccall_args
- | otherwise = ccall_args
+ ccall_fun_args | isDynamicTarget op_str = tail ccall_args
+ | otherwise = ccall_args
ccall_args = zipWith (\ _ i -> char '%' <> int i) non_void_args [0..]
ppr_amode (CLit lit) = pprBasicLit lit
-ppr_amode (CLitLit str _) = ptext str
-
ppr_amode (CJoinPoint _)
= panic "ppr_amode: CJoinPoint"
ppr_amode (CMacroExpr pk macro as)
- = parens (pprPrimKind pk) <>
- parens (ptext (cExprMacroText macro) <>
+ = parens (ptext (cExprMacroText macro) <>
parens (hcat (punctuate comma (map pprAmode as))))
\end{code}
cExprMacroText ARG_TAG = SLIT("ARG_TAG")
cExprMacroText GET_TAG = SLIT("GET_TAG")
cExprMacroText UPD_FRAME_UPDATEE = SLIT("UPD_FRAME_UPDATEE")
+cExprMacroText CCS_HDR = SLIT("CCS_HDR")
cStmtMacroText ARGS_CHK = SLIT("ARGS_CHK")
cStmtMacroText ARGS_CHK_LOAD_NODE = SLIT("ARGS_CHK_LOAD_NODE")
cStmtMacroText SET_TAG = SLIT("SET_TAG")
cStmtMacroText REGISTER_FOREIGN_EXPORT = SLIT("REGISTER_FOREIGN_EXPORT")
cStmtMacroText REGISTER_IMPORT = SLIT("REGISTER_IMPORT")
+cStmtMacroText REGISTER_DIMPORT = SLIT("REGISTER_DIMPORT")
cStmtMacroText GRAN_FETCH = SLIT("GRAN_FETCH")
cStmtMacroText GRAN_RESCHEDULE = SLIT("GRAN_RESCHEDULE")
cStmtMacroText GRAN_FETCH_AND_RESCHEDULE= SLIT("GRAN_FETCH_AND_RESCHEDULE")
pprMagicId (VanillaReg pk n)
= hcat [ pprVanillaReg n, char '.',
pprUnionTag pk ]
-pprMagicId (FloatReg n) = (<>) (ptext SLIT("F")) (int IBOX(n))
-pprMagicId (DoubleReg n) = (<>) (ptext SLIT("D")) (int IBOX(n))
-pprMagicId (LongReg _ n) = (<>) (ptext SLIT("L")) (int IBOX(n))
+pprMagicId (FloatReg n) = ptext SLIT("F") <> int (I# n)
+pprMagicId (DoubleReg n) = ptext SLIT("D") <> int (I# n)
+pprMagicId (LongReg _ n) = ptext SLIT("L") <> int (I# n)
pprMagicId Sp = ptext SLIT("Sp")
pprMagicId Su = ptext SLIT("Su")
pprMagicId SpLim = ptext SLIT("SpLim")
pprMagicId CurCostCentre = ptext SLIT("CCCS")
pprMagicId VoidReg = panic "pprMagicId:VoidReg!"
-pprVanillaReg :: FAST_INT -> SDoc
-pprVanillaReg n = (<>) (char 'R') (int IBOX(n))
+pprVanillaReg :: Int# -> SDoc
+pprVanillaReg n = char 'R' <> int (I# n)
pprUnionTag :: PrimRep -> SDoc
pprUnionTag CostCentreRep = panic "pprUnionTag:CostCentre?"
pprUnionTag CharRep = char 'c'
+pprUnionTag Int8Rep = ptext SLIT("i8")
pprUnionTag IntRep = char 'i'
pprUnionTag WordRep = char 'w'
pprUnionTag AddrRep = char 'a'
pprUnionTag StableNameRep = char 'p'
pprUnionTag WeakPtrRep = char 'p'
pprUnionTag ForeignObjRep = char 'p'
+pprUnionTag PrimPtrRep = char 'p'
pprUnionTag ThreadIdRep = char 't'
pprUnionTag ArrayRep = char 'p'
pprUnionTag ByteArrayRep = char 'b'
+pprUnionTag BCORep = char 'p'
pprUnionTag _ = panic "pprUnionTag:Odd kind"
\end{code}
Nothing -> mkErrorStdEntryLabel
Just _ -> entryLabelFromCI cl_info
-ppr_decls_AbsC (CSRT lbl closure_lbls)
+ppr_decls_AbsC (CSRT _ closure_lbls)
= mapTE labelSeenTE closure_lbls `thenTE` \ seen ->
returnTE (Nothing,
if and seen then Nothing
ppr_decls_Amode (CAddr _) = returnTE (Nothing, Nothing)
ppr_decls_Amode (CReg _) = returnTE (Nothing, Nothing)
ppr_decls_Amode (CLit _) = returnTE (Nothing, Nothing)
-ppr_decls_Amode (CLitLit _ _) = returnTE (Nothing, Nothing)
-- CIntLike must be a literal -- no decls
ppr_decls_Amode (CIntLike int) = returnTE (Nothing, Nothing)
--- CCharLike may have be arbitrary value -- may have decls
-ppr_decls_Amode (CCharLike char)
- = ppr_decls_Amode char
+-- CCharLike too
+ppr_decls_Amode (CCharLike char) = returnTE (Nothing, Nothing)
-- now, the only place where we actually print temps/externs...
ppr_decls_Amode (CTemp uniq kind)