remove empty dir

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

diff --git a/ghc/compiler/nativeGen/MachRegs.lhs b/ghc/compiler/nativeGen/MachRegs.lhs
index 61fa199..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
@@ -342,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
 
@@ -394,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