Commit ad779f57 authored by ian@well-typed.com's avatar ian@well-typed.com
Browse files

Whitespace only in cmm/CmmUtils.hs

parent 00e4140d
{-# 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
-- higher address
-- ToDo: consider using half-word lits instead
-- ToDo: consider using half-word lits instead
-- 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)
= mkWordCLit ((fromIntegral lower_half_word `shiftL` hALF_WORD_SIZE_IN_BITS)
.|. fromIntegral upper_half_word)
 
= mkWordCLit ((fromIntegral lower_half_word)
.|. fromIntegral upper_half_word)
#else
= mkWordCLit ((fromIntegral lower_half_word)
.|. (fromIntegral upper_half_word `shiftL` hALF_WORD_SIZE_IN_BITS))
#endif
---------------------------------------------------
--
--
-- 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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment