X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fcmm%2FCmmCallConv.hs;h=a49fa65ab4a2d20d0da73083a5f0c5697bd9aa36;hp=7b3dd0d83f82bf7950884ed0cfe9a70dcdc06a89;hb=703ca1542c8e0983cc9d8eebce6e9f3dd3fd71e2;hpb=8e9c95ac7ad62c5ce6d39e52ac8da6936f19da4c

diff --git a/compiler/cmm/CmmCallConv.hs b/compiler/cmm/CmmCallConv.hs
index 7b3dd0d..a49fa65 100644
--- a/compiler/cmm/CmmCallConv.hs
+++ b/compiler/cmm/CmmCallConv.hs
@@ -15,7 +15,6 @@ import ZipCfgCmmRep (Convention(..))
 import Constants
 import StaticFlags (opt_Unregisterised)
 import Outputable
-import Panic
 
 -- Calculate the 'GlobalReg' or stack locations for function call
 -- parameters as used by the Cmm calling convention.
@@ -46,13 +45,9 @@ 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 = case (reps, conv) of
                (_,   NativeNodeCall)   -> getRegsWithNode
@@ -65,34 +60,6 @@ assignArgumentsPos conv isCall arg_ty reps = map cvt assignments
                (_,   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
-           --       (_, Slow  ) -> noRegs
-           --       _ -> panic "Unknown calling convention"
-           --   else
-           --     case (reps, conv) of
-           --       ([_], _)    -> allRegs
-           --       (_, NativeCall)   -> getRegsWithNode
       (sizes, assignments) = unzip $ assignArguments' reps (sum sizes) regs
       assignArguments' [] _ _ = []
       assignArguments' (r:rs) offset avails =
@@ -203,12 +170,11 @@ assign_bits_reg :: SlotAssigner -> Width -> WordOff -> VGcPtr -> AvailRegs -> As
 assign_bits_reg _ W128 _ _ _ = panic "W128 is not a supported register type"
 assign_bits_reg _ w off gcp (v:vs, fs, ds, ls)
   | widthInBits w <= widthInBits wordWidth =
-        pprTrace "long regs" (ppr ls <+> ppr wordWidth <+> ppr mAX_Real_Long_REG) $ (RegisterParam (v gcp), off, 0, (vs, fs, ds, ls))
+        (RegisterParam (v gcp), off, 0, (vs, fs, ds, ls))
 assign_bits_reg _ w off _ (vs, fs, ds, l:ls)
   | widthInBits w > widthInBits wordWidth =
-        pprTrace "long regs" (ppr ls <+> ppr wordWidth <+> ppr mAX_Real_Long_REG) $ (RegisterParam l, off, 0, (vs, fs, ds, ls))
-assign_bits_reg assign_slot w off _ regs@(_, _, _, ls) =
-  pprTrace "long regs" (ppr w <+> ppr ls <+> ppr wordWidth <+> ppr mAX_Real_Long_REG <+> ppr mAX_Long_REG) $ assign_slot w off regs
+        (RegisterParam l, off, 0, (vs, fs, ds, ls))
+assign_bits_reg assign_slot w off _ regs@(_, _, _, _) = assign_slot w off regs
 
 assign_float_reg :: SlotAssigner -> Width -> WordOff -> AvailRegs -> Assignment
 assign_float_reg _ W32 off (vs, f:fs, ds, ls) = (RegisterParam $ f, off, 0, (vs, fs, ds, ls))