2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[Foreign]{Foreign calls}
8 -- The above warning supression flag is a temporary kludge.
9 -- While working on this module you are encouraged to remove it and fix
10 -- any warnings in the module. See
11 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
13 {-# LANGUAGE DeriveDataTypeable #-}
17 Safety(..), playSafe, playInterruptible,
19 CExportSpec(..), CLabelString, isCLabelString, pprCLabelString,
21 CCallTarget(..), isDynamicTarget,
22 CCallConv(..), defaultCCallConv, ccallConvToInt, ccallConvAttribute,
35 %************************************************************************
37 \subsubsection{Data types}
39 %************************************************************************
42 newtype ForeignCall = CCall CCallSpec
44 {-! derive: Binary !-}
46 -- We may need more clues to distinguish foreign calls
47 -- but this simple printer will do for now
48 instance Outputable ForeignCall where
49 ppr (CCall cc) = ppr cc
55 = PlaySafe -- Might invoke Haskell GC, or do a call back, or
56 -- switch threads, etc. So make sure things are
57 -- tidy before the call. Additionally, in the threaded
58 -- RTS we arrange for the external call to be executed
59 -- by a separate OS thread, i.e., _concurrently_ to the
60 -- execution of other Haskell threads.
62 Bool -- Indicates the deprecated "threadsafe" annotation
63 -- which is now an alias for "safe". This information
64 -- is never used except to emit a deprecation warning.
66 | PlayInterruptible -- Like PlaySafe, but additionally
67 -- the worker thread running this foreign call may
68 -- be unceremoniously killed, so it must be scheduled
69 -- on an unbound thread.
71 | PlayRisky -- None of the above can happen; the call will return
72 -- without interacting with the runtime system at all
73 deriving ( Eq, Show, Data, Typeable )
74 -- Show used just for Show Lex.Token, I think
75 {-! derive: Binary !-}
77 instance Outputable Safety where
78 ppr (PlaySafe False) = ptext (sLit "safe")
79 ppr (PlaySafe True) = ptext (sLit "threadsafe")
80 ppr PlayInterruptible = ptext (sLit "interruptible")
81 ppr PlayRisky = ptext (sLit "unsafe")
83 playSafe :: Safety -> Bool
84 playSafe PlaySafe{} = True
85 playSafe PlayInterruptible = True
86 playSafe PlayRisky = False
88 playInterruptible :: Safety -> Bool
89 playInterruptible PlayInterruptible = True
90 playInterruptible _ = False
94 %************************************************************************
96 \subsubsection{Calling C}
98 %************************************************************************
102 = CExportStatic -- foreign export ccall foo :: ty
103 CLabelString -- C Name of exported function
105 deriving (Data, Typeable)
106 {-! derive: Binary !-}
109 = CCallSpec CCallTarget -- What to call
110 CCallConv -- Calling convention to use.
113 {-! derive: Binary !-}
120 -- | How to call a particular function in C-land.
122 -- An "unboxed" ccall# to named function in a particular package.
124 CLabelString -- C-land name of label.
126 (Maybe PackageId) -- What package the function is in.
127 -- If Nothing, then it's taken to be in the current package.
128 -- Note: This information is only used for PrimCalls on Windows.
129 -- See CLabel.labelDynamic and CoreToStg.coreToStgApp
130 -- for the difference in representation between PrimCalls
131 -- and ForeignCalls. If the CCallTarget is representing
132 -- a regular ForeignCall then it's safe to set this to Nothing.
134 -- The first argument of the import is the name of a function pointer (an Addr#).
135 -- Used when importing a label as "foreign import ccall "dynamic" ..."
138 deriving( Eq, Data, Typeable )
139 {-! derive: Binary !-}
141 isDynamicTarget :: CCallTarget -> Bool
142 isDynamicTarget DynamicTarget = True
143 isDynamicTarget _ = False
147 Stuff to do with calling convention:
149 ccall: Caller allocates parameters, *and* deallocates them.
151 stdcall: Caller allocates parameters, callee deallocates.
152 Function name has @N after it, where N is number of arg bytes
155 ToDo: The stdcall calling convention is x86 (win32) specific,
156 so perhaps we should emit a warning if it's being used on other
159 See: http://www.programmersheaven.com/2/Calling-conventions
162 data CCallConv = CCallConv | StdCallConv | CmmCallConv | PrimCallConv
163 deriving (Eq, Data, Typeable)
164 {-! derive: Binary !-}
166 instance Outputable CCallConv where
167 ppr StdCallConv = ptext (sLit "stdcall")
168 ppr CCallConv = ptext (sLit "ccall")
169 ppr CmmCallConv = ptext (sLit "C--")
170 ppr PrimCallConv = ptext (sLit "prim")
172 defaultCCallConv :: CCallConv
173 defaultCCallConv = CCallConv
175 ccallConvToInt :: CCallConv -> Int
176 ccallConvToInt StdCallConv = 0
177 ccallConvToInt CCallConv = 1
180 Generate the gcc attribute corresponding to the given
181 calling convention (used by PprAbsC):
184 ccallConvAttribute :: CCallConv -> String
185 ccallConvAttribute StdCallConv = "__attribute__((__stdcall__))"
186 ccallConvAttribute CCallConv = ""
190 type CLabelString = FastString -- A C label, completely unencoded
192 pprCLabelString :: CLabelString -> SDoc
193 pprCLabelString lbl = ftext lbl
195 isCLabelString :: CLabelString -> Bool -- Checks to see if this is a valid C label
197 = all ok (unpackFS lbl)
199 ok c = isAlphaNum c || c == '_' || c == '.'
200 -- The '.' appears in e.g. "foo.so" in the
201 -- module part of a ExtName. Maybe it should be separate
205 Printing into C files:
208 instance Outputable CExportSpec where
209 ppr (CExportStatic str _) = pprCLabelString str
211 instance Outputable CCallSpec where
212 ppr (CCallSpec fun cconv safety)
213 = hcat [ ifPprDebug callconv, ppr_fun fun ]
215 callconv = text "{-" <> ppr cconv <> text "-}"
217 gc_suf | playSafe safety = text "_GC"
220 ppr_fun (StaticTarget fn Nothing)
221 = text "__pkg_ccall" <> gc_suf <+> pprCLabelString fn
223 ppr_fun (StaticTarget fn (Just pkgId))
224 = text "__pkg_ccall" <> gc_suf <+> ppr pkgId <+> pprCLabelString fn
226 ppr_fun DynamicTarget
227 = text "__dyn_ccall" <> gc_suf <+> text "\"\""
231 %************************************************************************
235 %************************************************************************
238 {-* Generated by DrIFT-v1.0 : Look, but Don't Touch. *-}
239 instance Binary ForeignCall where
240 put_ bh (CCall aa) = put_ bh aa
241 get bh = do aa <- get bh; return (CCall aa)
243 instance Binary Safety where
244 put_ bh (PlaySafe aa) = do
247 put_ bh PlayInterruptible = do
249 put_ bh PlayRisky = do
256 1 -> do return PlayInterruptible
257 _ -> do return PlayRisky
259 instance Binary CExportSpec where
260 put_ bh (CExportStatic aa ab) = do
266 return (CExportStatic aa ab)
268 instance Binary CCallSpec where
269 put_ bh (CCallSpec aa ab ac) = do
277 return (CCallSpec aa ab ac)
279 instance Binary CCallTarget where
280 put_ bh (StaticTarget aa ab) = do
284 put_ bh DynamicTarget = do
291 return (StaticTarget aa ab)
292 _ -> do return DynamicTarget
294 instance Binary CCallConv where
295 put_ bh CCallConv = do
297 put_ bh StdCallConv = do
299 put_ bh PrimCallConv = do
304 0 -> do return CCallConv
305 1 -> do return StdCallConv
306 _ -> do return PrimCallConv