FFI Inbox: FFI-Kernel-nice.119.mcz

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

FFI Inbox: FFI-Kernel-nice.119.mcz

commits-2
Nicolas Cellier uploaded a new version of FFI-Kernel to project FFI Inbox:
http://source.squeak.org/FFIinbox/FFI-Kernel-nice.119.mcz

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

Name: FFI-Kernel-nice.119
Author: nice
Time: 21 June 2020, 10:34:00.334284 pm
UUID: 3f2eca9d-8f55-476c-a0b0-c5ed6368a6b4
Ancestors: FFI-Kernel-nice.118

Make the compiledSpecs of struct pointers conform to the experimental FFI branch (thru #adjustPointerType)

See https://github.com/OpenSmalltalk/opensmalltalk-vm/tree/experimental_FFI

Simplify a bit ExternalData access (at: / at:put:).
The assumption that ExternalDataType is the type of the contents and not the type of the reference helps simplifying IMO.

We might want to make it more complete once we deal with pointer arity.
It's not the case yet.

=============== Diff against FFI-Kernel-nice.118 ===============

Item was changed:
  ----- Method: ExternalData>>at: (in category 'accessing') -----
  at: index
 
- self
- assert: [index = 1 or: [type isAtomic]]
- description: 'Should not read non-atomic pointer as array'.
-
  ((1 > index) or: [size notNil and: [index > size]])
  ifTrue: [^ self errorSubscriptBounds: index].
 
+ ^ type
- ^ type asNonPointerType
  handle: handle
+ at: ((index-1) * type byteSize) + 1!
- at: ((index-1) * type asNonPointerType byteSize) + 1!

Item was changed:
  ----- Method: ExternalData>>at:put: (in category 'accessing') -----
  at: index put: value
 
- self
- assert: [index = 1 or: [type isAtomic]]
- description: 'Should not read non-atomic pointer as array'.
-
  ((1 > index) or: [size notNil and: [index > size]])
  ifTrue: [^ self errorSubscriptBounds: index].
 
+ ^ type
- ^ type asNonPointerType
  handle: handle
+ at: ((index-1) * type byteSize) + 1
- at: ((index-1) * type asNonPointerType byteSize) + 1
  put: value!

Item was changed:
  ----- Method: ExternalStructure class>>compileAllFields (in category 'system startup') -----
  compileAllFields
  "
  ExternalStructure compileAllFields
  "
+ | priorAuthorInitials |
- | priorAuthorInitials fieldSpec |
  priorAuthorInitials := Utilities authorInitialsPerSe.
  [Utilities setAuthorInitials: 'FFI'.
 
  self allStructuresInCompilationOrder do: [:structClass |
+ | fieldSpec |
  fieldSpec := structClass fields.
  self flag: #discuss. "mt: Why do we need that extra layout check? Performance gain is minimal..."
  (structClass hasFieldLayoutChanged: fieldSpec)
  ifTrue: [structClass compileFieldsSilently: fieldSpec].
  structClass externalType "asNonPointerType"
  compiledSpec: structClass compiledSpec;
+ byteAlignment: structClass byteAlignment;
+ adjustPointerType.
- byteAlignment: structClass byteAlignment.
  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: ExternalStructureType>>adjustPointerType (in category 'private') -----
+ adjustPointerType
+ self isPointerType
+ ifFalse: [self asPointerType
+ compiledSpec: (WordArray with: ((self compiledSpec first
+ bitAnd: FFIFlagAtomic + FFIFlagStructure)
+ bitOr: self class pointerSpec));
+ byteAlignment: self class pointerAlignment]!

Item was changed:
  ----- Method: ExternalType class>>initializeStructureTypes (in category 'class initialization') -----
  initializeStructureTypes
  "Reset all non-pointer struct types to zero and their pointer companions to the appropriate pointer size."
 
  StructTypes ifNil: [
  StructTypes := WeakValueDictionary new].
 
  self cleanupUnusedTypes.
 
  StructTypes valuesDo:[:structType |
  structType "asNonPointerType"
  compiledSpec: (WordArray with: self structureSpec);
  byteAlignment: nil.
  structType asPointerType
+ compiledSpec: (WordArray with: self pointerSpec + self structureSpec);
- compiledSpec: (WordArray with: self pointerSpec);
  byteAlignment: nil].!

Item was changed:
  ----- Method: ExternalType>>handle:at: (in category 'external data') -----
  handle: handle at: byteOffset
  "Read the receiver's external type using the given handle and the byteOffset. This is the dynamic version of #readFieldAt:."
 
+ | address value |
- | result |
- self checkType.
-
  self isPointerType
+ ifTrue:
+ [address := handle pointerAt: byteOffset length: self byteSize.
+ ^ExternalData
+ fromHandle: address
+ type: self asNonPointerType].
+ self isAtomic
+ ifTrue:
+ ["Answer atomic value"
+ value := handle
- ifFalse: [
- "Answer atomic value"
- ^ handle
  perform: (AtomicSelectors at: self atomicType)
+ with: byteOffset.
+ ^referentClass ifNil: [value] ifNotNil: [referentClass fromHandle: value]].
+
+ referentClass isNil
+ ifTrue: [self error: 'unknown type'].
+ self isEmpty ifTrue: [self error: 'Empty structure'].
+
+ ^referentClass fromHandle: (handle structAt: byteOffset length: self byteSize)!
- with: byteOffset]
- ifTrue: [
- ^ referentClass
- ifNotNil: [
- "Answer structure, union, or type alias"
- referentClass fromHandle: (handle pointerAt: byteOffset length: self byteSize)]
- ifNil: [
- "Answer wrapper that points to external data"
- result := ExternalData
- fromHandle: (handle pointerAt: byteOffset length: self byteSize)
- type: self.
- self = ExternalType string
- ifTrue: [result fromCString]
- ifFalse: [result]]]!

Item was changed:
  ----- Method: ExternalType>>handle:at:put: (in category 'external data') -----
  handle: handle at: byteOffset put: value
  "Write a value using the receiver's external type at the given handle and byteOffset. This is the dynamic version of #writeFieldAt:with:."
 
- self checkType.
-
  self isPointerType
- ifFalse: [ "set atomic value"
- self flag: #addTypeCheck. "mt: Note that there is currently no mapping from objects that represent valid atomics to atomic types."
- handle
- perform: ((AtomicSelectors at: self atomicType), 'put:') asSymbol
- with: byteOffset
- with: value]
  ifTrue: [ "set pointer to struct/union/alias"
+ self assert: [value externalType == self asNonPointerType].
- self assert: [value externalType == self].
  handle
  pointerAt: byteOffset
  put: value getHandle
+ length: self byteSize.
+ ^value].
+
+ self isAtomic
+ ifTrue:
+ [ "set atomic value"
+ self flag: #addTypeCheck. "mt: Note that there is currently no mapping from objects that represent valid atomics to atomic types."
+ handle
+ perform: ((AtomicSelectors at: self atomicType), 'put:') asSymbol
+ with: byteOffset
+ with: value.
+ ^value].
+
+ referentClass isNil
+ ifTrue: [self error: 'unknown type'].
+ self isEmpty ifTrue: [self error: 'Empty structure'].
+
+ self assert: [value externalType == self].
+ handle structAt: byteOffset put: value getHandle length: self byteSize.
+ ^value
+ !
- length: self byteSize].!


Reply | Threaded
Open this post in threaded view
|

Re: FFI Inbox: FFI-Kernel-nice.119.mcz

marcel.taeumel
Hi Nicolas,

thanks! :-) I will take a look at it during this week, I hope. 

Here is a first thought:

I don't think that the pointer types for external structs should have the FFIFlagStructure."referentClass" should be more than enough for the FFI plugin side for both coercing and return-value packaging.

So, -1 for now but maybe I overlooked a use case. Raising this FFIFlagStructure here for such pointer types really messes up a lot of my current conceptual model about the relationship of ExternalStructure and ExternalType/ExternalStructureType. :-)

Why is "referentClass" not enough for the plugin side? Just check for ifNil, if not, instantiate and put instVar 0 to the return value. Done. ;-) For coercing, just compare argument class with "referentClass" in the argType; then check for the pointer flag. Maybe discriminate between ByteArray and ExternalAddress. 

...please don't raise FFIFlagStructure for pointer types for external structures... pretty please ^__^

Best,
Marcel

Am 21.06.2020 22:34:09 schrieb [hidden email] <[hidden email]>:

Nicolas Cellier uploaded a new version of FFI-Kernel to project FFI Inbox:
http://source.squeak.org/FFIinbox/FFI-Kernel-nice.119.mcz

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

Name: FFI-Kernel-nice.119
Author: nice
Time: 21 June 2020, 10:34:00.334284 pm
UUID: 3f2eca9d-8f55-476c-a0b0-c5ed6368a6b4
Ancestors: FFI-Kernel-nice.118

Make the compiledSpecs of struct pointers conform to the experimental FFI branch (thru #adjustPointerType)

See https://github.com/OpenSmalltalk/opensmalltalk-vm/tree/experimental_FFI

Simplify a bit ExternalData access (at: / at:put:).
The assumption that ExternalDataType is the type of the contents and not the type of the reference helps simplifying IMO.

We might want to make it more complete once we deal with pointer arity.
It's not the case yet.

=============== Diff against FFI-Kernel-nice.118 ===============

Item was changed:
----- Method: ExternalData>>at: (in category 'accessing') -----
at: index

- self
- assert: [index = 1 or: [type isAtomic]]
- description: 'Should not read non-atomic pointer as array'.
-
((1 > index) or: [size notNil and: [index > size]])
ifTrue: [^ self errorSubscriptBounds: index].

+ ^ type
- ^ type asNonPointerType
handle: handle
+ at: ((index-1) * type byteSize) + 1!
- at: ((index-1) * type asNonPointerType byteSize) + 1!

Item was changed:
----- Method: ExternalData>>at:put: (in category 'accessing') -----
at: index put: value

- self
- assert: [index = 1 or: [type isAtomic]]
- description: 'Should not read non-atomic pointer as array'.
-
((1 > index) or: [size notNil and: [index > size]])
ifTrue: [^ self errorSubscriptBounds: index].

+ ^ type
- ^ type asNonPointerType
handle: handle
+ at: ((index-1) * type byteSize) + 1
- at: ((index-1) * type asNonPointerType byteSize) + 1
put: value!

Item was changed:
----- Method: ExternalStructure class>>compileAllFields (in category 'system startup') -----
compileAllFields
"
ExternalStructure compileAllFields
"
+ | priorAuthorInitials |
- | priorAuthorInitials fieldSpec |
priorAuthorInitials := Utilities authorInitialsPerSe.
[Utilities setAuthorInitials: 'FFI'.

self allStructuresInCompilationOrder do: [:structClass |
+ | fieldSpec |
fieldSpec := structClass fields.
self flag: #discuss. "mt: Why do we need that extra layout check? Performance gain is minimal..."
(structClass hasFieldLayoutChanged: fieldSpec)
ifTrue: [structClass compileFieldsSilently: fieldSpec].
structClass externalType "asNonPointerType"
compiledSpec: structClass compiledSpec;
+ byteAlignment: structClass byteAlignment;
+ adjustPointerType.
- byteAlignment: structClass byteAlignment.
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: ExternalStructureType>>adjustPointerType (in category 'private') -----
+ adjustPointerType
+ self isPointerType
+ ifFalse: [self asPointerType
+ compiledSpec: (WordArray with: ((self compiledSpec first
+ bitAnd: FFIFlagAtomic + FFIFlagStructure)
+ bitOr: self class pointerSpec));
+ byteAlignment: self class pointerAlignment]!

Item was changed:
----- Method: ExternalType class>>initializeStructureTypes (in category 'class initialization') -----
initializeStructureTypes
"Reset all non-pointer struct types to zero and their pointer companions to the appropriate pointer size."

StructTypes ifNil: [
StructTypes := WeakValueDictionary new].

self cleanupUnusedTypes.

StructTypes valuesDo:[:structType |
structType "asNonPointerType"
compiledSpec: (WordArray with: self structureSpec);
byteAlignment: nil.
structType asPointerType
+ compiledSpec: (WordArray with: self pointerSpec + self structureSpec);
- compiledSpec: (WordArray with: self pointerSpec);
byteAlignment: nil].!

Item was changed:
----- Method: ExternalType>>handle:at: (in category 'external data') -----
handle: handle at: byteOffset
"Read the receiver's external type using the given handle and the byteOffset. This is the dynamic version of #readFieldAt:."

+ | address value |
- | result |
- self checkType.
-
self isPointerType
+ ifTrue:
+ [address := handle pointerAt: byteOffset length: self byteSize.
+ ^ExternalData
+ fromHandle: address
+ type: self asNonPointerType].
+ self isAtomic
+ ifTrue:
+ ["Answer atomic value"
+ value := handle
- ifFalse: [
- "Answer atomic value"
- ^ handle
perform: (AtomicSelectors at: self atomicType)
+ with: byteOffset.
+ ^referentClass ifNil: [value] ifNotNil: [referentClass fromHandle: value]].
+
+ referentClass isNil
+ ifTrue: [self error: 'unknown type'].
+ self isEmpty ifTrue: [self error: 'Empty structure'].
+
+ ^referentClass fromHandle: (handle structAt: byteOffset length: self byteSize)!
- with: byteOffset]
- ifTrue: [
- ^ referentClass
- ifNotNil: [
- "Answer structure, union, or type alias"
- referentClass fromHandle: (handle pointerAt: byteOffset length: self byteSize)]
- ifNil: [
- "Answer wrapper that points to external data"
- result := ExternalData
- fromHandle: (handle pointerAt: byteOffset length: self byteSize)
- type: self.
- self = ExternalType string
- ifTrue: [result fromCString]
- ifFalse: [result]]]!

Item was changed:
----- Method: ExternalType>>handle:at:put: (in category 'external data') -----
handle: handle at: byteOffset put: value
"Write a value using the receiver's external type at the given handle and byteOffset. This is the dynamic version of #writeFieldAt:with:."

- self checkType.
-
self isPointerType
- ifFalse: [ "set atomic value"
- self flag: #addTypeCheck. "mt: Note that there is currently no mapping from objects that represent valid atomics to atomic types."
- handle
- perform: ((AtomicSelectors at: self atomicType), 'put:') asSymbol
- with: byteOffset
- with: value]
ifTrue: [ "set pointer to struct/union/alias"
+ self assert: [value externalType == self asNonPointerType].
- self assert: [value externalType == self].
handle
pointerAt: byteOffset
put: value getHandle
+ length: self byteSize.
+ ^value].
+
+ self isAtomic
+ ifTrue:
+ [ "set atomic value"
+ self flag: #addTypeCheck. "mt: Note that there is currently no mapping from objects that represent valid atomics to atomic types."
+ handle
+ perform: ((AtomicSelectors at: self atomicType), 'put:') asSymbol
+ with: byteOffset
+ with: value.
+ ^value].
+
+ referentClass isNil
+ ifTrue: [self error: 'unknown type'].
+ self isEmpty ifTrue: [self error: 'Empty structure'].
+
+ self assert: [value externalType == self].
+ handle structAt: byteOffset put: value getHandle length: self byteSize.
+ ^value
+ !
- length: self byteSize].!




Reply | Threaded
Open this post in threaded view
|

Re: FFI Inbox: FFI-Kernel-nice.119.mcz

Nicolas Cellier
Hi Marcel,
So you mean that I don't really need to distinguish pointer to struct and pointer to atomic type alias?
Maybe...

There is currently a difference:
- an atomic type alias has an immediate value as handle
  it thus cannot be passed as parameter by reference
  (well, for aliases to pointers, I don't really know...)
- a struct has a memory zone as value (ExternalAddress or direct ByteArray)
 it thus can be passed as parameter by reference without having to resort to an ExternalData.
See ffiPassStructureArgumentByReference: oop Class: oopClass expectedClass: argClass In: calloutState
vs ffiPassAtomicArgumentByReference: oop Class: oopClass expectedClass: argClass In: calloutState


Le lun. 22 juin 2020 à 09:18, Marcel Taeumel <[hidden email]> a écrit :
Hi Nicolas,

thanks! :-) I will take a look at it during this week, I hope. 

Here is a first thought:

I don't think that the pointer types for external structs should have the FFIFlagStructure."referentClass" should be more than enough for the FFI plugin side for both coercing and return-value packaging.

So, -1 for now but maybe I overlooked a use case. Raising this FFIFlagStructure here for such pointer types really messes up a lot of my current conceptual model about the relationship of ExternalStructure and ExternalType/ExternalStructureType. :-)

Why is "referentClass" not enough for the plugin side? Just check for ifNil, if not, instantiate and put instVar 0 to the return value. Done. ;-) For coercing, just compare argument class with "referentClass" in the argType; then check for the pointer flag. Maybe discriminate between ByteArray and ExternalAddress. 

