summaryrefslogtreecommitdiff
path: root/compiler/cmm
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/cmm')
-rw-r--r--compiler/cmm/CLabel.hs4
-rw-r--r--compiler/cmm/CmmExpr.hs6
-rw-r--r--compiler/cmm/CmmLayoutStack.hs2
-rw-r--r--compiler/cmm/CmmParse.y8
-rw-r--r--compiler/cmm/CmmUtils.hs6
-rw-r--r--compiler/cmm/MkGraph.hs71
-rw-r--r--compiler/cmm/PprCmmExpr.hs9
7 files changed, 29 insertions, 77 deletions
diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs
index 447eee8e8d..b262371b65 100644
--- a/compiler/cmm/CLabel.hs
+++ b/compiler/cmm/CLabel.hs
@@ -66,7 +66,6 @@ module CLabel (
mkSMAP_DIRTY_infoLabel,
mkEMPTY_MVAR_infoLabel,
mkArrWords_infoLabel,
- mkRUBBISH_ENTRY_infoLabel,
mkTopTickyCtrLabel,
mkCAFBlackHoleInfoTableLabel,
@@ -507,7 +506,7 @@ mkDirty_MUT_VAR_Label, mkSplitMarkerLabel, mkUpdInfoLabel,
mkEMPTY_MVAR_infoLabel, mkTopTickyCtrLabel,
mkCAFBlackHoleInfoTableLabel, mkCAFBlackHoleEntryLabel,
mkArrWords_infoLabel, mkSMAP_FROZEN_infoLabel, mkSMAP_FROZEN0_infoLabel,
- mkSMAP_DIRTY_infoLabel, mkRUBBISH_ENTRY_infoLabel :: CLabel
+ mkSMAP_DIRTY_infoLabel :: CLabel
mkDirty_MUT_VAR_Label = mkForeignLabel (fsLit "dirty_MUT_VAR") Nothing ForeignLabelInExternalPackage IsFunction
mkSplitMarkerLabel = CmmLabel rtsUnitId (fsLit "__stg_split_marker") CmmCode
mkUpdInfoLabel = CmmLabel rtsUnitId (fsLit "stg_upd_frame") CmmInfo
@@ -525,7 +524,6 @@ mkArrWords_infoLabel = CmmLabel rtsUnitId (fsLit "stg_ARR_WORDS")
mkSMAP_FROZEN_infoLabel = CmmLabel rtsUnitId (fsLit "stg_SMALL_MUT_ARR_PTRS_FROZEN") CmmInfo
mkSMAP_FROZEN0_infoLabel = CmmLabel rtsUnitId (fsLit "stg_SMALL_MUT_ARR_PTRS_FROZEN0") CmmInfo
mkSMAP_DIRTY_infoLabel = CmmLabel rtsUnitId (fsLit "stg_SMALL_MUT_ARR_PTRS_DIRTY") CmmInfo
-mkRUBBISH_ENTRY_infoLabel = CmmLabel rtsUnitId (fsLit "stg_RUBBISH_ENTRY") CmmInfo
-----
mkCmmInfoLabel, mkCmmEntryLabel, mkCmmRetInfoLabel, mkCmmRetLabel,
diff --git a/compiler/cmm/CmmExpr.hs b/compiler/cmm/CmmExpr.hs
index 784724da2d..985db0ee31 100644
--- a/compiler/cmm/CmmExpr.hs
+++ b/compiler/cmm/CmmExpr.hs
@@ -6,7 +6,6 @@
module CmmExpr
( CmmExpr(..), cmmExprType, cmmExprWidth, maybeInvertCmmExpr
- , CmmArg(..)
, CmmReg(..), cmmRegType
, CmmLit(..), cmmLitType
, LocalReg(..), localRegType
@@ -36,7 +35,6 @@ import CmmMachOp
import CmmType
import DynFlags
import Outputable (panic)
-import Type
import Unique
import Data.Set (Set)
@@ -75,10 +73,6 @@ data CmmReg
| CmmGlobal GlobalReg
deriving( Eq, Ord )
-data CmmArg
- = CmmExprArg CmmExpr
- | CmmRubbishArg Type -- See StgRubbishArg in StgSyn.hs
-
-- | A stack area is either the stack slot where a variable is spilled
-- or the stack space where function arguments and results are passed.
data Area
diff --git a/compiler/cmm/CmmLayoutStack.hs b/compiler/cmm/CmmLayoutStack.hs
index 2536030f1d..96231ec732 100644
--- a/compiler/cmm/CmmLayoutStack.hs
+++ b/compiler/cmm/CmmLayoutStack.hs
@@ -1032,7 +1032,7 @@ lowerSafeForeignCall dflags block
(_, regs, copyout) =
copyOutOflow dflags NativeReturn Jump (Young succ)
- (map (CmmExprArg . CmmReg . CmmLocal) res)
+ (map (CmmReg . CmmLocal) res)
ret_off []
-- NB. after resumeThread returns, the top-of-stack probably contains
diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y
index b8c100a3c0..c836e2cf44 100644
--- a/compiler/cmm/CmmParse.y
+++ b/compiler/cmm/CmmParse.y
@@ -1105,7 +1105,7 @@ pushStackFrame fields body = do
exprs <- sequence fields
updfr_off <- getUpdFrameOff
let (new_updfr_off, _, g) = copyOutOflow dflags NativeReturn Ret Old
- [] updfr_off (map CmmExprArg exprs)
+ [] updfr_off exprs
emit g
withUpdFrameOff new_updfr_off body
@@ -1176,7 +1176,7 @@ doReturn exprs_code = do
mkReturnSimple :: DynFlags -> [CmmActual] -> UpdFrameOffset -> CmmAGraph
mkReturnSimple dflags actuals updfr_off =
- mkReturn dflags e (map CmmExprArg actuals) updfr_off
+ mkReturn dflags e actuals updfr_off
where e = entryCode dflags (CmmLoad (CmmStackSlot Old updfr_off)
(gcWord dflags))
@@ -1195,7 +1195,7 @@ doJumpWithStack expr_code stk_code args_code = do
stk_args <- sequence stk_code
args <- sequence args_code
updfr_off <- getUpdFrameOff
- emit (mkJumpExtra dflags NativeNodeCall expr (map CmmExprArg args) updfr_off (map CmmExprArg stk_args))
+ emit (mkJumpExtra dflags NativeNodeCall expr args updfr_off stk_args)
doCall :: CmmParse CmmExpr -> [CmmParse LocalReg] -> [CmmParse CmmExpr]
-> CmmParse ()
@@ -1205,7 +1205,7 @@ doCall expr_code res_code args_code = do
args <- sequence args_code
ress <- sequence res_code
updfr_off <- getUpdFrameOff
- c <- code $ mkCall expr (NativeNodeCall,NativeReturn) ress (map CmmExprArg args) updfr_off []
+ c <- code $ mkCall expr (NativeNodeCall,NativeReturn) ress args updfr_off []
emit c
adjCallTarget :: DynFlags -> CCallConv -> CmmExpr -> [(CmmExpr, ForeignHint) ]
diff --git a/compiler/cmm/CmmUtils.hs b/compiler/cmm/CmmUtils.hs
index e9f2612713..b82f780c08 100644
--- a/compiler/cmm/CmmUtils.hs
+++ b/compiler/cmm/CmmUtils.hs
@@ -10,7 +10,7 @@
module CmmUtils(
-- CmmType
- primRepCmmType, slotCmmType, slotForeignHint, cmmArgType,
+ primRepCmmType, slotCmmType, slotForeignHint,
typeCmmType, typeForeignHint,
-- CmmLit
@@ -127,10 +127,6 @@ primElemRepCmmType DoubleElemRep = f64
typeCmmType :: DynFlags -> UnaryType -> CmmType
typeCmmType dflags ty = primRepCmmType dflags (typePrimRep ty)
-cmmArgType :: DynFlags -> CmmArg -> CmmType
-cmmArgType dflags (CmmExprArg e) = cmmExprType dflags e
-cmmArgType dflags (CmmRubbishArg ty) = typeCmmType dflags ty
-
primRepForeignHint :: PrimRep -> ForeignHint
primRepForeignHint VoidRep = panic "primRepForeignHint:VoidRep"
primRepForeignHint PtrRep = AddrHint
diff --git a/compiler/cmm/MkGraph.hs b/compiler/cmm/MkGraph.hs
index b1bd48a71f..ae7c5097af 100644
--- a/compiler/cmm/MkGraph.hs
+++ b/compiler/cmm/MkGraph.hs
@@ -7,7 +7,7 @@ module MkGraph
, lgraphOfAGraph, labelAGraph
, stackStubExpr
- , mkNop, mkAssign, mkAssign', mkStore, mkStore'
+ , mkNop, mkAssign, mkStore
, mkUnsafeCall, mkFinalCall, mkCallReturnsTo
, mkJumpReturnsTo
, mkJump, mkJumpExtra
@@ -17,18 +17,13 @@ module MkGraph
, copyInOflow, copyOutOflow
, noExtraStack
, toCall, Transfer(..)
- , rubbishExpr
)
where
import BlockId
-import CLabel (mkRUBBISH_ENTRY_infoLabel)
import Cmm
import CmmCallConv
import CmmSwitch (SwitchTargets)
-import CmmUtils (cmmArgType)
-import TyCon (isGcPtrRep)
-import RepType (typePrimRep)
import Compiler.Hoopl hiding (Unique, (<*>), mkFirst, mkMiddle, mkLast, mkLabel, mkBranch, Shape(..))
import DynFlags
@@ -41,7 +36,7 @@ import UniqSupply
import Control.Monad
import Data.List
import Data.Maybe
-import Prelude (($),Int,Bool,Eq(..),otherwise) -- avoid importing (<*>)
+import Prelude (($),Int,Bool,Eq(..)) -- avoid importing (<*>)
#include "HsVersions.h"
@@ -199,30 +194,12 @@ mkAssign :: CmmReg -> CmmExpr -> CmmAGraph
mkAssign l (CmmReg r) | l == r = mkNop
mkAssign l r = mkMiddle $ CmmAssign l r
-mkAssign' :: CmmReg -> CmmArg -> CmmAGraph
-mkAssign' l (CmmRubbishArg ty)
- | isGcPtrRep (typePrimRep ty)
- = mkAssign l rubbishExpr
- | otherwise
- = mkNop
-mkAssign' l (CmmExprArg r)
- = mkAssign l r
-
mkStore :: CmmExpr -> CmmExpr -> CmmAGraph
mkStore l r = mkMiddle $ CmmStore l r
-mkStore' :: CmmExpr -> CmmArg -> CmmAGraph
-mkStore' l (CmmRubbishArg ty)
- | isGcPtrRep (typePrimRep ty)
- = mkStore l rubbishExpr
- | otherwise
- = mkNop
-mkStore' l (CmmExprArg r)
- = mkStore l r
-
---------- Control transfer
mkJump :: DynFlags -> Convention -> CmmExpr
- -> [CmmArg]
+ -> [CmmExpr]
-> UpdFrameOffset
-> CmmAGraph
mkJump dflags conv e actuals updfr_off =
@@ -238,8 +215,8 @@ mkRawJump dflags e updfr_off vols =
\arg_space _ -> toCall e Nothing updfr_off 0 arg_space vols
-mkJumpExtra :: DynFlags -> Convention -> CmmExpr -> [CmmArg]
- -> UpdFrameOffset -> [CmmArg]
+mkJumpExtra :: DynFlags -> Convention -> CmmExpr -> [CmmExpr]
+ -> UpdFrameOffset -> [CmmExpr]
-> CmmAGraph
mkJumpExtra dflags conv e actuals updfr_off extra_stack =
lastWithArgsAndExtraStack dflags Jump Old conv actuals updfr_off extra_stack $
@@ -252,7 +229,7 @@ mkCbranch pred ifso ifnot likely =
mkSwitch :: CmmExpr -> SwitchTargets -> CmmAGraph
mkSwitch e tbl = mkLast $ CmmSwitch e tbl
-mkReturn :: DynFlags -> CmmExpr -> [CmmArg] -> UpdFrameOffset
+mkReturn :: DynFlags -> CmmExpr -> [CmmExpr] -> UpdFrameOffset
-> CmmAGraph
mkReturn dflags e actuals updfr_off =
lastWithArgs dflags Ret Old NativeReturn actuals updfr_off $
@@ -262,17 +239,17 @@ mkBranch :: BlockId -> CmmAGraph
mkBranch bid = mkLast (CmmBranch bid)
mkFinalCall :: DynFlags
- -> CmmExpr -> CCallConv -> [CmmArg] -> UpdFrameOffset
+ -> CmmExpr -> CCallConv -> [CmmExpr] -> UpdFrameOffset
-> CmmAGraph
mkFinalCall dflags f _ actuals updfr_off =
lastWithArgs dflags Call Old NativeDirectCall actuals updfr_off $
toCall f Nothing updfr_off 0
-mkCallReturnsTo :: DynFlags -> CmmExpr -> Convention -> [CmmArg]
+mkCallReturnsTo :: DynFlags -> CmmExpr -> Convention -> [CmmExpr]
-> BlockId
-> ByteOff
-> UpdFrameOffset
- -> [CmmArg]
+ -> [CmmExpr]
-> CmmAGraph
mkCallReturnsTo dflags f callConv actuals ret_lbl ret_off updfr_off extra_stack = do
lastWithArgsAndExtraStack dflags Call (Young ret_lbl) callConv actuals
@@ -281,7 +258,7 @@ mkCallReturnsTo dflags f callConv actuals ret_lbl ret_off updfr_off extra_stack
-- Like mkCallReturnsTo, but does not push the return address (it is assumed to be
-- already on the stack).
-mkJumpReturnsTo :: DynFlags -> CmmExpr -> Convention -> [CmmArg]
+mkJumpReturnsTo :: DynFlags -> CmmExpr -> Convention -> [CmmExpr]
-> BlockId
-> ByteOff
-> UpdFrameOffset
@@ -349,9 +326,9 @@ copyIn dflags conv area formals extra_stk
data Transfer = Call | JumpRet | Jump | Ret deriving Eq
-copyOutOflow :: DynFlags -> Convention -> Transfer -> Area -> [CmmArg]
+copyOutOflow :: DynFlags -> Convention -> Transfer -> Area -> [CmmExpr]
-> UpdFrameOffset
- -> [CmmArg] -- extra stack args
+ -> [CmmExpr] -- extra stack args
-> (Int, [GlobalReg], CmmAGraph)
-- Generate code to move the actual parameters into the locations
@@ -369,9 +346,9 @@ copyOutOflow dflags conv transfer area actuals updfr_off extra_stack_stuff
(regs, graph) = foldr co ([], mkNop) (setRA ++ args ++ stack_params)
co (v, RegisterParam r) (rs, ms)
- = (r:rs, mkAssign' (CmmGlobal r) v <*> ms)
+ = (r:rs, mkAssign (CmmGlobal r) v <*> ms)
co (v, StackParam off) (rs, ms)
- = (rs, mkStore' (CmmStackSlot area off) v <*> ms)
+ = (rs, mkStore (CmmStackSlot area off) v <*> ms)
(setRA, init_offset) =
case area of
@@ -379,7 +356,7 @@ copyOutOflow dflags conv transfer area actuals updfr_off extra_stack_stuff
-- the return address if making a call
case transfer of
Call ->
- ([(CmmExprArg (CmmLit (CmmBlock id)), StackParam init_offset)],
+ ([(CmmLit (CmmBlock id), StackParam init_offset)],
widthInBytes (wordWidth dflags))
JumpRet ->
([],
@@ -389,11 +366,11 @@ copyOutOflow dflags conv transfer area actuals updfr_off extra_stack_stuff
Old -> ([], updfr_off)
(extra_stack_off, stack_params) =
- assignStack dflags init_offset (cmmArgType dflags) extra_stack_stuff
+ assignStack dflags init_offset (cmmExprType dflags) extra_stack_stuff
- args :: [(CmmArg, ParamLocation)] -- The argument and where to put it
+ args :: [(CmmExpr, ParamLocation)] -- The argument and where to put it
(stk_size, args) = assignArgumentsPos dflags extra_stack_off conv
- (cmmArgType dflags) actuals
+ (cmmExprType dflags) actuals
@@ -402,7 +379,7 @@ mkCallEntry :: DynFlags -> Convention -> [CmmFormal] -> [CmmFormal]
mkCallEntry dflags conv formals extra_stk
= copyInOflow dflags conv Old formals extra_stk
-lastWithArgs :: DynFlags -> Transfer -> Area -> Convention -> [CmmArg]
+lastWithArgs :: DynFlags -> Transfer -> Area -> Convention -> [CmmExpr]
-> UpdFrameOffset
-> (ByteOff -> [GlobalReg] -> CmmAGraph)
-> CmmAGraph
@@ -411,8 +388,8 @@ lastWithArgs dflags transfer area conv actuals updfr_off last =
updfr_off noExtraStack last
lastWithArgsAndExtraStack :: DynFlags
- -> Transfer -> Area -> Convention -> [CmmArg]
- -> UpdFrameOffset -> [CmmArg]
+ -> Transfer -> Area -> Convention -> [CmmExpr]
+ -> UpdFrameOffset -> [CmmExpr]
-> (ByteOff -> [GlobalReg] -> CmmAGraph)
-> CmmAGraph
lastWithArgsAndExtraStack dflags transfer area conv actuals updfr_off
@@ -423,7 +400,7 @@ lastWithArgsAndExtraStack dflags transfer area conv actuals updfr_off
updfr_off extra_stack
-noExtraStack :: [CmmArg]
+noExtraStack :: [CmmExpr]
noExtraStack = []
toCall :: CmmExpr -> Maybe BlockId -> UpdFrameOffset -> ByteOff
@@ -431,7 +408,3 @@ toCall :: CmmExpr -> Maybe BlockId -> UpdFrameOffset -> ByteOff
-> CmmAGraph
toCall e cont updfr_off res_space arg_space regs =
mkLast $ CmmCall e cont regs arg_space res_space updfr_off
-
---------------
-rubbishExpr :: CmmExpr
-rubbishExpr = CmmLit (CmmLabel mkRUBBISH_ENTRY_infoLabel)
diff --git a/compiler/cmm/PprCmmExpr.hs b/compiler/cmm/PprCmmExpr.hs
index 219b287f01..77c92407bc 100644
--- a/compiler/cmm/PprCmmExpr.hs
+++ b/compiler/cmm/PprCmmExpr.hs
@@ -53,9 +53,6 @@ instance Outputable CmmExpr where
instance Outputable CmmReg where
ppr e = pprReg e
-instance Outputable CmmArg where
- ppr a = pprArg a
-
instance Outputable CmmLit where
ppr l = pprLit l
@@ -278,11 +275,5 @@ pprGlobalReg gr
-----------------------------------------------------------------------------
-pprArg :: CmmArg -> SDoc
-pprArg (CmmExprArg e) = ppr e
-pprArg (CmmRubbishArg ty) = text "Rubbish" <+> dcolon <+> ppr ty
-
------------------------------------------------------------------------------
-
commafy :: [SDoc] -> SDoc
commafy xs = fsep $ punctuate comma xs
View Lorry Controller Status