summaryrefslogtreecommitdiff
path: root/compiler/codeGen
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/codeGen')
-rw-r--r--compiler/codeGen/CgExpr.lhs3
-rw-r--r--compiler/codeGen/CgTailCall.lhs13
-rw-r--r--compiler/codeGen/StgCmmPrim.hs5
3 files changed, 19 insertions, 2 deletions
diff --git a/compiler/codeGen/CgExpr.lhs b/compiler/codeGen/CgExpr.lhs
index eb1d9f082c..71087ca7c5 100644
--- a/compiler/codeGen/CgExpr.lhs
+++ b/compiler/codeGen/CgExpr.lhs
@@ -179,6 +179,9 @@ cgExpr (StgOpApp (StgPrimOp primop) args res_ty)
performReturn emitReturnInstr
where
result_info = getPrimOpResultInfo primop
+
+cgExpr (StgOpApp (StgPrimCallOp primcall) args _res_ty)
+ = tailCallPrimCall primcall args
\end{code}
%********************************************************
diff --git a/compiler/codeGen/CgTailCall.lhs b/compiler/codeGen/CgTailCall.lhs
index 60a856177c..89c050406f 100644
--- a/compiler/codeGen/CgTailCall.lhs
+++ b/compiler/codeGen/CgTailCall.lhs
@@ -11,6 +11,7 @@ module CgTailCall (
returnUnboxedTuple, ccallReturnUnboxedTuple,
pushUnboxedTuple,
tailCallPrimOp,
+ tailCallPrimCall,
pushReturnAddress
) where
@@ -382,13 +383,21 @@ ccallReturnUnboxedTuple amodes before_jump
-- 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
; let (arg_regs, leftovers) = assignPrimOpCallRegs arg_amodes
- jump_to_primop = jumpToLbl (mkRtsPrimOpLabel op)
+ jump_to_primop = jumpToLbl lbl
; ASSERT(null leftovers) -- no stack-resident args
emitSimultaneously (assignToRegs arg_regs)
diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs
index 7bc75de940..80a4bb6160 100644
--- a/compiler/codeGen/StgCmmPrim.hs
+++ b/compiler/codeGen/StgCmmPrim.hs
@@ -110,6 +110,11 @@ cgOpApp (StgPrimOp primop) args res_ty
where
result_info = getPrimOpResultInfo primop
+cgOpApp (StgPrimCallOp primcall) args _res_ty
+ = do { cmm_args <- getNonVoidArgAmodes args
+ ; let fun = CmmLit (CmmLabel (mkPrimCallLabel primcall))
+ ; emitCall (PrimOpCall, PrimOpReturn) fun cmm_args }
+
---------------------------------------------------
cgPrimOp :: [LocalReg] -- where to put the results
-> PrimOp -- the op