X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fcmm%2FZipCfgCmmRep.hs;h=0f00641efd565df40d0ce2260914cf8f537d3480;hp=27191f38c9844b336893f3ae48278a1dacdafc1a;hb=edc0bafd3fcd01b85a2e8894e5dfe149eb0e0857;hpb=b25c93f1c914d81d77aeafeb49263f29bed128aa

diff --git a/compiler/cmm/ZipCfgCmmRep.hs b/compiler/cmm/ZipCfgCmmRep.hs
index 27191f3..0f00641 100644
--- a/compiler/cmm/ZipCfgCmmRep.hs
+++ b/compiler/cmm/ZipCfgCmmRep.hs
@@ -1,3 +1,6 @@
+{-# OPTIONS_GHC -XNoMonoLocalBinds #-}
+-- Norman likes local bindings
+
 -- This module is pure representation and should be imported only by
 -- clients that need to manipulate representation and know what
 -- they're doing.  Clients that need to create flow graphs should
@@ -103,21 +106,24 @@ data Last
 	    -- This is really needed at the *return* point rather than here
 	    -- at the call, but in practice it's convenient to record it here.
 
-        cml_ret_off :: Maybe UpdFrameOffset
-          -- Stack offset for return (update frames);
-          -- The return offset should be Nothing only if we have to create
-          -- a new call, e.g. for a procpoint, in which case it's an invariant
-          -- that the call does not stand for a return or a tail call,
-          -- and the successor does not need an info table.
+        cml_ret_off :: Maybe ByteOff
+          -- For calls *only*, the byte offset of the base of the frame that
+	  -- must be described by the info table for the return point.  
+ 	  -- The older words are an update frames, which have their own
+	  -- info-table and layout information
+
+	  -- From a liveness point of view, the stack words older than
+	  -- cml_ret_off are treated as live, even if the sequel of
+	  -- the call goes into a loop.
 	}
 
-data MidCallTarget	-- The target of a MidUnsafeCall
-  = ForeignTarget 	-- A foreign procedure
-	CmmExpr			-- Its address
-	ForeignConvention	-- Its calling convention
+data MidCallTarget        -- The target of a MidUnsafeCall
+  = ForeignTarget         -- A foreign procedure
+        CmmExpr                  -- Its address
+        ForeignConvention        -- Its calling convention
 
-  | PrimTarget		-- A possibly-side-effecting machine operation
-	CallishMachOp		-- Which one
+  | PrimTarget            -- A possibly-side-effecting machine operation
+        CallishMachOp            -- Which one
   deriving Eq
 
 data Convention
@@ -157,6 +163,7 @@ data ForeignSafety
   = Unsafe              -- unsafe call
   | Safe BlockId        -- making infotable requires: 1. label 
          UpdFrameOffset --                            2. where the upd frame is
+         Bool           -- is the call interruptible?
   deriving Eq
 
 data ValueDirection = Arguments | Results
@@ -274,8 +281,8 @@ instance UserOfLocalRegs MidCallTarget where
   foldRegsUsed f  z (ForeignTarget e _) = foldRegsUsed f z e
 
 instance UserOfSlots MidCallTarget where
+  foldSlotsUsed  f z (ForeignTarget e _) = foldSlotsUsed f z e
   foldSlotsUsed _f z (PrimTarget _)      = z
-  foldSlotsUsed f  z (ForeignTarget e _) = foldSlotsUsed f z e
 
 instance (UserOfLocalRegs a) => UserOfLocalRegs (Maybe a) where
   foldRegsUsed f z (Just x) = foldRegsUsed f z x
@@ -456,10 +463,9 @@ pprMiddle stmt = pp_stmt <+> pp_debug
     	-- call "ccall" foo(x, y)[r1, r2];
     	-- ToDo ppr volatile
     	MidForeignCall safety target results args ->
-    	    hsep [ if null results
-    	              then empty
-    	              else parens (commafy $ map ppr results) <+> equals,
-                      ppr_safety safety,
+    	    hsep [ ppUnless (null results) $
+    	              parens (commafy $ map ppr results) <+> equals,
+                   ppr_safety safety,
     	           ptext $ sLit "call", 
     	           ppr_call_target target <> parens (commafy $ map ppr args) <> semi]
 
@@ -477,12 +483,19 @@ ppr_fc (ForeignConvention c args res) =
   doubleQuotes (ppr c) <+> text "args: " <+> ppr args <+> text " results: " <+> ppr res
 
 ppr_safety :: ForeignSafety -> SDoc
-ppr_safety (Safe bid upd) = text "safe<" <> ppr bid <> text ", " <> ppr upd <> text ">"
+ppr_safety (Safe bid upd interruptible) =
+    text (if interruptible then "interruptible" else "safe") <>
+    text "<" <> ppr bid <> text ", " <> ppr upd <> text ">"
 ppr_safety Unsafe         = text "unsafe"
 
 ppr_call_target :: MidCallTarget -> SDoc
 ppr_call_target (ForeignTarget fn c) = ppr_fc c <+> ppr_target fn
-ppr_call_target (PrimTarget op)      = ppr (CmmLabel (mkForeignLabel (mkFastString (show op)) Nothing False IsFunction))
+ppr_call_target (PrimTarget op) 
+ -- HACK: We're just using a ForeignLabel to get this printed, the label
+ --	  might not really be foreign.
+ = ppr (CmmLabel (mkForeignLabel
+ 			(mkFastString (show op)) 
+			Nothing ForeignLabelInThisPackage IsFunction))
 
 ppr_target :: CmmExpr -> SDoc
 ppr_target t@(CmmLit _) = ppr t