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
Dylan Yudaken
GHC
Commits
db24e480
Commit
db24e480
authored
Jan 06, 2020
by
Ben Gamari
🐢
Committed by
Marge Bot
Jan 20, 2020
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
llvmGen: Don't trash STG registers
Fixes #13904.
parent
a661df91
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
2 additions
and
38 deletions
+2
-38
compiler/llvmGen/LlvmCodeGen/CodeGen.hs
compiler/llvmGen/LlvmCodeGen/CodeGen.hs
+2
-38
No files found.
compiler/llvmGen/LlvmCodeGen/CodeGen.hs
View file @
db24e480
...
...
@@ -14,7 +14,7 @@ import LlvmCodeGen.Base
import
LlvmCodeGen.Regs
import
BlockId
import
GHC.Platform.Regs
(
activeStgRegs
,
callerSaves
)
import
GHC.Platform.Regs
(
activeStgRegs
)
import
CLabel
import
Cmm
import
PprCmm
...
...
@@ -222,7 +222,6 @@ genCall t@(PrimTarget (MO_Prefetch_Data localityInt)) [] args
fptr
<-
liftExprData
$
getFunPtr
funTy
t
argVars'
<-
castVarsW
Signed
$
zip
argVars
argTy
doTrashStmts
let
argSuffix
=
[
mkIntLit
i32
0
,
mkIntLit
i32
localityInt
,
mkIntLit
i32
1
]
statement
$
Expr
$
Call
StdCall
fptr
(
argVars'
++
argSuffix
)
[]
|
otherwise
=
panic
$
"prefetch locality level integer must be between 0 and 3, given: "
++
(
show
localityInt
)
...
...
@@ -307,7 +306,6 @@ genCall t@(PrimTarget op) [] args
fptr
<-
getFunPtrW
funTy
t
argVars'
<-
castVarsW
Signed
$
zip
argVars
argTy
doTrashStmts
let
alignVal
=
mkIntLit
i32
align
arguments
=
argVars'
++
(
alignVal
:
isVolVal
)
statement
$
Expr
$
Call
StdCall
fptr
arguments
[]
...
...
@@ -462,7 +460,6 @@ genCall target res args = runStmtsDecls $ do
|
never_returns
=
statement
$
Unreachable
|
otherwise
=
return
()
doTrashStmts
-- make the actual call
case
retTy
of
...
...
@@ -1810,12 +1807,9 @@ genLit _ CmmHighStackMark
funPrologue
::
LiveGlobalRegs
->
[
CmmBlock
]
->
LlvmM
StmtData
funPrologue
live
cmmBlocks
=
do
trash
<-
getTrashRegs
let
getAssignedRegs
::
CmmNode
O
O
->
[
CmmReg
]
getAssignedRegs
(
CmmAssign
reg
_
)
=
[
reg
]
-- Calls will trash all registers. Unfortunately, this needs them to
-- be stack-allocated in the first place.
getAssignedRegs
(
CmmUnsafeForeignCall
_
rs
_
)
=
map
CmmGlobal
trash
++
map
CmmLocal
rs
getAssignedRegs
(
CmmUnsafeForeignCall
_
rs
_
)
=
map
CmmLocal
rs
getAssignedRegs
_
=
[]
getRegsBlock
(
_
,
body
,
_
)
=
concatMap
getAssignedRegs
$
blockToList
body
assignedRegs
=
nub
$
concatMap
(
getRegsBlock
.
blockSplit
)
cmmBlocks
...
...
@@ -1875,31 +1869,6 @@ funEpilogue live = do
let
(
vars
,
stmts
)
=
unzip
loads
return
(
catMaybes
vars
,
concatOL
stmts
)
-- | A series of statements to trash all the STG registers.
--
-- In LLVM we pass the STG registers around everywhere in function calls.
-- So this means LLVM considers them live across the entire function, when
-- in reality they usually aren't. For Caller save registers across C calls
-- the saving and restoring of them is done by the Cmm code generator,
-- using Cmm local vars. So to stop LLVM saving them as well (and saving
-- all of them since it thinks they're always live, we trash them just
-- before the call by assigning the 'undef' value to them. The ones we
-- need are restored from the Cmm local var and the ones we don't need
-- are fine to be trashed.
getTrashStmts
::
LlvmM
LlvmStatements
getTrashStmts
=
do
regs
<-
getTrashRegs
stmts
<-
flip
mapM
regs
$
\
r
->
do
reg
<-
getCmmReg
(
CmmGlobal
r
)
let
ty
=
(
pLower
.
getVarType
)
reg
return
$
Store
(
LMLitVar
$
LMUndefLit
ty
)
reg
return
$
toOL
stmts
getTrashRegs
::
LlvmM
[
GlobalReg
]
getTrashRegs
=
do
plat
<-
getLlvmPlatform
return
$
filter
(
callerSaves
plat
)
(
activeStgRegs
plat
)
-- | Get a function pointer to the CLabel specified.
--
-- This is for Haskell functions, function type is assumed, so doesn't work
...
...
@@ -2021,11 +1990,6 @@ getCmmRegW = lift . getCmmReg
genLoadW
::
Atomic
->
CmmExpr
->
CmmType
->
WriterT
LlvmAccum
LlvmM
LlvmVar
genLoadW
atomic
e
ty
=
liftExprData
$
genLoad
atomic
e
ty
doTrashStmts
::
WriterT
LlvmAccum
LlvmM
()
doTrashStmts
=
do
stmts
<-
lift
getTrashStmts
tell
$
LlvmAccum
stmts
mempty
-- | Return element of single-element list; 'panic' if list is not a single-element list
singletonPanic
::
String
->
[
a
]
->
a
singletonPanic
_
[
x
]
=
x
...
...
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