The Trunk: System-ar.280.mcz

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!