X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fcmm%2FCmmCallConv.hs;h=e7d0acc811d5f3fe77603498ce5f61c320f021ce;hp=24adb99df78bcf88fd0fa4a45cd1e15aaeaf69b1;hb=86add45dbfb6f962b65e371143dd467ae783f9e7;hpb=889c084e943779e76d19f2ef5e970ff655f511eb

diff --git a/compiler/cmm/CmmCallConv.hs b/compiler/cmm/CmmCallConv.hs
index 24adb99..e7d0acc 100644
--- a/compiler/cmm/CmmCallConv.hs
+++ b/compiler/cmm/CmmCallConv.hs
@@ -47,7 +47,8 @@ assignArgumentsPos conv arg_ty reps = assignments
                (_,   NativeDirectCall) -> getRegsWithoutNode
                ([_], NativeReturn)     -> allRegs
                (_,   NativeReturn)     -> getRegsWithNode
-               (_,   GC)               -> getRegsWithNode
+               -- GC calling convention *must* put values in registers
+               (_,   GC)               -> allRegs
                (_,   PrimOpCall)       -> allRegs
                ([_], PrimOpReturn)     -> allRegs
                (_,   PrimOpReturn)     -> getRegsWithNode
@@ -61,6 +62,7 @@ assignArgumentsPos conv arg_ty reps = assignments
       (reg_assts, stk_args) = assign_regs [] reps regs
       stk_args' = case conv of NativeReturn -> part
                                PrimOpReturn -> part
+                               GC | length stk_args /= 0 -> panic "Failed to allocate registers for GC call"
                                _            -> stk_args
                   where part = uncurry (++)
                                        (L.partition (not . isGcPtrType . arg_ty) stk_args)