X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fprelude%2FForeignCall.lhs;h=015b28e2fe3403f74156aa9186006316bed18166;hp=50130785cd72a9e608403f2452766a2fd8a32b69;hb=71aa4a4723e95b4f27fccf93dcc0a33000010974;hpb=30c122df62ec75f9ed7f392f24c2925675bf1d06

diff --git a/compiler/prelude/ForeignCall.lhs b/compiler/prelude/ForeignCall.lhs
index 5013078..015b28e 100644
--- a/compiler/prelude/ForeignCall.lhs
+++ b/compiler/prelude/ForeignCall.lhs
@@ -13,7 +13,7 @@
 
 module ForeignCall (
 	ForeignCall(..),
-	Safety(..), playSafe, playThreadSafe,
+	Safety(..), playSafe,
 
 	CExportSpec(..), CLabelString, isCLabelString, pprCLabelString,
 	CCallSpec(..), 
@@ -24,8 +24,6 @@ module ForeignCall (
 	withDNTypes
     ) where
 
-#include "HsVersions.h"
-
 import FastString
 import Char		( isAlphaNum )
 import Binary
@@ -59,11 +57,14 @@ instance Outputable ForeignCall where
 data Safety
   = PlaySafe		-- Might invoke Haskell GC, or do a call back, or
 			-- switch threads, etc.  So make sure things are
-			-- tidy before the call
-	Bool            -- => True, external function is also re-entrant.
-			--    [if supported, RTS arranges for the external call
-			--    to be executed by a separate OS thread, i.e.,
-			--    _concurrently_ to the execution of other Haskell threads.]
+			-- tidy before the call. Additionally, in the threaded
+			-- RTS we arrange for the external call to be executed
+			-- by a separate OS thread, i.e., _concurrently_ to the
+			-- execution of other Haskell threads.
+
+      Bool              -- Indicates the deprecated "threadsafe" annotation
+                        -- which is now an alias for "safe". This information
+                        -- is never used except to emit a deprecation warning.
 
   | PlayRisky		-- None of the above can happen; the call will return
 			-- without interacting with the runtime system at all
@@ -72,17 +73,13 @@ data Safety
   {-! derive: Binary !-}
 
 instance Outputable Safety where
-  ppr (PlaySafe False) = ptext SLIT("safe")
-  ppr (PlaySafe True)  = ptext SLIT("threadsafe")
-  ppr PlayRisky = ptext SLIT("unsafe")
+  ppr (PlaySafe False) = ptext (sLit "safe")
+  ppr (PlaySafe True)  = ptext (sLit "threadsafe")
+  ppr PlayRisky = ptext (sLit "unsafe")
 
 playSafe :: Safety -> Bool
 playSafe PlaySafe{} = True
 playSafe PlayRisky  = False
-
-playThreadSafe :: Safety -> Bool
-playThreadSafe (PlaySafe x) = x
-playThreadSafe _ = False
 \end{code}
 
 
@@ -118,7 +115,7 @@ data CCallTarget
 
 isDynamicTarget :: CCallTarget -> Bool
 isDynamicTarget DynamicTarget = True
-isDynamicTarget other	      = False
+isDynamicTarget _             = False
 \end{code}
 
 
@@ -133,16 +130,19 @@ stdcall: 	Caller allocates parameters, callee deallocates.
 ToDo: The stdcall calling convention is x86 (win32) specific,
 so perhaps we should emit a warning if it's being used on other
 platforms.
+ 
+See: http://www.programmersheaven.com/2/Calling-conventions
 
 \begin{code}
-data CCallConv = CCallConv | StdCallConv | CmmCallConv
+data CCallConv = CCallConv | StdCallConv | CmmCallConv | PrimCallConv
   deriving (Eq)
   {-! derive: Binary !-}
 
 instance Outputable CCallConv where
-  ppr StdCallConv = ptext SLIT("stdcall")
-  ppr CCallConv   = ptext SLIT("ccall")
-  ppr CmmCallConv = ptext SLIT("C--")
+  ppr StdCallConv = ptext (sLit "stdcall")
+  ppr CCallConv   = ptext (sLit "ccall")
+  ppr CmmCallConv = ptext (sLit "C--")
+  ppr PrimCallConv = ptext (sLit "prim")
 
 defaultCCallConv :: CCallConv
 defaultCCallConv = CCallConv
@@ -333,11 +333,14 @@ instance Binary CCallConv where
 	    putByte bh 0
     put_ bh StdCallConv = do
 	    putByte bh 1
+    put_ bh PrimCallConv = do
+	    putByte bh 2
     get bh = do
 	    h <- getByte bh
 	    case h of
 	      0 -> do return CCallConv
-	      _ -> do return StdCallConv
+	      1 -> do return StdCallConv
+	      _ -> do return PrimCallConv
 
 instance Binary DNCallSpec where
     put_ bh (DNCallSpec isStatic kind ass nm _ _) = do