The Trunk: Monticello-cmm.561.mcz

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))!