Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
GHC
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Locked Files
Issues
0
Issues
0
List
Boards
Labels
Service Desk
Milestones
Iterations
Merge Requests
0
Merge Requests
0
Requirements
Requirements
List
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Security & Compliance
Security & Compliance
Dependency List
License Compliance
Operations
Operations
Incidents
Environments
Packages & Registries
Packages & Registries
Package Registry
Container Registry
Analytics
Analytics
CI / CD
Code Review
Insights
Issue
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Alex D
GHC
Commits
56042256
Commit
56042256
authored
Jul 10, 2012
by
Simon Marlow
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Support the 2-result primops in the new code generator
parent
bf32abda
Changes
6
Hide whitespace changes
Inline
Side-by-side
Showing
6 changed files
with
176 additions
and
7 deletions
+176
-7
compiler/cmm/CmmCvt.hs
compiler/cmm/CmmCvt.hs
+1
-1
compiler/cmm/CmmLayoutStack.hs
compiler/cmm/CmmLayoutStack.hs
+1
-1
compiler/cmm/CmmRewriteAssignments.hs
compiler/cmm/CmmRewriteAssignments.hs
+1
-0
compiler/cmm/Hoopl.hs
compiler/cmm/Hoopl.hs
+2
-1
compiler/codeGen/StgCmmHeap.hs
compiler/codeGen/StgCmmHeap.hs
+1
-1
compiler/codeGen/StgCmmPrim.hs
compiler/codeGen/StgCmmPrim.hs
+170
-3
No files found.
compiler/cmm/CmmCvt.hs
View file @
56042256
...
...
@@ -12,7 +12,7 @@ import CmmUtils
import
qualified
OldCmm
as
Old
import
OldPprCmm
()
import
Hoopl
hiding
((
<*>
),
mkLabel
,
mkBranch
)
import
Hoopl
import
Data.Maybe
import
Maybes
import
Outputable
...
...
compiler/cmm/CmmLayoutStack.hs
View file @
56042256
...
...
@@ -16,7 +16,7 @@ import ForeignCall
import
CmmLive
import
CmmProcPoint
import
SMRep
import
Hoopl
hiding
((
<*>
),
mkLast
,
mkMiddle
)
import
Hoopl
import
Constants
import
UniqSupply
import
Maybes
...
...
compiler/cmm/CmmRewriteAssignments.hs
View file @
56042256
...
...
@@ -27,6 +27,7 @@ import Unique
import
BlockId
import
Hoopl
import
Compiler.Hoopl
((
<*>
),
mkMiddle
,
mkLast
)
import
Data.Maybe
import
Control.Monad
import
Prelude
hiding
(
succ
,
zip
)
...
...
compiler/cmm/Hoopl.hs
View file @
56042256
...
...
@@ -7,7 +7,8 @@ module Hoopl (
)
where
import
Compiler.Hoopl
hiding
(
Unique
,
(
(
<*>
),
mkLabel
,
mkBranch
,
mkMiddle
,
mkLast
,
-- clashes with our MkGraph
Unique
,
FwdTransfer
(
..
),
FwdRewrite
(
..
),
FwdPass
(
..
),
BwdTransfer
(
..
),
BwdRewrite
(
..
),
BwdPass
(
..
),
noFwdRewrite
,
noBwdRewrite
,
...
...
compiler/codeGen/StgCmmHeap.hs
View file @
56042256
...
...
@@ -33,7 +33,7 @@ import StgCmmEnv
import
MkGraph
import
Hoopl
hiding
((
<*>
),
mkBranch
)
import
Hoopl
import
SMRep
import
Cmm
import
CmmUtils
...
...
compiler/codeGen/StgCmmPrim.hs
View file @
56042256
...
...
@@ -30,6 +30,8 @@ import StgCmmTicky
import
StgCmmHeap
import
StgCmmProf
import
DynFlags
import
Platform
import
BasicTypes
import
MkGraph
import
StgSyn
...
...
@@ -47,6 +49,8 @@ import Outputable
import
StaticFlags
import
Util
import
Control.Monad
(
liftM
)
------------------------------------------------------------------------
-- Primitive operations and foreign calls
------------------------------------------------------------------------
...
...
@@ -508,9 +512,172 @@ emitPrimOp r@[res] op args
=
let
stmt
=
mkAssign
(
CmmLocal
res
)
(
CmmMachOp
mop
args
)
in
emit
stmt
emitPrimOp
_
op
_
=
pprPanic
"emitPrimOp: can't translate PrimOp"
(
ppr
op
)
emitPrimOp
results
op
args
=
do
dflags
<-
getDynFlags
case
callishPrimOpSupported
dflags
op
of
Left
op
->
emit
$
mkUnsafeCall
(
PrimTarget
op
)
results
args
Right
gen
->
gen
results
args
type
GenericOp
=
[
CmmFormal
]
->
[
CmmActual
]
->
FCode
()
callishPrimOpSupported
::
DynFlags
->
PrimOp
->
Either
CallishMachOp
GenericOp
callishPrimOpSupported
dflags
op
=
case
op
of
IntQuotRemOp
|
ncg
&&
x86ish
->
Left
(
MO_S_QuotRem
wordWidth
)
|
otherwise
->
Right
genericIntQuotRemOp
WordQuotRemOp
|
ncg
&&
x86ish
->
Left
(
MO_U_QuotRem
wordWidth
)
|
otherwise
->
Right
genericWordQuotRemOp
WordQuotRem2Op
|
ncg
&&
x86ish
->
Left
(
MO_U_QuotRem2
wordWidth
)
|
otherwise
->
Right
genericWordQuotRem2Op
WordAdd2Op
|
ncg
&&
x86ish
->
Left
(
MO_Add2
wordWidth
)
|
otherwise
->
Right
genericWordAdd2Op
WordMul2Op
|
ncg
&&
x86ish
->
Left
(
MO_U_Mul2
wordWidth
)
|
otherwise
->
Right
genericWordMul2Op
_
->
panic
"emitPrimOp: can't translate PrimOp"
(
ppr
op
)
where
ncg
=
case
hscTarget
dflags
of
HscAsm
->
True
_
->
False
x86ish
=
case
platformArch
(
targetPlatform
dflags
)
of
ArchX86
->
True
ArchX86_64
->
True
_
->
False
genericIntQuotRemOp
::
GenericOp
genericIntQuotRemOp
[
res_q
,
res_r
]
[
arg_x
,
arg_y
]
=
emit
$
mkAssign
(
CmmLocal
res_q
)
(
CmmMachOp
(
MO_S_Quot
wordWidth
)
[
arg_x
,
arg_y
])
<*>
mkAssign
(
CmmLocal
res_r
)
(
CmmMachOp
(
MO_S_Rem
wordWidth
)
[
arg_x
,
arg_y
])
genericIntQuotRemOp
_
_
=
panic
"genericIntQuotRemOp"
genericWordQuotRemOp
::
GenericOp
genericWordQuotRemOp
[
res_q
,
res_r
]
[
arg_x
,
arg_y
]
=
emit
$
mkAssign
(
CmmLocal
res_q
)
(
CmmMachOp
(
MO_U_Quot
wordWidth
)
[
arg_x
,
arg_y
])
<*>
mkAssign
(
CmmLocal
res_r
)
(
CmmMachOp
(
MO_U_Rem
wordWidth
)
[
arg_x
,
arg_y
])
genericWordQuotRemOp
_
_
=
panic
"genericWordQuotRemOp"
genericWordQuotRem2Op
::
GenericOp
genericWordQuotRem2Op
[
res_q
,
res_r
]
[
arg_x_high
,
arg_x_low
,
arg_y
]
=
emit
=<<
f
(
widthInBits
wordWidth
)
zero
arg_x_high
arg_x_low
where
ty
=
cmmExprType
arg_x_high
shl
x
i
=
CmmMachOp
(
MO_Shl
wordWidth
)
[
x
,
i
]
shr
x
i
=
CmmMachOp
(
MO_U_Shr
wordWidth
)
[
x
,
i
]
or
x
y
=
CmmMachOp
(
MO_Or
wordWidth
)
[
x
,
y
]
ge
x
y
=
CmmMachOp
(
MO_U_Ge
wordWidth
)
[
x
,
y
]
ne
x
y
=
CmmMachOp
(
MO_Ne
wordWidth
)
[
x
,
y
]
minus
x
y
=
CmmMachOp
(
MO_Sub
wordWidth
)
[
x
,
y
]
times
x
y
=
CmmMachOp
(
MO_Mul
wordWidth
)
[
x
,
y
]
zero
=
lit
0
one
=
lit
1
negone
=
lit
(
fromIntegral
(
widthInBits
wordWidth
)
-
1
)
lit
i
=
CmmLit
(
CmmInt
i
wordWidth
)
f
::
Int
->
CmmExpr
->
CmmExpr
->
CmmExpr
->
FCode
CmmAGraph
f
0
acc
high
_
=
return
(
mkAssign
(
CmmLocal
res_q
)
acc
<*>
mkAssign
(
CmmLocal
res_r
)
high
)
f
i
acc
high
low
=
do
roverflowedBit
<-
newTemp
ty
rhigh'
<-
newTemp
ty
rhigh''
<-
newTemp
ty
rlow'
<-
newTemp
ty
risge
<-
newTemp
ty
racc'
<-
newTemp
ty
let
high'
=
CmmReg
(
CmmLocal
rhigh'
)
isge
=
CmmReg
(
CmmLocal
risge
)
overflowedBit
=
CmmReg
(
CmmLocal
roverflowedBit
)
let
this
=
catAGraphs
[
mkAssign
(
CmmLocal
roverflowedBit
)
(
shr
high
negone
),
mkAssign
(
CmmLocal
rhigh'
)
(
or
(
shl
high
one
)
(
shr
low
negone
)),
mkAssign
(
CmmLocal
rlow'
)
(
shl
low
one
),
mkAssign
(
CmmLocal
risge
)
(
or
(
overflowedBit
`
ne
`
zero
)
(
high'
`
ge
`
arg_y
)),
mkAssign
(
CmmLocal
rhigh''
)
(
high'
`
minus
`
(
arg_y
`
times
`
isge
)),
mkAssign
(
CmmLocal
racc'
)
(
or
(
shl
acc
one
)
isge
)]
rest
<-
f
(
i
-
1
)
(
CmmReg
(
CmmLocal
racc'
))
(
CmmReg
(
CmmLocal
rhigh''
))
(
CmmReg
(
CmmLocal
rlow'
))
return
(
this
<*>
rest
)
genericWordQuotRem2Op
_
_
=
panic
"genericWordQuotRem2Op"
genericWordAdd2Op
::
GenericOp
genericWordAdd2Op
[
res_h
,
res_l
]
[
arg_x
,
arg_y
]
=
do
r1
<-
newTemp
(
cmmExprType
arg_x
)
r2
<-
newTemp
(
cmmExprType
arg_x
)
emit
$
catAGraphs
[
mkAssign
(
CmmLocal
r1
)
(
add
(
bottomHalf
arg_x
)
(
bottomHalf
arg_y
)),
mkAssign
(
CmmLocal
r2
)
(
add
(
topHalf
(
CmmReg
(
CmmLocal
r1
)))
(
add
(
topHalf
arg_x
)
(
topHalf
arg_y
))),
mkAssign
(
CmmLocal
res_h
)
(
topHalf
(
CmmReg
(
CmmLocal
r2
))),
mkAssign
(
CmmLocal
res_l
)
(
or
(
toTopHalf
(
CmmReg
(
CmmLocal
r2
)))
(
bottomHalf
(
CmmReg
(
CmmLocal
r1
))))]
where
topHalf
x
=
CmmMachOp
(
MO_U_Shr
wordWidth
)
[
x
,
hww
]
toTopHalf
x
=
CmmMachOp
(
MO_Shl
wordWidth
)
[
x
,
hww
]
bottomHalf
x
=
CmmMachOp
(
MO_And
wordWidth
)
[
x
,
hwm
]
add
x
y
=
CmmMachOp
(
MO_Add
wordWidth
)
[
x
,
y
]
or
x
y
=
CmmMachOp
(
MO_Or
wordWidth
)
[
x
,
y
]
hww
=
CmmLit
(
CmmInt
(
fromIntegral
(
widthInBits
halfWordWidth
))
wordWidth
)
hwm
=
CmmLit
(
CmmInt
halfWordMask
wordWidth
)
genericWordAdd2Op
_
_
=
panic
"genericWordAdd2Op"
genericWordMul2Op
::
GenericOp
genericWordMul2Op
[
res_h
,
res_l
]
[
arg_x
,
arg_y
]
=
do
let
t
=
cmmExprType
arg_x
xlyl
<-
liftM
CmmLocal
$
newTemp
t
xlyh
<-
liftM
CmmLocal
$
newTemp
t
xhyl
<-
liftM
CmmLocal
$
newTemp
t
r
<-
liftM
CmmLocal
$
newTemp
t
-- This generic implementation is very simple and slow. We might
-- well be able to do better, but for now this at least works.
emit
$
catAGraphs
[
mkAssign
xlyl
(
mul
(
bottomHalf
arg_x
)
(
bottomHalf
arg_y
)),
mkAssign
xlyh
(
mul
(
bottomHalf
arg_x
)
(
topHalf
arg_y
)),
mkAssign
xhyl
(
mul
(
topHalf
arg_x
)
(
bottomHalf
arg_y
)),
mkAssign
r
(
sum
[
topHalf
(
CmmReg
xlyl
),
bottomHalf
(
CmmReg
xhyl
),
bottomHalf
(
CmmReg
xlyh
)]),
mkAssign
(
CmmLocal
res_l
)
(
or
(
bottomHalf
(
CmmReg
xlyl
))
(
toTopHalf
(
CmmReg
r
))),
mkAssign
(
CmmLocal
res_h
)
(
sum
[
mul
(
topHalf
arg_x
)
(
topHalf
arg_y
),
topHalf
(
CmmReg
xhyl
),
topHalf
(
CmmReg
xlyh
),
topHalf
(
CmmReg
r
)])]
where
topHalf
x
=
CmmMachOp
(
MO_U_Shr
wordWidth
)
[
x
,
hww
]
toTopHalf
x
=
CmmMachOp
(
MO_Shl
wordWidth
)
[
x
,
hww
]
bottomHalf
x
=
CmmMachOp
(
MO_And
wordWidth
)
[
x
,
hwm
]
add
x
y
=
CmmMachOp
(
MO_Add
wordWidth
)
[
x
,
y
]
sum
=
foldl1
add
mul
x
y
=
CmmMachOp
(
MO_Mul
wordWidth
)
[
x
,
y
]
or
x
y
=
CmmMachOp
(
MO_Or
wordWidth
)
[
x
,
y
]
hww
=
CmmLit
(
CmmInt
(
fromIntegral
(
widthInBits
halfWordWidth
))
wordWidth
)
hwm
=
CmmLit
(
CmmInt
halfWordMask
wordWidth
)
genericWordMul2Op
_
_
=
panic
"genericWordMul2Op"
-- These PrimOps are NOPs in Cmm
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a 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