[squeak-dev] FFI: FFI-Kernel-mt.208.mcz

commits at source.squeak.org commits at source.squeak.org
Tue Aug 17 10:29:19 UTC 2021


Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI:
http://source.squeak.org/FFI/FFI-Kernel-mt.208.mcz

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

Name: FFI-Kernel-mt.208
Author: mt
Time: 17 August 2021, 12:29:18.868505 pm
UUID: ffad33cd-cc4f-0946-b8c6-6eea0f527dee
Ancestors: FFI-Kernel-mt.207

Complements FFI-Pools-mt34. Adds atomic types for 16-bit and 32-bit characters. Note both types are currently just a sketch to further think about how the FFI plugin can help with string encoding à la TextConverter. We might even want to change both types again and find others.

In any case, this design sketch is accompanied by other changes that make the evolution of atomic types easier. 

Here is what changes
- Adds char8_t, uchar8_t, char16_t, uchar16_t, char32_t, and uchar32_t to mirror int8_t etc.
- The existing 'char' is an alias for 'uchar8_t', which means it is still an unsigned 8-bit char type, as before
- Replace #asciiValue with #asInteger in read/write sends for char types
- Revamp type initialization; see ExternalType class >> #initialize
- Adds #companionType to atomic types to not rely on type codes when switching between signed/unsigned; see #initializeAtomicTypeCompanions
- As array classes, use ByteString for uchar8_t and char8_t as well as WideString for uchar32_t and char32_t
- Move the rest of the FFI compatibility extensions from ByteString up to String

Note that we do not have an array class for 16-bit strings. Whatever this means outside the notion of encoding.

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

Item was changed:
  ----- 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!
- 	^ ExternalType signedChar handle: self at: byteOffset!

Item was changed:
  ----- Method: ByteArray>>signedCharAt:put: (in category '*FFI-Kernel-examples') -----
  signedCharAt: byteOffset put: aCharacter
  
+ 	^ ExternalType char8_t handle: self at: byteOffset put: aCharacter!
- 	^ ExternalType signedChar handle: self at: byteOffset put: aCharacter!

Item was changed:
  ----- 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!
- 	^ ExternalType unsignedChar handle: self at: byteOffset!

Item was changed:
  ----- 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!
- 	^ ExternalType unsignedChar handle: self at: byteOffset put: aCharacter!

Item was removed:
- ----- Method: ByteString class>>externalType (in category '*FFI-Kernel') -----
- externalType
- 
- 	^ self new contentType asArrayType: nil!

Item was removed:
- ----- Method: ByteString>>atByteOffset: (in category '*FFI-Kernel-accessing') -----
- atByteOffset: byteOffset
- 
- 	| index |
- 	index := ((byteOffset-1) / self contentType byteSize) + 1.
- 	^ self at: index!

Item was removed:
- ----- Method: ByteString>>atByteOffset:put: (in category '*FFI-Kernel-accessing') -----
- atByteOffset: byteOffset put: value
- 
- 	| index |
- 	index := ((byteOffset-1) / self contentType byteSize) + 1.
- 	^ self at: index put: value!

Item was changed:
  ----- Method: ByteString>>contentType (in category '*FFI-Kernel-external data') -----
  contentType
  
+ 	^ ExternalType uchar8_t!
- 	^ ExternalType char!

Item was removed:
- ----- Method: ByteString>>externalType (in category '*FFI-Kernel-external data') -----
- externalType
- 
- 	^ self contentType asArrayType: self size!

Item was removed:
- ----- Method: ByteString>>free (in category '*FFI-Kernel-external data') -----
- free
- 
- 	self shouldNotImplement.!

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

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

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

Item was removed:
- ----- Method: ByteString>>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.!

Item was removed:
- ----- Method: ByteString>>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!

Item was removed:
- ----- Method: ByteString>>isFFIArray (in category '*FFI-Kernel-external data') -----
- isFFIArray
- 
- 	^ true!

Item was removed:
- ----- Method: ByteString>>isNull (in category '*FFI-Kernel-external data') -----
- isNull
- 
- 	^ false!

Item was removed:
- ----- Method: ByteString>>reader (in category '*FFI-Kernel-external data') -----
- reader
- 
- 	^ self!

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

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

Item was removed:
- ----- Method: ByteString>>writer (in category '*FFI-Kernel-external data') -----
- writer
- 
- 	^ self!

Item was removed:
- ----- Method: ByteString>>zeroMemory (in category '*FFI-Kernel-external data') -----
- zeroMemory
- 
- 	1 to: self size do: [:index |
- 		self at: index put: Character null].!

Item was changed:
  ----- Method: CharacterReadWriteSend>>handle:at:put: (in category 'evaluating') -----
  handle: handle at: byteOffset put: aCharacter
  
  	super
  		handle: handle
  		at: byteOffset
+ 		put: aCharacter asInteger.
- 		put: aCharacter asciiValue.
  	^ aCharacter!

