X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcodeGen%2FCgForeignCall.hs;h=da52bd09d1ddfe091b48807905b9ac021289442c;hb=2eb04ca0f8d0ec72b417cddc60672c696b4a3daa;hp=10f41bdf8bc1ae70297d96c8b322daba4545d8d9;hpb=0065d5ab628975892cea1ec7303f968c3338cbe1;p=ghc-hetmet.git

diff --git a/compiler/codeGen/CgForeignCall.hs b/compiler/codeGen/CgForeignCall.hs
index 10f41bd..da52bd0 100644
--- 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,25 +19,24 @@ 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, cmmLoadIndexW, newTemp,
-			  assignTemp )
-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 Control.Monad
 
 -- -----------------------------------------------------------------------------
 -- Code generation for Foreign Calls
@@ -111,13 +110,14 @@ emitForeignCall' safety results target args vols
   | otherwise = do
     id <- newTemp wordRep
     temp_args <- load_args_into_temps args
+    temp_target <- load_target_into_temp target
     emitSaveThreadState
     stmtC (CmmCall (CmmForeignCall suspendThread CCallConv) 
 			[(id,PtrHint)]
 			[ (CmmReg (CmmGlobal BaseReg), PtrHint) ] 
 			vols
 			)
-    stmtC (CmmCall target results temp_args vols)
+    stmtC (CmmCall temp_target results temp_args vols)
     stmtC (CmmCall (CmmForeignCall resumeThread CCallConv) 
 			[ (CmmGlobal BaseReg, PtrHint) ]
 				-- Assign the result to BaseReg: we
@@ -140,16 +140,25 @@ resumeThread  = CmmLit (CmmLabel (mkRtsCodeLabel SLIT("resumeThread")))
 --
 -- This is a HACK; really it should be done in the back end, but
 -- it's easier to generate the temporaries here.
-load_args_into_temps args = mapM maybe_assignTemp args
+load_args_into_temps = mapM arg_assign_temp
+  where arg_assign_temp (e,hint) = do
+	   tmp <- maybe_assign_temp e
+	   return (tmp,hint)
 	
-maybe_assignTemp (e, hint)
-  | hasNoGlobalRegs e = return (e, hint)
+load_target_into_temp (CmmForeignCall expr conv) = do 
+  tmp <- maybe_assign_temp expr
+  return (CmmForeignCall tmp conv)
+load_target_info_temp other_target =
+  return other_target
+
+maybe_assign_temp e
+  | hasNoGlobalRegs e = return e
   | otherwise          = do 
 	-- don't use assignTemp, it uses its own notion of "trivial"
 	-- expressions, which are wrong here
 	reg <- newTemp (cmmExprRep e)
 	stmtC (CmmAssign reg e)
-	return (CmmReg reg, hint)
+	return (CmmReg reg)
 
 -- -----------------------------------------------------------------------------
 -- Save/restore the thread state in the TSO