callerSaveVolatileRegs: fix the Nothing case

[ghc-hetmet.git] / ghc / compiler / nativeGen / MachRegs.lhs

diff --git a/ghc/compiler/nativeGen/MachRegs.lhs b/ghc/compiler/nativeGen/MachRegs.lhs
index 0d048e3..bffb723 100644 (file)
--- a/ghc/compiler/nativeGen/MachRegs.lhs
+++ b/ghc/compiler/nativeGen/MachRegs.lhs
@@ -33,7 +33,7 @@ module MachRegs (
 
        -- * Global registers
         get_GlobalReg_reg_or_addr,
-       callerSaves,
+       callerSaves, callerSaveVolatileRegs,
 
        -- * Machine-dependent register-related stuff
         allocatableRegs, argRegs, allArgRegs, callClobberedRegs,
@@ -58,7 +58,7 @@ module MachRegs (
        r8, r9, r10, r11, r12, r13, r14, r15,
        xmm0, xmm1, xmm2, xmm3, xmm4, xmm5, xmm6, xmm7,
        xmm8, xmm9, xmm10, xmm11, xmm12, xmm13, xmm14, xmm15,
-       xmm, eax, edx,
+       xmm,
        addrModeRegs, allFPArgRegs,
 #endif
 #if sparc_TARGET_ARCH
@@ -88,7 +88,6 @@ import Cmm
 import MachOp          ( MachRep(..) )
 
 import CLabel           ( CLabel, mkMainCapabilityLabel )
-import Unique          ( Unique )
 import Pretty
 import Outputable      ( Outputable(..), pprPanic, panic )
 import qualified Outputable
@@ -343,6 +342,44 @@ get_Regtable_addr_from_offset rep offset
                  Nothing -> regTableOffset offset
                  Just _  -> CmmRegOff (CmmGlobal BaseReg) offset
 
+-- -----------------------------------------------------------------------------
+-- caller-save registers
+
+-- Here we generate the sequence of saves/restores required around a
+-- foreign call instruction.
+
+callerSaveVolatileRegs :: Maybe [GlobalReg] -> ([CmmStmt], [CmmStmt])
+callerSaveVolatileRegs vols = (caller_save, caller_load)
+  where
+    caller_save = foldr ($!) [] (map callerSaveGlobalReg    regs_to_save)
+    caller_load = foldr ($!) [] (map callerRestoreGlobalReg regs_to_save)
+
+    system_regs = [Sp,SpLim,Hp,HpLim,CurrentTSO,CurrentNursery,
+                  {-SparkHd,SparkTl,SparkBase,SparkLim,-}BaseReg ]
+
+    regs_to_save = system_regs ++ vol_list
+
+    vol_list = case vols of Nothing -> all_of_em; Just regs -> regs
+
+    all_of_em = [ VanillaReg n | n <- [0..mAX_Vanilla_REG] ]
+            ++ [ FloatReg   n | n <- [0..mAX_Float_REG] ]
+            ++ [ DoubleReg  n | n <- [0..mAX_Double_REG] ]
+            ++ [ LongReg    n | n <- [0..mAX_Long_REG] ]
+
+    callerSaveGlobalReg reg next
+       | callerSaves reg = 
+               CmmStore (get_GlobalReg_addr reg) 
+                        (CmmReg (CmmGlobal reg)) : next
+       | otherwise = next
+
+    callerRestoreGlobalReg reg next
+       | callerSaves reg = 
+               CmmAssign (CmmGlobal reg)
+                         (CmmLoad (get_GlobalReg_addr reg) (globalRegRep reg))
+                       : next
+       | otherwise = next
+
+
 -- ---------------------------------------------------------------------------
 -- Registers
 
@@ -395,6 +432,9 @@ instance Uniquable Reg where
    getUnique (VirtualRegF u)  = u
    getUnique (VirtualRegD u)  = u
 
+unRealReg (RealReg i) = i
+unRealReg vreg        = pprPanic "unRealReg on VirtualReg" (ppr vreg)
+
 mkVReg :: Unique -> MachRep -> Reg
 mkVReg u rep
    = case rep of
@@ -587,7 +627,7 @@ regNames
 
 showReg :: RegNo -> String
 showReg n
-  | n >= 16 = "%xmm" ++ show n  
+  | n >= 16 = "%xmm" ++ show (n-16)
   | n >= 8  = "%r" ++ show n
   | otherwise = regNames !! n
 
@@ -1242,72 +1282,72 @@ baseRegOffset _                   = panic "baseRegOffset:other"
 callerSaves :: GlobalReg -> Bool
 
 #ifdef CALLER_SAVES_Base
-callerSaves BaseReg                    = True
+callerSaves BaseReg            = True
 #endif
 #ifdef CALLER_SAVES_R1
-callerSaves (VanillaReg _ ILIT(1))     = True
+callerSaves (VanillaReg 1)     = True
 #endif
 #ifdef CALLER_SAVES_R2
-callerSaves (VanillaReg _ ILIT(2))     = True
+callerSaves (VanillaReg 2)     = True
 #endif
 #ifdef CALLER_SAVES_R3
-callerSaves (VanillaReg _ ILIT(3))     = True
+callerSaves (VanillaReg 3)     = True
 #endif
 #ifdef CALLER_SAVES_R4
-callerSaves (VanillaReg _ ILIT(4))     = True
+callerSaves (VanillaReg 4)     = True
 #endif
 #ifdef CALLER_SAVES_R5
-callerSaves (VanillaReg _ ILIT(5))     = True
+callerSaves (VanillaReg 5)     = True
 #endif
 #ifdef CALLER_SAVES_R6
-callerSaves (VanillaReg _ ILIT(6))     = True
+callerSaves (VanillaReg 6)     = True
 #endif
 #ifdef CALLER_SAVES_R7
-callerSaves (VanillaReg _ ILIT(7))     = True
+callerSaves (VanillaReg 7)     = True
 #endif
 #ifdef CALLER_SAVES_R8
-callerSaves (VanillaReg _ ILIT(8))     = True
+callerSaves (VanillaReg 8)     = True
 #endif
 #ifdef CALLER_SAVES_F1
-callerSaves (FloatReg 1#)              = True
+callerSaves (FloatReg 1)       = True
 #endif
 #ifdef CALLER_SAVES_F2
-callerSaves (FloatReg 2#)              = True
+callerSaves (FloatReg 2)       = True
 #endif
 #ifdef CALLER_SAVES_F3
-callerSaves (FloatReg 3#)              = True
+callerSaves (FloatReg 3)       = True
 #endif
 #ifdef CALLER_SAVES_F4
-callerSaves (FloatReg 4#)              = True
+callerSaves (FloatReg 4)       = True
 #endif
 #ifdef CALLER_SAVES_D1
-callerSaves (DoubleReg 1#)             = True
+callerSaves (DoubleReg 1)      = True
 #endif
 #ifdef CALLER_SAVES_D2
-callerSaves (DoubleReg 2#)             = True
+callerSaves (DoubleReg 2)      = True
 #endif
 #ifdef CALLER_SAVES_L1
-callerSaves (LongReg _ ILIT(1))                = True
+callerSaves (LongReg 1)                = True
 #endif
 #ifdef CALLER_SAVES_Sp
-callerSaves Sp                         = True
+callerSaves Sp                 = True
 #endif
 #ifdef CALLER_SAVES_SpLim
-callerSaves SpLim                      = True
+callerSaves SpLim              = True
 #endif
 #ifdef CALLER_SAVES_Hp
-callerSaves Hp                         = True
+callerSaves Hp                 = True
 #endif
 #ifdef CALLER_SAVES_HpLim
-callerSaves HpLim                      = True
+callerSaves HpLim              = True
 #endif
 #ifdef CALLER_SAVES_CurrentTSO
-callerSaves CurrentTSO                 = True
+callerSaves CurrentTSO         = True
 #endif
 #ifdef CALLER_SAVES_CurrentNursery
-callerSaves CurrentNursery             = True
+callerSaves CurrentNursery     = True
 #endif
-callerSaves _                          = False
+callerSaves _                  = False
 
 
 --  | Returns 'Nothing' if this global register is not stored