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,
  10
  11         CCallSpec(..), ccallIsCasm,
  12         CCallTarget(..), dynamicTarget, isDynamicTarget,
  13         CCallConv(..), defaultCCallConv, ccallConvToInt, ccallConvAttribute,
  14
  15         DotNetCallSpec(..)
  16     ) where
  17
  18 #include "HsVersions.h"
  19
  20 import CStrings         ( CLabelString, pprCLabelString )
  21 import Outputable
  22 \end{code}
  23
  24
  25 %************************************************************************
  26 %*                                                                      *
  27 \subsubsection{Data types}
  28 %*                                                                      *
  29 %************************************************************************
  30
  31 \begin{code}
  32 data ForeignCall
  33   = CCall       CCallSpec
  34   | DotNetCall  DotNetCallSpec
  35   deriving( Eq )                -- We compare them when seeing if an interface
  36                                 -- has changed (for versioning purposes)
  37
  38 -- We may need more clues to distinguish foreign calls
  39 -- but this simple printer will do for now
  40 instance Outputable ForeignCall where
  41   ppr (CCall cc)      = ppr cc
  42   ppr (DotNetCall dn) = ppr dn
  43 \end{code}
  44
  45
  46 \begin{code}
  47 data Safety
  48   = PlaySafe            -- Might invoke Haskell GC, or do a call back, or
  49                         -- switch threads, etc.  So make sure things are
  50                         -- tidy before the call
  51
  52   | PlayRisky           -- None of the above can happen; the call will return
  53                         -- without interacting with the runtime system at all
  54   deriving( Eq, Show )
  55         -- Show used just for Show Lex.Token, I think
  56
  57 instance Outputable Safety where
  58   ppr PlaySafe  = empty
  59   ppr PlayRisky = ptext SLIT("unsafe")
  60
  61 playSafe PlaySafe  = True
  62 playSafe PlayRisky = False
  63 \end{code}
  64
  65
  66 %************************************************************************
  67 %*                                                                      *
  68 \subsubsection{Calling C}
  69 %*                                                                      *
  70 %************************************************************************
  71
  72 \begin{code}
  73 data CCallSpec
  74   =  CCallSpec  CCallTarget     -- What to call
  75                 CCallConv       -- Calling convention to use.
  76                 Safety
  77                 Bool            -- True <=> really a "casm"
  78   deriving( Eq )
  79
  80
  81 ccallIsCasm :: CCallSpec -> Bool
  82 ccallIsCasm (CCallSpec _ _ _ c_asm) = c_asm
  83 \end{code}
  84
  85 The call target:
  86
  87 \begin{code}
  88 data CCallTarget
  89   = StaticTarget  CLabelString  -- An "unboxed" ccall# to `fn'.
  90   | DynamicTarget               -- First argument (an Addr#) is the function pointer
  91   deriving( Eq )
  92
  93 isDynamicTarget DynamicTarget    = True
  94 isDynamicTarget (StaticTarget _) = False
  95
  96 dynamicTarget :: CCallTarget
  97 dynamicTarget = DynamicTarget
  98 \end{code}
  99
 100
 101 Stuff to do with calling convention
 102
 103 \begin{code}
 104 data CCallConv = CCallConv | StdCallConv
 105                deriving( Eq )
 106
 107 instance Outputable CCallConv where
 108   ppr StdCallConv = ptext SLIT("__stdcall")
 109   ppr CCallConv   = ptext SLIT("_ccall")
 110
 111 defaultCCallConv :: CCallConv
 112 defaultCCallConv = CCallConv
 113
 114 ccallConvToInt :: CCallConv -> Int
 115 ccallConvToInt StdCallConv = 0
 116 ccallConvToInt CCallConv   = 1
 117 \end{code}
 118
 119 Generate the gcc attribute corresponding to the given
 120 calling convention (used by PprAbsC):
 121
 122 ToDo: The stdcall calling convention is x86 (win32) specific,
 123 so perhaps we should emit a warning if it's being used on other
 124 platforms.
 125
 126 \begin{code}
 127 ccallConvAttribute :: CCallConv -> String
 128 ccallConvAttribute StdCallConv = "__stdcall"
 129 ccallConvAttribute CCallConv   = ""
 130 \end{code}
 131
 132 Printing into C files:
 133
 134 \begin{code}
 135 instance Outputable CCallSpec where
 136   ppr (CCallSpec fun cconv safety is_casm)
 137     = hcat [ ifPprDebug callconv
 138            , text "__", ppr_dyn
 139            , text before , ppr_fun , after]
 140     where
 141         callconv = text "{-" <> ppr cconv <> text "-}"
 142         play_safe = playSafe safety
 143
 144         before
 145           | is_casm && play_safe = "casm_GC ``"
 146           | is_casm              = "casm ``"
 147           | play_safe            = "ccall_GC "
 148           | otherwise            = "ccall "
 149
 150         after
 151           | is_casm   = text "''"
 152           | otherwise = empty
 153
 154         ppr_dyn = case fun of
 155                     DynamicTarget -> text "dyn_"
 156                     _             -> empty
 157
 158         ppr_fun = case fun of
 159                      DynamicTarget   -> text "\"\""
 160                      StaticTarget fn -> pprCLabelString fn
 161 \end{code}
 162
 163
 164 %************************************************************************
 165 %*                                                                      *
 166 \subsubsection{.NET stuff}
 167 %*                                                                      *
 168 %************************************************************************
 169
 170 \begin{code}
 171 data DotNetCallSpec = DotNetCallSpec
 172                     deriving( Eq )
 173
 174 instance Outputable DotNetCallSpec where
 175   ppr DotNetCallSpec = text "DotNet!"
 176 \end{code}