[squeak-dev] The Trunk: System-ar.280.mcz

commits at source.squeak.org commits at source.squeak.org
Sat Mar 6 05:08:12 UTC 2010


Andreas Raab uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-ar.280.mcz

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

Name: System-ar.280
Author: ar
Time: 5 March 2010, 9:07:18.106 pm
UUID: 712ccb92-9a23-a744-b0d7-c06ed872af81
Ancestors: System-ar.279

Avoid dictionary protocol in Smalltalk.

=============== Diff against System-ar.279 ===============

Item was changed:
+ ----- Method: SmalltalkImage>>associationOrUndeclaredAt: (in category 'accessing') -----
+ associationOrUndeclaredAt: aKey
+ 	"DO NOT DEPRECATE - used by binary storage"
+ 	^globals associationOrUndeclaredAt: aKey!
- ----- Method: SmalltalkImage>>associationOrUndeclaredAt: (in category 'dictionary access') -----
- associationOrUndeclaredAt: key 
- 	"return an association or install in undeclared.  Used for mating up ImageSegments."
- 
- 	^ globals associationAt: key ifAbsent: [
- 		Undeclared at: key put: nil.
- 		Undeclared associationAt: key]!

Item was changed:
  ----- Method: SystemOrganizer>>fileOutCategory:on:initializing: (in category 'fileIn/Out') -----
  fileOutCategory: category on: aFileStream initializing: aBool
  	"Store on the file associated with aFileStream, all the traits and classes associated 
  	with the category and any requested shared pools in the right order."
  
  	| first poolSet tempClass classes traits |
  	traits := self orderedTraitsIn: category.
  	classes := self superclassOrder: category.
  	poolSet := Set new.
  	classes do:  [:class | class sharedPools do: [:eachPool | poolSet add: eachPool]].
  	poolSet size > 0 ifTrue: [
  		tempClass := Class new.
  		tempClass shouldFileOutPools ifTrue: [
  			poolSet := poolSet select: [:aPool |
+ 				tempClass shouldFileOutPool: (Smalltalk globals keyAtIdentityValue: aPool)].
- 				tempClass shouldFileOutPool: (Smalltalk keyAtIdentityValue: aPool)].
  			poolSet do: [:aPool | tempClass fileOutPool: aPool onFileStream: aFileStream]]].
  	first := true.
  	traits, classes do: [:each | 
  		first
  			ifTrue: [first := false]
  			ifFalse: [aFileStream cr; nextPut: Character newPage; cr].
  		each
  			fileOutOn: aFileStream
  			moveSource: false
  			toFile: 0
  			initializing: false].
  	aBool ifTrue: [classes do: [:cls | cls fileOutInitializerOn: aFileStream]].!

Item was changed:
+ ----- Method: SmalltalkImage>>associationAt: (in category 'accessing') -----
+ associationAt: aKey
+ 	"DO NOT DEPRECATE - used by ImageSegments"
+ 	^globals associationAt: aKey!
- ----- Method: SmalltalkImage>>associationAt: (in category 'dictionary access') -----
- associationAt: key
- 	"delegate to globals"
- 	^globals associationAt: key!

Item was changed:
+ ----- Method: SmalltalkImage>>bindingOf: (in category 'accessing') -----
+ bindingOf: varName
+ 	"Answer the binding of some variable resolved in the scope of the receiver"
+ 
+ 	^globals bindingOf: varName!
- ----- Method: SmalltalkImage>>bindingOf: (in category 'dictionary access') -----
- bindingOf: aString
- 	"delegate to globals"
- 	^globals bindingOf: aString!

Item was changed:
+ ----- Method: SmalltalkImage>>at:put: (in category 'accessing') -----
- ----- Method: SmalltalkImage>>at:put: (in category 'dictionary access') -----
  at: aKey put: anObject 
  	"Override from Dictionary to check Undeclared and fix up
  	references to undeclared variables."
  	(globals includesKey: aKey) ifFalse: 
  		[globals declare: aKey from: Undeclared.
  		self flushClassNameCache].
  	globals at: aKey put: anObject.
  	^ anObject!

