Work around lack of saving volatile registers from unsafe foreign calls.

Signed-off-by: Edward Z. Yang <ezyang@mit.edu>

compiler/cmm/CmmNode.hs

@@ -46,7 +46,9 @@ data CmmNode e x where
       CmmActuals ->               -- zero or more arguments
       CmmNode O O
       -- Semantics: kills only result regs; all other regs (both GlobalReg
-      --            and LocalReg) are preserved
+      --            and LocalReg) are preserved.  But there is a current
+      --            bug for what can be put in arguments, see
+      --            Note [Register Parameter Passing]
 
   CmmBranch :: Label -> CmmNode O C  -- Goto another block in the same procedure
 
@@ -73,7 +75,8 @@ data CmmNode e x where
 -- moment of the call.  Later stages can use this to give liveness
 -- everywhere, which in turn guides register allocation.
 -- It is the companion of cml_args; cml_args says which stack words
--- hold parameters, while cml_arg_regs says which global regs hold parameters
+-- hold parameters, while cml_arg_regs says which global regs hold parameters.
+-- But do note [Register parameter passing]
 
       cml_args :: ByteOff,
           -- Byte offset, from the *old* end of the Area associated with
@@ -103,7 +106,7 @@ data CmmNode e x where
   		    		-- Always the last node of a block
       tgt   :: ForeignTarget,   -- call target and convention
       res   :: CmmFormals,      -- zero or more results
-      args  :: CmmActuals,      -- zero or more arguments
+      args  :: CmmActuals,      -- zero or more arguments; see Note [Register parameter passing]
       succ  :: Label,           -- Label of continuation
       updfr :: UpdFrameOffset,  -- where the update frame is (for building infotable)
       intrbl:: Bool             -- whether or not the call is interruptible
@@ -113,9 +116,11 @@ data CmmNode e x where
 ~~~~~~~~~~~~~~~~~~~~~~~
 A CmmUnsafeForeignCall is used for *unsafe* foreign calls;
 a CmmForeignCall call is used for *safe* foreign calls.
-Unsafe ones are easy: think of them as a "fat machine instruction".
-In particular, they do *not* kill all live registers (there was a bit
-of code in GHC that conservatively assumed otherwise.)
+
+Unsafe ones are mostly easy: think of them as a "fat machine
+instruction".  In particular, they do *not* kill all live registers,
+just the registers they return to (there was a bit of code in GHC that
+conservatively assumed otherwise.)  However, see [Register parameter passing].
 
 Safe ones are trickier.  A safe foreign call 
      r = f(x)
@@ -138,6 +143,21 @@ constructors do *not* (currently) know the foreign call conventions.
 Note that a safe foreign call needs an info table.
 -}
 
+{- Note [Register parameter passing]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+On certain architectures, some registers are utilized for parameter
+passing in the C calling convention.  For example, in x86-64 Linux
+convention, rdi, rsi, rdx and rcx (as well as r8 and r9) may be used for
+argument passing.  These are registers R3-R6, which our generated
+code may also be using; as a result, it's necessary to save these
+values before doing a foreign call.  This is done during initial
+code generation in callerSaveVolatileRegs in StgCmmUtils.hs.  However,
+one result of doing this is that the contents of these registers
+may mysteriously change if referenced inside the arguments.  This
+is dangerous, so you'll need to disable inlining much in the same
+way is done in cmm/CmmOpt.hs currently.  We should fix this!
+-}
+
 ---------------------------------------------
 -- Eq instance of CmmNode
 -- It is a shame GHC cannot infer it by itself :(

compiler/cmm/CmmSpillReload.hs

@@ -25,6 +25,7 @@ import Cmm
 import CmmExpr
 import CmmLive
 import OptimizationFuel
+import StgCmmUtils
 
 import Control.Monad
 import Outputable hiding (empty)
@@ -495,8 +496,19 @@ middleAssignment (Plain n@(CmmStore lhs rhs)) assign
 -}
 
 -- Assumption: Unsafe foreign calls don't clobber memory
