Vm-dev September 2021

vm-dev@lists.squeakfoundation.org

15 participants
137 discussions

[OpenSmalltalk/opensmalltalk-vm] f5d6e7: Add an option to not print the bitness of the VM i...
by Eliot Miranda 17 Sep '21

17 Sep '21

Branch: refs/heads/Cog Home: https://github.com/OpenSmalltalk/opensmalltalk-vm Commit: f5d6e73699af0fdd1e14b2702cbac109b5892164 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/f5d6e73699af0fdd1e… Author: Eliot Miranda <eliot.miranda(a)gmail.com> Date: 2021-09-15 (Wed, 15 Sep 2021) Changed paths: M platforms/Cross/vm/sqSCCSVersion.h Log Message: ----------- Add an option to not print the bitness of the VM in getversion. P.S. some clients already use this tag in production...

3 2

[OpenSmalltalk/opensmalltalk-vm] bbcace: CogVM source as per VMMaker.oscog-eem.3071
by Eliot Miranda 17 Sep '21

17 Sep '21

Branch: refs/heads/Cog Home: https://github.com/OpenSmalltalk/opensmalltalk-vm Commit: bbcacee31f9de4c009d3690de151792bd1ba3b9e https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/bbcacee31f9de4c009… Author: Eliot Miranda <eliot.miranda(a)gmail.com> Date: 2021-09-16 (Thu, 16 Sep 2021) Changed paths: M platforms/Cross/vm/sqCogStackAlignment.h M src/spur32.cog/cogit.h M src/spur32.cog/cogitARMv5.c M src/spur32.cog/cogitIA32.c M src/spur32.cog/cointerp.c M src/spur32.cog/cointerp.h M src/spur32.cog/gcc3x-cointerp.c M src/spur32.sista/cogit.h M src/spur32.sista/cogitARMv5.c M src/spur32.sista/cogitIA32.c M src/spur32.sista/cointerp.c M src/spur32.sista/cointerp.h M src/spur32.sista/gcc3x-cointerp.c M src/spur64.cog/cogit.h M src/spur64.cog/cogitARMv8.c M src/spur64.cog/cogitX64SysV.c M src/spur64.cog/cogitX64WIN64.c M src/spur64.cog/cointerp.c M src/spur64.cog/cointerp.h M src/spur64.cog/gcc3x-cointerp.c M src/spur64.sista/cogit.h M src/spur64.sista/cogitARMv8.c M src/spur64.sista/cogitX64SysV.c M src/spur64.sista/cogitX64WIN64.c M src/spur64.sista/cointerp.c M src/spur64.sista/cointerp.h M src/spur64.sista/gcc3x-cointerp.c M src/v3.cog/cogit.h M src/v3.cog/cogitARMv5.c M src/v3.cog/cogitIA32.c M src/v3.cog/cointerp.c M src/v3.cog/cointerp.h M src/v3.cog/gcc3x-cointerp.c Log Message: ----------- CogVM source as per VMMaker.oscog-eem.3071 Allow cFramePointerInUse to be defined at compile time. Some compilers do not use the frame pointer consistently and don't allow overriding their inconsistent use (clang-cl 10).

1 0

VM Maker: VMMaker.oscog-eem.3071.mcz
by commits＠source.squeak.org 17 Sep '21

17 Sep '21

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.3071.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.3071 Author: eem Time: 16 September 2021, 7:49:59.194516 pm UUID: ae226d69-be9f-4f7a-a138-0c85163277dd Ancestors: VMMaker.oscog-eem.3070 Allow cFramePointerInUse to be defined at compile time. Some compilers do not use the frame pointer consistently and don't allow overriding their inconsistent use (clang-cl 10). Clue StackDepthFinder into the implicit literal enumeration fix. =============== Diff against VMMaker.oscog-eem.3070 =============== Item was changed: ----- Method: CoInterpreter>>checkIfCFramePointerInUse (in category 'cog jit support') ----- checkIfCFramePointerInUse <api> "Necessary because we very much want CStackPointer and CFramePointer to be static/private and grouped + with other interpreter variables which will hence be accessed via VarBaseReg on platforms that have one." - with other interpreter variables which will hence be accessed via VarBaseReg on platforms trhat have one." ^self isCFramePointerInUse: (self addressOf: CFramePointer) _: (self addressOf: CStackPointer)! Item was changed: ----- Method: CoInterpreter>>enterSmalltalkExecutiveImplementation (in category 'initialization') ----- enterSmalltalkExecutiveImplementation "Main entry-point into the interpreter at each execution level, where an execution level is either the start of execution or reentry for a callback. Capture the C stack pointers so that calls from machine-code into the C run-time occur at this level. This is the actual implementation, separated from enterSmalltalkExecutive so the + simulator can wrap it in an exception handler and hence simulate the Cogit's jump + back into C code on interpreting; see ceInvokeInterpret. + + Conceptually, an invocation of interpret exists at each level of execution from the + initial invocation through each callback. Entry to each execution level is through + this function. It captures the C stack & frame pointers for this level of execution + and then either invokes machine code or interpret, depending on whether the + current frame (the effective entry-point into Smalltalk execution) is a machine code + or interpreted frame. In addition, interpret captures the return address of its caller + (this funciton). The Cogit then uses the captured C stack pointers and return + address to invoke interpret as if it had been called from this function." - simulator can wrap it in an exception handler and hence simulate the setjmp/longjmp." <inline: false> cogit assertCStackWellAligned. cogit ceCaptureCStackPointers. (self isMachineCodeFrame: framePointer) ifTrue: [self returnToExecutive: false postContextSwitch: true "NOTREACHED"]. self interpret. ^0! Item was changed: ----- Method: Cogit class>>declareCVarsIn: (in category 'translation') ----- declareCVarsIn: aCCodeGenerator | backEnd | backEnd := CogCompilerClass basicNew. #( 'coInterpreter' 'objectMemory' 'methodZone' 'objectRepresentation' 'cogBlockMethodSurrogateClass' 'cogMethodSurrogateClass' 'nsSendCacheSurrogateClass' 'threadManager' 'processor' 'lastNInstructions' 'simulatedAddresses' 'ioHighResClock' 'simulatedTrampolines' 'simulatedVariableGetters' 'simulatedVariableSetters' 'processorFrameValid' 'printRegisters' 'printInstructions' 'clickConfirm' 'singleStep' 'codeZoneIsExecutableNotWritable' 'debugAPISelector' 'shortCutTrampolineBlocks' 'perMethodProfile' 'instructionProfile') do: [:simulationVariableUnusedByRealVM| aCCodeGenerator removeVariable: simulationVariableUnusedByRealVM]. NewspeakVM ifFalse: [#( 'selfSendTrampolines' 'dynamicSuperSendTrampolines' 'implicitReceiverSendTrampolines' 'outerSendTrampolines' 'ceEnclosingObjectTrampoline' 'numIRCs' 'indexOfIRC' 'theIRCs') do: [:variableNotNeededInNormalVM| aCCodeGenerator removeVariable: variableNotNeededInNormalVM]]. aCCodeGenerator removeConstant: #COGMTVM. "this should be defined at compile time" "N.B. We *do not* include sq.h; it pulls in conflicting definitions now that sqVirtualMachine.h declares cointerp's functions, and declares some of them inaccurately for histrical reasons. We pull in CoInterpreter's api via cointerp.h which is accurate." aCCodeGenerator addHeaderFile:'"sqConfig.h"'; "config.h must be first on linux" addHeaderFile:'<stddef.h>'; "for e.g. offsetof" addHeaderFile:'<stdio.h>'; addHeaderFile:'<stdlib.h>'; addHeaderFile:'<string.h>'; addHeaderFile:'"sqPlatformSpecific.h"'; "e.g. solaris overrides things for sqCogStackAlignment.h" addHeaderFile:'"sqMemoryAccess.h"'; addHeaderFile:'"sqCogStackAlignment.h"'; addHeaderFile:'"dispdbg.h"'; "must precede cointerp.h & cogit.h otherwise NoDbgRegParms gets screwed up" addHeaderFile:'"cogmethod.h"'. NewspeakVM ifTrue: [aCCodeGenerator addHeaderFile:'"nssendcache.h"']. aCCodeGenerator addHeaderFile:'#if COGMTVM'; addHeaderFile:'"cointerpmt.h"'; addHeaderFile:'#else'; addHeaderFile:'"cointerp.h"'; addHeaderFile:'#endif'; addHeaderFile:'"cogit.h"'. aCCodeGenerator var: #ceGetFP declareC: 'usqIntptr_t (*ceGetFP)(void)'; var: #ceGetSP declareC: 'usqIntptr_t (*ceGetSP)(void)'; var: #ceCaptureCStackPointers declareC: 'void (*ceCaptureCStackPointers)(void)'; var: #ceInvokeInterpret declareC: 'void (*ceInvokeInterpret)(void)'; var: #ceEnterCogCodePopReceiverReg declareC: 'void (*ceEnterCogCodePopReceiverReg)(void)'; var: #realCEEnterCogCodePopReceiverReg declareC: 'void (*realCEEnterCogCodePopReceiverReg)(void)'; var: #ceCallCogCodePopReceiverReg declareC: 'void (*ceCallCogCodePopReceiverReg)(void)'; var: #realCECallCogCodePopReceiverReg declareC: 'void (*realCECallCogCodePopReceiverReg)(void)'; var: #ceCallCogCodePopReceiverAndClassRegs declareC: 'void (*ceCallCogCodePopReceiverAndClassRegs)(void)'; var: #realCECallCogCodePopReceiverAndClassRegs declareC: 'void (*realCECallCogCodePopReceiverAndClassRegs)(void)'; var: #postCompileHook declareC: 'void (*postCompileHook)(CogMethod *)'; var: #openPICList declareC: 'CogMethod *openPICList = 0'; var: #maxMethodBefore type: #'CogBlockMethod *'; var: 'enumeratingCogMethod' type: #'CogMethod *'. aCCodeGenerator var: #ceTryLockVMOwner declareC: '#if COGMTVM\usqIntptr_t (*ceTryLockVMOwner)(usqIntptr_t)\#endif'. backEnd numICacheFlushOpcodes > 0 ifTrue: [aCCodeGenerator var: #ceFlushICache declareC: 'static void (*ceFlushICache)(usqIntptr_t from, usqIntptr_t to)']. aCCodeGenerator var: #ceFlushDCache declareC: '#if DUAL_MAPPED_CODE_ZONE\static void (*ceFlushDCache)(usqIntptr_t from, usqIntptr_t to)\#endif'; var: #codeToDataDelta + declareC: '#if DUAL_MAPPED_CODE_ZONE\static sqInt codeToDataDelta\#else\# define codeToDataDelta 0\#endif'; + var: #cFramePointerInUse + declareC: '#if !!defined(cFramePointerInUse)\sqInt cFramePointerInUse\#endif'. - declareC: '#if DUAL_MAPPED_CODE_ZONE\static sqInt codeToDataDelta\#else\# define codeToDataDelta 0\#endif'. aCCodeGenerator declareVar: 'aMethodLabel' type: #'AbstractInstruction'; "Has to come lexicographically before backEnd & methodLabel" var: #backEnd declareC: 'AbstractInstruction * const backEnd = &aMethodLabel'; var: #methodLabel declareC: 'AbstractInstruction * const methodLabel = &aMethodLabel'. self declareC: #(abstractOpcodes stackCheckLabel blockEntryLabel blockEntryNoContextSwitch stackOverflowCall sendMiss entry noCheckEntry selfSendEntry dynSuperEntry fullBlockNoContextSwitchEntry fullBlockEntry picMNUAbort picInterpretAbort endCPICCase0 endCPICCase1 cPICEndOfCodeLabel) as: #'AbstractInstruction *' in: aCCodeGenerator. aCCodeGenerator declareVar: #cPICPrototype type: #'CogMethod *'; declareVar: #blockStarts type: #'BlockStart *'; declareVar: #fixups type: #'BytecodeFixup *'; declareVar: #methodZoneBase type: #usqInt. aCCodeGenerator var: #ordinarySendTrampolines declareC: 'sqInt ordinarySendTrampolines[NumSendTrampolines]'; var: #superSendTrampolines declareC: 'sqInt superSendTrampolines[NumSendTrampolines]'. BytecodeSetHasDirectedSuperSend ifTrue: [aCCodeGenerator var: #directedSuperSendTrampolines declareC: 'sqInt directedSuperSendTrampolines[NumSendTrampolines]'; var: #directedSuperBindingSendTrampolines declareC: 'sqInt directedSuperBindingSendTrampolines[NumSendTrampolines]']. NewspeakVM ifTrue: [aCCodeGenerator var: #selfSendTrampolines declareC: 'sqInt selfSendTrampolines[NumSendTrampolines]'; var: #dynamicSuperSendTrampolines declareC: 'sqInt dynamicSuperSendTrampolines[NumSendTrampolines]'; var: #implicitReceiverSendTrampolines declareC: 'sqInt implicitReceiverSendTrampolines[NumSendTrampolines]'; var: #outerSendTrampolines declareC: 'sqInt outerSendTrampolines[NumSendTrampolines]']. aCCodeGenerator addConstantForBinding: self bindingForNumTrampolines; var: #trampolineAddresses declareC: 'static char *trampolineAddresses[NumTrampolines*2]'; var: #objectReferencesInRuntime declareC: 'static usqInt objectReferencesInRuntime[NumObjRefsInRuntime+1]'; var: #labelCounter type: #int; var: #traceFlags declareC: 'int traceFlags = 8 /* prim trace log on by default */'; var: #cStackAlignment declareC: 'const int cStackAlignment = STACK_ALIGN_BYTES'. aCCodeGenerator declareVar: #minValidCallAddress type: #'usqIntptr_t'. aCCodeGenerator vmClass generatorTable ifNotNil: [:bytecodeGenTable| aCCodeGenerator var: #generatorTable declareC: 'static BytecodeDescriptor generatorTable[', bytecodeGenTable size printString, ']', (self tableInitializerFor: bytecodeGenTable in: aCCodeGenerator)]. "In C the abstract opcode names clash with the Smalltalk generator syntactic sugar. Most of the syntactic sugar is inlined, but alas some remains. Rename the syntactic sugar to avoid the clash." (self organization listAtCategoryNamed: #'abstract instructions') do: [:s| aCCodeGenerator addSelectorTranslation: s to: 'g', (aCCodeGenerator cFunctionNameFor: s)]. aCCodeGenerator addSelectorTranslation: #halt: to: 'haltmsg'. self declareFlagVarsAsByteIn: aCCodeGenerator! Item was changed: ----- Method: Cogit>>generateStackPointerCapture (in category 'initialization') ----- generateStackPointerCapture "Generate a routine ceCaptureCStackPointers that will capture the C stack pointer, and, if it is in use, the C frame pointer. These are used in trampolines to call run-time routines in the interpreter from machine-code." + self cppIf: #cFramePointerInUse defined + ifTrue: + [self assertCStackWellAligned. + self generateCaptureCStackPointers: cFramePointerInUse] + ifFalse: + [| oldMethodZoneBase oldTrampolineTableIndex | + cFramePointerInUse := false. "For the benefit of the following assert, assume the minimum at first." + self assertCStackWellAligned. + oldMethodZoneBase := methodZoneBase. + oldTrampolineTableIndex := trampolineTableIndex. + self generateCaptureCStackPointers: true. + self perform: #ceCaptureCStackPointers. + (cFramePointerInUse := coInterpreter checkIfCFramePointerInUse) ifFalse: + [methodZoneBase := oldMethodZoneBase. + trampolineTableIndex := oldTrampolineTableIndex. + self generateCaptureCStackPointers: false]]. - | oldMethodZoneBase oldTrampolineTableIndex | - cFramePointerInUse := false. "For the benefit of the following assert, assume the minimum at first." - self assertCStackWellAligned. - oldMethodZoneBase := methodZoneBase. - oldTrampolineTableIndex := trampolineTableIndex. - self generateCaptureCStackPointers: true. - self perform: #ceCaptureCStackPointers. - (cFramePointerInUse := coInterpreter checkIfCFramePointerInUse) ifFalse: - [methodZoneBase := oldMethodZoneBase. - trampolineTableIndex := oldTrampolineTableIndex. - self generateCaptureCStackPointers: false]. self ensureWritableCodeZone. self assertCStackWellAligned! Item was added: + ----- Method: StackDepthFinder>>pushSpecialConstant: (in category 'instruction decoding implicit literals') ----- + pushSpecialConstant: value + ^self pushConstant: value! Item was added: + ----- Method: StackDepthFinder>>sendSpecial:numArgs: (in category 'instruction decoding implicit literals') ----- + sendSpecial: aSymbol numArgs: numArgs + ^self send: aSymbol super: false numArgs: numArgs!

1 0

VM Maker: FileAttributesPlugin.oscog-eem.61.mcz
by commits＠source.squeak.org 17 Sep '21

17 Sep '21

Eliot Miranda uploaded a new version of FileAttributesPlugin to project VM Maker: http://source.squeak.org/VMMaker/FileAttributesPlugin.oscog-eem.61.mcz ==================== Summary ==================== Name: FileAttributesPlugin.oscog-eem.61 Author: eem Time: 16 September 2021, 7:32:06.488584 pm UUID: bf616f5a-459a-4d9a-b061-d887e3107deb Ancestors: FileAttributesPlugin.oscog-eem.60 Eliminate a compiler warning. =============== Diff against FileAttributesPlugin.oscog-eem.60 =============== Item was changed: ----- Method: FileAttributesPlugin class>>declareCVarsIn: (in category 'translation') ----- declareCVarsIn: cg self declareC: #('sCLPfn' 'sCOFfn') as: #'void *' in: cg. "Assume the security plugin can be loaded until proven otherwise" cg var: 'hasSecurityPlugin' declareC: 'int hasSecurityPlugin = 1'. cg addHeaderFile: '<errno.h>'. cg addHeaderFile: '<limits.h>'. cg addHeaderFile: '<sys/types.h> #if _WIN32 || _WIN64 + # include <Windows.h> + # include <WinBase.h> - # include <windows.h> - # include <winbase.h> # if !!defined(_MSC_VER) /* i.e. cygwin or mingw */ # include <unistd.h> # include <dirent.h> # endif # define FAIL() { return -1; } # include "sqWin32File.h" # if !!defined(PATH_MAX) /* work around bug in 64-bit cygwin; sigh :-( */ # define PATH_MAX 4096 # endif # define HAVE_CHMOD 0 # define HAVE_CHOWN 0 #else # include <unistd.h> # include <dirent.h> # define HAVE_CHMOD 1 # define HAVE_CHOWN 1 #endif'. cg addHeaderFile: '"faCommon.h"'. cg addHeaderFile: '<sys/stat.h> #if !!defined(HAVE_LSTAT) && !!defined(_WIN32) && !!defined(_WIN64) # define HAVE_LSTAT 1 #endif /* AKG 2018 - ', self moduleName, '.c translated from class ', self name, ' */'!

1 0

OSProcessPlugin: VMConstruction-Plugins-OSProcessPlugin.oscog-eem.74.mcz
by squeak-dev-noreply＠lists.squeakfoundation.org 17 Sep '21

17 Sep '21

Eliot Miranda uploaded a new version of VMConstruction-Plugins-OSProcessPlugin to project OSProcessPlugin: http://www.squeaksource.com/OSProcessPlugin/VMConstruction-Plugins-OSProces… ==================== Summary ==================== Name: VMConstruction-Plugins-OSProcessPlugin.oscog-eem.74 Author: eem Time: 16 September 2021, 7:31:19.642618 pm UUID: f1be6e33-7c83-4bd0-b310-e8f42ad4e4a3 Ancestors: VMConstruction-Plugins-OSProcessPlugin.oscog-eem.73 Eliminate a compiler warning

1 0

[OpenSmalltalk/opensmalltalk-vm] ab171a: Oops! Delete platforms/win32/plugins/SqueakFFIPrim...
by Eliot Miranda 16 Sep '21

16 Sep '21

Branch: refs/heads/Cog Home: https://github.com/OpenSmalltalk/opensmalltalk-vm Commit: ab171a6524fe81e52b2f12905e7c631516aea4a4 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/ab171a6524fe81e52b… Author: Eliot Miranda <eliot.miranda(a)gmail.com> Date: 2021-09-16 (Thu, 16 Sep 2021) Changed paths: A platforms/Cross/plugins/SqueakFFIPrims/sqFFIPlugin.c M platforms/win32/plugins/SqueakFFIPrims/Makefile M platforms/win32/plugins/SqueakFFIPrims/Makefile.msvc M platforms/win32/plugins/SqueakFFIPrims/Makefile.plugin R platforms/win32/plugins/SqueakFFIPrims/sqWin32FFI.c Log Message: ----------- Oops! Delete platforms/win32/plugins/SqueakFFIPrims/sqWin32FFI.c which provides obsolete support. platforms/Cross/plugins/SqueakFFIPrims/sqFFIPlugin.c is very much in use! Undo the damage of e632352f11dfa9d0b5ba69b1e7fec7d750b0a7ba

1 0

[OpenSmalltalk/opensmalltalk-vm] e63235: Nuke sqFFIPlugin.c which provides support for the ...
by Eliot Miranda 16 Sep '21

16 Sep '21

Branch: refs/heads/Cog Home: https://github.com/OpenSmalltalk/opensmalltalk-vm Commit: e632352f11dfa9d0b5ba69b1e7fec7d750b0a7ba https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/e632352f11dfa9d0b5… Author: Eliot Miranda <eliot.miranda(a)gmail.com> Date: 2021-09-16 (Thu, 16 Sep 2021) Changed paths: R platforms/Cross/plugins/SqueakFFIPrims/sqFFIPlugin.c M platforms/Cross/vm/sqPath.c M platforms/win32/plugins/SqueakFFIPrims/Makefile M platforms/win32/plugins/SqueakFFIPrims/Makefile.msvc M platforms/win32/plugins/SqueakFFIPrims/Makefile.plugin M platforms/win32/plugins/SqueakFFIPrims/sqWin32FFI.c Log Message: ----------- Nuke sqFFIPlugin.c which provides support for the old FFIPlugin. Fix a couple of windows.h => Windows.h

1 0

[OpenSmalltalk/opensmalltalk-vm] 0b4abd: CogVM source as per VMMaker.oscog-eem.3070
by Eliot Miranda 16 Sep '21

16 Sep '21

