Moved global register saving from the backend to codeGen

[ghc-hetmet.git] / compiler / codeGen / CgForeignCall.hs

diff --git a/compiler/codeGen/CgForeignCall.hs b/compiler/codeGen/CgForeignCall.hs
index 822a043..c4af511 100644 (file)
--- a/compiler/codeGen/CgForeignCall.hs
+++ b/compiler/codeGen/CgForeignCall.hs
@@ -2,7 +2,7 @@
 --
 -- Code generation for foreign calls.
 --
--- (c) The University of Glasgow 2004
+-- (c) The University of Glasgow 2004-2006
 --
 -----------------------------------------------------------------------------
 
@@ -19,24 +19,30 @@ module CgForeignCall (
 
 #include "HsVersions.h"
 
-import StgSyn          ( StgLiveVars, StgArg, stgArgType )
-import CgProf          ( curCCS, curCCSAddr )
-import CgBindery       ( getVolatileRegs, getArgAmodes )
+import StgSyn
+import CgProf
+import CgBindery
 import CgMonad
-import CgUtils         ( cmmOffsetW, cmmOffsetB, newTemp )
-import Type            ( tyConAppTyCon, repType )
+import CgUtils
+import Type
 import TysPrim
-import CLabel          ( mkForeignLabel, mkRtsCodeLabel )
+import CLabel
 import Cmm
 import CmmUtils
 import MachOp
 import SMRep
 import ForeignCall
 import Constants
-import StaticFlags     ( opt_SccProfilingOn )
+import StaticFlags
 import Outputable
 
-import Monad           ( when )
+import MachRegs (callerSaveVolatileRegs)
+  -- HACK: this is part of the NCG so we shouldn't use this, but we need
+  -- it for now to eliminate the need for saved regs to be in CmmCall.
+  -- The long term solution is to factor callerSaveVolatileRegs
+  -- from nativeGen into codeGen
+
+import Control.Monad
 
 -- -----------------------------------------------------------------------------
 -- Code generation for Foreign Calls
@@ -105,30 +111,33 @@ emitForeignCall'
 emitForeignCall' safety results target args vols 
   | not (playSafe safety) = do
     temp_args <- load_args_into_temps args
-    stmtC (CmmCall target results temp_args vols)
+    let (caller_save, caller_load) = callerSaveVolatileRegs vols
+    stmtsC caller_save
+    stmtC (CmmCall target results temp_args)
+    stmtsC caller_load
 
   | otherwise = do
     id <- newTemp wordRep
     temp_args <- load_args_into_temps args
     temp_target <- load_target_into_temp target
+    let (caller_save, caller_load) = callerSaveVolatileRegs vols
     emitSaveThreadState
+    stmtsC caller_save
     stmtC (CmmCall (CmmForeignCall suspendThread CCallConv) 
                        [(id,PtrHint)]
                        [ (CmmReg (CmmGlobal BaseReg), PtrHint) ] 
-                       vols
                        )
-    stmtC (CmmCall temp_target results temp_args vols)
+    stmtC (CmmCall temp_target results temp_args)
     stmtC (CmmCall (CmmForeignCall resumeThread CCallConv) 
                        [ (CmmGlobal BaseReg, PtrHint) ]
                                -- Assign the result to BaseReg: we
                                -- might now have a different
                                -- Capability!
                        [ (CmmReg id, PtrHint) ]
-                       vols
                        )
+    stmtsC caller_load
     emitLoadThreadState
 
-
 suspendThread = CmmLit (CmmLabel (mkRtsCodeLabel SLIT("suspendThread")))
 resumeThread  = CmmLit (CmmLabel (mkRtsCodeLabel SLIT("resumeThread")))