X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FCmm.hs;h=27bf8d6bd67b0b69d031bd95efb5e1a245eae20b;hb=8a2809c29de9f23eba7ca682b48390033a9d40f6;hp=903853489f14972a0b16d31f1223f85047946455;hpb=1f46671fe24c7155ee64091b71b77dd66909e7a0;p=ghc-hetmet.git

diff --git a/compiler/cmm/Cmm.hs b/compiler/cmm/Cmm.hs
index 9038534..27bf8d6 100644
--- a/compiler/cmm/Cmm.hs
+++ b/compiler/cmm/Cmm.hs
@@ -9,9 +9,11 @@
 module Cmm ( 
 	GenCmm(..), Cmm, RawCmm,
 	GenCmmTop(..), CmmTop, RawCmmTop,
-	CmmInfo(..), ClosureTypeInfo(..), ProfilingInfo(..),
-	GenBasicBlock(..), CmmBasicBlock, blockId, blockStmts,
+	CmmInfo(..), UpdateFrame(..),
+        CmmInfoTable(..), ClosureTypeInfo(..), ProfilingInfo(..), ClosureTypeTag,
+	GenBasicBlock(..), CmmBasicBlock, blockId, blockStmts, mapBlockStmts,
 	CmmStmt(..), CmmActuals, CmmFormal, CmmFormals, CmmHintFormals,
+        CmmSafety(..),
 	CmmCallTarget(..),
 	CmmStatic(..), Section(..),
 	CmmExpr(..), cmmExprRep, 
@@ -103,19 +105,25 @@ blockId (BasicBlock blk_id _ ) = blk_id
 blockStmts :: GenBasicBlock i -> [i]
 blockStmts (BasicBlock _ stmts) = stmts
 
+mapBlockStmts f (BasicBlock id bs) = BasicBlock id (map f bs)
+
 -----------------------------------------------------------------------------
 --     Info Tables
 -----------------------------------------------------------------------------
 
--- Info table as a haskell data type
 data CmmInfo
   = CmmInfo
+      (Maybe BlockId) -- GC target. Nothing <=> CPS won't do stack check
+      (Maybe UpdateFrame) -- Update frame
+      CmmInfoTable -- Info table
+
+-- Info table as a haskell data type
+data CmmInfoTable
+  = CmmInfoTable
       ProfilingInfo
-      (Maybe BlockId) -- GC target
       ClosureTypeTag -- Int
       ClosureTypeInfo
-  | CmmNonInfo   -- Procedure doesn't need an info table
-      (Maybe BlockId) -- But we still need a GC target for it
+  | CmmNonInfoTable   -- Procedure doesn't need an info table
 
 -- TODO: The GC target shouldn't really be part of CmmInfo
 -- as it doesn't appear in the resulting info table.
@@ -133,14 +141,23 @@ data ClosureTypeInfo
 -- TODO: These types may need refinement
 data ProfilingInfo = ProfilingInfo CmmLit CmmLit -- closure_type, closure_desc
 type ClosureTypeTag = StgHalfWord
-type ClosureLayout = (StgHalfWord, StgHalfWord) -- pts, nptrs
+type ClosureLayout = (StgHalfWord, StgHalfWord) -- ptrs, nptrs
 type ConstrTag = StgHalfWord
 type ConstrDescription = CmmLit
 type FunType = StgHalfWord
 type FunArity = StgHalfWord
-type SlowEntry = CLabel
+type SlowEntry = CmmLit
+  -- ^We would like this to be a CLabel but
+  -- for now the parser sets this to zero on an INFO_TABLE_FUN.
 type SelectorOffset = StgWord
 
+-- | A frame that is to be pushed before entry to the function.
+-- Used to handle 'update' frames.
+data UpdateFrame =
+    UpdateFrame
+      CmmExpr    -- Frame header.  Behaves like the target of a 'jump'.
+      [CmmExpr]  -- Frame remainder.  Behaves like the arguments of a 'jump'.
+
 -----------------------------------------------------------------------------
 --		CmmStmt
 -- A "statement".  Note that all branches are explicit: there are no
@@ -161,7 +178,7 @@ data CmmStmt
      CmmCallTarget
      CmmHintFormals		 -- zero or more results
      CmmActuals			 -- zero or more arguments
-     C_SRT			 -- SRT for the continuation of the call
+     CmmSafety			 -- whether to build a continuation
 
   | CmmBranch BlockId             -- branch to another BB in this fn
 
@@ -184,6 +201,7 @@ type CmmActuals = [(CmmActual,MachHint)]
 type CmmFormal = LocalReg
 type CmmHintFormals = [(CmmFormal,MachHint)]
 type CmmFormals = [CmmFormal]
+data CmmSafety = CmmUnsafe | CmmSafe C_SRT
 
 {-
 Discussion