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
0e504ed5
Commit
0e504ed5
authored
May 29, 2007
by
Michael D. Adams
Browse files
Added early draft of parameter passing to the CPS converter
parent
bdfa9495
Changes
3
Hide whitespace changes
Inline
Side-by-side
compiler/cmm/CmmCPS.hs
View file @
0e504ed5
...
...
@@ -154,10 +154,12 @@ data Continuation =
-- Describes the layout of a stack frame for a continuation
data
StackFormat
=
StackFormat
(
Maybe
CLabel
)
-- The label occupying the top slot
WordOff
-- Total frame size in words
[(
CmmReg
,
WordOff
)]
-- local reg offsets from stack top
=
StackFormat
{
stack_label
::
Maybe
CLabel
,
-- The label occupying the top slot
stack_frame_size
::
WordOff
,
-- Total frame size in words (not including arguments)
stack_live
::
[(
CmmReg
,
WordOff
)]
-- local reg offsets from stack top
-- TODO: see if the above can be LocalReg
}
-- A block can be a continuation of a call
-- A block can be a continuation of another block (w/ or w/o joins)
...
...
@@ -252,22 +254,24 @@ continuationToProc formats (Continuation is_entry info label formals blocks) =
unknown_block
=
panic
"unknown BlockId in continuationToProc"
prefix
=
case
entry
of
ControlEntry
->
[]
FunctionEntry
_
_
->
[]
FunctionEntry
_
formals
->
-- TODO: gc_stack_check
function_entry
formals
curr_format
ContinuationEntry
formals
->
un
pack_continuation
curr_format
f
un
ction_entry
formals
curr_format
postfix
=
case
exit
of
FinalBranch
next
->
[
CmmBranch
next
]
FinalSwitch
expr
targets
->
[
CmmSwitch
expr
targets
]
FinalReturn
arguments
->
exit_function
curr_format
tail_call
(
stack_frame_size
curr_format
)
(
CmmLoad
(
CmmReg
spReg
)
wordRep
)
arguments
FinalJump
target
arguments
->
exit_function
curr_format
target
arguments
tail_call
(
stack_frame_size
curr_format
)
target
arguments
FinalCall
next
(
CmmForeignCall
target
CmmCallConv
)
results
arguments
->
pack_continuation
curr_format
cont_format
++
[
CmmJump
target
arguments
]
tail_call
(
stack_frame_size
curr_format
-
stack_frame_size
cont_format
)
target
arguments
where
cont_format
=
maybe
unknown_block
id
$
lookup
(
mkReturnPtLabel
$
getUnique
next
)
formats
...
...
@@ -278,18 +282,24 @@ continuationToProc formats (Continuation is_entry info label formals blocks) =
-- for packing/unpacking continuations
-- and entering/exiting functions
exit_function
::
StackFormat
->
CmmExpr
->
CmmActuals
->
[
CmmStmt
]
exit_function
(
StackFormat
curr_id
curr_frame_size
curr_offsets
)
target
arguments
=
adjust_spReg
++
jump
where
tail_call
::
WordOff
->
CmmExpr
->
CmmActuals
->
[
CmmStmt
]
tail_call
spRel
target
arguments
=
store_arguments
++
adjust_spReg
++
jump
where
store_arguments
=
[
stack_put
spRel
expr
offset
|
((
expr
,
_
),
StackParam
offset
)
<-
argument_formats
]
++
[
global_put
expr
global
|
((
expr
,
_
),
RegisterParam
global
)
<-
argument_formats
]
adjust_spReg
=
if
curr_frame_size
==
0
if
spRel
==
0
then
[]
else
[
CmmAssign
spReg
(
CmmRegOff
spReg
(
curr_frame_size
*
wORD_SIZE
))]
else
[
CmmAssign
spReg
(
CmmRegOff
spReg
(
spRel
*
wORD_SIZE
))]
jump
=
[
CmmJump
target
arguments
]
enter_function
::
WordOff
->
[
CmmStmt
]
enter_function
max_frame_size
argument_formats
=
assignArguments
(
cmmExprRep
.
fst
)
arguments
gc_stack_check
::
WordOff
->
[
CmmStmt
]
gc_stack_check
max_frame_size
=
check_stack_limit
where
check_stack_limit
=
[
CmmCondBranch
...
...
@@ -300,41 +310,69 @@ enter_function max_frame_size
-- TODO: fix branches to proc point (we have to insert a new block to marshel the continuation)
pack_continuation
::
StackFormat
->
StackFormat
->
[
CmmStmt
]
pack_continuation
(
StackFormat
curr_id
curr_frame_size
curr_offsets
)
pack_continuation
(
StackFormat
curr_id
curr_frame_size
_
)
(
StackFormat
cont_id
cont_frame_size
cont_offsets
)
=
save_live_values
++
set_stack_header
++
adjust_spReg
where
-- TODO: only save variables when actually needed
save_live_values
=
[
CmmStore
(
CmmRegOff
spReg
(
wORD_SIZE
*
(
curr_frame_size
-
cont_frame_size
+
offset
)))
(
CmmReg
reg
)
=
store_live_values
++
set_stack_header
where
-- TODO: only save variables when actually needed (may be handled by latter pass)
store_live_values
=
[
stack_put
spRel
(
CmmReg
reg
)
offset
|
(
reg
,
offset
)
<-
cont_offsets
]
needs_header
=
case
(
curr_id
,
cont_id
)
of
(
Just
x
,
Just
y
)
->
x
/=
y
_
->
isJust
cont_id
set_stack_header
=
if
not
needs_header
then
[]
else
[
CmmStore
(
CmmRegOff
spReg
(
wORD_SIZE
*
(
curr_frame_size
-
cont_frame_size
)))
continuation_function
]
continuation_function
=
CmmLit
$
CmmLabel
$
fromJust
cont_id
adjust_spReg
=
if
curr_frame_size
==
cont_frame_size
if
not
needs_header
then
[]
else
[
CmmAssign
spReg
(
CmmRegOff
spReg
((
curr_frame_size
-
cont_frame_size
)
*
wORD_SIZE
))]
else
[
stack_put
spRel
continuation_function
0
]
spRel
=
curr_frame_size
-
cont_frame_size
continuation_function
=
CmmLit
$
CmmLabel
$
fromJust
cont_id
needs_header
=
case
(
curr_id
,
cont_id
)
of
(
Just
x
,
Just
y
)
->
x
/=
y
_
->
isJust
cont_id
-- Lazy adjustment of stack headers assumes all blocks
-- that could branch to eachother (i.e. control blocks)
-- have the same stack format (this causes a problem
-- only for proc-point).
un
pack_continuation
::
StackFormat
->
[
CmmStmt
]
un
pack_continuation
(
StackFormat
curr_id
curr_frame_size
curr_offsets
)
=
load_live_values
where
-- TODO: only save variables when actually needed
f
un
ction_entry
::
CmmFormals
->
StackFormat
->
[
CmmStmt
]
f
un
ction_entry
formals
(
StackFormat
_
_
curr_offsets
)
=
load_live_values
++
load_args
where
-- TODO: only save variables when actually needed
(may be handled by latter pass)
load_live_values
=
[
CmmAssign
reg
(
CmmLoad
(
CmmRegOff
spReg
(
wORD_SIZE
*
offset
))
(
cmmRegRep
reg
))
[
stack_get
0
reg
offset
|
(
reg
,
offset
)
<-
curr_offsets
]
load_args
=
[
stack_get
0
reg
offset
|
((
reg
,
_
),
StackParam
offset
)
<-
argument_formats
]
++
[
global_get
reg
global
|
((
reg
,
_
),
RegisterParam
global
)
<-
argument_formats
]
argument_formats
=
assignArguments
(
cmmRegRep
.
fst
)
formals
-----------------------------------------------------------------------------
-- Section: Stack and argument register puts and gets
-----------------------------------------------------------------------------
-- TODO: document
-- |Construct a 'CmmStmt' that will save a value on the stack
stack_put
::
WordOff
-- ^ Offset from the real 'Sp' that 'offset'
-- is relative to (added to offset)
->
CmmExpr
-- ^ What to store onto the stack
->
WordOff
-- ^ Where on the stack to store it
-- (positive <=> higher addresses)
->
CmmStmt
stack_put
spRel
expr
offset
=
CmmStore
(
CmmRegOff
spReg
(
wORD_SIZE
*
(
spRel
+
offset
)))
expr
--------------------------------
-- |Construct a
stack_get
::
WordOff
->
CmmReg
->
WordOff
->
CmmStmt
stack_get
spRel
reg
offset
=
CmmAssign
reg
(
CmmLoad
(
CmmRegOff
spReg
(
wORD_SIZE
*
(
spRel
+
offset
)))
(
cmmRegRep
reg
))
global_put
::
CmmExpr
->
GlobalReg
->
CmmStmt
global_put
expr
global
=
CmmAssign
(
CmmGlobal
global
)
expr
global_get
::
CmmReg
->
GlobalReg
->
CmmStmt
global_get
reg
global
=
CmmAssign
reg
(
CmmReg
(
CmmGlobal
global
))
compiler/cmm/CmmCallConv.hs
0 → 100644
View file @
0e504ed5
module
CmmCallConv
(
ParamLocation
(
..
),
ArgumentFormat
,
assignRegs
,
assignArguments
,
)
where
#
include
"HsVersions.h"
import
Cmm
import
MachOp
import
SMRep
import
Constants
import
StaticFlags
(
opt_Unregisterised
)
import
Panic
data
ParamLocation
=
RegisterParam
GlobalReg
|
StackParam
WordOff
assignRegs
::
[
LocalReg
]
->
ArgumentFormat
LocalReg
assignRegs
regs
=
assignRegs'
regs
0
availRegs
where
assignRegs'
(
r
:
rs
)
offset
availRegs
=
(
r
,
assignment
)
:
assignRegs'
rs
new_offset
remaining
where
(
assignment
,
new_offset
,
remaining
)
=
assign_reg
(
localRegRep
r
)
offset
availRegs
assignArguments
::
(
a
->
MachRep
)
->
[
a
]
->
ArgumentFormat
a
assignArguments
f
reps
=
assignArguments'
reps
0
availRegs
where
assignArguments'
[]
offset
availRegs
=
[]
assignArguments'
(
r
:
rs
)
offset
availRegs
=
(
r
,
assignment
)
:
assignArguments'
rs
new_offset
remaining
where
(
assignment
,
new_offset
,
remaining
)
=
assign_reg
(
f
r
)
offset
availRegs
type
ArgumentFormat
a
=
[(
a
,
ParamLocation
)]
type
AvailRegs
=
(
[
GlobalReg
]
-- available vanilla regs.
,
[
GlobalReg
]
-- floats
,
[
GlobalReg
]
-- doubles
,
[
GlobalReg
]
-- longs (int64 and word64)
)
-- Vanilla registers can contain pointers, Ints, Chars.
-- Floats and doubles have separate register supplies.
--
-- We take these register supplies from the *real* registers, i.e. those
-- that are guaranteed to map to machine registers.
useVanillaRegs
|
opt_Unregisterised
=
0
|
otherwise
=
mAX_Real_Vanilla_REG
useFloatRegs
|
opt_Unregisterised
=
0
|
otherwise
=
mAX_Real_Float_REG
useDoubleRegs
|
opt_Unregisterised
=
0
|
otherwise
=
mAX_Real_Double_REG
useLongRegs
|
opt_Unregisterised
=
0
|
otherwise
=
mAX_Real_Long_REG
availRegs
=
(
regList
VanillaReg
useVanillaRegs
,
regList
FloatReg
useFloatRegs
,
regList
DoubleReg
useDoubleRegs
,
regList
LongReg
useLongRegs
)
where
regList
f
max
=
map
f
[
1
..
max
]
slot_size
::
LocalReg
->
Int
slot_size
reg
=
((
machRepByteWidth
(
localRegRep
reg
)
-
1
)
`
div
`
wORD_SIZE
)
+
1
slot_size'
::
MachRep
->
Int
slot_size'
reg
=
((
machRepByteWidth
reg
-
1
)
`
div
`
wORD_SIZE
)
+
1
assign_reg
::
MachRep
->
WordOff
->
AvailRegs
->
(
ParamLocation
,
WordOff
,
AvailRegs
)
assign_reg
I8
off
(
v
:
vs
,
fs
,
ds
,
ls
)
=
(
RegisterParam
$
v
,
off
,
(
vs
,
fs
,
ds
,
ls
))
assign_reg
I16
off
(
v
:
vs
,
fs
,
ds
,
ls
)
=
(
RegisterParam
$
v
,
off
,
(
vs
,
fs
,
ds
,
ls
))
assign_reg
I32
off
(
v
:
vs
,
fs
,
ds
,
ls
)
=
(
RegisterParam
$
v
,
off
,
(
vs
,
fs
,
ds
,
ls
))
assign_reg
I64
off
(
vs
,
fs
,
ds
,
l
:
ls
)
=
(
RegisterParam
$
l
,
off
,
(
vs
,
fs
,
ds
,
ls
))
assign_reg
I128
off
_
=
panic
"I128 is not a supported register type"
assign_reg
F32
off
(
vs
,
f
:
fs
,
ds
,
ls
)
=
(
RegisterParam
$
f
,
off
,
(
vs
,
fs
,
ds
,
ls
))
assign_reg
F64
off
(
vs
,
fs
,
d
:
ds
,
ls
)
=
(
RegisterParam
$
d
,
off
,
(
vs
,
fs
,
ds
,
ls
))
assign_reg
F80
off
_
=
panic
"F80 is not a supported register type"
assign_reg
reg
off
_
=
(
StackParam
$
off
-
size
,
off
-
size
,
(
[]
,
[]
,
[]
,
[]
))
where
size
=
slot_size'
reg
compiler/cmm/CmmLive.hs
View file @
0e504ed5
...
...
@@ -129,6 +129,7 @@ cmmBlockUpdate blocks node _ state =
-----------------------------------------------------------------------------
-- Section:
-----------------------------------------------------------------------------
-----------------------------------------------------------------------------
-- CmmBlockLive, cmmStmtListLive and helpers
-----------------------------------------------------------------------------
...
...
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