Chris Muller uploaded a new version of Monticello to project The Trunk: http://source.squeak.org/trunk/Monticello-cmm.561.mcz
==================== Summary ====================
Name: Monticello-cmm.561 Author: cmm Time: 16 August 2013, 3:02:36.937 pm UUID: ccf0e287-93b4-427f-ae5a-dafb4b86d1b8 Ancestors: Monticello-cmm.560
- If an ancestry is already trimmed with a proxy, don't wrap that proxy in yet another proxy if the user invokes flush twice in a row. - Allow flushing of versions without flushing ancestry. - Fix stubbing of merged packages. - Renamed MCWorkingCopyBrowser>>#flushAllCaches to #flushCachedVersions to match what it does.
=============== Diff against Monticello-cmm.560 ===============
Item was added: + ----- Method: MCAncestry>>isMCInfoProxy (in category 'testing') ----- + isMCInfoProxy + ^ false!
Item was changed: ----- Method: MCAncestry>>stubAncestryFor:using: (in category 'initialize-release') ----- + stubAncestryFor: aMCWorkingCopy using: aMCRepository - stubAncestryFor: childInfo using: aMCRepository "childInfo was retrieved from aMCRepository. Replace my ancestry with a Proxy that can retrieve the full tree from these two elements." ancestors := ancestors collect: + [ : each | each isMCInfoProxy + ifTrue: [ each ] + ifFalse: + [ MCInfoProxy + info: each copyWithTrimmedAncestry + workingCopy: aMCWorkingCopy + repository: aMCRepository ] ]. - [ : each | MCInfoProxy - info: each copyWithTrimmedAncestry - child: childInfo - repository: aMCRepository ]. stepChildren := stepChildren collect: + [ : each | each isMCInfoProxy + ifTrue: [ each ] + ifFalse: + [ MCInfoProxy + info: each copyWithTrimmedAncestry + workingCopy: aMCWorkingCopy + repository: aMCRepository ] ]! - [ : each | MCInfoProxy - info: each copyWithTrimmedAncestry - child: childInfo - repository: aMCRepository ].!
Item was changed: ProtoObject subclass: #MCInfoProxy + instanceVariableNames: 'info repository workingCopy' - instanceVariableNames: 'info repository childInfo' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Repositories'!
!MCInfoProxy commentStamp: 'cmm 8/12/2013 21:51' prior: 0! A MCInfoProxy takes the place of a MCVersionInfo with a large tree of ancestors that consume memory in the image, but are almost never accessed. If they are, however, I will dynamically retrieve and become the Info from the original MC repository which includes the full ancestry tree.!
Item was removed: - ----- Method: MCInfoProxy class>>info:child:repository: (in category 'create') ----- - info: aMCVersionInfo child: childInfo repository: aMCRepository - ^ self new - - setInfo: aMCVersionInfo - childInfo: childInfo - repository: aMCRepository!
Item was removed: - ----- Method: MCInfoProxy class>>info:repository: (in category 'create') ----- - info: aMCVersionInfo repository: aMCRepository - ^ self new - - setInfo: aMCVersionInfo - repository: aMCRepository!
Item was added: + ----- Method: MCInfoProxy class>>info:workingCopy:repository: (in category 'create') ----- + info: aMCVersionInfo workingCopy: aMCWorkingCopy repository: aMCRepository + ^ self new + setInfo: aMCVersionInfo + workingCopy: aMCWorkingCopy + repository: aMCRepository!
Item was added: + ----- Method: MCInfoProxy>>isMCInfoProxy (in category 'testing') ----- + isMCInfoProxy + ^ true!
Item was changed: ----- Method: MCInfoProxy>>materializeInfo (in category 'private') ----- materializeInfo + workingCopy ancestry breadthFirstAncestorsDo: + [ : each | (repository versionWithInfo: each) ifNotNil: + [ : ver | ^ ver info allAncestorsDo: + [ : eachAncestor | eachAncestor = info ifTrue: [ ^ eachAncestor ] ] ] ]. + nil error: 'Expected ' , info asString , ' to be an ancestor of one of ' , workingCopy ancestors asString! - | persistentVersion | - [ (persistentVersion := repository versionWithInfo: childInfo) isNil ] whileTrue: [ Warning signal: 'Please copy ' , childInfo name , 'with id ' , childInfo id asString , ' back to ' , repository asString , ' and try again.' ]. - persistentVersion info allAncestorsDo: - [ : each | each = info ifTrue: [ ^ each ] ]. - nil error: 'Expected ' , info asString , ' to be an ancestor of ' , childInfo asString!
Item was removed: - ----- Method: MCInfoProxy>>setInfo:childInfo:repository: (in category 'initialize-release') ----- - setInfo: aMCVersionInfo childInfo: childMCVersionInfo repository: aMCRepository - info := aMCVersionInfo. - childInfo := childMCVersionInfo. - repository := aMCRepository!
Item was added: + ----- Method: MCInfoProxy>>setInfo:workingCopy:repository: (in category 'initialize-release') ----- + setInfo: aMCVersionInfo workingCopy: aMCWorkingCopy repository: aMCRepository + info := aMCVersionInfo. + workingCopy := aMCWorkingCopy. + repository := aMCRepository!
Item was changed: ----- Method: MCWorkingCopy>>stubAncestry (in category 'operations') ----- stubAncestry "Stub all but the most recent 10 of my ancestry tree to save memory with a proxy which can be transparently accessed later, if necessary." self ancestors ifEmpty: [ ^ self ]. repositoryGroup ifNotNil: [ | tenAgo count | count := 0. ancestry ancestorsDoWhileTrue: [ : each | tenAgo := each. (count := count + 1) < 10 ]. tenAgo + stubAncestryFor: self - stubAncestryFor: self ancestors anyOne using: repositoryGroup ]!
Item was removed: - ----- Method: MCWorkingCopyBrowser>>flushAllCaches (in category 'actions') ----- - flushAllCaches - | beforeBytes afterBytes beforeVersions afterVersions beforeInfos afterInfos | - Cursor wait showWhile: - [ beforeBytes := Smalltalk garbageCollect. - beforeVersions := MCVersion allSubInstances size. - beforeInfos := MCVersionInfo instanceCount. - MCFileBasedRepository flushAllCaches. - MCWorkingCopy stubAllAncestry. - afterBytes := Smalltalk garbageCollect. - afterVersions := MCVersion allSubInstances size. - afterInfos := MCVersionInfo instanceCount ]. - self inform: - (beforeVersions-afterVersions) asString, ' versions flushed', - String cr, (beforeInfos-afterInfos), ' infos flushed', - String cr, (afterBytes-beforeBytes) asBytesDescription, ' reclaimed'!
Item was added: + ----- Method: MCWorkingCopyBrowser>>flushCachedVersions (in category 'actions') ----- + flushCachedVersions + | beforeBytes afterBytes beforeVersions afterVersions | + Cursor wait showWhile: [ + beforeBytes := Smalltalk garbageCollect. + beforeVersions := MCVersion allSubInstances size. + MCFileBasedRepository flushAllCaches. + afterBytes := Smalltalk garbageCollect. + afterVersions := MCVersion allSubInstances size. + ]. + ^self inform: (beforeVersions - afterVersions) asString, ' versions flushed', String cr, + (afterBytes - beforeBytes) asStringWithCommas, ' bytes reclaimed'!
Item was added: + ----- Method: MCWorkingCopyBrowser>>flushCachedVersionsAncestry (in category 'actions') ----- + flushCachedVersionsAncestry + | beforeBytes afterBytes beforeVersions afterVersions beforeInfos afterInfos | + Cursor wait showWhile: + [ beforeBytes := Smalltalk garbageCollect. + beforeVersions := MCVersion allSubInstances size. + beforeInfos := MCVersionInfo instanceCount. + MCFileBasedRepository flushAllCaches. + MCWorkingCopy stubAllAncestry. + afterBytes := Smalltalk garbageCollect. + afterVersions := MCVersion allSubInstances size. + afterInfos := MCVersionInfo instanceCount ]. + self inform: + (beforeVersions-afterVersions) asString, ' versions flushed', + String cr, (beforeInfos-afterInfos), ' infos flushed', + String cr, (afterBytes-beforeBytes) asBytesDescription, ' reclaimed'!
Item was changed: ----- Method: MCWorkingCopyBrowser>>repositoryListMenu: (in category 'morphic ui') ----- repositoryListMenu: aMenu "first add repository-specific commands" self repository ifNotNil: [self fillMenu: aMenu fromSpecs: #(('open repository' #openRepository) ('edit repository info' #editRepository) ('add to package...' #addRepositoryToPackage) ('remove repository' #removeRepository) ('copy image versions here' #copyImageVersions)). aMenu add: (self repository alwaysStoreDiffs ifTrue: ['store full versions'] ifFalse: ['store diffs']) target: self selector: #toggleDiffs; addLine]. "then the non-specific commands" ^self fillMenu: aMenu fromSpecs: #( ('load repositories' #loadRepositories) ('save repositories' #saveRepositories) + ('flush cached versions' #flushCachedVersions) + ('flush cached versions and ancestry' #flushCachedVersionsAncestry))! - ('flush cached versions' #flushAllCaches))!