Posted by
commits-2 on
May 19, 2021; 8:34am
URL: https://forum.world.st/FFI-FFI-Kernel-mt-160-mcz-tp5129847.html
Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI:
http://source.squeak.org/FFI/FFI-Kernel-mt.160.mcz==================== Summary ====================
Name: FFI-Kernel-mt.160
Author: mt
Time: 19 May 2021, 10:34:07.057615 am
UUID: 5179b160-697d-7b46-9e83-dbccf3a05953
Ancestors: FFI-Kernel-mt.159
Clean-up the extension protocol on ByteArray and ExternalAddress:
- Explicit read/write methods for integers are no longer used but replaced through FFIAtomicReadWriteSend, which also speeds up dynamic reads (i.e. through ExternalData) about 3x
- Protocol retained as "*FFI-Kernel-examples" in ByteArray and ExternalAddress
- Generated field accessors in ExternalStructure now use the primitives #integerAt:(put:)size:length: directly, which also speeds up such static reads a little bit.
- ByteArrayReadWriter benefits from this change by a simpler implementation without a tricky DNU
- Extra mappings over integer types - i.e. bool, char, schar - are now encapsulated in CharacterReadWriteSend and BooleanReadWriteSend.
Other minor changes:
- Unknown types now show their soon-to-be-known type name
- External types can be asked for #isBoolType just like #isIntegerType and #isFloatTpye and #isCharType
- In ExternalType, AtomicSelectors got replaced with AtomicSends
The postscript should re-build all types and re-define all field accessors. If not do-it:
ExternalType resetAllTypes.
ExternalStructure defineAllFields.
=============== Diff against FFI-Kernel-mt.159 ===============
Item was added:
+ IntegerReadWriteSend subclass: #BooleanReadWriteSend
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'FFI-Kernel-Support'!
+
+ !BooleanReadWriteSend commentStamp: 'mt 5/19/2021 10:17' prior: 0!
+ I am a specialization for the atomic 'bool' type, which maps to 'byte' but adds extra pre- and post-processing to read and write instances of Boolean, i.e. true and false.!
Item was added:
+ ----- Method: BooleanReadWriteSend class>>fromType: (in category 'instance creation') -----
+ fromType: type
+
+ ^ super fromType: ExternalType byte!
Item was added:
+ ----- Method: BooleanReadWriteSend>>handle:at: (in category 'evaluating') -----
+ handle: handle at: byteOffset
+
+ ^ (super handle: handle at: byteOffset) ~= 0!
Item was added:
+ ----- Method: BooleanReadWriteSend>>handle:at:put: (in category 'evaluating') -----
+ handle: handle at: byteOffset put: aBoolean
+
+ super
+ handle: handle
+ at: byteOffset
+ put: (aBoolean ifTrue: [1] ifFalse: [0]).
+ ^ aBoolean!
Item was added:
+ ----- Method: BooleanReadWriteSend>>template (in category 'compiling') -----
+ template
+
+ ^ self isReading
+ ifTrue: ['(', super template, ') ~= 0']
+ ifFalse: [super template copyReplaceAll: '{3}' with: '({3} ifTrue: [1] ifFalse: [0])']!
Item was changed:
+ ----- Method: ByteArray>>booleanAt: (in category '*FFI-Kernel-examples') -----
- ----- Method: ByteArray>>booleanAt: (in category '*FFI-Kernel') -----
booleanAt: byteOffset
+ "For documentation and convenient exploration only. Type-safe access to byte arrays or external addresses SHOULD happen via external objects that have a type set such as instances of ExternalStructure and ExternalData."
+
+ ^ ExternalType bool handle: self at: byteOffset!
- "Booleans are just integers in C word"
- ^(self integerAt: byteOffset size: 1 signed: false) ~= 0!
Item was changed:
+ ----- Method: ByteArray>>booleanAt:put: (in category '*FFI-Kernel-examples') -----
- ----- Method: ByteArray>>booleanAt:put: (in category '*FFI-Kernel') -----
booleanAt: byteOffset put: value
+ "For documentation and convenient exploration only. Type-safe access to byte arrays or external addresses SHOULD happen via external objects that have a type set such as instances of ExternalStructure and ExternalData."
+
+ ^ ExternalType bool handle: self at: byteOffset put: value!
- "Booleans are just integers in C word"
- ^self integerAt: byteOffset put: (value ifTrue:[1] ifFalse:[0]) size: 1 signed: false!
Item was changed:
----- Method: ByteArray>>doubleAt: (in category '*FFI-Kernel') -----
+ doubleAt: byteOffset
+ "Primitive. Return a float value from the receiver.
+ - FAILS IF the receiver has not enough bytes for an IEEE 754 (64 bits) floating point number.
+ - NOTE that this primitive will access memory in the outer space if invoked from ExternalAddress.
+ - SEE Float class >> #fromIEEE64Bit: and Float >> #asIEEE64BitWord"
- doubleAt: byteOffset
<primitive:'primitiveFFIDoubleAt' module:'SqueakFFIPrims'>
+ <ffiAtomicRead: #( double )>
+ "Examples:
+ ExternalType double handle: #[ 0 0 0 255 0 0 0 0 ] at: 1.
+ ExternalType double handle: #[ 0 0 0 255 ] at: 1. --- Error.
+ "
+ ^ self primitiveFailed!
- ^self primitiveFailed!
Item was changed:
----- Method: ByteArray>>doubleAt:put: (in category '*FFI-Kernel') -----
doubleAt: byteOffset put: value
+ "Primitive. Store the given value as IEEE 754 (64 bits) floating point number.
+ - FAILS IF the receiver has not enough bytes for that representation.
+ - NOTE that this primitive will access memory in the outer space if invoked from ExternalAddress.
+ - SEE Float class >> #fromIEEE64Bit: and Float >> #asIEEE64BitWord"
<primitive:'primitiveFFIDoubleAtPut' module:'SqueakFFIPrims'>
+ <ffiAtomicWrite: #( double )>
+ "Examples:
+ ExternalType double allocate value: 123.4567890; explore
+ ExternalType double allocate value: 0.0001; explore
+ "
+ ^ self primitiveFailed!
- ^self primitiveFailed!
Item was changed:
----- Method: ByteArray>>floatAt: (in category '*FFI-Kernel') -----
floatAt: byteOffset
+ "Primitive. Return a float value from the receiver.
+ - FAILS IF the receiver has not enough bytes for an IEEE 754 (32 bits) floating point number.
+ - NOTE that this primitive will access memory in the outer space if invoked from ExternalAddress.
+ - SEE Float class >> #fromIEEE32Bit: and Float >> #asIEEE32BitWord"
<primitive:'primitiveFFIFloatAt' module:'SqueakFFIPrims'>
+ <ffiAtomicRead: #( float )>
+ "Examples:
+ ExternalType float handle: #[ 0 0 0 255 ] at: 1.
+ ExternalType float handle: #[ 0 0 255 ] at: 1. --- Error.
+ "
+ ^ self primitiveFailed!
- ^self primitiveFailed!
Item was changed:
----- Method: ByteArray>>floatAt:put: (in category '*FFI-Kernel') -----
floatAt: byteOffset put: value
+ "Primitive. Store the given value as IEEE 754 (32 bits) floating point number.
+ - FAILS IF the receiver has not enough bytes for that representation.
+ - NOTE that this primitive will access memory in the outer space if invoked from ExternalAddress.
+ - SEE Float class >> #fromIEEE32Bit: and Float >> #asIEEE32BitWord"
<primitive:'primitiveFFIFloatAtPut' module:'SqueakFFIPrims'>
+ <ffiAtomicWrite: #( float )>
+ "Examples:
+ ExternalType float allocate value: 123.4567890; explore
+ ExternalType float allocate value: 0.0001; explore
+ "
+ ^ self primitiveFailed!
- ^self primitiveFailed!
Item was changed:
----- Method: ByteArray>>integerAt:put:size:signed: (in category '*FFI-Kernel') -----
integerAt: byteOffset put: value size: nBytes signed: aBoolean
+ "Primitive. Store the given value as integer of nBytes size in the receiver.
+ - BYTE ORDER is Smalltalk order, which is little-endian.
+ - FAILS IF the value is out of range.
+ - NOTE that this primitive will access memory in the outer space if invoked from ExternalAddress."
- "Primitive. Store the given value as integer of nBytes size
- in the receiver. Fail if the value is out of range.
- Note: This primitive will access memory in the outer space if
- invoked from ExternalAddress."
<primitive: 'primitiveFFIIntegerAtPut' module:'SqueakFFIPrims'>
+ <ffiAtomicWrite: #( int8_t uint8_t int16_t uint16_t int32_t uint32_t int64_t uint64_t ) >
+ "Examples:
+ ExternalType int32_t allocate value: -1; explore.
+ ExternalType uint32_t allocate value: 1; explore.
+ "
+ ^ self primitiveFailed!
- ^self primitiveFailed!
Item was changed:
----- Method: ByteArray>>integerAt:size:signed: (in category '*FFI-Kernel') -----
integerAt: byteOffset size: nBytes signed: aBoolean
"Primitive. Return an integer of nBytes size from the receiver.
+ - BYTE ORDER is Smalltalk order, which is little-endian.
+ - FAILS IF the receiver has not enough bytes.
+ - NOTE that this primitive will access memory in the outer space if invoked from ExternalAddress."
- Note: This primitive will access memory in the outer space if
- invoked from ExternalAddress."
<primitive: 'primitiveFFIIntegerAt' module:'SqueakFFIPrims'>
+ <ffiAtomicRead: #( int8_t uint8_t int16_t uint16_t int32_t uint32_t int64_t uint64_t ) >
+ "Examples:
+ ExternalType int32_t handle: #[ 255 0 0 255 ] at: 1.
+ ExternalType uint32_t handle: #[ 255 0 0 255 ] at: 1.
+ "
+ ^ self primitiveFailed!
- ^self primitiveFailed!
Item was changed:
+ ----- Method: ByteArray>>longPointerAt: (in category '*FFI-Kernel-deprecated') -----
- ----- Method: ByteArray>>longPointerAt: (in category '*FFI-Kernel-pointers') -----
longPointerAt: byteOffset
"Answer an 8-byte pointer object stored at the given byte address"
self deprecated: 'Use #pointerAt:length:'.
^ self pointerAt: byteOffset length: 8!
Item was changed:
+ ----- Method: ByteArray>>longPointerAt:put: (in category '*FFI-Kernel-deprecated') -----
- ----- Method: ByteArray>>longPointerAt:put: (in category '*FFI-Kernel-pointers') -----
longPointerAt: byteOffset put: value
"Store an 8-byte pointer object at the given byte address"
self deprecated: 'Use #pointerAt:put:length:'.
^ self pointerAt: byteOffset put: value length: 8!
Item was changed:
+ ----- Method: ByteArray>>pointerAt: (in category '*FFI-Kernel-examples') -----
- ----- Method: ByteArray>>pointerAt: (in category '*FFI-Kernel-pointers') -----
pointerAt: byteOffset
+ "For documentation and convenient exploration only. Type-safe access to byte arrays or external addresses SHOULD happen via external objects that have a type set such as instances of ExternalStructure and ExternalData."
+
+ ^ ExternalType void asPointerType handle: self at: byteOffset!
- "Answer a pointer object stored at the given byte address"
-
- ^ self pointerAt: byteOffset length: ExternalAddress wordSize!
Item was changed:
+ ----- Method: ByteArray>>pointerAt:length: (in category '*FFI-Kernel') -----
+ pointerAt: byteOffset length: length
+ "Return a pointer of the given length starting at the indicated byte offset."
- ----- Method: ByteArray>>pointerAt:length: (in category '*FFI-Kernel-pointers') -----
- pointerAt: byteOffset length: numBytes "^ <ExternalAddress>"
- "Answer a pointer object of numBytes length stored at the given byte address"
+ | pointer startByteOffset |
+ pointer := ExternalAddress basicNew: length.
+ startByteOffset := byteOffset - 1.
+ 1 to: length do: [:pointerByteOffset |
+ pointer
+ basicAt: pointerByteOffset
+ put: (self unsignedByteAt: startByteOffset + pointerByteOffset)].
+ ^ pointer!
- | addr |
- addr := ExternalAddress basicNew: numBytes.
- 1 to: numBytes do: [:index |
- addr
- basicAt: index
- put: (self unsignedByteAt: byteOffset+index-1)].
- ^addr!
Item was changed:
+ ----- Method: ByteArray>>pointerAt:put: (in category '*FFI-Kernel-examples') -----
- ----- Method: ByteArray>>pointerAt:put: (in category '*FFI-Kernel-pointers') -----
pointerAt: byteOffset put: value
+ "For documentation and convenient exploration only. Type-safe access to byte arrays or external addresses SHOULD happen via external objects that have a type set such as instances of ExternalStructure and ExternalData."
+
+ ^ ExternalType void asPointerType handle: self at: byteOffset put: value!
- "Store a pointer object at the given byte address"
-
- ^ self pointerAt: byteOffset put: value length: ExternalAddress wordSize!
Item was changed:
+ ----- Method: ByteArray>>pointerAt:put:length: (in category '*FFI-Kernel') -----
+ pointerAt: byteOffset put: pointer length: length
+ "Store a pointer of the given length starting at the indicated byte offset."
- ----- Method: ByteArray>>pointerAt:put:length: (in category '*FFI-Kernel-pointers') -----
- pointerAt: byteOffset put: value length: numBytes
- "Store a pointer object with numBytes lengeth at the given byte address"
+ | startByteOffset |
+ self assert: [pointer isExternalAddress].
+ startByteOffset := byteOffset - 1.
+ 1 to: length do: [:pointerByteOffset |
- self assert: [value isExternalAddress].
-
- 1 to: numBytes do: [:index |
self
+ unsignedByteAt: startByteOffset + pointerByteOffset
+ put: (pointer basicAt: pointerByteOffset)].
+ ^ pointer!
- unsignedByteAt: byteOffset + index - 1
- put: (value basicAt: index)].
- ^ value!
Item was changed:
+ ----- Method: ByteArray>>shortPointerAt: (in category '*FFI-Kernel-deprecated') -----
- ----- Method: ByteArray>>shortPointerAt: (in category '*FFI-Kernel-pointers') -----
shortPointerAt: byteOffset
"Answer a 4-byte pointer object stored at the given byte address"
self deprecated: 'Use #pointerAt:length:'.
^ self pointerAt: byteOffset length: 4!
Item was changed:
+ ----- Method: ByteArray>>shortPointerAt:put: (in category '*FFI-Kernel-deprecated') -----
- ----- Method: ByteArray>>shortPointerAt:put: (in category '*FFI-Kernel-pointers') -----
shortPointerAt: byteOffset put: value
"Store a 4-byte pointer object at the given byte address"
self deprecated: 'Use #pointerAt:put:length:'.
^ self pointerAt: byteOffset put: value length: 4!
Item was changed:
+ ----- Method: ByteArray>>signedCharAt: (in category '*FFI-Kernel-examples') -----
- ----- Method: ByteArray>>signedCharAt: (in category '*FFI-Kernel') -----
signedCharAt: byteOffset
+ "For documentation and convenient exploration only. Type-safe access to byte arrays or external addresses SHOULD happen via external objects that have a type set such as instances of ExternalStructure and ExternalData."
+
+ ^ ExternalType signedChar handle: self at: byteOffset!
- ^(self unsignedByteAt: byteOffset) asCharacter!
Item was changed:
+ ----- Method: ByteArray>>signedCharAt:put: (in category '*FFI-Kernel-examples') -----
- ----- Method: ByteArray>>signedCharAt:put: (in category '*FFI-Kernel') -----
signedCharAt: byteOffset put: aCharacter
+
+ ^ ExternalType signedChar handle: self at: byteOffset put: aCharacter!
- ^self unsignedByteAt: byteOffset put: aCharacter asciiValue!
Item was changed:
+ ----- Method: ByteArray>>signedLongAt: (in category '*FFI-Kernel-examples') -----
- ----- Method: ByteArray>>signedLongAt: (in category '*FFI-Kernel') -----
signedLongAt: byteOffset
+ "For documentation and convenient exploration only. Type-safe access to byte arrays or external addresses SHOULD happen via external objects that have a type set such as instances of ExternalStructure and ExternalData."
+
+ ^ ExternalType int32_t handle: self at: byteOffset!
- "Return a 32bit signed integer starting at the given byte offset"
- ^self integerAt: byteOffset size: 4 signed: true!
Item was changed:
+ ----- Method: ByteArray>>signedLongAt:put: (in category '*FFI-Kernel-examples') -----
- ----- Method: ByteArray>>signedLongAt:put: (in category '*FFI-Kernel') -----
signedLongAt: byteOffset put: value
+ "For documentation and convenient exploration only. Type-safe access to byte arrays or external addresses SHOULD happen via external objects that have a type set such as instances of ExternalStructure and ExternalData."
+
+ ^ ExternalType int32_t handle: self at: byteOffset put: value!
- "Store a 32bit signed integer starting at the given byte offset"
- ^self integerAt: byteOffset put: value size: 4 signed: true!
Item was changed:
+ ----- Method: ByteArray>>signedLongLongAt: (in category '*FFI-Kernel-examples') -----
- ----- Method: ByteArray>>signedLongLongAt: (in category '*FFI-Kernel') -----
signedLongLongAt: byteOffset
+ "For documentation and convenient exploration only. Type-safe access to byte arrays or external addresses SHOULD happen via external objects that have a type set such as instances of ExternalStructure and ExternalData."
+
+ ^ ExternalType int64_t handle: self at: byteOffset!
- | int |
- int := self unsignedLongLongAt: byteOffset.
- int > 16r7FFFFFFFFFFFFFFF ifTrue: [^int - 16r10000000000000000].
- ^int!
Item was changed:
+ ----- Method: ByteArray>>signedLongLongAt:put: (in category '*FFI-Kernel-examples') -----
- ----- Method: ByteArray>>signedLongLongAt:put: (in category '*FFI-Kernel') -----
signedLongLongAt: byteOffset put: value
+ "For documentation and convenient exploration only. Type-safe access to byte arrays or external addresses SHOULD happen via external objects that have a type set such as instances of ExternalStructure and ExternalData."
+
+ ^ ExternalType int64_t handle: self at: byteOffset put: value!
- self unsignedLongLongAt: byteOffset put: (value < 0
- ifTrue: [ value + 16r10000000000000000 ]
- ifFalse: [ value ])!
Item was changed:
+ ----- Method: ByteArray>>signedShortAt: (in category '*FFI-Kernel-examples') -----
- ----- Method: ByteArray>>signedShortAt: (in category '*FFI-Kernel') -----
signedShortAt: byteOffset
+ "For documentation and convenient exploration only. Type-safe access to byte arrays or external addresses SHOULD happen via external objects that have a type set such as instances of ExternalStructure and ExternalData."
+
+ ^ ExternalType int16_t handle: self at: byteOffset!
- "Return a 16bit signed integer starting at the given byte offset"
- ^self integerAt: byteOffset size: 2 signed: true!
Item was changed:
+ ----- Method: ByteArray>>signedShortAt:put: (in category '*FFI-Kernel-examples') -----
- ----- Method: ByteArray>>signedShortAt:put: (in category '*FFI-Kernel') -----
signedShortAt: byteOffset put: value
+ "For documentation and convenient exploration only. Type-safe access to byte arrays or external addresses SHOULD happen via external objects that have a type set such as instances of ExternalStructure and ExternalData."
+
+ ^ ExternalType int16_t handle: self at: byteOffset put: value!
- "Store a 16bit signed integer starting at the given byte offset"
- ^self integerAt: byteOffset put: value size: 2 signed: true!
Item was changed:
----- Method: ByteArray>>structAt:length: (in category '*FFI-Kernel') -----
structAt: byteOffset length: length
"Return a structure of the given length starting at the indicated byte offset."
+
+ | value startByteOffset |
- | value |
value := ByteArray new: length.
+ startByteOffset := byteOffset - 1.
+ 1 to: length do: [:valueByteOffset |
+ value
+ unsignedByteAt: valueByteOffset
+ put: (self unsignedByteAt: startByteOffset + valueByteOffset)].
+ ^ value!
- 1 to: length do:[:i|
- value unsignedByteAt: i put: (self unsignedByteAt: byteOffset+i-1)].
- ^value!
Item was changed:
----- Method: ByteArray>>structAt:put:length: (in category '*FFI-Kernel') -----
structAt: byteOffset put: value length: length
"Store a structure of the given length starting at the indicated byte offset."
+
+ | startByteOffset |
+ startByteOffset := byteOffset - 1.
+ 1 to: length do: [:valueByteOffset |
+ self
+ unsignedByteAt: startByteOffset + valueByteOffset
+ put: (value unsignedByteAt:valueByteOffset)].
+ ^ value!
- 1 to: length do:[:i|
- self unsignedByteAt: byteOffset+i-1 put: (value unsignedByteAt: i)].
- ^value!
Item was changed:
----- Method: ByteArray>>unsignedByteAt: (in category '*FFI-Kernel') -----
unsignedByteAt: byteOffset
+ "Same as #byteAt: but different primitive to support ExternalAddress."
+
+ ^ self integerAt: byteOffset size: 1 signed: false!
- "Return a 8bit unsigned integer starting at the given byte offset"
- ^self integerAt: byteOffset size: 1 signed: false!
Item was changed:
----- Method: ByteArray>>unsignedByteAt:put: (in category '*FFI-Kernel') -----
unsignedByteAt: byteOffset put: value
+ "Same as #byteAt: but different primitive to support ExternalAddress."
+
+ ^ self integerAt: byteOffset put: value size: 1 signed: false!
- "Store a 8bit unsigned integer starting at the given byte offset"
- ^self integerAt: byteOffset put: value size: 1 signed: false!
Item was changed:
+ ----- Method: ByteArray>>unsignedCharAt: (in category '*FFI-Kernel-examples') -----
- ----- Method: ByteArray>>unsignedCharAt: (in category '*FFI-Kernel') -----
unsignedCharAt: byteOffset
+ "For documentation and convenient exploration only. Type-safe access to byte arrays or external addresses SHOULD happen via external objects that have a type set such as instances of ExternalStructure and ExternalData."
+
+ ^ ExternalType unsignedChar handle: self at: byteOffset!
- ^(self unsignedByteAt: byteOffset) asCharacter!
Item was changed:
+ ----- Method: ByteArray>>unsignedCharAt:put: (in category '*FFI-Kernel-examples') -----
- ----- Method: ByteArray>>unsignedCharAt:put: (in category '*FFI-Kernel') -----
unsignedCharAt: byteOffset put: aCharacter
+ "For documentation and convenient exploration only. Type-safe access to byte arrays or external addresses SHOULD happen via external objects that have a type set such as instances of ExternalStructure and ExternalData."
+
+ ^ ExternalType unsignedChar handle: self at: byteOffset put: aCharacter!
- ^self unsignedByteAt: byteOffset put: aCharacter asciiValue!
Item was changed:
+ ----- Method: ByteArray>>unsignedLongAt: (in category '*FFI-Kernel-examples') -----
- ----- Method: ByteArray>>unsignedLongAt: (in category '*FFI-Kernel') -----
unsignedLongAt: byteOffset
+ "For documentation and convenient exploration only. Type-safe access to byte arrays or external addresses SHOULD happen via external objects that have a type set such as instances of ExternalStructure and ExternalData."
+
+ ^ ExternalType uint32_t handle: self at: byteOffset!
- "Return a 32bit unsigned integer starting at the given byte offset"
- ^self integerAt: byteOffset size: 4 signed: false!
Item was changed:
+ ----- Method: ByteArray>>unsignedLongAt:put: (in category '*FFI-Kernel-examples') -----
- ----- Method: ByteArray>>unsignedLongAt:put: (in category '*FFI-Kernel') -----
unsignedLongAt: byteOffset put: value
+ "For documentation and convenient exploration only. Type-safe access to byte arrays or external addresses SHOULD happen via external objects that have a type set such as instances of ExternalStructure and ExternalData."
+
+ ^ ExternalType uint32_t handle: self at: byteOffset put: value!
- "Store a 32bit signed integer starting at the given byte offset"
- ^self integerAt: byteOffset put: value size: 4 signed: false!
Item was changed:
+ ----- Method: ByteArray>>unsignedLongLongAt: (in category '*FFI-Kernel-examples') -----
- ----- Method: ByteArray>>unsignedLongLongAt: (in category '*FFI-Kernel') -----
unsignedLongLongAt: byteOffset
+ "For documentation and convenient exploration only. Type-safe access to byte arrays or external addresses SHOULD happen via external objects that have a type set such as instances of ExternalStructure and ExternalData."
+
+ ^ ExternalType uint64_t handle: self at: byteOffset!
- "Answer a 64-bit integer in Smalltalk order (little-endian)."
- ^self integerAt: byteOffset size: 8 signed: false!
Item was changed:
+ ----- Method: ByteArray>>unsignedLongLongAt:put: (in category '*FFI-Kernel-examples') -----
- ----- Method: ByteArray>>unsignedLongLongAt:put: (in category '*FFI-Kernel') -----
unsignedLongLongAt: byteOffset put: value
+ "For documentation and convenient exploration only. Type-safe access to byte arrays or external addresses SHOULD happen via external objects that have a type set such as instances of ExternalStructure and ExternalData."
+
+ ^ ExternalType uint64_t handle: self at: byteOffset put: value!
- "I store 64-bit integers in Smalltalk (little-endian) order."
- ^self integerAt: byteOffset put: value size: 8 signed: false!
Item was changed:
+ ----- Method: ByteArray>>unsignedShortAt: (in category '*FFI-Kernel-examples') -----
- ----- Method: ByteArray>>unsignedShortAt: (in category '*FFI-Kernel') -----
unsignedShortAt: byteOffset
+ "For documentation and convenient exploration only. Type-safe access to byte arrays or external addresses SHOULD happen via external objects that have a type set such as instances of ExternalStructure and ExternalData."
+
+ ^ ExternalType uint16_t handle: self at: byteOffset!
- "Return a 16bit unsigned integer starting at the given byte offset"
- ^self integerAt: byteOffset size: 2 signed: false!
Item was changed:
+ ----- Method: ByteArray>>unsignedShortAt:put: (in category '*FFI-Kernel-examples') -----
- ----- Method: ByteArray>>unsignedShortAt:put: (in category '*FFI-Kernel') -----
unsignedShortAt: byteOffset put: value
+ "For documentation and convenient exploration only. Type-safe access to byte arrays or external addresses SHOULD happen via external objects that have a type set such as instances of ExternalStructure and ExternalData."
+
+ ^ ExternalType uint16_t handle: self at: byteOffset put: value!
- "Store a 16bit unsigned integer starting at the given byte offset"
- ^self integerAt: byteOffset put: value size: 2 signed: false!
Item was removed:
- ----- Method: ByteArray>>voidAt: (in category '*FFI-Kernel') -----
- voidAt: byteOffset
- "no accessors for void"
- ^self shouldNotImplement!
Item was removed:
- ----- Method: ByteArray>>voidAt:put: (in category '*FFI-Kernel') -----
- voidAt: byteOffset put: value
- "no accessors for void"
- ^self shouldNotImplement!
Item was changed:
----- Method: ByteArray>>zeroMemory: (in category '*FFI-Kernel') -----
zeroMemory: numBytes
1 to: numBytes do: [:index |
+ self unsignedByteAt: index put: 0].!
- self byteAt: index put: 0].!
Item was changed:
----- Method: ByteArrayReadWriter>>copy (in category 'copying') -----
copy
+ "Materialize the current array segment. See ExternalStructure >> #postCopy"
+
-
^ byteArray copyFrom: byteOffset + 1 to: byteOffset + byteSize !
Item was changed:
----- Method: ByteArrayReadWriter>>doesNotUnderstand: (in category 'system primitives') -----
doesNotUnderstand: aMessage
- | selector args |
- selector := aMessage selector.
- args := aMessage arguments.
- args size caseOf: {
- [ 1 ] -> [ (selector endsWith: 'At:') ifTrue: [ args at: 1 put: args first + byteOffset ] ].
- [ 2 ] -> [ (selector endsWith: 'length:')
- ifTrue: [
- args at: 1 put: args first + byteOffset.
- (args first + args second - 1) > (byteOffset + byteSize)
- ifTrue: [self errorSubscriptBounds: args first + args second - 1] ]
- ifFalse: [(selector endsWith: 'put:') ifTrue: [
- args at: 1 put: args first + byteOffset ]] ].
- [ 3 ] -> [ (selector endsWith: 'length:')
- ifTrue: [
- args at: 1 put: args first + byteOffset.
- (args first + args third - 1) > (byteSize + byteSize)
- ifTrue: [self errorSubscriptBounds: args first + args third - 1]]]
- } otherwise: [].
^ aMessage sendTo: byteArray!
Item was added:
+ ----- Method: ByteArrayReadWriter>>doubleAt: (in category 'read/write atomics') -----
+ doubleAt: oByteOffset
+
+ ^ byteArray doubleAt: oByteOffset + byteOffset!
Item was added:
+ ----- Method: ByteArrayReadWriter>>doubleAt:put: (in category 'read/write atomics') -----
+ doubleAt: oByteOffset put: value
+
+ ^ byteArray doubleAt: oByteOffset + byteOffset put: value!
Item was added:
+ ----- Method: ByteArrayReadWriter>>floatAt: (in category 'read/write atomics') -----
+ floatAt: oByteOffset
+
+ ^ byteArray floatAt: oByteOffset + byteOffset!
Item was added:
+ ----- Method: ByteArrayReadWriter>>floatAt:put: (in category 'read/write atomics') -----
+ floatAt: oByteOffset put: value
+
+ ^ byteArray floatAt: oByteOffset + byteOffset put: value!
Item was added:
+ ----- Method: ByteArrayReadWriter>>integerAt:put:size:signed: (in category 'read/write atomics') -----
+ integerAt: oByteOffset put: value size: nBytes signed: aBoolean
+
+ ^ byteArray integerAt: oByteOffset + byteOffset put: value size: nBytes signed: aBoolean!
Item was added:
+ ----- Method: ByteArrayReadWriter>>integerAt:size:signed: (in category 'read/write atomics') -----
+ integerAt: oByteOffset size: nBytes signed: aBoolean
+
+ ^ byteArray integerAt: oByteOffset + byteOffset size: nBytes signed: aBoolean.!
Item was removed:
- ----- Method: ByteArrayReadWriter>>perform:with: (in category 'message handling') -----
- perform: aSymbol with: anObject
- "Needed because of AtomicSelectors. See ExternalType >> #handle:at:."
-
- <primitive: 83>
- ^ self perform: aSymbol withArguments: { anObject }!
Item was removed:
- ----- Method: ByteArrayReadWriter>>perform:with:with: (in category 'message handling') -----
- perform: aSymbol with: firstObject with: secondObject
- "Needed because of AtomicSelectors. See ExternalType >> #handle:at:put:."
-
- <primitive: 83>
- ^ self perform: aSymbol withArguments: { firstObject. secondObject }!
Item was added:
+ ----- Method: ByteArrayReadWriter>>perform:with:with:with: (in category 'message handling') -----
+ perform: aSymbol with: firstObject with: secondObject with: thirdObject
+ "Needed because of AtomicSelectors. See FFIAtomicReadWriteSend >> #handle:at:."
+
+ <primitive: 83>
+ ^ self perform: aSymbol withArguments: { firstObject. secondObject. thirdObject }!
Item was added:
+ ----- Method: ByteArrayReadWriter>>perform:with:with:with:with: (in category 'message handling') -----
+ perform: aSymbol with: firstObject with: secondObject with: thirdObject with: fourthObject
+ "Needed because of AtomicSelectors. See FFIAtomicReadWriteSend >> #handle:at:put:."
+
+ <primitive: 83>
+ ^ self perform: aSymbol withArguments: { firstObject. secondObject. thirdObject. fourthObject }!
Item was added:
+ ----- Method: ByteArrayReadWriter>>pointerAt:length: (in category 'read/write pointers') -----
+ pointerAt: oByteOffset length: numBytes
+
+ ^ byteArray pointerAt: oByteOffset + byteOffset length: numBytes!
Item was added:
+ ----- Method: ByteArrayReadWriter>>pointerAt:put:length: (in category 'read/write pointers') -----
+ pointerAt: oByteOffset put: value length: numBytes
+
+ ^ byteArray pointerAt: oByteOffset + byteOffset put: value length: numBytes!
Item was changed:
+ ----- Method: ByteArrayReadWriter>>structAt:length: (in category 'read/write structs') -----
- ----- Method: ByteArrayReadWriter>>structAt:length: (in category 'structs') -----
structAt: newByteOffset length: newLength
^ ByteArrayReadWriter new
setArray: byteArray
offset: byteOffset + newByteOffset - 1
size: newLength!
Item was changed:
+ ----- Method: ByteArrayReadWriter>>structAt:put:length: (in category 'read/write structs') -----
- ----- Method: ByteArrayReadWriter>>structAt:put:length: (in category 'structs') -----
structAt: newByteOffset put: value length: newLength
(newByteOffset + newLength > byteSize)
ifTrue: [self errorSubscriptBounds: newByteOffset + newLength].
^ byteArray
structAt: byteOffset + newByteOffset - 1
put: value
length: newLength!
Item was added:
+ IntegerReadWriteSend subclass: #CharacterReadWriteSend
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'FFI-Kernel-Support'!
+
+ !CharacterReadWriteSend commentStamp: 'mt 5/19/2021 10:18' prior: 0!
+ I am a specialization for the atomic 'char' and 'schar' types, which both map to (unsigned) 'byte' but add extra pre- and post-processing to read and write instances of Character such as $A and $Z.!
Item was added:
+ ----- Method: CharacterReadWriteSend class>>fromType: (in category 'instance creation') -----
+ fromType: type
+
+ ^ super fromType: ExternalType byte!
Item was added:
+ ----- Method: CharacterReadWriteSend>>handle:at: (in category 'evaluating') -----
+ handle: handle at: byteOffset
+
+ ^ (super handle: handle at: byteOffset) asCharacter!
Item was added:
+ ----- Method: CharacterReadWriteSend>>handle:at:put: (in category 'evaluating') -----
+ handle: handle at: byteOffset put: aCharacter
+
+ super
+ handle: handle
+ at: byteOffset
+ put: aCharacter asciiValue.
+ ^ aCharacter!
Item was added:
+ ----- Method: CharacterReadWriteSend>>template (in category 'compiling') -----
+ template
+
+ ^ self isReading
+ ifTrue: ['(', super template, ') asCharacter']
+ ifFalse: [super template copyReplaceAll: '{3}' with: '{3} asciiValue']!
Item was changed:
----- Method: ExternalAddress>>byteAt: (in category 'accessing') -----
byteAt: byteOffset
+ "For documentation and convenient exploration only. Please use #unsignedByteAt: directly.
+ Overwritten to go through a different primitive since the receiver describes data in the outside world."
- "Overwritten to to through a different primitive since the receiver describes data in the outside world."
+ ^ self unsignedByteAt: byteOffset!
- ^ self integerAt: byteOffset size: 1 signed: false!
Item was changed:
----- Method: ExternalAddress>>byteAt:put: (in category 'accessing') -----
byteAt: byteOffset put: value
+ "For documentation and convenient exploration only. Please use #unsignedByteAt:put: directly.
+ Overwritten to go through a different primitive since the receiver describes data in the outside world."
+
+ ^ self unsignedByteAt: byteOffset put: value!
- "Overwritten to go through a different primitive since the receiver describes data in the outside world."
-
- ^ self integerAt: byteOffset put: value size: 1 signed: false!
Item was changed:
+ ----- Method: ExternalAddress>>signedByteAt: (in category 'examples') -----
- ----- Method: ExternalAddress>>signedByteAt: (in category 'accessing') -----
signedByteAt: byteOffset
+ "For documentation and convenient exploration only. Type-safe access to byte arrays or external addresses SHOULD happen via external objects that have a type set such as instances of ExternalStructure and ExternalData."
+
+ ^ ExternalType uint8_t handle: self at: byteOffset!
- "Overwritten to go through a different primitive since the receiver describes data in the outside world."
-
- ^ self integerAt: byteOffset size: 1 signed: true!
Item was changed:
+ ----- Method: ExternalAddress>>signedByteAt:put: (in category 'examples') -----
- ----- Method: ExternalAddress>>signedByteAt:put: (in category 'accessing') -----
signedByteAt: byteOffset put: value
+ "For documentation and convenient exploration only. Type-safe access to byte arrays or external addresses SHOULD happen via external objects that have a type set such as instances of ExternalStructure and ExternalData."
+
+ ^ ExternalType int8_t handle: self at: byteOffset put: value!
- "Overwritten to go through a different primitive since the receiver describes data in the outside world."
-
- ^ self integerAt: byteOffset put: value size: 1 signed: true!
Item was changed:
----- Method: ExternalAddress>>structAt:length: (in category 'accessing') -----
structAt: byteOffset length: length
+ "Overwritten to not read bytes but just move the pointer. Ignore the length."
+
+ ^ ExternalAddress fromAddress: self movedBy: byteOffset - 1!
- "Return the external address of the struct's first field. Ignore length."
- ^ self + (byteOffset-1)!
Item was removed:
- ----- Method: ExternalAddress>>structAt:put:length: (in category 'accessing') -----
- structAt: byteOffset put: externalAddress length: length
- "Read length bytes from externalAddress and write it at this external address (plus byteOffset)."
-
- | start |
- start := self + (byteOffset-1).
- 1 to: length do: [:targetOffset |
- start
- byteAt: targetOffset
- put: (externalAddress byteAt: targetOffset)].!
Item was changed:
----- Method: ExternalAtomicType>>handle:at: (in category 'external data') -----
handle: handle at: byteOffset
^ referentClass
ifNil: [ "Genuine atomics"
+ (AtomicSends at: self atomicType + 1) first
+ handle: handle
+ at: byteOffset]
- handle
- perform: (AtomicSelectors at: self atomicType)
- with: byteOffset]
ifNotNil: [ "Alias to atomics"
referentClass fromHandle: (handle
structAt: byteOffset
length: self byteSize)]!
Item was changed:
----- Method: ExternalAtomicType>>handle:at:put: (in category 'external data') -----
handle: handle at: byteOffset put: value
^ referentClass
ifNil: ["genuine atomic"
+ (AtomicSends at: self atomicType + 1) second
+ handle: handle
+ at: byteOffset
+ put: value]
- handle
- perform: ((AtomicSelectors at: self atomicType), 'put:') asSymbol
- with: byteOffset
- with: value]
ifNotNil: ["type alias"
handle
structAt: byteOffset
put: value getHandle
length: self byteSize]!
Item was changed:
----- Method: ExternalAtomicType>>readFieldAt: (in category 'external structure') -----
readFieldAt: byteOffset
^ referentClass
ifNil: [ "Genuine atomics"
+ '^ ', (AtomicSends at: self atomicType + 1) first template
- '^ handle {1} {2}'
format: {
+ 'handle'.
- AtomicSelectors at: self atomicType.
byteOffset}]
ifNotNil: [ "Type alias"
'^ {1} fromHandle: (handle structAt: {2} length: {3})'
format: {
referentClass name.
byteOffset.
self byteSize}]!
Item was changed:
----- Method: ExternalAtomicType>>writeFieldAt:with: (in category 'external structure') -----
writeFieldAt: byteOffset with: valueName
^ referentClass
ifNil: ["genuine atomics"
+ (AtomicSends at: self atomicType + 1) second template, '.'
- 'handle {1} {2} put: {3}.'
format: {
+ 'handle'.
- AtomicSelectors at: self atomicType.
byteOffset.
valueName}]
ifNotNil: ["type alias"
'handle structAt: {1} put: {2} getHandle length: {3}.'
format: {
byteOffset.
valueName.
self byteSize}]!
Item was changed:
----- Method: ExternalStructureType>>readAlias (in category 'external structure') -----
readAlias
^ '^ {1} fromHandle: handle'
format: {referentClass name}!
Item was changed:
Object subclass: #ExternalType
instanceVariableNames: 'compiledSpec referentClass referencedType byteAlignment'
+ classVariableNames: 'ArrayClasses ArrayTypes AtomicSends AtomicTypeNames AtomicTypes ExtraTypeChecks StructTypes UseArrayClasses'
- classVariableNames: 'ArrayClasses ArrayTypes AtomicSelectors AtomicTypeNames AtomicTypes ExtraTypeChecks StructTypes UseArrayClasses'
poolDictionaries: 'FFIConstants'
category: 'FFI-Kernel'!
!ExternalType commentStamp: 'mt 6/5/2020 18:25' prior: 0!
An external type represents the type of external objects.
Instance variables:
compiledSpec <WordArray> Compiled specification of the external type
referentClass <Behavior | nil> Class type of argument required
referencedType <ExternalType> Associated (non)pointer type with the receiver
byteAlignment <Integer | nil> The desired alignment for a field of the external type within a structure. If nil it has yet to be computed.
Compiled Spec:
The compiled spec defines the type in terms which are understood by the VM. Each word is defined as:
bits 0...15 - byte size of the entity
bit 16 - structure flag (FFIFlagStructure)
This flag is set if the following words define a structure
bit 17 - pointer flag (FFIFlagPointer)
This flag is set if the entity represents a pointer to another object
bit 18 - atomic flag (FFIFlagAtomic)
This flag is set if the entity represents an atomic type.
If the flag is set the atomic type bits are valid.
bits 19...23 - unused
bits 24...27 - atomic type (FFITypeVoid ... FFITypeDoubleFloat)
bits 28...31 - unused
Note that all combinations of the flags FFIFlagPointer, FFIFlagAtomic, and FFIFlagStructure are invalid, EXCEPT from the following:
FFIFlagPointer + FFIFlagAtomic:
This defines a pointer to an atomic type (e.g., 'char*', 'int*').
The actual atomic type is represented in the atomic type bits.
FFIFlagPointer + FFIFlagStructure:
This defines a structure which is a typedef of a pointer type as in
typedef void* VoidPointer;
typedef Pixmap* PixmapPtr;
It requires a byte size of four or eight (e.g. a 32-bit or 64-bit pointer) to work correctly.
[Note: Other combinations may be allowed in the future]
!
Item was added:
+ ----- Method: ExternalType class>>initializeAtomicSends (in category 'class initialization') -----
+ initializeAtomicSends
+ "
+ ExternalType initializeAtomicSends.
+ "
+ AtomicSends ifNil: [
+ AtomicSends := Array new: AtomicTypeNames size].
+
+ self atomicTypes withIndexDo: [:type :index |
+ AtomicSends at: index put: (FFIAtomicReadWriteSend fromType: type)].!
Item was changed:
----- Method: ExternalType class>>initializeDefaultTypes (in category 'class initialization') -----
initializeDefaultTypes
"Create new atomic types and setup the dictionaries. See #resetAllAtomicTypes."
AtomicTypes ifNil: [
AtomicTypes := Dictionary new. "Strong references required because there is no lazy atomic type initialization like there is for struct types and array types."
AtomicTypeNames valuesDo: [:typeName |
self newTypeForAtomicNamed: typeName]].
self initializeAtomicTypes.
+ self initializeAtomicSends.
self initializeStructureTypes.!
Item was changed:
----- Method: ExternalType class>>initializeFFIConstants (in category 'class initialization') -----
initializeFFIConstants
"ExternalType initialize"
FFIConstants initialize. "ensure proper initialization"
AtomicTypeNames := IdentityDictionary new.
- AtomicSelectors := IdentityDictionary new.
AtomicTypeNames
at: FFITypeVoid put: 'void';
at: FFITypeBool put: 'bool';
at: FFITypeUnsignedByte put: 'byte';
at: FFITypeSignedByte put: 'sbyte';
at: FFITypeUnsignedShort put: 'ushort';
at: FFITypeSignedShort put: 'short';
flag: #ffiLongVsInt;
at: FFITypeUnsignedInt put: 'ulong';
at: FFITypeSignedInt put: 'long';
at: FFITypeUnsignedLongLong put: 'ulonglong';
at: FFITypeSignedLongLong put: 'longlong';
at: FFITypeUnsignedChar put: 'char';
at: FFITypeSignedChar put: 'schar';
at: FFITypeSingleFloat put: 'float';
at: FFITypeDoubleFloat put: 'double';
+ yourself.!
- yourself.
-
- AtomicSelectors
- at: FFITypeVoid put: #voidAt:;
- at: FFITypeBool put: #booleanAt:;
- at: FFITypeUnsignedByte put: #unsignedByteAt:;
- at: FFITypeSignedByte put: #signedByteAt:;
- at: FFITypeUnsignedShort put: #unsignedShortAt:;
- at: FFITypeSignedShort put: #signedShortAt:;
- flag: #ffiLongVsInt;
- at: FFITypeUnsignedInt put: #unsignedLongAt:;
- at: FFITypeSignedInt put: #signedLongAt:;
- at: FFITypeUnsignedLongLong put: #unsignedLongLongAt:;
- at: FFITypeSignedLongLong put: #signedLongLongAt:;
- at: FFITypeUnsignedChar put: #unsignedCharAt:;
- at: FFITypeSignedChar put: #signedCharAt:;
- at: FFITypeSingleFloat put: #floatAt:;
- at: FFITypeDoubleFloat put: #doubleAt:;
- yourself!
Item was changed:
----- Method: ExternalType class>>resetAllAtomicTypes (in category 'housekeeping') -----
resetAllAtomicTypes
"Warning: This call is only required if you change the initialization for AtomicTypes."
AtomicTypes := nil.
+ AtomicSends := nil.
StructTypes := nil.
ArrayTypes := nil.
ArrayClasses := nil.
self initializeDefaultTypes.
self initializeArrayClasses.
self resetAllStructureTypes.!
Item was added:
+ ----- Method: ExternalType>>isBoolType (in category 'testing - special') -----
+ isBoolType
+
+ | type |
+ type := self atomicType.
+ ^ type = FFITypeBool!
Item was changed:
----- Method: ExternalUnknownType>>printOn: (in category 'printing') -----
printOn: aStream
+ aStream
+ nextPutAll: '<unknown type>';
+ space;
+ print: self typeName.!
- aStream nextPutAll: '<unknown type>'.!
Item was added:
+ MessageSend subclass: #FFIAtomicReadWriteSend
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'FFI-Kernel-Support'!
+
+ !FFIAtomicReadWriteSend commentStamp: 'mt 5/19/2021 10:20' prior: 0!
+ I am a message send for reading and writing atomic values from and to byte arrays or external addresses.
+
+ I can help with code generation through #template.
+
+ Take a look at ExternalType class >> #initializeAtomicSends.!
Item was added:
+ ----- Method: FFIAtomicReadWriteSend class>>fromType: (in category 'instance creation') -----
+ fromType: atomicType
+
+ atomicType isFloatType
+ ifTrue: [^ FloatReadWriteSend fromType: atomicType].
+
+ atomicType isIntegerType
+ ifTrue: [^ IntegerReadWriteSend fromType: atomicType].
+
+ atomicType isCharType
+ ifTrue: [^ CharacterReadWriteSend fromType: atomicType].
+
+ atomicType isBoolType
+ ifTrue: [^ BooleanReadWriteSend fromType: atomicType].
+
+ atomicType isVoid
+ ifTrue: [^ VoidReadWriteSend fromType: atomicType].
+
+ self error: 'Unkown atomic type!!'.!
Item was added:
+ ----- Method: FFIAtomicReadWriteSend class>>lookupSelectorsFor: (in category 'instance creation') -----
+ lookupSelectorsFor: atomicType
+
+ | result |
+ result := Array with: nil "read selector" with: nil "write selector".
+ ByteArray methodsDo: [:method |
+ (method pragmaAt: #ffiAtomicRead:) ifNotNil: [:pragma |
+ ((pragma argumentAt: 1) anySatisfy: [:typeName |
+ (ExternalType atomicTypeNamed: typeName) = atomicType])
+ ifTrue: [result at: 1 put: method selector]].
+ (method pragmaAt: #ffiAtomicWrite:) ifNotNil: [:pragma |
+ ((pragma argumentAt: 1) anySatisfy: [:typeName |
+ (ExternalType atomicTypeNamed: typeName) = atomicType])
+ ifTrue: [result at: 2 put: method selector]].
+ (result first notNil and: [result second notNil])
+ ifTrue: [^ result "early out"]].
+
+ (result first isNil or: [result second isNil])
+ ifTrue: [self error: 'Could not find selectors for both read and write!!'].
+
+ ^ result!
Item was added:
+ ----- Method: FFIAtomicReadWriteSend>>handle:at: (in category 'evaluating') -----
+ handle: receiver at: byteOffset
+
+ self subclassResponsibility.!
Item was added:
+ ----- Method: FFIAtomicReadWriteSend>>handle:at:put: (in category 'evaluating') -----
+ handle: receiver at: byteOffset put: floatValue
+
+ self subclassResponsibility.!
Item was added:
+ ----- Method: FFIAtomicReadWriteSend>>isReading (in category 'accessing') -----
+ isReading
+
+ self subclassResponsibility.!
Item was added:
+ ----- Method: FFIAtomicReadWriteSend>>isWriting (in category 'accessing') -----
+ isWriting
+
+ ^ self isReading not!
Item was added:
+ ----- Method: FFIAtomicReadWriteSend>>printOn: (in category 'nil') -----
+ printOn: stream
+
+ stream nextPutAll: self template.!
Item was added:
+ ----- Method: FFIAtomicReadWriteSend>>template (in category 'compiling') -----
+ template
+ "Answers a source code template to be used to compile this send into an accessor method such as for struct fields."
+
+ | formatIndex result |
+ formatIndex := 1.
+ result := ((selector findTokens: ':') with: arguments collect: [:token :argument |
+ argument
+ ifNil: [ formatIndex := formatIndex + 1. token, ': {', formatIndex, '}' ]
+ ifNotNil: [ token, ': ', argument asString ]]) joinSeparatedBy: String space.
+ ^ '{1} ', result!
Item was added:
+ FFIAtomicReadWriteSend subclass: #FloatReadWriteSend
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'FFI-Kernel-Support'!
+
+ !FloatReadWriteSend commentStamp: 'mt 5/19/2021 10:19' prior: 0!
+ I am a message send for reading and writing atomic float values from and to byte arrays or external addresses. See #isFloatType and #initializeAtomicSends.!
Item was added:
+ ----- Method: FloatReadWriteSend class>>fromType: (in category 'instance creation') -----
+ fromType: type
+
+ | selectors |
+ selectors := self lookupSelectorsFor: type.
+ ^ {
+
+ self
+ receiver: nil "handle" selector: selectors first
+ arguments: (Array
+ with: nil "byteOffset").
+
+ self
+ receiver: nil "handle" selector: selectors second
+ arguments: (Array
+ with: nil "byteOffset"
+ with: nil "aFloat")
+
+ }!
Item was added:
+ ----- Method: FloatReadWriteSend>>handle:at: (in category 'evaluating') -----
+ handle: receiver at: byteOffset
+
+ ^ receiver
+ perform: selector
+ with: byteOffset!
Item was added:
+ ----- Method: FloatReadWriteSend>>handle:at:put: (in category 'evaluating') -----
+ handle: receiver at: byteOffset put: floatValue
+
+ receiver
+ perform: selector
+ with: byteOffset
+ with: floatValue.
+ ^ floatValue!
Item was added:
+ ----- Method: FloatReadWriteSend>>isReading (in category 'accessing') -----
+ isReading
+
+ ^ selector numArgs = 1!
Item was added:
+ FFIAtomicReadWriteSend subclass: #IntegerReadWriteSend
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'FFI-Kernel-Support'!
+
+ !IntegerReadWriteSend commentStamp: 'mt 5/19/2021 10:15' prior: 0!
+ I am a message send for reading and writing atomic integer values from and to byte arrays or external addresses. My instances memoize type-specific #byteSize and #isSigned. See #isIntegerType and #initializeAtomicSends.!
Item was added:
+ ----- Method: IntegerReadWriteSend class>>fromType: (in category 'instance creation') -----
+ fromType: type
+ "Overwritten to account for byteSize and isSigned."
+
+ | selectors |
+ selectors := self lookupSelectorsFor: type.
+ ^ {
+
+ self
+ receiver: nil "handle" selector: selectors first
+ arguments: (Array
+ with: nil "byteOffset"
+ with: type byteSize
+ with: type isSigned).
+
+ self
+ receiver: nil "handle" selector: selectors second
+ arguments: (Array
+ with: nil "byteOffset"
+ with: nil "integerValue"
+ with: type byteSize
+ with: type isSigned)
+
+ }!
Item was added:
+ ----- Method: IntegerReadWriteSend>>handle:at: (in category 'evaluating') -----
+ handle: receiver at: byteOffset
+ "Read."
+
+ ^ receiver
+ perform: selector
+ with: byteOffset
+ with: (arguments at: 2) "byteSize"
+ with: (arguments at: 3) "isSigned"!
Item was added:
+ ----- Method: IntegerReadWriteSend>>handle:at:put: (in category 'evaluating') -----
+ handle: receiver at: byteOffset put: integerValue
+ "Write."
+
+ receiver
+ perform: selector
+ with: byteOffset
+ with: integerValue
+ with: (arguments at: 3) "byteSize"
+ with: (arguments at: 4). "isSigned"
+ ^ integerValue!
Item was added:
+ ----- Method: IntegerReadWriteSend>>isReading (in category 'accessing') -----
+ isReading
+
+ ^ selector numArgs = 3!
Item was added:
+ FFIAtomicReadWriteSend subclass: #VoidReadWriteSend
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'FFI-Kernel-Support'!
+
+ !VoidReadWriteSend commentStamp: 'mt 5/19/2021 10:19' prior: 0!
+ I am (kind of a) null object for atomic read-write sends. You should never try to read nor write void.!
Item was added:
+ ----- Method: VoidReadWriteSend class>>fromType: (in category 'instance creation') -----
+ fromType: type
+
+ ^ {
+ self receiver: nil selector: #voidAt:.
+ self receiver: nil selector: #voidAt:put:}!
Item was added:
+ ----- Method: VoidReadWriteSend>>handle:at: (in category 'evaluating') -----
+ handle: handle at: byteOffset
+ "no accessors for void"
+ self shouldNotImplement.!
Item was added:
+ ----- Method: VoidReadWriteSend>>handle:at:put: (in category 'evaluating') -----
+ handle: handle at: byteOffset put: value
+ "no accessors for void"
+ self shouldNotImplement.!
Item was added:
+ ----- Method: VoidReadWriteSend>>isReading (in category 'accessing') -----
+ isReading
+
+ ^ selector numArgs = 1!
Item was added:
+ ----- Method: VoidReadWriteSend>>template (in category 'compiling') -----
+ template
+
+ ^ 'self shouldNotImplement'!
Item was changed:
(PackageInfo named: 'FFI-Kernel') postscript: 'Smalltalk removeFromStartUpList: ExternalAddress.
Smalltalk removeFromStartUpList: ExternalObject.
+ "Introduce FFIAtomicReadWriteSend. All types need to be reset and all fields need to be re-defined."
+ ExternalType resetAllTypes.
- ExternalType resetAllTypes..
-
- "Re-generate all field accessors because in ExternalData, #size: was replaced with #setSet: and a new constructors for content and container types."
ExternalStructure defineAllFields.
'!