Item was added:
+ ----- Method: SmalltalkImage>>associationDeclareAt: (in category 'accessing') -----
+ associationDeclareAt: aKey
+ 	"DO NOT DEPRECATE - used by ImageSegments"
+ 	^globals associationDeclareAt: aKey!

Item was changed:
+ ----- Method: SmalltalkImage>>at:ifAbsent: (in category 'accessing') -----
- ----- Method: SmalltalkImage>>at:ifAbsent: (in category 'dictionary access') -----
  at: key ifAbsent: aBlock
  	"delegate to globals"
  	^globals at: key ifAbsent: aBlock!

Item was changed:
  ----- Method: SARInstaller class>>basicNewChangeSet: (in category 'change set utilities') -----
  basicNewChangeSet: newName
+ 	Smalltalk at: #ChangesOrganizer ifPresent: [ :cs | ^cs basicNewChangeSet: newName ].
- 	Smalltalk at: #ChangesOrganizer ifPresentAndInMemory: [ :cs | ^cs basicNewChangeSet: newName ].
  	(self changeSetNamed: newName) ifNotNil: [ self inform: 'Sorry that name is already used'. ^nil ].
  	^ChangeSet basicNewNamed: newName.!

Item was changed:
  ----- Method: PseudoClass>>nameExists (in category 'testing') -----
  nameExists
+ 	^Smalltalk globals includesKey: self name asSymbol!
- 	^Smalltalk includesKey: self name asSymbol!

Item was changed:
  ----- Method: SARInstaller class>>changeSetNamed: (in category 'change set utilities') -----
  changeSetNamed: newName
+ 	Smalltalk at: #ChangesOrganizer ifPresent: [ :cs | ^cs changeSetNamed: newName ].
- 	Smalltalk at: #ChangesOrganizer ifPresentAndInMemory: [ :cs | ^cs changeSetNamed: newName ].
  	^ChangeSet allInstances detect: [ :cs | cs name = newName ] ifNone: [ nil ].!

Item was changed:
  ----- Method: ChangeRecord>>methodClass (in category 'access') -----
  methodClass 
  	| methodClass |
  	type == #method ifFalse: [^ nil].
+ 	(Smalltalk globals includesKey: class asSymbol) ifFalse: [^ nil].
- 	(Smalltalk includesKey: class asSymbol) ifFalse: [^ nil].
  	methodClass := Smalltalk at: class asSymbol.
  	meta ifTrue: [^ methodClass class]
  		ifFalse: [^ methodClass]!

Item was changed:
+ ----- Method: SmalltalkImage>>includesKey: (in category 'accessing') -----
- ----- Method: SmalltalkImage>>includesKey: (in category 'dictionary access') -----
  includesKey: key
  	"delegate to globals"
  	^globals includesKey: key!

