Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
17910899
Commit
17910899
authored
Sep 16, 2012
by
ian@well-typed.com
Browse files
Move wORD_SIZE into platformConstants
parent
a62b56ef
Changes
63
Hide whitespace changes
Inline
Side-by-side
compiler/cmm/Bitmap.hs
View file @
17910899
...
...
@@ -24,7 +24,6 @@ module Bitmap (
#
include
"../includes/MachDeps.h"
import
SMRep
import
Constants
import
DynFlags
import
Util
...
...
@@ -84,9 +83,10 @@ possible, or fall back to an external pointer when the bitmap is too
large. This value represents the largest size of bitmap that can be
packed into a single word.
-}
mAX_SMALL_BITMAP_SIZE
::
Int
mAX_SMALL_BITMAP_SIZE
|
wORD_SIZE
==
4
=
27
|
otherwise
=
58
mAX_SMALL_BITMAP_SIZE
::
DynFlags
->
Int
mAX_SMALL_BITMAP_SIZE
dflags
|
wORD_SIZE
dflags
==
4
=
27
|
otherwise
=
58
seqBitmap
::
Bitmap
->
a
->
a
seqBitmap
=
seqList
...
...
compiler/cmm/CmmBuildInfoTables.hs
View file @
17910899
...
...
@@ -233,7 +233,7 @@ to_SRT dflags top_srt off len bmp
let
srt_desc_lbl
=
mkLargeSRTLabel
id
tbl
=
CmmData
RelocatableReadOnlyData
$
Statics
srt_desc_lbl
$
map
CmmStaticLit
(
cmmLabelOffW
top_srt
off
(
cmmLabelOffW
dflags
top_srt
off
:
mkWordCLit
dflags
(
fromIntegral
len
)
:
map
(
mkWordCLit
dflags
)
bmp
)
return
(
Just
tbl
,
C_SRT
srt_desc_lbl
0
srt_escape
)
...
...
compiler/cmm/CmmCallConv.hs
View file @
17910899
...
...
@@ -18,7 +18,6 @@ import SMRep
import
Cmm
(
Convention
(
..
))
import
PprCmm
()
import
Constants
import
qualified
Data.List
as
L
import
DynFlags
import
Outputable
...
...
@@ -92,7 +91,7 @@ assignArgumentsPos dflags conv arg_ty reps = assignments
assign_stk
_
assts
[]
=
assts
assign_stk
offset
assts
(
r
:
rs
)
=
assign_stk
off'
((
r
,
StackParam
off'
)
:
assts
)
rs
where
w
=
typeWidth
(
arg_ty
r
)
size
=
(((
widthInBytes
w
-
1
)
`
div
`
wORD_SIZE
)
+
1
)
*
wORD_SIZE
size
=
(((
widthInBytes
w
-
1
)
`
div
`
wORD_SIZE
dflags
)
+
1
)
*
wORD_SIZE
dflags
off'
=
offset
+
size
-----------------------------------------------------------------------------
...
...
compiler/cmm/CmmInfo.hs
View file @
17910899
...
...
@@ -173,7 +173,7 @@ mkInfoTableContents dflags
|
StackRep
frame
<-
smrep
=
do
{
(
prof_lits
,
prof_data
)
<-
mkProfLits
dflags
prof
;
let
(
srt_label
,
srt_bitmap
)
=
mkSRTLit
srt
;
let
(
srt_label
,
srt_bitmap
)
=
mkSRTLit
dflags
srt
;
(
liveness_lit
,
liveness_data
)
<-
mkLivenessBits
dflags
frame
;
let
std_info
=
mkStdInfoTable
dflags
prof_lits
rts_tag
srt_bitmap
liveness_lit
...
...
@@ -186,7 +186,7 @@ mkInfoTableContents dflags
|
HeapRep
_
ptrs
nonptrs
closure_type
<-
smrep
=
do
{
let
layout
=
packHalfWordsCLit
dflags
ptrs
nonptrs
;
(
prof_lits
,
prof_data
)
<-
mkProfLits
dflags
prof
;
let
(
srt_label
,
srt_bitmap
)
=
mkSRTLit
srt
;
let
(
srt_label
,
srt_bitmap
)
=
mkSRTLit
dflags
srt
;
(
mb_srt_field
,
mb_layout
,
extra_bits
,
ct_data
)
<-
mk_pieces
closure_type
srt_label
;
let
std_info
=
mkStdInfoTable
dflags
prof_lits
...
...
@@ -233,11 +233,12 @@ mkInfoTableContents dflags
mkInfoTableContents
_
_
_
=
panic
"mkInfoTableContents"
-- NonInfoTable dealt with earlier
mkSRTLit
::
C_SRT
mkSRTLit
::
DynFlags
->
C_SRT
->
([
CmmLit
],
-- srt_label, if any
StgHalfWord
)
-- srt_bitmap
mkSRTLit
NoC_SRT
=
(
[]
,
0
)
mkSRTLit
(
C_SRT
lbl
off
bitmap
)
=
([
cmmLabelOffW
lbl
off
],
bitmap
)
mkSRTLit
_
NoC_SRT
=
(
[]
,
0
)
mkSRTLit
dflags
(
C_SRT
lbl
off
bitmap
)
=
([
cmmLabelOffW
dflags
lbl
off
],
bitmap
)
-------------------------------------------------------------------------
...
...
@@ -303,7 +304,7 @@ mkLivenessBits :: DynFlags -> Liveness -> UniqSM (CmmLit, [RawCmmDecl])
-- 2. Large bitmap CmmData if needed
mkLivenessBits
dflags
liveness
|
n_bits
>
mAX_SMALL_BITMAP_SIZE
-- does not fit in one word
|
n_bits
>
mAX_SMALL_BITMAP_SIZE
dflags
-- does not fit in one word
=
do
{
uniq
<-
getUniqueUs
;
let
bitmap_lbl
=
mkBitmapLabel
uniq
;
return
(
CmmLabel
bitmap_lbl
,
...
...
compiler/cmm/CmmLayoutStack.hs
View file @
17910899
...
...
@@ -17,7 +17,6 @@ import CmmLive
import
CmmProcPoint
import
SMRep
import
Hoopl
import
Constants
import
UniqSupply
import
Maybes
import
UniqFM
...
...
@@ -345,7 +344,7 @@ handleLastNode dflags procpoints liveness cont_info stackmaps
return
$
lastCall
cont_lbl
cml_args
cml_ret_args
cml_ret_off
CmmForeignCall
{
succ
=
cont_lbl
,
..
}
->
do
return
$
lastCall
cont_lbl
wORD_SIZE
wORD_SIZE
(
sm_ret_off
stack0
)
return
$
lastCall
cont_lbl
(
wORD_SIZE
dflags
)
(
wORD_SIZE
dflags
)
(
sm_ret_off
stack0
)
-- one word each for args and results: the return address
CmmBranch
{
..
}
->
handleBranches
...
...
@@ -381,7 +380,7 @@ handleLastNode dflags procpoints liveness cont_info stackmaps
=
(
save_assignments
,
new_cont_stack
)
where
(
new_cont_stack
,
save_assignments
)
=
setupStackFrame
lbl
liveness
cml_ret_off
cml_ret_args
stack0
=
setupStackFrame
dflags
lbl
liveness
cml_ret_off
cml_ret_args
stack0
-- For other last nodes (branches), if any of the targets is a
...
...
@@ -404,7 +403,7 @@ handleLastNode dflags procpoints liveness cont_info stackmaps
out
=
mapFromList
[
(
l'
,
cont_stack
)
|
l'
<-
successors
last
]
return
(
assigs
,
spOffsetForCall
sp0
cont_stack
wORD_SIZE
,
spOffsetForCall
sp0
cont_stack
(
wORD_SIZE
dflags
)
,
last
,
[]
,
out
)
...
...
@@ -440,7 +439,7 @@ handleLastNode dflags procpoints liveness cont_info stackmaps
(
stack2
,
assigs
)
=
--pprTrace "first visit to proc point"
-- (ppr l <+> ppr stack1) $
setupStackFrame
l
liveness
(
sm_ret_off
stack0
)
setupStackFrame
dflags
l
liveness
(
sm_ret_off
stack0
)
cont_args
stack0
--
(
tmp_lbl
,
block
)
<-
makeFixupBlock
dflags
sp0
l
stack2
assigs
...
...
@@ -496,14 +495,15 @@ fixupStack old_stack new_stack = concatMap move new_locs
setupStackFrame
::
BlockId
-- label of continuation
::
DynFlags
->
BlockId
-- label of continuation
->
BlockEnv
CmmLive
-- liveness
->
ByteOff
-- updfr
->
ByteOff
-- bytes of return values on stack
->
StackMap
-- current StackMap
->
(
StackMap
,
[
CmmNode
O
O
])
setupStackFrame
lbl
liveness
updfr_off
ret_args
stack0
setupStackFrame
dflags
lbl
liveness
updfr_off
ret_args
stack0
=
(
cont_stack
,
assignments
)
where
-- get the set of LocalRegs live in the continuation
...
...
@@ -519,7 +519,7 @@ setupStackFrame lbl liveness updfr_off ret_args stack0
-- everything up to updfr_off is off-limits
-- stack1 contains updfr_off, plus everything we need to save
(
stack1
,
assignments
)
=
allocate
updfr_off
live
stack0
(
stack1
,
assignments
)
=
allocate
dflags
updfr_off
live
stack0
-- And the Sp at the continuation is:
-- sm_sp stack1 + ret_args
...
...
@@ -600,9 +600,10 @@ futureContinuation middle = foldBlockNodesB f middle Nothing
-- on the stack and return the new StackMap and the assignments to do
-- the saving.
--
allocate
::
ByteOff
->
RegSet
->
StackMap
->
(
StackMap
,
[
CmmNode
O
O
])
allocate
ret_off
live
stackmap
@
StackMap
{
sm_sp
=
sp0
,
sm_regs
=
regs0
}
allocate
::
DynFlags
->
ByteOff
->
RegSet
->
StackMap
->
(
StackMap
,
[
CmmNode
O
O
])
allocate
dflags
ret_off
live
stackmap
@
StackMap
{
sm_sp
=
sp0
,
sm_regs
=
regs0
}
=
-- pprTrace "allocate" (ppr live $$ ppr stackmap) $
...
...
@@ -613,37 +614,37 @@ allocate ret_off live stackmap@StackMap{ sm_sp = sp0
-- make a map of the stack
let
stack
=
reverse
$
Array
.
elems
$
accumArray
(
\
_
x
->
x
)
Empty
(
1
,
toWords
(
max
sp0
ret_off
))
$
accumArray
(
\
_
x
->
x
)
Empty
(
1
,
toWords
dflags
(
max
sp0
ret_off
))
$
ret_words
++
live_words
where
ret_words
=
[
(
x
,
Occupied
)
|
x
<-
[
1
..
toWords
ret_off
]
]
|
x
<-
[
1
..
toWords
dflags
ret_off
]
]
live_words
=
[
(
toWords
x
,
Occupied
)
[
(
toWords
dflags
x
,
Occupied
)
|
(
r
,
off
)
<-
eltsUFM
regs1
,
let
w
=
localRegBytes
r
,
x
<-
[
off
,
off
-
wORD_SIZE
..
off
-
w
+
1
]
]
let
w
=
localRegBytes
dflags
r
,
x
<-
[
off
,
off
-
wORD_SIZE
dflags
..
off
-
w
+
1
]
]
in
-- Pass over the stack: find slots to save all the new live variables,
-- choosing the oldest slots first (hence a foldr).
let
save
slot
(
[]
,
stack
,
n
,
assigs
,
regs
)
-- no more regs to save
=
(
[]
,
slot
:
stack
,
n
`
plusW
`
1
,
assigs
,
regs
)
=
(
[]
,
slot
:
stack
,
plusW
dflags
n
1
,
assigs
,
regs
)
save
slot
(
to_save
,
stack
,
n
,
assigs
,
regs
)
=
case
slot
of
Occupied
->
(
to_save
,
Occupied
:
stack
,
n
`
plusW
`
1
,
assigs
,
regs
)
Occupied
->
(
to_save
,
Occupied
:
stack
,
plusW
dflags
n
1
,
assigs
,
regs
)
Empty
|
Just
(
stack'
,
r
,
to_save'
)
<-
select_save
to_save
(
slot
:
stack
)
->
let
assig
=
CmmStore
(
CmmStackSlot
Old
n'
)
(
CmmReg
(
CmmLocal
r
))
n'
=
n
`
plusW
`
1
n'
=
plusW
dflags
n
1
in
(
to_save'
,
stack'
,
n'
,
assig
:
assigs
,
(
r
,(
r
,
n'
))
:
regs
)
|
otherwise
->
(
to_save
,
slot
:
stack
,
n
`
plusW
`
1
,
assigs
,
regs
)
->
(
to_save
,
slot
:
stack
,
plusW
dflags
n
1
,
assigs
,
regs
)
-- we should do better here: right now we'll fit the smallest first,
-- but it would make more sense to fit the biggest first.
...
...
@@ -656,7 +657,7 @@ allocate ret_off live stackmap@StackMap{ sm_sp = sp0
=
Just
(
replicate
words
Occupied
++
rest
,
r
,
rs
++
no_fit
)
|
otherwise
=
go
rs
(
r
:
no_fit
)
where
words
=
localRegWords
r
where
words
=
localRegWords
dflags
r
-- fill in empty slots as much as possible
(
still_to_save
,
save_stack
,
n
,
save_assigs
,
save_regs
)
...
...
@@ -669,14 +670,14 @@ allocate ret_off live stackmap@StackMap{ sm_sp = sp0
push
r
(
n
,
assigs
,
regs
)
=
(
n'
,
assig
:
assigs
,
(
r
,(
r
,
n'
))
:
regs
)
where
n'
=
n
+
localRegBytes
r
n'
=
n
+
localRegBytes
dflags
r
assig
=
CmmStore
(
CmmStackSlot
Old
n'
)
(
CmmReg
(
CmmLocal
r
))
trim_sp
|
not
(
null
push_regs
)
=
push_sp
|
otherwise
=
n
`
plusW
`
(
-
length
(
takeWhile
isEmpty
save_stack
))
=
plusW
dflags
n
(
-
length
(
takeWhile
isEmpty
save_stack
))
final_regs
=
regs1
`
addListToUFM
`
push_regs
`
addListToUFM
`
save_regs
...
...
@@ -685,7 +686,7 @@ allocate ret_off live stackmap@StackMap{ sm_sp = sp0
-- XXX should be an assert
if
(
n
/=
max
sp0
ret_off
)
then
pprPanic
"allocate"
(
ppr
n
<+>
ppr
sp0
<+>
ppr
ret_off
)
else
if
(
trim_sp
.&.
(
wORD_SIZE
-
1
))
/=
0
then
pprPanic
"allocate2"
(
ppr
trim_sp
<+>
ppr
final_regs
<+>
ppr
push_sp
)
else
if
(
trim_sp
.&.
(
wORD_SIZE
dflags
-
1
))
/=
0
then
pprPanic
"allocate2"
(
ppr
trim_sp
<+>
ppr
final_regs
<+>
ppr
push_sp
)
else
(
stackmap
{
sm_regs
=
final_regs
,
sm_sp
=
trim_sp
}
,
push_assigs
++
save_assigs
)
...
...
@@ -843,8 +844,8 @@ elimStackStores stackmap stackmaps area_off nodes
-- Update info tables to include stack liveness
setInfoTableStackMap
::
BlockEnv
StackMap
->
CmmDecl
->
CmmDecl
setInfoTableStackMap
stackmaps
(
CmmProc
top_info
@
TopInfo
{
..
}
l
g
)
setInfoTableStackMap
::
DynFlags
->
BlockEnv
StackMap
->
CmmDecl
->
CmmDecl
setInfoTableStackMap
dflags
stackmaps
(
CmmProc
top_info
@
TopInfo
{
..
}
l
g
)
=
CmmProc
top_info
{
info_tbls
=
mapMapWithKey
fix_info
info_tbls
}
l
g
where
fix_info
lbl
info_tbl
@
CmmInfoTable
{
cit_rep
=
StackRep
_
}
=
...
...
@@ -855,18 +856,18 @@ setInfoTableStackMap stackmaps (CmmProc top_info@TopInfo{..} l g)
get_liveness
lbl
=
case
mapLookup
lbl
stackmaps
of
Nothing
->
pprPanic
"setInfoTableStackMap"
(
ppr
lbl
<+>
ppr
info_tbls
)
Just
sm
->
stackMapToLiveness
sm
Just
sm
->
stackMapToLiveness
dflags
sm
setInfoTableStackMap
_
d
=
d
setInfoTableStackMap
_
_
d
=
d
stackMapToLiveness
::
StackMap
->
Liveness
stackMapToLiveness
StackMap
{
..
}
=
stackMapToLiveness
::
DynFlags
->
StackMap
->
Liveness
stackMapToLiveness
dflags
StackMap
{
..
}
=
reverse
$
Array
.
elems
$
accumArray
(
\
_
x
->
x
)
True
(
toWords
sm_ret_off
+
1
,
toWords
(
sm_sp
-
sm_args
))
live_words
accumArray
(
\
_
x
->
x
)
True
(
toWords
dflags
sm_ret_off
+
1
,
toWords
dflags
(
sm_sp
-
sm_args
))
live_words
where
live_words
=
[
(
toWords
off
,
False
)
live_words
=
[
(
toWords
dflags
off
,
False
)
|
(
r
,
off
)
<-
eltsUFM
sm_regs
,
isGcPtrType
(
localRegType
r
)
]
...
...
@@ -982,8 +983,8 @@ callResumeThread new_base id =
-- -----------------------------------------------------------------------------
plusW
::
ByteOff
->
WordOff
->
ByteOff
plusW
b
w
=
b
+
w
*
wORD_SIZE
plusW
::
DynFlags
->
ByteOff
->
WordOff
->
ByteOff
plusW
dflags
b
w
=
b
+
w
*
wORD_SIZE
dflags
dropEmpty
::
WordOff
->
[
StackSlot
]
->
Maybe
[
StackSlot
]
dropEmpty
0
ss
=
Just
ss
...
...
@@ -994,14 +995,15 @@ isEmpty :: StackSlot -> Bool
isEmpty
Empty
=
True
isEmpty
_
=
False
localRegBytes
::
LocalReg
->
ByteOff
localRegBytes
r
=
roundUpToWords
(
widthInBytes
(
typeWidth
(
localRegType
r
)))
localRegBytes
::
DynFlags
->
LocalReg
->
ByteOff
localRegBytes
dflags
r
=
roundUpToWords
dflags
(
widthInBytes
(
typeWidth
(
localRegType
r
)))
localRegWords
::
LocalReg
->
WordOff
localRegWords
=
toWords
.
localRegBytes
localRegWords
::
DynFlags
->
LocalReg
->
WordOff
localRegWords
dflags
=
toWords
dflags
.
localRegBytes
dflags
toWords
::
ByteOff
->
WordOff
toWords
x
=
x
`
quot
`
wORD_SIZE
toWords
::
DynFlags
->
ByteOff
->
WordOff
toWords
dflags
x
=
x
`
quot
`
wORD_SIZE
dflags
insertReloads
::
StackMap
->
[
CmmNode
O
O
]
...
...
compiler/cmm/CmmLint.hs
View file @
17910899
...
...
@@ -18,7 +18,6 @@ import PprCmm ()
import
BlockId
import
FastString
import
Outputable
import
Constants
import
DynFlags
import
Data.Maybe
...
...
@@ -108,6 +107,7 @@ cmmCheckMachOp op _ tys
=
do
dflags
<-
getDynFlags
return
(
machOpResultType
dflags
op
tys
)
{-
isOffsetOp :: MachOp -> Bool
isOffsetOp (MO_Add _) = True
isOffsetOp (MO_Sub _) = True
...
...
@@ -117,10 +117,10 @@ isOffsetOp _ = False
-- check for funny-looking sub-word offsets.
_cmmCheckWordAddress :: CmmExpr -> CmmLint ()
_cmmCheckWordAddress e@(CmmMachOp op [arg, CmmLit (CmmInt i _)])
|
isOffsetOp
op
&&
notNodeReg
arg
&&
i
`
rem
`
fromIntegral
wORD_SIZE
/=
0
| isOffsetOp op && notNodeReg arg && i `rem` fromIntegral
(
wORD_SIZE
dflags)
/= 0
= cmmLintDubiousWordOffset e
_cmmCheckWordAddress e@(CmmMachOp op [CmmLit (CmmInt i _), arg])
|
isOffsetOp
op
&&
notNodeReg
arg
&&
i
`
rem
`
fromIntegral
wORD_SIZE
/=
0
| isOffsetOp op && notNodeReg arg && i `rem` fromIntegral
(
wORD_SIZE
dflags)
/= 0
= cmmLintDubiousWordOffset e
_cmmCheckWordAddress _
= return ()
...
...
@@ -130,6 +130,7 @@ _cmmCheckWordAddress _
notNodeReg :: CmmExpr -> Bool
notNodeReg (CmmReg reg) | reg == nodeReg = False
notNodeReg _ = True
-}
lintCmmMiddle
::
CmmNode
O
O
->
CmmLint
()
lintCmmMiddle
node
=
case
node
of
...
...
@@ -239,7 +240,10 @@ cmmLintAssignErr stmt e_ty r_ty
text
"Rhs ty:"
<+>
ppr
e_ty
]))
{-
cmmLintDubiousWordOffset :: CmmExpr -> CmmLint a
cmmLintDubiousWordOffset expr
= cmmLintErr (text "offset is not a multiple of words: " $$
nest 2 (ppr expr))
-}
compiler/cmm/CmmParse.y
View file @
17910899
...
...
@@ -340,9 +340,10 @@ info :: { ExtFCode (CLabel, CmmInfoTable, [Maybe LocalReg]) }
| 'INFO_TABLE_RET' '(' NAME ',' INT ',' formals_without_hints0 ')'
-- closure type, live regs
{% withThisPackage $ \pkg ->
do live <- sequence (map (liftM Just) $7)
do dflags <- getDynFlags
live <- sequence (map (liftM Just) $7)
let prof = NoProfilingInfo
bitmap = mkLiveness live
bitmap = mkLiveness
dflags
live
rep = mkRTSRep (fromIntegral $5) $ mkStackRep bitmap
return (mkCmmRetLabel pkg $3,
CmmInfoTable { cit_lbl = mkCmmInfoLabel pkg $3
...
...
@@ -888,7 +889,7 @@ adjCallTarget :: DynFlags -> CCallConv -> CmmExpr -> [CmmHinted CmmExpr]
adjCallTarget dflags StdCallConv (CmmLit (CmmLabel lbl)) args
| platformOS (targetPlatform dflags) == OSMinGW32
= CmmLit (CmmLabel (addLabelSize lbl (sum (map size args))))
where size (CmmHinted e _) = max wORD_SIZE (widthInBytes (typeWidth (cmmExprType dflags e)))
where size (CmmHinted e _) = max
(
wORD_SIZE
dflags)
(widthInBytes (typeWidth (cmmExprType dflags e)))
-- c.f. CgForeignCall.emitForeignCall
adjCallTarget _ _ expr _
= expr
...
...
@@ -943,8 +944,8 @@ emitRetUT args = do
emitSimultaneously stmts -- NB. the args might overlap with the stack slots
-- or regs that we assign to, so better use
-- simultaneous assignments here (#3546)
when (sp /= 0) $ stmtC (CmmAssign spReg (cmmRegOffW spReg (-sp)))
stmtC $ CmmJump (entryCode dflags (CmmLoad (cmmRegOffW spReg sp) (bWord dflags))) (Just live)
when (sp /= 0) $ stmtC (CmmAssign spReg (cmmRegOffW
dflags
spReg (-sp)))
stmtC $ CmmJump (entryCode dflags (CmmLoad (cmmRegOffW
dflags
spReg sp) (bWord dflags))) (Just live)
-- -----------------------------------------------------------------------------
-- If-then-else and boolean expressions
...
...
@@ -1053,7 +1054,7 @@ doSwitch mb_range scrut arms deflt
initEnv :: DynFlags -> Env
initEnv dflags = listToUFM [
( fsLit "SIZEOF_StgHeader",
VarN (CmmLit (CmmInt (fromIntegral (fixedHdrSize dflags * wORD_SIZE)) (wordWidth dflags)) )),
VarN (CmmLit (CmmInt (fromIntegral (fixedHdrSize dflags * wORD_SIZE
dflags
)) (wordWidth dflags)) )),
( fsLit "SIZEOF_StgInfoTable",
VarN (CmmLit (CmmInt (fromIntegral (stdInfoTableSizeB dflags)) (wordWidth dflags)) ))
]
...
...
compiler/cmm/CmmPipeline.hs
View file @
17910899
...
...
@@ -119,7 +119,7 @@ cpsTop hsc_env (CmmProc h@(TopInfo {stack_info=StackInfo {arg_space=entry_off}})
------------- Populate info tables with stack info -----------------
gs
<-
{-# SCC "setInfoTableStackMap" #-}
return
$
map
(
setInfoTableStackMap
stackmaps
)
gs
return
$
map
(
setInfoTableStackMap
dflags
stackmaps
)
gs
dumps
Opt_D_dump_cmmz_info
"after setInfoTableStackMap"
gs
----------- Control-flow optimisations -----------------------------
...
...
@@ -137,7 +137,7 @@ cpsTop hsc_env (CmmProc h@(TopInfo {stack_info=StackInfo {arg_space=entry_off}})
------------- Populate info tables with stack info -----------------
g
<-
{-# SCC "setInfoTableStackMap" #-}
return
$
setInfoTableStackMap
stackmaps
g
return
$
setInfoTableStackMap
dflags
stackmaps
g
dump'
Opt_D_dump_cmmz_info
"after setInfoTableStackMap"
g
----------- Control-flow optimisations -----------------------------
...
...
compiler/cmm/CmmType.hs
View file @
17910899
...
...
@@ -17,7 +17,6 @@ where
#
include
"HsVersions.h"
import
Constants
import
DynFlags
import
FastString
import
Outputable
...
...
@@ -161,22 +160,22 @@ mrStr W80 = sLit("W80")
-------- Common Widths ------------
wordWidth
::
DynFlags
->
Width
wordWidth
_
|
wORD_SIZE
==
4
=
W32
|
wORD_SIZE
==
8
=
W64
|
otherwise
=
panic
"MachOp.wordRep: Unknown word size"
wordWidth
dflags
|
wORD_SIZE
dflags
==
4
=
W32
|
wORD_SIZE
dflags
==
8
=
W64
|
otherwise
=
panic
"MachOp.wordRep: Unknown word size"
halfWordWidth
::
DynFlags
->
Width
halfWordWidth
_
|
wORD_SIZE
==
4
=
W16
|
wORD_SIZE
==
8
=
W32
|
otherwise
=
panic
"MachOp.halfWordRep: Unknown word size"
halfWordWidth
dflags
|
wORD_SIZE
dflags
==
4
=
W16
|
wORD_SIZE
dflags
==
8
=
W32
|
otherwise
=
panic
"MachOp.halfWordRep: Unknown word size"
halfWordMask
::
DynFlags
->
Integer
halfWordMask
_
|
wORD_SIZE
==
4
=
0xFFFF
|
wORD_SIZE
==
8
=
0xFFFFFFFF
|
otherwise
=
panic
"MachOp.halfWordMask: Unknown word size"
halfWordMask
dflags
|
wORD_SIZE
dflags
==
4
=
0xFFFF
|
wORD_SIZE
dflags
==
8
=
0xFFFFFFFF
|
otherwise
=
panic
"MachOp.halfWordMask: Unknown word size"
-- cIntRep is the Width for a C-language 'int'
cIntWidth
,
cLongWidth
::
Width
...
...
compiler/cmm/CmmUtils.hs
View file @
17910899
...
...
@@ -72,7 +72,7 @@ import CLabel
import
Outputable
import
Unique
import
UniqSupply
import
Constants
(
wORD_SIZE
,
tAG_MASK
)
import
Constants
(
tAG_MASK
)
import
DynFlags
import
Util
...
...
@@ -272,16 +272,16 @@ cmmOffsetExprW dflags e (CmmLit (CmmInt n _)) = cmmOffsetW dflags e (fromIntege
cmmOffsetExprW
dflags
e
wd_off
=
cmmIndexExpr
dflags
(
wordWidth
dflags
)
e
wd_off
cmmOffsetW
::
DynFlags
->
CmmExpr
->
WordOff
->
CmmExpr
cmmOffsetW
dflags
e
n
=
cmmOffsetB
dflags
e
(
wORD_SIZE
*
n
)
cmmOffsetW
dflags
e
n
=
cmmOffsetB
dflags
e
(
wORD_SIZE
dflags
*
n
)
cmmRegOffW
::
CmmReg
->
WordOff
->
CmmExpr
cmmRegOffW
reg
wd_off
=
cmmRegOffB
reg
(
wd_off
*
wORD_SIZE
)
cmmRegOffW
::
DynFlags
->
CmmReg
->
WordOff
->
CmmExpr
cmmRegOffW
dflags
reg
wd_off
=
cmmRegOffB
reg
(
wd_off
*
wORD_SIZE
dflags
)
cmmOffsetLitW
::
CmmLit
->
WordOff
->
CmmLit
cmmOffsetLitW
lit
wd_off
=
cmmOffsetLitB
lit
(
wORD_SIZE
*
wd_off
)
cmmOffsetLitW
::
DynFlags
->
CmmLit
->
WordOff
->
CmmLit
cmmOffsetLitW
dflags
lit
wd_off
=
cmmOffsetLitB
lit
(
wORD_SIZE
dflags
*
wd_off
)
cmmLabelOffW
::
CLabel
->
WordOff
->
CmmLit
cmmLabelOffW
lbl
wd_off
=
cmmLabelOffB
lbl
(
wORD_SIZE
*
wd_off
)
cmmLabelOffW
::
DynFlags
->
CLabel
->
WordOff
->
CmmLit
cmmLabelOffW
dflags
lbl
wd_off
=
cmmLabelOffB
lbl
(
wORD_SIZE
dflags
*
wd_off
)
cmmLoadIndexW
::
DynFlags
->
CmmExpr
->
Int
->
CmmType
->
CmmExpr
cmmLoadIndexW
dflags
base
off
ty
=
CmmLoad
(
cmmOffsetW
dflags
base
off
)
ty
...
...
@@ -309,8 +309,8 @@ cmmNegate :: DynFlags -> CmmExpr -> CmmExpr
cmmNegate
_
(
CmmLit
(
CmmInt
n
rep
))
=
CmmLit
(
CmmInt
(
-
n
)
rep
)
cmmNegate
dflags
e
=
CmmMachOp
(
MO_S_Neg
(
cmmExprWidth
dflags
e
))
[
e
]
blankWord
::
CmmStatic
blankWord
=
CmmUninitialised
wORD_SIZE
blankWord
::
DynFlags
->
CmmStatic
blankWord
dflags
=
CmmUninitialised
(
wORD_SIZE
dflags
)
---------------------------------------------------
--
...
...
@@ -371,15 +371,15 @@ cmmConstrTag1 dflags e = cmmAndWord dflags e (cmmTagMask dflags)
--
---------------------------------------------
mkLiveness
::
[
Maybe
LocalReg
]
->
Liveness
mkLiveness
[]
=
[]
mkLiveness
(
reg
:
regs
)
=
take
sizeW
bits
++
mkLiveness
regs
mkLiveness
::
DynFlags
->
[
Maybe
LocalReg
]
->
Liveness
mkLiveness
_
[]
=
[]
mkLiveness
dflags
(
reg
:
regs
)
=
take
sizeW
bits
++
mkLiveness
dflags
regs
where
sizeW
=
case
reg
of
Nothing
->
1
Just
r
->
(
widthInBytes
(
typeWidth
(
localRegType
r
))
+
wORD_SIZE
-
1
)
`
quot
`
wORD_SIZE
Just
r
->
(
widthInBytes
(
typeWidth
(
localRegType
r
))
+
wORD_SIZE
dflags
-
1
)
`
quot
`
wORD_SIZE
dflags
-- number of words, rounded up
bits
=
repeat
$
is_non_ptr
reg
-- True <=> Non Ptr
...
...
compiler/cmm/OldCmmLint.hs
View file @
17910899
...
...
@@ -22,7 +22,6 @@ import OldCmm
import
CLabel
import
Outputable
import
OldPprCmm
()
import
Constants
import
FastString
import
DynFlags
...
...
@@ -97,6 +96,7 @@ cmmCheckMachOp dflags op [lit@(CmmLit (CmmInt { })), reg@(CmmReg _)] tys
cmmCheckMachOp
dflags
op
_
tys
=
return
(
machOpResultType
dflags
op
tys
)
{-
isOffsetOp :: MachOp -> Bool
isOffsetOp (MO_Add _) = True
isOffsetOp (MO_Sub _) = True
...
...
@@ -106,10 +106,10 @@ isOffsetOp _ = False
-- check for funny-looking sub-word offsets.
_cmmCheckWordAddress :: CmmExpr -> CmmLint ()
_cmmCheckWordAddress e@(CmmMachOp op [arg, CmmLit (CmmInt i _)])
|
isOffsetOp
op
&&
notNodeReg
arg
&&
i
`
rem
`
fromIntegral
wORD_SIZE
/=
0
| isOffsetOp op && notNodeReg arg && i `rem` fromIntegral
(
wORD_SIZE
dflags)
/= 0
= cmmLintDubiousWordOffset e
_cmmCheckWordAddress e@(CmmMachOp op [CmmLit (CmmInt i _), arg])
|
isOffsetOp
op
&&
notNodeReg
arg
&&
i
`
rem
`
fromIntegral
wORD_SIZE
/=
0
| isOffsetOp op && notNodeReg arg && i `rem` fromIntegral
(
wORD_SIZE
dflags)
/= 0
= cmmLintDubiousWordOffset e
_cmmCheckWordAddress _
= return ()
...
...
@@ -119,6 +119,7 @@ _cmmCheckWordAddress _
notNodeReg :: CmmExpr -> Bool
notNodeReg (CmmReg reg) | reg == nodeReg = False
notNodeReg _ = True
-}
lintCmmStmt
::
DynFlags
->
BlockSet
->
CmmStmt
->
CmmLint
()
lintCmmStmt
dflags
labels
=
lint
...
...
@@ -204,7 +205,10 @@ cmmLintAssignErr stmt e_ty r_ty
{-
cmmLintDubiousWordOffset :: CmmExpr -> CmmLint a
cmmLintDubiousWordOffset expr
= cmmLintErr (text "offset is not a multiple of words: " $$
nest 2 (ppr expr))
-}
compiler/cmm/PprC.hs
View file @
17910899
...
...
@@ -374,7 +374,7 @@ pprLoad dflags e ty
->
char
'*'
<>
pprAsPtrReg
r
CmmRegOff
r
off
|
isPtrReg
r
&&
width
==
wordWidth
dflags
,
off
`
rem
`
wORD_SIZE
==
0
&&
not
(
isFloatType
ty
)
,
off
`
rem
`
wORD_SIZE
dflags
==
0
&&
not
(
isFloatType
ty
)
-- ToDo: check that the offset is a word multiple?
-- (For tagging to work, I had to avoid unaligned loads. --ARY)
->
pprAsPtrReg
r
<>
brackets
(
ppr
(
off
`
shiftR
`
wordShift
dflags
))
...
...
@@ -480,9 +480,9 @@ pprStatics :: DynFlags -> [CmmStatic] -> [SDoc]
pprStatics
_
[]
=
[]
pprStatics
dflags
(
CmmStaticLit
(
CmmFloat
f
W32
)
:
rest
)
-- floats are padded to a word, see #1852
|
wORD_SIZE
==
8
,
CmmStaticLit
(
CmmInt
0
W32
)
:
rest'
<-
rest
|
wORD_SIZE
dflags
==
8
,
CmmStaticLit
(
CmmInt
0
W32
)
:
rest'
<-
rest
=
pprLit1
(
floatToWord
dflags
f
)
:
pprStatics
dflags
rest'
|
wORD_SIZE
==
4
|
wORD_SIZE
dflags
==
4
=
pprLit1
(
floatToWord
dflags
f
)
:
pprStatics
dflags
rest
|
otherwise
=
pprPanic
"pprStatics: float"
(
vcat
(
map
ppr'
rest
))
...
...
@@ -721,7 +721,7 @@ pprAssign _ r1 (CmmReg r2)
-- dest is a reg, rhs is a CmmRegOff
pprAssign
dflags
r1
(
CmmRegOff
r2
off
)
|
isPtrReg
r1
&&
isPtrReg
r2
&&
(
off
`
rem
`
wORD_SIZE
==
0
)
|
isPtrReg
r1
&&
isPtrReg
r2
&&
(
off
`
rem
`
wORD_SIZE
dflags
==
0
)
=
hcat
[
pprAsPtrReg
r1
,
equals
,
pprAsPtrReg
r2
,
op
,
int
off'
,
semi