X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FabsCSyn%2FPprAbsC.lhs;h=e022656075aa7b978369a15cc8e6f8a1eb24a123;hb=ebf2c80221ccf11aeb7a0a2be27bfc72529855a5;hp=667d1bb8f55c59960a36e4983e649402a5da727d;hpb=b0624daa9057eec25ddf35a9ed3c771b9c5d9c75;p=ghc-hetmet.git diff --git a/ghc/compiler/absCSyn/PprAbsC.lhs b/ghc/compiler/absCSyn/PprAbsC.lhs index 667d1bb..e022656 100644 --- a/ghc/compiler/absCSyn/PprAbsC.lhs +++ b/ghc/compiler/absCSyn/PprAbsC.lhs @@ -26,28 +26,28 @@ import AbsCUtils ( getAmodeRep, nonemptyAbsC, ) 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, +import PrimOp ( primOpNeedsWrapper, pprCCallOp, PrimOp(..), CCall(..), CCallTarget(..), isDynamicTarget ) -import PrimRep ( isFloatingRep, PrimRep(..), getPrimRepSize, showPrimRep ) +import PrimRep ( isFloatingRep, PrimRep(..), getPrimRepSize ) import SMRep ( pprSMRep ) import Unique ( pprUnique, Unique{-instance NamedThing-} ) import UniqSet ( emptyUniqSet, elementOfUniqSet, @@ -56,11 +56,10 @@ 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} @@ -240,7 +239,7 @@ pprAbsC stmt@(COpStmt results op args vol_regs) _ 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)), @@ -334,14 +333,14 @@ pprAbsC stmt@(CCallTypedef is_tdef (CCall op_str is_asm may_gc cconv) results ar 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 @@ -419,16 +418,18 @@ pprAbsC stmt@(CStaticClosure closure_lbl cl_info cost_centre amodes) _ 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 [ @@ -499,8 +500,8 @@ pprAbsC stmt@(CClosureInfoAndCode cl_info slow maybe_fast cl_descr) _ 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 ( @@ -648,9 +649,6 @@ pp_basic_restores = ptext SLIT("CALLER_RESTORE_SYSTEM") \end{code} \begin{code} -has_srt (_, NoSRT) = False -has_srt _ = True - pp_srt_info srt = case srt of (lbl, NoSRT) -> @@ -813,14 +811,6 @@ pprCCall call@(CCall op_str is_asm may_gc cconv) args results vol_regs (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" - (declare_local_vars, local_vars, assign_results) = ppr_casm_results non_void_results @@ -838,7 +828,7 @@ pprCCall call@(CCall op_str is_asm may_gc cconv) args results vol_regs if null non_void_results then empty else text "%r = ", - lparen, parens fun_name, lparen, + lparen, fun_name, lparen, hcat (punctuate comma ccall_fun_args), text "));" ]) @@ -1145,14 +1135,11 @@ ppr_amode (CIntLike int) 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} @@ -1161,6 +1148,7 @@ 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") +cExprMacroText CCS_HDR = SLIT("CCS_HDR") cStmtMacroText ARGS_CHK = SLIT("ARGS_CHK") cStmtMacroText ARGS_CHK_LOAD_NODE = SLIT("ARGS_CHK_LOAD_NODE") @@ -1173,6 +1161,7 @@ cStmtMacroText UPDATE_SU_FROM_UPD_FRAME = SLIT("UPDATE_SU_FROM_UPD_FRAME") 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") @@ -1276,9 +1265,9 @@ pprMagicId BaseReg = ptext SLIT("BaseReg") 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") @@ -1287,8 +1276,8 @@ pprMagicId HpLim = ptext SLIT("HpLim") 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 @@ -1299,6 +1288,7 @@ pprUnionTag RetRep = char 'p' 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' @@ -1309,11 +1299,13 @@ pprUnionTag StablePtrRep = char 'p' 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} @@ -1518,7 +1510,7 @@ ppr_decls_AbsC (CClosureInfoAndCode cl_info slow maybe_fast _) 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 @@ -1540,14 +1532,12 @@ ppr_decls_Amode (CVal _ _) = returnTE (Nothing, 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)