projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Cleanup sweep and fix a bug in RTS flag processing.
[ghc-hetmet.git]
/
compiler
/
codeGen
/
CgTailCall.lhs
diff --git
a/compiler/codeGen/CgTailCall.lhs
b/compiler/codeGen/CgTailCall.lhs
index
3732bab
..
a3dbe6a
100644
(file)
--- a/
compiler/codeGen/CgTailCall.lhs
+++ b/
compiler/codeGen/CgTailCall.lhs
@@
-11,6
+11,7
@@
module CgTailCall (
returnUnboxedTuple, ccallReturnUnboxedTuple,
pushUnboxedTuple,
tailCallPrimOp,
returnUnboxedTuple, ccallReturnUnboxedTuple,
pushUnboxedTuple,
tailCallPrimOp,
+ tailCallPrimCall,
pushReturnAddress
) where
pushReturnAddress
) where
@@
-27,8
+28,8
@@
import CgUtils
import CgTicky
import ClosureInfo
import SMRep
import CgTicky
import ClosureInfo
import SMRep
-import Cmm
-import CmmUtils
+import OldCmm
+import OldCmmUtils
import CLabel
import Type
import Id
import CLabel
import Type
import Id
@@
-382,13
+383,21
@@
ccallReturnUnboxedTuple amodes before_jump
-- Calling an out-of-line primop
tailCallPrimOp :: PrimOp -> [StgArg] -> Code
-- Calling an out-of-line primop
tailCallPrimOp :: PrimOp -> [StgArg] -> Code
-tailCallPrimOp op args
+tailCallPrimOp op
+ = tailCallPrim (mkRtsPrimOpLabel op)
+
+tailCallPrimCall :: PrimCall -> [StgArg] -> Code
+tailCallPrimCall primcall
+ = tailCallPrim (mkPrimCallLabel primcall)
+
+tailCallPrim :: CLabel -> [StgArg] -> Code
+tailCallPrim lbl args
= do { -- We're going to perform a normal-looking tail call,
-- except that *all* the arguments will be in registers.
-- Hence the ASSERT( null leftovers )
arg_amodes <- getArgAmodes args
= do { -- We're going to perform a normal-looking tail call,
-- except that *all* the arguments will be in registers.
-- Hence the ASSERT( null leftovers )
arg_amodes <- getArgAmodes args
- ; let (arg_regs, leftovers) = pprTrace "prim op" (ppr op) $ assignPrimOpCallRegs arg_amodes
- jump_to_primop = jumpToLbl (mkRtsPrimOpLabel op)
+ ; let (arg_regs, leftovers) = assignPrimOpCallRegs arg_amodes
+ jump_to_primop = jumpToLbl lbl
; ASSERT(null leftovers) -- no stack-resident args
emitSimultaneously (assignToRegs arg_regs)
; ASSERT(null leftovers) -- no stack-resident args
emitSimultaneously (assignToRegs arg_regs)