[squeak-dev] FFI: FFI-Kernel-mt.75.mcz

commits at source.squeak.org commits at source.squeak.org
Wed May 27 09:09:52 UTC 2020


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.'!



More information about the Squeak-dev mailing list