[squeak-dev] The Inbox: FFI-Kernel-tonyg.223.mcz

commits at source.squeak.org commits at source.squeak.org
Wed Dec 15 20:18:51 UTC 2021


A new version of FFI-Kernel was added to project The Inbox:
http://source.squeak.org/inbox/FFI-Kernel-tonyg.223.mcz

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

Name: FFI-Kernel-tonyg.223
Author: tonyg
Time: 15 December 2021, 9:18:29.517342 pm
UUID: f44fab66-daea-406f-8c1d-9ea530ea8eaa
Ancestors: FFI-Kernel-mt.222

Repair typo in ExternalArrayType>>writeFieldAt:with: -- 'stuctAt:' should be 'structAt:'

==================== Snapshot ====================

SystemOrganization addCategory: #'FFI-Kernel'!
SystemOrganization addCategory: #'FFI-Kernel-Support'!

(PackageInfo named: 'FFI-Kernel') postscript: '"Update for array classes. No type codes for signed char types anymore."
ExternalType initialize...'!

----- Method: DoubleWordArray>>contentType (in category '*FFI-Kernel-external data') -----
contentType

	^ ExternalType uint64_t!

----- Method: DoubleWordArray>>uint64At: (in category '*FFI-Kernel-accessing') -----
uint64At: byteOffset
	"Backstop for compatibility with handle-based access. Raw-bits arrays are their own handle. See #getHandle and ExternalType >> #handle:at:."

	^ self atByteOffset: byteOffset!

----- Method: DoubleWordArray>>uint64At:put: (in category '*FFI-Kernel-accessing') -----
uint64At: byteOffset put: value
	"Backstop for compatibility with handle-based access. Raw-bits arrays are their own handle. See #getHandle and ExternalType >> #handle:at:."

	^ self atByteOffset: byteOffset put: value!

----- Method: Float32Array>>contentType (in category '*FFI-Kernel-external data') -----
contentType

	^ ExternalType float!

----- Method: Float32Array>>floatAtByteOffset: (in category '*FFI-Kernel-accessing') -----
floatAtByteOffset: byteOffset
	"Backstop for compatibility with handle-based access. Raw-bits arrays are their own handle. See #getHandle and ExternalType >> #handle:at:."
	
	^ self atByteOffset: byteOffset!

----- Method: Float32Array>>floatAtByteOffset:put: (in category '*FFI-Kernel-accessing') -----
floatAtByteOffset: byteOffset put: value
	"Backstop for compatibility with handle-based access. Raw-bits arrays are their own handle. See #getHandle and ExternalType >> #handle:at:put:."
	
	^ self atByteOffset: byteOffset put: value!

----- Method: ByteArray>>booleanAt: (in category '*FFI-Kernel-examples') -----
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!

----- Method: ByteArray>>booleanAt:put: (in category '*FFI-Kernel-examples') -----
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!

----- Method: ByteArray>>contentType (in category '*FFI-Kernel-external data') -----
contentType

	^ ExternalType uint8_t!

----- Method: ByteArray>>doubleAt: (in category '*FFI-Kernel-accessing - float') -----
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> -- See #doubleAtByteOffset:."
	"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!

----- Method: ByteArray>>doubleAt:put: (in category '*FFI-Kernel-accessing - float') -----
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> -- See doubleAtByteOffset:put:."
	"Examples:
		ExternalType double allocate value: 123.4567890; explore
		ExternalType double allocate value: 0.0001; explore
	"
	^ self primitiveFailed!

----- Method: ByteArray>>doubleAtByteOffset: (in category '*FFI-Kernel-accessing - float') -----
doubleAtByteOffset: byteOffset	
	"Duplicates #doubleAt: for compatibility reasons with Alien and 3DTransform. See comment in #doubleAt:."
	<primitive: #primitiveFFIDoubleAt module: #SqueakFFIPrims>
	<ffiAtomicRead: #double>
	^ self primitiveFailed!

----- Method: ByteArray>>doubleAtByteOffset:put: (in category '*FFI-Kernel-accessing - float') -----
doubleAtByteOffset: byteOffset put: value
	"Duplicates #doubleAt:put: for compatibility reasons with Alien and 3DTransform. See comment in #doubleAt:put:."
	<primitive: #primitiveFFIDoubleAtPut module: #SqueakFFIPrims>
	<ffiAtomicWrite: #double>
	^ self primitiveFailed!

----- Method: ByteArray>>ffiEqual: (in category '*FFI-Kernel-comparing') -----
ffiEqual: other

	^ self = other withoutReadWriter!

----- Method: ByteArray>>ffiIdentical: (in category '*FFI-Kernel-comparing') -----
ffiIdentical: other

	^ self == other withoutReadWriter!

----- Method: ByteArray>>floatAt: (in category '*FFI-Kernel-accessing - float') -----
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> -- See #floatAtByteOffset:."
	"Examples:
		ExternalType float handle: #[ 0 0 0 255 ] at: 1.
		ExternalType float handle: #[ 0 0 255 ] at: 1. --- Error.
	"
	^ self primitiveFailed!

----- Method: ByteArray>>floatAt:put: (in category '*FFI-Kernel-accessing - float') -----
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> -- See floatAtByteOffset:put:."
	"Examples:
		ExternalType float allocate value: 123.4567890; explore
		ExternalType float allocate value: 0.0001; explore
	"
	^ self primitiveFailed!

----- Method: ByteArray>>floatAtByteOffset: (in category '*FFI-Kernel-accessing - float') -----
floatAtByteOffset: byteOffset
	"Duplicates #floatAt: for compatibility reasons with Alien and 3DTransform. See comment in #floatAt:."
	<primitive: #primitiveFFIFloatAt module: #SqueakFFIPrims>
	<ffiAtomicRead: #float>
	^ self primitiveFailed!

----- Method: ByteArray>>floatAtByteOffset:put: (in category '*FFI-Kernel-accessing - float') -----
floatAtByteOffset: byteOffset put: value
	"Duplicates #floatAt:put: for compatibility reasons with Alien and 3DTransform. See comment in #floatAt:put:."
	<primitive: #primitiveFFIFloatAtPut module: #SqueakFFIPrims>
	<ffiAtomicWrite: #float>
	^ self primitiveFailed!

----- Method: ByteArray>>int16At: (in category '*FFI-Kernel-accessing - integer') -----
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!

----- Method: ByteArray>>int16At:put: (in category '*FFI-Kernel-accessing - integer') -----
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!

----- Method: ByteArray>>int32At: (in category '*FFI-Kernel-accessing - integer') -----
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!

----- Method: ByteArray>>int32At:put: (in category '*FFI-Kernel-accessing - integer') -----
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!

----- Method: ByteArray>>int64At: (in category '*FFI-Kernel-accessing - integer') -----
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!

----- Method: ByteArray>>int64At:put: (in category '*FFI-Kernel-accessing - integer') -----
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!

----- Method: ByteArray>>int8At: (in category '*FFI-Kernel-accessing - integer') -----
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!

----- Method: ByteArray>>int8At:put: (in category '*FFI-Kernel-accessing - integer') -----
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!

----- Method: ByteArray>>integerAt:put:size:signed: (in category '*FFI-Kernel-accessing - integer') -----
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.
	- 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>
	<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!

----- Method: ByteArray>>integerAt:size:signed: (in category '*FFI-Kernel-accessing - integer') -----
integerAt: byteOffset size: nBytes signed: aBoolean
	"Primitive. Return an integer of nBytes size from the receiver.
	- BYTE ORDER is platform native order.
	- 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>
	<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!

----- Method: ByteArray>>longPointerAt: (in category '*FFI-Kernel-deprecated') -----
longPointerAt: byteOffset
	"Answer an 8-byte pointer object stored at the given byte address"

	self deprecated: 'Use #pointerAt:length:'.
	^ self pointerAt: byteOffset length: 8!

----- Method: ByteArray>>longPointerAt:put: (in category '*FFI-Kernel-deprecated') -----
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!

----- Method: ByteArray>>memoryAt:length: (in category '*FFI-Kernel-accessing') -----
memoryAt: byteOffset length: numBytes

	| index size handle startByteOffset |
	handle := ByteArray new: numBytes.
	startByteOffset := byteOffset - 1.
	index := 1.
	size := numBytes - 7.
	[index <= size] whileTrue:
		[handle uint64At: index put: (self uint64At: startByteOffset + index).
		 index := index + 8].
	size := size + 4. "7 - 3, i.e. numBytes - 3"
	index <= size ifTrue:
		[handle uint32At: index put: (self uint32At: startByteOffset + index).
		 index := index + 4].
	size := size + 2. "3 - 1, i.e. numBytes - 1"
	index <= size ifTrue:
		[handle uint16At: index put: (self uint16At: startByteOffset + index).
		 index := index + 2].
	size := size + 1.
	index <= size ifTrue:
		[handle uint8At: index put: (self uint8At: startByteOffset + index)].
	^ handle!

----- Method: ByteArray>>memoryAt:put:length: (in category '*FFI-Kernel-accessing') -----
memoryAt: byteOffset put: handle length: numBytes

	| index size startByteOffset |
	startByteOffset := byteOffset - 1.
	index := 1.
	size := numBytes - 7.
	[index <= size] whileTrue:
		[self uint64At: startByteOffset + index put: (handle uint64At: index).
		 index := index + 8].
	size := size + 4. "7 - 3, i.e. numBytes - 3"
	index <= size ifTrue:
		[self uint32At: startByteOffset + index put: (handle uint32At: index).
		 index := index + 4].
	size := size + 2. "3 - 1, i.e. numBytes - 1"
	index <= size ifTrue:
		[self uint16At: startByteOffset + index put: (handle uint16At: index).
		 index := index + 2].
	size := size + 1.
	index <= size ifTrue:
		[self uint8At: startByteOffset + index put: (handle uint8At: index)].
	^ handle!

----- Method: ByteArray>>pointerAt: (in category '*FFI-Kernel-examples') -----
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 pointer handle: self at: byteOffset!

----- Method: ByteArray>>pointerAt:length: (in category '*FFI-Kernel-accessing') -----
pointerAt: byteOffset length: length
	"Return a pointer of the given length starting at the indicated byte offset."

	^ ExternalAddress fromInteger: (self integerAt: byteOffset size: length signed: false)!

----- Method: ByteArray>>pointerAt:put: (in category '*FFI-Kernel-examples') -----
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 pointer handle: self at: byteOffset put: value!

----- Method: ByteArray>>pointerAt:put:length: (in category '*FFI-Kernel-accessing') -----
pointerAt: byteOffset put: externalAddress length: length
	"Store a pointer of the given length starting at the indicated byte offset."

	self integerAt: byteOffset put: externalAddress asInteger size: length signed: false.
	^ externalAddress!

----- Method: ByteArray>>shortPointerAt: (in category '*FFI-Kernel-deprecated') -----
shortPointerAt: byteOffset
	"Answer a 4-byte pointer object stored at the given byte address"

	self deprecated: 'Use #pointerAt:length:'.
	^ self pointerAt: byteOffset length: 4!

----- Method: ByteArray>>shortPointerAt:put: (in category '*FFI-Kernel-deprecated') -----
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!

----- Method: ByteArray>>signedCharAt: (in category '*FFI-Kernel-examples') -----
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 char8_t handle: self at: byteOffset!

----- Method: ByteArray>>signedCharAt:put: (in category '*FFI-Kernel-examples') -----
signedCharAt: byteOffset put: aCharacter

	^ ExternalType char8_t handle: self at: byteOffset put: aCharacter!

----- Method: ByteArray>>signedLongAt: (in category '*FFI-Kernel-examples') -----
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."
	<primitive: #primitiveSignedInt32At module: #SqueakFFIPrims error: ec>
	^ ExternalType int32_t handle: self at: byteOffset!

----- Method: ByteArray>>signedLongAt:put: (in category '*FFI-Kernel-examples') -----
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."
	<primitive: #primitiveSignedInt32AtPut module: #SqueakFFIPrims error: ec>
	^ ExternalType int32_t handle: self at: byteOffset put: value!

----- Method: ByteArray>>signedLongLongAt: (in category '*FFI-Kernel-examples') -----
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."
	<primitive: #primitiveSignedInt64At module: #SqueakFFIPrims error: ec>
	^ ExternalType int64_t handle: self at: byteOffset!

----- Method: ByteArray>>signedLongLongAt:put: (in category '*FFI-Kernel-examples') -----
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."
	<primitive: #primitiveSignedInt64AtPut module: #SqueakFFIPrims error: ec>
	^ ExternalType int64_t handle: self at: byteOffset put: value!

----- Method: ByteArray>>signedShortAt: (in category '*FFI-Kernel-examples') -----
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."
	<primitive: #primitiveSignedInt16At module: #SqueakFFIPrims error: ec>
	^ ExternalType int16_t handle: self at: byteOffset!

----- Method: ByteArray>>signedShortAt:put: (in category '*FFI-Kernel-examples') -----
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."
	<primitive: #primitiveSignedInt16AtPut module: #SqueakFFIPrims error: ec>
	^ ExternalType int16_t handle: self at: byteOffset put: value!

----- Method: ByteArray>>structAt:length: (in category '*FFI-Kernel-accessing') -----
structAt: byteOffset length: length
	"Return a structure of the given length starting at the indicated byte offset."

	^ self memoryAt: byteOffset length: length!

----- Method: ByteArray>>structAt:put:length: (in category '*FFI-Kernel-accessing') -----
structAt: byteOffset put: value length: length
	"Store a structure of the given length starting at the indicated byte offset."
	
	^ self memoryAt: byteOffset put: value length: length!

----- Method: ByteArray>>testInt32At: (in category '*FFI-Kernel-accessing - integer') -----
testInt32At: byteOffset
	"Use this to check whether your FFI plugin supports the specific integer primitives."
	<primitive: #primitiveSignedInt32At module: #SqueakFFIPrims error: ec>
	^ nil "To make check faster than via #primitiveFailed exception handler."!

----- Method: ByteArray>>type:at: (in category '*FFI-Kernel-accessing') -----
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!

----- Method: ByteArray>>type:at:put: (in category '*FFI-Kernel-accessing') -----
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!

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

----- Method: ByteArray>>uint16At:put: (in category '*FFI-Kernel-accessing - integer') -----
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!

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

----- Method: ByteArray>>uint32At:put: (in category '*FFI-Kernel-accessing - integer') -----
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!

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

----- Method: ByteArray>>uint64At:put: (in category '*FFI-Kernel-accessing - integer') -----
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!

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

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

----- Method: ByteArray>>unsignedByteAt: (in category '*FFI-Kernel-accessing') -----
unsignedByteAt: byteOffset
	"Same as #byteAt: but different primitive to support ExternalAddress."

	<primitive: #primitiveUnsignedInt8At module: #SqueakFFIPrims error: ec>
	^ self integerAt: byteOffset size: 1 signed: false!

----- Method: ByteArray>>unsignedByteAt:put: (in category '*FFI-Kernel-accessing') -----
unsignedByteAt: byteOffset put: value
	"Same as #byteAt: but different primitive to support ExternalAddress."

	<primitive: #primitiveUnsignedInt8AtPut module: #SqueakFFIPrims error: ec>
	^ self integerAt: byteOffset put: value size: 1 signed: false!

----- Method: ByteArray>>unsignedCharAt: (in category '*FFI-Kernel-examples') -----
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 uchar8_t handle: self at: byteOffset!

----- Method: ByteArray>>unsignedCharAt:put: (in category '*FFI-Kernel-examples') -----
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 uchar8_t handle: self at: byteOffset put: aCharacter!

----- Method: ByteArray>>unsignedLongAt: (in category '*FFI-Kernel-examples') -----
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."
	<primitive: #primitiveUnsignedInt32At module: #SqueakFFIPrims error: ec>
	^ ExternalType uint32_t handle: self at: byteOffset!

----- Method: ByteArray>>unsignedLongAt:put: (in category '*FFI-Kernel-examples') -----
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."
	<primitive: #primitiveUnsignedInt32AtPut module: #SqueakFFIPrims error: ec>
	^ ExternalType uint32_t handle: self at: byteOffset put: value!

----- Method: ByteArray>>unsignedLongLongAt: (in category '*FFI-Kernel-examples') -----
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."
	<primitive: #primitiveUnsignedInt64At module: #SqueakFFIPrims error: ec>
	^ ExternalType uint64_t handle: self at: byteOffset!

----- Method: ByteArray>>unsignedLongLongAt:put: (in category '*FFI-Kernel-examples') -----
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."
	<primitive: #primitiveUnsignedInt64AtPut module: #SqueakFFIPrims error: ec>
	^ ExternalType uint64_t handle: self at: byteOffset put: value!

----- Method: ByteArray>>unsignedShortAt: (in category '*FFI-Kernel-examples') -----
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."
	<primitive: #primitiveUnsignedInt16At module: #SqueakFFIPrims error: ec>
	^ ExternalType uint16_t handle: self at: byteOffset!

----- Method: ByteArray>>unsignedShortAt:put: (in category '*FFI-Kernel-examples') -----
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."
	<primitive: #primitiveUnsignedInt16AtPut module: #SqueakFFIPrims error: ec>
	^ ExternalType uint16_t handle: self at: byteOffset put: value!

----- Method: ByteArray>>withoutReadWriter (in category '*FFI-Kernel-comparing') -----
withoutReadWriter
	"Workaround to make #= and #== work through ByteArrayReadWriter."
	
	^ self!

----- Method: ByteArray>>zeroMemory: (in category '*FFI-Kernel-accessing') -----
zeroMemory: numBytes
	"Zero numBytes in the receiver. Try to set multiple bytes at once if possible. Simple algorithm looks as follows:
	
		1  to: numBytes do: [:index |
			self unsignedByteAt: index put: 0].
	"

	| index size |
	index := 1.
	size := numBytes - 7.
	[index <= size] whileTrue:
		[self uint64At: index put: 0.
		 index := index + 8].
	size := size + 4. "7 - 3, i.e. numBytes - 3"
	index <= size ifTrue:
		[self uint32At: index put: 0.
		 index := index + 4].
	size := size + 2. "3 - 1, i.e. numBytes - 1"
	index <= size ifTrue:
		[self uint16At: index put: 0.
		 index := index + 2].
	size := size + 1.
	index <= size ifTrue:
		[self uint8At: index put: 0]!

ByteArray variableByteSubclass: #ExternalAddress
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'FFI-Kernel-Support'!

!ExternalAddress commentStamp: '<historical>' prior: 0!
An ExternalAddress is an opaque handle to objects outside Smalltalk memory (e.g., a pointer).!

----- Method: ExternalAddress class>>allBeNull (in category 'system startup') -----
allBeNull
	"If starting the image afresh all external addresses should be zero."

	self allInstancesDo: [:address | address beNull].!

----- Method: ExternalAddress class>>allBeNullAndResize (in category 'system startup') -----
allBeNullAndResize
	"Null all instances by becomming to new (and hence null) pointers of the platform's current word size."

	| instances wordSize |
	instances := self allInstances.
	wordSize := self wordSize.
	instances elementsForwardIdentityTo:
		(instances collect: [:address | self basicNew: wordSize]).!

----- 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>
	
	self flag: #todo. "mt: Ensure zero'ed memory."
	^ self primitiveFailed!

----- Method: ExternalAddress class>>allocateZero: (in category 'instance creation') -----
allocateZero: byteSize

	^ (self allocate: byteSize)
		zeroMemory: byteSize;
		yourself!

----- Method: ExternalAddress class>>fromAddress:movedBy: (in category 'support') -----
fromAddress: externalAddress movedBy: delta
	"Do pointer arithmetic. This might better be done in the plugin."

	delta = 0 ifTrue: [^ externalAddress].
	^ self fromInteger: externalAddress asInteger + delta!

----- Method: ExternalAddress class>>fromInteger: (in category 'instance creation') -----
fromInteger: anInteger
	"Interpret the given integer as an address pointing to an external memory area.
	 Answer an ExternalAddress to that address."
	<primitive: #primitiveExternalAddressFromInteger module: #SqueakFFIPrims>
	| bytes |
	bytes := ByteArray basicNew: self wordSize.
	bytes integerAt: 1 put: anInteger size: bytes size signed: false.
	^ bytes changeClassTo: self!

----- Method: ExternalAddress class>>gcallocate: (in category 'instance creation') -----
gcallocate: byteSize
	"Primitive. Allocate an object on the external heap.
	The external memory will be freed when i am garbage collected.
	BEWARE: there should be no copy of self, nor any pointer to a sub part..."
	
	| externalAddress |
	externalAddress := self allocate: byteSize.
	self finalizationRegistry add: externalAddress.
	^externalAddress!

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

----- Method: ExternalAddress class>>new (in category 'instance creation') -----
new
	"External addresses are either four or eight bytes long."
	^super new: self wordSize!

----- Method: ExternalAddress class>>new: (in category 'instance creation') -----
new: n
	"Only create ExternalAddresses of the right size."
	^n = self wordSize
		ifTrue: [super new: n]
		ifFalse: [self shouldNotImplement]!

----- Method: ExternalAddress class>>platformChangedFrom:to: (in category 'system startup') -----
platformChangedFrom: lastPlatform to: currentPlatform

	lastPlatform wordSize = currentPlatform wordSize
		ifTrue: [self allBeNull]
		ifFalse: [self allBeNullAndResize].!

----- Method: ExternalAddress class>>wordSize (in category 'constants') -----
wordSize

	^ FFIPlatformDescription current wordSize!

----- Method: ExternalAddress>>+ (in category 'arithmetic') -----
+ offset
	"Answer a new address that is offset by the given number of bytes."

	^ ExternalAddress fromAddress: self movedBy: offset!

----- 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]!

----- Method: ExternalAddress>>beNull (in category 'initialize-release') -----
beNull
	"Make the receiver a NULL pointer"
	self atAllPut: 0.!

----- 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."
	
	^ self unsignedByteAt: byteOffset!

----- 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!

----- Method: ExternalAddress>>clone (in category 'copying') -----
clone

	<primitive: 148>
	self primitiveFailed!

----- Method: ExternalAddress>>finalize (in category 'initialize-release') -----
finalize
	"I am an executor (a copy) of an ExternalAddress that was just garbage collected.
	I must finalize. my mission is to free memory"
	self isNull ifTrue: [^self].
	self free!

----- 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>
	^self primitiveFailed!

----- Method: ExternalAddress>>isExternalAddress (in category 'testing') -----
isExternalAddress
	"Return true if the receiver describes the address of an object in the outside world"
	^true!

----- Method: ExternalAddress>>isNull (in category 'testing') -----
isNull
	"Answer true if I am a null pointer"
	1 to: self size do:[:i| (self at: i) = 0 ifFalse:[^false]].
	^true!

----- Method: ExternalAddress>>memoryAt:length: (in category 'accessing') -----
memoryAt: byteOffset length: length
	"Overwritten to not read bytes but just move the pointer. Ignore the length."
	
	^ ExternalAddress fromAddress: self movedBy: byteOffset - 1!

----- Method: ExternalAddress>>printOn: (in category 'printing') -----
printOn: aStream
	"print this as a hex address ('@ 16rFFFFFFFF') to distinguish it from ByteArrays"

	aStream
		nextPutAll: '@ ';
		nextPutAll: (self asInteger
			storeStringBase: 16
			length: 3 "16r" + (self class wordSize * 2)
			padded: true)!

----- Method: ExternalAddress>>shallowCopy (in category 'copying') -----
shallowCopy
	"Re-implemented to avoid superclass call to #new:"
	"But superclass's shallowCopy sends basicNew: and basicNew: is ok. eem 2/21/2016 15:31"
	^self clone!

----- Method: ExternalAddress>>signedByteAt: (in category 'examples') -----
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!

----- Method: ExternalAddress>>signedByteAt:put: (in category 'examples') -----
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!

----- Method: ExternalAddress>>zeroMemory (in category 'external data') -----
zeroMemory
	"Overwritten for robustness. See RawBitsArray >> #zeroMemory."
	
	self shouldNotImplement. "Use #zeroMemory: instead."!

----- Method: SignedDoubleByteArray>>contentType (in category '*FFI-Kernel-external data') -----
contentType

	^ ExternalType int16_t!

----- Method: SignedDoubleByteArray>>int16At: (in category '*FFI-Kernel-accessing') -----
int16At: byteOffset
	"Backstop for compatibility with handle-based access. Raw-bits arrays are their own handle. See #getHandle and ExternalType >> #handle:at:."

	^ self atByteOffset: byteOffset!

----- Method: SignedDoubleByteArray>>int16At:put: (in category '*FFI-Kernel-accessing') -----
int16At: byteOffset put: value
	"Backstop for compatibility with handle-based access. Raw-bits arrays are their own handle. See #getHandle and ExternalType >> #handle:at:."

	^ self atByteOffset: byteOffset put: value!

----- Method: CompiledMethod>>externalLibraryFunction (in category '*FFI-Kernel') -----
externalLibraryFunction
	"Answers the external library function that will be called when evaluating this method."

	| result |
	^ self numLiterals > 0 ifTrue:
		[(result := self literalAt: 1) class == ExternalLibraryFunction ifTrue: [result]]!

----- Method: CompiledMethod>>externalLibraryName (in category '*FFI-Kernel') -----
externalLibraryName
	"Try to answer the effective name of the external library involved. Might be ambiguous for external libraries if function's module was set, too, and handle not null."
	
	^ self externalLibraryFunction ifNotNil: [:extFun | 
		self methodClass
			ifNil: [extFun module "Method not installed. Rely on external function data."]
			ifNotNil: [:extLib |
				(extLib inheritsFrom: ExternalLibrary)
					ifFalse: [extFun module "Class is no external library. Rely on external function data."]
					ifTrue: [
						extFun module
							ifNil: [extLib moduleName "External function has no data. Rely on external library data."]
							ifNotNil: [:extFunModName |
								extLib moduleName
									ifNil: [extFunModName "External library has no data. Rely on external function data."]
									ifNotNil: [:extLibModName |
										"Now we have two options: module name from function or from library."
										extFun isNull
											ifTrue: [extFunModName "Function has higher priority than library on first call."]
											ifFalse: [ {extFunModName. extLibModName} "We cannot know. It is likely to be from the function's module name. So put that first."]]]]]]!

----- Method: CompiledMethod>>externalLibraryName: (in category '*FFI-Kernel') -----
externalLibraryName: libraryName
	"Reset the library to look for the external function. Also reset the function's handle in case it has been called before. The next call should definitely go to the new library."
	
	^ self externalLibraryFunction
		ifNotNil: [:extFun |
			extFun setModule: libraryName.
			self flag: #todo. "mt: Maybe actually #free the handle here?"
			extFun getHandle beNull]!

----- Method: SignedByteArray>>contentType (in category '*FFI-Kernel-external data') -----
contentType

	^ ExternalType int8_t!

----- Method: SignedByteArray>>int8At: (in category '*FFI-Kernel-accessing') -----
int8At: byteOffset
	"Backstop for compatibility with handle-based access. Raw-bits arrays are their own handle. See #getHandle and ExternalType >> #handle:at:."

	^ self atByteOffset: byteOffset!

----- Method: SignedByteArray>>int8At:put: (in category '*FFI-Kernel-accessing') -----
int8At: byteOffset put: value
	"Backstop for compatibility with handle-based access. Raw-bits arrays are their own handle. See #getHandle and ExternalType >> #handle:at:."

	^ self atByteOffset: byteOffset put: value!

----- Method: WideString>>contentType (in category '*FFI-Kernel-external data') -----
contentType

	^ ExternalType uchar32_t!

----- Method: WideString>>uint32At: (in category '*FFI-Kernel-accessing') -----
uint32At: byteOffset
	"Backstop for compatibility with handle-based access. Raw-bits arrays are their own handle. See #getHandle and ExternalType >> #handle:at:."

	^ self atByteOffset: byteOffset!

----- Method: WideString>>uint32At:put: (in category '*FFI-Kernel-accessing') -----
uint32At: byteOffset put: value
	"Backstop for compatibility with handle-based access. Raw-bits arrays are their own handle. See #getHandle and ExternalType >> #handle:at:."

	^ self atByteOffset: byteOffset put: value asCharacter!

----- Method: DoubleByteArray>>contentType (in category '*FFI-Kernel-external data') -----
contentType

	^ ExternalType uint16_t!

----- Method: DoubleByteArray>>uint16At: (in category '*FFI-Kernel-accessing') -----
uint16At: byteOffset
	"Backstop for compatibility with handle-based access. Raw-bits arrays are their own handle. See #getHandle and ExternalType >> #handle:at:."

	^ self atByteOffset: byteOffset!

----- Method: DoubleByteArray>>uint16At:put: (in category '*FFI-Kernel-accessing') -----
uint16At: byteOffset put: value
	"Backstop for compatibility with handle-based access. Raw-bits arrays are their own handle. See #getHandle and ExternalType >> #handle:at:."

	^ self atByteOffset: byteOffset put: value!

----- Method: Parser>>apicall (in category '*FFI-Kernel') -----
apicall
	<pragmaParser>
	^ self externalFunctionDeclaration!