Branch: refs/heads/Cog Home: https://github.com/OpenSmalltalk/opensmalltalk-vm Commit: 0b4abd6c8d3cc938530b453d8090d4498abf5d43 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/0b4abd6c8d3cc93853… Author: Eliot Miranda <eliot.miranda(a)gmail.com> Date: 2021-09-16 (Thu, 16 Sep 2021) Changed paths: M src/plugins/SqueakFFIPrims/ARM32FFIPlugin.c M src/plugins/SqueakFFIPrims/ARM64FFIPlugin.c M src/plugins/SqueakFFIPrims/IA32FFIPlugin.c M src/plugins/SqueakFFIPrims/X64SysVFFIPlugin.c M src/plugins/SqueakFFIPrims/X64Win64FFIPlugin.c Log Message: ----------- CogVM source as per VMMaker.oscog-eem.3070 ThreadedFFIPlugin: Add support for 16 & 32-bit characters. Rename by value integer/character marshalling methods from Byte,Short,Int,LongLong, to 8,16,32,64

1 0

VM Maker: VMMaker.oscog-eem.3070.mcz
by commits＠source.squeak.org 16 Sep '21

16 Sep '21

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.3070.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.3070 Author: eem Time: 16 September 2021, 11:29:25.055321 am UUID: 3819b51a-e88e-4c94-b648-2921efd6a46d Ancestors: VMMaker.oscog-mt.3069 ThreadedFFIPlugin: Add support for 16 & 32-bit characters. Rename by value integer/characetr marshalling methods from Byte,Short,Int,LongLong, to 8,16,32,64 Nuke the FFIPlugin; it's truly obsolete now. =============== Diff against VMMaker.oscog-mt.3069 =============== Item was removed: - InterpreterPlugin subclass: #FFIPlugin - instanceVariableNames: 'ffiLastError ffiArgSpec ffiArgSpecSize ffiArgHeader ffiRetOop ffiRetClass ffiRetSpec ffiRetSpecSize ffiRetHeader ffiLogEnabled externalFunctionInstSize' - classVariableNames: '' - poolDictionaries: 'FFIConstants' - category: 'VMMaker-Plugins-FFI'! - - !FFIPlugin commentStamp: 'eem 11/24/2014 11:00' prior: 0! - This plugin provides access to foreign function interfaces on those platforms that provide such. For example Windows DLLs and unix .so's. It is obsolete, having been superceded by the ThreadedFFIPlugin.! Item was removed: - ----- Method: FFIPlugin class>>declareCVarsIn: (in category 'accessing') ----- - declareCVarsIn: aCCodeGen - aCCodeGen addHeaderFile: '"sqFFI.h"'! Item was removed: - ----- Method: FFIPlugin class>>hasHeaderFile (in category 'C support code') ----- - hasHeaderFile - "If there is a single intrinsic header file to be associated with the plugin, here is where you want to flag" - ^true! Item was removed: - ----- Method: FFIPlugin class>>moduleName (in category 'translation') ----- - moduleName "FFIPlugin translate" - "IMPORTANT: IF YOU CHANGE THE NAME OF THIS PLUGIN YOU MUST CHANGE - Interpreter>>primitiveCalloutToFFI - TO REFLECT THE CHANGE." - ^'SqueakFFIPrims (Obsolete)'! Item was removed: - ----- Method: FFIPlugin class>>requiresPlatformFiles (in category 'translation') ----- - requiresPlatformFiles - "this plugin requires platform specific files in order to work" - ^true! Item was removed: - ----- Method: FFIPlugin>>atomicTypeOf: (in category 'primitive support') ----- - atomicTypeOf: value - ^(value bitAnd: FFIAtomicTypeMask) >> FFIAtomicTypeShift! Item was removed: - ----- Method: FFIPlugin>>ffiAddressOf:startingAt:size: (in category 'primitive support') ----- - ffiAddressOf: rcvr startingAt: byteOffset size: byteSize - "return an int of the address of the byteSize slot (byte, short, int, whatever) at byteOffset in rcvr. Nominally intended for use with ExternalAddress objects, this code will work (for obscure historical reasons) with plain Byte or Word Arrays as well. " - | rcvrClass rcvrSize addr | - (interpreterProxy isBytes: rcvr) ifFalse:[^interpreterProxy primitiveFail]. - (byteOffset > 0) ifFalse:[^interpreterProxy primitiveFail]. - rcvrClass := interpreterProxy fetchClassOf: rcvr. - rcvrSize := interpreterProxy byteSizeOf: rcvr. - rcvrClass == interpreterProxy classExternalAddress ifTrue:[ - (rcvrSize = 4) ifFalse:[^interpreterProxy primitiveFail]. - addr := interpreterProxy fetchPointer: 0 ofObject: rcvr. - "don't you dare to read from object memory!!" - (addr == 0 or:[interpreterProxy isInMemory: addr]) - ifTrue:[^interpreterProxy primitiveFail]. - ] ifFalse:[ - (byteOffset+byteSize-1 <= rcvrSize) - ifFalse:[^interpreterProxy primitiveFail]. - addr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: 'int'. - ]. - addr := addr + byteOffset - 1. - ^addr! Item was removed: - ----- Method: FFIPlugin>>ffiArgByValue: (in category 'callout support') ----- - ffiArgByValue: oop - "Support for generic callout. Prepare an argument by value for a callout." - | atomicType intValue floatValue | - <inline: true> - <var: #floatValue type: 'double'> - atomicType := self atomicTypeOf: ffiArgHeader. - "check if the range is valid" - (atomicType < 0 or:[atomicType > FFITypeDoubleFloat]) - ifTrue:[^self ffiFail: FFIErrorBadAtomicType]. - atomicType < FFITypeSingleFloat ifTrue:["integer types" - (atomicType >> 1) = (FFITypeSignedInt64 >> 1) - ifTrue:[intValue := oop] "ffi support code must coerce longlong" - ifFalse:[intValue := self ffiIntegerValueOf: oop]. "does all the coercions" - interpreterProxy failed ifTrue:[^self ffiFail: FFIErrorCoercionFailed]. - self dispatchOn: atomicType - in: #( - ffiPushVoid: - ffiPushUnsignedInt: - ffiPushUnsignedByte: - ffiPushSignedByte: - ffiPushUnsignedShort: - ffiPushSignedShort: - ffiPushUnsignedInt: - ffiPushSignedInt: - ffiPushUnsignedLongLongOop: - ffiPushSignedLongLongOop: - ffiPushUnsignedChar: - ffiPushSignedChar:) - with: intValue. - ] ifFalse:[ - "either float or double" - floatValue := self ffiFloatValueOf: oop. - interpreterProxy failed ifTrue:[^self ffiFail: FFIErrorCoercionFailed]. - atomicType = FFITypeSingleFloat - ifTrue:[self ffiPushSingleFloat: floatValue] - ifFalse:[self ffiPushDoubleFloat: floatValue]. - ]. - ^0! Item was removed: - ----- Method: FFIPlugin>>ffiArgument:Spec:Class: (in category 'callout support') ----- - ffiArgument: oop Spec: argSpec Class: argClass - "Callout support. Prepare the given oop as argument. - argSpec defines the compiled spec for the argument. - argClass (if non-nil) defines the required (super)class for the argument." - | valueOop oopClass isStruct nilOop | - <inline: false> - oopClass := interpreterProxy fetchClassOf: oop. "Prefetch class (we'll need it)" - nilOop := interpreterProxy nilObject. - "Do the necessary type checks" - argClass == nilOop ifFalse:[ - "Type check 1: - Is the required class of the argument a subclass of ExternalStructure?" - (interpreterProxy includesBehavior: argClass - ThatOf: interpreterProxy classExternalStructure) - ifFalse:[^self ffiFail: FFIErrorWrongType]. "Nope. Fail." - "Type check 2: - Is the class of the argument a subclass of required class?" - ((nilOop == oop) or:[interpreterProxy includesBehavior: oopClass ThatOf: argClass]) - ifFalse:[^self ffiFail: FFIErrorCoercionFailed]. "Nope. Fail." - "Okay, we've passed the type check (so far)" - ]. - - "Check if oopClass is a subclass of ExternalStructure. - If this is the case we'll work on it's handle and not the actual oop." - isStruct := false. - ((interpreterProxy isImmediate: oop) or:[oop == nilOop]) ifFalse:[ - "#isPointers: will fail if oop is immediate so don't even attempt to use it" - (interpreterProxy isPointers: oop) - ifTrue:[isStruct := interpreterProxy includesBehavior: oopClass - ThatOf: interpreterProxy classExternalStructure. - (argClass == nilOop or:[isStruct]) - ifFalse:[^self ffiFail: FFIErrorCoercionFailed]]. - "note: the test for #isPointers: above should speed up execution since no pointer type ST objects are allowed in external calls and thus if #isPointers: is true then the arg must be ExternalStructure to work. If it isn't then the code fails anyways so speed isn't an issue" - ]. - - "Determine valueOop (e.g., the actual oop to pass as argument)" - isStruct - ifTrue:[valueOop := interpreterProxy fetchPointer: 0 ofObject: oop] - ifFalse:[valueOop := oop]. - - "Fetch and check the contents of the compiled spec" - (interpreterProxy isWords: argSpec) - ifFalse:[self ffiFail: FFIErrorWrongType. ^nil]. - ffiArgSpecSize := interpreterProxy slotSizeOf: argSpec. - ffiArgSpecSize = 0 ifTrue:[self ffiFail: FFIErrorWrongType. ^nil]. - ffiArgSpec := self cCoerce: (interpreterProxy firstIndexableField: argSpec) to: 'int'. - ffiArgHeader := interpreterProxy longAt: ffiArgSpec. - - "Do the actual preparation of the argument" - "Note: Order is important since FFIFlagStructure + FFIFlagPointer is used to represent 'typedef void* VoidPointer' and VoidPointer really is *struct* not pointer." - - (ffiArgHeader anyMask: FFIFlagStructure) ifTrue:[ - "argument must be ExternalStructure" - isStruct ifFalse:[^self ffiFail: FFIErrorCoercionFailed]. - (ffiArgHeader anyMask: FFIFlagAtomic) - ifTrue:[^self ffiFail: FFIErrorWrongType]. "bad combination" - ^self ffiPushStructureContentsOf: valueOop]. - - (ffiArgHeader anyMask: FFIFlagPointer) ifTrue:[ - "no integers (or characters) for pointers please" - (interpreterProxy isImmediate: oop) - ifTrue:[^self ffiFail: FFIErrorIntAsPointer]. - - "but allow passing nil pointer for any pointer type" - oop == interpreterProxy nilObject ifTrue:[^self ffiPushPointer: nil]. - - "argument is reference to either atomic or structure type" - (ffiArgHeader anyMask: FFIFlagAtomic) ifTrue:[ - isStruct "e.g., ExternalData" - ifTrue:[^self ffiAtomicStructByReference: oop Class: oopClass] - ifFalse:[^self ffiAtomicArgByReference: oop Class: oopClass]. - "********* NOTE: The above uses 'oop' not 'valueOop' (for ExternalData) ******" - ]. - - "Needs to be external structure here" - isStruct ifFalse:[^self ffiFail: FFIErrorCoercionFailed]. - ^self ffiPushPointerContentsOf: valueOop]. - - (ffiArgHeader anyMask: FFIFlagAtomic) ifTrue:[ - "argument is atomic value" - self ffiArgByValue: valueOop. - ^0]. - "None of the above - bad spec" - ^self ffiFail: FFIErrorWrongType! Item was removed: - ----- Method: FFIPlugin>>ffiAtomicArgByReference:Class: (in category 'callout support') ----- - ffiAtomicArgByReference: oop Class: oopClass - "Support for generic callout. Prepare a pointer reference to an atomic type for callout. Note: for type 'void*' we allow either one of ByteArray/String/Symbol or wordVariableSubclass." - | atomicType isString | - <inline: true> - atomicType := self atomicTypeOf: ffiArgHeader. - (atomicType = FFITypeBool) "No bools on input" - ifTrue:[^self ffiFail: FFIErrorCoercionFailed]. - ((atomicType >> 1) = (FFITypeSignedChar8 >> 1)) ifTrue:["string value (char*)" - "note: the only types allowed for passing into char* types are - ByteArray, String, Symbol and *no* other byte indexed objects - (e.g., CompiledMethod, LargeInteger). We only check for strings - here and fall through to the byte* check otherwise." - isString := interpreterProxy - includesBehavior: oopClass - ThatOf: interpreterProxy classString. - isString ifTrue:["String/Symbol" - "Strings must be allocated by the ffi support code" - ^self ffiPushString: (self cCoerce: (interpreterProxy firstIndexableField: oop) to: 'int') OfLength: (interpreterProxy byteSizeOf: oop)]. - "Fall through to byte* test" - atomicType := FFITypeUnsignedInt8]. - - (atomicType = FFITypeVoid or:[(atomicType >> 1) = (FFITypeSignedInt8 >> 1)]) ifTrue:[ - "byte* -- see comment on string above" - oopClass = interpreterProxy classByteArray ifTrue:["ByteArray" - ^self ffiPushPointer: (self cCoerce: (interpreterProxy firstIndexableField: oop) to:'int')]. - isString := interpreterProxy includesBehavior: oopClass - ThatOf: interpreterProxy classString. - isString ifTrue:["String/Symbol" - ^self ffiPushPointer: (self cCoerce: (interpreterProxy firstIndexableField: oop) to:'int')]. - atomicType = FFITypeVoid ifFalse:[^self ffiFail: FFIErrorCoercionFailed]. - "note: type void falls through" - ]. - - (atomicType <= FFITypeSignedInt32 "void/short/int" - or:[atomicType = FFITypeSingleFloat]) ifTrue:[ - "require a word subclass to work" - (interpreterProxy isWords: oop) ifTrue:[ - ^self ffiPushPointer: (self cCoerce: (interpreterProxy firstIndexableField: oop) to:'int')]]. - - ^self ffiFail: FFIErrorCoercionFailed.! Item was removed: - ----- Method: FFIPlugin>>ffiAtomicStructByReference:Class: (in category 'callout support') ----- - ffiAtomicStructByReference: oop Class: oopClass - "Support for generic callout. Prepare an external pointer reference to an atomic type for callout." - | atomicType valueOop | - <inline: true> - "must be external data to pass pointers to atomic type" - oopClass == interpreterProxy classExternalData - ifFalse:[^self ffiFail: FFIErrorCoercionFailed]. - atomicType := self atomicTypeOf: ffiArgHeader. - "no type checks for void pointers" - atomicType ~= FFITypeVoid ifTrue:[ - self ffiValidateExternalData: oop AtomicType: atomicType. - interpreterProxy failed ifTrue:[^nil]. - ]. - "and push pointer contents" - valueOop := interpreterProxy fetchPointer: 0 ofObject: oop. - ^self ffiPushPointerContentsOf: valueOop! Item was removed: - ----- Method: FFIPlugin>>ffiCall:WithFlags:AndTypes: (in category 'callout support') ----- - ffiCall: address WithFlags: callType AndTypes: argTypeArray - "Generic callout. Does the actual work." - | stackIndex argType argTypes oop nArgs argClass argSpec | - <inline: true> - "check if the calling convention is supported" - (self ffiSupportsCallingConvention: callType) - ifFalse:[^self ffiFail: FFIErrorCallType]. - argTypes := argTypeArray. - "Fetch return type and args" - argType := interpreterProxy fetchPointer: 0 ofObject: argTypes. - argSpec := interpreterProxy fetchPointer: 0 ofObject: argType. - argClass := interpreterProxy fetchPointer: 1 ofObject: argType. - self ffiCheckReturn: argSpec With: argClass. - interpreterProxy failed ifTrue:[^0]. "cannot return" - ffiRetOop := argType. - nArgs := interpreterProxy methodArgumentCount. - stackIndex := nArgs - 1. "stack index goes downwards" - 1 to: nArgs do:[:i| - argType := interpreterProxy fetchPointer: i ofObject: argTypes. - argSpec := interpreterProxy fetchPointer: 0 ofObject: argType. - argClass := interpreterProxy fetchPointer: 1 ofObject: argType. - oop := interpreterProxy stackValue: stackIndex. - self ffiArgument: oop Spec: argSpec Class: argClass. - interpreterProxy failed ifTrue:[^0]. "coercion failed" - stackIndex := stackIndex - 1. - ]. - "Go out and call this guy" - ^self ffiCalloutTo: address WithFlags: callType! Item was removed: - ----- Method: FFIPlugin>>ffiCall:WithFlags:Args:AndTypes:OfSize: (in category 'callout support') ----- - ffiCall: address WithFlags: callType Args: argArray AndTypes: argTypeArray OfSize: nArgs - "Generic callout. Does the actual work." - | argType argTypes oop argSpec argClass | - <inline: true> - "check if the calling convention is supported" - (self ffiSupportsCallingConvention: callType) - ifFalse:[^self ffiFail: FFIErrorCallType]. - argTypes := argTypeArray. - "Fetch return type and args" - argType := interpreterProxy fetchPointer: 0 ofObject: argTypes. - argSpec := interpreterProxy fetchPointer: 0 ofObject: argType. - argClass := interpreterProxy fetchPointer: 1 ofObject: argType. - self ffiCheckReturn: argSpec With: argClass. - interpreterProxy failed ifTrue:[^0]. "cannot return" - ffiRetOop := argType. - 1 to: nArgs do:[:i| - argType := interpreterProxy fetchPointer: i ofObject: argTypes. - argSpec := interpreterProxy fetchPointer: 0 ofObject: argType. - argClass := interpreterProxy fetchPointer: 1 ofObject: argType. - oop := interpreterProxy fetchPointer: i-1 ofObject: argArray. - self ffiArgument: oop Spec: argSpec Class: argClass. - interpreterProxy failed ifTrue:[^0]. "coercion failed" - ]. - "Go out and call this guy" - ^self ffiCalloutTo: address WithFlags: callType! Item was removed: - ----- Method: FFIPlugin>>ffiCalloutTo:WithFlags: (in category 'callout support') ----- - ffiCalloutTo: address WithFlags: callType - "Go out, call this guy and create the return value" - | retVal | - <inline: false> - "Note: Order is important here since FFIFlagPointer + FFIFlagStructure is used to represent 'typedef void* VoidPointer' and VoidPointer must be returned as pointer *not* as struct" - (ffiRetHeader anyMask: FFIFlagPointer) ifTrue:[ - retVal := self ffiCallAddressOf: address WithPointerReturn: callType. - ^self ffiCreateReturnPointer: retVal. - ]. - (ffiRetHeader anyMask: FFIFlagStructure) ifTrue:[ - self - ffiCallAddressOf: address - With: callType - Struct: (self cCoerce: ffiRetSpec to:'int*') - Return: ffiRetSpecSize. - ^self ffiCreateReturnStruct. - ]. - retVal := self ffiCallAddressOf: address With: callType ReturnType: ffiRetHeader. - ^self ffiCreateReturn: retVal.! Item was removed: - ----- Method: FFIPlugin>>ffiCheckReturn:With: (in category 'callout support') ----- - ffiCheckReturn: retSpec With: retClass - "Make sure we can return an object of the given type" - <inline: true> - retClass == interpreterProxy nilObject ifFalse:[ - (interpreterProxy includesBehavior: retClass - ThatOf: interpreterProxy classExternalStructure) - ifFalse:[^self ffiFail: FFIErrorBadReturn]]. - ffiRetClass := retClass. - - (interpreterProxy isWords: retSpec) - ifFalse:[self ffiFail: FFIErrorWrongType. ^nil]. - ffiRetSpecSize := interpreterProxy slotSizeOf: retSpec. - ffiRetSpecSize = 0 ifTrue:[self ffiFail: FFIErrorWrongType. ^nil]. - ffiRetSpec := self cCoerce: (interpreterProxy firstIndexableField: retSpec) to: 'int'. - ffiRetHeader := interpreterProxy longAt: ffiRetSpec. - (self isAtomicType: ffiRetHeader) ifFalse:[ - (ffiRetClass == interpreterProxy nilObject) - ifTrue:[^self ffiFail: FFIErrorBadReturn]]. - (self ffiCan: (self cCoerce: ffiRetSpec to:'int*') Return: ffiRetSpecSize) - ifFalse:[self ffiFail: FFIErrorBadReturn]. "cannot return this type" - ^0! Item was removed: - ----- Method: FFIPlugin>>ffiContentsOfHandle:errCode: (in category 'callout support') ----- - ffiContentsOfHandle: oop errCode: errCode - "Make sure that the given oop is a valid external handle" - <inline: true> - (interpreterProxy isBytes: oop) - ifFalse:[^self ffiFail: errCode]. - ((interpreterProxy byteSizeOf: oop) == 4) - ifFalse:[^self ffiFail: errCode]. - ^interpreterProxy fetchPointer: 0 ofObject: oop! Item was removed: - ----- Method: FFIPlugin>>ffiCreateLongLongReturn: (in category 'callout support') ----- - ffiCreateLongLongReturn: isSigned - "Create a longlong return value from a previous call out" - | lowWord highWord largeClass nBytes largeInt ptr | - <var: #ptr type:'unsigned char *'> - lowWord := self ffiLongLongResultLow. - highWord := self ffiLongLongResultHigh. - isSigned ifTrue:["check for 32 bit signed" - (highWord = 0 and:[lowWord >= 0]) - ifTrue:[^interpreterProxy signed32BitIntegerFor: lowWord]. - (highWord = -1 and:[lowWord < 0]) - ifTrue:[^interpreterProxy signed32BitIntegerFor: lowWord]. - "negate value for negative longlong" - highWord < 0 - ifTrue:[ largeClass := interpreterProxy classLargeNegativeInteger. - lowWord := lowWord bitInvert32. - highWord := highWord bitInvert32. - lowWord = -1 "e.g., overflow when adding one" - ifTrue:[highWord := highWord + 1]. - lowWord := lowWord + 1] - ifFalse:[largeClass := interpreterProxy classLargePositiveInteger]. - "fall through" - ] ifFalse:["check for 32 bit unsigned" - highWord = 0 ifTrue:[ - ^interpreterProxy positive32BitIntegerFor: lowWord]. - largeClass := interpreterProxy classLargePositiveInteger. - "fall through" - ]. - "Create LargeInteger result" - nBytes := 8. - (highWord anyMask: 255 << 24) ifFalse:[ - nBytes := 7. - highWord < (1 << 16) ifTrue:[nBytes := 6]. - highWord < (1 << 8) ifTrue:[nBytes := 5]. - highWord = 0 ifTrue:[nBytes := 4]]. - "now we know how many bytes to create" - largeInt := interpreterProxy instantiateClass: largeClass indexableSize: nBytes. - (interpreterProxy isBytes: largeInt) - ifFalse:[^self ffiFail: FFIErrorBadReturn]. "Hossa!!" - ptr := interpreterProxy firstIndexableField: largeInt. - 4 to: nBytes-1 do:[:i| - ptr at: i put: (highWord >> (i-4*8) bitAnd: 255)]. - ptr at: 3 put: (lowWord >> 24 bitAnd: 255). - ptr at: 2 put: (lowWord >> 16 bitAnd: 255). - ptr at: 1 put: (lowWord >> 8 bitAnd: 255). - ptr at: 0 put: (lowWord bitAnd: 255). - ^largeInt! Item was removed: - ----- Method: FFIPlugin>>ffiCreateReturn: (in category 'callout support') ----- - ffiCreateReturn: retVal - "Generic callout support. Create an atomic return value from an external function call" - | atomicType retOop oop | - <inline: true> - interpreterProxy failed ifTrue:[^nil]. - atomicType := self atomicTypeOf: ffiRetHeader. - "void returns self" - atomicType <= FFITypeVoid ifTrue:[ - ^interpreterProxy pop: interpreterProxy methodArgumentCount]. - "everything else returns value" - interpreterProxy pop: - interpreterProxy methodArgumentCount+1. - interpreterProxy pushRemappableOop: ffiRetClass. - retOop := self ffiCreateReturnOop: retVal. - ffiRetClass := interpreterProxy popRemappableOop. - ffiRetClass == interpreterProxy nilObject ifTrue:[ - "Just return oop" - ^interpreterProxy push: retOop]. - "Otherwise create an instance of external structure and store the return oop" - interpreterProxy pushRemappableOop: retOop. - retOop := interpreterProxy instantiateClass: ffiRetClass indexableSize: 0. - oop := interpreterProxy popRemappableOop. - interpreterProxy storePointer: 0 ofObject: retOop withValue: oop. - ^interpreterProxy push: retOop.! Item was removed: - ----- Method: FFIPlugin>>ffiCreateReturnOop: (in category 'callout support') ----- - ffiCreateReturnOop: retVal - "Callout support. Return the appropriate oop for the given atomic value" - | atomicType shift value mask byteSize | - atomicType := self atomicTypeOf: ffiRetHeader. - atomicType = FFITypeBool ifTrue:[ - "Make sure bool honors the byte size requested" - byteSize := ffiRetHeader bitAnd: FFIStructSizeMask. - byteSize = 4 - ifTrue:[value := retVal] - ifFalse:[value := retVal bitAnd: 1 << (byteSize * 8) - 1]. - value = 0 - ifTrue:[^interpreterProxy falseObject] - ifFalse:[^interpreterProxy trueObject]]. - atomicType <= FFITypeSignedInt32 ifTrue:[ - "these are all generall integer returns" - atomicType <= FFITypeSignedInt16 ifTrue:[ - "byte/short. first extract partial word, then sign extend" - shift := (atomicType >> 1) * 8. "# of significant bits" - value := retVal bitAnd: (1 << shift - 1). - (atomicType anyMask: 1) ifTrue:[ - "make the guy signed" - mask := 1 << (shift-1). - value := (value bitAnd: mask-1) - (value bitAnd: mask)]. - ^interpreterProxy integerObjectOf: value]. - "32bit integer return" - (atomicType anyMask: 1) - ifTrue:[^(interpreterProxy signed32BitIntegerFor: retVal)] "signed return" - ifFalse:[^(interpreterProxy positive32BitIntegerFor: retVal)]]. "unsigned return" - - atomicType < FFITypeSingleFloat ifTrue:[ - "longlong, char" - (atomicType >> 1) = (FFITypeSignedInt64 >> 1) - ifTrue:[^self ffiCreateLongLongReturn: (atomicType anyMask: 1)] - ifFalse:[^(interpreterProxy - fetchPointer: (retVal bitAnd: 255) - ofObject: interpreterProxy characterTable)]]. - "float return" - ^interpreterProxy floatObjectOf: (self ffiReturnFloatValue).! Item was removed: - ----- Method: FFIPlugin>>ffiCreateReturnPointer: (in category 'callout support') ----- - ffiCreateReturnPointer: retVal - "Generic callout support. Create a pointer return value from an external function call" - | atomicType retOop oop ptr classOop | - <var: #ptr type:'int *'> - interpreterProxy failed ifTrue:[^nil]. - interpreterProxy pop: interpreterProxy methodArgumentCount+1. - (ffiRetClass == interpreterProxy nilObject) ifTrue:[ - "Create ExternalData upon return" - atomicType := self atomicTypeOf: ffiRetHeader. - (atomicType >> 1) = (FFITypeSignedChar8 >> 1) ifTrue:["String return" - ^self ffiReturnCStringFrom: retVal]. - "generate external data" - interpreterProxy pushRemappableOop: ffiRetOop. - oop := interpreterProxy - instantiateClass: interpreterProxy classExternalAddress - indexableSize: 4. - ptr := interpreterProxy firstIndexableField: oop. - ptr at: 0 put: retVal. - interpreterProxy pushRemappableOop: oop. "preserve for gc" - retOop := interpreterProxy - instantiateClass: interpreterProxy classExternalData - indexableSize: 0. - oop := interpreterProxy popRemappableOop. "external address" - interpreterProxy storePointer: 0 ofObject: retOop withValue: oop. - oop := interpreterProxy popRemappableOop. "return type" - interpreterProxy storePointer: 1 ofObject: retOop withValue: oop. - ^interpreterProxy push: retOop. - ]. - "non-atomic pointer return" - interpreterProxy pushRemappableOop: ffiRetClass. "preserve for gc" - (ffiRetHeader anyMask: FFIFlagStructure) - ifTrue:[classOop := interpreterProxy classByteArray] - ifFalse:[classOop := interpreterProxy classExternalAddress]. - oop := interpreterProxy - instantiateClass: classOop - indexableSize: 4. - ptr := interpreterProxy firstIndexableField: oop. - ptr at: 0 put: retVal. - ffiRetClass := interpreterProxy popRemappableOop. "return class" - interpreterProxy pushRemappableOop: oop. "preserve for gc" - retOop := interpreterProxy instantiateClass: ffiRetClass indexableSize: 0. - oop := interpreterProxy popRemappableOop. "external address" - interpreterProxy storePointer: 0 ofObject: retOop withValue: oop. - ^interpreterProxy push: retOop.! Item was removed: - ----- Method: FFIPlugin>>ffiCreateReturnStruct (in category 'callout support') ----- - ffiCreateReturnStruct - "Generic callout support. Create a structure return value from an external function call" - | retOop structSize oop | - <inline: true> - interpreterProxy failed ifTrue:[^nil]. - interpreterProxy pop: interpreterProxy methodArgumentCount+1. - structSize := ffiRetHeader bitAnd: FFIStructSizeMask. - interpreterProxy pushRemappableOop: ffiRetClass. - oop := interpreterProxy - instantiateClass: interpreterProxy classByteArray - indexableSize: structSize. - self ffiStore: (self cCoerce: (interpreterProxy firstIndexableField: oop) to:'int') - Structure: structSize. - ffiRetClass := interpreterProxy popRemappableOop. - interpreterProxy pushRemappableOop: oop. "secure byte array" - retOop := interpreterProxy instantiateClass: ffiRetClass indexableSize: 0. - oop := interpreterProxy popRemappableOop. - interpreterProxy storePointer: 0 ofObject: retOop withValue: oop. - ^interpreterProxy push: retOop.! Item was removed: - ----- Method: FFIPlugin>>ffiFail: (in category 'callout support') ----- - ffiFail: reason - <inline: false> - "Map the FFI error code into a primitive error code. If reason is negative it encodes one of the - standard PrimErr... codes, negated to distinguish it from the FFIError codes. If it is an FFIError... - code then add the size of the primitive error table + 2 to disambiguate it from the PrimErr... codes. - For historic reasons the FFIError codes range from -1 on up hence adding size + 2 maps them to - size of table + 1 on up. This OFFSET IS undone by ExternalFunction class>>externalCallFailedWith:. - Thus we can communicate back both PrimErr.. and FFIError codes. Complex but necessary in the ThreadedFFIPlugin." - self ffiSetLastError: reason. - ^interpreterProxy primitiveFailFor: - (reason >= FFINoCalloutAvailable - ifTrue: [reason + 2 + (interpreterProxy slotSizeOf: interpreterProxy primitiveErrorTable)] - ifFalse: [reason negated])! Item was removed: - ----- Method: FFIPlugin>>ffiFloatValueOf: (in category 'callout support') ----- - ffiFloatValueOf: oop - "Support for generic callout. Return a float value that is coerced as C would do." - | oopClass | - <returnTypeC:'double'> - oopClass := interpreterProxy fetchClassOf: oop. - oopClass == interpreterProxy classFloat - ifTrue:[^interpreterProxy floatValueOf: oop]. - "otherwise try the integer coercions and return its float value" - ^(self ffiIntegerValueOf: oop) asFloat! Item was removed: - ----- Method: FFIPlugin>>ffiGetLastError (in category 'callout support') ----- - ffiGetLastError - ^ffiLastError! Item was removed: - ----- Method: FFIPlugin>>ffiIntegerValueOf: (in category 'callout support') ----- - ffiIntegerValueOf: oop - "Support for generic callout. Return an integer value that is coerced as C would do." - | oopClass | - <inline: true> - (interpreterProxy isIntegerObject: oop) ifTrue:[^interpreterProxy integerValueOf: oop]. - oop == interpreterProxy nilObject ifTrue:[^0]. "@@: should we really allow this????" - oop == interpreterProxy falseObject ifTrue:[^0]. - oop == interpreterProxy trueObject ifTrue:[^1]. - oopClass := interpreterProxy fetchClassOf: oop. - oopClass == interpreterProxy classFloat - ifTrue:[^(interpreterProxy floatValueOf: oop) asInteger]. - oopClass == interpreterProxy classCharacter - ifTrue:[^interpreterProxy characterValueOf: oop]. - oopClass == interpreterProxy classLargePositiveInteger - ifTrue:[^interpreterProxy positive32BitValueOf: oop]. - ^interpreterProxy signed32BitValueOf: oop "<- will fail if not integer"! Item was removed: - ----- Method: FFIPlugin>>ffiLoadCalloutAddress: (in category 'symbol loading') ----- - ffiLoadCalloutAddress: lit - "Load the address of the foreign function from the given object" - | addressPtr address ptr | - <var: #ptr type:'int *'> - "Lookup the address" - addressPtr := interpreterProxy fetchPointer: 0 ofObject: lit. - "Make sure it's an external handle" - address := self ffiContentsOfHandle: addressPtr errCode: FFIErrorBadAddress. - interpreterProxy failed ifTrue:[^0]. - address = 0 ifTrue:["Go look it up in the module" - (interpreterProxy slotSizeOf: lit) < 5 ifTrue:[^self ffiFail: FFIErrorNoModule]. - address := self ffiLoadCalloutAddressFrom: lit. - interpreterProxy failed ifTrue:[^0]. - "Store back the address" - ptr := interpreterProxy firstIndexableField: addressPtr. - ptr at: 0 put: address]. - ^address! Item was removed: - ----- Method: FFIPlugin>>ffiLoadCalloutAddressFrom: (in category 'symbol loading') ----- - ffiLoadCalloutAddressFrom: oop - "Load the function address for a call out to an external function" - | module moduleHandle functionName functionLength address | - <inline: false> - "First find and load the module" - module := interpreterProxy fetchPointer: externalFunctionInstSize + 1 ofObject: oop. - moduleHandle := self ffiLoadCalloutModule: module. - interpreterProxy failed ifTrue: - [^0]. "failed" - "fetch the function name" - functionName := interpreterProxy fetchPointer: externalFunctionInstSize ofObject: oop. - (interpreterProxy isBytes: functionName) ifFalse: - [^self ffiFail: FFIErrorBadExternalFunction]. - functionLength := interpreterProxy byteSizeOf: functionName. - address := interpreterProxy - ioLoadSymbol: (self cCoerce: (interpreterProxy firstIndexableField: functionName) to: #int) - OfLength: functionLength - FromModule: moduleHandle. - (interpreterProxy failed or: [address = 0]) ifTrue: - [^self ffiFail: FFIErrorAddressNotFound]. - ^address! Item was removed: - ----- Method: FFIPlugin>>ffiLoadCalloutModule: (in category 'symbol loading') ----- - ffiLoadCalloutModule: module - "Load the given module and return its handle" - | moduleHandlePtr moduleHandle ffiModuleName moduleLength rcvr theClass ptr | - <var: #ptr type:'int *'> - (interpreterProxy isBytes: module) ifTrue:[ - "plain module name" - ffiModuleName := module. - moduleLength := interpreterProxy byteSizeOf: ffiModuleName. - moduleHandle := interpreterProxy ioLoadModule: (self cCoerce: (interpreterProxy firstIndexableField: ffiModuleName) to:'int') OfLength: moduleLength. - interpreterProxy failed ifTrue:[^self ffiFail: FFIErrorModuleNotFound]. "failed" - ^moduleHandle]. - "Check if the external method is defined in an external library" - rcvr := interpreterProxy stackValue: interpreterProxy methodArgumentCount. - theClass := interpreterProxy fetchClassOf: rcvr. - (interpreterProxy includesBehavior: theClass - ThatOf: interpreterProxy classExternalLibrary) ifFalse:[^0]. - "external library" - moduleHandlePtr := interpreterProxy fetchPointer: 0 ofObject: rcvr. - moduleHandle := self ffiContentsOfHandle: moduleHandlePtr errCode: FFIErrorBadExternalLibrary. - interpreterProxy failed ifTrue:[^0]. - moduleHandle = 0 ifTrue:["need to reload module" - ffiModuleName := interpreterProxy fetchPointer: 1 ofObject: rcvr. - (interpreterProxy isBytes: ffiModuleName) ifFalse:[^self ffiFail: FFIErrorBadExternalLibrary]. - moduleLength := interpreterProxy byteSizeOf: ffiModuleName. - moduleHandle := interpreterProxy ioLoadModule: (self cCoerce: (interpreterProxy firstIndexableField: ffiModuleName) to:'int') OfLength: moduleLength. - interpreterProxy failed ifTrue:[^self ffiFail: FFIErrorModuleNotFound]. "failed" - "and store back" - ptr := interpreterProxy firstIndexableField: moduleHandlePtr. - ptr at: 0 put: moduleHandle]. - ^moduleHandle! Item was removed: - ----- Method: FFIPlugin>>ffiLogCallout: (in category 'symbol loading') ----- - ffiLogCallout: lit - "fetch the function name" - | functionName | - ffiLogEnabled ifTrue:[ - functionName := interpreterProxy fetchPointer: externalFunctionInstSize ofObject: lit. - (interpreterProxy isBytes: functionName) ifFalse:[^nil]. - self ffiLogCall: (interpreterProxy firstIndexableField: functionName) - OfLength: (interpreterProxy byteSizeOf: functionName). - ].! Item was removed: - ----- Method: FFIPlugin>>ffiLogCallsTo: (in category 'initialize') ----- - ffiLogCallsTo: fileName - "This is a special entry point exposed such that client code can - enable and disable logging of FFI calls." - | ok | - <export: true> - <var: #fileName type: 'char*'> - fileName == nil ifTrue:[ "disable logging" - ok := self ffiLogFileName: nil OfLength: 0. - ok ifFalse:[^false]. - ffiLogEnabled := false. - ] ifFalse:[ "enable logging" - ok := self ffiLogFileName: fileName OfLength: (self strlen: fileName). - ok ifFalse:[^false]. - ffiLogEnabled := true. - ]. - ^true! Item was removed: - ----- Method: FFIPlugin>>ffiPushPointerContentsOf: (in category 'callout support') ----- - ffiPushPointerContentsOf: oop - "Push the contents of the given external structure" - | ptrValue ptrClass ptrAddress | - <inline: false> - ptrValue := oop. - ptrClass := interpreterProxy fetchClassOf: ptrValue. - ptrClass == interpreterProxy classExternalAddress ifTrue:[ - ptrAddress := interpreterProxy fetchPointer: 0 ofObject: ptrValue. - "Don't you dare to pass pointers into object memory" - (interpreterProxy isInMemory: ptrAddress) - ifTrue:[^self ffiFail: FFIErrorInvalidPointer]. - ^self ffiPushPointer: ptrAddress]. - ptrClass == interpreterProxy classByteArray ifTrue:[ - ptrAddress := self cCoerce: (interpreterProxy firstIndexableField: ptrValue) to: 'int'. - ^self ffiPushPointer: ptrAddress]. - ^self ffiFail: FFIErrorBadArg! Item was removed: - ----- Method: FFIPlugin>>ffiPushSignedLongLongOop: (in category 'callout support') ----- - ffiPushSignedLongLongOop: oop - "Push a longlong type (e.g., a 64bit integer). - Note: Coercions from float are *not* supported." - | lowWord highWord length oopClass negative ptr | - <var: #ptr type:'unsigned char *'> - oop == interpreterProxy nilObject - ifTrue:[^self ffiPushSignedLong: 0 Long: 0.]. "@@: check this" - oop == interpreterProxy falseObject - ifTrue:[^self ffiPushSignedLong: 0 Long: 0]. - oop == interpreterProxy trueObject - ifTrue:[^self ffiPushSignedLong: 0 Long: 1]. - (interpreterProxy isIntegerObject: oop) ifTrue:[ - lowWord := interpreterProxy integerValueOf: oop. - lowWord < 0 - ifTrue:[highWord := -1] - ifFalse:[highWord := 0]. - ] ifFalse:[ - oopClass := interpreterProxy fetchClassOf: oop. - oopClass == interpreterProxy classLargePositiveInteger - ifTrue:[negative := false] - ifFalse:[oopClass == interpreterProxy classLargeNegativeInteger - ifTrue:[negative := true] - ifFalse:[^self ffiFail: FFIErrorCoercionFailed]]. - (interpreterProxy isBytes: oop) ifFalse:[^self ffiFail: FFIErrorCoercionFailed]. - length := interpreterProxy byteSizeOf: oop. - length > 8 ifTrue:[^self ffiFail: FFIErrorCoercionFailed]. - lowWord := highWord := 0. - ptr := interpreterProxy firstIndexableField: oop. - 0 to: (length min: 4)-1 do:[:i| - lowWord := lowWord + ((ptr at: i) << (i*8))]. - 0 to: (length-5) do:[:i| - highWord := highWord + ((ptr at: i+4) << (i*8))]. - negative ifTrue:[ - lowWord := lowWord bitInvert32. - highWord := highWord bitInvert32. - lowWord = -1 "e.g., will overflow when adding one" - ifTrue:[highWord := highWord + 1]. - lowWord := lowWord + 1]. - ]. - ^self ffiPushSignedLong: lowWord Long: highWord.! Item was removed: - ----- Method: FFIPlugin>>ffiPushStructureContentsOf: (in category 'callout support') ----- - ffiPushStructureContentsOf: oop - "Push the contents of the given external structure" - | ptrValue ptrClass ptrAddress | - <inline: true> - ptrValue := oop. - ptrClass := interpreterProxy fetchClassOf: ptrValue. - ptrClass == interpreterProxy classExternalAddress ifTrue:[ - ptrAddress := interpreterProxy fetchPointer: 0 ofObject: ptrValue. - "There is no way we can make sure the structure is valid. - But we can at least check for attempts to pass pointers to ST memory." - (interpreterProxy isInMemory: ptrAddress) - ifTrue:[^self ffiFail: FFIErrorInvalidPointer]. - ^self ffiPush: ptrAddress - Structure: (self cCoerce: ffiArgSpec to:'int*') - OfLength: ffiArgSpecSize]. - ptrClass == interpreterProxy classByteArray ifTrue:[ - "The following is a somewhat pessimistic test but I like being sure..." - (interpreterProxy byteSizeOf: ptrValue) = (ffiArgHeader bitAnd: FFIStructSizeMask) - ifFalse:[^self ffiFail: FFIErrorStructSize]. - ptrAddress := self cCoerce: (interpreterProxy firstIndexableField: ptrValue) to: 'int'. - (ffiArgHeader anyMask: FFIFlagPointer) ifFalse:[ - ^self ffiPush: ptrAddress - Structure: (self cCoerce: ffiArgSpec to: 'int*') - OfLength: ffiArgSpecSize]. - "If FFIFlagPointer + FFIFlagStructure is set use ffiPushPointer on the contents" - (ffiArgHeader bitAnd: FFIStructSizeMask) = 4 - ifFalse:[^self ffiFail: FFIErrorStructSize]. - ptrAddress := interpreterProxy fetchPointer: 0 ofObject: ptrValue. - (interpreterProxy isInMemory: ptrAddress) - ifTrue:[^self ffiFail: FFIErrorInvalidPointer]. - ^self ffiPushPointer: ptrAddress]. - ^self ffiFail: FFIErrorBadArg! Item was removed: - ----- Method: FFIPlugin>>ffiPushUnsignedLongLongOop: (in category 'callout support') ----- - ffiPushUnsignedLongLongOop: oop - "Push a longlong type (e.g., a 64bit integer). - Note: Coercions from float are *not* supported." - | lowWord highWord length ptr | - <var: #ptr type:'unsigned char *'> - oop == interpreterProxy nilObject - ifTrue:[^self ffiPushUnsignedLong: 0 Long: 0.]. "@@: check this" - oop == interpreterProxy falseObject - ifTrue:[^self ffiPushUnsignedLong: 0 Long: 0]. - oop == interpreterProxy trueObject - ifTrue:[^self ffiPushUnsignedLong: 0 Long: 1]. - (interpreterProxy isIntegerObject: oop) ifTrue:[ - lowWord := interpreterProxy integerValueOf: oop. - lowWord < 0 ifTrue:[^self ffiFail: FFIErrorCoercionFailed]. - highWord := 0. - ] ifFalse:[ - (interpreterProxy isLargePositiveIntegerObject: oop) - ifFalse:[^interpreterProxy primitiveFail]. - (interpreterProxy isBytes: oop) ifFalse:[^self ffiFail: FFIErrorCoercionFailed]. - length := interpreterProxy byteSizeOf: oop. - length > 8 ifTrue:[^self ffiFail: FFIErrorCoercionFailed]. - lowWord := highWord := 0. - ptr := interpreterProxy firstIndexableField: oop. - 0 to: (length min: 4)-1 do:[:i| - lowWord := lowWord + ((ptr at: i) << (i*8))]. - 0 to: (length-5) do:[:i| - highWord := highWord + ((ptr at: i+4) << (i*8))]. - ]. - ^self ffiPushUnsignedLong: lowWord Long: highWord.! Item was removed: - ----- Method: FFIPlugin>>ffiPushVoid: (in category 'callout support') ----- - ffiPushVoid: ignored - "This is a fallback in case somebody tries to pass a 'void' value. - We could simply ignore the argument but I think it's better to let - the caller know what he did" - ^self ffiFail: FFIErrorAttemptToPassVoid.! Item was removed: - ----- Method: FFIPlugin>>ffiReturnCStringFrom: (in category 'callout support') ----- - ffiReturnCStringFrom: cPointer - "Create a Smalltalk string from a zero terminated C string" - | strLen strOop cString strPtr | - <var: #cString type:'char *'> - <var: #strPtr type:'char *'> - cPointer = nil ifTrue:[ - ^interpreterProxy push: interpreterProxy nilObject]. "nil always returs as nil" - cString := self cCoerce: cPointer to:'char *'. - strLen := 0. - [(cString at: strLen) = 0] whileFalse:[strLen := strLen+1]. - strOop := interpreterProxy - instantiateClass: interpreterProxy classString - indexableSize: strLen. - strPtr := interpreterProxy firstIndexableField: strOop. - 0 to: strLen-1 do:[:i| strPtr at: i put: (cString at: i)]. - ^interpreterProxy push: strOop! Item was removed: - ----- Method: FFIPlugin>>ffiSetLastError: (in category 'callout support') ----- - ffiSetLastError: errCode - ^ffiLastError := errCode! Item was removed: - ----- Method: FFIPlugin>>ffiValidateExternalData:AtomicType: (in category 'callout support') ----- - ffiValidateExternalData: oop AtomicType: atomicType - "Validate if the given oop (an instance of ExternalData) can be passed as a pointer to the given atomic type." - | ptrType specOop spec specType | - <inline: true> - ptrType := interpreterProxy fetchPointer: 1 ofObject: oop. - (interpreterProxy isPointers: ptrType) - ifFalse:[^self ffiFail: FFIErrorWrongType]. - (interpreterProxy slotSizeOf: ptrType) < 2 - ifTrue:[^self ffiFail: FFIErrorWrongType]. - specOop := interpreterProxy fetchPointer: 0 ofObject: ptrType. - (interpreterProxy isWords: specOop) - ifFalse:[^self ffiFail: FFIErrorWrongType]. - (interpreterProxy slotSizeOf: specOop) = 0 - ifTrue:[^self ffiFail: FFIErrorWrongType]. - spec := interpreterProxy fetchPointer: 0 ofObject: specOop. - (self isAtomicType: spec) - ifFalse:[^self ffiFail: FFIErrorWrongType]. - specType := self atomicTypeOf: spec. - specType ~= atomicType ifTrue:[ - "allow for signed/unsigned conversion but nothing else" - (atomicType > FFITypeBool and:[atomicType < FFITypeSingleFloat]) - ifFalse:[^self ffiFail: FFIErrorCoercionFailed]. - ((atomicType >> 1) = (specType >> 1)) - ifFalse:[^self ffiFail: FFIErrorCoercionFailed]]. - ^0! Item was removed: - ----- Method: FFIPlugin>>initialiseModule (in category 'initialize') ----- - initialiseModule - <export: true> - self initSurfacePluginFunctionPointers. - "By default, disable logging" - ffiLogEnabled := false. - "Get the instSize of ExternalFunction to know whether it contains a cache of the stackSize, - and what the offset of ExternalLibraryFunction's functionName and moduleName slots are." - externalFunctionInstSize := interpreterProxy instanceSizeOf: interpreterProxy classExternalFunction. - ^1! Item was removed: - ----- Method: FFIPlugin>>isAtomicType: (in category 'primitive support') ----- - isAtomicType: typeSpec - ^typeSpec anyMask: FFIFlagAtomic! Item was removed: - ----- Method: FFIPlugin>>primitiveCallout (in category 'primitives') ----- - primitiveCallout - - "IMPORTANT: IF YOU CHANGE THE NAME OF THIS METHOD YOU MUST CHANGE - Interpreter>>primitiveCalloutToFFI - TO REFLECT THE CHANGE." - - "Perform a function call to a foreign function. - Only invoked from method containing explicit external call spec." - | lit address flags argTypes litClass nArgs meth | - <export: true> - <inline: false> - self ffiSetLastError: FFIErrorGenericError. "educated guess if we fail silently" - lit := nil. - "Look if the method is itself a callout function" - meth := interpreterProxy primitiveMethod. - (interpreterProxy literalCountOf: meth) > 0 ifFalse:[^interpreterProxy primitiveFail]. - lit := interpreterProxy literal: 0 ofMethod: meth. - litClass := interpreterProxy fetchClassOf: lit. - (interpreterProxy includesBehavior: litClass - ThatOf: interpreterProxy classExternalFunction) - ifFalse:[^self ffiFail: FFIErrorNotFunction]. - address := self ffiLoadCalloutAddress: lit. - interpreterProxy failed ifTrue:[^0]. - "Load and check the other values before we call out" - flags := interpreterProxy fetchInteger: 1 ofObject: lit. - interpreterProxy failed ifTrue:[^self ffiFail: FFIErrorBadArgs]. - argTypes := interpreterProxy fetchPointer: 2 ofObject: lit. - "must be array of arg types" - (interpreterProxy isArray: argTypes) - ifFalse:[^self ffiFail: FFIErrorBadArgs]. - nArgs := interpreterProxy slotSizeOf: argTypes. - "must be argumentCount+1 arg types" - nArgs = (interpreterProxy methodArgumentCount+1) - ifFalse:[^self ffiFail: FFIErrorBadArgs]. - self ffiLogCallout: lit. - self ffiInitialize. "announce the execution of an external call" - self ffiCall: address - WithFlags: flags - AndTypes: argTypes. - self ffiCleanup. "cleanup temp allocations" - ^0! Item was removed: - ----- Method: FFIPlugin>>primitiveCalloutWithArgs (in category 'primitives') ----- - primitiveCalloutWithArgs - "Perform a function call to a foreign function. - Only invoked from ExternalFunction>>invokeWithArguments:" - | lit address flags argTypes litClass nArgs argArray | - <export: true> - <inline: false> - self ffiSetLastError: FFIErrorGenericError. "educated guess if we fail silently" - lit := nil. - "Look if the method is itself a callout function" - lit := interpreterProxy stackValue: interpreterProxy methodArgumentCount. - litClass := interpreterProxy fetchClassOf: lit. - (interpreterProxy includesBehavior: litClass - ThatOf: interpreterProxy classExternalFunction) - ifFalse:[^self ffiFail: FFIErrorNotFunction]. - address := self ffiLoadCalloutAddress: lit. - interpreterProxy failed ifTrue:[^nil]. - "Load and check the other values before we call out" - flags := interpreterProxy fetchInteger: 1 ofObject: lit. - interpreterProxy failed ifTrue:[^self ffiFail: FFIErrorBadArgs]. - argTypes := interpreterProxy fetchPointer: 2 ofObject: lit. - "must be array of arg types" - (interpreterProxy isArray: argTypes) - ifFalse:[^self ffiFail: FFIErrorBadArgs]. - nArgs := interpreterProxy slotSizeOf: argTypes. - (interpreterProxy methodArgumentCount = 1) - ifFalse:[^self ffiFail: FFIErrorBadArgs]. - argArray := interpreterProxy stackValue: 0. - (interpreterProxy isArray: argArray) - ifFalse:[^self ffiFail: FFIErrorBadArgs]. - nArgs = ((interpreterProxy slotSizeOf: argArray) + 1) - ifFalse:[^self ffiFail: FFIErrorBadArgs]. - self ffiInitialize. "announce the execution of an external call" - self ffiCall: address - WithFlags: flags - Args: argArray - AndTypes: argTypes - OfSize: nArgs-1. - self ffiCleanup. "cleanup temp allocations" - ^0! Item was removed: - ----- Method: FFIPlugin>>primitiveCreateManualSurface (in category 'primitives - surfaces') ----- - primitiveCreateManualSurface - "arguments: name(type, stack offset) - width(Integer, 4) - height(Integer, 3) - rowPitch(Integer, 2) - depth(Integer, 1) - isMSB(Boolean, 0)" - | width height rowPitch depth isMSB result | - <export: true> - - interpreterProxy methodArgumentCount == 5 ifFalse: [^interpreterProxy primitiveFail]. - width := interpreterProxy stackIntegerValue: 4. - height := interpreterProxy stackIntegerValue: 3. - rowPitch := interpreterProxy stackIntegerValue: 2. - depth := interpreterProxy stackIntegerValue: 1. - isMSB := interpreterProxy stackObjectValue: 0. - isMSB := interpreterProxy booleanValueOf: isMSB. - interpreterProxy failed ifTrue: [^nil]. - - self touch: width; touch: height; touch: rowPitch; touch: depth; touch: isMSB. - - result := self cCode: 'createManualSurface(width, height, rowPitch, depth, isMSB)'. - result < 0 ifTrue: [^interpreterProxy primitiveFail]. - result := interpreterProxy signed32BitIntegerFor: result. - ^interpreterProxy pop: 6 thenPush: result - ! Item was removed: - ----- Method: FFIPlugin>>primitiveDestroyManualSurface (in category 'primitives - surfaces') ----- - primitiveDestroyManualSurface - "arguments: name(type, stack offset) - surfaceID(Integer, 0)" - | surfaceID result | - <export: true> - - interpreterProxy methodArgumentCount == 1 ifFalse: [^interpreterProxy primitiveFail]. - surfaceID := interpreterProxy stackIntegerValue: 0. - interpreterProxy failed ifTrue: [^nil]. - result := self destroyManualSurface: surfaceID. - result = 0 ifTrue: [^interpreterProxy primitiveFail]. - ^interpreterProxy pop: 1 - ! Item was removed: - ----- Method: FFIPlugin>>primitiveFFIAllocate (in category 'primitives') ----- - primitiveFFIAllocate - "Primitive. Allocate an object on the external heap." - | byteSize addr oop ptr | - <export: true> - <inline: false> - <var: #ptr type:'int *'> - byteSize := interpreterProxy stackIntegerValue: 0. - interpreterProxy failed ifTrue:[^nil]. - addr := self ffiAlloc: byteSize. - addr = 0 ifTrue:[^interpreterProxy primitiveFail]. - oop := interpreterProxy - instantiateClass: interpreterProxy classExternalAddress - indexableSize: 4. - ptr := interpreterProxy firstIndexableField: oop. - ptr at: 0 put: addr. - interpreterProxy pop: 2. - ^interpreterProxy push: oop. - ! Item was removed: - ----- Method: FFIPlugin>>primitiveFFIDoubleAt (in category 'primitives') ----- - primitiveFFIDoubleAt - "Return a (signed or unsigned) n byte integer from the given byte offset." - | byteOffset rcvr addr floatValue | - <export: true> - <inline: false> - <var: #floatValue type: #double> - byteOffset := interpreterProxy stackIntegerValue: 0. - rcvr := interpreterProxy stackObjectValue: 1. - interpreterProxy failed ifTrue:[^0]. - addr := self ffiAddressOf: rcvr startingAt: byteOffset size: 8. - interpreterProxy failed ifTrue:[^0]. - self memcpy: (self addressOf: floatValue) _: addr _: (self sizeof: floatValue). - interpreterProxy pop: 2. - ^interpreterProxy pushFloat: floatValue - ! Item was removed: - ----- Method: FFIPlugin>>primitiveFFIDoubleAtPut (in category 'primitives') ----- - primitiveFFIDoubleAtPut - "Return a (signed or unsigned) n byte integer from the given byte offset." - | byteOffset rcvr addr floatValue floatOop | - <export: true> - <inline: false> - <var: #floatValue type: #double> - floatOop := interpreterProxy stackValue: 0. - (interpreterProxy isIntegerObject: floatOop) - ifTrue:[floatValue := self cCoerce: (interpreterProxy integerValueOf: floatOop) to:'double'] - ifFalse:[floatValue := self cCoerce: (interpreterProxy floatValueOf: floatOop) to:'double']. - byteOffset := interpreterProxy stackIntegerValue: 1. - rcvr := interpreterProxy stackObjectValue: 2. - interpreterProxy failed ifTrue:[^0]. - addr := self ffiAddressOf: rcvr startingAt: byteOffset size: 8. - interpreterProxy failed ifTrue:[^0]. - self memcpy: addr _: (self addressOf: floatValue) _: (self sizeof: floatValue). - interpreterProxy pop: 3. - ^interpreterProxy push: floatOop! Item was removed: - ----- Method: FFIPlugin>>primitiveFFIFloatAt (in category 'primitives') ----- - primitiveFFIFloatAt - "Return a (signed or unsigned) n byte integer from the given byte offset." - | byteOffset rcvr addr floatValue | - <export: true> - <inline: false> - <var: #floatValue type: #float> - byteOffset := interpreterProxy stackIntegerValue: 0. - rcvr := interpreterProxy stackObjectValue: 1. - interpreterProxy failed ifTrue:[^0]. - addr := self ffiAddressOf: rcvr startingAt: byteOffset size: 4. - interpreterProxy failed ifTrue:[^0]. - self memcpy: (self addressOf: floatValue) _: addr _: (self sizeof: floatValue). - interpreterProxy pop: 2. - ^interpreterProxy pushFloat: floatValue! Item was removed: - ----- Method: FFIPlugin>>primitiveFFIFloatAtPut (in category 'primitives') ----- - primitiveFFIFloatAtPut - "Return a (signed or unsigned) n byte integer from the given byte offset." - | byteOffset rcvr addr floatValue floatOop | - <export: true> - <inline: false> - <var: #floatValue type: #float> - floatOop := interpreterProxy stackValue: 0. - (interpreterProxy isIntegerObject: floatOop) - ifTrue:[floatValue := self cCoerce: (interpreterProxy integerValueOf: floatOop) to:'float'] - ifFalse:[floatValue := self cCoerce: (interpreterProxy floatValueOf: floatOop) to:'float']. - byteOffset := interpreterProxy stackIntegerValue: 1. - rcvr := interpreterProxy stackObjectValue: 2. - interpreterProxy failed ifTrue:[^0]. - addr := self ffiAddressOf: rcvr startingAt: byteOffset size: 4. - interpreterProxy failed ifTrue:[^0]. - self memcpy: addr _: (self addressOf: floatValue) _: (self sizeof: floatValue). - interpreterProxy pop: 3. - ^interpreterProxy push: floatOop! Item was removed: - ----- Method: FFIPlugin>>primitiveFFIFree (in category 'primitives') ----- - primitiveFFIFree - "Primitive. Free the object pointed to on the external heap." - | addr oop ptr | - <export: true> - <inline: false> - <var: #ptr type:'int *'> - oop := interpreterProxy stackObjectValue: 0. - interpreterProxy failed ifTrue:[^nil]. - (interpreterProxy fetchClassOf: oop) = (interpreterProxy classExternalAddress) - ifFalse:[^interpreterProxy primitiveFail]. - (interpreterProxy byteSizeOf: oop) = 4 - ifFalse:[^interpreterProxy primitiveFail]. - ptr := interpreterProxy firstIndexableField: oop. - addr := ptr at: 0. - "Don't you dare to free Squeak's memory!!" - (addr = 0 or:[interpreterProxy isInMemory: addr]) - ifTrue:[^interpreterProxy primitiveFail]. - self ffiFree: addr. - ^ptr at: 0 put: 0. "cleanup" - ! Item was removed: - ----- Method: FFIPlugin>>primitiveFFIGetLastError (in category 'primitives') ----- - primitiveFFIGetLastError - "Primitive. Return the error code from a failed call to the foreign function interface." - <export: true> - <inline: false> - interpreterProxy pop: 1. - ^interpreterProxy pushInteger: self ffiGetLastError.! Item was removed: - ----- Method: FFIPlugin>>primitiveFFIIntegerAt (in category 'primitives') ----- - primitiveFFIIntegerAt - "Return a (signed or unsigned) n byte integer from the given byte offset." - | isSigned byteSize byteOffset rcvr addr value mask | - <export: true> - <inline: false> - isSigned := interpreterProxy booleanValueOf: (interpreterProxy stackValue: 0). - byteSize := interpreterProxy stackIntegerValue: 1. - byteOffset := interpreterProxy stackIntegerValue: 2. - rcvr := interpreterProxy stackObjectValue: 3. - interpreterProxy failed ifTrue:[^0]. - (byteOffset > 0 and:[byteSize = 1 or:[byteSize = 2 or:[byteSize = 4]]]) - ifFalse:[^interpreterProxy primitiveFail]. - addr := self ffiAddressOf: rcvr startingAt: byteOffset size: byteSize. - interpreterProxy failed ifTrue:[^0]. - byteSize < 4 ifTrue:[ - "short/byte" - byteSize = 1 - ifTrue:[value := interpreterProxy byteAt: addr] - ifFalse:[ value := self cCode: '*((unsigned short int *) addr)' - inSmalltalk: [interpreterProxy shortAt: addr]]. - isSigned ifTrue:["sign extend value" - mask := 1 << (byteSize * 8 - 1). - value := (value bitAnd: mask-1) - (value bitAnd: mask)]. - "note: byte/short never exceed SmallInteger range" - value := interpreterProxy integerObjectOf: value. - ] ifFalse:[ - "general 32 bit integer" - value := interpreterProxy longAt: addr. - isSigned - ifTrue:[value := interpreterProxy signed32BitIntegerFor: value] - ifFalse:[value := interpreterProxy positive32BitIntegerFor: value]. - ]. - interpreterProxy pop: 4. - ^interpreterProxy push: value - ! Item was removed: - ----- Method: FFIPlugin>>primitiveFFIIntegerAtPut (in category 'primitives') ----- - primitiveFFIIntegerAtPut - "Store a (signed or unsigned) n byte integer at the given byte offset." - | isSigned byteSize byteOffset rcvr addr value max valueOop | - <export: true> - <inline: false> - isSigned := interpreterProxy booleanValueOf: (interpreterProxy stackValue: 0). - byteSize := interpreterProxy stackIntegerValue: 1. - valueOop := interpreterProxy stackValue: 2. - byteOffset := interpreterProxy stackIntegerValue: 3. - rcvr := interpreterProxy stackObjectValue: 4. - interpreterProxy failed ifTrue:[^0]. - (byteOffset > 0 and:[byteSize = 1 or:[byteSize = 2 or:[byteSize = 4]]]) - ifFalse:[^interpreterProxy primitiveFail]. - addr := self ffiAddressOf: rcvr startingAt: byteOffset size: byteSize. - interpreterProxy failed ifTrue:[^0]. - isSigned - ifTrue:[value := interpreterProxy signed32BitValueOf: valueOop] - ifFalse:[value := interpreterProxy positive32BitValueOf: valueOop]. - interpreterProxy failed ifTrue:[^0]. - byteSize < 4 ifTrue:[ - isSigned ifTrue:[ - max := 1 << (8 * byteSize - 1). - value >= max ifTrue:[^interpreterProxy primitiveFail]. - value < (0 - max) ifTrue:[^interpreterProxy primitiveFail]. - ] ifFalse:[ - value >= (1 << (8*byteSize)) ifTrue:[^interpreterProxy primitiveFail]. - ]. - "short/byte" - byteSize = 1 - ifTrue:[interpreterProxy byteAt: addr put: value] - ifFalse:[ self cCode: '*((short int *) addr) = value' - inSmalltalk: [interpreterProxy shortAt: addr put: value]]. - ] ifFalse:[interpreterProxy longAt: addr put: value]. - interpreterProxy pop: 5. - ^interpreterProxy push: valueOop.! Item was removed: - ----- Method: FFIPlugin>>primitiveForceLoad (in category 'primitives') ----- - primitiveForceLoad - "Primitive. Force loading the receiver (an instance of ExternalLibrary)." - | rcvr theClass moduleHandlePtr moduleHandle ffiModuleName moduleLength ptr | - <export: true> - <inline: false> - <var: #ptr type:'int *'> - self ffiSetLastError: FFIErrorGenericError. "educated guess if we fail silently" - interpreterProxy methodArgumentCount = 0 - ifFalse:[^interpreterProxy primitiveFail]. - rcvr := interpreterProxy stackValue: 0. - theClass := interpreterProxy fetchClassOf: rcvr. - (interpreterProxy includesBehavior: theClass - ThatOf: interpreterProxy classExternalLibrary) - ifFalse:[^self ffiFail: FFIErrorBadExternalLibrary]. - moduleHandlePtr := interpreterProxy fetchPointer: 0 ofObject: rcvr. - moduleHandle := self ffiContentsOfHandle: moduleHandlePtr errCode: FFIErrorBadExternalLibrary. - interpreterProxy failed ifTrue:[^0]. - ffiModuleName := interpreterProxy fetchPointer: 1 ofObject: rcvr. - (interpreterProxy isBytes: ffiModuleName) - ifFalse:[^self ffiFail: FFIErrorBadExternalLibrary]. - moduleLength := interpreterProxy byteSizeOf: ffiModuleName. - moduleHandle := interpreterProxy ioLoadModule: (self cCoerce: (interpreterProxy firstIndexableField: ffiModuleName) to:'int') OfLength: moduleLength. - interpreterProxy failed ifTrue:[^self ffiFail: FFIErrorModuleNotFound]. "failed" - "and store back" - ptr := interpreterProxy firstIndexableField: moduleHandlePtr. - ptr at: 0 put: moduleHandle. - ^0 "done"! Item was removed: - ----- Method: FFIPlugin>>primitiveLogCallsTo (in category 'primitives') ----- - primitiveLogCallsTo - "Enable logging of FFI calls by providing it with a log file name." - | logFile ok | - <export: true> - interpreterProxy methodArgumentCount = 1 - ifFalse:[^interpreterProxy primitiveFail]. - logFile := interpreterProxy stackObjectValue: 0. - logFile == interpreterProxy nilObject ifTrue:[ "disable logging" - ok := self ffiLogFileName: nil OfLength: 0. - ok ifFalse:[^interpreterProxy primitiveFail]. - ffiLogEnabled := false. - ] ifFalse:[ "enable logging" - (interpreterProxy isBytes: logFile) ifFalse:[^interpreterProxy primitiveFail]. - ok := self ffiLogFileName: (interpreterProxy firstIndexableField: logFile) - OfLength: (interpreterProxy byteSizeOf: logFile). - ok ifFalse:[^interpreterProxy primitiveFail]. - ffiLogEnabled := true. - ]. - ^interpreterProxy pop: 1. "pop arg; return rcvr" - ! Item was removed: - ----- Method: FFIPlugin>>primitiveSetManualSurfacePointer (in category 'primitives - surfaces') ----- - primitiveSetManualSurfacePointer - "Create a 'manual surface' data-structure. See the ExternalForm class in the FFI package for example usage." - "arguments: name(type, stack offset) - surfaceID(Integer, 1) - ptr(uint32, 0)" - | surfaceID ptr result | - <export: true> - <var: #ptr type: #'unsigned int'> - - interpreterProxy methodArgumentCount == 2 ifFalse: [^interpreterProxy primitiveFail]. - surfaceID := interpreterProxy stackIntegerValue: 1. - ptr := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 0). - interpreterProxy failed ifTrue: [^nil]. - - self touch: surfaceID; touch: ptr. - - result := self cCode: 'setManualSurfacePointer(surfaceID, (void*)ptr)'. - result = 0 ifTrue: [^interpreterProxy primitiveFail]. - ^interpreterProxy pop: 2 - ! Item was removed: - ----- Method: ThreadedARM32FFIPlugin>>ffiPushDoubleFloat:in: (in category 'marshalling') ----- - ffiPushDoubleFloat: value in: calloutState - <var: #value type: #double> - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - - calloutState floatRegisterIndex < (NumFloatRegArgs - 1) - ifTrue: - [(calloutState floatRegisterIndex bitAnd: 1) = 1 - ifTrue: - [calloutState backfillFloatRegisterIndex: calloutState floatRegisterIndex. - calloutState floatRegisterIndex: (calloutState floatRegisterIndex + 1)]. - (self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: calloutState floatRegisterIndex)) - to: 'double*') - at: 0 - put: value. - calloutState floatRegisterIndex: calloutState floatRegisterIndex + 2] - ifFalse: - [calloutState currentArg + 8 > calloutState limit ifTrue: - [^FFIErrorCallFrameTooBig]. - calloutState floatRegisterIndex: NumFloatRegArgs. - interpreterProxy storeFloatAtPointer: calloutState currentArg from: value. - calloutState currentArg: calloutState currentArg + 8]. - ^0! Item was added: + ----- Method: ThreadedARM32FFIPlugin>>ffiPushFloat32:in: (in category 'marshalling') ----- + ffiPushFloat32: value in: calloutState + <var: #value type: #float> + <var: #calloutState type: #'CalloutState *'> + <inline: #always> + calloutState floatRegisterIndex < NumFloatRegArgs + ifTrue: + [calloutState backfillFloatRegisterIndex > 0 + ifTrue: + [calloutState floatRegisters at: calloutState backfillFloatRegisterIndex put: value. + calloutState backfillFloatRegisterIndex: 0] + ifFalse: + [calloutState floatRegisters at: calloutState floatRegisterIndex put: value. + calloutState floatRegisterIndex: calloutState floatRegisterIndex + 1]] + ifFalse: + [calloutState currentArg + self wordSize > calloutState limit ifTrue: + [^FFIErrorCallFrameTooBig]. + interpreterProxy storeSingleFloatAtPointer: calloutState currentArg from: value. + calloutState currentArg: calloutState currentArg + self wordSize]. + ^0! Item was added: + ----- Method: ThreadedARM32FFIPlugin>>ffiPushFloat64:in: (in category 'marshalling') ----- + ffiPushFloat64: value in: calloutState + <var: #value type: #double> + <var: #calloutState type: #'CalloutState *'> + <inline: #always> + + calloutState floatRegisterIndex < (NumFloatRegArgs - 1) + ifTrue: + [(calloutState floatRegisterIndex bitAnd: 1) = 1 + ifTrue: + [calloutState backfillFloatRegisterIndex: calloutState floatRegisterIndex. + calloutState floatRegisterIndex: (calloutState floatRegisterIndex + 1)]. + (self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: calloutState floatRegisterIndex)) + to: 'double*') + at: 0 + put: value. + calloutState floatRegisterIndex: calloutState floatRegisterIndex + 2] + ifFalse: + [calloutState currentArg + 8 > calloutState limit ifTrue: + [^FFIErrorCallFrameTooBig]. + calloutState floatRegisterIndex: NumFloatRegArgs. + interpreterProxy storeFloatAtPointer: calloutState currentArg from: value. + calloutState currentArg: calloutState currentArg + 8]. + ^0! Item was added: + ----- Method: ThreadedARM32FFIPlugin>>ffiPushSigned16:in: (in category 'marshalling') ----- + ffiPushSigned16: value in: calloutState + <var: #calloutState type: #'CalloutState *'> + <inline: #always> + calloutState integerRegisterIndex < NumIntRegArgs + ifTrue: + [calloutState integerRegisters at: calloutState integerRegisterIndex put: (self cCoerceSimple: value to: #'signed short'). + calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1] + ifFalse: + [calloutState currentArg + self wordSize > calloutState limit ifTrue: + [^FFIErrorCallFrameTooBig]. + interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'signed short'). + calloutState currentArg: calloutState currentArg + self wordSize]. + ^0! Item was added: + ----- Method: ThreadedARM32FFIPlugin>>ffiPushSigned32:in: (in category 'marshalling') ----- + ffiPushSigned32: value in: calloutState + <var: #calloutState type: #'CalloutState *'> + <inline: #always> + calloutState integerRegisterIndex < NumIntRegArgs + ifTrue: + [calloutState integerRegisters at: calloutState integerRegisterIndex put: value. + calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1] + ifFalse: + [calloutState currentArg + self wordSize > calloutState limit ifTrue: + [^FFIErrorCallFrameTooBig]. + interpreterProxy longAt: calloutState currentArg put: value. + calloutState currentArg: calloutState currentArg + self wordSize]. + ^0! Item was added: + ----- Method: ThreadedARM32FFIPlugin>>ffiPushSigned64:in: (in category 'marshalling') ----- + ffiPushSigned64: value in: calloutState + <var: #value type: #sqLong> + <var: #calloutState type: #'CalloutState *'> + <inline: #always> + calloutState integerRegisterIndex < (NumIntRegArgs - 1) + ifTrue: + [calloutState integerRegisterIndex: (calloutState integerRegisterIndex + 1 bitClear: 1). + calloutState integerRegisters at: calloutState integerRegisterIndex put: (self cCoerceSimple: value to: #usqInt). + calloutState integerRegisters at: calloutState integerRegisterIndex + 1 put: (self cCoerceSimple: value >> 32 to: #usqInt). + calloutState integerRegisterIndex: calloutState integerRegisterIndex + 2] + ifFalse: + [calloutState currentArg + 8 > calloutState limit ifTrue: [^FFIErrorCallFrameTooBig]. + calloutState integerRegisterIndex: NumIntRegArgs. + interpreterProxy + longAt: calloutState currentArg put: (self cCoerceSimple: value to: #usqInt); + longAt: calloutState currentArg + self wordSize put: (self cCoerceSimple: value >> 32 to: #usqInt). + calloutState currentArg: calloutState currentArg + 8]. + ^0! Item was added: + ----- Method: ThreadedARM32FFIPlugin>>ffiPushSigned8:in: (in category 'marshalling') ----- + ffiPushSigned8: value in: calloutState + <var: #calloutState type: #'CalloutState *'> + <inline: #always> + calloutState integerRegisterIndex < NumIntRegArgs + ifTrue: + [calloutState integerRegisters at: calloutState integerRegisterIndex put: (self cCoerceSimple: value to: #'signed char'). + calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1] + ifFalse: + [calloutState currentArg + self wordSize > calloutState limit ifTrue: + [^FFIErrorCallFrameTooBig]. + interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'signed char'). + calloutState currentArg: calloutState currentArg + self wordSize]. + ^0! Item was removed: - ----- Method: ThreadedARM32FFIPlugin>>ffiPushSignedByte:in: (in category 'marshalling') ----- - ffiPushSignedByte: value in: calloutState - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - calloutState integerRegisterIndex < NumIntRegArgs - ifTrue: - [calloutState integerRegisters at: calloutState integerRegisterIndex put: (self cCoerceSimple: value to: #'signed char'). - calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1] - ifFalse: - [calloutState currentArg + self wordSize > calloutState limit ifTrue: - [^FFIErrorCallFrameTooBig]. - interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'signed char'). - calloutState currentArg: calloutState currentArg + self wordSize]. - ^0! Item was removed: - ----- Method: ThreadedARM32FFIPlugin>>ffiPushSignedChar:in: (in category 'marshalling') ----- - ffiPushSignedChar: value in: calloutState - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - calloutState integerRegisterIndex < NumIntRegArgs - ifTrue: - [calloutState integerRegisters at: calloutState integerRegisterIndex put: (self cCoerceSimple: value to: #'signed char'). - calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1] - ifFalse: - [calloutState currentArg + self wordSize > calloutState limit ifTrue: - [^FFIErrorCallFrameTooBig]. - interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'signed char'). - calloutState currentArg: calloutState currentArg + self wordSize]. - ^0! Item was removed: - ----- Method: ThreadedARM32FFIPlugin>>ffiPushSignedInt:in: (in category 'marshalling') ----- - ffiPushSignedInt: value in: calloutState - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - calloutState integerRegisterIndex < NumIntRegArgs - ifTrue: - [calloutState integerRegisters at: calloutState integerRegisterIndex put: value. - calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1] - ifFalse: - [calloutState currentArg + self wordSize > calloutState limit ifTrue: - [^FFIErrorCallFrameTooBig]. - interpreterProxy longAt: calloutState currentArg put: value. - calloutState currentArg: calloutState currentArg + self wordSize]. - ^0! Item was removed: - ----- Method: ThreadedARM32FFIPlugin>>ffiPushSignedLongLong:in: (in category 'marshalling') ----- - ffiPushSignedLongLong: value in: calloutState - <var: #value type: #sqLong> - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - calloutState integerRegisterIndex < (NumIntRegArgs - 1) - ifTrue: - [calloutState integerRegisterIndex: (calloutState integerRegisterIndex + 1 bitClear: 1). - calloutState integerRegisters at: calloutState integerRegisterIndex put: (self cCoerceSimple: value to: #usqInt). - calloutState integerRegisters at: calloutState integerRegisterIndex + 1 put: (self cCoerceSimple: value >> 32 to: #usqInt). - calloutState integerRegisterIndex: calloutState integerRegisterIndex + 2] - ifFalse: - [calloutState currentArg + 8 > calloutState limit ifTrue: [^FFIErrorCallFrameTooBig]. - calloutState integerRegisterIndex: NumIntRegArgs. - interpreterProxy - longAt: calloutState currentArg put: (self cCoerceSimple: value to: #usqInt); - longAt: calloutState currentArg + self wordSize put: (self cCoerceSimple: value >> 32 to: #usqInt). - calloutState currentArg: calloutState currentArg + 8]. - ^0! Item was removed: - ----- Method: ThreadedARM32FFIPlugin>>ffiPushSignedShort:in: (in category 'marshalling') ----- - ffiPushSignedShort: value in: calloutState - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - calloutState integerRegisterIndex < NumIntRegArgs - ifTrue: - [calloutState integerRegisters at: calloutState integerRegisterIndex put: (self cCoerceSimple: value to: #'signed short'). - calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1] - ifFalse: - [calloutState currentArg + self wordSize > calloutState limit ifTrue: - [^FFIErrorCallFrameTooBig]. - interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'signed short'). - calloutState currentArg: calloutState currentArg + self wordSize]. - ^0! Item was removed: - ----- Method: ThreadedARM32FFIPlugin>>ffiPushSingleFloat:in: (in category 'marshalling') ----- - ffiPushSingleFloat: value in: calloutState - <var: #value type: #float> - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - calloutState floatRegisterIndex < NumFloatRegArgs - ifTrue: - [calloutState backfillFloatRegisterIndex > 0 - ifTrue: - [calloutState floatRegisters at: calloutState backfillFloatRegisterIndex put: value. - calloutState backfillFloatRegisterIndex: 0] - ifFalse: - [calloutState floatRegisters at: calloutState floatRegisterIndex put: value. - calloutState floatRegisterIndex: calloutState floatRegisterIndex + 1]] - ifFalse: - [calloutState currentArg + self wordSize > calloutState limit ifTrue: - [^FFIErrorCallFrameTooBig]. - interpreterProxy storeSingleFloatAtPointer: calloutState currentArg from: value. - calloutState currentArg: calloutState currentArg + self wordSize]. - ^0! Item was added: + ----- Method: ThreadedARM32FFIPlugin>>ffiPushUnsigned16:in: (in category 'marshalling') ----- + ffiPushUnsigned16: value in: calloutState + <var: #calloutState type: #'CalloutState *'> + <inline: #always> + calloutState integerRegisterIndex < NumIntRegArgs + ifTrue: + [calloutState integerRegisters at: calloutState integerRegisterIndex put: (self cCoerceSimple: value to: #'unsigned short'). + calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1] + ifFalse: + [calloutState currentArg + self wordSize > calloutState limit ifTrue: + [^FFIErrorCallFrameTooBig]. + interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'unsigned short'). + calloutState currentArg: calloutState currentArg + self wordSize]. + ^0! Item was added: + ----- Method: ThreadedARM32FFIPlugin>>ffiPushUnsigned32:in: (in category 'marshalling') ----- + ffiPushUnsigned32: value in: calloutState + <var: #calloutState type: #'CalloutState *'> + <inline: #always> + calloutState integerRegisterIndex < NumIntRegArgs + ifTrue: + [calloutState integerRegisters at: calloutState integerRegisterIndex put: value. + calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1] + ifFalse: + [calloutState currentArg + self wordSize > calloutState limit ifTrue: + [^FFIErrorCallFrameTooBig]. + interpreterProxy longAt: calloutState currentArg put: value. + calloutState currentArg: calloutState currentArg + self wordSize]. + ^0! Item was added: + ----- Method: ThreadedARM32FFIPlugin>>ffiPushUnsigned64:in: (in category 'marshalling') ----- + ffiPushUnsigned64: value in: calloutState + <var: #value type: #usqLong> + <var: #calloutState type: #'CalloutState *'> + <inline: #always> + calloutState integerRegisterIndex < (NumIntRegArgs - 1) + ifTrue: + [calloutState integerRegisterIndex: (calloutState integerRegisterIndex + 1 bitClear: 1). + calloutState integerRegisters at: calloutState integerRegisterIndex put: (self cCoerceSimple: value to: #usqInt). + calloutState integerRegisters at: calloutState integerRegisterIndex + 1 put: (self cCoerceSimple: value >> 32 to: #usqInt). + calloutState integerRegisterIndex: calloutState integerRegisterIndex + 2] + ifFalse: + [calloutState currentArg + 8 > calloutState limit ifTrue: [^FFIErrorCallFrameTooBig]. + calloutState integerRegisterIndex: NumIntRegArgs. + interpreterProxy + longAt: calloutState currentArg put: (self cCoerceSimple: value to: #usqInt); + longAt: calloutState currentArg + self wordSize put: (self cCoerceSimple: value >> 32 to: #usqInt). + calloutState currentArg: calloutState currentArg + 8]. + ^0! Item was added: + ----- Method: ThreadedARM32FFIPlugin>>ffiPushUnsigned8:in: (in category 'marshalling') ----- + ffiPushUnsigned8: value in: calloutState + <var: #calloutState type: #'CalloutState *'> + <inline: #always> + calloutState integerRegisterIndex < NumIntRegArgs + ifTrue: + [calloutState integerRegisters at: calloutState integerRegisterIndex put: (self cCoerceSimple: value to: #'unsigned char'). + calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1] + ifFalse: + [calloutState currentArg + self wordSize > calloutState limit ifTrue: + [^FFIErrorCallFrameTooBig]. + interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'unsigned char'). + calloutState currentArg: calloutState currentArg + self wordSize]. + ^0! Item was removed: - ----- Method: ThreadedARM32FFIPlugin>>ffiPushUnsignedByte:in: (in category 'marshalling') ----- - ffiPushUnsignedByte: value in: calloutState - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - calloutState integerRegisterIndex < NumIntRegArgs - ifTrue: - [calloutState integerRegisters at: calloutState integerRegisterIndex put: (self cCoerceSimple: value to: #'unsigned char'). - calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1] - ifFalse: - [calloutState currentArg + self wordSize > calloutState limit ifTrue: - [^FFIErrorCallFrameTooBig]. - interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'unsigned char'). - calloutState currentArg: calloutState currentArg + self wordSize]. - ^0! Item was removed: - ----- Method: ThreadedARM32FFIPlugin>>ffiPushUnsignedChar:in: (in category 'marshalling') ----- - ffiPushUnsignedChar: value in: calloutState - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - calloutState integerRegisterIndex < NumIntRegArgs - ifTrue: - [calloutState integerRegisters at: calloutState integerRegisterIndex put: (self cCoerceSimple: value to: #'unsigned char'). - calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1] - ifFalse: - [calloutState currentArg + self wordSize > calloutState limit ifTrue: - [^FFIErrorCallFrameTooBig]. - interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'unsigned char'). - calloutState currentArg: calloutState currentArg + self wordSize]. - ^0! Item was removed: - ----- Method: ThreadedARM32FFIPlugin>>ffiPushUnsignedInt:in: (in category 'marshalling') ----- - ffiPushUnsignedInt: value in: calloutState - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - calloutState integerRegisterIndex < NumIntRegArgs - ifTrue: - [calloutState integerRegisters at: calloutState integerRegisterIndex put: value. - calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1] - ifFalse: - [calloutState currentArg + self wordSize > calloutState limit ifTrue: - [^FFIErrorCallFrameTooBig]. - interpreterProxy longAt: calloutState currentArg put: value. - calloutState currentArg: calloutState currentArg + self wordSize]. - ^0! Item was removed: - ----- Method: ThreadedARM32FFIPlugin>>ffiPushUnsignedLongLong:in: (in category 'marshalling') ----- - ffiPushUnsignedLongLong: value in: calloutState - <var: #value type: #usqLong> - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - calloutState integerRegisterIndex < (NumIntRegArgs - 1) - ifTrue: - [calloutState integerRegisterIndex: (calloutState integerRegisterIndex + 1 bitClear: 1). - calloutState integerRegisters at: calloutState integerRegisterIndex put: (self cCoerceSimple: value to: #usqInt). - calloutState integerRegisters at: calloutState integerRegisterIndex + 1 put: (self cCoerceSimple: value >> 32 to: #usqInt). - calloutState integerRegisterIndex: calloutState integerRegisterIndex + 2] - ifFalse: - [calloutState currentArg + 8 > calloutState limit ifTrue: [^FFIErrorCallFrameTooBig]. - calloutState integerRegisterIndex: NumIntRegArgs. - interpreterProxy - longAt: calloutState currentArg put: (self cCoerceSimple: value to: #usqInt); - longAt: calloutState currentArg + self wordSize put: (self cCoerceSimple: value >> 32 to: #usqInt). - calloutState currentArg: calloutState currentArg + 8]. - ^0! Item was removed: - ----- Method: ThreadedARM32FFIPlugin>>ffiPushUnsignedShort:in: (in category 'marshalling') ----- - ffiPushUnsignedShort: value in: calloutState - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - calloutState integerRegisterIndex < NumIntRegArgs - ifTrue: - [calloutState integerRegisters at: calloutState integerRegisterIndex put: (self cCoerceSimple: value to: #'unsigned short'). - calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1] - ifFalse: - [calloutState currentArg + self wordSize > calloutState limit ifTrue: - [^FFIErrorCallFrameTooBig]. - interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'unsigned short'). - calloutState currentArg: calloutState currentArg + self wordSize]. - ^0! Item was removed: - ----- Method: ThreadedARM64FFIPlugin>>ffiPushDoubleFloat:in: (in category 'marshalling') ----- - ffiPushDoubleFloat: value in: calloutState - <var: #value type: #double> - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - - calloutState floatRegisterIndex < NumFloatRegArgs - ifTrue: - [calloutState floatRegisters - at: calloutState floatRegisterIndex - put: value. - calloutState floatRegisterIndex: calloutState floatRegisterIndex + 1] - ifFalse: - [calloutState currentArg + self wordSize > calloutState limit ifTrue: - [^FFIErrorCallFrameTooBig]. - calloutState floatRegisterIndex: NumFloatRegArgs. - interpreterProxy storeFloatAtPointer: calloutState currentArg from: value. - calloutState currentArg: calloutState currentArg + self wordSize]. - ^0! Item was added: + ----- Method: ThreadedARM64FFIPlugin>>ffiPushFloat32:in: (in category 'marshalling') ----- + ffiPushFloat32: value in: calloutState + <var: #value type: #float> + <var: #calloutState type: #'CalloutState *'> + <inline: #always> + calloutState floatRegisterIndex < NumFloatRegArgs + ifTrue: "Note: this is a 'memcopy', so size is preserved. Casting to #double changes the size" + [(self cCoerceSimple: + (self addressOf: (calloutState floatRegisters at: calloutState floatRegisterIndex)) + to: 'float*') + at: 0 + put: value. + calloutState floatRegisterIndex: calloutState floatRegisterIndex + 1] + ifFalse: + [calloutState currentArg + self wordSize > calloutState limit ifTrue: + [^FFIErrorCallFrameTooBig]. + interpreterProxy storeSingleFloatAtPointer: calloutState currentArg from: value. + calloutState currentArg: calloutState currentArg + self wordSize]. + ^0! Item was added: + ----- Method: ThreadedARM64FFIPlugin>>ffiPushFloat64:in: (in category 'marshalling') ----- + ffiPushFloat64: value in: calloutState + <var: #value type: #double> + <var: #calloutState type: #'CalloutState *'> + <inline: #always> + + calloutState floatRegisterIndex < NumFloatRegArgs + ifTrue: + [calloutState floatRegisters + at: calloutState floatRegisterIndex + put: value. + calloutState floatRegisterIndex: calloutState floatRegisterIndex + 1] + ifFalse: + [calloutState currentArg + self wordSize > calloutState limit ifTrue: + [^FFIErrorCallFrameTooBig]. + calloutState floatRegisterIndex: NumFloatRegArgs. + interpreterProxy storeFloatAtPointer: calloutState currentArg from: value. + calloutState currentArg: calloutState currentArg + self wordSize]. + ^0! Item was added: + ----- Method: ThreadedARM64FFIPlugin>>ffiPushSigned32:in: (in category 'marshalling') ----- + ffiPushSigned32: value in: calloutState + <var: #calloutState type: #'CalloutState *'> + <inline: #always> + calloutState integerRegisterIndex < NumIntRegArgs + ifTrue: + [calloutState integerRegisters + at: calloutState integerRegisterIndex + put: (self cCoerceSimple: value to: #sqLong). + calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1] + ifFalse: + [calloutState currentArg + self wordSize > calloutState limit ifTrue: + [^FFIErrorCallFrameTooBig]. + interpreterProxy longAt: calloutState currentArg put: value. + calloutState currentArg: calloutState currentArg + self wordSize]. + ^0! Item was added: + ----- Method: ThreadedARM64FFIPlugin>>ffiPushSigned64:in: (in category 'marshalling') ----- + ffiPushSigned64: value in: calloutState + <var: #value type: #sqLong> + <var: #calloutState type: #'CalloutState *'> + <inline: #always> + calloutState integerRegisterIndex < NumIntRegArgs + ifTrue: + [calloutState integerRegisters + at: calloutState integerRegisterIndex + put: (self cCoerceSimple: value to: #sqLong). + calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1] + ifFalse: + [calloutState currentArg + self wordSize > calloutState limit ifTrue: [^FFIErrorCallFrameTooBig]. + interpreterProxy longAt: calloutState currentArg put: value. + calloutState currentArg: calloutState currentArg + self wordSize]. + ^0! Item was removed: - ----- Method: ThreadedARM64FFIPlugin>>ffiPushSignedInt:in: (in category 'marshalling') ----- - ffiPushSignedInt: value in: calloutState - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - calloutState integerRegisterIndex < NumIntRegArgs - ifTrue: - [calloutState integerRegisters - at: calloutState integerRegisterIndex - put: (self cCoerceSimple: value to: #sqLong). - calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1] - ifFalse: - [calloutState currentArg + self wordSize > calloutState limit ifTrue: - [^FFIErrorCallFrameTooBig]. - interpreterProxy longAt: calloutState currentArg put: value. - calloutState currentArg: calloutState currentArg + self wordSize]. - ^0! Item was removed: - ----- Method: ThreadedARM64FFIPlugin>>ffiPushSignedLongLong:in: (in category 'marshalling') ----- - ffiPushSignedLongLong: value in: calloutState - <var: #value type: #sqLong> - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - calloutState integerRegisterIndex < NumIntRegArgs - ifTrue: - [calloutState integerRegisters - at: calloutState integerRegisterIndex - put: (self cCoerceSimple: value to: #sqLong). - calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1] - ifFalse: - [calloutState currentArg + self wordSize > calloutState limit ifTrue: [^FFIErrorCallFrameTooBig]. - interpreterProxy longAt: calloutState currentArg put: value. - calloutState currentArg: calloutState currentArg + self wordSize]. - ^0! Item was removed: - ----- Method: ThreadedARM64FFIPlugin>>ffiPushSingleFloat:in: (in category 'marshalling') ----- - ffiPushSingleFloat: value in: calloutState - <var: #value type: #float> - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - calloutState floatRegisterIndex < NumFloatRegArgs - ifTrue: "Note: this is a 'memcopy', so size is preserved. Casting to #double changes the size" - [(self cCoerceSimple: - (self addressOf: (calloutState floatRegisters at: calloutState floatRegisterIndex)) - to: 'float*') - at: 0 - put: value. - calloutState floatRegisterIndex: calloutState floatRegisterIndex + 1] - ifFalse: - [calloutState currentArg + self wordSize > calloutState limit ifTrue: - [^FFIErrorCallFrameTooBig]. - interpreterProxy storeSingleFloatAtPointer: calloutState currentArg from: value. - calloutState currentArg: calloutState currentArg + self wordSize]. - ^0! Item was added: + ----- Method: ThreadedARM64FFIPlugin>>ffiPushUnsigned32:in: (in category 'marshalling') ----- + ffiPushUnsigned32: value in: calloutState + <var: #calloutState type: #'CalloutState *'> + <inline: #always> + calloutState integerRegisterIndex < NumIntRegArgs + ifTrue: + [calloutState integerRegisters + at: calloutState integerRegisterIndex + put: (self cCoerceSimple: value to: #usqLong). + calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1] + ifFalse: + [calloutState currentArg + self wordSize > calloutState limit ifTrue: + [^FFIErrorCallFrameTooBig]. + interpreterProxy longAt: calloutState currentArg put: value. + calloutState currentArg: calloutState currentArg + self wordSize]. + ^0! Item was added: + ----- Method: ThreadedARM64FFIPlugin>>ffiPushUnsigned64:in: (in category 'marshalling') ----- + ffiPushUnsigned64: value in: calloutState + <var: #value type: #usqLong> + <var: #calloutState type: #'CalloutState *'> + <inline: #always> + calloutState integerRegisterIndex < NumIntRegArgs + ifTrue: + [calloutState integerRegisters + at: calloutState integerRegisterIndex + put:(self cCoerceSimple: value to: #usqLong). + calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1] + ifFalse: + [calloutState currentArg + self wordSize > calloutState limit ifTrue: [^FFIErrorCallFrameTooBig]. + interpreterProxy longAt: calloutState currentArg put: value. + calloutState currentArg: calloutState currentArg + self wordSize]. + ^0! Item was removed: - ----- Method: ThreadedARM64FFIPlugin>>ffiPushUnsignedInt:in: (in category 'marshalling') ----- - ffiPushUnsignedInt: value in: calloutState - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - calloutState integerRegisterIndex < NumIntRegArgs - ifTrue: - [calloutState integerRegisters - at: calloutState integerRegisterIndex - put: (self cCoerceSimple: value to: #usqLong). - calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1] - ifFalse: - [calloutState currentArg + self wordSize > calloutState limit ifTrue: - [^FFIErrorCallFrameTooBig]. - interpreterProxy longAt: calloutState currentArg put: value. - calloutState currentArg: calloutState currentArg + self wordSize]. - ^0! Item was removed: - ----- Method: ThreadedARM64FFIPlugin>>ffiPushUnsignedLongLong:in: (in category 'marshalling') ----- - ffiPushUnsignedLongLong: value in: calloutState - <var: #value type: #usqLong> - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - calloutState integerRegisterIndex < NumIntRegArgs - ifTrue: - [calloutState integerRegisters - at: calloutState integerRegisterIndex - put:(self cCoerceSimple: value to: #usqLong). - calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1] - ifFalse: - [calloutState currentArg + self wordSize > calloutState limit ifTrue: [^FFIErrorCallFrameTooBig]. - interpreterProxy longAt: calloutState currentArg put: value. - calloutState currentArg: calloutState currentArg + self wordSize]. - ^0! Item was changed: ----- Method: ThreadedFFIPlugin>>atomicTypeOf: (in category 'primitive support') ----- atomicTypeOf: typeSpec + <inline: #always> ^(typeSpec bitAnd: FFIAtomicTypeMask) >> FFIAtomicTypeShift! Item was changed: ----- Method: ThreadedFFIPlugin>>ffiArgByValue:in: (in category 'callout support') ----- ffiArgByValue: oop in: calloutState "Support for generic callout. Prepare an argument by value for a callout." <var: #calloutState type: #'CalloutState *'> | atomicType intValue floatValue | <inline: true> - <var: #floatValue type: #double> atomicType := self atomicTypeOf: calloutState ffiArgHeader. + (self isFloatAtomicType: atomicType) ifFalse: + [intValue := self ffiIntegerValueOf: oop. + interpreterProxy failed ifTrue: + [^FFIErrorCoercionFailed]. + "N.B. Slang inlines the functions within the dispatchOn:in:with:with: here-in" + self cppIf: BytesPerWord = 8 + ifTrue: + [^self dispatchOn: atomicType + in: #( + ffiPushVoid:in: "FFITypeVoid" + ffiPushUnsigned64:in: "FFITypeBool" + ffiPushUnsigned8:in: "FFITypeUnsignedInt8" + ffiPushSigned8:in: "FFITypeSignedInt8" + ffiPushUnsigned16:in: "FFITypeUnsignedInt16" + ffiPushSigned16:in: "FFITypeSignedInt16" + ffiPushUnsigned32:in: "FFITypeUnsignedInt32" + ffiPushSigned32:in: "FFITypeSignedInt32" + ffiPushUnsigned64:in: "FFITypeUnsignedInt64" + ffiPushSigned64:in: "FFITypeSignedInt64" + ffiPushUnsigned8:in: "FFITypeUnsignedChar8" + ffiPushSigned8:in: "FFITypeSignedChar8" + ffiPushVoid:in: "ffiPushFloat32:" "FFITypeSingleFloat" + ffiPushVoid:in: "ffiPushFloat64:" "FFITypeDoubleFloat" + ffiPushUnsigned16:in: "FFITypeUnsignedChar16" + ffiPushUnsigned32:in:) "FFITypeUnsignedChar32" + with: intValue + with: calloutState] + ifFalse: + [^self dispatchOn: atomicType + in: #( + ffiPushVoid:in: "FFITypeVoid" + ffiPushUnsigned32:in: "FFITypeBool" + ffiPushUnsigned8:in: "FFITypeUnsignedInt8" + ffiPushSigned8:in: "FFITypeSignedInt8" + ffiPushUnsigned16:in: "FFITypeUnsignedInt16" + ffiPushSigned16:in: "FFITypeSignedInt16" + ffiPushUnsigned32:in: "FFITypeUnsignedInt32" + ffiPushSigned32:in: "FFITypeSignedInt32" + ffiPushUnsigned64:in: "FFITypeUnsignedInt64" + ffiPushSigned64:in: "FFITypeSignedInt64" + ffiPushUnsigned8:in: "FFITypeUnsignedChar8" + ffiPushSigned8:in: "FFITypeSignedChar8" + ffiPushVoid:in: "ffiPushFloat32:" "FFITypeSingleFloat" + ffiPushVoid:in: "ffiPushFloat64:" "FFITypeDoubleFloat" + ffiPushUnsigned16:in: "FFITypeUnsignedChar16" + ffiPushUnsigned32:in:) "FFITypeUnsignedChar32" + with: intValue + with: calloutState]]. + - "check if the range is valid" - (atomicType < 0 or:[atomicType > FFITypeDoubleFloat]) - ifTrue:[^FFIErrorBadAtomicType]. - atomicType < FFITypeSingleFloat ifTrue:["integer types" - (atomicType >> 1) = (FFITypeSignedInt64 >> 1) - ifTrue:[intValue := oop] "ffi support code must coerce longlong" - ifFalse:[intValue := self ffiIntegerValueOf: oop]. "does all the coercions" - interpreterProxy failed ifTrue:[^FFIErrorCoercionFailed]. - ^self dispatchOn: atomicType - in: #( - ffiPushVoid:in: - ffiPushUnsignedInt:in: - ffiPushUnsignedByte:in: - ffiPushSignedByte:in: - ffiPushUnsignedShort:in: - ffiPushSignedShort:in: - ffiPushUnsignedInt:in: - ffiPushSignedInt:in: - ffiPushUnsignedLongLongOop:in: - ffiPushSignedLongLongOop:in: - ffiPushUnsignedChar:in: - ffiPushSignedChar:in:) - with: intValue - with: calloutState]. - "either float or double" floatValue := self ffiFloatValueOf: oop. interpreterProxy failed ifTrue: [^FFIErrorCoercionFailed]. atomicType = FFITypeSingleFloat + ifTrue: [^self ffiPushFloat32: floatValue in: calloutState] + ifFalse:[^self ffiPushFloat64: floatValue in: calloutState]! - ifTrue: [^self ffiPushSingleFloat: floatValue in: calloutState] - ifFalse:[^self ffiPushDoubleFloat: floatValue in: calloutState]! Item was changed: ----- Method: ThreadedFFIPlugin>>ffiCreateIntegralResultOop:ofAtomicType:in: (in category 'callout support') ----- ffiCreateIntegralResultOop: retVal ofAtomicType: atomicType in: calloutState <inline: #always> + <var: 'calloutState' type: #'CalloutState *'> + <var: 'retVal' type: #usqLong> - <var: #calloutState type: #'CalloutState *'> - <var: #retVal type: #usqLong> "Callout support. Return the appropriate oop for the given atomic type" | shift value mask byteSize | <var: 'value' type: #usqLong> <var: 'mask' type: #usqLong> - self assert: atomicType < FFITypeSingleFloat. + self deny: (self isFloatAtomicType: atomicType). + atomicType = FFITypeBool ifTrue: ["Make sure bool honors the byte size requested" byteSize := calloutState ffiRetHeader bitAnd: FFIStructSizeMask. value := byteSize = (self sizeof: retVal) + ifTrue: [retVal] + ifFalse: [retVal bitAnd: 1 asUnsignedLongLong << (byteSize * 8) - 1]. - ifTrue:[retVal] - ifFalse:[retVal bitAnd: 1 asUnsignedLongLong << (byteSize * 8) - 1]. ^value = 0 + ifTrue: [interpreterProxy falseObject] + ifFalse: [interpreterProxy trueObject]]. - ifTrue:[interpreterProxy falseObject] - ifFalse:[interpreterProxy trueObject]]. atomicType <= FFITypeSignedInt32 ifTrue: ["these are all generall integer returns" atomicType <= (BytesPerWord = 8 ifTrue: [FFITypeSignedInt32] ifFalse: [FFITypeSignedInt16]) ifTrue: + ["byte/short(/int). first extract partial word, then sign extend" - ["byte/short. first extract partial word, then sign extend" shift := (BytesPerWord = 8 and: [atomicType >= FFITypeUnsignedInt32]) ifTrue: [32] ifFalse: [(atomicType >> 1) * 8]. "# of significant bits" value := retVal bitAnd: (1 asUnsignedLongLong << shift - 1). (atomicType anyMask: 1) ifTrue: ["make the guy signed" mask := 1 asUnsignedLongLong << (shift-1). value := (value bitAnd: mask-1) - (value bitAnd: mask)]. ^interpreterProxy integerObjectOf: value]. "Word sized integer return" ^(atomicType anyMask: 1) + ifTrue: [interpreterProxy signedMachineIntegerFor: retVal] "signed return" + ifFalse: [interpreterProxy positiveMachineIntegerFor: retVal]]. "unsigned return" - ifTrue:[interpreterProxy signedMachineIntegerFor: retVal] "signed return" - ifFalse:[interpreterProxy positiveMachineIntegerFor: retVal]]. "unsigned return" "longlong, char" (atomicType >> 1) = (FFITypeSignedInt64 >> 1) ifTrue: [^(atomicType anyMask: 1) ifTrue: [interpreterProxy signed64BitIntegerFor: retVal] "signed return" + ifFalse: [interpreterProxy positive64BitIntegerFor: retVal]]. "unsigned return" + + self assert: (self isCharacterAtomicType: atomicType). + + ^atomicType caseOf: { + [FFITypeUnsignedChar8] -> [interpreterProxy characterObjectOf: (retVal bitAnd: 16rFF)]. + [FFITypeSignedChar8] -> [interpreterProxy characterObjectOf: (retVal bitAnd: 16rFF)]. + [FFITypeUnsignedChar16] -> [interpreterProxy characterObjectOf: (retVal bitAnd: 16rFFFF)]. + [FFITypeUnsignedChar32] -> [interpreterProxy characterObjectOf: (self cCoerce: retVal to: #'unsigned int')] }! - ifFalse: [interpreterProxy positive64BitIntegerFor: retVal]]. - self flag: 'we need a solution for wide characters; spur supports upto 30 bit characters'. - ^interpreterProxy characterObjectOf: (retVal bitAnd: 16rFF)! Item was changed: ----- Method: ThreadedFFIPlugin>>ffiLogCallsTo: (in category 'initialize') ----- ffiLogCallsTo: fileName + "This is a special entry point exposed such that client code can enable and disable logging of FFI calls." - "This is a special entry point exposed such that client code can - enable and disable logging of FFI calls." - | ok | <export: true> + <var: 'fileName' type: #'char*'> + fileName + ifNil: "disable logging" + [(self ffiLogFileName: nil OfLength: 0) ifFalse: + [^false]. + ffiLogEnabled := false] + ifNotNil: "enable logging" + [(self ffiLogFileName: fileName OfLength: (self strlen: fileName)) ifFalse: + [^false]. + ffiLogEnabled := true]. - <var: #fileName type: 'char*'> - fileName == nil ifTrue:[ "disable logging" - ok := self ffiLogFileName: nil OfLength: 0. - ok ifFalse:[^false]. - ffiLogEnabled := false. - ] ifFalse:[ "enable logging" - ok := self ffiLogFileName: fileName OfLength: (self strlen: fileName). - ok ifFalse:[^false]. - ffiLogEnabled := true. - ]. ^true! Item was removed: - ----- Method: ThreadedFFIPlugin>>ffiPushDoubleFloat:in: (in category 'marshalling') ----- - ffiPushDoubleFloat: value in: calloutState - <var: #calloutState type: #double> - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - ^self subclassResponsibility! Item was added: + ----- Method: ThreadedFFIPlugin>>ffiPushFloat32:in: (in category 'marshalling') ----- + ffiPushFloat32: value in: calloutState + <var: #value type: #float> + <var: #calloutState type: #'CalloutState *'> + <inline: #always> + self subclassResponsibility! Item was added: + ----- Method: ThreadedFFIPlugin>>ffiPushFloat64:in: (in category 'marshalling') ----- + ffiPushFloat64: value in: calloutState + <var: #calloutState type: #double> + <var: #calloutState type: #'CalloutState *'> + <inline: #always> + ^self subclassResponsibility! Item was added: + ----- Method: ThreadedFFIPlugin>>ffiPushSigned16:in: (in category 'marshalling') ----- + ffiPushSigned16: value in: calloutState + <var: #calloutState type: #'CalloutState *'> + <inline: #always> + self subclassResponsibility! Item was added: + ----- Method: ThreadedFFIPlugin>>ffiPushSigned32:in: (in category 'marshalling') ----- + ffiPushSigned32: value in: calloutState + <var: #calloutState type: #'CalloutState *'> + <inline: #always> + self subclassResponsibility! Item was added: + ----- Method: ThreadedFFIPlugin>>ffiPushSigned64:in: (in category 'marshalling') ----- + ffiPushSigned64: value in: calloutState + <var: #value type: #sqLong> + <var: #calloutState type: #'CalloutState *'> + <inline: #always> + ^self subclassResponsibility! Item was added: + ----- Method: ThreadedFFIPlugin>>ffiPushSigned8:in: (in category 'marshalling') ----- + ffiPushSigned8: value in: calloutState + <var: #calloutState type: #'CalloutState *'> + <inline: #always> + self subclassResponsibility! Item was removed: - ----- Method: ThreadedFFIPlugin>>ffiPushSignedByte:in: (in category 'marshalling') ----- - ffiPushSignedByte: value in: calloutState - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - self subclassResponsibility! Item was removed: - ----- Method: ThreadedFFIPlugin>>ffiPushSignedChar:in: (in category 'marshalling') ----- - ffiPushSignedChar: value in: calloutState - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - self subclassResponsibility! Item was removed: - ----- Method: ThreadedFFIPlugin>>ffiPushSignedInt:in: (in category 'marshalling') ----- - ffiPushSignedInt: value in: calloutState - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - self subclassResponsibility! Item was removed: - ----- Method: ThreadedFFIPlugin>>ffiPushSignedLongLong:in: (in category 'marshalling') ----- - ffiPushSignedLongLong: value in: calloutState - <var: #value type: #sqLong> - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - ^self subclassResponsibility! Item was removed: - ----- Method: ThreadedFFIPlugin>>ffiPushSignedLongLongOop:in: (in category 'marshalling') ----- - ffiPushSignedLongLongOop: oop in: calloutState - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - "Push a longlong type (e.g., a 64bit integer). - Note: Coercions from float are *not* supported." - | value | - <var: #value type: #sqLong> - (oop = interpreterProxy nilObject - or: [oop = interpreterProxy falseObject]) - ifTrue:[value := 0] ifFalse: - [oop = interpreterProxy trueObject - ifTrue:[value := 1] ifFalse: - [value := interpreterProxy signed64BitValueOf: oop. - interpreterProxy failed ifTrue: - [^FFIErrorCoercionFailed]]]. - ^self ffiPushSignedLongLong: value in: calloutState! Item was removed: - ----- Method: ThreadedFFIPlugin>>ffiPushSignedShort:in: (in category 'marshalling') ----- - ffiPushSignedShort: value in: calloutState - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - self subclassResponsibility! Item was removed: - ----- Method: ThreadedFFIPlugin>>ffiPushSingleFloat:in: (in category 'marshalling') ----- - ffiPushSingleFloat: value in: calloutState - <var: #value type: #float> - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - self subclassResponsibility! Item was added: + ----- Method: ThreadedFFIPlugin>>ffiPushUnsigned16:in: (in category 'marshalling') ----- + ffiPushUnsigned16: value in: calloutState + <var: #calloutState type: #'CalloutState *'> + <inline: #always> + self subclassResponsibility! Item was added: + ----- Method: ThreadedFFIPlugin>>ffiPushUnsigned32:in: (in category 'marshalling') ----- + ffiPushUnsigned32: value in: calloutState + <var: #calloutState type: #'CalloutState *'> + <inline: #always> + self subclassResponsibility! Item was added: + ----- Method: ThreadedFFIPlugin>>ffiPushUnsigned64:in: (in category 'marshalling') ----- + ffiPushUnsigned64: value in: calloutState + <var: #value type: #usqLong> + ^self subclassResponsibility! Item was added: + ----- Method: ThreadedFFIPlugin>>ffiPushUnsigned8:in: (in category 'marshalling') ----- + ffiPushUnsigned8: value in: calloutState + <var: #calloutState type: #'CalloutState *'> + <inline: #always> + self subclassResponsibility! Item was removed: - ----- Method: ThreadedFFIPlugin>>ffiPushUnsignedByte:in: (in category 'marshalling') ----- - ffiPushUnsignedByte: value in: calloutState - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - self subclassResponsibility! Item was removed: - ----- Method: ThreadedFFIPlugin>>ffiPushUnsignedChar:in: (in category 'marshalling') ----- - ffiPushUnsignedChar: value in: calloutState - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - self subclassResponsibility! Item was removed: - ----- Method: ThreadedFFIPlugin>>ffiPushUnsignedInt:in: (in category 'marshalling') ----- - ffiPushUnsignedInt: value in: calloutState - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - self subclassResponsibility! Item was removed: - ----- Method: ThreadedFFIPlugin>>ffiPushUnsignedLongLong:in: (in category 'marshalling') ----- - ffiPushUnsignedLongLong: value in: calloutState - <var: #value type: #usqLong> - ^self subclassResponsibility! Item was removed: - ----- Method: ThreadedFFIPlugin>>ffiPushUnsignedLongLongOop:in: (in category 'marshalling') ----- - ffiPushUnsignedLongLongOop: oop in: calloutState - <var: #calloutState type: #'CalloutState *'> - "Push an unsigned longlong type (e.g., a 64bit integer). - Note: Coercions from float are *not* supported." - <inline: #always> - | value | - <var: #value type: #usqLong> - (oop = interpreterProxy nilObject - or: [oop = interpreterProxy falseObject]) - ifTrue:[value := 0] ifFalse: - [oop = interpreterProxy trueObject - ifTrue:[value := 1] ifFalse: - [value := interpreterProxy positive64BitValueOf: oop. - interpreterProxy failed ifTrue: - [^FFIErrorCoercionFailed]]]. - ^self ffiPushUnsignedLongLong: value in: calloutState! Item was removed: - ----- Method: ThreadedFFIPlugin>>ffiPushUnsignedShort:in: (in category 'marshalling') ----- - ffiPushUnsignedShort: value in: calloutState - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - self subclassResponsibility! Item was changed: ----- Method: ThreadedFFIPlugin>>isAtomicType: (in category 'primitive support') ----- isAtomicType: typeSpec + <inline: #always> ^typeSpec anyMask: FFIFlagAtomic! Item was added: + ----- Method: ThreadedFFIPlugin>>isCharacterAtomicType: (in category 'primitive support') ----- + isCharacterAtomicType: atomicTypeCode + <inline: true> + ^atomicTypeCode >= FFITypeUnsignedChar8 + and: [(self isFloatAtomicType: atomicTypeCode) not]! Item was added: + ----- Method: ThreadedFFIPlugin>>isFloatAtomicType: (in category 'primitive support') ----- + isFloatAtomicType: atomicTypeCode + <inline: true> + ^atomicTypeCode >> 1 = 6! Item was removed: - ----- Method: ThreadedIA32FFIPlugin>>ffiPushDoubleFloat:in: (in category 'marshalling') ----- - ffiPushDoubleFloat: value in: calloutState - <var: #value type: #double> - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - calloutState currentArg + 8 > calloutState limit ifTrue: - [^FFIErrorCallFrameTooBig]. - interpreterProxy storeFloatAtPointer: calloutState currentArg from: value. - calloutState currentArg: calloutState currentArg + 8. - ^0! Item was added: + ----- Method: ThreadedIA32FFIPlugin>>ffiPushFloat32:in: (in category 'marshalling') ----- + ffiPushFloat32: value in: calloutState + <var: #value type: #float> + <var: #calloutState type: #'CalloutState *'> + <inline: #always> + calloutState currentArg + 4 > calloutState limit ifTrue: + [^FFIErrorCallFrameTooBig]. + interpreterProxy storeSingleFloatAtPointer: calloutState currentArg from: value. + calloutState currentArg: calloutState currentArg + 4. + ^0! Item was added: + ----- Method: ThreadedIA32FFIPlugin>>ffiPushFloat64:in: (in category 'marshalling') ----- + ffiPushFloat64: value in: calloutState + <var: #value type: #double> + <var: #calloutState type: #'CalloutState *'> + <inline: #always> + calloutState currentArg + 8 > calloutState limit ifTrue: + [^FFIErrorCallFrameTooBig]. + interpreterProxy storeFloatAtPointer: calloutState currentArg from: value. + calloutState currentArg: calloutState currentArg + 8. + ^0! Item was added: + ----- Method: ThreadedIA32FFIPlugin>>ffiPushSigned16:in: (in category 'marshalling') ----- + ffiPushSigned16: value in: calloutState + <var: #calloutState type: #'CalloutState *'> + <inline: #always> + calloutState currentArg + 4 > calloutState limit ifTrue: + [^FFIErrorCallFrameTooBig]. + interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'signed short'). + calloutState currentArg: calloutState currentArg + 4. + ^0! Item was added: + ----- Method: ThreadedIA32FFIPlugin>>ffiPushSigned32:in: (in category 'marshalling') ----- + ffiPushSigned32: value in: calloutState + <var: #calloutState type: #'CalloutState *'> + <inline: #always> + calloutState currentArg + 4 > calloutState limit ifTrue: + [^FFIErrorCallFrameTooBig]. + interpreterProxy longAt: calloutState currentArg put: value. + calloutState currentArg: calloutState currentArg + 4. + ^0! Item was added: + ----- Method: ThreadedIA32FFIPlugin>>ffiPushSigned64:in: (in category 'marshalling') ----- + ffiPushSigned64: value in: calloutState + <var: #value type: #usqLong> + <var: #calloutState type: #'CalloutState *'> + <inline: #always> + calloutState currentArg + 8 > calloutState limit ifTrue: + [^FFIErrorCallFrameTooBig]. + interpreterProxy + longAt: calloutState currentArg put: (self cCoerceSimple: value to: #usqInt); + longAt: calloutState currentArg + 4 put: (self cCoerceSimple: value >> 32 to: #usqInt). + calloutState currentArg: calloutState currentArg + 8. + ^0! Item was added: + ----- Method: ThreadedIA32FFIPlugin>>ffiPushSigned8:in: (in category 'marshalling') ----- + ffiPushSigned8: value in: calloutState + <var: #calloutState type: #'CalloutState *'> + <inline: #always> + calloutState currentArg + 4 > calloutState limit ifTrue: + [^FFIErrorCallFrameTooBig]. + interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'signed char'). + calloutState currentArg: calloutState currentArg + 4. + ^0! Item was removed: - ----- Method: ThreadedIA32FFIPlugin>>ffiPushSignedByte:in: (in category 'marshalling') ----- - ffiPushSignedByte: value in: calloutState - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - calloutState currentArg + 4 > calloutState limit ifTrue: - [^FFIErrorCallFrameTooBig]. - interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'signed char'). - calloutState currentArg: calloutState currentArg + 4. - ^0! Item was removed: - ----- Method: ThreadedIA32FFIPlugin>>ffiPushSignedChar:in: (in category 'marshalling') ----- - ffiPushSignedChar: value in: calloutState - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - calloutState currentArg + 4 > calloutState limit ifTrue: - [^FFIErrorCallFrameTooBig]. - interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'signed char'). - calloutState currentArg: calloutState currentArg + 4. - ^0! Item was removed: - ----- Method: ThreadedIA32FFIPlugin>>ffiPushSignedInt:in: (in category 'marshalling') ----- - ffiPushSignedInt: value in: calloutState - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - calloutState currentArg + 4 > calloutState limit ifTrue: - [^FFIErrorCallFrameTooBig]. - interpreterProxy longAt: calloutState currentArg put: value. - calloutState currentArg: calloutState currentArg + 4. - ^0! Item was removed: - ----- Method: ThreadedIA32FFIPlugin>>ffiPushSignedLongLong:in: (in category 'marshalling') ----- - ffiPushSignedLongLong: value in: calloutState - <var: #value type: #usqLong> - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - calloutState currentArg + 8 > calloutState limit ifTrue: - [^FFIErrorCallFrameTooBig]. - interpreterProxy - longAt: calloutState currentArg put: (self cCoerceSimple: value to: #usqInt); - longAt: calloutState currentArg + 4 put: (self cCoerceSimple: value >> 32 to: #usqInt). - calloutState currentArg: calloutState currentArg + 8. - ^0! Item was removed: - ----- Method: ThreadedIA32FFIPlugin>>ffiPushSignedShort:in: (in category 'marshalling') ----- - ffiPushSignedShort: value in: calloutState - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - calloutState currentArg + 4 > calloutState limit ifTrue: - [^FFIErrorCallFrameTooBig]. - interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'signed short'). - calloutState currentArg: calloutState currentArg + 4. - ^0! Item was removed: - ----- Method: ThreadedIA32FFIPlugin>>ffiPushSingleFloat:in: (in category 'marshalling') ----- - ffiPushSingleFloat: value in: calloutState - <var: #value type: #float> - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - calloutState currentArg + 4 > calloutState limit ifTrue: - [^FFIErrorCallFrameTooBig]. - interpreterProxy storeSingleFloatAtPointer: calloutState currentArg from: value. - calloutState currentArg: calloutState currentArg + 4. - ^0! Item was added: + ----- Method: ThreadedIA32FFIPlugin>>ffiPushUnsigned16:in: (in category 'marshalling') ----- + ffiPushUnsigned16: value in: calloutState + <var: #calloutState type: #'CalloutState *'> + <inline: #always> + calloutState currentArg + 4 > calloutState limit ifTrue: + [^FFIErrorCallFrameTooBig]. + interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'unsigned short'). + calloutState currentArg: calloutState currentArg + 4. + ^0! Item was added: + ----- Method: ThreadedIA32FFIPlugin>>ffiPushUnsigned32:in: (in category 'marshalling') ----- + ffiPushUnsigned32: value in: calloutState + <var: #calloutState type: #'CalloutState *'> + <inline: #always> + calloutState currentArg + 4 > calloutState limit ifTrue: + [^FFIErrorCallFrameTooBig]. + interpreterProxy longAt: calloutState currentArg put: value. + calloutState currentArg: calloutState currentArg + 4. + ^0! Item was added: + ----- Method: ThreadedIA32FFIPlugin>>ffiPushUnsigned64:in: (in category 'marshalling') ----- + ffiPushUnsigned64: value in: calloutState + <var: #value type: #usqLong> + <var: #calloutState type: #'CalloutState *'> + <inline: #always> + calloutState currentArg + 8 > calloutState limit ifTrue: + [^FFIErrorCallFrameTooBig]. + interpreterProxy + longAt: calloutState currentArg put: (self cCoerceSimple: value to: #usqInt); + longAt: calloutState currentArg + 4 put: (self cCoerceSimple: value >> 32 to: #usqInt). + calloutState currentArg: calloutState currentArg + 8. + ^0! Item was added: + ----- Method: ThreadedIA32FFIPlugin>>ffiPushUnsigned8:in: (in category 'marshalling') ----- + ffiPushUnsigned8: value in: calloutState + <var: #calloutState type: #'CalloutState *'> + <inline: #always> + calloutState currentArg + 4 > calloutState limit ifTrue: + [^FFIErrorCallFrameTooBig]. + interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'unsigned char'). + calloutState currentArg: calloutState currentArg + 4. + ^0! Item was removed: - ----- Method: ThreadedIA32FFIPlugin>>ffiPushUnsignedByte:in: (in category 'marshalling') ----- - ffiPushUnsignedByte: value in: calloutState - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - calloutState currentArg + 4 > calloutState limit ifTrue: - [^FFIErrorCallFrameTooBig]. - interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'unsigned char'). - calloutState currentArg: calloutState currentArg + 4. - ^0! Item was removed: - ----- Method: ThreadedIA32FFIPlugin>>ffiPushUnsignedChar:in: (in category 'marshalling') ----- - ffiPushUnsignedChar: value in: calloutState - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - calloutState currentArg + 4 > calloutState limit ifTrue: - [^FFIErrorCallFrameTooBig]. - interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'unsigned char'). - calloutState currentArg: calloutState currentArg + 4. - ^0! Item was removed: - ----- Method: ThreadedIA32FFIPlugin>>ffiPushUnsignedInt:in: (in category 'marshalling') ----- - ffiPushUnsignedInt: value in: calloutState - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - calloutState currentArg + 4 > calloutState limit ifTrue: - [^FFIErrorCallFrameTooBig]. - interpreterProxy longAt: calloutState currentArg put: value. - calloutState currentArg: calloutState currentArg + 4. - ^0! Item was removed: - ----- Method: ThreadedIA32FFIPlugin>>ffiPushUnsignedLongLong:in: (in category 'marshalling') ----- - ffiPushUnsignedLongLong: value in: calloutState - <var: #value type: #usqLong> - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - calloutState currentArg + 8 > calloutState limit ifTrue: - [^FFIErrorCallFrameTooBig]. - interpreterProxy - longAt: calloutState currentArg put: (self cCoerceSimple: value to: #usqInt); - longAt: calloutState currentArg + 4 put: (self cCoerceSimple: value >> 32 to: #usqInt). - calloutState currentArg: calloutState currentArg + 8. - ^0! Item was removed: - ----- Method: ThreadedIA32FFIPlugin>>ffiPushUnsignedShort:in: (in category 'marshalling') ----- - ffiPushUnsignedShort: value in: calloutState - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - calloutState currentArg + 4 > calloutState limit ifTrue: - [^FFIErrorCallFrameTooBig]. - interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'unsigned short'). - calloutState currentArg: calloutState currentArg + 4. - ^0! Item was removed: - ----- Method: ThreadedPPCBEFFIPlugin>>ffiPushDoubleFloat:in: (in category 'marshalling') ----- - ffiPushDoubleFloat: value in: calloutState - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - self shouldBeImplemented. - ^0! Item was added: + ----- Method: ThreadedPPCBEFFIPlugin>>ffiPushFloat32:in: (in category 'marshalling') ----- + ffiPushFloat32: value in: calloutState + <var: #calloutState type: #'CalloutState *'> + <inline: #always> + self shouldBeImplemented. + ^0! Item was added: + ----- Method: ThreadedPPCBEFFIPlugin>>ffiPushFloat64:in: (in category 'marshalling') ----- + ffiPushFloat64: value in: calloutState + <var: #calloutState type: #'CalloutState *'> + <inline: #always> + self shouldBeImplemented. + ^0! Item was added: + ----- Method: ThreadedPPCBEFFIPlugin>>ffiPushSigned16:in: (in category 'marshalling') ----- + ffiPushSigned16: value in: calloutState + <var: #calloutState type: #'CalloutState *'> + <inline: #always> + self shouldBeImplemented. + ^0! Item was added: + ----- Method: ThreadedPPCBEFFIPlugin>>ffiPushSigned32:in: (in category 'marshalling') ----- + ffiPushSigned32: value in: calloutState + <var: #calloutState type: #'CalloutState *'> + <inline: #always> + self shouldBeImplemented. + ^0! Item was added: + ----- Method: ThreadedPPCBEFFIPlugin>>ffiPushSigned64:in: (in category 'marshalling') ----- + ffiPushSigned64: value in: calloutState + <var: #value type: #sqLong> + <var: #calloutState type: #'CalloutState *'> + <inline: #always> + self shouldBeImplemented. + ^0! Item was added: + ----- Method: ThreadedPPCBEFFIPlugin>>ffiPushSigned8:in: (in category 'marshalling') ----- + ffiPushSigned8: value in: calloutState + <var: #calloutState type: #'CalloutState *'> + <inline: #always> + self shouldBeImplemented. + ^0! Item was removed: - ----- Method: ThreadedPPCBEFFIPlugin>>ffiPushSignedByte:in: (in category 'marshalling') ----- - ffiPushSignedByte: value in: calloutState - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - self shouldBeImplemented. - ^0! Item was removed: - ----- Method: ThreadedPPCBEFFIPlugin>>ffiPushSignedChar:in: (in category 'marshalling') ----- - ffiPushSignedChar: value in: calloutState - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - self shouldBeImplemented. - ^0! Item was removed: - ----- Method: ThreadedPPCBEFFIPlugin>>ffiPushSignedInt:in: (in category 'marshalling') ----- - ffiPushSignedInt: value in: calloutState - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - self shouldBeImplemented. - ^0! Item was removed: - ----- Method: ThreadedPPCBEFFIPlugin>>ffiPushSignedLongLong:in: (in category 'marshalling') ----- - ffiPushSignedLongLong: value in: calloutState - <var: #value type: #sqLong> - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - self shouldBeImplemented. - ^0! Item was removed: - ----- Method: ThreadedPPCBEFFIPlugin>>ffiPushSignedShort:in: (in category 'marshalling') ----- - ffiPushSignedShort: value in: calloutState - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - self shouldBeImplemented. - ^0! Item was removed: - ----- Method: ThreadedPPCBEFFIPlugin>>ffiPushSingleFloat:in: (in category 'marshalling') ----- - ffiPushSingleFloat: value in: calloutState - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - self shouldBeImplemented. - ^0! Item was added: + ----- Method: ThreadedPPCBEFFIPlugin>>ffiPushUnsigned16:in: (in category 'marshalling') ----- + ffiPushUnsigned16: value in: calloutState + <var: #calloutState type: #'CalloutState *'> + <inline: #always> + self shouldBeImplemented. + ^0! Item was added: + ----- Method: ThreadedPPCBEFFIPlugin>>ffiPushUnsigned32:in: (in category 'marshalling') ----- + ffiPushUnsigned32: value in: calloutState + <var: #calloutState type: #'CalloutState *'> + <inline: #always> + self shouldBeImplemented. + ^0! Item was added: + ----- Method: ThreadedPPCBEFFIPlugin>>ffiPushUnsigned64:in: (in category 'marshalling') ----- + ffiPushUnsigned64: value in: calloutState + <var: #value type: #usqLong> + <var: #calloutState type: #'CalloutState *'> + <inline: #always> + self shouldBeImplemented. + ^0! Item was added: + ----- Method: ThreadedPPCBEFFIPlugin>>ffiPushUnsigned8:in: (in category 'marshalling') ----- + ffiPushUnsigned8: value in: calloutState + <var: #calloutState type: #'CalloutState *'> + <inline: #always> + self shouldBeImplemented. + ^0! Item was removed: - ----- Method: ThreadedPPCBEFFIPlugin>>ffiPushUnsignedByte:in: (in category 'marshalling') ----- - ffiPushUnsignedByte: value in: calloutState - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - self shouldBeImplemented. - ^0! Item was removed: - ----- Method: ThreadedPPCBEFFIPlugin>>ffiPushUnsignedChar:in: (in category 'marshalling') ----- - ffiPushUnsignedChar: value in: calloutState - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - self shouldBeImplemented. - ^0! Item was removed: - ----- Method: ThreadedPPCBEFFIPlugin>>ffiPushUnsignedInt:in: (in category 'marshalling') ----- - ffiPushUnsignedInt: value in: calloutState - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - self shouldBeImplemented. - ^0! Item was removed: - ----- Method: ThreadedPPCBEFFIPlugin>>ffiPushUnsignedLongLong:in: (in category 'marshalling') ----- - ffiPushUnsignedLongLong: value in: calloutState - <var: #value type: #usqLong> - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - self shouldBeImplemented. - ^0! Item was removed: - ----- Method: ThreadedPPCBEFFIPlugin>>ffiPushUnsignedShort:in: (in category 'marshalling') ----- - ffiPushUnsignedShort: value in: calloutState - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - self shouldBeImplemented. - ^0! Item was removed: - ----- Method: ThreadedX64FFIPlugin>>ffiPushDoubleFloat:in: (in category 'marshalling') ----- - ffiPushDoubleFloat: value in: calloutState - <var: #value type: #double> - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - - calloutState floatRegisterIndex < NumFloatRegArgs - ifTrue: - [calloutState floatRegisters at: calloutState floatRegisterIndex put: value. - calloutState incrementFloatRegisterIndex] - ifFalse: - [calloutState currentArg + WordSize > calloutState limit ifTrue: - [^FFIErrorCallFrameTooBig]. - interpreterProxy storeFloatAtPointer: calloutState currentArg from: value. - calloutState currentArg: calloutState currentArg + WordSize]. - ^0! Item was added: + ----- Method: ThreadedX64FFIPlugin>>ffiPushFloat32:in: (in category 'marshalling') ----- + ffiPushFloat32: value in: calloutState + <var: #value type: #float> + <var: #calloutState type: #'CalloutState *'> + <inline: #always> + + calloutState floatRegisterIndex < NumFloatRegArgs + ifTrue: + [(self cCoerce: calloutState floatRegisters + calloutState floatRegisterIndex to: #'float *') at: 0 put: value. + calloutState incrementFloatRegisterIndex] + ifFalse: + [calloutState currentArg + WordSize > calloutState limit ifTrue: + [^FFIErrorCallFrameTooBig]. + "Float passed in least significant word, but good to zero the high bits for clarity." + interpreterProxy + long64AtPointer: calloutState currentArg put: 0; + storeSingleFloatAtPointer: calloutState currentArg from: value. + calloutState currentArg: calloutState currentArg + WordSize]. + ^0! Item was added: + ----- Method: ThreadedX64FFIPlugin>>ffiPushFloat64:in: (in category 'marshalling') ----- + ffiPushFloat64: value in: calloutState + <var: #value type: #double> + <var: #calloutState type: #'CalloutState *'> + <inline: #always> + + calloutState floatRegisterIndex < NumFloatRegArgs + ifTrue: + [calloutState floatRegisters at: calloutState floatRegisterIndex put: value. + calloutState incrementFloatRegisterIndex] + ifFalse: + [calloutState currentArg + WordSize > calloutState limit ifTrue: + [^FFIErrorCallFrameTooBig]. + interpreterProxy storeFloatAtPointer: calloutState currentArg from: value. + calloutState currentArg: calloutState currentArg + WordSize]. + ^0! Item was added: + ----- Method: ThreadedX64FFIPlugin>>ffiPushSigned16:in: (in category 'marshalling') ----- + ffiPushSigned16: value in: calloutState + <var: #calloutState type: #'CalloutState *'> + <inline: #always> + calloutState integerRegisterIndex < NumIntRegArgs + ifTrue: + [calloutState integerRegisters at: calloutState integerRegisterIndex put: (self cCoerceSimple: value to: #'signed short'). + calloutState incrementIntegerRegisterIndex] + ifFalse: + [calloutState currentArg + WordSize > calloutState limit ifTrue: + [^FFIErrorCallFrameTooBig]. + interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'signed short'). + calloutState currentArg: calloutState currentArg + WordSize]. + ^0! Item was added: + ----- Method: ThreadedX64FFIPlugin>>ffiPushSigned32:in: (in category 'marshalling') ----- + ffiPushSigned32: value in: calloutState + <var: #calloutState type: #'CalloutState *'> + <inline: #always> + calloutState integerRegisterIndex < NumIntRegArgs + ifTrue: + [calloutState integerRegisters at: calloutState integerRegisterIndex put: value. + calloutState incrementIntegerRegisterIndex] + ifFalse: + [calloutState currentArg + WordSize > calloutState limit ifTrue: + [^FFIErrorCallFrameTooBig]. + interpreterProxy longAt: calloutState currentArg put: value. + calloutState currentArg: calloutState currentArg + WordSize]. + ^0! Item was added: + ----- Method: ThreadedX64FFIPlugin>>ffiPushSigned64:in: (in category 'marshalling') ----- + ffiPushSigned64: value in: calloutState + <var: #value type: #sqLong> + <var: #calloutState type: #'CalloutState *'> + <inline: #always> + calloutState integerRegisterIndex < NumIntRegArgs + ifTrue: + [calloutState integerRegisters at: calloutState integerRegisterIndex put: (self cCoerceSimple: value to: #usqInt). + calloutState incrementIntegerRegisterIndex] + ifFalse: + [calloutState currentArg + WordSize > calloutState limit ifTrue: [^FFIErrorCallFrameTooBig]. + interpreterProxy longAt: calloutState currentArg put: value. + calloutState currentArg: calloutState currentArg + WordSize]. + ^0! Item was added: + ----- Method: ThreadedX64FFIPlugin>>ffiPushSigned8:in: (in category 'marshalling') ----- + ffiPushSigned8: value in: calloutState + <var: #calloutState type: #'CalloutState *'> + <inline: #always> + calloutState integerRegisterIndex < NumIntRegArgs + ifTrue: + [calloutState integerRegisters at: calloutState integerRegisterIndex put: (self cCoerceSimple: value to: #'signed char'). + calloutState incrementIntegerRegisterIndex] + ifFalse: + [calloutState currentArg + WordSize > calloutState limit ifTrue: + [^FFIErrorCallFrameTooBig]. + interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'signed char'). + calloutState currentArg: calloutState currentArg + WordSize]. + ^0! Item was removed: - ----- Method: ThreadedX64FFIPlugin>>ffiPushSignedByte:in: (in category 'marshalling') ----- - ffiPushSignedByte: value in: calloutState - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - calloutState integerRegisterIndex < NumIntRegArgs - ifTrue: - [calloutState integerRegisters at: calloutState integerRegisterIndex put: (self cCoerceSimple: value to: #'signed char'). - calloutState incrementIntegerRegisterIndex] - ifFalse: - [calloutState currentArg + WordSize > calloutState limit ifTrue: - [^FFIErrorCallFrameTooBig]. - interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'signed char'). - calloutState currentArg: calloutState currentArg + WordSize]. - ^0! Item was removed: - ----- Method: ThreadedX64FFIPlugin>>ffiPushSignedChar:in: (in category 'marshalling') ----- - ffiPushSignedChar: value in: calloutState - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - calloutState integerRegisterIndex < NumIntRegArgs - ifTrue: - [calloutState integerRegisters at: calloutState integerRegisterIndex put: (self cCoerceSimple: value to: #'signed char'). - calloutState incrementIntegerRegisterIndex] - ifFalse: - [calloutState currentArg + WordSize > calloutState limit ifTrue: - [^FFIErrorCallFrameTooBig]. - interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'signed char'). - calloutState currentArg: calloutState currentArg + WordSize]. - ^0! Item was removed: - ----- Method: ThreadedX64FFIPlugin>>ffiPushSignedInt:in: (in category 'marshalling') ----- - ffiPushSignedInt: value in: calloutState - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - calloutState integerRegisterIndex < NumIntRegArgs - ifTrue: - [calloutState integerRegisters at: calloutState integerRegisterIndex put: value. - calloutState incrementIntegerRegisterIndex] - ifFalse: - [calloutState currentArg + WordSize > calloutState limit ifTrue: - [^FFIErrorCallFrameTooBig]. - interpreterProxy longAt: calloutState currentArg put: value. - calloutState currentArg: calloutState currentArg + WordSize]. - ^0! Item was removed: - ----- Method: ThreadedX64FFIPlugin>>ffiPushSignedLongLong:in: (in category 'marshalling') ----- - ffiPushSignedLongLong: value in: calloutState - <var: #value type: #sqLong> - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - calloutState integerRegisterIndex < NumIntRegArgs - ifTrue: - [calloutState integerRegisters at: calloutState integerRegisterIndex put: (self cCoerceSimple: value to: #usqInt). - calloutState incrementIntegerRegisterIndex] - ifFalse: - [calloutState currentArg + WordSize > calloutState limit ifTrue: [^FFIErrorCallFrameTooBig]. - interpreterProxy longAt: calloutState currentArg put: value. - calloutState currentArg: calloutState currentArg + WordSize]. - ^0! Item was removed: - ----- Method: ThreadedX64FFIPlugin>>ffiPushSignedShort:in: (in category 'marshalling') ----- - ffiPushSignedShort: value in: calloutState - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - calloutState integerRegisterIndex < NumIntRegArgs - ifTrue: - [calloutState integerRegisters at: calloutState integerRegisterIndex put: (self cCoerceSimple: value to: #'signed short'). - calloutState incrementIntegerRegisterIndex] - ifFalse: - [calloutState currentArg + WordSize > calloutState limit ifTrue: - [^FFIErrorCallFrameTooBig]. - interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'signed short'). - calloutState currentArg: calloutState currentArg + WordSize]. - ^0! Item was removed: - ----- Method: ThreadedX64FFIPlugin>>ffiPushSingleFloat:in: (in category 'marshalling') ----- - ffiPushSingleFloat: value in: calloutState - <var: #value type: #float> - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - - calloutState floatRegisterIndex < NumFloatRegArgs - ifTrue: - [(self cCoerce: calloutState floatRegisters + calloutState floatRegisterIndex to: #'float *') at: 0 put: value. - calloutState incrementFloatRegisterIndex] - ifFalse: - [calloutState currentArg + WordSize > calloutState limit ifTrue: - [^FFIErrorCallFrameTooBig]. - "Float passed in least significant word, but good to zero the high bits for clarity." - interpreterProxy - long64AtPointer: calloutState currentArg put: 0; - storeSingleFloatAtPointer: calloutState currentArg from: value. - calloutState currentArg: calloutState currentArg + WordSize]. - ^0! Item was added: + ----- Method: ThreadedX64FFIPlugin>>ffiPushUnsigned16:in: (in category 'marshalling') ----- + ffiPushUnsigned16: value in: calloutState + <var: #calloutState type: #'CalloutState *'> + <inline: #always> + calloutState integerRegisterIndex < NumIntRegArgs + ifTrue: + [calloutState integerRegisters at: calloutState integerRegisterIndex put: (self cCoerceSimple: value to: #'unsigned short'). + calloutState incrementIntegerRegisterIndex] + ifFalse: + [calloutState currentArg + WordSize > calloutState limit ifTrue: + [^FFIErrorCallFrameTooBig]. + interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'unsigned short'). + calloutState currentArg: calloutState currentArg + WordSize]. + ^0! Item was added: + ----- Method: ThreadedX64FFIPlugin>>ffiPushUnsigned32:in: (in category 'marshalling') ----- + ffiPushUnsigned32: value in: calloutState + <var: #calloutState type: #'CalloutState *'> + <inline: #always> + calloutState integerRegisterIndex < NumIntRegArgs + ifTrue: + [calloutState integerRegisters at: calloutState integerRegisterIndex put: value. + calloutState incrementIntegerRegisterIndex] + ifFalse: + [calloutState currentArg + WordSize > calloutState limit ifTrue: + [^FFIErrorCallFrameTooBig]. + interpreterProxy longAt: calloutState currentArg put: value. + calloutState currentArg: calloutState currentArg + WordSize]. + ^0! Item was added: + ----- Method: ThreadedX64FFIPlugin>>ffiPushUnsigned64:in: (in category 'marshalling') ----- + ffiPushUnsigned64: value in: calloutState + <var: #value type: #usqLong> + <var: #calloutState type: #'CalloutState *'> + <inline: #always> + calloutState integerRegisterIndex < NumIntRegArgs + ifTrue: + [calloutState integerRegisters at: calloutState integerRegisterIndex put: value. + calloutState incrementIntegerRegisterIndex] + ifFalse: + [calloutState currentArg + WordSize > calloutState limit ifTrue: [^FFIErrorCallFrameTooBig]. + interpreterProxy longAt: calloutState currentArg put: value. + calloutState currentArg: calloutState currentArg + WordSize]. + ^0! Item was added: + ----- Method: ThreadedX64FFIPlugin>>ffiPushUnsigned8:in: (in category 'marshalling') ----- + ffiPushUnsigned8: value in: calloutState + <var: #calloutState type: #'CalloutState *'> + <inline: #always> + calloutState integerRegisterIndex < NumIntRegArgs + ifTrue: + [calloutState integerRegisters at: calloutState integerRegisterIndex put: (self cCoerceSimple: value to: #'unsigned char'). + calloutState incrementIntegerRegisterIndex] + ifFalse: + [calloutState currentArg + WordSize > calloutState limit ifTrue: + [^FFIErrorCallFrameTooBig]. + interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'unsigned char'). + calloutState currentArg: calloutState currentArg + WordSize]. + ^0! Item was removed: - ----- Method: ThreadedX64FFIPlugin>>ffiPushUnsignedByte:in: (in category 'marshalling') ----- - ffiPushUnsignedByte: value in: calloutState - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - calloutState integerRegisterIndex < NumIntRegArgs - ifTrue: - [calloutState integerRegisters at: calloutState integerRegisterIndex put: (self cCoerceSimple: value to: #'unsigned char'). - calloutState incrementIntegerRegisterIndex] - ifFalse: - [calloutState currentArg + WordSize > calloutState limit ifTrue: - [^FFIErrorCallFrameTooBig]. - interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'unsigned char'). - calloutState currentArg: calloutState currentArg + WordSize]. - ^0! Item was removed: - ----- Method: ThreadedX64FFIPlugin>>ffiPushUnsignedChar:in: (in category 'marshalling') ----- - ffiPushUnsignedChar: value in: calloutState - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - calloutState integerRegisterIndex < NumIntRegArgs - ifTrue: - [calloutState integerRegisters at: calloutState integerRegisterIndex put: (self cCoerceSimple: value to: #'unsigned char'). - calloutState incrementIntegerRegisterIndex] - ifFalse: - [calloutState currentArg + WordSize > calloutState limit ifTrue: - [^FFIErrorCallFrameTooBig]. - interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'unsigned char'). - calloutState currentArg: calloutState currentArg + WordSize]. - ^0! Item was removed: - ----- Method: ThreadedX64FFIPlugin>>ffiPushUnsignedInt:in: (in category 'marshalling') ----- - ffiPushUnsignedInt: value in: calloutState - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - calloutState integerRegisterIndex < NumIntRegArgs - ifTrue: - [calloutState integerRegisters at: calloutState integerRegisterIndex put: value. - calloutState incrementIntegerRegisterIndex] - ifFalse: - [calloutState currentArg + WordSize > calloutState limit ifTrue: - [^FFIErrorCallFrameTooBig]. - interpreterProxy longAt: calloutState currentArg put: value. - calloutState currentArg: calloutState currentArg + WordSize]. - ^0! Item was removed: - ----- Method: ThreadedX64FFIPlugin>>ffiPushUnsignedLongLong:in: (in category 'marshalling') ----- - ffiPushUnsignedLongLong: value in: calloutState - <var: #value type: #usqLong> - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - calloutState integerRegisterIndex < NumIntRegArgs - ifTrue: - [calloutState integerRegisters at: calloutState integerRegisterIndex put: value. - calloutState incrementIntegerRegisterIndex] - ifFalse: - [calloutState currentArg + WordSize > calloutState limit ifTrue: [^FFIErrorCallFrameTooBig]. - interpreterProxy longAt: calloutState currentArg put: value. - calloutState currentArg: calloutState currentArg + WordSize]. - ^0! Item was removed: - ----- Method: ThreadedX64FFIPlugin>>ffiPushUnsignedShort:in: (in category 'marshalling') ----- - ffiPushUnsignedShort: value in: calloutState - <var: #calloutState type: #'CalloutState *'> - <inline: #always> - calloutState integerRegisterIndex < NumIntRegArgs - ifTrue: - [calloutState integerRegisters at: calloutState integerRegisterIndex put: (self cCoerceSimple: value to: #'unsigned short'). - calloutState incrementIntegerRegisterIndex] - ifFalse: - [calloutState currentArg + WordSize > calloutState limit ifTrue: - [^FFIErrorCallFrameTooBig]. - interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'unsigned short'). - calloutState currentArg: calloutState currentArg + WordSize]. - ^0! Item was changed: ----- Method: ThreadedX64SysVFFIPlugin>>ffiPushStructure:ofSize:typeSpec:ofLength:in: (in category 'marshalling') ----- ffiPushStructure: pointer ofSize: structSize typeSpec: argSpec ofLength: argSpecSize in: calloutState <var: #pointer type: #'void *'> <var: #argSpec type: #'sqInt *'> <var: #calloutState type: #'CalloutState *'> <inline: #always> | roundedSize registerType numDoubleRegisters numIntegerRegisters passField0InXmmReg passField1InXmmReg | structSize <= 16 ifTrue: ["See sec 3.2.3 of http://people.freebsd.org/~obrien/amd64-elf-abi.pdf. (dravft version 0.90). All of the folowing are passed in registers: typedef struct { long a; } s0; typedef struct { double a; } s1; typedef struct { long a; double b; } s2; typedef struct { int a; int b; double c; } s2a; typedef struct { short a; short b; short c; short d; double e; } s2b; typedef struct { long a; float b; } s2f; typedef struct { long a; float b; float c; } s2g; typedef struct { int a; float b; int c; float d; } s2h;" registerType := self registerTypeForStructSpecs: (self cCoerce: argSpec to: #'unsigned int *') OfLength: argSpecSize. registerType = 2r110 "check case of invalid alignment => pass by memory" ifFalse: [passField0InXmmReg := (registerType bitAnd: 1) = 0. structSize <= 8 ifTrue: [numIntegerRegisters := registerType bitAnd: 1. numDoubleRegisters := 1 - numIntegerRegisters] ifFalse: [passField1InXmmReg := (registerType bitAnd: 2) = 0. numIntegerRegisters := (registerType bitAnd: 2) >> 1 + (registerType bitAnd: 1). numDoubleRegisters := 2 - numIntegerRegisters]. (calloutState floatRegisterIndex + numDoubleRegisters <= NumFloatRegArgs and: [calloutState integerRegisterIndex + numIntegerRegisters <= NumIntRegArgs]) ifTrue: [passField0InXmmReg + ifTrue: [self ffiPushFloat64: ((self cCoerceSimple: pointer to: #'double *') at: 0) in: calloutState] + ifFalse: [self ffiPushSigned64: ((self cCoerceSimple: pointer to: #'long long *') at: 0) in: calloutState]. - ifTrue: [self ffiPushDoubleFloat: ((self cCoerceSimple: pointer to: #'double *') at: 0) in: calloutState] - ifFalse: [self ffiPushSignedLongLong: ((self cCoerceSimple: pointer to: #'long long *') at: 0) in: calloutState]. structSize > 8 ifTrue: [passField1InXmmReg + ifTrue: [self ffiPushFloat64: ((self cCoerceSimple: pointer to: #'double *') at: 1) in: calloutState] + ifFalse: [self ffiPushSigned64: ((self cCoerceSimple: pointer to: #'long long *') at: 1) in: calloutState]]. - ifTrue: [self ffiPushDoubleFloat: ((self cCoerceSimple: pointer to: #'double *') at: 1) in: calloutState] - ifFalse: [self ffiPushSignedLongLong: ((self cCoerceSimple: pointer to: #'long long *') at: 1) in: calloutState]]. ^0]]]. roundedSize := structSize + 7 bitClear: 7. calloutState currentArg + roundedSize > calloutState limit ifTrue: [^FFIErrorCallFrameTooBig]. self memcpy: calloutState currentArg _: (self cCoerceSimple: pointer to: 'char *') _: structSize. calloutState currentArg: calloutState currentArg + roundedSize. ^0! Item was changed: ----- Method: ThreadedX64Win64FFIPlugin>>ffiPushStructure:ofSize:typeSpec:ofLength:in: (in category 'marshalling') ----- ffiPushStructure: pointer ofSize: structSize typeSpec: argSpec ofLength: argSpecSize in: calloutState <var: #pointer type: #'void *'> <var: #argSpec type: #'sqInt *'> <var: #calloutState type: #'CalloutState *'> <var: #arg type: #usqLong> <inline: #always> structSize <= 0 ifTrue: [^FFIErrorStructSize]. "See https://docs.microsoft.com/en-us/cpp/build/x64-calling-convention?view=vs-2…" (structSize <= WordSize and: [(structSize bitAnd: structSize - 1) = 0 "a.k.a. structSize isPowerOfTwo"]) ifTrue: [| arg | self memcpy: (self addressOf: arg) _: pointer _: structSize. + ^self ffiPushUnsigned64: arg in: calloutState]. - ^self ffiPushUnsignedLongLong: arg in: calloutState]. "BUG!!!! This memory should be 16-byte aligned; Spur guarantees only 8-byte alignment." self flag: #bug. ^self ffiPushPointer: pointer in: calloutState!

