X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fcmm%2FMkGraph.hs;h=bb2d799487cd26715fe1486e6e6c1acad55397d1;hp=69b481b501169a9477cfef6b5fa504d4c12cd0c5;hb=f3a1b28e408de01d01ec252efd5b54722eb775d8;hpb=889c084e943779e76d19f2ef5e970ff655f511eb

diff --git a/compiler/cmm/MkGraph.hs b/compiler/cmm/MkGraph.hs
index 69b481b..bb2d799 100644
--- a/compiler/cmm/MkGraph.hs
+++ b/compiler/cmm/MkGraph.hs
@@ -24,7 +24,7 @@ module MkGraph
          , copyInOflow, copyInSlot, copyOutOflow, copyOutSlot
   -- Reexport of needed Cmm stuff
   , Convention(..), ForeignConvention(..), ForeignTarget(..)
-  , CmmStackInfo(..), CmmTopInfo(..), CmmGraph(..)
+  , CmmStackInfo(..), CmmTopInfo(..), CmmGraph, GenCmmGraph(..)
   , Cmm, CmmTop
   )
 where
@@ -290,8 +290,6 @@ stackStubExpr w = CmmLit (CmmInt 0 w)
 -- functions to pass the arguments in an overflow area and to pass them in spill slots.
 copyInOflow  :: Convention -> Area -> CmmFormals -> (Int, CmmAGraph)
 copyInSlot   :: Convention -> CmmFormals -> [CmmNode O O]
-copyOutOflow :: Convention -> Transfer -> Area -> CmmActuals -> UpdFrameOffset ->
-                              (Int, CmmAGraph)
 copyOutSlot  :: Convention -> [LocalReg] -> [CmmNode O O]
 
 copyInOflow conv area formals = (offset, catAGraphs $ map mkMiddle nodes)
@@ -333,26 +331,37 @@ oneCopySlotI _ (reg, _) (n, ms) =
 -- Factoring out the common parts of the copyout functions yielded something
 -- more complicated:
 
+copyOutOflow :: Convention -> Transfer -> Area -> CmmActuals -> UpdFrameOffset ->
+                              (Int, CmmAGraph)
+-- Generate code to move the actual parameters into the locations
+-- required by the calling convention.  This includes a store for the return address.
+--
 -- The argument layout function ignores the pointer to the info table, so we slot that
 -- in here. When copying-out to a young area, we set the info table for return
 -- and adjust the offsets of the other parameters.
 -- If this is a call instruction, we adjust the offsets of the other parameters.
-copyOutOflow conv transfer area@(CallArea a) actuals updfr_off =
-  foldr co (init_offset, emptyAGraph) args'
-  where co (v, RegisterParam r) (n, ms) = (n, mkAssign (CmmGlobal r) v <*> ms)
-        co (v, StackParam off)  (n, ms) =
-          (max n off, mkStore (CmmStackSlot area off) v <*> ms)
-        (setRA, init_offset) =
-          case a of Young id -> id `seq` -- set RA if making a call
-                      if transfer == Call then
-                        ([(CmmLit (CmmBlock id), StackParam init_offset)],
-                         widthInBytes wordWidth)
-                      else ([], 0)
-                    Old -> ([], updfr_off)
-        args = assignArgumentsPos conv cmmExprType actuals
-        args' = foldl adjust setRA args
-          where adjust rst (v, StackParam off) = (v, StackParam (off + init_offset)) : rst
-                adjust rst x@(_, RegisterParam _) = x : rst
+copyOutOflow conv transfer area@(CallArea a) actuals updfr_off
+  = foldr co (init_offset, emptyAGraph) args'
+  where 
+    co (v, RegisterParam r) (n, ms) = (n, mkAssign (CmmGlobal r) v <*> ms)
+    co (v, StackParam off)  (n, ms) = (max n off, mkStore (CmmStackSlot area off) v <*> ms)
+
+    (setRA, init_offset) =
+      case a of Young id -> id `seq` -- Generate a store instruction for
+           	    	     	     -- the return address if making a call
+                  if transfer == Call then
+                    ([(CmmLit (CmmBlock id), StackParam init_offset)],
+                     widthInBytes wordWidth)
+                  else ([], 0)
+                Old -> ([], updfr_off)
+
+    args :: [(CmmExpr, ParamLocation)]   -- The argument and where to put it
+    args = assignArgumentsPos conv cmmExprType actuals
+
+    args' = foldl adjust setRA args
+      where adjust rst   (v, StackParam off)  = (v, StackParam (off + init_offset)) : rst
+            adjust rst x@(_, RegisterParam _) = x : rst
+
 copyOutOflow _ _ (RegSlot _) _ _ = panic "cannot copy arguments into a register slot"
 
 -- Args passed only in registers and stack slots; no overflow space.