...please don't raise FFIFlagStructure for pointer types for external structures... pretty please ^__^

Best,
Marcel

Am 21.06.2020 22:34:09 schrieb [hidden email] <[hidden email]>:

Nicolas Cellier uploaded a new version of FFI-Kernel to project FFI Inbox:
http://source.squeak.org/FFIinbox/FFI-Kernel-nice.119.mcz

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

Name: FFI-Kernel-nice.119
Author: nice
Time: 21 June 2020, 10:34:00.334284 pm
UUID: 3f2eca9d-8f55-476c-a0b0-c5ed6368a6b4
Ancestors: FFI-Kernel-nice.118

Make the compiledSpecs of struct pointers conform to the experimental FFI branch (thru #adjustPointerType)

See https://github.com/OpenSmalltalk/opensmalltalk-vm/tree/experimental_FFI

Simplify a bit ExternalData access (at: / at:put:).
The assumption that ExternalDataType is the type of the contents and not the type of the reference helps simplifying IMO.

We might want to make it more complete once we deal with pointer arity.
It's not the case yet.

=============== Diff against FFI-Kernel-nice.118 ===============

Item was changed:
----- Method: ExternalData>>at: (in category 'accessing') -----
at: index

- self
- assert: [index = 1 or: [type isAtomic]]
- description: 'Should not read non-atomic pointer as array'.
-
((1 > index) or: [size notNil and: [index > size]])
ifTrue: [^ self errorSubscriptBounds: index].

+ ^ type
- ^ type asNonPointerType
handle: handle
+ at: ((index-1) * type byteSize) + 1!
- at: ((index-1) * type asNonPointerType byteSize) + 1!

Item was changed:
----- Method: ExternalData>>at:put: (in category 'accessing') -----
at: index put: value

- self
- assert: [index = 1 or: [type isAtomic]]
- description: 'Should not read non-atomic pointer as array'.
-
((1 > index) or: [size notNil and: [index > size]])
ifTrue: [^ self errorSubscriptBounds: index].

+ ^ type
- ^ type asNonPointerType
handle: handle
+ at: ((index-1) * type byteSize) + 1
- at: ((index-1) * type asNonPointerType byteSize) + 1
put: value!

Item was changed:
----- Method: ExternalStructure class>>compileAllFields (in category 'system startup') -----
compileAllFields
"
ExternalStructure compileAllFields
"
+ | priorAuthorInitials |
- | priorAuthorInitials fieldSpec |
priorAuthorInitials := Utilities authorInitialsPerSe.
[Utilities setAuthorInitials: 'FFI'.

self allStructuresInCompilationOrder do: [:structClass |
+ | fieldSpec |
fieldSpec := structClass fields.
self flag: #discuss. "mt: Why do we need that extra layout check? Performance gain is minimal..."
(structClass hasFieldLayoutChanged: fieldSpec)
ifTrue: [structClass compileFieldsSilently: fieldSpec].
structClass externalType "asNonPointerType"
compiledSpec: structClass compiledSpec;
+ byteAlignment: structClass byteAlignment;
+ adjustPointerType.
- byteAlignment: structClass byteAlignment.
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: ExternalStructureType>>adjustPointerType (in category 'private') -----
+ adjustPointerType
+ self isPointerType
+ ifFalse: [self asPointerType
+ compiledSpec: (WordArray with: ((self compiledSpec first
+ bitAnd: FFIFlagAtomic + FFIFlagStructure)
+ bitOr: self class pointerSpec));
+ byteAlignment: self class pointerAlignment]!

Item was changed:
----- Method: ExternalType class>>initializeStructureTypes (in category 'class initialization') -----
initializeStructureTypes
"Reset all non-pointer struct types to zero and their pointer companions to the appropriate pointer size."

StructTypes ifNil: [
StructTypes := WeakValueDictionary new].

self cleanupUnusedTypes.

StructTypes valuesDo:[:structType |
structType "asNonPointerType"
compiledSpec: (WordArray with: self structureSpec);
byteAlignment: nil.
structType asPointerType
+ compiledSpec: (WordArray with: self pointerSpec + self structureSpec);
- compiledSpec: (WordArray with: self pointerSpec);
byteAlignment: nil].!

Item was changed:
----- Method: ExternalType>>handle:at: (in category 'external data') -----
handle: handle at: byteOffset
"Read the receiver's external type using the given handle and the byteOffset. This is the dynamic version of #readFieldAt:."

+ | address value |
- | result |
- self checkType.
-
self isPointerType
+ ifTrue:
+ [address := handle pointerAt: byteOffset length: self byteSize.
+ ^ExternalData
+ fromHandle: address
+ type: self asNonPointerType].
+ self isAtomic
+ ifTrue:
+ ["Answer atomic value"
+ value := handle
- ifFalse: [
- "Answer atomic value"
- ^ handle
perform: (AtomicSelectors at: self atomicType)
+ with: byteOffset.
+ ^referentClass ifNil: [value] ifNotNil: [referentClass fromHandle: value]].
+
+ referentClass isNil
+ ifTrue: [self error: 'unknown type'].
+ self isEmpty ifTrue: [self error: 'Empty structure'].
+
+ ^referentClass fromHandle: (handle structAt: byteOffset length: self byteSize)!
- with: byteOffset]
- ifTrue: [
- ^ referentClass
- ifNotNil: [
- "Answer structure, union, or type alias"
- referentClass fromHandle: (handle pointerAt: byteOffset length: self byteSize)]
- ifNil: [
- "Answer wrapper that points to external data"
- result := ExternalData
- fromHandle: (handle pointerAt: byteOffset length: self byteSize)
- type: self.
- self = ExternalType string
- ifTrue: [result fromCString]
- ifFalse: [result]]]!

Item was changed:
----- Method: ExternalType>>handle:at:put: (in category 'external data') -----
handle: handle at: byteOffset put: value
"Write a value using the receiver's external type at the given handle and byteOffset. This is the dynamic version of #writeFieldAt:with:."

- self checkType.
-
self isPointerType
- ifFalse: [ "set atomic value"
- self flag: #addTypeCheck. "mt: Note that there is currently no mapping from objects that represent valid atomics to atomic types."
- handle
- perform: ((AtomicSelectors at: self atomicType), 'put:') asSymbol
- with: byteOffset
- with: value]
ifTrue: [ "set pointer to struct/union/alias"
+ self assert: [value externalType == self asNonPointerType].
- self assert: [value externalType == self].
handle
pointerAt: byteOffset
put: value getHandle
+ length: self byteSize.
+ ^value].
+
+ self isAtomic
+ ifTrue:
+ [ "set atomic value"
+ self flag: #addTypeCheck. "mt: Note that there is currently no mapping from objects that represent valid atomics to atomic types."
+ handle
+ perform: ((AtomicSelectors at: self atomicType), 'put:') asSymbol
+ with: byteOffset
+ with: value.
+ ^value].
+
+ referentClass isNil
+ ifTrue: [self error: 'unknown type'].
+ self isEmpty ifTrue: [self error: 'Empty structure'].
+
+ self assert: [value externalType == self].
+ handle structAt: byteOffset put: value getHandle length: self byteSize.
+ ^value
+ !
- length: self byteSize].!





Reply | Threaded
Open this post in threaded view
|

Re: FFI Inbox: FFI-Kernel-nice.119.mcz

marcel.taeumel
Hi Nicolas,

sure, there might be a difference. But you have all the information you need directly in the plugin already:



Let me catch up on this later this week.

Best,
Marcel

Am 22.06.2020 09:56:05 schrieb Nicolas Cellier <[hidden email]>:

Hi Marcel,
So you mean that I don't really need to distinguish pointer to struct and pointer to atomic type alias?
Maybe...

There is currently a difference:
- an atomic type alias has an immediate value as handle
  it thus cannot be passed as parameter by reference
  (well, for aliases to pointers, I don't really know...)
- a struct has a memory zone as value (ExternalAddress or direct ByteArray)
 it thus can be passed as parameter by reference without having to resort to an ExternalData.
See ffiPassStructureArgumentByReference: oop Class: oopClass expectedClass: argClass In: calloutState
vs ffiPassAtomicArgumentByReference: oop Class: oopClass expectedClass: argClass In: calloutState


Le lun. 22 juin 2020 à 09:18, Marcel Taeumel <[hidden email]> a écrit :
Hi Nicolas,

thanks! :-) I will take a look at it during this week, I hope. 

Here is a first thought:

I don't think that the pointer types for external structs should have the FFIFlagStructure."referentClass" should be more than enough for the FFI plugin side for both coercing and return-value packaging.

So, -1 for now but maybe I overlooked a use case. Raising this FFIFlagStructure here for such pointer types really messes up a lot of my current conceptual model about the relationship of ExternalStructure and ExternalType/ExternalStructureType. :-)

Why is "referentClass" not enough for the plugin side? Just check for ifNil, if not, instantiate and put instVar 0 to the return value. Done. ;-) For coercing, just compare argument class with "referentClass" in the argType; then check for the pointer flag. Maybe discriminate between ByteArray and ExternalAddress. 

...please don't raise FFIFlagStructure for pointer types for external structures... pretty please ^__^

Best,
Marcel

Am 21.06.2020 22:34:09 schrieb [hidden email] <[hidden email]>:

Nicolas Cellier uploaded a new version of FFI-Kernel to project FFI Inbox:
http://source.squeak.org/FFIinbox/FFI-Kernel-nice.119.mcz

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

Name: FFI-Kernel-nice.119
Author: nice
Time: 21 June 2020, 10:34:00.334284 pm
UUID: 3f2eca9d-8f55-476c-a0b0-c5ed6368a6b4
Ancestors: FFI-Kernel-nice.118

Make the compiledSpecs of struct pointers conform to the experimental FFI branch (thru #adjustPointerType)

See https://github.com/OpenSmalltalk/opensmalltalk-vm/tree/experimental_FFI

Simplify a bit ExternalData access (at: / at:put:).
The assumption that ExternalDataType is the type of the contents and not the type of the reference helps simplifying IMO.

We might want to make it more complete once we deal with pointer arity.
It's not the case yet.

=============== Diff against FFI-Kernel-nice.118 ===============

Item was changed:
----- Method: ExternalData>>at: (in category 'accessing') -----
at: index

- self
- assert: [index = 1 or: [type isAtomic]]
- description: 'Should not read non-atomic pointer as array'.
-
((1 > index) or: [size notNil and: [index > size]])
ifTrue: [^ self errorSubscriptBounds: index].

+ ^ type
- ^ type asNonPointerType
handle: handle
+ at: ((index-1) * type byteSize) + 1!
- at: ((index-1) * type asNonPointerType byteSize) + 1!

Item was changed:
----- Method: ExternalData>>at:put: (in category 'accessing') -----
at: index put: value

- self
- assert: [index = 1 or: [type isAtomic]]
- description: 'Should not read non-atomic pointer as array'.
-
((1 > index) or: [size notNil and: [index > size]])
ifTrue: [^ self errorSubscriptBounds: index].

+ ^ type
- ^ type asNonPointerType
handle: handle
+ at: ((index-1) * type byteSize) + 1
- at: ((index-1) * type asNonPointerType byteSize) + 1
put: value!

Item was changed:
----- Method: ExternalStructure class>>compileAllFields (in category 'system startup') -----
compileAllFields
"
ExternalStructure compileAllFields
"
+ | priorAuthorInitials |
- | priorAuthorInitials fieldSpec |
priorAuthorInitials := Utilities authorInitialsPerSe.
[Utilities setAuthorInitials: 'FFI'.

self allStructuresInCompilationOrder do: [:structClass |
+ | fieldSpec |
fieldSpec := structClass fields.
self flag: #discuss. "mt: Why do we need that extra layout check? Performance gain is minimal..."
(structClass hasFieldLayoutChanged: fieldSpec)
ifTrue: [structClass compileFieldsSilently: fieldSpec].
structClass externalType "asNonPointerType"
compiledSpec: structClass compiledSpec;
+ byteAlignment: structClass byteAlignment;
+ adjustPointerType.
- byteAlignment: structClass byteAlignment.
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: ExternalStructureType>>adjustPointerType (in category 'private') -----
+ adjustPointerType
+ self isPointerType
+ ifFalse: [self asPointerType
+ compiledSpec: (WordArray with: ((self compiledSpec first
+ bitAnd: FFIFlagAtomic + FFIFlagStructure)
+ bitOr: self class pointerSpec));
+ byteAlignment: self class pointerAlignment]!

Item was changed:
----- Method: ExternalType class>>initializeStructureTypes (in category 'class initialization') -----
initializeStructureTypes
"Reset all non-pointer struct types to zero and their pointer companions to the appropriate pointer size."

StructTypes ifNil: [
StructTypes := WeakValueDictionary new].

self cleanupUnusedTypes.

StructTypes valuesDo:[:structType |
structType "asNonPointerType"
compiledSpec: (WordArray with: self structureSpec);
byteAlignment: nil.
structType asPointerType
+ compiledSpec: (WordArray with: self pointerSpec + self structureSpec);
- compiledSpec: (WordArray with: self pointerSpec);
byteAlignment: nil].!

Item was changed:
----- Method: ExternalType>>handle:at: (in category 'external data') -----
handle: handle at: byteOffset
"Read the receiver's external type using the given handle and the byteOffset. This is the dynamic version of #readFieldAt:."

+ | address value |
- | result |
- self checkType.
-
self isPointerType
+ ifTrue:
+ [address := handle pointerAt: byteOffset length: self byteSize.
+ ^ExternalData
+ fromHandle: address
+ type: self asNonPointerType].
+ self isAtomic
+ ifTrue:
+ ["Answer atomic value"
+ value := handle
- ifFalse: [
- "Answer atomic value"
- ^ handle
perform: (AtomicSelectors at: self atomicType)
+ with: byteOffset.
+ ^referentClass ifNil: [value] ifNotNil: [referentClass fromHandle: value]].
+
+ referentClass isNil
+ ifTrue: [self error: 'unknown type'].
+ self isEmpty ifTrue: [self error: 'Empty structure'].
+
+ ^referentClass fromHandle: (handle structAt: byteOffset length: self byteSize)!
- with: byteOffset]
- ifTrue: [
- ^ referentClass
- ifNotNil: [
- "Answer structure, union, or type alias"
- referentClass fromHandle: (handle pointerAt: byteOffset length: self byteSize)]
- ifNil: [
- "Answer wrapper that points to external data"
- result := ExternalData
- fromHandle: (handle pointerAt: byteOffset length: self byteSize)
- type: self.
- self = ExternalType string
- ifTrue: [result fromCString]
- ifFalse: [result]]]!

Item was changed:
----- Method: ExternalType>>handle:at:put: (in category 'external data') -----
handle: handle at: byteOffset put: value
"Write a value using the receiver's external type at the given handle and byteOffset. This is the dynamic version of #writeFieldAt:with:."

- self checkType.
-
self isPointerType
- ifFalse: [ "set atomic value"
- self flag: #addTypeCheck. "mt: Note that there is currently no mapping from objects that represent valid atomics to atomic types."
- handle
- perform: ((AtomicSelectors at: self atomicType), 'put:') asSymbol
- with: byteOffset
- with: value]
ifTrue: [ "set pointer to struct/union/alias"
+ self assert: [value externalType == self asNonPointerType].
- self assert: [value externalType == self].
handle
pointerAt: byteOffset
put: value getHandle
+ length: self byteSize.
+ ^value].
+
+ self isAtomic
+ ifTrue:
+ [ "set atomic value"
+ self flag: #addTypeCheck. "mt: Note that there is currently no mapping from objects that represent valid atomics to atomic types."
+ handle
+ perform: ((AtomicSelectors at: self atomicType), 'put:') asSymbol
+ with: byteOffset
+ with: value.
+ ^value].
+
+ referentClass isNil
+ ifTrue: [self error: 'unknown type'].
+ self isEmpty ifTrue: [self error: 'Empty structure'].
+
+ self assert: [value externalType == self].
+ handle structAt: byteOffset put: value getHandle length: self byteSize.
+ ^value
+ !
- length: self byteSize].!





Reply | Threaded
Open this post in threaded view
|

Re: FFI Inbox: FFI-Kernel-nice.119.mcz

Nicolas Cellier
No, no,
throw that code away, and have a look at  in VMMakerInbox, you will understand better...

In fact, if you read my proposals, I'd like to get rid of FFIFlagStructure altogether...
Either a type is atomic or composite, it's not both nor neither...
So we ain't gonna need 2 flags FFIFlagAtomic and FFIFlagStructure.

So hopefully, we shall throw away the FFIFlagStructure and make your life easier at image side :)

Le lun. 22 juin 2020 à 10:19, Marcel Taeumel <[hidden email]> a écrit :
Hi Nicolas,

sure, there might be a difference. But you have all the information you need directly in the plugin already:



Let me catch up on this later this week.

Best,
Marcel

Am 22.06.2020 09:56:05 schrieb Nicolas Cellier <[hidden email]>:

Hi Marcel,
So you mean that I don't really need to distinguish pointer to struct and pointer to atomic type alias?
Maybe...

There is currently a difference:
- an atomic type alias has an immediate value as handle
  it thus cannot be passed as parameter by reference
  (well, for aliases to pointers, I don't really know...)
- a struct has a memory zone as value (ExternalAddress or direct ByteArray)
 it thus can be passed as parameter by reference without having to resort to an ExternalData.
See ffiPassStructureArgumentByReference: oop Class: oopClass expectedClass: argClass In: calloutState
vs ffiPassAtomicArgumentByReference: oop Class: oopClass expectedClass: argClass In: calloutState


Le lun. 22 juin 2020 à 09:18, Marcel Taeumel <[hidden email]> a écrit :
Hi Nicolas,

thanks! :-) I will take a look at it during this week, I hope. 

Here is a first thought:

I don't think that the pointer types for external structs should have the FFIFlagStructure."referentClass" should be more than enough for the FFI plugin side for both coercing and return-value packaging.

So, -1 for now but maybe I overlooked a use case. Raising this FFIFlagStructure here for such pointer types really messes up a lot of my current conceptual model about the relationship of ExternalStructure and ExternalType/ExternalStructureType. :-)

