modules/ffi.st

   1 "
   2  Little Smalltalk, Version 5
   3
   4  Copyright (C) 1987-2005 by Timothy A. Budd
   5  Copyright (C) 2007 by Charles R. Childers
   6  Copyright (C) 2005-2007 by Danny Reinhold
   7  Copyright (C) 2010 by Ketmar // Vampire Avalon
   8
   9  ============================================================================
  10  This license applies to the virtual machine and to the initial image of
  11  the Little Smalltalk system and to all files in the Little Smalltalk
  12  packages except the files explicitly licensed with another license(s).
  13  ============================================================================
  14  Permission is hereby granted, free of charge, to any person obtaining a copy
  15  of this software and associated documentation files (the 'Software'), to deal
  16  in the Software without restriction, including without limitation the rights
  17  to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
  18  copies of the Software, and to permit persons to whom the Software is
  19  furnished to do so, subject to the following conditions:
  20
  21  The above copyright notice and this permission notice shall be included in
  22  all copies or substantial portions of the Software.
  23
  24  THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
  25  IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
  26  FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
  27  AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
  28  LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
  29  FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
  30  DEALINGS IN THE SOFTWARE.
  31 "
  32 Requires [
  33   pathname
  34 ]
  35
  36 Package [
  37   FFI
  38 ]
  39 "
  40 EXTPRIM FFIResolveName
  41 EXTPRIM FFILoadDLib
  42 EXTPRIM FFICloseHandle
  43 EXTPRIM FFICall
  44 EXTPRIM FFICallRetInt
  45 EXTPRIM FFICallRetStr
  46 EXTPRIM FFIGetInt
  47 EXTPRIM FFISetInt
  48 "
  49
  50 Object subclass: FFI [
  51 | handle name functions |
  52
  53 ^new [
  54   | obj |
  55   obj <- super new.
  56   obj init.
  57   ^obj
  58 ]
  59
  60 ^new: theName [
  61   | obj |
  62   obj <- super new.
  63   obj init.
  64   obj open: theName.
  65   ^obj
  66 ]
  67
  68 init [
  69   functions <- Dictionary new
  70 ]
  71
  72 name: theName [
  73   | path |
  74   path <- PathName new: theName.
  75   path replaceOrAddSuffix: System suffixForDLL.
  76   name <- path path.
  77 ]
  78
  79 name [
  80   ^name
  81 ]
  82
  83 handle: theHandle [
  84   handle <- theHandle
  85 ]
  86
  87 handle [
  88   ^handle
  89 ]
  90
  91 functions: theFunctions [
  92   functions <- theFunctions
  93 ]
  94
  95 functions [
  96   ^functions
  97 ]
  98
  99 resolveFunction: theName [
 100   ^<#FFIResolveName handle (theName printString)>
 101 ]
 102
 103 add: theName [
 104   | func |
 105   func <- self resolveFunction: theName.
 106   functions at: theName put: func.
 107 ]
 108
 109 at: theName [
 110   ^functions at: theName
 111 ]
 112
 113 openPrim [
 114   ^<#FFILoadDLib (name printString)>
 115 ]
 116
 117 open [
 118   handle <- self openPrim
 119 ]
 120
 121 open: theName [
 122   self name: theName.
 123   ^self open
 124 ]
 125
 126 closePrim [
 127   ^<#FFICloseHandle handle>
 128 ]
 129
 130 close [
 131   self closePrim.
 132   handle <- nil
 133 ]
 134
 135 call: theName [
 136   ^self call: theName args: (Array new: 0)
 137 ]
 138
 139 call: theName arg: theArg [
 140   | args |
 141   args <- Array new: 1.
 142   args at: 1 put: theArg.
 143   ^self call: theName args: args.
 144 ]
 145
 146 call: theName arg: argOne arg: argTwo [
 147   | args |
 148   args <- Array new: 2.
 149   args at: 1 put: argOne.
 150   args at: 2 put: argTwo.
 151   ^self call: theName args: args.
 152 ]
 153
 154 call: theName arg: argOne arg: argTwo arg: argThree [
 155   | args |
 156   args <- Array new: 3.
 157   args at: 1 put: argOne.
 158   args at: 2 put: argTwo.
 159   args at: 3 put: argThree.
 160   ^self call: theName args: args.
 161 ]
 162
 163 callInt: theName [
 164   ^self callInt: theName args: (Array new: 0)
 165 ]
 166
 167 callInt: theName arg: theArg [
 168   | args |
 169   args <- Array new: 1.
 170   args at: 1 put: theArg.
 171   ^self callInt: theName args: args.
 172 ]
 173
 174 callInt: theName arg: argOne arg: argTwo [
 175   | args |
 176   args <- Array new: 2.
 177   args at: 1 put: argOne.
 178   args at: 2 put: argTwo.
 179   ^self callInt: theName args: args.
 180 ]
 181
 182 callInt: theName arg: argOne arg: argTwo arg: argThree [
 183   | args |
 184   args <- Array new: 3.
 185   args at: 1 put: argOne.
 186   args at: 2 put: argTwo.
 187   args at: 3 put: argThree.
 188   ^self callInt: theName args: args.
 189 ]
 190
 191 callStr: theName [
 192   ^self callStr: theName args: (Array new: 0)
 193 ]
 194
 195 callStr: theName arg: theArg [
 196   | args |
 197   args <- Array new: 1.
 198   args at: 1 put: theArg.
 199   ^self callStr: theName args: args.
 200 ]
 201
 202 callStr: theName arg: argOne arg: argTwo [
 203   | args |
 204   args <- Array new: 2.
 205   args at: 1 put: argOne.
 206   args at: 2 put: argTwo.
 207   ^self callStr: theName args: args.
 208 ]
 209
 210 callStr: theName arg: argOne arg: argTwo arg: argThree [
 211   | args |
 212   args <- Array new: 3.
 213   args at: 1 put: argOne.
 214   args at: 2 put: argTwo.
 215   args at: 3 put: argThree.
 216   ^self callStr: theName args: args.
 217 ]
 218
 219 call: theName args: theArgs [
 220   | func args |
 221   func <- self at: theName.
 222   args <- theArgs asArray.
 223   <#FFICall handle func args>
 224 ]
 225
 226 callInt: theName args: theArgs [
 227   | func args |
 228   func <- self at: theName.
 229   args <- theArgs asArray.
 230   <#FFICallRetInt handle func args>
 231 ]
 232
 233 callStr: theName args: theArgs [
 234   | func args |
 235   func <- self at: theName.
 236   args <- theArgs asArray.
 237   <#FFICallRetStr handle func args>
 238 ]
 239
 240 getInt: theName [
 241   | symb |
 242   symb <- self at: theName.
 243   ^<#FFIGetInt handle symb>
 244 ]
 245
 246 setInt: theName value: anInt [
 247   | symb |
 248   symb <- self at: theName.
 249   <#FFISetInt handle symb anInt>
 250 ]
 251 ]