+-- Since foreign calls clobber caller saved registers, we need
+-- invalidate any assignments that reference those global registers.
+-- This is kind of expensive. (One way to optimize this might be to
+-- store extra information about expressions that allow this and other
+-- checks to be done cheaply.)
 middleAssignment (Plain n@(CmmUnsafeForeignCall{})) assign
-    = foldRegsDefd (\m r -> addToUFM m r NeverOptimize) (deleteSinks n assign) n
+    = deleteCallerSaves (foldRegsDefd (\m r -> addToUFM m r NeverOptimize) (deleteSinks n assign) n)
+    where deleteCallerSaves m = foldUFM_Directly f m m
+          f u (xassign -> Just x) m | wrapRecExpf g x False = addToUFM_Directly m u NeverOptimize
+          f _ _ m = m
+          g (CmmReg (CmmGlobal r)) _      | callerSaves r = True
+          g (CmmRegOff (CmmGlobal r) _) _ | callerSaves r = True
+          g _ b = b
 
 middleAssignment (Plain (CmmComment {})) assign
     = assign
@@ -588,16 +600,18 @@ assignmentRewrite = mkFRewrite3 first middle last
                                 Nothing -> (i, l)
         rewrite _ (False, []) _ _ = Nothing
         -- Note [CmmCall Inline Hack]
-        -- ToDo: Conservative hack: don't do any inlining on CmmCalls, since
-        -- the code produced here tends to be unproblematic and I need
-        -- to write lint passes to ensure that we don't put anything in
-        -- the arguments that could be construed as a global register by
+        -- Conservative hack: don't do any inlining on what will
+        -- be translated into an OldCmm CmmCalls, since the code
+        -- produced here tends to be unproblematic and I need to write
+        -- lint passes to ensure that we don't put anything in the
+        -- arguments that could be construed as a global register by
         -- some later translation pass.  (For example, slots will turn
-        -- into dereferences of Sp).  This is the same hack in spirit as
-        -- was in cmm/CmmOpt.hs.  Fix this up to only bug out if certain
-        -- CmmExprs are involved.
-        -- ToDo: We miss an opportunity here, where all possible
-        -- inlinings should instead be sunk.
+        -- into dereferences of Sp).  See [Register parameter passing].
+        -- ToDo: Fix this up to only bug out if all inlines were for
+        -- CmmExprs with global registers (we can't use the
+        -- straightforward mapExpDeep call, in this case.) ToDo: We miss
+        -- an opportunity here, where all possible inlinings should
+        -- instead be sunk.
         rewrite _ (True, []) _ n | not (inlinable n) = Nothing -- see [CmmCall Inline Hack]
         rewrite assign (i, xs) mk n = Just $ mkMiddles xs <*> mk (Plain (inline i assign n))
 
@@ -630,6 +644,7 @@ assignmentRewrite = mkFRewrite3 first middle last
         inlinable :: CmmNode e x -> Bool
         inlinable (CmmCall{}) = False
         inlinable (CmmForeignCall{}) = False
+        inlinable (CmmUnsafeForeignCall{}) = False
         inlinable _ = True
 
 rewriteAssignments :: CmmGraph -> FuelUniqSM CmmGraph

compiler/cmm/OldCmm.hs

@@ -144,12 +144,14 @@ data CmmStmt	-- Old-style
   | CmmStore CmmExpr CmmExpr     -- Assign to memory location.  Size is
                                  -- given by cmmExprType of the rhs.
 
-  | CmmCall	 		 -- A call (forign, native or primitive), with 
+  | CmmCall	 		 -- A call (foreign, native or primitive), with 
      CmmCallTarget
      HintedCmmFormals		 -- zero or more results
      HintedCmmActuals		 -- zero or more arguments
      CmmSafety			 -- whether to build a continuation
      CmmReturnInfo
+  -- Some care is necessary when handling the arguments of these, see
+  -- [Register parameter passing] and the hack in cmm/CmmOpt.hs
 
   | CmmBranch BlockId             -- branch to another BB in this fn
 

compiler/codeGen/StgCmmUtils.hs

