X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcodeGen%2FStgCmmExpr.hs;h=96b9e316c4f8eeba95ac29eebfdf19adfca3a087;hb=b48fc016e9b15c465ba2c2f1d42b6221bcd19b45;hp=df6e8a1a479e8308b912fb03b64139ffea50c020;hpb=31a9d04804d9cacda35695c5397590516b964964;p=ghc-hetmet.git

diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs
index df6e8a1..96b9e31 100644
--- a/compiler/codeGen/StgCmmExpr.hs
+++ b/compiler/codeGen/StgCmmExpr.hs
@@ -322,6 +322,7 @@ isSimpleOp :: StgOp -> Bool
 isSimpleOp (StgFCallOp (CCall (CCallSpec _ _ safe)) _) = not (playSafe safe)
 isSimpleOp (StgFCallOp (DNCall _) _)                   = False         -- Safe!
 isSimpleOp (StgPrimOp op)      			       = not (primOpOutOfLine op)
+isSimpleOp (StgPrimCallOp _)                           = False
 
 -----------------
 chooseReturnBndrs :: Id -> AltType -> [StgAlt] -> [NonVoid Id]
@@ -464,8 +465,9 @@ cgTailCall fun_id fun_info args = do
       		do { let fun' = CmmLoad fun (cmmExprType fun)
                    ; [ret,call] <- forkAlts [
       			getCode $ emitReturn [fun],	-- Is tagged; no need to untag
-      			getCode $ do emit (mkAssign nodeReg fun)
-                                     emitCall Native (entryCode fun') []]  -- Not tagged
+      			getCode $ do -- emit (mkAssign nodeReg fun)
+                         emitCall (NativeNodeCall, NativeReturn)
+                                  (entryCode fun') [fun]]  -- Not tagged
       		   ; emit (mkCmmIfThenElse (cmmIsTagged fun) ret call) }
 
       	SlowCall -> do 	    -- A slow function call via the RTS apply routines
@@ -480,8 +482,6 @@ cgTailCall fun_id fun_info args = do
                     do emit $ mkComment $ mkFastString "directEntry"
                        emit (mkAssign nodeReg fun)
                        directCall lbl arity args
-                    -- directCall lbl (arity+1) (StgVarArg fun_id : args))
-                    -- >>= (emit . (mkComment (mkFastString "DirectEntry") <*>))
 		  else do emit $ mkComment $ mkFastString "directEntry else"
                           directCall lbl arity args }