Commit e239aa23 authored by dias@eecs.tufts.edu's avatar dias@eecs.tufts.edu
Browse files

Small step toward call-conv improvement: separate out calls and returns

parent f9d5c95f
......@@ -56,19 +56,21 @@ assignArgumentsPos conv isCall arg_ty reps = map cvt assignments
where -- The calling conventions (CgCallConv.hs) are complicated, to say the least
regs = if isCall then
case (reps, conv) of
(_, Native) -> getRegsWithoutNode
(_, NativeCall) -> getRegsWithoutNode
(_, GC ) -> getRegsWithNode
(_, PrimOp) -> allRegs
(_, PrimOpCall) -> allRegs
(_, Slow ) -> noRegs
(_, _ ) -> getRegsWithoutNode
_ -> panic "Unknown calling convention"
else
case (reps, conv) of
([_], _) -> allRegs
(_, Native) -> getRegsWithNode
(_, NativeCall) -> getRegsWithNode
(_, NativeReturn) -> getRegsWithNode
(_, GC ) -> getRegsWithNode
(_, PrimOp) -> getRegsWithNode
(_, PrimOpCall) -> getRegsWithNode
(_, PrimOpReturn) -> getRegsWithNode
(_, Slow ) -> noRegs
(_, _ ) -> getRegsWithNode
_ -> pprPanic "Unknown calling convention" (ppr conv)
(sizes, assignments) = unzip $ assignArguments' reps (sum sizes) regs
assignArguments' [] _ _ = []
assignArguments' (r:rs) offset avails =
......
......@@ -36,7 +36,7 @@ toZgraph _ _ (ListGraph []) =
do g <- lgraphOfAGraph emptyAGraph
return ((0, Nothing), g)
toZgraph fun_name args g@(ListGraph (BasicBlock id ss : other_blocks)) =
let (offset, entry) = mkEntry id Native args in
let (offset, entry) = mkEntry id NativeCall args in
do g <- labelAGraph id $
entry <*> mkStmts ss <*> foldr addBlock emptyAGraph other_blocks
return ((offset, Nothing), g)
......@@ -94,7 +94,7 @@ get_hints (Foreign (ForeignConvention _ _ hints)) Results = hints
get_hints _other_conv _vd = repeat NoHint
get_conv :: MidCallTarget -> Convention
get_conv (PrimTarget _) = Native
get_conv (PrimTarget _) = NativeCall
get_conv (ForeignTarget _ fc) = Foreign fc
cmm_target :: MidCallTarget -> CmmCallTarget
......
......@@ -244,22 +244,22 @@ toCall :: CmmExpr -> Maybe BlockId -> UpdFrameOffset -> ByteOff -> ByteOff -> La
toCall e cont updfr_off res_space arg_space =
LastCall e cont arg_space res_space (Just updfr_off)
mkJump e actuals updfr_off =
lastWithArgs Jump old Native actuals updfr_off $ toCall e Nothing updfr_off 0
lastWithArgs Jump old NativeCall actuals updfr_off $ toCall e Nothing updfr_off 0
mkJumpGC e actuals updfr_off =
lastWithArgs Jump old GC actuals updfr_off $ toCall e Nothing updfr_off 0
mkForeignJump conv e actuals updfr_off =
lastWithArgs Jump old conv actuals updfr_off $ toCall e Nothing updfr_off 0
mkReturn e actuals updfr_off =
lastWithArgs Ret old Native actuals updfr_off $ toCall e Nothing updfr_off 0
lastWithArgs Ret old NativeReturn actuals updfr_off $ toCall e Nothing updfr_off 0
-- where e = CmmLoad (CmmStackSlot (CallArea Old) updfr_off) gcWord
mkReturnSimple actuals updfr_off =
lastWithArgs Ret old Native actuals updfr_off $ toCall e Nothing updfr_off 0
lastWithArgs Ret old NativeReturn actuals updfr_off $ toCall e Nothing updfr_off 0
where e = CmmLoad (CmmStackSlot (CallArea Old) updfr_off) gcWord
mkFinalCall f _ actuals updfr_off =
lastWithArgs Call old Native actuals updfr_off $ toCall f Nothing updfr_off 0
lastWithArgs Call old NativeCall actuals updfr_off $ toCall f Nothing updfr_off 0
mkCmmCall f results actuals = mkCall f Native results actuals
mkCmmCall f results actuals = mkCall f NativeCall results actuals
-- I'm dropping the SRT, but that should be okay: we plan to reconstruct it later.
mkCall f conv results actuals updfr_off =
......
......@@ -110,13 +110,17 @@ data MidCallTarget -- The target of a MidUnsafeCall
deriving Eq
data Convention
= Native -- Native C-- call/return
= NativeCall -- Native C-- call
| NativeReturn -- Native C-- return
| Slow -- Slow entry points: all args pushed on the stack
| GC -- Entry to the garbage collector: uses the node reg!
| PrimOp -- Calling prim ops
| PrimOpCall -- Calling prim ops
| PrimOpReturn -- Returning from prim ops
| Foreign -- Foreign call/return
ForeignConvention
......@@ -516,12 +520,14 @@ genFullCondBranch expr t f =
]
pprConvention :: Convention -> SDoc
pprConvention (Native {}) = text "<native-convention>"
pprConvention Slow = text "<slow-convention>"
pprConvention GC = text "<gc-convention>"
pprConvention PrimOp = text "<primop-convention>"
pprConvention (Foreign c) = ppr c
pprConvention (Private {}) = text "<private-convention>"
pprConvention (NativeCall {}) = text "<native-call-convention>"
pprConvention (NativeReturn {}) = text "<native-ret-convention>"
pprConvention Slow = text "<slow-convention>"
pprConvention GC = text "<gc-convention>"
pprConvention PrimOpCall = text "<primop-call-convention>"
pprConvention PrimOpReturn = text "<primop-ret-convention>"
pprConvention (Foreign c) = ppr c
pprConvention (Private {}) = text "<private-convention>"
pprForeignConvention :: ForeignConvention -> SDoc
pprForeignConvention (ForeignConvention c as rs) = ppr c <> ppr as <> ppr rs
......
......@@ -465,7 +465,7 @@ cgTailCall fun_id fun_info args = do
; [ret,call] <- forkAlts [
getCode $ emitReturn [fun], -- Is tagged; no need to untag
getCode $ do emit (mkAssign nodeReg fun)
emitCall Native (entryCode fun') []] -- Not tagged
emitCall NativeCall (entryCode fun') []] -- Not tagged
; emit (mkCmmIfThenElse (cmmIsTagged fun) ret call) }
SlowCall -> do -- A slow function call via the RTS apply routines
......
......@@ -161,13 +161,13 @@ direct_call caller lbl arity args reps
<+> ppr args <+> ppr reps )
| null rest_reps -- Precisely the right number of arguments
= emitCall Native target args
= emitCall NativeCall target args
| otherwise -- Over-saturated call
= ASSERT( arity == length initial_reps )
do { pap_id <- newTemp gcWord
; withSequel (AssignTo [pap_id] True)
(emitCall Native target fast_args)
(emitCall NativeCall target fast_args)
; slow_call (CmmReg (CmmLocal pap_id))
rest_args rest_reps }
where
......
......@@ -607,7 +607,7 @@ emitProcWithConvention conv info lbl args blocks
; setState $ state { cgs_tops = cgs_tops state `snocOL` proc_block } }
emitProc :: CmmInfo -> CLabel -> CmmFormals -> CmmAGraph -> FCode ()
emitProc = emitProcWithConvention Native
emitProc = emitProcWithConvention NativeCall
emitSimpleProc :: CLabel -> CmmAGraph -> FCode ()
emitSimpleProc lbl code =
......
......@@ -82,7 +82,7 @@ cgOpApp (StgPrimOp primop) args res_ty
| primOpOutOfLine primop
= do { cmm_args <- getNonVoidArgAmodes args
; let fun = CmmLit (CmmLabel (mkRtsPrimOpLabel primop))
; emitCall PrimOp fun cmm_args }
; emitCall PrimOpCall fun cmm_args }
| ReturnsPrim VoidRep <- result_info
= do cgPrimOp [] primop args
......
......@@ -314,7 +314,7 @@ emitRtsCall' res fun args _vols safe
where
call updfr_off =
if safe then
mkCall fun_expr Native res' args' updfr_off
mkCall fun_expr NativeCall res' args' updfr_off
else
mkUnsafeCall (ForeignTarget fun_expr
(ForeignConvention CCallConv arg_hints res_hints)) res' args'
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment