diff options
Diffstat (limited to 'ghc/compiler/absCSyn')
-rw-r--r-- | ghc/compiler/absCSyn/AbsCSyn.lhs | 11 | ||||
-rw-r--r-- | ghc/compiler/absCSyn/AbsCUtils.lhs | 4 | ||||
-rw-r--r-- | ghc/compiler/absCSyn/CLabel.lhs | 21 | ||||
-rw-r--r-- | ghc/compiler/absCSyn/CStrings.lhs | 15 | ||||
-rw-r--r-- | ghc/compiler/absCSyn/PprAbsC.lhs | 7 |
5 files changed, 30 insertions, 28 deletions
diff --git a/ghc/compiler/absCSyn/AbsCSyn.lhs b/ghc/compiler/absCSyn/AbsCSyn.lhs index 36d3db7e6e..2389512c77 100644 --- a/ghc/compiler/absCSyn/AbsCSyn.lhs +++ b/ghc/compiler/absCSyn/AbsCSyn.lhs @@ -1,7 +1,7 @@ % % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % -% $Id: AbsCSyn.lhs,v 1.46 2002/03/02 18:02:30 sof Exp $ +% $Id: AbsCSyn.lhs,v 1.47 2002/04/29 14:03:39 simonmar Exp $ % \section[AbstractC]{Abstract C: the last stop before machine code} @@ -53,8 +53,7 @@ import StgSyn ( StgOp ) import TyCon ( TyCon ) import BitSet -- for liveness masks import FastTypes - -import Outputable +import FastString \end{code} @AbstractC@ is a list of Abstract~C statements, but the data structure @@ -174,8 +173,8 @@ stored in a mixed type location.) -- see the notes about these next few; they follow below... | CMacroStmt CStmtMacro [CAddrMode] - | CCallProfCtrMacro FAST_STRING [CAddrMode] - | CCallProfCCMacro FAST_STRING [CAddrMode] + | CCallProfCtrMacro FastString [CAddrMode] + | CCallProfCCMacro FastString [CAddrMode] {- The presence of this constructor is a makeshift solution; it being used to work around a gcc-related problem of @@ -401,7 +400,7 @@ Convenience functions: mkIntCLit :: Int -> CAddrMode mkIntCLit i = CLit (mkMachInt (toInteger i)) -mkCString :: FAST_STRING -> CAddrMode +mkCString :: FastString -> CAddrMode mkCString s = CLit (MachStr s) mkCCostCentre :: CostCentre -> CAddrMode diff --git a/ghc/compiler/absCSyn/AbsCUtils.lhs b/ghc/compiler/absCSyn/AbsCUtils.lhs index 5643da8309..90988cdebc 100644 --- a/ghc/compiler/absCSyn/AbsCUtils.lhs +++ b/ghc/compiler/absCSyn/AbsCUtils.lhs @@ -367,7 +367,7 @@ flatAbsC stmt@(CCheck macro amodes code) -- the TICKY_CTR macro always needs to be hoisted out to the top level. -- This is a HACK. flatAbsC stmt@(CCallProfCtrMacro str amodes) - | str == SLIT("TICK_CTR") = returnFlt (AbsCNop, stmt) + | str == FSLIT("TICK_CTR") = returnFlt (AbsCNop, stmt) | otherwise = returnFlt (stmt, AbsCNop) -- Some statements need no flattening at all: @@ -401,7 +401,7 @@ flatAbsC stmt@(COpStmt results (StgPrimOp op) args vol_regs) = COpStmt [] (StgFCallOp - (CCall (CCallSpec (CasmTarget (_PK_ (mktxt op_str))) + (CCall (CCallSpec (CasmTarget (mkFastString (mktxt op_str))) defaultCCallConv (PlaySafe False))) uu ) diff --git a/ghc/compiler/absCSyn/CLabel.lhs b/ghc/compiler/absCSyn/CLabel.lhs index b56db8d269..a26d9d7a51 100644 --- a/ghc/compiler/absCSyn/CLabel.lhs +++ b/ghc/compiler/absCSyn/CLabel.lhs @@ -1,7 +1,7 @@ % % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % -% $Id: CLabel.lhs,v 1.51 2002/03/14 15:27:15 simonpj Exp $ +% $Id: CLabel.lhs,v 1.52 2002/04/29 14:03:39 simonmar Exp $ % \section[CLabel]{@CLabel@: Information to make C Labels} @@ -90,6 +90,7 @@ import Unique ( pprUnique, Unique ) import PrimOp ( PrimOp ) import CostCentre ( CostCentre, CostCentreStack ) import Outputable +import FastString \end{code} things we want to find out: @@ -126,7 +127,7 @@ data CLabel | RtsLabel RtsLabelInfo - | ForeignLabel FAST_STRING Bool -- a 'C' (or otherwise foreign) label + | ForeignLabel FastString Bool -- a 'C' (or otherwise foreign) label -- Bool <=> is dynamic | CC_Label CostCentre @@ -173,7 +174,7 @@ data CaseLabelInfo data RtsLabelInfo = RtsShouldNeverHappenCode - | RtsBlackHoleInfoTbl FAST_STRING -- black hole with info table name + | RtsBlackHoleInfoTbl FastString -- black hole with info table name | RtsUpdInfo -- upd_frame_info | RtsSeqInfo -- seq_frame_info @@ -254,10 +255,10 @@ mkMAP_FROZEN_infoLabel = RtsLabel (Rts_Info "stg_MUT_ARR_PTRS_FROZEN_info") mkEMPTY_MVAR_infoLabel = RtsLabel (Rts_Info "stg_EMPTY_MVAR_info") mkTopTickyCtrLabel = RtsLabel RtsTopTickyCtr -mkBlackHoleInfoTableLabel = RtsLabel (RtsBlackHoleInfoTbl SLIT("stg_BLACKHOLE_info")) -mkCAFBlackHoleInfoTableLabel = RtsLabel (RtsBlackHoleInfoTbl SLIT("stg_CAF_BLACKHOLE_info")) +mkBlackHoleInfoTableLabel = RtsLabel (RtsBlackHoleInfoTbl FSLIT("stg_BLACKHOLE_info")) +mkCAFBlackHoleInfoTableLabel = RtsLabel (RtsBlackHoleInfoTbl FSLIT("stg_CAF_BLACKHOLE_info")) mkSECAFBlackHoleInfoTableLabel = if opt_DoTickyProfiling then - RtsLabel (RtsBlackHoleInfoTbl SLIT("stg_SE_CAF_BLACKHOLE_info")) + RtsLabel (RtsBlackHoleInfoTbl FSLIT("stg_SE_CAF_BLACKHOLE_info")) else -- RTS won't have info table unless -ticky is on panic "mkSECAFBlackHoleInfoTableLabel requires -ticky" mkRtsPrimOpLabel primop = RtsLabel (RtsPrimOp primop) @@ -272,7 +273,7 @@ mkApEntryLabel upd off = RtsLabel (RtsApEntry upd off) -- Foreign labels -mkForeignLabel :: FAST_STRING -> Bool -> CLabel +mkForeignLabel :: FastString -> Bool -> CLabel mkForeignLabel str is_dynamic = ForeignLabel str is_dynamic -- Cost centres etc. @@ -472,7 +473,7 @@ pprCLbl (RtsLabel (Rts_Code str)) = text str pprCLbl (RtsLabel RtsTopTickyCtr) = ptext SLIT("top_ct") -pprCLbl (RtsLabel (RtsBlackHoleInfoTbl info)) = ptext info +pprCLbl (RtsLabel (RtsBlackHoleInfoTbl info)) = ftext info pprCLbl (RtsLabel (RtsSelectorInfoTbl upd_reqd offset)) = hcat [ptext SLIT("stg_sel_"), text (show offset), @@ -509,7 +510,7 @@ pprCLbl (RtsLabel RtsModuleRegd) = ptext SLIT("module_registered") pprCLbl (ForeignLabel str _) - = ptext str + = ftext str pprCLbl (TyConLabel tc) = hcat [ppr tc, pp_cSEP, ptext SLIT("closure_tbl")] @@ -521,7 +522,7 @@ pprCLbl (CC_Label cc) = ppr cc pprCLbl (CCS_Label ccs) = ppr ccs pprCLbl (ModuleInitLabel mod) - = ptext SLIT("__stginit_") <> ptext (moduleNameFS (moduleName mod)) + = ptext SLIT("__stginit_") <> ftext (moduleNameFS (moduleName mod)) ppIdFlavor :: IdLabelInfo -> SDoc diff --git a/ghc/compiler/absCSyn/CStrings.lhs b/ghc/compiler/absCSyn/CStrings.lhs index 6f2a0e3570..f25e6c204f 100644 --- a/ghc/compiler/absCSyn/CStrings.lhs +++ b/ghc/compiler/absCSyn/CStrings.lhs @@ -4,7 +4,7 @@ This module deals with printing C string literals module CStrings( CLabelString, isCLabelString, pprCLabelString, - cSEP, pp_cSEP, + pp_cSEP, pprFSInCStyle, pprStringInCStyle ) where @@ -12,31 +12,32 @@ module CStrings( #include "HsVersions.h" import Char ( ord, chr, isAlphaNum ) +import FastString import Outputable \end{code} \begin{code} -type CLabelString = FAST_STRING -- A C label, completely unencoded +type CLabelString = FastString -- A C label, completely unencoded -pprCLabelString lbl = ptext lbl +pprCLabelString :: CLabelString -> SDoc +pprCLabelString lbl = ftext lbl isCLabelString :: CLabelString -> Bool -- Checks to see if this is a valid C label isCLabelString lbl - = all ok (_UNPK_ lbl) + = all ok (unpackFS lbl) where ok c = isAlphaNum c || c == '_' || c == '.' -- The '.' appears in e.g. "foo.so" in the -- module part of a ExtName. Maybe it should be separate -cSEP = SLIT("_") -- official C separator pp_cSEP = char '_' \end{code} \begin{code} -pprFSInCStyle :: FAST_STRING -> SDoc +pprFSInCStyle :: FastString -> SDoc -- Assumes it contains only characters '\0'..'\xFF'! -pprFSInCStyle fs = pprStringInCStyle (_UNPK_ fs) +pprFSInCStyle fs = pprStringInCStyle (unpackFS fs) pprStringInCStyle :: String -> SDoc pprStringInCStyle s = doubleQuotes (text (concatMap charToC s)) diff --git a/ghc/compiler/absCSyn/PprAbsC.lhs b/ghc/compiler/absCSyn/PprAbsC.lhs index df93726227..c08740cdd5 100644 --- a/ghc/compiler/absCSyn/PprAbsC.lhs +++ b/ghc/compiler/absCSyn/PprAbsC.lhs @@ -59,6 +59,7 @@ import StgSyn ( StgOp(..) ) import BitSet ( BitSet, intBS ) import Outputable import GlaExts +import FastString import Util ( lengthExceeds, listLengthCmp ) import ST @@ -309,10 +310,10 @@ pprAbsC (CMacroStmt macro as) _ = 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, + = hcat [ftext op, lparen, hcat (punctuate comma (map ppr_amode as)),pp_paren_semi] pprAbsC (CCallProfCCMacro op as) _ - = hcat [ptext op, lparen, + = hcat [ftext op, lparen, hcat (punctuate comma (map ppr_amode as)),pp_paren_semi] pprAbsC stmt@(CCallTypedef is_tdef (CCallSpec op_str cconv _) uniq results args) _ = hsep [ ptext (if is_tdef then SLIT("typedef") else SLIT("extern")) @@ -971,7 +972,7 @@ pprFCall call@(CCall (CCallSpec target cconv safety)) uniq args results vol_regs = ppr_casm_results non_void_results call_str = case target of - CasmTarget str -> _UNPK_ str + CasmTarget str -> unpackFS str StaticTarget fn -> mk_ccall_str (pprCLabelString fn) ccall_args DynamicTarget -> mk_ccall_str dyn_fun (tail ccall_args) |