X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcodeGen%2FCgCallConv.hs;h=752769f4e39e9ad841684176334a39223a4a633b;hb=36104d7a0d66df895c8275e3aa7cfe35a322ff04;hp=da5a3d9162b19f70bf5239bbed438f719066f244;hpb=ebe7cd764a8f5c58b3f9be31818e72b922c8aef4;p=ghc-hetmet.git

diff --git a/compiler/codeGen/CgCallConv.hs b/compiler/codeGen/CgCallConv.hs
index da5a3d9..752769f 100644
--- a/compiler/codeGen/CgCallConv.hs
+++ b/compiler/codeGen/CgCallConv.hs
@@ -336,9 +336,22 @@ assignPrimOpCallRegs args
 	-- For primops, *all* arguments must be passed in registers
 
 assignReturnRegs args
- = assign_regs args (mkRegTbl [])
+ -- when we have a single non-void component to return, use the normal
+ -- unpointed return convention.  This make various things simpler: it
+ -- means we can assume a consistent convention for IO, which is useful
+ -- when writing code that relies on knowing the IO return convention in 
+ -- the RTS (primops, especially exception-related primops).
+ -- Also, the bytecode compiler assumes this when compiling
+ -- case expressions and ccalls, so it only needs to know one set of
+ -- return conventions.
+ | [(rep,arg)] <- non_void_args, CmmGlobal r <- dataReturnConvPrim rep
+    = ([(arg, r)], [])
+ | otherwise
+    = assign_regs args (mkRegTbl [])
 	-- For returning unboxed tuples etc, 
 	-- we use all regs
+ where 
+       non_void_args = filter ((/= VoidArg).fst) args
 
 assign_regs :: [(CgRep,a)]     	-- Arg or result values to assign
 	    -> AvailRegs	-- Regs still avail: Vanilla, Float, Double, Longs