[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
|