Why is "referentClass" not enough for the plugin side? Just check for ifNil, if not, instantiate and put instVar 0 to the return value. Done. ;-) For coercing, just compare argument class with "referentClass" in the argType; then check for the pointer flag. Maybe discriminate between ByteArray and ExternalAddress. 

...please don't raise FFIFlagStructure for pointer types for external structures... pretty please ^__^

Best,
Marcel

Am 21.06.2020 22:34:09 schrieb [hidden email] <[hidden email]>:

Nicolas Cellier uploaded a new version of FFI-Kernel to project FFI Inbox:
http://source.squeak.org/FFIinbox/FFI-Kernel-nice.119.mcz

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

Name: FFI-Kernel-nice.119
Author: nice
Time: 21 June 2020, 10:34:00.334284 pm
UUID: 3f2eca9d-8f55-476c-a0b0-c5ed6368a6b4
Ancestors: FFI-Kernel-nice.118

Make the compiledSpecs of struct pointers conform to the experimental FFI branch (thru #adjustPointerType)

See https://github.com/OpenSmalltalk/opensmalltalk-vm/tree/experimental_FFI

Simplify a bit ExternalData access (at: / at:put:).
The assumption that ExternalDataType is the type of the contents and not the type of the reference helps simplifying IMO.

We might want to make it more complete once we deal with pointer arity.
It's not the case yet.

=============== Diff against FFI-Kernel-nice.118 ===============

Item was changed:
----- Method: ExternalData>>at: (in category 'accessing') -----
at: index

- self
- assert: [index = 1 or: [type isAtomic]]
- description: 'Should not read non-atomic pointer as array'.
-
((1 > index) or: [size notNil and: [index > size]])
ifTrue: [^ self errorSubscriptBounds: index].

+ ^ type
- ^ type asNonPointerType
handle: handle
+ at: ((index-1) * type byteSize) + 1!
- at: ((index-1) * type asNonPointerType byteSize) + 1!

Item was changed:
----- Method: ExternalData>>at:put: (in category 'accessing') -----
at: index put: value

- self
- assert: [index = 1 or: [type isAtomic]]
- description: 'Should not read non-atomic pointer as array'.
-
((1 > index) or: [size notNil and: [index > size]])
ifTrue: [^ self errorSubscriptBounds: index].

+ ^ type
- ^ type asNonPointerType
handle: handle
+ at: ((index-1) * type byteSize) + 1
- at: ((index-1) * type asNonPointerType byteSize) + 1
put: value!

Item was changed:
----- Method: ExternalStructure class>>compileAllFields (in category 'system startup') -----
compileAllFields
"
ExternalStructure compileAllFields
"
+ | priorAuthorInitials |
- | priorAuthorInitials fieldSpec |
priorAuthorInitials := Utilities authorInitialsPerSe.
[Utilities setAuthorInitials: 'FFI'.

self allStructuresInCompilationOrder do: [:structClass |
+ | fieldSpec |
fieldSpec := structClass fields.
self flag: #discuss. "mt: Why do we need that extra layout check? Performance gain is minimal..."
(structClass hasFieldLayoutChanged: fieldSpec)
ifTrue: [structClass compileFieldsSilently: fieldSpec].
structClass externalType "asNonPointerType"
compiledSpec: structClass compiledSpec;
+ byteAlignment: structClass byteAlignment;
+ adjustPointerType.
- byteAlignment: structClass byteAlignment.
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: ExternalStructureType>>adjustPointerType (in category 'private') -----
+ adjustPointerType
+ self isPointerType
+ ifFalse: [self asPointerType
+ compiledSpec: (WordArray with: ((self compiledSpec first
+ bitAnd: FFIFlagAtomic + FFIFlagStructure)
+ bitOr: self class pointerSpec));
+ byteAlignment: self class pointerAlignment]!

Item was changed:
----- Method: ExternalType class>>initializeStructureTypes (in category 'class initialization') -----
initializeStructureTypes
"Reset all non-pointer struct types to zero and their pointer companions to the appropriate pointer size."

StructTypes ifNil: [
StructTypes := WeakValueDictionary new].

self cleanupUnusedTypes.

StructTypes valuesDo:[:structType |
structType "asNonPointerType"
compiledSpec: (WordArray with: self structureSpec);
byteAlignment: nil.
structType asPointerType
+ compiledSpec: (WordArray with: self pointerSpec + self structureSpec);
- compiledSpec: (WordArray with: self pointerSpec);
byteAlignment: nil].!

Item was changed:
----- Method: ExternalType>>handle:at: (in category 'external data') -----
handle: handle at: byteOffset
"Read the receiver's external type using the given handle and the byteOffset. This is the dynamic version of #readFieldAt:."

+ | address value |
- | result |
- self checkType.
-
self isPointerType
+ ifTrue:
+ [address := handle pointerAt: byteOffset length: self byteSize.
+ ^ExternalData
+ fromHandle: address
+ type: self asNonPointerType].
+ self isAtomic
+ ifTrue:
+ ["Answer atomic value"
+ value := handle
- ifFalse: [
- "Answer atomic value"
- ^ handle
perform: (AtomicSelectors at: self atomicType)
+ with: byteOffset.
+ ^referentClass ifNil: [value] ifNotNil: [referentClass fromHandle: value]].
+
+ referentClass isNil
+ ifTrue: [self error: 'unknown type'].
+ self isEmpty ifTrue: [self error: 'Empty structure'].
+
+ ^referentClass fromHandle: (handle structAt: byteOffset length: self byteSize)!
- with: byteOffset]
- ifTrue: [
- ^ referentClass
- ifNotNil: [
- "Answer structure, union, or type alias"
- referentClass fromHandle: (handle pointerAt: byteOffset length: self byteSize)]
- ifNil: [
- "Answer wrapper that points to external data"
- result := ExternalData
- fromHandle: (handle pointerAt: byteOffset length: self byteSize)
- type: self.
- self = ExternalType string
- ifTrue: [result fromCString]
- ifFalse: [result]]]!

Item was changed:
----- Method: ExternalType>>handle:at:put: (in category 'external data') -----
handle: handle at: byteOffset put: value
"Write a value using the receiver's external type at the given handle and byteOffset. This is the dynamic version of #writeFieldAt:with:."

- self checkType.
-
self isPointerType
- ifFalse: [ "set atomic value"
- self flag: #addTypeCheck. "mt: Note that there is currently no mapping from objects that represent valid atomics to atomic types."
- handle
- perform: ((AtomicSelectors at: self atomicType), 'put:') asSymbol
- with: byteOffset
- with: value]
ifTrue: [ "set pointer to struct/union/alias"
+ self assert: [value externalType == self asNonPointerType].
- self assert: [value externalType == self].
handle
pointerAt: byteOffset
put: value getHandle
+ length: self byteSize.
+ ^value].
+
+ self isAtomic
+ ifTrue:
+ [ "set atomic value"
+ self flag: #addTypeCheck. "mt: Note that there is currently no mapping from objects that represent valid atomics to atomic types."
+ handle
+ perform: ((AtomicSelectors at: self atomicType), 'put:') asSymbol
+ with: byteOffset
+ with: value.
+ ^value].
+
+ referentClass isNil
+ ifTrue: [self error: 'unknown type'].
+ self isEmpty ifTrue: [self error: 'Empty structure'].
+
+ self assert: [value externalType == self].
+ handle structAt: byteOffset put: value getHandle length: self byteSize.
+ ^value
+ !
- length: self byteSize].!






Reply | Threaded
Open this post in threaded view
|

Re: FFI Inbox: FFI-Kernel-nice.119.mcz

marcel.taeumel
throw that code away, and have a look at  in VMMakerInbox, you will understand better...

Not so sure ... because I think we do not agree on the status quo yet. We should do that first. Understand the compiledSpec as is. Then move forward.

So hopefully, we shall throw away the FFIFlagStructure and make your life easier at image side :)

Not so sure. See above. 

Best,
Marcel

Am 22.06.2020 10:28:12 schrieb Nicolas Cellier <[hidden email]>:

No, no,
throw that code away, and have a look at  in VMMakerInbox, you will understand better...

In fact, if you read my proposals, I'd like to get rid of FFIFlagStructure altogether...
Either a type is atomic or composite, it's not both nor neither...
So we ain't gonna need 2 flags FFIFlagAtomic and FFIFlagStructure.

So hopefully, we shall throw away the FFIFlagStructure and make your life easier at image side :)

Le lun. 22 juin 2020 à 10:19, Marcel Taeumel <[hidden email]> a écrit :
Hi Nicolas,

sure, there might be a difference. But you have all the information you need directly in the plugin already:



Let me catch up on this later this week.

Best,
Marcel

Am 22.06.2020 09:56:05 schrieb Nicolas Cellier <[hidden email]>:

Hi Marcel,
So you mean that I don't really need to distinguish pointer to struct and pointer to atomic type alias?
Maybe...

There is currently a difference:
- an atomic type alias has an immediate value as handle
  it thus cannot be passed as parameter by reference
  (well, for aliases to pointers, I don't really know...)
- a struct has a memory zone as value (ExternalAddress or direct ByteArray)
 it thus can be passed as parameter by reference without having to resort to an ExternalData.
See ffiPassStructureArgumentByReference: oop Class: oopClass expectedClass: argClass In: calloutState
vs ffiPassAtomicArgumentByReference: oop Class: oopClass expectedClass: argClass In: calloutState


Le lun. 22 juin 2020 à 09:18, Marcel Taeumel <[hidden email]> a écrit :
Hi Nicolas,

thanks! :-) I will take a look at it during this week, I hope. 

Here is a first thought:

I don't think that the pointer types for external structs should have the FFIFlagStructure."referentClass" should be more than enough for the FFI plugin side for both coercing and return-value packaging.

So, -1 for now but maybe I overlooked a use case. Raising this FFIFlagStructure here for such pointer types really messes up a lot of my current conceptual model about the relationship of ExternalStructure and ExternalType/ExternalStructureType. :-)

Why is "referentClass" not enough for the plugin side? Just check for ifNil, if not, instantiate and put instVar 0 to the return value. Done. ;-) For coercing, just compare argument class with "referentClass" in the argType; then check for the pointer flag. Maybe discriminate between ByteArray and ExternalAddress. 

...please don't raise FFIFlagStructure for pointer types for external structures... pretty please ^__^

Best,
Marcel

Am 21.06.2020 22:34:09 schrieb [hidden email] <[hidden email]>:

Nicolas Cellier uploaded a new version of FFI-Kernel to project FFI Inbox:
http://source.squeak.org/FFIinbox/FFI-Kernel-nice.119.mcz

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

Name: FFI-Kernel-nice.119
Author: nice
Time: 21 June 2020, 10:34:00.334284 pm
UUID: 3f2eca9d-8f55-476c-a0b0-c5ed6368a6b4
Ancestors: FFI-Kernel-nice.118

