[squeak-dev] FFI: FFI-Kernel-mt.89.mczcommits at source.squeak.org commits at source.squeak.orgThu Jun 4 13:58:25 UTC 2020
Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.89.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.89 Author: mt Time: 4 June 2020, 3:58:25.336669 pm UUID: 40d6dc34-2829-e141-ac5e-405a9753b67b Ancestors: FFI-Kernel-mt.88 Serveral fixes concerning the creation for external struct types during field compilation in external structs. It is now possible to have a pointer to the same struct you are currently defining in the very first try. typedef struct Link { struct Link* next; } Link; Note that I think there is no need for #initializeStructureTypes anymore. I may drop that in the near future in favor of the #platformChangedFrom:to: mechanism. :-) =============== Diff against FFI-Kernel-mt.88 =============== Item was removed: - ----- Method: ExternalFunction class>>forceTypeNamed: (in category 'compiler support') ----- - forceTypeNamed: aString - ^ExternalType forceTypeNamed: aString! Item was removed: - ----- Method: ExternalFunction class>>isValidType: (in category 'compiler support') ----- - isValidType: anObject - ^anObject isBehavior and:[anObject includesBehavior: ExternalStructure]! Item was added: + ----- Method: ExternalFunction class>>newTypeNamed: (in category 'compiler support') ----- + newTypeNamed: typeName + ^ExternalType newTypeNamed: typeName! Item was added: + ----- Method: ExternalFunction class>>typeNamed: (in category 'compiler support') ----- + typeNamed: aString + ^ExternalType typeNamed: aString! Item was changed: ----- Method: ExternalStructure class>>byteAlignment (in category 'field definition') ----- byteAlignment - byteAlignment ifNil: [self compileFields]. - self assert: byteAlignment ~~ nil. ^ byteAlignment! Item was changed: ----- Method: ExternalStructure class>>compileAlias:withAccessors: (in category 'field definition') ----- compileAlias: spec withAccessors: aSymbol "Define all the fields in the receiver. Return the newly compiled spec." + | fieldName fieldTypeName isPointerField externalType newCompiledSpec | - | fieldName fieldType isPointerField externalType newCompiledSpec | fieldName := spec first. + fieldTypeName := spec second. + isPointerField := fieldTypeName last = $*. + fieldTypeName := fieldTypeName copyWithout: $*. + externalType := (ExternalType typeNamed: fieldTypeName) + ifNil: [self errorTypeNotFound: spec second]. - fieldType := spec second. - isPointerField := fieldType last = $*. - fieldType := fieldType copyWithout: $*. - externalType := ExternalType atomicTypeNamed: fieldType. - 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]. (fieldName notNil and:[self shouldGenerate: fieldName policy: aSymbol]) ifTrue:[ self defineAliasAccessorsFor: fieldName type: externalType]. newCompiledSpec := isPointerField ifTrue:[WordArray with: (ExternalType structureSpec bitOr: ExternalType pointerSpec)] ifFalse:[externalType compiledSpec]. byteAlignment := isPointerField ifTrue: [ExternalType pointerAlignment] ifFalse: [externalType byteAlignment]. ^newCompiledSpec! Item was changed: ----- Method: ExternalStructure class>>compileFields:withAccessors: (in category 'field definition') ----- 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" | newByteAlignment byteOffset typeSpec newCompiledSpec | (specArray size > 0 and: [specArray first class ~~ Array]) ifTrue: [^ self compileAlias: specArray withAccessors: aSymbol]. byteOffset := 0. newByteAlignment := self minStructureAlignment. typeSpec := WriteStream on: (WordArray new: 10). typeSpec nextPut: FFIFlagStructure. + specArray do: [:spec | + | fieldName fieldTypeName isPointerField externalType typeSize fieldAlignment | - "dummy for size" - specArray do: - [:spec | | fieldName fieldType isPointerField externalType typeSize fieldAlignment selfRefering | fieldName := spec first. + fieldTypeName := spec second. + isPointerField := fieldTypeName last = $*. + fieldTypeName := (fieldTypeName findTokens: '*') first withBlanksTrimmed. + externalType := (ExternalType typeNamed: fieldTypeName) + ifNil: [self errorTypeNotFound: spec second]. + isPointerField ifTrue: [externalType := externalType asPointerType]. + 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. - fieldType := spec second. - isPointerField := fieldType last = $*. - fieldType := (fieldType findTokens: '*') first withBlanksTrimmed. - externalType := ExternalType atomicTypeNamed: fieldType. - selfRefering := isPointerField and: [externalType isNil and: [fieldType = self asString]]. - selfRefering ifTrue: [ - externalType := ExternalType void asPointerType - ] ifFalse:[ - externalType ifNil: ["non-atomic" - (Symbol lookup: fieldType) ifNotNil: [:sym | - externalType := ExternalType structTypeNamed: sym]. - ]. - externalType ifNil: [ - Transcript show: '(' , fieldType , ' is void)'. - externalType := ExternalType void. - ]. - isPointerField ifTrue: [externalType := externalType asPointerType]]. - 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 shouldGenerate: fieldName policy: aSymbol]) ifTrue: [ - self defineFieldAccessorsFor: fieldName startingAt: byteOffset + 1 type: externalType. - ]. - typeSpec nextPutAll: (externalType embeddedSpecWithSize: typeSize). - byteOffset := byteOffset + typeSize. ]. + (fieldName notNil and: [self shouldGenerate: fieldName policy: aSymbol]) ifTrue: [ + self defineFieldAccessorsFor: 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). byteAlignment := newByteAlignment. ^ newCompiledSpec! Item was added: + ----- Method: ExternalStructure class>>compileFieldsSilently (in category 'field definition') ----- + compileFieldsSilently + + compiledSpec := self compileFields: self fields withAccessors: #generated. + ^compiledSpec! Item was changed: ----- Method: ExternalStructure class>>compiledSpec (in category 'field definition') ----- compiledSpec + ^compiledSpec! - "Return the compiled spec of the receiver" - ^compiledSpec ifNil:[self compileFields].! Item was added: + ----- Method: ExternalStructure class>>errorTypeNotFound: (in category 'field definition') ----- + errorTypeNotFound: typeName + + self error: ('Unknown external type ''{1}''. If it is a structure type, create a class for that structure first.' format: {typeName}).! Item was changed: + ----- Method: ExternalType class>>atomicTypeNamed: (in category 'instance lookup') ----- - ----- Method: ExternalType class>>atomicTypeNamed: (in category 'private') ----- atomicTypeNamed: aString ^AtomicTypes at: aString ifAbsent:[nil]! Item was removed: - ----- Method: ExternalType class>>forceTypeNamed: (in category 'private') ----- - forceTypeNamed: aString - ^self newTypeNamed: aString force: true! Item was changed: ----- Method: ExternalType class>>initializeStructureTypes (in category 'class initialization') ----- initializeStructureTypes "ExternalType initialize" + + | referentClassOrNil | - | referentClass pointerType | self cleanupUnusedTypes. + + StructTypes keysAndValuesDo:[:referentName :type | + referentClassOrNil := (self environment classNamed: referentName) + ifNotNil: [:cls | (cls includesBehavior: ExternalStructure) ifTrue: [cls]]. + + self flag: #remove. "mt: Recompilation happens already via ExternalObject." + referentClassOrNil ifNotNil: [referentClassOrNil compileFieldsSilently]. + + type asNonPointerType + newReferentClass: referentClassOrNil. + type asPointerType + newReferentClass: referentClassOrNil. + - StructTypes keysAndValuesDo:[:referentName :type| - referentClass := (Smalltalk at: referentName ifAbsent:[nil]). - (referentClass isBehavior and:[ - referentClass includesBehavior: ExternalStructure]) - ifFalse:[referentClass := nil]. - type compiledSpec: - (WordArray with: self structureSpec). - type newReferentClass: referentClass. - pointerType := type asPointerType. - pointerType compiledSpec: - (WordArray with: self pointerSpec); - byteAlignment: self pointerAlignment. - pointerType newReferentClass: referentClass. ].! Item was added: + ----- Method: ExternalType class>>newTypeForStructureClass: (in category 'instance creation') ----- + newTypeForStructureClass: anExternalStructureClass + + | type referentClass | + referentClass := anExternalStructureClass. + self assert: [referentClass includesBehavior: ExternalStructure]. + + type := self newTypeForUnknownNamed: referentClass name. + + referentClass compiledSpec + ifNil: [ "First time. The referent class' fields are probably just compiled for the first time." + type asNonPointerType setReferentClass: referentClass. + type asPointerType setReferentClass: referentClass] + ifNotNil: [ + type asNonPointerType newReferentClass: referentClass. + type asPointerType newReferentClass: referentClass]. + + ^ type! Item was added: + ----- Method: ExternalType class>>newTypeForUnknownNamed: (in category 'instance creation') ----- + newTypeForUnknownNamed: typeName + + | type pointerType | + self assert: [(StructTypes includesKey: typeName) not]. + + type := self basicNew + compiledSpec: (WordArray with: self structureSpec); + yourself. + + pointerType := self basicNew + compiledSpec: (WordArray with: self pointerSpec); + yourself. + + "Connect non-pointer type with pointer type." + type setReferencedType: pointerType. + pointerType setReferencedType: type. + + "Remember this new struct type." + self flag: #discuss. "mt: Field definitions in external structures will usually have strings of the struct type, not symbols. At least, if it is a pointer to that struct type. Maybe we should always use strings instead of symbols?" + StructTypes at: typeName asSymbol put: type. + + ^ type! Item was added: + ----- Method: ExternalType class>>newTypeNamed: (in category 'instance creation') ----- + newTypeNamed: aTypeName + + | structClass | + structClass := (self environment classNamed: aTypeName) + ifNotNil: [:class | (class includesBehavior: ExternalStructure) ifTrue: [class]]. + + ^ structClass + ifNil: [self newTypeForUnknownNamed: aTypeName] + ifNotNil: [self newTypeForStructureClass: structClass]! Item was removed: - ----- Method: ExternalType class>>newTypeNamed:force: (in category 'private') ----- - newTypeNamed: aString force: aBool - | sym type referentClass pointerType | - sym := aString asSymbol. - type := StructTypes at: aString ifAbsent:[nil]. - type == nil ifFalse:[^type]. - referentClass := Smalltalk at: sym ifAbsent:[nil]. - (referentClass isBehavior and:[referentClass includesBehavior: ExternalStructure]) - ifFalse:[referentClass := nil]. - "If we don't have a referent class and are not forced to create a type get out" - (referentClass == nil and:[aBool not]) ifTrue:[^nil]. - type := self basicNew compiledSpec: - (WordArray with: self structureSpec). - pointerType := self basicNew compiledSpec: - (WordArray with: self pointerSpec). - type setReferencedType: pointerType. - pointerType setReferencedType: type. - type newReferentClass: referentClass. - pointerType newReferentClass: referentClass. - pointerType byteAlignment: self pointerAlignment. - StructTypes at: sym put: type. - ^type! Item was changed: + ----- 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: [ + (self environment classNamed: typeName) + ifNotNil: [:cls | (cls includesBehavior: ExternalStructure) ifTrue: [ + StructTypes removeKey: typeName ifAbsent: []. + self newTypeNamed: typeName]]] + ! - ----- Method: ExternalType class>>structTypeNamed: (in category 'private') ----- - structTypeNamed: aSymbol - aSymbol == nil ifTrue:[^nil]. - ^self newTypeNamed: aSymbol force: false! Item was added: + ----- Method: ExternalType class>>typeNamed: (in category 'instance lookup') ----- + typeNamed: typeName + + (self atomicTypeNamed: typeName) + ifNotNil: [:type | ^ type]. + (self structTypeNamed: typeName) + ifNotNil: [:type | ^ type]. + + ^ nil! Item was changed: ----- Method: ExternalType>>newReferentClass: (in category 'private') ----- 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: self class structureSpec. - compiledSpec := WordArray with: (FFIFlagStructure). byteAlignment := 1. ] ifFalse:[ "my class has been changed - update my compiledSpec" compiledSpec := referentClass compiledSpec. byteAlignment := referentClass byteAlignment. ].! Item was changed: ----- Method: ExternalType>>printOn: (in category 'printing') ----- printOn: aStream + + self isAtomic + ifTrue: [aStream nextPutAll: (AtomicTypeNames at: self atomicType)] + ifFalse: [ + referentClass == nil + ifTrue:[aStream nextPutAll: '<unknown struct type>'] + ifFalse:[aStream nextPutAll: referentClass name]]. - referentClass == nil - ifTrue:[aStream nextPutAll: (AtomicTypeNames at: self atomicType)] - ifFalse:[aStream nextPutAll: referentClass name]. self isPointerType ifTrue:[aStream nextPut: $*].! Item was added: + ----- Method: ExternalType>>setReferentClass: (in category 'private') ----- + setReferentClass: aClass + referentClass := aClass.! Item was changed: ----- Method: ExternalType>>storeOn: (in category 'printing') ----- storeOn: aStream + + self isAtomic - referentClass == nil ifTrue:[aStream nextPutAll: ExternalType name; space; nextPutAll: (AtomicTypeNames at: self atomicType)] + ifFalse:[ + referentClass == nil + ifTrue: [aStream nextPutAll: 'nil'] + ifFalse: [aStream nextPut: $(; nextPutAll: ExternalType name; space; nextPutAll: #structTypeNamed:; space; store: referentClass name; nextPut: $)]]. - ifFalse:[aStream nextPut: $(; nextPutAll: ExternalType name; space; nextPutAll: #structTypeNamed:; space; store: referentClass name; nextPut: $)]. self isPointerType ifTrue: [aStream space; nextPutAll: #asPointerType].! Item was changed: ----- Method: ExternalUnion class>>compileFields:withAccessors: (in category 'field definition') ----- 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 newByteAlignment | (specArray size > 0 and: [specArray first class ~~ Array]) ifTrue: + [^ self error: 'Use ExternalStructure to define a type alias, not ExternalUnion']. - [^ self error: 'unions must have fields defined by sub-Array']. byteOffset := 1. newByteAlignment := 1. maxByteSize := 0. typeSpec := WriteStream on: (WordArray new: specArray size + 1). typeSpec nextPut: FFIFlagStructure. + specArray do: [:spec | + | fieldName fieldTypeName isPointerField externalType typeSize typeAlignment | - "dummy for size" - specArray do: - [:spec | - | fieldName fieldType isPointerField externalType typeSize typeAlignment selfRefering | fieldName := spec first. + fieldTypeName := spec second. + isPointerField := fieldTypeName last = $*. + fieldTypeName := (fieldTypeName findTokens: '*') first withBlanksTrimmed. + externalType := (ExternalType typeNamed: fieldTypeName) + ifNil: [self errorTypeNotFound: spec second]. + isPointerField ifTrue: [externalType := externalType asPointerType]. + 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. - fieldType := spec second. - isPointerField := fieldType last = $*. - fieldType := (fieldType findTokens: '*') first withBlanksTrimmed. - externalType := ExternalType atomicTypeNamed: fieldType. - selfRefering := isPointerField and: [externalType isNil and: [fieldType = self asString]]. - selfRefering ifTrue: [ - externalType := ExternalType void asPointerType - ] ifFalse:[ - externalType ifNil: ["non-atomic" - (Symbol lookup: fieldType) ifNotNil: [:sym | - externalType := ExternalType structTypeNamed: sym]. - ]. - externalType ifNil: [ - Transcript show: '(' , fieldType , ' is void)'. - externalType := ExternalType void. - ]. - isPointerField ifTrue: [externalType := externalType asPointerType]]. - 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 shouldGenerate: fieldName policy: aSymbol]) ifTrue: [ - self defineFieldAccessorsFor: fieldName startingAt: byteOffset type: externalType. - ]. - typeSpec nextPutAll: (externalType embeddedSpecWithSize: typeSize). - maxByteSize := maxByteSize max: typeSize. - newByteAlignment := newByteAlignment max: typeAlignment ]. + (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. + newByteAlignment := newByteAlignment max: typeAlignment + ]. maxByteSize := maxByteSize alignedTo: newByteAlignment. newCompiledSpec := typeSpec contents. newCompiledSpec at: 1 put: (maxByteSize bitOr: FFIFlagStructure). byteAlignment := newByteAlignment. ^ newCompiledSpec!
More information about the Squeak-dev mailing list |