Item was changed:
  ----- Method: CharacterReadWriteSend>>template (in category 'compiling') -----
  template
  
  	^ self isReading
  		ifTrue: ['(', super template, ') asCharacter']
+ 		ifFalse: [super template copyReplaceAll: '{3}' with: '{3} asInteger']!
- 		ifFalse: [super template copyReplaceAll: '{3}' with: '{3} asciiValue']!

Item was changed:
  ExternalType subclass: #ExternalAtomicType
+ 	instanceVariableNames: 'readSend writeSend atomicTypeName companionType'
- 	instanceVariableNames: ''
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'FFI-Kernel'!

Item was added:
+ ----- Method: ExternalAtomicType class>>code: (in category 'instance lookup') -----
+ code: typeCode
+ 
+ 	^ AtomicTypes at: (AtomicTypeCodes keyAtValue: typeCode)!

Item was added:
+ ----- 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'  #'char8_t')
+ 		(#'char8_t'   #'uchar8_t')
+ 		(#'uchar16_t' #'char16_t')
+ 		(#'char16_t'  #'uchar16_t')
+ 		(#'uchar32_t' #'char32_t')
+ 		(#'char32_t'  #'uchar32_t')
+ 
+ 		(#'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]].!

Item was added:
+ ----- 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."
+ 
+ 	| atomicType byteSize type typeName byteAlignment |
+ 	self assert: [AtomicTypes notNil].
+ 	self assert: [AtomicTypes notEmpty].
+ 
+ 	#(
+ 		"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          8)
+ 		(#'int64_t'   8          8)
+ 
+ 		(#'uchar8_t'  1          1)
+ 		(#'char8_t'   1          1)
+ 		(#'uchar16_t' 2          2)
+ 		(#'char16_t'  2          2)
+ 		(#'uchar32_t' 4          4)
+ 		(#'char32_t'  4          4)
+ 
+ 		(#'float'     4          4)
+ 		(#'double'    8          8)
+ "TODO: ('longdouble' 10			16? 4?)"
+ 	) do:[:typeSpec| | compiled |
+ 		typeName := typeSpec first.
+ 		byteSize := typeSpec second.
+ 		byteAlignment := typeSpec third.
+ 		
+ 		"0) On 32-bits Windows and MacOS, double and long long have an alignment of 8. But on 32-bit Linux, their alignment is 4. But not on a 32-bit Raspberry Pi OS."
+ 		(FFIPlatformDescription current wordSize = 4
+ 			and: [FFIPlatformDescription current isUnix
+ 			and: [FFIPlatformDescription current isARM not]]) ifTrue: [
+ 				(#('double' 'int64_t' 'uint64_t') includes: typeName) ifTrue: [
+ 					byteAlignment := 4]].
+ 		
+ 		"1) Regular type; put type code into headerWord"
+ 		type := AtomicTypes at: typeName.
+ 		atomicType := AtomicTypeCodes at: typeName.
+ 		compiled := WordArray with: ((byteSize bitOr: FFIFlagAtomic) bitOr:
+ 				(atomicType 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:
+ 				(atomicType bitShift: FFIAtomicTypeShift)).
+ 		compiled ~= type compiledSpec
+ 			"Preserve the identity of #compiledSpec."
+ 			ifTrue: [type compiledSpec: compiled].
+ 		type byteAlignment: self pointerAlignment.
+ 	].!

Item was changed:
  ----- 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!

Item was added:
+ ----- Method: ExternalAtomicType>>atomicTypeName (in category 'accessing') -----
+ atomicTypeName
+ 
+ 	^ atomicTypeName!

Item was added:
+ ----- Method: ExternalAtomicType>>companionType (in category 'accessing') -----
+ companionType
+ 	"Answer the receivers companion type, which is either the signed or unsigned version of it."
+ 	
+ 	^ companionType!

Item was changed:
  ----- Method: ExternalAtomicType>>handle:at: (in category 'external data') -----
  handle: handle at: byteOffset
  
  	^ referentClass
  		ifNil: [ "Genuine atomics"
+ 			readSend
- 			(AtomicSends at: self atomicType + 1) first
  				handle: handle
  				at: byteOffset]
  		ifNotNil: [ "Alias to atomics"
  			referentClass fromHandle: (handle
  				structAt: byteOffset
  				length: self byteSize)]!

Item was changed:
  ----- Method: ExternalAtomicType>>handle:at:put: (in category 'external data') -----
  handle: handle at: byteOffset put: value
  
  	^ referentClass
  		ifNil: ["genuine atomic"
+ 			writeSend
- 			(AtomicSends at: self atomicType + 1) second
  				handle: handle
  				at: byteOffset
  				put: value]
  		ifNotNil: ["type alias"
  			handle
  				structAt: byteOffset
  				put: value getHandle
  				length: self byteSize]!

Item was changed:
  ----- 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 
- 		^ (AtomicSends at: self atomicType + 1) first
  				handle: handle
  				atIndex: index].
  	^ super handle: handle atIndex: index!

Item was changed:
  ----- 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
- 		^ (AtomicSends at: self atomicType + 1) second
  				handle: handle
  				atIndex: index
  				put: value].
  	^ super handle: handle atIndex: index put: value!

Item was added:
+ ----- Method: ExternalAtomicType>>invalidate (in category 'private') -----
+ invalidate
+ 	"Do not invalidate my typeName but read/write sends."
+ 	
+ 	super invalidate.
+ 	readSend := nil.
+ 	writeSend := nil.!

Item was changed:
  ----- Method: ExternalAtomicType>>newTypeAlias (in category 'private') -----
  newTypeAlias
- 	"Only support switching between atomic types for now."
  	
  	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.
+ 
+ "!
- 	byteAlignment := referentClass byteAlignment.!

Item was changed:
  ----- Method: ExternalAtomicType>>readFieldAt: (in category 'external structure') -----
  readFieldAt: byteOffset
  
  	^ referentClass
  		ifNil: [ "Genuine atomics"
+ 			'^ ', readSend template
- 			'^ ', (AtomicSends at: self atomicType + 1) first template
  				format: {
  					'handle'.
  					byteOffset}]
  		ifNotNil: [ "Type alias"
  			'^ {1} fromHandle: (handle structAt: {2} length: {3})'
  				format: {
  					referentClass name.
  					byteOffset.
  					self byteSize}]!

Item was added:
+ ----- Method: ExternalAtomicType>>readSend (in category 'accessing') -----
+ readSend
+ 
+ 	^ readSend!

Item was added:
+ ----- Method: ExternalAtomicType>>setAtomicTypeName: (in category 'private') -----
+ setAtomicTypeName: aString
+ 
+ 	atomicTypeName := aString.!

Item was added:
+ ----- Method: ExternalAtomicType>>setCompanionType: (in category 'private') -----
+ setCompanionType: atomicTypeOrNil
+ 
+ 	self assert: [atomicTypeOrNil isNil or: [atomicTypeOrNil isAtomic]].
+ 	companionType := atomicTypeOrNil.!

Item was added:
+ ----- Method: ExternalAtomicType>>setReadWriteSends: (in category 'private') -----
+ setReadWriteSends: atomicReadWriteSends
+ 
+ 	readSend := atomicReadWriteSends first.
+ 	writeSend := atomicReadWriteSends second.!

Item was changed:
  ----- 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 isTypeAlias ifTrue: [
- 		^ super writeFieldArgName].
  
+ 	self error: 'Unknown atomic type'.!
- 	self isIntegerType ifTrue: [
- 		^ 'anInteger'].
- 
- 	^ self atomicTypeName caseOf: {
- 		['bool'] -> ['aBoolean'].
- 		['char'] -> ['aCharacter'].
- 		['schar'] -> ['aCharacter'].
- 		['float'] -> ['aFloat'].
- 		['double'] -> ['aFloat'] }!

Item was changed:
  ----- Method: ExternalAtomicType>>writeFieldAt:with: (in category 'external structure') -----
  writeFieldAt: byteOffset with: valueName
  
  	^ referentClass
  		ifNil: ["genuine atomics"
+ 			writeSend template, '.'
- 			(AtomicSends at: self atomicType + 1) second template, '.'
  				format: {
  					'handle'.
  					byteOffset.
  					valueName}]
  		ifNotNil: ["type alias"
  			'handle structAt: {1} put: {2} getHandle length: {3}.'
  				format: {
  					byteOffset.
  					valueName.
  					self byteSize}]!

Item was added:
+ ----- Method: ExternalAtomicType>>writeSend (in category 'accessing') -----
+ writeSend
+ 
+ 	^ writeSend!

Item was added:
+ ----- Method: ExternalPointerType>>atomicTypeName (in category 'accessing - atomic') -----
+ atomicTypeName
+ 	"Implemented because the receiver might be a pointer-to-atomic type."
+ 
+ 	^ self asNonPointerType atomicTypeName!

Item was changed:
  Object subclass: #ExternalType
  	instanceVariableNames: 'compiledSpec referentClass referencedType byteAlignment'
+ 	classVariableNames: 'ArrayClasses ArrayTypes AtomicTypeCodes AtomicTypes ExtraTypeChecks StructTypes UseArrayClasses UseTypePool'
- 	classVariableNames: 'ArrayClasses ArrayTypes AtomicSends AtomicTypeNames AtomicTypes ExtraTypeChecks StructTypes UseArrayClasses UseTypePool'
  	poolDictionaries: 'FFIConstants'
  	category: 'FFI-Kernel'!
  
  !ExternalType commentStamp: 'mt 6/5/2020 18:25' prior: 0!
  An external type represents the type of external objects.
  
  Instance variables:
  	compiledSpec	<WordArray>		Compiled specification of the external type
  	referentClass	<Behavior | nil>	Class type of argument required
  	referencedType	<ExternalType>	Associated (non)pointer type with the receiver
  	byteAlignment	<Integer | nil>		The desired alignment for a field of the external type within a structure.  If nil it has yet to be computed.
  
  Compiled Spec:
  The compiled spec defines the type in terms which are understood by the VM. Each word is defined as:
  	bits 0...15 	- byte size of the entity
  	bit 16		- structure flag (FFIFlagStructure)
  				  This flag is set if the following words define a structure
  	bit 17		- pointer flag (FFIFlagPointer)
  				  This flag is set if the entity represents a pointer to another object
  	bit 18		- atomic flag (FFIFlagAtomic)
  				  This flag is set if the entity represents an atomic type.
  				  If the flag is set the atomic type bits are valid.
  	bits 19...23	- unused
  	bits 24...27	- atomic type (FFITypeVoid ... FFITypeDoubleFloat)
  	bits 28...31	- unused
  
  Note that all combinations of the flags FFIFlagPointer, FFIFlagAtomic, and FFIFlagStructure are invalid, EXCEPT from the following:
  
  	FFIFlagPointer + FFIFlagAtomic:
  		This defines a pointer to an atomic type (e.g., 'char*', 'int*').
  		The actual atomic type is represented in the atomic type bits.
  
  	FFIFlagPointer + FFIFlagStructure:
  		This defines a structure which is a typedef of a pointer type as in
  			typedef void* VoidPointer;
  			typedef Pixmap* PixmapPtr;
  		It requires a byte size of four or eight (e.g. a 32-bit or 64-bit pointer) to work correctly.
  
  [Note: Other combinations may be allowed in the future]
  !

Item was changed:
  ----- Method: ExternalType class>>atomicTypeNames (in category 'instance list') -----
  atomicTypeNames
  	"Answers the names of the currently known atomic types."
  
+ 	^ AtomicTypeCodes keysInOrder!
- 	^ AtomicTypeNames asArray!

Item was changed:
  ----- Method: ExternalType class>>atomicTypesDo: (in category 'instance list') -----
  atomicTypesDo: block
+ 	"Enumerate all atomic types. No alias-to-atomic types."
  
+ 	self atomicTypeNames do: [:typeName |
- 	AtomicTypeNames do: [:typeName |
  		block value: (AtomicTypes at: typeName)]!

Item was changed:
  ----- Method: ExternalType class>>basicInitializeAtomicTypes (in category 'class initialization') -----
  basicInitializeAtomicTypes
  
  	AtomicTypes ifNil: [
  		AtomicTypes := Dictionary new. "Strong references required because there is no lazy atomic type initialization like there is for struct types and array types."
+ 		self atomicTypeNames do: [:typeName |
- 		AtomicTypeNames valuesDo: [:typeName |
  			self newTypeForAtomicNamed: typeName]].!

Item was changed:
  ----- Method: ExternalType class>>char (in category 'type constants') -----
  char
+ 	"For convenience. Defaults to unsigned 8-bit character type."
- 	"char defaults to unsigned char"
  	
  	self flag: #discuss. "mt: Shouldn't this rather be signed 8-bit character type?"
+ 	^self uchar8_t!
- 	^self unsignedChar!

Item was added:
+ ----- Method: ExternalType class>>char16_t (in category 'type constants - stdint.h') -----
+ char16_t
+ 
+ 	^ AtomicTypes at: 'char16_t'!

Item was added:
+ ----- Method: ExternalType class>>char32_t (in category 'type constants - stdint.h') -----
+ char32_t
+ 
+ 	^ AtomicTypes at: 'char32_t'!

Item was added:
+ ----- Method: ExternalType class>>char8_t (in category 'type constants - stdint.h') -----
+ char8_t
+ 
+ 	^ AtomicTypes at: 'char8_t'!

Item was changed:
  ----- Method: ExternalType class>>initialize (in category 'class initialization') -----
  initialize
  	"
  	ExternalType initialize
  	"
+ 	self initializeAtomicTypeCodes.
- 	self initializeAtomicTypeNames.
- 	
  	self initializeAtomicTypes.
- 	self initializeAtomicSends.
  	
  	self initializeStructureTypes.
  	
  	self initializeArrayClasses.!

Item was changed:
  ----- Method: ExternalType class>>initializeArrayClasses (in category 'class initialization') -----
  initializeArrayClasses
  	"
  	ExternalType initializeArrayClasses.
  	"
  	ArrayClasses ifNil: [
  		ArrayClasses := IdentityDictionary new].
  	
  	RawBitsArray allSubclasses collect: [:arrayClass |
  		[ArrayClasses at: arrayClass new contentType ifAbsentPut: arrayClass]
  			on: Error do: [ "Ignore." ]].
  
+ 	String allSubclasses collect: [:stringClass | | contentType |
+ 		[ contentType := stringClass new contentType.
+ 		ArrayClasses at: contentType asUnsigned ifAbsentPut: stringClass.
+ 		ArrayClasses at: contentType asSigned ifAbsentPut: stringClass ]
+ 			on: Error do: [ "Ignore."]].!
- 	ArrayClasses at: ExternalType unsignedChar put: ByteString.
- 	ArrayClasses at: ExternalType signedChar put: ByteString.	!

Item was changed:
  ----- Method: ExternalType class>>initializeAtomicSends (in category 'class initialization') -----
  initializeAtomicSends
  	"
  	ExternalType initializeAtomicSends.
  	"
+ 	self atomicTypesDo: [:type |
+ 		type setReadWriteSends: (FFIAtomicReadWriteSend fromType: type)].!
- 	AtomicSends ifNil: [
- 		AtomicSends := Array new: AtomicTypeNames size].
- 	
- 	self atomicTypes withIndexDo: [:type :index |
- 		AtomicSends at: index put: (FFIAtomicReadWriteSend fromType: type)].!

Item was added:
+ ----- Method: ExternalType class>>initializeAtomicTypeCodes (in category 'class initialization') -----
+ initializeAtomicTypeCodes
+ 	"ExternalType initializeAtomicTypeCodes"
+ 
+ 	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.
+ 		#'char16_t' -> FFITypeSignedChar16.
+ 		#'uchar32_t' -> FFITypeUnsignedChar32.
+ 		#'char32_t' -> FFITypeSignedChar32.
+ 		
+ 		#'float' -> FFITypeSingleFloat.
+ 		#'double' -> FFITypeDoubleFloat
+ 	}.!

Item was removed:
- ----- Method: ExternalType class>>initializeAtomicTypeNames (in category 'class initialization') -----
- initializeAtomicTypeNames
- 	"ExternalType initialize"
- 
- 	AtomicTypeNames := IdentityDictionary newFrom: {
- 		FFITypeVoid -> #'void'.
- 		FFITypeBool -> #'bool'.
- 		
- 		FFITypeUnsignedInt8 -> #'uint8_t'.
- 		FFITypeSignedInt8 -> #'int8_t'.
- 		FFITypeUnsignedInt16 -> #'uint16_t'.
- 		FFITypeSignedInt16 -> #'int16_t'.
- 		FFITypeUnsignedInt32 -> #'uint32_t'.
- 		FFITypeSignedInt32 -> #'int32_t'.
- 		FFITypeUnsignedInt64 -> #'uint64_t'.
- 		FFITypeSignedInt64 -> #'int64_t'.
- 		
- 		FFITypeUnsignedChar -> #'char'.
- 		FFITypeSignedChar -> #'schar'.
- 		
- 		FFITypeSingleFloat -> #'float'.
- 		FFITypeDoubleFloat -> #'double'
- 	}.!

Item was changed:
  ----- Method: ExternalType class>>initializeAtomicTypes (in category 'class initialization') -----
  initializeAtomicTypes
+ 	"(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].
- 	"(Re-)initialize all atomic types. Preserves object identity of all involved types. If the amount of types changed, use #resetAllAtomicTypes instead."
  		
- 	| atomicType byteSize type typeName byteAlignment |
  	self basicInitializeAtomicTypes.
  	self invalidateAtomicTypes.
  	
+ 	ExternalAtomicType initializeAtomicTypes.
+ 	ExternalAtomicType initializeAtomicTypeCompanions.	
+ 	
+ 	self initializeAtomicSends.!
- 	#(
- 		"name		atomic id		byte size	byte alignment"
- 		(#'void' 		0 				0			0) "No non-pointer support in calls. Duh. ;-)"
- 		(#'bool' 		1 				1			1) "No pointer support in calls."
- 		(#'uint8_t' 		2 				1			1)
- 		(#'int8_t' 	3 				1			1)
- 		(#'uint16_t' 	4 				2			2)
- 		(#'int16_t' 		5 				2			2)
- 		(#'uint32_t' 	6 				4 			4)
- 		(#'int32_t' 		7 				4			4)
- 		(#'uint64_t' 8 				8			8) "v.i."
- 		(#'int64_t' 	9 				8			8) "v.i."
- 		(#'char' 		10 				1			1)
- 		(#'schar' 	11 				1			1)
- 		(#'float' 		12 				4			4)
- 		(#'double' 	13 				8			8) "v.i."
- "TODO: ('longdouble' 14			10			16? 4?)"
- 	) do:[:typeSpec| | compiled |
- 		typeName := typeSpec first.
- 		atomicType := typeSpec second.
- 		self assert: [(AtomicTypeNames keyAtValue: typeName) = atomicType].
- 		
- 		byteSize := typeSpec third.
- 		byteAlignment := typeSpec fourth.
- 		
- 		"0) On 32-bits Windows and MacOS, double and long long have an alignment of 8. But on 32-bit Linux, their alignment is 4. But not on a 32-bit Raspberry Pi OS."
- 		(FFIPlatformDescription current wordSize = 4
- 			and: [FFIPlatformDescription current isUnix
- 			and: [FFIPlatformDescription current isARM not]]) ifTrue: [
- 				(#('double' 'int64_t' 'uint64_t') includes: typeName) ifTrue: [
- 					byteAlignment := 4]].
- 		
- 		"1) Regular type"
- 		type := (AtomicTypes at: typeName).
- 		compiled := WordArray with: ((byteSize bitOr: FFIFlagAtomic) bitOr:
- 				(atomicType bitShift: FFIAtomicTypeShift)).
- 		compiled ~= type compiledSpec
- 			"Preserve the identity of #compiledSpec."
- 			ifTrue: [type compiledSpec: compiled].
- 		type byteAlignment: byteAlignment.
- 		
- 		"2) Pointer type"
- 		type := type asPointerType.
- 		compiled := WordArray with: ((self pointerSpec bitOr: FFIFlagAtomic) bitOr:
- 				(atomicType bitShift: FFIAtomicTypeShift)).
- 		compiled ~= type compiledSpec
- 			"Preserve the identity of #compiledSpec."
- 			ifTrue: [type compiledSpec: compiled].
- 		type byteAlignment: self pointerAlignment.
- 	].!

Item was changed:
  ----- 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."
  	
+ 	"0) For a different FFI plugin version, type-codes might have changed."
+ 	lastPlatform pluginVersion ~= currentPlatform pluginVersion ifTrue: [
+ 		FFIConstants initialize.
+ 		self initializeAtomicTypeCodes].
+ 
  	"1) Update all atomic types for platform-specifc byte size and alignment."
  	self initializeAtomicTypes.
  	
  	"2) Discard all compiled specs for all structure types."
  	self initializeStructureTypes.
  	
  	"3) 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].!

Item was changed:
  ----- Method: ExternalType class>>resetAllAtomicTypes (in category 'housekeeping') -----
  resetAllAtomicTypes
  	"Warning: This call is only required if you change the initialization for AtomicTypes."
  
+ 	AtomicTypeCodes := nil.
+ 	self initializeAtomicTypeCodes.
- 	AtomicTypeNames := nil.
- 	self initializeAtomicTypeNames.
  
  	AtomicTypes := nil.
  	self initializeAtomicTypes.
- 
- 	AtomicSends := nil.
- 	self initializeAtomicSends.
  	
  	"Now also reset everything that depends on atomic types."	
  	self resetAllStructureTypes.!

Item was changed:
  ----- Method: ExternalType class>>schar (in category 'type constants') -----
  schar
+ 
+ 	self flag: #deprecated.
+ 	^ self char8_t!
- 	^self signedChar!

Item was changed:
  ----- Method: ExternalType class>>signedChar (in category 'type constants') -----
  signedChar
+ 
+ 	self flag: #deprecated.
+ 	^ self char8_t!
- 	^AtomicTypes at: 'schar'!

Item was changed:
  ----- 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]])
- 	StructTypes do: [:each | (each notNil and: [each isStructureType])
  		ifTrue: [block value: each]]!

Item was added:
+ ----- Method: ExternalType class>>uchar16_t (in category 'type constants - stdint.h') -----
+ uchar16_t
+ 
+ 	^ AtomicTypes at: 'uchar16_t'!

Item was added:
+ ----- Method: ExternalType class>>uchar32_t (in category 'type constants - stdint.h') -----
+ uchar32_t
+ 
+ 	^ AtomicTypes at: 'uchar32_t'!

Item was added:
+ ----- Method: ExternalType class>>uchar8_t (in category 'type constants - stdint.h') -----
+ uchar8_t
+ 
+ 	^ AtomicTypes at: 'uchar8_t'!

Item was changed:
  ----- Method: ExternalType class>>unsignedChar (in category 'type constants') -----
  unsignedChar
+ 
+ 	self flag: #deprecated.
+ 	^self uchar8_t!
- 	^AtomicTypes at: 'char'!

Item was added:
+ ----- Method: ExternalType class>>wchar_t (in category 'type constants - extra') -----
+ wchar_t
+ 	"Type for wide characters. Name originates from wchar.h"
+ 
+ 	^ self uchar32_t!

Item was added:
+ ----- 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 isSigned ifTrue: [self class char8_t] ifFalse: [self class uchar8_t]].
+ 	self byteSize = 2 ifTrue: [^ self isSigned ifTrue: [self class char16_t] ifFalse: [self class uchar16_t]].
+ 	self byteSize = 4 ifTrue: [^ self isSigned ifTrue: [self class char32_t] ifFalse: [self class uchar32_t]].
+ 
+ 	self error: 'Cannot convert integer to char type; unsupported byteSize'.!

Item was changed:
+ ----- Method: ExternalType>>asDoublePrecision (in category 'converting - float') -----
- ----- Method: ExternalType>>asDoublePrecision (in category 'converting - integer') -----
  asDoublePrecision
  
+ 	^ self isDoublePrecision
+ 		ifTrue: [self]
+ 		ifFalse: [self companionType]!
- 	self isDoublePrecision ifTrue: [^ self].
- 	^ AtomicTypes at: (AtomicTypeNames at: self atomicType + 1)!

Item was added:
+ ----- 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 isSigned ifTrue: [self class int8_t] ifFalse: [self class uint8_t]].
+ 	self byteSize = 2 ifTrue: [^ self isSigned ifTrue: [self class int16_t] ifFalse: [self class uint16_t]].
+ 	self byteSize = 4 ifTrue: [^ self isSigned ifTrue: [self class int32_t] ifFalse: [self class uint32_t]].
+ 
+ 	self error: 'Cannot convert char to integer type; unsupported byteSize'.!

Item was changed:
+ ----- Method: ExternalType>>asSigned (in category 'converting - integer / char') -----
- ----- Method: ExternalType>>asSigned (in category 'converting - integer') -----
  asSigned
  
+ 	^ self isSigned
+ 		ifTrue: [self]
+ 		ifFalse: [self companionType]!
- 	self isSigned ifTrue: [^ self].
- 	^ AtomicTypes at: (AtomicTypeNames at: self atomicType + 1)!

Item was changed:
+ ----- Method: ExternalType>>asSinglePrecision (in category 'converting - float') -----
- ----- Method: ExternalType>>asSinglePrecision (in category 'converting - integer') -----
  asSinglePrecision
  
+ 	^ self isSinglePrecision
+ 		ifTrue: [self]
+ 		ifFalse: [self companionType]!
- 	self isSinglePrecision ifTrue: [^ self].
- 	^ AtomicTypes at: (AtomicTypeNames at: self atomicType - 1)!

Item was changed:
+ ----- Method: ExternalType>>asUnsigned (in category 'converting - integer / char') -----
- ----- Method: ExternalType>>asUnsigned (in category 'converting - integer') -----
  asUnsigned
  
+ 	^ self isUnsigned
+ 		ifTrue: [self]
+ 		ifFalse: [self companionType]!
- 	self isUnsigned ifTrue: [^ self].
- 	^ AtomicTypes at: (AtomicTypeNames at: self atomicType - 1)!

Item was changed:
+ ----- Method: ExternalType>>atomicType (in category 'accessing - atomic') -----
- ----- Method: ExternalType>>atomicType (in category 'accessing') -----
  atomicType
+ 	"Type code for atomic types is stored in the headerWord. See AtomicTypeCodes for another lookup table."
+ 	
  	^(self headerWord bitAnd: FFIAtomicTypeMask) >> FFIAtomicTypeShift!

Item was changed:
+ ----- Method: ExternalType>>atomicTypeName (in category 'accessing - atomic') -----
- ----- Method: ExternalType>>atomicTypeName (in category 'accessing') -----
  atomicTypeName
+ 	
+ 	self subclassResponsibility.!
- 
- 	^ AtomicTypeNames at: self atomicType!

Item was changed:
  ----- Method: ExternalType>>checkIntegerType (in category 'private') -----
  checkIntegerType
  
+ 	(self isIntegerType or: [self isCharType])
- 	self isIntegerType
  		ifFalse: [self error: 'Test is only defined on integer types!!'].!

Item was added:
+ ----- Method: ExternalType>>companionType (in category 'accessing - atomic') -----
+ companionType
+ 
+ 	self subclassResponsibility.!

Item was changed:
+ ----- Method: ExternalType>>isCharType (in category 'testing - integer / char') -----
- ----- Method: ExternalType>>isCharType (in category 'testing - special') -----
  isCharType
  	
  	| type |
  	type := self atomicType.
+ 	^ type >= FFITypeUnsignedChar8 and: [type <= FFITypeSignedChar32]!
- 	^ type = FFITypeUnsignedChar or: [type = FFITypeSignedChar]!

Item was changed:
+ ----- Method: ExternalType>>isIntegerType (in category 'testing - integer / char') -----
- ----- Method: ExternalType>>isIntegerType (in category 'testing - integer') -----
  isIntegerType
  	"Return true if the receiver is a built-in integer type"
  	| type |
  	type := self atomicType.
  	^type >= FFITypeUnsignedInt8 and:[type <= FFITypeSignedInt64]!

Item was changed:
+ ----- Method: ExternalType>>isSigned (in category 'testing - integer / char') -----
- ----- Method: ExternalType>>isSigned (in category 'testing - integer') -----
  isSigned
  	"Return true if the receiver is a signed integer type."
  
  	self checkIntegerType.
  	^self atomicType anyMask: 1!

Item was changed:
  ----- Method: ExternalType>>isStringType (in category 'testing - special') -----
  isStringType
  
+ 	^ self isCharType and: [self isPointerType]!
- 	| type |
- 	type := self atomicType.
- 	^ type = FFITypeUnsignedChar and: [self isPointerType]!

Item was changed:
+ ----- Method: ExternalType>>isUnsigned (in category 'testing - integer / char') -----
- ----- Method: ExternalType>>isUnsigned (in category 'testing - integer') -----
  isUnsigned
  	"Return true if the receiver is an unsigned integer type."
  
  	^ self isSigned not!

Item was changed:
+ ----- Method: ExternalType>>maxVal (in category 'accessing - atomic') -----
- ----- Method: ExternalType>>maxVal (in category 'accessing') -----
  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'.!

Item was changed:
+ ----- Method: ExternalType>>minVal (in category 'accessing - atomic') -----
- ----- Method: ExternalType>>minVal (in category 'accessing') -----
  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'.!

Item was changed:
  ----- Method: ExternalUnknownType>>becomeAtomicType (in category 'construction') -----
  becomeAtomicType
  
+ 	^ self
+ 		becomeKnownTypeClass: ExternalAtomicType
+ 		with: [:atomicType |
+ 			atomicType
+ 				setAtomicTypeName: referentClass originalType atomicTypeName;
+ 				setReadWriteSends: { referentClass originalType readSend. referentClass originalType writeSend }]!
- 	self changeClassTo: ExternalAtomicType.!

Item was changed:
  ----- Method: GenericCharacterReadWriteSend class>>fromType: (in category 'instance creation') -----
+ fromType: charType
- fromType: type
  
+ 	^ super fromType: charType asIntegerType!
- 	^ super fromType: ExternalType byte!

Item was changed:
  ----- Method: GenericCharacterReadWriteSend>>handle:at:put: (in category 'evaluating') -----
  handle: handle at: byteOffset put: aCharacter
  
  	super
  		handle: handle
  		at: byteOffset
+ 		put: aCharacter asInteger.
- 		put: aCharacter asciiValue.
  	^ aCharacter!

Item was changed:
  ----- Method: GenericCharacterReadWriteSend>>template (in category 'compiling') -----
  template
  
  	^ self isReading
  		ifTrue: ['(', super template, ') asCharacter']
+ 		ifFalse: [super template copyReplaceAll: '{3}' with: '{3} asInteger']!
- 		ifFalse: [super template copyReplaceAll: '{3}' with: '{3} asciiValue']!

Item was added:
+ ----- Method: String class>>externalType (in category '*FFI-Kernel') -----
+ externalType
+ 
+ 	^ self new contentType asArrayType: nil!

Item was added:
+ ----- Method: String>>atByteOffset: (in category '*FFI-Kernel-accessing') -----
+ atByteOffset: byteOffset
+ 
+ 	| index |
+ 	index := ((byteOffset-1) / self contentType byteSize) + 1.
+ 	^ self at: index!

Item was added:
+ ----- 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!

Item was added:
+ ----- Method: String>>contentType (in category '*FFI-Kernel-external data') -----
+ contentType
+ 
+ 	self subclassResponsibility.!

Item was added:
+ ----- Method: String>>externalType (in category '*FFI-Kernel-external data') -----
+ externalType
+ 
+ 	^ self contentType asArrayType: self size!

Item was added:
+ ----- Method: String>>free (in category '*FFI-Kernel-external data') -----
+ free
+ 
+ 	self shouldNotImplement.!

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

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

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

Item was added:
+ ----- 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.!

Item was added:
+ ----- 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!

Item was added:
+ ----- Method: String>>isFFIArray (in category '*FFI-Kernel-external data') -----
+ isFFIArray
+ 
+ 	^ true!

Item was added:
+ ----- Method: String>>isNull (in category '*FFI-Kernel-external data') -----
+ isNull
+ 
+ 	^ false!

Item was added:
+ ----- Method: String>>reader (in category '*FFI-Kernel-external data') -----
+ reader
+ 
+ 	^ self!

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

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

Item was added:
+ ----- Method: String>>writer (in category '*FFI-Kernel-external data') -----
+ writer
+ 
+ 	^ self!

Item was added:
+ ----- Method: String>>zeroMemory (in category '*FFI-Kernel-external data') -----
+ zeroMemory
+ 
+ 	1 to: self size do: [:index |
+ 		self at: index put: Character null].!

Item was added:
+ ----- Method: WideString>>contentType (in category '*FFI-Kernel-external data') -----
+ contentType
+ 
+ 	^ ExternalType uchar32_t!

Item was added:
+ ----- 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!

Item was added:
+ ----- 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!

Item was changed:
+ (PackageInfo named: 'FFI-Kernel') postscript: '"Reinitialize new names and codes for atomic types. Includes new types for 16-bit and 32-bit characters."
- (PackageInfo named: 'FFI-Kernel') postscript: '"Reinitialize new names and codes for atomic types."
  FFIConstants initialize.
+ ExternalType resetAllTypes..'!
- ExternalType resetAllTypes.'!




More information about the Squeak-dev mailing list