[squeak-dev] FFI: FFI-Kernel-eem.182.mcz

commits at source.squeak.org commits at source.squeak.org
Mon Jul 26 19:02:04 UTC 2021


Eliot Miranda uploaded a new version of FFI-Kernel to project FFI:
http://source.squeak.org/FFI/FFI-Kernel-eem.182.mcz

==================== Summary ====================

Name: FFI-Kernel-eem.182
Author: eem
Time: 26 July 2021, 12:02:02.569371 pm
UUID: 2aa208f9-824b-4b91-b5bf-6cc01a61f26f
Ancestors: FFI-Kernel-mt.181

Provide [u]int{8,16,32,64}At:[put:] accessors using new  primitives in SqueakFFIPrims (failing to the old integerAt:[put:]size:signed: API).

Clarify that these accessors do (& always have) access integers in the platform's native order.

Allow ffiAtomicRead: & ffiAtomicWrite: pragmas to take symbols as well as arrays of symbols.  Why?  Because in time, with the new primtives, we will be able to discard the old slow integerAt:put:size:signed: API and this is the only one that needs the array facilities.

Use symbols for the primitive pragmas; in the compiled method module and primitive funciton are symbols anyway.

=============== Diff against FFI-Kernel-mt.181 ===============

Item was changed:
+ ----- Method: ByteArray>>doubleAt: (in category '*FFI-Kernel-accessing') -----
- ----- 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"
+ 	<primitive: #primitiveFFIDoubleAt module: #SqueakFFIPrims>
+ 	<ffiAtomicRead: #double>
- 	<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!

Item was changed:
+ ----- Method: ByteArray>>doubleAt:put: (in category '*FFI-Kernel-accessing') -----
- ----- 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>
- 	<primitive:'primitiveFFIDoubleAtPut' module:'SqueakFFIPrims'>
- 	<ffiAtomicWrite: #( double )>
  	"Examples:
  		ExternalType double allocate value: 123.4567890; explore
  		ExternalType double allocate value: 0.0001; explore
  	"
  	^ self primitiveFailed!

Item was changed:
+ ----- Method: ByteArray>>floatAt: (in category '*FFI-Kernel-accessing') -----
- ----- 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>
- 	<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!

Item was changed:
+ ----- Method: ByteArray>>floatAt:put: (in category '*FFI-Kernel-accessing') -----
- ----- 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>
- 	<primitive:'primitiveFFIFloatAtPut' module:'SqueakFFIPrims'>
- 	<ffiAtomicWrite: #( float )>
  	"Examples:
  		ExternalType float allocate value: 123.4567890; explore
  		ExternalType float allocate value: 0.0001; explore
  	"
  	^ self primitiveFailed!

Item was added:
+ ----- Method: ByteArray>>int16At: (in category '*FFI-Kernel-accessing') -----
+ int16At: byteOffset
+ 	"Answer the signed 16-bit integer at byte offset, in platform native order."
+ 	<primitive: #primitiveSignedInt16At module: #SqueakFFIPrims error: ec>
+ 	<ffiAtomicRead: #int16_t>
+ 	^ self integerAt: byteOffset size: 2 signed: true!

Item was added:
+ ----- Method: ByteArray>>int16At:put: (in category '*FFI-Kernel-accessing') -----
+ int16At: byteOffset put: value
+ 	"Store the signed 16-bit integer at byte offset, in platform native order."
+ 	<primitive: #primitiveSignedInt16AtPut module: #SqueakFFIPrims error: ec>
+ 	<ffiAtomicWrite: #int16_t>
+ 	^ self integerAt: byteOffset put: value size: 2 signed: true!

Item was added:
+ ----- Method: ByteArray>>int32At: (in category '*FFI-Kernel-accessing') -----
+ int32At: byteOffset
+ 	"Answer the signed 32-bit integer at byte offset, in platform native order."
+ 	<primitive: #primitiveSignedInt32At module: #SqueakFFIPrims error: ec>
+ 	<ffiAtomicRead: #int32_t>
+ 	^ self integerAt: byteOffset size: 4 signed: true!

