{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
module GHC.StgToCmm.Layout (
mkArgDescr,
emitCall, emitReturn, adjustHpBackwards,
emitClosureProcAndInfoTable,
emitClosureAndInfoTable,
slowCall, directCall,
FieldOffOrPadding(..),
ClosureHeader(..),
mkVirtHeapOffsets,
mkVirtHeapOffsetsWithPadding,
mkVirtConstrOffsets,
mkVirtConstrSizes,
getHpRelOffset,
ArgRep(..), toArgRep, argRepSizeW
) where
#include "HsVersions.h"
import GhcPrelude hiding ((<*>))
import GHC.StgToCmm.Closure
import GHC.StgToCmm.Env
import GHC.StgToCmm.ArgRep
import GHC.StgToCmm.Ticky
import GHC.StgToCmm.Monad
import GHC.StgToCmm.Utils
import MkGraph
import SMRep
import BlockId
import Cmm
import CmmUtils
import CmmInfo
import CLabel
import StgSyn
import Id
import TyCon ( PrimRep(..), primRepSizeB )
import BasicTypes ( RepArity )
import DynFlags
import Module
import Util
import Data.List
import Outputable
import FastString
import Control.Monad
emitReturn :: [CmmExpr] -> FCode ReturnKind
emitReturn :: [CmmExpr] -> FCode ReturnKind
emitReturn [CmmExpr]
results
= do { DynFlags
dflags <- FCode DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
; Sequel
sequel <- FCode Sequel
getSequel
; UpdFrameOffset
updfr_off <- FCode UpdFrameOffset
getUpdFrameOff
; case Sequel
sequel of
Sequel
Return ->
do { FCode ()
adjustHpBackwards
; let e :: CmmExpr
e = CmmExpr -> CmmType -> CmmExpr
CmmLoad (Area -> UpdFrameOffset -> CmmExpr
CmmStackSlot Area
Old UpdFrameOffset
updfr_off) (DynFlags -> CmmType
gcWord DynFlags
dflags)
; CmmAGraph -> FCode ()
emit (DynFlags -> CmmExpr -> [CmmExpr] -> UpdFrameOffset -> CmmAGraph
mkReturn DynFlags
dflags (DynFlags -> CmmExpr -> CmmExpr
entryCode DynFlags
dflags CmmExpr
e) [CmmExpr]
results UpdFrameOffset
updfr_off)
}
AssignTo [LocalReg]
regs Bool
adjust ->
do { Bool -> FCode () -> FCode ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
adjust FCode ()
adjustHpBackwards
; [LocalReg] -> [CmmExpr] -> FCode ()
emitMultiAssign [LocalReg]
regs [CmmExpr]
results }
; ReturnKind -> FCode ReturnKind
forall (m :: * -> *) a. Monad m => a -> m a
return ReturnKind
AssignedDirectly
}
emitCall :: (Convention, Convention) -> CmmExpr -> [CmmExpr] -> FCode ReturnKind
emitCall :: (Convention, Convention)
-> CmmExpr -> [CmmExpr] -> FCode ReturnKind
emitCall (Convention, Convention)
convs CmmExpr
fun [CmmExpr]
args
= (Convention, Convention)
-> CmmExpr -> [CmmExpr] -> [CmmExpr] -> FCode ReturnKind
emitCallWithExtraStack (Convention, Convention)
convs CmmExpr
fun [CmmExpr]
args [CmmExpr]
noExtraStack
emitCallWithExtraStack
:: (Convention, Convention) -> CmmExpr -> [CmmExpr]
-> [CmmExpr] -> FCode ReturnKind
(Convention
callConv, Convention
retConv) CmmExpr
fun [CmmExpr]
args [CmmExpr]
extra_stack
= do { DynFlags
dflags <- FCode DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
; FCode ()
adjustHpBackwards
; Sequel
sequel <- FCode Sequel
getSequel
; UpdFrameOffset
updfr_off <- FCode UpdFrameOffset
getUpdFrameOff
; case Sequel
sequel of
Sequel
Return -> do
CmmAGraph -> FCode ()
emit (CmmAGraph -> FCode ()) -> CmmAGraph -> FCode ()
forall a b. (a -> b) -> a -> b
$ DynFlags
-> Convention
-> CmmExpr
-> [CmmExpr]
-> UpdFrameOffset
-> [CmmExpr]
-> CmmAGraph
mkJumpExtra DynFlags
dflags Convention
callConv CmmExpr
fun [CmmExpr]
args UpdFrameOffset
updfr_off [CmmExpr]
extra_stack
ReturnKind -> FCode ReturnKind
forall (m :: * -> *) a. Monad m => a -> m a
return ReturnKind
AssignedDirectly
AssignTo [LocalReg]
res_regs Bool
_ -> do
BlockId
k <- FCode BlockId
forall (m :: * -> *). MonadUnique m => m BlockId
newBlockId
let area :: Area
area = BlockId -> Area
Young BlockId
k
(UpdFrameOffset
off, [GlobalReg]
_, CmmAGraph
copyin) = DynFlags
-> Convention
-> Area
-> [LocalReg]
-> [LocalReg]
-> (UpdFrameOffset, [GlobalReg], CmmAGraph)
copyInOflow DynFlags
dflags Convention
retConv Area
area [LocalReg]
res_regs []
copyout :: CmmAGraph
copyout = DynFlags
-> CmmExpr
-> Convention
-> [CmmExpr]
-> BlockId
-> UpdFrameOffset
-> UpdFrameOffset
-> [CmmExpr]
-> CmmAGraph
mkCallReturnsTo DynFlags
dflags CmmExpr
fun Convention
callConv [CmmExpr]
args BlockId
k UpdFrameOffset
off UpdFrameOffset
updfr_off
[CmmExpr]
extra_stack
CmmTickScope
tscope <- FCode CmmTickScope
getTickScope
CmmAGraph -> FCode ()
emit (CmmAGraph
copyout CmmAGraph -> CmmAGraph -> CmmAGraph
<*> BlockId -> CmmTickScope -> CmmAGraph
mkLabel BlockId
k CmmTickScope
tscope CmmAGraph -> CmmAGraph -> CmmAGraph
<*> CmmAGraph
copyin)
ReturnKind -> FCode ReturnKind
forall (m :: * -> *) a. Monad m => a -> m a
return (BlockId -> UpdFrameOffset -> ReturnKind
ReturnedTo BlockId
k UpdFrameOffset
off)
}
adjustHpBackwards :: FCode ()
adjustHpBackwards :: FCode ()
adjustHpBackwards
= do { HeapUsage
hp_usg <- FCode HeapUsage
getHpUsage
; let rHp :: UpdFrameOffset
rHp = HeapUsage -> UpdFrameOffset
realHp HeapUsage
hp_usg
vHp :: UpdFrameOffset
vHp = HeapUsage -> UpdFrameOffset
virtHp HeapUsage
hp_usg
adjust_words :: UpdFrameOffset
adjust_words = UpdFrameOffset
vHp UpdFrameOffset -> UpdFrameOffset -> UpdFrameOffset
forall a. Num a => a -> a -> a
-UpdFrameOffset
rHp
; CmmExpr
new_hp <- UpdFrameOffset -> FCode CmmExpr
getHpRelOffset UpdFrameOffset
vHp
; CmmAGraph -> FCode ()
emit (if UpdFrameOffset
adjust_words UpdFrameOffset -> UpdFrameOffset -> Bool
forall a. Eq a => a -> a -> Bool
== UpdFrameOffset
0
then CmmAGraph
mkNop
else CmmReg -> CmmExpr -> CmmAGraph
mkAssign CmmReg
hpReg CmmExpr
new_hp)
; Bool -> UpdFrameOffset -> FCode ()
tickyAllocHeap Bool
False UpdFrameOffset
adjust_words
; UpdFrameOffset -> FCode ()
setRealHp UpdFrameOffset
vHp
}
directCall :: Convention -> CLabel -> RepArity -> [StgArg] -> FCode ReturnKind
directCall :: Convention
-> CLabel -> UpdFrameOffset -> [StgArg] -> FCode ReturnKind
directCall Convention
conv CLabel
lbl UpdFrameOffset
arity [StgArg]
stg_args
= do { [(ArgRep, Maybe CmmExpr)]
argreps <- [StgArg] -> FCode [(ArgRep, Maybe CmmExpr)]
getArgRepsAmodes [StgArg]
stg_args
; String
-> Convention
-> CLabel
-> UpdFrameOffset
-> [(ArgRep, Maybe CmmExpr)]
-> FCode ReturnKind
direct_call String
"directCall" Convention
conv CLabel
lbl UpdFrameOffset
arity [(ArgRep, Maybe CmmExpr)]
argreps }
slowCall :: CmmExpr -> [StgArg] -> FCode ReturnKind
slowCall :: CmmExpr -> [StgArg] -> FCode ReturnKind
slowCall CmmExpr
fun [StgArg]
stg_args
= do DynFlags
dflags <- FCode DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
[(ArgRep, Maybe CmmExpr)]
argsreps <- [StgArg] -> FCode [(ArgRep, Maybe CmmExpr)]
getArgRepsAmodes [StgArg]
stg_args
let (FastString
rts_fun, UpdFrameOffset
arity) = [ArgRep] -> (FastString, UpdFrameOffset)
slowCallPattern (((ArgRep, Maybe CmmExpr) -> ArgRep)
-> [(ArgRep, Maybe CmmExpr)] -> [ArgRep]
forall a b. (a -> b) -> [a] -> [b]
map (ArgRep, Maybe CmmExpr) -> ArgRep
forall a b. (a, b) -> a
fst [(ArgRep, Maybe CmmExpr)]
argsreps)
(ReturnKind
r, CmmAGraph
slow_code) <- FCode ReturnKind -> FCode (ReturnKind, CmmAGraph)
forall a. FCode a -> FCode (a, CmmAGraph)
getCodeR (FCode ReturnKind -> FCode (ReturnKind, CmmAGraph))
-> FCode ReturnKind -> FCode (ReturnKind, CmmAGraph)
forall a b. (a -> b) -> a -> b
$ do
ReturnKind
r <- String
-> Convention
-> CLabel
-> UpdFrameOffset
-> [(ArgRep, Maybe CmmExpr)]
-> FCode ReturnKind
direct_call String
"slow_call" Convention
NativeNodeCall
(FastString -> CLabel
mkRtsApFastLabel FastString
rts_fun) UpdFrameOffset
arity ((ArgRep
P,CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just CmmExpr
fun)(ArgRep, Maybe CmmExpr)
-> [(ArgRep, Maybe CmmExpr)] -> [(ArgRep, Maybe CmmExpr)]
forall a. a -> [a] -> [a]
:[(ArgRep, Maybe CmmExpr)]
argsreps)
FastString -> FCode ()
emitComment (FastString -> FCode ()) -> FastString -> FCode ()
forall a b. (a -> b) -> a -> b
$ String -> FastString
mkFastString (String
"slow_call for " String -> String -> String
forall a. [a] -> [a] -> [a]
++
DynFlags -> SDoc -> String
showSDoc DynFlags
dflags (CmmExpr -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmExpr
fun) String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" with pat " String -> String -> String
forall a. [a] -> [a] -> [a]
++ FastString -> String
unpackFS FastString
rts_fun)
ReturnKind -> FCode ReturnKind
forall (m :: * -> *) a. Monad m => a -> m a
return ReturnKind
r
let n_args :: UpdFrameOffset
n_args = [StgArg] -> UpdFrameOffset
forall (t :: * -> *) a. Foldable t => t a -> UpdFrameOffset
length [StgArg]
stg_args
if UpdFrameOffset
n_args UpdFrameOffset -> UpdFrameOffset -> Bool
forall a. Ord a => a -> a -> Bool
> UpdFrameOffset
arity Bool -> Bool -> Bool
&& DynFlags -> UpdFrameOffset
optLevel DynFlags
dflags UpdFrameOffset -> UpdFrameOffset -> Bool
forall a. Ord a => a -> a -> Bool
>= UpdFrameOffset
2
then do
CmmExpr
funv <- (CmmReg -> CmmExpr
CmmReg (CmmReg -> CmmExpr) -> (LocalReg -> CmmReg) -> LocalReg -> CmmExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalReg -> CmmReg
CmmLocal) (LocalReg -> CmmExpr) -> FCode LocalReg -> FCode CmmExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` CmmExpr -> FCode LocalReg
assignTemp CmmExpr
fun
CmmExpr
fun_iptr <- (CmmReg -> CmmExpr
CmmReg (CmmReg -> CmmExpr) -> (LocalReg -> CmmReg) -> LocalReg -> CmmExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalReg -> CmmReg
CmmLocal) (LocalReg -> CmmExpr) -> FCode LocalReg -> FCode CmmExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap`
CmmExpr -> FCode LocalReg
assignTemp (DynFlags -> CmmExpr -> CmmExpr
closureInfoPtr DynFlags
dflags (DynFlags -> CmmExpr -> CmmExpr
cmmUntag DynFlags
dflags CmmExpr
funv))
CmmAGraph
fast_code <- FCode ReturnKind -> FCode CmmAGraph
forall a. FCode a -> FCode CmmAGraph
getCode (FCode ReturnKind -> FCode CmmAGraph)
-> FCode ReturnKind -> FCode CmmAGraph
forall a b. (a -> b) -> a -> b
$
(Convention, Convention)
-> CmmExpr -> [CmmExpr] -> FCode ReturnKind
emitCall (Convention
NativeNodeCall, Convention
NativeReturn)
(DynFlags -> CmmExpr -> CmmExpr
entryCode DynFlags
dflags CmmExpr
fun_iptr)
([(ArgRep, Maybe CmmExpr)] -> [CmmExpr]
nonVArgs ((ArgRep
P,CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just CmmExpr
funv)(ArgRep, Maybe CmmExpr)
-> [(ArgRep, Maybe CmmExpr)] -> [(ArgRep, Maybe CmmExpr)]
forall a. a -> [a] -> [a]
:[(ArgRep, Maybe CmmExpr)]
argsreps))
BlockId
slow_lbl <- FCode BlockId
forall (m :: * -> *). MonadUnique m => m BlockId
newBlockId
BlockId
fast_lbl <- FCode BlockId
forall (m :: * -> *). MonadUnique m => m BlockId
newBlockId
BlockId
is_tagged_lbl <- FCode BlockId
forall (m :: * -> *). MonadUnique m => m BlockId
newBlockId
BlockId
end_lbl <- FCode BlockId
forall (m :: * -> *). MonadUnique m => m BlockId
newBlockId
let correct_arity :: CmmExpr
correct_arity = DynFlags -> CmmExpr -> CmmExpr -> CmmExpr
cmmEqWord DynFlags
dflags (DynFlags -> CmmExpr -> CmmExpr
funInfoArity DynFlags
dflags CmmExpr
fun_iptr)
(DynFlags -> UpdFrameOffset -> CmmExpr
mkIntExpr DynFlags
dflags UpdFrameOffset
n_args)
CmmTickScope
tscope <- FCode CmmTickScope
getTickScope
CmmAGraph -> FCode ()
emit (CmmExpr -> BlockId -> BlockId -> Maybe Bool -> CmmAGraph
mkCbranch (DynFlags -> CmmExpr -> CmmExpr
cmmIsTagged DynFlags
dflags CmmExpr
funv)
BlockId
is_tagged_lbl BlockId
slow_lbl (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True)
CmmAGraph -> CmmAGraph -> CmmAGraph
<*> BlockId -> CmmTickScope -> CmmAGraph
mkLabel BlockId
is_tagged_lbl CmmTickScope
tscope
CmmAGraph -> CmmAGraph -> CmmAGraph
<*> CmmExpr -> BlockId -> BlockId -> Maybe Bool -> CmmAGraph
mkCbranch CmmExpr
correct_arity BlockId
fast_lbl BlockId
slow_lbl (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True)
CmmAGraph -> CmmAGraph -> CmmAGraph
<*> BlockId -> CmmTickScope -> CmmAGraph
mkLabel BlockId
fast_lbl CmmTickScope
tscope
CmmAGraph -> CmmAGraph -> CmmAGraph
<*> CmmAGraph
fast_code
CmmAGraph -> CmmAGraph -> CmmAGraph
<*> BlockId -> CmmAGraph
mkBranch BlockId
end_lbl
CmmAGraph -> CmmAGraph -> CmmAGraph
<*> BlockId -> CmmTickScope -> CmmAGraph
mkLabel BlockId
slow_lbl CmmTickScope
tscope
CmmAGraph -> CmmAGraph -> CmmAGraph
<*> CmmAGraph
slow_code
CmmAGraph -> CmmAGraph -> CmmAGraph
<*> BlockId -> CmmTickScope -> CmmAGraph
mkLabel BlockId
end_lbl CmmTickScope
tscope)
ReturnKind -> FCode ReturnKind
forall (m :: * -> *) a. Monad m => a -> m a
return ReturnKind
r
else do
CmmAGraph -> FCode ()
emit CmmAGraph
slow_code
ReturnKind -> FCode ReturnKind
forall (m :: * -> *) a. Monad m => a -> m a
return ReturnKind
r
direct_call :: String
-> Convention
-> CLabel -> RepArity
-> [(ArgRep,Maybe CmmExpr)] -> FCode ReturnKind
direct_call :: String
-> Convention
-> CLabel
-> UpdFrameOffset
-> [(ArgRep, Maybe CmmExpr)]
-> FCode ReturnKind
direct_call String
caller Convention
call_conv CLabel
lbl UpdFrameOffset
arity [(ArgRep, Maybe CmmExpr)]
args
| Bool
debugIsOn Bool -> Bool -> Bool
&& [(ArgRep, Maybe CmmExpr)]
args [(ArgRep, Maybe CmmExpr)] -> UpdFrameOffset -> Bool
forall a. [a] -> UpdFrameOffset -> Bool
`lengthLessThan` UpdFrameOffset
real_arity
= do
String -> SDoc -> FCode ReturnKind
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"direct_call" (SDoc -> FCode ReturnKind) -> SDoc -> FCode ReturnKind
forall a b. (a -> b) -> a -> b
$
String -> SDoc
text String
caller SDoc -> SDoc -> SDoc
<+> UpdFrameOffset -> SDoc
forall a. Outputable a => a -> SDoc
ppr UpdFrameOffset
arity SDoc -> SDoc -> SDoc
<+>
CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
lbl SDoc -> SDoc -> SDoc
<+> UpdFrameOffset -> SDoc
forall a. Outputable a => a -> SDoc
ppr ([(ArgRep, Maybe CmmExpr)] -> UpdFrameOffset
forall (t :: * -> *) a. Foldable t => t a -> UpdFrameOffset
length [(ArgRep, Maybe CmmExpr)]
args) SDoc -> SDoc -> SDoc
<+>
[Maybe CmmExpr] -> SDoc
forall a. Outputable a => a -> SDoc
ppr (((ArgRep, Maybe CmmExpr) -> Maybe CmmExpr)
-> [(ArgRep, Maybe CmmExpr)] -> [Maybe CmmExpr]
forall a b. (a -> b) -> [a] -> [b]
map (ArgRep, Maybe CmmExpr) -> Maybe CmmExpr
forall a b. (a, b) -> b
snd [(ArgRep, Maybe CmmExpr)]
args) SDoc -> SDoc -> SDoc
<+> [ArgRep] -> SDoc
forall a. Outputable a => a -> SDoc
ppr (((ArgRep, Maybe CmmExpr) -> ArgRep)
-> [(ArgRep, Maybe CmmExpr)] -> [ArgRep]
forall a b. (a -> b) -> [a] -> [b]
map (ArgRep, Maybe CmmExpr) -> ArgRep
forall a b. (a, b) -> a
fst [(ArgRep, Maybe CmmExpr)]
args)
| [(ArgRep, Maybe CmmExpr)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(ArgRep, Maybe CmmExpr)]
rest_args
= (Convention, Convention)
-> CmmExpr -> [CmmExpr] -> FCode ReturnKind
emitCall (Convention
call_conv, Convention
NativeReturn) CmmExpr
target ([(ArgRep, Maybe CmmExpr)] -> [CmmExpr]
nonVArgs [(ArgRep, Maybe CmmExpr)]
args)
| Bool
otherwise
= do DynFlags
dflags <- FCode DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
(Convention, Convention)
-> CmmExpr -> [CmmExpr] -> [CmmExpr] -> FCode ReturnKind
emitCallWithExtraStack (Convention
call_conv, Convention
NativeReturn)
CmmExpr
target
([(ArgRep, Maybe CmmExpr)] -> [CmmExpr]
nonVArgs [(ArgRep, Maybe CmmExpr)]
fast_args)
([(ArgRep, Maybe CmmExpr)] -> [CmmExpr]
nonVArgs (DynFlags -> [(ArgRep, Maybe CmmExpr)]
stack_args DynFlags
dflags))
where
target :: CmmExpr
target = CmmLit -> CmmExpr
CmmLit (CLabel -> CmmLit
CmmLabel CLabel
lbl)
([(ArgRep, Maybe CmmExpr)]
fast_args, [(ArgRep, Maybe CmmExpr)]
rest_args) = UpdFrameOffset
-> [(ArgRep, Maybe CmmExpr)]
-> ([(ArgRep, Maybe CmmExpr)], [(ArgRep, Maybe CmmExpr)])
forall a. UpdFrameOffset -> [a] -> ([a], [a])
splitAt UpdFrameOffset
real_arity [(ArgRep, Maybe CmmExpr)]
args
stack_args :: DynFlags -> [(ArgRep, Maybe CmmExpr)]
stack_args DynFlags
dflags = DynFlags -> [(ArgRep, Maybe CmmExpr)] -> [(ArgRep, Maybe CmmExpr)]
slowArgs DynFlags
dflags [(ArgRep, Maybe CmmExpr)]
rest_args
real_arity :: UpdFrameOffset
real_arity = case Convention
call_conv of
Convention
NativeNodeCall -> UpdFrameOffset
arityUpdFrameOffset -> UpdFrameOffset -> UpdFrameOffset
forall a. Num a => a -> a -> a
+UpdFrameOffset
1
Convention
_ -> UpdFrameOffset
arity
getArgRepsAmodes :: [StgArg] -> FCode [(ArgRep, Maybe CmmExpr)]
getArgRepsAmodes :: [StgArg] -> FCode [(ArgRep, Maybe CmmExpr)]
getArgRepsAmodes = (StgArg -> FCode (ArgRep, Maybe CmmExpr))
-> [StgArg] -> FCode [(ArgRep, Maybe CmmExpr)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM StgArg -> FCode (ArgRep, Maybe CmmExpr)
getArgRepAmode
where getArgRepAmode :: StgArg -> FCode (ArgRep, Maybe CmmExpr)
getArgRepAmode StgArg
arg
| ArgRep
V <- ArgRep
rep = (ArgRep, Maybe CmmExpr) -> FCode (ArgRep, Maybe CmmExpr)
forall (m :: * -> *) a. Monad m => a -> m a
return (ArgRep
V, Maybe CmmExpr
forall a. Maybe a
Nothing)
| Bool
otherwise = do CmmExpr
expr <- NonVoid StgArg -> FCode CmmExpr
getArgAmode (StgArg -> NonVoid StgArg
forall a. a -> NonVoid a
NonVoid StgArg
arg)
(ArgRep, Maybe CmmExpr) -> FCode (ArgRep, Maybe CmmExpr)
forall (m :: * -> *) a. Monad m => a -> m a
return (ArgRep
rep, CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just CmmExpr
expr)
where rep :: ArgRep
rep = PrimRep -> ArgRep
toArgRep (StgArg -> PrimRep
argPrimRep StgArg
arg)
nonVArgs :: [(ArgRep, Maybe CmmExpr)] -> [CmmExpr]
nonVArgs :: [(ArgRep, Maybe CmmExpr)] -> [CmmExpr]
nonVArgs [] = []
nonVArgs ((ArgRep
_,Maybe CmmExpr
Nothing) : [(ArgRep, Maybe CmmExpr)]
args) = [(ArgRep, Maybe CmmExpr)] -> [CmmExpr]
nonVArgs [(ArgRep, Maybe CmmExpr)]
args
nonVArgs ((ArgRep
_,Just CmmExpr
arg) : [(ArgRep, Maybe CmmExpr)]
args) = CmmExpr
arg CmmExpr -> [CmmExpr] -> [CmmExpr]
forall a. a -> [a] -> [a]
: [(ArgRep, Maybe CmmExpr)] -> [CmmExpr]
nonVArgs [(ArgRep, Maybe CmmExpr)]
args
slowArgs :: DynFlags -> [(ArgRep, Maybe CmmExpr)] -> [(ArgRep, Maybe CmmExpr)]
slowArgs :: DynFlags -> [(ArgRep, Maybe CmmExpr)] -> [(ArgRep, Maybe CmmExpr)]
slowArgs DynFlags
_ [] = []
slowArgs DynFlags
dflags [(ArgRep, Maybe CmmExpr)]
args
| GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_SccProfilingOn DynFlags
dflags
= [(ArgRep, Maybe CmmExpr)]
save_cccs [(ArgRep, Maybe CmmExpr)]
-> [(ArgRep, Maybe CmmExpr)] -> [(ArgRep, Maybe CmmExpr)]
forall a. [a] -> [a] -> [a]
++ [(ArgRep, Maybe CmmExpr)]
this_pat [(ArgRep, Maybe CmmExpr)]
-> [(ArgRep, Maybe CmmExpr)] -> [(ArgRep, Maybe CmmExpr)]
forall a. [a] -> [a] -> [a]
++ DynFlags -> [(ArgRep, Maybe CmmExpr)] -> [(ArgRep, Maybe CmmExpr)]
slowArgs DynFlags
dflags [(ArgRep, Maybe CmmExpr)]
rest_args
| Bool
otherwise = [(ArgRep, Maybe CmmExpr)]
this_pat [(ArgRep, Maybe CmmExpr)]
-> [(ArgRep, Maybe CmmExpr)] -> [(ArgRep, Maybe CmmExpr)]
forall a. [a] -> [a] -> [a]
++ DynFlags -> [(ArgRep, Maybe CmmExpr)] -> [(ArgRep, Maybe CmmExpr)]
slowArgs DynFlags
dflags [(ArgRep, Maybe CmmExpr)]
rest_args
where
(FastString
arg_pat, UpdFrameOffset
n) = [ArgRep] -> (FastString, UpdFrameOffset)
slowCallPattern (((ArgRep, Maybe CmmExpr) -> ArgRep)
-> [(ArgRep, Maybe CmmExpr)] -> [ArgRep]
forall a b. (a -> b) -> [a] -> [b]
map (ArgRep, Maybe CmmExpr) -> ArgRep
forall a b. (a, b) -> a
fst [(ArgRep, Maybe CmmExpr)]
args)
([(ArgRep, Maybe CmmExpr)]
call_args, [(ArgRep, Maybe CmmExpr)]
rest_args) = UpdFrameOffset
-> [(ArgRep, Maybe CmmExpr)]
-> ([(ArgRep, Maybe CmmExpr)], [(ArgRep, Maybe CmmExpr)])
forall a. UpdFrameOffset -> [a] -> ([a], [a])
splitAt UpdFrameOffset
n [(ArgRep, Maybe CmmExpr)]
args
stg_ap_pat :: CLabel
stg_ap_pat = UnitId -> FastString -> CLabel
mkCmmRetInfoLabel UnitId
rtsUnitId FastString
arg_pat
this_pat :: [(ArgRep, Maybe CmmExpr)]
this_pat = (ArgRep
N, CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just (CLabel -> CmmExpr
mkLblExpr CLabel
stg_ap_pat)) (ArgRep, Maybe CmmExpr)
-> [(ArgRep, Maybe CmmExpr)] -> [(ArgRep, Maybe CmmExpr)]
forall a. a -> [a] -> [a]
: [(ArgRep, Maybe CmmExpr)]
call_args
save_cccs :: [(ArgRep, Maybe CmmExpr)]
save_cccs = [(ArgRep
N, CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just (CLabel -> CmmExpr
mkLblExpr CLabel
save_cccs_lbl)), (ArgRep
N, CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just CmmExpr
cccsExpr)]
save_cccs_lbl :: CLabel
save_cccs_lbl = UnitId -> FastString -> CLabel
mkCmmRetInfoLabel UnitId
rtsUnitId (String -> FastString
fsLit String
"stg_restore_cccs")
hpRel :: VirtualHpOffset
-> VirtualHpOffset
-> WordOff
hpRel :: UpdFrameOffset -> UpdFrameOffset -> UpdFrameOffset
hpRel UpdFrameOffset
hp UpdFrameOffset
off = UpdFrameOffset
off UpdFrameOffset -> UpdFrameOffset -> UpdFrameOffset
forall a. Num a => a -> a -> a
- UpdFrameOffset
hp
getHpRelOffset :: VirtualHpOffset -> FCode CmmExpr
getHpRelOffset :: UpdFrameOffset -> FCode CmmExpr
getHpRelOffset UpdFrameOffset
virtual_offset
= do DynFlags
dflags <- FCode DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
HeapUsage
hp_usg <- FCode HeapUsage
getHpUsage
CmmExpr -> FCode CmmExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (DynFlags -> CmmReg -> UpdFrameOffset -> CmmExpr
cmmRegOffW DynFlags
dflags CmmReg
hpReg (UpdFrameOffset -> UpdFrameOffset -> UpdFrameOffset
hpRel (HeapUsage -> UpdFrameOffset
realHp HeapUsage
hp_usg) UpdFrameOffset
virtual_offset))
data FieldOffOrPadding a
= FieldOff (NonVoid a)
ByteOff
| Padding ByteOff
ByteOff
data
=
|
|
mkVirtHeapOffsetsWithPadding
:: DynFlags
-> ClosureHeader
-> [NonVoid (PrimRep, a)]
-> ( WordOff
, WordOff
, [FieldOffOrPadding a]
)
mkVirtHeapOffsetsWithPadding :: DynFlags
-> ClosureHeader
-> [NonVoid (PrimRep, a)]
-> (UpdFrameOffset, UpdFrameOffset, [FieldOffOrPadding a])
mkVirtHeapOffsetsWithPadding DynFlags
dflags ClosureHeader
header [NonVoid (PrimRep, a)]
things =
ASSERT(not (any (isVoidRep . fst . fromNonVoid) things))
( UpdFrameOffset
tot_wds
, DynFlags -> UpdFrameOffset -> UpdFrameOffset
bytesToWordsRoundUp DynFlags
dflags UpdFrameOffset
bytes_of_ptrs
, [[FieldOffOrPadding a]] -> [FieldOffOrPadding a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[FieldOffOrPadding a]]
ptrs_w_offsets [[FieldOffOrPadding a]]
-> [[FieldOffOrPadding a]] -> [[FieldOffOrPadding a]]
forall a. [a] -> [a] -> [a]
++ [[FieldOffOrPadding a]]
non_ptrs_w_offsets) [FieldOffOrPadding a]
-> [FieldOffOrPadding a] -> [FieldOffOrPadding a]
forall a. [a] -> [a] -> [a]
++ [FieldOffOrPadding a]
forall a. [FieldOffOrPadding a]
final_pad
)
where
hdr_words :: UpdFrameOffset
hdr_words = case ClosureHeader
header of
ClosureHeader
NoHeader -> UpdFrameOffset
0
ClosureHeader
StdHeader -> DynFlags -> UpdFrameOffset
fixedHdrSizeW DynFlags
dflags
ClosureHeader
ThunkHeader -> DynFlags -> UpdFrameOffset
thunkHdrSize DynFlags
dflags
hdr_bytes :: UpdFrameOffset
hdr_bytes = DynFlags -> UpdFrameOffset -> UpdFrameOffset
forall a. Num a => DynFlags -> a -> a
wordsToBytes DynFlags
dflags UpdFrameOffset
hdr_words
([NonVoid (PrimRep, a)]
ptrs, [NonVoid (PrimRep, a)]
non_ptrs) = (NonVoid (PrimRep, a) -> Bool)
-> [NonVoid (PrimRep, a)]
-> ([NonVoid (PrimRep, a)], [NonVoid (PrimRep, a)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (PrimRep -> Bool
isGcPtrRep (PrimRep -> Bool)
-> (NonVoid (PrimRep, a) -> PrimRep)
-> NonVoid (PrimRep, a)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PrimRep, a) -> PrimRep
forall a b. (a, b) -> a
fst ((PrimRep, a) -> PrimRep)
-> (NonVoid (PrimRep, a) -> (PrimRep, a))
-> NonVoid (PrimRep, a)
-> PrimRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonVoid (PrimRep, a) -> (PrimRep, a)
forall a. NonVoid a -> a
fromNonVoid) [NonVoid (PrimRep, a)]
things
(UpdFrameOffset
bytes_of_ptrs, [[FieldOffOrPadding a]]
ptrs_w_offsets) =
(UpdFrameOffset
-> NonVoid (PrimRep, a) -> (UpdFrameOffset, [FieldOffOrPadding a]))
-> UpdFrameOffset
-> [NonVoid (PrimRep, a)]
-> (UpdFrameOffset, [[FieldOffOrPadding a]])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL UpdFrameOffset
-> NonVoid (PrimRep, a) -> (UpdFrameOffset, [FieldOffOrPadding a])
forall a.
UpdFrameOffset
-> NonVoid (PrimRep, a) -> (UpdFrameOffset, [FieldOffOrPadding a])
computeOffset UpdFrameOffset
0 [NonVoid (PrimRep, a)]
ptrs
(UpdFrameOffset
tot_bytes, [[FieldOffOrPadding a]]
non_ptrs_w_offsets) =
(UpdFrameOffset
-> NonVoid (PrimRep, a) -> (UpdFrameOffset, [FieldOffOrPadding a]))
-> UpdFrameOffset
-> [NonVoid (PrimRep, a)]
-> (UpdFrameOffset, [[FieldOffOrPadding a]])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL UpdFrameOffset
-> NonVoid (PrimRep, a) -> (UpdFrameOffset, [FieldOffOrPadding a])
forall a.
UpdFrameOffset
-> NonVoid (PrimRep, a) -> (UpdFrameOffset, [FieldOffOrPadding a])
computeOffset UpdFrameOffset
bytes_of_ptrs [NonVoid (PrimRep, a)]
non_ptrs
tot_wds :: UpdFrameOffset
tot_wds = DynFlags -> UpdFrameOffset -> UpdFrameOffset
bytesToWordsRoundUp DynFlags
dflags UpdFrameOffset
tot_bytes
final_pad_size :: UpdFrameOffset
final_pad_size = UpdFrameOffset
tot_wds UpdFrameOffset -> UpdFrameOffset -> UpdFrameOffset
forall a. Num a => a -> a -> a
* UpdFrameOffset
word_size UpdFrameOffset -> UpdFrameOffset -> UpdFrameOffset
forall a. Num a => a -> a -> a
- UpdFrameOffset
tot_bytes
final_pad :: [FieldOffOrPadding a]
final_pad
| UpdFrameOffset
final_pad_size UpdFrameOffset -> UpdFrameOffset -> Bool
forall a. Ord a => a -> a -> Bool
> UpdFrameOffset
0 = [(UpdFrameOffset -> UpdFrameOffset -> FieldOffOrPadding a
forall a. UpdFrameOffset -> UpdFrameOffset -> FieldOffOrPadding a
Padding UpdFrameOffset
final_pad_size
(UpdFrameOffset
hdr_bytes UpdFrameOffset -> UpdFrameOffset -> UpdFrameOffset
forall a. Num a => a -> a -> a
+ UpdFrameOffset
tot_bytes))]
| Bool
otherwise = []
word_size :: UpdFrameOffset
word_size = DynFlags -> UpdFrameOffset
wORD_SIZE DynFlags
dflags
computeOffset :: UpdFrameOffset
-> NonVoid (PrimRep, a) -> (UpdFrameOffset, [FieldOffOrPadding a])
computeOffset UpdFrameOffset
bytes_so_far NonVoid (PrimRep, a)
nv_thing =
(UpdFrameOffset
new_bytes_so_far, FieldOffOrPadding a -> [FieldOffOrPadding a]
forall a. FieldOffOrPadding a -> [FieldOffOrPadding a]
with_padding FieldOffOrPadding a
field_off)
where
(PrimRep
rep, a
thing) = NonVoid (PrimRep, a) -> (PrimRep, a)
forall a. NonVoid a -> a
fromNonVoid NonVoid (PrimRep, a)
nv_thing
!sizeB :: UpdFrameOffset
sizeB = DynFlags -> PrimRep -> UpdFrameOffset
primRepSizeB DynFlags
dflags PrimRep
rep
!align :: UpdFrameOffset
align = UpdFrameOffset -> UpdFrameOffset -> UpdFrameOffset
forall a. Ord a => a -> a -> a
min UpdFrameOffset
word_size UpdFrameOffset
sizeB
!start :: UpdFrameOffset
start = UpdFrameOffset -> UpdFrameOffset -> UpdFrameOffset
roundUpTo UpdFrameOffset
bytes_so_far UpdFrameOffset
align
!padding :: UpdFrameOffset
padding = UpdFrameOffset
start UpdFrameOffset -> UpdFrameOffset -> UpdFrameOffset
forall a. Num a => a -> a -> a
- UpdFrameOffset
bytes_so_far
!final_offset :: UpdFrameOffset
final_offset = UpdFrameOffset
hdr_bytes UpdFrameOffset -> UpdFrameOffset -> UpdFrameOffset
forall a. Num a => a -> a -> a
+ UpdFrameOffset
bytes_so_far UpdFrameOffset -> UpdFrameOffset -> UpdFrameOffset
forall a. Num a => a -> a -> a
+ UpdFrameOffset
padding
!new_bytes_so_far :: UpdFrameOffset
new_bytes_so_far = UpdFrameOffset
start UpdFrameOffset -> UpdFrameOffset -> UpdFrameOffset
forall a. Num a => a -> a -> a
+ UpdFrameOffset
sizeB
field_off :: FieldOffOrPadding a
field_off = NonVoid a -> UpdFrameOffset -> FieldOffOrPadding a
forall a. NonVoid a -> UpdFrameOffset -> FieldOffOrPadding a
FieldOff (a -> NonVoid a
forall a. a -> NonVoid a
NonVoid a
thing) UpdFrameOffset
final_offset
with_padding :: FieldOffOrPadding a -> [FieldOffOrPadding a]
with_padding FieldOffOrPadding a
field_off
| UpdFrameOffset
padding UpdFrameOffset -> UpdFrameOffset -> Bool
forall a. Eq a => a -> a -> Bool
== UpdFrameOffset
0 = [FieldOffOrPadding a
field_off]
| Bool
otherwise = [ UpdFrameOffset -> UpdFrameOffset -> FieldOffOrPadding a
forall a. UpdFrameOffset -> UpdFrameOffset -> FieldOffOrPadding a
Padding UpdFrameOffset
padding (UpdFrameOffset
hdr_bytes UpdFrameOffset -> UpdFrameOffset -> UpdFrameOffset
forall a. Num a => a -> a -> a
+ UpdFrameOffset
bytes_so_far)
, FieldOffOrPadding a
field_off
]
mkVirtHeapOffsets
:: DynFlags
-> ClosureHeader
-> [NonVoid (PrimRep,a)]
-> (WordOff,
WordOff,
[(NonVoid a, ByteOff)])
mkVirtHeapOffsets :: DynFlags
-> ClosureHeader
-> [NonVoid (PrimRep, a)]
-> (UpdFrameOffset, UpdFrameOffset, [(NonVoid a, UpdFrameOffset)])
mkVirtHeapOffsets DynFlags
dflags ClosureHeader
header [NonVoid (PrimRep, a)]
things =
( UpdFrameOffset
tot_wds
, UpdFrameOffset
ptr_wds
, [ (NonVoid a
field, UpdFrameOffset
offset) | (FieldOff NonVoid a
field UpdFrameOffset
offset) <- [FieldOffOrPadding a]
things_offsets ]
)
where
(UpdFrameOffset
tot_wds, UpdFrameOffset
ptr_wds, [FieldOffOrPadding a]
things_offsets) =
DynFlags
-> ClosureHeader
-> [NonVoid (PrimRep, a)]
-> (UpdFrameOffset, UpdFrameOffset, [FieldOffOrPadding a])
forall a.
DynFlags
-> ClosureHeader
-> [NonVoid (PrimRep, a)]
-> (UpdFrameOffset, UpdFrameOffset, [FieldOffOrPadding a])
mkVirtHeapOffsetsWithPadding DynFlags
dflags ClosureHeader
header [NonVoid (PrimRep, a)]
things
mkVirtConstrOffsets
:: DynFlags -> [NonVoid (PrimRep, a)]
-> (WordOff, WordOff, [(NonVoid a, ByteOff)])
mkVirtConstrOffsets :: DynFlags
-> [NonVoid (PrimRep, a)]
-> (UpdFrameOffset, UpdFrameOffset, [(NonVoid a, UpdFrameOffset)])
mkVirtConstrOffsets DynFlags
dflags = DynFlags
-> ClosureHeader
-> [NonVoid (PrimRep, a)]
-> (UpdFrameOffset, UpdFrameOffset, [(NonVoid a, UpdFrameOffset)])
forall a.
DynFlags
-> ClosureHeader
-> [NonVoid (PrimRep, a)]
-> (UpdFrameOffset, UpdFrameOffset, [(NonVoid a, UpdFrameOffset)])
mkVirtHeapOffsets DynFlags
dflags ClosureHeader
StdHeader
mkVirtConstrSizes :: DynFlags -> [NonVoid PrimRep] -> (WordOff, WordOff)
mkVirtConstrSizes :: DynFlags -> [NonVoid PrimRep] -> (UpdFrameOffset, UpdFrameOffset)
mkVirtConstrSizes DynFlags
dflags [NonVoid PrimRep]
field_reps
= (UpdFrameOffset
tot_wds, UpdFrameOffset
ptr_wds)
where
(UpdFrameOffset
tot_wds, UpdFrameOffset
ptr_wds, [(NonVoid (), UpdFrameOffset)]
_) =
DynFlags
-> [NonVoid (PrimRep, ())]
-> (UpdFrameOffset, UpdFrameOffset, [(NonVoid (), UpdFrameOffset)])
forall a.
DynFlags
-> [NonVoid (PrimRep, a)]
-> (UpdFrameOffset, UpdFrameOffset, [(NonVoid a, UpdFrameOffset)])
mkVirtConstrOffsets DynFlags
dflags
((NonVoid PrimRep -> NonVoid (PrimRep, ()))
-> [NonVoid PrimRep] -> [NonVoid (PrimRep, ())]
forall a b. (a -> b) -> [a] -> [b]
map (\NonVoid PrimRep
nv_rep -> (PrimRep, ()) -> NonVoid (PrimRep, ())
forall a. a -> NonVoid a
NonVoid (NonVoid PrimRep -> PrimRep
forall a. NonVoid a -> a
fromNonVoid NonVoid PrimRep
nv_rep, ())) [NonVoid PrimRep]
field_reps)
#include "rts/storage/FunTypes.h"
mkArgDescr :: DynFlags -> [Id] -> ArgDescr
mkArgDescr :: DynFlags -> [Id] -> ArgDescr
mkArgDescr DynFlags
dflags [Id]
args
= let arg_bits :: [Bool]
arg_bits = DynFlags -> [ArgRep] -> [Bool]
argBits DynFlags
dflags [ArgRep]
arg_reps
arg_reps :: [ArgRep]
arg_reps = (ArgRep -> Bool) -> [ArgRep] -> [ArgRep]
forall a. (a -> Bool) -> [a] -> [a]
filter ArgRep -> Bool
isNonV ((Id -> ArgRep) -> [Id] -> [ArgRep]
forall a b. (a -> b) -> [a] -> [b]
map Id -> ArgRep
idArgRep [Id]
args)
in case [ArgRep] -> Maybe UpdFrameOffset
stdPattern [ArgRep]
arg_reps of
Just UpdFrameOffset
spec_id -> UpdFrameOffset -> ArgDescr
ArgSpec UpdFrameOffset
spec_id
Maybe UpdFrameOffset
Nothing -> [Bool] -> ArgDescr
ArgGen [Bool]
arg_bits
argBits :: DynFlags -> [ArgRep] -> [Bool]
argBits :: DynFlags -> [ArgRep] -> [Bool]
argBits DynFlags
_ [] = []
argBits DynFlags
dflags (ArgRep
P : [ArgRep]
args) = Bool
False Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: DynFlags -> [ArgRep] -> [Bool]
argBits DynFlags
dflags [ArgRep]
args
argBits DynFlags
dflags (ArgRep
arg : [ArgRep]
args) = UpdFrameOffset -> [Bool] -> [Bool]
forall a. UpdFrameOffset -> [a] -> [a]
take (DynFlags -> ArgRep -> UpdFrameOffset
argRepSizeW DynFlags
dflags ArgRep
arg) (Bool -> [Bool]
forall a. a -> [a]
repeat Bool
True)
[Bool] -> [Bool] -> [Bool]
forall a. [a] -> [a] -> [a]
++ DynFlags -> [ArgRep] -> [Bool]
argBits DynFlags
dflags [ArgRep]
args
stdPattern :: [ArgRep] -> Maybe Int
stdPattern :: [ArgRep] -> Maybe UpdFrameOffset
stdPattern [ArgRep]
reps
= case [ArgRep]
reps of
[] -> UpdFrameOffset -> Maybe UpdFrameOffset
forall a. a -> Maybe a
Just ARG_NONE
[ArgRep
N] -> UpdFrameOffset -> Maybe UpdFrameOffset
forall a. a -> Maybe a
Just ARG_N
[ArgRep
P] -> UpdFrameOffset -> Maybe UpdFrameOffset
forall a. a -> Maybe a
Just ARG_P
[ArgRep
F] -> UpdFrameOffset -> Maybe UpdFrameOffset
forall a. a -> Maybe a
Just ARG_F
[ArgRep
D] -> UpdFrameOffset -> Maybe UpdFrameOffset
forall a. a -> Maybe a
Just ARG_D
[ArgRep
L] -> UpdFrameOffset -> Maybe UpdFrameOffset
forall a. a -> Maybe a
Just ARG_L
[ArgRep
V16] -> UpdFrameOffset -> Maybe UpdFrameOffset
forall a. a -> Maybe a
Just ARG_V16
[ArgRep
V32] -> UpdFrameOffset -> Maybe UpdFrameOffset
forall a. a -> Maybe a
Just ARG_V32
[ArgRep
V64] -> UpdFrameOffset -> Maybe UpdFrameOffset
forall a. a -> Maybe a
Just ARG_V64
[ArgRep
N,ArgRep
N] -> UpdFrameOffset -> Maybe UpdFrameOffset
forall a. a -> Maybe a
Just ARG_NN
[ArgRep
N,ArgRep
P] -> UpdFrameOffset -> Maybe UpdFrameOffset
forall a. a -> Maybe a
Just ARG_NP
[ArgRep
P,ArgRep
N] -> UpdFrameOffset -> Maybe UpdFrameOffset
forall a. a -> Maybe a
Just ARG_PN
[ArgRep
P,ArgRep
P] -> UpdFrameOffset -> Maybe UpdFrameOffset
forall a. a -> Maybe a
Just ARG_PP
[ArgRep
N,ArgRep
N,ArgRep
N] -> UpdFrameOffset -> Maybe UpdFrameOffset
forall a. a -> Maybe a
Just ARG_NNN
[ArgRep
N,ArgRep
N,ArgRep
P] -> UpdFrameOffset -> Maybe UpdFrameOffset
forall a. a -> Maybe a
Just ARG_NNP
[ArgRep
N,ArgRep
P,ArgRep
N] -> UpdFrameOffset -> Maybe UpdFrameOffset
forall a. a -> Maybe a
Just ARG_NPN
[ArgRep
N,ArgRep
P,ArgRep
P] -> UpdFrameOffset -> Maybe UpdFrameOffset
forall a. a -> Maybe a
Just ARG_NPP
[ArgRep
P,ArgRep
N,ArgRep
N] -> UpdFrameOffset -> Maybe UpdFrameOffset
forall a. a -> Maybe a
Just ARG_PNN
[ArgRep
P,ArgRep
N,ArgRep
P] -> UpdFrameOffset -> Maybe UpdFrameOffset
forall a. a -> Maybe a
Just ARG_PNP
[ArgRep
P,ArgRep
P,ArgRep
N] -> UpdFrameOffset -> Maybe UpdFrameOffset
forall a. a -> Maybe a
Just ARG_PPN
[ArgRep
P,ArgRep
P,ArgRep
P] -> UpdFrameOffset -> Maybe UpdFrameOffset
forall a. a -> Maybe a
Just ARG_PPP
[ArgRep
P,ArgRep
P,ArgRep
P,ArgRep
P] -> UpdFrameOffset -> Maybe UpdFrameOffset
forall a. a -> Maybe a
Just ARG_PPPP
[ArgRep
P,ArgRep
P,ArgRep
P,ArgRep
P,ArgRep
P] -> UpdFrameOffset -> Maybe UpdFrameOffset
forall a. a -> Maybe a
Just ARG_PPPPP
[ArgRep
P,ArgRep
P,ArgRep
P,ArgRep
P,ArgRep
P,ArgRep
P] -> UpdFrameOffset -> Maybe UpdFrameOffset
forall a. a -> Maybe a
Just ARG_PPPPPP
[ArgRep]
_ -> Maybe UpdFrameOffset
forall a. Maybe a
Nothing
emitClosureProcAndInfoTable :: Bool
-> Id
-> LambdaFormInfo
-> CmmInfoTable
-> [NonVoid Id]
-> ((Int, LocalReg, [LocalReg]) -> FCode ())
-> FCode ()
emitClosureProcAndInfoTable :: Bool
-> Id
-> LambdaFormInfo
-> CmmInfoTable
-> [NonVoid Id]
-> ((UpdFrameOffset, LocalReg, [LocalReg]) -> FCode ())
-> FCode ()
emitClosureProcAndInfoTable Bool
top_lvl Id
bndr LambdaFormInfo
lf_info CmmInfoTable
info_tbl [NonVoid Id]
args (UpdFrameOffset, LocalReg, [LocalReg]) -> FCode ()
body
= do { DynFlags
dflags <- FCode DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
; LocalReg
node <- if Bool
top_lvl then LocalReg -> FCode LocalReg
forall (m :: * -> *) a. Monad m => a -> m a
return (LocalReg -> FCode LocalReg) -> LocalReg -> FCode LocalReg
forall a b. (a -> b) -> a -> b
$ DynFlags -> NonVoid Id -> LocalReg
idToReg DynFlags
dflags (Id -> NonVoid Id
forall a. a -> NonVoid a
NonVoid Id
bndr)
else NonVoid Id -> LambdaFormInfo -> FCode LocalReg
bindToReg (Id -> NonVoid Id
forall a. a -> NonVoid a
NonVoid Id
bndr) LambdaFormInfo
lf_info
; let node_points :: Bool
node_points = DynFlags -> LambdaFormInfo -> Bool
nodeMustPointToIt DynFlags
dflags LambdaFormInfo
lf_info
; [LocalReg]
arg_regs <- [NonVoid Id] -> FCode [LocalReg]
bindArgsToRegs [NonVoid Id]
args
; let args' :: [LocalReg]
args' = if Bool
node_points then (LocalReg
node LocalReg -> [LocalReg] -> [LocalReg]
forall a. a -> [a] -> [a]
: [LocalReg]
arg_regs) else [LocalReg]
arg_regs
conv :: Convention
conv = if DynFlags -> LambdaFormInfo -> Bool
nodeMustPointToIt DynFlags
dflags LambdaFormInfo
lf_info then Convention
NativeNodeCall
else Convention
NativeDirectCall
(UpdFrameOffset
offset, [GlobalReg]
_, CmmAGraph
_) = DynFlags
-> Convention
-> [LocalReg]
-> [LocalReg]
-> (UpdFrameOffset, [GlobalReg], CmmAGraph)
mkCallEntry DynFlags
dflags Convention
conv [LocalReg]
args' []
; CmmInfoTable -> Convention -> [LocalReg] -> FCode () -> FCode ()
emitClosureAndInfoTable CmmInfoTable
info_tbl Convention
conv [LocalReg]
args' (FCode () -> FCode ()) -> FCode () -> FCode ()
forall a b. (a -> b) -> a -> b
$ (UpdFrameOffset, LocalReg, [LocalReg]) -> FCode ()
body (UpdFrameOffset
offset, LocalReg
node, [LocalReg]
arg_regs)
}
emitClosureAndInfoTable ::
CmmInfoTable -> Convention -> [LocalReg] -> FCode () -> FCode ()
emitClosureAndInfoTable :: CmmInfoTable -> Convention -> [LocalReg] -> FCode () -> FCode ()
emitClosureAndInfoTable CmmInfoTable
info_tbl Convention
conv [LocalReg]
args FCode ()
body
= do { (()
_, CmmAGraphScoped
blks) <- FCode () -> FCode ((), CmmAGraphScoped)
forall a. FCode a -> FCode (a, CmmAGraphScoped)
getCodeScoped FCode ()
body
; let entry_lbl :: CLabel
entry_lbl = CLabel -> CLabel
toEntryLbl (CmmInfoTable -> CLabel
cit_lbl CmmInfoTable
info_tbl)
; Convention
-> Maybe CmmInfoTable
-> CLabel
-> [LocalReg]
-> CmmAGraphScoped
-> FCode ()
emitProcWithConvention Convention
conv (CmmInfoTable -> Maybe CmmInfoTable
forall a. a -> Maybe a
Just CmmInfoTable
info_tbl) CLabel
entry_lbl [LocalReg]
args CmmAGraphScoped
blks
}