X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FCmmCallConv.hs;h=990e178c30452545aafe901833236a29d04a7328;hb=5dd61c6680eb9c2091048cacbfa53ab9e55ddcb6;hp=b7e528b78a00e11afdf041b8799271656f272346;hpb=e5e7d10bb9fc69e58a78540a4a4bf34124730f48;p=ghc-hetmet.git

diff --git a/compiler/cmm/CmmCallConv.hs b/compiler/cmm/CmmCallConv.hs
index b7e528b..990e178 100644
--- a/compiler/cmm/CmmCallConv.hs
+++ b/compiler/cmm/CmmCallConv.hs
@@ -46,29 +46,21 @@ assignArguments f reps = assignments
 -- | JD: For the new stack story, I want arguments passed on the stack to manifest as
 -- positive offsets in a CallArea, not negative offsets from the stack pointer.
 -- Also, I want byte offsets, not word offsets.
--- The first argument tells us whether we are assigning positions for call arguments
--- or return results. The distinction matters because some conventions use different
--- global registers in each case. In particular, the native calling convention
--- uses the `node' register to pass the closure environment.
-assignArgumentsPos :: (Outputable a) => Convention -> Bool -> (a -> CmmType) -> [a] ->
+assignArgumentsPos :: (Outputable a) => Convention -> (a -> CmmType) -> [a] ->
                       ArgumentFormat a ByteOff
-assignArgumentsPos conv isCall arg_ty reps = map cvt assignments
+assignArgumentsPos conv arg_ty reps = map cvt assignments
     where -- The calling conventions (CgCallConv.hs) are complicated, to say the least
-      regs = if isCall then
-               case (reps, conv) of
-                 (_, Native) -> getRegsWithoutNode
-                 (_, GC    ) -> getRegsWithNode
-                 (_, PrimOp) -> allRegs
-                 (_, Slow  ) -> noRegs
-                 (_, _     ) -> getRegsWithoutNode
-             else
-               case (reps, conv) of
-                 ([_], _)    -> allRegs
-                 (_, Native) -> getRegsWithNode
-                 (_, GC    ) -> getRegsWithNode
-                 (_, PrimOp) -> getRegsWithNode
-                 (_, Slow  ) -> noRegs
-                 (_, _     ) -> getRegsWithNode
+      regs = case (reps, conv) of
+               (_,   NativeNodeCall)   -> getRegsWithNode
+               (_,   NativeDirectCall) -> getRegsWithoutNode
+               ([_], NativeReturn)     -> allRegs
+               (_,   NativeReturn)     -> getRegsWithNode
+               (_,   GC)               -> getRegsWithNode
+               (_,   PrimOpCall)       -> allRegs
+               ([_], PrimOpReturn)     -> allRegs
+               (_,   PrimOpReturn)     -> getRegsWithNode
+               (_,   Slow)             -> noRegs
+               _ -> pprPanic "Unknown calling convention" (ppr conv)
       (sizes, assignments) = unzip $ assignArguments' reps (sum sizes) regs
       assignArguments' [] _ _ = []
       assignArguments' (r:rs) offset avails =