1 0

[OpenSmalltalk/opensmalltalk-vm] cf11c7: Changes option "scriptname" to "with-scriptname" t...
by Marcel Taeumel 16 Sep '21

16 Sep '21

Branch: refs/heads/dtl/distinct-scriptnames Home: https://github.com/OpenSmalltalk/opensmalltalk-vm Commit: cf11c7e64d98f45fe869cdc59626cd2b50479642 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/cf11c7e64d98f45fe8… Author: Marcel Taeumel <marcel.taeumel(a)hpi.de> Date: 2021-09-16 (Thu, 16 Sep 2021) Changed paths: M building/linux32ARMv6/squeak.cog.spur/build.assert/mvm M building/linux32ARMv6/squeak.cog.spur/build.debug/mvm M building/linux32ARMv6/squeak.cog.spur/build/mvm M building/linux32ARMv6/squeak.cog.v3/build.assert/mvm M building/linux32ARMv6/squeak.cog.v3/build.debug/mvm M building/linux32ARMv6/squeak.cog.v3/build/mvm M building/linux32ARMv6/squeak.stack.spur/build.assert/mvm M building/linux32ARMv6/squeak.stack.spur/build.debug/mvm M building/linux32ARMv6/squeak.stack.spur/build/mvm M building/linux32ARMv6/squeak.stack.v3/build.assert/mvm M building/linux32ARMv6/squeak.stack.v3/build.debug/mvm M building/linux32ARMv6/squeak.stack.v3/build/mvm M building/linux32x86/squeak.cog.spur/build.assert.itimerheartbeat/mvm M building/linux32x86/squeak.cog.spur/build.assert/mvm M building/linux32x86/squeak.cog.spur/build.debug.itimerheartbeat/mvm M building/linux32x86/squeak.cog.spur/build.debug/mvm M building/linux32x86/squeak.cog.spur/build.itimerheartbeat/mvm M building/linux32x86/squeak.cog.spur/build/mvm M building/linux32x86/squeak.cog.v3/build.assert.itimerheartbeat/mvm M building/linux32x86/squeak.cog.v3/build.assert/mvm M building/linux32x86/squeak.cog.v3/build.debug.itimerheartbeat/mvm M building/linux32x86/squeak.cog.v3/build.debug/mvm M building/linux32x86/squeak.cog.v3/build.itimerheartbeat/mvm M building/linux32x86/squeak.cog.v3/build.multithreaded.assert/mvm M building/linux32x86/squeak.cog.v3/build.multithreaded.debug/mvm M building/linux32x86/squeak.cog.v3/build.multithreaded/mvm M building/linux32x86/squeak.cog.v3/build/mvm M building/linux32x86/squeak.sista.spur/build.assert.itimerheartbeat/mvm M building/linux32x86/squeak.sista.spur/build.assert/mvm M building/linux32x86/squeak.sista.spur/build.debug.itimerheartbeat/mvm M building/linux32x86/squeak.sista.spur/build.debug/mvm M building/linux32x86/squeak.sista.spur/build.itimerheartbeat/mvm M building/linux32x86/squeak.sista.spur/build/mvm M building/linux32x86/squeak.stack.spur/build.assert/mvm M building/linux32x86/squeak.stack.spur/build.debug/mvm M building/linux32x86/squeak.stack.spur/build/mvm M building/linux32x86/squeak.stack.v3/build.assert/mvm M building/linux32x86/squeak.stack.v3/build.debug/mvm M building/linux32x86/squeak.stack.v3/build/mvm M building/linux64ARMv8/squeak.cog.spur/build.assert/mvm M building/linux64ARMv8/squeak.cog.spur/build.debug/mvm M building/linux64ARMv8/squeak.cog.spur/build/mvm M building/linux64ARMv8/squeak.cogmt.spur/build.assert/mvm M building/linux64ARMv8/squeak.cogmt.spur/build.debug/mvm M building/linux64ARMv8/squeak.cogmt.spur/build/mvm M building/linux64ARMv8/squeak.stack.spur/build.assert/mvm M building/linux64ARMv8/squeak.stack.spur/build.debug/mvm M building/linux64ARMv8/squeak.stack.spur/build/mvm M building/linux64x64/squeak.cog.spur/build.assert.itimerheartbeat/mvm M building/linux64x64/squeak.cog.spur/build.assert/mvm M building/linux64x64/squeak.cog.spur/build.debug.itimerheartbeat/mvm M building/linux64x64/squeak.cog.spur/build.debug/mvm M building/linux64x64/squeak.cog.spur/build.itimerheartbeat/mvm M building/linux64x64/squeak.cog.spur/build/mvm M building/linux64x64/squeak.stack.spur/build.assert/mvm M building/linux64x64/squeak.stack.spur/build.debug/mvm M building/linux64x64/squeak.stack.spur/build/mvm M building/sunos32x86/squeak.cog.spur/build/mvm M building/sunos32x86/squeak.stack.spur/build/mvm M building/sunos64x64/squeak.cog.spur/build/mvm M building/sunos64x64/squeak.stack.spur/build/mvm M platforms/unix/config/configure M platforms/unix/config/configure.ac Log Message: ----------- Changes option "scriptname" to "with-scriptname" to make it compatible with "make configure". Adapts "configure.ac" and all mvm files accordingly.

1 0

← Newer
1
...
5
6
7
8
9
10
11
...
14
Older →

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Vm-dev September 2021