Make the compiledSpecs of struct pointers conform to the experimental FFI branch (thru #adjustPointerType)

See https://github.com/OpenSmalltalk/opensmalltalk-vm/tree/experimental_FFI

Simplify a bit ExternalData access (at: / at:put:).
The assumption that ExternalDataType is the type of the contents and not the type of the reference helps simplifying IMO.

We might want to make it more complete once we deal with pointer arity.
It's not the case yet.

=============== Diff against FFI-Kernel-nice.118 ===============

Item was changed:
----- Method: ExternalData>>at: (in category 'accessing') -----
at: index

- self
- assert: [index = 1 or: [type isAtomic]]
- description: 'Should not read non-atomic pointer as array'.
-
((1 > index) or: [size notNil and: [index > size]])
ifTrue: [^ self errorSubscriptBounds: index].

+ ^ type
- ^ type asNonPointerType
handle: handle
+ at: ((index-1) * type byteSize) + 1!
- at: ((index-1) * type asNonPointerType byteSize) + 1!

Item was changed:
----- Method: ExternalData>>at:put: (in category 'accessing') -----
at: index put: value

- self
- assert: [index = 1 or: [type isAtomic]]
- description: 'Should not read non-atomic pointer as array'.
-
((1 > index) or: [size notNil and: [index > size]])
ifTrue: [^ self errorSubscriptBounds: index].

+ ^ type
- ^ type asNonPointerType
handle: handle
+ at: ((index-1) * type byteSize) + 1
- at: ((index-1) * type asNonPointerType byteSize) + 1
put: value!

Item was changed:
----- Method: ExternalStructure class>>compileAllFields (in category 'system startup') -----
compileAllFields
"
ExternalStructure compileAllFields
"
+ | priorAuthorInitials |
- | priorAuthorInitials fieldSpec |
priorAuthorInitials := Utilities authorInitialsPerSe.
[Utilities setAuthorInitials: 'FFI'.

self allStructuresInCompilationOrder do: [:structClass |
+ | fieldSpec |
fieldSpec := structClass fields.
self flag: #discuss. "mt: Why do we need that extra layout check? Performance gain is minimal..."
(structClass hasFieldLayoutChanged: fieldSpec)
ifTrue: [structClass compileFieldsSilently: fieldSpec].
structClass externalType "asNonPointerType"
compiledSpec: structClass compiledSpec;
+ byteAlignment: structClass byteAlignment;
+ adjustPointerType.
- byteAlignment: structClass byteAlignment.
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: ExternalStructureType>>adjustPointerType (in category 'private') -----
+ adjustPointerType
+ self isPointerType
+ ifFalse: [self asPointerType
+ compiledSpec: (WordArray with: ((self compiledSpec first
+ bitAnd: FFIFlagAtomic + FFIFlagStructure)
+ bitOr: self class pointerSpec));
+ byteAlignment: self class pointerAlignment]!

Item was changed:
----- Method: ExternalType class>>initializeStructureTypes (in category 'class initialization') -----
initializeStructureTypes
"Reset all non-pointer struct types to zero and their pointer companions to the appropriate pointer size."

StructTypes ifNil: [
StructTypes := WeakValueDictionary new].

self cleanupUnusedTypes.

StructTypes valuesDo:[:structType |
structType "asNonPointerType"
compiledSpec: (WordArray with: self structureSpec);
byteAlignment: nil.
structType asPointerType
+ compiledSpec: (WordArray with: self pointerSpec + self structureSpec);
- compiledSpec: (WordArray with: self pointerSpec);
byteAlignment: nil].!

Item was changed:
----- Method: ExternalType>>handle:at: (in category 'external data') -----
handle: handle at: byteOffset
"Read the receiver's external type using the given handle and the byteOffset. This is the dynamic version of #readFieldAt:."

+ | address value |
- | result |
- self checkType.
-
self isPointerType
+ ifTrue:
+ [address := handle pointerAt: byteOffset length: self byteSize.
+ ^ExternalData
+ fromHandle: address
+ type: self asNonPointerType].
+ self isAtomic
+ ifTrue:
+ ["Answer atomic value"
+ value := handle
- ifFalse: [
- "Answer atomic value"
- ^ handle
perform: (AtomicSelectors at: self atomicType)
+ with: byteOffset.
+ ^referentClass ifNil: [value] ifNotNil: [referentClass fromHandle: value]].
+
+ referentClass isNil
+ ifTrue: [self error: 'unknown type'].
+ self isEmpty ifTrue: [self error: 'Empty structure'].
+
+ ^referentClass fromHandle: (handle structAt: byteOffset length: self byteSize)!
- with: byteOffset]
- ifTrue: [
- ^ referentClass
- ifNotNil: [
- "Answer structure, union, or type alias"
- referentClass fromHandle: (handle pointerAt: byteOffset length: self byteSize)]
- ifNil: [
- "Answer wrapper that points to external data"
- result := ExternalData
- fromHandle: (handle pointerAt: byteOffset length: self byteSize)
- type: self.
- self = ExternalType string
- ifTrue: [result fromCString]
- ifFalse: [result]]]!

Item was changed:
----- Method: ExternalType>>handle:at:put: (in category 'external data') -----
handle: handle at: byteOffset put: value
"Write a value using the receiver's external type at the given handle and byteOffset. This is the dynamic version of #writeFieldAt:with:."

- self checkType.
-
self isPointerType
- ifFalse: [ "set atomic value"
- self flag: #addTypeCheck. "mt: Note that there is currently no mapping from objects that represent valid atomics to atomic types."
- handle
- perform: ((AtomicSelectors at: self atomicType), 'put:') asSymbol
- with: byteOffset
- with: value]
ifTrue: [ "set pointer to struct/union/alias"
+ self assert: [value externalType == self asNonPointerType].
- self assert: [value externalType == self].
handle
pointerAt: byteOffset
put: value getHandle
+ length: self byteSize.
+ ^value].
+
+ self isAtomic
+ ifTrue:
+ [ "set atomic value"
+ self flag: #addTypeCheck. "mt: Note that there is currently no mapping from objects that represent valid atomics to atomic types."
+ handle
+ perform: ((AtomicSelectors at: self atomicType), 'put:') asSymbol
+ with: byteOffset
+ with: value.
+ ^value].
+
+ referentClass isNil
+ ifTrue: [self error: 'unknown type'].
+ self isEmpty ifTrue: [self error: 'Empty structure'].
+
+ self assert: [value externalType == self].
+ handle structAt: byteOffset put: value getHandle length: self byteSize.
+ ^value
+ !
- length: self byteSize].!






Reply | Threaded
Open this post in threaded view
|

Re: FFI Inbox: FFI-Kernel-nice.119.mcz

marcel.taeumel
Let me add that I am really surprised (and a little bit worried) that this little requirement of "wrap alias to atomic into referentClass on return" turned into such a huge proposal of yours.

All that other coercing stuff could easily be added via #doesNotCoerce: as proposed here: 
http://forum.world.st/FFI-Plugin-Proposal-Add-doesNotCoerce-for-like-doesNotUnderstand-td5118724.html

Please, try to understand the relationship between ExternalData and ExternalStructure/Union/TypeAlias. It's so simple. But maybe not so clear. ExternalData is not an implementation detail. It's part of the public interface; it's like Array but as a composition of handle and type. And maybe size and offset -- but that's due to heap memory management part.

Type safety is valuable, of course. Maybe you can give more examples of what you want to achieve. :-)

Best,
Marcel

Am 22.06.2020 10:31:47 schrieb Marcel Taeumel <[hidden email]>:

throw that code away, and have a look at  in VMMakerInbox, you will understand better...

Not so sure ... because I think we do not agree on the status quo yet. We should do that first. Understand the compiledSpec as is. Then move forward.

So hopefully, we shall throw away the FFIFlagStructure and make your life easier at image side :)

Not so sure. See above. 

Best,
Marcel

Am 22.06.2020 10:28:12 schrieb Nicolas Cellier <[hidden email]>:

No, no,
throw that code away, and have a look at  in VMMakerInbox, you will understand better...

In fact, if you read my proposals, I'd like to get rid of FFIFlagStructure altogether...
Either a type is atomic or composite, it's not both nor neither...
So we ain't gonna need 2 flags FFIFlagAtomic and FFIFlagStructure.

So hopefully, we shall throw away the FFIFlagStructure and make your life easier at image side :)

Le lun. 22 juin 2020 à 10:19, Marcel Taeumel <[hidden email]> a écrit :
Hi Nicolas,

sure, there might be a difference. But you have all the information you need directly in the plugin already:



Let me catch up on this later this week.

Best,
Marcel

Am 22.06.2020 09:56:05 schrieb Nicolas Cellier <[hidden email]>:

Hi Marcel,
So you mean that I don't really need to distinguish pointer to struct and pointer to atomic type alias?
Maybe...

There is currently a difference:
- an atomic type alias has an immediate value as handle
  it thus cannot be passed as parameter by reference
  (well, for aliases to pointers, I don't really know...)
- a struct has a memory zone as value (ExternalAddress or direct ByteArray)
 it thus can be passed as parameter by reference without having to resort to an ExternalData.
See ffiPassStructureArgumentByReference: oop Class: oopClass expectedClass: argClass In: calloutState
vs ffiPassAtomicArgumentByReference: oop Class: oopClass expectedClass: argClass In: calloutState


Le lun. 22 juin 2020 à 09:18, Marcel Taeumel <[hidden email]> a écrit :
Hi Nicolas,

thanks! :-) I will take a look at it during this week, I hope. 

Here is a first thought:

I don't think that the pointer types for external structs should have the FFIFlagStructure."referentClass" should be more than enough for the FFI plugin side for both coercing and return-value packaging.

So, -1 for now but maybe I overlooked a use case. Raising this FFIFlagStructure here for such pointer types really messes up a lot of my current conceptual model about the relationship of ExternalStructure and ExternalType/ExternalStructureType. :-)

Why is "referentClass" not enough for the plugin side? Just check for ifNil, if not, instantiate and put instVar 0 to the return value. Done. ;-) For coercing, just compare argument class with "referentClass" in the argType; then check for the pointer flag. Maybe discriminate between ByteArray and ExternalAddress. 

...please don't raise FFIFlagStructure for pointer types for external structures... pretty please ^__^

Best,
Marcel

Am 21.06.2020 22:34:09 schrieb [hidden email] <[hidden email]>:

Nicolas Cellier uploaded a new version of FFI-Kernel to project FFI Inbox:
http://source.squeak.org/FFIinbox/FFI-Kernel-nice.119.mcz

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

Name: FFI-Kernel-nice.119
Author: nice
Time: 21 June 2020, 10:34:00.334284 pm
UUID: 3f2eca9d-8f55-476c-a0b0-c5ed6368a6b4
Ancestors: FFI-Kernel-nice.118

Make the compiledSpecs of struct pointers conform to the experimental FFI branch (thru #adjustPointerType)

See https://github.com/OpenSmalltalk/opensmalltalk-vm/tree/experimental_FFI

Simplify a bit ExternalData access (at: / at:put:).
The assumption that ExternalDataType is the type of the contents and not the type of the reference helps simplifying IMO.

We might want to make it more complete once we deal with pointer arity.
It's not the case yet.

=============== Diff against FFI-Kernel-nice.118 ===============

Item was changed:
----- Method: ExternalData>>at: (in category 'accessing') -----
at: index

- self
- assert: [index = 1 or: [type isAtomic]]
- description: 'Should not read non-atomic pointer as array'.
-
((1 > index) or: [size notNil and: [index > size]])
ifTrue: [^ self errorSubscriptBounds: index].

+ ^ type
- ^ type asNonPointerType
handle: handle
+ at: ((index-1) * type byteSize) + 1!
- at: ((index-1) * type asNonPointerType byteSize) + 1!

Item was changed:
----- Method: ExternalData>>at:put: (in category 'accessing') -----
at: index put: value

- self
- assert: [index = 1 or: [type isAtomic]]
- description: 'Should not read non-atomic pointer as array'.
-
((1 > index) or: [size notNil and: [index > size]])
ifTrue: [^ self errorSubscriptBounds: index].

+ ^ type
- ^ type asNonPointerType
handle: handle
+ at: ((index-1) * type byteSize) + 1
- at: ((index-1) * type asNonPointerType byteSize) + 1
put: value!

Item was changed:
----- Method: ExternalStructure class>>compileAllFields (in category 'system startup') -----
compileAllFields
"
ExternalStructure compileAllFields
"
+ | priorAuthorInitials |
- | priorAuthorInitials fieldSpec |
priorAuthorInitials := Utilities authorInitialsPerSe.
[Utilities setAuthorInitials: 'FFI'.

self allStructuresInCompilationOrder do: [:structClass |
+ | fieldSpec |
fieldSpec := structClass fields.
self flag: #discuss. "mt: Why do we need that extra layout check? Performance gain is minimal..."
(structClass hasFieldLayoutChanged: fieldSpec)
ifTrue: [structClass compileFieldsSilently: fieldSpec].
structClass externalType "asNonPointerType"
compiledSpec: structClass compiledSpec;
+ byteAlignment: structClass byteAlignment;
+ adjustPointerType.
- byteAlignment: structClass byteAlignment.
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: ExternalStructureType>>adjustPointerType (in category 'private') -----
+ adjustPointerType
+ self isPointerType
+ ifFalse: [self asPointerType
+ compiledSpec: (WordArray with: ((self compiledSpec first
+ bitAnd: FFIFlagAtomic + FFIFlagStructure)
+ bitOr: self class pointerSpec));
+ byteAlignment: self class pointerAlignment]!

Item was changed:
----- Method: ExternalType class>>initializeStructureTypes (in category 'class initialization') -----
initializeStructureTypes
"Reset all non-pointer struct types to zero and their pointer companions to the appropriate pointer size."

StructTypes ifNil: [
StructTypes := WeakValueDictionary new].

self cleanupUnusedTypes.

StructTypes valuesDo:[:structType |
structType "asNonPointerType"
compiledSpec: (WordArray with: self structureSpec);
byteAlignment: nil.
structType asPointerType
+ compiledSpec: (WordArray with: self pointerSpec + self structureSpec);
- compiledSpec: (WordArray with: self pointerSpec);
byteAlignment: nil].!

Item was changed:
----- Method: ExternalType>>handle:at: (in category 'external data') -----
handle: handle at: byteOffset
"Read the receiver's external type using the given handle and the byteOffset. This is the dynamic version of #readFieldAt:."

+ | address value |
- | result |
- self checkType.
-
self isPointerType
+ ifTrue:
+ [address := handle pointerAt: byteOffset length: self byteSize.
+ ^ExternalData
+ fromHandle: address
+ type: self asNonPointerType].
+ self isAtomic
+ ifTrue:
+ ["Answer atomic value"
+ value := handle
- ifFalse: [
- "Answer atomic value"
- ^ handle
perform: (AtomicSelectors at: self atomicType)
+ with: byteOffset.
+ ^referentClass ifNil: [value] ifNotNil: [referentClass fromHandle: value]].
+
+ referentClass isNil
+ ifTrue: [self error: 'unknown type'].
+ self isEmpty ifTrue: [self error: 'Empty structure'].
+
+ ^referentClass fromHandle: (handle structAt: byteOffset length: self byteSize)!
- with: byteOffset]
- ifTrue: [
- ^ referentClass
- ifNotNil: [
- "Answer structure, union, or type alias"
- referentClass fromHandle: (handle pointerAt: byteOffset length: self byteSize)]
- ifNil: [
- "Answer wrapper that points to external data"
- result := ExternalData
- fromHandle: (handle pointerAt: byteOffset length: self byteSize)
- type: self.
- self = ExternalType string
- ifTrue: [result fromCString]
- ifFalse: [result]]]!

Item was changed:
----- Method: ExternalType>>handle:at:put: (in category 'external data') -----
handle: handle at: byteOffset put: value
"Write a value using the receiver's external type at the given handle and byteOffset. This is the dynamic version of #writeFieldAt:with:."

- self checkType.
-
self isPointerType
- ifFalse: [ "set atomic value"
- self flag: #addTypeCheck. "mt: Note that there is currently no mapping from objects that represent valid atomics to atomic types."
- handle
- perform: ((AtomicSelectors at: self atomicType), 'put:') asSymbol
- with: byteOffset
- with: value]
ifTrue: [ "set pointer to struct/union/alias"
+ self assert: [value externalType == self asNonPointerType].
- self assert: [value externalType == self].
handle
pointerAt: byteOffset
put: value getHandle
+ length: self byteSize.
+ ^value].
+
+ self isAtomic
+ ifTrue:
+ [ "set atomic value"
+ self flag: #addTypeCheck. "mt: Note that there is currently no mapping from objects that represent valid atomics to atomic types."
+ handle
+ perform: ((AtomicSelectors at: self atomicType), 'put:') asSymbol
+ with: byteOffset
+ with: value.
+ ^value].
+
+ referentClass isNil
+ ifTrue: [self error: 'unknown type'].
+ self isEmpty ifTrue: [self error: 'Empty structure'].
+
+ self assert: [value externalType == self].
+ handle structAt: byteOffset put: value getHandle length: self byteSize.
+ ^value
+ !
- length: self byteSize].!






Reply | Threaded
Open this post in threaded view
|

Re: FFI Inbox: FFI-Kernel-nice.119.mcz

Nicolas Cellier
Hi Marcel,
I think we have difficulties to understand each other, while I'm pretty sure that we mostly agree (except on 1 little detail).

I decided to refactor the FFI Plugin because it reached the point to being
- incomprehensible
- way too complex
- impossible to maintain/change

Take a look at the combinatorial on the parameter specification side:
Atomic + pointer + struct + referentClass isNil
That's roughly 16 possibilities

Take a look at the combinatorial of actual arguments:
ByteArray ExternalAddress Alien WordArray immediate values (char int float) nil,true,false
ExternalStructure ExternalAlias ExternalData

Now draw a map of what actual argument you can pass to what specification and what you cannot.
It's the Excel that I sent to you. I had to decipher that sheet from reverse engineering...
Way too complex! We reached the limit and MUST refactor (or die).

So what I'm proposing is essentially a refactoring, and almost a statu quo (except the ones marked new!)
I want to reduce the number of combinations to 6 instead of 16, the 6 that makes sense IMO.
And at the same time, I want to extend the possible actual parameters, and ensure type safety (though it's more for future once we get pointer arity).

The 6 combinations that make sense are:
1) atomic <-> immediate value (or type alias)
2) atomic + referentClass <-> ExternalTypeAlias or ExternalData (new!)
3) atomic pointer <-> ExternalData or direct ByteArray, WordArray, ExternalAddress, Alien (no change, is required for UFFI, Alien etc...) DoubleByte/WordArray (new!)
4) atomic pointer + referentClass <-> ExternalData
5) structure + referentClass <-> ExternalStructure or ExternalData (new!)
6) structure + pointer + referentClass <-> ExternalStructure (new!) or ExternalData