Item was changed:
  ----- Method: ImageSegment>>prepareToBeSaved (in category 'fileIn/Out') -----
  prepareToBeSaved
  	"Prepare objects in outPointers to be written on the disk.  They must be able to match up with existing objects in their new system.  outPointers is already a copy.
  	Classes are already converted to a DiskProxy.  
  	Associations in outPointers:
  1) in Smalltalk.
  2) in a classPool.
  3) in a shared pool.
  4) A pool dict pointed at directly"
  
  | left myClasses outIndexes |
  myClasses := Set new.
  arrayOfRoots do: [:aRoot | aRoot class class == Metaclass ifTrue: [myClasses add: aRoot]].
  outIndexes := IdentityDictionary new.
  outPointers withIndexDo: [:anOut :ind | | key | 
  	anOut isVariableBinding ifTrue: [
  		(myClasses includes: anOut value)
  			ifFalse: [outIndexes at: anOut put: ind]
+ 			ifTrue: [(Smalltalk globals associationAt: anOut key ifAbsent: [3]) == anOut 
- 			ifTrue: [(Smalltalk associationAt: anOut key ifAbsent: [3]) == anOut 
  				ifTrue: [outPointers at: ind put: 
  					(DiskProxy global: #Smalltalk selector: #associationDeclareAt: 
  						args: (Array with: anOut key))]
  				ifFalse: [outIndexes at: anOut put: ind]
  				]].
  	(anOut isKindOf: Dictionary) ifTrue: ["Pools pointed at directly"
+ 		(key := Smalltalk globals keyAtIdentityValue: anOut ifAbsent: [nil]) ifNotNil: [
- 		(key := Smalltalk keyAtIdentityValue: anOut ifAbsent: [nil]) ifNotNil: [
  			outPointers at: ind put: 
  				(DiskProxy global: key selector: #yourself args: #())]].
  	anOut isMorph ifTrue: [outPointers at: ind put: 
  		(StringMorph contents: anOut printString, ' that was not counted')]
  	].
  left := outIndexes keys asSet.
  left size > 0 ifTrue: ["Globals"
  	(left copy) do: [:assoc |	"stay stable while delete items"
+ 		(Smalltalk globals associationAt: assoc key ifAbsent: [3]) == assoc ifTrue: [
- 		(Smalltalk associationAt: assoc key ifAbsent: [3]) == assoc ifTrue: [
  			outPointers at: (outIndexes at: assoc) put: 
  				(DiskProxy global: #Smalltalk selector: #associationAt: 
  					args: (Array with: assoc key)).
  			left remove: assoc]]].
  left size > 0 ifTrue: ["Class variables"
  	Smalltalk allClassesDo: [:cls | cls classPool size > 0 ifTrue: [
  		(left copy) do: [:assoc |	"stay stable while delete items"
  			(cls classPool associationAt: assoc key ifAbsent: [3]) == assoc ifTrue: [
  				outPointers at: (outIndexes at: assoc) put: 
  					(DiskProxy new global: cls name
  						preSelector: #classPool
  						selector: #associationAt: 
  						args: (Array with: assoc key)).
  				left remove: assoc]]]]].
  left size > 0 ifTrue: ["Pool variables"
+ 	Smalltalk globals associationsDo: [:poolAssoc | | pool |
- 	Smalltalk associationsDo: [:poolAssoc | | pool |
  		poolAssoc value class == Dictionary ifTrue: ["a pool"
  			pool := poolAssoc value.
  			(left copy) do: [:assoc |	"stay stable while delete items"
  				(pool associationAt: assoc key ifAbsent: [3]) == assoc ifTrue: [
  					outPointers at: (outIndexes at: assoc) put: 
  						(DiskProxy global: poolAssoc key selector: #associationAt: 
  							args: (Array with: assoc key)).
  					left remove: assoc]]]]].
  left size > 0 ifTrue: [
  	"If points to class in arrayOfRoots, must deal with it separately"
  	"OK to have obsolete associations that just get moved to the new system"
  	self inform: 'extra associations'.
  	left inspect].
  !

Item was changed:
  ----- Method: SmalltalkImage>>classNamed: (in category 'classes and traits') -----
  classNamed: className 
  	"Answer the global with the given name."
  
+ 	^globals classNamed: className!
- 	^self classOrTraitNamed: className.!

Item was changed:
+ ----- Method: SmalltalkImage>>at: (in category 'accessing') -----
- ----- Method: SmalltalkImage>>at: (in category 'dictionary access') -----
  at: aKey
  	"delegate to globals"
  	^globals at: aKey!

Item was changed:
+ ----- Method: SmalltalkImage>>at:ifPresent: (in category 'accessing') -----
- ----- Method: SmalltalkImage>>at:ifPresent: (in category 'dictionary access') -----
  at: key ifPresent: aBlock
  	"delegate to globals"
  	^globals at: key ifPresent: aBlock!

Item was removed:
- ----- Method: SmalltalkImage>>at:ifPresentAndInMemory: (in category 'dictionary access') -----
- at: key ifPresentAndInMemory: aBlock
- 	"delegate to globals"
- 	^globals at: key ifPresentAndInMemory: aBlock!




More information about the Squeak-dev mailing list