--- a/ObjectMemory.st Thu Jun 27 23:01:02 2013 +0200
+++ b/ObjectMemory.st Thu Jun 27 23:01:21 2013 +0200
@@ -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.
+
+ 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.
"/ '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
@@ -3207,9 +3207,9 @@
you may want to increase this limit."
%{ /* NOCONTEXT */
- extern unsigned __compressingGCLimit();
-
- RETURN (__MKUINT( __compressingGCLimit((unsigned int)-1) ));
+ extern unsigned INT __compressingGCLimit();
+
+ RETURN (__MKUINT( __compressingGCLimit((unsigned INT)-1) ));
%}.
^ 0
"
@@ -3229,10 +3229,10 @@
|result|
%{
- extern unsigned __compressingGCLimit();
+ extern unsigned INT __compressingGCLimit();
if (__isInteger(amount)) {
- result = __MKUINT( __compressingGCLimit(__unsignedLongIntVal(amount)) );
+ result = __MKUINT( __compressingGCLimit((unsigned INT)__unsignedLongIntVal(amount)) );
}
%}.
result isNil ifTrue:[
@@ -3254,9 +3254,9 @@
and there is no need to change it."
%{ /* NOCONTEXT */
- extern unsigned __oldSpaceIncrement();
-
- RETURN (__MKUINT( __oldSpaceIncrement((unsigned int)-1) ));
+ extern unsigned INT __oldSpaceIncrement();
+
+ RETURN (__MKUINT( __oldSpaceIncrement((unsigned INT)-1) ));
%}.
^ 0
"
@@ -3274,10 +3274,10 @@
|result|
%{
- extern unsigned __oldSpaceIncrement();
+ extern unsigned INT __oldSpaceIncrement();
if (__isInteger(amount)) {
- result = __MKUINT( __oldSpaceIncrement(__unsignedLongIntVal(amount)) );
+ result = __MKUINT( __oldSpaceIncrement((unsigned INT)__unsignedLongIntVal(amount)) );
}
%}.
result isNil ifTrue:[
@@ -3958,10 +3958,10 @@
int prev;
prev = __optimizeContexts(aBoolean == true
- ? 1
- : (aBoolean == false)
- ? 0
- : -1);
+ ? 1
+ : (aBoolean == false)
+ ? 0
+ : -1);
RETURN (prev ? true : false);
%}
"
@@ -4318,13 +4318,13 @@
aCollection := OrderedCollection new.
self allObjectsIncludingContextsDo:[:o |
- (aBlock value:o) ifTrue:[
- aCollection add:o
- ]
+ (aBlock value:o) ifTrue:[
+ aCollection add:o
+ ]
].
(aCollection size == 0) ifTrue:[
- "actually this cannot happen - there is always one"
- ^ nil
+ "actually this cannot happen - there is always one"
+ ^ nil
].
^ aCollection
!
@@ -5504,7 +5504,7 @@
!ObjectMemory class methodsFor:'documentation'!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/ObjectMemory.st,v 1.268 2013-05-11 17:42:41 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ObjectMemory.st,v 1.269 2013-06-27 21:01:21 cg Exp $'
!
version_SVN