The refactoring makes those 6 possibilities very clear by virtue of #caseOf:
There is one method ffiPassArgument* for each of the 6 possibilities.

What are the essential changes?
1) allow passing an ExternalData when we specified a parameter by value
This is a convenience for supporting global variables.
A global variable is a reference (an ExternalAddress) and a type incarnated in an ExternalData.
We want to be able to pass a global variable as argument to an external function call (whether by value or by reference)
So either the marshalling of objects is performed at image side (see UFFI for example, or somehow DLLCC in VW).
Or it is performed by the plugin itself (the case of SqueakFFI).
You proposed a mixed way via doesNotCoerce:. This can be interesting but more complex IMO (vs UFFI).

2) have a CLEAR encoding of combinations
 That means adding structure + pointer flag to pointer to ExternalStruct (if not atomic type alias).
 You legitimately ask whether it's needed to distinguish atomic+pointer+referentClass from structure+pointer+referentClass
 We might review that. For now, it enables passing an ExternalStruct directly to a struct pointer without resorting to an ExternalData.
  If you further look at the combinations, obviously, we ain't gonna need to flags struct + atomic. They are exclusive. So yes, this refactoring is only a first step to have things clarified. Then we can drive further.

I perfectly understand the importance of ExternalData and how it is central in the FFI and the relations to ExternalType.
I simply disagree on the urge to IMPOSE ExternalData for every interaction with our domain types/objects.
We can expose, but should not impose.
ExternalData can be used both for scalar or arrays. It's conceptually a ValueHolder.
We cannot really differentiate a pointer to a single value or to an array of values... This is the nature of C.
ExternalStructure is hybrid. It acts both as
- an ExternalData (the handle is the same as a scalar ExternalData)
- and as a type surrogate (by name in function interface specification, and via referentClass in the plugin)
If you take the POV of a user of FFI rather than the one of implementer of FFI, you'll see that this is the central object that user may and want to deal with.
That's our only point of friction I think, that should better be discussed around a beer!

cheers

Le lun. 22 juin 2020 à 10:44, Marcel Taeumel <[hidden email]> a écrit :
Let me add that I am really surprised (and a little bit worried) that this little requirement of "wrap alias to atomic into referentClass on return" turned into such a huge proposal of yours.

All that other coercing stuff could easily be added via #doesNotCoerce: as proposed here: 
http://forum.world.st/FFI-Plugin-Proposal-Add-doesNotCoerce-for-like-doesNotUnderstand-td5118724.html

Please, try to understand the relationship between ExternalData and ExternalStructure/Union/TypeAlias. It's so simple. But maybe not so clear. ExternalData is not an implementation detail. It's part of the public interface; it's like Array but as a composition of handle and type. And maybe size and offset -- but that's due to heap memory management part.

Type safety is valuable, of course. Maybe you can give more examples of what you want to achieve. :-)

Best,
Marcel

Am 22.06.2020 10:31:47 schrieb Marcel Taeumel <[hidden email]>:

throw that code away, and have a look at  in VMMakerInbox, you will understand better...

Not so sure ... because I think we do not agree on the status quo yet. We should do that first. Understand the compiledSpec as is. Then move forward.

So hopefully, we shall throw away the FFIFlagStructure and make your life easier at image side :)

Not so sure. See above. 

Best,
Marcel

Am 22.06.2020 10:28:12 schrieb Nicolas Cellier <[hidden email]>:

No, no,
throw that code away, and have a look at  in VMMakerInbox, you will understand better...

In fact, if you read my proposals, I'd like to get rid of FFIFlagStructure altogether...
Either a type is atomic or composite, it's not both nor neither...
So we ain't gonna need 2 flags FFIFlagAtomic and FFIFlagStructure.

So hopefully, we shall throw away the FFIFlagStructure and make your life easier at image side :)

Le lun. 22 juin 2020 à 10:19, Marcel Taeumel <[hidden email]> a écrit :
Hi Nicolas,

sure, there might be a difference. But you have all the information you need directly in the plugin already:



Let me catch up on this later this week.

Best,
Marcel

Am 22.06.2020 09:56:05 schrieb Nicolas Cellier <[hidden email]>:

Hi Marcel,
So you mean that I don't really need to distinguish pointer to struct and pointer to atomic type alias?
Maybe...

There is currently a difference:
- an atomic type alias has an immediate value as handle
  it thus cannot be passed as parameter by reference
  (well, for aliases to pointers, I don't really know...)
- a struct has a memory zone as value (ExternalAddress or direct ByteArray)
 it thus can be passed as parameter by reference without having to resort to an ExternalData.
See ffiPassStructureArgumentByReference: oop Class: oopClass expectedClass: argClass In: calloutState
vs ffiPassAtomicArgumentByReference: oop Class: oopClass expectedClass: argClass In: calloutState


Le lun. 22 juin 2020 à 09:18, Marcel Taeumel <[hidden email]> a écrit :
Hi Nicolas,

thanks! :-) I will take a look at it during this week, I hope. 

Here is a first thought:

I don't think that the pointer types for external structs should have the FFIFlagStructure."referentClass" should be more than enough for the FFI plugin side for both coercing and return-value packaging.

So, -1 for now but maybe I overlooked a use case. Raising this FFIFlagStructure here for such pointer types really messes up a lot of my current conceptual model about the relationship of ExternalStructure and ExternalType/ExternalStructureType. :-)

Why is "referentClass" not enough for the plugin side? Just check for ifNil, if not, instantiate and put instVar 0 to the return value. Done. ;-) For coercing, just compare argument class with "referentClass" in the argType; then check for the pointer flag. Maybe discriminate between ByteArray and ExternalAddress. 

...please don't raise FFIFlagStructure for pointer types for external structures... pretty please ^__^

Best,
Marcel

Am 21.06.2020 22:34:09 schrieb [hidden email] <[hidden email]>:

Nicolas Cellier uploaded a new version of FFI-Kernel to project FFI Inbox:
http://source.squeak.org/FFIinbox/FFI-Kernel-nice.119.mcz

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

Name: FFI-Kernel-nice.119
Author: nice
Time: 21 June 2020, 10:34:00.334284 pm
UUID: 3f2eca9d-8f55-476c-a0b0-c5ed6368a6b4
Ancestors: FFI-Kernel-nice.118

Make the compiledSpecs of struct pointers conform to the experimental FFI branch (thru #adjustPointerType)

See https://github.com/OpenSmalltalk/opensmalltalk-vm/tree/experimental_FFI

Simplify a bit ExternalData access (at: / at:put:).
The assumption that ExternalDataType is the type of the contents and not the type of the reference helps simplifying IMO.

We might want to make it more complete once we deal with pointer arity.
It's not the case yet.

=============== Diff against FFI-Kernel-nice.118 ===============

Item was changed:
----- Method: ExternalData>>at: (in category 'accessing') -----
at: index

- self
- assert: [index = 1 or: [type isAtomic]]
- description: 'Should not read non-atomic pointer as array'.
-
((1 > index) or: [size notNil and: [index > size]])
ifTrue: [^ self errorSubscriptBounds: index].

+ ^ type
- ^ type asNonPointerType
handle: handle
+ at: ((index-1) * type byteSize) + 1!
- at: ((index-1) * type asNonPointerType byteSize) + 1!

Item was changed:
----- Method: ExternalData>>at:put: (in category 'accessing') -----
at: index put: value

- self
- assert: [index = 1 or: [type isAtomic]]
- description: 'Should not read non-atomic pointer as array'.
-
((1 > index) or: [size notNil and: [index > size]])
ifTrue: [^ self errorSubscriptBounds: index].

+ ^ type
- ^ type asNonPointerType
handle: handle
+ at: ((index-1) * type byteSize) + 1
- at: ((index-1) * type asNonPointerType byteSize) + 1
put: value!

Item was changed:
----- Method: ExternalStructure class>>compileAllFields (in category 'system startup') -----
compileAllFields
"
ExternalStructure compileAllFields
"
+ | priorAuthorInitials |
- | priorAuthorInitials fieldSpec |
priorAuthorInitials := Utilities authorInitialsPerSe.
[Utilities setAuthorInitials: 'FFI'.

self allStructuresInCompilationOrder do: [:structClass |
+ | fieldSpec |
fieldSpec := structClass fields.
self flag: #discuss. "mt: Why do we need that extra layout check? Performance gain is minimal..."
(structClass hasFieldLayoutChanged: fieldSpec)
ifTrue: [structClass compileFieldsSilently: fieldSpec].
structClass externalType "asNonPointerType"
compiledSpec: structClass compiledSpec;
+ byteAlignment: structClass byteAlignment;
+ adjustPointerType.
- byteAlignment: structClass byteAlignment.
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: ExternalStructureType>>adjustPointerType (in category 'private') -----
+ adjustPointerType
+ self isPointerType
+ ifFalse: [self asPointerType
+ compiledSpec: (WordArray with: ((self compiledSpec first
+ bitAnd: FFIFlagAtomic + FFIFlagStructure)
+ bitOr: self class pointerSpec));
+ byteAlignment: self class pointerAlignment]!

Item was changed:
----- Method: ExternalType class>>initializeStructureTypes (in category 'class initialization') -----
initializeStructureTypes
"Reset all non-pointer struct types to zero and their pointer companions to the appropriate pointer size."

StructTypes ifNil: [
StructTypes := WeakValueDictionary new].

self cleanupUnusedTypes.

StructTypes valuesDo:[:structType |
structType "asNonPointerType"
compiledSpec: (WordArray with: self structureSpec);
byteAlignment: nil.
structType asPointerType
+ compiledSpec: (WordArray with: self pointerSpec + self structureSpec);
- compiledSpec: (WordArray with: self pointerSpec);
byteAlignment: nil].!

Item was changed:
----- Method: ExternalType>>handle:at: (in category 'external data') -----
handle: handle at: byteOffset
"Read the receiver's external type using the given handle and the byteOffset. This is the dynamic version of #readFieldAt:."

+ | address value |
- | result |
- self checkType.
-
self isPointerType
+ ifTrue:
+ [address := handle pointerAt: byteOffset length: self byteSize.
+ ^ExternalData
+ fromHandle: address
+ type: self asNonPointerType].
+ self isAtomic
+ ifTrue:
+ ["Answer atomic value"
+ value := handle
- ifFalse: [
- "Answer atomic value"
- ^ handle
perform: (AtomicSelectors at: self atomicType)
+ with: byteOffset.
+ ^referentClass ifNil: [value] ifNotNil: [referentClass fromHandle: value]].
+
+ referentClass isNil
+ ifTrue: [self error: 'unknown type'].
+ self isEmpty ifTrue: [self error: 'Empty structure'].
+
+ ^referentClass fromHandle: (handle structAt: byteOffset length: self byteSize)!
- with: byteOffset]
- ifTrue: [
- ^ referentClass
- ifNotNil: [
- "Answer structure, union, or type alias"
- referentClass fromHandle: (handle pointerAt: byteOffset length: self byteSize)]
- ifNil: [
- "Answer wrapper that points to external data"
- result := ExternalData
- fromHandle: (handle pointerAt: byteOffset length: self byteSize)
- type: self.
- self = ExternalType string
- ifTrue: [result fromCString]
- ifFalse: [result]]]!

Item was changed:
----- Method: ExternalType>>handle:at:put: (in category 'external data') -----
handle: handle at: byteOffset put: value
"Write a value using the receiver's external type at the given handle and byteOffset. This is the dynamic version of #writeFieldAt:with:."

- self checkType.
-
self isPointerType
- ifFalse: [ "set atomic value"
- self flag: #addTypeCheck. "mt: Note that there is currently no mapping from objects that represent valid atomics to atomic types."
- handle
- perform: ((AtomicSelectors at: self atomicType), 'put:') asSymbol
- with: byteOffset
- with: value]
ifTrue: [ "set pointer to struct/union/alias"
+ self assert: [value externalType == self asNonPointerType].
- self assert: [value externalType == self].
handle
pointerAt: byteOffset
put: value getHandle
+ length: self byteSize.
+ ^value].
+
+ self isAtomic
+ ifTrue:
+ [ "set atomic value"
+ self flag: #addTypeCheck. "mt: Note that there is currently no mapping from objects that represent valid atomics to atomic types."
+ handle
+ perform: ((AtomicSelectors at: self atomicType), 'put:') asSymbol
+ with: byteOffset
+ with: value.
+ ^value].
+
+ referentClass isNil
+ ifTrue: [self error: 'unknown type'].
+ self isEmpty ifTrue: [self error: 'Empty structure'].
+
+ self assert: [value externalType == self].
+ handle structAt: byteOffset put: value getHandle length: self byteSize.
+ ^value
+ !
- length: self byteSize].!







Reply | Threaded
Open this post in threaded view
|

Re: FFI Inbox: FFI-Kernel-nice.119.mcz

Nicolas Cellier


Le lun. 22 juin 2020 à 11:50, Nicolas Cellier <[hidden email]> a écrit :
Hi Marcel,
I think we have difficulties to understand each other, while I'm pretty sure that we mostly agree (except on 1 little detail).

I decided to refactor the FFI Plugin because it reached the point to being
- incomprehensible
- way too complex
- impossible to maintain/change

Take a look at the combinatorial on the parameter specification side:
Atomic + pointer + struct + referentClass isNil
That's roughly 16 possibilities

Take a look at the combinatorial of actual arguments:
ByteArray ExternalAddress Alien WordArray immediate values (char int float) nil,true,false
ExternalStructure ExternalAlias ExternalData

Now draw a map of what actual argument you can pass to what specification and what you cannot.
It's the Excel that I sent to you. I had to decipher that sheet from reverse engineering...
Way too complex! We reached the limit and MUST refactor (or die).

So what I'm proposing is essentially a refactoring, and almost a statu quo (except the ones marked new!)
I want to reduce the number of combinations to 6 instead of 16, the 6 that makes sense IMO.
And at the same time, I want to extend the possible actual parameters, and ensure type safety (though it's more for future once we get pointer arity).

The 6 combinations that make sense are:
1) atomic <-> immediate value (or type alias)
2) atomic + referentClass <-> ExternalTypeAlias or ExternalData (new!)
3) atomic pointer <-> ExternalData or direct ByteArray, WordArray, ExternalAddress, Alien (no change, is required for UFFI, Alien etc...) DoubleByte/WordArray (new!)
4) atomic pointer + referentClass <-> ExternalData
5) structure + referentClass <-> ExternalStructure or ExternalData (new!)
6) structure + pointer + referentClass <-> ExternalStructure (new!) or ExternalData

The refactoring makes those 6 possibilities very clear by virtue of #caseOf:
There is one method ffiPassArgument* for each of the 6 possibilities.

What are the essential changes?
1) allow passing an ExternalData when we specified a parameter by value
This is a convenience for supporting global variables.
A global variable is a reference (an ExternalAddress) and a type incarnated in an ExternalData.
We want to be able to pass a global variable as argument to an external function call (whether by value or by reference)
So either the marshalling of objects is performed at image side (see UFFI for example, or somehow DLLCC in VW).
Or it is performed by the plugin itself (the case of SqueakFFI).
You proposed a mixed way via doesNotCoerce:. This can be interesting but more complex IMO (vs UFFI).

