FFI: FFI-Tools-mt.30.mcz

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
1 message Options
Reply | Threaded
Open this post in threaded view
|

FFI: FFI-Tools-mt.30.mcz

commits-2
Marcel Taeumel uploaded a new version of FFI-Tools to project FFI:
http://source.squeak.org/FFI/FFI-Tools-mt.30.mcz

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

Name: FFI-Tools-mt.30
Author: mt
Time: 14 May 2021, 3:04:42.77076 pm
UUID: 7076b5d3-0e8a-2648-a430-bdda981b628f
Ancestors: FFI-Tools-mt.29

Complements FFI-Kernel-mt.142

=============== Diff against FFI-Tools-mt.29 ===============

Item was added:
+ ----- Method: ExternalData>>explorerContents (in category '*FFI-Tools') -----
+ explorerContents
+ "Prefix all instance variables and append extra meta information (e.g., the external type) as well as all structure fields as defined in #fields."
+
+ | basicExplorerFields |
+ basicExplorerFields := super explorerContents.
+ basicExplorerFields do: [:explorerField |
+ explorerField itemName = '_type' ifTrue: [
+ explorerField itemName: '_containerType']].
+ ^ basicExplorerFields!

Item was changed:
  ----- Method: ExternalData>>explorerContentsMetaFields (in category '*FFI-Tools') -----
  explorerContentsMetaFields
  "Skip _type because our external type is already in the basic explorer fields because it is an instance variable. Add _contentType for clarification."
 
  ^ {
- ObjectExplorerWrapper with: self containerType name: '_containerType' model: self.
  ObjectExplorerWrapper with: self contentType name: '_contentType' model: self.
  }!

Item was changed:
  ----- Method: ExternalData>>explorerContentsStructFields (in category '*FFI-Tools') -----
  explorerContentsStructFields
  "In case some data interpretation omitted to convert char*, which is a (null-terminated) C string, to Smalltalk string."
 