Item was added:
+ ----- Method: ByteArray>>int32At:put: (in category '*FFI-Kernel-accessing') -----
+ int32At: byteOffset put: value
+ 	"Store the signed 32-bit integer at byte offset, in platform native order."
+ 	<primitive: #primitiveSignedInt32AtPut module: #SqueakFFIPrims error: ec>
+ 	<ffiAtomicWrite: #int32_t>
+ 	^ self integerAt: byteOffset put: value size: 4 signed: true!

Item was added:
+ ----- Method: ByteArray>>int64At: (in category '*FFI-Kernel-accessing') -----
+ int64At: byteOffset
+ 	"Answer the signed 64-bit integer at byte offset, in platform native order."
+ 	<primitive: #primitiveSignedInt64At module: #SqueakFFIPrims error: ec>
+ 	<ffiAtomicRead: #int64_t>
+ 	^ self integerAt: byteOffset size: 8 signed: true!

Item was added:
+ ----- Method: ByteArray>>int64At:put: (in category '*FFI-Kernel-accessing') -----
+ int64At: byteOffset put: value
+ 	"Store the signed 64-bit integer at byte offset, in platform native order."
+ 	<primitive: #primitiveSignedInt64AtPut module: #SqueakFFIPrims error: ec>
+ 	<ffiAtomicWrite: #int64_t>
+ 	^ self integerAt: byteOffset put: value size: 8 signed: true!

Item was added:
+ ----- Method: ByteArray>>int8At: (in category '*FFI-Kernel-accessing') -----
+ int8At: byteOffset
+ 	"Answer the signed 8-bit integer at byte offset."
+ 	<primitive: #primitiveSignedInt8At module: #SqueakFFIPrims error: ec>
+ 	<ffiAtomicRead: #int8_t>
+ 	^ self integerAt: byteOffset size: 1 signed: true!

Item was added:
+ ----- Method: ByteArray>>int8At:put: (in category '*FFI-Kernel-accessing') -----
+ int8At: byteOffset put: value
+ 	"Store the signed 8-bit integer at byte offset."
+ 	<primitive: #primitiveSignedInt8AtPut module: #SqueakFFIPrims error: ec>
+ 	<ffiAtomicWrite: #int8_t>
+ 	^ self integerAt: byteOffset put: value size: 1 signed: true!

Item was changed:
+ ----- Method: ByteArray>>integerAt:put:size:signed: (in category '*FFI-Kernel-accessing') -----
- ----- 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 platform native order.
- 	- 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: #primitiveFFIIntegerAtPut module: #SqueakFFIPrims>
- 	<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!

Item was changed:
+ ----- Method: ByteArray>>integerAt:size:signed: (in category '*FFI-Kernel-accessing') -----
- ----- 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 platform native order.
- 	- 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."
+ 	<primitive: #primitiveFFIIntegerAt module: #SqueakFFIPrims>
- 	<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!

Item was changed:
+ ----- Method: ByteArray>>pointerAt:length: (in category '*FFI-Kernel-accessing') -----
- ----- 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."
  
  	| pointer startByteOffset |
  	pointer := ExternalAddress basicNew: length.
  	startByteOffset := byteOffset - 1.
  	1 to: length do: [:pointerByteOffset |
  		pointer
  			basicAt: pointerByteOffset
  			put: (self unsignedByteAt: startByteOffset + pointerByteOffset)].
  	^ pointer!

Item was changed:
+ ----- Method: ByteArray>>pointerAt:put:length: (in category '*FFI-Kernel-accessing') -----
- ----- 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."
  
  	| startByteOffset |
  	self assert: [pointer isExternalAddress].
  	startByteOffset := byteOffset - 1.
  	1 to: length do: [:pointerByteOffset |
  		self
  			unsignedByteAt: startByteOffset + pointerByteOffset
  			put: (pointer basicAt: pointerByteOffset)].
  	^ pointer!

Item was changed:
+ ----- Method: ByteArray>>structAt:length: (in category '*FFI-Kernel-accessing') -----
- ----- 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 |
  	self flag: #todo. "mt: Better name #unsignedBytesAt:length:?"
  	value := ByteArray new: length.
  	startByteOffset := byteOffset - 1.
  	1 to: length do: [:valueByteOffset |
  		value
  			unsignedByteAt: valueByteOffset
  			put: (self unsignedByteAt: startByteOffset + valueByteOffset)].
  	^ value!

