Code simplification due to separate call/return conventions

diff --git a/compiler/cmm/CmmCallConv.hs b/compiler/cmm/CmmCallConv.hs
index 7c67107..7b3dd0d 100644 (file)
--- a/compiler/cmm/CmmCallConv.hs
+++ b/compiler/cmm/CmmCallConv.hs
@@ -54,24 +54,36 @@ assignArgumentsPos :: (Outputable a) => Convention -> Bool -> (a -> CmmType) ->
                       ArgumentFormat a ByteOff
 assignArgumentsPos conv isCall 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
-                 (_, NativeNodeCall)   -> getRegsWithNode
-                 (_, NativeDirectCall) -> getRegsWithoutNode
-                 (_, GC    ) -> getRegsWithNode
-                 (_, PrimOpCall) -> allRegs
-                 (_, Slow  ) -> noRegs
-                 _ -> pprPanic "Unknown calling convention" (ppr conv)
-             else
-               case (reps, conv) of
-                 ([_], _)    -> allRegs
-                 (_, NativeNodeCall)   -> getRegsWithNode
-                 (_, NativeDirectCall) -> getRegsWithoutNode
-                 (_, NativeReturn) -> getRegsWithNode
-                 (_, GC    ) -> getRegsWithNode
-                 (_, PrimOpReturn) -> getRegsWithNode
-                 (_, Slow  ) -> noRegs
-                 _ -> pprPanic "Unknown calling convention" (ppr conv)
+      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)
+      -- regs = if isCall then
+      --          case (reps, conv) of
+      --            (_, NativeNodeCall)   -> getRegsWithNode
+      --            (_, NativeDirectCall) -> getRegsWithoutNode
+      --            (_, GC    ) -> getRegsWithNode
+      --            (_, PrimOpCall) -> allRegs
+      --            (_, Slow  ) -> noRegs
+      --            _ -> pprPanic "Unknown calling convention" (ppr conv)
+      --        else
+      --          case (reps, conv) of
+      --            (_,   NativeNodeCall)   -> getRegsWithNode
+      --            (_,   NativeDirectCall) -> getRegsWithoutNode
+      --            ([_], NativeReturn)     -> allRegs
+      --            (_,   NativeReturn)     -> getRegsWithNode
+      --            (_,   GC)               -> getRegsWithNode
+      --            ([_], PrimOpReturn)     -> allRegs
+      --            (_,   PrimOpReturn)     -> getRegsWithNode
+      --            (_,   Slow)             -> noRegs
+      --            _ -> pprPanic "Unknown calling convention" (ppr conv)
            --       (_, NativeCall) -> getRegsWithoutNode
            --       (_, GC    ) -> getRegsWithNode
            --       (_, PrimOpCall) -> allRegs

diff --git a/compiler/cmm/MkZipCfgCmm.hs b/compiler/cmm/MkZipCfgCmm.hs
index b47185b..4b2c022 100644 (file)
--- a/compiler/cmm/MkZipCfgCmm.hs
+++ b/compiler/cmm/MkZipCfgCmm.hs
@@ -64,11 +64,11 @@ mkCall       :: CmmExpr -> (Convention, Convention) -> CmmFormals -> CmmActuals
                   UpdFrameOffset -> CmmAGraph
 mkCmmCall    :: CmmExpr ->              CmmFormals -> CmmActuals ->
                   UpdFrameOffset -> CmmAGraph
-                       -- Native C-- calling convention
+  -- Native C-- calling convention
 mkSafeCall    :: MidCallTarget -> CmmFormals -> CmmActuals -> UpdFrameOffset -> CmmAGraph
 mkUnsafeCall  :: MidCallTarget -> CmmFormals -> CmmActuals -> CmmAGraph
 mkFinalCall   :: CmmExpr -> CCallConv -> CmmActuals -> UpdFrameOffset -> CmmAGraph
-                -- Never returns; like exit() or barf()
+  -- Never returns; like exit() or barf()
 
 ---------- Control transfer
 mkJump         ::               CmmExpr -> CmmActuals -> UpdFrameOffset -> CmmAGraph
@@ -158,19 +158,18 @@ copyInSlot c i f = snd $ copyIn oneCopySlotI c i (panic "no area for copying to
 
 type SlotCopier = Area -> (LocalReg, ByteOff) -> (ByteOff, CmmAGraph) ->
                           (ByteOff, CmmAGraph)
-type CopyIn  = SlotCopier -> Convention -> Bool -> Area -> CmmFormals ->
-                          (ByteOff, CmmAGraph)
+type CopyIn  = SlotCopier -> Convention -> Area -> CmmFormals -> (ByteOff, CmmAGraph)
 
 -- Return the number of bytes used for copying arguments, as well as the
 -- instructions to copy the arguments.
 copyIn :: CopyIn
-copyIn oflow conv isCall area formals =
+copyIn oflow conv area formals =
   foldr ci (init_offset, mkNop) args'
   where ci (reg, RegisterParam r) (n, ms) =
           (n, mkAssign (CmmLocal reg) (CmmReg $ CmmGlobal r) <*> ms)
         ci (r, StackParam off) (n, ms) = oflow area (r, off) (n, ms)
         init_offset = widthInBytes wordWidth -- infotable
-        args  = assignArgumentsPos conv isCall localRegType formals
+        args  = assignArgumentsPos conv localRegType formals
         args' = foldl adjust [] args
           where adjust rst (v, StackParam off) = (v, StackParam (off + init_offset)) : rst
                 adjust rst x@(_, RegisterParam _) = x : rst

diff --git a/compiler/cmm/ZipCfgCmmRep.hs b/compiler/cmm/ZipCfgCmmRep.hs
index b08f2f3..d821b03 100644 (file)
--- a/compiler/cmm/ZipCfgCmmRep.hs
+++ b/compiler/cmm/ZipCfgCmmRep.hs
@@ -114,17 +114,17 @@ data Convention
   
   | NativeNodeCall   -- Native C-- call including the node argument
 
-  | NativeReturn -- Native C-- return
+  | NativeReturn     -- Native C-- return
 
-  | Slow         -- Slow entry points: all args pushed on the stack
+  | Slow             -- Slow entry points: all args pushed on the stack
 
-  | GC           -- Entry to the garbage collector: uses the node reg!
+  | GC               -- Entry to the garbage collector: uses the node reg!
 
-  | PrimOpCall   -- Calling prim ops
+  | PrimOpCall       -- Calling prim ops
 
-  | PrimOpReturn -- Returning from prim ops
+  | PrimOpReturn     -- Returning from prim ops
 
-  | Foreign      -- Foreign call/return
+  | Foreign          -- Foreign call/return
         ForeignConvention
 
   | Private