diff options
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/cmm/CmmUtils.hs | 148 |
1 files changed, 71 insertions, 77 deletions
diff --git a/compiler/cmm/CmmUtils.hs b/compiler/cmm/CmmUtils.hs index 93158848f3..6607aec33c 100644 --- a/compiler/cmm/CmmUtils.hs +++ b/compiler/cmm/CmmUtils.hs @@ -1,10 +1,4 @@ {-# LANGUAGE GADTs #-} -{-# OPTIONS -fno-warn-tabs #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and --- detab the module (please do the detabbing in a separate patch). See --- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces --- for details {-# OPTIONS_GHC -fno-warn-deprecations #-} -- Warnings from deprecated blockToNodeList @@ -18,37 +12,37 @@ -- ----------------------------------------------------------------------------- -module CmmUtils( +module CmmUtils( -- CmmType - primRepCmmType, primRepForeignHint, - typeCmmType, typeForeignHint, + primRepCmmType, primRepForeignHint, + typeCmmType, typeForeignHint, - -- CmmLit + -- CmmLit zeroCLit, mkIntCLit, - mkWordCLit, packHalfWordsCLit, - mkByteStringCLit, + mkWordCLit, packHalfWordsCLit, + mkByteStringCLit, mkDataLits, mkRODataLits, - -- CmmExpr + -- CmmExpr mkIntExpr, zeroExpr, mkLblExpr, - cmmRegOff, cmmOffset, cmmLabelOff, cmmOffsetLit, cmmOffsetExpr, - cmmRegOffB, cmmOffsetB, cmmLabelOffB, cmmOffsetLitB, cmmOffsetExprB, - cmmRegOffW, cmmOffsetW, cmmLabelOffW, cmmOffsetLitW, cmmOffsetExprW, - cmmIndex, cmmIndexExpr, cmmLoadIndex, cmmLoadIndexW, - cmmNegate, - cmmULtWord, cmmUGeWord, cmmUGtWord, cmmSubWord, - cmmNeWord, cmmEqWord, cmmOrWord, cmmAndWord, + cmmRegOff, cmmOffset, cmmLabelOff, cmmOffsetLit, cmmOffsetExpr, + cmmRegOffB, cmmOffsetB, cmmLabelOffB, cmmOffsetLitB, cmmOffsetExprB, + cmmRegOffW, cmmOffsetW, cmmLabelOffW, cmmOffsetLitW, cmmOffsetExprW, + cmmIndex, cmmIndexExpr, cmmLoadIndex, cmmLoadIndexW, + cmmNegate, + cmmULtWord, cmmUGeWord, cmmUGtWord, cmmSubWord, + cmmNeWord, cmmEqWord, cmmOrWord, cmmAndWord, cmmUShrWord, cmmAddWord, cmmMulWord, cmmQuotWord, - isTrivialCmmExpr, hasNoGlobalRegs, - - -- Statics - blankWord, + isTrivialCmmExpr, hasNoGlobalRegs, - -- Tagging - cmmTagMask, cmmPointerMask, cmmUntag, cmmGetTag, cmmIsTagged, - cmmConstrTag, cmmConstrTag1, + -- Statics + blankWord, + + -- Tagging + cmmTagMask, cmmPointerMask, cmmUntag, cmmGetTag, cmmIsTagged, + cmmConstrTag, cmmConstrTag1, -- Liveness and bitmaps mkLiveness, @@ -60,7 +54,7 @@ module CmmUtils( ofBlockMap, toBlockMap, insertBlock, ofBlockList, toBlockList, bodyToBlockList, foldGraphBlocks, mapGraphNodes, postorderDfs, mapGraphNodes1, - + analFwd, analBwd, analRewFwd, analRewBwd, dataflowPassFwd, dataflowPassBwd, dataflowAnalFwd, dataflowAnalBwd, dataflowAnalFwdBlocks @@ -68,8 +62,8 @@ module CmmUtils( #include "HsVersions.h" -import TyCon ( PrimRep(..) ) -import Type ( UnaryType, typePrimRep ) +import TyCon ( PrimRep(..) ) +import Type ( UnaryType, typePrimRep ) import SMRep import Cmm @@ -88,15 +82,15 @@ import Hoopl --------------------------------------------------- -- --- CmmTypes +-- CmmTypes -- --------------------------------------------------- primRepCmmType :: PrimRep -> CmmType primRepCmmType VoidRep = panic "primRepCmmType:VoidRep" primRepCmmType PtrRep = gcWord -primRepCmmType IntRep = bWord -primRepCmmType WordRep = bWord +primRepCmmType IntRep = bWord +primRepCmmType WordRep = bWord primRepCmmType Int64Rep = b64 primRepCmmType Word64Rep = b64 primRepCmmType AddrRep = bWord @@ -107,22 +101,22 @@ typeCmmType :: UnaryType -> CmmType typeCmmType ty = primRepCmmType (typePrimRep ty) primRepForeignHint :: PrimRep -> ForeignHint -primRepForeignHint VoidRep = panic "primRepForeignHint:VoidRep" -primRepForeignHint PtrRep = AddrHint -primRepForeignHint IntRep = SignedHint -primRepForeignHint WordRep = NoHint -primRepForeignHint Int64Rep = SignedHint -primRepForeignHint Word64Rep = NoHint +primRepForeignHint VoidRep = panic "primRepForeignHint:VoidRep" +primRepForeignHint PtrRep = AddrHint +primRepForeignHint IntRep = SignedHint +primRepForeignHint WordRep = NoHint +primRepForeignHint Int64Rep = SignedHint +primRepForeignHint Word64Rep = NoHint primRepForeignHint AddrRep = AddrHint -- NB! AddrHint, but NonPtrArg -primRepForeignHint FloatRep = NoHint -primRepForeignHint DoubleRep = NoHint +primRepForeignHint FloatRep = NoHint +primRepForeignHint DoubleRep = NoHint typeForeignHint :: UnaryType -> ForeignHint typeForeignHint = primRepForeignHint . typePrimRep --------------------------------------------------- -- --- CmmLit +-- CmmLit -- --------------------------------------------------- @@ -139,7 +133,7 @@ zeroExpr :: CmmExpr zeroExpr = CmmLit zeroCLit mkByteStringCLit :: Unique -> [Word8] -> (CmmLit, GenCmmDecl CmmStatics info stmt) --- We have to make a top-level decl for the string, +-- We have to make a top-level decl for the string, -- and return a literal pointing to it mkByteStringCLit uniq bytes = (CmmLabel lbl, CmmData ReadOnlyData $ Statics lbl [CmmString bytes]) @@ -154,7 +148,7 @@ mkRODataLits :: CLabel -> [CmmLit] -> GenCmmDecl CmmStatics info stmt -- Build a read-only data block mkRODataLits lbl lits = mkDataLits section lbl lits - where + where section | any needsRelocation lits = RelocatableReadOnlyData | otherwise = ReadOnlyData needsRelocation (CmmLabel _) = True @@ -166,22 +160,22 @@ mkWordCLit wd = CmmInt (fromIntegral wd) wordWidth packHalfWordsCLit :: (Integral a, Integral b) => a -> b -> CmmLit -- Make a single word literal in which the lower_half_word is --- at the lower address, and the upper_half_word is at the +-- at the lower address, and the upper_half_word is at the -- higher address -- ToDo: consider using half-word lits instead --- but be careful: that's vulnerable when reversed +-- but be careful: that's vulnerable when reversed packHalfWordsCLit lower_half_word upper_half_word #ifdef WORDS_BIGENDIAN = mkWordCLit ((fromIntegral lower_half_word `shiftL` hALF_WORD_SIZE_IN_BITS) - .|. fromIntegral upper_half_word) -#else - = mkWordCLit ((fromIntegral lower_half_word) - .|. (fromIntegral upper_half_word `shiftL` hALF_WORD_SIZE_IN_BITS)) + .|. fromIntegral upper_half_word) +#else + = mkWordCLit ((fromIntegral lower_half_word) + .|. (fromIntegral upper_half_word `shiftL` hALF_WORD_SIZE_IN_BITS)) #endif --------------------------------------------------- -- --- CmmExpr +-- CmmExpr -- --------------------------------------------------- @@ -206,8 +200,8 @@ cmmOffset (CmmReg reg) byte_off = cmmRegOff reg byte_off cmmOffset (CmmRegOff reg m) byte_off = cmmRegOff reg (m+byte_off) cmmOffset (CmmLit lit) byte_off = CmmLit (cmmOffsetLit lit byte_off) cmmOffset (CmmMachOp (MO_Add rep) [expr, CmmLit (CmmInt byte_off1 _rep)]) byte_off2 - = CmmMachOp (MO_Add rep) - [expr, CmmLit (CmmInt (byte_off1 + toInteger byte_off2) rep)] + = CmmMachOp (MO_Add rep) + [expr, CmmLit (CmmInt (byte_off1 + toInteger byte_off2) rep)] cmmOffset expr byte_off = CmmMachOp (MO_Add width) [expr, CmmLit (CmmInt (toInteger byte_off) width)] where @@ -218,10 +212,10 @@ cmmRegOff :: CmmReg -> Int -> CmmExpr cmmRegOff reg byte_off = CmmRegOff reg byte_off cmmOffsetLit :: CmmLit -> Int -> CmmLit -cmmOffsetLit (CmmLabel l) byte_off = cmmLabelOff l byte_off -cmmOffsetLit (CmmLabelOff l m) byte_off = cmmLabelOff l (m+byte_off) +cmmOffsetLit (CmmLabel l) byte_off = cmmLabelOff l byte_off +cmmOffsetLit (CmmLabelOff l m) byte_off = cmmLabelOff l (m+byte_off) cmmOffsetLit (CmmInt m rep) byte_off = CmmInt (m + fromIntegral byte_off) rep -cmmOffsetLit _ byte_off = pprPanic "cmmOffsetLit" (ppr byte_off) +cmmOffsetLit _ byte_off = pprPanic "cmmOffsetLit" (ppr byte_off) cmmLabelOff :: CLabel -> Int -> CmmLit -- Smart constructor for CmmLabelOff @@ -230,17 +224,17 @@ cmmLabelOff lbl byte_off = CmmLabelOff lbl byte_off -- | Useful for creating an index into an array, with a staticaly known offset. -- The type is the element type; used for making the multiplier -cmmIndex :: Width -- Width w - -> CmmExpr -- Address of vector of items of width w - -> Int -- Which element of the vector (0 based) - -> CmmExpr -- Address of i'th element +cmmIndex :: Width -- Width w + -> CmmExpr -- Address of vector of items of width w + -> Int -- Which element of the vector (0 based) + -> CmmExpr -- Address of i'th element cmmIndex width base idx = cmmOffset base (idx * widthInBytes width) -- | Useful for creating an index into an array, with an unknown offset. -cmmIndexExpr :: Width -- Width w - -> CmmExpr -- Address of vector of items of width w - -> CmmExpr -- Which element of the vector (0 based) - -> CmmExpr -- Address of i'th element +cmmIndexExpr :: Width -- Width w + -> CmmExpr -- Address of vector of items of width w + -> CmmExpr -- Which element of the vector (0 based) + -> CmmExpr -- Address of i'th element cmmIndexExpr width base (CmmLit (CmmInt n _)) = cmmIndex width base (fromInteger n) cmmIndexExpr width base idx = cmmOffsetExpr base byte_off @@ -310,36 +304,36 @@ cmmQuotWord e1 e2 = CmmMachOp mo_wordUQuot [e1, e2] cmmNegate :: CmmExpr -> CmmExpr cmmNegate (CmmLit (CmmInt n rep)) = CmmLit (CmmInt (-n) rep) -cmmNegate e = CmmMachOp (MO_S_Neg (cmmExprWidth e)) [e] +cmmNegate e = CmmMachOp (MO_S_Neg (cmmExprWidth e)) [e] blankWord :: CmmStatic blankWord = CmmUninitialised wORD_SIZE --------------------------------------------------- -- --- CmmExpr predicates +-- CmmExpr predicates -- --------------------------------------------------- isTrivialCmmExpr :: CmmExpr -> Bool -isTrivialCmmExpr (CmmLoad _ _) = False -isTrivialCmmExpr (CmmMachOp _ _) = False -isTrivialCmmExpr (CmmLit _) = True -isTrivialCmmExpr (CmmReg _) = True -isTrivialCmmExpr (CmmRegOff _ _) = True +isTrivialCmmExpr (CmmLoad _ _) = False +isTrivialCmmExpr (CmmMachOp _ _) = False +isTrivialCmmExpr (CmmLit _) = True +isTrivialCmmExpr (CmmReg _) = True +isTrivialCmmExpr (CmmRegOff _ _) = True isTrivialCmmExpr (CmmStackSlot _ _) = panic "isTrivialCmmExpr CmmStackSlot" hasNoGlobalRegs :: CmmExpr -> Bool -hasNoGlobalRegs (CmmLoad e _) = hasNoGlobalRegs e -hasNoGlobalRegs (CmmMachOp _ es) = all hasNoGlobalRegs es -hasNoGlobalRegs (CmmLit _) = True +hasNoGlobalRegs (CmmLoad e _) = hasNoGlobalRegs e +hasNoGlobalRegs (CmmMachOp _ es) = all hasNoGlobalRegs es +hasNoGlobalRegs (CmmLit _) = True hasNoGlobalRegs (CmmReg (CmmLocal _)) = True hasNoGlobalRegs (CmmRegOff (CmmLocal _) _) = True hasNoGlobalRegs _ = False --------------------------------------------------- -- --- Tagging +-- Tagging -- --------------------------------------------------- @@ -377,8 +371,8 @@ cmmConstrTag1 e = e `cmmAndWord` cmmTagMask mkLiveness :: [Maybe LocalReg] -> Liveness mkLiveness [] = [] -mkLiveness (reg:regs) - = take sizeW bits ++ mkLiveness regs +mkLiveness (reg:regs) + = take sizeW bits ++ mkLiveness regs where sizeW = case reg of Nothing -> 1 |