ghc/compiler/prelude/ForeignCall.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 \section[Foreign]{Foreign calls}
   5
   6 \begin{code}
   7 module ForeignCall (
   8         ForeignCall(..),
   9         Safety(..), playSafe, playThreadSafe,
  10
  11         CExportSpec(..),
  12         CCallSpec(..),
  13         CCallTarget(..), isDynamicTarget, isCasmTarget,
  14         CCallConv(..), defaultCCallConv, ccallConvToInt, ccallConvAttribute,
  15
  16         DNCallSpec(..),
  17
  18         okToExposeFCall
  19     ) where
  20
  21 #include "HsVersions.h"
  22
  23 import CStrings         ( CLabelString, pprCLabelString )
  24 import FastString       ( FastString )
  25 import Outputable
  26 \end{code}
  27
  28
  29 %************************************************************************
  30 %*                                                                      *
  31 \subsubsection{Data types}
  32 %*                                                                      *
  33 %************************************************************************
  34
  35 \begin{code}
  36 data ForeignCall
  37   = CCall       CCallSpec
  38   | DNCall      DNCallSpec
  39   deriving( Eq )                -- We compare them when seeing if an interface
  40                                 -- has changed (for versioning purposes)
  41
  42 -- We may need more clues to distinguish foreign calls
  43 -- but this simple printer will do for now
  44 instance Outputable ForeignCall where
  45   ppr (CCall cc)  = ppr cc
  46   ppr (DNCall dn) = ppr dn
  47 \end{code}
  48
  49
  50 \begin{code}
  51 data Safety
  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
  55         Bool            -- => True, external function is also re-entrant.
  56                         --    [if supported, RTS arranges for the external call
  57                         --    to be executed by a separate OS thread, i.e.,
  58                         --    _concurrently_ to the execution of other Haskell threads.]
  59
  60   | PlayRisky           -- None of the above can happen; the call will return
  61                         -- without interacting with the runtime system at all
  62   deriving( Eq, Show )
  63         -- Show used just for Show Lex.Token, I think
  64
  65 instance Outputable Safety where
  66   ppr (PlaySafe False) = ptext SLIT("safe")
  67   ppr (PlaySafe True)  = ptext SLIT("threadsafe")
  68   ppr PlayRisky = ptext SLIT("unsafe")
  69
  70 playSafe :: Safety -> Bool
  71 playSafe PlaySafe{} = True
  72 playSafe PlayRisky  = False
  73
  74 playThreadSafe :: Safety -> Bool
  75 playThreadSafe (PlaySafe x) = x
  76 playThreadSafe _ = False
  77 \end{code}
  78
  79
  80 %************************************************************************
  81 %*                                                                      *
  82 \subsubsection{Calling C}
  83 %*                                                                      *
  84 %************************************************************************
  85
  86 \begin{code}
  87 data CExportSpec
  88   = CExportStatic               -- foreign export ccall foo :: ty
  89         CLabelString            -- C Name of exported function
  90         CCallConv
  91
  92 data CCallSpec
  93   =  CCallSpec  CCallTarget     -- What to call
  94                 CCallConv       -- Calling convention to use.
  95                 Safety
  96   deriving( Eq )
  97 \end{code}
  98
  99 The call target:
 100
 101 \begin{code}
 102 data CCallTarget
 103   = StaticTarget  CLabelString  -- An "unboxed" ccall# to `fn'.
 104   | DynamicTarget               -- First argument (an Addr#) is the function pointer
 105   | CasmTarget    CLabelString  -- Inline C code (now seriously deprecated)
 106   deriving( Eq )
 107
 108 isDynamicTarget, isCasmTarget :: CCallTarget -> Bool
 109 isDynamicTarget DynamicTarget = True
 110 isDynamicTarget other         = False
 111
 112 isCasmTarget (CasmTarget _) = True
 113 isCasmTarget other          = False
 114 \end{code}
 115
 116
 117 Stuff to do with calling convention:
 118
 119 ccall:          Caller allocates parameters, *and* deallocates them.
 120
 121 stdcall:        Caller allocates parameters, callee deallocates.
 122                 Function name has @N after it, where N is number of arg bytes
 123                 e.g.  _Foo@8
 124
 125 ToDo: The stdcall calling convention is x86 (win32) specific,
 126 so perhaps we should emit a warning if it's being used on other
 127 platforms.
 128
 129 \begin{code}
 130 data CCallConv = CCallConv | StdCallConv
 131                deriving (Eq)
 132
 133 instance Outputable CCallConv where
 134   ppr StdCallConv = ptext SLIT("stdcall")
 135   ppr CCallConv   = ptext SLIT("ccall")
 136
 137 defaultCCallConv :: CCallConv
 138 defaultCCallConv = CCallConv
 139
 140 ccallConvToInt :: CCallConv -> Int
 141 ccallConvToInt StdCallConv = 0
 142 ccallConvToInt CCallConv   = 1
 143 \end{code}
 144
 145 Generate the gcc attribute corresponding to the given
 146 calling convention (used by PprAbsC):
 147
 148 \begin{code}
 149 ccallConvAttribute :: CCallConv -> String
 150 ccallConvAttribute StdCallConv = "__stdcall"
 151 ccallConvAttribute CCallConv   = ""
 152 \end{code}
 153
 154 Printing into C files:
 155
 156 \begin{code}
 157 instance Outputable CExportSpec where
 158   ppr (CExportStatic str _) = pprCLabelString str
 159
 160 instance Outputable CCallSpec where
 161   ppr (CCallSpec fun cconv safety)
 162     = hcat [ ifPprDebug callconv, ppr_fun fun ]
 163     where
 164       callconv = text "{-" <> ppr cconv <> text "-}"
 165
 166       gc_suf | playSafe safety = text "_GC"
 167              | otherwise       = empty
 168
 169       ppr_fun DynamicTarget     = text "__dyn_ccall" <> gc_suf <+> text "\"\""
 170       ppr_fun (StaticTarget fn) = text "__ccall"     <> gc_suf <+> pprCLabelString fn
 171       ppr_fun (CasmTarget   fn) = text "__casm"      <> gc_suf <+> text "``" <> pprCLabelString fn <> text "''"
 172 \end{code}
 173
 174
 175 %************************************************************************
 176 %*                                                                      *
 177 \subsubsection{.NET stuff}
 178 %*                                                                      *
 179 %************************************************************************
 180
 181 \begin{code}
 182 data DNCallSpec = DNCallSpec FastString
 183                 deriving (Eq)
 184
 185 instance Outputable DNCallSpec where
 186   ppr (DNCallSpec s) = char '"' <> ptext s <> char '"'
 187 \end{code}
 188
 189
 190
 191 %************************************************************************
 192 %*                                                                      *
 193 \subsubsection{Misc}
 194 %*                                                                      *
 195 %************************************************************************
 196
 197 \begin{code}
 198 okToExposeFCall :: ForeignCall -> Bool
 199 -- OK to unfold a Foreign Call in an interface file
 200 -- Yes, unless it's a _casm_
 201 okToExposeFCall (CCall (CCallSpec target _ _)) = not (isCasmTarget target)
 202 okToExposeFCall other                          = True
 203 \end{code}