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
18 CExportSpec(..), CLabelString, isCLabelString, pprCLabelString,
20 CCallTarget(..), isDynamicTarget,
21 CCallConv(..), defaultCCallConv, ccallConvToInt, ccallConvAttribute,
32 %************************************************************************
34 \subsubsection{Data types}
36 %************************************************************************
39 newtype ForeignCall = CCall CCallSpec
41 {-! derive: Binary !-}
43 -- We may need more clues to distinguish foreign calls
44 -- but this simple printer will do for now
45 instance Outputable ForeignCall where
46 ppr (CCall cc) = ppr cc
52 = PlaySafe -- Might invoke Haskell GC, or do a call back, or
53 -- switch threads, etc. So make sure things are
54 -- tidy before the call. Additionally, in the threaded
55 -- RTS we arrange for the external call to be executed
56 -- by a separate OS thread, i.e., _concurrently_ to the
57 -- execution of other Haskell threads.
59 Bool -- Indicates the deprecated "threadsafe" annotation
60 -- which is now an alias for "safe". This information
61 -- is never used except to emit a deprecation warning.
63 | PlayRisky -- None of the above can happen; the call will return
64 -- without interacting with the runtime system at all
66 -- Show used just for Show Lex.Token, I think
67 {-! derive: Binary !-}
69 instance Outputable Safety where
70 ppr (PlaySafe False) = ptext (sLit "safe")
71 ppr (PlaySafe True) = ptext (sLit "threadsafe")
72 ppr PlayRisky = ptext (sLit "unsafe")
74 playSafe :: Safety -> Bool
75 playSafe PlaySafe{} = True
76 playSafe PlayRisky = False
80 %************************************************************************
82 \subsubsection{Calling C}
84 %************************************************************************
88 = CExportStatic -- foreign export ccall foo :: ty
89 CLabelString -- C Name of exported function
91 {-! derive: Binary !-}
94 = CCallSpec CCallTarget -- What to call
95 CCallConv -- Calling convention to use.
98 {-! derive: Binary !-}
105 = StaticTarget CLabelString -- An "unboxed" ccall# to `fn'.
106 | DynamicTarget -- First argument (an Addr#) is the function pointer
108 {-! derive: Binary !-}
110 isDynamicTarget :: CCallTarget -> Bool
111 isDynamicTarget DynamicTarget = True
112 isDynamicTarget _ = False
116 Stuff to do with calling convention:
118 ccall: Caller allocates parameters, *and* deallocates them.
120 stdcall: Caller allocates parameters, callee deallocates.
121 Function name has @N after it, where N is number of arg bytes
124 ToDo: The stdcall calling convention is x86 (win32) specific,
125 so perhaps we should emit a warning if it's being used on other
128 See: http://www.programmersheaven.com/2/Calling-conventions
131 data CCallConv = CCallConv | StdCallConv | CmmCallConv | PrimCallConv
133 {-! derive: Binary !-}
135 instance Outputable CCallConv where
136 ppr StdCallConv = ptext (sLit "stdcall")
137 ppr CCallConv = ptext (sLit "ccall")
138 ppr CmmCallConv = ptext (sLit "C--")
139 ppr PrimCallConv = ptext (sLit "prim")
141 defaultCCallConv :: CCallConv
142 defaultCCallConv = CCallConv
144 ccallConvToInt :: CCallConv -> Int
145 ccallConvToInt StdCallConv = 0
146 ccallConvToInt CCallConv = 1
149 Generate the gcc attribute corresponding to the given
150 calling convention (used by PprAbsC):
153 ccallConvAttribute :: CCallConv -> String
154 ccallConvAttribute StdCallConv = "__attribute__((__stdcall__))"
155 ccallConvAttribute CCallConv = ""
159 type CLabelString = FastString -- A C label, completely unencoded
161 pprCLabelString :: CLabelString -> SDoc
162 pprCLabelString lbl = ftext lbl
164 isCLabelString :: CLabelString -> Bool -- Checks to see if this is a valid C label
166 = all ok (unpackFS lbl)
168 ok c = isAlphaNum c || c == '_' || c == '.'
169 -- The '.' appears in e.g. "foo.so" in the
170 -- module part of a ExtName. Maybe it should be separate
174 Printing into C files:
177 instance Outputable CExportSpec where
178 ppr (CExportStatic str _) = pprCLabelString str
180 instance Outputable CCallSpec where
181 ppr (CCallSpec fun cconv safety)
182 = hcat [ ifPprDebug callconv, ppr_fun fun ]
184 callconv = text "{-" <> ppr cconv <> text "-}"
186 gc_suf | playSafe safety = text "_GC"
189 ppr_fun DynamicTarget = text "__dyn_ccall" <> gc_suf <+> text "\"\""
190 ppr_fun (StaticTarget fn) = text "__ccall" <> gc_suf <+> pprCLabelString fn
194 %************************************************************************
198 %************************************************************************
201 {-* Generated by DrIFT-v1.0 : Look, but Don't Touch. *-}
202 instance Binary ForeignCall where
203 put_ bh (CCall aa) = put_ bh aa
204 get bh = do aa <- get bh; return (CCall aa)
206 instance Binary Safety where
207 put_ bh (PlaySafe aa) = do
210 put_ bh PlayRisky = do
217 _ -> do return PlayRisky
219 instance Binary CExportSpec where
220 put_ bh (CExportStatic aa ab) = do
226 return (CExportStatic aa ab)
228 instance Binary CCallSpec where
229 put_ bh (CCallSpec aa ab ac) = do
237 return (CCallSpec aa ab ac)
239 instance Binary CCallTarget where
240 put_ bh (StaticTarget aa) = do
243 put_ bh DynamicTarget = do
249 return (StaticTarget aa)
250 _ -> do return DynamicTarget
252 instance Binary CCallConv where
253 put_ bh CCallConv = do
255 put_ bh StdCallConv = do
257 put_ bh PrimCallConv = do
262 0 -> do return CCallConv
263 1 -> do return StdCallConv
264 _ -> do return PrimCallConv