[squeak-dev] FFI: FFI-Kernel-mt.194.mczcommits at source.squeak.org commits at source.squeak.orgWed Aug 11 08:32:45 UTC 2021
Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.194.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.194 Author: mt Time: 11 August 2021, 10:32:43.073115 am UUID: dd919d6b-185f-ee40-9061-e47adb6fa72e Ancestors: FFI-Kernel-mt.193 Code clean-up and refactoring: - Rename ...withAccessors: to ...generateAccessors: - Rename policy #generated to #ifGenerated - Rename policy #absent to #ifAbsent - Deprecate #compileFields and #compileFields: in favor if #defineFields and #defineFields: - Add #defineChangedFields(:), which uses #hasFieldLayoutChanged: and thus distinguishes itself from #defineFields(:) - After code loading or class reshaping, call #triggerDefineAllChangedFields instead of #triggerDefineAllFields - Remove obsolete #byteSize from ExternalStructure class; see its instance side Note that this also fixes a regression, that is, let #defineAllFields and #defineAllChangedFields work as expected. Note that #defineFields(:) will always compile the field spec and generate (missing) field accessors #ifGenerated. =============== Diff against FFI-Kernel-mt.193 =============== Item was removed: - ----- Method: ExternalStructure class>>byteSize (in category 'external type') ----- - byteSize - "Return the size in bytes of this structure." - ^self compiledSpec first bitAnd: FFIStructSizeMask! Item was changed: ----- Method: ExternalStructure class>>compileAllFields (in category 'system startup') ----- compileAllFields - " - ExternalStructure compileAllFields - " - | priorAuthorInitials fieldSpec | - priorAuthorInitials := Utilities authorInitialsPerSe. - [Utilities setAuthorInitials: 'FFI'. - - self allStructuresInCompilationOrder do: [:structClass | - fieldSpec := structClass fields. - (structClass hasFieldLayoutChanged: fieldSpec) - ifTrue: [structClass compileFields: fieldSpec]. - structClass organization removeEmptyCategories]. - "Compilation of fields only needs external types temporarily. Non-weak references to external types are only in methods with FFI calls." - ExternalType cleanupUnusedTypes. + self deprecated: 'Use #defineAllFields.'. + self defineAllFields.! - ] ensure: [Utilities setAuthorInitials: priorAuthorInitials]! Item was changed: ----- Method: ExternalStructure class>>compileFields (in category 'field definition') ----- compileFields - "Public. Define all the fields in the receiver. Only re-generate changed field accessors if auto-generated in the first place." + self deprecated: 'Use #defineFields'. + self defineFields.! - self isSkipped ifTrue: [^ nil]. - self compileFields: self fields.! Item was changed: ----- Method: ExternalStructure class>>compileFields: (in category 'field definition') ----- compileFields: fieldSpec + + self deprecated: 'Use #defineFields:'. + self defineFields: fieldSpec.! - "Private. Use #compileFields." - - self compileFields: fieldSpec withAccessors: #generated. - ExternalType noticeModificationOf: self.! Item was added: + ----- Method: ExternalStructure class>>compileFields:generateAccessors: (in category 'field definition - support') ----- + compileFields: specArray generateAccessors: aSymbol + "Private. Use #compileFields or #defineFields. Compile a type specification for the FFI calls. + + Eventually generate the field accessors according to following rules: + - aSymbol = #always always generate the accessors + - aSymbol = #never never generate the accessors + - aSymbol = #ifGenerated only generate the auto-generated accessors + - aSymbol = #ifAbsent only generate the absent accessors" + + (self isTypeAlias: specArray) + ifTrue: [self compileTypeAliasSpec: specArray generateAccessors: aSymbol] + ifFalse: [self compileStructureSpec: specArray generateAccessors: aSymbol]! Item was removed: - ----- Method: ExternalStructure class>>compileFields:withAccessors: (in category 'field definition') ----- - compileFields: specArray withAccessors: aSymbol - "Private. Use #compileFields or #defineFields. Compile a type specification for the FFI calls. - - Eventually generate the field accessors according to following rules: - - aSymbol = #always always generate the accessors - - aSymbol = #never never generate the accessors - - aSymbol = #generated only generate the auto-generated accessors - - aSymbol = #absent only generate the absent accessors" - - (self isTypeAlias: specArray) - ifTrue: [self compileTypeAliasSpec: specArray withAccessors: aSymbol] - ifFalse: [self compileStructureSpec: specArray withAccessors: aSymbol]! Item was removed: - ----- Method: ExternalStructure class>>compileFieldsSafely (in category 'field definition') ----- - compileFieldsSafely - - [self compileFields] - ifError: [:msg | Transcript showln: '[FFI] Field compilation failed: ', msg].! Item was added: + ----- Method: ExternalStructure class>>compileStructureSpec:generateAccessors: (in category 'field definition - support') ----- + compileStructureSpec: specArray generateAccessors: aSymbol + "Compile a type specification for the FFI calls. + Return the newly compiled spec. + + Eventually generate the field accessors according to following rules: + - aSymbol = #always always generate the accessors + - aSymbol = #never never generate the accessors + - aSymbol = #ifGenerated only generate the auto-generated accessors + - aSymbol = #ifAbsent only generate the absent accessors" + + | newByteAlignment byteOffset typeSpec newCompiledSpec | + byteOffset := 0. + newByteAlignment := self minStructureAlignment. + typeSpec := WriteStream on: (WordArray new: 10). + typeSpec nextPut: FFIFlagStructure. + specArray do: [:spec | + | fieldName fieldTypeName externalType typeSize fieldAlignment | + fieldName := spec first. + fieldTypeName := spec second. + externalType := (ExternalType typeNamed: fieldTypeName) + ifNil: [self errorTypeNotFound: spec second]. + typeSize := externalType byteSize. + fieldAlignment := (externalType byteAlignment + max: self minFieldAlignment) + min: self maxFieldAlignment. + byteOffset := byteOffset alignedTo: fieldAlignment. + newByteAlignment := newByteAlignment max: fieldAlignment. + spec size > 2 ifTrue: ["extra size" + spec third < typeSize + ifTrue: [^ self error: 'Explicit type size is less than expected']. + typeSize := spec third. + ]. + (fieldName notNil and: [self shouldGenerateAccessorsFor: fieldName policy: aSymbol]) ifTrue: [ + self generateStructureFieldAccessorsFor: fieldName startingAt: byteOffset + 1 type: externalType. + ]. + typeSpec nextPutAll: (externalType embeddedSpecWithSize: typeSize). + byteOffset := byteOffset + typeSize. + ]. + newByteAlignment := newByteAlignment min: self maxStructureAlignment. + byteOffset := byteOffset alignedTo: newByteAlignment. + newCompiledSpec := typeSpec contents. + newCompiledSpec at: 1 put: (byteOffset bitOr: FFIFlagStructure). + self + setCompiledSpec: newCompiledSpec + byteAlignment: newByteAlignment.! Item was removed: - ----- Method: ExternalStructure class>>compileStructureSpec:withAccessors: (in category 'field definition - support') ----- - compileStructureSpec: specArray withAccessors: aSymbol - "Compile a type specification for the FFI calls. - Return the newly compiled spec. - - Eventually generate the field accessors according to following rules: - - aSymbol = #always always generate the accessors - - aSymbol = #never never generate the accessors - - aSymbol = #generated only generate the auto-generated accessors - - aSymbol = #absent only generate the absent accessors" - - | newByteAlignment byteOffset typeSpec newCompiledSpec | - byteOffset := 0. - newByteAlignment := self minStructureAlignment. - typeSpec := WriteStream on: (WordArray new: 10). - typeSpec nextPut: FFIFlagStructure. - specArray do: [:spec | - | fieldName fieldTypeName externalType typeSize fieldAlignment | - fieldName := spec first. - fieldTypeName := spec second. - externalType := (ExternalType typeNamed: fieldTypeName) - ifNil: [self errorTypeNotFound: spec second]. - typeSize := externalType byteSize. - fieldAlignment := (externalType byteAlignment - max: self minFieldAlignment) - min: self maxFieldAlignment. - byteOffset := byteOffset alignedTo: fieldAlignment. - newByteAlignment := newByteAlignment max: fieldAlignment. - spec size > 2 ifTrue: ["extra size" - spec third < typeSize - ifTrue: [^ self error: 'Explicit type size is less than expected']. - typeSize := spec third. - ]. - (fieldName notNil and: [self shouldGenerate: fieldName policy: aSymbol]) ifTrue: [ - self generateStructureFieldAccessorsFor: fieldName startingAt: byteOffset + 1 type: externalType. - ]. - typeSpec nextPutAll: (externalType embeddedSpecWithSize: typeSize). - byteOffset := byteOffset + typeSize. - ]. - newByteAlignment := newByteAlignment min: self maxStructureAlignment. - byteOffset := byteOffset alignedTo: newByteAlignment. - newCompiledSpec := typeSpec contents. - newCompiledSpec at: 1 put: (byteOffset bitOr: FFIFlagStructure). - self - setCompiledSpec: newCompiledSpec - byteAlignment: newByteAlignment.! Item was added: + ----- Method: ExternalStructure class>>compileTypeAliasSpec:generateAccessors: (in category 'field definition - support') ----- + compileTypeAliasSpec: spec generateAccessors: aSymbol + "Define all the fields in the receiver. + Return the newly compiled spec." + | fieldName fieldTypeName externalType | + fieldName := spec first. + fieldTypeName := spec second. + externalType := (ExternalType typeNamed: fieldTypeName) + ifNil: [self errorTypeNotFound: spec second]. + (fieldName notNil and:[self shouldGenerateAccessorsFor: fieldName policy: aSymbol]) ifTrue:[ + self generateTypeAliasAccessorsFor: fieldName type: externalType]. + externalType isPointerType + ifTrue: ["Special case. Typedef for a pointer type, e.g., typedef char* LPSTR in Win32 API. Mark it as both structure and pointer. Note that #isPointerType will only answer true for the in-image pointer type, not the non-pointer alias for the pointer." + self + setCompiledSpec: (WordArray with: ExternalType pointerAliasSpec) + byteAlignment: ExternalType pointerAliasAlignment] + ifFalse: ["Usual case. Typedef for another struct type or atomic type. Just re-use compiled spec and extras from the aliased type." + self + flag: #isTypeAlias; + setCompiledSpec: externalType compiledSpec + byteAlignment: externalType byteAlignment].! Item was removed: - ----- Method: ExternalStructure class>>compileTypeAliasSpec:withAccessors: (in category 'field definition - support') ----- - compileTypeAliasSpec: spec withAccessors: aSymbol - "Define all the fields in the receiver. - Return the newly compiled spec." - | fieldName fieldTypeName externalType | - fieldName := spec first. - fieldTypeName := spec second. - externalType := (ExternalType typeNamed: fieldTypeName) - ifNil: [self errorTypeNotFound: spec second]. - (fieldName notNil and:[self shouldGenerate: fieldName policy: aSymbol]) ifTrue:[ - self generateTypeAliasAccessorsFor: fieldName type: externalType]. - externalType isPointerType - ifTrue: ["Special case. Typedef for a pointer type, e.g., typedef char* LPSTR in Win32 API. Mark it as both structure and pointer. Note that #isPointerType will only answer true for the in-image pointer type, not the non-pointer alias for the pointer." - self - setCompiledSpec: (WordArray with: ExternalType pointerAliasSpec) - byteAlignment: ExternalType pointerAliasAlignment] - ifFalse: ["Usual case. Typedef for another struct type or atomic type. Just re-use compiled spec and extras from the aliased type." - self - flag: #isTypeAlias; - setCompiledSpec: externalType compiledSpec - byteAlignment: externalType byteAlignment].! Item was added: + ----- Method: ExternalStructure class>>defineAllChangedFields (in category 'system startup') ----- + defineAllChangedFields + " + ExternalStructure defineAllChangedFields + " + self allStructuresInCompilationOrder do: [:structClass | + structClass defineChangedFields. + structClass organization removeEmptyCategories]. + + "Compilation of fields only needs external types temporarily. Non-weak references to external types are only in methods with FFI calls." + ExternalType cleanupUnusedTypes.! Item was changed: ----- Method: ExternalStructure class>>defineAllFields (in category 'system startup') ----- defineAllFields " ExternalStructure defineAllFields " + self allStructuresInCompilationOrder do: [:structClass | + structClass defineFields. + structClass organization removeEmptyCategories]. - | priorAuthorInitials fieldSpec | - priorAuthorInitials := Utilities authorInitialsPerSe. - [Utilities setAuthorInitials: 'FFI'. + "Compilation of fields only needs external types temporarily. Non-weak references to external types are only in methods with FFI calls." + ExternalType cleanupUnusedTypes.! - self allStructuresInCompilationOrder do: [:structClass | - fieldSpec := structClass fields. - (structClass hasFieldLayoutChanged: fieldSpec) - ifTrue: [structClass defineFields: fieldSpec]. - structClass organization removeEmptyCategories]. - "Compilation of fields only needs external types temporarily. Non-weak references to external types are only in methods with FFI calls." - ExternalType cleanupUnusedTypes. - - ] ensure: [Utilities setAuthorInitials: priorAuthorInitials]! Item was added: + ----- Method: ExternalStructure class>>defineChangedFields (in category 'field definition') ----- + defineChangedFields + "Public. Define all the fields in the receiver. Only re-generate changed field accessors if auto-generated in the first place." + + self isSkipped ifTrue: [^ nil]. + self hasFieldLayoutChanged ifTrue: [self defineFields].! Item was added: + ----- Method: ExternalStructure class>>defineChangedFields: (in category 'field definition') ----- + defineChangedFields: fieldSpec + "Public. Define all the fields in the receiver. Only re-generate changed field accessors if auto-generated in the first place." + + self isSkipped ifTrue: [^ nil]. + (self hasFieldLayoutChanged: fieldSpec) ifTrue: [self defineFields: fieldSpec].! Item was changed: ----- Method: ExternalStructure class>>defineFields: (in category 'field definition') ----- defineFields: fieldSpec "Private. Use #defineFields." + self compileFields: fieldSpec generateAccessors: #ifGenerated. - self compileFields: fieldSpec withAccessors: #generated. ExternalType noticeModificationOf: self.! Item was changed: ----- Method: ExternalStructure class>>doneCompiling (in category 'class management') ----- doneCompiling + "Base class changed to something that is an external structure now. This is also the post-load hook for Monticello; see MCMethodDefinition >> #postLoad." - "Base class changed to something that is an external structure now." self isSkipped ifTrue: [^ self]. + ExternalStructure triggerDefineAllChangedFields.! - ExternalStructure triggerDefineAllFields.! Item was changed: + ----- Method: ExternalStructure class>>hasFieldLayoutChanged (in category 'field definition - support') ----- - ----- Method: ExternalStructure class>>hasFieldLayoutChanged (in category 'system startup') ----- hasFieldLayoutChanged "Answers whether all fields should be re-compiled (and hence accessors re-generated)." ^ self hasFieldLayoutChanged: self fields! Item was changed: + ----- Method: ExternalStructure class>>hasFieldLayoutChanged: (in category 'field definition - support') ----- - ----- Method: ExternalStructure class>>hasFieldLayoutChanged: (in category 'system startup') ----- hasFieldLayoutChanged: fieldSpec "Answers whether all fields should be re-compiled (and hence accessors re-generated). This is useful at system startup time if a platform change was detected, which can influence alignment and size of pointers. !!!!!! Note that this method depends on all referenced types to be checked for field-layout changes first !!!!!!" | oldCompiledSpec oldByteAlignment result | (oldCompiledSpec := self compiledSpec) ifNil: [^ true]. (oldByteAlignment := self byteAlignment) ifNil: [^ true]. + self compileFields: fieldSpec generateAccessors: #never. - self compileFields: fieldSpec withAccessors: #never. self flag: #bug. "mt: Changed type aliasing for pointers not noticed unless that alias hides a pointer type." result := self isTypeAlias or: [oldCompiledSpec ~= self compiledSpec]. self setCompiledSpec: oldCompiledSpec byteAlignment: oldByteAlignment. ^ result! Item was changed: ----- Method: ExternalStructure class>>maybeCompileAccessor:withSelector: (in category 'field definition - support') ----- maybeCompileAccessor: newSourceString withSelector: selector + "Only compile if category or source changed. Use generic author initials during compilation." - "Only compile if category or source changed." + | newCategory existingReference priorAuthorInitials | - | newCategory existingReference | newCategory := #'*autogenerated - accessing'. ((existingReference := MethodReference class: self selector: selector) isValid and: [existingReference category = newCategory] and: [existingReference sourceString = newSourceString]) ifTrue: [^ self]. + + priorAuthorInitials := Utilities authorInitialsPerSe. + [Utilities authorInitials: 'FFI'. + self compile: newSourceString classified: newCategory. + ] ensure: [Utilities authorInitials: priorAuthorInitials].! - self compile: newSourceString classified: newCategory.! Item was changed: + ----- Method: ExternalStructure class>>setCompiledSpec:byteAlignment: (in category 'field definition - support') ----- - ----- Method: ExternalStructure class>>setCompiledSpec:byteAlignment: (in category 'external type') ----- setCompiledSpec: spec byteAlignment: alignment + "Private. Store this structure's compiled spec and extras to be used when creating external types for this structure as required. See ExternalType class >> #newTypeNamed: and ExternalType >> #newReferentClass:. Note that this should only be called from the struct compiler; see #compile*Spec:withAccessors:." - "Store this structure's compiled spec and extras to be used when creating external types for this structure as required. See ExternalType class >> #newTypeNamed: and ExternalType >> #newReferentClass:." compiledSpec := spec. byteAlignment := alignment.! Item was removed: - ----- Method: ExternalStructure class>>shouldGenerate:policy: (in category 'field definition - support') ----- - 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 "includes #absent rule" - ifTrue: [^ (self methodDictionary includesKey: fieldname) not - or: [(self methodDictionary at: fieldname) hasPragma: #generated]]. - self error: 'unknown generation policy'! Item was added: + ----- Method: ExternalStructure class>>shouldGenerateAccessorsFor:policy: (in category 'field definition - support') ----- + shouldGenerateAccessorsFor: fieldname policy: aSymbol + "Answer true if the field accessors must be compiled. + Do so according to the following rules: + - aSymbol = #always always generate the accessors + - aSymbol = #never never generate the accessors + - aSymbol = #ifGenerated only re-generate the auto-generated accessors + - aSymbol = #ifAbsent only generate the absent accessors" + aSymbol = #never ifTrue: [^ false]. + aSymbol = #always ifTrue: [^ true]. + aSymbol = #ifAbsent ifTrue: [^ (self methodDictionary includesKey: fieldname) not]. + aSymbol = #ifGenerated "includes #ifAbsent rule" + ifTrue: [^ (self methodDictionary includesKey: fieldname) not + or: [(self methodDictionary at: fieldname) hasPragma: #generated]]. + self error: 'unknown generation policy'! Item was added: + ----- Method: ExternalStructure class>>triggerDefineAllChangedFields (in category 'field definition - deferred') ----- + triggerDefineAllChangedFields + + self environment at: #'FFIDeferredTask_DefineAllChangedFields' put: true. + Project current addDeferredUIMessage: [self tryDefineAllChangedFields].! Item was added: + ----- Method: ExternalStructure class>>tryDefineAllChangedFields (in category 'field definition - deferred') ----- + tryDefineAllChangedFields + + (self environment includesKey: #'FFIDeferredTask_DefineAllChangedFields') + ifTrue: [self environment removeKey: #'FFIDeferredTask_DefineAllChangedFields'] + ifFalse: [^ self]. + + self defineAllChangedFields.! Item was added: + ----- Method: ExternalUnion class>>compileStructureSpec:generateAccessors: (in category 'field definition - support') ----- + compileStructureSpec: specArray generateAccessors: aSymbol + "Compile a type specification for the FFI machinery. + Return the newly compiled spec. + Eventually generate the field accessors according to the policy defined in aSymbol." + | byteOffset maxByteSize typeSpec newCompiledSpec newByteAlignment | + byteOffset := 1. + newByteAlignment := 1. + maxByteSize := 0. + typeSpec := WriteStream on: (WordArray new: specArray size + 1). + typeSpec nextPut: FFIFlagStructure. + specArray do: [:spec | + | fieldName fieldTypeName externalType typeSize typeAlignment | + fieldName := spec first. + fieldTypeName := spec second. + externalType := (ExternalType typeNamed: fieldTypeName) + ifNil: [self errorTypeNotFound: spec second]. + typeSize := externalType byteSize. + typeAlignment := externalType byteAlignment. + spec size > 2 ifTrue: ["extra size" + spec third < typeSize + ifTrue: [^ self error: 'Explicit type size is less than expected']. + typeSize := spec third. + ]. + (fieldName notNil and: [self shouldGenerateAccessorsFor: fieldName policy: aSymbol]) ifTrue: [ + self generateStructureFieldAccessorsFor: fieldName startingAt: byteOffset type: externalType. + ]. + typeSpec nextPutAll: (externalType embeddedSpecWithSize: typeSize). + maxByteSize := maxByteSize max: typeSize. + newByteAlignment := newByteAlignment max: typeAlignment + ]. + maxByteSize := maxByteSize alignedTo: newByteAlignment. + newCompiledSpec := typeSpec contents. + newCompiledSpec at: 1 put: (maxByteSize bitOr: FFIFlagStructure). + self + setCompiledSpec: newCompiledSpec + byteAlignment: newByteAlignment.! Item was removed: - ----- Method: ExternalUnion class>>compileStructureSpec:withAccessors: (in category 'field definition - support') ----- - compileStructureSpec: 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 | - byteOffset := 1. - newByteAlignment := 1. - maxByteSize := 0. - typeSpec := WriteStream on: (WordArray new: specArray size + 1). - typeSpec nextPut: FFIFlagStructure. - specArray do: [:spec | - | fieldName fieldTypeName externalType typeSize typeAlignment | - fieldName := spec first. - fieldTypeName := spec second. - externalType := (ExternalType typeNamed: fieldTypeName) - ifNil: [self errorTypeNotFound: spec second]. - typeSize := externalType byteSize. - typeAlignment := externalType byteAlignment. - spec size > 2 ifTrue: ["extra size" - spec third < typeSize - ifTrue: [^ self error: 'Explicit type size is less than expected']. - typeSize := spec third. - ]. - (fieldName notNil and: [self shouldGenerate: fieldName policy: aSymbol]) ifTrue: [ - self generateStructureFieldAccessorsFor: fieldName startingAt: byteOffset type: externalType. - ]. - typeSpec nextPutAll: (externalType embeddedSpecWithSize: typeSize). - maxByteSize := maxByteSize max: typeSize. - newByteAlignment := newByteAlignment max: typeAlignment - ]. - maxByteSize := maxByteSize alignedTo: newByteAlignment. - newCompiledSpec := typeSpec contents. - newCompiledSpec at: 1 put: (maxByteSize bitOr: FFIFlagStructure). - self - setCompiledSpec: newCompiledSpec - byteAlignment: newByteAlignment.! Item was added: + ----- Method: ExternalUnion class>>compileTypeAliasSpec:generateAccessors: (in category 'field definition - support') ----- + compileTypeAliasSpec: spec generateAccessors: aSymbol + + self error: 'Use ExternalStructure or ExternalTypeAlias to define a type alias, not ExternalUnion'.! Item was removed: - ----- Method: ExternalUnion class>>compileTypeAliasSpec:withAccessors: (in category 'field definition - support') ----- - compileTypeAliasSpec: spec withAccessors: aSymbol - - self error: 'Use ExternalStructure or ExternalTypeAlias to define a type alias, not ExternalUnion'.!
More information about the Squeak-dev mailing list |