+ (self size notNil and: [self isNull not]) ifTrue: [
- size notNil ifTrue: [
  ^ self withIndexCollect: [:each :index |
  ObjectExplorerWrapper
  with: each
  name: index printString
  model: self]].
 
  ^ (ExternalStructureInspector readCStrings and: [self mightBeCString]) ifFalse: [#()] ifTrue: [
  {ObjectExplorerWrapper
  with: ([self fromCString] ifError: [:msg | '<', msg, '>'])
  name: 'as C string'
  model: self}]!

Item was added:
+ ----- Method: ExternalData>>explorerOkToClose (in category '*FFI-Tools') -----
+ explorerOkToClose
+ "Overwritten to also check by content type. That is, a byte array full of pointers is also managed here."
+
+ ^ ((handle isExternalAddress or: [self contentType isPointerType])
+ and: [self isNull not])
+ ifTrue: [self confirmFree]
+ ifFalse: [true]!

Item was changed:
  ----- Method: ExternalData>>hasContentsInExplorer (in category '*FFI-Tools') -----
  hasContentsInExplorer
 
  ^ super hasContentsInExplorer
+ or: [self size notNil or: [ExternalStructureInspector readCStrings and: [self mightBeCString]]]!
- or: [size notNil or: [ExternalStructureInspector readCStrings and: [self mightBeCString]]]!

Item was added:
+ ----- Method: ExternalStructure>>confirmFree (in category '*FFI-Tools') -----
+ confirmFree
+ "Ask the user whether we should free the receivers handle."
+
+ | byteSize |
+ (Project uiManager
+ confirm: ('There are <b>{1}</b> bytes addressed.<br>Do you want to <b>free</b> the allocated memory?'
+ translated format: {
+ (byteSize := self byteSize) notNil
+ ifTrue: [byteSize] ifFalse: ['an unknown number of']. }) asTextFromHtml
+ orCancel: [^ false]
+ title: 'External Pointer Detected' translated)
+ ifTrue: [self free].
+
+ ^ true!

Item was changed:
  ----- Method: ExternalStructure>>explorerOkToClose (in category '*FFI-Tools') -----
  explorerOkToClose
  "We are being explored and that explorer wants to close. If we point to external memory, ask the user whether we should free it to avoid leaks."
+
+ ^ (self externalType isPointerType and: [self isNull not])
+ ifTrue: [self confirmFree]
+ ifFalse: [true]!
-
- | byteSize |
- (handle isExternalAddress and: [handle isNull not]) ifTrue: [
- (Project uiManager
- confirm: ('There are <b>{1}</b> bytes addressed.<br>Do you want to <b>free</b> the allocated memory?'
- translated format: {
- (byteSize := self externalType byteSize) > 0
- ifTrue: [byteSize] ifFalse: ['an unknown number of']. }) asTextFromHtml
- orCancel: [^ false]
- title: 'External Address Detected' translated)
- ifTrue: [self free]].
-
- ^ true!

Item was changed:
  ----- Method: ExternalStructureType>>explorerContents (in category '*FFI-Tools') -----
  explorerContents
 
+ | basicExplorerFields fieldTypeFields |
- | basicExplorerFields originalTypeField fieldTypeFields |
  basicExplorerFields := super explorerContents.
-
- self isTypeAlias ifTrue: [
- originalTypeField := ObjectExplorerWrapper
- with: self originalType
- name: '_originalType'
- model: self.
- ^ {originalTypeField}, basicExplorerFields].
 
  fieldTypeFields := Array streamContents: [:s |
  self typesDo: [:type :fieldName |
  s nextPut: (ObjectExplorerWrapper
  with: type
  name: (fieldName ifNil: ['__'] ifNotNil: ['_', fieldName])
  model: self)]].
 
  ^ fieldTypeFields, basicExplorerFields!

Item was changed:
  ----- Method: ExternalStructureType>>typesDo: (in category '*FFI-Tools-enumerating') -----
  typesDo: block
 
+ (self isTypeAlias or: [self isTypeAliasReferenced])
+ ifTrue: [^ self originalType typesDo: block].
- self assert: [self isPointerType not].
- self assert: [self referentClass notNil].
 
+ self referentClass fields do: [:spec |
+ | fieldName typeName type |
+ fieldName := spec first.
+ typeName := spec second.
+ type := ExternalType typeNamed: typeName.
+ block cull: type cull: fieldName].!
- (self isTypeAlias
- ifTrue: [
- "Add a custom role to emphasize it in #allTypes."
- {{#'_aliasFor' . self referentClass fields second}}]
- ifFalse: [self referentClass fields])
- do: [:spec |
- | fieldName typeName type |
- fieldName := spec first.
- typeName := spec second.
- type := ExternalType typeNamed: typeName.
- block cull: type cull: fieldName].!

Item was changed:
  ----- Method: ExternalType>>explorerContents (in category '*FFI-Tools') -----
  explorerContents
 
+ | basicExplorerFields originalTypeField |
- | basicExplorerFields |
  basicExplorerFields := super explorerContents.
  basicExplorerFields do: [:explorerField |
  explorerField itemName = 'compiledSpec' ifTrue: [
  explorerField changeClassTo: CompiledSpecWrapper]].
+
+ self isTypeAlias ifTrue: [
+ originalTypeField := ObjectExplorerWrapper
+ with: self originalType
+ name: '_originalType'
+ model: self.
+ ^ {originalTypeField}, basicExplorerFields].
+
  ^ basicExplorerFields!

Item was added:
+ ----- Method: ExternalUnknownType>>explorerContents (in category '*FFI-Tools') -----
+ explorerContents
+ "Overwritten to just list fields for the instVars."
+
+ | basicExplorerFields |
+ basicExplorerFields := self perform: #explorerContents withArguments: #() inSuperclass: Object.
+ basicExplorerFields do: [:explorerField |
+ explorerField itemName = 'compiledSpec' ifTrue: [
+ explorerField changeClassTo: CompiledSpecWrapper]].
+
+ ^ basicExplorerFields!