Add PrimCall to the STG layer and update Core -> STG translation

[ghc-hetmet.git] / compiler / codeGen / CgTailCall.lhs

diff --git a/compiler/codeGen/CgTailCall.lhs b/compiler/codeGen/CgTailCall.lhs
index 3732bab..89c0504 100644 (file)
--- 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) = 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)