FFI: FFI-Kernel-mt.75.mcz

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

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

Name: FFI-Kernel-mt.75
Author: mt
Time: 27 May 2020, 11:09:51.708317 am
UUID: 53ccac06-63be-844f-b5eb-267645ea78d0
Ancestors: FFI-Kernel-mt.74

Merges start-up logic from ExternalAddress, ExternalObject, and FFIExternalSharedPool (in FFI-Pools) into a single FFIPlatformDescription (which was FFIExternalSharedPoolPlatform from FFI-Pools).

The list of observers is hard-coded in FFIPlatformDescription class >> #startUp: for now.

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

Item was changed:
  ByteArray variableByteSubclass: #ExternalAddress
  instanceVariableNames: ''
  classVariableNames: ''
  poolDictionaries: ''
  category: 'FFI-Kernel'!
- ExternalAddress class
- instanceVariableNames: 'wordSize'!
 
  !ExternalAddress commentStamp: '<historical>' prior: 0!
  An ExternalAddress is an opaque handle to objects outside Smalltalk memory (e.g., a pointer).!
- ExternalAddress class
- instanceVariableNames: 'wordSize'!

Item was added:
+ ----- Method: ExternalAddress class>>allBeNull (in category 'system startup') -----
+ allBeNull
+ "If starting the image afresh all external addresses should be zero."
+
+ self allInstancesDo: [:address | address beNull].!

Item was added:
+ ----- Method: ExternalAddress class>>allBeNullAndResize (in category 'system startup') -----
+ allBeNullAndResize
+ "Null all instances by becomming to new (and hence null) pointers of the platform's current word size."
+
+ | instances wordSize |
+ instances := self allInstances.
+ wordSize := FFIPlatformDescription current wordSize.
+ instances elementsForwardIdentityTo:
+ (instances collect: [:address | self basicNew: wordSize]).!

Item was removed:
- ----- Method: ExternalAddress class>>initialize (in category 'class initialization') -----
- initialize
- wordSize := Smalltalk wordSize!

Item was changed:
  ----- Method: ExternalAddress class>>new (in category 'instance creation') -----
  new
  "External addresses are either four or eight bytes long."
+ ^super new: FFIPlatformDescription current wordSize!
- ^super new: wordSize!

Item was changed:
  ----- Method: ExternalAddress class>>new: (in category 'instance creation') -----
  new: n
  "Only create ExternalAddresses of the right size."
+ ^n = FFIPlatformDescription current wordSize
- ^n = wordSize
  ifTrue: [super new: n]
  ifFalse: [self shouldNotImplement]!

Item was added:
+ ----- Method: ExternalAddress class>>platformChangedFrom:to: (in category 'system startup') -----
+ platformChangedFrom: lastPlatform to: currentPlatform
+
+ lastPlatform wordSize = currentPlatform wordSize
+ ifTrue: [self allBeNull]
+ ifFalse: [self allBeNullAndResize].!

Item was removed:
- ----- Method: ExternalAddress class>>startUp: (in category 'class initialization') -----
- startUp: resuming
- "If starting the image afresh all external addresses should be zero.
- In addition, if the word size has changed then external addresses shoiuld be resized.
- The two steps are combined for efficiency."
- resuming ifTrue:
- [| instances |
- instances := self allInstances.
- wordSize ~= Smalltalk wordSize
- ifTrue: "Implement nulling by becomming all existing instances to new (and hence null) pointers of the right size."
- [wordSize := Smalltalk wordSize.
- instances elementsForwardIdentityTo: (instances collect: [:ea| self basicNew: wordSize])]
- ifFalse:
- [instances do: [:addr| addr beNull]]]!

Item was removed:
- ----- Method: ExternalAddress class>>wordSize (in category 'accessing') -----
- wordSize
- ^wordSize!

