[squeak-dev] The Trunk: System-cwp.663.mczcommits at source.squeak.org commits at source.squeak.orgSat Jan 18 15:50:02 UTC 2014
Colin Putney uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-cwp.663.mcz ==================== Summary ==================== Name: System-cwp.663 Author: cwp Time: 18 January 2014, 10:48:09.728 am UUID: f3f0e545-2d39-4f63-aa7e-311e81892dfd Ancestors: System-cmm.662 Remove direct references to Undeclared and route through the appropriate environment. Flag methods that need to be made environment-aware. =============== Diff against System-cmm.662 =============== Item was changed: ----- Method: Association>>objectForDataStream: (in category '*System-Object Storage-objects from disk') ----- objectForDataStream: refStrm | dp | "I am about to be written on an object file. If I am a known global, write a proxy that will hook up with the same resource in the destination system." + self flag: #environments. ^ (Smalltalk globals associationAt: key ifAbsent: [nil]) == self ifTrue: [dp := DiskProxy global: #Smalltalk selector: #associationOrUndeclaredAt: args: (Array with: key). refStrm replace: self with: dp. dp] ifFalse: [self]! Item was changed: ----- Method: DiskProxy>>comeFullyUpOnReload: (in category 'i/o') ----- comeFullyUpOnReload: smartRefStream "Internalize myself into a fully alive object after raw loading from a DataStream. (See my class comment.) DataStream will substitute the object from this eval for the DiskProxy." | globalObj symbol pr nn arrayIndex | + self flag: #environments. symbol := globalObjectName. "See if class is mapped to another name" (smartRefStream respondsTo: #renamed) ifTrue: [ "If in outPointers in an ImageSegment, remember original class name. See mapClass:installIn:. Would be lost otherwise." ((thisContext sender sender sender sender sender sender sender sender receiver class == ImageSegment) and: [ thisContext sender sender sender sender method == (DataStream compiledMethodAt: #readArray)]) ifTrue: [ arrayIndex := (thisContext sender sender sender sender) tempAt: 4. "index var in readArray. Later safer to find i on stack of context." smartRefStream renamedConv at: arrayIndex put: symbol]. "save original name" symbol := smartRefStream renamed at: symbol ifAbsent: [symbol]]. "map" globalObj := Smalltalk at: symbol ifAbsent: [ preSelector == nil & (constructorSelector = #yourself) ifTrue: [ Transcript cr; show: symbol, ' is undeclared.'. (Undeclared includesKey: symbol) ifTrue: [^ Undeclared at: symbol]. Undeclared at: symbol put: nil. ^ nil]. ^ self error: 'Global "', symbol, '" not found']. ((symbol == #World) and: [Smalltalk isMorphic not]) ifTrue: [ self inform: 'These objects will work better if opened in a Morphic World. Dismiss and reopen all menus.']. preSelector ifNotNil: [ Symbol hasInterned: preSelector ifTrue: [:selector | [globalObj := globalObj perform: selector] on: Error do: [:ex | ex messageText = 'key not found' ifTrue: [^ nil]. ^ ex signal]] ]. symbol == #Project ifTrue: [ (constructorSelector = #fromUrl:) ifTrue: [ nn := (constructorArgs first findTokens: '/') last. nn := (nn findTokens: '.|') first. pr := Project named: nn. ^ pr ifNil: [self] ifNotNil: [pr]]. pr := globalObj perform: constructorSelector withArguments: constructorArgs. ^ pr ifNil: [self] ifNotNil: [pr]]. "keep the Proxy if Project does not exist" constructorSelector ifNil: [^ globalObj]. Symbol hasInterned: constructorSelector ifTrue: [:selector | [^ globalObj perform: selector withArguments: constructorArgs] on: Error do: [:ex | ex messageText = 'key not found' ifTrue: [^ nil]. ^ ex signal] ]. "args not checked against Renamed" ^ nil "was not in proper form"! 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 | + self flag: #environments. 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: [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: [ 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: [ 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 | 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: ObjectScanner>>rename:toBe: (in category 'utilities') ----- rename: existingName toBe: newName "See if there is a conflict between what the fileIn wants to call the new UniClass (Player23) and what already exists for another unique instance. If conflict, make a class variable to intercept the existingName and direct it to class newName." + self flag: #environments. existingName = newName ifFalse: [ self class ensureClassPool. "create the dictionary" "can't use addClassVarName: because it checks for conflicts with Smalltalk" (self class classPool includesKey: existingName) ifFalse: ["Pick up any refs in Undeclared" self class classPool declare: existingName from: Undeclared]. self class classPool at: existingName put: (Smalltalk at: newName). pvt3SmartRefStrm renamed at: existingName put: newName]! Item was changed: ----- Method: SmalltalkImage class>>cleanUp (in category 'class initialization') ----- cleanUp "Flush caches" - Smalltalk flushClassNameCache. - Undeclared removeUnreferencedKeys. Smalltalk removeObsoleteClassesFromCompactClassesArray! Item was changed: ----- Method: SmalltalkImage>>associationDeclareAt: (in category 'dictionary access') ----- associationDeclareAt: aKey "DO NOT DEPRECATE - used by ImageSegments" + self flag: #environments. - ^globals associationDeclareAt: aKey! Item was changed: ----- Method: SmalltalkImage>>cleanOutUndeclared (in category 'housekeeping') ----- cleanOutUndeclared + "This should be deprecated, and senders rewritten to deal with environments directly" + self flag: #environments. + + globals purgeUndeclared.! - globals undeclared removeUnreferencedKeys! Item was changed: ----- Method: SystemDictionary>>associationOrUndeclaredAt: (in category 'dictionary access') ----- associationOrUndeclaredAt: key "return an association or install in undeclared. Used for mating up ImageSegments." + self flag: #environments. ^ self associationAt: key ifAbsent: [ Undeclared at: key put: nil. Undeclared associationAt: key]! Item was changed: ----- Method: SystemNavigation>>methodsWithUnboundGlobals (in category 'query') ----- methodsWithUnboundGlobals "Get all methods that use undeclared global objects that are not listed in Undeclared. For a clean image the result should be empty." "SystemNavigation new methodsWithUnboundGlobals" + self flag: #environments. + - ^self allSelect: [:m| m literals anySatisfy: [:l| l isVariableBinding and: [l key isSymbol "avoid class-side methodClass literals" and: [(m methodClass bindingOf: l key) ifNil: [(Undeclared associationAt: l key ifAbsent: []) ~~ l] ifNotNil: [:b| b ~~ l]]]]]! Item was changed: Object subclass: #Utilities instanceVariableNames: '' + classVariableNames: 'AuthorInitials AuthorName CommonRequestStrings LastStats ScrapsBook' - classVariableNames: 'AuthorInitials AuthorName CommonRequestStrings LastStats' poolDictionaries: '' category: 'System-Support'! !Utilities commentStamp: '<historical>' prior: 0! A repository for general and miscellaneous utilities; much of what is here are in effect global methods that don't naturally attach to anything else. 1/96 sw!
More information about the Squeak-dev mailing list |