--- a/ObjectMemory.st Mon Jul 01 22:14:20 2013 +0100
+++ b/ObjectMemory.st Tue Jul 09 22:51:30 2013 +0100
@@ -1288,29 +1288,29 @@
lbl origin:(0.0@0.0) corner:(1.0@0.0).
h := lbl preferredHeight.
lbl
- topInset:5;
- bottomInset:(h+5) negated;
- leftInset:5;
- rightInset:5.
+ topInset:5;
+ bottomInset:(h+5) negated;
+ leftInset:5;
+ rightInset:5.
progress := ProgressIndicator in:top.
progress origin:(0.0@45) corner:(1.0@45).
progress level:-1.
h := progress preferredHeight.
progress
- topInset:(h // 2) negated;
- bottomInset:(h // 2) negated;
- leftInset:5;
- rightInset:5.
+ topInset:(h // 2) negated;
+ bottomInset:(h // 2) negated;
+ leftInset:5;
+ rightInset:5.
progress beInvisible.
listV := HVScrollableView for:SelectionInListView in:top.
listV origin:(0.0@55) corner:(1.0@1.0).
listV
- topInset:(h // 2);
- bottomInset:40;
- leftInset:5;
- rightInset:5.
+ topInset:(h // 2);
+ bottomInset:40;
+ leftInset:5;
+ rightInset:5.
listV beInvisible.
panel := HorizontalPanelView in:top.
@@ -1349,247 +1349,247 @@
firstRound := true.
[done] whileFalse:[
- anyShown := false.
-
- progress percentage:0.
- firstRound ifTrue:[
- firstRound := false.
- ] ifFalse:[
- lbl label:'compressing garbage ...'.
- self garbageCollect.
- ].
-
- lbl label:('searching level '
- , levels size printString
- , ' (' , objects size printString , ' refs) ...').
- nAll := objects size.
- nDone := 0.
-
- objectArray := objects asArray.
-
- owners := "Weak"IdentitySet new.
-
- numObjectsDone := 0.
- found := false.
-
- AbortSignal handle:[]
- do:[
- [self allObjectsIncludingContextsDo:[:o |
- |inPrevLevel isOwner|
-
- stop ifTrue:[AbortSignal raise].
- stop ifFalse:[
- isOwner := false.
- (o referencesAny:objectArray) ifTrue:[
- o isBehavior ifTrue:[
- o == Smalltalk ifTrue:[
- found := true.
- ] ifFalse:[
- "/ only add it if it has classInstVars
- o instSize ~~ Class instSize ifTrue:[
- isOwner := true.
- ]
- ]
- ] ifFalse:[
- o class ~~ WeakArray ifTrue:[
- isOwner := true.
- ]
- ].
- ].
-
- isOwner ifTrue:[
- (objects includesIdentical:o) ifFalse:[
- inPrevLevel := false.
- levels do:[:lColl |
- lColl == o ifTrue:[
- inPrevLevel := true
- ] ifFalse:[
- (lColl includesIdentical:o) ifTrue:[inPrevLevel := true].
- ]
- ].
- inPrevLevel ifFalse:[
- owners add:o.
- (limitOrNil notNil and:[owners size >= limitOrNil]) ifTrue:[
- AbortSignal raise
- ].
- ]
- ]
- ].
-
- numObjectsDone := numObjectsDone + 1.
- numObjects notNil ifTrue:[
- numObjectsDone \\ 1000 == 0 ifTrue:[
- progress percentage:(numObjectsDone / numObjects * 100).
- Processor yield.
- ]
- ]
- ]
- ]] whileFalse.
- ].
- progress percentage:100.
-
- numObjects isNil ifTrue:[
- numObjects := numObjectsDone.
- ].
-
- owners remove:aCollection ifAbsent:nil.
- owners remove:thisContext ifAbsent:nil.
- owners remove:objectArray ifAbsent:nil.
- owners remove:objects keyArray ifAbsent:nil.
- owners remove:owners keyArray ifAbsent:nil.
+ anyShown := false.
+
+ progress percentage:0.
+ firstRound ifTrue:[
+ firstRound := false.
+ ] ifFalse:[
+ lbl label:'compressing garbage ...'.
+ self garbageCollect.
+ ].
+
+ lbl label:('searching level '
+ , levels size printString
+ , ' (' , objects size printString , ' refs) ...').
+ nAll := objects size.
+ nDone := 0.
+
+ objectArray := objects asArray.
+
+ owners := "Weak"IdentitySet new.
+
+ numObjectsDone := 0.
+ found := false.
+
+ AbortOperationRequest handle:[]
+ do:[
+ [self allObjectsIncludingContextsDo:[:o |
+ |inPrevLevel isOwner|
+
+ stop ifTrue:[AbortOperationRequest raise].
+ stop ifFalse:[
+ isOwner := false.
+ (o referencesAny:objectArray) ifTrue:[
+ o isBehavior ifTrue:[
+ o == Smalltalk ifTrue:[
+ found := true.
+ ] ifFalse:[
+ "/ only add it if it has classInstVars
+ o instSize ~~ Class instSize ifTrue:[
+ isOwner := true.
+ ]
+ ]
+ ] ifFalse:[
+ o class ~~ WeakArray ifTrue:[
+ isOwner := true.
+ ]
+ ].
+ ].
+
+ isOwner ifTrue:[
+ (objects includesIdentical:o) ifFalse:[
+ inPrevLevel := false.
+ levels do:[:lColl |
+ lColl == o ifTrue:[
+ inPrevLevel := true
+ ] ifFalse:[
+ (lColl includesIdentical:o) ifTrue:[inPrevLevel := true].
+ ]
+ ].
+ inPrevLevel ifFalse:[
+ owners add:o.
+ (limitOrNil notNil and:[owners size >= limitOrNil]) ifTrue:[
+ AbortOperationRequest raise
+ ].
+ ]
+ ]
+ ].
+
+ numObjectsDone := numObjectsDone + 1.
+ numObjects notNil ifTrue:[
+ numObjectsDone \\ 1000 == 0 ifTrue:[
+ progress percentage:(numObjectsDone / numObjects * 100).
+ Processor yield.
+ ]
+ ]
+ ]
+ ]] whileFalse.
+ ].
+ progress percentage:100.
+
+ numObjects isNil ifTrue:[
+ numObjects := numObjectsDone.
+ ].
+
+ owners remove:aCollection ifAbsent:nil.
+ owners remove:thisContext ifAbsent:nil.
+ owners remove:objectArray ifAbsent:nil.
+ owners remove:objects keyArray ifAbsent:nil.
+ owners remove:owners keyArray ifAbsent:nil.
"/ 'done with level: ' print. levels size print. ' found ' print. owners size print. ' refs' printCR.
- owners isEmpty ifTrue:[
- found ifFalse:[
- stop := true.
- ]
- ].
-
- stop ifFalse:[
- done := found or:[(owners includesIdentical:Smalltalk)].
- done ifTrue:[
- moreChainsOnThisLevel := true.
- temporaryRemoved := IdentitySet new.
-
- levels size > 0 ifTrue:[
- "/ show what we found so far.
- levels last add:Smalltalk.
- levels reverse.
- ].
-
- chains := OrderedCollection new.
-
- tLevels := levels collect:[:lColl | lColl copy].
-
- lbl label:('building refchains ...').
-
- nAll := aCollection size.
- nDone := 0.
- aCollection do:[:anObject | |theseChains|
- stop ifFalse:[
- theseChains := self
- refChainsFrom:Smalltalk
- to:anObject
- inRefSets:tLevels
- startingAt:1.
-
- theseChains size > 0 ifTrue:[
- chains addAll:theseChains
- ].
- nDone := nDone + 1.
- progress percentage:(nDone / nAll * 100).
- ]
- ].
-
- tLevels := nil.
-
- levels size > 0 ifTrue:[
- levels reverse.
- levels last remove:Smalltalk.
- ].
-
- [stop not
- and:[chains size > 0]] whileTrue:[
- chain := chains first.
- chains removeFirst.
-
- lbl label:('found a reference chain.').
- progress beInvisible.
-
- chain addFirst:Smalltalk.
- list := OrderedCollection withSize:chain size.
- 1 to:chain size-1 do:[:i |
- list
- at:i
- put:(self refNameFor:(chain at:i+1) in:(chain at:i))
- ].
- list at:list size put:(chain last classNameWithArticle).
-
- "/ hide the VMProcesses stuff from the user ...
- (list at:1) string = 'Smalltalk:__VMProcesses__' ifTrue:[
- list at:1 put:'__VMProcesses__ (a hidden VM reference)'.
- list removeIndex:2.
- chain at:1 put:nil.
- chain removeIndex:2.
- ].
-
- listV list:list.
-
- listV beVisible.
- listV doubleClickAction:[:idx | |o|
- (o := chain at:idx) notNil ifTrue:[
- o inspect.
- ]
- ].
- moreButton beVisible.
- anyShown := anyShownInAnyLevel := true.
- showMore := false.
-
- "/ kludge - wait for some user action
-
- [showMore or:[stop or:[top realized not]]] whileFalse:[
- Delay waitForSeconds:0.1
- ].
-
- chain := nil.
-
- top realized ifFalse:[
- stop := true
- ] ifTrue:[
- listV doubleClickAction:nil.
- showMore ifFalse:[
- stop := true.
- ].
- ].
- done := false.
-
- stop ifFalse:[
- progress beVisible.
- listV beInvisible.
- moreButton beInvisible.
-
- chain := nil.
- ]
- ].
- levels size > 0 ifTrue:[
- levels last addAll:temporaryRemoved.
- ]
- ].
- ].
-
- owners remove:Smalltalk ifAbsent:nil.
- owners remove:(owners keyArray) ifAbsent:nil.
- owners remove:objectArray ifAbsent:nil.
- levels do:[:lColl |
- owners remove:lColl ifAbsent:nil
- ].
-
- levels add:owners.
-
- objects := owners.
-
- objects size == 0 ifTrue:[
- stop := true
- ].
-
- stop ifTrue:[
- Smalltalk at:#'__VMProcesses__' put:nil.
- top destroy.
- anyShown ifFalse:[
- userStop ifFalse:[
- self information:(anyShownInAnyLevel ifTrue:['no more references'] ifFalse:['no references']).
- ]
- ].
- ^ self.
- ].
+ owners isEmpty ifTrue:[
+ found ifFalse:[
+ stop := true.
+ ]
+ ].
+
+ stop ifFalse:[
+ done := found or:[(owners includesIdentical:Smalltalk)].
+ done ifTrue:[
+ moreChainsOnThisLevel := true.
+ temporaryRemoved := IdentitySet new.
+
+ levels size > 0 ifTrue:[
+ "/ show what we found so far.
+ levels last add:Smalltalk.
+ levels reverse.
+ ].
+
+ chains := OrderedCollection new.
+
+ tLevels := levels collect:[:lColl | lColl copy].
+
+ lbl label:('building refchains ...').
+
+ nAll := aCollection size.
+ nDone := 0.
+ aCollection do:[:anObject | |theseChains|
+ stop ifFalse:[
+ theseChains := self
+ refChainsFrom:Smalltalk
+ to:anObject
+ inRefSets:tLevels
+ startingAt:1.
+
+ theseChains size > 0 ifTrue:[
+ chains addAll:theseChains
+ ].
+ nDone := nDone + 1.
+ progress percentage:(nDone / nAll * 100).
+ ]
+ ].
+
+ tLevels := nil.
+
+ levels size > 0 ifTrue:[
+ levels reverse.
+ levels last remove:Smalltalk.
+ ].
+
+ [stop not
+ and:[chains size > 0]] whileTrue:[
+ chain := chains first.
+ chains removeFirst.
+
+ lbl label:('found a reference chain.').
+ progress beInvisible.
+
+ chain addFirst:Smalltalk.
+ list := OrderedCollection withSize:chain size.
+ 1 to:chain size-1 do:[:i |
+ list
+ at:i
+ put:(self refNameFor:(chain at:i+1) in:(chain at:i))
+ ].
+ list at:list size put:(chain last classNameWithArticle).
+
+ "/ hide the VMProcesses stuff from the user ...
+ (list at:1) string = 'Smalltalk:__VMProcesses__' ifTrue:[
+ list at:1 put:'__VMProcesses__ (a hidden VM reference)'.
+ list removeIndex:2.
+ chain at:1 put:nil.
+ chain removeIndex:2.
+ ].
+
+ listV list:list.
+
+ listV beVisible.
+ listV doubleClickAction:[:idx | |o|
+ (o := chain at:idx) notNil ifTrue:[
+ o inspect.
+ ]
+ ].
+ moreButton beVisible.
+ anyShown := anyShownInAnyLevel := true.
+ showMore := false.
+
+ "/ kludge - wait for some user action
+
+ [showMore or:[stop or:[top realized not]]] whileFalse:[
+ Delay waitForSeconds:0.1
+ ].
+
+ chain := nil.
+
+ top realized ifFalse:[
+ stop := true
+ ] ifTrue:[
+ listV doubleClickAction:nil.
+ showMore ifFalse:[
+ stop := true.
+ ].
+ ].
+ done := false.
+
+ stop ifFalse:[
+ progress beVisible.
+ listV beInvisible.
+ moreButton beInvisible.
+
+ chain := nil.
+ ]
+ ].
+ levels size > 0 ifTrue:[
+ levels last addAll:temporaryRemoved.
+ ]
+ ].
+ ].
+
+ owners remove:Smalltalk ifAbsent:nil.
+ owners remove:(owners keyArray) ifAbsent:nil.
+ owners remove:objectArray ifAbsent:nil.
+ levels do:[:lColl |
+ owners remove:lColl ifAbsent:nil
+ ].
+
+ levels add:owners.
+
+ objects := owners.
+
+ objects size == 0 ifTrue:[
+ stop := true
+ ].
+
+ stop ifTrue:[
+ Smalltalk at:#'__VMProcesses__' put:nil.
+ top destroy.
+ anyShown ifFalse:[
+ userStop ifFalse:[
+ self information:(anyShownInAnyLevel ifTrue:['no more references'] ifFalse:['no references']).
+ ]
+ ].
+ ^ self.
+ ].
].
anyShown ifTrue:[
- userStop ifFalse:[
- self information:'no more references'.
- ]
+ userStop ifFalse:[
+ self information:'no more references'.
+ ]
].
Smalltalk at:#'__VMProcesses__' put:nil.
^ self
@@ -2269,41 +2269,41 @@
|done limit|
- AbortSignal handle:[:ex |
- "/ in case of abort (from the debugger),
- "/ disable gcSteps.
- done := true.
- IncrementalGCLimit := FreeSpaceGCLimit := nil.
- 'ObjectMemory [error]: IGC aborted; turning off incremental GC' errorPrintCR
+ AbortOperationRequest handle:[:ex |
+ "/ in case of abort (from the debugger),
+ "/ disable gcSteps.
+ done := true.
+ IncrementalGCLimit := FreeSpaceGCLimit := nil.
+ 'ObjectMemory [error]: IGC aborted; turning off incremental GC' errorPrintCR
] do:[
- limit := IncrementalGCLimit.
- (limit notNil and:[self oldSpaceAllocatedSinceLastGC > limit]) ifTrue:[
+ limit := IncrementalGCLimit.
+ (limit notNil and:[self oldSpaceAllocatedSinceLastGC > limit]) ifTrue:[
"/ 'IGC [info]: start since allocatedSinceLastGC > IncrementalGCLimit' infoPrintCR.
- done := ObjectMemory gcStep
- ] ifFalse:[
- limit := FreeSpaceGCLimit.
- (limit notNil and:[(self freeSpace + self freeListSpace) < limit]) ifTrue:[
+ done := ObjectMemory gcStep
+ ] ifFalse:[
+ limit := FreeSpaceGCLimit.
+ (limit notNil and:[(self freeSpace + self freeListSpace) < limit]) ifTrue:[
"/ 'IGC [info]: start since freeSpace < FreeSpaceGCLimit' infoPrintCR.
- done := ObjectMemory gcStep.
- done ifTrue:[
- self moreOldSpaceIfUseful
- ].
- ] ifFalse:[
- limit := DynamicCodeGCTrigger.
- (limit notNil and:[self compiledCodeCounter > limit]) ifTrue:[
+ done := ObjectMemory gcStep.
+ done ifTrue:[
+ self moreOldSpaceIfUseful
+ ].
+ ] ifFalse:[
+ limit := DynamicCodeGCTrigger.
+ (limit notNil and:[self compiledCodeCounter > limit]) ifTrue:[
"/ 'IGC [info]: start since compiledCodeCounter > DynamicCodeGCTrigger' infoPrintCR.
- done := ObjectMemory gcStep.
- ] ifFalse:[
- limit := DynamicCodeLimit.
- (limit notNil and:[self compiledCodeSpaceUsed > limit]) ifTrue:[
+ done := ObjectMemory gcStep.
+ ] ifFalse:[
+ limit := DynamicCodeLimit.
+ (limit notNil and:[self compiledCodeSpaceUsed > limit]) ifTrue:[
"/ 'IGC [info]: start since compiledCodeSpaceUsed > DynamicCodeLimit' infoPrintCR.
- done := ObjectMemory gcStep.
- ] ifFalse:[
- done := true
- ]
- ]
- ]
- ].
+ done := ObjectMemory gcStep.
+ ] ifFalse:[
+ done := true
+ ]
+ ]
+ ]
+ ].
].
^ done not
@@ -5504,7 +5504,7 @@
!ObjectMemory class methodsFor:'documentation'!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/ObjectMemory.st,v 1.269 2013-06-27 21:01:21 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ObjectMemory.st,v 1.270 2013-07-05 11:17:47 stefan Exp $'
!
version_SVN