Item was removed:
- ----- Method: ExternalObject class>>initialize (in category 'class initialization') -----
- initialize
- "ExternalObject initialize"
- (Smalltalk classNamed: #SessionManager)
- ifNotNil: [:sessionManagerClass|
- sessionManagerClass default
- registerSystemClassNamed: self name
- atPriority: 60]
- ifNil: [Smalltalk addToStartUpList: self after: (Smalltalk classNamed: #ShortRunArray)]. !

Item was changed:
  ----- Method: ExternalObject class>>install (in category 'system startup') -----
  install
  "Notify all instances of the receiver that we're coming up on a new platform.
  Note: The default implementation does nothing since the general external
+ objects are cleaned up by ExternalAddress>>platformChangedFrom:to: but subclasses may
- objects are cleaned up by ExternalAddress>>startUp: but subclasses may
  implement this method so that the appropriate action for existing instances can
  be taken."!

Item was added:
+ ----- Method: ExternalObject class>>platformChangedFrom:to: (in category 'system startup') -----
+ platformChangedFrom: lastPlatform to: currentPlatform
+ "The system is coming up on a new platform. Clear out the existing handles."
+ self installSubclasses.!

Item was removed:
- ----- Method: ExternalObject class>>startUp: (in category 'system startup') -----
- startUp: resuming
- "The system is coming up. If it is on a new platform, clear out the existing handles."
- ExternalAddress startUp: resuming. "Make sure handles are invalid"
- resuming ifTrue:[self installSubclasses].
- !

Item was changed:
  ----- Method: ExternalStructure class>>install (in category 'system startup') -----
  install
+ "Resume the system on a new platform. Recompile all structures to accound for different word size etc."
+
+ self recompileStructures.!
- "Resuming the image on another architecture may require a re-compilation of structure layout."
- | newPlatform |
- newPlatform := Smalltalk platformName.
- PreviousPlatform = newPlatform
- ifFalse:
- [self recompileStructures.
- PreviousPlatform := newPlatform]!

Item was added:
+ Object subclass: #FFIPlatformDescription
+ instanceVariableNames: 'name osVersion subtype wordSize'
+ classVariableNames: 'LastPlatform'
+ poolDictionaries: ''
+ category: 'FFI-Kernel'!
+
+ !FFIPlatformDescription commentStamp: 'monty 4/1/2018 12:02' prior: 0!
+ This class stores the platform information for an FFIExternalSharedPool and supports testing instances for platform compatibility and specificity.!

Item was added:
+ ----- Method: FFIPlatformDescription class>>current (in category 'instance creation') -----
+ current
+
+ ^ LastPlatform ifNil: [LastPlatform := self newCurrent]!

Item was added:
+ ----- Method: FFIPlatformDescription class>>currentName (in category 'accessing') -----
+ currentName
+ "self currentName"
+
+ ^ Smalltalk os platformName!

Item was added:
+ ----- Method: FFIPlatformDescription class>>currentOSVersion (in category 'accessing') -----
+ currentOSVersion
+ "self currentOSVersion"
+
+ ^ Smalltalk osVersion!

Item was added:
+ ----- Method: FFIPlatformDescription class>>currentSubtype (in category 'accessing') -----
+ currentSubtype
+ "self currentSubtype"
+
+ ^ Smalltalk os platformSubtype!

Item was added:
+ ----- Method: FFIPlatformDescription class>>currentWordSize (in category 'accessing') -----
+ currentWordSize
+ "self currentWordSize"
+
+ ^ Smalltalk wordSize!

Item was added:
+ ----- Method: FFIPlatformDescription class>>empty (in category 'instance creation') -----
+ empty
+ ^ self new!

Item was added:
+ ----- Method: FFIPlatformDescription class>>initialize (in category 'class initialization') -----
+ initialize
+ "
+ FFIPlatformDescription initialize
+ "
+ Smalltalk addToStartUpList: self after: (Smalltalk classNamed: #ShortRunArray).!

Item was added:
+ ----- Method: FFIPlatformDescription class>>isCurrentPlatformWindows (in category 'testing') -----
+ isCurrentPlatformWindows
+ ^ self isWindowsPlatformName: self currentName!

Item was added:
+ ----- Method: FFIPlatformDescription class>>isWindowsPlatformName: (in category 'private') -----
+ isWindowsPlatformName: aPlatformName
+ ^ aPlatformName asLowercase beginsWith: 'win'!

Item was added:
+ ----- Method: FFIPlatformDescription class>>name: (in category 'instance creation') -----
+ name: aName
+ ^ self new name: aName!

Item was added:
+ ----- Method: FFIPlatformDescription class>>name:osVersion: (in category 'instance creation') -----
+ name: aName osVersion: anOSVersionString
+ ^ self new
+ name: aName;
+ osVersion: anOSVersionString!

Item was added:
+ ----- Method: FFIPlatformDescription class>>name:osVersion:subtype: (in category 'instance creation') -----
+ name: aName osVersion: anOSVersionString subtype: aSubtypeString
+ ^ self new
+ name: aName;
+ osVersion: anOSVersionString;
+ subtype: aSubtypeString!

Item was added:
+ ----- Method: FFIPlatformDescription class>>name:osVersion:subtype:wordSize: (in category 'instance creation') -----
+ name: aName osVersion: anOSVersionString subtype: aSubtypeString wordSize: aWordSize
+ ^ self new
+ name: aName;
+ osVersion: anOSVersionString;
+ subtype: aSubtypeString;
+ wordSize: aWordSize!

Item was added:
+ ----- Method: FFIPlatformDescription class>>name:wordSize: (in category 'instance creation') -----
+ name: aName wordSize: aWordSize
+ ^ self new
+ name: aName;
+ wordSize: aWordSize!

Item was added:
+ ----- Method: FFIPlatformDescription class>>newCurrent (in category 'instance creation') -----
+ newCurrent
+
+ ^ self
+ name: self currentName
+ osVersion: self currentOSVersion
+ subtype: self currentSubtype
+ wordSize: self currentWordSize!

Item was added:
+ ----- Method: FFIPlatformDescription class>>startUp: (in category 'system startup') -----
+ startUp: resuming
+ "Notify all FFI classes about platform changes."
+
+ resuming ifTrue: [
+ LastPlatform in: [:lastPlatform | self newCurrent in: [:currentPlatform |
+ lastPlatform = currentPlatform
+ ifTrue: [
+ self flag: #discuss. "mt: Maybe add #platformResuming?"
+ ExternalAddress allBeNull]
+ ifFalse: [
+ LastPlatform := currentPlatform. "Update now. See #current."
+ self flag: #discuss. "mt: Maybe directly call ExternalStructure?"
+ { ExternalAddress. ExternalObject. FFIExternalSharedPool }
+ do: [:cls | cls
+ platformChangedFrom: lastPlatform
+ to: currentPlatform] ]]] ].!

Item was added:
+ ----- Method: FFIPlatformDescription class>>unload (in category 'class initialization') -----
+ unload
+
+ Smalltalk removeFromStartUpList: self.!

Item was added:
+ ----- Method: FFIPlatformDescription>>= (in category 'comparing') -----
+ = anObject
+ self == anObject
+ ifTrue: [^ true].
+
+ self species == anObject species
+ ifFalse: [^ false].
+
+ ^ self name = anObject name
+ and: [self osVersion = anObject osVersion
+ and: [self subtype = anObject subtype
+ and: [self wordSize = anObject wordSize]]].!

Item was added:
+ ----- Method: FFIPlatformDescription>>hasName (in category 'testing') -----
+ hasName
+ ^ self name notEmpty!

Item was added:
+ ----- Method: FFIPlatformDescription>>hasOSVersion (in category 'testing') -----
+ hasOSVersion
+ ^ self osVersion notEmpty!

Item was added:
+ ----- Method: FFIPlatformDescription>>hasSubtype (in category 'testing') -----
+ hasSubtype
+ ^ self subtype notEmpty!

Item was added:
+ ----- Method: FFIPlatformDescription>>hasWordSize (in category 'testing') -----
+ hasWordSize
+ ^ self wordSize notNil!

Item was added:
+ ----- Method: FFIPlatformDescription>>hash (in category 'comparing') -----
+ hash
+ ^ (((self species hash bitXor:
+ self name hash) bitXor:
+ self osVersion hash) bitXor:
+ self subtype hash) bitXor:
+ self wordSize hash!

Item was added:
+ ----- Method: FFIPlatformDescription>>isCompatibleWith: (in category 'testing') -----
+ isCompatibleWith: aPlatform
+ self == aPlatform
+ ifTrue: [^ true].
+
+ (self name = aPlatform name
+ or: [self hasName not
+ or: [aPlatform hasName not]])
+ ifFalse: [^ false].
+
+ (self osVersion = aPlatform osVersion
+ or: [self hasOSVersion not
+ or: [aPlatform hasOSVersion not]])
+ ifFalse: [^ false].
+
+ (self subtype = aPlatform subtype
+ or: [self hasSubtype not
+ or: [aPlatform hasSubtype not]])
+ ifFalse: [^ false].
+
+ (self wordSize = aPlatform wordSize
+ or: [self hasWordSize not
+ or: [aPlatform hasWordSize not]])
+ ifFalse: [^ false].
+
+ ^ true.!

Item was added:
+ ----- Method: FFIPlatformDescription>>isMoreSpecificThan: (in category 'testing') -----
+ isMoreSpecificThan: aPlatform
+ self == aPlatform
+ ifTrue: [^ false].
+
+ (self hasName
+ and: [aPlatform hasName not])
+ ifTrue: [^ true].
+
+ (self hasOSVersion
+ and: [aPlatform hasOSVersion not])
+ ifTrue: [^ true].
+
+ (self hasSubtype
+ and: [aPlatform hasSubtype not])
+ ifTrue: [^ true].
+
+ (self hasWordSize
+ and: [aPlatform hasWordSize not])
+ ifTrue: [^ true].
+
+ ^ false.!

Item was added:
+ ----- Method: FFIPlatformDescription>>isWindows (in category 'testing') -----
+ isWindows
+ ^ self class isWindowsPlatformName: self name!

Item was added:
+ ----- Method: FFIPlatformDescription>>name (in category 'accessing') -----
+ name
+ ^ name ifNil: [name := '']!

Item was added:
+ ----- Method: FFIPlatformDescription>>name: (in category 'accessing') -----
+ name: aName
+ name := aName!

Item was added:
+ ----- Method: FFIPlatformDescription>>osVersion (in category 'accessing') -----
+ osVersion
+ ^ osVersion ifNil: [osVersion := '']!

Item was added:
+ ----- Method: FFIPlatformDescription>>osVersion: (in category 'accessing') -----
+ osVersion: anOSVersionString
+ osVersion := anOSVersionString!

Item was added:
+ ----- Method: FFIPlatformDescription>>printOn: (in category 'printing') -----
+ printOn: aStream
+ self storeOn: aStream!

Item was added:
+ ----- Method: FFIPlatformDescription>>storeOn: (in category 'printing') -----
+ storeOn: aStream
+ aStream
+ nextPut: $(;
+ nextPutAll: self class name asString;
+ nextPutAll: ' name: ';
+ print: self name;
+ nextPutAll: ' osVersion: ';
+ print: self osVersion;
+ nextPutAll: ' subtype: ';
+ print: self subtype;
+ nextPutAll: ' wordSize: ';
+ print: self wordSize;
+ nextPut: $).!

Item was added:
+ ----- Method: FFIPlatformDescription>>subtype (in category 'accessing') -----
+ subtype
+ ^ subtype ifNil: [subtype := '']!

Item was added:
+ ----- Method: FFIPlatformDescription>>subtype: (in category 'accessing') -----
+ subtype: aSubtypeString
+ subtype := aSubtypeString!

Item was added:
+ ----- Method: FFIPlatformDescription>>wordSize (in category 'accessing') -----
+ wordSize
+ ^ wordSize!

Item was added:
+ ----- Method: FFIPlatformDescription>>wordSize: (in category 'accessing') -----
+ wordSize: aWordSize
+ wordSize := aWordSize!

Item was added:
+ (PackageInfo named: 'FFI-Kernel') postscript: 'Smalltalk removeFromStartUpList: ExternalAddress.
+ Smalltalk removeFromStartUpList: ExternalObject.'!