@@ -340,6 +340,22 @@ emitRtsCall' res pkg fun args _vols safe
 --  * Regs.h claims that BaseReg should be saved last and loaded first
 --    * This might not have been tickled before since BaseReg is callee save
 --  * Regs.h saves SparkHd, ParkT1, SparkBase and SparkLim
+-- EZY: This code is very dodgy, because callerSaves only ever
+-- returns true in the current universe for registers NOT in
+-- system_regs (just do a grep for CALLER_SAVES in
+-- includes/stg/MachRegs.h).  Thus, this is all one giant no-op.  What we are
+-- actually interested in is saving are the non-system registers, which
+-- we is what the old code generator actually does at this point.
+-- Unfortunately, we can't do that here either, because we don't
+-- liveness information, and thus there's not an easy way to tell which
+-- specific global registers need to be saved (the 'vols' argument in
+-- the old code generator.)  One possible hack is to save all of them
+-- unconditionally, but unless we have very clever dead /memory/
+-- elimination (unlikely), this will still leave a dead, unnecessary
+-- memory assignment.  And really, we shouldn't be doing the workaround
+-- at this point in the pipeline, see Note [Register parameter passing].
+-- Right now the workaround is to avoid inlining across unsafe foreign
+-- calls in rewriteAssignments.
 callerSaveVolatileRegs :: (CmmAGraph, CmmAGraph)
 callerSaveVolatileRegs = (caller_save, caller_load)
   where
@@ -396,6 +412,51 @@ callerSaves :: GlobalReg -> Bool
 #ifdef CALLER_SAVES_Base
 callerSaves BaseReg		= True
 #endif
+#ifdef CALLER_SAVES_R1
+callerSaves (VanillaReg 1 _)	= True
+#endif
+#ifdef CALLER_SAVES_R2
+callerSaves (VanillaReg 2 _)	= True
+#endif
+#ifdef CALLER_SAVES_R3
+callerSaves (VanillaReg 3 _)	= True
+#endif
+#ifdef CALLER_SAVES_R4
+callerSaves (VanillaReg 4 _)	= True
+#endif
+#ifdef CALLER_SAVES_R5
+callerSaves (VanillaReg 5 _)	= True
+#endif
+#ifdef CALLER_SAVES_R6
+callerSaves (VanillaReg 6 _)	= True
+#endif
+#ifdef CALLER_SAVES_R7
+callerSaves (VanillaReg 7 _)	= True
+#endif
+#ifdef CALLER_SAVES_R8
+callerSaves (VanillaReg 8 _)	= True
+#endif
+#ifdef CALLER_SAVES_F1
+callerSaves (FloatReg 1)	= True
+#endif
+#ifdef CALLER_SAVES_F2
+callerSaves (FloatReg 2)	= True
+#endif
+#ifdef CALLER_SAVES_F3
+callerSaves (FloatReg 3)	= True
+#endif
+#ifdef CALLER_SAVES_F4
+callerSaves (FloatReg 4)	= True
+#endif
+#ifdef CALLER_SAVES_D1
+callerSaves (DoubleReg 1)	= True
+#endif
+#ifdef CALLER_SAVES_D2
+callerSaves (DoubleReg 2)	= True
+#endif
+#ifdef CALLER_SAVES_L1
+callerSaves (LongReg 1)		= True
+#endif
 #ifdef CALLER_SAVES_Sp
 callerSaves Sp			= True
 #endif

includes/stg/MachRegs.h

@@ -67,6 +67,11 @@
    Caller-saves regs have to be saved around C-calls made from STG
    land, so this file defines CALLER_SAVES_<reg> for each <reg> that
    is designated caller-saves in that machine's C calling convention.
+
+   As it stands, the only registers that are ever marked caller saves
+   are the RX, FX, DX and USER registers; as a result, if you
+   decide to caller save a system register (e.g. SP, HP, etc), note that
+   this code path is completely untested! -- EZY
    -------------------------------------------------------------------------- */
 
 /* -----------------------------------------------------------------------------