--- a/ObjectMemory.st Tue Jun 10 12:15:17 2014 +0200
+++ b/ObjectMemory.st Tue Jun 10 12:15:44 2014 +0200
@@ -948,14 +948,14 @@
Occasionally, the VM needs to unwind-protect some C code.
If so, it creates and artificial context on the stack and
marks it for unwind, so stack unwinding logic finds it
- and handles it.
+ and handles it.
Now, only #lookupMethodForSelectorUnwindProtect is supported
(ensures the lookup is popped out from the lookupActications)
"
aContext selector == #lookupMethodForSelectorUnwindHandlerFor: ifTrue:[
- ^[self lookupMethodForSelectorUnwindHandlerFor: (aContext argAt: 1)]
- ].
+ ^[self lookupMethodForSelectorUnwindHandlerFor: (aContext argAt: 1)]
+ ].
self internalError:'Unknown VM unwind protect action'
@@ -1334,29 +1334,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.
@@ -1395,246 +1395,246 @@
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.
-
- AbortOperationRequest catch:[
- 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.
- ]
- ]
- ]
- ].
- ].
- 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 catch:[
+ 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.
+ ]
+ ]
+ ]
+ ].
+ ].
+ 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
@@ -1774,27 +1774,27 @@
|chain|
index > levels size ifTrue:[
- (start referencesObject:anObject) ifTrue:[
- ^ OrderedCollection with:anObject. "/ (self refNameFor:anObject in:start)
- ].
- ^ nil.
+ (start referencesObject:anObject) ifTrue:[
+ ^ OrderedCollection with:anObject. "/ (self refNameFor:anObject in:start)
+ ].
+ ^ nil.
].
(levels at:index) do:[:el |
el ~~ start ifTrue:[
- (start referencesObject:el) ifTrue:[
- chain := self
- refChainFrom:el
- to:anObject
- inRefSets:levels
- startingAt:(index+1).
-
- chain notNil ifTrue:[
- (levels at:index) safeRemove:el.
- chain addFirst:el. "/ (self refNameFor:el in:start).
- ^ chain.
- ]
- ].
+ (start referencesObject:el) ifTrue:[
+ chain := self
+ refChainFrom:el
+ to:anObject
+ inRefSets:levels
+ startingAt:(index+1).
+
+ chain notNil ifTrue:[
+ (levels at:index) safeRemove:el.
+ chain addFirst:el. "/ (self refNameFor:el in:start).
+ ^ chain.
+ ]
+ ].
].
].
^ nil
@@ -1818,8 +1818,8 @@
a3 := Array with:a2.
a4 := Array with:a3.
levels := Array with:(Array with:a3)
- with:(Array with:a2)
- with:(Array with:a1).
+ with:(Array with:a2)
+ with:(Array with:a1).
self refChainFrom:a4 to:o inRefSets:levels startingAt:1.
"
@@ -1833,30 +1833,30 @@
chains := OrderedCollection new.
index > levels size ifTrue:[
- (start referencesObject:anObject) ifTrue:[
- chains add:(OrderedCollection with:anObject "(self refNameFor:anObject in:start)").
- ].
- ^ chains
+ (start referencesObject:anObject) ifTrue:[
+ chains add:(OrderedCollection with:anObject "(self refNameFor:anObject in:start)").
+ ].
+ ^ chains
].
(levels at:index) do:[:el |
el ~~ start ifTrue:[
- (start referencesObject:el) ifTrue:[
- chain := self
- refChainFrom:el
- to:anObject
- inRefSets:levels
- startingAt:(index+1).
-
- chain size > 0 ifTrue:[
- (levels at:index) safeRemove:el.
-
- c := chain copy.
- c addFirst:el "(self refNameFor:el in:start)".
- chains add:c.
- ]
+ (start referencesObject:el) ifTrue:[
+ chain := self
+ refChainFrom:el
+ to:anObject
+ inRefSets:levels
+ startingAt:(index+1).
+
+ chain size > 0 ifTrue:[
+ (levels at:index) safeRemove:el.
+
+ c := chain copy.
+ c addFirst:el "(self refNameFor:el in:start)".
+ chains add:c.
+ ]
].
- ].
+ ].
].
^ chains
@@ -1868,40 +1868,40 @@
|names oClass|
referent == Smalltalk ifTrue:[
- referent keysAndValuesDo:[:key :val |
- |idx|
-
- (anObject == val) ifTrue:[
- "/ for our convenience - if its a nameSpace, cut off Smalltalk.
- idx := key string indexOf:$:.
- (idx ~~ 0
- and:[idx < key string size
- and:[(key string at:(idx+1)) == $:]]) ifTrue:[
- ^ key allBold "/ (key copyFrom:(idx+2)) allBold
- ].
- ^ 'Smalltalk:' , (key allBold).
- ]
- ].
+ referent keysAndValuesDo:[:key :val |
+ |idx|
+
+ (anObject == val) ifTrue:[
+ "/ for our convenience - if its a nameSpace, cut off Smalltalk.
+ idx := key string indexOf:$:.
+ (idx ~~ 0
+ and:[idx < key string size
+ and:[(key string at:(idx+1)) == $:]]) ifTrue:[
+ ^ key allBold "/ (key copyFrom:(idx+2)) allBold
+ ].
+ ^ 'Smalltalk:' , (key allBold).
+ ]
+ ].
] ifFalse:[
- names := referent class allInstVarNames.
- oClass := referent class.
- oClass == anObject ifTrue:[
- ^ oClass name.
- ].
- 1 to:oClass instSize do:[:i |
- ((referent instVarAt:i) == anObject) ifTrue:[
- ^ '%1 [%2]' bindWith:referent classNameWithArticle with:(names at:i) allBold.
- ].
- ].
- oClass isVariable ifTrue:[
- oClass isPointers ifTrue:[
- 1 to:referent basicSize do:[:i |
- ((referent basicAt:i) == anObject) ifTrue:[
- ^ '%1 [%2] (sz=%2)' bindWith:referent classNameWithArticle with:i printString allBold with:referent basicSize printString
- ]
- ]
- ]
- ].
+ names := referent class allInstVarNames.
+ oClass := referent class.
+ oClass == anObject ifTrue:[
+ ^ oClass name.
+ ].
+ 1 to:oClass instSize do:[:i |
+ ((referent instVarAt:i) == anObject) ifTrue:[
+ ^ '%1 [%2]' bindWith:referent classNameWithArticle with:(names at:i) allBold.
+ ].
+ ].
+ oClass isVariable ifTrue:[
+ oClass isPointers ifTrue:[
+ 1 to:referent basicSize do:[:i |
+ ((referent basicAt:i) == anObject) ifTrue:[
+ ^ '%1 [%2] (sz=%2)' bindWith:referent classNameWithArticle with:i printString allBold with:referent basicSize printString
+ ]
+ ]
+ ]
+ ].
].
self error:'no reference' mayProceed:true.
^ nil.
@@ -2318,40 +2318,40 @@
|done limit|
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
+ "/ 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
@@ -2492,49 +2492,49 @@
"/ its not useful, to run it more than once
"/
BackgroundCollectProcess notNil ifTrue:[
- BackgroundCollectProcess priority:aPriority.
- ^ self
+ BackgroundCollectProcess priority:aPriority.
+ ^ self
].
p :=
- [
- [
- |myDelay timeOfLastGC doGC|
-
- myDelay := Delay forSeconds:5.
- timeOfLastGC := Timestamp now.
-
- [true] whileTrue:[
- doGC := self gcStepIfUseful.
- doGC ifFalse:[
- (BackgroundCollectMaximumInterval notNil
- and:[(Timestamp now secondDeltaFrom: timeOfLastGC) > BackgroundCollectMaximumInterval])
- ifTrue:[
+ [
+ [
+ |myDelay timeOfLastGC doGC|
+
+ myDelay := Delay forSeconds:5.
+ timeOfLastGC := Timestamp now.
+
+ [true] whileTrue:[
+ doGC := self gcStepIfUseful.
+ doGC ifFalse:[
+ (BackgroundCollectMaximumInterval notNil
+ and:[(Timestamp now secondDeltaFrom: timeOfLastGC) > BackgroundCollectMaximumInterval])
+ ifTrue:[
"/ 'ObjectMemory [info]: start time-triggered background collect.' infoPrintCR.
- doGC := true.
- ]
- ].
-
- doGC ifTrue:[
- "/
- "/ perform a full cycle (finish cycle)
- "/
- [self gcStep] whileFalse:[].
- "/
- "/ increase oldSpace, if freeSpace is below limits.
- "/
- self moreOldSpaceIfUseful.
- timeOfLastGC := Timestamp now.
- ].
- "/
- "/ wait a bit
- "/
- myDelay wait.
- ]
- ] ifCurtailed:[
- BackgroundCollectProcess := nil
- ]
- ] newProcess.
+ doGC := true.
+ ]
+ ].
+
+ doGC ifTrue:[
+ "/
+ "/ perform a full cycle (finish cycle)
+ "/
+ [self gcStep] whileFalse:[].
+ "/
+ "/ increase oldSpace, if freeSpace is below limits.
+ "/
+ self moreOldSpaceIfUseful.
+ timeOfLastGC := Timestamp now.
+ ].
+ "/
+ "/ wait a bit
+ "/
+ myDelay wait.
+ ]
+ ] ifCurtailed:[
+ BackgroundCollectProcess := nil
+ ]
+ ] newProcess.
p name:'background collector'.
p priority:aPriority.
p restartable:true.
@@ -4174,7 +4174,7 @@
self allChangedShadowObjectsDo:[:aShadowArray |
Error handle:[:ex |
- 'ObjectMemory [warning]: cought error in weakArray processing: ' errorPrint.
+ 'ObjectMemory [warning]: caught error in weakArray processing: ' errorPrint.
ex description errorPrintCR.
ex suspendedContext fullPrintAllLevels:10.
"Restart the do block to clean up the rest of the shadow array.
@@ -4387,7 +4387,7 @@
%}
"
- self collectedOldSpaceAddress
+ self collectedOldSpaceAddress
"
!
@@ -4727,7 +4727,7 @@
%}
"
- self oldSpaceAddress
+ self oldSpaceAddress
"
!
@@ -5184,7 +5184,7 @@
|nm|
(nm := UserPreferences current changeFileName) notNil ifTrue:[
- ^ nm
+ ^ nm
].
ChangeFileName notNil ifTrue:[^ ChangeFileName].
^ self nameForChangesLocal
@@ -5296,9 +5296,9 @@
No copy when the changes name is given explicitly."
ChangeFileName notNil ifTrue: [
- ChangeFileName ~= self nameForChangesLocal ifTrue:[
- ^ self
- ]
+ ChangeFileName ~= self nameForChangesLocal ifTrue:[
+ ^ self
+ ]
].
oldChangesName asFilename copyTo:self nameForChanges
@@ -5344,7 +5344,7 @@
ST-80 compatibility; send #preSnapshot to all classes
"
Smalltalk allClassesDo:[:aClass |
- aClass preSnapshot
+ aClass preSnapshot
].
"
@@ -5354,53 +5354,53 @@
"
snapshotFilename := aFileName asFilename.
tempFilename := (FileStream newTemporaryIn:snapshotFilename directory)
- close;
- fileName.
+ close;
+ fileName.
ok := self primSnapShotOn:tempFilename.
ok ifTrue:[
- "keep history of one snapshot file"
- snapshotFilename exists ifTrue:[
- tempFilename symbolicAccessRights:snapshotFilename symbolicAccessRights.
- snapshotFilename renameTo:(snapshotFilename withSuffix:'sav').
- ] ifFalse:[
- "image file hat stx as interpreter and can be executed"
- tempFilename makeExecutable.
- ].
- tempFilename renameTo:snapshotFilename.
-
- Class addChangeRecordForSnapshot:aFileName.
-
- setImageName ifTrue:[
- oldChangeFile := self nameForChanges.
- ImageName := snapshotFilename asAbsoluteFilename asString.
- self refreshChangesFrom:oldChangeFile.
- ].
+ "keep history of one snapshot file"
+ snapshotFilename exists ifTrue:[
+ tempFilename symbolicAccessRights:snapshotFilename symbolicAccessRights.
+ snapshotFilename renameTo:(snapshotFilename withSuffix:'sav').
+ ] ifFalse:[
+ "image file hat stx as interpreter and can be executed"
+ tempFilename makeExecutable.
+ ].
+ tempFilename renameTo:snapshotFilename.
+
+ Class addChangeRecordForSnapshot:aFileName.
+
+ setImageName ifTrue:[
+ oldChangeFile := self nameForChanges.
+ ImageName := snapshotFilename asAbsoluteFilename asString.
+ self refreshChangesFrom:oldChangeFile.
+ ].
] ifFalse:[
- tempFilename remove.
+ tempFilename remove.
].
"
ST-80 compatibility; send #postSnapshot to all classes
"
Smalltalk allClassesDo:[:aClass |
- aClass postSnapshot
+ aClass postSnapshot
].
self changed:#finishedSnapshot. "/ ST-80 compatibility
ok ifFalse:[
- SnapshotError raise.
- "not reached"
+ SnapshotError raise.
+ "not reached"
].
Transcript
- show:'Snapshot ';
- show:snapshotFilename baseName allBold;
- show:' saved ';
- show:Timestamp now;
- show:' in ';
- show:snapshotFilename asAbsoluteFilename directoryName;
- showCR:'.'.
+ show:'Snapshot ';
+ show:snapshotFilename baseName allBold;
+ show:' saved ';
+ show:Timestamp now;
+ show:' in ';
+ show:snapshotFilename asAbsoluteFilename directoryName;
+ showCR:'.'.
^ ok
@@ -5563,11 +5563,11 @@
!ObjectMemory class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/ObjectMemory.st,v 1.278 2014-06-03 05:39:54 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ObjectMemory.st,v 1.279 2014-06-10 10:15:44 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/ObjectMemory.st,v 1.278 2014-06-03 05:39:54 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ObjectMemory.st,v 1.279 2014-06-10 10:15:44 cg Exp $'
!
version_SVN