summaryrefslogtreecommitdiff
path: root/compiler/codeGen/StgCmmUtils.hs
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/codeGen/StgCmmUtils.hs')
-rw-r--r--compiler/codeGen/StgCmmUtils.hs191
1 files changed, 22 insertions, 169 deletions
diff --git a/compiler/codeGen/StgCmmUtils.hs b/compiler/codeGen/StgCmmUtils.hs
index 74da7317d4..4575a0384e 100644
--- a/compiler/codeGen/StgCmmUtils.hs
+++ b/compiler/codeGen/StgCmmUtils.hs
@@ -36,7 +36,7 @@ module StgCmmUtils (
addToMem, addToMemE, addToMemLbl,
mkWordCLit,
- mkStringCLit, mkByteStringCLit,
+ newStringCLit, newByteStringCLit,
packHalfWordsCLit,
blankWord,
@@ -48,9 +48,8 @@ module StgCmmUtils (
import StgCmmMonad
import StgCmmClosure
+import Cmm
import BlockId
-import CmmDecl
-import CmmExpr hiding (regUsedIn)
import MkGraph
import CLabel
import CmmUtils
@@ -73,7 +72,6 @@ import FastString
import Outputable
import Data.Char
-import Data.Bits
import Data.Word
import Data.Maybe
@@ -85,10 +83,18 @@ import Data.Maybe
-------------------------------------------------------------------------
cgLit :: Literal -> FCode CmmLit
-cgLit (MachStr s) = mkByteStringCLit (bytesFS s)
+cgLit (MachStr s) = newByteStringCLit (bytesFS s)
-- not unpackFS; we want the UTF-8 byte stream.
cgLit other_lit = return (mkSimpleLit other_lit)
+mkLtOp :: Literal -> MachOp
+-- On signed literals we must do a signed comparison
+mkLtOp (MachInt _) = MO_S_Lt wordWidth
+mkLtOp (MachFloat _) = MO_F_Lt W32
+mkLtOp (MachDouble _) = MO_F_Lt W64
+mkLtOp lit = MO_U_Lt (typeWidth (cmmLitType (mkSimpleLit lit)))
+ -- ToDo: seems terribly indirect!
+
mkSimpleLit :: Literal -> CmmLit
mkSimpleLit (MachChar c) = CmmInt (fromIntegral (ord c)) wordWidth
mkSimpleLit MachNullAddr = zeroCLit
@@ -105,131 +111,6 @@ mkSimpleLit (MachLabel fs ms fod)
labelSrc = ForeignLabelInThisPackage
mkSimpleLit other = pprPanic "mkSimpleLit" (ppr other)
-mkLtOp :: Literal -> MachOp
--- On signed literals we must do a signed comparison
-mkLtOp (MachInt _) = MO_S_Lt wordWidth
-mkLtOp (MachFloat _) = MO_F_Lt W32
-mkLtOp (MachDouble _) = MO_F_Lt W64
-mkLtOp lit = MO_U_Lt (typeWidth (cmmLitType (mkSimpleLit lit)))
- -- ToDo: seems terribly indirect!
-
-
----------------------------------------------------
---
--- Cmm data type functions
---
----------------------------------------------------
-
--- The "B" variants take byte offsets
-cmmRegOffB :: CmmReg -> ByteOff -> CmmExpr
-cmmRegOffB = cmmRegOff
-
-cmmOffsetB :: CmmExpr -> ByteOff -> CmmExpr
-cmmOffsetB = cmmOffset
-
-cmmOffsetExprB :: CmmExpr -> CmmExpr -> CmmExpr
-cmmOffsetExprB = cmmOffsetExpr
-
-cmmLabelOffB :: CLabel -> ByteOff -> CmmLit
-cmmLabelOffB = cmmLabelOff
-
-cmmOffsetLitB :: CmmLit -> ByteOff -> CmmLit
-cmmOffsetLitB = cmmOffsetLit
-
------------------------
--- The "W" variants take word offsets
-cmmOffsetExprW :: CmmExpr -> CmmExpr -> CmmExpr
--- The second arg is a *word* offset; need to change it to bytes
-cmmOffsetExprW e (CmmLit (CmmInt n _)) = cmmOffsetW e (fromInteger n)
-cmmOffsetExprW e wd_off = cmmIndexExpr wordWidth e wd_off
-
-cmmOffsetW :: CmmExpr -> WordOff -> CmmExpr
-cmmOffsetW e n = cmmOffsetB e (wORD_SIZE * n)
-
-cmmRegOffW :: CmmReg -> WordOff -> CmmExpr
-cmmRegOffW reg wd_off = cmmRegOffB reg (wd_off * wORD_SIZE)
-
-cmmOffsetLitW :: CmmLit -> WordOff -> CmmLit
-cmmOffsetLitW lit wd_off = cmmOffsetLitB lit (wORD_SIZE * wd_off)
-
-cmmLabelOffW :: CLabel -> WordOff -> CmmLit
-cmmLabelOffW lbl wd_off = cmmLabelOffB lbl (wORD_SIZE * wd_off)
-
-cmmLoadIndexW :: CmmExpr -> Int -> CmmType -> CmmExpr
-cmmLoadIndexW base off ty = CmmLoad (cmmOffsetW base off) ty
-
------------------------
-cmmULtWord, cmmUGeWord, cmmUGtWord, cmmSubWord,
- cmmNeWord, cmmEqWord, cmmOrWord, cmmAndWord,
- cmmUShrWord, cmmAddWord, cmmMulWord
- :: CmmExpr -> CmmExpr -> CmmExpr
-cmmOrWord e1 e2 = CmmMachOp mo_wordOr [e1, e2]
-cmmAndWord e1 e2 = CmmMachOp mo_wordAnd [e1, e2]
-cmmNeWord e1 e2 = CmmMachOp mo_wordNe [e1, e2]
-cmmEqWord e1 e2 = CmmMachOp mo_wordEq [e1, e2]
-cmmULtWord e1 e2 = CmmMachOp mo_wordULt [e1, e2]
-cmmUGeWord e1 e2 = CmmMachOp mo_wordUGe [e1, e2]
-cmmUGtWord e1 e2 = CmmMachOp mo_wordUGt [e1, e2]
---cmmShlWord e1 e2 = CmmMachOp mo_wordShl [e1, e2]
-cmmUShrWord e1 e2 = CmmMachOp mo_wordUShr [e1, e2]
-cmmAddWord e1 e2 = CmmMachOp mo_wordAdd [e1, e2]
-cmmSubWord e1 e2 = CmmMachOp mo_wordSub [e1, e2]
-cmmMulWord e1 e2 = CmmMachOp mo_wordMul [e1, e2]
-
-cmmNegate :: CmmExpr -> CmmExpr
-cmmNegate (CmmLit (CmmInt n rep)) = CmmLit (CmmInt (-n) rep)
-cmmNegate e = CmmMachOp (MO_S_Neg (cmmExprWidth e)) [e]
-
-blankWord :: CmmStatic
-blankWord = CmmUninitialised wORD_SIZE
-
--- Tagging --
--- Tag bits mask
---cmmTagBits = CmmLit (mkIntCLit tAG_BITS)
-cmmTagMask, cmmPointerMask :: CmmExpr
-cmmTagMask = CmmLit (mkIntCLit tAG_MASK)
-cmmPointerMask = CmmLit (mkIntCLit (complement tAG_MASK))
-
--- Used to untag a possibly tagged pointer
--- A static label need not be untagged
-cmmUntag, cmmGetTag :: CmmExpr -> CmmExpr
-cmmUntag e@(CmmLit (CmmLabel _)) = e
--- Default case
-cmmUntag e = (e `cmmAndWord` cmmPointerMask)
-
-cmmGetTag e = (e `cmmAndWord` cmmTagMask)
-
--- Test if a closure pointer is untagged
-cmmIsTagged :: CmmExpr -> CmmExpr
-cmmIsTagged e = (e `cmmAndWord` cmmTagMask)
- `cmmNeWord` CmmLit zeroCLit
-
-cmmConstrTag, cmmConstrTag1 :: CmmExpr -> CmmExpr
-cmmConstrTag e = (e `cmmAndWord` cmmTagMask) `cmmSubWord` (CmmLit (mkIntCLit 1))
--- Get constructor tag, but one based.
-cmmConstrTag1 e = e `cmmAndWord` cmmTagMask
-
------------------------
--- Making literals
-
-mkWordCLit :: StgWord -> CmmLit
-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
--- 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))
-#endif
-
--------------------------------------------------------------------------
--
-- Incrementing a memory location
@@ -507,44 +388,23 @@ baseRegOffset reg = pprPanic "baseRegOffset:" (ppr reg)
emitDataLits :: CLabel -> [CmmLit] -> FCode ()
-- Emit a data-segment data block
-emitDataLits lbl lits
- = emitData Data (Statics lbl $ map CmmStaticLit lits)
-
-mkDataLits :: CLabel -> [CmmLit] -> GenCmmTop CmmStatics info stmt
--- Emit a data-segment data block
-mkDataLits lbl lits
- = CmmData Data (Statics lbl $ map CmmStaticLit lits)
+emitDataLits lbl lits = emitDecl (mkDataLits Data lbl lits)
emitRODataLits :: CLabel -> [CmmLit] -> FCode ()
-- Emit a read-only data block
-emitRODataLits lbl lits
- = emitData section (Statics lbl $ map CmmStaticLit lits)
- where section | any needsRelocation lits = RelocatableReadOnlyData
- | otherwise = ReadOnlyData
- needsRelocation (CmmLabel _) = True
- needsRelocation (CmmLabelOff _ _) = True
- needsRelocation _ = False
-
-mkRODataLits :: CLabel -> [CmmLit] -> GenCmmTop CmmStatics info stmt
-mkRODataLits lbl lits
- = CmmData section (Statics lbl $ map CmmStaticLit lits)
- where section | any needsRelocation lits = RelocatableReadOnlyData
- | otherwise = ReadOnlyData
- needsRelocation (CmmLabel _) = True
- needsRelocation (CmmLabelOff _ _) = True
- needsRelocation _ = False
-
-mkStringCLit :: String -> FCode CmmLit
+emitRODataLits lbl lits = emitDecl (mkRODataLits lbl lits)
+
+newStringCLit :: String -> FCode CmmLit
-- Make a global definition for the string,
-- and return its label
-mkStringCLit str = mkByteStringCLit (map (fromIntegral . ord) str)
+newStringCLit str = newByteStringCLit (map (fromIntegral . ord) str)
-mkByteStringCLit :: [Word8] -> FCode CmmLit
-mkByteStringCLit bytes
+newByteStringCLit :: [Word8] -> FCode CmmLit
+newByteStringCLit bytes
= do { uniq <- newUnique
- ; let lbl = mkStringLitLabel uniq
- ; emitData ReadOnlyData $ Statics lbl [CmmString bytes]
- ; return (CmmLabel lbl) }
+ ; let (lit, decl) = mkByteStringCLit uniq bytes
+ ; emitDecl decl
+ ; return lit }
-------------------------------------------------------------------------
--
@@ -658,14 +518,7 @@ unscramble vertices
mk_graph (reg, rhs) = mkAssign (CmmLocal reg) rhs
mustFollow :: Stmt -> Stmt -> Bool
-(reg, _) `mustFollow` (_, rhs) = reg `regUsedIn` rhs
-
-regUsedIn :: LocalReg -> CmmExpr -> Bool
-reg `regUsedIn` CmmLoad e _ = reg `regUsedIn` e
-reg `regUsedIn` CmmReg (CmmLocal reg') = reg == reg'
-reg `regUsedIn` CmmRegOff (CmmLocal reg') _ = reg == reg'
-reg `regUsedIn` CmmMachOp _ es = any (reg `regUsedIn`) es
-_reg `regUsedIn` _other = False -- The CmmGlobal cases
+(reg, _) `mustFollow` (_, rhs) = CmmLocal reg `regUsedIn` rhs
-------------------------------------------------------------------------
-- mkSwitch
View Lorry Controller Status