Item was changed:
+ ----- Method: ByteArray>>structAt:put:length: (in category '*FFI-Kernel-accessing') -----
- ----- 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 |
  	self flag: #todo. "mt: Better name #unsignedBytesAt:put:length:?"
  	startByteOffset := byteOffset - 1.
  	1 to: length do: [:valueByteOffset |
  		self
  			unsignedByteAt: startByteOffset + valueByteOffset
  			put: (value unsignedByteAt:valueByteOffset)].
  	^ value!

Item was changed:
+ ----- Method: ByteArray>>type:at: (in category '*FFI-Kernel-accessing') -----
- ----- Method: ByteArray>>type:at: (in category '*FFI-Kernel') -----
  type: spec at: byteOffset
  	"For convenience, when the receiver needs to filled with a mix of typed contents. See FFICallback for an example."
  	
  	^ (ExternalType lookupType: spec) handle: self at: byteOffset!

Item was changed:
+ ----- Method: ByteArray>>type:at:put: (in category '*FFI-Kernel-accessing') -----
- ----- Method: ByteArray>>type:at:put: (in category '*FFI-Kernel') -----
  type: spec at: byteOffset put: value
  	"For convenience, when the receiver needs to filled with a mix of typed contents. See FFICallback for an example."
  
  	^ (ExternalType lookupType: spec) handle: self at: byteOffset put: value!

Item was added:
+ ----- Method: ByteArray>>uint16At: (in category '*FFI-Kernel-accessing') -----
+ uint16At: byteOffset
+ 	"Answer the signed 16-bit integer at byte offset, in platform native order."
+ 	<primitive: #primitiveSignedInt16At module: #SqueakFFIPrims error: ec>
+ 	<ffiAtomicRead: #uint16_t>
+ 	^ self integerAt: byteOffset size: 2 signed: false!

Item was added:
+ ----- Method: ByteArray>>uint16At:put: (in category '*FFI-Kernel-accessing') -----
+ uint16At: byteOffset put: value
+ 	"Store the unsigned 16-bit integer at byte offset, in platform native order."
+ 	<primitive: #primitiveUnsignedInt16AtPut module: #SqueakFFIPrims error: ec>
+ 	<ffiAtomicWrite: #uint16_t>
+ 	^ self integerAt: byteOffset put: value size: 2 signed: false!

Item was added:
+ ----- Method: ByteArray>>uint32At: (in category '*FFI-Kernel-accessing') -----
+ uint32At: byteOffset
+ 	"Answer the signed 32-bit integer at byte offset, in platform native order."
+ 	<primitive: #primitiveSignedInt32At module: #SqueakFFIPrims error: ec>
+ 	<ffiAtomicRead: #uint32_t>
+ 	^ self integerAt: byteOffset size: 4 signed: false!

Item was added:
+ ----- Method: ByteArray>>uint32At:put: (in category '*FFI-Kernel-accessing') -----
+ uint32At: byteOffset put: value
+ 	"Store the unsigned 32-bit integer at byte offset, in platform native order."
+ 	<primitive: #primitiveUnsignedInt32AtPut module: #SqueakFFIPrims error: ec>
+ 	<ffiAtomicWrite: #uint32_t>
+ 	^ self integerAt: byteOffset put: value size: 4 signed: false!

Item was added:
+ ----- Method: ByteArray>>uint64At: (in category '*FFI-Kernel-accessing') -----
+ uint64At: byteOffset
+ 	"Answer the signed 64-bit integer at byte offset, in platform native order."
+ 	<primitive: #primitiveSignedInt64At module: #SqueakFFIPrims error: ec>
+ 	<ffiAtomicRead: #uint64_t>
+ 	^ self integerAt: byteOffset size: 8 signed: false!

Item was added:
+ ----- Method: ByteArray>>uint64At:put: (in category '*FFI-Kernel-accessing') -----
+ uint64At: byteOffset put: value
+ 	"Store the unsigned 64-bit integer at byte offset, in platform native order."
+ 	<primitive: #primitiveUnsignedInt64AtPut module: #SqueakFFIPrims error: ec>
+ 	<ffiAtomicWrite: #uint64_t>
+ 	^ self integerAt: byteOffset put: value size: 8 signed: false!

Item was added:
+ ----- Method: ByteArray>>uint8At: (in category '*FFI-Kernel-accessing') -----
+ uint8At: byteOffset
+ 	"Answer the unsigned 8-bit integer at byte offset."
+ 	<primitive: #primitiveUnsignedInt8At module: #SqueakFFIPrims error: ec>
+ 	<ffiAtomicRead: #uint8_t>
+ 	^ self integerAt: byteOffset size: 1 signed: false!

Item was added:
+ ----- Method: ByteArray>>uint8At:put: (in category '*FFI-Kernel-accessing') -----
+ uint8At: byteOffset put: value
+ 	"Store the unsigned 8-bit integer at byte offset."
+ 	<primitive: #primitiveUnsignedInt8AtPut module: #SqueakFFIPrims error: ec>
+ 	<ffiAtomicWrite: #uint8_t>
+ 	^ self integerAt: byteOffset put: value size: 1 signed: false!

Item was changed:
+ ----- Method: ByteArray>>unsignedByteAt: (in category '*FFI-Kernel-accessing') -----
- ----- Method: ByteArray>>unsignedByteAt: (in category '*FFI-Kernel') -----
  unsignedByteAt: byteOffset
  	"Same as #byteAt: but different primitive to support ExternalAddress."
+ 	<primitive: #primitiveUnsignedInt8At module: #SqueakFFIPrims error: ec>
- 	
  	^ self integerAt: byteOffset size: 1 signed: false!

Item was changed:
+ ----- Method: ByteArray>>unsignedByteAt:put: (in category '*FFI-Kernel-accessing') -----
- ----- 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!

Item was changed:
+ ----- Method: ByteArray>>zeroMemory: (in category '*FFI-Kernel-accessing') -----
- ----- Method: ByteArray>>zeroMemory: (in category '*FFI-Kernel') -----
  zeroMemory: numBytes
  
+ 	| index size |
+ 	index := 1.
+ 	size := self size - 7.
+ 	[index <= size] whileTrue:
+ 		[self uint64At: index put: 0.
+ 		 index := index + 8].
+ 	size := size + 4. "7 - 3, i.e. self size - 3"
+ 	index <= size ifTrue:
+ 		[self uint32At: index put: 0.
+ 		 index := index + 4].
+ 	size := size + 2. "3 - 1, i.e. self size - 1"
+ 	index <= size ifTrue:
+ 		[self uint16At: index put: 0.
+ 		 index := index + 2].
+ 	index < size ifTrue:
+ 		[self uint8At: index put: 0]!
- 	1  to: numBytes do: [:index |
- 		self unsignedByteAt: index put: 0].!

Item was changed:
  ----- Method: ExternalAddress class>>allocate: (in category 'instance creation') -----
  allocate: byteSize
  	"Primitive. Allocates byteSize bytes on the external heap. Answers an address pointing to those bytes. WARNING bytes might not be zero'ed!!"
+ 	<primitive: #primitiveFFIAllocate module: #SqueakFFIPrims>
- 	<primitive:'primitiveFFIAllocate' module:'SqueakFFIPrims'>
  	
  	self flag: #todo. "mt: Ensure zero'ed memory."
  	^ self primitiveFailed!

Item was changed:
  ----- Method: ExternalAddress class>>loadSymbol:module: (in category 'instance creation') -----
  loadSymbol: moduleSymbol module: module 
+ 	<primitive: #primitiveLoadSymbolFromModule module: #SqueakFFIPrims>
- 	<primitive: 'primitiveLoadSymbolFromModule' module: 'SqueakFFIPrims'>
  	^ self primitiveFailed!

Item was changed:
  ----- Method: ExternalAddress>>asInteger (in category 'arithmetic') -----
  asInteger
  	"Convert address to integer. Change class to not follow the address when reading bytes."
+ 	<primitive: #primitiveExternalAddressAsInteger module: #SqueakFFIPrims>
+ 	| class |
+ 	class := self class.
+ 	^[self changeClassTo: ByteArray.
+ 	  self integerAt: 1 size: self size signed: false]
+ 		ensure: [self changeClassTo: class]!
- 	
- 	| result |
- 	[self changeClassTo: ByteArray.
- 	result := self integerAt: 1 size: self size signed: false]
- 		ensure: [self changeClassTo: ExternalAddress].
- 	
- 	^ result!

Item was changed:
  ----- Method: ExternalAddress>>free (in category 'initialize-release') -----
  free
  	"Primitive. Free the object pointed to on the external heap.
  	Dangerous - may break your system if the receiver hasn't been
  	allocated by ExternalAddress class>>allocate:. No checks are done."
+ 	<primitive: #primitiveFFIFree module: #SqueakFFIPrims>
- 	<primitive:'primitiveFFIFree' module:'SqueakFFIPrims'>
  	^self primitiveFailed!

Item was changed:
  ----- Method: ExternalFunction class>>getLastError (in category 'error handling') -----
  getLastError
  	"Return the last error from an external call.
  	Only valid immediately after the external call failed."
+ 	<primitive: #primitiveFFIGetLastError module: #SqueakFFIPrims>
- 	<primitive: 'primitiveFFIGetLastError' module:'SqueakFFIPrims'>
  	^-1!

Item was changed:
  ----- Method: ExternalFunction>>invokeWithArguments: (in category 'invoking') -----
  invokeWithArguments: argArray
  	"Manually invoke the receiver, representing an external function."
+ 	<primitive: #primitiveCalloutWithArgs module: #SqueakFFIPrims error: ec>
- 	<primitive: 'primitiveCalloutWithArgs' module: 'SqueakFFIPrims' error: ec>
  	^self externalCallFailed!

Item was changed:
  ----- Method: ExternalFunction>>tryInvokeWithArguments: (in category 'invoking') -----
  tryInvokeWithArguments: argArray
  	"Sent from the debugger to simulate an FFI call."
+ 	<primitive: #primitiveCalloutWithArgs module: #SqueakFFIPrims error: ec>
- 	<primitive: 'primitiveCalloutWithArgs' module: 'SqueakFFIPrims' error: ec>
  	
  	^thisContext class primitiveFailTokenFor: ec!

Item was changed:
  ----- Method: ExternalLibrary>>forceLoading (in category 'initialize-release') -----
  forceLoading
  	"Primitive. Force loading the given library.
  	The primitive will fail if the library is not available
  	or if anything is wrong with the receiver."
+ 	<primitive: #primitiveForceLoad module: #SqueakFFIPrims>
- 	<primitive: 'primitiveForceLoad' module:'SqueakFFIPrims'>
  	^self externalCallFailed "The primitive will set the error code"!

Item was changed:
  ----- Method: FFIAtomicReadWriteSend class>>lookupSelectorsFor: (in category 'instance creation') -----
  lookupSelectorsFor: atomicType
- 
  	| result |
+ 	result := { nil. "read selector" nil "write selector" }.
+ 	"Maybe these selectors should be cached in a couple of class variables?"
+ 	(((ByteArray organization listAtCategoryNamed: #'*FFI-Kernel-accessing') sorted: [:s1 :s2| s1 numArgs <= s2 numArgs])
+ 		collect: [:selector| ByteArray compiledMethodAt: selector])
+ 		do: 	[:method |
+ 			(self pragma: (method pragmaAt: #ffiAtomicRead:) selectsAtomicType: atomicType) ifTrue:
+ 				[result at: 1 put: method selector.
+ 				 (result at: 2) ifNotNil: [^result]].
+ 			(self pragma: (method pragmaAt: #ffiAtomicWrite:) selectsAtomicType: atomicType) ifTrue:
+ 				[result at: 2 put: method selector.
+ 				 (result at: 1) ifNotNil: [^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"]].
  			
+ 	self error: 'Could not find selectors for both read and write!!'.
+ 	^result!
- 	(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 class>>pragma:selectsAtomicType: (in category 'instance creation') -----
+ pragma: pragmaOrNil selectsAtomicType: atomicType
+ 	| pragmaLiteral |
+ 	pragmaOrNil ifNil: [^false].
+ 	pragmaLiteral := pragmaOrNil argumentAt: 1.
+ 	pragmaLiteral isArray ifTrue:
+ 		[^pragmaLiteral anySatisfy:
+ 			[:typeName| (ExternalType atomicTypeNamed: typeName) = atomicType]].
+ 	^(ExternalType atomicTypeNamed: pragmaLiteral) = atomicType!



More information about the Squeak-dev mailing list