----- Method: Parser>>callback (in category '*FFI-Kernel') -----
callback
	<pragmaParser>
	
	| descriptorClass retType externalName args argType |
	descriptorClass := self environment classNamed: #ExternalFunction.
	"Parse return type"
	self advance.
	retType := self externalType: descriptorClass.
	retType == nil ifTrue:[^self expected:'return type'].
	"Parse function name or index"
	externalName := here.

	(self match: #leftParenthesis) ifFalse:[^self expected:'function pointer (*)'].
	(self matchToken: #*) ifFalse:[^self expected:'function pointer (*)'].
	(self match: #rightParenthesis) ifFalse:[^self expected:'function pointer (*)'].

	(self match: #leftParenthesis) ifFalse:[^self expected:'argument list'].
	args := WriteStream on: Array new.
	[self match: #rightParenthesis] whileFalse:[
		argType := self externalType: descriptorClass.
		argType == nil ifTrue:[^self expected:'argument'].
		argType isVoid & argType isPointerType not ifFalse:[args nextPut: argType]].

	self addPragma: (Pragma keyword: #callback: arguments: {{retType}, args contents}).
	^true!

----- Method: Parser>>cdecl (in category '*FFI-Kernel') -----
cdecl
	<pragmaParser>
	^ self externalFunctionDeclaration!

----- Method: Parser>>externalFunctionDeclaration (in category '*FFI-Kernel') -----
externalFunctionDeclaration
	"Parse the function declaration for a call to an external library.
	
	(1) Create an instance of ExternalLibraryFunction and install it as first literal.
	(2) Add a pragma to primitive call 120.
	"
	| descriptorClass callType modifier retType externalName args argType module fn |
	descriptorClass := cue environment
		valueOf: #ExternalFunction 
		ifAbsent: [^ false].
	callType := descriptorClass callingConventionFor: here.
	callType == nil ifTrue:[^false].
	[modifier := descriptorClass callingConventionModifierFor: token.
	 modifier notNil] whileTrue:
		[self advance.
		 callType := callType bitOr: modifier].
	"Parse return type"
	self advance.
	retType := self externalType: descriptorClass.
	retType == nil ifTrue:[^self expected:'return type'].
	"Parse function name or index"
	externalName := here.
	(self match: #number)
		ifFalse: [ "Consume all tokens as function name"
			self advance.
			externalName := externalName asSymbol].
	(self match: #leftParenthesis) ifFalse:[^self expected:'argument list'].
	args := WriteStream on: Array new.
	[self match: #rightParenthesis] whileFalse:[
		argType := self externalType: descriptorClass.
		argType == nil ifTrue:[^self expected:'argument'].
		argType isVoid & argType isPointerType not ifFalse:[args nextPut: argType]].
	(self matchToken: 'module:') ifTrue:[
		module := here.
		(self match: #string) ifFalse:[^self expected: 'String'].
		module := module asSymbol].
	
	self environment at: #ExternalLibraryFunction ifPresent:[:xfn|
		fn := xfn name: externalName 
				module: module 
				callType: callType
				returnType: retType
				argumentTypes: args contents.
		self allocateLiteral: fn.
		fn beWritableObject. "Undo the read-only setting in litIndex:"].
	(self matchToken: 'error:')
		ifTrue:
			[| errorCodeVariable |
			 errorCodeVariable := here.
			(hereType == #string
			 or: [hereType == #word]) ifFalse:[^self expected: 'error code (a variable or string)'].
			 self advance.
			 self addPragma: (Pragma keyword: #primitive:error: arguments: (Array with: 120 with: errorCodeVariable)).
			 fn ifNotNil: [fn setErrorCodeName: errorCodeVariable]]
		ifFalse:
			[self addPragma: (Pragma keyword: #primitive: arguments: #(120))].
	^true!

----- Method: Parser>>externalType: (in category '*FFI-Kernel') -----
externalType: descriptorClass
	"Parse and return an external type. Ignore leading comma and 'const'."

	| xType typeName isArrayType tokenString |
	self matchToken: ','.
	self matchToken: 'const'.
	typeName := here. "Note that pointer token is not yet parsed!!"
	self advance.
	(isArrayType := self matchToken: $[)
		ifTrue: [
			(self matchToken: $])
				ifTrue: [typeName := typeName, '[]']
				ifFalse: [
					typeName := typeName, '[', here, ']'.
					self advance.
					(self matchToken: $]) ifFalse: [^ self expected: 'closing bracket']]].
	(xType := descriptorClass typeNamed: typeName)
		ifNil: [
			"Raise an error if user is there"
			self interactive ifTrue: [^nil].
			"otherwise go over it silently -- use an unknown struct type"
			xType := descriptorClass newTypeNamed: typeName].
	isArrayType ifTrue: [
		xType := xType asPointerType].
	self flag: #todo. "mt: Extra commas are currently merged with pointer indicator as a single token."
	tokenString := here asString.
	^ (tokenString first == $*)
		ifTrue: [self advance. xType asPointerType]
		ifFalse:[(tokenString beginsWith: '**')
			ifTrue: [self advance. xType asPointerToPointerType]
			ifFalse: [xType]]!

----- Method: Character class>>zero (in category '*FFI-Kernel') -----
zero
	"See ExternalStructure >> #zeroMemory."
	
	^ Character value: 0!

----- Method: SignedIntegerArray>>integerAt:put:size:signed: (in category '*FFI-Kernel-accessing') -----
integerAt: byteOffset put: value size: nBytes signed: aBoolean
	"Backstop for compatibility with handle-based access. Raw-bits arrays are their own handle. See #getHandle and ExternalType >> #handle:at:put:."
	
	^ self atByteOffset: byteOffset put: value!

----- Method: SignedIntegerArray>>integerAt:size:signed: (in category '*FFI-Kernel-accessing') -----
integerAt: byteOffset size: nBytes signed: aBoolean
	"Backstop for compatibility with handle-based access. Raw-bits arrays are their own handle. See #getHandle and ExternalType >> #handle:at:."
	
	^ self atByteOffset: byteOffset!

MessageSend subclass: #FFIAtomicReadWriteSend
	instanceVariableNames: 'byteSize'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'FFI-Kernel-Support'!

!FFIAtomicReadWriteSend commentStamp: 'mt 8/6/2021 16:16' prior: 0!
I am a message send for reading and writing atomic values from and to byte arrays or external addresses. I can be used for all direct mappings from atomic type to primitive send such as #float, #double, and #int32_t.

I can help with code generation through #template.

Take a look at ExternalType class >> #initializeAtomicSends.!

FFIAtomicReadWriteSend subclass: #BooleanReadWriteSend
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'FFI-Kernel-Support'!

!BooleanReadWriteSend commentStamp: 'mt 8/6/2021 16:15' 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.!

----- Method: BooleanReadWriteSend class>>fromType: (in category 'instance creation') -----
fromType: type

	^ super fromType: ExternalType byte!

----- Method: BooleanReadWriteSend>>handle:at: (in category 'evaluating') -----
handle: handle at: byteOffset

	^ (super handle: handle at: byteOffset) ~= 0!

----- 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!

----- Method: BooleanReadWriteSend>>template (in category 'compiling') -----
template

	^ self isReading
		ifTrue: ['(', super template, ') ~= 0']
		ifFalse: [super template copyReplaceAll: '{3}' with: '({3} ifTrue: [1] ifFalse: [0])']!

FFIAtomicReadWriteSend subclass: #CharacterReadWriteSend
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'FFI-Kernel-Support'!

!CharacterReadWriteSend commentStamp: 'mt 8/6/2021 16:15' 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.!

----- Method: CharacterReadWriteSend class>>fromType: (in category 'instance creation') -----
fromType: type

	^ super fromType: type asIntegerType!

----- Method: CharacterReadWriteSend>>handle:at: (in category 'evaluating') -----
handle: handle at: byteOffset

	^ (super handle: handle at: byteOffset) asCharacter!

----- Method: CharacterReadWriteSend>>handle:at:put: (in category 'evaluating') -----
handle: handle at: byteOffset put: aCharacter

	super
		handle: handle
		at: byteOffset
		put: aCharacter asInteger.
	^ aCharacter!

----- Method: CharacterReadWriteSend>>template (in category 'compiling') -----
template

	^ self isReading
		ifTrue: ['(', super template, ') asCharacter']
		ifFalse: [super template copyReplaceAll: '{3}' with: '{3} asInteger']!

----- Method: FFIAtomicReadWriteSend class>>basicFromType: (in category 'instance creation') -----
basicFromType: atomicType
	
	^(self lookupSelectorsFor: atomicType) collect:
		[:selector| | arguments |
		arguments := selector numArgs caseOf: {
							[1] -> "e.g. doubleAt:"					[#(nil)]. "byteOffset"
							[2] -> "e.g. floatAt:put:"				[#(nil nil)]. "byteOffset aFloat" }.
		(self receiver: nil "handle" selector: selector arguments: arguments)
			byteSize: atomicType byteSize;
			yourself]!

----- Method: FFIAtomicReadWriteSend class>>fromType: (in category 'instance creation') -----
fromType: atomicType
	
	atomicType isIntegerType
		ifTrue: [^ GenericIntegerReadWriteSend fromType: atomicType].
		
	atomicType isCharType
		ifTrue: [^ GenericCharacterReadWriteSend fromType: atomicType].
	
	atomicType isBoolType
		ifTrue: [^ GenericBooleanReadWriteSend fromType: atomicType].
		
	atomicType isVoid
		ifTrue: [^ VoidReadWriteSend fromType: atomicType].

	^ self basicFromType: atomicType!

----- Method: FFIAtomicReadWriteSend class>>lookupSelectorsFor: (in category 'instance creation') -----
lookupSelectorsFor: atomicType

	| result |
	result := { nil. "read selector" nil. "write selector" }.
	ByteArray methodsDo: [:method |
		(method pragmaAt: #ffiAtomicRead:) ifNotNil: [:pragma |
			(self pragma: pragma selectsAtomicType: atomicType)
				ifTrue: [
					result at: 1 put: method selector.
					(result at: 2) ifNotNil: [^ result "early out"] ]].
		(method pragmaAt: #ffiAtomicWrite:) ifNotNil: [:pragma |
			(self pragma: pragma selectsAtomicType: atomicType)
				ifTrue: [
					result at: 2 put: method selector.
					(result at: 1) ifNotNil: [^ result "early out"] ]] ].
			
	self notify: ('Could not find selectors for both reading and writing {1}!!' format: {atomicType typeName}).
	^ result!

----- Method: FFIAtomicReadWriteSend class>>pragma:selectsAtomicType: (in category 'instance creation') -----
pragma: pragma selectsAtomicType: atomicType

	| typeNames |
	typeNames := pragma argumentAt: 1.
	typeNames isArray ifFalse: [typeNames := {typeNames}].
	^ typeNames anySatisfy: [:typeName |
		(ExternalType atomicTypeNamed: typeName) = atomicType]!

----- Method: FFIAtomicReadWriteSend>>byteSize (in category 'accessing') -----
byteSize

	^ byteSize!

----- Method: FFIAtomicReadWriteSend>>byteSize: (in category 'accessing') -----
byteSize: numBytes

	byteSize := numBytes.!

----- Method: FFIAtomicReadWriteSend>>handle:at: (in category 'evaluating') -----
handle: receiver at: byteOffset
	
	^ receiver
		perform: selector
		with: byteOffset!

----- Method: FFIAtomicReadWriteSend>>handle:at:put: (in category 'evaluating') -----
handle: receiver at: byteOffset put: value
	
	receiver
		perform: selector
		with: byteOffset
		with: value.
	^ value!

----- Method: FFIAtomicReadWriteSend>>handle:atIndex: (in category 'evaluating') -----
handle: receiver atIndex: index

	^ self
		handle: receiver
		at: ((index-1) * self byteSize) + 1!

----- Method: FFIAtomicReadWriteSend>>handle:atIndex:put: (in category 'evaluating') -----
handle: receiver atIndex: index put: value

	^ self
		handle: receiver
		at: ((index-1) * self byteSize) + 1
		put: value!

----- Method: FFIAtomicReadWriteSend>>isReading (in category 'accessing') -----
isReading

	^ selector numArgs = 1!

----- Method: FFIAtomicReadWriteSend>>isWriting (in category 'accessing') -----
isWriting

	^ self isReading not!

----- Method: FFIAtomicReadWriteSend>>printOn: (in category 'printing') -----
printOn: stream

	stream nextPutAll: self template.!

----- 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!

FFIAtomicReadWriteSend subclass: #GenericIntegerReadWriteSend
	instanceVariableNames: ''
	classVariableNames: 'UseSpecificIntegerPrimitives'
	poolDictionaries: ''
	category: 'FFI-Kernel-Support'!

!GenericIntegerReadWriteSend commentStamp: 'mt 8/6/2021 16:11' 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.

I am generic in the sense that my target primitive covers several atomic types.!

GenericIntegerReadWriteSend subclass: #GenericBooleanReadWriteSend
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'FFI-Kernel-Support'!

!GenericBooleanReadWriteSend 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.!

----- Method: GenericBooleanReadWriteSend class>>fromType: (in category 'instance creation') -----
fromType: type

	^ super fromType: ExternalType byte!

----- Method: GenericBooleanReadWriteSend class>>specificSendClass (in category 'instance creation') -----
specificSendClass

	^ BooleanReadWriteSend!

----- Method: GenericBooleanReadWriteSend>>handle:at: (in category 'evaluating') -----
handle: handle at: byteOffset

	^ (super handle: handle at: byteOffset) ~= 0!

----- Method: GenericBooleanReadWriteSend>>handle:at:put: (in category 'evaluating') -----
handle: handle at: byteOffset put: aBoolean

	super
		handle: handle
		at: byteOffset
		put: (aBoolean ifTrue: [1] ifFalse: [0]).
	^ aBoolean!

----- Method: GenericBooleanReadWriteSend>>template (in category 'compiling') -----
template

	^ self isReading
		ifTrue: ['(', super template, ') ~= 0']
		ifFalse: [super template copyReplaceAll: '{3}' with: '({3} ifTrue: [1] ifFalse: [0])']!

GenericIntegerReadWriteSend subclass: #GenericCharacterReadWriteSend
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'FFI-Kernel-Support'!

!GenericCharacterReadWriteSend 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.!

----- Method: GenericCharacterReadWriteSend class>>fromType: (in category 'instance creation') -----
fromType: charType

	^ super fromType: charType asIntegerType!

----- Method: GenericCharacterReadWriteSend class>>specificSendClass (in category 'instance creation') -----
specificSendClass

	^ CharacterReadWriteSend!

----- Method: GenericCharacterReadWriteSend>>handle:at: (in category 'evaluating') -----
handle: handle at: byteOffset

	^ (super handle: handle at: byteOffset) asCharacter!

----- Method: GenericCharacterReadWriteSend>>handle:at:put: (in category 'evaluating') -----
handle: handle at: byteOffset put: aCharacter

	super
		handle: handle
		at: byteOffset
		put: aCharacter asInteger.
	^ aCharacter!

----- Method: GenericCharacterReadWriteSend>>template (in category 'compiling') -----
template

	^ self isReading
		ifTrue: ['(', super template, ') asCharacter']
		ifFalse: [super template copyReplaceAll: '{3}' with: '{3} asInteger']!

----- Method: GenericIntegerReadWriteSend class>>basicFromType: (in category 'instance creation') -----
basicFromType: type
	"Overwritten to account for byteSize and isSigned."

	^(self lookupSelectorsFor: type) collect:
		[:selector| | arguments sendClass |
		arguments := selector numArgs caseOf: {
							[1] -> "e.g. int32At:"					[#(nil)]. "byteOffset"
							[2] -> "e.g. int8At:put:"				[#(nil nil)]. "byteOffset integerValue"
							[3] -> "e.g. integerAt:size:signed:"		[{nil. "byteOffset" type byteSize. type isSigned}]. 
							[4] -> "e.g. integerAt:put:size:signed:"	[{nil. "byteOffset" nil. "integerValue" type byteSize. type isSigned}] }.
		sendClass := selector numArgs > 2
			ifTrue: [self "generic send-class"]
			ifFalse: [self specificSendClass].
		(sendClass receiver: nil "handle" selector: selector arguments: arguments)
			byteSize: type byteSize;
			yourself]!

----- Method: GenericIntegerReadWriteSend class>>canUseSpecificIntegerPrimitives (in category 'preferences') -----
canUseSpecificIntegerPrimitives

	^ ((ByteArray new: 4) testInt32At: 1) notNil!

----- Method: GenericIntegerReadWriteSend class>>fromType: (in category 'instance creation') -----
fromType: atomicType

	^ self basicFromType: atomicType!

----- Method: GenericIntegerReadWriteSend class>>pragma:selectsAtomicType: (in category 'instance creation') -----
pragma: pragma selectsAtomicType: atomicType
	"Overwritten to filter between generic and specific integer primitives according to the preference. Note that #isArray is an indicator for a generic primitive."
	
	"self assert: [atomicType isIntegerType]."
	^ self useSpecificIntegerPrimitives "want specific?" = (pragma argumentAt: 1) isArray "found generic?"
		ifTrue: [false]
		ifFalse: [super pragma: pragma selectsAtomicType: atomicType]!

----- Method: GenericIntegerReadWriteSend class>>specificSendClass (in category 'instance creation') -----
specificSendClass
	"Answer the send-class that should be used for direct mappings between atomic type and primitive send."
	
	^ FFIAtomicReadWriteSend!

----- Method: GenericIntegerReadWriteSend class>>useSpecificIntegerPrimitives (in category 'preferences') -----
useSpecificIntegerPrimitives
	<preference: 'Use specific integer primitives'
		categoryList: #('FFI Kernel')
		description: 'When true, use specific primitives when reading/writing int32_t, uint32_t etc. from/to ByteArray or ExternalAddress. Note that your FFI plugin might not support those newer primitives.'
		type: #Boolean>
	^ UseSpecificIntegerPrimitives ifNil: [true "Cannot use #canUseSpecificIntegerPrimitives because struct-field generation is affected. Need to keep this preference in sync with how the struct-field accessors actually look like."]!

----- Method: GenericIntegerReadWriteSend class>>useSpecificIntegerPrimitives: (in category 'preferences') -----
useSpecificIntegerPrimitives: aBoolean

	UseSpecificIntegerPrimitives = aBoolean ifTrue: [^ self].

	aBoolean ==> [self canUseSpecificIntegerPrimitives]
		ifFalse: [self notify: 'FFI plugin does not support specific integer primitives. Proceed to update atomic sends anyway. Fallback code will redirect to generic integer primitive. Performance might be affected.'].

	UseSpecificIntegerPrimitives := aBoolean.
	
	Cursor wait showWhile: [
		ExternalType initializeAtomicSends.
		ExternalStructure defineAllFields].!

----- Method: GenericIntegerReadWriteSend>>handle:at: (in category 'evaluating') -----
handle: receiver at: byteOffset
	"Read."
	
	^arguments size = 1
		ifTrue: [receiver perform: selector with: byteOffset]
		ifFalse:
			[receiver
				perform: selector
				with: byteOffset
				with: (arguments at: 2) "byteSize"
				with: (arguments at: 3)] "isSigned"!

----- Method: GenericIntegerReadWriteSend>>handle:at:put: (in category 'evaluating') -----
handle: receiver at: byteOffset put: integerValue
	"Write."
	arguments size = 2
		ifTrue:
			[receiver perform: selector with: byteOffset with: integerValue]
		ifFalse:
			[receiver
				perform: selector
				with: byteOffset
				with: integerValue
				with: (arguments at: 3) "byteSize"
				with: (arguments at: 4)]. "isSigned"
	^integerValue!

----- Method: GenericIntegerReadWriteSend>>isReading (in category 'accessing') -----
isReading

	^ selector numArgs = 3!

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.!

----- Method: VoidReadWriteSend class>>fromType: (in category 'instance creation') -----
fromType: type

	^ {
	(self receiver: nil selector: #voidAt:) byteSize: type byteSize; yourself.
	(self receiver: nil selector: #voidAt:put:) byteSize: type byteSize; yourself}!

----- Method: VoidReadWriteSend>>handle:at: (in category 'evaluating') -----
handle: handle at: byteOffset
	"no accessors for void"
	self shouldNotImplement.!

----- Method: VoidReadWriteSend>>handle:at:put: (in category 'evaluating') -----
handle: handle at: byteOffset put: value
	"no accessors for void"
	self shouldNotImplement.!

----- Method: VoidReadWriteSend>>isReading (in category 'accessing') -----
isReading

	^ selector numArgs = 1!

----- Method: VoidReadWriteSend>>template (in category 'compiling') -----
template

	^ 'self shouldNotImplement'!

----- Method: WordArray>>contentType (in category '*FFI-Kernel-external data') -----
contentType

	^ ExternalType uint32_t!

----- Method: WordArray>>uint32At: (in category '*FFI-Kernel-accessing') -----
uint32At: byteOffset
	"Backstop for compatibility with handle-based access. Raw-bits arrays are their own handle. See #getHandle and ExternalType >> #handle:at:."

	^ self atByteOffset: byteOffset!

----- Method: WordArray>>uint32At:put: (in category '*FFI-Kernel-accessing') -----
uint32At: byteOffset put: value
	"Backstop for compatibility with handle-based access. Raw-bits arrays are their own handle. See #getHandle and ExternalType >> #handle:at:."

	^ self atByteOffset: byteOffset put: value!

----- Method: ByteString>>contentType (in category '*FFI-Kernel-external data') -----
contentType

	^ ExternalType uchar8_t!

----- Method: ByteString>>uint8At: (in category '*FFI-Kernel-accessing') -----
uint8At: byteOffset
	"Backstop for compatibility with handle-based access. Raw-bits arrays are their own handle. See #getHandle and ExternalType >> #handle:at:."

	^ self atByteOffset: byteOffset!

----- Method: ByteString>>uint8At:put: (in category '*FFI-Kernel-accessing') -----
uint8At: byteOffset put: value
	"Backstop for compatibility with handle-based access. Raw-bits arrays are their own handle. See #getHandle and ExternalType >> #handle:at:."

	^ self atByteOffset: byteOffset put: value asCharacter!

ProtoObject subclass: #ByteArrayReadWriter
	instanceVariableNames: 'byteOffset byteSize byteArray'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'FFI-Kernel-Support'!

!ByteArrayReadWriter commentStamp: 'mt 5/3/2021 17:44' prior: 0!
I am a transparent wrapper over byte-array handles to allow access and manipulation just like through an external address.!

----- Method: ByteArrayReadWriter class>>on: (in category 'instance creation') -----
on: handle
	"Wraps the given handle into a read-writer. Avoid double-wrapping."
	
	self assert: [handle isExternalAddress not].
	
	^ (thisContext objectClass: handle) == self
		ifTrue: [handle]
		ifFalse: [self new setArray: handle]!

----- Method: ByteArrayReadWriter>>checkAt: (in category 'private') -----
checkAt: nextByteOffset

	| endOffset |
	(endOffset := nextByteOffset + byteOffset) > (byteOffset + byteSize)
		ifTrue: [self errorSubscriptBounds: endOffset].!

----- Method: ByteArrayReadWriter>>checkAt:length: (in category 'private') -----
checkAt: nextByteOffset length: numBytes

	| endOffset |
	(endOffset := nextByteOffset + numBytes - 1) > (byteOffset + byteSize)
		ifTrue: [self errorSubscriptBounds: endOffset].!

----- Method: ByteArrayReadWriter>>copy (in category 'copying') -----
copy
	"Materialize the current array segment. See ExternalStructure >> #postCopy"
	
	^ byteArray copyFrom: byteOffset + 1 to: byteOffset + byteSize !

----- Method: ByteArrayReadWriter>>doesNotUnderstand: (in category 'system primitives') -----
doesNotUnderstand: aMessage

	^ aMessage sendTo: byteArray!

----- Method: ByteArrayReadWriter>>doubleAt: (in category 'read/write atomics') -----
doubleAt: oByteOffset

	self shouldNotImplement. "See doubleAtByteOffset:"!

----- Method: ByteArrayReadWriter>>doubleAt:put: (in category 'read/write atomics') -----
doubleAt: oByteOffset put: value

	self shouldNotImplement. "See doubleAtByteOffset:put:"!

----- Method: ByteArrayReadWriter>>doubleAtByteOffset: (in category 'read/write atomics') -----
doubleAtByteOffset: oByteOffset

	self checkAt: oByteOffset.
	^ byteArray doubleAtByteOffset: oByteOffset + byteOffset!

----- Method: ByteArrayReadWriter>>doubleAtByteOffset:put: (in category 'read/write atomics') -----
doubleAtByteOffset: oByteOffset put: value

	self checkAt: oByteOffset.
	^ byteArray doubleAtByteOffset: oByteOffset + byteOffset put: value!

----- Method: ByteArrayReadWriter>>errorSubscriptBounds: (in category 'initialization') -----
errorSubscriptBounds: index

	Error signal: 'subscript is out of bounds: ' , index printString.!

----- Method: ByteArrayReadWriter>>floatAt: (in category 'read/write atomics') -----
floatAt: oByteOffset 

	self shouldNotImplement. "See floatAtByteOffset:"!

----- Method: ByteArrayReadWriter>>floatAt:put: (in category 'read/write atomics') -----
floatAt: oByteOffset put: value

	self shouldNotImplement. "See floatAtByteOffset:put:"!

----- Method: ByteArrayReadWriter>>floatAtByteOffset: (in category 'read/write atomics') -----
floatAtByteOffset: oByteOffset 

	self checkAt: oByteOffset.
	^ byteArray floatAtByteOffset: oByteOffset + byteOffset!

----- Method: ByteArrayReadWriter>>floatAtByteOffset:put: (in category 'read/write atomics') -----
floatAtByteOffset: oByteOffset put: value

	self checkAt: oByteOffset.
	^ byteArray floatAtByteOffset: oByteOffset + byteOffset put: value!

----- Method: ByteArrayReadWriter>>int16At: (in category 'read/write atomics') -----
int16At: oByteOffset

	self checkAt: oByteOffset.
	^ byteArray int16At: oByteOffset + byteOffset!

----- Method: ByteArrayReadWriter>>int16At:put: (in category 'read/write atomics') -----
int16At: oByteOffset put: value

	self checkAt: oByteOffset.
	^ byteArray int16At: oByteOffset + byteOffset put: value!

----- Method: ByteArrayReadWriter>>int32At: (in category 'read/write atomics') -----
int32At: oByteOffset

	self checkAt: oByteOffset.
	^ byteArray int32At: oByteOffset + byteOffset!

----- Method: ByteArrayReadWriter>>int32At:put: (in category 'read/write atomics') -----
int32At: oByteOffset put: value

	self checkAt: oByteOffset.
	^ byteArray int32At: oByteOffset + byteOffset put: value!

----- Method: ByteArrayReadWriter>>int64At: (in category 'read/write atomics') -----
int64At: oByteOffset

	self checkAt: oByteOffset.
	^ byteArray int64At: oByteOffset + byteOffset!

----- Method: ByteArrayReadWriter>>int64At:put: (in category 'read/write atomics') -----
int64At: oByteOffset put: value

	self checkAt: oByteOffset.
	^ byteArray int64At: oByteOffset + byteOffset put: value!

----- Method: ByteArrayReadWriter>>int8At: (in category 'read/write atomics') -----
int8At: oByteOffset

	self checkAt: oByteOffset.
	^ byteArray int8At: oByteOffset + byteOffset!

----- Method: ByteArrayReadWriter>>int8At:put: (in category 'read/write atomics') -----
int8At: oByteOffset put: value

	self checkAt: oByteOffset.
	^ byteArray int8At: oByteOffset + byteOffset put: value!

----- Method: ByteArrayReadWriter>>integerAt:put:size:signed: (in category 'read/write atomics') -----
integerAt: oByteOffset put: value size: nBytes signed: aBoolean

	self checkAt: oByteOffset.
	^ byteArray integerAt: oByteOffset + byteOffset put: value size: nBytes signed: aBoolean!

----- Method: ByteArrayReadWriter>>integerAt:size:signed: (in category 'read/write atomics') -----
integerAt: oByteOffset size: nBytes signed: aBoolean

	self checkAt: oByteOffset.
	^ byteArray integerAt: oByteOffset + byteOffset size: nBytes signed: aBoolean.!

----- Method: ByteArrayReadWriter>>memoryAt:length: (in category 'read/write structs') -----
memoryAt: newByteOffset length: newLength

	self checkAt: newByteOffset length: newLength.
	^ ByteArrayReadWriter new
		setArray: byteArray
		offset: byteOffset + newByteOffset - 1
		size: newLength!

----- Method: ByteArrayReadWriter>>memoryAt:put:length: (in category 'read/write structs') -----
memoryAt: newByteOffset put: value length: newLength

	self checkAt: newByteOffset length: newLength.
	^ byteArray
		structAt: byteOffset + newByteOffset - 1
		put: value
		length: newLength!

----- Method: ByteArrayReadWriter>>perform:with: (in category 'message handling') -----
perform: aSymbol with: firstObject
	"Needed because of AtomicSelectors. See FFIAtomicReadWriteSend >> #handle:at:."
	
	<primitive: 83>
	^ self perform: aSymbol withArguments: { firstObject }!

----- Method: ByteArrayReadWriter>>perform:with:with: (in category 'message handling') -----
perform: aSymbol with: firstObject with: secondObject
	"Needed because of AtomicSelectors. See FFIAtomicReadWriteSend >> #handle:at:put:."
	
	<primitive: 83>
	^ self perform: aSymbol withArguments: { firstObject. secondObject }!

----- Method: ByteArrayReadWriter>>perform:with:with:with: (in category 'message handling') -----
perform: aSymbol with: firstObject with: secondObject with: thirdObject 
	"Needed because of AtomicSelectors. See GenericIntegerReadWriteSend >> #handle:at:."
	
	<primitive: 83>
	^ self perform: aSymbol withArguments: { firstObject. secondObject. thirdObject }!

----- 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 GenericIntegerReadWriteSend >> #handle:at:put:."

	<primitive: 83>
	^ self perform: aSymbol withArguments: { firstObject. secondObject. thirdObject. fourthObject }!

----- Method: ByteArrayReadWriter>>pointerAt:length: (in category 'read/write pointers') -----
pointerAt: oByteOffset length: numBytes

	self checkAt: oByteOffset length: numBytes.
	^ byteArray pointerAt: oByteOffset + byteOffset length: numBytes!

----- Method: ByteArrayReadWriter>>pointerAt:put:length: (in category 'read/write pointers') -----
pointerAt: oByteOffset put: value length: numBytes

	self checkAt: oByteOffset length: numBytes.
	^ byteArray pointerAt: oByteOffset + byteOffset put: value length: numBytes!

----- Method: ByteArrayReadWriter>>setArray: (in category 'initialization') -----
setArray: aByteArray

	self setArray: aByteArray offset: 0 size: aByteArray size.!

----- Method: ByteArrayReadWriter>>setArray:offset:size: (in category 'initialization') -----
setArray: aByteArray offset: aByteOffset size: aByteSize

	byteArray := aByteArray.
	byteOffset := aByteOffset.
	byteSize := aByteSize.
	
	(byteOffset + byteSize > byteArray size)
		ifTrue: [self errorSubscriptBounds: byteOffset + byteSize].!

----- Method: ByteArrayReadWriter>>structAt:length: (in category 'read/write structs') -----
structAt: newByteOffset length: newLength

	^ self memoryAt: newByteOffset length: newLength!

----- Method: ByteArrayReadWriter>>structAt:put:length: (in category 'read/write structs') -----
structAt: newByteOffset put: value length: newLength

	^ self memoryAt: newByteOffset put: value length: newLength!

----- Method: ByteArrayReadWriter>>uint16At: (in category 'read/write atomics') -----
uint16At: oByteOffset

	self checkAt: oByteOffset.
	^ byteArray uint16At: oByteOffset + byteOffset!

----- Method: ByteArrayReadWriter>>uint16At:put: (in category 'read/write atomics') -----
uint16At: oByteOffset put: value

	self checkAt: oByteOffset.
	^ byteArray uint16At: oByteOffset + byteOffset put: value!

----- Method: ByteArrayReadWriter>>uint32At: (in category 'read/write atomics') -----
uint32At: oByteOffset

	self checkAt: oByteOffset.
	^ byteArray uint32At: oByteOffset + byteOffset!

----- Method: ByteArrayReadWriter>>uint32At:put: (in category 'read/write atomics') -----
uint32At: oByteOffset put: value

	self checkAt: oByteOffset.
	^ byteArray uint32At: oByteOffset + byteOffset put: value!

----- Method: ByteArrayReadWriter>>uint64At: (in category 'read/write atomics') -----
uint64At: oByteOffset

	self checkAt: oByteOffset.
	^ byteArray uint64At: oByteOffset + byteOffset!

----- Method: ByteArrayReadWriter>>uint64At:put: (in category 'read/write atomics') -----
uint64At: oByteOffset put: value

	self checkAt: oByteOffset.
	^ byteArray uint64At: oByteOffset + byteOffset put: value!

----- Method: ByteArrayReadWriter>>uint8At: (in category 'read/write atomics') -----
uint8At: oByteOffset

	self checkAt: oByteOffset.
	^ byteArray uint8At: oByteOffset + byteOffset!

----- Method: ByteArrayReadWriter>>uint8At:put: (in category 'read/write atomics') -----
uint8At: oByteOffset put: value

	self checkAt: oByteOffset.
	^ byteArray uint8At: oByteOffset + byteOffset put: value!

----- Method: ByteArrayReadWriter>>withoutReadWriter (in category 'initialization') -----
withoutReadWriter

	^ byteArray!

----- Method: Float64Array>>contentType (in category '*FFI-Kernel-external data') -----
contentType

	^ ExternalType double!

----- Method: Float64Array>>doubleAtByteOffset: (in category '*FFI-Kernel-accessing') -----
doubleAtByteOffset: byteOffset
	"Backstop for compatibility with handle-based access. Raw-bits arrays are their own handle. See #getHandle and ExternalType >> #handle:at:."

	^ self atByteOffset: byteOffset!

----- Method: Float64Array>>doubleAtByteOffset:put: (in category '*FFI-Kernel-accessing') -----
doubleAtByteOffset: byteOffset put: value
	"Backstop for compatibility with handle-based access. Raw-bits arrays are their own handle. See #getHandle and ExternalType >> #handle:at:put:."
	
	^ self atByteOffset: byteOffset put: value!

----- Method: SignedDoubleWordArray>>contentType (in category '*FFI-Kernel-external data') -----
contentType

	^ ExternalType int64_t!

----- Method: SignedDoubleWordArray>>int64At: (in category '*FFI-Kernel-accessing') -----
int64At: byteOffset
	"Backstop for compatibility with handle-based access. Raw-bits arrays are their own handle. See #getHandle and ExternalType >> #handle:at:."

	^ self atByteOffset: byteOffset!

----- Method: SignedDoubleWordArray>>int64At:put: (in category '*FFI-Kernel-accessing') -----
int64At: byteOffset put: value
	"Backstop for compatibility with handle-based access. Raw-bits arrays are their own handle. See #getHandle and ExternalType >> #handle:at:."

	^ self atByteOffset: byteOffset put: value!

----- Method: RawBitsArray class>>externalType (in category '*FFI-Kernel') -----
externalType

	^ self new contentType asArrayType: nil!

----- Method: RawBitsArray>>atByteOffset: (in category '*FFI-Kernel-accessing') -----
atByteOffset: byteOffset

	| index |
	index := ((byteOffset-1) / self contentType byteSize) + 1.
	^ self at: index!

----- Method: RawBitsArray>>atByteOffset:put: (in category '*FFI-Kernel-accessing') -----
atByteOffset: byteOffset put: value

	| index |
	index := ((byteOffset-1) / self contentType byteSize) + 1.
	^ self at: index put: value!

----- Method: RawBitsArray>>contentType (in category '*FFI-Kernel-external data') -----
contentType

	self subclassResponsibility.!

----- Method: RawBitsArray>>externalType (in category '*FFI-Kernel-external data') -----
externalType

	^ self contentType asArrayType: self size!

----- Method: RawBitsArray>>free (in category '*FFI-Kernel-external data') -----
free

	self shouldNotImplement.!

----- Method: RawBitsArray>>from: (in category '*FFI-Kernel-external data') -----
from: firstIndex
	"See ExternalData"
	
	^ self copyFrom: firstIndex to: self size!

----- Method: RawBitsArray>>from:to: (in category '*FFI-Kernel-external data') -----
from: firstIndex to: lastIndex
	"See ExternalData"
	
	^ self copyFrom: firstIndex to: lastIndex!

----- Method: RawBitsArray>>getHandle (in category '*FFI-Kernel-external data') -----
getHandle
	"I am my own handle."
	
	^ self!

----- Method: RawBitsArray>>isFFIArray (in category '*FFI-Kernel-external data') -----
isFFIArray

	^ true!

----- Method: RawBitsArray>>isNull (in category '*FFI-Kernel-external data') -----
isNull

	^ false!

----- Method: RawBitsArray>>reader (in category '*FFI-Kernel-external data') -----
reader

	^ self!

----- Method: RawBitsArray>>setContentType: (in category '*FFI-Kernel-external data') -----
setContentType: type
	"See ExternalData."
	
	self shouldNotImplement.!

----- Method: RawBitsArray>>setSize: (in category '*FFI-Kernel-external data') -----
setSize: size
	"See ExternalData."
	
	self shouldNotImplement.!

----- Method: RawBitsArray>>writer (in category '*FFI-Kernel-external data') -----
writer

	^ self!

----- Method: RawBitsArray>>zeroMemory (in category '*FFI-Kernel-external data') -----
zeroMemory

	self atAllPut: 0.!

----- Method: SignedWordArray>>contentType (in category '*FFI-Kernel-external data') -----
contentType

	^ ExternalType int32_t!

----- Method: SignedWordArray>>int32At: (in category '*FFI-Kernel-accessing') -----
int32At: byteOffset
	"Backstop for compatibility with handle-based access. Raw-bits arrays are their own handle. See #getHandle and ExternalType >> #handle:at:."

	^ self atByteOffset: byteOffset!

----- Method: SignedWordArray>>int32At:put: (in category '*FFI-Kernel-accessing') -----
int32At: byteOffset put: value
	"Backstop for compatibility with handle-based access. Raw-bits arrays are their own handle. See #getHandle and ExternalType >> #handle:at:."

	^ self atByteOffset: byteOffset put: value!

----- Method: String class>>externalType (in category '*FFI-Kernel') -----
externalType

	^ self new contentType asArrayType: nil!

----- Method: String>>atByteOffset: (in category '*FFI-Kernel-accessing') -----
atByteOffset: byteOffset

	| index |
	index := ((byteOffset-1) / self contentType byteSize) + 1.
	^ self at: index!

----- Method: String>>atByteOffset:put: (in category '*FFI-Kernel-accessing') -----
atByteOffset: byteOffset put: value

	| index |
	index := ((byteOffset-1) / self contentType byteSize) + 1.
	^ self at: index put: value!

----- Method: String>>contentType (in category '*FFI-Kernel-external data') -----
contentType

	self subclassResponsibility.!

----- Method: String>>externalType (in category '*FFI-Kernel-external data') -----
externalType

	^ self contentType asArrayType: self size!

----- Method: String>>free (in category '*FFI-Kernel-external data') -----
free

	self shouldNotImplement.!

----- Method: String>>from: (in category '*FFI-Kernel-external data') -----
from: firstIndex
	"See ExternalData"
	
	^ self copyFrom: firstIndex to: self size!

----- Method: String>>from:to: (in category '*FFI-Kernel-external data') -----
from: firstIndex to: lastIndex
	"See ExternalData"
	
	^ self copyFrom: firstIndex to: lastIndex!

----- Method: String>>getHandle (in category '*FFI-Kernel-external data') -----
getHandle
	"I am my own handle."
	
	^ self!

----- Method: String>>integerAt:put:size:signed: (in category '*FFI-Kernel-accessing') -----
integerAt: byteOffset put: value size: nBytes signed: aBoolean
	"Backstop for compatibility with handle-based access. Raw-bits arrays are their own handle. See #getHandle and ExternalType >> #handle:at:put:."
	
	^ self atByteOffset: byteOffset put: value asCharacter.!

----- Method: String>>integerAt:size:signed: (in category '*FFI-Kernel-accessing') -----
integerAt: byteOffset size: nBytes signed: aBoolean
	"Backstop for compatibility with handle-based access. Raw-bits arrays are their own handle. See #getHandle and ExternalType >> #handle:at:."
	
	^ self atByteOffset: byteOffset!

----- Method: String>>isFFIArray (in category '*FFI-Kernel-external data') -----
isFFIArray

	^ true!

----- Method: String>>isNull (in category '*FFI-Kernel-external data') -----
isNull

	^ false!

----- Method: String>>reader (in category '*FFI-Kernel-external data') -----
reader

	^ self!

----- Method: String>>setContentType: (in category '*FFI-Kernel-external data') -----
setContentType: type
	"See ExternalData."
	
	self shouldNotImplement.!

----- Method: String>>setSize: (in category '*FFI-Kernel-external data') -----
setSize: size
	"See ExternalData."
	
	self shouldNotImplement.!

----- Method: String>>writer (in category '*FFI-Kernel-external data') -----
writer

	^ self!

----- Method: String>>zeroMemory (in category '*FFI-Kernel-external data') -----
zeroMemory

	1 to: self size do: [:index |
		self at: index put: Character null].!

----- Method: UnsignedIntegerArray>>integerAt:put:size:signed: (in category '*FFI-Kernel-accessing') -----
integerAt: byteOffset put: value size: nBytes signed: aBoolean
	"Backstop for compatibility with handle-based access. Raw-bits arrays are their own handle. See #getHandle and ExternalType >> #handle:at:put:."
	
	^ self atByteOffset: byteOffset put: value!

----- Method: UnsignedIntegerArray>>integerAt:size:signed: (in category '*FFI-Kernel-accessing') -----
integerAt: byteOffset size: nBytes signed: aBoolean
	"Backstop for compatibility with handle-based access. Raw-bits arrays are their own handle. See #getHandle and ExternalType >> #handle:at:."
	
	^ self atByteOffset: byteOffset!

Object subclass: #ExternalObject
	instanceVariableNames: 'handle'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'FFI-Kernel'!

!ExternalObject commentStamp: '' prior: 0!
External objects represent entities that are not part of the Smalltalk universe. They are accessed using a unique handle which is interpreted depending on the actual entity that is represented. 

Instance variables:
	handle	<ByteArray | ExternalAddress>!

ExternalObject subclass: #ExternalFunction
	instanceVariableNames: 'flags argTypes'
	classVariableNames: 'FFIErrorMessages'
	poolDictionaries: 'FFIConstants'
	category: 'FFI-Kernel'!

!ExternalFunction commentStamp: '' prior: 0!
This class represents an external function called from Smalltalk. Instances of ExternalFunction can be created if the address/parameters of the function are known by some other means than loading from a shared library or compiling the appropriate primitive specification.

Instance variables:
	flags	<Integer>	a set of flags encoding the calling convention
	args	<Array of: ExternalType>		the parameters of the function

Implementation notes:

The arguments consist of an array with the first element defining the return type, the remaining arguments defining the parameters of the call.
!

----- Method: ExternalFunction class>>callTypeAPI (in category 'constants') -----
callTypeAPI
	^FFICallTypeApi!

----- Method: ExternalFunction class>>callTypeCDecl (in category 'constants') -----
callTypeCDecl
	^FFICallTypeCDecl!

----- Method: ExternalFunction class>>callingConventionFor: (in category 'compiler support') -----
callingConventionFor: aString
	"Return the constant describing the calling convention for the given string specification or nil if unknown."
	aString = 'cdecl:' ifTrue:[^self callTypeCDecl].
	aString = 'apicall:' ifTrue:[^self callTypeAPI].
	^nil!

----- Method: ExternalFunction class>>callingConventionModifierFor: (in category 'compiler support') -----
callingConventionModifierFor: aString
	"Return the constant describing the calling convention modifier for the given string specification or nil if unknown."
	aString = 'threaded' ifTrue:[^FFICallFlagThreaded].
	^nil!

----- Method: ExternalFunction class>>errorMessageFor: (in category 'error handling') -----
errorMessageFor: code
	"Return the error message for the given error code from the foreign function interface"
	^FFIErrorMessages at: code ifAbsent:['Call to external function failed'].!

----- Method: ExternalFunction class>>externalCallFailed (in category 'error handling') -----
externalCallFailed
	"Raise an error after a failed call to an external function"
	| errCode |
	errCode := self getLastError. "this allows us to look at the actual error code"
	^self error: (self errorMessageFor: errCode).!

----- Method: ExternalFunction class>>externalCallFailedWith: (in category 'error handling') -----
externalCallFailedWith: primErrorCode
	"Raise an error after a failed call to an external function.
	 The primFailCode could be any of:
		- a symbol; one of the standard primitive errors defined in Smalltalk primitiveErrorTable
		- nil; the VM does not support primitive errors and is not providing error codes
		- an integer; one of the FFI codes incremented by Smalltalk primitiveErrorTable size + 2
		  so as not to clash with the standard primitive errors."
	^self error: (primErrorCode isInteger
					ifTrue: [self errorMessageFor: primErrorCode - (Smalltalk primitiveErrorTable size + 2)]
					ifFalse: [primErrorCode isNil
								ifTrue: ['Call to external function failed']
								ifFalse: [primErrorCode]])!

----- 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>
	^-1!

----- Method: ExternalFunction class>>initialize (in category 'class initialization') -----
initialize
	"ExternalFunction initialize"
	FFIConstants initialize. "ensure proper initialization"
	self initializeErrorMessages.
	(Smalltalk specialObjectsArray at: 47) == self 
		ifFalse:[Smalltalk recreateSpecialObjectsArray].
!

----- Method: ExternalFunction class>>initializeErrorMessages (in category 'class initialization') -----
initializeErrorMessages
	"ExternalFunction initializeErrorMessages"
	FFIErrorMessages := Dictionary new.
	FFIErrorMessages
		at: FFINoCalloutAvailable put: 'Callout mechanism not available';
		at: FFIErrorGenericError put: 'A call to an external function failed';
		at: FFIErrorNotFunction put: 'Only ExternalFunctions can be called';
		at: FFIErrorBadArgs put: 'Bad arguments in primitive invocation';
		at: FFIErrorBadArg put: 'Bad argument for external function';
		at: FFIErrorIntAsPointer put: 'Cannot use integer as pointer';
		at: FFIErrorBadAtomicType put: 'Unknown atomic type in external call';
		at: FFIErrorCoercionFailed put: 'Could not coerce arguments';
		at: FFIErrorWrongType put: 'Wrong type in external call';
		at: FFIErrorStructSize put: 'Bad structure size in external call';
		at: FFIErrorCallType put: 'Unsupported calling convention';
		at: FFIErrorBadReturn put: 'Cannot return the given type';
		at: FFIErrorBadAddress put: 'Bad function address';
		at: FFIErrorNoModule put: 'No module to load address from';
		at: FFIErrorAddressNotFound put: 'Unable to find function address';
		at: FFIErrorAttemptToPassVoid put: 'Cannot pass ''void'' parameter';
		at: FFIErrorModuleNotFound put: 'External module not found';
		at: FFIErrorBadExternalLibrary put: 'External library is invalid';
		at: FFIErrorBadExternalFunction put: 'External function is invalid';
		at: FFIErrorInvalidPointer put: 'Attempt to pass invalid pointer';
		at: FFIErrorCallFrameTooBig put: 'Call requires more than 16k of stack space';
	yourself!

----- Method: ExternalFunction class>>newTypeNamed: (in category 'compiler support') -----
newTypeNamed: typeName
	^ExternalType newTypeNamed: typeName!

----- Method: ExternalFunction class>>typeNamed: (in category 'compiler support') -----
typeNamed: aString
	^ExternalType typeNamed: aString!

----- Method: ExternalFunction class>>unload (in category 'class initialization') -----
unload
	"Clean out the splObj array"
	Smalltalk specialObjectsArray from: 44 to: 48 put: nil.
!

----- Method: ExternalFunction>>argTypes (in category 'accessing') -----
argTypes
	^argTypes!

----- Method: ExternalFunction>>callingConventionString (in category 'printing') -----
callingConventionString
	(flags allMask: FFICallTypeApi) 
		ifTrue:[^'apicall']
		ifFalse:[^'cdecl']!

----- Method: ExternalFunction>>errorCodeName (in category 'accessing') -----
errorCodeName
	^nil!

----- Method: ExternalFunction>>flags (in category 'accessing') -----
flags
	^flags!

----- Method: ExternalFunction>>initialize (in category 'initialize-release') -----
initialize
	"Initialize the receiver"
	handle := ExternalAddress new.!

----- Method: ExternalFunction>>invoke (in category 'invoking') -----
invoke
	^self invokeWithArguments: #()!

----- Method: ExternalFunction>>invokeWith: (in category 'invoking') -----
invokeWith: arg1
	^self invokeWithArguments: (Array with: arg1)!

----- Method: ExternalFunction>>invokeWith:with: (in category 'invoking') -----
invokeWith: arg1 with: arg2
	^self invokeWithArguments: (Array with: arg1 with: arg2)!

----- Method: ExternalFunction>>invokeWith:with:with: (in category 'invoking') -----
invokeWith: arg1 with: arg2 with: arg3
	^self invokeWithArguments: (Array with: arg1 with: arg2 with: arg3)!

----- Method: ExternalFunction>>invokeWith:with:with:with: (in category 'invoking') -----
invokeWith: arg1 with: arg2 with: arg3 with: arg4
	^self invokeWithArguments: (Array with: arg1 with: arg2 with: arg3 with: arg4)!

----- Method: ExternalFunction>>invokeWith:with:with:with:with: (in category 'invoking') -----
invokeWith: arg1 with: arg2 with: arg3 with: arg4 with: arg5
	^self invokeWithArguments: (Array with: arg1 with: arg2 with: arg3 with: arg4 with: arg5)!

----- Method: ExternalFunction>>invokeWith:with:with:with:with:with: (in category 'invoking') -----
invokeWith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6
	^self invokeWithArguments: (Array with: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6)!

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

----- Method: ExternalFunction>>module (in category 'accessing') -----
module
	^nil!

----- Method: ExternalFunction>>name (in category 'accessing') -----
name
	^nil!

----- Method: ExternalFunction>>printOn: (in category 'printing') -----
printOn: aStream
	aStream
		nextPut:$<;
		nextPutAll: self callingConventionString; nextPutAll:': '.
	{ 'threaded' } with: { FFICallFlagThreaded } do:
		[:modifier :flag|
		(flags anyMask: flag) ifTrue:
			[aStream nextPutAll: modifier; space]].
	aStream nextPutAll: argTypes first typeName; space.
	self name == nil
		ifTrue:[aStream nextPutAll:'(*) ']
		ifFalse:[aStream print: self name asString; space].
	aStream nextPut:$(.
	2 to: argTypes size do:[:i|
		aStream nextPutAll: (argTypes at: i) typeName.
		i < argTypes size ifTrue:[aStream space]].
	aStream nextPut:$).
	self module == nil ifFalse:[
		aStream space; nextPutAll:'module: '; print: self module asString.
	].
	self errorCodeName == nil ifFalse:[
		aStream space; nextPutAll:'error: '; nextPutAll: self errorCodeName.
	].
	aStream nextPut:$>!

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

ExternalFunction subclass: #ExternalLibraryFunction
	instanceVariableNames: 'name module errorCodeName'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'FFI-Kernel'!

!ExternalLibraryFunction commentStamp: '' prior: 0!
An ExternalLibraryFunction specifies a fully qualified function from an external library.

Instance variables:
	name			<String | Integer>	name or ordinal of function
	module			<String | nil>		name of module (nil if bound in the VM).
	errorCodeName <String | nil>		name of temp receiving error code, if any!

----- Method: ExternalLibraryFunction class>>name:module:callType:returnType:argumentTypes: (in category 'instance creation') -----
name: aName module: aModule callType: callType returnType: retType argumentTypes: argTypes
	^self new
		name: aName
		module: aModule
		flags: callType
		argTypes: (Array with: retType), argTypes!

----- Method: ExternalLibraryFunction>>analogousCodeTo: (in category 'comparing') -----
analogousCodeTo: anObject
	^(anObject isKindOf: ExternalLibraryFunction)
	and: [flags = anObject flags
	and: [argTypes = anObject argTypes
	and: [name = anObject name
	and: [module = anObject module
	and: [errorCodeName = anObject errorCodeName]]]]]!

----- Method: ExternalLibraryFunction>>errorCodeName (in category 'accessing') -----
errorCodeName
	^errorCodeName!

----- Method: ExternalLibraryFunction>>module (in category 'accessing') -----
module
	^module!

----- Method: ExternalLibraryFunction>>name (in category 'accessing') -----
name
	^name!

----- Method: ExternalLibraryFunction>>name:module:flags:argTypes: (in category 'private') -----
name: aName module: aModule flags: anInteger argTypes: argTypeArray

	name := aName.
	module := aModule.
	flags := anInteger.
	argTypes := argTypeArray.!

----- Method: ExternalLibraryFunction>>setErrorCodeName: (in category 'accessing') -----
setErrorCodeName: aString
	errorCodeName := aString!

----- Method: ExternalLibraryFunction>>setModule: (in category 'accessing') -----
setModule: aString
	"Private. Hack the module"
	module := aString.!

ExternalObject subclass: #ExternalLibrary
	instanceVariableNames: 'name'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'FFI-Kernel'!
ExternalLibrary class
	instanceVariableNames: 'default'!

!ExternalLibrary commentStamp: 'mt 6/8/2020 13:21' prior: 0!
An external library bundles calls to functions from the same library. It is provided mainly as convenience since every external function can be fully specified by the name and the module it resides in.

Every external function that is defined in an external library by default will use the library it is defined in. This can always be modified by providing the appropriate module in the specification.

Note that you will only get a valid handle *automatically* for the library if the module has not yet been loaded when making the first FFI call. After that, new instances of me must call #forceLoading to get the handle right. Consequently, it is advised to only have a single instance of your external library to reliably check #isLoaded.!
ExternalLibrary class
	instanceVariableNames: 'default'!

----- Method: ExternalLibrary class>>clearAllCaches (in category 'system startup') -----
clearAllCaches

	self withAllSubclassesDo: [:libraryClass |
		libraryClass clearCaches].!

----- Method: ExternalLibrary class>>clearCaches (in category 'system startup') -----
clearCaches

	self resetDefault.!

----- Method: ExternalLibrary class>>default (in category 'instance access') -----
default

	^ default ifNil: [default := self new]!

----- Method: ExternalLibrary class>>moduleName (in category 'accessing') -----
moduleName
	"Return the name of the module for this library"
	^nil!

----- Method: ExternalLibrary class>>platformChangedFrom:to: (in category 'system startup') -----
platformChangedFrom: oldPlatform to: newPlatform

	self clearAllCaches.!

----- Method: ExternalLibrary class>>resetDefault (in category 'instance creation') -----
resetDefault

	default := nil.
	self methodsDo: [:m | m externalLibraryName: nil].!

----- 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>
	^self externalCallFailed "The primitive will set the error code"!

----- Method: ExternalLibrary>>handle (in category 'accessing') -----
handle
	^handle!

----- Method: ExternalLibrary>>initialize (in category 'initialize-release') -----
initialize
	"Initialize the receiver"
	name := self class moduleName.
	handle := ExternalAddress new.!

----- Method: ExternalLibrary>>name (in category 'accessing') -----
name
	^name!

----- Method: ExternalObject>>= (in category 'comparing') -----
= other
	"By default, we use the not-so-expensive check for external indentity like Object does. Subclasses can choose to use #ffiEqual:, which compares types and bytes, or implement their own domain-specific notion of equality."
	
	^ self ffiIdentical: other!

----- Method: ExternalObject>>ffiEqual: (in category 'comparing') -----
ffiEqual: other
	"We do not know better."
	
	^ self ffiIdentical: other!

----- Method: ExternalObject>>ffiEqualityHash (in category 'comparing') -----
ffiEqualityHash

	^ self ffiIdentityHash!

----- Method: ExternalObject>>ffiIdentical: (in category 'comparing') -----
ffiIdentical: other
	"Define identity for external objects. External objects sharing an external address are considered 'externally identical.' "
	
	self == other ifTrue: [^ true].
	other isExternalObject ifFalse: [^ false].
	self getHandle species = other getHandle species ifFalse: [^ false].
	
	^ (self getHandle ffiIdentical: other getHandle) or: [
			self getHandle isExternalAddress
				and: [other getHandle isExternalAddress]
				and: [self getHandle = other getHandle]]!

----- Method: ExternalObject>>ffiIdentityHash (in category 'comparing') -----
ffiIdentityHash

	^ self species scaledIdentityHash bitXor: self getHandle scaledIdentityHash!

----- Method: ExternalObject>>getHandle (in category 'private') -----
getHandle
	"Private. Return the handle used to represent the external entitiy."
	^handle!

----- Method: ExternalObject>>hash (in category 'comparing') -----
hash

	^ self ffiIdentityHash!

----- Method: ExternalObject>>isExternalObject (in category 'testing') -----
isExternalObject

	^ true!

----- Method: ExternalObject>>isNull (in category 'testing') -----
isNull
	"Answer true if the receiver currently is a NULL pointer"
	^handle == nil or:[handle isNull]!

----- Method: ExternalObject>>setHandle: (in category 'private') -----
setHandle: anObject
	"Private. Set the handle used to represent the external entity."
	handle := anObject!

ExternalObject subclass: #ExternalStructure
	instanceVariableNames: ''
	classVariableNames: 'LogAccessorSourceCode'
	poolDictionaries: 'ExternalTypePool FFIConstants'
	category: 'FFI-Kernel'!
ExternalStructure class
	instanceVariableNames: 'compiledSpec byteAlignment'!

!ExternalStructure commentStamp: 'eem 6/26/2019 15:26' prior: 0!
An ExternalStructure is for representing external data that is
- either a structure composed of different fields (a struct of C language)
- or an alias for another type (like a typedef of C language)

It reserves enough bytes of data for representing all the fields.

The data is stored into the handle instance variable which can be of two different types:
	- ExternalAddress
		If the handle is an external address then the object described does not reside in the Smalltalk object memory.
	- ByteArray
		If the handle is a byte array then the object described resides in Smalltalk memory.


Instance Variables (class side)
	byteAlignment:		<Integer>
	compiledSpec:		<WordArray>

byteAlignment
	- the required alignment for the structure

compiledSpec
	- the bit-field definiton of the structure in the ExternalType encoding understood by the VM's FFI call marshalling machinery.


A specific structure is defined by subclassing ExternalStructure and specifying its #fields via a class side method.
For example if we define a subclass:
	ExternalStructure subclass: #StructExample
		instanceVariableNames: ''
		classVariableNames: ''
		poolDictionaries: ''
		category: 'garbage'.
Then declare the fields like this:
    StructExample class compile: 'fields  ^#( (name ''char*'') (color ''ulong'') )' classified: 'garbage'.

It means that this type is composed of two different fields:
- a string (accessed thru the field #name)
- and an unsigned 32bit integer (accessed thru the field #color).
It represents the following C type:
   struct StructExample {char *name; uint32_t color; };

The accessors for those fields can be generated automatically like this:
	StructExample defineFields.
As can be verified in a Browser:
	StructExample browse.
We see that name and color fields are stored sequentially in different zones of data.

The total size of the structure can be verified with:
	StructExample byteSize = (Smalltalk wordSize + 4).

An ExternalStructure can also be used for defining an alias.
The fields definition must contain only 2 elements: an eventual accessor (or nil) and the type.
For example, We can define a machine dependent 'unsigned long' like this:
	ExternalStructure subclass: #UnsignedLong
		instanceVariableNames: ''
		classVariableNames: ''
		poolDictionaries: ''
		category: 'garbage'.
Then set the fields like this:
    UnsignedLong class compile: 'fields  ^(Smalltalk wordSize=4 or: [Smalltalk platformName=''Win64''])
		ifTrue: [#(nil ''ulong'')] ifFalse: [#(nil ''ulonglong'')]' classified: 'garbage'.
And verify the size on current platform:
	UnsignedLong byteSize.
	
Then, the class names 'UnsignedLong' and 'StructExamples' acts as a type specification.
They can be used for composing other types, and for defining prototype of external functions:

LibraryExample>>initMyStruct: aStructExample name: name color: anInteger
	<cdecl: void 'init_my_struct'( StructExample * char * UnsignedLong )>
	self externalCallFailed


!
ExternalStructure class
	instanceVariableNames: 'compiledSpec byteAlignment'!

ExternalStructure subclass: #ExternalData
	instanceVariableNames: 'type contentType'
	classVariableNames: 'AllowDetectForUnknownSize ExtraSizeChecks'
	poolDictionaries: ''
	category: 'FFI-Kernel'!

!ExternalData commentStamp: 'mt 6/13/2020 17:26' prior: 0!
Instances of ExternalData explicitly describe objects with associated type. They can be used for describing atomic C types like arrays of atomic types (e.g., 'int[]') or pointer to atomic types (e.g., 'int *').

Instance variables:
	type	<ExternalType>	The external type of the receiver. Always a pointer type.

The encoding of type is equivalent to that of the basic type in class ExternalType. The interpretation of whether the receiver describes an array of data or a pointer to data depends on the contents of the instance variable 'handle'. If handle contains an ExternalAddress the receiver is treated as pointer to type. If the handle contains a ByteArray the receiver is interpreted as describing an array of type. Note that both interpretations are treated equivalent in external calls, e.g., if one describes an argument to an external call as taking 'int*' then, depending on the type of handle either the actual contents (if ExternalAddress) or a pointer to the contents (if ByteArray) is passed.

!

----- Method: ExternalData class>>allowDetectForUnknownSize (in category 'preferences') -----
allowDetectForUnknownSize
	<preference: 'Allow #detect:ifFound: for unknown size'
		categoryList: #('FFI Kernel')
		description: 'When true, does not fail when calling #detect:ifFound: on external data with unknown size. This can be used to read NUL-terminated C strings, for example. CAN BE DANGEROUS!!'
		type: #Boolean>
	^AllowDetectForUnknownSize ifNil: [true]!

----- Method: ExternalData class>>allowDetectForUnknownSize: (in category 'preferences') -----
allowDetectForUnknownSize: aBoolean

	AllowDetectForUnknownSize := aBoolean.!

----- Method: ExternalData class>>allowDetectForUnknownSizeDuring: (in category 'preferences') -----
allowDetectForUnknownSizeDuring: aBlock

	| priorValue |
	priorValue := AllowDetectForUnknownSize.
	AllowDetectForUnknownSize := true.
	aBlock ensure: [AllowDetectForUnknownSize := priorValue].!

----- Method: ExternalData class>>byteAlignment (in category 'external type') -----
byteAlignment

	self shouldNotImplement.!

----- Method: ExternalData class>>byteSize (in category 'external type') -----
byteSize

	self shouldNotImplement.!

----- Method: ExternalData class>>compiledSpec (in category 'external type') -----
compiledSpec

	self shouldNotImplement.!

----- Method: ExternalData class>>doneCompiling (in category 'class management') -----
doneCompiling
	"Nevermind here."!

----- Method: ExternalData class>>externalType (in category 'external type') -----
externalType
	
	self shouldNotImplement.!

----- Method: ExternalData class>>extraSizeChecks (in category 'preferences') -----
extraSizeChecks
	<preference: 'Extra size checks'
		categoryList: #('FFI Kernel')
		description: 'When true, there will be extra out-of-bounds checks when accessing external data with a known array size.'
		type: #Boolean>
	^ ExtraSizeChecks ifNil: [false]!

----- Method: ExternalData class>>extraSizeChecks: (in category 'preferences') -----
extraSizeChecks: aBoolean

	ExtraSizeChecks := aBoolean.!

----- Method: ExternalData class>>fields (in category 'field definition') -----
fields
	"Note: The definition is for completeness only. ExternalData is treated specially by the VM."
	^#(nil 'void*')!

----- Method: ExternalData class>>fromHandle: (in category 'instance creation') -----
fromHandle: aHandle

	^ self fromHandle: aHandle type: ExternalType void!

----- Method: ExternalData class>>fromHandle:type: (in category 'instance creation') -----
fromHandle: aHandle type: containerOrContentType
	"Answer with given container type or content type and unknown size."
	
	^ self basicNew setHandle: aHandle type: containerOrContentType!

----- Method: ExternalData class>>fromHandle:type:size: (in category 'instance creation') -----
fromHandle: aHandle type: contentType size: numElements

	^ self basicNew setHandle: aHandle type: contentType size: numElements!

----- Method: ExternalData class>>isSkipped (in category 'field definition') -----
isSkipped

	^ true!

----- Method: ExternalData class>>isTypeAlias: (in category 'type alias') -----
isTypeAlias: fieldSpec
	"Technically, external data aliases atomic C types like arrays of atomic types (e.g., 'int[]') or pointer to atomic types (e.g., 'int *'). However, that's an implementation detail of FFI and not the same as actual aliases you can define for struct types."
	
	^ false!

----- Method: ExternalData class>>new (in category 'instance creation') -----
new
	"You better not..."
	^self shouldNotImplement!

----- Method: ExternalData class>>setCompiledSpec:byteAlignment: (in category 'external type') -----
setCompiledSpec: spec byteAlignment: alignment

	self shouldNotImplement.!

----- Method: ExternalData class>>with: (in category 'instance creation') -----
with: externalStructure
	"Put externalStructure into an array. Note that pointer types need to be elevated as pointer type of the array type. The content type MUST be a non-pointer type because the handle will decide between internal memory or external address."

	| contentType arrayType |
	contentType := externalStructure externalType asNonPointerType.
	arrayType := contentType asArrayType: 1.
	
	^ ExternalData
		fromHandle: externalStructure getHandle
		type: arrayType!

----- Method: ExternalData>>allSatisfy: (in category 'enumerating') -----
allSatisfy: aBlock

	self do: [:each | (aBlock value: each) ifFalse: [^ false]].
	^ true!

----- Method: ExternalData>>anySatisfy: (in category 'enumerating') -----
anySatisfy: aBlock

	self do: [:each | (aBlock value: each) ifTrue: [^ true]].
	^ false!

----- Method: ExternalData>>arrayType (in category 'accessing - types') -----
arrayType
	"Answer this container's array type or 'nil' if unknown. Supports"
	
	| arrayType |
	^ (arrayType := self containerType) asNonPointerType isVoid
		ifFalse: [arrayType]!

----- Method: ExternalData>>asContentType: (in category 'converting') -----
asContentType: contentType
	"Keep the size."

	^ ExternalData fromHandle: handle type: contentType size: self size!

----- Method: ExternalData>>asType: (in category 'converting') -----
asType: containerType

	^ ExternalData fromHandle: handle type: containerType!

----- Method: ExternalData>>asType:size: (in category 'converting') -----
asType: contentType size: numElements

	^ ExternalData fromHandle: handle type: contentType size: numElements!

----- Method: ExternalData>>assert:at: (in category 'accessing') -----
assert: expectedType at: index

	self
		assert: [self contentType = expectedType]
		description: 'Wrong content type'.

	^ self at: index!

----- Method: ExternalData>>assert:at:put: (in category 'accessing') -----
assert: expectedType at: index put: value

	self
		assert: [self contentType = expectedType]
		description: 'Wrong content type'.

	^ self at: index put: value!

----- Method: ExternalData>>assureLocal (in category 'copying') -----
assureLocal

	^ handle isExternalAddress
		ifTrue: [self copy]
		ifFalse: [self]!

----- Method: ExternalData>>at: (in category 'accessing') -----
at: index

	ExtraSizeChecks == true ifTrue: [self sizeCheck: index].

	^ self contentType
		handle: handle
		atIndex: index!

----- Method: ExternalData>>at:put: (in category 'accessing') -----
at: index put: value

	ExtraSizeChecks == true ifTrue: [self sizeCheck: index].
	
	^ self contentType
		handle: handle
		atIndex: index
		put: value!

----- Method: ExternalData>>atAllPut: (in category 'accessing') -----
atAllPut: anObject

	self sizeCheck.	
	1 to: self size do:
		[:index | self at: index put: anObject].!

----- Method: ExternalData>>booleanAt: (in category 'accessing - atomic values') -----
booleanAt: index

	^ self
		assert: ExternalType bool
		at: index!

----- Method: ExternalData>>booleanAt:put: (in category 'accessing - atomic values') -----
booleanAt: index put: value

	^ self
		assert: ExternalType bool
		at: index
		put: value!

----- Method: ExternalData>>byteSize (in category 'accessing') -----
byteSize
	"Answer how many bytes the receiver manages."

	| ct myBytes |
	self isNull ifTrue: [^ 0].
	self size ifNil: [^ nil "We don't know"].
	
	myBytes := self size * (ct := self contentType) byteSize.

	^ ct isPointerType
		ifTrue: [
			ct asNonPointerType isVoid ifTrue: [nil] ifFalse: [
				"Locally managed pointers do not count. See ByteArray >> #isNull."
				(handle isExternalAddress ifTrue: [myBytes] ifFalse: [0])
					+ (self reader collect: [:each | each byteSize]) sum ]]
		ifFalse: [ myBytes ]!

----- Method: ExternalData>>collect: (in category 'enumerating') -----
collect: aBlock
	"See Collection >> #collect:."
	
	| newCollection |
	self sizeCheck.
	newCollection := Array new: self size.
	1 to: self size do:
		[:index |
		newCollection at: index put: (aBlock value: (self at: index))].
	^ newCollection!

----- Method: ExternalData>>containerType (in category 'accessing - types') -----
containerType "^ <ExternalArrayType>"
	"Answer the current container type, which may or may not have a known #size and #byteSize."
	
	self typeCheck.
	^ type!

----- Method: ExternalData>>contentType (in category 'accessing - types') -----
contentType "^ <ExternalType>"
	"Answer the content type for the current container type."

	^ contentType ifNil: [
		contentType := self arrayType
			ifNil: [ExternalType void]
			ifNotNil: [:arrayType | arrayType contentType]]!

----- Method: ExternalData>>contentTypeCheck (in category 'private') -----
contentTypeCheck

	self contentType isVoid ifTrue: [
		self error: 'You cannot do that for void content.'].!

----- Method: ExternalData>>copy (in category 'copying') -----
copy
	"Overwritten to obey #useArrayClasses preference."
	
	self sizeCheck.
	ExternalType useArrayClasses ifTrue: [
		(self contentType allocateArrayClass: self size)
			ifNotNil: [:array | 
				self withIndexDo: [:each :index |
					array at: index put: each].
				^ array]].
		
	^ super copy!

----- Method: ExternalData>>copyFrom:to: (in category 'accessing') -----
copyFrom: firstIndex to: lastIndex

	^ (self from: firstIndex to: lastIndex) copy!

----- Method: ExternalData>>detect:ifFound: (in category 'enumerating') -----
detect: aBlock ifFound: foundBlock
	"DANGEROUS for unknown size!!"

	self class allowDetectForUnknownSize
		ifFalse: [self sizeCheck].

	self size
		ifNotNil: [
			self detect: aBlock ifFound: foundBlock ifNone: nil]
		ifNil: [ | index each |
			index := 1.
			[each := self at: index.
			(aBlock value: each)
				ifTrue: [^ foundBlock value: each]
				ifFalse: [index := index + 1. false]]
					whileFalse].!

----- Method: ExternalData>>detect:ifFound:ifNone: (in category 'enumerating') -----
detect: aBlock ifFound: foundBlock ifNone: exceptionBlock

	self sizeCheck.
	self do: [:each | (aBlock value: each) ifTrue: [^ foundBlock value: each]].
	^ exceptionBlock value!

----- Method: ExternalData>>detect:ifNone: (in category 'enumerating') -----
detect: aBlock ifNone: exceptionBlock 

	^ self
		detect: aBlock
		ifFound: [:element | element]
		ifNone: exceptionBlock!

----- Method: ExternalData>>do: (in category 'enumerating') -----
do: aBlock
	"See Collection >> #collect:."

	self sizeCheck.	
	1 to: self size do:
		[:index | aBlock value: (self at: index)].!

----- Method: ExternalData>>doubleAt: (in category 'accessing - atomic values') -----
doubleAt: index

	^ self
		assert: ExternalType double
		at: index!

----- Method: ExternalData>>doubleAt:put: (in category 'accessing - atomic values') -----
doubleAt: index put: value

	^ self
		assert: ExternalType double
		at: index
		put: value!

----- Method: ExternalData>>eighth (in category 'accessing - convenience') -----
eighth

	^ self at: 8!

----- Method: ExternalData>>externalType (in category 'accessing - types') -----
externalType "^ <ExternalType>"
	"Overwritten to answer our #containerType, which is important so that clients can then send #byteSize to the result."

	^ handle isExternalAddress
		ifTrue: [self containerType asPointerType]
		ifFalse: [self containerType asNonPointerType]!

----- Method: ExternalData>>ffiEqual: (in category 'comparing') -----
ffiEqual: other
	"WARNING!! EXPENSIVE!! We can compare bytes if the types are compatible."
	
	(self ffiIdentical: other) ifTrue: [^ true].
	
	self flag: #todo. "mt: Which types are actually compatible? :-)"
	self externalType asNonPointerType = other externalType asNonPointerType ifFalse: [^ false].
	
	self flag: #todo. "mt: Follow pointers? Detect cycles? Hmmm... :-) See #free as inspiration."
	^ self assureLocal getHandle ffiEqual: other assureLocal getHandle!

----- Method: ExternalData>>ffiEqualityHash (in category 'comparing') -----
ffiEqualityHash
	"WARNING!! EXPENSIVE!!"
	
	self ffiIdentityHash
		bitXor: self assureLocal getHandle hash!

----- Method: ExternalData>>fifth (in category 'accessing - convenience') -----
fifth

	^ self at: 5!

----- Method: ExternalData>>first (in category 'accessing - convenience') -----
first

	^ self at: 1!

----- Method: ExternalData>>first: (in category 'accessing') -----
first: n
	"Answer the first n elements of the receiver."
	
	^ self from: 1 to: n!

----- Method: ExternalData>>floatAt: (in category 'accessing - atomic values') -----
floatAt: index

	^ self
		assert: ExternalType float
		at: index!

----- Method: ExternalData>>floatAt:put: (in category 'accessing - atomic values') -----
floatAt: index put: value

	^ self
		assert: ExternalType float
		at: index
		put: value!

----- Method: ExternalData>>fourth (in category 'accessing - convenience') -----
fourth

	^ self at: 4!

----- Method: ExternalData>>free (in category 'initialize-release') -----
free

	| ct |
	self size ifNil: [^ super free "We don't know better"].

	self flag: #todo. "mt: Add support for cycles. This simplification relies on the reuse of ExternalAddress and ByteArrayPointer, which is not the case. Double-free might happen for cycling structures."
	((ct := self contentType) isPointerType)
		ifTrue: [self reader collect: [:each | each free]].

	super free.
	self setSize: nil.!

----- Method: ExternalData>>from: (in category 'accessing') -----
from: firstIndex
	"Move the start of this array. Size not needed."

	| byteOffset numElements byteSize |
	byteOffset := ((firstIndex-1) * self contentType byteSize)+1.
	numElements := (self size ifNotNil: [:sz | sz - firstIndex + 1 max: 0]).
	byteSize := numElements
		ifNil: [self contentType byteSize]
		ifNotNil: [numElements * self contentType byteSize].

	^ ExternalData
		fromHandle: (handle memoryAt: byteOffset length: (byteSize ifNil: [1]))
		type: self contentType
		size: numElements!

----- Method: ExternalData>>from:to: (in category 'accessing') -----
from: firstIndex to: lastIndex
	"Only copy data if already in object memory, that is, as byte array. Only check size if configured."

	| byteOffset numElements byteSize |
	ExtraSizeChecks == true ifTrue: [
		self sizeCheck: firstIndex.
		self sizeCheck: lastIndex].

	byteOffset := ((firstIndex-1) * self contentType byteSize)+1.
	numElements := lastIndex - firstIndex + 1 max: 0.
	byteSize := numElements * self contentType byteSize.

	^ ExternalData
		fromHandle: (handle memoryAt: byteOffset length: byteSize)
		type: self contentType
		size: numElements!

----- Method: ExternalData>>fromCString (in category 'accessing - unsafe') -----
fromCString
	"Read a NUL-terminated string"

	self
		assert: [self mightBeCString]
		description: 'Wrong content type'.
	
	^ String streamContents: [:stream |
		self
			detect: [:char | 
				char == Character null ifTrue: [true] ifFalse: [
					stream nextPut: char.
					false]]
			ifFound: [:char | "finished"]]!

----- Method: ExternalData>>fromCStrings (in category 'accessing - unsafe') -----
fromCStrings	
	"Read a list of double-null terminated strings.
	
	https://devblogs.microsoft.com/oldnewthing/20110511-00/?p=10693
	http://web.archive.org/web/20100103003417/http://blogs.msdn.com/oldnewthing/archive/2009/10/08/9904646.aspx"

	self
		assert: [self mightBeCString]
		description: 'Wrong content type'.
		
	^ Array streamContents: [:list | String streamContents: [:element |
		| lastChar |
		lastChar := nil.
		self
			detect: [:char |
				(lastChar == Character null and: [char == Character null])
					ifTrue: [true] ifFalse: [
						char == Character null
							ifTrue: [
								list nextPut: element contents.
								element reset]
							ifFalse: [
								element nextPut: char].
						lastChar := char. false]]
			ifFound: [:char | "finished"]]].!

----- Method: ExternalData>>isFFIArray (in category 'testing') -----
isFFIArray

	^ true!

----- Method: ExternalData>>isNull (in category 'testing') -----
isNull
	
	handle isNil ifTrue:[^ true "internal memory already free'd"].
	handle isNull ifTrue: [^ true "external address already free'd"].
	
	self size ifNil: [^ false "we don't know better"].
	
	^ false!

----- Method: ExternalData>>isSequenceable (in category 'testing') -----
isSequenceable
	"The receiver implements #at: and #at:put:."
	
	^ true!

----- Method: ExternalData>>last: (in category 'accessing') -----
last: n
	"Answer the last n elements of the receiver."
	
	| sz |
	self sizeCheck.
	^ self from: (sz := self size) - n + 1 to: sz!

----- Method: ExternalData>>mightBeCString (in category 'testing') -----
mightBeCString

	^ self contentType isCharType and: [self size isNil]!

----- Method: ExternalData>>ninth (in category 'accessing - convenience') -----
ninth

	^ self at: 9!

----- Method: ExternalData>>pointerAt: (in category 'accessing - pointers') -----
pointerAt: index

	self assert: [self contentType isPointerType].
	^ self at: index!

----- Method: ExternalData>>pointerAt:put: (in category 'accessing - pointers') -----
pointerAt: index put: value

	self assert: [self contentType isPointerType].
	^ self at: index put: value!

----- Method: ExternalData>>postCopy (in category 'copying') -----
postCopy
	"Reads all bytes from external into object memory or duplicate the array within object memory. Note that this does not flatten all bytes into a single array by repeatedly calling it."

	| newHandle numBytes |
	self sizeCheck.
	
	numBytes := self byteSize.
	newHandle := ByteArray new: numBytes.
	newHandle memoryAt: 1 put: handle length: numBytes.
	
	handle := newHandle.
	self setType: type. "Change container type from pointer to non-pointer type."!

----- Method: ExternalData>>printContentTypeOn: (in category 'printing') -----
printContentTypeOn: stream

	stream
		nextPut: $<;
		print: self contentType;
		nextPut: $>.!

----- Method: ExternalData>>printOn: (in category 'printing') -----
printOn: stream

	super printOn: stream.
	self printContentTypeOn: stream.!

----- Method: ExternalData>>reject: (in category 'enumerating') -----
reject: aBlock
	"See Collection >> #reject:."
	
	^ self select: [:each | (aBlock value: each) not]!

----- Method: ExternalData>>second (in category 'accessing - convenience') -----
second

	^ self at: 2!

----- Method: ExternalData>>select: (in category 'enumerating') -----
select: aBlock
	"See Collection >> #select:."
	
	^ Array streamContents: [:stream |
		self do: [:each | (aBlock value: each)
			ifTrue: [stream nextPut: each]]]!

----- Method: ExternalData>>setContentType: (in category 'initialize-release') -----
setContentType: externalType

	| newContentType |
	(newContentType := externalType) isStringType ifTrue: [
		newContentType := newContentType asNonPointerType].

	self setType: (newContentType isVoid
		ifTrue: [newContentType "Size gets lost for void."]
		ifFalse: [newContentType asArrayType: self size]).!

----- Method: ExternalData>>setHandle:type: (in category 'private') -----
setHandle: aHandle type: containerType

	self setHandle: aHandle.
	self setType: containerType.!

----- Method: ExternalData>>setHandle:type:size: (in category 'private') -----
setHandle: aHandle type: contentType size: numElements

	self
		setHandle: aHandle
		type: (contentType asArrayType: numElements).!

----- Method: ExternalData>>setSize: (in category 'initialize-release') -----
setSize: numElements
	"Set the size for the receiver, which will be used when enumerating its elements."

	self contentTypeCheck.
	self setType: (self contentType asArrayType: numElements).!

----- Method: ExternalData>>setType: (in category 'private') -----
setType: externalType
	"Private. Set the type used to derive content and container types. If you want to change the content type later, use #setContentType:."

	| newType isVoid |
	(newType := externalType) isStringType ifTrue: [
		newType := newType asNonPointerType].

	(isVoid := newType isVoid) ifTrue: [
		newType := newType asPointerType].

	(newType isArrayType or: [isVoid or: [newType asNonPointerType isVoid]])
		ifTrue: [type := newType "array type or void*"]
		ifFalse: [type := (newType asArrayType: nil)].
		
	contentType := nil.!

----- Method: ExternalData>>seventh (in category 'accessing - convenience') -----
seventh

	^ self at: 7!

----- Method: ExternalData>>signedByteAt: (in category 'accessing - atomic values') -----
signedByteAt: index

	^ self
		assert: ExternalType signedByte
		at: index!

----- Method: ExternalData>>signedByteAt:put: (in category 'accessing - atomic values') -----
signedByteAt: index put: value

	^ self
		assert: ExternalType signedByte
		at: index
		put: value!

----- Method: ExternalData>>signedCharAt: (in category 'accessing - atomic values') -----
signedCharAt: index

	^ self
		assert: ExternalType signedChar
		at: index!

----- Method: ExternalData>>signedCharAt:put: (in category 'accessing - atomic values') -----
signedCharAt: index put: value

	^ self
		assert: ExternalType signedChar
		at: index
		put: value!

----- Method: ExternalData>>signedLongAt: (in category 'accessing - atomic values') -----
signedLongAt: index

	^ self
		assert: ExternalType signedLong
		at: index!

----- Method: ExternalData>>signedLongAt:put: (in category 'accessing - atomic values') -----
signedLongAt: index put: value

	^ self
		assert: ExternalType signedLong
		at: index
		put: value!

----- Method: ExternalData>>signedLongLongAt: (in category 'accessing - atomic values') -----
signedLongLongAt: index

	^ self
		assert: ExternalType signedLongLong
		at: index!

----- Method: ExternalData>>signedLongLongAt:put: (in category 'accessing - atomic values') -----
signedLongLongAt: index put: value

	^ self
		assert: ExternalType signedLongLong
		at: index
		put: value!

----- Method: ExternalData>>signedShortAt: (in category 'accessing - atomic values') -----
signedShortAt: index

	^ self
		assert: ExternalType signedShort
		at: index!

----- Method: ExternalData>>signedShortAt:put: (in category 'accessing - atomic values') -----
signedShortAt: index put: value

	^ self
		assert: ExternalType signedShort
		at: index
		put: value!

----- Method: ExternalData>>sixth (in category 'accessing - convenience') -----
sixth

	^ self at: 6!

----- Method: ExternalData>>size (in category 'accessing') -----
size
	"Answer how many elements the receiver contains. Support void type."

	^ self arrayType ifNotNil: [:arrayType | arrayType size]!

----- Method: ExternalData>>sizeCheck (in category 'private') -----
sizeCheck

	self size ifNil: [self error: 'Size is unknown for this data'].!

----- Method: ExternalData>>sizeCheck: (in category 'private') -----
sizeCheck: index
	"Negative indices should work to move back-and-forth in the memory."
	
	| sz |
	((sz := self size) notNil and: [index > sz])
		ifTrue: [^ self errorSubscriptBounds: index].!

----- Method: ExternalData>>third (in category 'accessing - convenience') -----
third

	^ self at: 3!

----- Method: ExternalData>>toCString: (in category 'accessing - unsafe') -----
toCString: aString
	"Write a NUL-terminated string"

	self
		assert: [self contentType = ExternalType char]
		description: 'Wrong content type'.
	
	self
		assert: [self size = (aString size + 1)]
		description: 'Wrong size'.
	
	aString withIndexDo: [:char :index |
		self at: index put: char].
	self at: aString size + 1 put: Character null.
	
	self setSize: nil. "See #mightBeCString."!

----- Method: ExternalData>>typeCheck (in category 'private') -----
typeCheck
	"Check type. If you happen to have a regular pointer type here, convert it into array type of unknown size. This can happen for result values of FFI calls if the signature did not specify, e.g., 'int[]' but 'int*'."
	
	type asNonPointerType isVoid "void*"
		ifTrue: [^ self].
	
	type isArrayType
		ifFalse: [self setType: type "int*" asNonPointerType "int ... to become int[], not int*[]"].!

----- Method: ExternalData>>unsignedByteAt: (in category 'accessing - atomic values') -----
unsignedByteAt: index

	^ self
		assert: ExternalType unsignedByte
		at: index!

----- Method: ExternalData>>unsignedByteAt:put: (in category 'accessing - atomic values') -----
unsignedByteAt: index put: value

	^ self
		assert: ExternalType unsignedByte
		at: index
		put: value!

----- Method: ExternalData>>unsignedCharAt: (in category 'accessing - atomic values') -----
unsignedCharAt: index

	^ self
		assert: ExternalType unsignedChar
		at: index!

----- Method: ExternalData>>unsignedCharAt:put: (in category 'accessing - atomic values') -----
unsignedCharAt: index put: value

	^ self
		assert: ExternalType unsignedChar
		at: index
		put: value!

----- Method: ExternalData>>unsignedLongAt: (in category 'accessing - atomic values') -----
unsignedLongAt: index

	^ self
		assert: ExternalType unsignedLong
		at: index!

----- Method: ExternalData>>unsignedLongAt:put: (in category 'accessing - atomic values') -----
unsignedLongAt: index put: value

	^ self
		assert: ExternalType unsignedLong
		at: index
		put: value!

----- Method: ExternalData>>unsignedLongLongAt: (in category 'accessing - atomic values') -----
unsignedLongLongAt: index

	^ self
		assert: ExternalType unsignedLongLong
		at: index!

----- Method: ExternalData>>unsignedLongLongAt:put: (in category 'accessing - atomic values') -----
unsignedLongLongAt: index put: value

	^ self
		assert: ExternalType unsignedLongLong
		at: index
		put: value!

----- Method: ExternalData>>unsignedShortAt: (in category 'accessing - atomic values') -----
unsignedShortAt: index

	^ self
		assert: ExternalType unsignedShort
		at: index!

----- Method: ExternalData>>unsignedShortAt:put: (in category 'accessing - atomic values') -----
unsignedShortAt: index  put: value

	^ self
		assert: ExternalType unsignedShort
		at: index
		put: value!

----- Method: ExternalData>>value (in category 'accessing - globals') -----
value
	"For convenience. Assume that the external data is just one global variable. Answer the value of that global variable."
	
	^ self at: 1!

----- Method: ExternalData>>value: (in category 'accessing - globals') -----
value: aValue
	"For convenience. Assume that the external data is just one global variable. Set the value of that global variable."

	self at: 1 put: aValue.!

----- Method: ExternalData>>voidAt: (in category 'accessing - atomic values') -----
voidAt: index
	"no accessors for void"
	^self shouldNotImplement!

----- Method: ExternalData>>voidAt:put: (in category 'accessing - atomic values') -----
voidAt: index put: value
	"no accessors for void"
	^self shouldNotImplement!

----- Method: ExternalData>>withIndexCollect: (in category 'enumerating') -----
withIndexCollect: elementAndIndexBlock
	"See SequenceableCollection >> #withIndexCollect:."
	
	| newCollection |
	self sizeCheck.
	newCollection := Array new: self size.
	1 to: self size do:
		[:index |
		newCollection at: index put:
		(elementAndIndexBlock
			value: (self at: index)
			value: index)].
	^ newCollection!

----- Method: ExternalData>>withIndexDo: (in category 'enumerating') -----
withIndexDo: elementAndIndexBlock
	"See SequenceableCollection >> #withIndexDo:."

	self sizeCheck.	
	1 to: self size do:
		[:index |
		elementAndIndexBlock
			value: (self at: index)
			value: index].!

----- Method: ExternalData>>writer (in category 'accessing') -----
writer
	"Overwritten to preserve type."

	^ (self isNull or: [handle isExternalAddress])
		ifTrue: [self]
		ifFalse: [self class fromHandle: (ByteArrayReadWriter on: handle) type: type]!

----- Method: ExternalData>>zeroMemory (in category 'initialize-release') -----
zeroMemory
	"Remove all information but keep the memory allocated. Supports an array of pointers."

	| ct |
	self isNull ifTrue: [^ self].
	self sizeCheck.
	
	((ct := self contentType) isPointerType)
		ifTrue: [self writer do: [:each | each zeroMemory]]
		ifFalse: [handle zeroMemory: self size * ct byteSize].!

ExternalStructure subclass: #ExternalPackedStructure
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'FFI-Kernel'!

!ExternalPackedStructure commentStamp: 'eem 6/27/2019 12:47' prior: 0!
An ExternalPackedStructure is a variation on ExternalStructure that ignores the alignment requirements of its types and aligns them on a specific alignment that defaults to 1.  Subclasses wishing to use a different packing should override the class side alignment methods as required, see ExternalStructure class methods for alignment.!

----- Method: ExternalPackedStructure class>>isSkipped (in category 'field definition') -----
isSkipped

	^ self == ExternalPackedStructure!

----- Method: ExternalPackedStructure class>>maxFieldAlignment (in category 'alignment') -----
maxFieldAlignment
	^ 1!

----- Method: ExternalStructure class>>allStructuresInCompilationOrder (in category 'system startup') -----
allStructuresInCompilationOrder
	"Answers a list of all known structure (and packed structures and unions) in ascending order of field compilation."
	
	| unordered ordered |
	self == ExternalStructure
		ifFalse: [self error: 'Correct compilation order cannot be guaranteed for a partial list of structure classes.'].
	
	unordered :=  self allSubclasses reject: [:ea | ea isSkipped].
	ordered := OrderedCollection new: unordered size.
	
	[unordered notEmpty] whileTrue:
		[ | structClass prevStructClass references |
		structClass := unordered anyOne.

		[references := structClass referencedTypeNames.
		references := references collect: [:ea | ExternalType parseBasicTypeName: ea].
		prevStructClass := unordered detect: [:c | c ~~ structClass and: [references includes: c name]] ifNone: [nil].
		prevStructClass isNil]
			whileFalse: [structClass := prevStructClass].

		"we found a structure/alias which does not depend on other structures/aliases"
		ordered add: (unordered remove: structClass)].
	
	^ ordered!

----- Method: ExternalStructure class>>allocate (in category 'instance creation') -----
allocate

	^self externalType allocate!

----- Method: ExternalStructure class>>allocate: (in category 'instance creation') -----
allocate: anInteger
	"Create an ExternalData with enough room for storing an array of size anInteger of such structure"
	^self externalType allocate: anInteger!

----- Method: ExternalStructure class>>allocateExternal (in category 'instance creation') -----
allocateExternal

	^ self externalType allocateExternal!

----- Method: ExternalStructure class>>allocateExternal: (in category 'instance creation') -----
allocateExternal: anInteger
	"Create an ExternalData with enough room for storing an array of size anInteger of such structure. Don't forget to free the allocated memory!!!!!!"
	^self externalType allocateExternal: anInteger!

----- Method: ExternalStructure class>>byteAlignment (in category 'external type') -----
byteAlignment
	^ byteAlignment!

----- Method: ExternalStructure class>>compileAllFields (in category 'system startup') -----
compileAllFields

	self deprecated: 'Use #defineAllFields.'.
	self defineAllFields.!

----- Method: ExternalStructure class>>compileFields (in category 'field definition') -----
compileFields

	self deprecated: 'Use #defineFields'.
	self defineFields.!

----- Method: ExternalStructure class>>compileFields: (in category 'field definition') -----
compileFields: fieldSpec

	self deprecated: 'Use #defineFields:'.
	self defineFields: fieldSpec.!

----- Method: ExternalStructure class>>compileFields:generateAccessors: (in category 'field definition - support') -----
compileFields: specArray generateAccessors: aSymbol 
	"Private. Use #compileFields or #defineFields. Compile a type specification for the FFI calls.
	
	Eventually generate the field accessors according to following rules:
	- aSymbol = #always always generate the accessors
	- aSymbol = #never never generate the accessors
	- aSymbol = #ifGenerated only generate the auto-generated accessors
	- aSymbol = #ifAbsent only generate the absent accessors"
	
	(self isTypeAlias: specArray)
		ifTrue: [self compileTypeAliasSpec: specArray generateAccessors: aSymbol]
		ifFalse: [self compileStructureSpec: specArray generateAccessors: aSymbol]!

----- Method: ExternalStructure class>>compileStructureSpec:generateAccessors: (in category 'field definition - support') -----
compileStructureSpec: specArray generateAccessors: aSymbol 
	"Compile a type specification for the FFI calls.
	Return the newly compiled spec.
	
	Eventually generate the field accessors according to following rules:
	- aSymbol = #always always generate the accessors
	- aSymbol = #never never generate the accessors
	- aSymbol = #ifGenerated only generate the auto-generated accessors
	- aSymbol = #ifAbsent only generate the absent accessors"
	
	| newByteAlignment byteOffset typeSpec newCompiledSpec |
	byteOffset := 0.
	newByteAlignment := self minStructureAlignment.
	typeSpec := WriteStream on: (WordArray new: 10).
	typeSpec nextPut: FFIFlagStructure.
	specArray do: [:spec |
		| fieldName fieldTypeName externalType typeSize fieldAlignment |
		fieldName := spec first.
		fieldTypeName := spec second.
		externalType := (ExternalType typeNamed: fieldTypeName)
			ifNil: [self errorTypeNotFound: spec second].
		typeSize := externalType byteSize.
		fieldAlignment := (externalType byteAlignment
			max: self minFieldAlignment)
			min: self maxFieldAlignment.
		byteOffset := byteOffset alignedTo: fieldAlignment.
		newByteAlignment := newByteAlignment max: fieldAlignment.
		spec size > 2 ifTrue: ["extra size"
			spec third < typeSize
				ifTrue: [^ self error: 'Explicit type size is less than expected'].
			typeSize := spec third.
		].
		(fieldName notNil and: [self shouldGenerateAccessorsFor: fieldName policy: aSymbol]) ifTrue: [
			self generateStructureFieldAccessorsFor: fieldName startingAt: byteOffset + 1 type: externalType.
		].
		typeSpec nextPutAll: (externalType embeddedSpecWithSize: typeSize).
		byteOffset := byteOffset + typeSize.
		].
	newByteAlignment := newByteAlignment min: self maxStructureAlignment.
	byteOffset := byteOffset alignedTo: newByteAlignment.
	newCompiledSpec := typeSpec contents.
	newCompiledSpec at: 1 put: (byteOffset bitOr: FFIFlagStructure).
	self
		setCompiledSpec: newCompiledSpec
		byteAlignment: newByteAlignment.!

----- Method: ExternalStructure class>>compileTypeAliasSpec:generateAccessors: (in category 'field definition - support') -----
compileTypeAliasSpec: spec generateAccessors: aSymbol
	"Define all the fields in the receiver.
	Return the newly compiled spec."
	| fieldName fieldTypeName externalType |
	fieldName := spec first.
	fieldTypeName := spec second.
	externalType := (ExternalType typeNamed: fieldTypeName)
		ifNil: [self errorTypeNotFound: spec second].
	(fieldName notNil and:[self shouldGenerateAccessorsFor: fieldName policy: aSymbol]) ifTrue:[
		self generateTypeAliasAccessorsFor: fieldName type: externalType].
	externalType isPointerType
		ifTrue: ["Special case. Typedef for a pointer type, e.g., typedef char* LPSTR in Win32 API. Mark it as both structure and pointer. Note that #isPointerType will only answer true for the in-image pointer type, not the non-pointer alias for the pointer."
			self
				setCompiledSpec: (WordArray with: ExternalType pointerAliasSpec)
				byteAlignment: ExternalType pointerAliasAlignment]
		ifFalse: ["Usual case. Typedef for another struct type or atomic type. Just re-use compiled spec and extras from the aliased type."
			self
				flag: #isTypeAlias;
				setCompiledSpec: externalType compiledSpec
				byteAlignment: externalType byteAlignment].!

----- Method: ExternalStructure class>>compiledSpec (in category 'external type') -----
compiledSpec
	^compiledSpec!

----- Method: ExternalStructure class>>defineAllChangedFields (in category 'system startup') -----
defineAllChangedFields
	"
	ExternalStructure defineAllChangedFields
	"
	self allStructuresInCompilationOrder do: [:structClass |
		structClass defineChangedFields.
		structClass organization removeEmptyCategories].
	
	"No #cleanupUnusedTypes because this method must be fast. See ExternalType class >> #initializeFast."!

----- Method: ExternalStructure class>>defineAllFields (in category 'system startup') -----
defineAllFields
	"
	ExternalStructure defineAllFields
	"
	self allStructuresInCompilationOrder do: [:structClass |
		structClass defineFields.
		structClass organization removeEmptyCategories].

	"Compilation of fields only needs external types temporarily. Non-weak references to external types are only in methods with FFI calls."
	ExternalType cleanupUnusedTypes.!

----- Method: ExternalStructure class>>defineChangedFields (in category 'field definition') -----
defineChangedFields
	"Public. Define all the fields in the receiver. Only re-generate changed field accessors if auto-generated in the first place."

	self isSkipped ifTrue: [^ nil].
	self hasFieldLayoutChanged ifTrue: [self defineFields].!

----- Method: ExternalStructure class>>defineChangedFields: (in category 'field definition') -----
defineChangedFields: fieldSpec
	"Public. Define all the fields in the receiver. Only re-generate changed field accessors if auto-generated in the first place."

	self isSkipped ifTrue: [^ nil].
	(self hasFieldLayoutChanged: fieldSpec) ifTrue: [self defineFields: fieldSpec].!

----- Method: ExternalStructure class>>defineFields (in category 'field definition') -----
defineFields
	"Public. Define all the fields in the receiver. Always re-generate changed field accessors, even if not auto-generated in the first place."

	self isSkipped ifTrue: [^ self].
	self defineFields: self fields.!

----- Method: ExternalStructure class>>defineFields: (in category 'field definition') -----
defineFields: fieldSpec
	"Private. Use #defineFields."
	
	self compileFields: fieldSpec generateAccessors: #ifGenerated.
	ExternalType noticeModificationOf: self.!

----- Method: ExternalStructure class>>defineFieldsSafely (in category 'field definition') -----
defineFieldsSafely

	[self defineFields]
		ifError: [:msg | Transcript showln: '[FFI] Field definition failed: ', msg].!

----- Method: ExternalStructure class>>doneCompiling (in category 'class management') -----
doneCompiling
	"Base class changed to something that is an external structure now. This is also the post-load hook for Monticello; see MCMethodDefinition >> #postLoad."

	self isSkipped ifTrue: [^ self].
	ExternalStructure triggerDefineAllChangedFields.!

----- Method: ExternalStructure class>>errorTypeNotFound: (in category 'field definition - support') -----
errorTypeNotFound: typeName

	self error: ('Unknown external type ''{1}''. If it is a structure type, create a class for that structure first.' format: {typeName}).!

----- Method: ExternalStructure class>>externalNew (in category 'instance creation') -----
externalNew
	"Create an instance of the receiver on the external heap"

	^ self allocateExternal!

----- Method: ExternalStructure class>>externalType (in category 'external type') -----
externalType
	"Return an external type describing the receiver as a structure"
	^ExternalType structTypeNamed: self name!

----- Method: ExternalStructure class>>fields (in category 'field definition') -----
fields
	"Return the fields defining the receiver. By default, return an empty array, which means that only the pointer type of this external structure should be used."
	
	^#()!

----- Method: ExternalStructure class>>fileOutInitializerOn: (in category 'class management') -----
fileOutInitializerOn: aFileStream
	super fileOutInitializerOn: aFileStream.
	aFileStream cr.
	aFileStream cr.
	aFileStream nextChunkPut: self name , ' compileFields'.
	aFileStream cr.!

----- Method: ExternalStructure class>>fileOutOn:moveSource:toFile:initializing: (in category 'class management') -----
fileOutOn: aFileStream moveSource: moveSource toFile: fileIndex initializing: aBool
	super fileOutOn: aFileStream
		moveSource: moveSource
		toFile: fileIndex
		initializing: aBool.
	(aBool and:[moveSource not]) ifTrue: 
		[aFileStream cr.
		aFileStream cr.
		aFileStream nextChunkPut: self name , ' compileFields'.
		aFileStream cr]!

----- Method: ExternalStructure class>>fromHandle: (in category 'instance creation') -----
fromHandle: aHandle
	^self basicNew setHandle: aHandle!

----- Method: ExternalStructure class>>generateStructureFieldAccessorsFor:startingAt:type: (in category 'field definition - support') -----
generateStructureFieldAccessorsFor: fieldName startingAt: byteOffset type: type
	"Define read/write accessors for the given field"
	| comment argName |
	(type isVoid and: [type isPointerType not]) ifTrue:[^self].
	comment := String streamContents: [:strm |
		strm crtab; nextPutAll: '"This method was automatically generated. See '; nextPutAll: self class name; nextPutAll: '>>fields."'; crtab.
		strm nextPut: $<; nextPutAll: #generated; nextPut: $>; crtab.].
	self maybeCompileAccessor: fieldName, comment, (type readFieldAt: byteOffset)
		withSelector: fieldName asSymbol.
		
	argName := type writeFieldArgName.
		
	self maybeCompileAccessor: fieldName,': ', argName, comment, (type writeFieldAt: byteOffset with: argName)
		withSelector: (fieldName, ':') asSymbol!

----- Method: ExternalStructure class>>generateTypeAliasAccessorsFor:type: (in category 'field definition - support') -----
generateTypeAliasAccessorsFor: fieldName type: type
	"Define read/write accessors for the given field"
	| comment argName |
	(type isVoid and:[type isPointerType not])
		ifTrue:[^self error: 'Cannot read or write void fields'].
	
	comment := String streamContents: [:strm |
		strm crtab; nextPutAll: '"This method was automatically generated. See '; nextPutAll: self class name; nextPutAll: '>>fields."'; crtab.
		strm nextPut: $<; nextPutAll: #generated; nextPut: $>; crtab.].
	
	self
		maybeCompileAccessor: fieldName, comment, type readAlias
		withSelector: fieldName asSimpleGetter.

	argName := type writeFieldArgName.
	self
		maybeCompileAccessor: fieldName, ': ', argName, comment, (type writeAliasWith: argName)
		withSelector: fieldName asSimpleSetter.!

----- Method: ExternalStructure class>>hasFieldLayoutChanged (in category 'field definition - support') -----
hasFieldLayoutChanged
	"Answers whether all fields should be re-compiled (and hence accessors re-generated)."
	
	^ self hasFieldLayoutChanged: self fields!

----- Method: ExternalStructure class>>hasFieldLayoutChanged: (in category 'field definition - support') -----
hasFieldLayoutChanged: fieldSpec
	"Answers whether all fields should be re-compiled (and hence accessors re-generated). This is useful at system startup time if a platform change was detected, which can influence alignment and size of pointers.
	!!!!!! Note that this method depends on all referenced types to be checked for field-layout changes first !!!!!!"
	
	| oldCompiledSpec oldByteAlignment result |
	(oldCompiledSpec := self compiledSpec) ifNil: [^ true].
	(oldByteAlignment := self byteAlignment) ifNil: [^ true].
	
	self compileFields: fieldSpec generateAccessors: #never.
	self flag: #bug. "mt: Changed type aliasing for pointers not noticed unless that alias hides a pointer type."	
	result := self isTypeAlias or: [oldCompiledSpec ~= self compiledSpec].
	
	self
		setCompiledSpec: oldCompiledSpec
		byteAlignment: oldByteAlignment.

	^ result!

----- Method: ExternalStructure class>>isSkipped (in category 'field definition') -----
isSkipped

	^ self == ExternalStructure!

----- Method: ExternalStructure class>>isTypeAlias (in category 'type alias') -----
isTypeAlias
	
	^ self isTypeAlias: self fields!

----- Method: ExternalStructure class>>isTypeAlias: (in category 'type alias') -----
isTypeAlias: specArray
	"Answer whether this structure is an alias for another C type, enum, etc."
	"Example: #( nil 'long' )"
	
	^ (specArray size > 0 and: [specArray first class ~~ Array])!

----- Method: ExternalStructure class>>logAccessorSourceCode (in category 'preferences') -----
logAccessorSourceCode
	<preference: 'Log source code for generated accessors'
		categoryList: #('FFI Kernel')
		description: 'When true, keep the sources generated for struct-field accessors in the method trailer. While this might increase the image file notably, no sources file will be accessed for performance reasons. When false, only the decompiled sources will be available for those accessors.'
		type: #Boolean>
	^ LogAccessorSourceCode ifNil: [false]!

----- Method: ExternalStructure class>>logAccessorSourceCode: (in category 'preferences') -----
logAccessorSourceCode: aBoolean

	LogAccessorSourceCode = aBoolean ifTrue: [^ self].
	LogAccessorSourceCode := aBoolean.
	ExternalStructure defineAllFields.!

----- Method: ExternalStructure class>>maxFieldAlignment (in category 'alignment') -----
maxFieldAlignment
	"Answer the maximum alignment of structure fields.
	This is platform dependent.
	On x86, struct{float f; double d} will have different alignment:
	- on windows, d will be 8-byte aligned
	- on SysV linux/OSX, d will be 4 byte aligned
	There are some special types that may have higher alignment requirements
	- SSE vectors
	- jump_buf ...
	But we do not handle these types yet"
	FFIPlatformDescription current isWindows ifTrue: [^8].
	FFIPlatformDescription current isARM ifTrue: [^8].
	^ FFIPlatformDescription current wordSize!

----- Method: ExternalStructure class>>maxStructureAlignment (in category 'alignment') -----
maxStructureAlignment
	^ 16r100000!

----- Method: ExternalStructure class>>maybeCompileAccessor:withSelector: (in category 'field definition - support') -----
maybeCompileAccessor: newSourceString withSelector: selector
	"When logging is enabled, only compile if category or source changed."
	
	| log newCategory oldMethod newMethod |
	log := self logAccessorSourceCode.
	newCategory := #'*autogenerated - accessing'.
	
	(log and: [self includesSelector: selector]) ifTrue: [
		oldMethod := self compiledMethodAt: selector.
		((self organization categoryOfElement: selector) = newCategory
			and: [oldMethod trailer sourceCode = newSourceString])
				ifTrue: [^ self]].

	"Compile silently. No changeStamp. No access to sources file. Keep source code in method trailer."
	self compileSilently: newSourceString classified: newCategory.
	log ifTrue: [
		newMethod := self compiledMethodAt: selector.
		newMethod becomeForward: (newMethod copyWithSourceCode: newSourceString)].!

----- Method: ExternalStructure class>>minFieldAlignment (in category 'alignment') -----
minFieldAlignment
	^ 1!

----- Method: ExternalStructure class>>minStructureAlignment (in category 'alignment') -----
minStructureAlignment
	^ 1!

----- Method: ExternalStructure class>>new (in category 'instance creation') -----
new

	^ self allocate!

----- Method: ExternalStructure class>>obsolete (in category 'class management') -----
obsolete
	"The receiver is becoming obsolete. 
	NOTE: You if you remove the whole class category at once, you cannot
	assume that the ExternalType class is still present."

	Smalltalk at: #ExternalType ifPresent: [:class | class noticeRemovalOf: self].
	^ super obsolete!

----- Method: ExternalStructure class>>originalType (in category 'type alias') -----
originalType
	
	^ ExternalType typeNamed: self originalTypeName!

----- Method: ExternalStructure class>>originalTypeName (in category 'type alias') -----
originalTypeName
	
	| fieldSpec |
	fieldSpec := self fields.
	(self isTypeAlias: fieldSpec)
		ifFalse: [self error: 'This is not an alias.'].
	^ fieldSpec second!

----- Method: ExternalStructure class>>referencedTypeNames (in category 'system startup') -----
referencedTypeNames
	"Answer the set of type names my fields depend on, which can include names for pointer types, e.g., 'long*' or 'MyStruct*'."

	| fieldSpec |
	(fieldSpec := self fields) ifEmpty: [^ Set new].
	(self isTypeAlias: fieldSpec) ifTrue: [^ Set with: self originalTypeName].
	^fieldSpec collect: [:e | e second] as: Set!

----- Method: ExternalStructure class>>rename: (in category 'class management') -----
rename: aString
	| oldName |
	oldName := name.
	super rename: aString.
	oldName = name ifFalse:[ExternalType noticeRenamingOf: self from: oldName to: name].!

----- Method: ExternalStructure class>>setCompiledSpec:byteAlignment: (in category 'field definition - support') -----
setCompiledSpec: spec byteAlignment: alignment
	"Private. Store this structure's compiled spec and extras to be used when creating external types for this structure as required. See ExternalType class >> #newTypeNamed: and ExternalType >> #newReferentClass:. Note that this should only be called from the struct compiler; see #compile*Spec:withAccessors:."

	compiledSpec := spec.
	byteAlignment := alignment.!

----- Method: ExternalStructure class>>shouldGenerateAccessorsFor:policy: (in category 'field definition - support') -----
shouldGenerateAccessorsFor: fieldname policy: aSymbol 
	"Answer true if the field accessors must be compiled.
	Do so according to the following rules:
	- aSymbol = #always always generate the accessors
	- aSymbol = #never never generate the accessors
	- aSymbol = #ifGenerated only re-generate the auto-generated accessors
	- aSymbol = #ifAbsent only generate the absent accessors"
	aSymbol = #never ifTrue: [^ false].
	aSymbol = #always ifTrue: [^ true].
	aSymbol = #ifAbsent ifTrue: [^ (self methodDictionary includesKey: fieldname) not].
	aSymbol = #ifGenerated "includes #ifAbsent rule"
		ifTrue: [^ (self methodDictionary includesKey: fieldname) not
				or: [(self methodDictionary at: fieldname) hasPragma: #generated]].
	self error: 'unknown generation policy'!

----- Method: ExternalStructure class>>triggerDefineAllChangedFields (in category 'field definition - deferred') -----
triggerDefineAllChangedFields

	self environment at: #'FFIDeferredTask_DefineAllChangedFields' put: true.
	Project current addDeferredUIMessage: [self tryDefineAllChangedFields].!

----- Method: ExternalStructure class>>triggerDefineAllFields (in category 'field definition - deferred') -----
triggerDefineAllFields

	self environment at: #'FFIDeferredTask_DefineAllFields' put: true.
	Project current addDeferredUIMessage: [self tryDefineAllFields].!

----- Method: ExternalStructure class>>tryDefineAllChangedFields (in category 'field definition - deferred') -----
tryDefineAllChangedFields

	(self environment includesKey: #'FFIDeferredTask_DefineAllChangedFields')
		ifTrue: [self environment removeKey: #'FFIDeferredTask_DefineAllChangedFields']
		ifFalse: [^ self].
	
	self defineAllChangedFields.!

----- Method: ExternalStructure class>>tryDefineAllFields (in category 'field definition - deferred') -----
tryDefineAllFields

	(self environment includesKey: #'FFIDeferredTask_DefineAllFields')
		ifTrue: [self environment removeKey: #'FFIDeferredTask_DefineAllFields']
		ifFalse: [^ self].
	
	self defineAllFields.!

----- Method: ExternalStructure>>byteSize (in category 'accessing') -----
byteSize
	"Answer the number of bytes used for my contents. If my handle is null, I do not require any bytes. If my handle is not null, my type will know the required bytes for my contents."

	^ self isNull
		ifTrue: [0]
		ifFalse: [self externalType asNonPointerType "content type" byteSize]!

----- Method: ExternalStructure>>externalType (in category 'accessing') -----
externalType

	^ handle isExternalAddress
		ifTrue: [self class externalType asPointerType]
		ifFalse: [self class externalType asNonPointerType]!

----- Method: ExternalStructure>>ffiEqual: (in category 'comparing') -----
ffiEqual: other
	"We can compare bytes if the types are compatible."
	
	(self ffiIdentical: other) ifTrue: [^ true].
	self externalType asNonPointerType = other externalType asNonPointerType ifFalse: [^ false].
	^ (ExternalData with: self) ffiEqual: (ExternalData with: other)!

----- Method: ExternalStructure>>ffiEqualityHash (in category 'comparing') -----
ffiEqualityHash
	
	^ self ffiIdentityHash
		bitXor: (ExternalData with: self) ffiEqualityHash!

----- Method: ExternalStructure>>ffiIdentical: (in category 'comparing') -----
ffiIdentical: other
	"Overwritten to also check the receiver's external type."
	
	(super ffiIdentical: other) ifFalse: [^ false].
	^ self externalType = other externalType!

----- Method: ExternalStructure>>ffiIdentityHash (in category 'comparing') -----
ffiIdentityHash

	^ super ffiIdentityHash bitXor: self externalType scaledIdentityHash!

----- Method: ExternalStructure>>free (in category 'initialize-release') -----
free
	"Free the handle pointed to by the receiver"

	handle isExternalAddress
		ifTrue: [handle isNull ifFalse: [handle free]]
		ifFalse: [handle := nil].!

----- Method: ExternalStructure>>isNull (in category 'testing') -----
isNull

	^ (handle isExternalAddress and: [handle isNull])
		or: [handle isNil]!

----- Method: ExternalStructure>>longPrintOn: (in category 'printing') -----
longPrintOn: aStream 
	"Append to the argument, aStream, the names and values of all the record's variables."
	| fields |
	fields := self class fields.
	(fields isEmpty or: [fields first isNil])
		ifTrue: [fields := #()]
		ifFalse: [fields first isArray ifFalse: [fields := Array with: fields]].
	fields do: [ :field |
		field first ifNotNil:
			[aStream nextPutAll: field first; nextPut: $:; space; tab.
			(self perform: field first) printOn: aStream.
			aStream cr]].!

----- Method: ExternalStructure>>postCopy (in category 'copying') -----
postCopy
	"Copy external memory into object memory, shallowCopy otherwise."

	self externalType isPointerType
		ifTrue: [handle := (ExternalData with: self) postCopy getHandle]
		ifFalse: [handle := handle copy. "Materializes byte-array read-writer section if any"].!

----- Method: ExternalStructure>>printOn: (in category 'printing') -----
printOn: stream

	handle isExternalAddress
		ifTrue: [
			stream
				nextPutAll: '@ ';
				nextPutAll: self class name]
		ifFalse: [
			stream
				nextPutAll: '[ ';
				nextPutAll: self class name;
				nextPutAll: ' ]'].
	self isNull ifTrue: [
		^ stream nextPutAll: '<NULL>'].!

----- Method: ExternalStructure>>reader (in category 'accessing') -----
reader

	^ self writer!

----- Method: ExternalStructure>>writer (in category 'accessing') -----
writer

	^ (handle isExternalAddress or: [self isNull])
		ifTrue: [self]
		ifFalse: [self class fromHandle: (ByteArrayReadWriter on: handle)]!

----- Method: ExternalStructure>>zeroMemory (in category 'initialize-release') -----
zeroMemory
	"Remove all information but keep the memory allocated."

	handle zeroMemory: self byteSize.!

ExternalStructure subclass: #ExternalTypeAlias
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'FFI-Kernel'!

!ExternalTypeAlias commentStamp: 'mt 6/5/2020 18:42' prior: 0!
You can subclass from here to make type aliasing (i.e., "typedef long long_t" or "typdef long* long_ptr") more clear. My instances support MNU and #value to perform the "C type cast" equivalent to address the original type behind the alias.

Type aliasing works by re-using the compiledSpec of the original type. For pointer-type aliases, the compiledSpec will have flags for both structure and pointer raised BUT it will not appear as #isPointerType for the in-image FFI interface.!

----- Method: ExternalTypeAlias class>>fields (in category 'field definition') -----
fields
	"Do not overwrite this method. Just implement #originalTypeName."
	^ { #value. self originalTypeName }!

----- Method: ExternalTypeAlias class>>isSkipped (in category 'field definition') -----
isSkipped
	"Skip this class and all subclasses that have not yet implemented #originalTypeName."

	^ self == ExternalTypeAlias
		or: [(self class lookupSelector: #originalTypeName) hasLiteral: #subclassResponsibility]!

----- Method: ExternalTypeAlias class>>isTypeAlias (in category 'testing') -----
isTypeAlias

	^ true!

----- Method: ExternalTypeAlias class>>isTypeAlias: (in category 'testing') -----
isTypeAlias: fieldSpec

	^ true!

----- Method: ExternalTypeAlias class>>on: (in category 'instance creation') -----
on: externalObject

	^ self new
		value: externalObject;
		yourself!

----- Method: ExternalTypeAlias class>>originalTypeName (in category 'type alias') -----
originalTypeName
	
	self subclassResponsibility.!

----- Method: ExternalTypeAlias>>at: (in category 'proxy') -----
at: index
	"Compatibility for alias-to-array types."
	
	^ self value at: index!

----- Method: ExternalTypeAlias>>at:put: (in category 'proxy') -----
at: index put: object
	"Compatibility for alias-to-array types."
	
	^ self value at: index put: object!

----- Method: ExternalTypeAlias>>doesNotUnderstand: (in category 'proxy') -----
doesNotUnderstand: msg
	"Use aliases as transparent proxies."
	
	^ msg sendTo: self value!

----- Method: ExternalTypeAlias>>value (in category 'accessing') -----
value

	self subclassResponsibility.!

----- Method: ExternalTypeAlias>>value: (in category 'accessing') -----
value: externalObject

	self subclassResponsibility.!

ExternalStructure subclass: #ExternalUnion
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'FFI-Kernel'!

!ExternalUnion commentStamp: 'nice 4/13/2018 21:07' prior: 0!
An ExternalUnion is for representing external data that is a union of possible fields.
It corresponds to the C type union.
It reserves enough bytes of data for representing the largest field.

A specific union is defined by subclassing ExternalUnion and specifying its #fields via a class side.

For example if we define a subclass:
	ExternalUnion subclass: #UnionExample
		instanceVariableNames: ''
		classVariableNames: ''
		poolDictionaries: ''
		category: 'garbage'.
Then set the fields like this:
    UnionExample class compile: 'fields  ^#( (name ''char*'') (color ''ulong'') )' classified: 'garbage'.

It means that this type will represents
- either a string (accessed thru the field #name)
- or an unsigned 32bit integer (accessed thru the field #color).

It represents the following C type:
   union UnionExample {char *name; uint32_t color; };

The accessors for those fields can be generated automatically like this:
	UnionExample defineFields.
As can be verified in a Browser:
	UnionExample browse.
We see that color and name fields both interpret the same zone of data (starting at 1st byte), but with a different interpretation.
The size of the union can be verified with:
	UnionExample byteSize = (Smalltalk wordSize max: 4).!

----- Method: ExternalUnion class>>compileStructureSpec:generateAccessors: (in category 'field definition - support') -----
compileStructureSpec: specArray generateAccessors: aSymbol 
	"Compile a type specification for the FFI machinery.
	Return the newly compiled spec.
	Eventually generate the field accessors according to the policy defined in aSymbol."
	| byteOffset maxByteSize typeSpec newCompiledSpec newByteAlignment |
	byteOffset := 1.
	newByteAlignment := 1.
	maxByteSize := 0.
	typeSpec := WriteStream on: (WordArray new: specArray size + 1).
	typeSpec nextPut: FFIFlagStructure.
	specArray do: [:spec |
		| fieldName fieldTypeName externalType typeSize typeAlignment |
		fieldName := spec first.
		fieldTypeName := spec second.
		externalType := (ExternalType typeNamed: fieldTypeName)
			ifNil: [self errorTypeNotFound: spec second].
		typeSize := externalType byteSize.
		typeAlignment := externalType byteAlignment.
		spec size > 2 ifTrue: ["extra size"
			spec third < typeSize
				ifTrue: [^ self error: 'Explicit type size is less than expected'].
			typeSize := spec third.
		].
		(fieldName notNil and: [self shouldGenerateAccessorsFor: fieldName policy: aSymbol]) ifTrue: [
			self generateStructureFieldAccessorsFor: fieldName startingAt: byteOffset type: externalType.
		].
		typeSpec nextPutAll: (externalType embeddedSpecWithSize: typeSize).
		maxByteSize := maxByteSize max: typeSize.
		newByteAlignment := newByteAlignment max: typeAlignment
		].
	maxByteSize := maxByteSize alignedTo: newByteAlignment.
	newCompiledSpec := typeSpec contents.
	newCompiledSpec at: 1 put: (maxByteSize bitOr: FFIFlagStructure).
	self
		setCompiledSpec: newCompiledSpec
		byteAlignment: newByteAlignment.!

----- Method: ExternalUnion class>>compileTypeAliasSpec:generateAccessors: (in category 'field definition - support') -----
compileTypeAliasSpec: spec generateAccessors: aSymbol 

	self error: 'Use ExternalStructure or ExternalTypeAlias to define a type alias, not ExternalUnion'.!

----- Method: ExternalUnion class>>isSkipped (in category 'field definition') -----
isSkipped

	^ self == ExternalUnion!

Object subclass: #ExternalType
	instanceVariableNames: 'compiledSpec referentClass referencedType byteAlignment arrayClass'
	classVariableNames: 'ArrayTypes AtomicTypeCodes AtomicTypes ExtraTypeChecks StructTypes UseArrayClasses UseTypePool'
	poolDictionaries: 'ExternalTypePool 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]
!

ExternalType subclass: #ExternalArrayType
	instanceVariableNames: 'contentType size byteSize'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'FFI-Kernel'!

----- Method: ExternalArrayType class>>newTypeForContentType:size: (in category 'instance creation') -----
newTypeForContentType: contentType size: numElements
	"!!!!!! Be aware that only the pointer type can be used in calls. As of SqueakFFIPrims VMMaker.oscog-eem.2950, there is no actual support for array types in the FFI plugin !!!!!!"

	| type pointerType headerWord byteSize |	
	self
		flag: #contentVsContainer;
		assert: [contentType isTypeAlias or: [contentType isArrayType not]]
		description: 'No support for direct multi-dimensional containers yet. Use type aliases.'.

	self
		assert: [contentType isVoid not]
		description: 'No array types for void type!!'.

	self
		assert: [
			(ArrayTypes at: contentType typeName
				ifPresent: [:sizes | sizes at: numElements ifAbsent: [nil]]
				ifAbsent: [nil] ) isNil]
		description: 'Array type already exists. Use #typeNamed: to access it.'.

	type := ExternalArrayType basicNew.
	pointerType := ExternalPointerType basicNew.
	
	"1) Regular type"
	byteSize := numElements
		ifNil: [0] ifNotNil: [numElements * contentType byteSize].
	headerWord := contentType headerWord.
	headerWord := headerWord bitClear: FFIStructSizeMask.
	headerWord := headerWord bitOr: (byteSize min: FFIStructSizeMask).
	type
		setReferencedType: pointerType;
		compiledSpec: (WordArray with: headerWord);
		byteAlignment: contentType byteAlignment;
		setReferentClass: nil; "Like atomics and pointers-to-atomics, no dedicated class exists."
		setContentType: contentType;
		setSize: numElements;
		setByteSize: byteSize.

	"2) Pointer type. Reuse the compiledSpec of the content-type's pointer type."
	pointerType
		setReferencedType: type;
		flag: #pointerToArray;
		compiledSpec: (WordArray with: (self pointerSpec bitOr: FFIFlagAtomic "HACK!! To deceive the FFI plugin :)"));
		byteAlignment: self pointerAlignment;
		setReferentClass: nil.
	
	"3) Remember this new array type."
	(ArrayTypes at: contentType typeName ifAbsentPut: [WeakValueDictionary new])
		at: numElements put: type.
		
	^ type!

----- Method: ExternalArrayType>>allocate (in category 'external data') -----
allocate
	"Overwritten to allocate specific to contentType and size. Check referentClass to consider #isTypeAlias."
	
	| data |
	data := self contentType allocate: self size.
	^ referentClass
		ifNil: [data "genuine arrays"]
		ifNotNil: [referentClass fromHandle: data getHandle]!

----- Method: ExternalArrayType>>allocate: (in category 'external data') -----
allocate: anInteger
	"No support for n-dimensional containers."
	
	self isTypeAlias ifTrue: [^ super allocate: anInteger].
	
	self notYetImplemented.!

----- Method: ExternalArrayType>>allocateExternal (in category 'external data') -----
allocateExternal
	"Overwritten to allocate specific to contentType and size. Check referentClass to consider #isTypeAlias."
	
	| data |
	data := self contentType allocateExternal: self size.
	^ referentClass
		ifNil: [data "genuine arrays"]
		ifNotNil: [referentClass fromHandle: data getHandle]!

----- Method: ExternalArrayType>>allocateExternal: (in category 'external data') -----
allocateExternal: anInteger
	"No support for n-dimensional containers."

	self isTypeAlias ifTrue: [^ super allocateExternal: anInteger].

	self notYetImplemented.!

----- Method: ExternalArrayType>>asArrayType: (in category 'converting') -----
asArrayType: numElements
	"N-dimensional containers only possible via type alias for now."
	
	self isTypeAlias ifTrue: [^ super asArrayType: numElements].
	
	self notYetImplemented.
	!

----- Method: ExternalArrayType>>asNonPointerType (in category 'converting') -----
asNonPointerType

	^ self!

----- Method: ExternalArrayType>>asPointerType (in category 'converting') -----
asPointerType

	^ referencedType!

----- Method: ExternalArrayType>>byteSize (in category 'accessing') -----
byteSize
	"For array types with an unknown size, also answer an unknown byte size."
	
	^ size ifNotNil: [byteSize]!

----- Method: ExternalArrayType>>contentType (in category 'external data') -----
contentType "^ <ExternalType>"
	
	^ contentType!

----- Method: ExternalArrayType>>contentTypeName (in category 'external data') -----
contentTypeName

	^ self contentType typeName!

----- Method: ExternalArrayType>>handle:at: (in category 'external data') -----
handle: handle at: byteOffset

	| resultHandle |
	resultHandle := handle structAt: byteOffset length: self byteSize.
	^ referentClass
		ifNotNil: [referentClass fromHandle: resultHandle]
		ifNil: [ExternalData fromHandle: resultHandle type: self]!

----- Method: ExternalArrayType>>handle:at:put: (in category 'external data') -----
handle: handle at: byteOffset put: value

	^ handle
		structAt: byteOffset
		put: value getHandle
		length: self byteSize!

----- Method: ExternalArrayType>>invalidate (in category 'private') -----
invalidate
	"Preserve size."

	compiledSpec := WordArray with: (self headerWord bitClear: FFIStructSizeMask).
	byteAlignment := nil.
	byteSize := nil.!

----- Method: ExternalArrayType>>isArrayOfArrays (in category 'testing') -----
isArrayOfArrays
	"Limited support for 2-dimensional arrays through type aliases possible."
	
	^ self contentType isArrayType!

----- Method: ExternalArrayType>>isArrayType (in category 'testing') -----
isArrayType

	^ true!

----- Method: ExternalArrayType>>isAtomic (in category 'testing') -----
isAtomic

	^ false!

----- Method: ExternalArrayType>>isPointerType (in category 'testing') -----
isPointerType

	^ false!

----- Method: ExternalArrayType>>isStringType (in category 'testing - special') -----
isStringType

	^ false!

----- Method: ExternalArrayType>>isStructureType (in category 'testing') -----
isStructureType

	^ false!

----- Method: ExternalArrayType>>isTypeAlias (in category 'testing') -----
isTypeAlias

	self isUnknownType ifTrue: [^ false].

	^ self isArrayOfArrays not
		and: [referentClass notNil
		and: [referentClass isTypeAlias
		and: [referentClass originalType isArrayType]]]!

----- Method: ExternalArrayType>>isUnknownType (in category 'testing') -----
isUnknownType
	"Array of unknown type is also an unknown type."
	
	^ self contentType isUnknownType!

----- Method: ExternalArrayType>>isVoid (in category 'testing') -----
isVoid

	^ false!

----- Method: ExternalArrayType>>newContentType: (in category 'private') -----
newContentType: typeOrNil
	"My content type has changed. Update my byteSize."

	| newByteSize newHeaderWord |
	(contentType := typeOrNil)
		ifNil: [ "my class has been removed - make me empty"
			compiledSpec := WordArray with: self class structureSpec.
			byteAlignment := 1]
		ifNotNil: [ "my class has been changed - update my compiledSpec"
			newHeaderWord := contentType headerWord.
			newByteSize := size ifNil: [0] ifNotNil: [size * (newHeaderWord bitAnd: FFIStructSizeMask)].
			newHeaderWord := newHeaderWord bitClear: FFIStructSizeMask.
			newHeaderWord := newHeaderWord bitOr: (newByteSize min: FFIStructSizeMask).
			compiledSpec := WordArray with: newHeaderWord.
			byteAlignment := contentType byteAlignment.
			byteSize := newByteSize]!

----- Method: ExternalArrayType>>newTypeAlias (in category 'private') -----
newTypeAlias
	"A little bit expensive but easy to implement. Once the size information is encoded in the headerWord, we might be able to do some cheap update like for the alias-to-pointer type."

	self isTypeAlias ifFalse: [^ self].
	self becomeUnknownType becomeKnownType.!

----- Method: ExternalArrayType>>readAlias (in category 'external structure') -----
readAlias

	^ '^ {1} fromHandle: handle{2}'
		format: {
			(referentClass ifNil: [ExternalData]) name.
			referentClass ifNotNil: [''] ifNil: [
				' type: ', self storeStringForField]}!

----- Method: ExternalArrayType>>readFieldAt: (in category 'external structure') -----
readFieldAt: byteOffset

	^ referentClass
		ifNotNil: [
			'^ {1} fromHandle: (handle structAt: {1} length: {2})'
				format: {
					referentClass name.
					byteOffset.
					self byteSize}]
		ifNil: [
			'^ ExternalData fromHandle: (handle structAt: {1} length: {2}) type: {3}'
				format: {
					byteOffset.
					self byteSize.
					self storeStringForField}]!

----- Method: ExternalArrayType>>setByteSize: (in category 'private') -----
setByteSize: newByteSize

	byteSize := newByteSize.!

----- Method: ExternalArrayType>>setContentType: (in category 'private') -----
setContentType: type

	contentType := type.!

----- Method: ExternalArrayType>>setSize: (in category 'private') -----
setSize: numElements

	size := numElements.!

----- Method: ExternalArrayType>>size (in category 'accessing') -----
size
	"Answers the number of elements for this array type."
	
	^ size!

----- Method: ExternalArrayType>>storeOn: (in category 'printing') -----
storeOn: aStream

	referentClass ifNotNil: [
		^ aStream
			nextPutAll: referentClass name;
			nextPutAll: ' externalType'].
			
	aStream nextPut: $(.
	self contentType storeOn: aStream.
	aStream nextPutAll: ' asArrayType: '.
	aStream nextPutAll: self size asString.
	aStream nextPut: $).!

----- Method: ExternalArrayType>>typeName (in category 'accessing') -----
typeName

	referentClass
		ifNotNil: [^ super typeName].

	^ String streamContents: [:stream | | inParentheses |
		(inParentheses := self contentType isPointerType not
			and: [self contentType asPointerType isTypeAlias])
				ifTrue: [stream nextPut: $(. "e.g. (*DoublePtr)[5]"].		
		
		stream nextPutAll: self contentType typeName.
		
		inParentheses ifTrue: [stream nextPut: $)].
		
		stream nextPut: $[.
		self size ifNotNil: [stream nextPutAll: self size asString].
		stream nextPut: $]. ]!

----- Method: ExternalArrayType>>updateFromReferentClass: (in category 'private') -----
updateFromReferentClass: classOrNil
	"The class I'm referencing has changed, which affects arrays of structs. Update my byteSize."

	(referentClass := classOrNil)
		ifNil: [ "my class has been removed - make me 'struct { void }'"
			compiledSpec := WordArray with: self class structureSpec.
			byteAlignment := 1.
			contentType := size := byteSize := nil]
		ifNotNil: [ "I am an alias-to-array type. Update my specs."
			| originalType |
			originalType := referentClass originalType.
			self assert: [originalType isArrayType].
			
			compiledSpec := originalType compiledSpec.
			byteAlignment := originalType byteAlignment.
			
			contentType := originalType contentType.
			size := originalType size.
			byteSize := originalType byteSize]!

----- Method: ExternalArrayType>>writeAliasWith: (in category 'external structure') -----
writeAliasWith: valueName

	^ 'handle := {1} getHandle.'
		format: {valueName}!

----- Method: ExternalArrayType>>writeFieldArgName (in category 'external structure') -----
writeFieldArgName

	^ 'anExternalData'!

----- Method: ExternalArrayType>>writeFieldAt:with: (in category 'external structure') -----
writeFieldAt: byteOffset with: valueName
	
	^ 'handle structAt: {1} put: {2} length: {3}'
		format: {
			byteOffset.
			valueName.
			self byteSize}!

ExternalType subclass: #ExternalAtomicType
	instanceVariableNames: 'readSend writeSend atomicTypeName companionType'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'FFI-Kernel'!

----- Method: ExternalAtomicType class>>atomicTypeSpecs (in category 'class initialization') -----
atomicTypeSpecs

	| platform isNonArm32BitUnix |
	platform := FFIPlatformDescription current.
	isNonArm32BitUnix := platform wordSize = 4 and: [platform isUnix and: [platform isARM not]].
	^ {
		"name         byte size   byte alignment"
		#'void'     . 0 .         0 . "No non-pointer support in calls. Duh. ;-)"
		#'bool'     . 1 .         1 . "No pointer support in calls."

		#'uint8_t'  . 1 .         1 .
		#'int8_t'   . 1 .         1 .
		#'uint16_t' . 2 .         2 .
		#'int16_t'  . 2 .         2 .
		#'uint32_t' . 4 .         4 .
		#'int32_t'  . 4 .         4 .
		#'uint64_t' . 8 .         isNonArm32BitUnix ifTrue: [4] ifFalse: [8] .
		#'int64_t'  . 8 .         isNonArm32BitUnix ifTrue: [4] ifFalse: [8] .

		#'uchar8_t' . 1 .         1 .
		"#'char8_t'  . 1 .         1 ."
		#'uchar16_t'. 2 .         2 .
		#'uchar32_t'. 4 .         4 .

		"#'half'     . 2 .         2 ."
		#'float'    . 4 .         4 .
		#'double'   . 8 .         isNonArm32BitUnix ifTrue: [4] ifFalse: [8] .
	}!

----- Method: ExternalAtomicType class>>code: (in category 'instance lookup') -----
code: typeCode

	^ AtomicTypes at: (AtomicTypeCodes keyAtValue: typeCode)!

----- Method: ExternalAtomicType class>>initializeAtomicTypeAccessors (in category 'class initialization') -----
initializeAtomicTypeAccessors
	"Call this to (re-)initialize accessors for atomic types, even if there are no substantial changes to the types themselves."

	self assert: [AtomicTypes notNil].
	self assert: [AtomicTypes notEmpty].

	self atomicTypesDo: [:type | type generateTypeAccessor].!

----- Method: ExternalAtomicType class>>initializeAtomicTypeCompanions (in category 'class initialization') -----
initializeAtomicTypeCompanions

	#(
		"name         companion"
		(#'void'      nil)
		(#'bool'      nil)

		(#'uint8_t'   #'int8_t')
		(#'int8_t'    #'uint8_t')
		(#'uint16_t'  #'int16_t')
		(#'int16_t'   #'uint16_t')
		(#'uint32_t'  #'int32_t')
		(#'int32_t'   #'uint32_t')
		(#'uint64_t'  #'int64_t')
		(#'int64_t'   #'uint64_t')

		(#'uchar8_t'      nil)
		(#'uchar16_t'      nil)
		(#'uchar32_t'      nil)

		(#'float'     #'double')
		(#'double'    #'float')

	) do:[:spec| | type companion |
		type := ExternalType typeNamed: spec first.
		companion := spec second ifNotNil: [ExternalType typeNamed: spec second].
		type setCompanionType: companion.
		companion ifNotNil: [companion setCompanionType: type]].!

----- Method: ExternalAtomicType class>>initializeAtomicTypes (in category 'class initialization') -----
initializeAtomicTypes
	"Fill all known instances of the receiver with the correct state. See super implementation to learn about the entire initialization process."

	self assert: [AtomicTypes notNil].
	self assert: [AtomicTypes notEmpty].

	self atomicTypeSpecs groupsDo: [:typeName :byteSize :byteAlignment |
		| type typeCode compiled |
				
		"1) Regular type; put type code into headerWord"
		type := AtomicTypes at: typeName.
		typeCode := AtomicTypeCodes at: typeName.
		compiled := WordArray with: ((byteSize bitOr: FFIFlagAtomic) bitOr:
				(typeCode bitShift: FFIAtomicTypeShift)).
		compiled ~= type compiledSpec
			"Preserve the identity of #compiledSpec."
			ifTrue: [type compiledSpec: compiled].
		type byteAlignment: byteAlignment.
		
		"2) Pointer type; put type code into headerWord, too"
		type := type asPointerType.
		compiled := WordArray with: ((self pointerSpec bitOr: FFIFlagAtomic) bitOr:
				(typeCode bitShift: FFIAtomicTypeShift)).
		compiled ~= type compiledSpec
			"Preserve the identity of #compiledSpec."
			ifTrue: [type compiledSpec: compiled].
		type byteAlignment: self pointerAlignment].
	
	self noticeModificationOfAtomics.!

----- Method: ExternalAtomicType class>>newTypeForAtomicNamed: (in category 'instance creation') -----
newTypeForAtomicNamed: atomicTypeName

	| type pointerType |
	type := ExternalAtomicType basicNew.
	pointerType := ExternalPointerType basicNew.
	
	type setReferencedType: pointerType.
	pointerType setReferencedType: type.
	
	type setAtomicTypeName: atomicTypeName.
	AtomicTypes at: atomicTypeName put: type.
	
	type generateTypeAccessor.
	^ type!

----- Method: ExternalAtomicType>>asNonPointerType (in category 'converting') -----
asNonPointerType

	^ self!

----- Method: ExternalAtomicType>>asPointerType (in category 'converting') -----
asPointerType

	^ referencedType!

----- Method: ExternalAtomicType>>atomicTypeName (in category 'accessing') -----
atomicTypeName

	^ atomicTypeName!

----- Method: ExternalAtomicType>>companionType (in category 'accessing') -----
companionType
	"Answer the receivers companion type, which is either the signed or unsigned version of it."
	
	^ companionType!

----- Method: ExternalAtomicType>>generateTypeAccessor (in category 'external structure') -----
generateTypeAccessor
	"Overwritten to generate accessors for atomic types directly in ExternalType class. Note that alias-to-atomic types have their referentClass; see super implementation."

	| theClass selector category expression source |
	referentClass ifNotNil: [^ super generateTypeAccessor].

	theClass := ExternalType.
	selector := self typeName.
	category := '*autogenerated - type constants'.
	expression := ExternalType useTypePool
		ifTrue: [ExternalTypePool assuredPoolVarNameFor: self]
		ifFalse: ['AtomicTypes at: ''{1}''' format: {self typeName}].
	
	source := '{1}\	{2}\	<generated>\	^ {3}' withCRs
		format: {
			selector.
			'"This method was automatically generated. See {1}>>{2}"'
				format: {thisContext methodClass. thisContext selector}.
			expression }.
	
	theClass class
		compileSilently: source
		classified: category.!

----- Method: ExternalAtomicType>>handle:at: (in category 'external data') -----
handle: handle at: byteOffset

	^ referentClass
		ifNil: [ "Genuine atomics"
			readSend
				handle: handle
				at: byteOffset]
		ifNotNil: [ "Alias to atomics"
			referentClass fromHandle: (handle
				structAt: byteOffset
				length: self byteSize)]!

----- Method: ExternalAtomicType>>handle:at:put: (in category 'external data') -----
handle: handle at: byteOffset put: value

	^ referentClass
		ifNil: ["genuine atomic"
			writeSend
				handle: handle
				at: byteOffset
				put: value]
		ifNotNil: ["type alias"
			handle
				structAt: byteOffset
				put: value getHandle
				length: self byteSize]!

----- Method: ExternalAtomicType>>handle:atIndex: (in category 'external data') -----
handle: handle atIndex: index
	"Overwritten to use cached byteSize in atomic sends for performance."
	
	referentClass == nil ifTrue: [
		^ readSend 
				handle: handle
				atIndex: index].
	^ super handle: handle atIndex: index!

----- Method: ExternalAtomicType>>handle:atIndex:put: (in category 'external data') -----
handle: handle atIndex: index put: value
	"Overwritten to use cached byteSize in atomic sends for performance."
	
	referentClass == nil ifTrue: [
		^ writeSend
				handle: handle
				atIndex: index
				put: value].
	^ super handle: handle atIndex: index put: value!

----- Method: ExternalAtomicType>>invalidate (in category 'private') -----
invalidate
	"Do not invalidate my typeName but read/write sends."
	
	super invalidate.
	readSend := nil.
	writeSend := nil.!

----- Method: ExternalAtomicType>>isArrayType (in category 'testing') -----
isArrayType

	^ false!

----- Method: ExternalAtomicType>>isAtomic (in category 'testing') -----
isAtomic

	^ true!

----- Method: ExternalAtomicType>>isPointerType (in category 'testing') -----
isPointerType

	^ false!

----- Method: ExternalAtomicType>>isStringType (in category 'testing - special') -----
isStringType

	^ false!

----- Method: ExternalAtomicType>>isStructureType (in category 'testing') -----
isStructureType

	^ false!

----- Method: ExternalAtomicType>>isTypeAlias (in category 'testing') -----
isTypeAlias

	^ referentClass notNil
		and: [referentClass isTypeAlias
		and: [referentClass originalType isAtomic]]!

----- Method: ExternalAtomicType>>isUnknownType (in category 'testing') -----
isUnknownType

	^ false!

----- Method: ExternalAtomicType>>isVoid (in category 'testing') -----
isVoid

	^ self atomicType = 0!

----- Method: ExternalAtomicType>>newTypeAlias (in category 'private') -----
newTypeAlias
	
	self isTypeAlias ifFalse: [^ self].
	self becomeUnknownType becomeKnownType.
	
"
	Might be faster:
	compiledSpec := referentClass compiledSpec.
	byteAlignment := referentClass byteAlignment.
	typeName := referentClass name.
	readSend := referentClass originalType readSend.
	writeSend := referentClass originalType writeSend.

"!

----- Method: ExternalAtomicType>>originalType (in category 'accessing - type alias') -----
originalType
	"Overwritten to look into my referencedType. See #isTypeAliasReferenced."

	^ self "e.g. *DoublePtr" asPointerType isTypeAlias "e.g. DoublePtr"
		ifTrue: [super originalType asNonPointerType "e.g. double, not double*"]
		ifFalse: [super originalType]!

----- Method: ExternalAtomicType>>readAlias (in category 'external structure') -----
readAlias

	^ self readFieldAt: 1!

----- Method: ExternalAtomicType>>readFieldAt: (in category 'external structure') -----
readFieldAt: byteOffset

	^ referentClass
		ifNil: [ "Genuine atomics"
			'^ ', readSend template
				format: {
					'handle'.
					byteOffset}]
		ifNotNil: [ "Type alias"
			'^ {1} fromHandle: (handle structAt: {2} length: {3})'
				format: {
					referentClass name.
					byteOffset.
					self byteSize}]!

----- Method: ExternalAtomicType>>readSend (in category 'accessing') -----
readSend

	^ readSend!

----- Method: ExternalAtomicType>>setAtomicTypeName: (in category 'private') -----
setAtomicTypeName: aString

	atomicTypeName := aString.!

----- Method: ExternalAtomicType>>setCompanionType: (in category 'private') -----
setCompanionType: atomicTypeOrNil

	self assert: [atomicTypeOrNil isNil or: [atomicTypeOrNil isAtomic]].
	companionType := atomicTypeOrNil.!

----- Method: ExternalAtomicType>>setReadWriteSends: (in category 'private') -----
setReadWriteSends: atomicReadWriteSends

	readSend := atomicReadWriteSends first.
	writeSend := atomicReadWriteSends second.!

----- Method: ExternalAtomicType>>storeOn: (in category 'printing') -----
storeOn: aStream

	referentClass
		ifNil: [
			aStream
				nextPutAll: 'ExternalType ';
				nextPutAll: self atomicTypeName]
		ifNotNil: [
			aStream
				nextPutAll: referentClass name;
				nextPutAll: ' externalType'].!

----- Method: ExternalAtomicType>>updateFromReferentClass: (in category 'private') -----
updateFromReferentClass: classOrNil
	"If I am an alias-to-atomic type, fetch the current spec from my referentClass."
	
	(referentClass := classOrNil)
		ifNotNil: [ "my class has been changed - update my compiledSpec"
			compiledSpec := referentClass compiledSpec.
			byteAlignment := referentClass byteAlignment].!

----- Method: ExternalAtomicType>>writeAliasWith: (in category 'external structure') -----
writeAliasWith: valueName

	^ self writeFieldAt: 1 with: valueName!

----- Method: ExternalAtomicType>>writeFieldArgName (in category 'external structure') -----
writeFieldArgName

	self isTypeAlias ifTrue: [^ super writeFieldArgName].
	
	self isBoolType ifTrue: [^ 'aBoolean'].
	self isIntegerType ifTrue: [^ 'anInteger'].
	self isCharType ifTrue: [^ 'aCharacter'].
	self isFloatType ifTrue: [^ 'aFloat'].

	self error: 'Unknown atomic type'.!

----- Method: ExternalAtomicType>>writeFieldAt:with: (in category 'external structure') -----
writeFieldAt: byteOffset with: valueName

	^ referentClass
		ifNil: ["genuine atomics"
			writeSend template, '.'
				format: {
					'handle'.
					byteOffset.
					valueName}]
		ifNotNil: ["type alias"
			'handle structAt: {1} put: {2} getHandle length: {3}.'
				format: {
					byteOffset.
					valueName.
					self byteSize}]!

----- Method: ExternalAtomicType>>writeSend (in category 'accessing') -----
writeSend

	^ writeSend!

ExternalType subclass: #ExternalPointerType
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'FFI-Kernel'!

----- Method: ExternalPointerType>>asNonPointerType (in category 'converting') -----
asNonPointerType

	^ referencedType!

----- Method: ExternalPointerType>>asPointerType (in category 'converting') -----
asPointerType

	^ self!

----- Method: ExternalPointerType>>atomicTypeName (in category 'accessing - atomic') -----
atomicTypeName
	"Implemented because the receiver might be a pointer-to-atomic type."

	^ self asNonPointerType atomicTypeName!

----- Method: ExternalPointerType>>generateTypeAccessor (in category 'external structure') -----
generateTypeAccessor
	"Overwritten to only generate accessor for alias-to-pointer types. The check for a non-nil referentClass is not enough when somebody is enumerating #allTypes."

	self isTypeAlias ifTrue: [super generateTypeAccessor].!

----- Method: ExternalPointerType>>handle:at: (in category 'external data') -----
handle: handle at: byteOffset

	^ referentClass
			ifNotNil: [
				referentClass fromHandle: (handle pointerAt: byteOffset length: self byteSize)]
			ifNil: [
				ExternalData
					fromHandle: (handle pointerAt: byteOffset length: self byteSize)
					type: self asNonPointerType "content type"]!

----- Method: ExternalPointerType>>handle:at:put: (in category 'external data') -----
handle: handle at: byteOffset put: value

	^ handle
		pointerAt: byteOffset
		put: value getHandle
		length: self byteSize!

----- Method: ExternalPointerType>>invalidate (in category 'private') -----
invalidate
	"We can directly initialize this type again. Unfortunately, we need special treatment for pointers to arrays-of-atomics to make coercion work. This can be improved once array types are encoded in the #headerWord."

	(self asNonPointerType isArrayType and: [self asNonPointerType isTypeAlias not])
		ifTrue: [
			self flag: #pointerToArray.
			compiledSpec := (WordArray with: (self class pointerSpec bitOr: FFIFlagAtomic "HACK!! To deceive the FFI plugin :)")).
			byteAlignment := self class pointerAlignment]
		ifFalse: [
			"Note that #initializeAtomicTypes will also update this because the current FFI plugin treats pointers to atomics as something special."
			compiledSpec := WordArray with: self class pointerSpec.
			byteAlignment := self class pointerAlignment].!

----- Method: ExternalPointerType>>isArrayType (in category 'testing') -----
isArrayType

	^ false!

----- Method: ExternalPointerType>>isAtomic (in category 'testing') -----
isAtomic

	^ false!

----- Method: ExternalPointerType>>isPointerType (in category 'testing') -----
isPointerType

	^ true!

----- Method: ExternalPointerType>>isStringType (in category 'testing - special') -----
isStringType
	"If pointer to atomic, the atomic type is encoded directly in the headerWord. Might change in the future; use #asNonPointerType in that case."
	
	^ self isCharType!

----- Method: ExternalPointerType>>isStructureType (in category 'testing') -----
isStructureType

	^ false!

----- Method: ExternalPointerType>>isTypeAlias (in category 'testing') -----
isTypeAlias
	
	^ referentClass notNil
		and: [referentClass isTypeAlias
		and: [referentClass originalType isPointerType]]!

----- Method: ExternalPointerType>>isUnknownType (in category 'testing') -----
isUnknownType

	^ false!

----- Method: ExternalPointerType>>isVoid (in category 'testing') -----
isVoid

	^ false!

----- Method: ExternalPointerType>>newTypeAlias (in category 'private') -----
newTypeAlias
	"We should update our referencedType. No need to update the compiledSpec because there is no information encoded that would change if we change the kind of pointer type."

	self isTypeAlias ifFalse: [^ self].	

	referencedType := referentClass originalType asNonPointerType copy.
	referencedType setReferencedType: self.
	referencedType setReferentClass: referentClass.!

----- Method: ExternalPointerType>>originalType (in category 'accessing - type alias') -----
originalType
	"Overwritten to look into my referencedType. See #isTypeAliasReferenced."

	^ self "e.g. MyStructPtr" asNonPointerType isTypeAlias "e.g. *MyStructPtr"
		ifTrue: [super originalType asPointerType "e.g. MyStruct*, not MyStruct"]
		ifFalse: [super originalType]!

----- Method: ExternalPointerType>>readAlias (in category 'external structure') -----
readAlias

	^ self asNonPointerType readAlias!

----- Method: ExternalPointerType>>readFieldAt: (in category 'external structure') -----
readFieldAt: byteOffset

	^ '^ {1} fromHandle: (handle pointerAt: {2} length: {3}){4}'
		format: {
			(referentClass ifNil: [ExternalData]) name.
			byteOffset.
			self byteSize.
			referentClass ifNotNil: [''] ifNil: [
				' type: ', self asNonPointerType "content type" storeStringForField]}!

----- Method: ExternalPointerType>>storeOn: (in category 'printing') -----
storeOn: aStream

	self isTypeAlias
		ifTrue: [
			aStream
				nextPutAll: referentClass name;
				nextPutAll: ' externalType']
		ifFalse: [
			self asNonPointerType storeOn: aStream.
			aStream nextPutAll: ' asPointerType'].!

----- Method: ExternalPointerType>>typeName (in category 'accessing') -----
typeName

	self asNonPointerType isArrayType
		ifFalse: [^ super typeName].
	
	"Special case for an array-type's pointer type. Answer would be void* if not treated. Also watch out for type alias. End with a $* to mark it a pointer type."
	^ String streamContents: [:stream | | inParentheses |
		(inParentheses := self asNonPointerType isTypeAlias not)
			ifTrue: [stream nextPut: $(].
		stream nextPutAll: self asNonPointerType typeName.
		inParentheses ifTrue: [stream nextPut: $)].
		stream nextPut: $*]!

----- Method: ExternalPointerType>>writeAliasWith: (in category 'external structure') -----
writeAliasWith: valueName

	^ self asNonPointerType writeAliasWith: valueName!

----- Method: ExternalPointerType>>writeFieldAt:with: (in category 'external structure') -----
writeFieldAt: byteOffset with: valueName
	
	^ 'handle pointerAt: {1} put: {2} getHandle length: {3}.'
		format: {
			byteOffset.
			valueName.
			self byteSize}!

ExternalType subclass: #ExternalStructureType
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'FFI-Kernel'!

!ExternalStructureType commentStamp: 'mt 6/18/2020 08:54' prior: 0!
I am specializing types for external structures. While compiledSpec and referentClass are still paramount when the FFI plugin is processing FFI calls, this specialization can help untangle in-image processing of external structures and their data. 

In terms of plugin compatibility, you could still use instances of ExternalType as, for example, argument types in ExternalFunction -- given that compiledSpec and referentClass are correct. Argument coercing in FFI calls would still work. However, you could no longer use in-image facilities such as #readFieldAt: / #writeFieldAt:width, which is used for generating struct-field accessors. And the dynamic access through #handle:at: / #handle:at:put: would fail. Also, #printOn: would not be very helpful anymore.

So, having this specialization of ExternalType for ExternalStructure helps packaging code. :-) Of course, this type can also be used for ExternalUnion, ExternalPackagedStructure, and ExternalTypeAlias.!

----- Method: ExternalStructureType class>>newTypeForStructureClass: (in category 'instance creation') -----
newTypeForStructureClass: anExternalStructureClass
	
	| type referentClass |
	referentClass := anExternalStructureClass.
	
	self
		assert: [referentClass includesBehavior: ExternalStructure]
		description: 'Wrong base class for structure'.
	
	type := self newTypeForUnknownNamed: referentClass name.
	
	referentClass compiledSpec
		ifNil: [ "First time. The referent class' fields are probably just compiled for the first time."
			type setReferentClass: referentClass.
			type asPointerType setReferentClass: referentClass]
		ifNotNil: [
			type newReferentClass: referentClass].

	type becomeKnownTypeSafely.
	type generateTypeAccessor.
	^ type!

----- Method: ExternalStructureType>>asNonPointerType (in category 'converting') -----
asNonPointerType

	^ self!

----- Method: ExternalStructureType>>asPointerType (in category 'converting') -----
asPointerType

	^ referencedType!

----- Method: ExternalStructureType>>handle:at: (in category 'external data') -----
handle: handle at: byteOffset

	^ referentClass fromHandle: (handle structAt: byteOffset length: self byteSize)!

----- Method: ExternalStructureType>>handle:at:put: (in category 'external data') -----
handle: handle at: byteOffset put: value

	^ handle
		structAt: byteOffset
		put: value getHandle
		length: self byteSize!

----- Method: ExternalStructureType>>invalidate (in category 'private') -----
invalidate
	"Make this type invalid to be re-initialized. This could happen when platform-characteristics change."

	compiledSpec := WordArray with: self class structureSpec.
	byteAlignment := nil.!

----- Method: ExternalStructureType>>isArrayType (in category 'testing') -----
isArrayType

	^ false!

----- Method: ExternalStructureType>>isAtomic (in category 'testing') -----
isAtomic

	^ false!

----- Method: ExternalStructureType>>isPointerType (in category 'testing') -----
isPointerType

	^ false!

----- Method: ExternalStructureType>>isStringType (in category 'testing - special') -----
isStringType

	^ false!

----- Method: ExternalStructureType>>isStructureType (in category 'testing') -----
isStructureType

	^ true!

----- Method: ExternalStructureType>>isTypeAlias (in category 'testing') -----
isTypeAlias

	^ referentClass notNil
		and: [referentClass isTypeAlias
		and: [referentClass originalType isStructureType]]!

----- Method: ExternalStructureType>>isUnknownType (in category 'testing') -----
isUnknownType

	^ false!

----- Method: ExternalStructureType>>isVoid (in category 'testing') -----
isVoid

	^ false!

----- Method: ExternalStructureType>>newTypeAlias (in category 'private') -----
newTypeAlias
	"Only support switching between struct types for now."
	
	self isTypeAlias ifFalse: [^ self].
	
	compiledSpec := referentClass compiledSpec.
	byteAlignment := referentClass byteAlignment.!

----- Method: ExternalStructureType>>originalType (in category 'accessing - type alias') -----
originalType
	"Overwritten to look into my referencedType. See #isTypeAliasReferenced."
	
	^ self "e.g. *MyStructPtr" asPointerType isTypeAlias "e.g. MyStructPtr"
		ifTrue: [super originalType asNonPointerType "e.g. MyStruct, not MyStruct*"]
		ifFalse: [super originalType]!

----- Method: ExternalStructureType>>printContentsOn: (in category 'printing') -----
printContentsOn: aStream

	self isEmpty
		ifTrue: [aStream nextPutAll: ' { void }']
		ifFalse: [super printContentsOn: aStream].!

----- Method: ExternalStructureType>>printOn: (in category 'printing') -----
printOn: aStream

	referentClass
		ifNil: [aStream nextPutAll: '<unknown struct type>']
		ifNotNil: [super printOn: aStream].!

----- Method: ExternalStructureType>>readAlias (in category 'external structure') -----
readAlias

	^ '^ {1} fromHandle: handle'
		format: {referentClass name}!

----- Method: ExternalStructureType>>readFieldAt: (in category 'external structure') -----
readFieldAt: byteOffset

	^ '^ {1} fromHandle: (handle structAt: {2} length: {3})'
		format: {
			referentClass name.
			byteOffset.
			self byteSize}!

----- Method: ExternalStructureType>>storeOn: (in category 'printing') -----
storeOn: aStream

	self asPointerType isTypeAlias
		ifTrue: [
			aStream
				nextPutAll: referentClass name;
				nextPutAll: ' externalType asNonPointerType']
		ifFalse: [super storeOn: aStream].!

----- Method: ExternalStructureType>>updateFromReferentClass: (in category 'private') -----
updateFromReferentClass: classOrNil
	"The class I'm referencing has changed. Update my spec."

	(referentClass := classOrNil)
		ifNil: [ "my class has been removed - make me 'struct { void }'"
			compiledSpec := WordArray with: self class structureSpec.
			byteAlignment := 1]
		ifNotNil: [ "my class has been changed - update my compiledSpec"
			compiledSpec := referentClass compiledSpec.
			byteAlignment := referentClass byteAlignment].!

----- Method: ExternalStructureType>>writeAliasWith: (in category 'external structure') -----
writeAliasWith: valueName

	^ 'handle := {1} getHandle.'
		format: {valueName}!

----- Method: ExternalStructureType>>writeFieldAt:with: (in category 'external structure') -----
writeFieldAt: byteOffset with: valueName

	^ 'handle structAt: {1} put: {2} getHandle length: {3}.'
		format: {
			byteOffset.
			valueName.
			self byteSize}!

----- Method: ExternalType class>>allArrayTypeNames (in category 'instance list') -----
allArrayTypeNames
	"Answers the names of the currently known array types. Includes alias-to-array types."
	
	^ self allArrayTypes collect: [:each | each typeName]!

----- Method: ExternalType class>>allArrayTypes (in category 'instance list') -----
allArrayTypes
	"Answers all array types. Includes alias-to-array types."
	
	^ Array streamContents: [:stream |
		self allArrayTypesDo: [:type | stream nextPut: type]]!

----- Method: ExternalType class>>allArrayTypesDo: (in category 'instance list') -----
allArrayTypesDo: block
	
	self arrayTypesDo: block.

	"Alias-to-array types are managed in StructTypes but are actual array types."
	StructTypes do: [:each |
		(each notNil "may be garbage collected" and: [each isArrayType])
			ifTrue: [block value: each]].!

----- Method: ExternalType class>>allAtomicTypeNames (in category 'instance list') -----
allAtomicTypeNames
	"Answers the names of the currently known atomic types. Includes names for alias-to-atomic types."

	^ self allAtomicTypes collect: [:type | type typeName] !

----- Method: ExternalType class>>allAtomicTypes (in category 'instance list') -----
allAtomicTypes
	"Answers the currently known atomic types. Includes alias-to-atomic types."

	^ Array streamContents: [:stream |
		self allAtomicTypesDo: [:type | stream nextPut: type]]!

----- Method: ExternalType class>>allAtomicTypesDo: (in category 'instance list') -----
allAtomicTypesDo: block

	self atomicTypesDo: block.
	
	self typeAliasTypesDo: [:type |
		type isAtomic ifTrue: [block value: type]].!

----- Method: ExternalType class>>allPointerTypeNames (in category 'instance list') -----
allPointerTypeNames

	^ self allPointerTypes collect: [:each | each typeName]!

----- Method: ExternalType class>>allPointerTypes (in category 'instance list') -----
allPointerTypes
	"Answers the pointer types. Includes alias-to-pointer types."

	^ Array streamContents: [:stream |	
		self allPointerTypesDo: [:type | stream nextPut: type]]!

----- Method: ExternalType class>>allPointerTypesDo: (in category 'instance list') -----
allPointerTypesDo: block
	"Enumerat all pointer types, including alias-to-pointer types."

	self pointerTypesDo: block.
		
	"Type alias-to-pointer types are managed in StructTypes but are actual pointer types."
	StructTypes do: [:each | (each notNil and: [each isPointerType])
		ifTrue: [block value: each]].!

----- Method: ExternalType class>>allStructTypeNames (in category 'instance list') -----
allStructTypeNames
	"Answers the names of the currently known struct types. Includes alias-to-struct types."

	^ self allStructTypes collect: [:each | each typeName]!

----- Method: ExternalType class>>allStructTypes (in category 'instance list') -----
allStructTypes
	"Answers the currently known struct types, including alias-to-struct types."

	^ Array streamContents: [:stream |
		self allStructTypesDo: [:type | stream nextPut: type]]!

----- Method: ExternalType class>>allStructTypesDo: (in category 'instance list') -----
allStructTypesDo: block
	"Enumerate all struct types. Includes types for packed structs and unions. Includes type aliases."
	
	StructTypes do: [:each | (each notNil and: [each isStructureType])
		ifTrue: [block value: each]]!

----- Method: ExternalType class>>allTypeNames (in category 'instance list') -----
allTypeNames
	"Answers the names of the currently known types."
	
	^ self allTypes collect: [:each | each typeName]!

----- Method: ExternalType class>>allTypes (in category 'instance list') -----
allTypes
	"Answers the currently known types."
	
	^ Array streamContents: [:stream |
		self allTypesDo: [:type | stream nextPut: type]]!

----- Method: ExternalType class>>allTypesDo: (in category 'instance list') -----
allTypesDo: block

	self allAtomicTypesDo: block.
	self allStructTypesDo: block.
	self allPointerTypesDo: block.
	self allArrayTypesDo: block.!

----- Method: ExternalType class>>arrayTypeFor:size: (in category 'instance lookup') -----
arrayTypeFor: contentType size: numElements
	"Lookup fails if content type is not present."

	^ ((ArrayTypes
		at: contentType typeName
		ifAbsentPut: [WeakValueDictionary new])
			at: numElements ifAbsent: [nil])
				ifNil: [
					self
						newTypeForContentType: contentType
						size: numElements]!

----- Method: ExternalType class>>arrayTypeNamed: (in category 'instance lookup') -----
arrayTypeNamed: typeName
	"Answers an array type for the content type and size specified in the typeName, e.g. char[10] or MyStruct[5]. Lookup fails silently (i.e. nil) if content type does not exist."
	
	| arraySpec contentType numElements |
	arraySpec := self parseArrayTypeName: typeName.
	contentType := arraySpec second.
	numElements := arraySpec third.
	
	contentType ifNil: [ ^ nil "content type unknown" ].
	contentType isUnknownType
		ifTrue: [ ^ nil "content type not initialized" ].
	
	^ self
		arrayTypeFor: arraySpec second
		size: arraySpec third!

----- Method: ExternalType class>>arrayTypeNames (in category 'instance list') -----
arrayTypeNames
	"Answers the names of the currently known array types."
	
	^ self arrayTypes collect: [:each | each typeName]!

----- Method: ExternalType class>>arrayTypes (in category 'instance list') -----
arrayTypes
	"Answers the currently known array types."
	
	^ Array streamContents: [:stream |
		self arrayTypesDo: [:type | stream nextPut: type]]!

----- Method: ExternalType class>>arrayTypesDo: (in category 'instance list') -----
arrayTypesDo: block
	
	ArrayTypes do: [:sizes | sizes do: [:each |
		each notNil "may be garbage collected"
			ifTrue: [block value: each]]].!

----- Method: ExternalType class>>atomicTypeNamed: (in category 'instance lookup') -----
atomicTypeNamed: typeName
	"If not found, look up 'type constants' protocol as lightweight alias to atomic type."

	^ AtomicTypes
		at: typeName
		ifAbsent: [		
			(self class includesSelector: typeName)
				ifTrue: [self perform: typeName]]!

----- Method: ExternalType class>>atomicTypeNames (in category 'instance list') -----
atomicTypeNames
	"Answers the names of the currently known atomic types."

	^ AtomicTypeCodes keysInOrder!

----- Method: ExternalType class>>atomicTypes (in category 'instance list') -----
atomicTypes
	"Answers the currently known atomic types."

	^ Array streamContents: [:stream |
		self atomicTypesDo: [:type | stream nextPut: type]]!

----- Method: ExternalType class>>atomicTypesDo: (in category 'instance list') -----
atomicTypesDo: block
	"Enumerate all atomic types. No alias-to-atomic types."

	self atomicTypeNames do: [:typeName |
		block value: (AtomicTypes at: typeName)]!

----- Method: ExternalType class>>basicInitializeAtomicTypes (in category 'class initialization') -----
basicInitializeAtomicTypes

	"Strong references required because there is no lazy initialization like there is for struct types and array types."
	AtomicTypes ifNil: [AtomicTypes := Dictionary new].
	
	"Add new atomic types using the current configuration of AtomicTypeCodes."
	AtomicTypeCodes keysDo: [:typeName |
		(AtomicTypes includesKey: typeName) ifFalse: [
			self newTypeForAtomicNamed: typeName]].
	
	"Remove discarded types."
	AtomicTypes keys do: [:typeName |
		(AtomicTypeCodes includesKey: typeName) ifFalse: [
			AtomicTypes removeKey: typeName]].
	
	"Migrate older instances."
	AtomicTypes keysAndValuesDo: [:typeName :type |
		type setAtomicTypeName: typeName]!

----- Method: ExternalType class>>basicInitializeStructureTypes (in category 'class initialization') -----
basicInitializeStructureTypes

	StructTypes ifNil: [
		StructTypes := WeakValueDictionary new].
	ArrayTypes ifNil: [
		ArrayTypes := Dictionary new].!

----- Method: ExternalType class>>byte (in category 'type constants') -----
byte
	"For convenience, byte defaults to unsigned 8-bit integer."
	
	^ self uint8_t!

----- Method: ExternalType class>>c_long (in category 'type constants - extra') -----
c_long
	"Try to approximate a fitting type for 'long' in a C interface. First, note that this is not the same as 'long' in Squeak FFI, which is always 4 byte and hence corresponds to 'int' or rather 'int32_t' in C. Second, note that we do not want to expose the platforms underlying data model in Squeak because the OpenSmalltalk VM has no support for all kinds of architectures out there but only a popular subset such as x86-based ones. Still, this method is written to explicate the issue of different data models for 32-bit and 64-bit platforms."

	| platform dataModel |
	platform := FFIPlatformDescription current.
	dataModel := platform wordSize = 4
		ifTrue: ['ILP32']
		ifFalse: [platform isWindows
			ifTrue: ['LLP64']
			ifFalse: ['LP64']].
	^ dataModel caseOf: {
		['ILP32'] -> [self int32_t].
		['LP64'] -> [self int64_t].
		['LLP64'] -> [self int32_t] }!

----- Method: ExternalType class>>c_ulong (in category 'type constants - extra') -----
c_ulong
	"Try to approximate a fitting type for 'usigned long' in a C interface. See comment in #c_long."
	
	^ self c_long asUnsigned!

----- Method: ExternalType class>>char (in category 'type constants') -----
char
	"For convenience. Defaults to unsigned 8-bit character type."
	
	^self uchar8_t!

----- Method: ExternalType class>>char16_t (in category 'type constants') -----
char16_t

	^ self uchar16_t!

----- Method: ExternalType class>>char32_t (in category 'type constants') -----
char32_t

	^ self uchar32_t!

----- Method: ExternalType class>>char8_t (in category 'type constants') -----
char8_t

	^ self uchar8_t!

----- Method: ExternalType class>>cleanupUnusedTypes (in category 'housekeeping') -----
cleanupUnusedTypes
	"In the lookup table for struct types and array types, remove keys to types no longer present..
		
	ExternalType cleanupUnusedTypes
	"
	Smalltalk garbageCollect.	
	StructTypes keys do: [:key |
		(StructTypes at: key) ifNil: [
			StructTypes removeKey: key]].
	
	ArrayTypes keys do: [:contentTypeName |
		| sizes |
		sizes := ArrayTypes at: contentTypeName.
		sizes keys do: [:size |
			(sizes at: size) ifNil: [sizes removeKey: size]].
		sizes ifEmpty: [
			ArrayTypes removeKey: contentTypeName]].!

----- Method: ExternalType class>>extraTypeChecks (in category 'preferences') -----
extraTypeChecks
	<preference: 'Extra type checks'
		categoryList: #('FFI Kernel')
		description: 'When true, there will be extra type checks during dynamic or compiled access to external objects (e.g. structures, unions).'
		type: #Boolean>
	^ExtraTypeChecks ifNil:[false]!

----- Method: ExternalType class>>extraTypeChecks: (in category 'preferences') -----
extraTypeChecks: aBoolean

	ExtraTypeChecks = aBoolean ifTrue: [^ self].

	ExtraTypeChecks := aBoolean.
	
	Cursor wait showWhile: [
		"Recompile all compiled artifacts."
		ExternalStructure defineAllFields].!

----- Method: ExternalType class>>extraTypeChecksDuring: (in category 'preferences') -----
extraTypeChecksDuring: aBlock

	| priorValue |
	priorValue := ExtraTypeChecks.
	ExtraTypeChecks := true.
	aBlock ensure: [ExtraTypeChecks := priorValue].!

----- Method: ExternalType class>>initialize (in category 'class initialization') -----
initialize
	"
	ExternalType initialize
	"
	self initializeAtomicTypeCodes.
	self initializeAtomicTypes.
	
	self initializeStructureTypes.
	
	self initializeArrayClasses.!

----- Method: ExternalType class>>initializeArrayClasses (in category 'class initialization') -----
initializeArrayClasses
	"
	ExternalType initializeArrayClasses.
	"
	RawBitsArray allSubclasses collect: [:arrayClass |
		(arrayClass includesSelector: #contentType) ifTrue: [
		[arrayClass new contentType setArrayClass: arrayClass]
			on: Error do: [ "Ignore." ]]].

	String allSubclasses collect: [:stringClass | | contentType |
		[ contentType := stringClass new contentType.
		contentType setArrayClass: stringClass ]
			on: Error do: [ "Ignore."]].!

----- Method: ExternalType class>>initializeAtomicSends (in category 'class initialization') -----
initializeAtomicSends
	"
	ExternalType initializeAtomicSends.
	"
	self atomicTypesDo: [:type |
		type setReadWriteSends: (FFIAtomicReadWriteSend fromType: type)].!

----- Method: ExternalType class>>initializeAtomicTypeCodes (in category 'class initialization') -----
initializeAtomicTypeCodes
	"ExternalType initializeAtomicTypeCodes"

	FFIConstants initialize. "Init appropriate type codes for current plugin version."

	AtomicTypeCodes := OrderedDictionary newFrom: {
		#'void' -> FFITypeVoid.
		#'bool' -> FFITypeBool.
		
		#'uint8_t' -> FFITypeUnsignedInt8.
		#'int8_t' -> FFITypeSignedInt8.
		#'uint16_t' -> FFITypeUnsignedInt16.
		#'int16_t' -> FFITypeSignedInt16.
		#'uint32_t' -> FFITypeUnsignedInt32.
		#'int32_t' -> FFITypeSignedInt32.
		#'uint64_t' -> FFITypeUnsignedInt64.
		#'int64_t' -> FFITypeSignedInt64.
		
		#'uchar8_t' -> FFITypeUnsignedChar8.
		"#'char8_t' -> FFITypeSignedChar8."
		#'uchar16_t' -> FFITypeUnsignedChar16.
		#'uchar32_t' -> FFITypeUnsignedChar32.
		
		#'float' -> FFITypeSingleFloat.
		#'double' -> FFITypeDoubleFloat}.
	
	"We must now update the names of all known atomic types."
	AtomicTypes ifNotNil: [
		AtomicTypes keys do: [:oldName |
			| type newName |
			type := AtomicTypes at: oldName.
			newName := AtomicTypeCodes keyAtValue: type atomicType ifAbsent: [oldName].
			(AtomicTypes includesKey: newName) ifFalse: [
				"Only store new names. Do not support name swap."
				AtomicTypes removeKey: oldName.
				AtomicTypes at: newName put: type.
				type setAtomicTypeName: newName]]].!

----- Method: ExternalType class>>initializeAtomicTypes (in category 'class initialization') -----
initializeAtomicTypes
	"Private. (Re-)initialize all atomic types. Preserves object identity of all involved types. If the amount of types changed, use #resetAllAtomicTypes instead. Needs atomic-type codes to be initialized already."

	self assert: [AtomicTypeCodes notNil].
	self assert: [AtomicTypeCodes notEmpty].
		
	self basicInitializeAtomicTypes.
	self invalidateAtomicTypes.
	
	ExternalAtomicType initializeAtomicTypes.
	ExternalAtomicType initializeAtomicTypeCompanions.
	ExternalAtomicType initializeAtomicTypeAccessors.
	
	self initializeAtomicSends.!

----- Method: ExternalType class>>initializeFast (in category 'class initialization') -----
initializeFast
	"Faster than #initialize. Update all atomic types for platform-specifc byte size and alignment. Also update struct and array types when they change due to changed atomics. NOTE THAT this cannot be used when atomic-type codes have changed!!"

	ExternalAtomicType initializeAtomicTypes.
	ExternalStructure defineAllChangedFields.!

----- Method: ExternalType class>>initializeStructureTypeAccessors (in category 'class initialization') -----
initializeStructureTypeAccessors
	"Call this to (re-)initialize accessors for types that have a referentClass, which generates/updates the class-side #externalType method according to the #useTypePool preference."

	self allTypesDo: [:type |
		type referentClass ifNotNil: [type generateTypeAccessor]].!

----- Method: ExternalType class>>initializeStructureTypes (in category 'class initialization') -----
initializeStructureTypes
	"(Re-)initialize all structure types and all array types. Preserves object identity of all involved types. If the amount of types changed, use #resetAllStructureTypes instead."

	self basicInitializeStructureTypes.
	self invalidateStructureTypes.
		
	self initializeStructureTypeAccessors.
	
	"Trigger #noticeModificationOf: callback to actually initialize all structure types. Since we invalidated all types, we cannot use #defineAllChangedFields. We rely on the #noticeModificationOf: callback."
	ExternalStructure defineAllFields.!

----- Method: ExternalType class>>int (in category 'type constants') -----
int

	self flag: #deprecated.
	^ self int32_t!

----- Method: ExternalType class>>intptr_t (in category 'type constants - stddef.h') -----
intptr_t
	"Answer a signed integer type that can hold a data pointer on the current platform, that is, 4-byte pointers on 32-bit und 8-byte pointers on 64-bit. Unlike actual C pointers (e.g., void*), you can do (pointer) arithmetic (e.g., #+) and bitwise manipulation (e.g., #bitOr:) on the resulting Smalltalk Integer objects.
	
	Note that the equivalent type for a void* yields an instance if ExternalData, whose handle is an ExternalAddress, which actually impelements #+ as of June 2020. So, you can also do pointer arithmetic using that type.
	
	Note that all FFI calls and struct types will be updated automatically on startup if a platform change is detected."
	
	^ FFIPlatformDescription current wordSize = 4
		ifTrue: [self signedInt]
		ifFalse: [self signedLongLong]!

----- Method: ExternalType class>>invalidateAtomicTypes (in category 'class initialization') -----
invalidateAtomicTypes
	"Invalidate all pure atomic types. Do not invalidate alias-to-atomic types here. See #invalidateStructureTypes."
	
	self atomicTypesDo: [:atomicType |
		atomicType "asNonPointerType" invalidate.
		atomicType asPointerType invalidate].!

----- Method: ExternalType class>>invalidateStructureTypes (in category 'class initialization') -----
invalidateStructureTypes
	"Invalidate all types that will be updated through the #noticeModificationOf: callback when #defineFields or #defineAllFields is called."

	self allAtomicTypesDo: [:atomicType |
		atomicType referentClass ifNotNil: [ "i.e., alias-to-atomic"
			atomicType "asNonPointerType" invalidate.
			atomicType asPointerType invalidate]].
	
	self allArrayTypesDo: [:arrayType |
		arrayType contentType referentClass ifNotNil: [ "i.e., not a genuine array-of-atomics"
			arrayType "asNonPointerType" invalidate.
			arrayType asPointerType invalidate]].

	self allStructTypesDo:[:structType |
		structType "asNonPointerType" invalidate.
		structType asPointerType invalidate].!

----- Method: ExternalType class>>long (in category 'type constants') -----
long

	self flag: #deprecated.	
	^ self int32_t!

----- Method: ExternalType class>>longlong (in category 'type constants') -----
longlong

	self flag: #deprecated.	
	^ self int64_t!

----- Method: ExternalType class>>lookupType: (in category 'instance lookup') -----
lookupType: structClassOrTypeNameOrType
	"Answers a type from the given spec, which can be a name, a struct class, or an actual type. Approximate being a struct class via #isBehavior."
	
	^ structClassOrTypeNameOrType isString
		ifTrue: [self typeNamed: structClassOrTypeNameOrType]
		ifFalse: [structClassOrTypeNameOrType isBehavior
			ifTrue: [structClassOrTypeNameOrType externalType]
			ifFalse: [structClassOrTypeNameOrType]]!

----- Method: ExternalType class>>new (in category 'instance creation') -----
new
	"Use either the type constants or #externalType for creating external types"
	^self shouldNotImplement!

----- Method: ExternalType class>>newTypeForAtomicNamed: (in category 'instance creation') -----
newTypeForAtomicNamed: atomicTypeName

	^ ExternalAtomicType newTypeForAtomicNamed: atomicTypeName!

----- Method: ExternalType class>>newTypeForContentType:size: (in category 'instance creation') -----
newTypeForContentType: contentType size: numElements

	^ ExternalArrayType newTypeForContentType: contentType size: numElements!

----- Method: ExternalType class>>newTypeForStructureClass: (in category 'instance creation') -----
newTypeForStructureClass: anExternalStructureClass

	^ ExternalStructureType newTypeForStructureClass: anExternalStructureClass!

----- Method: ExternalType class>>newTypeForUnknownNamed: (in category 'instance creation') -----
newTypeForUnknownNamed: typeName
	
	^ ExternalUnknownType newTypeForUnknownNamed: typeName!

----- Method: ExternalType class>>newTypeNamed: (in category 'instance creation') -----
newTypeNamed: aTypeName
	"Create a new struct type or array type. Not needed for atomic types; see #initializeDefaultTypes."
	
	| structClass arraySpec |
	self
		assert: [aTypeName last ~~ $*]
		description: 'Pointer type will be created automatically'.
	self
		assert: [aTypeName first ~~ $*]
		description: 'Non-pointer type for alias-to-pointer types will be created automatically'.
			
	aTypeName last == $] ifTrue: [ "array type, e.g., char[50]"
		arraySpec := self parseArrayTypeName: aTypeName.
		arraySpec second ifNil: [arraySpec at: 2 put: (self newTypeNamed: arraySpec first)].
		^ self
			newTypeForContentType: arraySpec second
			size: arraySpec third].
	
	structClass := (self environment classNamed: aTypeName)
		ifNotNil: [:class | (class includesBehavior: ExternalStructure) ifTrue: [class]].

	^ (structClass isNil or: [structClass isSkipped "i.e., not yet ready, see ExternalTypeAlias"])
		ifTrue: [self newTypeForUnknownNamed: aTypeName]
		ifFalse: [self newTypeForStructureClass: structClass]!

----- Method: ExternalType class>>noticeModificationOf: (in category 'housekeeping') -----
noticeModificationOf: aClass
	"A subclass of ExternalStructure has been redefined."

	aClass withAllSubclassesDo: [:cls | | typeName type |
		typeName := cls name.
		
		(type := StructTypes at: typeName ifAbsent: [])
			ifNil: ["Give unused types a chance to establish a hard reference via type accessor."
				type := self structTypeNamed: typeName]
			ifNotNil: [
				type newReferentClass: cls.
				type newTypeAlias].
			
		ArrayTypes at: typeName ifPresent: [:sizes |
			sizes do: [:arrayType | arrayType ifNotNil: [
				arrayType newContentType: type]]].
	
		"Alias-to-array types, which are stored in StructTypes, will not update via #newContentType:. We scan StructTypes for #isArrayType to find such aliases to then call #newContentType:."
		self flag: #performance.
		StructTypes do: [:each |
			(each notNil and: [each isArrayType and: [each contentType == type]])
				ifTrue: [each newContentType: type]]].!

----- Method: ExternalType class>>noticeModificationOfAtomics (in category 'housekeeping') -----
noticeModificationOfAtomics
	"Atomic types have been redefined. Initialize all array types that have an atomic-or-pointer type as their content type. Other array types will be updated through #initializeStructureTypes because of how #defineAllFields work with its callback to ExternalType class >> #noticeModificationOf:."

	ArrayTypes ifNil: [^ self "Not yet initialized"].
	self arrayTypesDo: [:arrayType |
		(arrayType contentType isAtomic or: [arrayType contentType isPointerType]) ifTrue: [
			arrayType newContentType: arrayType contentType]].!

----- Method: ExternalType class>>noticeRemovalOf: (in category 'housekeeping') -----
noticeRemovalOf: aClass
	"A subclass of ExternalStructure is being removed.
	Clean out any obsolete references to its type."

	| typeName type |
	typeName := aClass name.
	
	(type := StructTypes at: typeName ifAbsent: [])
		ifNotNil: [type newReferentClass: nil].
		
	ArrayTypes at: aClass name ifPresent: [:sizes |
		sizes do: [:arrayType | arrayType ifNotNil: [
			arrayType newContentType: nil]].
	
	"Alias-to-array types, which are stored in StructTypes, will not update via #newContentType:. We scan StructTypes for #isArrayType to find such aliases to then call #newContentType:."
	StructTypes do: [:each |
		(each notNil and: [each isArrayType and: [each contentType == type]])
			ifTrue: [each newContentType: type]]].!

----- Method: ExternalType class>>noticeRenamingOf:from:to: (in category 'housekeeping') -----
noticeRenamingOf: aClass from: oldName to: newName
	"An ExternalStructure has been renamed from oldName to newName.
	Keep our type names in sync."

	(StructTypes at: oldName ifAbsent:[nil])
		ifNotNil: [:type | StructTypes at: newName put: type].
	StructTypes removeKey: oldName ifAbsent: [].
	
	(ArrayTypes at: oldName ifAbsent: [nil])
		ifNotNil: [:sizes | ArrayTypes at: newName put: sizes].
	ArrayTypes removeKey: oldName ifAbsent: [].!

----- Method: ExternalType class>>parseArrayTypeName: (in category 'private') -----
parseArrayTypeName: aTypeName

	| contentTypeName contentType numElements |
	contentTypeName:= aTypeName copyFrom: 1 to: (aTypeName indexOf: $[) - 1.
	contentType := self typeNamed: contentTypeName.
	numElements := (aTypeName copyFrom: (aTypeName indexOf: $[) + 1 to: aTypeName size - 1) asInteger.
	^ { contentTypeName . contentType . numElements }!

----- Method: ExternalType class>>parseBasicTypeName: (in category 'instance lookup') -----
parseBasicTypeName: typeName
	"Answers the name of the basic type needed to resolve the given typeName."
	
	| actualTypeName |
	actualTypeName := typeName copyWithoutAll: ' '.

	actualTypeName last == $* "e.g. MyStruct*"
		ifTrue: [actualTypeName := actualTypeName allButLast].
	actualTypeName last == $) "e.g. (char[])* -- pointer type for array type"
		ifTrue: [actualTypeName := (actualTypeName copyFrom: 2 to: actualTypeName size - 1)].
	actualTypeName first == $* "e.g. *DoublePtr"
		ifTrue: [actualTypeName := actualTypeName allButFirst].

	^ actualTypeName last == $]
		ifTrue: [self parseBasicTypeName: (self parseArrayTypeName: actualTypeName) first]
		ifFalse: [actualTypeName]!

----- Method: ExternalType class>>platformChangedFrom:to: (in category 'system startup') -----
platformChangedFrom: lastPlatform to: currentPlatform
	"Byte size or byte alignment for atomic types might be different on the new platform."
	
	lastPlatform pluginVersion ~= currentPlatform pluginVersion
		ifTrue: ["Type codes might have changed. Re-init thoroughly. Preserve type identity."
			self initialize "Slower but necessary for new type codes"]
		ifFalse: ["Byte alignment of double and int64_t might have changed. Re-init quickly. Preserve type identity."
			currentPlatform wordSize = 4 ifTrue: [self initializeFast]].
	
	self flag: #todo. "mt: Update all critical aliases for atomic types, i.e., intptr_t, uintptr_t. But what about 'c_long' between 64-bit platforms?!!"
	"lastPlatform wordSize ~= currentPlatform wordSize
		ifTrue: [self recompileAllLibraryFunctions]."!

----- Method: ExternalType class>>pointer (in category 'type constants - extra') -----
pointer
	"Answers a generic pointer type, that is, void*"
	
	^ ExternalType void asPointerType!

----- Method: ExternalType class>>pointerAliasAlignment (in category 'private') -----
pointerAliasAlignment
	^ self pointerAlignment!

----- Method: ExternalType class>>pointerAliasSpec (in category 'private') -----
pointerAliasSpec
	"Answers a mask to check the #headerWord for a type alias to a pointer type.
	
	mt 5/15/2021 -- I removed the FFIFlagStructure because the FFI plugin returned byte arrays as pointers instead of an external address, which is really cumbersome to manage in the image. Also this distinction is not needed, which makes me believe it was a simple bug. -- Also note that simply converting thos byte arrays into external addresses in the image would not work for FFI calls, which actually expected those byte arrays. Strange. There might be some extra table managed for those. Still not sure why."
	^ "self structureSpec bitOr:" self pointerSpec!

----- Method: ExternalType class>>pointerAlignment (in category 'private') -----
pointerAlignment
	^ FFIPlatformDescription current wordSize!

----- Method: ExternalType class>>pointerSpec (in category 'private') -----
pointerSpec
	"Answers a spec for pointers, which already includes the platform-specific pointer size."
	^(FFIPlatformDescription current wordSize bitOr: FFIFlagPointer)!

----- Method: ExternalType class>>pointerTypeNames (in category 'instance list') -----
pointerTypeNames

	^ self pointerTypes collect: [:each | each typeName]!

----- Method: ExternalType class>>pointerTypes (in category 'instance list') -----
pointerTypes
	"Answers the pointer types."

	^ Array streamContents: [:stream |	
		self pointerTypesDo: [:type | stream nextPut: type]]!

----- Method: ExternalType class>>pointerTypesDo: (in category 'instance list') -----
pointerTypesDo: block
	"Enumerate all pointer types. No alias-to-pointer types, but pointer types for other type aliases."

	self allAtomicTypesDo: [:type |
		block value: type asPointerType].
	self allStructTypesDo: [:type |
		block value: type asPointerType].
	self allArrayTypesDo: [:type |
		block value: type asPointerType].!

----- Method: ExternalType class>>ptrdiff_t (in category 'type constants - stddef.h') -----
ptrdiff_t

	^ self intptr_t!

----- Method: ExternalType class>>recompileAllLibraryFunctions (in category 'housekeeping') -----
recompileAllLibraryFunctions
	"Recompile all methods that do FFI calls (e.g. <apicall ... > or <cdecl ... >) to update all mappings from type name to atomic type and struct type. Note that unknown struct types will be created on-the-fly and can later be completed by defining fields in the particular structure class via #defineFields or #compileFields. Note that such a recompilation is especially useful if 'type constants' for atomic types to additional dispatch such as according to the current platform's #wordSize."

	SystemNavigation default allSelectorsAndMethodsDo: [:behavior :selector :method |
		(method externalLibraryFunction notNil
			or: [method hasPragma: #callback:])
				ifTrue: [behavior recompile: selector]].!

----- Method: ExternalType class>>resetAllTypes (in category 'housekeeping') -----
resetAllTypes
	"DANGEROUS!! Only do this if you think that your image is in an inconsistent state. You must not actively use FFI (i.e., have instances of external structures or external data) while calling this."
	
	ExternalTypePool nukeAll.

	AtomicTypeCodes := nil.
	AtomicTypes := nil.
	StructTypes := nil.
	ArrayTypes := nil.

	self initialize.
	self recompileAllLibraryFunctions.!

----- Method: ExternalType class>>sbyte (in category 'type constants') -----
sbyte

	self flag: #deprecated.
	^self int8_t!

----- Method: ExternalType class>>schar (in category 'type constants') -----
schar

	self flag: #deprecated.
	^ self char8_t!

----- Method: ExternalType class>>short (in category 'type constants') -----
short

	self flag: #deprecated.
	^self int16_t!

----- Method: ExternalType class>>signedByte (in category 'type constants') -----
signedByte

	self flag: #deprecated.
	^ self int8_t!

----- Method: ExternalType class>>signedChar (in category 'type constants') -----
signedChar

	self flag: #deprecated.
	^ self char8_t!

----- Method: ExternalType class>>signedInt (in category 'type constants') -----
signedInt

	self flag: #deprecated.
	^ self signedLong!

----- Method: ExternalType class>>signedLong (in category 'type constants') -----
signedLong

	self flag: #deprecated.
	^ self int32_t!

----- Method: ExternalType class>>signedLongLong (in category 'type constants') -----
signedLongLong

	self flag: #deprecated.	
	^ self int64_t!

----- Method: ExternalType class>>signedShort (in category 'type constants') -----
signedShort

	self flag: #deprecated.	
	^ self int16_t!

----- Method: ExternalType class>>size_t (in category 'type constants - stddef.h') -----
size_t

	^ self uintptr_t!

----- Method: ExternalType class>>string (in category 'type constants - extra') -----
string
	^ self char asPointerType!

----- Method: ExternalType class>>structTypeNamed: (in category 'instance lookup') -----
structTypeNamed: typeName
	"Answers the external type for the struct named typeName. If there is no type yet, create a new one but only if typeName can be matched to an existing class in the system already. If you still need a type even if there is no such class present, use #newTypeNamed: to create a type with an unknown referent class."
	
	^ (StructTypes at: typeName ifAbsent: [nil])
		ifNil: [ "Create struct types for existing struct classes on-the-fly."
			StructTypes removeKey: typeName ifAbsent: [].
			(self environment classNamed: typeName)
				ifNotNil: [:cls | (cls includesBehavior: ExternalStructure) ifTrue: [
					self newTypeNamed: typeName]]]!

----- Method: ExternalType class>>structTypeNames (in category 'instance list') -----
structTypeNames
	"Answers the names of the currently known struct types."

	^ self structTypes collect: [:each | each typeName]!

----- Method: ExternalType class>>structTypes (in category 'instance list') -----
structTypes
	"Answers the currently known struct types, including type-alias-to-atomic and type-alias-to-struct types."

	^ Array streamContents: [:stream |
		self structTypesDo: [:type | stream nextPut: type]]!

----- Method: ExternalType class>>structTypesDo: (in category 'instance list') -----
structTypesDo: block
	"Enumerate all struct types. Includes types for packed structs and unions."
	
	StructTypes do: [:each | (each notNil and: [each isStructureType and: [each isTypeAlias not]])
		ifTrue: [block value: each]]!

----- Method: ExternalType class>>structureSpec (in category 'private') -----
structureSpec
	"Answers a spec for empty structures, which are 0 bytes in size."
	^FFIFlagStructure!

----- Method: ExternalType class>>typeAliasTypeNames (in category 'instance list') -----
typeAliasTypeNames

	^ self typeAliasTypes collect: [:each | each typeName]!

----- Method: ExternalType class>>typeAliasTypes (in category 'instance list') -----
typeAliasTypes
	"Answers the currently known type-alias types."

	^ Array streamContents: [:stream |
		self typeAliasTypesDo: [:type | stream nextPut: type]]!

----- Method: ExternalType class>>typeAliasTypesDo: (in category 'instance list') -----
typeAliasTypesDo: block
	"All type alias types are managed in StructTypes for easy reference via #referentClass."
	
	StructTypes do: [:each | each ifNotNil: [:type |
		type isTypeAlias ifTrue: [block value: type]]]!

----- Method: ExternalType class>>typeNamed: (in category 'instance lookup') -----
typeNamed: typeName
	"Supports pointer-type lookup for both atomic and structure types.
	Examples: 'long', 'long*', 'long *' or 'MyStruct', 'MyStruct*', 'MyStruct *', 'IntPtr', '*IntPtr' "
	
	| isPointerType isNonPointerType isArrayType actualTypeName type |
	isArrayType := false. isNonPointerType := false.
	actualTypeName := typeName copyWithoutAll: ' '.

	(isPointerType := actualTypeName last == $*) "e.g. MyStruct*"
		ifTrue: [actualTypeName := actualTypeName allButLast].
	actualTypeName last == $) "e.g. (char[])* -- pointer type for array type"
		ifTrue: [actualTypeName := (actualTypeName copyFrom: 2 to: actualTypeName size - 1)].
	(isNonPointerType := actualTypeName first == $*) "e.g. *DoublePtr"
		ifTrue: [actualTypeName := actualTypeName allButFirst].

	(isArrayType := actualTypeName last == $])
		ifTrue: [ type := self arrayTypeNamed: actualTypeName ]
		ifFalse: [
			(Symbol lookup: actualTypeName)
				ifNotNil: [:sym | actualTypeName := sym].
			type := (self atomicTypeNamed: actualTypeName)
				ifNil: [self structTypeNamed: actualTypeName]].

	^ type ifNotNil: [
		isPointerType
			ifTrue: [type asPointerType "e.g. int* MyStruct* "]
			ifFalse: [isNonPointerType
				ifTrue: [type asNonPointerType "e.g. *IntPtr *MyStructPtr "]
				ifFalse: [type "e.g. int IntPtr MyStruct MyStructPtr "]]]!

----- Method: ExternalType class>>uint (in category 'type constants') -----
uint

	self flag: #deprecated.
	^ self uint32_t!

----- Method: ExternalType class>>uintptr_t (in category 'type constants - stddef.h') -----
uintptr_t
	"Answer an unsigned integer type that can hold a data pointer on the current platform, that is, 4-byte pointers on 32-bit und 8-byte pointers on 64-bit. Unlike actual C pointers (e.g., void*), you can do (pointer) arithmetic (e.g., #+) and bitwise manipulation (e.g., #bitOr:) on the resulting Smalltalk Integer objects.
	
	Note that the equivalent type for a void* yields an instance if ExternalData, whose handle is an ExternalAddress, which actually impelements #+ as of June 2020. So, you can also do pointer arithmetic using that type.
	
	Note that all FFI calls and struct types will be updated automatically on startup if a platform change is detected."

	^ FFIPlatformDescription current wordSize = 4
		ifTrue: [self uint32_t]
		ifFalse: [self uint64_t]!

----- Method: ExternalType class>>ulong (in category 'type constants') -----
ulong

	self flag: #deprecated.
	^ self uint32_t!

----- Method: ExternalType class>>ulonglong (in category 'type constants') -----
ulonglong

	self flag: #deprecated.
	^ self uint64_t!

----- Method: ExternalType class>>unsignedByte (in category 'type constants') -----
unsignedByte

	self flag: #deprecated.
	^ self uint8_t!

----- Method: ExternalType class>>unsignedChar (in category 'type constants') -----
unsignedChar

	self flag: #deprecated.
	^self uchar8_t!

----- Method: ExternalType class>>unsignedInt (in category 'type constants') -----
unsignedInt

	self flag: #deprecated.
	^ self uint32_t!

----- Method: ExternalType class>>unsignedLong (in category 'type constants') -----
unsignedLong

	self flag: #deprecated.
	^ self uint32_t!

----- Method: ExternalType class>>unsignedLongLong (in category 'type constants') -----
unsignedLongLong
	
	self flag: #deprecated.
	^ self uint64_t!

----- Method: ExternalType class>>unsignedShort (in category 'type constants') -----
unsignedShort

	self flag: #deprecated.
	^ self uint16_t!

----- Method: ExternalType class>>useArrayClasses (in category 'preferences') -----
useArrayClasses
	<preference: 'Use array classes (i.e. RawBitsArray)'
		categoryList: #('FFI Kernel')
		description: 'When true, type-based allocation in (local) object memory will use array classes instead of a ByteArray wrapped in ExternalData. Does not apply to external allocation.'
		type: #Boolean>
	^UseArrayClasses ifNil:[true]!

----- Method: ExternalType class>>useArrayClasses: (in category 'preferences') -----
useArrayClasses: aBoolean

	UseArrayClasses := aBoolean.!

----- Method: ExternalType class>>useArrayClassesDuring: (in category 'preferences') -----
useArrayClassesDuring: aBlock

	| priorValue |
	priorValue := UseArrayClasses.
	UseArrayClasses := true.
	aBlock ensure: [UseArrayClasses := priorValue].!

----- Method: ExternalType class>>useTypePool (in category 'preferences') -----
useTypePool
	<preference: 'Use type pool in generated accessors'
		categoryList: #('FFI Kernel')
		description: 'When true, fill a pool of external types to be used in type accessors and struct-field accessors, which makes type access much faster. See ExternalTypePool.'
		type: #Boolean>
	^UseTypePool ifNil: [true]!

----- Method: ExternalType class>>useTypePool: (in category 'preferences') -----
useTypePool: aBoolean

	UseTypePool = aBoolean ifTrue: [^ self].
	UseTypePool := aBoolean.
	Cursor wait showWhile: [ExternalTypePool update].!

----- Method: ExternalType class>>ushort (in category 'type constants') -----
ushort

	self flag: #deprecated.
	^ self uint16_t!

----- Method: ExternalType class>>wchar_t (in category 'type constants - extra') -----
wchar_t
	"Type for wide characters. Name originates from wchar.h"

	^ self uchar32_t!

----- Method: ExternalType>>allocate (in category 'external data') -----
allocate
	"Allocate a single representative for this type."

	| data |
	data := self asNonPointerType allocate: 1.	
	^ referentClass ifNil: [data "genuine atomics"] ifNotNil: [data first]!

----- Method: ExternalType>>allocate: (in category 'external data') -----
allocate: numElements
	"Allocate space for containing an array of numElements of this dataType. Use a proper array class if present."
	
	| handle |
	self class useArrayClasses ifTrue: [
		(self allocateArrayClass: numElements)
			ifNotNil: [:array | ^ array]].
	handle := ByteArray new: self byteSize * numElements.
	^ExternalData fromHandle: handle type: self size: numElements!

----- Method: ExternalType>>allocateArrayClass: (in category 'external data') -----
allocateArrayClass: numElements
	"Allocate space for containing an array of numElements of this dataType. Try to use an array class. Answer 'nil' if there is no such class for the receiver."
	
	^ arrayClass ifNotNil: [arrayClass new: numElements]!

----- Method: ExternalType>>allocateExternal (in category 'external data') -----
allocateExternal
	"Allocate a single representative for this type in external memory."

	| data |
	data := self asNonPointerType allocateExternal: 1.	
	^ referentClass ifNil: [data "genuine atomics"] ifNotNil: [data first]!

----- Method: ExternalType>>allocateExternal: (in category 'external data') -----
allocateExternal: numElements
	"Allocate space for containing an array of numElements of this type. Note that we zero the memory for safe use. If you do not need that, please use ExternalAddress class >> #allocate: directly. BE AWARE that structs can have pointers tools automatically follow and thus risking a SEGFAULT and hence VM CRASH for uninitalized memory."
	
	| handle arrayByteSize |
	arrayByteSize := self byteSize * numElements.
	handle := ExternalAddress allocateZero: arrayByteSize.
	^ ExternalData fromHandle: handle type: self size: numElements!

----- Method: ExternalType>>arrayClass (in category 'accessing') -----
arrayClass

	^ arrayClass!

----- Method: ExternalType>>asArrayType: (in category 'converting') -----
asArrayType: numElements

	^ self class arrayTypeFor: self size: numElements!

----- Method: ExternalType>>asBasicType (in category 'converting') -----
asBasicType
	"Construct a basic representation of the receiver. Can be used for testing the #headerWord and other basic properties that are accessible from within the FFI plugin for type checking etc. where polymorphic message sending cannot be applied."
	
	| basicType basicReferencedType |
	basicType := ExternalType basicNew
		compiledSpec: compiledSpec;
		setReferentClass: referentClass;
		yourself.
	basicReferencedType :=  ExternalType basicNew
		compiledSpec: referencedType compiledSpec;
		setReferentClass: referencedType referentClass;
		yourself.
	basicType setReferencedType: basicReferencedType.
	basicReferencedType setReferencedType: basicType.
	^ basicType!

----- Method: ExternalType>>asCharType (in category 'converting - integer / char') -----
asCharType
	"When the receiver is an integer type, answer the corresponding character type."
	
	self isCharType ifTrue: [^ self].
	self isIntegerType ifFalse: [^ self error: 'Cannot convert non-integer type to char type'].
	
	self byteSize = 1 ifTrue: [^ self class uchar8_t].
	self byteSize = 2 ifTrue: [^ self class uchar16_t].
	self byteSize = 4 ifTrue: [^ self class uchar32_t].

	self error: 'Cannot convert integer to char type; unsupported byteSize'.!

----- Method: ExternalType>>asDoublePrecision (in category 'converting - float') -----
asDoublePrecision

	^ self isDoublePrecision
		ifTrue: [self]
		ifFalse: [self companionType]!

----- Method: ExternalType>>asIntegerType (in category 'converting - integer / char') -----
asIntegerType
	"When the receiver is a character type, answer the corresponding integer type."

	self isIntegerType ifTrue: [^ self].
	self isCharType ifFalse: [^ self error: 'Cannot convert non-char type to integer type'].
	
	self byteSize = 1 ifTrue: [^ self class uint8_t].
	self byteSize = 2 ifTrue: [^ self class uint16_t].
	self byteSize = 4 ifTrue: [^ self class uint32_t].

	self error: 'Cannot convert char to integer type; unsupported byteSize'.!

----- Method: ExternalType>>asNonPointerType (in category 'converting') -----
asNonPointerType
	"convert the receiver into a non pointer type"
	self isPointerType
		ifTrue:[^referencedType]
		ifFalse:[^self]!

----- Method: ExternalType>>asPointerToPointerType (in category 'converting') -----
asPointerToPointerType

	self flag: #todo. "mt: Maybe we might want to use double pointers such as void** to indicate address-of-a-pointer on call? So that domain-specific malloc functions can work such as void allocate(void** pointer, size_t size);. Otherwise map it to an array of pointers instead: void*[]."
	^ (self asPointerType asArrayType: nil) asPointerType!

----- Method: ExternalType>>asPointerType (in category 'converting') -----
asPointerType
	"convert the receiver into a pointer type"
	self isPointerType
		ifTrue:[^self]
		ifFalse:[^referencedType]!

----- Method: ExternalType>>asSigned (in category 'converting - integer / char') -----
asSigned

	^ self isSigned
		ifTrue: [self]
		ifFalse: [self companionType]!

----- Method: ExternalType>>asSinglePrecision (in category 'converting - float') -----
asSinglePrecision

	^ self isSinglePrecision
		ifTrue: [self]
		ifFalse: [self companionType]!

----- Method: ExternalType>>asUnsigned (in category 'converting - integer / char') -----
asUnsigned

	^ self isUnsigned
		ifTrue: [self]
		ifFalse: [self companionType]!

----- Method: ExternalType>>atomicType (in category 'accessing - atomic') -----
atomicType
	"Type code for atomic types is stored in the headerWord. See AtomicTypeCodes for another lookup table."
	
	^(self headerWord bitAnd: FFIAtomicTypeMask) >> FFIAtomicTypeShift!

----- Method: ExternalType>>atomicTypeName (in category 'accessing - atomic') -----
atomicTypeName
	
	self subclassResponsibility.!

----- Method: ExternalType>>becomeUnknownType (in category 'private') -----
becomeUnknownType

	| newUnknownType |
	newUnknownType := ExternalUnknownType basicNew
		compiledSpec: self compiledSpec;
		byteAlignment: self byteAlignment;
		setReferentClass: referentClass;
		setReferencedType: referencedType;
		yourself.
	
	"Make my pointer type common again by setting the referentClass."
	newUnknownType setReferencedType: referencedType.
	referencedType setReferentClass: referentClass.
		
	self becomeForward: newUnknownType.
	^ newUnknownType!

----- Method: ExternalType>>byteAlignment (in category 'accessing') -----
byteAlignment
	^ byteAlignment!

----- Method: ExternalType>>byteAlignment: (in category 'private') -----
byteAlignment: anInteger
	byteAlignment := anInteger!

----- Method: ExternalType>>byteSize (in category 'accessing') -----
byteSize
	"Return the size in bytes of this type"
	^self headerWord bitAnd: FFIStructSizeMask!

----- Method: ExternalType>>checkFloatType (in category 'private') -----
checkFloatType

	self isFloatType
		ifFalse: [self error: 'Test is only defined on integer types!!'].!

----- Method: ExternalType>>checkIntegerType (in category 'private') -----
checkIntegerType

	self isIntegerType
		ifFalse: [self error: 'Test is only defined on integer types!!'].!

----- Method: ExternalType>>companionType (in category 'accessing - atomic') -----
companionType

	self subclassResponsibility.!

----- Method: ExternalType>>compiledSpec (in category 'accessing') -----
compiledSpec
	"Return the compiled spec of the receiver"
	^compiledSpec!

----- Method: ExternalType>>compiledSpec: (in category 'private') -----
compiledSpec: aWordArray
	compiledSpec := aWordArray.!

----- Method: ExternalType>>embeddedSpecWithSize: (in category 'private') -----
embeddedSpecWithSize: typeSize
	"Return a compiled spec for embedding in a new compiled spec."
	| spec header |
	spec := self compiledSpec copy.
	header := spec at: 1.
	header := (header bitAnd: FFIStructSizeMask bitInvert32) bitOr: typeSize.
	spec at: 1 put: header.
	(self isStructureType and:[self isPointerType not])
		ifTrue:[spec := spec copyWith: self class structureSpec].
	^spec!

----- Method: ExternalType>>generateTypeAccessor (in category 'external structure') -----
generateTypeAccessor
	"Generate a fast accessor for the receiver, usually implemented on the class-side of the referentClass."
	
	| poolVarName theClass selector source category |
	referentClass ifNil: [^ self "See ExternalAtomicType >> #generateTypeAccessor"].

	theClass := referentClass.
	selector := #externalType.

	self
		assert: [theClass ~~ ExternalStructure]
		description: 'You must not overwrite the generic type accessor'.

	ExternalType useTypePool ifFalse: [
		SystemChangeNotifier uniqueInstance doSilently: [theClass class removeSelector: selector].
		^ self "See ExternalStructure class >> #externalType"].

	poolVarName := ExternalTypePool assuredPoolVarNameFor: self.
	
	source := '{1}\	{2}\	<generated>\	^ {3}' withCRs
		format: {
			selector.
			'"This method was automatically generated. See {1}>>{2}"'
				format: {thisContext methodClass. thisContext selector}.
			poolVarName }.
	
	category := '*autogenerated - external type'.
	theClass class compileSilently: source classified: category.!

----- Method: ExternalType>>handle:at: (in category 'external data') -----
handle: handle at: byteOffset
	"Read the receiver's external type using the given handle and the byteOffset. This is the dynamic version of #readFieldAt:."

	self subclassResponsibility.!

----- Method: ExternalType>>handle:at:put: (in category 'external data') -----
handle: handle at: byteOffset put: value
	"Write a value using the receiver's external type at the given handle and byteOffset. This is the dynamic version of #writeFieldAt:with:."

	self subclassResponsibility.!

----- Method: ExternalType>>handle:atIndex: (in category 'external data') -----
handle: handle atIndex: index

	^ self
		handle: handle
		at: ((index-1) * self byteSize) + 1!

----- Method: ExternalType>>handle:atIndex:put: (in category 'external data') -----
handle: handle atIndex: index put: value

	^ self
		handle: handle
		at: ((index-1) * self byteSize) + 1
		put: value!

----- Method: ExternalType>>headerWord (in category 'private') -----
headerWord
	"Return the compiled header word"
	^compiledSpec at: 1!

----- Method: ExternalType>>invalidate (in category 'private') -----
invalidate
	"Make this type invalid to be re-initialized. This could happen when platform-characteristics change."

	compiledSpec := nil.
	byteAlignment := nil.!

----- Method: ExternalType>>isArrayType (in category 'testing') -----
isArrayType

	self flag: #todo. "mt: Change once encoded in headerWord. See #isAtomic for inspiration."
	^ false!

----- Method: ExternalType>>isAtomic (in category 'testing') -----
isAtomic
	"Return true if the receiver describes a built-in type"

	^ (self headerWord anyMask: FFIFlagAtomic)
		and: [self headerWord noMask: FFIFlagPointer]!

----- Method: ExternalType>>isBoolType (in category 'testing - special') -----
isBoolType
	
	| type |
	type := self atomicType.
	^ type = FFITypeBool!

----- Method: ExternalType>>isCharType (in category 'testing - integer / char') -----
isCharType
	"Return true if the receiver is a built-in character type. Note that we want to avoid hard-coding type codes and invariants around type codes here to remain compatible with different plugin versions."

	| type |
	type := self atomicType.
	type = FFITypeUnsignedChar8 ifTrue: [^ true].
	type = FFITypeSignedChar8 ifTrue: [^ true]. "Not needed anymore. See #atomicTypeSpecs"
	type = FFITypeUnsignedChar16 ifTrue: [^ true].
	type = FFITypeUnsignedChar32 ifTrue: [^ true].
	^ false!

----- Method: ExternalType>>isDoublePrecision (in category 'testing - float') -----
isDoublePrecision

	self checkFloatType.
	^ self atomicType = FFITypeDoubleFloat !

----- Method: ExternalType>>isEmpty (in category 'testing - special') -----
isEmpty

	^ self byteSize = 0!

----- Method: ExternalType>>isFloatType (in category 'testing - float') -----
isFloatType
	"Return true if the receiver is a built-in float type"
	| type |
	type := self atomicType.
	^type = FFITypeSingleFloat or: [type = FFITypeDoubleFloat]!

----- Method: ExternalType>>isIntegerType (in category 'testing - integer / char') -----
isIntegerType
	"Return true if the receiver is a built-in integer type. Note that we want to avoid hard-coding type codes and invariants around type codes here to remain compatible with different plugin versions."

	| type |
	type := self atomicType.
	type = FFITypeUnsignedInt8 ifTrue: [^ true].
	type = FFITypeSignedInt8 ifTrue: [^ true].
	type = FFITypeUnsignedInt16 ifTrue: [^ true].
	type = FFITypeSignedInt16 ifTrue: [^ true].
	type = FFITypeUnsignedInt32 ifTrue: [^ true].
	type = FFITypeSignedInt32 ifTrue: [^ true].
	type = FFITypeUnsignedInt64 ifTrue: [^ true].
	type = FFITypeSignedInt64 ifTrue: [^ true].
	^ false!

----- Method: ExternalType>>isPointerType (in category 'testing') -----
isPointerType

	^ self headerWord anyMask: FFIFlagPointer!

----- Method: ExternalType>>isSigned (in category 'testing - integer / char') -----
isSigned
	"Return true if the receiver is a signed integer type. Note that we want to avoid hard-coding type codes and invariants around type codes here to remain compatible with different plugin versions."

	| type |
	type := self atomicType.
	type = FFITypeSignedInt8 ifTrue: [^ true].
	type = FFITypeSignedInt16 ifTrue: [^ true].
	type = FFITypeSignedInt32 ifTrue: [^ true].
	type = FFITypeSignedInt64 ifTrue: [^ true].
	self checkIntegerType.
	^ false!

----- Method: ExternalType>>isSinglePrecision (in category 'testing - float') -----
isSinglePrecision

	self checkFloatType.
	^ self atomicType = FFITypeSingleFloat !

----- Method: ExternalType>>isStringType (in category 'testing - special') -----
isStringType

	^ self isCharType and: [self isPointerType]!

----- Method: ExternalType>>isStructureType (in category 'testing') -----
isStructureType
	"Return true if the receiver represents a structure type"
	
	^ (self headerWord anyMask: FFIFlagStructure)
		and: [self headerWord noMask: FFIFlagPointer "alias to pointer type"]
		and: [self isArrayType not "alias to array type"]!

----- Method: ExternalType>>isTypeAlias (in category 'testing') -----
isTypeAlias
	
	self subclassResponsibility.!

----- Method: ExternalType>>isTypeAliasReferenced (in category 'testing') -----
isTypeAliasReferenced
	"Answer whether this type is the referencedType of a type alias."
	
	^ referencedType notNil and: [referencedType isTypeAlias]!

----- Method: ExternalType>>isUnknownType (in category 'testing') -----
isUnknownType
	
	^ (self isAtomic
		or: [self isPointerType
		or: [self isStructureType
		or: [self isArrayType]]]) not!

----- Method: ExternalType>>isUnsigned (in category 'testing - integer / char') -----
isUnsigned
	"Return true if the receiver is an unsigned integer type."

	^ self isSigned not!

----- Method: ExternalType>>isVoid (in category 'testing - special') -----
isVoid
	"Return true if the receiver describes a plain 'void' type"
	^self isAtomic and:[self atomicType = 0]!

----- Method: ExternalType>>maxVal (in category 'accessing - atomic') -----
maxVal
	"Force ByteArray. Do not use #allocate:."
	
	| data bytes |
	bytes := ByteArray new: self byteSize.
	data := ExternalData fromHandle: bytes type: self size: 1.
	
	self isIntegerType ifTrue: [
		self isSigned ifTrue: [
			bytes atAllPut: 16rFF.
			FFIPlatformDescription current endianness = #little
				ifTrue: [bytes at: bytes size put: 16r7F]
				ifFalse: [bytes at: 1 put: 16r7F].
			^ data value].
		self isUnsigned ifTrue: [
			bytes atAllPut: 16rFF.
			^ data value]].

	self isFloatType ifTrue: [
		bytes atAllPut: 16rFF.
		self isSinglePrecision ifTrue: [
			FFIPlatformDescription current endianness = #little
				ifTrue: [
					bytes at: bytes size put: 16r7F.
					bytes at: bytes size - 1 put: 16r7F]
				ifFalse: [
					bytes at: 1 put: 16r7F.
					bytes at: 2 put: 16r7F].
			^ data value].
		self isDoublePrecision ifTrue: [
			FFIPlatformDescription current endianness = #little
				ifTrue: [
					bytes at: bytes size put: 16r7F.
					bytes at: bytes size - 1 put: 16rEF]
				ifFalse: [
					bytes at: 1 put: 16r7F.
					bytes at: 2 put: 16rEF].
			^ data value]].
	
	self error: 'maxVal not defined for this type'.!

----- Method: ExternalType>>minVal (in category 'accessing - atomic') -----
minVal
	"Force ByteArray. Do not use #allocate:."

	| data bytes |
	bytes := ByteArray new: self byteSize.
	data := ExternalData fromHandle: bytes type: self size: 1.
	
	self isIntegerType ifTrue: [
		self isSigned ifTrue: [
			FFIPlatformDescription current endianness = #little
				ifTrue: [bytes at: bytes size put: 1 << 7]
				ifFalse: [bytes at: 1 put: 1 << 7].
			^ data value].
		self isUnsigned ifTrue: [
			^ data value]].

	self isFloatType ifTrue: [
		bytes atAllPut: 16rFF.
		self isSinglePrecision ifTrue: [
			FFIPlatformDescription current endianness = #little
				ifTrue: [bytes at: bytes size - 1 put: 16r7F]
				ifFalse: [bytes at: 2 put: 16r7F].
			^ data value].
		self isDoublePrecision ifTrue: [
			FFIPlatformDescription current endianness = #little
				ifTrue: [bytes at: bytes size - 1 put: 16rEF]
				ifFalse: [bytes at: 2 put: 16rEF].
			^ data value]].
		
	self error: 'minVal not defined for this type'.!

----- Method: ExternalType>>newReferentClass: (in category 'private') -----
newReferentClass: classOrNil

	self updateFromReferentClass: classOrNil.
	referencedType updateFromReferentClass: classOrNil.!

----- Method: ExternalType>>newTypeAlias (in category 'private') -----
newTypeAlias

	self subclassResponsibility.!

----- Method: ExternalType>>originalType (in category 'accessing - type alias') -----
originalType
	"Resolve original type for alias. Error if not a type alias."

	^ referentClass originalType!

----- Method: ExternalType>>printContentsOn: (in category 'printing') -----
printContentsOn: aStream

	aStream
		space;
		nextPut: $(;
		nextPutAll: self byteSize asString;
		space;
		nextPutAll: self byteAlignment asString;
		nextPut: $).!

----- Method: ExternalType>>printOn: (in category 'printing') -----
printOn: aStream

	self printTypeNameOn: aStream.
	
	(self isTypeAlias or: [self isTypeAliasReferenced])
		ifTrue: [self printOriginalTypeOn: aStream]
		ifFalse: [self printContentsOn: aStream].!

----- Method: ExternalType>>printOriginalTypeOn: (in category 'printing') -----
printOriginalTypeOn: aStream

	aStream
		nextPutAll: ' ~> ';
		print: self originalType.!

----- Method: ExternalType>>printTypeNameOn: (in category 'printing') -----
printTypeNameOn: aStream

	aStream nextPutAll: self typeName.!

----- Method: ExternalType>>readAlias (in category 'external structure') -----
readAlias

	self subclassResponsibility.!

----- Method: ExternalType>>readFieldAt: (in category 'external structure') -----
readFieldAt: byteOffset
	"Answer a string defining the accessor to an entity of the receiver type starting at the given byte offset. 
	 Private. Used for field definition only."

	self subclassResponsibility.!

----- Method: ExternalType>>referentClass (in category 'accessing') -----
referentClass
	"Return the class specifying the receiver"
	^referentClass!

----- Method: ExternalType>>setArrayClass: (in category 'private') -----
setArrayClass: class

	arrayClass := class.!

----- Method: ExternalType>>setReferencedType: (in category 'private') -----
setReferencedType: aType
	referencedType := aType!

----- Method: ExternalType>>setReferentClass: (in category 'private') -----
setReferentClass: aClass
	referentClass := aClass.!

----- Method: ExternalType>>size (in category 'accessing') -----
size
	"Backstop for array types. Undefined for all other types. Once encoded in the headerWord, this might answer something more specific for all types."

	^ nil!

----- Method: ExternalType>>storeOn: (in category 'printing') -----
storeOn: aStream

	self flag: #todo. "mt: There are more compact (and maybe faster) representations for atomic types."
	
	aStream
		nextPut: $(;
		nextPutAll: ExternalType name; space;
		nextPutAll: #typeNamed:; space;
		store: self typeName;
		nextPutAll: ')'.!

----- Method: ExternalType>>storeStringForField (in category 'external structure') -----
storeStringForField
	"Answers the code snippet to be used to make use of the receiver during field access in an external structure."

	^ self class useTypePool
		ifTrue: [ExternalTypePool assuredPoolVarNameFor: self]
		ifFalse: [self storeString]!

----- Method: ExternalType>>typeName (in category 'accessing') -----
typeName

	^ String streamContents: [:stream |
		(self isPointerType not and: [self asPointerType isTypeAlias])
			ifTrue: [stream nextPut: $* "e.g. *DoublePtr *MyStructPtr"]
			ifFalse: ["e.g. double DoublePtr MyStruct MyStructPtr"].
		
		stream nextPutAll: (referentClass
			ifNil: [self atomicTypeName "e.g. double double*"]
			ifNotNil: [referentClass name "e.g. MyStruct MyStruct* MyStructPtr *MyStructPtr"]).
		
		(self isPointerType and: [self isTypeAlias not])
			ifTrue: [stream nextPut: $* "e.g. double* MyStruct*"]
			ifFalse: ["e.g. double DoublePtr MyStruct MyStructPtr"]]!

----- Method: ExternalType>>updateFromReferentClass: (in category 'private') -----
updateFromReferentClass: classOrNil

	referentClass := classOrNil.!

----- Method: ExternalType>>writeAliasWith: (in category 'external structure') -----
writeAliasWith: valueName

	self subclassResponsibility.!

----- Method: ExternalType>>writeFieldArgName (in category 'external structure') -----
writeFieldArgName

	^ referentClass
		ifNotNil: ['a',referentClass name]
		ifNil: ['externalData']!

----- Method: ExternalType>>writeFieldAt:with: (in category 'external structure') -----
writeFieldAt: byteOffset with: valueName
	"Answer a string defining the accessor to an entity of the receiver type starting at the given byte offset. 
	 Private. Used for field definition only."

	self subclassResponsibility.!

ExternalType subclass: #ExternalUnknownType
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'FFI-Kernel'!

----- Method: ExternalUnknownType class>>newTypeForUnknownNamed: (in category 'instance creation') -----
newTypeForUnknownNamed: label
	
	| typeName type pointerType |
	typeName := label asSymbol.
	self
		assert: [(StructTypes includesKey: typeName) not]
		description: 'Type already exists. Use #typeNamed: to access it.'.
	
	type := ExternalUnknownType basicNew
		compiledSpec: (WordArray with: self structureSpec);
		byteAlignment: 0; "dummy until #newReferentClass: is called"
		setReferentClass: typeName;
		yourself.
	self assert: [type isEmpty].
		
	pointerType := ExternalPointerType basicNew
		compiledSpec: (WordArray with: self pointerSpec);
		byteAlignment: self pointerAlignment;
		yourself.
	self assert: [pointerType isPointerType].

	"Connect non-pointer type with pointer type."
	type setReferencedType: pointerType.
	pointerType setReferencedType: type.
	
	"Remember this new struct type, even if still unknown."
	StructTypes at: typeName put: type.
	
	^ type!

----- Method: ExternalUnknownType>>becomeArrayType (in category 'construction') -----
becomeArrayType
	"I am now positive on #isTypeAliasForArray :-) Make myself an array type. Not that easy because Arraytype as extra instVars #size and #contentType."
	
	^ self
		becomeKnownTypeClass: ExternalArrayType
		with: [:arrayType |
			arrayType
				setContentType: referentClass originalType contentType; "Hmm..."
				setSize: referentClass originalType size; "Hmm..."
				setByteSize: referentClass originalType byteSize "Hmm..."]!

----- Method: ExternalUnknownType>>becomeAtomicType (in category 'construction') -----
becomeAtomicType

	^ self
		becomeKnownTypeClass: ExternalAtomicType
		with: [:atomicType |
			atomicType
				setAtomicTypeName: referentClass originalType atomicTypeName;
				setReadWriteSends: { referentClass originalType readSend. referentClass originalType writeSend }]!

----- Method: ExternalUnknownType>>becomeKnownType (in category 'construction') -----
becomeKnownType
	"Give me some purpose. :-)"

	self isTypeAliasForAtomic
		ifTrue: [^ self becomeAtomicType].
	self isTypeAliasForPointer
		ifTrue: [^ self becomePointerType].
	self isTypeAliasForStructure
		ifTrue: [^ self becomeStructureType].
	self isTypeAliasForArray
		ifTrue: [^ self becomeArrayType].

	^ self becomeStructureType!

----- Method: ExternalUnknownType>>becomeKnownTypeClass:with: (in category 'construction') -----
becomeKnownTypeClass: typeClass with: initBlock

	| newKnownType |	
	newKnownType := typeClass basicNew
		compiledSpec: self compiledSpec;
		byteAlignment: self byteAlignment;
		setReferentClass: referentClass;
		setReferencedType: referencedType.
	initBlock value: newKnownType.
	self becomeForward: newKnownType.	
	^ newKnownType!

----- Method: ExternalUnknownType>>becomeKnownTypeSafely (in category 'construction') -----
becomeKnownTypeSafely
	"Give me some purpose. :-)"

	^ [self becomeKnownType]
		ifError: [:msg |
			Transcript showln: ('[FFI] Type for {1} still unknown: {2}' format: {referentClass. msg}).
			self assert: [self isUnknownType].
			self].!

----- Method: ExternalUnknownType>>becomePointerType (in category 'construction') -----
becomePointerType
	"I am a type alias for a pointer type now. Forget my current pointer type (i.e. referencedType), which I will replace myself. Also, create a new non-pointer type based on a copy of the original type's non-pointer type. In that copy, we can (1) replace the referentClass with mine and (2) link back to use via referencedType so that #asPointerType and #asNonPointerType work as expected."
	
	self changeClassTo: ExternalPointerType.
	self newTypeAlias.!

----- Method: ExternalUnknownType>>becomeStructureType (in category 'construction') -----
becomeStructureType
	"Fast path because no extra instVars in ExternalStructureType."
	
	self changeClassTo: ExternalStructureType.!

----- Method: ExternalUnknownType>>becomeUnknownType (in category 'private') -----
becomeUnknownType

	self assert: [self isUnknownType].!

----- Method: ExternalUnknownType>>invalidate (in category 'private') -----
invalidate
	"We can directly initialize this type again."

	compiledSpec := WordArray with: self structureSpec.
	byteAlignment := 0.!

----- Method: ExternalUnknownType>>isArrayType (in category 'testing') -----
isArrayType

	^ false!

----- Method: ExternalUnknownType>>isAtomic (in category 'testing') -----
isAtomic

	^ false!

----- Method: ExternalUnknownType>>isPointerType (in category 'testing') -----
isPointerType

	^ false!

----- Method: ExternalUnknownType>>isStructureType (in category 'testing') -----
isStructureType

	^ false!

----- Method: ExternalUnknownType>>isTypeAlias (in category 'testing') -----
isTypeAlias

	^ [self isTypeAliasForAtomic
		or: [self isTypeAliasForPointer
		or: [self isTypeAliasForStructure
		or: [self isTypeAliasForArray]]]
	] ifError: [false "Ignore uninitialized field specs"]!

----- Method: ExternalUnknownType>>isTypeAliasForArray (in category 'testing - type alias') -----
isTypeAliasForArray
	"Overwritten because at some point, the receiver might be an alias and not yet changed to ExternalArrayType. See #becomeArrayType. Once #isArrayType is encoded in the headerWord, this can be removed."
	
	^ referentClass notNil
		and: [referentClass isTypeAlias
		and: [referentClass originalType isArrayType]]!

----- Method: ExternalUnknownType>>isTypeAliasForAtomic (in category 'testing - type alias') -----
isTypeAliasForAtomic

	^ referentClass notNil
		and: [referentClass isTypeAlias
		and: [referentClass originalType isAtomic]]!

----- Method: ExternalUnknownType>>isTypeAliasForPointer (in category 'testing - type alias') -----
isTypeAliasForPointer

	^ referentClass notNil
		and: [referentClass isTypeAlias
		and: [referentClass originalType isPointerType]]!

----- Method: ExternalUnknownType>>isTypeAliasForStructure (in category 'testing - type alias') -----
isTypeAliasForStructure

	^ referentClass notNil
		and: [referentClass isTypeAlias
		and: [referentClass originalType isStructureType]]!

----- Method: ExternalUnknownType>>isUnknownType (in category 'testing') -----
isUnknownType

	^ true!

----- Method: ExternalUnknownType>>newTypeAlias (in category 'private') -----
newTypeAlias
	"A type alias is done compiling and its type can now be initialized completely. See ExternalTypeAlias class >> #originalTypeName and #isSkipped."

	self assert: [referentClass isBehavior].

	referentClass isTypeAlias
		ifTrue: [^ self becomeKnownType].
		
	self error: '[FFI] Only type aliases can become a known type later on'.!

----- Method: ExternalUnknownType>>printOn: (in category 'printing') -----
printOn: aStream

	aStream
		nextPutAll: '<unknown type>';
		space;
		print: self typeName.!

----- Method: ExternalUnknownType>>typeName (in category 'accessing') -----
typeName

	self assert: [referentClass isSymbol].
	^ referentClass "Usually just the name of the class."!

----- Method: ExternalUnknownType>>updateFromReferentClass: (in category 'private') -----
updateFromReferentClass: classOrNil

	self assert: [classOrNil notNil].
	
	referentClass := classOrNil.
	compiledSpec := referentClass compiledSpec.
	byteAlignment := referentClass byteAlignment.!

Object subclass: #FFIPlatformDescription
	instanceVariableNames: 'name osVersion subtype wordSize endianness pluginVersion'
	classVariableNames: 'CheckFFIOnStartUp LastPlatform'
	poolDictionaries: ''
	category: 'FFI-Kernel-Support'!

!FFIPlatformDescription commentStamp: 'mt 6/2/2020 15:18' prior: 0!
This class stores the information about the current (host) platform. It supports testing instances for platform compatibility and specificity. The entire FFI machinery should go through here, when making platform-specific decisions such as when figuring out the #wordSize for pointers to external memory (i.e., ExternalAddress class >> #new) or when looking up compatible definitions for external pools (i.e., ExternalPool class >> #compatibleResolvedDefinitions).


1. DETECT PLATFORM CHANGE ON STARTUP

This class is registered for system startup. It then checks whether the current platform is different from the last one. In that case, a selection of FFI classes gets notified such as ExternalObject and ExternalType.


2. PLATFORM SPECIFICITY

Platform descriptions may be unspecific, that is, some of their values may be undefined. For example, (FFIPlatformDescription name: 'unix') creates a valid description but is not specific about #osVersion or #wordSize. When comparing such descriptions, precedence of the platform values are:

	platform name > osVersion > subtype > wordSize

So, if one description has a #name and the other does not, the first one is more specific. If both have #name but only the second one has #osVersion, the second one is more specific. If one has only #wordSize and another one has only #subtype, the second one is more specific because #subtype has a higher precedence than #wordSize.


3. PLATFORM COMPATIBILITY

Platform descriptions implement a notion of compatibility, which is coupled to its notion of specificity as mentioned before. Using the same rules of precedence, compatibility is checked by comparing the description's values. If not specificed, compatibility is assumed. If specified, values must match via #= to be regarded compatible.

Here is an interesting edge case of two compatible platform descriptions:

	| p1 p2 |
	p1 := FFIPlatformDescription name: 'Win32' osVersion: '' subtype: 'IX86' wordSize: nil.
	p2 := FFIPlatformDescription name: '' osVersion: 'linux-gnu' subtype: '' wordSize: 8.
	p1 isCompatibleWith: p2.

Consequently, the developer has to be careful with unspecific platform descriptions, which are used, for example, in the definitions of external pools.


4. FURTHER READING

- all references to FFIPlatformDescription
- all senders of #wordSize
- class comments of ExternalAddress, ExternalType, ExternalPool, ExternalObject
!

----- Method: FFIPlatformDescription class>>checkFFI (in category 'system startup') -----
checkFFI
	"Try to load the FFI module. Warn if not possible."
	
	[ [ExternalType int32_t
		handle: #[ 0 0 0 0 ]
		at: 1
		put: 42] ifError: [:msg |
			self notify: 'FFI plugin not available.', String cr, String cr, msg]
	] fork. "Do not interrupt the startup list."!

----- Method: FFIPlatformDescription class>>checkFFIOnStartUp (in category 'preferences') -----
checkFFIOnStartUp
	<preference: 'Check FFI on start-up'
		categoryList: #('FFI Kernel')
		description: 'When enabled, performs a simple check of the FFI plugin when Squeak is resuming.'
		type: #Boolean>
	^ CheckFFIOnStartUp ifNil: [true]!

----- Method: FFIPlatformDescription class>>checkFFIOnStartUp: (in category 'preferences') -----
checkFFIOnStartUp: aBoolean

	CheckFFIOnStartUp := aBoolean.!

----- Method: FFIPlatformDescription class>>cleanUp: (in category 'initialize-release') -----
cleanUp: aggressive

	aggressive ifTrue: [
		"Force a detection of platform change on next system start up."
		LastPlatform := nil].!

----- Method: FFIPlatformDescription class>>current (in category 'instance creation') -----
current

	^ LastPlatform ifNil: [LastPlatform := self newCurrent]!

----- Method: FFIPlatformDescription class>>currentEndianness (in category 'accessing') -----
currentEndianness
	"self currentEndianness"

	^ Smalltalk os endianness!

----- Method: FFIPlatformDescription class>>currentName (in category 'accessing') -----
currentName
	"self currentName"

	^ Smalltalk os platformName!

----- Method: FFIPlatformDescription class>>currentOSVersion (in category 'accessing') -----
currentOSVersion
	"self currentOSVersion"

	^ Smalltalk osVersion!

----- Method: FFIPlatformDescription class>>currentPluginVersion (in category 'system startup') -----
currentPluginVersion
	"Answers the version of the currently loaded FFI plugin. Can be used to coordinate the communication that relies on shared data structures such as type codes (e.g., v1 means float = 12 and double = 13) and classes (e.g., v1 means ExternalType has compiledSpec at instVar[1] and ExternalObject has handle at instVar[1]."
	<primitive: #primitivePluginVersion module: #SqueakFFIPrims>
	^ 1!

----- Method: FFIPlatformDescription class>>currentSubtype (in category 'accessing') -----
currentSubtype
	"self currentSubtype"

	^ Smalltalk os platformSubtype!

----- Method: FFIPlatformDescription class>>currentWordSize (in category 'accessing') -----
currentWordSize
	"self currentWordSize"

	^ Smalltalk wordSize!

----- Method: FFIPlatformDescription class>>empty (in category 'instance creation') -----
empty
	^ self new!

----- Method: FFIPlatformDescription class>>initialize (in category 'class initialization') -----
initialize
	"
	FFIPlatformDescription initialize
	"
	Smalltalk addToStartUpList: self after: (Smalltalk classNamed: #ShortRunArray).!

----- Method: FFIPlatformDescription class>>name: (in category 'instance creation') -----
name: aName
	^ self new name: aName!

----- Method: FFIPlatformDescription class>>name:osVersion: (in category 'instance creation') -----
name: aName osVersion: anOSVersionString
	^ self new
		name: aName;
		osVersion: anOSVersionString!

----- Method: FFIPlatformDescription class>>name:osVersion:subtype: (in category 'instance creation') -----
name: aName osVersion: anOSVersionString subtype: aSubtypeString
	^ self new
		name: aName;
		osVersion: anOSVersionString;
		subtype: aSubtypeString!

----- Method: FFIPlatformDescription class>>name:osVersion:subtype:wordSize: (in category 'instance creation') -----
name: aName osVersion: anOSVersionString subtype: aSubtypeString wordSize: aWordSize
	^ self new
		name: aName;
		osVersion: anOSVersionString;
		subtype: aSubtypeString;
		wordSize: aWordSize!

----- Method: FFIPlatformDescription class>>name:osVersion:subtype:wordSize:pluginVersion: (in category 'instance creation') -----
name: aName osVersion: anOSVersionString subtype: aSubtypeString wordSize: aWordSize pluginVersion: aVersionNumber
	^ self new
		name: aName;
		osVersion: anOSVersionString;
		subtype: aSubtypeString;
		wordSize: aWordSize;
		pluginVersion: aVersionNumber!

----- Method: FFIPlatformDescription class>>name:wordSize: (in category 'instance creation') -----
name: aName wordSize: aWordSize
	^ self new
		name: aName;
		wordSize: aWordSize!

----- Method: FFIPlatformDescription class>>newCurrent (in category 'instance creation') -----
newCurrent

	^ self
		name: self currentName
		osVersion: self currentOSVersion
		subtype: self currentSubtype
		wordSize: self currentWordSize
		pluginVersion: self currentPluginVersion!

----- Method: FFIPlatformDescription class>>startUp: (in category 'system startup') -----
startUp: resuming
	"Notify all FFI classes about platform changes."

	resuming ifTrue: [
		LastPlatform in: [:lastPlatform | self newCurrent in: [:currentPlatform |
			lastPlatform = currentPlatform
				ifTrue: [
					self flag: #discuss. "mt: Maybe add #platformResuming?"
					ExternalAddress allBeNull ]
				ifFalse: [
					LastPlatform := currentPlatform. "Update now. See #current."
					{ ExternalAddress. ExternalType. ExternalPool. ExternalLibrary }
						do: [:cls | cls
							platformChangedFrom: lastPlatform
							to: currentPlatform] ]]].
		self checkFFIOnStartUp ifTrue: [self checkFFI]].!

----- Method: FFIPlatformDescription class>>unload (in category 'class initialization') -----
unload

	Smalltalk removeFromStartUpList: self.!

----- Method: FFIPlatformDescription>>= (in category 'comparing') -----
= anObject
	self == anObject
		ifTrue: [^ true].

	self species == anObject species
		ifFalse: [^ false].

	^ self name = anObject name
		and: [self osVersion = anObject osVersion
		and: [self subtype = anObject subtype
		and: [self wordSize = anObject wordSize
		and: [self pluginVersion = anObject pluginVersion]]]]!

----- Method: FFIPlatformDescription>>endianness (in category 'accessing') -----
endianness

	^ endianness ifNil: [endianness := self class currentEndianness]!

----- Method: FFIPlatformDescription>>endianness: (in category 'accessing') -----
endianness: aSymbol

	endianness := aSymbol.!

----- Method: FFIPlatformDescription>>hasName (in category 'testing') -----
hasName
	^ self name notEmpty!

----- Method: FFIPlatformDescription>>hasOSVersion (in category 'testing') -----
hasOSVersion
	^ self osVersion notEmpty!

----- Method: FFIPlatformDescription>>hasSubtype (in category 'testing') -----
hasSubtype
	^ self subtype notEmpty!

----- Method: FFIPlatformDescription>>hasWordSize (in category 'testing') -----
hasWordSize
	^ self wordSize notNil!

----- Method: FFIPlatformDescription>>hash (in category 'comparing') -----
hash
	^ (((self species hash bitXor:
		self name hash) bitXor:
			self osVersion hash) bitXor:
				self subtype hash) bitXor:
					self wordSize hash!

----- Method: FFIPlatformDescription>>isARM (in category 'testing') -----
isARM

	^ self subtype beginsWith: 'arm'!

----- Method: FFIPlatformDescription>>isCompatibleWith: (in category 'testing') -----
isCompatibleWith: aPlatform
	self == aPlatform
		ifTrue: [^ true].

	(self name = aPlatform name
		or: [self hasName not
			or: [aPlatform hasName not]])
		ifFalse: [^ false].

	(self osVersion = aPlatform osVersion
		or: [self hasOSVersion not
			or: [aPlatform hasOSVersion not]])
		ifFalse: [^ false].

	(self subtype = aPlatform subtype
		or: [self hasSubtype not
			or: [aPlatform hasSubtype not]])
		ifFalse: [^ false].

	(self wordSize = aPlatform wordSize
		or: [self hasWordSize not
			or: [aPlatform hasWordSize not]])
		ifFalse: [^ false].

	^ true.!

----- Method: FFIPlatformDescription>>isMacOS (in category 'testing') -----
isMacOS

	^ self name = 'Mac OS'!

----- Method: FFIPlatformDescription>>isMoreSpecificThan: (in category 'testing') -----
isMoreSpecificThan: aPlatform
	self == aPlatform
		ifTrue: [^ false].

	(self hasName
		and: [aPlatform hasName not])
		ifTrue: [^ true].

	(self hasOSVersion
		and: [aPlatform hasOSVersion not])
		ifTrue: [^ true].

	(self hasSubtype
		and: [aPlatform hasSubtype not])
		ifTrue: [^ true].

	(self hasWordSize
		and: [aPlatform hasWordSize not])
		ifTrue: [^ true].

	^ false.!

----- Method: FFIPlatformDescription>>isUnix (in category 'testing') -----
isUnix

	^ self name = 'unix'!

----- Method: FFIPlatformDescription>>isWindows (in category 'testing') -----
isWindows

	^ self name = 'Win32'!

----- Method: FFIPlatformDescription>>name (in category 'accessing') -----
name
	^ name ifNil: [name := '']!

----- Method: FFIPlatformDescription>>name: (in category 'accessing') -----
name: aName
	name := aName!

----- Method: FFIPlatformDescription>>osVersion (in category 'accessing') -----
osVersion
	^ osVersion ifNil: [osVersion := '']!

----- Method: FFIPlatformDescription>>osVersion: (in category 'accessing') -----
osVersion: anOSVersionString
	osVersion := anOSVersionString!

----- Method: FFIPlatformDescription>>osVersionBuild (in category 'accessing') -----
osVersionBuild
	"Answers the build version number for the platform. Only defined for macOS and Windows platforms. Usually 0 on Windows platforms."

	^ (self osVersion findTokens: $.) second!

----- Method: FFIPlatformDescription>>osVersionMajor (in category 'accessing') -----
osVersionMajor
	"Answers the major version number for the platform. Only defined for macOS and Windows platforms."
	
	| token |
	token := (self osVersion findTokens: $.) first.
	self isMacOS
		ifTrue: [ "e.g. Mac OS 90.3 92.2 109.1 1015.2 1100.0"
			^ ((token beginsWith: '9')
				ifTrue: [token first]
				ifFalse: [token first: 2]) asInteger].
	^ token asInteger "e.g. Windows 10.0"!

----- Method: FFIPlatformDescription>>osVersionMinor (in category 'accessing') -----
osVersionMinor
	"Answers the minor version number for the platform. Only defined for macOS."

	| token |
	token := (self osVersion findTokens: $.) first.
	self isMacOS
		ifTrue: [ "e.g. 90.3 92.2 109.1 1015.2 1100.0"
			^ ((token beginsWith: '9')
				ifTrue: [token allButFirst: 1]
				ifFalse: [token allButFirst: 2]) asInteger].
	^ nil!

----- Method: FFIPlatformDescription>>pluginVersion (in category 'accessing') -----
pluginVersion
	^ pluginVersion ifNil: [pluginVersion := 1]!

----- Method: FFIPlatformDescription>>pluginVersion: (in category 'accessing') -----
pluginVersion: anInteger
	pluginVersion := anInteger!

----- Method: FFIPlatformDescription>>printOn: (in category 'printing') -----
printOn: aStream
	self storeOn: aStream!

----- Method: FFIPlatformDescription>>storeOn: (in category 'printing') -----
storeOn: aStream
	aStream
		nextPut: $(;
		nextPutAll: self class name asString;
		nextPutAll: ' name: ';
		print: self name;
		nextPutAll: ' osVersion: ';
		print: self osVersion;
		nextPutAll: ' subtype: ';
		print: self subtype;
		nextPutAll: ' wordSize: ';
		print: self wordSize;
		nextPut: $).!

----- Method: FFIPlatformDescription>>subtype (in category 'accessing') -----
subtype
	^ subtype ifNil: [subtype := '']!

----- Method: FFIPlatformDescription>>subtype: (in category 'accessing') -----
subtype: aSubtypeString
	subtype := aSubtypeString!

----- Method: FFIPlatformDescription>>wordSize (in category 'accessing') -----
wordSize
	^ wordSize!

----- Method: FFIPlatformDescription>>wordSize: (in category 'accessing') -----
wordSize: aWordSize
	wordSize := aWordSize!

----- Method: Object>>externalCallFailed (in category '*FFI-Kernel') -----
externalCallFailed
	"Raise an error after a failed call to an external function"
	| errCode |
	errCode := ExternalFunction getLastError. "this allows us to look at the actual error code"
	^self error: (ExternalFunction errorMessageFor: errCode).!

----- Method: Object>>ffiEqual: (in category '*FFI-Kernel') -----
ffiEqual: other
	
	^ self = other!

----- Method: Object>>ffiIdentical: (in category '*FFI-Kernel') -----
ffiIdentical: other
	
	^ self == other!

----- Method: Object>>isExternalAddress (in category '*FFI-Kernel') -----
isExternalAddress
	"Return true if the receiver describes the address of an object in the outside world. NOTE that this backstop is in Object because atomic types store actual objects (e.g., numbers) as their handle."

	^ false!

----- Method: Object>>isExternalObject (in category '*FFI-Kernel') -----
isExternalObject
	"Answer true if the receiver is a representation for an object that lives in external memory. Note that Squeak FFI supports managing such object in internal object memory, too. See ExternalObject, ExternalStructure, ExternalUnion, ExternalData etc. and also #isInternalMemory and #isExternalAddress."

	^ false!

----- Method: Object>>isFFIArray (in category '*FFI-Kernel') -----
isFFIArray

	^ false!




More information about the Squeak-dev mailing list