Another small step: call and return conventions specified separately when making calls

5 files changed, 14 insertions, 13 deletions

diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs
index 462def3d5d..f3687fcc07 100644
--- a/compiler/codeGen/StgCmmExpr.hs
+++ b/compiler/codeGen/StgCmmExpr.hs
@@ -465,7 +465,8 @@ 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 NativeCall (entryCode fun') []]  -- Not tagged
+                                     emitCall (NativeCall, NativeReturn)
+                                              (entryCode fun') []]  -- Not tagged
       		   ; emit (mkCmmIfThenElse (cmmIsTagged fun) ret call) }
 
       	SlowCall -> do 	    -- A slow function call via the RTS apply routines
diff --git a/compiler/codeGen/StgCmmHeap.hs b/compiler/codeGen/StgCmmHeap.hs
index 676aa4f4aa..0e3501a720 100644
--- a/compiler/codeGen/StgCmmHeap.hs
+++ b/compiler/codeGen/StgCmmHeap.hs
@@ -352,7 +352,7 @@ entryHeapCheck fun arity args code
 	| otherwise  = case gc_lbl (fun : args) of
 		 	 Just lbl -> mkJumpGC (CmmLit (CmmLabel (mkRtsCodeLabel lbl)))
 					      args' updfr_sz
-			 Nothing  -> mkCall generic_gc GC [] [] updfr_sz
+			 Nothing  -> mkCall generic_gc (GC, GC) [] [] updfr_sz
 
     gc_lbl :: [LocalReg] -> Maybe LitString
 {-
@@ -386,13 +386,13 @@ altHeapCheck regs code
        heapCheck False (gc_call updfr_sz) code
   where
     gc_call updfr_sz
-	| null regs = mkCall generic_gc GC [] [] updfr_sz
+	| null regs = mkCall generic_gc (GC, GC) [] [] updfr_sz
 
 	| Just gc_lbl <- rts_label regs	-- Canned call
-	= mkCall    (CmmLit (CmmLabel (mkRtsCodeLabel gc_lbl))) GC
+	= mkCall    (CmmLit (CmmLabel (mkRtsCodeLabel gc_lbl))) (GC, GC)
 		    regs (map (CmmReg . CmmLocal) regs) updfr_sz
 	| otherwise		-- No canned call, and non-empty live vars
-	= mkCall generic_gc GC [] [] updfr_sz
+	= mkCall generic_gc (GC, GC) [] [] updfr_sz
 
 {-
     rts_label [reg] 
diff --git a/compiler/codeGen/StgCmmLayout.hs b/compiler/codeGen/StgCmmLayout.hs
index c9f0324181..47df621622 100644
--- a/compiler/codeGen/StgCmmLayout.hs
+++ b/compiler/codeGen/StgCmmLayout.hs
@@ -90,17 +90,17 @@ emitReturn results
                 ; emit (mkMultiAssign  regs results) }
        }
 
-emitCall :: Convention -> CmmExpr -> [CmmExpr] -> FCode ()
+emitCall :: (Convention, Convention) -> CmmExpr -> [CmmExpr] -> FCode ()
 -- (cgCall fun args) makes a call to the entry-code of 'fun', 
 -- passing 'args', and returning the results to the current sequel
-emitCall conv fun args
+emitCall convs@(callConv, _) fun args
   = do	{ adjustHpBackwards
 	; sequel <- getSequel
 	; updfr_off <- getUpdFrameOff
         ; emit $ mkComment $ mkFastString ("emitCall: " ++ show sequel)
 	; case sequel of
-	    Return _            -> emit (mkForeignJump conv fun args updfr_off)
-	    AssignTo res_regs _ -> emit (mkCall fun conv res_regs args updfr_off)
+	    Return _            -> emit (mkForeignJump callConv fun args updfr_off)
+	    AssignTo res_regs _ -> emit (mkCall fun convs res_regs args updfr_off)
     }
 
 adjustHpBackwards :: FCode ()
@@ -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 NativeCall target args
+  = emitCall (NativeCall, NativeReturn) target args
 
   | otherwise		-- Over-saturated call
   = ASSERT( arity == length initial_reps )
     do	{ pap_id <- newTemp gcWord
 	; withSequel (AssignTo [pap_id] True)
-		     (emitCall NativeCall target fast_args)
+		     (emitCall (NativeCall, NativeReturn) target fast_args)
 	; slow_call (CmmReg (CmmLocal pap_id)) 
 		    rest_args rest_reps }
   where
diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs
index 1d2f0db142..7bc75de940 100644
--- a/compiler/codeGen/StgCmmPrim.hs
+++ b/compiler/codeGen/StgCmmPrim.hs
@@ -82,7 +82,7 @@ cgOpApp (StgPrimOp primop) args res_ty
   | primOpOutOfLine primop
   = do	{ cmm_args <- getNonVoidArgAmodes args
         ; let fun = CmmLit (CmmLabel (mkRtsPrimOpLabel primop))
-        ; emitCall PrimOpCall fun cmm_args }
+        ; emitCall (PrimOpCall, PrimOpReturn) fun cmm_args }
 
   | ReturnsPrim VoidRep <- result_info
   = do cgPrimOp [] primop args 
diff --git a/compiler/codeGen/StgCmmUtils.hs b/compiler/codeGen/StgCmmUtils.hs
index 9ef5862eaa..eb437a9c3d 100644
--- a/compiler/codeGen/StgCmmUtils.hs
+++ b/compiler/codeGen/StgCmmUtils.hs
@@ -314,7 +314,7 @@ emitRtsCall' res fun args _vols safe
   where
     call updfr_off =
       if safe then
-        mkCall fun_expr NativeCall res' args' updfr_off
+        mkCmmCall fun_expr res' args' updfr_off
       else
         mkUnsafeCall (ForeignTarget fun_expr
                          (ForeignConvention CCallConv arg_hints res_hints)) res' args'