Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
jberryman
GHC
Commits
de3a8f76
Commit
de3a8f76
authored
Aug 28, 2012
by
Simon Marlow
Browse files
Cleanup: add mkIntExpr and zeroExpr utils
parent
8aabe8d0
Changes
15
Hide whitespace changes
Inline
Side-by-side
compiler/cmm/CmmExpr.hs
View file @
de3a8f76
...
...
@@ -62,7 +62,7 @@ instance Eq CmmExpr where -- Equality ignores the types
CmmStackSlot
a1
i1
==
CmmStackSlot
a2
i2
=
a1
==
a2
&&
i1
==
i2
_e1
==
_e2
=
False
data
CmmReg
data
CmmReg
=
CmmLocal
{-# UNPACK #-}
!
LocalReg
|
CmmGlobal
GlobalReg
deriving
(
Eq
,
Ord
)
...
...
compiler/cmm/CmmLayoutStack.hs
View file @
de3a8f76
...
...
@@ -773,12 +773,12 @@ arguments.
areaToSp
::
ByteOff
->
ByteOff
->
(
Area
->
StackLoc
)
->
CmmExpr
->
CmmExpr
areaToSp
sp_old
_sp_hwm
area_off
(
CmmStackSlot
area
n
)
=
cmmOffset
(
CmmReg
spReg
)
(
sp_old
-
area_off
area
-
n
)
areaToSp
_
sp_hwm
_
(
CmmLit
CmmHighStackMark
)
=
CmmLit
(
mkInt
CLit
sp_hwm
)
areaToSp
_
sp_hwm
_
(
CmmLit
CmmHighStackMark
)
=
mkInt
Expr
sp_hwm
areaToSp
_
_
_
(
CmmMachOp
(
MO_U_Lt
_
)
-- Note [null stack check]
[
CmmMachOp
(
MO_Sub
_
)
[
CmmReg
(
CmmGlobal
Sp
)
,
CmmLit
(
CmmInt
0
_
)],
CmmReg
(
CmmGlobal
SpLim
)])
=
CmmLit
(
CmmInt
0
wordWidth
)
CmmReg
(
CmmGlobal
SpLim
)])
=
zeroExpr
areaToSp
_
_
_
other
=
other
-- -----------------------------------------------------------------------------
...
...
@@ -968,7 +968,7 @@ callSuspendThread id intrbl =
CmmUnsafeForeignCall
(
ForeignTarget
(
foreignLbl
(
fsLit
"suspendThread"
))
(
ForeignConvention
CCallConv
[
AddrHint
,
NoHint
]
[
AddrHint
]))
[
id
]
[
CmmReg
(
CmmGlobal
BaseReg
),
CmmLit
(
mkInt
CLit
(
fromEnum
intrbl
)
)
]
[
id
]
[
CmmReg
(
CmmGlobal
BaseReg
),
mkInt
Expr
(
fromEnum
intrbl
)]
callResumeThread
::
LocalReg
->
LocalReg
->
CmmNode
O
O
callResumeThread
new_base
id
=
...
...
compiler/cmm/CmmUtils.hs
View file @
de3a8f76
...
...
@@ -24,13 +24,14 @@ module CmmUtils(
typeCmmType
,
typeForeignHint
,
-- CmmLit
zeroCLit
,
mkIntCLit
,
zeroCLit
,
mkIntCLit
,
mkWordCLit
,
packHalfWordsCLit
,
mkByteStringCLit
,
mkDataLits
,
mkRODataLits
,
-- CmmExpr
mkLblExpr
,
mkIntExpr
,
zeroExpr
,
mkLblExpr
,
cmmRegOff
,
cmmOffset
,
cmmLabelOff
,
cmmOffsetLit
,
cmmOffsetExpr
,
cmmRegOffB
,
cmmOffsetB
,
cmmLabelOffB
,
cmmOffsetLitB
,
cmmOffsetExprB
,
cmmRegOffW
,
cmmOffsetW
,
cmmLabelOffW
,
cmmOffsetLitW
,
cmmOffsetExprW
,
...
...
@@ -128,9 +129,15 @@ typeForeignHint = primRepForeignHint . typePrimRep
mkIntCLit
::
Int
->
CmmLit
mkIntCLit
i
=
CmmInt
(
toInteger
i
)
wordWidth
mkIntExpr
::
Int
->
CmmExpr
mkIntExpr
i
=
CmmLit
$!
mkIntCLit
i
zeroCLit
::
CmmLit
zeroCLit
=
CmmInt
0
wordWidth
zeroExpr
::
CmmExpr
zeroExpr
=
CmmLit
zeroCLit
mkByteStringCLit
::
Unique
->
[
Word8
]
->
(
CmmLit
,
GenCmmDecl
CmmStatics
info
stmt
)
-- We have to make a top-level decl for the string,
-- and return a literal pointing to it
...
...
@@ -239,7 +246,7 @@ cmmIndexExpr width base idx =
cmmOffsetExpr
base
byte_off
where
idx_w
=
cmmExprWidth
idx
byte_off
=
CmmMachOp
(
MO_Shl
idx_w
)
[
idx
,
CmmLit
(
mkInt
CLit
(
widthInLog
width
)
)
]
byte_off
=
CmmMachOp
(
MO_Shl
idx_w
)
[
idx
,
mkInt
Expr
(
widthInLog
width
)]
cmmLoadIndex
::
CmmType
->
CmmExpr
->
Int
->
CmmExpr
cmmLoadIndex
ty
expr
ix
=
CmmLoad
(
cmmIndex
(
typeWidth
ty
)
expr
ix
)
ty
...
...
@@ -299,6 +306,7 @@ 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
]
cmmQuotWord
e1
e2
=
CmmMachOp
mo_wordUQuot
[
e1
,
e2
]
cmmNegate
::
CmmExpr
->
CmmExpr
cmmNegate
(
CmmLit
(
CmmInt
n
rep
))
=
CmmLit
(
CmmInt
(
-
n
)
rep
)
...
...
@@ -306,7 +314,6 @@ cmmNegate e = CmmMachOp (MO_S_Neg (cmmExprWidth e)) [e]
blankWord
::
CmmStatic
blankWord
=
CmmUninitialised
wORD_SIZE
cmmQuotWord
e1
e2
=
CmmMachOp
mo_wordUQuot
[
e1
,
e2
]
---------------------------------------------------
--
...
...
@@ -339,8 +346,8 @@ hasNoGlobalRegs _ = False
-- Tag bits mask
--cmmTagBits = CmmLit (mkIntCLit tAG_BITS)
cmmTagMask
,
cmmPointerMask
::
CmmExpr
cmmTagMask
=
CmmLit
(
mkInt
CLit
tAG_MASK
)
cmmPointerMask
=
CmmLit
(
mkInt
CLit
(
complement
tAG_MASK
)
)
cmmTagMask
=
mkInt
Expr
tAG_MASK
cmmPointerMask
=
mkInt
Expr
(
complement
tAG_MASK
)
-- Used to untag a possibly tagged pointer
-- A static label need not be untagged
...
...
@@ -354,10 +361,10 @@ cmmGetTag e = (e `cmmAndWord` cmmTagMask)
-- Test if a closure pointer is untagged
cmmIsTagged
::
CmmExpr
->
CmmExpr
cmmIsTagged
e
=
(
e
`
cmmAndWord
`
cmmTagMask
)
`
cmmNeWord
`
CmmLit
zeroCLit
`
cmmNeWord
`
zeroExpr
cmmConstrTag
,
cmmConstrTag1
::
CmmExpr
->
CmmExpr
cmmConstrTag
e
=
(
e
`
cmmAndWord
`
cmmTagMask
)
`
cmmSubWord
`
(
CmmLit
(
mkIntCLit
1
))
cmmConstrTag
e
=
(
e
`
cmmAndWord
`
cmmTagMask
)
`
cmmSubWord
`
mkIntExpr
1
-- Get constructor tag, but one based.
cmmConstrTag1
e
=
e
`
cmmAndWord
`
cmmTagMask
...
...
compiler/codeGen/CgClosure.lhs
View file @
de3a8f76
...
...
@@ -323,7 +323,7 @@ mkFunEntryCode cl_info cc reg_args stk_args sp_top reg_save_code body = do
{ tickyEnterFun cl_info
; enterCostCentreFun cc
(CmmMachOp mo_wordSub [ CmmReg nodeReg
,
CmmLit (
mkInt
CLit
(funTag cl_info)
)
])
, mkInt
Expr
(funTag cl_info) ])
(node : map snd reg_args) -- live regs
; cgExpr body }
...
...
@@ -429,8 +429,8 @@ funWrapper closure_info arg_regs reg_save_code fun_body = do
; whenC (tag /= 0 && node_points) $ do
l <- newLabelC
stmtC (CmmCondBranch (CmmMachOp mo_wordEq [cmmGetTag (CmmReg nodeReg),
CmmLit (
mkInt
CLit
tag)]) l)
stmtC (CmmStore (CmmLit (mkWordCLit 0))
(CmmLit
(mkWord
CLit
0))
)
mkInt
Expr
tag)]) l)
stmtC (CmmStore (CmmLit (mkWordCLit 0)) (mkWord
Expr
0))
labelC l
-}
...
...
@@ -598,7 +598,7 @@ link_caf cl_info _is_upd = do
-- node is live, so save it.
-- see Note [atomic CAF entry] in rts/sm/Storage.c
; emitIf (CmmMachOp mo_wordEq [ CmmReg (CmmLocal ret),
CmmLit zeroCLit
]) $
; emitIf (CmmMachOp mo_wordEq [ CmmReg (CmmLocal ret),
zeroExpr
]) $
-- re-enter R1. Doing this directly is slightly dodgy; we're
-- assuming lots of things, like the stack pointer hasn't
-- moved since we entered the CAF.
...
...
compiler/codeGen/CgForeignCall.hs
View file @
de3a8f76
...
...
@@ -263,7 +263,7 @@ emitOpenNursery = stmtsC [
(
CmmMachOp
mo_wordMul
[
CmmMachOp
(
MO_SS_Conv
W32
wordWidth
)
[
CmmLoad
nursery_bdescr_blocks
b32
],
CmmLit
(
mkInt
CLit
bLOCK_SIZE
)
mkInt
Expr
bLOCK_SIZE
])
(
-
1
)
)
...
...
compiler/codeGen/CgHeapery.lhs
View file @
de3a8f76
...
...
@@ -462,8 +462,8 @@ do_checks _ hp _ _ _
"structures in the code."])
do_checks stk hp reg_save_code rts_lbl live
= do_checks'
(CmmLit
(mkInt
CLit
(stk*wORD_SIZE))
)
(CmmLit
(mkInt
CLit
(hp*wORD_SIZE))
)
= do_checks' (mkInt
Expr
(stk*wORD_SIZE))
(mkInt
Expr
(hp*wORD_SIZE))
(stk /= 0) (hp /= 0) reg_save_code rts_lbl live
-- The offsets are now in *bytes*
...
...
@@ -528,7 +528,7 @@ hpChkGen :: CmmExpr -> CmmExpr -> CmmExpr -> Code
hpChkGen bytes liveness reentry
= do dflags <- getDynFlags
let platform = targetPlatform dflags
do_checks'
(CmmLit (mkIntCLit 0))
bytes False True assigns
do_checks'
zeroExpr
bytes False True assigns
stg_gc_gen (Just (activeStgRegs platform))
where
assigns = mkStmts [ mk_vanilla_assignment 9 liveness,
...
...
@@ -538,7 +538,7 @@ hpChkGen bytes liveness reentry
-- we want to assign to Sp[0] on failure (used in AutoApply.cmm:BUILD_PAP).
hpChkNodePointsAssignSp0 :: CmmExpr -> CmmExpr -> Code
hpChkNodePointsAssignSp0 bytes sp0
= do_checks'
(CmmLit (mkIntCLit 0))
bytes False True assign
= do_checks'
zeroExpr
bytes False True assign
stg_gc_enter1 (Just [node])
where assign = oneStmt (CmmStore (CmmReg spReg) sp0)
...
...
@@ -546,7 +546,7 @@ stkChkGen :: CmmExpr -> CmmExpr -> CmmExpr -> Code
stkChkGen bytes liveness reentry
= do dflags <- getDynFlags
let platform = targetPlatform dflags
do_checks' bytes
(CmmLit (mkIntCLit 0))
True False assigns
do_checks' bytes
zeroExpr
True False assigns
stg_gc_gen (Just (activeStgRegs platform))
where
assigns = mkStmts [ mk_vanilla_assignment 9 liveness,
...
...
@@ -558,7 +558,7 @@ mk_vanilla_assignment n e
stkChkNodePoints :: CmmExpr -> Code
stkChkNodePoints bytes
= do_checks' bytes
(CmmLit (mkIntCLit 0))
True False noStmts
= do_checks' bytes
zeroExpr
True False noStmts
stg_gc_enter1 (Just [node])
stg_gc_gen :: CmmExpr
...
...
compiler/codeGen/CgPrimOp.hs
View file @
de3a8f76
...
...
@@ -89,7 +89,7 @@ emitPrimOp [res_r,res_c] IntAddCOp [aa,bb] _
CmmMachOp
mo_wordNot
[
CmmMachOp
mo_wordXor
[
aa
,
bb
]],
CmmMachOp
mo_wordXor
[
aa
,
CmmReg
(
CmmLocal
res_r
)]
],
CmmLit
(
mkInt
CLit
(
wORD_SIZE_IN_BITS
-
1
)
)
mkInt
Expr
(
wORD_SIZE_IN_BITS
-
1
)
]
]
...
...
@@ -112,7 +112,7 @@ emitPrimOp [res_r,res_c] IntSubCOp [aa,bb] _
CmmMachOp
mo_wordXor
[
aa
,
bb
],
CmmMachOp
mo_wordXor
[
aa
,
CmmReg
(
CmmLocal
res_r
)]
],
CmmLit
(
mkInt
CLit
(
wORD_SIZE_IN_BITS
-
1
)
)
mkInt
Expr
(
wORD_SIZE_IN_BITS
-
1
)
]
]
...
...
compiler/codeGen/CgProf.hs
View file @
de3a8f76
...
...
@@ -108,7 +108,7 @@ profDynAlloc :: ClosureInfo -> CmmExpr -> Code
profDynAlloc
cl_info
ccs
=
ifProfiling
$
do
dflags
<-
getDynFlags
profAlloc
(
CmmLit
(
mkInt
CLit
(
closureSize
dflags
cl_info
))
)
ccs
profAlloc
(
mkInt
Expr
(
closureSize
dflags
cl_info
))
ccs
-- | Record the allocation of a closure (size is given by a CmmExpr)
-- The size must be in words, because the allocation counter in a CCS counts
...
...
@@ -124,7 +124,7 @@ profAlloc words ccs
(
cmmOffsetB
ccs
oFFSET_CostCentreStack_mem_alloc
)
(
CmmMachOp
(
MO_UU_Conv
wordWidth
alloc_rep
)
$
[
CmmMachOp
mo_wordSub
[
words
,
CmmLit
(
mkInt
CLit
(
profHdrSize
dflags
)
)
]]))
mkInt
Expr
(
profHdrSize
dflags
)]]))
-- subtract the "profiling overhead", which is the
-- profiling header in a closure.
where
...
...
@@ -266,7 +266,7 @@ staticLdvInit = zeroCLit
dynLdvInit
::
CmmExpr
dynLdvInit
=
-- (era << LDV_SHIFT) | LDV_STATE_CREATE
CmmMachOp
mo_wordOr
[
CmmMachOp
mo_wordShl
[
loadEra
,
CmmLit
(
mkInt
CLit
lDV_SHIFT
)
],
CmmMachOp
mo_wordShl
[
loadEra
,
mkInt
Expr
lDV_SHIFT
],
CmmLit
(
mkWordCLit
lDV_STATE_CREATE
)
]
...
...
compiler/codeGen/StgCmmBind.hs
View file @
de3a8f76
...
...
@@ -459,7 +459,7 @@ closureCodeBody top_lvl bndr cl_info cc args arity body fv_details
;
enterCostCentreFun
cc
(
CmmMachOp
mo_wordSub
[
CmmReg
nodeReg
,
CmmLit
(
mkInt
CLit
(
funTag
cl_info
)
)
])
,
mkInt
Expr
(
funTag
cl_info
)
])
;
whenC
node_points
(
ldvEnterClosure
cl_info
)
;
granYield
arg_regs
node_points
...
...
compiler/codeGen/StgCmmForeign.hs
View file @
de3a8f76
...
...
@@ -339,7 +339,7 @@ openNursery = catAGraphs [
(
CmmMachOp
mo_wordMul
[
CmmMachOp
(
MO_SS_Conv
W32
wordWidth
)
[
CmmLoad
nursery_bdescr_blocks
b32
],
CmmLit
(
mkInt
CLit
bLOCK_SIZE
)
mkInt
Expr
bLOCK_SIZE
])
(
-
1
)
)
...
...
compiler/codeGen/StgCmmHeap.hs
View file @
de3a8f76
...
...
@@ -559,7 +559,7 @@ do_checks checkStack alloc do_gc = do
-- with slop at the end of the current block, which can
-- confuse the LDV profiler.
where
alloc_lit
=
CmmLit
(
mkInt
CLit
(
alloc
*
wORD_SIZE
)
)
-- Bytes
alloc_lit
=
mkInt
Expr
(
alloc
*
wORD_SIZE
)
-- Bytes
bump_hp
=
cmmOffsetExprB
(
CmmReg
hpReg
)
alloc_lit
-- Sp overflow if (Sp - CmmHighStack < SpLim)
...
...
compiler/codeGen/StgCmmPrim.hs
View file @
de3a8f76
...
...
@@ -182,7 +182,7 @@ emitPrimOp [res_r,res_c] IntAddCOp [aa,bb]
CmmMachOp
mo_wordNot
[
CmmMachOp
mo_wordXor
[
aa
,
bb
]],
CmmMachOp
mo_wordXor
[
aa
,
CmmReg
(
CmmLocal
res_r
)]
],
CmmLit
(
mkInt
CLit
(
wORD_SIZE_IN_BITS
-
1
)
)
mkInt
Expr
(
wORD_SIZE_IN_BITS
-
1
)
]
]
...
...
@@ -205,7 +205,7 @@ emitPrimOp [res_r,res_c] IntSubCOp [aa,bb]
CmmMachOp
mo_wordXor
[
aa
,
bb
],
CmmMachOp
mo_wordXor
[
aa
,
CmmReg
(
CmmLocal
res_r
)]
],
CmmLit
(
mkInt
CLit
(
wORD_SIZE_IN_BITS
-
1
)
)
mkInt
Expr
(
wORD_SIZE_IN_BITS
-
1
)
]
]
...
...
@@ -913,7 +913,7 @@ doWritePtrArrayOp addr idx val
(
cmmOffsetExprW
(
cmmOffsetB
addr
(
arrPtrsHdrSize
dflags
))
(
loadArrPtrsSize
dflags
addr
))
(
CmmMachOp
mo_wordUShr
[
idx
,
CmmLit
(
mkInt
CLit
mUT_ARR_PTRS_CARD_BITS
)
])
mkInt
Expr
mUT_ARR_PTRS_CARD_BITS
])
)
(
CmmLit
(
CmmInt
1
W8
))
loadArrPtrsSize
::
DynFlags
->
CmmExpr
->
CmmExpr
...
...
@@ -963,7 +963,7 @@ doCopyByteArrayOp = emitCopyByteArray copy
-- Copy data (we assume the arrays aren't overlapping since
-- they're of different types)
copy
_src
_dst
dst_p
src_p
bytes
=
emitMemcpyCall
dst_p
src_p
bytes
(
CmmLit
(
mkInt
CLit
1
)
)
emitMemcpyCall
dst_p
src_p
bytes
(
mkInt
Expr
1
)
-- | Takes a source 'MutableByteArray#', an offset in the source
-- array, a destination 'MutableByteArray#', an offset into the
...
...
@@ -979,8 +979,8 @@ doCopyMutableByteArrayOp = emitCopyByteArray copy
-- TODO: Optimize branch for common case of no aliasing.
copy
src
dst
dst_p
src_p
bytes
=
do
[
moveCall
,
cpyCall
]
<-
forkAlts
[
getCode
$
emitMemmoveCall
dst_p
src_p
bytes
(
CmmLit
(
mkInt
CLit
1
)
)
,
getCode
$
emitMemcpyCall
dst_p
src_p
bytes
(
CmmLit
(
mkInt
CLit
1
)
)
getCode
$
emitMemmoveCall
dst_p
src_p
bytes
(
mkInt
Expr
1
),
getCode
$
emitMemcpyCall
dst_p
src_p
bytes
(
mkInt
Expr
1
)
]
emit
=<<
mkCmmIfThenElse
(
cmmEqWord
src
dst
)
moveCall
cpyCall
...
...
@@ -1005,7 +1005,7 @@ doSetByteArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
doSetByteArrayOp
ba
off
len
c
=
do
dflags
<-
getDynFlags
p
<-
assignTempE
$
cmmOffsetExpr
(
cmmOffsetB
ba
(
arrWordsHdrSize
dflags
))
off
emitMemsetCall
p
c
len
(
CmmLit
(
mkInt
CLit
1
)
)
emitMemsetCall
p
c
len
(
mkInt
Expr
1
)
-- ----------------------------------------------------------------------------
-- Copying pointer arrays
...
...
@@ -1035,7 +1035,7 @@ doCopyArrayOp = emitCopyArray copy
-- Copy data (we assume the arrays aren't overlapping since
-- they're of different types)
copy
_src
_dst
dst_p
src_p
bytes
=
emitMemcpyCall
dst_p
src_p
bytes
(
CmmLit
(
mkInt
CLit
wORD_SIZE
)
)
emitMemcpyCall
dst_p
src_p
bytes
(
mkInt
Expr
wORD_SIZE
)
-- | Takes a source 'MutableArray#', an offset in the source array, a
...
...
@@ -1051,8 +1051,8 @@ doCopyMutableArrayOp = emitCopyArray copy
-- TODO: Optimize branch for common case of no aliasing.
copy
src
dst
dst_p
src_p
bytes
=
do
[
moveCall
,
cpyCall
]
<-
forkAlts
[
getCode
$
emitMemmoveCall
dst_p
src_p
bytes
(
CmmLit
(
mkInt
CLit
wORD_SIZE
)
)
,
getCode
$
emitMemcpyCall
dst_p
src_p
bytes
(
CmmLit
(
mkInt
CLit
wORD_SIZE
)
)
getCode
$
emitMemmoveCall
dst_p
src_p
bytes
(
mkInt
Expr
wORD_SIZE
),
getCode
$
emitMemcpyCall
dst_p
src_p
bytes
(
mkInt
Expr
wORD_SIZE
)
]
emit
=<<
mkCmmIfThenElse
(
cmmEqWord
src
dst
)
moveCall
cpyCall
...
...
@@ -1075,7 +1075,7 @@ emitCopyArray copy src0 src_off0 dst0 dst_off0 n0 = do
dst_elems_p
<-
assignTempE
$
cmmOffsetB
dst
(
arrPtrsHdrSize
dflags
)
dst_p
<-
assignTempE
$
cmmOffsetExprW
dst_elems_p
dst_off
src_p
<-
assignTempE
$
cmmOffsetExprW
(
cmmOffsetB
src
(
arrPtrsHdrSize
dflags
))
src_off
bytes
<-
assignTempE
$
cmmMulWord
n
(
CmmLit
(
mkInt
CLit
wORD_SIZE
)
)
bytes
<-
assignTempE
$
cmmMulWord
n
(
mkInt
Expr
wORD_SIZE
)
copy
src
dst
dst_p
src_p
bytes
...
...
@@ -1103,8 +1103,8 @@ emitCloneArray info_p res_r src0 src_off0 n0 = do
arr_r
<-
newTemp
bWord
emitAllocateCall
arr_r
myCapability
words
tickyAllocPrim
(
CmmLit
(
mkInt
CLit
(
arrPtrsHdrSize
dflags
))
)
(
n
`
cmmMulWord
`
wordSize
)
(
CmmLit
$
mkIntCLit
0
)
tickyAllocPrim
(
mkInt
Expr
(
arrPtrsHdrSize
dflags
))
(
n
`
cmmMulWord
`
wordSize
)
zeroExpr
let
arr
=
CmmReg
(
CmmLocal
arr_r
)
emitSetDynHdr
arr
(
CmmLit
(
CmmLabel
info_p
))
curCCS
...
...
@@ -1117,18 +1117,17 @@ emitCloneArray info_p res_r src0 src_off0 n0 = do
src_p
<-
assignTempE
$
cmmOffsetExprW
(
cmmOffsetB
src
(
arrPtrsHdrSize
dflags
))
src_off
emitMemcpyCall
dst_p
src_p
(
n
`
cmmMulWord
`
wordSize
)
(
CmmLit
(
mkInt
CLit
wORD_SIZE
)
)
emitMemcpyCall
dst_p
src_p
(
n
`
cmmMulWord
`
wordSize
)
(
mkInt
Expr
wORD_SIZE
)
emitMemsetCall
(
cmmOffsetExprW
dst_p
n
)
(
CmmLit
(
mkInt
CLit
1
)
)
(
mkInt
Expr
1
)
card_bytes
(
CmmLit
(
mkInt
CLit
wORD_SIZE
)
)
(
mkInt
Expr
wORD_SIZE
)
emit
$
mkAssign
(
CmmLocal
res_r
)
arr
where
arrPtrsHdrSizeW
dflags
=
CmmLit
$
mkIntCLit
$
fixedHdrSize
dflags
+
(
sIZEOF_StgMutArrPtrs_NoHdr
`
div
`
wORD_SIZE
)
myCapability
=
CmmReg
baseReg
`
cmmSubWord
`
CmmLit
(
mkIntCLit
oFFSET_Capability_r
)
arrPtrsHdrSizeW
dflags
=
mkIntExpr
(
fixedHdrSize
dflags
+
(
sIZEOF_StgMutArrPtrs_NoHdr
`
div
`
wORD_SIZE
))
myCapability
=
CmmReg
baseReg
`
cmmSubWord
`
mkIntExpr
oFFSET_Capability_r
-- | Takes and offset in the destination array, the base address of
-- the card table, and the number of elements affected (*not* the
...
...
@@ -1137,24 +1136,24 @@ emitSetCards :: CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
emitSetCards
dst_start
dst_cards_start
n
=
do
start_card
<-
assignTempE
$
card
dst_start
emitMemsetCall
(
dst_cards_start
`
cmmAddWord
`
start_card
)
(
CmmLit
(
mkInt
CLit
1
)
)
(
mkInt
Expr
1
)
(
cardRoundUp
n
)
(
CmmLit
(
mkInt
CLit
1
)
)
-- no alignment (1 byte)
(
mkInt
Expr
1
)
-- no alignment (1 byte)
-- Convert an element index to a card index
card
::
CmmExpr
->
CmmExpr
card
i
=
i
`
cmmUShrWord
`
(
CmmLit
(
mkInt
CLit
mUT_ARR_PTRS_CARD_BITS
))
card
i
=
i
`
cmmUShrWord
`
mkInt
Expr
mUT_ARR_PTRS_CARD_BITS
-- Convert a number of elements to a number of cards, rounding up
cardRoundUp
::
CmmExpr
->
CmmExpr
cardRoundUp
i
=
card
(
i
`
cmmAddWord
`
(
CmmLit
(
mkInt
CLit
((
1
`
shiftL
`
mUT_ARR_PTRS_CARD_BITS
)
-
1
)))
)
cardRoundUp
i
=
card
(
i
`
cmmAddWord
`
(
mkInt
Expr
((
1
`
shiftL
`
mUT_ARR_PTRS_CARD_BITS
)
-
1
)))
bytesToWordsRoundUp
::
CmmExpr
->
CmmExpr
bytesToWordsRoundUp
e
=
(
e
`
cmmAddWord
`
CmmLit
(
mkInt
CLit
(
wORD_SIZE
-
1
))
)
bytesToWordsRoundUp
e
=
(
e
`
cmmAddWord
`
mkInt
Expr
(
wORD_SIZE
-
1
))
`
cmmQuotWord
`
wordSize
wordSize
::
CmmExpr
wordSize
=
CmmLit
(
mkInt
CLit
wORD_SIZE
)
wordSize
=
mkInt
Expr
wORD_SIZE
-- | Emit a call to @memcpy@.
emitMemcpyCall
::
CmmExpr
->
CmmExpr
->
CmmExpr
->
CmmExpr
->
FCode
()
...
...
compiler/codeGen/StgCmmProf.hs
View file @
de3a8f76
...
...
@@ -163,7 +163,7 @@ profDynAlloc :: SMRep -> CmmExpr -> FCode ()
profDynAlloc
rep
ccs
=
ifProfiling
$
do
dflags
<-
getDynFlags
profAlloc
(
CmmLit
(
mkInt
CLit
(
heapClosureSize
dflags
rep
))
)
ccs
profAlloc
(
mkInt
Expr
(
heapClosureSize
dflags
rep
))
ccs
-- | Record the allocation of a closure (size is given by a CmmExpr)
-- The size must be in words, because the allocation counter in a CCS counts
...
...
@@ -176,7 +176,7 @@ profAlloc words ccs
(
cmmOffsetB
ccs
oFFSET_CostCentreStack_mem_alloc
)
(
CmmMachOp
(
MO_UU_Conv
wordWidth
(
typeWidth
alloc_rep
))
$
[
CmmMachOp
mo_wordSub
[
words
,
CmmLit
(
mkInt
CLit
(
profHdrSize
dflags
)
)
]]))
mkInt
Expr
(
profHdrSize
dflags
)]]))
-- subtract the "profiling overhead", which is the
-- profiling header in a closure.
where
...
...
@@ -324,7 +324,7 @@ staticLdvInit = zeroCLit
dynLdvInit
::
CmmExpr
dynLdvInit
=
-- (era << LDV_SHIFT) | LDV_STATE_CREATE
CmmMachOp
mo_wordOr
[
CmmMachOp
mo_wordShl
[
loadEra
,
CmmLit
(
mkInt
CLit
lDV_SHIFT
)
],
CmmMachOp
mo_wordShl
[
loadEra
,
mkInt
Expr
lDV_SHIFT
],
CmmLit
(
mkWordCLit
lDV_STATE_CREATE
)
]
...
...
compiler/codeGen/StgCmmTicky.hs
View file @
de3a8f76
...
...
@@ -186,14 +186,14 @@ registerTickyCtr ctr_lbl
test
=
CmmMachOp
(
MO_Eq
wordWidth
)
[
CmmLoad
(
CmmLit
(
cmmLabelOffB
ctr_lbl
oFFSET_StgEntCounter_registeredp
))
bWord
,
CmmLit
(
mkIntCLit
0
)
]
zeroExpr
]
register_stmts
=
[
mkStore
(
CmmLit
(
cmmLabelOffB
ctr_lbl
oFFSET_StgEntCounter_link
))
(
CmmLoad
ticky_entry_ctrs
bWord
)
,
mkStore
ticky_entry_ctrs
(
mkLblExpr
ctr_lbl
)
,
mkStore
(
CmmLit
(
cmmLabelOffB
ctr_lbl
oFFSET_StgEntCounter_registeredp
))
(
CmmLit
(
mkInt
CLit
1
)
)
]
(
mkInt
Expr
1
)
]
ticky_entry_ctrs
=
mkLblExpr
(
mkCmmDataLabel
rtsPackageId
(
fsLit
"ticky_entry_ctrs"
))
tickyReturnOldCon
,
tickyReturnNewCon
::
RepArity
->
FCode
()
...
...
compiler/codeGen/StgCmmUtils.hs
View file @
de3a8f76
...
...
@@ -512,7 +512,7 @@ mk_switch _tag_expr [(_tag,lbl)] Nothing _ _ _
mk_switch
tag_expr
[(
tag
,
lbl
)]
(
Just
deflt
)
_
_
_
=
return
(
mkCbranch
cond
deflt
lbl
)
where
cond
=
cmmNeWord
tag_expr
(
CmmLit
(
mkInt
CLit
tag
)
)
cond
=
cmmNeWord
tag_expr
(
mkInt
Expr
tag
)
-- We have lo_tag < hi_tag, but there's only one branch,
-- so there must be a default
...
...
@@ -550,7 +550,7 @@ mk_switch tag_expr branches mb_deflt lo_tag hi_tag via_C
=
do
stmts
<-
mk_switch
tag_expr
branches
mb_deflt
lowest_branch
hi_tag
via_C
mkCmmIfThenElse
(
cmmULtWord
tag_expr
(
CmmLit
(
mkInt
CLit
lowest_branch
))
)
(
cmmULtWord
tag_expr
(
mkInt
Expr
lowest_branch
))
(
mkBranch
deflt
)
stmts
...
...
@@ -558,7 +558,7 @@ mk_switch tag_expr branches mb_deflt lo_tag hi_tag via_C
=
do
stmts
<-
mk_switch
tag_expr
branches
mb_deflt
lo_tag
highest_branch
via_C
mkCmmIfThenElse
(
cmmUGtWord
tag_expr
(
CmmLit
(
mkInt
CLit
highest_branch
))
)
(
cmmUGtWord
tag_expr
(
mkInt
Expr
highest_branch
))
(
mkBranch
deflt
)
stmts
...
...
@@ -568,7 +568,7 @@ mk_switch tag_expr branches mb_deflt lo_tag hi_tag via_C
hi_stmts
<-
mk_switch
tag_expr
hi_branches
mb_deflt
mid_tag
hi_tag
via_C
mkCmmIfThenElse
(
cmmUGeWord
tag_expr
(
CmmLit
(
mkInt
CLit
mid_tag
))
)
(
cmmUGeWord
tag_expr
(
mkInt
Expr
mid_tag
))
hi_stmts
lo_stmts
-- we test (e >= mid_tag) rather than (e < mid_tag), because
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment