FFI: FFI-Kernel-mt.139.mcz

Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI:
http://source.squeak.org/FFI/FFI-Kernel-mt.139.mcz

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

Name: FFI-Kernel-mt.139
Author: mt
Time: 7 May 2021, 11:39:01.650725 am
UUID: 1b17c0aa-8b78-9e4c-80fe-614726687a6c
Ancestors: FFI-Kernel-mt.138

Clean up NUL-terminated CString processing in ExternalData. Allow clients to do that only explicitely via #fromCString(s) if #allowDetectForUnknownSize preference is enabled. Automatic processing moved over to "FFI-Tools" and even then it remains dangerous.

Fixes small glitch in housekeeping for array types (#noticeModificationOf:).

Fixes a small regression by ingoring the #doneCompiling call on ExternalData.

=============== Diff against FFI-Kernel-mt.138 ===============

Item was changed:
  ExternalStructure subclass: #ExternalData
  instanceVariableNames: 'type size'
+ classVariableNames: 'AllowDetectForUnknownSize'
- classVariableNames: ''
  poolDictionaries: ''
  category: 'FFI-Kernel'!
 
  !ExternalData commentStamp: 'mt 6/13/2020 17:26' prior: 0!
  Instances of ExternalData explicitly describe objects with associated type. They can be used for describing atomic C types like arrays of atomic types (e.g., 'int[]') or pointer to atomic types (e.g., 'int *').
 
  Instance variables:
  type <ExternalType> The external type of the receiver. Always a pointer type.
 
  The encoding of type is equivalent to that of the basic type in class ExternalType. The interpretation of whether the receiver describes an array of data or a pointer to data depends on the contents of the instance variable 'handle'. If handle contains an ExternalAddress the receiver is treated as pointer to type. If the handle contains a ByteArray the receiver is interpreted as describing an array of type. Note that both interpretations are treated equivalent in external calls, e.g., if one describes an argument to an external call as taking 'int*' then, depending on the type of handle either the actual contents (if ExternalAddress) or a pointer to the contents (if ByteArray) is passed.
 
  !

Item was added:
+ ----- Method: ExternalData class>>allowDetectForUnknownSize (in category 'preferences') -----
+ allowDetectForUnknownSize
+ <preference: 'Allow #detect:ifFound: for unknown size'
+ categoryList: #('FFI Kernel')
+ description: 'When true, does not fail when calling #detect:ifFound: on external data with unknown size. This can be used to read NUL-terminated C strings, for example. CAN BE DANGEROUS!!'
+ type: #Boolean>
+ ^AllowDetectForUnknownSize ifNil: [true]!

Item was added:
+ ----- Method: ExternalData class>>allowDetectForUnknownSize: (in category 'preferences') -----
+ allowDetectForUnknownSize: aBoolean
+
+ AllowDetectForUnknownSize := aBoolean.!

Item was added:
+ ----- Method: ExternalData class>>allowDetectForUnknownSizeDuring: (in category 'preferences') -----
+ allowDetectForUnknownSizeDuring: aBlock
+
+ | priorValue |
+ priorValue := AllowDetectForUnknownSize.
+ AllowDetectForUnknownSize := true.
+ aBlock ensure: [AllowDetectForUnknownSize := priorValue].!

Item was added:
+ ----- Method: ExternalData class>>doneCompiling (in category 'class management') -----
+ doneCompiling
+ "Nevermind here."!

Item was added:
+ ----- Method: ExternalData>>detect:ifFound: (in category 'enumerating') -----
+ detect: aBlock ifFound: foundBlock
+ "DANGEROUS for unknown size!!"
+
+ self class allowDetectForUnknownSize
+ ifFalse: [self sizeCheck].
+
+ size
+ ifNotNil: [
+ self detect: aBlock ifFound: foundBlock ifNone: nil]
+ ifNil: [ | index each |
+ index := 1.
+ [each := self at: index.
+ (aBlock value: each)
+ ifTrue: [^ foundBlock value: each]
+ ifFalse: [index := index + 1. false]]
+ whileFalse].!

Item was added:
+ ----- Method: ExternalData>>detect:ifFound:ifNone: (in category 'enumerating') -----
+ detect: aBlock ifFound: foundBlock ifNone: exceptionBlock
+
+ self sizeCheck.
+ self do: [:each | (aBlock value: each) ifTrue: [^ foundBlock value: each]].
+ ^ exceptionBlock value!

Item was added:
+ ----- Method: ExternalData>>detect:ifNone: (in category 'enumerating') -----
+ detect: aBlock ifNone: exceptionBlock
+
+ ^ self
+ detect: aBlock
+ ifFound: [:element | element]
+ ifNone: exceptionBlock!

Item was changed:
  ----- Method: ExternalData>>fromCString (in category 'converting - support') -----
  fromCString
+ "Read a NUL-terminated string"
- "Assume that the receiver represents a C string and convert it to a Smalltalk string. hg 2/25/2000 14:18"
 
- | stream index char |
  self
+ assert: [self mightBeCString]
- assert: [self containerType = ExternalType string]
  description: 'Wrong content type'.
+
+ ^ String streamContents: [:stream |
+ self
+ detect: [:char |
+ char == Character null ifTrue: [true] ifFalse: [
+ stream nextPut: char.
+ false]]
+ ifFound: [:char | "finished"]]!
-
- stream := WriteStream on: String new.
- index := 1.
- [(char := self at: index) = 0 asCharacter] whileFalse: [
- stream nextPut: char.
- index := index + 1].
- ^stream contents!

Item was changed:
  ----- Method: ExternalData>>fromCStrings (in category 'converting - support') -----
+ fromCStrings
+ "Read a list of double-null terminated strings.
+
+ https://devblogs.microsoft.com/oldnewthing/20110511-00/?p=10693
+ http://web.archive.org/web/20100103003417/http://blogs.msdn.com/oldnewthing/archive/2009/10/08/9904646.aspx"
- fromCStrings
- "Assume that the receiver represents a set of C strings and is teerminated by a empty string and convert it to a Smalltalk ordered collection of strings"
 
+ self
+ assert: [self mightBeCString]
+ description: 'Wrong content type'.
+
+ ^ Array streamContents: [:list | String streamContents: [:element |
+ | lastChar |
+ lastChar := nil.
+ self
+ detect: [:char |
+ (lastChar == Character null and: [char == Character null])
+ ifTrue: [true] ifFalse: [
+ char == Character null
+ ifTrue: [
+ list nextPut: element contents.
+ element reset]
+ ifFalse: [
+ element nextPut: char].
+ lastChar := char. false]]
+ ifFound: [:char | "finished"]]].!
- | stream index char strings str |
- type isPointerType ifFalse: [self error: 'External object is not a pointer type.'].
- self flag: #bogus. "mt: This format seems to be rather specific to some library. There would normally be pointers to pointers for such a structure. Or does the C standard mention such a format somehow? 'abcd\0efg\0hijklmnopq\0rstuvwxyz\0\0' ??? "
- strings := OrderedCollection new.
- index := 1.
- [
- stream := WriteStream on: String new.
- [(char := handle unsignedCharAt: index) = 0 asCharacter]
- whileFalse: [
- stream nextPut: char.
- index := index + 1
- ].
- str := stream contents.
- strings addLast: str.
- str size = 0
- ] whileFalse.
- ^strings!

Item was added:
+ ----- Method: ExternalData>>mightBeCString (in category 'testing') -----
+ mightBeCString
+
+ self
+ assert: [(ExternalType char asArrayType: 1) asPointerType ~= ExternalType char asPointerType]
+ description: 'Unexpected reuse of pointer type char* for both atomic type and array type!!'.
+
+ ^ type = ExternalType string "char*"!

Item was changed:
  ----- Method: ExternalType class>>noticeModificationOf: (in category 'housekeeping') -----
  noticeModificationOf: aClass
  "A subclass of ExternalStructure has been redefined.
  Clean out any obsolete references to its type."
 
  aClass withAllSubclassesDo: [:cls | | typeName |
  typeName := cls name.
  (StructTypes at: typeName ifAbsent: [])
  ifNotNil: [:type |
  type newReferentClass: cls.
  type asPointerType newReferentClass: cls].
  ArrayTypes keysAndValuesDo: [:nameSpec :arrayType |
+ arrayType ifNotNil: [
+ nameSpec key = typeName "content type" ifTrue: [
+ arrayType newReferentClass: cls.
+ arrayType asPointerType newReferentClass: cls]]]]!
- nameSpec key = typeName "content type" ifTrue: [
- arrayType newReferentClass: cls.
- arrayType asPointerType newReferentClass: cls]]]!

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:."
 
- | result |
  self checkType.
 
  self isPointerType
  ifFalse: [
  "Answer atomic value"
  ^ handle
  perform: (AtomicSelectors at: self atomicType)
  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, unknown size (i.e. number of elements)"
+ ExternalData
- "Answer wrapper that points to external data"
- result := ExternalData
  fromHandle: (handle pointerAt: byteOffset length: self byteSize)
+ type: self ]]!
- type: self.
- self = ExternalType string
- ifTrue: [result fromCString]
- ifFalse: [result]]]!

Item was changed:
  ----- Method: ExternalType>>readAlias (in category 'external structure') -----
  readAlias
 
  self checkType.
 
  ^ String streamContents: [:s |
  self isPointerType
  ifFalse: [
  "this is an aliased atomic, non-pointer type"
  s nextPutAll: '^handle "', self writeFieldArgName, '"']
  ifTrue: [
  referentClass
  ifNotNil: [
  "this is an aliased pointer to a structure, union, or type alias"
  s nextPutAll:'^', referentClass name,' fromHandle: handle asExternalPointer']
  ifNil: [
  "this is an aliased pointer to external data"
+ s nextPutAll: '^ ExternalData fromHandle: handle'.
- | shouldReadCString |
- (shouldReadCString := self = ExternalType string)
- ifTrue: [s nextPutAll: '^(']
- ifFalse: [s nextPutAll: '^'].
- s nextPutAll: 'ExternalData fromHandle: handle'.
  self isPointerType ifTrue:[s nextPutAll:' asExternalPointer'].
  s nextPutAll:' type: '.
+ s nextPutAll: self asPointerType storeString]]]!
- shouldReadCString
- ifTrue: [s nextPutAll: 'ExternalType string) fromCString']
- ifFalse: [s nextPutAll: self asPointerType storeString]]]]!

Item was changed:
  ----- Method: ExternalType>>readFieldAt: (in category 'external structure') -----
  readFieldAt: byteOffset
  "Answer a string defining the accessor to an entity of the receiver type starting at the given byte offset.
  Private. Used for field definition only."
 
  self checkType.
 
  ^ String streamContents: [:s |
 
  self isPointerType
  ifFalse: [
  "Atomic value"
  s nextPutAll:'^handle ';
  nextPutAll: (AtomicSelectors at: self atomicType);
  space; print: byteOffset]
  ifTrue: [
- | shouldReadCString |
- shouldReadCString := self = ExternalType string.
  referentClass
  ifNotNil: [
  "Pointer to structure, union, or type alias"
  s nextPutAll: '^';
  print: referentClass;
  nextPutAll: ' fromHandle: (handle pointerAt: ';
  print: byteOffset;
  nextPutAll: ' length: ';
  print: self byteSize;
  nextPut: $)]
  ifNil: [
  "Pointer to external data"
+ s nextPutAll: '^ ExternalData fromHandle: (handle pointerAt: ';
- shouldReadCString
- ifTrue: [s nextPutAll: '^(']
- ifFalse: [s nextPutAll: '^'].
- s nextPutAll: 'ExternalData fromHandle: (handle pointerAt: ';
  print: byteOffset;
  nextPutAll: ' length: ';
  print: self byteSize;
+ nextPutAll: ') type: ExternalType ';
+ nextPutAll: self atomicTypeName]]].!
- nextPutAll: ') type: ExternalType '.
- shouldReadCString
- ifTrue:
- [s nextPutAll: 'string) fromCString']
- ifFalse:
- [s nextPutAll: self atomicTypeName;
- nextPutAll: ' asPointerType']]]].!

Item was changed:
  ----- Method: ExternalType>>writeFieldArgName (in category 'external structure') -----
  writeFieldArgName
 
  ^ self isPointerType
  ifFalse: [
  self atomicTypeName caseOf: {
  ['bool'] -> ['aBoolean'].
  ['char'] -> ['aCharacter'].
  ['schar'] -> ['aCharacter'].
  ['float'] -> ['aFloat'].
  ['double'] -> ['aFloat'].
  } otherwise: ['anInteger']]
  ifTrue: [
  referentClass
  ifNotNil: ['a',referentClass name]
+ ifNil: ['externalData']]!
- ifNil: [
- self = ExternalType string
- ifTrue: ['externalCStringData']
- ifFalse: ['externalData']]]!