X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fcmm%2FCmm.hs;h=4ea7f00b6aec113e6ab24c4b3d94c31dd41e46ab;hp=2ee259c78a828e41851a46524194472a51e43d87;hb=83d563cb9ede0ba792836e529b1e2929db926355;hpb=e6243a818496aad82b6f47511d3bd9bc800f747d

diff --git a/compiler/cmm/Cmm.hs b/compiler/cmm/Cmm.hs
index 2ee259c..4ea7f00 100644
--- a/compiler/cmm/Cmm.hs
+++ b/compiler/cmm/Cmm.hs
@@ -135,7 +135,7 @@ cmmTopMapGraphM :: Monad m => (String -> g -> m g') -> GenCmmTop d h g -> m (Gen
 
 cmmMapGraph f (Cmm tops) = Cmm $ map (cmmTopMapGraph f) tops
 cmmTopMapGraph f (CmmProc h l args g) = CmmProc h l args (f g)
-cmmTopMapGraph _ (CmmData s ds)       = CmmData s ds
+cmmTopMapGraph _ (CmmData s ds)             = CmmData s ds
 
 cmmMapGraphM f (Cmm tops) = mapM (cmmTopMapGraphM f) tops >>= return . Cmm
 cmmTopMapGraphM f (CmmProc h l args g) =
@@ -174,11 +174,14 @@ data ClosureTypeInfo
   | ThunkInfo  ClosureLayout C_SRT
   | ThunkSelectorInfo SelectorOffset C_SRT
   | ContInfo
-      [Maybe LocalReg]  -- stack layout
+      [Maybe LocalReg]  -- Stack layout: Just x, an item x
+                        --               Nothing: a 1-word gap
+			-- Start of list is the *young* end
       C_SRT
 
 data CmmReturnInfo = CmmMayReturn
                    | CmmNeverReturns
+    deriving ( Eq )
 
 -- TODO: These types may need refinement
 data ProfilingInfo = ProfilingInfo CmmLit CmmLit -- closure_type, closure_desc
@@ -251,22 +254,26 @@ type HintedCmmFormals = [HintedCmmFormal]
 type HintedCmmFormal  = CmmHinted CmmFormal
 type HintedCmmActual  = CmmHinted CmmActual
 
-data CmmSafety      = CmmUnsafe | CmmSafe C_SRT
+data CmmSafety      = CmmUnsafe | CmmSafe C_SRT | CmmInterruptible
 
 -- | enable us to fold used registers over 'CmmActuals' and 'CmmFormals'
 instance UserOfLocalRegs CmmStmt where
-  foldRegsUsed f set s = stmt s set
-    where stmt (CmmNop)                  = id
-          stmt (CmmComment {})           = id
-          stmt (CmmAssign _ e)           = gen e
-          stmt (CmmStore e1 e2)          = gen e1 . gen e2
-          stmt (CmmCall target _ es _ _) = gen target . gen es
-          stmt (CmmBranch _)             = id
-          stmt (CmmCondBranch e _)       = gen e
-          stmt (CmmSwitch e _)           = gen e
-          stmt (CmmJump e es)            = gen e . gen es
-          stmt (CmmReturn es)            = gen es
-          gen a set = foldRegsUsed f set a
+  foldRegsUsed f (set::b) s = stmt s set
+    where 
+      stmt :: CmmStmt -> b -> b
+      stmt (CmmNop)                  = id
+      stmt (CmmComment {})           = id
+      stmt (CmmAssign _ e)           = gen e
+      stmt (CmmStore e1 e2)          = gen e1 . gen e2
+      stmt (CmmCall target _ es _ _) = gen target . gen es
+      stmt (CmmBranch _)             = id
+      stmt (CmmCondBranch e _)       = gen e
+      stmt (CmmSwitch e _)           = gen e
+      stmt (CmmJump e es)            = gen e . gen es
+      stmt (CmmReturn es)            = gen es
+
+      gen :: UserOfLocalRegs a => a -> b -> b
+      gen a set = foldRegsUsed f set a
 
 instance UserOfLocalRegs CmmCallTarget where
     foldRegsUsed f set (CmmCallee e _) = foldRegsUsed f set e
@@ -382,6 +389,7 @@ data CallishMachOp
   | MO_F32_Exp
   | MO_F32_Sqrt
   | MO_WriteBarrier
+  | MO_Touch         -- Keep variables live (when using interior pointers)
   deriving (Eq, Show)
 
 pprCallishMachOp :: CallishMachOp -> SDoc