Ah one more thing,
I think that image side marshalling is much more powerful, because extensible.
Yes, it's far easier to coerce at image side, extend with new classes, etc...
So, IMO, UFFI is on the right track.

2) have a CLEAR encoding of combinations
 That means adding structure + pointer flag to pointer to ExternalStruct (if not atomic type alias).
 You legitimately ask whether it's needed to distinguish atomic+pointer+referentClass from structure+pointer+referentClass
 We might review that. For now, it enables passing an ExternalStruct directly to a struct pointer without resorting to an ExternalData.
  If you further look at the combinations, obviously, we ain't gonna need to flags struct + atomic. They are exclusive. So yes, this refactoring is only a first step to have things clarified. Then we can drive further.

I perfectly understand the importance of ExternalData and how it is central in the FFI and the relations to ExternalType.
I simply disagree on the urge to IMPOSE ExternalData for every interaction with our domain types/objects.
We can expose, but should not impose.
ExternalData can be used both for scalar or arrays. It's conceptually a ValueHolder.
We cannot really differentiate a pointer to a single value or to an array of values... This is the nature of C.
ExternalStructure is hybrid. It acts both as
- an ExternalData (the handle is the same as a scalar ExternalData)
- and as a type surrogate (by name in function interface specification, and via referentClass in the plugin)
If you take the POV of a user of FFI rather than the one of implementer of FFI, you'll see that this is the central object that user may and want to deal with.
That's our only point of friction I think, that should better be discussed around a beer!

cheers

Le lun. 22 juin 2020 à 10:44, Marcel Taeumel <[hidden email]> a écrit :
Let me add that I am really surprised (and a little bit worried) that this little requirement of "wrap alias to atomic into referentClass on return" turned into such a huge proposal of yours.

All that other coercing stuff could easily be added via #doesNotCoerce: as proposed here: 
http://forum.world.st/FFI-Plugin-Proposal-Add-doesNotCoerce-for-like-doesNotUnderstand-td5118724.html

Please, try to understand the relationship between ExternalData and ExternalStructure/Union/TypeAlias. It's so simple. But maybe not so clear. ExternalData is not an implementation detail. It's part of the public interface; it's like Array but as a composition of handle and type. And maybe size and offset -- but that's due to heap memory management part.

Type safety is valuable, of course. Maybe you can give more examples of what you want to achieve. :-)

Best,
Marcel

Am 22.06.2020 10:31:47 schrieb Marcel Taeumel <[hidden email]>:

throw that code away, and have a look at  in VMMakerInbox, you will understand better...

Not so sure ... because I think we do not agree on the status quo yet. We should do that first. Understand the compiledSpec as is. Then move forward.

So hopefully, we shall throw away the FFIFlagStructure and make your life easier at image side :)

Not so sure. See above. 

Best,
Marcel

Am 22.06.2020 10:28:12 schrieb Nicolas Cellier <[hidden email]>:

No, no,
throw that code away, and have a look at  in VMMakerInbox, you will understand better...

In fact, if you read my proposals, I'd like to get rid of FFIFlagStructure altogether...
Either a type is atomic or composite, it's not both nor neither...
So we ain't gonna need 2 flags FFIFlagAtomic and FFIFlagStructure.

So hopefully, we shall throw away the FFIFlagStructure and make your life easier at image side :)

Le lun. 22 juin 2020 à 10:19, Marcel Taeumel <[hidden email]> a écrit :
Hi Nicolas,

sure, there might be a difference. But you have all the information you need directly in the plugin already:



Let me catch up on this later this week.

Best,
Marcel

Am 22.06.2020 09:56:05 schrieb Nicolas Cellier <[hidden email]>:

Hi Marcel,
So you mean that I don't really need to distinguish pointer to struct and pointer to atomic type alias?
Maybe...

There is currently a difference:
- an atomic type alias has an immediate value as handle
  it thus cannot be passed as parameter by reference
  (well, for aliases to pointers, I don't really know...)
- a struct has a memory zone as value (ExternalAddress or direct ByteArray)
 it thus can be passed as parameter by reference without having to resort to an ExternalData.
See ffiPassStructureArgumentByReference: oop Class: oopClass expectedClass: argClass In: calloutState
vs ffiPassAtomicArgumentByReference: oop Class: oopClass expectedClass: argClass In: calloutState


Le lun. 22 juin 2020 à 09:18, Marcel Taeumel <[hidden email]> a écrit :
Hi Nicolas,

thanks! :-) I will take a look at it during this week, I hope. 

Here is a first thought:

I don't think that the pointer types for external structs should have the FFIFlagStructure."referentClass" should be more than enough for the FFI plugin side for both coercing and return-value packaging.

So, -1 for now but maybe I overlooked a use case. Raising this FFIFlagStructure here for such pointer types really messes up a lot of my current conceptual model about the relationship of ExternalStructure and ExternalType/ExternalStructureType. :-)

Why is "referentClass" not enough for the plugin side? Just check for ifNil, if not, instantiate and put instVar 0 to the return value. Done. ;-) For coercing, just compare argument class with "referentClass" in the argType; then check for the pointer flag. Maybe discriminate between ByteArray and ExternalAddress. 

...please don't raise FFIFlagStructure for pointer types for external structures... pretty please ^__^

Best,
Marcel

Am 21.06.2020 22:34:09 schrieb [hidden email] <[hidden email]>:

Nicolas Cellier uploaded a new version of FFI-Kernel to project FFI Inbox:
http://source.squeak.org/FFIinbox/FFI-Kernel-nice.119.mcz

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

Name: FFI-Kernel-nice.119
Author: nice
Time: 21 June 2020, 10:34:00.334284 pm
UUID: 3f2eca9d-8f55-476c-a0b0-c5ed6368a6b4
Ancestors: FFI-Kernel-nice.118

Make the compiledSpecs of struct pointers conform to the experimental FFI branch (thru #adjustPointerType)

See https://github.com/OpenSmalltalk/opensmalltalk-vm/tree/experimental_FFI

Simplify a bit ExternalData access (at: / at:put:).
The assumption that ExternalDataType is the type of the contents and not the type of the reference helps simplifying IMO.

We might want to make it more complete once we deal with pointer arity.
It's not the case yet.

=============== Diff against FFI-Kernel-nice.118 ===============

Item was changed:
----- Method: ExternalData>>at: (in category 'accessing') -----
at: index

- self
- assert: [index = 1 or: [type isAtomic]]
- description: 'Should not read non-atomic pointer as array'.
-
((1 > index) or: [size notNil and: [index > size]])
ifTrue: [^ self errorSubscriptBounds: index].

+ ^ type
- ^ type asNonPointerType
handle: handle
+ at: ((index-1) * type byteSize) + 1!
- at: ((index-1) * type asNonPointerType byteSize) + 1!

Item was changed:
----- Method: ExternalData>>at:put: (in category 'accessing') -----
at: index put: value

- self
- assert: [index = 1 or: [type isAtomic]]
- description: 'Should not read non-atomic pointer as array'.
-
((1 > index) or: [size notNil and: [index > size]])
ifTrue: [^ self errorSubscriptBounds: index].

+ ^ type
- ^ type asNonPointerType
handle: handle
+ at: ((index-1) * type byteSize) + 1
- at: ((index-1) * type asNonPointerType byteSize) + 1
put: value!

Item was changed:
----- Method: ExternalStructure class>>compileAllFields (in category 'system startup') -----
compileAllFields
"
ExternalStructure compileAllFields
"
+ | priorAuthorInitials |
- | priorAuthorInitials fieldSpec |
priorAuthorInitials := Utilities authorInitialsPerSe.
[Utilities setAuthorInitials: 'FFI'.

self allStructuresInCompilationOrder do: [:structClass |
+ | fieldSpec |
fieldSpec := structClass fields.
self flag: #discuss. "mt: Why do we need that extra layout check? Performance gain is minimal..."
(structClass hasFieldLayoutChanged: fieldSpec)
ifTrue: [structClass compileFieldsSilently: fieldSpec].
structClass externalType "asNonPointerType"
compiledSpec: structClass compiledSpec;
+ byteAlignment: structClass byteAlignment;
+ adjustPointerType.
- byteAlignment: structClass byteAlignment.
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: ExternalStructureType>>adjustPointerType (in category 'private') -----
+ adjustPointerType
+ self isPointerType
+ ifFalse: [self asPointerType
+ compiledSpec: (WordArray with: ((self compiledSpec first
+ bitAnd: FFIFlagAtomic + FFIFlagStructure)
+ bitOr: self class pointerSpec));
+ byteAlignment: self class pointerAlignment]!

Item was changed:
----- Method: ExternalType class>>initializeStructureTypes (in category 'class initialization') -----
initializeStructureTypes
"Reset all non-pointer struct types to zero and their pointer companions to the appropriate pointer size."

StructTypes ifNil: [
StructTypes := WeakValueDictionary new].

self cleanupUnusedTypes.

StructTypes valuesDo:[:structType |
structType "asNonPointerType"
compiledSpec: (WordArray with: self structureSpec);
byteAlignment: nil.
structType asPointerType
+ compiledSpec: (WordArray with: self pointerSpec + self structureSpec);
- compiledSpec: (WordArray with: self pointerSpec);
byteAlignment: nil].!

Item was changed:
----- Method: ExternalType>>handle:at: (in category 'external data') -----
handle: handle at: byteOffset
"Read the receiver's external type using the given handle and the byteOffset. This is the dynamic version of #readFieldAt:."

+ | address value |
- | result |
- self checkType.
-
self isPointerType
+ ifTrue:
+ [address := handle pointerAt: byteOffset length: self byteSize.
+ ^ExternalData
+ fromHandle: address
+ type: self asNonPointerType].
+ self isAtomic
+ ifTrue:
+ ["Answer atomic value"
+ value := handle
- ifFalse: [
- "Answer atomic value"
- ^ handle
perform: (AtomicSelectors at: self atomicType)
+ with: byteOffset.
+ ^referentClass ifNil: [value] ifNotNil: [referentClass fromHandle: value]].
+
+ referentClass isNil
+ ifTrue: [self error: 'unknown type'].
+ self isEmpty ifTrue: [self error: 'Empty structure'].
+
+ ^referentClass fromHandle: (handle structAt: byteOffset length: self byteSize)!
- with: byteOffset]
- ifTrue: [
- ^ referentClass
- ifNotNil: [
- "Answer structure, union, or type alias"
- referentClass fromHandle: (handle pointerAt: byteOffset length: self byteSize)]
- ifNil: [
- "Answer wrapper that points to external data"
- result := ExternalData
- fromHandle: (handle pointerAt: byteOffset length: self byteSize)
- type: self.
- self = ExternalType string
- ifTrue: [result fromCString]
- ifFalse: [result]]]!

Item was changed:
----- Method: ExternalType>>handle:at:put: (in category 'external data') -----
handle: handle at: byteOffset put: value
"Write a value using the receiver's external type at the given handle and byteOffset. This is the dynamic version of #writeFieldAt:with:."

- self checkType.
-
self isPointerType
- ifFalse: [ "set atomic value"
- self flag: #addTypeCheck. "mt: Note that there is currently no mapping from objects that represent valid atomics to atomic types."
- handle
- perform: ((AtomicSelectors at: self atomicType), 'put:') asSymbol
- with: byteOffset
- with: value]
ifTrue: [ "set pointer to struct/union/alias"
+ self assert: [value externalType == self asNonPointerType].
- self assert: [value externalType == self].
handle
pointerAt: byteOffset
put: value getHandle
+ length: self byteSize.
+ ^value].
+
+ self isAtomic
+ ifTrue:
+ [ "set atomic value"
+ self flag: #addTypeCheck. "mt: Note that there is currently no mapping from objects that represent valid atomics to atomic types."
+ handle
+ perform: ((AtomicSelectors at: self atomicType), 'put:') asSymbol
+ with: byteOffset
+ with: value.
+ ^value].
+
+ referentClass isNil
+ ifTrue: [self error: 'unknown type'].
+ self isEmpty ifTrue: [self error: 'Empty structure'].
+
+ self assert: [value externalType == self].
+ handle structAt: byteOffset put: value getHandle length: self byteSize.
+ ^value
+ !
- length: self byteSize].!







Reply | Threaded
Open this post in threaded view
|

Re: FFI Inbox: FFI-Kernel-nice.119.mcz

marcel.taeumel
In reply to this post by Nicolas Cellier
Hi Nicolas,

If you take the POV of a user of FFI rather than the one of implementer of FFI, you'll see that this is the central object that user may and want to deal with.
> That's our only point of friction I think, that should better be discussed around a beer!

The plenitude of code examples I did already provide on this list is an indicator that I am very much able to take the POV of a user of FFI. :-) I think you are having difficulties to separate public from private interface from my code examples. Sorry for that. I will try to get better.

This change (FFI-Kernel-nice.119) adds too much complexity to the implementation -- it even breaks part of the model that is already there. That's why I disagree.

> I decided to refactor the FFI Plugin because it reached the point to being - incomprehensible - way too complex - impossible to maintain/change

Well, I read that code days ago. While I was unfamiliar with it at first, I quickly understood what is implemented where. Comments where helpful. Combinatorial complexity manageable. The biggest challenge was to learn about compiledSpec and referentClass. So, no, I think you are just unfamiliar with its patterns. No need to refactor it right away if you are just in the learning process.

Maybe Eliot can help here.

> We want to be able to pass a global variable as argument to an external function call 

Well, you disagreed with my proposal to use ExternalData<@F2398FEE, int*> as a representative for a global variable. You claimed that we should use non-pointer types in such external data. Now you propose a lot of changes to make your plan work.

Please, go one step back and reconsider.

If you want to coerce a global var by value, just check for the pointer type and look up the value.

Sigh.

We should really start this discussion afresh. -.-" 

Best,
Marcel

Am 22.06.2020 11:51:25 schrieb Nicolas Cellier <[hidden email]>:

Hi Marcel,
I think we have difficulties to understand each other, while I'm pretty sure that we mostly agree (except on 1 little detail).

I decided to refactor the FFI Plugin because it reached the point to being
- incomprehensible
- way too complex
- impossible to maintain/change

Take a look at the combinatorial on the parameter specification side:
Atomic + pointer + struct + referentClass isNil
That's roughly 16 possibilities

Take a look at the combinatorial of actual arguments:
ByteArray ExternalAddress Alien WordArray immediate values (char int float) nil,true,false
ExternalStructure ExternalAlias ExternalData

Now draw a map of what actual argument you can pass to what specification and what you cannot.
It's the Excel that I sent to you. I had to decipher that sheet from reverse engineering...
Way too complex! We reached the limit and MUST refactor (or die).

So what I'm proposing is essentially a refactoring, and almost a statu quo (except the ones marked new!)
I want to reduce the number of combinations to 6 instead of 16, the 6 that makes sense IMO.
And at the same time, I want to extend the possible actual parameters, and ensure type safety (though it's more for future once we get pointer arity).

The 6 combinations that make sense are:
1) atomic <-> immediate value (or type alias)
2) atomic + referentClass <-> ExternalTypeAlias or ExternalData (new!)
3) atomic pointer <-> ExternalData or direct ByteArray, WordArray, ExternalAddress, Alien (no change, is required for UFFI, Alien etc...) DoubleByte/WordArray (new!)
4) atomic pointer + referentClass <-> ExternalData
5) structure + referentClass <-> ExternalStructure or ExternalData (new!)
6) structure + pointer + referentClass <-> ExternalStructure (new!) or ExternalData

The refactoring makes those 6 possibilities very clear by virtue of #caseOf:
There is one method ffiPassArgument* for each of the 6 possibilities.

What are the essential changes?
1) allow passing an ExternalData when we specified a parameter by value
This is a convenience for supporting global variables.
A global variable is a reference (an ExternalAddress) and a type incarnated in an ExternalData.
We want to be able to pass a global variable as argument to an external function call (whether by value or by reference)
So either the marshalling of objects is performed at image side (see UFFI for example, or somehow DLLCC in VW).
Or it is performed by the plugin itself (the case of SqueakFFI).
You proposed a mixed way via doesNotCoerce:. This can be interesting but more complex IMO (vs UFFI).

