diff --git a/src/FFI-Kernel/ByteArray.extension.st b/src/FFI-Kernel/ByteArray.extension.st index 368762f1bc8..455c5707131 100644 --- a/src/FFI-Kernel/ByteArray.extension.st +++ b/src/FFI-Kernel/ByteArray.extension.st @@ -12,8 +12,8 @@ ByteArray >> booleanAt: byteOffset [ Examples: (#[1 2 0 4] booleanAt: 2) >>> true. (#[1 2 0 4] booleanAt: 3) >>> false." - - ^(self integerAt: byteOffset size: 1 signed: false) ~= 0 + + ^ (self integerAt: byteOffset size: 1 signed: false) ~= 0 ] { #category : #'*FFI-Kernel' } diff --git a/src/FFI-Kernel/ExternalAddress.class.st b/src/FFI-Kernel/ExternalAddress.class.st index 008048fa01a..fe3094ade4a 100644 --- a/src/FFI-Kernel/ExternalAddress.class.st +++ b/src/FFI-Kernel/ExternalAddress.class.st @@ -86,7 +86,9 @@ ExternalAddress >> + offset [ "Convert xaddr -> bytes" bytes := self asByteArrayPointer. "Update bytes using platform dependent accessors" - bytes unsignedLongAt: 1 put: (bytes unsignedLongAt: 1) + offset. + self size = 4 + ifTrue: [bytes unsignedLongAt: 1 put: (bytes unsignedLongAt: 1) + offset] + ifFalse: [bytes unsignedLongLongAt: 1 put: (bytes unsignedLongLongAt: 1) + offset]. "Convert bytes -> xaddr" ^bytes asExternalPointer ] @@ -95,7 +97,7 @@ ExternalAddress >> + offset [ ExternalAddress >> asByteArrayPointer [ "Answer a ByteArray containing a copy of pointer to the contents of the receiver." | sz | - ^(ByteArray basicNew: (sz := self class wordSize)) + ^(ByteArray basicNew: (sz := self size)) replaceFrom: 1 to: sz with: self startingAt: 1 "answers self" ] @@ -108,10 +110,10 @@ ExternalAddress >> asExternalPointer [ { #category : #converting } ExternalAddress >> asInteger [ "convert address to integer" - ^ self asByteArrayPointer integerAt: 1 size: self class wordSize signed: false + ^ self asByteArrayPointer integerAt: 1 size: self size signed: false ] -{ #category : #'initialize-release' } +{ #category : #initialization } ExternalAddress >> beNull [ "Make the receiver a NULL pointer" self atAllPut: 0. @@ -144,7 +146,7 @@ ExternalAddress >> finalize [ self free ] -{ #category : #'initialize-release' } +{ #category : #initialization } ExternalAddress >> free [ "Primitive. Free the object pointed to on the external heap. Dangerous - may break your system if the receiver hasn't been @@ -159,7 +161,7 @@ ExternalAddress >> fromInteger: address [ "Do we really need this? bf 2/21/2001 23:48" | sz pointer | - sz := self class wordSize. + sz := self size. pointer := ByteArray new: sz. pointer integerAt: 1 put: address size: sz signed: false. . self basicAt: 1 put: (pointer byteAt: 1); diff --git a/src/FFI-Kernel/ExternalFunction.class.st b/src/FFI-Kernel/ExternalFunction.class.st index d713ed62498..0be6f970df0 100644 --- a/src/FFI-Kernel/ExternalFunction.class.st +++ b/src/FFI-Kernel/ExternalFunction.class.st @@ -176,7 +176,7 @@ ExternalFunction >> flags [ ^flags ] -{ #category : #'initialize-release' } +{ #category : #initialization } ExternalFunction >> initialize [ "Initialize the receiver" handle := ExternalAddress new. @@ -220,7 +220,7 @@ ExternalFunction >> invokeWith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 { #category : #invoking } ExternalFunction >> invokeWithArguments: argArray [ "Manually invoke the receiver, representing an external function." - + ^self externalCallFailed ] diff --git a/src/FFI-Kernel/ExternalLibrary.class.st b/src/FFI-Kernel/ExternalLibrary.class.st index 64fd71f25be..abe9d2a4aed 100644 --- a/src/FFI-Kernel/ExternalLibrary.class.st +++ b/src/FFI-Kernel/ExternalLibrary.class.st @@ -18,7 +18,7 @@ ExternalLibrary class >> moduleName [ ^nil ] -{ #category : #'initialize-release' } +{ #category : #initialization } ExternalLibrary >> forceLoading [ "Primitive. Force loading the given library. The primitive will fail if the library is not available @@ -32,7 +32,7 @@ ExternalLibrary >> handle [ ^handle ] -{ #category : #'initialize-release' } +{ #category : #initialization } ExternalLibrary >> initialize [ "Initialize the receiver" name := self class moduleName. diff --git a/src/FFI-Kernel/ExternalStructure.class.st b/src/FFI-Kernel/ExternalStructure.class.st index 418989719b0..3b486c7279f 100644 --- a/src/FFI-Kernel/ExternalStructure.class.st +++ b/src/FFI-Kernel/ExternalStructure.class.st @@ -1,14 +1,71 @@ " -This class provides an abstract base for all structures that can be used by external functions. ExternalStructures have two possible handle types: +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. -Useful methods should be implemented by subclasses of ExternalStructure using the common ByteArray/ExternalAddress platform dependent access protocol which will transparently access the correct memory location. + +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 + + self externalCallFailed + + + " Class { #name : #ExternalStructure, #superclass : #ExternalObject, + #classVars : [ + 'PreviousPlatform' + ], #pools : [ 'FFIConstants' ], @@ -25,31 +82,48 @@ ExternalStructure class >> byteSize [ ] { #category : #'field definition' } -ExternalStructure class >> compileAlias: spec withAccessors: aBool [ +ExternalStructure class >> checkFieldLayoutChange [ + "Recompile the spec and field accessors if the layout changed. + Answer true if the layout changed. + This is usefull at system startup if some structure are machine dependent. + No provision is made for correct initialization order of nested structures. + The correct order of invocation is left at upper responsibility." + + | newCompiledSpec oldCompiledSpec | + oldCompiledSpec := compiledSpec. + newCompiledSpec := self compileFields: self fields withAccessors: #never. + oldCompiledSpec = newCompiledSpec ifTrue: [^false]. + "only regenerate the automatically generated fields: the others are under user responsibility" + compiledSpec := self compileFields: self fields withAccessors: #generated. + ExternalType noticeModificationOf: self. + ^true +] + +{ #category : #'field definition' } +ExternalStructure class >> compileAlias: spec withAccessors: aSymbol [ "Define all the fields in the receiver. Return the newly compiled spec." - | fieldName fieldType isPointerField externalType | + | fieldName fieldType isPointerField externalType newCompiledSpec | fieldName := spec first. fieldType := spec second. isPointerField := fieldType last = $*. fieldType := fieldType copyWithout: $*. externalType := ExternalType atomicTypeNamed: fieldType. - externalType == nil ifTrue:["non-atomic" + externalType isNil ifTrue:["non-atomic" Symbol hasInterned: fieldType ifTrue:[:sym| externalType := ExternalType structTypeNamed: sym]]. - externalType == nil ifTrue:[ + externalType isNil ifTrue:[ Transcript show:'(', fieldType,' is void)'. externalType := ExternalType void]. isPointerField ifTrue:[externalType := externalType asPointerType]. - (fieldName notNil and:[aBool]) ifTrue:[ + (fieldName notNil and:[self shouldGenerate: fieldName policy: aSymbol]) ifTrue:[ self defineAliasAccessorsFor: fieldName type: externalType]. - isPointerField - ifTrue:[compiledSpec := WordArray with: + newCompiledSpec := isPointerField + ifTrue:[WordArray with: (ExternalType structureSpec bitOr: ExternalType pointerSpec)] - ifFalse:[compiledSpec := externalType compiledSpec]. - ExternalType noticeModificationOf: self. - ^compiledSpec + ifFalse:[externalType compiledSpec]. + ^newCompiledSpec ] { #category : #'field definition' } @@ -71,16 +145,23 @@ ExternalStructure class >> compileFields [ ExternalStructure class >> compileFields: fieldSpec [ "Compile the field definition of the receiver. Return the newly compiled spec." - ^self compileFields: fieldSpec withAccessors: false. + compiledSpec := self compileFields: fieldSpec withAccessors: #never. + ExternalType noticeModificationOf: self. + ^compiledSpec ] { #category : #'field definition' } -ExternalStructure class >> compileFields: specArray withAccessors: aBool [ - "Define all the fields in the receiver. - Return the newly compiled spec." - | byteOffset typeSpec | +ExternalStructure class >> compileFields: specArray withAccessors: aSymbol [ + "Compile a type specification for the FFI machinery. + 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 = #generated only generate the auto-generated accessors + - aSymbol = #absent only generate the absent accessors" + | byteOffset typeSpec newCompiledSpec | (specArray size > 0 and: [specArray first class ~~ Array]) ifTrue: - [^ self compileAlias: specArray withAccessors: aBool]. + [^ self compileAlias: specArray withAccessors: aSymbol]. byteOffset := 1. typeSpec := WriteStream on: (WordArray new: 10). typeSpec nextPut: FFIFlagStructure. @@ -112,16 +193,15 @@ ExternalStructure class >> compileFields: specArray withAccessors: aBool [ ifTrue: [^ self error: 'Explicit type size is less than expected']. typeSize := spec third. ]. - (fieldName notNil and: [aBool]) ifTrue: [ + (fieldName notNil and: [self shouldGenerate: fieldName policy: aSymbol]) ifTrue: [ self defineFieldAccessorsFor: fieldName startingAt: byteOffset type: externalType. ]. typeSpec nextPutAll: (externalType embeddedSpecWithSize: typeSize). byteOffset := byteOffset + typeSize. ]. - compiledSpec := typeSpec contents. - compiledSpec at: 1 put: (byteOffset - 1 bitOr: FFIFlagStructure). - ExternalType noticeModificationOf: self. - ^ compiledSpec + newCompiledSpec := typeSpec contents. + newCompiledSpec at: 1 put: (byteOffset - 1 bitOr: FFIFlagStructure). + ^ newCompiledSpec ] { #category : #'field definition' } @@ -130,6 +210,11 @@ ExternalStructure class >> compiledSpec [ ^compiledSpec ifNil:[self compileFields]. ] +{ #category : #converting } +ExternalStructure class >> compositeName [ + ^'struct' +] + { #category : #'field definition' } ExternalStructure class >> defineAliasAccessorsFor: fieldName type: type [ "Define read/write accessors for the given field" @@ -139,7 +224,8 @@ ExternalStructure class >> defineAliasAccessorsFor: fieldName type: type [ code := String streamContents:[:s| s nextPutAll: fieldName; crtab; - nextPutAll:'"This method was automatically generated"'; crtab. + nextPutAll:'"This method was automatically generated"'; crtab; + nextPut: $<; nextPutAll: #generated; nextPut: $>; crtab. refClass == nil ifTrue:[(type isAtomic and:[type isPointerType not]) ifTrue:[s nextPutAll:'^handle'] @@ -159,7 +245,8 @@ ExternalStructure class >> defineAliasAccessorsFor: fieldName type: type [ ifFalse:['a',refClass name]. s nextPutAll: fieldName,': '; nextPutAll: argName; crtab; - nextPutAll:'"This method was automatically generated"'; crtab. + nextPutAll:'"This method was automatically generated"'; crtab; + nextPut: $<; nextPutAll: #generated; nextPut: $>; crtab. (refClass == nil and:[type isAtomic and:[type isPointerType not]]) ifTrue:[s nextPutAll:'handle := ', argName] ifFalse:[s nextPutAll:'handle := ', argName,' getHandle'. @@ -172,7 +259,9 @@ ExternalStructure class >> defineFieldAccessorsFor: fieldName startingAt: byteOf "Define read/write accessors for the given field" | comment | (type isVoid and: [type isPointerType not]) ifTrue:[^self]. - comment := ('\ "This method was automatically generated. See ', self class name, '>>fields."\ ') withCRs. + 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. self maybeCompileAccessor: fieldName,': anObject', comment, (type writeFieldAt: byteOffset with: 'anObject') @@ -186,9 +275,11 @@ ExternalStructure class >> defineFields [ ] { #category : #'field definition' } -ExternalStructure class >> defineFields: fields [ +ExternalStructure class >> defineFields: fieldSpec [ "Define all the fields in the receiver" - self compileFields: fields withAccessors: true. + compiledSpec := self compileFields: fieldSpec withAccessors: #always. + ExternalType noticeModificationOf: self. + ^compiledSpec ] { #category : #'class management' } @@ -242,6 +333,17 @@ ExternalStructure class >> fromHandle: aHandle [ ^self basicNew setHandle: aHandle ] +{ #category : #'system startup' } +ExternalStructure class >> install [ + "Resuming the image on another architecture may require a re-compilation of structure layout." + | newPlatform | + newPlatform := Smalltalk platformName. + PreviousPlatform = newPlatform + ifFalse: + [self recompileStructures. + PreviousPlatform := newPlatform] +] + { #category : #compiling } ExternalStructure class >> maybeCompileAccessor: aString withSelector: selector [ (self compiledMethodAt: selector ifAbsent: []) ifNotNil: @@ -274,6 +376,19 @@ ExternalStructure class >> pointerSize [ ^nil ] +{ #category : #'system startup' } +ExternalStructure class >> recompileStructures [ + "Check and update the layout of all subclasses for host machine dependency. + Arrange to check the inner nested structures first." + + "ExternalStructure recompileStructures" + | sorted unsorted | + unsorted := self withAllSubclasses. + sorted := OrderedCollection new: unsorted size. + self sortStructs: unsorted into: sorted. + sorted do: [:e | e checkFieldLayoutChange] +] + { #category : #'class management' } ExternalStructure class >> rename: aString [ | oldName | @@ -282,15 +397,65 @@ ExternalStructure class >> rename: aString [ oldName = name ifFalse:[ExternalType noticeRenamingOf: self from: oldName to: name]. ] +{ #category : #'field definition' } +ExternalStructure class >> shouldGenerate: 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 = #generated only re-generate the auto-generated accessors + - aSymbol = #absent only generate the absent accessors" + aSymbol = #never ifTrue: [^ false]. + aSymbol = #always ifTrue: [^ true]. + aSymbol = #absent ifTrue: [^ (self methodDictionary includesKey: fieldname) not]. + aSymbol = #generated + ifTrue: [^ (self methodDictionary includesKey: fieldname) + and: [(self methodDictionary at: fieldname) pragmas + anySatisfy: [:p | p keyword = #generated]]]. + self error: 'unknow generation policy' +] + +{ #category : #'field definition' } +ExternalStructure class >> sortStructs: structureClasses into: sortedClasses [ + "Sort the structure definitions so as to obtain a correct initialization order." + + [| structClass prevStructClass dependsOnOtherTypes | + structureClasses isEmpty ifTrue: [^ self]. + structClass := structureClasses anyOne. + + [dependsOnOtherTypes := structClass typeNamesFromWhichIDepend. + prevStructClass := structureClasses detect: [:c | c ~~ structClass and: [dependsOnOtherTypes includes: c name]] ifNone: [nil]. + prevStructClass isNil] + whileFalse: [structClass := prevStructClass]. + + "we found a structure/alias which does not depend on other structures/aliases + add the corresponding class to the initialization list" + sortedClasses add: (structureClasses remove: structClass)] repeat +] + +{ #category : #'field definition' } +ExternalStructure class >> typeNamesFromWhichIDepend [ + "Answer the set of type names of my fields (including pointer stars)" + | f | + (f := self fields) isEmpty ifTrue: [^Set new]. + f first isArray ifFalse: [^Set with: f second]. + ^f collect: [:e | e second] as: Set +] + { #category : #converting } ExternalStructure class >> typedef [ ^self externalType typedef ] -{ #category : #'initialize-release' } +{ #category : #printing } +ExternalStructure >> compositeName [ + ^self class compositeName +] + +{ #category : #finalization } ExternalStructure >> free [ "Free the handle pointed to by the receiver" - (handle ~~ nil and:[handle isExternalAddress]) ifTrue:[handle free]. + (handle notNil and:[handle isExternalAddress]) ifTrue:[handle free]. handle := nil. ] @@ -299,11 +464,12 @@ ExternalStructure >> 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 isKindOf: Array) ifFalse: [fields := Array with: fields]]. + (fields isEmpty or: [fields first isNil]) + ifTrue: [fields := #()] + ifFalse: [fields first isArray ifFalse: [fields := Array with: fields]]. fields do: [ :field | - field first notNil ifTrue: [ - aStream nextPutAll: field first; nextPut: $:; space; tab. + field first ifNotNil: + [aStream nextPutAll: field first; nextPut: $:; space; tab. (self perform: field first) printOn: aStream. aStream cr]]. ] diff --git a/src/FFI-Kernel/ExternalType.class.st b/src/FFI-Kernel/ExternalType.class.st index 0b685b72152..63ad403636c 100644 --- a/src/FFI-Kernel/ExternalType.class.st +++ b/src/FFI-Kernel/ExternalType.class.st @@ -297,7 +297,7 @@ ExternalType class >> noticeRenamingOf: aClass from: oldName to: newName [ { #category : #private } ExternalType class >> pointerSpec [ - ^(4 bitOr: FFIFlagPointer) + ^(Smalltalk wordSize bitOr: FFIFlagPointer) ] { #category : #'type constants' } @@ -518,15 +518,15 @@ ExternalType >> isVoid [ { #category : #private } ExternalType >> newReferentClass: aClass [ "The class I'm referencing has changed. Update my spec." + referentClass := aClass. - self isPointerType ifTrue:[^self]. "for pointers only the referentClass changed" - referentClass == nil ifTrue:[ - "my class has been removed - make me 'struct { void }'" - compiledSpec := WordArray with: (FFIFlagStructure). - ] ifFalse:[ - "my class has been changed - update my compiledSpec" - compiledSpec := referentClass compiledSpec. - ]. + self isPointerType + ifTrue: [ ^ self ]. "for pointers only the referentClass changed" + compiledSpec := referentClass isNil + ifTrue: + [ "my class has been removed - make me 'struct { void }'" WordArray with: FFIFlagStructure ] + ifFalse: + [ "my class has been changed - update my compiledSpec" referentClass compiledSpec ] ] { #category : #accessing } @@ -559,7 +559,7 @@ ExternalType >> printAtomicType: spec on: aStream [ { #category : #printing } ExternalType >> printOn: aStream [ - referentClass == nil + referentClass isNil ifTrue:[aStream nextPutAll: (AtomicTypeNames at: self atomicType)] ifFalse:[aStream nextPutAll: referentClass name]. self isPointerType ifTrue:[aStream nextPut: $*]. @@ -580,7 +580,9 @@ ExternalType >> printStructureFieldStartingAt: initialSpecIndex withName: name i (spec bitClear: FFIStructSizeMask) = FFIFlagStructure ifTrue: [| next | next := initialSpecIndex + 1. - aStream nextPutAll: 'struct {'. + aStream + nextPutAll: subStructureClassBinding value compositeName; + nextPutAll: ' {'. subStructureClassBinding value fields withIndexDo: [:tuple :i| aStream cr. @@ -595,18 +597,24 @@ ExternalType >> printStructureFieldStartingAt: initialSpecIndex withName: name i self assert: (next - 1 = compiledSpec size or: [(compiledSpec at: next) = FFIFlagStructure]). ^next <= compiledSpec size ifTrue: [next + 1] ifFalse: [next]]. self assert: (spec anyMask: FFIFlagPointer). - aStream nextPutAll: 'struct '; nextPutAll: subStructureClassBinding value name; nextPutAll: ' *'; nextPutAll: name. + (subStructureClassBinding value isKindOf: ExternalUnion) + ifTrue: [aStream nextPutAll: 'union '] + ifFalse: [aStream nextPutAll: 'struct ']. + aStream nextPutAll: subStructureClassBinding value name; nextPutAll: ' *'; nextPutAll: name. ^initialSpecIndex + 1 ] { #category : #printing } ExternalType >> printTypedefOn: s [ s nextPutAll: 'typedef '. - (compiledSpec first bitClear: FFIStructSizeMask) = FFIFlagStructure + (referentClass notNil + and: [(compiledSpec first bitClear: FFIStructSizeMask) = FFIFlagStructure]) ifTrue: [| next | next := 2. - s nextPutAll: 'struct {'. + s + nextPutAll: referentClass compositeName; + nextPutAll: ' {'. referentClass fields withIndexDo: [:tuple :i| s cr. @@ -680,7 +688,7 @@ ExternalType >> setReferencedType: aType [ { #category : #printing } ExternalType >> storeOn: aStream [ - referentClass == nil + referentClass isNil ifTrue:[aStream nextPutAll: ExternalType name; space; nextPutAll: (AtomicTypeNames at: self atomicType)] ifFalse:[aStream nextPut: $(; nextPutAll: ExternalType name; space; nextPutAll: #structTypeNamed:; space; store: referentClass name; nextPut: $)]. self isPointerType ifTrue: [aStream space; nextPutAll: #asPointer]. diff --git a/src/FFI-Kernel/ExternalUnion.class.st b/src/FFI-Kernel/ExternalUnion.class.st new file mode 100644 index 00000000000..af609421cf7 --- /dev/null +++ b/src/FFI-Kernel/ExternalUnion.class.st @@ -0,0 +1,93 @@ +" +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 represent +- either a string (accessed through 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). +" +Class { + #name : #ExternalUnion, + #superclass : #ExternalStructure, + #category : #'FFI-Kernel' +} + +{ #category : #'field definition' } +ExternalUnion class >> compileFields: specArray withAccessors: 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 | + (specArray size > 0 and: [specArray first class ~~ Array]) ifTrue: + [^ self error: 'unions must have fields defined by sub-Array']. + byteOffset := 1. + maxByteSize := 0. + typeSpec := WriteStream on: (WordArray new: specArray size + 1). + typeSpec nextPut: FFIFlagStructure. + "dummy for size" + specArray do: + [:spec | + | fieldName fieldType isPointerField externalType typeSize selfRefering | + fieldName := spec first. + fieldType := spec second. + isPointerField := fieldType last = $*. + fieldType := (fieldType findTokens: ' *') first. + externalType := ExternalType atomicTypeNamed: fieldType. + selfRefering := isPointerField and: [externalType isNil and: [fieldType = self asString]]. + selfRefering ifTrue: [ + externalType := ExternalType void asPointerType + ] ifFalse:[ + externalType == nil ifTrue: ["non-atomic" + Symbol + hasInterned: fieldType + ifTrue: [:sym | externalType := ExternalType structTypeNamed: sym]. + ]. + externalType == nil ifTrue:[ + Transcript show: '(' , fieldType , ' is void)'. + externalType := ExternalType void. + ]. + isPointerField ifTrue: [externalType := externalType asPointerType: self pointerSize]]. + typeSize := externalType byteSize. + 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 shouldGenerate: fieldName policy: aSymbol]) ifTrue: [ + self defineFieldAccessorsFor: fieldName startingAt: byteOffset type: externalType. + ]. + typeSpec nextPutAll: (externalType embeddedSpecWithSize: typeSize). + maxByteSize := maxByteSize max: typeSize. + ]. + newCompiledSpec := typeSpec contents. + newCompiledSpec at: 1 put: (maxByteSize bitOr: FFIFlagStructure). + ^ newCompiledSpec +] + +{ #category : #converting } +ExternalUnion class >> compositeName [ + ^'union' +] diff --git a/src/Spec-Core/MenuItemPresenter.class.st b/src/Spec-Core/MenuItemPresenter.class.st index e9644b38bfe..b21264236e8 100644 --- a/src/Spec-Core/MenuItemPresenter.class.st +++ b/src/Spec-Core/MenuItemPresenter.class.st @@ -156,12 +156,12 @@ MenuItemPresenter >> name: aString [ { #category : #api } MenuItemPresenter >> performMenuActionWith: aMenuItem [ | en | - - en := self enabled. + + en := self isEnabled. en isBlock ifTrue: [ en := en value ]. en ifFalse: [ ^ self ]. - - action value cull: aMenuItem + + action value cull: aMenuItem ] { #category : #api } diff --git a/src/UnifiedFFI/FFIExternalPackedStructure.class.st b/src/UnifiedFFI/FFIExternalPackedStructure.class.st index 5f783a234a5..4c882f55b2f 100644 --- a/src/UnifiedFFI/FFIExternalPackedStructure.class.st +++ b/src/UnifiedFFI/FFIExternalPackedStructure.class.st @@ -9,9 +9,9 @@ Class { } { #category : #private } -FFIExternalPackedStructure class >> compileFields: specArray withAccessors: defineBoolean [ - | offset fieldSpec | - +FFIExternalPackedStructure class >> compileFields: specArray withAccessors: aSymbol [ + | offset fieldSpec defineBoolean| + defineBoolean := aSymbol = #always. fieldSpec := self fieldSpec. offset := 0. externalStructureAlignment := self packedStructureAlignment. diff --git a/src/UnifiedFFI/FFIExternalStructure.class.st b/src/UnifiedFFI/FFIExternalStructure.class.st index e5555260e2a..c8158c17f50 100644 --- a/src/UnifiedFFI/FFIExternalStructure.class.st +++ b/src/UnifiedFFI/FFIExternalStructure.class.st @@ -24,9 +24,9 @@ FFIExternalStructure class >> asExternalTypeOn: generator [ ] { #category : #private } -FFIExternalStructure class >> compileFields: specArray withAccessors: defineBoolean [ - | offset fieldSpec | - +FFIExternalStructure class >> compileFields: specArray withAccessors: aSymbol [ + | offset fieldSpec defineBoolean| + defineBoolean := aSymbol = #always. fieldSpec := self fieldSpec. offset := 0. externalStructureAlignment := 1. @@ -209,7 +209,7 @@ FFIExternalStructure class >> rebuildFieldAccessors [ self removeAllOffsetVariables. self compileFields: self fields - withAccessors: true] + withAccessors: #always] ] { #category : #private } diff --git a/src/UnifiedFFI/FFIExternalUnion.class.st b/src/UnifiedFFI/FFIExternalUnion.class.st index de57fb1ad15..d2c1dd45214 100644 --- a/src/UnifiedFFI/FFIExternalUnion.class.st +++ b/src/UnifiedFFI/FFIExternalUnion.class.st @@ -9,9 +9,9 @@ Class { } { #category : #private } -FFIExternalUnion class >> compileFields: specArray withAccessors: defineBoolean [ - | totalSize fieldSpec | - +FFIExternalUnion class >> compileFields: specArray withAccessors: aSymbol [ + | fieldSpec defineBoolean totalSize| + defineBoolean := aSymbol = #always. fieldSpec := self fieldSpec. totalSize := 0. externalStructureAlignment := 1.