1(* 2 Title: Foreign Function Interface: main part 3 Author: David Matthews 4 Copyright David Matthews 2015-16, 2018 5 6 This library is free software; you can redistribute it and/or 7 modify it under the terms of the GNU Lesser General Public 8 License version 2.1 as published by the Free Software Foundation. 9 10 This library is distributed in the hope that it will be useful, 11 but WITHOUT ANY WARRANTY; without even the implied warranty of 12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 13 Lesser General Public License for more details. 14 15 You should have received a copy of the GNU Lesser General Public 16 License along with this library; if not, write to the Free Software 17 Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA 18*) 19 20signature FOREIGN = 21sig 22 exception Foreign of string 23 24 structure Memory: 25 sig 26 eqtype volatileRef 27 val volatileRef: SysWord.word -> volatileRef 28 val setVolatileRef: volatileRef * SysWord.word -> unit 29 val getVolatileRef: volatileRef -> SysWord.word 30 31 eqtype voidStar 32 val voidStar2Sysword: voidStar -> SysWord.word 33 val sysWord2VoidStar: SysWord.word -> voidStar 34 val null: voidStar 35 36 val ++ : voidStar * word -> voidStar 37 val -- : voidStar * word -> voidStar 38 39 (* Remember an address except across loads. *) 40 val memoise: ('a -> voidStar) ->'a -> unit -> voidStar 41 42 exception Memory 43 44 (* malloc - allocate memory. N.B. argument is the number of bytes. 45 Raises Memory exception if it cannot allocate. *) 46 val malloc: word -> voidStar 47 (* free - free allocated memory. *) 48 val free: voidStar -> unit 49 50 val get8: voidStar * Word.word -> Word8.word 51 val get16: voidStar * Word.word -> Word.word 52 val get32: voidStar * Word.word -> Word32.word 53 val get64: voidStar * Word.word -> SysWord.word 54 val set8: voidStar * Word.word * Word8.word -> unit 55 val set16: voidStar * Word.word * Word.word -> unit 56 val set32: voidStar * Word.word * Word32.word -> unit 57 val set64: voidStar * Word.word * SysWord.word -> unit 58 59 val getFloat: voidStar * Word.word -> real 60 val getDouble: voidStar * Word.word -> real 61 val setFloat: voidStar * Word.word * real -> unit 62 val setDouble: voidStar * Word.word * real -> unit 63 64 val getAddress: voidStar * Word.word -> voidStar 65 val setAddress: voidStar * Word.word * voidStar -> unit 66 end 67 68 structure System: 69 sig 70 type voidStar = Memory.voidStar 71 type externalSymbol 72 val loadLibrary: string -> voidStar 73 and loadExecutable: unit -> voidStar 74 and freeLibrary: voidStar -> unit 75 and getSymbol: voidStar * string -> voidStar 76 and externalFunctionSymbol: string -> externalSymbol 77 and externalDataSymbol: string -> externalSymbol 78 and addressOfExternal: externalSymbol -> voidStar 79 end 80 81 structure LibFFI: 82 sig 83 eqtype abi 84 (* List of ABIs defined in libffi for this platform. *) 85 val abiList: (string * abi) list 86 (* The default Abi. *) 87 val abiDefault: abi 88 89 (* Type codes. *) 90 val ffiTypeCodeVoid: Word.word 91 and ffiTypeCodeInt: Word.word 92 and ffiTypeCodeFloat: Word.word 93 and ffiTypeCodeDouble: Word.word 94 and ffiTypeCodeUInt8: Word.word 95 and ffiTypeCodeSInt8: Word.word 96 and ffiTypeCodeUInt16: Word.word 97 and ffiTypeCodeSInt16: Word.word 98 and ffiTypeCodeUInt32: Word.word 99 and ffiTypeCodeSInt32: Word.word 100 and ffiTypeCodeUInt64: Word.word 101 and ffiTypeCodeSInt64: Word.word 102 and ffiTypeCodeStruct: Word.word 103 and ffiTypeCodePointer: Word.word 104 105 (* Predefined types. These are addresses so have to be reloaded 106 in each session. *) 107 eqtype ffiType 108 val ffiType2voidStar: ffiType -> Memory.voidStar 109 val voidStar2ffiType: Memory.voidStar -> ffiType 110 111 val getFFItypeVoid: unit -> ffiType 112 and getFFItypeUint8: unit -> ffiType 113 and getFFItypeSint8: unit -> ffiType 114 and getFFItypeUint16: unit -> ffiType 115 and getFFItypeSint16: unit -> ffiType 116 and getFFItypeUint32: unit -> ffiType 117 and getFFItypeSint32: unit -> ffiType 118 and getFFItypeUint64: unit -> ffiType 119 and getFFItypeSint64: unit -> ffiType 120 and getFFItypeFloat: unit -> ffiType 121 and getFFItypeDouble: unit -> ffiType 122 and getFFItypePointer: unit -> ffiType 123 and getFFItypeUChar: unit -> ffiType 124 and getFFItypeSChar: unit -> ffiType 125 and getFFItypeUShort: unit -> ffiType 126 and getFFItypeSShort: unit -> ffiType 127 and getFFItypeUint: unit -> ffiType 128 and getFFItypeSint: unit -> ffiType 129 and getFFItypeUlong: unit -> ffiType 130 and getFFItypeSlong: unit -> ffiType 131 132 val extractFFItype: 133 ffiType -> { size: word, align: word, typeCode: word, elements: ffiType list } 134 val createFFItype: 135 { size: word, align: word, typeCode: word, elements: ffiType list } -> ffiType 136 137 eqtype cif 138 val cif2voidStar: cif -> Memory.voidStar 139 val voidStar2cif: Memory.voidStar -> cif 140 val createCIF: abi * ffiType * ffiType list -> cif 141 val callFunction: 142 { cif: cif, function: Memory.voidStar, result: Memory.voidStar, arguments: Memory.voidStar } -> unit 143 144 val createCallback: 145 (Memory.voidStar * Memory.voidStar -> unit) * cif -> Memory.voidStar 146 val freeCallback: Memory.voidStar -> unit 147 end 148 149 structure Error: 150 sig 151 type syserror = OS.syserror 152 val getLastError: unit -> SysWord.word 153 val setLastError: SysWord.word -> unit 154 val fromWord: SysWord.word -> syserror 155 and toWord: syserror -> SysWord.word 156 end 157 158 type library 159 type symbol 160 val loadLibrary: string -> library 161 val loadExecutable: unit -> library 162 val getSymbol: library -> string -> symbol 163 val symbolAsAddress: symbol -> Memory.voidStar 164 val externalFunctionSymbol: string -> symbol 165 and externalDataSymbol: string -> symbol 166 167 structure LowLevel: 168 sig 169 type ctype = 170 { 171 size: Word.word, (* Size in bytes *) 172 align: Word.word, (* Alignment *) 173 ffiType: unit -> LibFFI.ffiType 174 } 175 176 val cTypeVoid: ctype 177 and cTypePointer: ctype 178 and cTypeInt8: ctype 179 and cTypeChar: ctype 180 and cTypeUint8: ctype 181 and cTypeUchar: ctype 182 and cTypeInt16: ctype 183 and cTypeUint16: ctype 184 and cTypeInt32: ctype 185 and cTypeUint32: ctype 186 and cTypeInt64: ctype 187 and cTypeUint64: ctype 188 and cTypeInt: ctype 189 and cTypeUint: ctype 190 and cTypeLong: ctype 191 and cTypeUlong: ctype 192 and cTypeFloat: ctype 193 and cTypeDouble: ctype 194 195 val cStruct: ctype list -> ctype 196 197 val callwithAbi: LibFFI.abi -> ctype list -> ctype -> symbol -> Memory.voidStar list * Memory.voidStar -> unit 198 val call: ctype list -> ctype -> symbol -> Memory.voidStar list * Memory.voidStar -> unit 199 200 val cFunctionWithAbi: 201 LibFFI.abi -> ctype list -> ctype -> (Memory.voidStar * Memory.voidStar -> unit) -> Memory.voidStar 202 val cFunction: 203 ctype list -> ctype -> (Memory.voidStar * Memory.voidStar -> unit) -> Memory.voidStar 204 end 205 206 type 'a conversion 207 208 val makeConversion: 209 { 210 load: Memory.voidStar -> 'a, (* Load a value from C memory *) 211 store: Memory.voidStar * 'a -> unit -> unit, (* Store value and return free function. *) 212 ctype: LowLevel.ctype 213 } -> 'a conversion 214 215 val breakConversion: 216 'a conversion -> 217 { 218 load: Memory.voidStar -> 'a, (* Load a value from C memory *) 219 store: Memory.voidStar * 'a -> unit -> unit, (* Store value and return free function. *) 220 ctype: LowLevel.ctype 221 } 222 223 val cVoid: unit conversion 224 val cPointer: Memory.voidStar conversion 225 val cInt8: int conversion 226 val cUint8: int conversion 227 val cChar: char conversion 228 val cUchar: Word8.word conversion 229 val cInt16: int conversion 230 val cUint16: int conversion 231 val cInt32: int conversion 232 val cUint32: int conversion 233 val cInt64: int conversion 234 val cUint64: int conversion 235 val cInt32Large: LargeInt.int conversion 236 val cUint32Large: LargeInt.int conversion 237 val cInt64Large: LargeInt.int conversion 238 val cUint64Large: LargeInt.int conversion 239 val cShort: int conversion 240 val cUshort: int conversion 241 val cInt: int conversion 242 val cUint: int conversion 243 val cLong: int conversion 244 val cUlong: int conversion 245 val cIntLarge: LargeInt.int conversion 246 val cUintLarge: LargeInt.int conversion 247 val cLongLarge: LargeInt.int conversion 248 val cUlongLarge: LargeInt.int conversion 249 val cString: string conversion 250 val cByteArray: Word8Vector.vector conversion 251 val cFloat: real conversion 252 val cDouble: real conversion 253 254 (* When a pointer e.g. a string may be null. *) 255 val cOptionPtr: 'a conversion -> 'a option conversion 256 257 type 'a closure 258 259 val cFunction: ('a->'b) closure conversion 260 261 val buildClosure0withAbi: (unit -> 'a) * LibFFI.abi * unit * 'a conversion -> (unit -> 'a) closure 262 val buildClosure0: (unit -> 'a) * unit * 'a conversion -> (unit -> 'a) closure 263 val buildClosure1withAbi: ('a -> 'b) * LibFFI.abi * 'a conversion * 'b conversion -> ('a -> 'b) closure 264 val buildClosure1: ('a -> 'b) * 'a conversion * 'b conversion -> ('a -> 'b) closure 265 val buildClosure2withAbi: 266 ('a * 'b -> 'c) * LibFFI.abi * ('a conversion * 'b conversion) * 'c conversion -> ('a * 'b -> 'c) closure 267 val buildClosure2: ('a * 'b -> 'c) * ('a conversion * 'b conversion) * 'c conversion -> ('a * 'b -> 'c) closure 268 val buildClosure3withAbi: 269 ('a * 'b *'c -> 'd) * LibFFI.abi * ('a conversion * 'b conversion * 'c conversion) * 'd conversion -> 270 ('a * 'b *'c -> 'd) closure 271 val buildClosure3: ('a * 'b *'c -> 'd) * ('a conversion * 'b conversion * 'c conversion) * 'd conversion -> 272 ('a * 'b *'c -> 'd) closure 273 val buildClosure4withAbi: 274 ('a * 'b * 'c * 'd -> 'e) * LibFFI.abi * ('a conversion * 'b conversion * 'c conversion* 'd conversion) * 'e conversion -> 275 ('a * 'b * 'c * 'd -> 'e) closure 276 val buildClosure4: 277 ('a * 'b * 'c * 'd -> 'e) * ('a conversion * 'b conversion * 'c conversion* 'd conversion) * 'e conversion -> 278 ('a * 'b * 'c * 'd -> 'e) closure 279 val buildClosure5withAbi: 280 ('a * 'b * 'c * 'd * 'e -> 'f) * 281 LibFFI.abi * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion) * 'f conversion -> 282 ('a * 'b * 'c * 'd * 'e -> 'f) closure 283 val buildClosure5: 284 ('a * 'b * 'c * 'd * 'e -> 'f) * 285 ('a conversion * 'b conversion * 'c conversion* 'd conversion * 'e conversion) * 'f conversion -> 286 ('a * 'b * 'c * 'd * 'e -> 'f) closure 287 val buildClosure6withAbi: 288 ('a * 'b * 'c * 'd * 'e * 'f -> 'g) * LibFFI.abi * 289 ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion) * 'g conversion -> 290 ('a * 'b * 'c * 'd * 'e * 'f -> 'g) closure 291 val buildClosure6: 292 ('a * 'b * 'c * 'd * 'e * 'f -> 'g) * 293 ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion) * 'g conversion -> 294 ('a * 'b * 'c * 'd * 'e * 'f -> 'g) closure 295 296 (* Remove the "free" from a conversion. Used if extra memory allocated 297 by the argument must not be freed when the function returns. *) 298 val permanent: 'a conversion -> 'a conversion 299 300 (* Call by reference. *) 301 val cStar: 'a conversion -> 'a ref conversion 302 (* Pass a const pointer *) 303 val cConstStar: 'a conversion -> 'a conversion 304 305 (* Fixed size vector. It is treated as a struct and passed by value or embedded in a structure. *) 306 val cVectorFixedSize: int * 'a conversion -> 'a vector conversion 307 (* Pass an ML vector as a pointer to a C array. *) 308 and cVectorPointer: 'a conversion -> 'a vector conversion 309 (* Pass an ML array as a pointer to a C array and, on return, update each element of 310 the ML array from the C array. *) 311 and cArrayPointer: 'a conversion -> 'a array conversion 312 313 (* structs. *) 314 val cStruct2: 'a conversion * 'b conversion -> ('a * 'b) conversion 315 val cStruct3: 'a conversion * 'b conversion * 'c conversion -> ('a*'b*'c)conversion 316 val cStruct4: 'a conversion * 'b conversion * 'c conversion * 'd conversion -> ('a*'b*'c*'d)conversion 317 val cStruct5: 'a conversion * 'b conversion * 'c conversion * 'd conversion * 318 'e conversion -> ('a*'b*'c*'d*'e)conversion 319 val cStruct6: 'a conversion * 'b conversion * 'c conversion * 'd conversion * 320 'e conversion * 'f conversion -> ('a*'b*'c*'d*'e*'f)conversion 321 val cStruct7: 'a conversion * 'b conversion * 'c conversion * 'd conversion * 322 'e conversion * 'f conversion * 'g conversion -> ('a*'b*'c*'d*'e*'f*'g)conversion 323 val cStruct8: 'a conversion * 'b conversion * 'c conversion * 'd conversion * 324 'e conversion * 'f conversion * 'g conversion * 'h conversion -> ('a*'b*'c*'d*'e*'f*'g*'h)conversion 325 val cStruct9: 'a conversion * 'b conversion * 'c conversion * 'd conversion * 326 'e conversion * 'f conversion * 'g conversion * 'h conversion * 'i conversion -> 327 ('a*'b*'c*'d*'e*'f*'g*'h*'i)conversion 328 val cStruct10: 'a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion * 'g conversion * 329 'h conversion * 'i conversion * 'j conversion -> ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j)conversion 330 val cStruct11: 'a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion * 'g conversion * 331 'h conversion * 'i conversion * 'j conversion * 'k conversion -> ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k)conversion 332 val cStruct12: 'a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion * 'g conversion * 333 'h conversion * 'i conversion * 'j conversion * 'k conversion * 'l conversion -> 334 ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k*'l)conversion 335 val cStruct13: 'a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion * 'g conversion * 336 'h conversion * 'i conversion * 'j conversion * 'k conversion * 'l conversion * 'm conversion -> 337 ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k*'l*'m)conversion 338 val cStruct14: 'a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion * 'g conversion * 339 'h conversion * 'i conversion * 'j conversion * 'k conversion * 'l conversion * 'm conversion * 'n conversion -> 340 ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k*'l*'m*'n)conversion 341 val cStruct15: 'a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion * 'g conversion * 342 'h conversion * 'i conversion * 'j conversion * 'k conversion * 'l conversion * 'm conversion * 'n conversion * 343 'o conversion -> ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k*'l*'m*'n*'o)conversion 344 val cStruct16: 'a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion * 'g conversion * 345 'h conversion * 'i conversion * 'j conversion * 'k conversion * 'l conversion * 'm conversion * 'n conversion * 346 'o conversion * 'p conversion -> ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k*'l*'m*'n*'o*'p)conversion 347 val cStruct17: 'a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion * 'g conversion * 348 'h conversion * 'i conversion * 'j conversion * 'k conversion * 'l conversion * 'm conversion * 'n conversion * 349 'o conversion * 'p conversion * 'q conversion -> 350 ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k*'l*'m*'n*'o*'p*'q)conversion 351 val cStruct18: 'a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion * 'g conversion * 352 'h conversion * 'i conversion * 'j conversion * 'k conversion * 'l conversion * 'm conversion * 'n conversion * 353 'o conversion * 'p conversion * 'q conversion * 'r conversion -> 354 ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k*'l*'m*'n*'o*'p*'q*'r)conversion 355 val cStruct19: 'a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion * 'g conversion * 356 'h conversion * 'i conversion * 'j conversion * 'k conversion * 'l conversion * 'm conversion * 'n conversion * 357 'o conversion * 'p conversion * 'q conversion * 'r conversion * 's conversion -> 358 ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k*'l*'m*'n*'o*'p*'q*'r*'s)conversion 359 val cStruct20: 'a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion * 'g conversion * 360 'h conversion * 'i conversion * 'j conversion * 'k conversion * 'l conversion * 'm conversion * 'n conversion * 361 'o conversion * 'p conversion * 'q conversion * 'r conversion * 's conversion * 't conversion -> 362 ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k*'l*'m*'n*'o*'p*'q*'r*'s*'t)conversion 363 364 val buildCall0withAbi: LibFFI.abi * symbol * unit * 'a conversion -> unit -> 'a 365 val buildCall0: symbol * unit * 'a conversion -> unit -> 'a 366 val buildCall1withAbi: LibFFI.abi * symbol * 'a conversion * 'b conversion -> 'a -> 'b 367 val buildCall1: symbol * 'a conversion * 'b conversion -> 'a -> 'b 368 val buildCall2withAbi: 369 LibFFI.abi * symbol * ('a conversion * 'b conversion) * 'c conversion -> 'a * 'b -> 'c 370 val buildCall2: 371 symbol * ('a conversion * 'b conversion) * 'c conversion -> 'a * 'b -> 'c 372 val buildCall3withAbi: 373 LibFFI.abi * symbol * ('a conversion * 'b conversion * 'c conversion) * 'd conversion -> 'a * 'b * 'c -> 'd 374 val buildCall3: 375 symbol * ('a conversion * 'b conversion * 'c conversion) * 'd conversion -> 'a * 'b * 'c -> 'd 376 val buildCall4withAbi: 377 LibFFI.abi * symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion) * 'e conversion -> 378 'a * 'b * 'c * 'd -> 'e 379 val buildCall4: 380 symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion) * 'e conversion -> 381 'a * 'b * 'c * 'd -> 'e 382 val buildCall5withAbi: 383 LibFFI.abi * symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion) * 'f conversion -> 384 'a * 'b * 'c * 'd * 'e -> 'f 385 val buildCall5: 386 symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion) * 'f conversion -> 387 'a * 'b * 'c * 'd * 'e -> 'f 388 val buildCall6withAbi: 389 LibFFI.abi * symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion) * 390 'g conversion -> 'a * 'b * 'c * 'd * 'e * 'f -> 'g 391 val buildCall6: 392 symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion) * 393 'g conversion -> 'a * 'b * 'c * 'd * 'e * 'f -> 'g 394 val buildCall7withAbi: 395 LibFFI.abi * symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 396 'f conversion * 'g conversion) * 397 'h conversion -> 'a * 'b * 'c * 'd * 'e * 'f * 'g -> 'h 398 val buildCall7: 399 symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 400 'f conversion * 'g conversion) * 401 'h conversion -> 'a * 'b * 'c * 'd * 'e * 'f * 'g -> 'h 402 val buildCall8withAbi: 403 LibFFI.abi * symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 404 'f conversion * 'g conversion * 'h conversion) * 405 'i conversion -> 'a * 'b * 'c * 'd * 'e * 'f * 'g * 'h -> 'i 406 val buildCall8: 407 symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 408 'f conversion * 'g conversion * 'h conversion) * 409 'i conversion -> 'a * 'b * 'c * 'd * 'e * 'f * 'g * 'h -> 'i 410 val buildCall9withAbi: 411 LibFFI.abi * symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 412 'f conversion * 'g conversion * 'h conversion * 'i conversion) * 413 'j conversion -> 'a * 'b * 'c * 'd * 'e * 'f * 'g * 'h * 'i -> 'j 414 val buildCall9: 415 symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 416 'f conversion * 'g conversion * 'h conversion * 'i conversion) * 417 'j conversion -> 'a * 'b * 'c * 'd * 'e * 'f * 'g * 'h * 'i -> 'j 418 val buildCall10withAbi: 419 LibFFI.abi * symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 420 'f conversion * 'g conversion * 'h conversion * 'i conversion * 'j conversion) * 421 'k conversion -> 'a * 'b * 'c * 'd * 'e * 'f * 'g * 'h * 'i * 'j -> 'k 422 val buildCall10: 423 symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 424 'f conversion * 'g conversion * 'h conversion * 'i conversion * 'j conversion) * 425 'k conversion -> 'a * 'b * 'c * 'd * 'e * 'f * 'g * 'h * 'i * 'j -> 'k 426 val buildCall11withAbi: 427 LibFFI.abi * symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 428 'f conversion * 'g conversion * 'h conversion * 'i conversion * 'j conversion * 'k conversion) * 429 'l conversion -> 'a * 'b * 'c * 'd * 'e * 'f * 'g * 'h * 'i * 'j * 'k -> 'l 430 val buildCall11: 431 symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 432 'f conversion * 'g conversion * 'h conversion * 'i conversion * 'j conversion * 'k conversion) * 433 'l conversion -> 'a * 'b * 'c * 'd * 'e * 'f * 'g * 'h * 'i * 'j * 'k -> 'l 434 val buildCall12withAbi: 435 LibFFI.abi * symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 436 'f conversion * 'g conversion * 'h conversion * 'i conversion * 'j conversion * 'k conversion * 437 'l conversion) * 'm conversion -> 438 'a * 'b * 'c * 'd * 'e * 'f * 'g * 'h * 'i * 'j * 'k * 'l -> 'm 439 val buildCall12: 440 symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 441 'f conversion * 'g conversion * 'h conversion * 'i conversion * 'j conversion * 'k conversion * 442 'l conversion) * 'm conversion -> 443 'a * 'b * 'c * 'd * 'e * 'f * 'g * 'h * 'i * 'j * 'k * 'l -> 'm 444 val buildCall13withAbi: 445 LibFFI.abi * symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 446 'f conversion * 'g conversion * 'h conversion * 'i conversion * 'j conversion * 'k conversion * 447 'l conversion * 'm conversion) * 448 'n conversion -> 'a * 'b * 'c * 'd * 'e * 'f * 'g * 'h * 'i * 'j * 'k * 'l * 'm -> 'n 449 val buildCall13: 450 symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 451 'f conversion * 'g conversion * 'h conversion * 'i conversion * 'j conversion * 'k conversion * 452 'l conversion * 'm conversion) * 453 'n conversion -> 'a * 'b * 'c * 'd * 'e * 'f * 'g * 'h * 'i * 'j * 'k * 'l * 'm -> 'n 454 val buildCall14withAbi: 455 LibFFI.abi * symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 456 'f conversion * 'g conversion * 'h conversion * 'i conversion * 'j conversion * 'k conversion * 457 'l conversion * 'm conversion * 'n conversion) * 458 'o conversion -> 'a * 'b * 'c * 'd * 'e * 'f * 'g * 'h * 'i * 'j * 'k * 'l * 'm * 'n -> 'o 459 val buildCall14: 460 symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 461 'f conversion * 'g conversion * 'h conversion * 'i conversion * 'j conversion * 'k conversion * 462 'l conversion * 'm conversion * 'n conversion) * 463 'o conversion -> 'a * 'b * 'c * 'd * 'e * 'f * 'g * 'h * 'i * 'j * 'k * 'l * 'm * 'n -> 'o 464end; 465 466structure Foreign:> FOREIGN = 467struct 468 fun id x = x 469 exception Foreign = RunCall.Foreign 470 471 open ForeignConstants 472 473 structure Memory = ForeignMemory 474 infix 6 ++ -- 475 476 (* Internal utility function. *) 477 fun alignUp(s, align) = Word.andb(s + align-0w1, ~ align) 478 479 local 480 val ffiGeneralCall = RunCall.rtsCallFull2 "PolyFFIGeneral" 481 in 482 fun ffiGeneral(code: int, arg: 'a): 'b = RunCall.unsafeCast(ffiGeneralCall(RunCall.unsafeCast(code, arg))) 483 end 484 485 structure System = 486 struct 487 type voidStar = Memory.voidStar 488 type externalSymbol = voidStar 489 fun loadLibrary(s: string): voidStar = ffiGeneral (2, s) 490 and loadExecutable(): voidStar = ffiGeneral (3, ()) 491 and freeLibrary(s: voidStar): unit = ffiGeneral (4, s) 492 and getSymbol(lib: voidStar, s: string): voidStar = ffiGeneral (5, (lib, s)) 493 494 (* Create an external symbol object. The first word of this is filled in with the 495 address after the code is exported and linked. 496 On a small number of platforms different relocations are required for functions 497 and for data. *) 498 val externalFunctionSymbol: string -> externalSymbol = RunCall.rtsCallFull1 "PolyFFICreateExtFn" 499 and externalDataSymbol: string -> externalSymbol = RunCall.rtsCallFull1 "PolyFFICreateExtData" 500 501 (* An external symbol is a memory cell containing the value in the first word 502 followed by the symbol name. Because the first word is the value it can 503 be treated as a Sysword.word value. 504 When it is created the value is zero and the address of the target is only 505 set once the symbol has been exported and the value set by the linker. *) 506 fun addressOfExternal(ext: externalSymbol): voidStar = 507 if Memory.voidStar2Sysword ext = 0w0 508 then raise Foreign "External symbol has not been set" 509 else ext 510 end 511 512 structure Error = 513 struct 514 type syserror = OS.syserror 515 fun toWord (s: syserror): SysWord.word = RunCall.unsafeCast s 516 and fromWord (w: SysWord.word) : syserror = RunCall.unsafeCast w 517 local 518 val callGetError = RunCall.rtsCallFast1 "PolyFFIGetError" 519 in 520 fun getLastError(): SysWord.word = 521 let 522 val mem = RunCall.allocateByteMemory(0w1, 0wx41) 523 val () = callGetError mem 524 val () = RunCall.clearMutableBit mem 525 in 526 RunCall.unsafeCast mem 527 end 528 end 529 val setLastError: SysWord.word -> unit = RunCall.rtsCallFast1 "PolyFFISetError" 530 end 531 532 structure LibFFI = 533 struct 534 type abi = Word.word 535 val abiList: (string * abi) list = ffiGeneral (50, ()) 536 537 local 538 fun getConstant (n: int) : Word.word = ffiGeneral (51, n) 539 in 540 val abiDefault = getConstant 0 541 542 and ffiTypeCodeVoid = getConstant 1 543 and ffiTypeCodeInt = getConstant 2 544 and ffiTypeCodeFloat = getConstant 3 545 and ffiTypeCodeDouble = getConstant 4 546 and ffiTypeCodeUInt8 = getConstant 5 547 and ffiTypeCodeSInt8 = getConstant 6 548 and ffiTypeCodeUInt16 = getConstant 7 549 and ffiTypeCodeSInt16 = getConstant 8 550 and ffiTypeCodeUInt32 = getConstant 9 551 and ffiTypeCodeSInt32 = getConstant 10 552 and ffiTypeCodeUInt64 = getConstant 11 553 and ffiTypeCodeSInt64 = getConstant 12 554 and ffiTypeCodeStruct = getConstant 13 555 and ffiTypeCodePointer = getConstant 14 556 end 557 558 type ffiType = Memory.voidStar 559 val ffiType2voidStar = id 560 and voidStar2ffiType = id 561 562 local 563 fun getFFItype (n: int) (): ffiType = ffiGeneral (52, n) 564 in 565 val getFFItypeVoid = getFFItype 0 566 and getFFItypeUint8 = getFFItype 1 567 and getFFItypeSint8 = getFFItype 2 568 and getFFItypeUint16 = getFFItype 3 569 and getFFItypeSint16 = getFFItype 4 570 and getFFItypeUint32 = getFFItype 5 571 and getFFItypeSint32 = getFFItype 6 572 and getFFItypeUint64 = getFFItype 7 573 and getFFItypeSint64 = getFFItype 8 574 and getFFItypeFloat = getFFItype 9 575 and getFFItypeDouble = getFFItype 10 576 and getFFItypePointer = getFFItype 11 577 and getFFItypeUChar = getFFItype 12 578 and getFFItypeSChar = getFFItype 13 579 and getFFItypeUShort = getFFItype 14 580 and getFFItypeSShort = getFFItype 15 581 and getFFItypeUint = getFFItype 16 582 and getFFItypeSint = getFFItype 17 583 and getFFItypeUlong = getFFItype 18 584 and getFFItypeSlong = getFFItype 19 585 end 586 587 fun extractFFItype (s: ffiType) = 588 let 589 val (size: word, align: word, typ: word, elem: Memory.voidStar) = 590 ffiGeneral (53, s) 591 (* Unpack the "elements". *) 592 open Memory 593 fun loadElements i = 594 let 595 val a = getAddress(elem, i) 596 in 597 if a = null 598 then [] 599 else a :: loadElements(i+0w1) 600 end 601 val elements = 602 if elem = sysWord2VoidStar 0w0 603 then [] 604 else loadElements 0w0 605 in 606 { size=size, align=align, typeCode = typ, elements = elements } 607 end 608 609 (* Construct a new FFItype in allocated memory. *) 610 fun createFFItype { size: word, align: word, typeCode: word, elements: ffiType list }: ffiType = 611 ffiGeneral (54, (size, align, typeCode, elements)) 612 613 type cif = Memory.voidStar 614 val cif2voidStar = id 615 and voidStar2cif = id 616 617 (* Construct and prepare a CIF in allocated memory. *) 618 fun createCIF (abi: abi, resultType: ffiType, argTypes: ffiType list): cif = 619 ffiGeneral (55, (abi, resultType, argTypes)) 620 621 (* Call a function. We have to pass some space for the result *) 622 fun callFunction 623 { cif: cif, function: Memory.voidStar, result: Memory.voidStar, arguments: Memory.voidStar }: unit = 624 ffiGeneral (56, (cif, function, result, arguments)) 625 626 (* Create a callback. Returns the C function. *) 627 fun createCallback(f: Memory.voidStar * Memory.voidStar -> unit, cif: cif): Memory.voidStar = 628 ffiGeneral (57, (f, cif)) 629 630 (* Free a callback. This takes the C function address returned by createCallback *) 631 fun freeCallback(cb: Memory.voidStar): unit = 632 ffiGeneral (58, cb) 633 end 634 635 type library = unit -> Memory.voidStar 636 type symbol = unit -> Memory.voidStar 637 638 (* Load the library but memoise it so if we reference the library in another 639 session we will reload it. We load the library immediately so that if 640 there is an error we get the error immediately. *) 641 fun loadLibrary (name: string): library = Memory.memoise System.loadLibrary name 642 and loadExecutable (): library = Memory.memoise System.loadExecutable () 643 644 (* To get a symbol we memoise a function that forces a library load if necessary 645 and then gets the symbol. *) 646 fun getSymbol(lib: library) (name: string): symbol = 647 Memory.memoise (fn s => System.getSymbol(lib(), s)) name 648 649 (* This forces the symbol to be loaded. The result is NOT memoised. *) 650 fun symbolAsAddress(s: symbol): Memory.voidStar = s() 651 652 (* Create an external symbol. This can only be used after linking. *) 653 fun externalFunctionSymbol(name: string): symbol = 654 let 655 val r = System.externalFunctionSymbol name 656 in 657 fn () => System.addressOfExternal r 658 end 659 660 and externalDataSymbol(name: string): symbol = 661 let 662 val r = System.externalDataSymbol name 663 in 664 fn () => System.addressOfExternal r 665 end 666 667 structure LowLevel = 668 struct 669 type ctype = 670 { 671 size: Word.word, (* Size in bytes *) 672 align: Word.word, (* Alignment *) 673 ffiType: unit -> LibFFI.ffiType 674 } 675 676 local 677 open LibFFI Memory 678 679 val getffArg = 680 if ffiMinArgSize = 0w4 then Word32.toLargeWord o get32 681 else if ffiMinArgSize = 0w8 then get64 682 else raise Foreign ("Unable to load ffi_arg size=" ^ Word.toString ffiMinArgSize) 683 684 in 685 val cTypeVoid = 686 { size= #size saVoid, align= #align saVoid, ffiType = memoise getFFItypeVoid () } 687 val cTypePointer = 688 { size= #size saPointer, align= #align saPointer, ffiType = memoise getFFItypePointer () } 689 val cTypeInt8 = 690 { size= #size saSint8, align= #align saSint8, ffiType = memoise getFFItypeSint8 () } 691 val cTypeChar = cTypeInt8 692 val cTypeUint8 = 693 { size= #size saUint8, align= #align saUint8, ffiType = memoise getFFItypeUint8 () } 694 val cTypeUchar = cTypeUint8 695 val cTypeInt16 = 696 { size= #size saSint16, align= #align saSint16, ffiType = memoise getFFItypeSint16 () } 697 val cTypeUint16 = 698 { size= #size saUint16, align= #align saUint16, ffiType = memoise getFFItypeUint16 () } 699 val cTypeInt32 = 700 { size= #size saSint32, align= #align saSint32, ffiType = memoise getFFItypeSint32 () } 701 val cTypeUint32 = 702 { size= #size saUint32, align= #align saUint32, ffiType = memoise getFFItypeUint32 () } 703 val cTypeInt64 = 704 { size= #size saSint64, align= #align saSint64, ffiType = memoise getFFItypeSint64 () } 705 val cTypeUint64 = 706 { size= #size saUint64, align= #align saUint64, ffiType = memoise getFFItypeUint64 () } 707 val cTypeInt = 708 { size= #size saSint, align= #align saSint, ffiType = memoise getFFItypeSint () } 709 val cTypeUint = 710 { size= #size saUint, align= #align saUint, ffiType = memoise getFFItypeUint () } 711 val cTypeLong = 712 { size= #size saSlong, align= #align saSlong, ffiType = memoise getFFItypeSlong () } 713 val cTypeUlong = 714 { size= #size saUlong, align= #align saUlong, ffiType = memoise getFFItypeUlong () } 715 val cTypeFloat = 716 { size= #size saFloat, align= #align saFloat, ffiType = memoise getFFItypeFloat () } 717 val cTypeDouble = 718 { size= #size saDouble, align= #align saDouble, ffiType = memoise getFFItypeDouble () } 719 720 fun cStruct(fields: ctype list): ctype = 721 let 722 (* The total alignment is the maximum alignment of the fields. *) 723 val align = foldl(fn ({align, ...}, a) => Word.max(align, a)) 0w1 fields 724 (* Each field needs to be on its alignment. Finally we round up the size 725 to the total alignment. *) 726 val size = 727 alignUp(foldl(fn ({align, size, ...}, s) => alignUp(s, align) + size) 0w0 fields, align) 728 729 val types = map #ffiType fields 730 731 (* Make the type but only when it's used. *) 732 fun ffiType () = 733 LibFFI.createFFItype { 734 size = size, align = align, typeCode=LibFFI.ffiTypeCodeStruct, 735 elements = map (fn t => t()) types } 736 in 737 {align=align, size=size, ffiType=memoise ffiType ()} 738 end 739 740 fun callwithAbi (abi: abi) (argTypes: ctype list) (resType: ctype): symbol -> voidStar list * voidStar -> unit = 741 let 742 (* Preparation when we create the function. *) 743 fun buildCif () = createCIF (abi, #ffiType resType (), map (fn {ffiType, ...} => ffiType ()) argTypes) 744 val cif: unit->cif = memoise buildCif () 745 val nArgs = List.length argTypes 746 val resSize = #size resType 747 748 (* If the result size is smaller than ffiMinArgSize we have to 749 first store the result in a value of size ffiMinArgSize then copy 750 the result. This is a restriction of libffi. *) 751 fun smallSpace (fnAddr: unit->voidStar) (args, resMem) = 752 let 753 val _ = List.length args = nArgs orelse raise Foreign "Incorrect number of arguments" 754 val resultSize = alignUp(ffiMinArgSize, #align saPointer) 755 val argResVec = malloc(resultSize + #size saPointer * Word.fromInt nArgs) 756 val argLocn = argResVec ++ resultSize 757 val _ = List.foldl(fn (arg, n) => (setAddress(argLocn, n, arg); n+0w1)) 0w0 args 758 in 759 let 760 val () = callFunction { cif=cif(), function=fnAddr(), result = argResVec, arguments = argLocn} 761 val result: SysWord.word = getffArg(argResVec, 0w0) 762 in 763 (* Copy to the final location. Currently "void" has size 1 so if 764 the function has a void result we still copy one byte. *) 765 if #size resType = 0w1 766 then set8(resMem, 0w0, Word8.fromLargeWord result) 767 else if #size resType = 0w2 768 then set16(resMem, 0w0, Word.fromLargeWord result) 769 else if #size resType = 0w4 770 then set32(resMem, 0w0, Word32.fromLargeWord result) 771 else raise Foreign "Unable to set result: wrong size"; 772 free argResVec 773 end handle exn => (free argResVec; raise exn) 774 end 775 776 (* If we have enough space. *) 777 fun largeSpace (fnAddr: unit->voidStar) (args, resMem) = 778 let 779 val _ = List.length args = nArgs orelse raise Foreign "Incorrect number of arguments" 780 val argVec = 781 if nArgs = 0 then null else malloc(#size saPointer * Word.fromInt nArgs) 782 val _ = List.foldl(fn (arg, n) => (setAddress(argVec, n, arg); n+0w1)) 0w0 args 783 in 784 let 785 val () = callFunction { cif=cif(), function=fnAddr(), result = resMem, arguments = argVec} 786 in 787 free argVec 788 end handle exn => (free argVec; raise exn) 789 end 790 in 791 if resSize < ffiMinArgSize 792 then smallSpace 793 else largeSpace 794 end 795 796 fun call x = callwithAbi abiDefault x (* Have to make it a fun to avoid value restriction *) 797 798 (* Build a call-back function. Returns a function to take the actual ML function, 799 create a callback and then return the address. *) 800 fun cFunctionWithAbi (abi: abi) (argTypes: ctype list) (resType: ctype): 801 (voidStar * voidStar -> unit) -> voidStar = 802 let 803 fun buildCif () = createCIF (abi, #ffiType resType (), map (fn {ffiType, ...} => ffiType ()) argTypes) 804 val cif: unit->cif = memoise buildCif () 805 in 806 fn cbFun => createCallback(cbFun, cif()) 807 end 808 809 fun cFunction x = cFunctionWithAbi abiDefault x 810 end 811 812 end 813 814 type 'a conversion = 815 { 816 load: Memory.voidStar -> 'a, (* Load a value from C memory *) 817 store: Memory.voidStar * 'a -> unit -> unit, (* Store a value in C memory *) 818 updateML: Memory.voidStar * 'a -> unit, (* Update ML value after call - only used in cStar. *) 819 updateC: Memory.voidStar * 'a -> unit, (* Update C value after callback - only used in cStar. *) 820 ctype: LowLevel.ctype 821 } 822 823 fun makeConversion { load, store, ctype } = 824 { load = load, store = store, ctype = ctype, updateML = fn _ => (), updateC = fn _ => () } 825 826 fun breakConversion({load, store, ctype, ... }: 'a conversion) = 827 { load = load, store = store, ctype = ctype } 828 829 (* Conversions *) 830 local 831 open LibFFI Memory LowLevel 832 fun checkRangeShort(i, min, max) = if i < min orelse i > max then raise Overflow else i 833 fun checkRangeLong(i: LargeInt.int, min, max) = if i < min orelse i > max then raise Overflow else i 834 fun noFree _ = () (* None of these allocate extra memory or need to update. *) 835 in 836 val cVoid: unit conversion = 837 makeConversion{ load=fn _ => (), store=fn _ => noFree, ctype = cTypeVoid } 838 839 (* cPointer should only be used to base other conversions on. *) 840 val cPointer: voidStar conversion = 841 makeConversion { load=fn a => getAddress(a, 0w0), store=fn(a, v) => (setAddress(a, 0w0, v); noFree), 842 ctype = cTypePointer } 843 844 local 845 fun load(m: voidStar): int = Word8.toIntX(get8(m, 0w0)) 846 fun store(m: voidStar, i: int) = 847 (set8(m, 0w0, Word8.fromInt(checkRangeShort(i, ~128, 127))); noFree) 848 in 849 val cInt8: int conversion = 850 makeConversion { load=load, store=store, ctype = cTypeInt8 } 851 end 852 853 local 854 (* Char is signed in C but unsigned in ML. *) 855 fun load(m: voidStar): char = Char.chr(Word8.toInt(get8(m, 0w0))) 856 fun store(m: voidStar, i: char) = 857 (set8(m, 0w0, Word8.fromInt(Char.ord i)); noFree) 858 in 859 val cChar: char conversion = 860 makeConversion{ load=load, store=store, ctype = cTypeChar } 861 end 862 863 local 864 (* Uchar - convert as Word8.word. *) 865 fun load(m: voidStar): Word8.word = get8(m, 0w0) 866 fun store(m: voidStar, i: Word8.word) = (set8(m, 0w0, i); noFree) 867 in 868 val cUchar: Word8.word conversion = 869 makeConversion{ load=load, store=store, ctype = cTypeUchar } 870 end 871 872 local 873 fun load(m: voidStar): int = Word8.toInt(get8(m, 0w0)) 874 fun store(m: voidStar, i: int) = 875 (set8(m, 0w0, Word8.fromInt(checkRangeShort(i, 0, 255))); noFree) 876 in 877 val cUint8: int conversion = 878 makeConversion{ load=load, store=store, ctype = cTypeUint8 } 879 end 880 881 local 882 (* Because the word length is greater than the length returned by 883 get16 we have to do something special to get the sign bit correct. 884 That isn't necessary in the other cases. *) 885 fun load(m: voidStar): int = 886 let 887 (* Could be done with shifts *) 888 val r = Word.toInt(get16(m, 0w0)) 889 in 890 if r >= 32768 891 then r - 65536 892 else r 893 end 894 fun store(m: voidStar, i: int) = 895 (set16(m, 0w0, Word.fromInt(checkRangeShort(i, ~32768, 32767))); noFree) 896 in 897 val cInt16: int conversion = 898 makeConversion{ load=load, store=store, ctype = cTypeInt16 } 899 end 900 901 local 902 fun load(m: voidStar): int = Word.toInt(get16(m, 0w0)) 903 fun store(m: voidStar, i: int) = 904 (set16(m, 0w0, Word.fromInt(checkRangeShort(i, 0, 65535))); noFree) 905 in 906 val cUint16: int conversion = 907 makeConversion{ load=load, store=store, ctype = cTypeUint16 } 908 end 909 910 local 911 fun load(m: voidStar): int = Word32.toIntX(get32(m, 0w0)) 912 val checkRange = 913 if wordSize = 0w4 andalso isSome (Int.maxInt) 914 then fn i => i (* We're using fixed precision 31-bit - no check necessary. *) 915 else 916 let 917 (* These will overflow on fixed precision 31-bit. *) 918 val max32 = Int32.toInt(valOf Int32.maxInt) 919 val min32 = ~max32 - 1 920 in 921 fn i => checkRangeShort(i, min32, max32) 922 end 923 fun store(m: voidStar, i: int) = 924 (set32(m, 0w0, Word32.fromInt(checkRange i)); noFree) 925 in 926 val cInt32: int conversion = 927 makeConversion{ load=load, store=store, ctype = cTypeInt32 } 928 end 929 930 local 931 fun load(m: voidStar): LargeInt.int = Word32.toLargeIntX(get32(m, 0w0)) 932 fun store(m: voidStar, i: LargeInt.int) = 933 (set32(m, 0w0, Word32.fromLargeInt(checkRangeLong(i, ~2147483648, 2147483647))); noFree) 934 in 935 val cInt32Large: LargeInt.int conversion = 936 makeConversion{ load=load, store=store, ctype = cTypeInt32 } 937 end 938 939 local 940 fun load(m: voidStar): int = Word32.toInt(get32(m, 0w0)) 941 val checkRange = 942 if wordSize = 0w4 andalso isSome (Int.maxInt) 943 then fn i => if i < 0 then raise Overflow else i (* Fixed precision 31-bit *) 944 else 945 let 946 (* This will overflow on fixed precision 31-bit. *) 947 val max32 = Int32.toInt(valOf Int32.maxInt) 948 val max32Unsigned = max32 * 2 + 1 949 in 950 fn i => checkRangeShort(i, 0, max32Unsigned) 951 end 952 fun store(m: voidStar, i: int) = 953 (set32(m, 0w0, Word32.fromInt(checkRange i)); noFree) 954 in 955 val cUint32: int conversion = 956 makeConversion{ load=load, store=store, ctype = cTypeUint32 } 957 end 958 959 local 960 fun load(m: voidStar): LargeInt.int = Word32.toLargeInt(get32(m, 0w0)) 961 fun store(m: voidStar, i: LargeInt.int) = 962 (set32(m, 0w0, Word32.fromLargeInt(checkRangeLong(i, 0, 4294967295))); noFree) 963 in 964 val cUint32Large: LargeInt.int conversion = 965 makeConversion{ load=load, store=store, ctype = cTypeUint32 } 966 end 967 968 local 969 fun loadLarge(m: voidStar): LargeInt.int = 970 if wordSize = 0w4 971 then 972 let 973 val v1 = get32(m, 0w0) and v2 = get32(m, 0w1) 974 in 975 if bigEndian 976 then IntInf.<<(Word32.toLargeIntX v1, 0w32) + Word32.toLargeInt v2 977 else IntInf.<<(Word32.toLargeIntX v2, 0w32) + Word32.toLargeInt v1 978 end 979 else SysWord.toLargeIntX(get64(m, 0w0)) 980 981 fun loadShort(m: voidStar): int = 982 if wordSize = 0w4 983 then Int.fromLarge(loadLarge m) 984 else SysWord.toIntX(get64(m, 0w0)) 985 986 val max = IntInf.<<(1, 0w63) - 1 and min = ~ (IntInf.<<(1, 0w63)) 987 988 fun storeLarge(m: voidStar, i: LargeInt.int) = 989 if wordSize = 0w4 990 then 991 let 992 val _ = checkRangeLong(i, min, max) 993 val lo = Word32.fromLargeInt i and hi = Word32.fromLargeInt (IntInf.~>>(i, 0w32)) 994 in 995 if bigEndian 996 then (set32(m, 0w0, hi); set32(m, 0w1, lo)) 997 else (set32(m, 0w0, lo); set32(m, 0w1, hi)); 998 noFree 999 end 1000 else (set64(m, 0w0, SysWord.fromLargeInt(checkRangeLong(i, min, max))); noFree) 1001 1002 fun storeShort(m: voidStar, i: int) = 1003 if wordSize = 0w4 orelse not (isSome Int.maxInt) 1004 then (* 32-bit or arbitrary precision. *) storeLarge(m, LargeInt.fromInt i) 1005 else (* Fixed precision 64-bit - no need for a range check. *) 1006 (set64(m, 0w0, SysWord.fromInt i); noFree) 1007 in 1008 val cInt64: int conversion = 1009 makeConversion{ load=loadShort, store=storeShort, ctype = cTypeInt64 } 1010 and cInt64Large: LargeInt.int conversion = 1011 makeConversion{ load=loadLarge, store=storeLarge, ctype = cTypeInt64 } 1012 end 1013 1014 local 1015 fun loadLarge(m: voidStar): LargeInt.int = 1016 if wordSize = 0w4 1017 then 1018 let 1019 val v1 = get32(m, 0w0) and v2 = get32(m, 0w1) 1020 in 1021 if bigEndian 1022 then IntInf.<<(Word32.toLargeInt v1, 0w32) + Word32.toLargeInt v2 1023 else IntInf.<<(Word32.toLargeInt v2, 0w32) + Word32.toLargeInt v1 1024 end 1025 else SysWord.toLargeInt(get64(m, 0w0)) 1026 1027 fun loadShort(m: voidStar): int = 1028 if wordSize = 0w4 1029 then Int.fromLarge(loadLarge m) 1030 else SysWord.toInt(get64(m, 0w0)) 1031 1032 val max = IntInf.<<(1, 0w64) - 1 1033 1034 fun storeLarge(m: voidStar, i: LargeInt.int) = 1035 if wordSize = 0w4 1036 then 1037 let 1038 val _ = checkRangeLong(i, 0, max) 1039 val lo = Word32.fromLargeInt i and hi = Word32.fromLargeInt (IntInf.~>>(i, 0w32)) 1040 in 1041 if bigEndian 1042 then (set32(m, 0w0, hi); set32(m, 0w1, lo)) 1043 else (set32(m, 0w0, lo); set32(m, 0w1, hi)); 1044 noFree 1045 end 1046 else (set64(m, 0w0, SysWord.fromLargeInt(checkRangeLong(i, 0, max))); noFree) 1047 1048 fun storeShort(m: voidStar, i: int) = 1049 if wordSize = 0w4 orelse not (isSome Int.maxInt) 1050 then (* 32-bit or arbitrary precision. *) storeLarge(m, LargeInt.fromInt i) 1051 else if i < 0 (* Fixed precision 64-bit - just check it's not negative. *) 1052 then raise Overflow 1053 else (set64(m, 0w0, SysWord.fromInt i); noFree) 1054 in 1055 val cUint64: int conversion = 1056 makeConversion{ load=loadShort, store=storeShort, ctype = cTypeUint64 } 1057 and cUint64Large: LargeInt.int conversion = 1058 makeConversion{ load=loadLarge, store=storeLarge, ctype = cTypeUint64 } 1059 end 1060 1061 local 1062 fun load(m: voidStar): real = getFloat(m, 0w0) 1063 fun store(m: voidStar, v: real) = (setFloat(m, 0w0, v); noFree) 1064 in 1065 val cFloat: real conversion = 1066 makeConversion{ load=load, store=store, ctype = cTypeFloat } 1067 end 1068 1069 local 1070 fun load(m: voidStar): real = getDouble(m, 0w0) 1071 fun store(m: voidStar, v: real) = (setDouble(m, 0w0, v); noFree) 1072 in 1073 val cDouble: real conversion = 1074 makeConversion{ load=load, store=store, ctype = cTypeDouble } 1075 end 1076 1077 val cShort = 1078 if #size saSShort = #size saSint16 then cInt16 1079 (*else if #size saSShort = #size saSint32 then cInt32*) 1080 else raise Foreign "Unable to find type for short" 1081 1082 val cUshort = 1083 if #size saUShort = #size saUint16 then cUint16 1084 (*else if #size saUShort = #size saUint32 then cUint32*) 1085 else raise Foreign "Unable to find type for unsigned" 1086 1087 val cInt = 1088 (*if #size saSint = #size saSint16 then cInt16 1089 else *)if #size saSint = #size saSint32 then cInt32 1090 else if #size saSint = #size saSint64 then cInt64 1091 else raise Foreign "Unable to find type for int" 1092 1093 val cIntLarge = 1094 (*if #size saSint = #size saSint16 then cInt16 1095 else *)if #size saSint = #size saSint32 then cInt32Large 1096 else if #size saSint = #size saSint64 then cInt64Large 1097 else raise Foreign "Unable to find type for int" 1098 1099 val cUint = 1100 (*if #size saUint = #size saUint16 then cUint16 1101 else *)if #size saUint = #size saUint32 then cUint32 1102 else if #size saUint = #size saUint64 then cUint64 1103 else raise Foreign "Unable to find type for unsigned" 1104 1105 val cUintLarge = 1106 (*if #size saUint = #size saUint16 then cUint16 1107 else *)if #size saUint = #size saUint32 then cUint32Large 1108 else if #size saUint = #size saUint64 then cUint64Large 1109 else raise Foreign "Unable to find type for unsigned" 1110 1111 val cLong = 1112 (*if #size saSlong = #size saSint16 then cInt16 1113 else *)if #size saSlong = #size saSint32 then cInt32 1114 else if #size saSlong = #size saSint64 then cInt64 1115 else raise Foreign "Unable to find type for long" 1116 1117 val cLongLarge = 1118 (*if #size saSlong = #size saSint16 then cInt16 1119 else *)if #size saSlong = #size saSint32 then cInt32Large 1120 else if #size saSlong = #size saSint64 then cInt64Large 1121 else raise Foreign "Unable to find type for long" 1122 1123 val cUlong = 1124 (*if #size saUlong = #size saUint16 then cUint16 1125 else *)if #size saUlong = #size saUint32 then cUint32 1126 else if #size saUlong = #size saUint64 then cUint64 1127 else raise Foreign "Unable to find type for unsigned long" 1128 1129 val cUlongLarge = 1130 (*if #size saUlong = #size saUint16 then cUint16 1131 else *)if #size saUlong = #size saUint32 then cUint32Large 1132 else if #size saUlong = #size saUint64 then cUint64Large 1133 else raise Foreign "Unable to find type for unsigned long" 1134 1135 local 1136 fun load(s: voidStar): string = 1137 let 1138 (* The location contains the address of the string. *) 1139 val sAddr = getAddress(s, 0w0) 1140 fun sLen i = if get8(sAddr, i) = 0w0 then i else sLen(i+0w1) 1141 val length = sLen 0w0 1142 fun loadChar i = 1143 Char.chr(Word8.toInt(get8(sAddr, Word.fromInt i))) 1144 in 1145 CharVector.tabulate(Word.toInt length, loadChar) 1146 end 1147 1148 fun store(v: voidStar, s: string) = 1149 let 1150 val sLen = Word.fromInt(String.size s) 1151 val sMem = malloc(sLen + 0w1) 1152 val () = CharVector.appi(fn(i, ch) => set8(sMem, Word.fromInt i, Word8.fromInt(Char.ord ch))) s 1153 val () = set8(sMem, sLen, 0w0) 1154 in 1155 setAddress(v, 0w0, sMem); 1156 fn () => Memory.free sMem 1157 end 1158 1159 in 1160 val cString: string conversion = 1161 makeConversion { load=load, store=store, ctype = cTypePointer } 1162 end 1163 1164 (* This is used if we want to pass NULL rather than a pointer in some cases. *) 1165 fun cOptionPtr({load, store, updateML, updateC, ctype}:'a conversion): 'a option conversion = 1166 if #typeCode(extractFFItype(#ffiType ctype ())) <> ffiTypeCodePointer 1167 then raise Foreign "cOptionPtr must be applied to a pointer type" 1168 else 1169 let 1170 fun loadOpt(s: voidStar) = 1171 if getAddress(s, 0w0) = null then NONE else SOME(load s) 1172 1173 fun storeOpt(v: voidStar, NONE) = (setAddress(v, 0w0, null); fn _ => ()) 1174 | storeOpt(v: voidStar, SOME s) = store(v, s) 1175 1176 (* Do we have update here? *) 1177 fun updateMLOpt(_, NONE) = () 1178 | updateMLOpt(v: voidStar, SOME s) = updateML(v, s) 1179 1180 fun updateCOpt(_, NONE) = () 1181 | updateCOpt(v, SOME s) = updateC(v, s) 1182 in 1183 { load=loadOpt, store=storeOpt, updateML = updateMLOpt, 1184 updateC = updateCOpt, ctype = cTypePointer } 1185 end 1186 1187 local 1188 (* Word8Vector.vector to C array of bytes. It is only possible to 1189 do this one way because conversion from a C array requires 1190 us to know the size. *) 1191 fun load _ = raise Foreign "cByteArray cannot convert from C to ML" 1192 1193 fun store(v: voidStar, s: Word8Vector.vector) = 1194 let 1195 open Word8Vector 1196 val sLen = Word.fromInt(length s) 1197 val sMem = malloc sLen 1198 val () = appi(fn(i, b) => set8(sMem, Word.fromInt i, b)) s 1199 in 1200 setAddress(v, 0w0, sMem); 1201 fn () => Memory.free sMem 1202 end 1203 1204 in 1205 val cByteArray: Word8Vector.vector conversion = 1206 makeConversion{ load=load, store=store, ctype = cTypePointer } 1207 end 1208 end 1209 1210 (* Remove the free part from the store fn. This is intended for situations 1211 where an argument should not be deleted once the function completes. *) 1212 fun permanent({load, store, ctype, updateML, updateC }: 'a conversion): 'a conversion = 1213 let 1214 fun storeP args = (ignore (store args); fn () => ()) 1215 in 1216 { load=load, store=storeP, updateML = updateML, updateC = updateC, ctype=ctype } 1217 end 1218 1219 val op ++ = Memory.++ 1220 1221 fun cStruct2(a: 'a conversion, b: 'b conversion): ('a*'b)conversion = 1222 let 1223 val {load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype = ctypea as {size=sizea, ... }} = a 1224 and {load=loadb, store=storeb, updateML=updateMLb, updateC=updateCb, ctype = ctypeb as {align=alignb, ... }} = b 1225 1226 val offsetb = alignUp(sizea, alignb) 1227 fun load s = (loada s, loadb(s ++ offsetb)) 1228 and store (x, (a, b)) = 1229 let 1230 val freea = storea(x, a) and freeb = storeb(x ++ offsetb, b) 1231 in 1232 fn () => ( freea(); freeb() ) 1233 end 1234 and updateML(s, (a, b)) = (updateMLa(s, a); updateMLb(s ++ offsetb, b)) 1235 and updateC(x, (a, b)) = 1236 (updateCa(x, a); updateCb(x ++ offsetb, b)) 1237 in 1238 {load=load, store=store, updateML = updateML, updateC=updateC, ctype = LowLevel.cStruct[ctypea, ctypeb]} 1239 end 1240 1241 fun cStruct3(a: 'a conversion, b: 'b conversion, c: 'c conversion): ('a*'b*'c)conversion = 1242 let 1243 val {load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype = ctypea as {size=sizea, ...} } = a 1244 and {load=loadb, store=storeb, updateML=updateMLb, updateC=updateCb, ctype = ctypeb as {size=sizeb, align=alignb, ...} } = b 1245 and {load=loadc, store=storec, updateML=updateMLc, updateC=updateCc, ctype = ctypec as {align=alignc, ...} } = c 1246 1247 val offsetb = alignUp(sizea, alignb) 1248 val offsetc = alignUp(offsetb + sizeb, alignc) 1249 1250 fun load s = (loada s, loadb(s ++ offsetb), loadc(s ++ offsetc)) 1251 and store (x, (a, b, c)) = 1252 let 1253 val freea = storea(x, a) and freeb = storeb(x ++ offsetb, b) and freec = storec(x ++ offsetc, c) 1254 in 1255 fn () => ( freea(); freeb(); freec() ) 1256 end 1257 and updateML(s, (a, b, c)) = (updateMLa(s, a); updateMLb(s ++ offsetb, b); updateMLc(s ++ offsetc, c)) 1258 and updateC(x, (a, b, c)) = 1259 (updateCa(x, a); updateCb(x ++ offsetb, b); updateCc(x ++ offsetc, c)) 1260 in 1261 {load=load, store=store, updateML=updateML, updateC=updateC, ctype = LowLevel.cStruct[ctypea, ctypeb, ctypec]} 1262 end 1263 1264 fun cStruct4(a: 'a conversion, b: 'b conversion, c: 'c conversion, d: 'd conversion): ('a*'b*'c*'d)conversion = 1265 let 1266 val {load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype = ctypea as {size=sizea, ...} } = a 1267 and {load=loadb, store=storeb, updateML=updateMLb, updateC=updateCb, ctype = ctypeb as {size=sizeb, align=alignb, ...} } = b 1268 and {load=loadc, store=storec, updateML=updateMLc, updateC=updateCc, ctype = ctypec as {size=sizec, align=alignc, ...} } = c 1269 and {load=loadd, store=stored, updateML=updateMLd, updateC=updateCd, ctype = ctyped as {align=alignd, ...} } = d 1270 1271 val offsetb = alignUp(sizea, alignb) 1272 val offsetc = alignUp(offsetb + sizeb, alignc) 1273 val offsetd = alignUp(offsetc + sizec, alignd) 1274 1275 fun load s = (loada s, loadb(s ++ offsetb), loadc(s ++ offsetc), loadd(s ++ offsetd)) 1276 and store (x, (a, b, c, d)) = 1277 let 1278 val freea = storea(x, a) and freeb = storeb(x ++ offsetb, b) and freec = storec(x ++ offsetc, c) 1279 and freed = stored(x ++ offsetd, d) 1280 in 1281 fn () => ( freea(); freeb(); freec(); freed() ) 1282 end 1283 and updateML(s, (a, b, c, d)) = 1284 (updateMLa(s, a); updateMLb(s ++ offsetb, b); updateMLc(s ++ offsetc, c); updateMLd(s ++ offsetd, d)) 1285 and updateC(x, (a, b, c, d)) = 1286 (updateCa(x, a); updateCb(x ++ offsetb, b); updateCc(x ++ offsetc, c); updateCd(x ++ offsetd, d)) 1287 in 1288 {load=load, store=store, updateML=updateML, updateC=updateC, ctype = LowLevel.cStruct[ctypea, ctypeb, ctypec, ctyped]} 1289 end 1290 1291 fun cStruct5(a: 'a conversion, b: 'b conversion, c: 'c conversion, d: 'd conversion, 1292 e: 'e conversion): ('a*'b*'c*'d*'e)conversion = 1293 let 1294 val {load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype = ctypea as {size=sizea, ...} } = a 1295 and {load=loadb, store=storeb, updateML=updateMLb, updateC=updateCb, ctype = ctypeb as {size=sizeb, align=alignb, ...} } = b 1296 and {load=loadc, store=storec, updateML=updateMLc, updateC=updateCc, ctype = ctypec as {size=sizec, align=alignc, ...} } = c 1297 and {load=loadd, store=stored, updateML=updateMLd, updateC=updateCd, ctype = ctyped as {size=sized, align=alignd, ...} } = d 1298 and {load=loade, store=storee, updateML=updateMLe, updateC=updateCe, ctype = ctypee as {align=aligne, ...} } = e 1299 1300 val offsetb = alignUp(sizea, alignb) 1301 val offsetc = alignUp(offsetb + sizeb, alignc) 1302 val offsetd = alignUp(offsetc + sizec, alignd) 1303 val offsete = alignUp(offsetd + sized, aligne) 1304 1305 fun load s = 1306 (loada s, loadb(s ++ offsetb), loadc(s ++ offsetc), loadd(s ++ offsetd), loade(s ++ offsete)) 1307 and store (x, (a, b, c, d, e)) = 1308 let 1309 val freea = storea(x, a) and freeb = storeb(x ++ offsetb, b) and freec = storec(x ++ offsetc, c) 1310 and freed = stored(x ++ offsetd, d) and freee = storee(x ++ offsete, e) 1311 in 1312 fn () => ( freea(); freeb(); freec(); freed(); freee() ) 1313 end 1314 and updateML(s, (a, b, c, d, e)) = 1315 (updateMLa(s, a); updateMLb(s ++ offsetb, b); updateMLc(s ++ offsetc, c); 1316 updateMLd(s ++ offsetd, d); updateMLe(s ++ offsete, e)) 1317 and updateC(x, (a, b, c, d, e)) = 1318 (updateCa(x, a); updateCb(x ++ offsetb, b); updateCc(x ++ offsetc, c); updateCd(x ++ offsetd, d); 1319 updateCe(x ++ offsete, e)) 1320 in 1321 {load=load, store=store, updateML=updateML, updateC=updateC, ctype = LowLevel.cStruct[ctypea, ctypeb, ctypec, ctyped, ctypee]} 1322 end 1323 1324 fun cStruct6(a: 'a conversion, b: 'b conversion, c: 'c conversion, d: 'd conversion, 1325 e: 'e conversion, f: 'f conversion): ('a*'b*'c*'d*'e*'f)conversion = 1326 let 1327 val {load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype = ctypea as {size=sizea, ...} } = a 1328 and {load=loadb, store=storeb, updateML=updateMLb, updateC=updateCb, ctype = ctypeb as {size=sizeb, align=alignb, ...} } = b 1329 and {load=loadc, store=storec, updateML=updateMLc, updateC=updateCc, ctype = ctypec as {size=sizec, align=alignc, ...} } = c 1330 and {load=loadd, store=stored, updateML=updateMLd, updateC=updateCd, ctype = ctyped as {size=sized, align=alignd, ...} } = d 1331 and {load=loade, store=storee, updateML=updateMLe, updateC=updateCe, ctype = ctypee as {size=sizee, align=aligne, ...} } = e 1332 and {load=loadf, store=storef, updateML=updateMLf, updateC=updateCf, ctype = ctypef as {align=alignf, ...} } = f 1333 1334 val offsetb = alignUp(sizea, alignb) 1335 val offsetc = alignUp(offsetb + sizeb, alignc) 1336 val offsetd = alignUp(offsetc + sizec, alignd) 1337 val offsete = alignUp(offsetd + sized, aligne) 1338 val offsetf = alignUp(offsete + sizee, alignf) 1339 1340 fun load s = 1341 (loada s, loadb(s ++ offsetb), loadc(s ++ offsetc), loadd(s ++ offsetd), 1342 loade(s ++ offsete), loadf(s ++ offsetf)) 1343 and store (x, (a, b, c, d, e, f)) = 1344 let 1345 val freea = storea(x, a) and freeb = storeb(x ++ offsetb, b) and freec = storec(x ++ offsetc, c) 1346 and freed = stored(x ++ offsetd, d) and freee = storee(x ++ offsete, e) and freef = storef(x ++ offsetf, f) 1347 in 1348 fn () => ( freea(); freeb(); freec(); freed(); freee(); freef() ) 1349 end 1350 and updateML(s, (a, b, c, d, e, f)) = 1351 (updateMLa(s, a); updateMLb(s ++ offsetb, b); updateMLc(s ++ offsetc, c); updateMLd(s ++ offsetd, d); 1352 updateMLe(s ++ offsete, e); updateMLf(s ++ offsetf, f)) 1353 and updateC(x, (a, b, c, d, e, f)) = 1354 (updateCa(x, a); updateCb(x ++ offsetb, b); updateCc(x ++ offsetc, c); updateCd(x ++ offsetd, d); 1355 updateCe(x ++ offsete, e); updateCf(x ++ offsetf, f)) 1356 in 1357 {load=load, store=store, updateML=updateML, updateC=updateC, ctype = LowLevel.cStruct[ctypea, ctypeb, ctypec, ctyped, ctypee, ctypef]} 1358 end 1359 1360 fun cStruct7(a: 'a conversion, b: 'b conversion, c: 'c conversion, d: 'd conversion, 1361 e: 'e conversion, f: 'f conversion, g: 'g conversion): ('a*'b*'c*'d*'e*'f*'g)conversion = 1362 let 1363 val {load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype = ctypea as {size=sizea, ...} } = a 1364 and {load=loadb, store=storeb, updateML=updateMLb, updateC=updateCb, ctype = ctypeb as {size=sizeb, align=alignb, ...} } = b 1365 and {load=loadc, store=storec, updateML=updateMLc, updateC=updateCc, ctype = ctypec as {size=sizec, align=alignc, ...} } = c 1366 and {load=loadd, store=stored, updateML=updateMLd, updateC=updateCd, ctype = ctyped as {size=sized, align=alignd, ...} } = d 1367 and {load=loade, store=storee, updateML=updateMLe, updateC=updateCe, ctype = ctypee as {size=sizee, align=aligne, ...} } = e 1368 and {load=loadf, store=storef, updateML=updateMLf, updateC=updateCf, ctype = ctypef as {size=sizef, align=alignf, ...} } = f 1369 and {load=loadg, store=storeg, updateML=updateMLg, updateC=updateCg, ctype = ctypeg as {align=aligng, ...} } = g 1370 1371 val offsetb = alignUp(sizea, alignb) 1372 val offsetc = alignUp(offsetb + sizeb, alignc) 1373 val offsetd = alignUp(offsetc + sizec, alignd) 1374 val offsete = alignUp(offsetd + sized, aligne) 1375 val offsetf = alignUp(offsete + sizee, alignf) 1376 val offsetg = alignUp(offsetf + sizef, aligng) 1377 1378 fun load s = 1379 (loada s, loadb(s ++ offsetb), loadc(s ++ offsetc), loadd(s ++ offsetd), 1380 loade(s ++ offsete), loadf(s ++ offsetf), loadg(s ++ offsetg)) 1381 and store (x, (a, b, c, d, e, f, g)) = 1382 let 1383 val freea = storea(x, a) and freeb = storeb(x ++ offsetb, b) and freec = storec(x ++ offsetc, c) 1384 and freed = stored(x ++ offsetd, d) and freee = storee(x ++ offsete, e) and freef = storef(x ++ offsetf, f) 1385 and freeg = storeg(x ++ offsetg, g) 1386 in 1387 fn () => ( freea(); freeb(); freec(); freed(); freee(); freef(); freeg() ) 1388 end 1389 and updateML(s, (a, b, c, d, e, f, g)) = 1390 (updateMLa(s, a); updateMLb(s ++ offsetb, b); updateMLc(s ++ offsetc, c); updateMLd(s ++ offsetd, d); 1391 updateMLe(s ++ offsete, e); updateMLf(s ++ offsetf, f); updateMLg(s ++ offsetg, g)) 1392 and updateC(x, (a, b, c, d, e, f, g)) = 1393 (updateCa(x, a); updateCb(x ++ offsetb, b); updateCc(x ++ offsetc, c); updateCd(x ++ offsetd, d); 1394 updateCe(x ++ offsete, e); updateCf(x ++ offsetf, f); updateCg(x ++ offsetg, g)) 1395 in 1396 {load=load, store=store, updateML=updateML, updateC=updateC, ctype = LowLevel.cStruct[ctypea, ctypeb, ctypec, ctyped, ctypee, ctypef, ctypeg]} 1397 end 1398 1399 fun cStruct8(a: 'a conversion, b: 'b conversion, c: 'c conversion, d: 'd conversion, 1400 e: 'e conversion, f: 'f conversion, g: 'g conversion, h: 'h conversion): 1401 ('a*'b*'c*'d*'e*'f*'g*'h)conversion = 1402 let 1403 val {load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype = ctypea as {size=sizea, ...} } = a 1404 and {load=loadb, store=storeb, updateML=updateMLb, updateC=updateCb, ctype = ctypeb as {size=sizeb, align=alignb, ...} } = b 1405 and {load=loadc, store=storec, updateML=updateMLc, updateC=updateCc, ctype = ctypec as {size=sizec, align=alignc, ...} } = c 1406 and {load=loadd, store=stored, updateML=updateMLd, updateC=updateCd, ctype = ctyped as {size=sized, align=alignd, ...} } = d 1407 and {load=loade, store=storee, updateML=updateMLe, updateC=updateCe, ctype = ctypee as {size=sizee, align=aligne, ...} } = e 1408 and {load=loadf, store=storef, updateML=updateMLf, updateC=updateCf, ctype = ctypef as {size=sizef, align=alignf, ...} } = f 1409 and {load=loadg, store=storeg, updateML=updateMLg, updateC=updateCg, ctype = ctypeg as {size=sizeg, align=aligng, ...} } = g 1410 and {load=loadh, store=storeh, updateML=updateMLh, updateC=updateCh, ctype = ctypeh as {align=alignh, ...} } = h 1411 1412 val offsetb = alignUp(sizea, alignb) 1413 val offsetc = alignUp(offsetb + sizeb, alignc) 1414 val offsetd = alignUp(offsetc + sizec, alignd) 1415 val offsete = alignUp(offsetd + sized, aligne) 1416 val offsetf = alignUp(offsete + sizee, alignf) 1417 val offsetg = alignUp(offsetf + sizef, aligng) 1418 val offseth = alignUp(offsetg + sizeg, alignh) 1419 1420 fun load s = 1421 (loada s, loadb(s ++ offsetb), loadc(s ++ offsetc), loadd(s ++ offsetd), 1422 loade(s ++ offsete), loadf(s ++ offsetf), loadg(s ++ offsetg), loadh(s ++ offseth)) 1423 and store (x, (a, b, c, d, e, f, g, h)) = 1424 let 1425 val freea = storea(x, a) and freeb = storeb(x ++ offsetb, b) and freec = storec(x ++ offsetc, c) 1426 and freed = stored(x ++ offsetd, d) and freee = storee(x ++ offsete, e) and freef = storef(x ++ offsetf, f) 1427 and freeg = storeg(x ++ offsetg, g) and freeh = storeh(x ++ offseth, h) 1428 in 1429 fn () => ( freea(); freeb(); freec(); freed(); freee(); freef(); freeg(); freeh() ) 1430 end 1431 and updateML(s, (a, b, c, d, e, f, g, h)) = 1432 (updateMLa(s, a); updateMLb(s ++ offsetb, b); updateMLc(s ++ offsetc, c); updateMLd(s ++ offsetd, d); 1433 updateMLe(s ++ offsete, e); updateMLf(s ++ offsetf, f); updateMLg(s ++ offsetg, g); 1434 updateMLh(s ++ offseth, h)) 1435 and updateC(x, (a, b, c, d, e, f, g, h)) = 1436 (updateCa(x, a); updateCb(x ++ offsetb, b); updateCc(x ++ offsetc, c); updateCd(x ++ offsetd, d); 1437 updateCe(x ++ offsete, e); updateCf(x ++ offsetf, f); updateCg(x ++ offsetg, g); 1438 updateCh(x ++ offseth, h)) 1439 in 1440 {load=load, store=store, updateML=updateML, updateC=updateC, 1441 ctype = LowLevel.cStruct[ctypea, ctypeb, ctypec, ctyped, ctypee, ctypef, ctypeg, ctypeh]} 1442 end 1443 1444 fun cStruct9(a: 'a conversion, b: 'b conversion, c: 'c conversion, d: 'd conversion, 1445 e: 'e conversion, f: 'f conversion, g: 'g conversion, h: 'h conversion, 1446 i: 'i conversion): ('a*'b*'c*'d*'e*'f*'g*'h*'i)conversion = 1447 let 1448 val {load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype = ctypea as {size=sizea, ...} } = a 1449 and {load=loadb, store=storeb, updateML=updateMLb, updateC=updateCb, ctype = ctypeb as {size=sizeb, align=alignb, ...} } = b 1450 and {load=loadc, store=storec, updateML=updateMLc, updateC=updateCc, ctype = ctypec as {size=sizec, align=alignc, ...} } = c 1451 and {load=loadd, store=stored, updateML=updateMLd, updateC=updateCd, ctype = ctyped as {size=sized, align=alignd, ...} } = d 1452 and {load=loade, store=storee, updateML=updateMLe, updateC=updateCe, ctype = ctypee as {size=sizee, align=aligne, ...} } = e 1453 and {load=loadf, store=storef, updateML=updateMLf, updateC=updateCf, ctype = ctypef as {size=sizef, align=alignf, ...} } = f 1454 and {load=loadg, store=storeg, updateML=updateMLg, updateC=updateCg, ctype = ctypeg as {size=sizeg, align=aligng, ...} } = g 1455 and {load=loadh, store=storeh, updateML=updateMLh, updateC=updateCh, ctype = ctypeh as {size=sizeh, align=alignh, ...} } = h 1456 and {load=loadi, store=storei, updateML=updateMLi, updateC=updateCi, ctype = ctypei as {align=aligni, ...} } = i 1457 1458 val offsetb = alignUp(sizea, alignb) 1459 val offsetc = alignUp(offsetb + sizeb, alignc) 1460 val offsetd = alignUp(offsetc + sizec, alignd) 1461 val offsete = alignUp(offsetd + sized, aligne) 1462 val offsetf = alignUp(offsete + sizee, alignf) 1463 val offsetg = alignUp(offsetf + sizef, aligng) 1464 val offseth = alignUp(offsetg + sizeg, alignh) 1465 val offseti = alignUp(offseth + sizeh, aligni) 1466 1467 fun load s = 1468 (loada s, loadb(s ++ offsetb), loadc(s ++ offsetc), loadd(s ++ offsetd), 1469 loade(s ++ offsete), loadf(s ++ offsetf), loadg(s ++ offsetg), 1470 loadh(s ++ offseth), loadi(s ++ offseti)) 1471 and store (x, (a, b, c, d, e, f, g, h, i)) = 1472 let 1473 val freea = storea(x, a) and freeb = storeb(x ++ offsetb, b) and freec = storec(x ++ offsetc, c) 1474 and freed = stored(x ++ offsetd, d) and freee = storee(x ++ offsete, e) and freef = storef(x ++ offsetf, f) 1475 and freeg = storeg(x ++ offsetg, g) and freeh = storeh(x ++ offseth, h) and freei = storei(x ++ offseti, i) 1476 in 1477 fn () => ( freea(); freeb(); freec(); freed(); freee(); freef(); freeg(); freeh(); freei() ) 1478 end 1479 and updateML(s, (a, b, c, d, e, f, g, h, i)) = 1480 (updateMLa(s, a); updateMLb(s ++ offsetb, b); updateMLc(s ++ offsetc, c); updateMLd(s ++ offsetd, d); 1481 updateMLe(s ++ offsete, e); updateMLf(s ++ offsetf, f); updateMLg(s ++ offsetg, g); 1482 updateMLh(s ++ offseth, h); updateMLi(s ++ offseti, i)) 1483 and updateC(x, (a, b, c, d, e, f, g, h, i)) = 1484 (updateCa(x, a); updateCb(x ++ offsetb, b); updateCc(x ++ offsetc, c); updateCd(x ++ offsetd, d); 1485 updateCe(x ++ offsete, e); updateCf(x ++ offsetf, f); updateCg(x ++ offsetg, g); 1486 updateCh(x ++ offseth, h); updateCi(x ++ offseti, i)) 1487 in 1488 {load=load, store=store, updateML=updateML, updateC=updateC, 1489 ctype = LowLevel.cStruct[ctypea, ctypeb, ctypec, ctyped, ctypee, ctypef, ctypeg, ctypeh, ctypei]} 1490 end 1491 1492 fun cStruct10(a: 'a conversion, b: 'b conversion, c: 'c conversion, d: 'd conversion, 1493 e: 'e conversion, f: 'f conversion, g: 'g conversion, h: 'h conversion, 1494 i: 'i conversion, j: 'j conversion): 1495 ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j)conversion = 1496 let 1497 val {load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype = ctypea as {size=sizea, ...} } = a 1498 and {load=loadb, store=storeb, updateML=updateMLb, updateC=updateCb, ctype = ctypeb as {size=sizeb, align=alignb, ...} } = b 1499 and {load=loadc, store=storec, updateML=updateMLc, updateC=updateCc, ctype = ctypec as {size=sizec, align=alignc, ...} } = c 1500 and {load=loadd, store=stored, updateML=updateMLd, updateC=updateCd, ctype = ctyped as {size=sized, align=alignd, ...} } = d 1501 and {load=loade, store=storee, updateML=updateMLe, updateC=updateCe, ctype = ctypee as {size=sizee, align=aligne, ...} } = e 1502 and {load=loadf, store=storef, updateML=updateMLf, updateC=updateCf, ctype = ctypef as {size=sizef, align=alignf, ...} } = f 1503 and {load=loadg, store=storeg, updateML=updateMLg, updateC=updateCg, ctype = ctypeg as {size=sizeg, align=aligng, ...} } = g 1504 and {load=loadh, store=storeh, updateML=updateMLh, updateC=updateCh, ctype = ctypeh as {size=sizeh, align=alignh, ...} } = h 1505 and {load=loadi, store=storei, updateML=updateMLi, updateC=updateCi, ctype = ctypei as {size=sizei, align=aligni, ...} } = i 1506 and {load=loadj, store=storej, updateML=updateMLj, updateC=updateCj, ctype = ctypej as {align=alignj, ...} } = j 1507 1508 val offsetb = alignUp(sizea, alignb) 1509 val offsetc = alignUp(offsetb + sizeb, alignc) 1510 val offsetd = alignUp(offsetc + sizec, alignd) 1511 val offsete = alignUp(offsetd + sized, aligne) 1512 val offsetf = alignUp(offsete + sizee, alignf) 1513 val offsetg = alignUp(offsetf + sizef, aligng) 1514 val offseth = alignUp(offsetg + sizeg, alignh) 1515 val offseti = alignUp(offseth + sizeh, aligni) 1516 val offsetj = alignUp(offseti + sizei, alignj) 1517 1518 fun load s = 1519 (loada s, loadb(s ++ offsetb), loadc(s ++ offsetc), loadd(s ++ offsetd), 1520 loade(s ++ offsete), loadf(s ++ offsetf), loadg(s ++ offsetg), 1521 loadh(s ++ offseth), loadi(s ++ offseti), loadj(s ++ offsetj)) 1522 and store (x, (a, b, c, d, e, f, g, h, i, j)) = 1523 let 1524 val freea = storea(x, a) and freeb = storeb(x ++ offsetb, b) and freec = storec(x ++ offsetc, c) 1525 and freed = stored(x ++ offsetd, d) and freee = storee(x ++ offsete, e) and freef = storef(x ++ offsetf, f) 1526 and freeg = storeg(x ++ offsetg, g) and freeh = storeh(x ++ offseth, h) and freei = storei(x ++ offseti, i) 1527 and freej = storej(x ++ offsetj, j) 1528 in 1529 fn () => 1530 ( 1531 freea(); freeb(); freec(); freed(); freee(); freef(); freeg(); 1532 freeh(); freei(); freej() 1533 ) 1534 end 1535 and updateML(x, (a, b, c, d, e, f, g, h, i, j)) = 1536 (updateMLa(x, a); updateMLb(x ++ offsetb, b); updateMLc(x ++ offsetc, c); updateMLd(x ++ offsetd, d); 1537 updateMLe(x ++ offsete, e); updateMLf(x ++ offsetf, f); updateMLg(x ++ offsetg, g); 1538 updateMLh(x ++ offseth, h); updateMLi(x ++ offseti, i); updateMLj(x ++ offsetj, j)) 1539 and updateC(x, (a, b, c, d, e, f, g, h, i, j)) = 1540 (updateCa(x, a); updateCb(x ++ offsetb, b); updateCc(x ++ offsetc, c); updateCd(x ++ offsetd, d); 1541 updateCe(x ++ offsete, e); updateCf(x ++ offsetf, f); updateCg(x ++ offsetg, g); 1542 updateCh(x ++ offseth, h); updateCi(x ++ offseti, i); updateCj(x ++ offsetj, j)) 1543 in 1544 {load=load, store=store, updateML=updateML, updateC=updateC, 1545 ctype = LowLevel.cStruct[ctypea, ctypeb, ctypec, ctyped, ctypee, ctypef, ctypeg, ctypeh, ctypei, ctypej]} 1546 end 1547 1548 fun cStruct11(a: 'a conversion, b: 'b conversion, c: 'c conversion, d: 'd conversion, 1549 e: 'e conversion, f: 'f conversion, g: 'g conversion, h: 'h conversion, 1550 i: 'i conversion, j: 'j conversion, k: 'k conversion): 1551 ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k)conversion = 1552 let 1553 val {load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype = ctypea as {size=sizea, ...} } = a 1554 and {load=loadb, store=storeb, updateML=updateMLb, updateC=updateCb, ctype = ctypeb as {size=sizeb, align=alignb, ...} } = b 1555 and {load=loadc, store=storec, updateML=updateMLc, updateC=updateCc, ctype = ctypec as {size=sizec, align=alignc, ...} } = c 1556 and {load=loadd, store=stored, updateML=updateMLd, updateC=updateCd, ctype = ctyped as {size=sized, align=alignd, ...} } = d 1557 and {load=loade, store=storee, updateML=updateMLe, updateC=updateCe, ctype = ctypee as {size=sizee, align=aligne, ...} } = e 1558 and {load=loadf, store=storef, updateML=updateMLf, updateC=updateCf, ctype = ctypef as {size=sizef, align=alignf, ...} } = f 1559 and {load=loadg, store=storeg, updateML=updateMLg, updateC=updateCg, ctype = ctypeg as {size=sizeg, align=aligng, ...} } = g 1560 and {load=loadh, store=storeh, updateML=updateMLh, updateC=updateCh, ctype = ctypeh as {size=sizeh, align=alignh, ...} } = h 1561 and {load=loadi, store=storei, updateML=updateMLi, updateC=updateCi, ctype = ctypei as {size=sizei, align=aligni, ...} } = i 1562 and {load=loadj, store=storej, updateML=updateMLj, updateC=updateCj, ctype = ctypej as {size=sizej, align=alignj, ...} } = j 1563 and {load=loadk, store=storek, updateML=updateMLk, updateC=updateCk, ctype = ctypek as {align=alignk, ...} } = k 1564 1565 val offsetb = alignUp(sizea, alignb) 1566 val offsetc = alignUp(offsetb + sizeb, alignc) 1567 val offsetd = alignUp(offsetc + sizec, alignd) 1568 val offsete = alignUp(offsetd + sized, aligne) 1569 val offsetf = alignUp(offsete + sizee, alignf) 1570 val offsetg = alignUp(offsetf + sizef, aligng) 1571 val offseth = alignUp(offsetg + sizeg, alignh) 1572 val offseti = alignUp(offseth + sizeh, aligni) 1573 val offsetj = alignUp(offseti + sizei, alignj) 1574 val offsetk = alignUp(offsetj + sizej, alignk) 1575 1576 fun load s = 1577 (loada s, loadb(s ++ offsetb), loadc(s ++ offsetc), loadd(s ++ offsetd), 1578 loade(s ++ offsete), loadf(s ++ offsetf), loadg(s ++ offsetg), 1579 loadh(s ++ offseth), loadi(s ++ offseti), loadj(s ++ offsetj), 1580 loadk(s ++ offsetk)) 1581 and store (x, (a, b, c, d, e, f, g, h, i, j, k)) = 1582 let 1583 val freea = storea(x, a) and freeb = storeb(x ++ offsetb, b) and freec = storec(x ++ offsetc, c) 1584 and freed = stored(x ++ offsetd, d) and freee = storee(x ++ offsete, e) and freef = storef(x ++ offsetf, f) 1585 and freeg = storeg(x ++ offsetg, g) and freeh = storeh(x ++ offseth, h) and freei = storei(x ++ offseti, i) 1586 and freej = storej(x ++ offsetj, j) and freek = storek(x ++ offsetk, k) 1587 in 1588 fn () => 1589 ( 1590 freea(); freeb(); freec(); freed(); freee(); freef(); freeg(); 1591 freeh(); freei(); freej(); freek() 1592 ) 1593 end 1594 and updateML(x, (a, b, c, d, e, f, g, h, i, j, k)) = 1595 (updateMLa(x, a); updateMLb(x ++ offsetb, b); updateMLc(x ++ offsetc, c); updateMLd(x ++ offsetd, d); 1596 updateMLe(x ++ offsete, e); updateMLf(x ++ offsetf, f); updateMLg(x ++ offsetg, g); 1597 updateMLh(x ++ offseth, h); updateMLi(x ++ offseti, i); updateMLj(x ++ offsetj, j); 1598 updateMLk(x ++ offsetk, k)) 1599 and updateC(x, (a, b, c, d, e, f, g, h, i, j, k)) = 1600 (updateCa(x, a); updateCb(x ++ offsetb, b); updateCc(x ++ offsetc, c); updateCd(x ++ offsetd, d); 1601 updateCe(x ++ offsete, e); updateCf(x ++ offsetf, f); updateCg(x ++ offsetg, g); 1602 updateCh(x ++ offseth, h); updateCi(x ++ offseti, i); updateCj(x ++ offsetj, j); 1603 updateCk(x ++ offsetk, k)) 1604 in 1605 {load=load, store=store, updateML=updateML, updateC=updateC, 1606 ctype = LowLevel.cStruct[ctypea, ctypeb, ctypec, ctyped, ctypee, ctypef, ctypeg, ctypeh, ctypei, ctypej, 1607 ctypek]} 1608 end 1609 1610 fun cStruct12(a: 'a conversion, b: 'b conversion, c: 'c conversion, d: 'd conversion, 1611 e: 'e conversion, f: 'f conversion, g: 'g conversion, h: 'h conversion, 1612 i: 'i conversion, j: 'j conversion, k: 'k conversion, l: 'l conversion): 1613 ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k*'l)conversion = 1614 let 1615 val {load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype = ctypea as {size=sizea, ...} } = a 1616 and {load=loadb, store=storeb, updateML=updateMLb, updateC=updateCb, ctype = ctypeb as {size=sizeb, align=alignb, ...} } = b 1617 and {load=loadc, store=storec, updateML=updateMLc, updateC=updateCc, ctype = ctypec as {size=sizec, align=alignc, ...} } = c 1618 and {load=loadd, store=stored, updateML=updateMLd, updateC=updateCd, ctype = ctyped as {size=sized, align=alignd, ...} } = d 1619 and {load=loade, store=storee, updateML=updateMLe, updateC=updateCe, ctype = ctypee as {size=sizee, align=aligne, ...} } = e 1620 and {load=loadf, store=storef, updateML=updateMLf, updateC=updateCf, ctype = ctypef as {size=sizef, align=alignf, ...} } = f 1621 and {load=loadg, store=storeg, updateML=updateMLg, updateC=updateCg, ctype = ctypeg as {size=sizeg, align=aligng, ...} } = g 1622 and {load=loadh, store=storeh, updateML=updateMLh, updateC=updateCh, ctype = ctypeh as {size=sizeh, align=alignh, ...} } = h 1623 and {load=loadi, store=storei, updateML=updateMLi, updateC=updateCi, ctype = ctypei as {size=sizei, align=aligni, ...} } = i 1624 and {load=loadj, store=storej, updateML=updateMLj, updateC=updateCj, ctype = ctypej as {size=sizej, align=alignj, ...} } = j 1625 and {load=loadk, store=storek, updateML=updateMLk, updateC=updateCk, ctype = ctypek as {size=sizek, align=alignk, ...} } = k 1626 and {load=loadl, store=storel, updateML=updateMLl, updateC=updateCl, ctype = ctypel as {align=alignl, ...} } = l 1627 1628 val offsetb = alignUp(sizea, alignb) 1629 val offsetc = alignUp(offsetb + sizeb, alignc) 1630 val offsetd = alignUp(offsetc + sizec, alignd) 1631 val offsete = alignUp(offsetd + sized, aligne) 1632 val offsetf = alignUp(offsete + sizee, alignf) 1633 val offsetg = alignUp(offsetf + sizef, aligng) 1634 val offseth = alignUp(offsetg + sizeg, alignh) 1635 val offseti = alignUp(offseth + sizeh, aligni) 1636 val offsetj = alignUp(offseti + sizei, alignj) 1637 val offsetk = alignUp(offsetj + sizej, alignk) 1638 val offsetl = alignUp(offsetk + sizek, alignl) 1639 1640 fun load s = 1641 (loada s, loadb(s ++ offsetb), loadc(s ++ offsetc), loadd(s ++ offsetd), 1642 loade(s ++ offsete), loadf(s ++ offsetf), loadg(s ++ offsetg), 1643 loadh(s ++ offseth), loadi(s ++ offseti), loadj(s ++ offsetj), 1644 loadk(s ++ offsetk), loadl(s ++ offsetl)) 1645 and store (x, (a, b, c, d, e, f, g, h, i, j, k, l)) = 1646 let 1647 val freea = storea(x, a) and freeb = storeb(x ++ offsetb, b) and freec = storec(x ++ offsetc, c) 1648 and freed = stored(x ++ offsetd, d) and freee = storee(x ++ offsete, e) and freef = storef(x ++ offsetf, f) 1649 and freeg = storeg(x ++ offsetg, g) and freeh = storeh(x ++ offseth, h) and freei = storei(x ++ offseti, i) 1650 and freej = storej(x ++ offsetj, j) and freek = storek(x ++ offsetk, k) and freel = storel(x ++ offsetl, l) 1651 in 1652 fn () => 1653 ( 1654 freea(); freeb(); freec(); freed(); freee(); freef(); freeg(); 1655 freeh(); freei(); freej(); freek(); freel() 1656 ) 1657 end 1658 and updateML(x, (a, b, c, d, e, f, g, h, i, j, k, l)) = 1659 (updateMLa(x, a); updateMLb(x ++ offsetb, b); updateMLc(x ++ offsetc, c); updateMLd(x ++ offsetd, d); 1660 updateMLe(x ++ offsete, e); updateMLf(x ++ offsetf, f); updateMLg(x ++ offsetg, g); 1661 updateMLh(x ++ offseth, h); updateMLi(x ++ offseti, i); updateMLj(x ++ offsetj, j); 1662 updateMLk(x ++ offsetk, k); updateMLl(x ++ offsetl, l)) 1663 and updateC(x, (a, b, c, d, e, f, g, h, i, j, k, l)) = 1664 (updateCa(x, a); updateCb(x ++ offsetb, b); updateCc(x ++ offsetc, c); updateCd(x ++ offsetd, d); 1665 updateCe(x ++ offsete, e); updateCf(x ++ offsetf, f); updateCg(x ++ offsetg, g); 1666 updateCh(x ++ offseth, h); updateCi(x ++ offseti, i); updateCj(x ++ offsetj, j); 1667 updateCk(x ++ offsetk, k); updateCl(x ++ offsetl, l)) 1668 in 1669 {load=load, store=store, updateML=updateML, updateC=updateC, 1670 ctype = LowLevel.cStruct[ctypea, ctypeb, ctypec, ctyped, ctypee, ctypef, ctypeg, ctypeh, ctypei, ctypej, 1671 ctypek, ctypel]} 1672 end 1673 1674 fun cStruct13(a: 'a conversion, b: 'b conversion, c: 'c conversion, d: 'd conversion, 1675 e: 'e conversion, f: 'f conversion, g: 'g conversion, h: 'h conversion, 1676 i: 'i conversion, j: 'j conversion, k: 'k conversion, l: 'l conversion, 1677 m: 'm conversion): 1678 ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k*'l*'m)conversion = 1679 let 1680 val {load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype = ctypea as {size=sizea, ...} } = a 1681 and {load=loadb, store=storeb, updateML=updateMLb, updateC=updateCb, ctype = ctypeb as {size=sizeb, align=alignb, ...} } = b 1682 and {load=loadc, store=storec, updateML=updateMLc, updateC=updateCc, ctype = ctypec as {size=sizec, align=alignc, ...} } = c 1683 and {load=loadd, store=stored, updateML=updateMLd, updateC=updateCd, ctype = ctyped as {size=sized, align=alignd, ...} } = d 1684 and {load=loade, store=storee, updateML=updateMLe, updateC=updateCe, ctype = ctypee as {size=sizee, align=aligne, ...} } = e 1685 and {load=loadf, store=storef, updateML=updateMLf, updateC=updateCf, ctype = ctypef as {size=sizef, align=alignf, ...} } = f 1686 and {load=loadg, store=storeg, updateML=updateMLg, updateC=updateCg, ctype = ctypeg as {size=sizeg, align=aligng, ...} } = g 1687 and {load=loadh, store=storeh, updateML=updateMLh, updateC=updateCh, ctype = ctypeh as {size=sizeh, align=alignh, ...} } = h 1688 and {load=loadi, store=storei, updateML=updateMLi, updateC=updateCi, ctype = ctypei as {size=sizei, align=aligni, ...} } = i 1689 and {load=loadj, store=storej, updateML=updateMLj, updateC=updateCj, ctype = ctypej as {size=sizej, align=alignj, ...} } = j 1690 and {load=loadk, store=storek, updateML=updateMLk, updateC=updateCk, ctype = ctypek as {size=sizek, align=alignk, ...} } = k 1691 and {load=loadl, store=storel, updateML=updateMLl, updateC=updateCl, ctype = ctypel as {size=sizel, align=alignl, ...} } = l 1692 and {load=loadm, store=storem, updateML=updateMLm, updateC=updateCm, ctype = ctypem as {align=alignm, ...} } = m 1693 1694 val offsetb = alignUp(sizea, alignb) 1695 val offsetc = alignUp(offsetb + sizeb, alignc) 1696 val offsetd = alignUp(offsetc + sizec, alignd) 1697 val offsete = alignUp(offsetd + sized, aligne) 1698 val offsetf = alignUp(offsete + sizee, alignf) 1699 val offsetg = alignUp(offsetf + sizef, aligng) 1700 val offseth = alignUp(offsetg + sizeg, alignh) 1701 val offseti = alignUp(offseth + sizeh, aligni) 1702 val offsetj = alignUp(offseti + sizei, alignj) 1703 val offsetk = alignUp(offsetj + sizej, alignk) 1704 val offsetl = alignUp(offsetk + sizek, alignl) 1705 val offsetm = alignUp(offsetl + sizel, alignm) 1706 1707 fun load s = 1708 (loada s, loadb(s ++ offsetb), loadc(s ++ offsetc), loadd(s ++ offsetd), 1709 loade(s ++ offsete), loadf(s ++ offsetf), loadg(s ++ offsetg), 1710 loadh(s ++ offseth), loadi(s ++ offseti), loadj(s ++ offsetj), 1711 loadk(s ++ offsetk), loadl(s ++ offsetl), loadm(s ++ offsetm)) 1712 and store (x, (a, b, c, d, e, f, g, h, i, j, k, l, m)) = 1713 let 1714 val freea = storea(x, a) and freeb = storeb(x ++ offsetb, b) and freec = storec(x ++ offsetc, c) 1715 and freed = stored(x ++ offsetd, d) and freee = storee(x ++ offsete, e) and freef = storef(x ++ offsetf, f) 1716 and freeg = storeg(x ++ offsetg, g) and freeh = storeh(x ++ offseth, h) and freei = storei(x ++ offseti, i) 1717 and freej = storej(x ++ offsetj, j) and freek = storek(x ++ offsetk, k) and freel = storel(x ++ offsetl, l) 1718 and freem = storem(x ++ offsetm, m) 1719 in 1720 fn () => 1721 ( 1722 freea(); freeb(); freec(); freed(); freee(); freef(); freeg(); 1723 freeh(); freei(); freej(); freek(); freel(); freem() 1724 ) 1725 end 1726 and updateML(x, (a, b, c, d, e, f, g, h, i, j, k, l, m)) = 1727 (updateMLa(x, a); updateMLb(x ++ offsetb, b); updateMLc(x ++ offsetc, c); updateMLd(x ++ offsetd, d); 1728 updateMLe(x ++ offsete, e); updateMLf(x ++ offsetf, f); updateMLg(x ++ offsetg, g); 1729 updateMLh(x ++ offseth, h); updateMLi(x ++ offseti, i); updateMLj(x ++ offsetj, j); 1730 updateMLk(x ++ offsetk, k); updateMLl(x ++ offsetl, l); updateMLm(x ++ offsetm, m)) 1731 and updateC(x, (a, b, c, d, e, f, g, h, i, j, k, l, m)) = 1732 (updateCa(x, a); updateCb(x ++ offsetb, b); updateCc(x ++ offsetc, c); updateCd(x ++ offsetd, d); 1733 updateCe(x ++ offsete, e); updateCf(x ++ offsetf, f); updateCg(x ++ offsetg, g); 1734 updateCh(x ++ offseth, h); updateCi(x ++ offseti, i); updateCj(x ++ offsetj, j); 1735 updateCk(x ++ offsetk, k); updateCl(x ++ offsetl, l); updateCm(x ++ offsetm, m)) 1736 in 1737 {load=load, store=store, updateML=updateML, updateC=updateC, 1738 ctype = LowLevel.cStruct[ctypea, ctypeb, ctypec, ctyped, ctypee, ctypef, ctypeg, ctypeh, ctypei, ctypej, 1739 ctypek, ctypel, ctypem]} 1740 end 1741 1742 nonfix o 1743 1744 fun cStruct14(a: 'a conversion, b: 'b conversion, c: 'c conversion, d: 'd conversion, 1745 e: 'e conversion, f: 'f conversion, g: 'g conversion, h: 'h conversion, 1746 i: 'i conversion, j: 'j conversion, k: 'k conversion, l: 'l conversion, 1747 m: 'm conversion, n: 'n conversion): 1748 ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k*'l*'m*'n)conversion = 1749 let 1750 val {load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype = ctypea as {size=sizea, ...} } = a 1751 and {load=loadb, store=storeb, updateML=updateMLb, updateC=updateCb, ctype = ctypeb as {size=sizeb, align=alignb, ...} } = b 1752 and {load=loadc, store=storec, updateML=updateMLc, updateC=updateCc, ctype = ctypec as {size=sizec, align=alignc, ...} } = c 1753 and {load=loadd, store=stored, updateML=updateMLd, updateC=updateCd, ctype = ctyped as {size=sized, align=alignd, ...} } = d 1754 and {load=loade, store=storee, updateML=updateMLe, updateC=updateCe, ctype = ctypee as {size=sizee, align=aligne, ...} } = e 1755 and {load=loadf, store=storef, updateML=updateMLf, updateC=updateCf, ctype = ctypef as {size=sizef, align=alignf, ...} } = f 1756 and {load=loadg, store=storeg, updateML=updateMLg, updateC=updateCg, ctype = ctypeg as {size=sizeg, align=aligng, ...} } = g 1757 and {load=loadh, store=storeh, updateML=updateMLh, updateC=updateCh, ctype = ctypeh as {size=sizeh, align=alignh, ...} } = h 1758 and {load=loadi, store=storei, updateML=updateMLi, updateC=updateCi, ctype = ctypei as {size=sizei, align=aligni, ...} } = i 1759 and {load=loadj, store=storej, updateML=updateMLj, updateC=updateCj, ctype = ctypej as {size=sizej, align=alignj, ...} } = j 1760 and {load=loadk, store=storek, updateML=updateMLk, updateC=updateCk, ctype = ctypek as {size=sizek, align=alignk, ...} } = k 1761 and {load=loadl, store=storel, updateML=updateMLl, updateC=updateCl, ctype = ctypel as {size=sizel, align=alignl, ...} } = l 1762 and {load=loadm, store=storem, updateML=updateMLm, updateC=updateCm, ctype = ctypem as {size=sizem, align=alignm, ...} } = m 1763 and {load=loadn, store=storen, updateML=updateMLn, updateC=updateCn, ctype = ctypen as {align=alignn, ...} } = n 1764 1765 val offsetb = alignUp(sizea, alignb) 1766 val offsetc = alignUp(offsetb + sizeb, alignc) 1767 val offsetd = alignUp(offsetc + sizec, alignd) 1768 val offsete = alignUp(offsetd + sized, aligne) 1769 val offsetf = alignUp(offsete + sizee, alignf) 1770 val offsetg = alignUp(offsetf + sizef, aligng) 1771 val offseth = alignUp(offsetg + sizeg, alignh) 1772 val offseti = alignUp(offseth + sizeh, aligni) 1773 val offsetj = alignUp(offseti + sizei, alignj) 1774 val offsetk = alignUp(offsetj + sizej, alignk) 1775 val offsetl = alignUp(offsetk + sizek, alignl) 1776 val offsetm = alignUp(offsetl + sizel, alignm) 1777 val offsetn = alignUp(offsetm + sizem, alignn) 1778 1779 fun load s = 1780 (loada s, loadb(s ++ offsetb), loadc(s ++ offsetc), loadd(s ++ offsetd), 1781 loade(s ++ offsete), loadf(s ++ offsetf), loadg(s ++ offsetg), 1782 loadh(s ++ offseth), loadi(s ++ offseti), loadj(s ++ offsetj), 1783 loadk(s ++ offsetk), loadl(s ++ offsetl), loadm(s ++ offsetm), 1784 loadn(s ++ offsetn)) 1785 and store (x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n)) = 1786 let 1787 val freea = storea(x, a) and freeb = storeb(x ++ offsetb, b) and freec = storec(x ++ offsetc, c) 1788 and freed = stored(x ++ offsetd, d) and freee = storee(x ++ offsete, e) and freef = storef(x ++ offsetf, f) 1789 and freeg = storeg(x ++ offsetg, g) and freeh = storeh(x ++ offseth, h) and freei = storei(x ++ offseti, i) 1790 and freej = storej(x ++ offsetj, j) and freek = storek(x ++ offsetk, k) and freel = storel(x ++ offsetl, l) 1791 and freem = storem(x ++ offsetm, m) and freen = storen(x ++ offsetn, n) 1792 in 1793 fn () => 1794 ( 1795 freea(); freeb(); freec(); freed(); freee(); freef(); freeg(); 1796 freeh(); freei(); freej(); freek(); freel(); freem(); 1797 freen() 1798 ) 1799 end 1800 and updateML(x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n)) = 1801 (updateMLa(x, a); updateMLb(x ++ offsetb, b); updateMLc(x ++ offsetc, c); updateMLd(x ++ offsetd, d); 1802 updateMLe(x ++ offsete, e); updateMLf(x ++ offsetf, f); updateMLg(x ++ offsetg, g); 1803 updateMLh(x ++ offseth, h); updateMLi(x ++ offseti, i); updateMLj(x ++ offsetj, j); 1804 updateMLk(x ++ offsetk, k); updateMLl(x ++ offsetl, l); updateMLm(x ++ offsetm, m); 1805 updateMLn(x ++ offsetn, n)) 1806 and updateC(x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n)) = 1807 (updateCa(x, a); updateCb(x ++ offsetb, b); updateCc(x ++ offsetc, c); updateCd(x ++ offsetd, d); 1808 updateCe(x ++ offsete, e); updateCf(x ++ offsetf, f); updateCg(x ++ offsetg, g); 1809 updateCh(x ++ offseth, h); updateCi(x ++ offseti, i); updateCj(x ++ offsetj, j); 1810 updateCk(x ++ offsetk, k); updateCl(x ++ offsetl, l); updateCm(x ++ offsetm, m); 1811 updateCn(x ++ offsetn, n)) 1812 in 1813 {load=load, store=store, updateML=updateML, updateC=updateC, 1814 ctype = LowLevel.cStruct[ctypea, ctypeb, ctypec, ctyped, ctypee, ctypef, ctypeg, ctypeh, ctypei, ctypej, 1815 ctypek, ctypel, ctypem, ctypen]} 1816 end 1817 1818 fun cStruct15(a: 'a conversion, b: 'b conversion, c: 'c conversion, d: 'd conversion, 1819 e: 'e conversion, f: 'f conversion, g: 'g conversion, h: 'h conversion, 1820 i: 'i conversion, j: 'j conversion, k: 'k conversion, l: 'l conversion, 1821 m: 'm conversion, n: 'n conversion, o: 'o conversion): 1822 ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k*'l*'m*'n*'o)conversion = 1823 let 1824 val {load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype = ctypea as {size=sizea, ...} } = a 1825 and {load=loadb, store=storeb, updateML=updateMLb, updateC=updateCb, ctype = ctypeb as {size=sizeb, align=alignb, ...} } = b 1826 and {load=loadc, store=storec, updateML=updateMLc, updateC=updateCc, ctype = ctypec as {size=sizec, align=alignc, ...} } = c 1827 and {load=loadd, store=stored, updateML=updateMLd, updateC=updateCd, ctype = ctyped as {size=sized, align=alignd, ...} } = d 1828 and {load=loade, store=storee, updateML=updateMLe, updateC=updateCe, ctype = ctypee as {size=sizee, align=aligne, ...} } = e 1829 and {load=loadf, store=storef, updateML=updateMLf, updateC=updateCf, ctype = ctypef as {size=sizef, align=alignf, ...} } = f 1830 and {load=loadg, store=storeg, updateML=updateMLg, updateC=updateCg, ctype = ctypeg as {size=sizeg, align=aligng, ...} } = g 1831 and {load=loadh, store=storeh, updateML=updateMLh, updateC=updateCh, ctype = ctypeh as {size=sizeh, align=alignh, ...} } = h 1832 and {load=loadi, store=storei, updateML=updateMLi, updateC=updateCi, ctype = ctypei as {size=sizei, align=aligni, ...} } = i 1833 and {load=loadj, store=storej, updateML=updateMLj, updateC=updateCj, ctype = ctypej as {size=sizej, align=alignj, ...} } = j 1834 and {load=loadk, store=storek, updateML=updateMLk, updateC=updateCk, ctype = ctypek as {size=sizek, align=alignk, ...} } = k 1835 and {load=loadl, store=storel, updateML=updateMLl, updateC=updateCl, ctype = ctypel as {size=sizel, align=alignl, ...} } = l 1836 and {load=loadm, store=storem, updateML=updateMLm, updateC=updateCm, ctype = ctypem as {size=sizem, align=alignm, ...} } = m 1837 and {load=loadn, store=storen, updateML=updateMLn, updateC=updateCn, ctype = ctypen as {size=sizen, align=alignn, ...} } = n 1838 and {load=loado, store=storeo, updateML=updateMLo, updateC=updateCo, ctype = ctypeo as {align=aligno, ...} } = o 1839 1840 val offsetb = alignUp(sizea, alignb) 1841 val offsetc = alignUp(offsetb + sizeb, alignc) 1842 val offsetd = alignUp(offsetc + sizec, alignd) 1843 val offsete = alignUp(offsetd + sized, aligne) 1844 val offsetf = alignUp(offsete + sizee, alignf) 1845 val offsetg = alignUp(offsetf + sizef, aligng) 1846 val offseth = alignUp(offsetg + sizeg, alignh) 1847 val offseti = alignUp(offseth + sizeh, aligni) 1848 val offsetj = alignUp(offseti + sizei, alignj) 1849 val offsetk = alignUp(offsetj + sizej, alignk) 1850 val offsetl = alignUp(offsetk + sizek, alignl) 1851 val offsetm = alignUp(offsetl + sizel, alignm) 1852 val offsetn = alignUp(offsetm + sizem, alignn) 1853 val offseto = alignUp(offsetn + sizen, aligno) 1854 1855 fun load s = 1856 (loada s, loadb(s ++ offsetb), loadc(s ++ offsetc), loadd(s ++ offsetd), 1857 loade(s ++ offsete), loadf(s ++ offsetf), loadg(s ++ offsetg), 1858 loadh(s ++ offseth), loadi(s ++ offseti), loadj(s ++ offsetj), 1859 loadk(s ++ offsetk), loadl(s ++ offsetl), loadm(s ++ offsetm), 1860 loadn(s ++ offsetn), loado(s ++ offseto)) 1861 and store (x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)) = 1862 let 1863 val freea = storea(x, a) and freeb = storeb(x ++ offsetb, b) and freec = storec(x ++ offsetc, c) 1864 and freed = stored(x ++ offsetd, d) and freee = storee(x ++ offsete, e) and freef = storef(x ++ offsetf, f) 1865 and freeg = storeg(x ++ offsetg, g) and freeh = storeh(x ++ offseth, h) and freei = storei(x ++ offseti, i) 1866 and freej = storej(x ++ offsetj, j) and freek = storek(x ++ offsetk, k) and freel = storel(x ++ offsetl, l) 1867 and freem = storem(x ++ offsetm, m) and freen = storen(x ++ offsetn, n) and freeo = storeo(x ++ offseto, o) 1868 in 1869 fn () => 1870 ( 1871 freea(); freeb(); freec(); freed(); freee(); freef(); freeg(); 1872 freeh(); freei(); freej(); freek(); freel(); freem(); 1873 freen(); freeo() 1874 ) 1875 end 1876 and updateML(x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)) = 1877 (updateMLa(x, a); updateMLb(x ++ offsetb, b); updateMLc(x ++ offsetc, c); updateMLd(x ++ offsetd, d); 1878 updateMLe(x ++ offsete, e); updateMLf(x ++ offsetf, f); updateMLg(x ++ offsetg, g); 1879 updateMLh(x ++ offseth, h); updateMLi(x ++ offseti, i); updateMLj(x ++ offsetj, j); 1880 updateMLk(x ++ offsetk, k); updateMLl(x ++ offsetl, l); updateMLm(x ++ offsetm, m); 1881 updateMLn(x ++ offsetn, n); updateMLo(x ++ offseto, o)) 1882 and updateC(x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)) = 1883 (updateCa(x, a); updateCb(x ++ offsetb, b); updateCc(x ++ offsetc, c); updateCd(x ++ offsetd, d); 1884 updateCe(x ++ offsete, e); updateCf(x ++ offsetf, f); updateCg(x ++ offsetg, g); 1885 updateCh(x ++ offseth, h); updateCi(x ++ offseti, i); updateCj(x ++ offsetj, j); 1886 updateCk(x ++ offsetk, k); updateCl(x ++ offsetl, l); updateCm(x ++ offsetm, m); 1887 updateCn(x ++ offsetn, n); updateCo(x ++ offseto, o)) 1888 in 1889 {load=load, store=store, updateML=updateML, updateC=updateC, 1890 ctype = LowLevel.cStruct[ctypea, ctypeb, ctypec, ctyped, ctypee, ctypef, ctypeg, ctypeh, ctypei, ctypej, 1891 ctypek, ctypel, ctypem, ctypen, ctypeo]} 1892 end 1893 1894 fun cStruct16(a: 'a conversion, b: 'b conversion, c: 'c conversion, d: 'd conversion, 1895 e: 'e conversion, f: 'f conversion, g: 'g conversion, h: 'h conversion, 1896 i: 'i conversion, j: 'j conversion, k: 'k conversion, l: 'l conversion, 1897 m: 'm conversion, n: 'n conversion, o: 'o conversion, p: 'p conversion): 1898 ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k*'l*'m*'n*'o*'p)conversion = 1899 let 1900 val {load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype = ctypea as {size=sizea, ...} } = a 1901 and {load=loadb, store=storeb, updateML=updateMLb, updateC=updateCb, ctype = ctypeb as {size=sizeb, align=alignb, ...} } = b 1902 and {load=loadc, store=storec, updateML=updateMLc, updateC=updateCc, ctype = ctypec as {size=sizec, align=alignc, ...} } = c 1903 and {load=loadd, store=stored, updateML=updateMLd, updateC=updateCd, ctype = ctyped as {size=sized, align=alignd, ...} } = d 1904 and {load=loade, store=storee, updateML=updateMLe, updateC=updateCe, ctype = ctypee as {size=sizee, align=aligne, ...} } = e 1905 and {load=loadf, store=storef, updateML=updateMLf, updateC=updateCf, ctype = ctypef as {size=sizef, align=alignf, ...} } = f 1906 and {load=loadg, store=storeg, updateML=updateMLg, updateC=updateCg, ctype = ctypeg as {size=sizeg, align=aligng, ...} } = g 1907 and {load=loadh, store=storeh, updateML=updateMLh, updateC=updateCh, ctype = ctypeh as {size=sizeh, align=alignh, ...} } = h 1908 and {load=loadi, store=storei, updateML=updateMLi, updateC=updateCi, ctype = ctypei as {size=sizei, align=aligni, ...} } = i 1909 and {load=loadj, store=storej, updateML=updateMLj, updateC=updateCj, ctype = ctypej as {size=sizej, align=alignj, ...} } = j 1910 and {load=loadk, store=storek, updateML=updateMLk, updateC=updateCk, ctype = ctypek as {size=sizek, align=alignk, ...} } = k 1911 and {load=loadl, store=storel, updateML=updateMLl, updateC=updateCl, ctype = ctypel as {size=sizel, align=alignl, ...} } = l 1912 and {load=loadm, store=storem, updateML=updateMLm, updateC=updateCm, ctype = ctypem as {size=sizem, align=alignm, ...} } = m 1913 and {load=loadn, store=storen, updateML=updateMLn, updateC=updateCn, ctype = ctypen as {size=sizen, align=alignn, ...} } = n 1914 and {load=loado, store=storeo, updateML=updateMLo, updateC=updateCo, ctype = ctypeo as {size=sizeo, align=aligno, ...} } = o 1915 and {load=loadp, store=storep, updateML=updateMLp, updateC=updateCp, ctype = ctypep as {align=alignp, ...} } = p 1916 1917 val offsetb = alignUp(sizea, alignb) 1918 val offsetc = alignUp(offsetb + sizeb, alignc) 1919 val offsetd = alignUp(offsetc + sizec, alignd) 1920 val offsete = alignUp(offsetd + sized, aligne) 1921 val offsetf = alignUp(offsete + sizee, alignf) 1922 val offsetg = alignUp(offsetf + sizef, aligng) 1923 val offseth = alignUp(offsetg + sizeg, alignh) 1924 val offseti = alignUp(offseth + sizeh, aligni) 1925 val offsetj = alignUp(offseti + sizei, alignj) 1926 val offsetk = alignUp(offsetj + sizej, alignk) 1927 val offsetl = alignUp(offsetk + sizek, alignl) 1928 val offsetm = alignUp(offsetl + sizel, alignm) 1929 val offsetn = alignUp(offsetm + sizem, alignn) 1930 val offseto = alignUp(offsetn + sizen, aligno) 1931 val offsetp = alignUp(offseto + sizeo, alignp) 1932 1933 fun load s = 1934 (loada s, loadb(s ++ offsetb), loadc(s ++ offsetc), loadd(s ++ offsetd), 1935 loade(s ++ offsete), loadf(s ++ offsetf), loadg(s ++ offsetg), 1936 loadh(s ++ offseth), loadi(s ++ offseti), loadj(s ++ offsetj), 1937 loadk(s ++ offsetk), loadl(s ++ offsetl), loadm(s ++ offsetm), 1938 loadn(s ++ offsetn), loado(s ++ offseto), loadp(s ++ offsetp)) 1939 and store (x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p)) = 1940 let 1941 val freea = storea(x, a) and freeb = storeb(x ++ offsetb, b) and freec = storec(x ++ offsetc, c) 1942 and freed = stored(x ++ offsetd, d) and freee = storee(x ++ offsete, e) and freef = storef(x ++ offsetf, f) 1943 and freeg = storeg(x ++ offsetg, g) and freeh = storeh(x ++ offseth, h) and freei = storei(x ++ offseti, i) 1944 and freej = storej(x ++ offsetj, j) and freek = storek(x ++ offsetk, k) and freel = storel(x ++ offsetl, l) 1945 and freem = storem(x ++ offsetm, m) and freen = storen(x ++ offsetn, n) and freeo = storeo(x ++ offseto, o) 1946 and freep = storep(x ++ offsetp, p) 1947 in 1948 fn () => 1949 ( 1950 freea(); freeb(); freec(); freed(); freee(); freef(); 1951 freeg(); freeh(); freei(); freej(); freek(); freel(); 1952 freem(); freen(); freeo(); freep() 1953 ) 1954 end 1955 and updateML(x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p)) = 1956 (updateMLa(x, a); updateMLb(x ++ offsetb, b); updateMLc(x ++ offsetc, c); updateMLd(x ++ offsetd, d); 1957 updateMLe(x ++ offsete, e); updateMLf(x ++ offsetf, f); updateMLg(x ++ offsetg, g); 1958 updateMLh(x ++ offseth, h); updateMLi(x ++ offseti, i); updateMLj(x ++ offsetj, j); 1959 updateMLk(x ++ offsetk, k); updateMLl(x ++ offsetl, l); updateMLm(x ++ offsetm, m); 1960 updateMLn(x ++ offsetn, n); updateMLo(x ++ offseto, o); updateMLp(x ++ offsetp, p)) 1961 and updateC(x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p)) = 1962 (updateCa(x, a); updateCb(x ++ offsetb, b); updateCc(x ++ offsetc, c); updateCd(x ++ offsetd, d); 1963 updateCe(x ++ offsete, e); updateCf(x ++ offsetf, f); updateCg(x ++ offsetg, g); 1964 updateCh(x ++ offseth, h); updateCi(x ++ offseti, i); updateCj(x ++ offsetj, j); 1965 updateCk(x ++ offsetk, k); updateCl(x ++ offsetl, l); updateCm(x ++ offsetm, m); 1966 updateCn(x ++ offsetn, n); updateCo(x ++ offseto, o); updateCp(x ++ offsetp, p)) 1967 in 1968 {load=load, store=store, updateML=updateML, updateC=updateC, 1969 ctype = LowLevel.cStruct[ctypea, ctypeb, ctypec, ctyped, ctypee, ctypef, ctypeg, ctypeh, ctypei, ctypej, 1970 ctypek, ctypel, ctypem, ctypen, ctypeo, ctypep]} 1971 end 1972 1973 fun cStruct17(a: 'a conversion, b: 'b conversion, c: 'c conversion, d: 'd conversion, 1974 e: 'e conversion, f: 'f conversion, g: 'g conversion, h: 'h conversion, 1975 i: 'i conversion, j: 'j conversion, k: 'k conversion, l: 'l conversion, 1976 m: 'm conversion, n: 'n conversion, o: 'o conversion, p: 'p conversion, 1977 q: 'q conversion): 1978 ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k*'l*'m*'n*'o*'p*'q)conversion = 1979 let 1980 val {load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype = ctypea as {size=sizea, ...} } = a 1981 and {load=loadb, store=storeb, updateML=updateMLb, updateC=updateCb, ctype = ctypeb as {size=sizeb, align=alignb, ...} } = b 1982 and {load=loadc, store=storec, updateML=updateMLc, updateC=updateCc, ctype = ctypec as {size=sizec, align=alignc, ...} } = c 1983 and {load=loadd, store=stored, updateML=updateMLd, updateC=updateCd, ctype = ctyped as {size=sized, align=alignd, ...} } = d 1984 and {load=loade, store=storee, updateML=updateMLe, updateC=updateCe, ctype = ctypee as {size=sizee, align=aligne, ...} } = e 1985 and {load=loadf, store=storef, updateML=updateMLf, updateC=updateCf, ctype = ctypef as {size=sizef, align=alignf, ...} } = f 1986 and {load=loadg, store=storeg, updateML=updateMLg, updateC=updateCg, ctype = ctypeg as {size=sizeg, align=aligng, ...} } = g 1987 and {load=loadh, store=storeh, updateML=updateMLh, updateC=updateCh, ctype = ctypeh as {size=sizeh, align=alignh, ...} } = h 1988 and {load=loadi, store=storei, updateML=updateMLi, updateC=updateCi, ctype = ctypei as {size=sizei, align=aligni, ...} } = i 1989 and {load=loadj, store=storej, updateML=updateMLj, updateC=updateCj, ctype = ctypej as {size=sizej, align=alignj, ...} } = j 1990 and {load=loadk, store=storek, updateML=updateMLk, updateC=updateCk, ctype = ctypek as {size=sizek, align=alignk, ...} } = k 1991 and {load=loadl, store=storel, updateML=updateMLl, updateC=updateCl, ctype = ctypel as {size=sizel, align=alignl, ...} } = l 1992 and {load=loadm, store=storem, updateML=updateMLm, updateC=updateCm, ctype = ctypem as {size=sizem, align=alignm, ...} } = m 1993 and {load=loadn, store=storen, updateML=updateMLn, updateC=updateCn, ctype = ctypen as {size=sizen, align=alignn, ...} } = n 1994 and {load=loado, store=storeo, updateML=updateMLo, updateC=updateCo, ctype = ctypeo as {size=sizeo, align=aligno, ...} } = o 1995 and {load=loadp, store=storep, updateML=updateMLp, updateC=updateCp, ctype = ctypep as {size=sizep, align=alignp, ...} } = p 1996 and {load=loadq, store=storeq, updateML=updateMLq, updateC=updateCq, ctype = ctypeq as {align=alignq, ...} } = q 1997 1998 val offsetb = alignUp(sizea, alignb) 1999 val offsetc = alignUp(offsetb + sizeb, alignc) 2000 val offsetd = alignUp(offsetc + sizec, alignd) 2001 val offsete = alignUp(offsetd + sized, aligne) 2002 val offsetf = alignUp(offsete + sizee, alignf) 2003 val offsetg = alignUp(offsetf + sizef, aligng) 2004 val offseth = alignUp(offsetg + sizeg, alignh) 2005 val offseti = alignUp(offseth + sizeh, aligni) 2006 val offsetj = alignUp(offseti + sizei, alignj) 2007 val offsetk = alignUp(offsetj + sizej, alignk) 2008 val offsetl = alignUp(offsetk + sizek, alignl) 2009 val offsetm = alignUp(offsetl + sizel, alignm) 2010 val offsetn = alignUp(offsetm + sizem, alignn) 2011 val offseto = alignUp(offsetn + sizen, aligno) 2012 val offsetp = alignUp(offseto + sizeo, alignp) 2013 val offsetq = alignUp(offsetp + sizep, alignq) 2014 2015 fun load s = 2016 (loada s, loadb(s ++ offsetb), loadc(s ++ offsetc), loadd(s ++ offsetd), 2017 loade(s ++ offsete), loadf(s ++ offsetf), loadg(s ++ offsetg), 2018 loadh(s ++ offseth), loadi(s ++ offseti), loadj(s ++ offsetj), 2019 loadk(s ++ offsetk), loadl(s ++ offsetl), loadm(s ++ offsetm), 2020 loadn(s ++ offsetn), loado(s ++ offseto), loadp(s ++ offsetp), 2021 loadq(s ++ offsetq)) 2022 and store (x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q)) = 2023 let 2024 val freea = storea(x, a) and freeb = storeb(x ++ offsetb, b) and freec = storec(x ++ offsetc, c) 2025 and freed = stored(x ++ offsetd, d) and freee = storee(x ++ offsete, e) and freef = storef(x ++ offsetf, f) 2026 and freeg = storeg(x ++ offsetg, g) and freeh = storeh(x ++ offseth, h) and freei = storei(x ++ offseti, i) 2027 and freej = storej(x ++ offsetj, j) and freek = storek(x ++ offsetk, k) and freel = storel(x ++ offsetl, l) 2028 and freem = storem(x ++ offsetm, m) and freen = storen(x ++ offsetn, n) and freeo = storeo(x ++ offseto, o) 2029 and freep = storep(x ++ offsetp, p) and freeq = storeq(x ++ offsetq, q) 2030 in 2031 fn () => 2032 ( 2033 freea(); freeb(); freec(); freed(); freee(); freef(); freeg(); 2034 freeh(); freei(); freej(); freek(); freel(); freem(); 2035 freen(); freeo(); freep(); freeq() 2036 ) 2037 end 2038 and updateML(x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q)) = 2039 (updateMLa(x, a); updateMLb(x ++ offsetb, b); updateMLc(x ++ offsetc, c); updateMLd(x ++ offsetd, d); 2040 updateMLe(x ++ offsete, e); updateMLf(x ++ offsetf, f); updateMLg(x ++ offsetg, g); 2041 updateMLh(x ++ offseth, h); updateMLi(x ++ offseti, i); updateMLj(x ++ offsetj, j); 2042 updateMLk(x ++ offsetk, k); updateMLl(x ++ offsetl, l); updateMLm(x ++ offsetm, m); 2043 updateMLn(x ++ offsetn, n); updateMLo(x ++ offseto, o); updateMLp(x ++ offsetp, p); 2044 updateMLq(x ++ offsetq, q)) 2045 and updateC(x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q)) = 2046 (updateCa(x, a); updateCb(x ++ offsetb, b); updateCc(x ++ offsetc, c); updateCd(x ++ offsetd, d); 2047 updateCe(x ++ offsete, e); updateCf(x ++ offsetf, f); updateCg(x ++ offsetg, g); 2048 updateCh(x ++ offseth, h); updateCi(x ++ offseti, i); updateCj(x ++ offsetj, j); 2049 updateCk(x ++ offsetk, k); updateCl(x ++ offsetl, l); updateCm(x ++ offsetm, m); 2050 updateCn(x ++ offsetn, n); updateCo(x ++ offseto, o); updateCp(x ++ offsetp, p); 2051 updateCq(x ++ offsetq, q)) 2052 in 2053 {load=load, store=store, updateML=updateML, updateC=updateC, 2054 ctype = LowLevel.cStruct[ctypea, ctypeb, ctypec, ctyped, ctypee, ctypef, ctypeg, ctypeh, ctypei, ctypej, 2055 ctypek, ctypel, ctypem, ctypen, ctypeo, ctypep, ctypeq]} 2056 end 2057 2058 fun cStruct18(a: 'a conversion, b: 'b conversion, c: 'c conversion, d: 'd conversion, 2059 e: 'e conversion, f: 'f conversion, g: 'g conversion, h: 'h conversion, 2060 i: 'i conversion, j: 'j conversion, k: 'k conversion, l: 'l conversion, 2061 m: 'm conversion, n: 'n conversion, o: 'o conversion, p: 'p conversion, 2062 q: 'q conversion, r: 'r conversion): 2063 ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k*'l*'m*'n*'o*'p*'q*'r)conversion = 2064 let 2065 val {load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype = ctypea as {size=sizea, ...} } = a 2066 and {load=loadb, store=storeb, updateML=updateMLb, updateC=updateCb, ctype = ctypeb as {size=sizeb, align=alignb, ...} } = b 2067 and {load=loadc, store=storec, updateML=updateMLc, updateC=updateCc, ctype = ctypec as {size=sizec, align=alignc, ...} } = c 2068 and {load=loadd, store=stored, updateML=updateMLd, updateC=updateCd, ctype = ctyped as {size=sized, align=alignd, ...} } = d 2069 and {load=loade, store=storee, updateML=updateMLe, updateC=updateCe, ctype = ctypee as {size=sizee, align=aligne, ...} } = e 2070 and {load=loadf, store=storef, updateML=updateMLf, updateC=updateCf, ctype = ctypef as {size=sizef, align=alignf, ...} } = f 2071 and {load=loadg, store=storeg, updateML=updateMLg, updateC=updateCg, ctype = ctypeg as {size=sizeg, align=aligng, ...} } = g 2072 and {load=loadh, store=storeh, updateML=updateMLh, updateC=updateCh, ctype = ctypeh as {size=sizeh, align=alignh, ...} } = h 2073 and {load=loadi, store=storei, updateML=updateMLi, updateC=updateCi, ctype = ctypei as {size=sizei, align=aligni, ...} } = i 2074 and {load=loadj, store=storej, updateML=updateMLj, updateC=updateCj, ctype = ctypej as {size=sizej, align=alignj, ...} } = j 2075 and {load=loadk, store=storek, updateML=updateMLk, updateC=updateCk, ctype = ctypek as {size=sizek, align=alignk, ...} } = k 2076 and {load=loadl, store=storel, updateML=updateMLl, updateC=updateCl, ctype = ctypel as {size=sizel, align=alignl, ...} } = l 2077 and {load=loadm, store=storem, updateML=updateMLm, updateC=updateCm, ctype = ctypem as {size=sizem, align=alignm, ...} } = m 2078 and {load=loadn, store=storen, updateML=updateMLn, updateC=updateCn, ctype = ctypen as {size=sizen, align=alignn, ...} } = n 2079 and {load=loado, store=storeo, updateML=updateMLo, updateC=updateCo, ctype = ctypeo as {size=sizeo, align=aligno, ...} } = o 2080 and {load=loadp, store=storep, updateML=updateMLp, updateC=updateCp, ctype = ctypep as {size=sizep, align=alignp, ...} } = p 2081 and {load=loadq, store=storeq, updateML=updateMLq, updateC=updateCq, ctype = ctypeq as {size=sizeq, align=alignq, ...} } = q 2082 and {load=loadr, store=storer, updateML=updateMLr, updateC=updateCr, ctype = ctyper as {align=alignr, ...} } = r 2083 2084 val offsetb = alignUp(sizea, alignb) 2085 val offsetc = alignUp(offsetb + sizeb, alignc) 2086 val offsetd = alignUp(offsetc + sizec, alignd) 2087 val offsete = alignUp(offsetd + sized, aligne) 2088 val offsetf = alignUp(offsete + sizee, alignf) 2089 val offsetg = alignUp(offsetf + sizef, aligng) 2090 val offseth = alignUp(offsetg + sizeg, alignh) 2091 val offseti = alignUp(offseth + sizeh, aligni) 2092 val offsetj = alignUp(offseti + sizei, alignj) 2093 val offsetk = alignUp(offsetj + sizej, alignk) 2094 val offsetl = alignUp(offsetk + sizek, alignl) 2095 val offsetm = alignUp(offsetl + sizel, alignm) 2096 val offsetn = alignUp(offsetm + sizem, alignn) 2097 val offseto = alignUp(offsetn + sizen, aligno) 2098 val offsetp = alignUp(offseto + sizeo, alignp) 2099 val offsetq = alignUp(offsetp + sizep, alignq) 2100 val offsetr = alignUp(offsetq + sizeq, alignr) 2101 2102 fun load s = 2103 (loada s, loadb(s ++ offsetb), loadc(s ++ offsetc), loadd(s ++ offsetd), 2104 loade(s ++ offsete), loadf(s ++ offsetf), loadg(s ++ offsetg), 2105 loadh(s ++ offseth), loadi(s ++ offseti), loadj(s ++ offsetj), 2106 loadk(s ++ offsetk), loadl(s ++ offsetl), loadm(s ++ offsetm), 2107 loadn(s ++ offsetn), loado(s ++ offseto), loadp(s ++ offsetp), 2108 loadq(s ++ offsetq), loadr(s ++ offsetr)) 2109 and store (x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r)) = 2110 let 2111 val freea = storea(x, a) and freeb = storeb(x ++ offsetb, b) and freec = storec(x ++ offsetc, c) 2112 and freed = stored(x ++ offsetd, d) and freee = storee(x ++ offsete, e) and freef = storef(x ++ offsetf, f) 2113 and freeg = storeg(x ++ offsetg, g) and freeh = storeh(x ++ offseth, h) and freei = storei(x ++ offseti, i) 2114 and freej = storej(x ++ offsetj, j) and freek = storek(x ++ offsetk, k) and freel = storel(x ++ offsetl, l) 2115 and freem = storem(x ++ offsetm, m) and freen = storen(x ++ offsetn, n) and freeo = storeo(x ++ offseto, o) 2116 and freep = storep(x ++ offsetp, p) and freeq = storeq(x ++ offsetq, q) and freer = storer(x ++ offsetr, r) 2117 in 2118 fn () => 2119 ( 2120 freea(); freeb(); freec(); freed(); freee(); freef(); freeg(); 2121 freeh(); freei(); freej(); freek(); freel(); freem(); 2122 freen(); freeo(); freep(); freeq(); freer() 2123 ) 2124 end 2125 and updateML(x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r)) = 2126 (updateMLa(x, a); updateMLb(x ++ offsetb, b); updateMLc(x ++ offsetc, c); updateMLd(x ++ offsetd, d); 2127 updateMLe(x ++ offsete, e); updateMLf(x ++ offsetf, f); updateMLg(x ++ offsetg, g); 2128 updateMLh(x ++ offseth, h); updateMLi(x ++ offseti, i); updateMLj(x ++ offsetj, j); 2129 updateMLk(x ++ offsetk, k); updateMLl(x ++ offsetl, l); updateMLm(x ++ offsetm, m); 2130 updateMLn(x ++ offsetn, n); updateMLo(x ++ offseto, o); updateMLp(x ++ offsetp, p); 2131 updateMLq(x ++ offsetq, q); updateMLr(x ++ offsetr, r)) 2132 and updateC(x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r)) = 2133 (updateCa(x, a); updateCb(x ++ offsetb, b); updateCc(x ++ offsetc, c); updateCd(x ++ offsetd, d); 2134 updateCe(x ++ offsete, e); updateCf(x ++ offsetf, f); updateCg(x ++ offsetg, g); 2135 updateCh(x ++ offseth, h); updateCi(x ++ offseti, i); updateCj(x ++ offsetj, j); 2136 updateCk(x ++ offsetk, k); updateCl(x ++ offsetl, l); updateCm(x ++ offsetm, m); 2137 updateCn(x ++ offsetn, n); updateCo(x ++ offseto, o); updateCp(x ++ offsetp, p); 2138 updateCq(x ++ offsetq, q); updateCr(x ++ offsetr, r)) 2139 in 2140 {load=load, store=store, updateML=updateML, updateC=updateC, 2141 ctype = LowLevel.cStruct[ctypea, ctypeb, ctypec, ctyped, ctypee, ctypef, ctypeg, ctypeh, ctypei, ctypej, 2142 ctypek, ctypel, ctypem, ctypen, ctypeo, ctypep, ctypeq, ctyper]} 2143 end 2144 2145 fun cStruct19(a: 'a conversion, b: 'b conversion, c: 'c conversion, d: 'd conversion, 2146 e: 'e conversion, f: 'f conversion, g: 'g conversion, h: 'h conversion, 2147 i: 'i conversion, j: 'j conversion, k: 'k conversion, l: 'l conversion, 2148 m: 'm conversion, n: 'n conversion, o: 'o conversion, p: 'p conversion, 2149 q: 'q conversion, r: 'r conversion, s: 's conversion): 2150 ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k*'l*'m*'n*'o*'p*'q*'r*'s)conversion = 2151 let 2152 val {load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype = ctypea as {size=sizea, ...} } = a 2153 and {load=loadb, store=storeb, updateML=updateMLb, updateC=updateCb, ctype = ctypeb as {size=sizeb, align=alignb, ...} } = b 2154 and {load=loadc, store=storec, updateML=updateMLc, updateC=updateCc, ctype = ctypec as {size=sizec, align=alignc, ...} } = c 2155 and {load=loadd, store=stored, updateML=updateMLd, updateC=updateCd, ctype = ctyped as {size=sized, align=alignd, ...} } = d 2156 and {load=loade, store=storee, updateML=updateMLe, updateC=updateCe, ctype = ctypee as {size=sizee, align=aligne, ...} } = e 2157 and {load=loadf, store=storef, updateML=updateMLf, updateC=updateCf, ctype = ctypef as {size=sizef, align=alignf, ...} } = f 2158 and {load=loadg, store=storeg, updateML=updateMLg, updateC=updateCg, ctype = ctypeg as {size=sizeg, align=aligng, ...} } = g 2159 and {load=loadh, store=storeh, updateML=updateMLh, updateC=updateCh, ctype = ctypeh as {size=sizeh, align=alignh, ...} } = h 2160 and {load=loadi, store=storei, updateML=updateMLi, updateC=updateCi, ctype = ctypei as {size=sizei, align=aligni, ...} } = i 2161 and {load=loadj, store=storej, updateML=updateMLj, updateC=updateCj, ctype = ctypej as {size=sizej, align=alignj, ...} } = j 2162 and {load=loadk, store=storek, updateML=updateMLk, updateC=updateCk, ctype = ctypek as {size=sizek, align=alignk, ...} } = k 2163 and {load=loadl, store=storel, updateML=updateMLl, updateC=updateCl, ctype = ctypel as {size=sizel, align=alignl, ...} } = l 2164 and {load=loadm, store=storem, updateML=updateMLm, updateC=updateCm, ctype = ctypem as {size=sizem, align=alignm, ...} } = m 2165 and {load=loadn, store=storen, updateML=updateMLn, updateC=updateCn, ctype = ctypen as {size=sizen, align=alignn, ...} } = n 2166 and {load=loado, store=storeo, updateML=updateMLo, updateC=updateCo, ctype = ctypeo as {size=sizeo, align=aligno, ...} } = o 2167 and {load=loadp, store=storep, updateML=updateMLp, updateC=updateCp, ctype = ctypep as {size=sizep, align=alignp, ...} } = p 2168 and {load=loadq, store=storeq, updateML=updateMLq, updateC=updateCq, ctype = ctypeq as {size=sizeq, align=alignq, ...} } = q 2169 and {load=loadr, store=storer, updateML=updateMLr, updateC=updateCr, ctype = ctyper as {size=sizer, align=alignr, ...} } = r 2170 and {load=loads, store=stores, updateML=updateMLs, updateC=updateCs, ctype = ctypes as {align=aligns, ...} } = s 2171 2172 val offsetb = alignUp(sizea, alignb) 2173 val offsetc = alignUp(offsetb + sizeb, alignc) 2174 val offsetd = alignUp(offsetc + sizec, alignd) 2175 val offsete = alignUp(offsetd + sized, aligne) 2176 val offsetf = alignUp(offsete + sizee, alignf) 2177 val offsetg = alignUp(offsetf + sizef, aligng) 2178 val offseth = alignUp(offsetg + sizeg, alignh) 2179 val offseti = alignUp(offseth + sizeh, aligni) 2180 val offsetj = alignUp(offseti + sizei, alignj) 2181 val offsetk = alignUp(offsetj + sizej, alignk) 2182 val offsetl = alignUp(offsetk + sizek, alignl) 2183 val offsetm = alignUp(offsetl + sizel, alignm) 2184 val offsetn = alignUp(offsetm + sizem, alignn) 2185 val offseto = alignUp(offsetn + sizen, aligno) 2186 val offsetp = alignUp(offseto + sizeo, alignp) 2187 val offsetq = alignUp(offsetp + sizep, alignq) 2188 val offsetr = alignUp(offsetq + sizeq, alignr) 2189 val offsets = alignUp(offsetr + sizer, aligns) 2190 2191 fun load s = 2192 (loada s, loadb(s ++ offsetb), loadc(s ++ offsetc), loadd(s ++ offsetd), 2193 loade(s ++ offsete), loadf(s ++ offsetf), loadg(s ++ offsetg), 2194 loadh(s ++ offseth), loadi(s ++ offseti), loadj(s ++ offsetj), 2195 loadk(s ++ offsetk), loadl(s ++ offsetl), loadm(s ++ offsetm), 2196 loadn(s ++ offsetn), loado(s ++ offseto), loadp(s ++ offsetp), 2197 loadq(s ++ offsetq), loadr(s ++ offsetr), loads(s ++ offsets)) 2198 and store (x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s)) = 2199 let 2200 val freea = storea(x, a) and freeb = storeb(x ++ offsetb, b) and freec = storec(x ++ offsetc, c) 2201 and freed = stored(x ++ offsetd, d) and freee = storee(x ++ offsete, e) and freef = storef(x ++ offsetf, f) 2202 and freeg = storeg(x ++ offsetg, g) and freeh = storeh(x ++ offseth, h) and freei = storei(x ++ offseti, i) 2203 and freej = storej(x ++ offsetj, j) and freek = storek(x ++ offsetk, k) and freel = storel(x ++ offsetl, l) 2204 and freem = storem(x ++ offsetm, m) and freen = storen(x ++ offsetn, n) and freeo = storeo(x ++ offseto, o) 2205 and freep = storep(x ++ offsetp, p) and freeq = storeq(x ++ offsetq, q) and freer = storer(x ++ offsetr, r) 2206 and frees = stores(x ++ offsets, s) 2207 in 2208 fn () => 2209 ( 2210 freea(); freeb(); freec(); freed(); freee(); freef(); freeg(); 2211 freeh(); freei(); freej(); freek(); freel(); freem(); 2212 freen(); freeo(); freep(); freeq(); freer(); frees() 2213 ) 2214 end 2215 and updateML(x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s)) = 2216 (updateMLa(x, a); updateMLb(x ++ offsetb, b); updateMLc(x ++ offsetc, c); updateMLd(x ++ offsetd, d); 2217 updateMLe(x ++ offsete, e); updateMLf(x ++ offsetf, f); updateMLg(x ++ offsetg, g); 2218 updateMLh(x ++ offseth, h); updateMLi(x ++ offseti, i); updateMLj(x ++ offsetj, j); 2219 updateMLk(x ++ offsetk, k); updateMLl(x ++ offsetl, l); updateMLm(x ++ offsetm, m); 2220 updateMLn(x ++ offsetn, n); updateMLo(x ++ offseto, o); updateMLp(x ++ offsetp, p); 2221 updateMLq(x ++ offsetq, q); updateMLr(x ++ offsetr, r); updateMLs(x ++ offsets, s)) 2222 and updateC(x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s)) = 2223 (updateCa(x, a); updateCb(x ++ offsetb, b); updateCc(x ++ offsetc, c); updateCd(x ++ offsetd, d); 2224 updateCe(x ++ offsete, e); updateCf(x ++ offsetf, f); updateCg(x ++ offsetg, g); 2225 updateCh(x ++ offseth, h); updateCi(x ++ offseti, i); updateCj(x ++ offsetj, j); 2226 updateCk(x ++ offsetk, k); updateCl(x ++ offsetl, l); updateCm(x ++ offsetm, m); 2227 updateCn(x ++ offsetn, n); updateCo(x ++ offseto, o); updateCp(x ++ offsetp, p); 2228 updateCq(x ++ offsetq, q); updateCr(x ++ offsetr, r); updateCs(x ++ offsets, s)) 2229 in 2230 {load=load, store=store, updateML=updateML, updateC=updateC, 2231 ctype = LowLevel.cStruct[ctypea, ctypeb, ctypec, ctyped, ctypee, ctypef, ctypeg, ctypeh, ctypei, ctypej, 2232 ctypek, ctypel, ctypem, ctypen, ctypeo, ctypep, ctypeq, ctyper, ctypes]} 2233 end 2234 2235 fun cStruct20(a: 'a conversion, b: 'b conversion, c: 'c conversion, d: 'd conversion, 2236 e: 'e conversion, f: 'f conversion, g: 'g conversion, h: 'h conversion, 2237 i: 'i conversion, j: 'j conversion, k: 'k conversion, l: 'l conversion, 2238 m: 'm conversion, n: 'n conversion, o: 'o conversion, p: 'p conversion, 2239 q: 'q conversion, r: 'r conversion, s: 's conversion, t: 't conversion): 2240 ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k*'l*'m*'n*'o*'p*'q*'r*'s*'t)conversion = 2241 let 2242 val {load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype = ctypea as {size=sizea, ...} } = a 2243 and {load=loadb, store=storeb, updateML=updateMLb, updateC=updateCb, ctype = ctypeb as {size=sizeb, align=alignb, ...} } = b 2244 and {load=loadc, store=storec, updateML=updateMLc, updateC=updateCc, ctype = ctypec as {size=sizec, align=alignc, ...} } = c 2245 and {load=loadd, store=stored, updateML=updateMLd, updateC=updateCd, ctype = ctyped as {size=sized, align=alignd, ...} } = d 2246 and {load=loade, store=storee, updateML=updateMLe, updateC=updateCe, ctype = ctypee as {size=sizee, align=aligne, ...} } = e 2247 and {load=loadf, store=storef, updateML=updateMLf, updateC=updateCf, ctype = ctypef as {size=sizef, align=alignf, ...} } = f 2248 and {load=loadg, store=storeg, updateML=updateMLg, updateC=updateCg, ctype = ctypeg as {size=sizeg, align=aligng, ...} } = g 2249 and {load=loadh, store=storeh, updateML=updateMLh, updateC=updateCh, ctype = ctypeh as {size=sizeh, align=alignh, ...} } = h 2250 and {load=loadi, store=storei, updateML=updateMLi, updateC=updateCi, ctype = ctypei as {size=sizei, align=aligni, ...} } = i 2251 and {load=loadj, store=storej, updateML=updateMLj, updateC=updateCj, ctype = ctypej as {size=sizej, align=alignj, ...} } = j 2252 and {load=loadk, store=storek, updateML=updateMLk, updateC=updateCk, ctype = ctypek as {size=sizek, align=alignk, ...} } = k 2253 and {load=loadl, store=storel, updateML=updateMLl, updateC=updateCl, ctype = ctypel as {size=sizel, align=alignl, ...} } = l 2254 and {load=loadm, store=storem, updateML=updateMLm, updateC=updateCm, ctype = ctypem as {size=sizem, align=alignm, ...} } = m 2255 and {load=loadn, store=storen, updateML=updateMLn, updateC=updateCn, ctype = ctypen as {size=sizen, align=alignn, ...} } = n 2256 and {load=loado, store=storeo, updateML=updateMLo, updateC=updateCo, ctype = ctypeo as {size=sizeo, align=aligno, ...} } = o 2257 and {load=loadp, store=storep, updateML=updateMLp, updateC=updateCp, ctype = ctypep as {size=sizep, align=alignp, ...} } = p 2258 and {load=loadq, store=storeq, updateML=updateMLq, updateC=updateCq, ctype = ctypeq as {size=sizeq, align=alignq, ...} } = q 2259 and {load=loadr, store=storer, updateML=updateMLr, updateC=updateCr, ctype = ctyper as {size=sizer, align=alignr, ...} } = r 2260 and {load=loads, store=stores, updateML=updateMLs, updateC=updateCs, ctype = ctypes as {size=sizes, align=aligns, ...} } = s 2261 and {load=loadt, store=storet, updateML=updateMLt, updateC=updateCt, ctype = ctypet as {align=alignt, ...} } = t 2262 2263 val offsetb = alignUp(sizea, alignb) 2264 val offsetc = alignUp(offsetb + sizeb, alignc) 2265 val offsetd = alignUp(offsetc + sizec, alignd) 2266 val offsete = alignUp(offsetd + sized, aligne) 2267 val offsetf = alignUp(offsete + sizee, alignf) 2268 val offsetg = alignUp(offsetf + sizef, aligng) 2269 val offseth = alignUp(offsetg + sizeg, alignh) 2270 val offseti = alignUp(offseth + sizeh, aligni) 2271 val offsetj = alignUp(offseti + sizei, alignj) 2272 val offsetk = alignUp(offsetj + sizej, alignk) 2273 val offsetl = alignUp(offsetk + sizek, alignl) 2274 val offsetm = alignUp(offsetl + sizel, alignm) 2275 val offsetn = alignUp(offsetm + sizem, alignn) 2276 val offseto = alignUp(offsetn + sizen, aligno) 2277 val offsetp = alignUp(offseto + sizeo, alignp) 2278 val offsetq = alignUp(offsetp + sizep, alignq) 2279 val offsetr = alignUp(offsetq + sizeq, alignr) 2280 val offsets = alignUp(offsetr + sizer, aligns) 2281 val offsett = alignUp(offsets + sizes, alignt) 2282 2283 fun load s = 2284 (loada s, loadb(s ++ offsetb), loadc(s ++ offsetc), loadd(s ++ offsetd), 2285 loade(s ++ offsete), loadf(s ++ offsetf), loadg(s ++ offsetg), 2286 loadh(s ++ offseth), loadi(s ++ offseti), loadj(s ++ offsetj), 2287 loadk(s ++ offsetk), loadl(s ++ offsetl), loadm(s ++ offsetm), 2288 loadn(s ++ offsetn), loado(s ++ offseto), loadp(s ++ offsetp), 2289 loadq(s ++ offsetq), loadr(s ++ offsetr), loads(s ++ offsets), loadt(s ++ offsett)) 2290 and store (x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t)) = 2291 let 2292 val freea = storea(x, a) and freeb = storeb(x ++ offsetb, b) and freec = storec(x ++ offsetc, c) 2293 and freed = stored(x ++ offsetd, d) and freee = storee(x ++ offsete, e) and freef = storef(x ++ offsetf, f) 2294 and freeg = storeg(x ++ offsetg, g) and freeh = storeh(x ++ offseth, h) and freei = storei(x ++ offseti, i) 2295 and freej = storej(x ++ offsetj, j) and freek = storek(x ++ offsetk, k) and freel = storel(x ++ offsetl, l) 2296 and freem = storem(x ++ offsetm, m) and freen = storen(x ++ offsetn, n) and freeo = storeo(x ++ offseto, o) 2297 and freep = storep(x ++ offsetp, p) and freeq = storeq(x ++ offsetq, q) and freer = storer(x ++ offsetr, r) 2298 and frees = stores(x ++ offsets, s) and freet = storet(x ++ offsett, t) 2299 in 2300 fn () => 2301 ( 2302 freea(); freeb(); freec(); freed(); freee(); freef(); freeg(); 2303 freeh(); freei(); freej(); freek(); freel(); freem(); 2304 freen(); freeo(); freep(); freeq(); freer(); frees(); freet() 2305 ) 2306 end 2307 and updateML(x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t)) = 2308 (updateMLa(x, a); updateMLb(x ++ offsetb, b); updateMLc(x ++ offsetc, c); updateMLd(x ++ offsetd, d); 2309 updateMLe(x ++ offsete, e); updateMLf(x ++ offsetf, f); updateMLg(x ++ offsetg, g); 2310 updateMLh(x ++ offseth, h); updateMLi(x ++ offseti, i); updateMLj(x ++ offsetj, j); 2311 updateMLk(x ++ offsetk, k); updateMLl(x ++ offsetl, l); updateMLm(x ++ offsetm, m); 2312 updateMLn(x ++ offsetn, n); updateMLo(x ++ offseto, o); updateMLp(x ++ offsetp, p); 2313 updateMLq(x ++ offsetq, q); updateMLr(x ++ offsetr, r); updateMLs(x ++ offsets, s); updateMLt(x ++ offsett, t)) 2314 and updateC(x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t)) = 2315 (updateCa(x, a); updateCb(x ++ offsetb, b); updateCc(x ++ offsetc, c); updateCd(x ++ offsetd, d); 2316 updateCe(x ++ offsete, e); updateCf(x ++ offsetf, f); updateCg(x ++ offsetg, g); 2317 updateCh(x ++ offseth, h); updateCi(x ++ offseti, i); updateCj(x ++ offsetj, j); 2318 updateCk(x ++ offsetk, k); updateCl(x ++ offsetl, l); updateCm(x ++ offsetm, m); 2319 updateCn(x ++ offsetn, n); updateCo(x ++ offseto, o); updateCp(x ++ offsetp, p); 2320 updateCq(x ++ offsetq, q); updateCr(x ++ offsetr, r); updateCs(x ++ offsets, s); updateCt(x ++ offsett, t)) 2321 in 2322 {load=load, store=store, updateML=updateML, updateC=updateC, 2323 ctype = LowLevel.cStruct[ctypea, ctypeb, ctypec, ctyped, ctypee, ctypef, ctypeg, ctypeh, ctypei, ctypej, 2324 ctypek, ctypel, ctypem, ctypen, ctypeo, ctypep, ctypeq, ctyper, ctypes, ctypet]} 2325 end 2326 2327 (* Conversion for call-by-reference. *) 2328 local 2329 open Memory LowLevel 2330 in 2331 fun cStar({load=loada, store=storea, ctype=ctypea, ...}: 'a conversion): 'a ref conversion = 2332 let 2333 fun store(m, ref s) = 2334 let 2335 (* When we pass a ref X into a cStar cX function we need to 2336 allocate a memory cell big enough for a cX value. Then 2337 we copy the current value of the ML into this. We set 2338 the argument, a pointer, to the address of the cell. *) 2339 val mem = malloc(#size ctypea) 2340 val () = setAddress(m, 0w0, mem) 2341 val freea = storea(mem, s) 2342 in 2343 fn () => (free mem; freea()) 2344 end 2345 2346 (* Called to update the ML value when the C . *) 2347 fun updateML(m, s) = s := loada(getAddress(m, 0w0)) 2348 2349 (* Used when an ML callback receives a cStar argument. *) 2350 fun load s = ref(loada(getAddress(s, 0w0))) 2351 2352 (* Used when a callback has returned to update the C value. 2353 If storea allocates then there's nothing we can do. *) 2354 fun updateC(m, ref s) = ignore(storea(getAddress(m, 0w0), s)) 2355 in 2356 {load=load, store=store, updateML=updateML, updateC=updateC, ctype = cTypePointer} 2357 end 2358 2359 (* Similar to cStar but without the need to update the result. *) 2360 fun cConstStar({load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype=ctypea}: 'a conversion): 'a conversion = 2361 let 2362 fun load s = loada(getAddress(s, 0w0)) 2363 2364 fun store(m, s) = 2365 let 2366 val mem = malloc(#size ctypea) 2367 val () = setAddress(m, 0w0, mem) 2368 val freea = storea(mem, s) 2369 in 2370 fn () => (free mem; freea()) 2371 end 2372 2373 (* Do we have to do anything here? Could we pass a const pointer 2374 to a structure with variable fields? *) 2375 fun updateML(m, s) = updateMLa(getAddress(m, 0w0), s) 2376 and updateC(m, s) = updateCa(getAddress(m, 0w0), s) 2377 in 2378 {load=load, store=store, updateML=updateML, updateC=updateC, ctype = cTypePointer} 2379 end 2380 2381 (* Fixed size vector. It is treated as a struct and passed by value or embedded in a structure. *) 2382 fun cVectorFixedSize(n, 2383 {load=loadEl, store=storeEl, updateML=updateMLel, updateC=updateCel, 2384 ctype={size=sizeEl, align=alignEl, ffiType=ffiTypeEl}, ...}: 'a conversion) 2385 : 'a vector conversion = 2386 let 2387 val arraySize = sizeEl * Word.fromInt n 2388 fun ffiTypeArray () = 2389 LibFFI.createFFItype { 2390 size = arraySize, align = alignEl, typeCode=LibFFI.ffiTypeCodeStruct, 2391 elements = List.tabulate (n, fn _ => ffiTypeEl()) } 2392 val arrayType = { size = arraySize, align = alignEl, ffiType = ffiTypeArray } 2393 2394 fun load(v: voidStar): 'a vector = 2395 Vector.tabulate(n, fn i => loadEl(v ++ Word.fromInt i)) 2396 2397 fun store(v: voidStar, s: 'a vector) = 2398 let 2399 val sLen = Vector.length s 2400 val _ = sLen <= n orelse raise Foreign "vector too long" 2401 (* Store the values. Make a list of the free fns in case they allocate *) 2402 val frees = Vector.foldli(fn(i, el, l) => storeEl(v ++ Word.fromInt i, el) :: l) [] s; 2403 in 2404 fn () => List.app (fn f => f()) frees 2405 end 2406 2407 (* If we have a ref in here we need to update *) 2408 fun updateML(v, s) = Vector.appi(fn (i, el) => updateMLel(v ++ Word.fromInt i, el)) s 2409 and updateC(v, s) = Vector.appi(fn (i, el) => updateCel(v ++ Word.fromInt i, el)) s 2410 in 2411 { load = load, store = store, updateML=updateML, updateC=updateC, ctype = arrayType } 2412 end 2413 2414 (* Pass an ML vector as a pointer to a C array. *) 2415 fun cVectorPointer 2416 ({store=storeEl, updateML=updateMLel, ctype={size=sizeEl, ...}, ...}: 'a conversion) 2417 : 'a vector conversion = 2418 let 2419 (* We can't determine the size so can't construct a suitable ML value. *) 2420 fun load _ = raise Foreign "Cannot return a cVectorPointer from C to ML" 2421 2422 fun store(m, s) = 2423 let 2424 val mem = malloc(sizeEl * Word.fromInt(Vector.length s)) 2425 val () = setAddress(m, 0w0, mem) 2426 (* Store the values. Make a list of the free fns in case they allocate *) 2427 val frees = Vector.foldli(fn(i, el, l) => storeEl(mem ++ (sizeEl * Word.fromInt i), el) :: l) [] s; 2428 in 2429 fn () => (List.app (fn f => f()) frees; free mem) 2430 end 2431 2432 (* This is only appropriate if the elements are refs. *) 2433 fun updateML(v, s) = 2434 let 2435 val addr = getAddress(v, 0w0) 2436 in 2437 Vector.appi(fn (i, el) => updateMLel(addr ++ (sizeEl * Word.fromInt i), el)) s 2438 end 2439 (* updateC can't actually be used because we can't load a suitable value *) 2440 and updateC _ = raise Foreign "Cannot return a cVectorPointer from C to ML" 2441 in 2442 {load=load, store=store, updateML=updateML, updateC=updateC, ctype = cTypePointer} 2443 end 2444 2445 (* Pass an ML array as a pointer to a C array and, on return, update each element of 2446 the ML array from the C array. *) 2447 fun cArrayPointer 2448 ({load=loadEl, store=storeEl, ctype={size=sizeEl, ...}, ...}: 'a conversion) : 'a array conversion = 2449 let 2450 (* We can't determine the size so can't construct a suitable ML value. *) 2451 fun load _ = raise Foreign "Cannot return a cArrayPointer from C to ML" 2452 2453 fun store(m, s) = 2454 let 2455 val mem = malloc(sizeEl * Word.fromInt(Array.length s)) 2456 val () = setAddress(m, 0w0, mem) 2457 (* Store the values. Make a list of the free fns in case they allocate *) 2458 val frees = Array.foldli(fn(i, el, l) => storeEl(mem ++ (sizeEl * Word.fromInt i), el) :: l) [] s; 2459 in 2460 fn () => (List.app (fn f => f()) frees; free mem) 2461 end 2462 2463 (* updateML is used after a C function returns. It needs to update each element. *) 2464 fun updateML(v, s) = 2465 let 2466 val addr = getAddress(v, 0w0) 2467 in 2468 Array.modifyi(fn (i, _) => loadEl(addr ++ (sizeEl * Word.fromInt i))) s 2469 end 2470 2471 (* updateC can't actually be used because we can't load a suitable value *) 2472 and updateC _ = raise Foreign "Cannot return a cArrayPointer from C to ML" 2473 in 2474 {load=load, store=store, updateML=updateML, updateC=updateC, ctype = cTypePointer} 2475 end 2476 end 2477 2478 (* Calls with conversion. *) 2479 (* Note: it may be possible to have general functions to compute offsets 2480 but we don't do that because this way the compiler can compute the offsets 2481 as constants during inline expansion. *) 2482 local 2483 open LibFFI Memory LowLevel 2484 in 2485 2486 fun buildCall0withAbi(abi: abi, fnAddr, (), {ctype = resType, load= resLoad, ...} : 'a conversion): unit->'a = 2487 let 2488 val callF = callwithAbi abi [] resType fnAddr 2489 in 2490 fn () => 2491 let 2492 val rMem = malloc(#size resType) 2493 in 2494 let 2495 val () = callF([], rMem) 2496 val result = resLoad rMem 2497 in 2498 free rMem; 2499 result 2500 end handle exn => (free rMem; raise exn) 2501 end 2502 end 2503 2504 fun buildCall0(symbol, argTypes, resType) = buildCall0withAbi (abiDefault, symbol, argTypes, resType) 2505 2506 fun buildCall1withAbi (abi: abi, fnAddr, 2507 { ctype = argType, store = argStore, updateML = argUpdate, ...}: 'a conversion, 2508 { ctype = resType, load= resLoad, ...}: 'b conversion): 'a ->'b = 2509 let 2510 val callF = callwithAbi abi [argType] resType fnAddr 2511 (* Allocate space for argument(s) and result. 2512 We can't use cStruct here because we only store the 2513 argument before the call and load the result after. *) 2514 val argOffset = alignUp(#size resType, #align argType) 2515 val argSpace = argOffset + #size argType 2516 in 2517 fn x => 2518 let 2519 val rMem = malloc argSpace 2520 val argAddr = rMem ++ argOffset 2521 val freea = argStore (argAddr, x) 2522 fun freeAll () = (freea(); free rMem) 2523 in 2524 let 2525 val () = callF([argAddr], rMem) 2526 val result = resLoad rMem 2527 in 2528 argUpdate (argAddr, x); 2529 freeAll (); 2530 result 2531 end handle exn => (freeAll (); raise exn) 2532 end 2533 end 2534 2535 fun buildCall1(symbol, argTypes, resType) = buildCall1withAbi (abiDefault, symbol, argTypes, resType) 2536 2537 fun buildCall2withAbi (abi: abi, fnAddr, 2538 ({ ctype = arg1Type, store = arg1Store, updateML = arg1Update, ...}: 'a conversion, 2539 { ctype = arg2Type, store = arg2Store, updateML = arg2Update, ...}: 'b conversion), 2540 { ctype = resType, load= resLoad, ...}: 'c conversion): 'a * 'b -> 'c = 2541 let 2542 val callF = callwithAbi abi [arg1Type, arg2Type] resType fnAddr 2543 val arg1Offset = alignUp(#size resType, #align arg1Type) 2544 val arg2Offset = alignUp(arg1Offset + #size arg1Type, #align arg2Type) 2545 val argSpace = arg2Offset + #size arg2Type 2546 in 2547 fn (a, b) => 2548 let 2549 val rMem = malloc argSpace 2550 val arg1Addr = rMem ++ arg1Offset 2551 val arg2Addr = rMem ++ arg2Offset 2552 val freea = arg1Store (arg1Addr, a) 2553 val freeb = arg2Store (arg2Addr, b) 2554 fun freeAll() = (freea(); freeb(); free rMem) 2555 in 2556 let 2557 val () = callF([arg1Addr, arg2Addr], rMem) 2558 val result = resLoad rMem 2559 in 2560 arg1Update(arg1Addr, a); arg2Update (arg2Addr, b); 2561 freeAll(); 2562 result 2563 end handle exn => (freeAll(); raise exn) 2564 end 2565 end 2566 2567 fun buildCall2(symbol, argTypes, resType) = buildCall2withAbi (abiDefault, symbol, argTypes, resType) 2568 2569 fun buildCall3withAbi (abi: abi, fnAddr, 2570 ({ ctype = arg1Type, store = arg1Store, updateML = arg1Update, ...}: 'a conversion, 2571 { ctype = arg2Type, store = arg2Store, updateML = arg2Update, ...}: 'b conversion, 2572 { ctype = arg3Type, store = arg3Store, updateML = arg3Update, ...}: 'c conversion), 2573 { ctype = resType, load= resLoad, ...}: 'd conversion): 'a * 'b *'c -> 'd = 2574 let 2575 val callF = callwithAbi abi [arg1Type, arg2Type, arg3Type] resType fnAddr 2576 val arg1Offset = alignUp(#size resType, #align arg1Type) 2577 val arg2Offset = alignUp(arg1Offset + #size arg1Type, #align arg2Type) 2578 val arg3Offset = alignUp(arg2Offset + #size arg2Type, #align arg3Type) 2579 val argSpace = arg3Offset + #size arg3Type 2580 in 2581 fn (a, b, c) => 2582 let 2583 val rMem = malloc argSpace 2584 val arg1Addr = rMem ++ arg1Offset 2585 val arg2Addr = rMem ++ arg2Offset 2586 val arg3Addr = rMem ++ arg3Offset 2587 val freea = arg1Store (arg1Addr, a) 2588 val freeb = arg2Store (arg2Addr, b) 2589 val freec = arg3Store (arg3Addr, c) 2590 fun freeAll() = (freea(); freeb(); freec(); free rMem) 2591 in 2592 let 2593 val () = callF([arg1Addr, arg2Addr, arg3Addr], rMem) 2594 val result = resLoad rMem 2595 in 2596 arg1Update(arg1Addr, a); arg2Update (arg2Addr, b); arg3Update (arg3Addr, c); 2597 freeAll(); 2598 result 2599 end handle exn => (freeAll(); raise exn) 2600 end 2601 end 2602 2603 fun buildCall3(symbol, argTypes, resType) = buildCall3withAbi (abiDefault, symbol, argTypes, resType) 2604 2605 fun buildCall4withAbi (abi: abi, fnAddr, 2606 ({ ctype = arg1Type, store = arg1Store, updateML = arg1Update, ...}: 'a conversion, 2607 { ctype = arg2Type, store = arg2Store, updateML = arg2Update, ...}: 'b conversion, 2608 { ctype = arg3Type, store = arg3Store, updateML = arg3Update, ...}: 'c conversion, 2609 { ctype = arg4Type, store = arg4Store, updateML = arg4Update, ...}: 'd conversion), 2610 { ctype = resType, load= resLoad, ...}: 'e conversion): 'a * 'b *'c * 'd -> 'e = 2611 let 2612 val callF = callwithAbi abi [arg1Type, arg2Type, arg3Type, arg4Type] resType fnAddr 2613 val arg1Offset = alignUp(#size resType, #align arg1Type) 2614 val arg2Offset = alignUp(arg1Offset + #size arg1Type, #align arg2Type) 2615 val arg3Offset = alignUp(arg2Offset + #size arg2Type, #align arg3Type) 2616 val arg4Offset = alignUp(arg3Offset + #size arg3Type, #align arg4Type) 2617 val argSpace = arg4Offset + #size arg4Type 2618 in 2619 fn (a, b, c, d) => 2620 let 2621 val rMem = malloc argSpace 2622 val arg1Addr = rMem ++ arg1Offset 2623 val arg2Addr = rMem ++ arg2Offset 2624 val arg3Addr = rMem ++ arg3Offset 2625 val arg4Addr = rMem ++ arg4Offset 2626 val freea = arg1Store (arg1Addr, a) 2627 val freeb = arg2Store (arg2Addr, b) 2628 val freec = arg3Store (arg3Addr, c) 2629 val freed = arg4Store (arg4Addr, d) 2630 fun freeAll() = (freea(); freeb(); freec(); freed(); free rMem) 2631 in 2632 let 2633 val () = callF([arg1Addr, arg2Addr, arg3Addr, arg4Addr], rMem) 2634 val result = resLoad rMem 2635 in 2636 arg1Update(arg1Addr, a); arg2Update (arg2Addr, b); arg3Update (arg3Addr, c); 2637 arg4Update (arg4Addr, d); 2638 freeAll(); 2639 result 2640 end handle exn => (freeAll(); raise exn) 2641 end 2642 end 2643 2644 fun buildCall4(symbol, argTypes, resType) = buildCall4withAbi (abiDefault, symbol, argTypes, resType) 2645 2646 fun buildCall5withAbi (abi: abi, fnAddr, 2647 ({ ctype = arg1Type, store = arg1Store, updateML = arg1Update, ...}: 'a conversion, 2648 { ctype = arg2Type, store = arg2Store, updateML = arg2Update, ...}: 'b conversion, 2649 { ctype = arg3Type, store = arg3Store, updateML = arg3Update, ...}: 'c conversion, 2650 { ctype = arg4Type, store = arg4Store, updateML = arg4Update, ...}: 'd conversion, 2651 { ctype = arg5Type, store = arg5Store, updateML = arg5Update, ...}: 'e conversion), 2652 { ctype = resType, load= resLoad, ...}: 'f conversion): 'a * 'b *'c * 'd * 'e -> 'f = 2653 let 2654 val callF = 2655 callwithAbi abi [arg1Type, arg2Type, arg3Type, arg4Type, arg5Type] resType fnAddr 2656 val arg1Offset = alignUp(#size resType, #align arg1Type) 2657 val arg2Offset = alignUp(arg1Offset + #size arg1Type, #align arg2Type) 2658 val arg3Offset = alignUp(arg2Offset + #size arg2Type, #align arg3Type) 2659 val arg4Offset = alignUp(arg3Offset + #size arg3Type, #align arg4Type) 2660 val arg5Offset = alignUp(arg4Offset + #size arg4Type, #align arg5Type) 2661 val argSpace = arg5Offset + #size arg5Type 2662 in 2663 fn (a, b, c, d, e) => 2664 let 2665 val rMem = malloc argSpace 2666 val arg1Addr = rMem ++ arg1Offset 2667 val arg2Addr = rMem ++ arg2Offset 2668 val arg3Addr = rMem ++ arg3Offset 2669 val arg4Addr = rMem ++ arg4Offset 2670 val arg5Addr = rMem ++ arg5Offset 2671 val freea = arg1Store (arg1Addr, a) 2672 val freeb = arg2Store (arg2Addr, b) 2673 val freec = arg3Store (arg3Addr, c) 2674 val freed = arg4Store (arg4Addr, d) 2675 val freee = arg5Store (arg5Addr, e) 2676 fun freeAll() = 2677 (freea(); freeb(); freec(); freed(); freee(); free rMem) 2678 in 2679 let 2680 val () = callF([arg1Addr, arg2Addr, arg3Addr, arg4Addr, arg5Addr], rMem) 2681 val result = resLoad rMem 2682 in 2683 arg1Update(arg1Addr, a); arg2Update (arg2Addr, b); arg3Update (arg3Addr, c); 2684 arg4Update (arg4Addr, d); arg5Update (arg5Addr, e); 2685 freeAll(); 2686 result 2687 end handle exn => (freeAll(); raise exn) 2688 end 2689 end 2690 2691 fun buildCall5(symbol, argTypes, resType) = buildCall5withAbi (abiDefault, symbol, argTypes, resType) 2692 2693 fun buildCall6withAbi (abi: abi, fnAddr, 2694 ({ ctype = arg1Type, store = arg1Store, updateML = arg1Update, ...}: 'a conversion, 2695 { ctype = arg2Type, store = arg2Store, updateML = arg2Update, ...}: 'b conversion, 2696 { ctype = arg3Type, store = arg3Store, updateML = arg3Update, ...}: 'c conversion, 2697 { ctype = arg4Type, store = arg4Store, updateML = arg4Update, ...}: 'd conversion, 2698 { ctype = arg5Type, store = arg5Store, updateML = arg5Update, ...}: 'e conversion, 2699 { ctype = arg6Type, store = arg6Store, updateML = arg6Update, ...}: 'f conversion), 2700 { ctype = resType, load= resLoad, ...}: 'g conversion): 'a * 'b *'c * 'd * 'e * 'f -> 'g = 2701 let 2702 val callF = 2703 callwithAbi abi [arg1Type, arg2Type, arg3Type, arg4Type, arg5Type, arg6Type] resType fnAddr 2704 val arg1Offset = alignUp(#size resType, #align arg1Type) 2705 val arg2Offset = alignUp(arg1Offset + #size arg1Type, #align arg2Type) 2706 val arg3Offset = alignUp(arg2Offset + #size arg2Type, #align arg3Type) 2707 val arg4Offset = alignUp(arg3Offset + #size arg3Type, #align arg4Type) 2708 val arg5Offset = alignUp(arg4Offset + #size arg4Type, #align arg5Type) 2709 val arg6Offset = alignUp(arg5Offset + #size arg5Type, #align arg6Type) 2710 val argSpace = arg6Offset + #size arg6Type 2711 in 2712 fn (a, b, c, d, e, f) => 2713 let 2714 val rMem = malloc argSpace 2715 val arg1Addr = rMem ++ arg1Offset 2716 val arg2Addr = rMem ++ arg2Offset 2717 val arg3Addr = rMem ++ arg3Offset 2718 val arg4Addr = rMem ++ arg4Offset 2719 val arg5Addr = rMem ++ arg5Offset 2720 val arg6Addr = rMem ++ arg6Offset 2721 val freea = arg1Store (arg1Addr, a) 2722 val freeb = arg2Store (arg2Addr, b) 2723 val freec = arg3Store (arg3Addr, c) 2724 val freed = arg4Store (arg4Addr, d) 2725 val freee = arg5Store (arg5Addr, e) 2726 val freef = arg6Store (arg6Addr, f) 2727 fun freeAll() = 2728 (freea(); freeb(); freec(); freed(); freee(); freef(); free rMem) 2729 in 2730 let 2731 val () = callF([arg1Addr, arg2Addr, arg3Addr, arg4Addr, arg5Addr , arg6Addr], rMem) 2732 val result = resLoad rMem 2733 in 2734 arg1Update(arg1Addr, a); arg2Update (arg2Addr, b); arg3Update (arg3Addr, c); 2735 arg4Update (arg4Addr, d); arg5Update (arg5Addr, e); arg6Update (arg6Addr, f); 2736 freeAll(); 2737 result 2738 end handle exn => (freeAll(); raise exn) 2739 end 2740 end 2741 2742 fun buildCall6(symbol, argTypes, resType) = buildCall6withAbi (abiDefault, symbol, argTypes, resType) 2743 2744 fun buildCall7withAbi (abi: abi, fnAddr, 2745 ({ ctype = arg1Type, store = arg1Store, updateML = arg1Update, ...}: 'a conversion, 2746 { ctype = arg2Type, store = arg2Store, updateML = arg2Update, ...}: 'b conversion, 2747 { ctype = arg3Type, store = arg3Store, updateML = arg3Update, ...}: 'c conversion, 2748 { ctype = arg4Type, store = arg4Store, updateML = arg4Update, ...}: 'd conversion, 2749 { ctype = arg5Type, store = arg5Store, updateML = arg5Update, ...}: 'e conversion, 2750 { ctype = arg6Type, store = arg6Store, updateML = arg6Update, ...}: 'f conversion, 2751 { ctype = arg7Type, store = arg7Store, updateML = arg7Update, ...}: 'g conversion), 2752 { ctype = resType, load= resLoad, ...}: 'h conversion): 2753 'a * 'b *'c * 'd * 'e * 'f * 'g -> 'h = 2754 let 2755 val callF = 2756 callwithAbi abi [arg1Type, arg2Type, arg3Type, arg4Type, arg5Type, arg6Type, arg7Type] resType fnAddr 2757 val arg1Offset = alignUp(#size resType, #align arg1Type) 2758 val arg2Offset = alignUp(arg1Offset + #size arg1Type, #align arg2Type) 2759 val arg3Offset = alignUp(arg2Offset + #size arg2Type, #align arg3Type) 2760 val arg4Offset = alignUp(arg3Offset + #size arg3Type, #align arg4Type) 2761 val arg5Offset = alignUp(arg4Offset + #size arg4Type, #align arg5Type) 2762 val arg6Offset = alignUp(arg5Offset + #size arg5Type, #align arg6Type) 2763 val arg7Offset = alignUp(arg6Offset + #size arg6Type, #align arg7Type) 2764 val argSpace = arg7Offset + #size arg7Type 2765 in 2766 fn (a, b, c, d, e, f, g) => 2767 let 2768 val rMem = malloc argSpace 2769 val arg1Addr = rMem ++ arg1Offset 2770 val arg2Addr = rMem ++ arg2Offset 2771 val arg3Addr = rMem ++ arg3Offset 2772 val arg4Addr = rMem ++ arg4Offset 2773 val arg5Addr = rMem ++ arg5Offset 2774 val arg6Addr = rMem ++ arg6Offset 2775 val arg7Addr = rMem ++ arg7Offset 2776 val freea = arg1Store (arg1Addr, a) 2777 val freeb = arg2Store (arg2Addr, b) 2778 val freec = arg3Store (arg3Addr, c) 2779 val freed = arg4Store (arg4Addr, d) 2780 val freee = arg5Store (arg5Addr, e) 2781 val freef = arg6Store (arg6Addr, f) 2782 val freeg = arg7Store (arg7Addr, g) 2783 fun freeAll() = 2784 (freea(); freeb(); freec(); freed(); freee(); freef(); freeg(); free rMem) 2785 in 2786 let 2787 val () = callF([arg1Addr, arg2Addr, arg3Addr, arg4Addr, arg5Addr, arg6Addr, arg7Addr], rMem) 2788 val result = resLoad rMem 2789 in 2790 arg1Update(arg1Addr, a); arg2Update (arg2Addr, b); arg3Update (arg3Addr, c); 2791 arg4Update (arg4Addr, d); arg5Update (arg5Addr, e); arg6Update (arg6Addr, f); 2792 arg7Update (arg7Addr, g); 2793 freeAll(); 2794 result 2795 end handle exn => (freeAll(); raise exn) 2796 end 2797 end 2798 2799 fun buildCall7(symbol, argTypes, resType) = buildCall7withAbi (abiDefault, symbol, argTypes, resType) 2800 2801 fun buildCall8withAbi (abi: abi, fnAddr, 2802 ({ ctype = arg1Type, store = arg1Store, updateML = arg1Update, ...}: 'a conversion, 2803 { ctype = arg2Type, store = arg2Store, updateML = arg2Update, ...}: 'b conversion, 2804 { ctype = arg3Type, store = arg3Store, updateML = arg3Update, ...}: 'c conversion, 2805 { ctype = arg4Type, store = arg4Store, updateML = arg4Update, ...}: 'd conversion, 2806 { ctype = arg5Type, store = arg5Store, updateML = arg5Update, ...}: 'e conversion, 2807 { ctype = arg6Type, store = arg6Store, updateML = arg6Update, ...}: 'f conversion, 2808 { ctype = arg7Type, store = arg7Store, updateML = arg7Update, ...}: 'g conversion, 2809 { ctype = arg8Type, store = arg8Store, updateML = arg8Update, ...}: 'h conversion), 2810 { ctype = resType, load= resLoad, ...}: 'i conversion): 2811 'a * 'b *'c * 'd * 'e * 'f * 'g * 'h -> 'i = 2812 let 2813 val callF = 2814 callwithAbi abi 2815 [arg1Type, arg2Type, arg3Type, arg4Type, arg5Type, arg6Type, arg7Type, arg8Type] resType fnAddr 2816 val arg1Offset = alignUp(#size resType, #align arg1Type) 2817 val arg2Offset = alignUp(arg1Offset + #size arg1Type, #align arg2Type) 2818 val arg3Offset = alignUp(arg2Offset + #size arg2Type, #align arg3Type) 2819 val arg4Offset = alignUp(arg3Offset + #size arg3Type, #align arg4Type) 2820 val arg5Offset = alignUp(arg4Offset + #size arg4Type, #align arg5Type) 2821 val arg6Offset = alignUp(arg5Offset + #size arg5Type, #align arg6Type) 2822 val arg7Offset = alignUp(arg6Offset + #size arg6Type, #align arg7Type) 2823 val arg8Offset = alignUp(arg7Offset + #size arg7Type, #align arg8Type) 2824 val argSpace = arg8Offset + #size arg8Type 2825 in 2826 fn (a, b, c, d, e, f, g, h) => 2827 let 2828 val rMem = malloc argSpace 2829 val arg1Addr = rMem ++ arg1Offset 2830 val arg2Addr = rMem ++ arg2Offset 2831 val arg3Addr = rMem ++ arg3Offset 2832 val arg4Addr = rMem ++ arg4Offset 2833 val arg5Addr = rMem ++ arg5Offset 2834 val arg6Addr = rMem ++ arg6Offset 2835 val arg7Addr = rMem ++ arg7Offset 2836 val arg8Addr = rMem ++ arg8Offset 2837 val freea = arg1Store (arg1Addr, a) 2838 val freeb = arg2Store (arg2Addr, b) 2839 val freec = arg3Store (arg3Addr, c) 2840 val freed = arg4Store (arg4Addr, d) 2841 val freee = arg5Store (arg5Addr, e) 2842 val freef = arg6Store (arg6Addr, f) 2843 val freeg = arg7Store (arg7Addr, g) 2844 val freeh = arg8Store (arg8Addr, h) 2845 fun freeAll() = 2846 (freea(); freeb(); freec(); freed(); freee(); freef(); freeg(); 2847 freeh(); free rMem) 2848 in 2849 let 2850 val () = callF([arg1Addr, arg2Addr, arg3Addr, arg4Addr, arg5Addr, arg6Addr, arg7Addr, arg8Addr], rMem) 2851 val result = resLoad rMem 2852 in 2853 arg1Update(arg1Addr, a); arg2Update (arg2Addr, b); arg3Update (arg3Addr, c); 2854 arg4Update (arg4Addr, d); arg5Update (arg5Addr, e); arg6Update (arg6Addr, f); 2855 arg7Update (arg7Addr, g); arg8Update (arg8Addr, h); 2856 freeAll(); 2857 result 2858 end handle exn => (freeAll(); raise exn) 2859 end 2860 end 2861 2862 fun buildCall8(symbol, argTypes, resType) = buildCall8withAbi (abiDefault, symbol, argTypes, resType) 2863 2864 fun buildCall9withAbi (abi: abi, fnAddr, 2865 ({ ctype = arg1Type, store = arg1Store, updateML = arg1Update, ...}: 'a conversion, 2866 { ctype = arg2Type, store = arg2Store, updateML = arg2Update, ...}: 'b conversion, 2867 { ctype = arg3Type, store = arg3Store, updateML = arg3Update, ...}: 'c conversion, 2868 { ctype = arg4Type, store = arg4Store, updateML = arg4Update, ...}: 'd conversion, 2869 { ctype = arg5Type, store = arg5Store, updateML = arg5Update, ...}: 'e conversion, 2870 { ctype = arg6Type, store = arg6Store, updateML = arg6Update, ...}: 'f conversion, 2871 { ctype = arg7Type, store = arg7Store, updateML = arg7Update, ...}: 'g conversion, 2872 { ctype = arg8Type, store = arg8Store, updateML = arg8Update, ...}: 'h conversion, 2873 { ctype = arg9Type, store = arg9Store, updateML = arg9Update, ...}: 'i conversion), 2874 { ctype = resType, load= resLoad, ...}: 'j conversion): 2875 'a * 'b *'c * 'd * 'e * 'f * 'g * 'h * 'i -> 'j = 2876 let 2877 val callF = 2878 callwithAbi abi 2879 [arg1Type, arg2Type, arg3Type, arg4Type, arg5Type, arg6Type, arg7Type, arg8Type, arg9Type] 2880 resType fnAddr 2881 val arg1Offset = alignUp(#size resType, #align arg1Type) 2882 val arg2Offset = alignUp(arg1Offset + #size arg1Type, #align arg2Type) 2883 val arg3Offset = alignUp(arg2Offset + #size arg2Type, #align arg3Type) 2884 val arg4Offset = alignUp(arg3Offset + #size arg3Type, #align arg4Type) 2885 val arg5Offset = alignUp(arg4Offset + #size arg4Type, #align arg5Type) 2886 val arg6Offset = alignUp(arg5Offset + #size arg5Type, #align arg6Type) 2887 val arg7Offset = alignUp(arg6Offset + #size arg6Type, #align arg7Type) 2888 val arg8Offset = alignUp(arg7Offset + #size arg7Type, #align arg8Type) 2889 val arg9Offset = alignUp(arg8Offset + #size arg8Type, #align arg9Type) 2890 val argSpace = arg9Offset + #size arg9Type 2891 in 2892 fn (a, b, c, d, e, f, g, h, i) => 2893 let 2894 val rMem = malloc argSpace 2895 val arg1Addr = rMem ++ arg1Offset 2896 val arg2Addr = rMem ++ arg2Offset 2897 val arg3Addr = rMem ++ arg3Offset 2898 val arg4Addr = rMem ++ arg4Offset 2899 val arg5Addr = rMem ++ arg5Offset 2900 val arg6Addr = rMem ++ arg6Offset 2901 val arg7Addr = rMem ++ arg7Offset 2902 val arg8Addr = rMem ++ arg8Offset 2903 val arg9Addr = rMem ++ arg9Offset 2904 val freea = arg1Store (arg1Addr, a) 2905 val freeb = arg2Store (arg2Addr, b) 2906 val freec = arg3Store (arg3Addr, c) 2907 val freed = arg4Store (arg4Addr, d) 2908 val freee = arg5Store (arg5Addr, e) 2909 val freef = arg6Store (arg6Addr, f) 2910 val freeg = arg7Store (arg7Addr, g) 2911 val freeh = arg8Store (arg8Addr, h) 2912 val freei = arg9Store (arg9Addr, i) 2913 fun freeAll() = 2914 (freea(); freeb(); freec(); freed(); freee(); freef(); freeg(); 2915 freeh(); freei(); free rMem) 2916 in 2917 let 2918 val () = 2919 callF([arg1Addr, arg2Addr, arg3Addr, arg4Addr, arg5Addr, arg6Addr, arg7Addr, arg8Addr, arg9Addr], rMem) 2920 val result = resLoad rMem 2921 in 2922 arg1Update(arg1Addr, a); arg2Update (arg2Addr, b); arg3Update (arg3Addr, c); 2923 arg4Update (arg4Addr, d); arg5Update (arg5Addr, e); arg6Update (arg6Addr, f); 2924 arg7Update (arg7Addr, g); arg8Update (arg8Addr, h); arg9Update (arg9Addr, i); 2925 freeAll(); 2926 result 2927 end handle exn => (freeAll(); raise exn) 2928 end 2929 end 2930 2931 fun buildCall9(symbol, argTypes, resType) = buildCall9withAbi (abiDefault, symbol, argTypes, resType) 2932 2933 fun buildCall10withAbi (abi: abi, fnAddr, 2934 ({ ctype = arg1Type, store = arg1Store, updateML = arg1Update, ...}: 'a conversion, 2935 { ctype = arg2Type, store = arg2Store, updateML = arg2Update, ...}: 'b conversion, 2936 { ctype = arg3Type, store = arg3Store, updateML = arg3Update, ...}: 'c conversion, 2937 { ctype = arg4Type, store = arg4Store, updateML = arg4Update, ...}: 'd conversion, 2938 { ctype = arg5Type, store = arg5Store, updateML = arg5Update, ...}: 'e conversion, 2939 { ctype = arg6Type, store = arg6Store, updateML = arg6Update, ...}: 'f conversion, 2940 { ctype = arg7Type, store = arg7Store, updateML = arg7Update, ...}: 'g conversion, 2941 { ctype = arg8Type, store = arg8Store, updateML = arg8Update, ...}: 'h conversion, 2942 { ctype = arg9Type, store = arg9Store, updateML = arg9Update, ...}: 'i conversion, 2943 { ctype = arg10Type, store = arg10Store, updateML = arg10Update, ...}: 'j conversion), 2944 { ctype = resType, load= resLoad, ...}: 'k conversion): 2945 'a * 'b *'c * 'd * 'e * 'f * 'g * 'h * 'i * 'j -> 'k = 2946 let 2947 val callF = 2948 callwithAbi abi 2949 [arg1Type, arg2Type, arg3Type, arg4Type, arg5Type, arg6Type, arg7Type, 2950 arg8Type, arg9Type, arg10Type] resType fnAddr 2951 val arg1Offset = alignUp(#size resType, #align arg1Type) 2952 val arg2Offset = alignUp(arg1Offset + #size arg1Type, #align arg2Type) 2953 val arg3Offset = alignUp(arg2Offset + #size arg2Type, #align arg3Type) 2954 val arg4Offset = alignUp(arg3Offset + #size arg3Type, #align arg4Type) 2955 val arg5Offset = alignUp(arg4Offset + #size arg4Type, #align arg5Type) 2956 val arg6Offset = alignUp(arg5Offset + #size arg5Type, #align arg6Type) 2957 val arg7Offset = alignUp(arg6Offset + #size arg6Type, #align arg7Type) 2958 val arg8Offset = alignUp(arg7Offset + #size arg7Type, #align arg8Type) 2959 val arg9Offset = alignUp(arg8Offset + #size arg8Type, #align arg9Type) 2960 val arg10Offset = alignUp(arg9Offset + #size arg9Type, #align arg10Type) 2961 val argSpace = arg10Offset + #size arg10Type 2962 in 2963 fn (a, b, c, d, e, f, g, h, i, j) => 2964 let 2965 val rMem = malloc argSpace 2966 val arg1Addr = rMem ++ arg1Offset 2967 val arg2Addr = rMem ++ arg2Offset 2968 val arg3Addr = rMem ++ arg3Offset 2969 val arg4Addr = rMem ++ arg4Offset 2970 val arg5Addr = rMem ++ arg5Offset 2971 val arg6Addr = rMem ++ arg6Offset 2972 val arg7Addr = rMem ++ arg7Offset 2973 val arg8Addr = rMem ++ arg8Offset 2974 val arg9Addr = rMem ++ arg9Offset 2975 val arg10Addr = rMem ++ arg10Offset 2976 val freea = arg1Store (arg1Addr, a) 2977 val freeb = arg2Store (arg2Addr, b) 2978 val freec = arg3Store (arg3Addr, c) 2979 val freed = arg4Store (arg4Addr, d) 2980 val freee = arg5Store (arg5Addr, e) 2981 val freef = arg6Store (arg6Addr, f) 2982 val freeg = arg7Store (arg7Addr, g) 2983 val freeh = arg8Store (arg8Addr, h) 2984 val freei = arg9Store (arg9Addr, i) 2985 val freej = arg10Store (arg10Addr, j) 2986 fun freeAll() = 2987 (freea(); freeb(); freec(); freed(); freee(); freef(); freeg(); 2988 freeh(); freei(); freej(); free rMem) 2989 in 2990 let 2991 val () = 2992 callF([arg1Addr, arg2Addr, arg3Addr, arg4Addr, arg5Addr, arg6Addr, arg7Addr, 2993 arg8Addr, arg9Addr, arg10Addr], rMem) 2994 val result = resLoad rMem 2995 in 2996 arg1Update(arg1Addr, a); arg2Update (arg2Addr, b); arg3Update (arg3Addr, c); 2997 arg4Update (arg4Addr, d); arg5Update (arg5Addr, e); arg6Update (arg6Addr, f); 2998 arg7Update (arg7Addr, g); arg8Update (arg8Addr, h); arg9Update (arg9Addr, i); 2999 arg10Update (arg10Addr, j); 3000 freeAll(); 3001 result 3002 end handle exn => (freeAll(); raise exn) 3003 end 3004 end 3005 3006 fun buildCall10(symbol, argTypes, resType) = buildCall10withAbi (abiDefault, symbol, argTypes, resType) 3007 3008 fun buildCall11withAbi (abi: abi, fnAddr, 3009 ({ ctype = arg1Type, store = arg1Store, updateML = arg1Update, ...}: 'a conversion, 3010 { ctype = arg2Type, store = arg2Store, updateML = arg2Update, ...}: 'b conversion, 3011 { ctype = arg3Type, store = arg3Store, updateML = arg3Update, ...}: 'c conversion, 3012 { ctype = arg4Type, store = arg4Store, updateML = arg4Update, ...}: 'd conversion, 3013 { ctype = arg5Type, store = arg5Store, updateML = arg5Update, ...}: 'e conversion, 3014 { ctype = arg6Type, store = arg6Store, updateML = arg6Update, ...}: 'f conversion, 3015 { ctype = arg7Type, store = arg7Store, updateML = arg7Update, ...}: 'g conversion, 3016 { ctype = arg8Type, store = arg8Store, updateML = arg8Update, ...}: 'h conversion, 3017 { ctype = arg9Type, store = arg9Store, updateML = arg9Update, ...}: 'i conversion, 3018 { ctype = arg10Type, store = arg10Store, updateML = arg10Update, ...}: 'j conversion, 3019 { ctype = arg11Type, store = arg11Store, updateML = arg11Update, ...}: 'k conversion), 3020 { ctype = resType, load= resLoad, ...}: 'l conversion): 3021 'a * 'b *'c * 'd * 'e * 'f * 'g * 'h * 'i * 'j * 'k -> 'l = 3022 let 3023 val callF = 3024 callwithAbi abi 3025 [arg1Type, arg2Type, arg3Type, arg4Type, arg5Type, arg6Type, arg7Type, 3026 arg8Type, arg9Type, arg10Type, arg11Type] resType fnAddr 3027 val arg1Offset = alignUp(#size resType, #align arg1Type) 3028 val arg2Offset = alignUp(arg1Offset + #size arg1Type, #align arg2Type) 3029 val arg3Offset = alignUp(arg2Offset + #size arg2Type, #align arg3Type) 3030 val arg4Offset = alignUp(arg3Offset + #size arg3Type, #align arg4Type) 3031 val arg5Offset = alignUp(arg4Offset + #size arg4Type, #align arg5Type) 3032 val arg6Offset = alignUp(arg5Offset + #size arg5Type, #align arg6Type) 3033 val arg7Offset = alignUp(arg6Offset + #size arg6Type, #align arg7Type) 3034 val arg8Offset = alignUp(arg7Offset + #size arg7Type, #align arg8Type) 3035 val arg9Offset = alignUp(arg8Offset + #size arg8Type, #align arg9Type) 3036 val arg10Offset = alignUp(arg9Offset + #size arg9Type, #align arg10Type) 3037 val arg11Offset = alignUp(arg10Offset + #size arg10Type, #align arg11Type) 3038 val argSpace = arg11Offset + #size arg11Type 3039 in 3040 fn (a, b, c, d, e, f, g, h, i, j, k) => 3041 let 3042 val rMem = malloc argSpace 3043 val arg1Addr = rMem ++ arg1Offset 3044 val arg2Addr = rMem ++ arg2Offset 3045 val arg3Addr = rMem ++ arg3Offset 3046 val arg4Addr = rMem ++ arg4Offset 3047 val arg5Addr = rMem ++ arg5Offset 3048 val arg6Addr = rMem ++ arg6Offset 3049 val arg7Addr = rMem ++ arg7Offset 3050 val arg8Addr = rMem ++ arg8Offset 3051 val arg9Addr = rMem ++ arg9Offset 3052 val arg10Addr = rMem ++ arg10Offset 3053 val arg11Addr = rMem ++ arg11Offset 3054 val freea = arg1Store (arg1Addr, a) 3055 val freeb = arg2Store (arg2Addr, b) 3056 val freec = arg3Store (arg3Addr, c) 3057 val freed = arg4Store (arg4Addr, d) 3058 val freee = arg5Store (arg5Addr, e) 3059 val freef = arg6Store (arg6Addr, f) 3060 val freeg = arg7Store (arg7Addr, g) 3061 val freeh = arg8Store (arg8Addr, h) 3062 val freei = arg9Store (arg9Addr, i) 3063 val freej = arg10Store (arg10Addr, j) 3064 val freek = arg11Store (arg11Addr, k) 3065 fun freeAll() = 3066 (freea(); freeb(); freec(); freed(); freee(); freef(); freeg(); 3067 freeh(); freei(); freej(); freek(); free rMem) 3068 in 3069 let 3070 val () = 3071 callF([arg1Addr, arg2Addr, arg3Addr, arg4Addr, arg5Addr, arg6Addr, arg7Addr, 3072 arg8Addr, arg9Addr, arg10Addr, arg11Addr], rMem) 3073 val result = resLoad rMem 3074 in 3075 arg1Update(arg1Addr, a); arg2Update (arg2Addr, b); arg3Update (arg3Addr, c); 3076 arg4Update (arg4Addr, d); arg5Update (arg5Addr, e); arg6Update (arg6Addr, f); 3077 arg7Update (arg7Addr, g); arg8Update (arg8Addr, h); arg9Update (arg9Addr, i); 3078 arg10Update (arg10Addr, j); arg11Update (arg11Addr, k); 3079 freeAll(); 3080 result 3081 end handle exn => (freeAll(); raise exn) 3082 end 3083 end 3084 3085 fun buildCall11(symbol, argTypes, resType) = buildCall11withAbi (abiDefault, symbol, argTypes, resType) 3086 3087 fun buildCall12withAbi (abi: abi, fnAddr, 3088 ({ ctype = arg1Type, store = arg1Store, updateML = arg1Update, ...}: 'a conversion, 3089 { ctype = arg2Type, store = arg2Store, updateML = arg2Update, ...}: 'b conversion, 3090 { ctype = arg3Type, store = arg3Store, updateML = arg3Update, ...}: 'c conversion, 3091 { ctype = arg4Type, store = arg4Store, updateML = arg4Update, ...}: 'd conversion, 3092 { ctype = arg5Type, store = arg5Store, updateML = arg5Update, ...}: 'e conversion, 3093 { ctype = arg6Type, store = arg6Store, updateML = arg6Update, ...}: 'f conversion, 3094 { ctype = arg7Type, store = arg7Store, updateML = arg7Update, ...}: 'g conversion, 3095 { ctype = arg8Type, store = arg8Store, updateML = arg8Update, ...}: 'h conversion, 3096 { ctype = arg9Type, store = arg9Store, updateML = arg9Update, ...}: 'i conversion, 3097 { ctype = arg10Type, store = arg10Store, updateML = arg10Update, ...}: 'j conversion, 3098 { ctype = arg11Type, store = arg11Store, updateML = arg11Update, ...}: 'k conversion, 3099 { ctype = arg12Type, store = arg12Store, updateML = arg12Update, ...}: 'l conversion), 3100 { ctype = resType, load= resLoad, ...}: 'm conversion): 3101 'a * 'b *'c * 'd * 'e * 'f * 'g * 'h * 'i * 'j * 'k * 'l -> 'm = 3102 let 3103 val callF = 3104 callwithAbi abi 3105 [arg1Type, arg2Type, arg3Type, arg4Type, arg5Type, arg6Type, arg7Type, 3106 arg8Type, arg9Type, arg10Type, arg11Type, arg12Type] resType fnAddr 3107 val arg1Offset = alignUp(#size resType, #align arg1Type) 3108 val arg2Offset = alignUp(arg1Offset + #size arg1Type, #align arg2Type) 3109 val arg3Offset = alignUp(arg2Offset + #size arg2Type, #align arg3Type) 3110 val arg4Offset = alignUp(arg3Offset + #size arg3Type, #align arg4Type) 3111 val arg5Offset = alignUp(arg4Offset + #size arg4Type, #align arg5Type) 3112 val arg6Offset = alignUp(arg5Offset + #size arg5Type, #align arg6Type) 3113 val arg7Offset = alignUp(arg6Offset + #size arg6Type, #align arg7Type) 3114 val arg8Offset = alignUp(arg7Offset + #size arg7Type, #align arg8Type) 3115 val arg9Offset = alignUp(arg8Offset + #size arg8Type, #align arg9Type) 3116 val arg10Offset = alignUp(arg9Offset + #size arg9Type, #align arg10Type) 3117 val arg11Offset = alignUp(arg10Offset + #size arg10Type, #align arg11Type) 3118 val arg12Offset = alignUp(arg11Offset + #size arg11Type, #align arg12Type) 3119 val argSpace = arg12Offset + #size arg12Type 3120 in 3121 fn (a, b, c, d, e, f, g, h, i, j, k, l) => 3122 let 3123 val rMem = malloc argSpace 3124 val arg1Addr = rMem ++ arg1Offset 3125 val arg2Addr = rMem ++ arg2Offset 3126 val arg3Addr = rMem ++ arg3Offset 3127 val arg4Addr = rMem ++ arg4Offset 3128 val arg5Addr = rMem ++ arg5Offset 3129 val arg6Addr = rMem ++ arg6Offset 3130 val arg7Addr = rMem ++ arg7Offset 3131 val arg8Addr = rMem ++ arg8Offset 3132 val arg9Addr = rMem ++ arg9Offset 3133 val arg10Addr = rMem ++ arg10Offset 3134 val arg11Addr = rMem ++ arg11Offset 3135 val arg12Addr = rMem ++ arg12Offset 3136 val freea = arg1Store (arg1Addr, a) 3137 val freeb = arg2Store (arg2Addr, b) 3138 val freec = arg3Store (arg3Addr, c) 3139 val freed = arg4Store (arg4Addr, d) 3140 val freee = arg5Store (arg5Addr, e) 3141 val freef = arg6Store (arg6Addr, f) 3142 val freeg = arg7Store (arg7Addr, g) 3143 val freeh = arg8Store (arg8Addr, h) 3144 val freei = arg9Store (arg9Addr, i) 3145 val freej = arg10Store (arg10Addr, j) 3146 val freek = arg11Store (arg11Addr, k) 3147 val freel = arg12Store (arg12Addr, l) 3148 fun freeAll() = 3149 (freea(); freeb(); freec(); freed(); freee(); freef(); freeg(); 3150 freeh(); freei(); freej(); freek(); freel(); free rMem) 3151 in 3152 let 3153 val () = 3154 callF([arg1Addr, arg2Addr, arg3Addr, arg4Addr, arg5Addr, arg6Addr, arg7Addr, 3155 arg8Addr, arg9Addr, arg10Addr, arg11Addr, arg12Addr], rMem) 3156 val result = resLoad rMem 3157 in 3158 arg1Update(arg1Addr, a); arg2Update (arg2Addr, b); arg3Update (arg3Addr, c); 3159 arg4Update (arg4Addr, d); arg5Update (arg5Addr, e); arg6Update (arg6Addr, f); 3160 arg7Update (arg7Addr, g); arg8Update (arg8Addr, h); arg9Update (arg9Addr, i); 3161 arg10Update (arg10Addr, j); arg11Update (arg11Addr, k); arg12Update (arg12Addr, l); 3162 freeAll(); 3163 result 3164 end handle exn => (freeAll(); raise exn) 3165 end 3166 end 3167 3168 fun buildCall12(symbol, argTypes, resType) = buildCall12withAbi (abiDefault, symbol, argTypes, resType) 3169 3170 fun buildCall13withAbi (abi: abi, fnAddr, 3171 ({ ctype = arg1Type, store = arg1Store, updateML = arg1Update, ...}: 'a conversion, 3172 { ctype = arg2Type, store = arg2Store, updateML = arg2Update, ...}: 'b conversion, 3173 { ctype = arg3Type, store = arg3Store, updateML = arg3Update, ...}: 'c conversion, 3174 { ctype = arg4Type, store = arg4Store, updateML = arg4Update, ...}: 'd conversion, 3175 { ctype = arg5Type, store = arg5Store, updateML = arg5Update, ...}: 'e conversion, 3176 { ctype = arg6Type, store = arg6Store, updateML = arg6Update, ...}: 'f conversion, 3177 { ctype = arg7Type, store = arg7Store, updateML = arg7Update, ...}: 'g conversion, 3178 { ctype = arg8Type, store = arg8Store, updateML = arg8Update, ...}: 'h conversion, 3179 { ctype = arg9Type, store = arg9Store, updateML = arg9Update, ...}: 'i conversion, 3180 { ctype = arg10Type, store = arg10Store, updateML = arg10Update, ...}: 'j conversion, 3181 { ctype = arg11Type, store = arg11Store, updateML = arg11Update, ...}: 'k conversion, 3182 { ctype = arg12Type, store = arg12Store, updateML = arg12Update, ...}: 'l conversion, 3183 { ctype = arg13Type, store = arg13Store, updateML = arg13Update, ...}: 'm conversion), 3184 { ctype = resType, load= resLoad, ...}: 'n conversion): 3185 'a * 'b *'c * 'd * 'e * 'f * 'g * 'h * 'i * 'j * 'k * 'l * 'm -> 'n = 3186 let 3187 val callF = 3188 callwithAbi abi 3189 [arg1Type, arg2Type, arg3Type, arg4Type, arg5Type, arg6Type, arg7Type, 3190 arg8Type, arg9Type, arg10Type, arg11Type, arg12Type, arg13Type] resType fnAddr 3191 val arg1Offset = alignUp(#size resType, #align arg1Type) 3192 val arg2Offset = alignUp(arg1Offset + #size arg1Type, #align arg2Type) 3193 val arg3Offset = alignUp(arg2Offset + #size arg2Type, #align arg3Type) 3194 val arg4Offset = alignUp(arg3Offset + #size arg3Type, #align arg4Type) 3195 val arg5Offset = alignUp(arg4Offset + #size arg4Type, #align arg5Type) 3196 val arg6Offset = alignUp(arg5Offset + #size arg5Type, #align arg6Type) 3197 val arg7Offset = alignUp(arg6Offset + #size arg6Type, #align arg7Type) 3198 val arg8Offset = alignUp(arg7Offset + #size arg7Type, #align arg8Type) 3199 val arg9Offset = alignUp(arg8Offset + #size arg8Type, #align arg9Type) 3200 val arg10Offset = alignUp(arg9Offset + #size arg9Type, #align arg10Type) 3201 val arg11Offset = alignUp(arg10Offset + #size arg10Type, #align arg11Type) 3202 val arg12Offset = alignUp(arg11Offset + #size arg11Type, #align arg12Type) 3203 val arg13Offset = alignUp(arg12Offset + #size arg12Type, #align arg13Type) 3204 val argSpace = arg13Offset + #size arg13Type 3205 in 3206 fn (a, b, c, d, e, f, g, h, i, j, k, l, m) => 3207 let 3208 val rMem = malloc argSpace 3209 val arg1Addr = rMem ++ arg1Offset 3210 val arg2Addr = rMem ++ arg2Offset 3211 val arg3Addr = rMem ++ arg3Offset 3212 val arg4Addr = rMem ++ arg4Offset 3213 val arg5Addr = rMem ++ arg5Offset 3214 val arg6Addr = rMem ++ arg6Offset 3215 val arg7Addr = rMem ++ arg7Offset 3216 val arg8Addr = rMem ++ arg8Offset 3217 val arg9Addr = rMem ++ arg9Offset 3218 val arg10Addr = rMem ++ arg10Offset 3219 val arg11Addr = rMem ++ arg11Offset 3220 val arg12Addr = rMem ++ arg12Offset 3221 val arg13Addr = rMem ++ arg13Offset 3222 val freea = arg1Store (arg1Addr, a) 3223 val freeb = arg2Store (arg2Addr, b) 3224 val freec = arg3Store (arg3Addr, c) 3225 val freed = arg4Store (arg4Addr, d) 3226 val freee = arg5Store (arg5Addr, e) 3227 val freef = arg6Store (arg6Addr, f) 3228 val freeg = arg7Store (arg7Addr, g) 3229 val freeh = arg8Store (arg8Addr, h) 3230 val freei = arg9Store (arg9Addr, i) 3231 val freej = arg10Store (arg10Addr, j) 3232 val freek = arg11Store (arg11Addr, k) 3233 val freel = arg12Store (arg12Addr, l) 3234 val freem = arg13Store (arg13Addr, m) 3235 fun freeAll() = 3236 (freea(); freeb(); freec(); freed(); freee(); freef(); freeg(); 3237 freeh(); freei(); freej(); freek(); freel(); freem(); free rMem) 3238 in 3239 let 3240 val () = 3241 callF([arg1Addr, arg2Addr, arg3Addr, arg4Addr, arg5Addr, arg6Addr, arg7Addr, 3242 arg8Addr, arg9Addr, arg10Addr, arg11Addr, arg12Addr, arg13Addr], rMem) 3243 val result = resLoad rMem 3244 in 3245 arg1Update(arg1Addr, a); arg2Update (arg2Addr, b); arg3Update (arg3Addr, c); 3246 arg4Update (arg4Addr, d); arg5Update (arg5Addr, e); arg6Update (arg6Addr, f); 3247 arg7Update (arg7Addr, g); arg8Update (arg8Addr, h); arg9Update (arg9Addr, i); 3248 arg10Update (arg10Addr, j); arg11Update (arg11Addr, k); arg12Update (arg12Addr, l); 3249 arg13Update (arg13Addr, m); 3250 freeAll(); 3251 result 3252 end handle exn => (freeAll(); raise exn) 3253 end 3254 end 3255 3256 fun buildCall13(symbol, argTypes, resType) = buildCall13withAbi (abiDefault, symbol, argTypes, resType) 3257 3258 fun buildCall14withAbi (abi: abi, fnAddr, 3259 ({ ctype = arg1Type, store = arg1Store, updateML = arg1Update, ...}: 'a conversion, 3260 { ctype = arg2Type, store = arg2Store, updateML = arg2Update, ...}: 'b conversion, 3261 { ctype = arg3Type, store = arg3Store, updateML = arg3Update, ...}: 'c conversion, 3262 { ctype = arg4Type, store = arg4Store, updateML = arg4Update, ...}: 'd conversion, 3263 { ctype = arg5Type, store = arg5Store, updateML = arg5Update, ...}: 'e conversion, 3264 { ctype = arg6Type, store = arg6Store, updateML = arg6Update, ...}: 'f conversion, 3265 { ctype = arg7Type, store = arg7Store, updateML = arg7Update, ...}: 'g conversion, 3266 { ctype = arg8Type, store = arg8Store, updateML = arg8Update, ...}: 'h conversion, 3267 { ctype = arg9Type, store = arg9Store, updateML = arg9Update, ...}: 'i conversion, 3268 { ctype = arg10Type, store = arg10Store, updateML = arg10Update, ...}: 'j conversion, 3269 { ctype = arg11Type, store = arg11Store, updateML = arg11Update, ...}: 'k conversion, 3270 { ctype = arg12Type, store = arg12Store, updateML = arg12Update, ...}: 'l conversion, 3271 { ctype = arg13Type, store = arg13Store, updateML = arg13Update, ...}: 'm conversion, 3272 { ctype = arg14Type, store = arg14Store, updateML = arg14Update, ...}: 'n conversion), 3273 { ctype = resType, load= resLoad, ...}: 'o conversion): 3274 'a * 'b *'c * 'd * 'e * 'f * 'g * 'h * 'i * 'j * 'k * 'l * 'm * 'n -> 'o = 3275 let 3276 val callF = 3277 callwithAbi abi 3278 [arg1Type, arg2Type, arg3Type, arg4Type, arg5Type, arg6Type, arg7Type, 3279 arg8Type, arg9Type, arg10Type, arg11Type, arg12Type, arg13Type, 3280 arg14Type] resType fnAddr 3281 val arg1Offset = alignUp(#size resType, #align arg1Type) 3282 val arg2Offset = alignUp(arg1Offset + #size arg1Type, #align arg2Type) 3283 val arg3Offset = alignUp(arg2Offset + #size arg2Type, #align arg3Type) 3284 val arg4Offset = alignUp(arg3Offset + #size arg3Type, #align arg4Type) 3285 val arg5Offset = alignUp(arg4Offset + #size arg4Type, #align arg5Type) 3286 val arg6Offset = alignUp(arg5Offset + #size arg5Type, #align arg6Type) 3287 val arg7Offset = alignUp(arg6Offset + #size arg6Type, #align arg7Type) 3288 val arg8Offset = alignUp(arg7Offset + #size arg7Type, #align arg8Type) 3289 val arg9Offset = alignUp(arg8Offset + #size arg8Type, #align arg9Type) 3290 val arg10Offset = alignUp(arg9Offset + #size arg9Type, #align arg10Type) 3291 val arg11Offset = alignUp(arg10Offset + #size arg10Type, #align arg11Type) 3292 val arg12Offset = alignUp(arg11Offset + #size arg11Type, #align arg12Type) 3293 val arg13Offset = alignUp(arg12Offset + #size arg12Type, #align arg13Type) 3294 val arg14Offset = alignUp(arg13Offset + #size arg13Type, #align arg14Type) 3295 val argSpace = arg14Offset + #size arg14Type 3296 in 3297 fn (a, b, c, d, e, f, g, h, i, j, k, l, m, n) => 3298 let 3299 val rMem = malloc argSpace 3300 val arg1Addr = rMem ++ arg1Offset 3301 val arg2Addr = rMem ++ arg2Offset 3302 val arg3Addr = rMem ++ arg3Offset 3303 val arg4Addr = rMem ++ arg4Offset 3304 val arg5Addr = rMem ++ arg5Offset 3305 val arg6Addr = rMem ++ arg6Offset 3306 val arg7Addr = rMem ++ arg7Offset 3307 val arg8Addr = rMem ++ arg8Offset 3308 val arg9Addr = rMem ++ arg9Offset 3309 val arg10Addr = rMem ++ arg10Offset 3310 val arg11Addr = rMem ++ arg11Offset 3311 val arg12Addr = rMem ++ arg12Offset 3312 val arg13Addr = rMem ++ arg13Offset 3313 val arg14Addr = rMem ++ arg14Offset 3314 val freea = arg1Store (arg1Addr, a) 3315 val freeb = arg2Store (arg2Addr, b) 3316 val freec = arg3Store (arg3Addr, c) 3317 val freed = arg4Store (arg4Addr, d) 3318 val freee = arg5Store (arg5Addr, e) 3319 val freef = arg6Store (arg6Addr, f) 3320 val freeg = arg7Store (arg7Addr, g) 3321 val freeh = arg8Store (arg8Addr, h) 3322 val freei = arg9Store (arg9Addr, i) 3323 val freej = arg10Store (arg10Addr, j) 3324 val freek = arg11Store (arg11Addr, k) 3325 val freel = arg12Store (arg12Addr, l) 3326 val freem = arg13Store (arg13Addr, m) 3327 val freen = arg14Store (arg14Addr, n) 3328 fun freeAll() = 3329 (freea(); freeb(); freec(); freed(); freee(); freef(); freeg(); 3330 freeh(); freei(); freej(); freek(); freel(); freem(); freen(); free rMem) 3331 in 3332 let 3333 val () = 3334 callF([arg1Addr, arg2Addr, arg3Addr, arg4Addr, arg5Addr, arg6Addr, arg7Addr, 3335 arg8Addr, arg9Addr, arg10Addr, arg11Addr, arg12Addr, arg13Addr, arg14Addr], rMem) 3336 val result = resLoad rMem 3337 in 3338 arg1Update(arg1Addr, a); arg2Update (arg2Addr, b); arg3Update (arg3Addr, c); 3339 arg4Update (arg4Addr, d); arg5Update (arg5Addr, e); arg6Update (arg6Addr, f); 3340 arg7Update (arg7Addr, g); arg8Update (arg8Addr, h); arg9Update (arg9Addr, i); 3341 arg10Update (arg10Addr, j); arg11Update (arg11Addr, k); arg12Update (arg12Addr, l); 3342 arg13Update (arg13Addr, m); arg14Update (arg14Addr, n); 3343 freeAll(); 3344 result 3345 end handle exn => (freeAll(); raise exn) 3346 end 3347 end 3348 3349 fun buildCall14(symbol, argTypes, resType) = buildCall14withAbi (abiDefault, symbol, argTypes, resType) 3350 3351 end 3352 3353 (* A closure is a memoised address. *) 3354 type 'a closure = unit -> Memory.voidStar 3355 3356 local 3357 open Memory LowLevel 3358 fun load _ = raise Foreign "Cannot return a closure" 3359 (* "dememoise" the value when we store it. This means that the closure is actually 3360 created when the value is first stored and then it is cached. *) 3361 and store(v, cl: ('a->'b) closure) = (Memory.setAddress(v, 0w0, cl()); fn () => ()) 3362 in 3363 val cFunction: ('a->'b) closure conversion = 3364 makeConversion { load=load, store=store, ctype = LowLevel.cTypePointer } 3365 end 3366 3367 local 3368 open LibFFI Memory LowLevel 3369 in 3370 fun buildClosure0withAbi(f: unit-> 'a, abi: abi, (), resConv: 'a conversion): (unit->'a) closure = 3371 let 3372 fun callback (f: unit -> 'a) (_: voidStar, res: voidStar): unit = 3373 ignore(#store resConv (res, f ())) 3374 (* Ignore the result of #store resConv. What this means is if the 3375 callback returns something, e.g. a string, that requires 3376 dynamic allocation there will be a memory leak. *) 3377 3378 val makeCallback = cFunctionWithAbi abi [] (#ctype resConv) 3379 in 3380 Memory.memoise (fn () => makeCallback(callback f)) () 3381 end 3382 3383 fun buildClosure0(f, argConv, resConv) = buildClosure0withAbi(f, abiDefault, argConv, resConv) 3384 3385 fun buildClosure1withAbi (f: 'a -> 'b, abi: abi, argConv: 'a conversion, resConv: 'b conversion) : ('a -> 'b) closure = 3386 let 3387 fun callback (f: 'a -> 'b) (args: voidStar, res: voidStar): unit = 3388 let 3389 val arg1Addr = getAddress(args, 0w0) 3390 val arg1 = #load argConv arg1Addr 3391 val result = f arg1 3392 val () = #updateC argConv (arg1Addr, arg1) 3393 in 3394 ignore(#store resConv (res, result)) 3395 end 3396 3397 val makeCallback = cFunctionWithAbi abi [#ctype argConv] (#ctype resConv) 3398 in 3399 Memory.memoise (fn () => makeCallback(callback f)) () 3400 end 3401 3402 fun buildClosure1(f, argConv, resConv) = buildClosure1withAbi(f, abiDefault, argConv, resConv) 3403 3404 fun buildClosure2withAbi 3405 (f: 'a * 'b -> 'c, abi: abi, (arg1Conv: 'a conversion, arg2Conv: 'b conversion), resConv: 'c conversion) : 3406 ('a * 'b -> 'c) closure = 3407 let 3408 fun callback (f: 'a *'b -> 'c) (args: voidStar, res: voidStar): unit = 3409 let 3410 val arg1Addr = getAddress(args, 0w0) 3411 and arg2Addr = getAddress(args, 0w1) 3412 val arg1 = #load arg1Conv arg1Addr 3413 and arg2 = #load arg2Conv arg2Addr 3414 3415 val result = f (arg1, arg2) 3416 3417 val () = #updateC arg1Conv(arg1Addr, arg1) 3418 and () = #updateC arg2Conv(arg2Addr, arg2) 3419 in 3420 ignore(#store resConv (res, result)) 3421 end 3422 3423 val argTypes = [#ctype arg1Conv, #ctype arg2Conv] 3424 and resType = #ctype resConv 3425 3426 val makeCallback = cFunctionWithAbi abi argTypes resType 3427 in 3428 Memory.memoise (fn () => makeCallback(callback f)) () 3429 end 3430 3431 fun buildClosure2(f, argConv, resConv) = buildClosure2withAbi(f, abiDefault, argConv, resConv) 3432 3433 fun buildClosure3withAbi 3434 (f, abi, (arg1Conv: 'a conversion, arg2Conv: 'b conversion, arg3Conv: 'c conversion), resConv: 'd conversion) = 3435 let 3436 fun callback (f: 'a *'b * 'c -> 'd) (args: voidStar, res: voidStar): unit = 3437 let 3438 val arg1Addr = getAddress(args, 0w0) 3439 and arg2Addr = getAddress(args, 0w1) 3440 and arg3Addr = getAddress(args, 0w2) 3441 val arg1 = #load arg1Conv arg1Addr 3442 and arg2 = #load arg2Conv arg2Addr 3443 and arg3 = #load arg3Conv arg3Addr 3444 3445 val result = f (arg1, arg2, arg3) 3446 3447 val () = #updateC arg1Conv(arg1Addr, arg1) 3448 and () = #updateC arg2Conv(arg2Addr, arg2) 3449 and () = #updateC arg3Conv(arg3Addr, arg3) 3450 in 3451 ignore(#store resConv (res, result)) 3452 end 3453 3454 val argTypes = 3455 [#ctype arg1Conv, #ctype arg2Conv, #ctype arg3Conv] 3456 and resType = #ctype resConv 3457 3458 val makeCallback = cFunctionWithAbi abi argTypes resType 3459 in 3460 Memory.memoise (fn () => makeCallback(callback f)) () 3461 end 3462 3463 fun buildClosure3(f, argConv, resConv) = buildClosure3withAbi(f, abiDefault, argConv, resConv) 3464 3465 fun buildClosure4withAbi 3466 (f, abi, 3467 (arg1Conv: 'a conversion, arg2Conv: 'b conversion, arg3Conv: 'c conversion, arg4Conv: 'd conversion), 3468 resConv: 'e conversion) = 3469 let 3470 fun callback (f: 'a *'b * 'c * 'd -> 'e) (args: voidStar, res: voidStar): unit = 3471 let 3472 val arg1Addr = getAddress(args, 0w0) 3473 and arg2Addr = getAddress(args, 0w1) 3474 and arg3Addr = getAddress(args, 0w2) 3475 and arg4Addr = getAddress(args, 0w3) 3476 val arg1 = #load arg1Conv arg1Addr 3477 and arg2 = #load arg2Conv arg2Addr 3478 and arg3 = #load arg3Conv arg3Addr 3479 and arg4 = #load arg4Conv arg4Addr 3480 3481 val result = f (arg1, arg2, arg3, arg4) 3482 3483 val () = #updateC arg1Conv(arg1Addr, arg1) 3484 and () = #updateC arg2Conv(arg2Addr, arg2) 3485 and () = #updateC arg3Conv(arg3Addr, arg3) 3486 and () = #updateC arg4Conv(arg4Addr, arg4) 3487 in 3488 ignore(#store resConv (res, result)) 3489 end 3490 3491 val argTypes = 3492 [#ctype arg1Conv, #ctype arg2Conv, #ctype arg3Conv, #ctype arg4Conv] 3493 and resType = #ctype resConv 3494 3495 val makeCallback = cFunctionWithAbi abi argTypes resType 3496 in 3497 Memory.memoise (fn () => makeCallback(callback f)) () 3498 end 3499 3500 fun buildClosure4(f, argConv, resConv) = buildClosure4withAbi(f, abiDefault, argConv, resConv) 3501 3502 fun buildClosure5withAbi 3503 (f, abi, 3504 (arg1Conv: 'a conversion, arg2Conv: 'b conversion, arg3Conv: 'c conversion, 3505 arg4Conv: 'd conversion, arg5Conv: 'e conversion), 3506 resConv: 'f conversion) = 3507 let 3508 fun callback (f: 'a *'b * 'c * 'd * 'e -> 'f) (args: voidStar, res: voidStar): unit = 3509 let 3510 val arg1Addr = getAddress(args, 0w0) 3511 and arg2Addr = getAddress(args, 0w1) 3512 and arg3Addr = getAddress(args, 0w2) 3513 and arg4Addr = getAddress(args, 0w3) 3514 and arg5Addr = getAddress(args, 0w4) 3515 val arg1 = #load arg1Conv arg1Addr 3516 and arg2 = #load arg2Conv arg2Addr 3517 and arg3 = #load arg3Conv arg3Addr 3518 and arg4 = #load arg4Conv arg4Addr 3519 and arg5 = #load arg5Conv arg5Addr 3520 3521 val result = f (arg1, arg2, arg3, arg4, arg5) 3522 3523 val () = #updateC arg1Conv(arg1Addr, arg1) 3524 and () = #updateC arg2Conv(arg2Addr, arg2) 3525 and () = #updateC arg3Conv(arg3Addr, arg3) 3526 and () = #updateC arg4Conv(arg4Addr, arg4) 3527 and () = #updateC arg5Conv(arg5Addr, arg5) 3528 in 3529 ignore(#store resConv (res, result)) 3530 end 3531 3532 val argTypes = 3533 [#ctype arg1Conv, #ctype arg2Conv, #ctype arg3Conv, 3534 #ctype arg4Conv, #ctype arg5Conv] 3535 and resType = #ctype resConv 3536 3537 val makeCallback = cFunctionWithAbi abi argTypes resType 3538 in 3539 Memory.memoise (fn () => makeCallback(callback f)) () 3540 end 3541 3542 fun buildClosure5(f, argConv, resConv) = buildClosure5withAbi(f, abiDefault, argConv, resConv) 3543 3544 fun buildClosure6withAbi 3545 (f, abi, 3546 (arg1Conv: 'a conversion, arg2Conv: 'b conversion, arg3Conv: 'c conversion, 3547 arg4Conv: 'd conversion, arg5Conv: 'e conversion, arg6Conv: 'f conversion), 3548 resConv: 'g conversion) = 3549 let 3550 fun callback (f: 'a *'b * 'c * 'd * 'e * 'f -> 'g) (args: voidStar, res: voidStar): unit = 3551 let 3552 val arg1Addr = getAddress(args, 0w0) 3553 and arg2Addr = getAddress(args, 0w1) 3554 and arg3Addr = getAddress(args, 0w2) 3555 and arg4Addr = getAddress(args, 0w3) 3556 and arg5Addr = getAddress(args, 0w4) 3557 and arg6Addr = getAddress(args, 0w5) 3558 val arg1 = #load arg1Conv arg1Addr 3559 and arg2 = #load arg2Conv arg2Addr 3560 and arg3 = #load arg3Conv arg3Addr 3561 and arg4 = #load arg4Conv arg4Addr 3562 and arg5 = #load arg5Conv arg5Addr 3563 and arg6 = #load arg6Conv arg6Addr 3564 3565 val result = f (arg1, arg2, arg3, arg4, arg5, arg6) 3566 3567 val () = #updateC arg1Conv(arg1Addr, arg1) 3568 and () = #updateC arg2Conv(arg2Addr, arg2) 3569 and () = #updateC arg3Conv(arg3Addr, arg3) 3570 and () = #updateC arg4Conv(arg4Addr, arg4) 3571 and () = #updateC arg5Conv(arg5Addr, arg5) 3572 and () = #updateC arg6Conv(arg6Addr, arg6) 3573 in 3574 ignore(#store resConv (res, result)) 3575 end 3576 3577 val argTypes = 3578 [#ctype arg1Conv, #ctype arg2Conv, #ctype arg3Conv, 3579 #ctype arg4Conv, #ctype arg5Conv, #ctype arg6Conv] 3580 and resType = #ctype resConv 3581 3582 val makeCallback = cFunctionWithAbi abi argTypes resType 3583 in 3584 Memory.memoise (fn () => makeCallback(callback f)) () 3585 end 3586 3587 fun buildClosure6(f, argConv, resConv) = buildClosure6withAbi(f, abiDefault, argConv, resConv) 3588 3589 end 3590end; 3591