2) have a CLEAR encoding of combinations
 That means adding structure + pointer flag to pointer to ExternalStruct (if not atomic type alias).
 You legitimately ask whether it's needed to distinguish atomic+pointer+referentClass from structure+pointer+referentClass
 We might review that. For now, it enables passing an ExternalStruct directly to a struct pointer without resorting to an ExternalData.
  If you further look at the combinations, obviously, we ain't gonna need to flags struct + atomic. They are exclusive. So yes, this refactoring is only a first step to have things clarified. Then we can drive further.

I perfectly understand the importance of ExternalData and how it is central in the FFI and the relations to ExternalType.
I simply disagree on the urge to IMPOSE ExternalData for every interaction with our domain types/objects.
We can expose, but should not impose.
ExternalData can be used both for scalar or arrays. It's conceptually a ValueHolder.
We cannot really differentiate a pointer to a single value or to an array of values... This is the nature of C.
ExternalStructure is hybrid. It acts both as
- an ExternalData (the handle is the same as a scalar ExternalData)
- and as a type surrogate (by name in function interface specification, and via referentClass in the plugin)
If you take the POV of a user of FFI rather than the one of implementer of FFI, you'll see that this is the central object that user may and want to deal with.
That's our only point of friction I think, that should better be discussed around a beer!

cheers

Le lun. 22 juin 2020 à 10:44, Marcel Taeumel <[hidden email]> a écrit :
Let me add that I am really surprised (and a little bit worried) that this little requirement of "wrap alias to atomic into referentClass on return" turned into such a huge proposal of yours.

All that other coercing stuff could easily be added via #doesNotCoerce: as proposed here: 
http://forum.world.st/FFI-Plugin-Proposal-Add-doesNotCoerce-for-like-doesNotUnderstand-td5118724.html

Please, try to understand the relationship between ExternalData and ExternalStructure/Union/TypeAlias. It's so simple. But maybe not so clear. ExternalData is not an implementation detail. It's part of the public interface; it's like Array but as a composition of handle and type. And maybe size and offset -- but that's due to heap memory management part.

Type safety is valuable, of course. Maybe you can give more examples of what you want to achieve. :-)

Best,
Marcel

Am 22.06.2020 10:31:47 schrieb Marcel Taeumel <[hidden email]>:

throw that code away, and have a look at  in VMMakerInbox, you will understand better...

Not so sure ... because I think we do not agree on the status quo yet. We should do that first. Understand the compiledSpec as is. Then move forward.

So hopefully, we shall throw away the FFIFlagStructure and make your life easier at image side :)

Not so sure. See above. 

Best,
Marcel

Am 22.06.2020 10:28:12 schrieb Nicolas Cellier <[hidden email]>:

No, no,
throw that code away, and have a look at  in VMMakerInbox, you will understand better...

In fact, if you read my proposals, I'd like to get rid of FFIFlagStructure altogether...
Either a type is atomic or composite, it's not both nor neither...
So we ain't gonna need 2 flags FFIFlagAtomic and FFIFlagStructure.

So hopefully, we shall throw away the FFIFlagStructure and make your life easier at image side :)

Le lun. 22 juin 2020 à 10:19, Marcel Taeumel <[hidden email]> a écrit :
Hi Nicolas,

sure, there might be a difference. But you have all the information you need directly in the plugin already:



Let me catch up on this later this week.

Best,
Marcel

Am 22.06.2020 09:56:05 schrieb Nicolas Cellier <[hidden email]>:

Hi Marcel,
So you mean that I don't really need to distinguish pointer to struct and pointer to atomic type alias?
Maybe...

There is currently a difference:
- an atomic type alias has an immediate value as handle
  it thus cannot be passed as parameter by reference
  (well, for aliases to pointers, I don't really know...)
- a struct has a memory zone as value (ExternalAddress or direct ByteArray)
 it thus can be passed as parameter by reference without having to resort to an ExternalData.
See ffiPassStructureArgumentByReference: oop Class: oopClass expectedClass: argClass In: calloutState
vs ffiPassAtomicArgumentByReference: oop Class: oopClass expectedClass: argClass In: calloutState


Le lun. 22 juin 2020 à 09:18, Marcel Taeumel <[hidden email]> a écrit :
Hi Nicolas,

thanks! :-) I will take a look at it during this week, I hope. 

Here is a first thought:

I don't think that the pointer types for external structs should have the FFIFlagStructure."referentClass" should be more than enough for the FFI plugin side for both coercing and return-value packaging.

So, -1 for now but maybe I overlooked a use case. Raising this FFIFlagStructure here for such pointer types really messes up a lot of my current conceptual model about the relationship of ExternalStructure and ExternalType/ExternalStructureType. :-)

Why is "referentClass" not enough for the plugin side? Just check for ifNil, if not, instantiate and put instVar 0 to the return value. Done. ;-) For coercing, just compare argument class with "referentClass" in the argType; then check for the pointer flag. Maybe discriminate between ByteArray and ExternalAddress. 

...please don't raise FFIFlagStructure for pointer types for external structures... pretty please ^__^

Best,
Marcel

Am 21.06.2020 22:34:09 schrieb [hidden email] <[hidden email]>:

Nicolas Cellier uploaded a new version of FFI-Kernel to project FFI Inbox:
http://source.squeak.org/FFIinbox/FFI-Kernel-nice.119.mcz

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

Name: FFI-Kernel-nice.119
Author: nice
Time: 21 June 2020, 10:34:00.334284 pm
UUID: 3f2eca9d-8f55-476c-a0b0-c5ed6368a6b4
Ancestors: FFI-Kernel-nice.118

Make the compiledSpecs of struct pointers conform to the experimental FFI branch (thru #adjustPointerType)

See https://github.com/OpenSmalltalk/opensmalltalk-vm/tree/experimental_FFI

Simplify a bit ExternalData access (at: / at:put:).
The assumption that ExternalDataType is the type of the contents and not the type of the reference helps simplifying IMO.

We might want to make it more complete once we deal with pointer arity.
It's not the case yet.

=============== Diff against FFI-Kernel-nice.118 ===============

Item was changed:
----- Method: ExternalData>>at: (in category 'accessing') -----
at: index

- self
- assert: [index = 1 or: [type isAtomic]]
- description: 'Should not read non-atomic pointer as array'.
-
((1 > index) or: [size notNil and: [index > size]])
ifTrue: [^ self errorSubscriptBounds: index].

+ ^ type
- ^ type asNonPointerType
handle: handle
+ at: ((index-1) * type byteSize) + 1!
- at: ((index-1) * type asNonPointerType byteSize) + 1!

Item was changed:
----- Method: ExternalData>>at:put: (in category 'accessing') -----
at: index put: value

- self
- assert: [index = 1 or: [type isAtomic]]
- description: 'Should not read non-atomic pointer as array'.
-
((1 > index) or: [size notNil and: [index > size]])
ifTrue: [^ self errorSubscriptBounds: index].

+ ^ type
- ^ type asNonPointerType
handle: handle
+ at: ((index-1) * type byteSize) + 1
- at: ((index-1) * type asNonPointerType byteSize) + 1
put: value!

Item was changed:
----- Method: ExternalStructure class>>compileAllFields (in category 'system startup') -----
compileAllFields
"
ExternalStructure compileAllFields
"
+ | priorAuthorInitials |
- | priorAuthorInitials fieldSpec |
priorAuthorInitials := Utilities authorInitialsPerSe.
[Utilities setAuthorInitials: 'FFI'.

self allStructuresInCompilationOrder do: [:structClass |
+ | fieldSpec |
fieldSpec := structClass fields.
self flag: #discuss. "mt: Why do we need that extra layout check? Performance gain is minimal..."
(structClass hasFieldLayoutChanged: fieldSpec)
ifTrue: [structClass compileFieldsSilently: fieldSpec].
structClass externalType "asNonPointerType"
compiledSpec: structClass compiledSpec;
+ byteAlignment: structClass byteAlignment;
+ adjustPointerType.
- byteAlignment: structClass byteAlignment.
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: ExternalStructureType>>adjustPointerType (in category 'private') -----
+ adjustPointerType
+ self isPointerType
+ ifFalse: [self asPointerType
+ compiledSpec: (WordArray with: ((self compiledSpec first
+ bitAnd: FFIFlagAtomic + FFIFlagStructure)
+ bitOr: self class pointerSpec));
+ byteAlignment: self class pointerAlignment]!

Item was changed:
----- Method: ExternalType class>>initializeStructureTypes (in category 'class initialization') -----
initializeStructureTypes
"Reset all non-pointer struct types to zero and their pointer companions to the appropriate pointer size."

StructTypes ifNil: [
StructTypes := WeakValueDictionary new].

self cleanupUnusedTypes.

StructTypes valuesDo:[:structType |
structType "asNonPointerType"
compiledSpec: (WordArray with: self structureSpec);
byteAlignment: nil.
structType asPointerType
+ compiledSpec: (WordArray with: self pointerSpec + self structureSpec);
- compiledSpec: (WordArray with: self pointerSpec);
byteAlignment: nil].!

Item was changed:
----- Method: ExternalType>>handle:at: (in category 'external data') -----
handle: handle at: byteOffset
"Read the receiver's external type using the given handle and the byteOffset. This is the dynamic version of #readFieldAt:."

+ | address value |
- | result |
- self checkType.
-
self isPointerType
+ ifTrue:
+ [address := handle pointerAt: byteOffset length: self byteSize.
+ ^ExternalData
+ fromHandle: address
+ type: self asNonPointerType].
+ self isAtomic
+ ifTrue:
+ ["Answer atomic value"
+ value := handle
- ifFalse: [
- "Answer atomic value"
- ^ handle
perform: (AtomicSelectors at: self atomicType)
+ with: byteOffset.
+ ^referentClass ifNil: [value] ifNotNil: [referentClass fromHandle: value]].
+
+ referentClass isNil
+ ifTrue: [self error: 'unknown type'].
+ self isEmpty ifTrue: [self error: 'Empty structure'].
+
+ ^referentClass fromHandle: (handle structAt: byteOffset length: self byteSize)!
- with: byteOffset]
- ifTrue: [
- ^ referentClass
- ifNotNil: [
- "Answer structure, union, or type alias"
- referentClass fromHandle: (handle pointerAt: byteOffset length: self byteSize)]
- ifNil: [
- "Answer wrapper that points to external data"
- result := ExternalData
- fromHandle: (handle pointerAt: byteOffset length: self byteSize)
- type: self.
- self = ExternalType string
- ifTrue: [result fromCString]
- ifFalse: [result]]]!

Item was changed:
----- Method: ExternalType>>handle:at:put: (in category 'external data') -----
handle: handle at: byteOffset put: value
"Write a value using the receiver's external type at the given handle and byteOffset. This is the dynamic version of #writeFieldAt:with:."

- self checkType.
-
self isPointerType
- ifFalse: [ "set atomic value"
- self flag: #addTypeCheck. "mt: Note that there is currently no mapping from objects that represent valid atomics to atomic types."
- handle
- perform: ((AtomicSelectors at: self atomicType), 'put:') asSymbol
- with: byteOffset
- with: value]
ifTrue: [ "set pointer to struct/union/alias"
+ self assert: [value externalType == self asNonPointerType].
- self assert: [value externalType == self].
handle
pointerAt: byteOffset
put: value getHandle
+ length: self byteSize.
+ ^value].
+
+ self isAtomic
+ ifTrue:
+ [ "set atomic value"
+ self flag: #addTypeCheck. "mt: Note that there is currently no mapping from objects that represent valid atomics to atomic types."
+ handle
+ perform: ((AtomicSelectors at: self atomicType), 'put:') asSymbol
+ with: byteOffset
+ with: value.
+ ^value].
+
+ referentClass isNil
+ ifTrue: [self error: 'unknown type'].
+ self isEmpty ifTrue: [self error: 'Empty structure'].
+
+ self assert: [value externalType == self].
+ handle structAt: byteOffset put: value getHandle length: self byteSize.
+ ^value
+ !
- length: self byteSize].!







Reply | Threaded
Open this post in threaded view
|

Re: FFI Inbox: FFI-Kernel-nice.119.mcz

Nicolas Cellier


Le lun. 22 juin 2020 à 12:09, Marcel Taeumel <[hidden email]> a écrit :
Hi Nicolas,

If you take the POV of a user of FFI rather than the one of implementer of FFI, you'll see that this is the central object that user may and want to deal with.
> That's our only point of friction I think, that should better be discussed around a beer!

The plenitude of code examples I did already provide on this list is an indicator that I am very much able to take the POV of a user of FFI. :-) I think you are having difficulties to separate public from private interface from my code examples. Sorry for that. I will try to get better.

This change (FFI-Kernel-nice.119) adds too much complexity to the implementation -- it even breaks part of the model that is already there. That's why I disagree.

> I decided to refactor the FFI Plugin because it reached the point to being - incomprehensible - way too complex - impossible to maintain/change

Well, I read that code days ago. While I was unfamiliar with it at first, I quickly understood what is implemented where. Comments where helpful. Combinatorial complexity manageable. The biggest challenge was to learn about compiledSpec and referentClass. So, no, I think you are just unfamiliar with its patterns. No need to refactor it right away if you are just in the learning process.

Maybe Eliot can help here.


argh, we're cross posting again :(
So let me repeat it publicly here.
The marshalling of arguments has to dispatch on both
- the interface type specification
- the actual class of arguments

If we represent it as a matrix, interface spec as rows and actual class as columns, we get the Excel attached.
The Excel itself is not simple, but I really invite you to try and infer the complete picture by yourself and you'll see that it's far from obvious, even if the code reads apparently seemingly!
If you want to answer can this class be passed to this spec, then you have to scan all the successive ifs.
But conditions on interface specs and actual arg class are mixed and scattered at several levels in method call tree.
So once you have the answer for a specific class, you have to restart anew for the next class (or you'll bring false answers)!
It's very close to my definition of brainfuck.
Needless to say that adding one more if to the edifice with a total mastering of all side effects is... like winning at lottery!

The main virtue of the refactoring is to make the dispatching manageable/predictable
The new implementation now dispatches on type specification first.
I have isolated only 6 possible cases that make sense out of the potential 16, hence 6 lines of caseOf:
This cries for more refactoring, because 4 bits for 6 cases is too much (one bit too much), and indeed two bits are exclusively 10 or 01 (atomic+struct)
A type is either atomic or composite (once we classify void * as atomic).

The second level dispatches on the arg class.
There are thus 6 different ffiPassArgument methods, one for each specification row.
We can push the refactoring further and group similar code into its own method, that's only a first step.

Now we can add whatever we want in the matrix without fear of un-managed side effects.

I needed to pass a global variable (int x;) thus an ExternalData by value (to an int).
The global is known through an ExternalData which references the external address provided by the dynamic link mechanism.
We have to dereference this address somewhere.
Unlike UFFI, we have no marshalling at image side, so this cannot be automated.
Letting the responsibility to client code is a no go, that would make FFI more complex than necessary (more complex than C!).
I thus have implemented it in the plugin, which is following our SqueakFFI logic.
But the very first if() would prevent passing an ExternalTypeAlias, as you can see...
I have tried to see what was the minimal possible change that could possibly work, and came to the conclusion: none! I would have broken the spaghetti if even more with even more complex conditions, clearly a no go, it's already beyond human mastery, the master himself (Eliot) included!


> We want to be able to pass a global variable as argument to an external function call 

Well, you disagreed with my proposal to use ExternalData<@F2398FEE, int*> as a representative for a global variable. You claimed that we should use non-pointer types in such external data. Now you propose a lot of changes to make your plan work.

Please, go one step back and reconsider.

If you want to coerce a global var by value, just check for the pointer type and look up the value.

Sigh.

We should really start this discussion afresh. -.-" 

Best,
Marcel

Yes, we only disagree on the embedded type. That's minor, and that's why I've put in the inbox for discussion :)
I have removed some code, and all the tests still pass, so for now, my changes cannot be completely disqualified ;)
please don't be offended :)

I claim that (foo x); must be represented as ExternalData( addressOf(x) , type(foo) ) instead of ExternalData( addressOf(x) , type(foo *) ).
IOW, that describing the type of contents is more useful than describing the type of address.
The extra level of pointer is implied by the class (ExternalData), and since we have no pointer arity implemented yet, it's better to preserve the scarce resource!

Until we correctly decide how to handle pointer arity, this discussion is moot, because the plugin only knows about one level of pointer,
it knows that ExternalData implies pointer, and just checks the atomicType part of the spec...

Since the plugin now wants to pass addressOf(x) as a foo or as a foo*, we cannot have trivial type checking by type identity in both cases anyway.
We'll have to access asNonPointerType or asPointerType. If we have pointer arity in 2 or 3 bits as I suggested, then it 's just a matter of comparing two ints...

I've not made up my mind about it, it's just a gut feeling...
I'm also not sure how much the plugin must be complexified, I'd rather see it simplified!
This should also drive our decisions.
You've put considerable effort at image side, and I'm really happy of how things go, I trust your skills!
We'll probably find common grounds :)

best!

Am 22.06.2020 11:51:25 schrieb Nicolas Cellier <[hidden email]>:

Hi Marcel,
I think we have difficulties to understand each other, while I'm pretty sure that we mostly agree (except on 1 little detail).

I decided to refactor the FFI Plugin because it reached the point to being
- incomprehensible
- way too complex
- impossible to maintain/change

Take a look at the combinatorial on the parameter specification side:
Atomic + pointer + struct + referentClass isNil
That's roughly 16 possibilities

Take a look at the combinatorial of actual arguments:
ByteArray ExternalAddress Alien WordArray immediate values (char int float) nil,true,false
ExternalStructure ExternalAlias ExternalData

Now draw a map of what actual argument you can pass to what specification and what you cannot.
It's the Excel that I sent to you. I had to decipher that sheet from reverse engineering...
Way too complex! We reached the limit and MUST refactor (or die).

So what I'm proposing is essentially a refactoring, and almost a statu quo (except the ones marked new!)
I want to reduce the number of combinations to 6 instead of 16, the 6 that makes sense IMO.
And at the same time, I want to extend the possible actual parameters, and ensure type safety (though it's more for future once we get pointer arity).

The 6 combinations that make sense are:
1) atomic <-> immediate value (or type alias)
2) atomic + referentClass <-> ExternalTypeAlias or ExternalData (new!)
3) atomic pointer <-> ExternalData or direct ByteArray, WordArray, ExternalAddress, Alien (no change, is required for UFFI, Alien etc...) DoubleByte/WordArray (new!)
4) atomic pointer + referentClass <-> ExternalData
5) structure + referentClass <-> ExternalStructure or ExternalData (new!)
6) structure + pointer + referentClass <-> ExternalStructure (new!) or ExternalData

The refactoring makes those 6 possibilities very clear by virtue of #caseOf:
There is one method ffiPassArgument* for each of the 6 possibilities.

What are the essential changes?
1) allow passing an ExternalData when we specified a parameter by value
This is a convenience for supporting global variables.
A global variable is a reference (an ExternalAddress) and a type incarnated in an ExternalData.
We want to be able to pass a global variable as argument to an external function call (whether by value or by reference)
So either the marshalling of objects is performed at image side (see UFFI for example, or somehow DLLCC in VW).
Or it is performed by the plugin itself (the case of SqueakFFI).
You proposed a mixed way via doesNotCoerce:. This can be interesting but more complex IMO (vs UFFI).

2) have a CLEAR encoding of combinations
 That means adding structure + pointer flag to pointer to ExternalStruct (if not atomic type alias).
 You legitimately ask whether it's needed to distinguish atomic+pointer+referentClass from structure+pointer+referentClass
 We might review that. For now, it enables passing an ExternalStruct directly to a struct pointer without resorting to an ExternalData.
  If you further look at the combinations, obviously, we ain't gonna need to flags struct + atomic. They are exclusive. So yes, this refactoring is only a first step to have things clarified. Then we can drive further.

I perfectly understand the importance of ExternalData and how it is central in the FFI and the relations to ExternalType.
I simply disagree on the urge to IMPOSE ExternalData for every interaction with our domain types/objects.
We can expose, but should not impose.
ExternalData can be used both for scalar or arrays. It's conceptually a ValueHolder.
We cannot really differentiate a pointer to a single value or to an array of values... This is the nature of C.
ExternalStructure is hybrid. It acts both as
- an ExternalData (the handle is the same as a scalar ExternalData)
- and as a type surrogate (by name in function interface specification, and via referentClass in the plugin)
If you take the POV of a user of FFI rather than the one of implementer of FFI, you'll see that this is the central object that user may and want to deal with.
That's our only point of friction I think, that should better be discussed around a beer!

cheers

Le lun. 22 juin 2020 à 10:44, Marcel Taeumel <[hidden email]> a écrit :
Let me add that I am really surprised (and a little bit worried) that this little requirement of "wrap alias to atomic into referentClass on return" turned into such a huge proposal of yours.

All that other coercing stuff could easily be added via #doesNotCoerce: as proposed here: 
http://forum.world.st/FFI-Plugin-Proposal-Add-doesNotCoerce-for-like-doesNotUnderstand-td5118724.html

Please, try to understand the relationship between ExternalData and ExternalStructure/Union/TypeAlias. It's so simple. But maybe not so clear. ExternalData is not an implementation detail. It's part of the public interface; it's like Array but as a composition of handle and type. And maybe size and offset -- but that's due to heap memory management part.

Type safety is valuable, of course. Maybe you can give more examples of what you want to achieve. :-)

Best,
Marcel

Am 22.06.2020 10:31:47 schrieb Marcel Taeumel <[hidden email]>:

throw that code away, and have a look at  in VMMakerInbox, you will understand better...

Not so sure ... because I think we do not agree on the status quo yet. We should do that first. Understand the compiledSpec as is. Then move forward.

So hopefully, we shall throw away the FFIFlagStructure and make your life easier at image side :)

Not so sure. See above. 

Best,
Marcel

Am 22.06.2020 10:28:12 schrieb Nicolas Cellier <[hidden email]>:

No, no,
throw that code away, and have a look at  in VMMakerInbox, you will understand better...

In fact, if you read my proposals, I'd like to get rid of FFIFlagStructure altogether...
Either a type is atomic or composite, it's not both nor neither...
So we ain't gonna need 2 flags FFIFlagAtomic and FFIFlagStructure.

So hopefully, we shall throw away the FFIFlagStructure and make your life easier at image side :)

Le lun. 22 juin 2020 à 10:19, Marcel Taeumel <[hidden email]> a écrit :
Hi Nicolas,

sure, there might be a difference. But you have all the information you need directly in the plugin already:



Let me catch up on this later this week.

Best,
Marcel

Am 22.06.2020 09:56:05 schrieb Nicolas Cellier <[hidden email]>:

Hi Marcel,
So you mean that I don't really need to distinguish pointer to struct and pointer to atomic type alias?
Maybe...

There is currently a difference:
- an atomic type alias has an immediate value as handle
  it thus cannot be passed as parameter by reference
  (well, for aliases to pointers, I don't really know...)
- a struct has a memory zone as value (ExternalAddress or direct ByteArray)
 it thus can be passed as parameter by reference without having to resort to an ExternalData.
See ffiPassStructureArgumentByReference: oop Class: oopClass expectedClass: argClass In: calloutState
vs ffiPassAtomicArgumentByReference: oop Class: oopClass expectedClass: argClass In: calloutState


Le lun. 22 juin 2020 à 09:18, Marcel Taeumel <[hidden email]> a écrit :
Hi Nicolas,

thanks! :-) I will take a look at it during this week, I hope. 

Here is a first thought:

I don't think that the pointer types for external structs should have the FFIFlagStructure."referentClass" should be more than enough for the FFI plugin side for both coercing and return-value packaging.

So, -1 for now but maybe I overlooked a use case. Raising this FFIFlagStructure here for such pointer types really messes up a lot of my current conceptual model about the relationship of ExternalStructure and ExternalType/ExternalStructureType. :-)

Why is "referentClass" not enough for the plugin side? Just check for ifNil, if not, instantiate and put instVar 0 to the return value. Done. ;-) For coercing, just compare argument class with "referentClass" in the argType; then check for the pointer flag. Maybe discriminate between ByteArray and ExternalAddress. 

...please don't raise FFIFlagStructure for pointer types for external structures... pretty please ^__^

Best,
Marcel

Am 21.06.2020 22:34:09 schrieb [hidden email] <[hidden email]>:

Nicolas Cellier uploaded a new version of FFI-Kernel to project FFI Inbox:
http://source.squeak.org/FFIinbox/FFI-Kernel-nice.119.mcz

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

Name: FFI-Kernel-nice.119
Author: nice
Time: 21 June 2020, 10:34:00.334284 pm
UUID: 3f2eca9d-8f55-476c-a0b0-c5ed6368a6b4
Ancestors: FFI-Kernel-nice.118

Make the compiledSpecs of struct pointers conform to the experimental FFI branch (thru #adjustPointerType)

See https://github.com/OpenSmalltalk/opensmalltalk-vm/tree/experimental_FFI

Simplify a bit ExternalData access (at: / at:put:).
The assumption that ExternalDataType is the type of the contents and not the type of the reference helps simplifying IMO.

We might want to make it more complete once we deal with pointer arity.
It's not the case yet.

=============== Diff against FFI-Kernel-nice.118 ===============

Item was changed:
----- Method: ExternalData>>at: (in category 'accessing') -----
at: index

- self
- assert: [index = 1 or: [type isAtomic]]
- description: 'Should not read non-atomic pointer as array'.
-
((1 > index) or: [size notNil and: [index > size]])
ifTrue: [^ self errorSubscriptBounds: index].

+ ^ type
- ^ type asNonPointerType
handle: handle
+ at: ((index-1) * type byteSize) + 1!
- at: ((index-1) * type asNonPointerType byteSize) + 1!

Item was changed:
----- Method: ExternalData>>at:put: (in category 'accessing') -----
at: index put: value

- self
- assert: [index = 1 or: [type isAtomic]]
- description: 'Should not read non-atomic pointer as array'.
-
((1 > index) or: [size notNil and: [index > size]])
ifTrue: [^ self errorSubscriptBounds: index].

+ ^ type
- ^ type asNonPointerType
handle: handle
+ at: ((index-1) * type byteSize) + 1
- at: ((index-1) * type asNonPointerType byteSize) + 1
put: value!

Item was changed:
----- Method: ExternalStructure class>>compileAllFields (in category 'system startup') -----
compileAllFields
"
ExternalStructure compileAllFields
"
+ | priorAuthorInitials |
- | priorAuthorInitials fieldSpec |
priorAuthorInitials := Utilities authorInitialsPerSe.
[Utilities setAuthorInitials: 'FFI'.

self allStructuresInCompilationOrder do: [:structClass |
+ | fieldSpec |
fieldSpec := structClass fields.
self flag: #discuss. "mt: Why do we need that extra layout check? Performance gain is minimal..."
(structClass hasFieldLayoutChanged: fieldSpec)
ifTrue: [structClass compileFieldsSilently: fieldSpec].
structClass externalType "asNonPointerType"
compiledSpec: structClass compiledSpec;
+ byteAlignment: structClass byteAlignment;
+ adjustPointerType.
- byteAlignment: structClass byteAlignment.
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: ExternalStructureType>>adjustPointerType (in category 'private') -----
+ adjustPointerType
+ self isPointerType
+ ifFalse: [self asPointerType
+ compiledSpec: (WordArray with: ((self compiledSpec first
+ bitAnd: FFIFlagAtomic + FFIFlagStructure)
+ bitOr: self class pointerSpec));
+ byteAlignment: self class pointerAlignment]!

Item was changed:
----- Method: ExternalType class>>initializeStructureTypes (in category 'class initialization') -----
initializeStructureTypes
"Reset all non-pointer struct types to zero and their pointer companions to the appropriate pointer size."

StructTypes ifNil: [
StructTypes := WeakValueDictionary new].

self cleanupUnusedTypes.

StructTypes valuesDo:[:structType |
structType "asNonPointerType"
compiledSpec: (WordArray with: self structureSpec);
byteAlignment: nil.
structType asPointerType
+ compiledSpec: (WordArray with: self pointerSpec + self structureSpec);
- compiledSpec: (WordArray with: self pointerSpec);
byteAlignment: nil].!

Item was changed:
----- Method: ExternalType>>handle:at: (in category 'external data') -----
handle: handle at: byteOffset
"Read the receiver's external type using the given handle and the byteOffset. This is the dynamic version of #readFieldAt:."

+ | address value |
- | result |
- self checkType.
-
self isPointerType
+ ifTrue:
+ [address := handle pointerAt: byteOffset length: self byteSize.
+ ^ExternalData
+ fromHandle: address
+ type: self asNonPointerType].
+ self isAtomic
+ ifTrue:
+ ["Answer atomic value"
+ value := handle
- ifFalse: [
- "Answer atomic value"
- ^ handle
perform: (AtomicSelectors at: self atomicType)
+ with: byteOffset.
+ ^referentClass ifNil: [value] ifNotNil: [referentClass fromHandle: value]].
+
+ referentClass isNil
+ ifTrue: [self error: 'unknown type'].
+ self isEmpty ifTrue: [self error: 'Empty structure'].
+
+ ^referentClass fromHandle: (handle structAt: byteOffset length: self byteSize)!
- with: byteOffset]
- ifTrue: [
- ^ referentClass
- ifNotNil: [
- "Answer structure, union, or type alias"
- referentClass fromHandle: (handle pointerAt: byteOffset length: self byteSize)]
- ifNil: [
- "Answer wrapper that points to external data"
- result := ExternalData
- fromHandle: (handle pointerAt: byteOffset length: self byteSize)
- type: self.
- self = ExternalType string
- ifTrue: [result fromCString]
- ifFalse: [result]]]!

Item was changed:
----- Method: ExternalType>>handle:at:put: (in category 'external data') -----
handle: handle at: byteOffset put: value
"Write a value using the receiver's external type at the given handle and byteOffset. This is the dynamic version of #writeFieldAt:with:."

- self checkType.
-
self isPointerType
- ifFalse: [ "set atomic value"
- self flag: #addTypeCheck. "mt: Note that there is currently no mapping from objects that represent valid atomics to atomic types."
- handle
- perform: ((AtomicSelectors at: self atomicType), 'put:') asSymbol
- with: byteOffset
- with: value]
ifTrue: [ "set pointer to struct/union/alias"
+ self assert: [value externalType == self asNonPointerType].
- self assert: [value externalType == self].
handle
pointerAt: byteOffset
put: value getHandle
+ length: self byteSize.
+ ^value].
+
+ self isAtomic
+ ifTrue:
+ [ "set atomic value"
+ self flag: #addTypeCheck. "mt: Note that there is currently no mapping from objects that represent valid atomics to atomic types."
+ handle
+ perform: ((AtomicSelectors at: self atomicType), 'put:') asSymbol
+ with: byteOffset
+ with: value.
+ ^value].
+
+ referentClass isNil
+ ifTrue: [self error: 'unknown type'].
+ self isEmpty ifTrue: [self error: 'Empty structure'].
+
+ self assert: [value externalType == self].
+ handle structAt: byteOffset put: value getHandle length: self byteSize.
+ ^value
+ !
- length: self byteSize].!









FFI_type_check.xls (52K) Download Attachment
Reply | Threaded
Open this post in threaded view
|

Re: FFI Inbox: FFI-Kernel-nice.119.mcz

timrowledge


> On 2020-06-22, at 5:58 AM, Nicolas Cellier <[hidden email]> wrote:
>
> argh, we're cross posting again :(

Seems to me that you need to organise a zoom-conference to have some sensibly bidirectional discussions on this. Save you a lot of time...


tim
--
tim Rowledge; [hidden email]; http://www.rowledge.org/tim
Strange OpCodes: SG: Show Garbage