[Vm-dev] VM Maker: VMMaker.oscog-eem.451.mcz
commits at source.squeak.org
commits at source.squeak.org
Fri Oct 11 22:22:44 UTC 2013
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.451.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.451
Author: eem
Time: 11 October 2013, 3:18:08.922 pm
UUID: b5e6b999-d2ef-4257-8624-97aab4e0c555
Ancestors: VMMaker.oscog-eem.450
An incendiary commit!! :-)
Refactor snapshotCleanUp to extract
bereaveAndNormalizeContextsAndFlushExternalPrimitives
for the bootstrap which doesn't want to GC before snapshotting.
Fix the StackInterpreterSimulator window border. Harmonize the
code with CogVMSimulator.
Rename markAndTraceMachineCodeForIncrementalGC to
markAndTraceMachineCodeForNewSpaceGC, &
leakCheckIncrementalGC to leakCheckNewSpaceGC.
Assert-check there's enough reserve on scavenge.
Initialize classTableIndex when setting classTableRootObj.
Fix setting up free space in the bootstrap.
Swizzle the fileds beyond the stack p[ointer in contexts on start-up
via adding lastPointerOfWhileSwizzling:.
remember to set-up new space variables on image load
(initializeNewSpaceVariables).
Make computeTenuringThreshold cope with a flushed futureSpace.
Spur now loads an image and can evaluate 3+4 (needs Cog-eem.114 or later).
=============== Diff against VMMaker.oscog-eem.450 ===============
Item was changed:
----- Method: CogVMSimulator>>openAsMorphNoTranscript (in category 'UI') -----
openAsMorphNoTranscript
"Open a morphic view on this simulation."
+ | localImageName borderWidth window |
- | localImageName theWindow |
localImageName := FileDirectory default localNameFor: imageName.
+ window := (SystemWindow labelled: 'Simulation of ' , localImageName) model: self.
- theWindow := (SystemWindow labelled: 'Simulation of ' , localImageName) model: self.
+ window addMorph: (displayView := ImageMorph new image: displayForm)
- theWindow addMorph: (displayView := ImageMorph new image: displayForm)
frame: (0 at 0 corner: 1 at 0.95).
+ window addMorph: (PluggableTextMorph on: self
- theWindow addMorph: (PluggableTextMorph on: self
text: #byteCountText accept: nil
readSelection: nil menu: #utilitiesMenu:) hideScrollBarsIndefinitely
frame: (0 at 0.95 corner: 1 at 1).
+ borderWidth := [SystemWindow borderWidth] "Squeak 4.1"
+ on: MessageNotUnderstood
+ do: [:ex| 0]. "3.8"
+ borderWidth := borderWidth + window borderWidth.
+ window openInWorldExtent: (self desiredDisplayExtent
+ + (2 * borderWidth)
+ + (0 at window labelHeight)
- theWindow openInWorldExtent: (self desiredDisplayExtent
- + (2 * theWindow borderWidth)
- + (0 at theWindow labelHeight)
* (1@(1/0.95))) rounded!
Item was added:
+ ----- Method: CogVMSimulator>>savedWindowSize (in category 'I/O primitives') -----
+ savedWindowSize
+ ^savedWindowSize ifNil: [0]!
Item was added:
+ ----- Method: CogVMSimulator>>shortPrintFrame: (in category 'debug printing') -----
+ shortPrintFrame: theFP
+ self transcript ensureCr.
+ ^super shortPrintFrame: theFP!
Item was removed:
- ----- Method: Cogit>>markAndTraceMachineCodeForIncrementalGC (in category 'jit - api') -----
- markAndTraceMachineCodeForIncrementalGC
- "Free any methods that refer to unmarked objects, unlinking sends to freed methods."
- | pointer cogMethod |
- <var: #cogMethod type: #'CogMethod *'>
- objectMemory leakCheckIncrementalGC ifTrue:
- [self assert: self allMachineCodeObjectReferencesValid].
- codeModified := false.
- pointer := methodZone youngReferrers.
- [pointer < methodZone zoneEnd] whileTrue:
- [cogMethod := coInterpreter cCoerceSimple: (objectMemory longAt: pointer) to: #'CogMethod *'.
- cogMethod cmRefersToYoung ifTrue:
- [self assert: (self cogMethodDoesntLookKosher: cogMethod) = 0.
- self assert: (cogMethod cmType = CMMethod
- or: [cogMethod cmType = CMOpenPIC]).
- (objectMemory isYoung: cogMethod selector) ifTrue:
- [objectMemory markAndTrace: cogMethod selector].
- cogMethod cmType = CMMethod ifTrue:
- [(objectMemory isYoung: cogMethod methodObject) ifTrue:
- [objectMemory markAndTrace: cogMethod methodObject].
- self markYoungObjectsIn: cogMethod]].
- pointer := pointer + BytesPerWord].
- objectMemory leakCheckIncrementalGC ifTrue:
- [self assert: self allMachineCodeObjectReferencesValid].
- codeModified ifTrue: "After updating oops in inline caches we need to flush the icache."
- [processor flushICacheFrom: methodZoneBase to: methodZone limitZony asInteger]!
Item was added:
+ ----- Method: Cogit>>markAndTraceMachineCodeForNewSpaceGC (in category 'jit - api') -----
+ markAndTraceMachineCodeForNewSpaceGC
+ "Free any methods that refer to unmarked objects, unlinking sends to freed methods."
+ | pointer cogMethod |
+ <var: #cogMethod type: #'CogMethod *'>
+ objectMemory leakCheckNewSpaceGC ifTrue:
+ [self assert: self allMachineCodeObjectReferencesValid].
+ codeModified := false.
+ pointer := methodZone youngReferrers.
+ [pointer < methodZone zoneEnd] whileTrue:
+ [cogMethod := coInterpreter cCoerceSimple: (objectMemory longAt: pointer) to: #'CogMethod *'.
+ cogMethod cmRefersToYoung ifTrue:
+ [self assert: (self cogMethodDoesntLookKosher: cogMethod) = 0.
+ self assert: (cogMethod cmType = CMMethod
+ or: [cogMethod cmType = CMOpenPIC]).
+ (objectMemory isYoung: cogMethod selector) ifTrue:
+ [objectMemory markAndTrace: cogMethod selector].
+ cogMethod cmType = CMMethod ifTrue:
+ [(objectMemory isYoung: cogMethod methodObject) ifTrue:
+ [objectMemory markAndTrace: cogMethod methodObject].
+ self markYoungObjectsIn: cogMethod]].
+ pointer := pointer + BytesPerWord].
+ objectMemory leakCheckIncrementalGC ifTrue:
+ [self assert: self allMachineCodeObjectReferencesValid].
+ codeModified ifTrue: "After updating oops in inline caches we need to flush the icache."
+ [processor flushICacheFrom: methodZoneBase to: methodZone limitZony asInteger]!
Item was changed:
----- Method: Cogit>>markAndTraceObjectsOrFreeMachineCode: (in category 'jit - api') -----
markAndTraceObjectsOrFreeMachineCode: inFullGC
<api>
inFullGC
ifTrue: [self markAndTraceOrFreeMachineCodeForFullGC]
+ ifFalse: [self markAndTraceMachineCodeForNewSpaceGC]!
- ifFalse: [self markAndTraceMachineCodeForIncrementalGC]!
Item was changed:
----- Method: NewObjectMemory>>runLeakCheckerForFullGC: (in category 'debug support') -----
runLeakCheckerForFullGC: fullGCFlag
<inline: false>
(fullGCFlag
ifTrue: [self leakCheckFullGC]
+ ifFalse: [self leakCheckNewSpaceGC]) ifTrue:
- ifFalse: [self leakCheckIncrementalGC]) ifTrue:
[fullGCFlag
ifTrue: [coInterpreter reverseDisplayFrom: 0 to: 7]
ifFalse: [coInterpreter reverseDisplayFrom: 8 to: 15].
self clearLeakMapAndMapAccessibleObjects.
self assert: self checkHeapIntegrity.
self assert: coInterpreter checkInterpreterIntegrity.
self assert: coInterpreter checkStackIntegrity.
self assert: (coInterpreter checkCodeIntegrity: fullGCFlag).
self validate "simulation only"]!
Item was changed:
----- Method: Spur32BitMMLESimulator>>scavengingGCTenuringIf: (in category 'generation scavenging') -----
scavengingGCTenuringIf: tenuringCriterion
"Run the scavenger."
+ "self halt: (statScavenges + 1) printString, ((statScavenges between: 9 and: 19)
- self halt: (statScavenges + 1) printString, ((statScavenges between: 9 and: 19)
ifTrue: ['th']
+ ifFalse: [#('st' 'nd' 'rd') at: (statScavenges + 1) \\ 10 ifAbsent: 'th']), ' scavenge'."
- ifFalse: [#('st' 'nd' 'rd') at: (statScavenges + 1) \\ 10 ifAbsent: 'th']), ' scavenge'.
^super scavengingGCTenuringIf: tenuringCriterion!
Item was changed:
----- Method: SpurGenerationScavenger>>computeTenuringThreshold (in category 'scavenger') -----
computeTenuringThreshold
| fractionSurvived |
<var: 'fractionSurvived' type: #float>
+ fractionSurvived := futureSpace limit = futureSpace start
+ ifTrue:
+ [0.0]
+ ifFalse:
+ [(futureSurvivorStart - futureSpace start) asFloat
+ / (futureSpace limit - futureSpace start)].
- fractionSurvived := (futureSurvivorStart - futureSpace start) asFloat
- / (futureSpace limit - futureSpace start).
tenuringThreshold := fractionSurvived > 0.9
ifTrue: [((pastSpace limit - pastSpace start) * (1.0 - tenuringProportion)) rounded + pastSpace start]
ifFalse: [0]!
Item was changed:
----- Method: SpurMemoryManager>>characterValueOf: (in category 'immediates') -----
characterValueOf: oop
"Immediate characters are unsigned"
+ ^oop asUnsignedInteger >> self numTagBits!
- ^(self cCoerceSimple: oop to: #'unsigned long') >> self numTagBits!
Item was changed:
----- Method: SpurMemoryManager>>classTableRootObj: (in category 'accessing') -----
classTableRootObj: anOop
- "For mapInterpreterOops"
classTableRootObj := anOop.
classTableFirstPage := self fetchPointer: 0 ofObject: classTableRootObj.
self assert: (self numSlotsOf: classTableRootObj) = (1 << (self classIndexFieldWidth - self classTableMajorIndexShift)).
+ self assert: (self numSlotsOf: classTableFirstPage) - 1 = self classTableMinorIndexMask.
+ "set classTableIndex to the start of the last used page"
+ 2 to: (self numSlotsOf: classTableRootObj) - 1 do:
+ [:i|
+ (self fetchPointer: i ofObject: classTableRootObj) = nilObj ifTrue:
+ [classTableIndex := i << self classTableMajorIndexShift.
+ ^self]].
+ "no unused pages; set it to the start of the second page."
+ classTableIndex := 1 << self classTableMajorIndexShift!
- self assert: (self numSlotsOf: classTableFirstPage) - 1 = self classTableMinorIndexMask!
Item was added:
+ ----- Method: SpurMemoryManager>>findString: (in category 'debug support') -----
+ findString: aCString
+ "Print the oops of all string-like things that have the same characters as aCString"
+ <api>
+ <var: #aCString type: #'char *'>
+ | cssz |
+ cssz := self strlen: aCString.
+ self allObjectsDo:
+ [:obj|
+ ((self isBytesNonImm: obj)
+ and: [(self lengthOf: obj) = cssz
+ and: [(self str: aCString n: (self pointerForOop: obj + BaseHeaderSize) cmp: cssz) = 0]]) ifTrue:
+ [coInterpreter printHex: obj; space; printOopShort: obj; cr]]!
Item was changed:
----- Method: SpurMemoryManager>>initializeFreeSpacePostLoad: (in category 'snapshot') -----
initializeFreeSpacePostLoad: freeListObj
"Reinitialize the free list info. The freeLists object needs to be swizzled
because its neither a free, nor a pointer object. Free objects have already
been swizzled in adjustAllOopsBy:"
self assert: (self numSlotsOf: freeListObj) = self numFreeLists.
self assert: (self formatOf: freeListObj) = (self wordSize = 4
ifTrue: [self firstLongFormat]
ifFalse: [self sixtyFourBitIndexableFormat]).
- segmentManager numSegments = 0 ifTrue: "true in Spur image bootstrap"
- [^self].
- self halt.
freeLists := self firstIndexableField: freeListObj.
0 to: self numFreeLists - 1 do:
[:i|
(freeLists at: i) ~= 0 ifTrue:
[freeListsMask := freeListsMask bitOr: (1 << i).
+ segmentManager numSegments > 0 ifTrue: "false in Spur image bootstrap"
- segmentManager numSegments > 0 ifTrue:
[freeLists at: i put: (segmentManager swizzleObj: (freeLists at: i))]]].
totalFreeOldSpace := self totalFreeListBytes!
Item was added:
+ ----- Method: SpurMemoryManager>>initializeNewSpaceVariables (in category 'generation scavenging') -----
+ initializeNewSpaceVariables
+ startOfMemory ifNotNil: "true in bootstrap"
+ [^self].
+ freeStart := scavenger eden start.
+ pastSpaceStart := scavenger pastSpace start.
+ scavengeThreshold := scavenger eden limit
+ - (scavenger edenBytes / 64)
+ - coInterpreter interpreterAllocationReserveBytes.
+ startOfMemory := scavenger pastSpace start min: scavenger futureSpace start.
+ self assert: startOfMemory < scavenger eden start.
+ self initSpaceForAllocationCheck: scavenger eden!
Item was changed:
----- Method: SpurMemoryManager>>initializeObjectMemory: (in category 'initialization') -----
initializeObjectMemory: bytesToShift
"Initialize object memory variables at startup time. Assume endOfMemory is initially set (by the image-reading code) to the end of the last object in the image. Initialization redefines endOfMemory to be the end of the object allocation area based on the total available memory, but reserving some space for forwarding blocks."
"Assume: image reader initializes the following variables:
memory
memoryLimit
specialObjectsOop
lastHash
"
<inline: false>
| freeListObj |
- self halt.
segmentManager adjustSegmentSwizzlesBy: bytesToShift.
"image may be at a different address; adjust oops for new location"
self adjustAllOopsBy: bytesToShift.
segmentManager numSegments > 0 "false if Spur image bootstrap"
ifTrue: [specialObjectsOop := segmentManager swizzleObj: specialObjectsOop]
ifFalse: [self assert: bytesToShift = 0].
"heavily used special objects"
nilObj := self splObj: NilObject.
falseObj := self splObj: FalseObject.
trueObj := self splObj: TrueObject.
"In Cog we insist that nil, true & false are next to each other (Cogit generates tighter
conditional branch code as a result). In addition, Spur places the free lists and
class table root page immediately following them."
self assert: nilObj = newSpaceLimit.
self assert: falseObj = (self objectAfter: nilObj).
self assert: trueObj = (self objectAfter: falseObj).
freeListObj := self objectAfter: trueObj.
self classTableRootObj: (self objectAfter: freeListObj).
self initializeFreeSpacePostLoad: freeListObj.
segmentManager collapseSegmentsPostSwizzle.
+
+ self initializeNewSpaceVariables.
- .
self initializeOldSpaceFirstFree: freeOldSpaceStart. "initializes endOfMemory, freeStart"
"lowSpaceThreshold := 0.
signalLowSpace := false.
remapBufferCount := 0.
tenuringThreshold := 2000. ""tenure all suriving objects if survivor count is over this threshold""
growHeadroom := 4*1024*1024. ""four megabytes of headroom when growing""
shrinkThreshold := 8*1024*1024. ""eight megabytes of free space before shrinking""
""garbage collection statistics""
statFullGCs := 0.
statFullGCUsecs := 0.
statIncrGCs := 0.
statIncrGCUsecs := 0.
statTenures := 0.
statRootTableOverflows := 0.
statGrowMemory := 0.
statShrinkMemory := 0.
forceTenureFlag := 0.
gcBiasToGrow := 0.
gcBiasToGrowGCLimit := 0.
extraRootCount := 0."!
Item was added:
+ ----- Method: SpurMemoryManager>>lastPointerOfWhileSwizzling: (in category 'snapshot') -----
+ lastPointerOfWhileSwizzling: objOop
+ "Answer the byte offset of the last pointer field of the given object.
+ Works with CompiledMethods, as well as ordinary objects.
+ Does not examine the stack pointer of contexts to be sure to swizzle
+ the nils that fill contexts on snapshot."
+ <api>
+ <inline: true>
+ <asmLabel: false>
+ | fmt numLiterals |
+ fmt := self formatOf: objOop.
+ self assert: fmt ~= self forwardedFormat.
+ fmt <= self lastPointerFormat ifTrue:
+ [^(self numSlotsOf: objOop) - 1 * BytesPerOop + self baseHeaderSize "all pointers"].
+ fmt < self firstCompiledMethodFormat ifTrue: [^0]. "no pointers"
+
+ "CompiledMethod: contains both pointers and bytes"
+ numLiterals := coInterpreter literalCountOf: objOop.
+ ^numLiterals + LiteralStart - 1 * BytesPerOop + self baseHeaderSize!
Item was changed:
----- Method: SpurMemoryManager>>leakCheckFullGC (in category 'debug support') -----
leakCheckFullGC
<api>
^(checkForLeaks bitAnd: 1) ~= 0!
Item was added:
+ ----- Method: SpurMemoryManager>>leakCheckNewSpaceGC (in category 'debug support') -----
+ leakCheckNewSpaceGC
+ <api>
+ ^(checkForLeaks bitAnd: 2) ~= 0!
Item was removed:
- ----- Method: SpurMemoryManager>>leakCheckScavenge (in category 'debug support') -----
- leakCheckScavenge
- <api>
- ^(checkForLeaks bitAnd: 2) ~= 0!
Item was changed:
----- Method: SpurMemoryManager>>runLeakCheckerForFullGC: (in category 'debug support') -----
runLeakCheckerForFullGC: fullGCFlag
<inline: false>
(fullGCFlag
ifTrue: [self leakCheckFullGC]
+ ifFalse: [self leakCheckNewSpaceGC]) ifTrue:
- ifFalse: [self leakCheckScavenge]) ifTrue:
[fullGCFlag
ifTrue: [coInterpreter reverseDisplayFrom: 0 to: 7]
ifFalse: [coInterpreter reverseDisplayFrom: 8 to: 15].
self clearLeakMapAndMapAccessibleObjects.
self assert: self checkHeapIntegrity.
self assert: coInterpreter checkInterpreterIntegrity.
self assert: coInterpreter checkStackIntegrity.
self assert: (coInterpreter checkCodeIntegrity: fullGCFlag)]!
Item was changed:
----- Method: SpurMemoryManager>>scavengingGCTenuringIf: (in category 'generation scavenging') -----
scavengingGCTenuringIf: tenuringCriterion
"Run the scavenger."
self assert: remapBufferCount = 0.
+ self assert: (segmentManager numSegments = 0 "true in the spur image bootstrap"
+ or: [scavenger eden limit - freeStart > coInterpreter interpreterAllocationReserveBytes]).
self checkFreeSpace.
"coInterpreter printCallStackFP: coInterpreter framePointer"
self runLeakCheckerForFullGC: false.
coInterpreter
preGCAction: GCModeIncr;
"would prefer this to be in mapInterpreterOops, but
compatibility with ObjectMemory dictates it goes here."
flushMethodCacheFrom: startOfMemory to: newSpaceLimit.
needGCFlag := false.
gcStartUsecs := coInterpreter ioUTCMicrosecondsNow.
scavengeInProgress := true.
scavenger tenuringCriterion: tenuringCriterion.
pastSpaceStart := scavenger scavenge.
self assert: (self
oop: pastSpaceStart
isGreaterThanOrEqualTo: scavenger pastSpace start
andLessThanOrEqualTo: scavenger pastSpace limit).
freeStart := scavenger eden start.
self initSpaceForAllocationCheck: scavenger eden.
scavengeInProgress := false.
statScavenges := statScavenges + 1.
statGCEndUsecs := coInterpreter ioUTCMicrosecondsNow.
statSGCDeltaUsecs := statGCEndUsecs - gcStartUsecs.
statScavengeGCUsecs := statScavengeGCUsecs + statSGCDeltaUsecs.
coInterpreter postGCAction.
self runLeakCheckerForFullGC: false.
self checkFreeSpace!
Item was changed:
----- Method: SpurMemoryManager>>setHeapBase:memoryLimit:endOfMemory: (in category 'snapshot') -----
setHeapBase: heapBase memoryLimit: memLimit endOfMemory: memEnd
+ "Transcript
- Transcript
cr; nextPutAll: 'heapBase: '; print: heapBase; nextPut: $/; nextPutAll: heapBase hex;
nextPutAll: ' memLimit '; print: memLimit; nextPut: $/; nextPutAll: memLimit hex;
+ nextPutAll: ' memEnd '; print: memEnd; nextPut: $/; nextPutAll: memEnd hex; cr; flush."
- nextPutAll: ' memEnd '; print: memEnd; nextPut: $/; nextPutAll: memEnd hex; cr; flush.
newSpaceLimit := heapBase
+ self newSpaceBytes
+ coInterpreter interpreterAllocationReserveBytes.
freeOldSpaceStart := memEnd.
endOfMemory := memLimit.
scavenger
newSpaceStart: heapBase
newSpaceBytes: newSpaceLimit - heapBase
edenBytes: newSpaceLimit - heapBase
* (self scavengerDenominator - self numSurvivorSpaces) // self scavengerDenominator.
freeStart := scavenger eden start.
pastSpaceStart := scavenger pastSpace start!
Item was changed:
----- Method: SpurMemoryManager>>swizzleFieldsOfObject: (in category 'snapshot') -----
swizzleFieldsOfObject: oop
| fieldAddr fieldOop |
<inline: true>
+ fieldAddr := oop + (self lastPointerOfWhileSwizzling: oop).
- fieldAddr := oop + (self lastPointerOf: oop).
[self oop: fieldAddr isGreaterThanOrEqualTo: oop + self baseHeaderSize] whileTrue:
[fieldOop := self longAt: fieldAddr.
(self isNonImmediate: fieldOop) ifTrue:
[self longAt: fieldAddr put: (segmentManager swizzleObj: fieldOop)].
fieldAddr := fieldAddr - BytesPerOop]!
Item was added:
+ ----- Method: StackInterpreter>>bereaveAndNormalizeContextsAndFlushExternalPrimitives (in category 'image save/restore') -----
+ bereaveAndNormalizeContextsAndFlushExternalPrimitives
+ "Clean up right before saving an image, sweeping memory and:
+ * nilling out all fields of contexts above the stack pointer
+ * bereaving widowed contexts.
+ * flushing external primitives.
+ By ensuring that all contexts are single in a snapshot (i.e. that no married contexts
+ exist) we can maintain the invariant that a married or widowed context's frame
+ reference (in its sender field) must point into the stack pages since no married or
+ widowed contexts are present from older runs of the system."
+ objectMemory allObjectsDo:
+ [:obj| | header fmt sz |
+ header := self longAt: obj.
+ fmt := objectMemory formatOfHeader: header.
+ "Clean out context"
+ (fmt = objectMemory indexablePointersFormat
+ and: [objectMemory isContextHeader: header]) ifTrue:
+ ["All contexts have been divorced. Bereave remaining widows."
+ (self isMarriedOrWidowedContext: obj) ifTrue:
+ [self markContextAsDead: obj].
+ "Fill slots beyond top of stack with nil"
+ (self fetchStackPointerOf: obj) + CtxtTempFrameStart
+ to: (objectMemory numSlotsOf: obj) - 1
+ do: [:i |
+ objectMemory
+ storePointerUnchecked: i
+ ofObject: obj
+ withValue: objectMemory nilObject]].
+ "Clean out external functions from compiled methods"
+ fmt >= objectMemory firstCompiledMethodFormat ifTrue:
+ ["Its primitiveExternalCall"
+ (self primitiveIndexOf: obj) = PrimitiveExternalCallIndex ifTrue:
+ [self flushExternalPrimitiveOf: obj]]].!
Item was changed:
----- Method: StackInterpreter>>snapshotCleanUp (in category 'image save/restore') -----
snapshotCleanUp
"Clean up right before saving an image, garbage collecting, sweeping memory and:
+ * nilling out all fields of contexts above the stack pointer.
+ * flushing external primitives
+ * bereaving widowed contexts
+ * clearing the root bit of any object in the root table.
- * nilling out all fields of contexts above the stack pointer.
- * flushing external primitives
- * clearing the root bit of any object in the root table
- * bereaving widowed contexts.
By ensuring that all contexts are single in a snapshot (i.e. that no married contexts
exist) we can maintain the invariant that a married or widowed context's frame
reference (in its sender field) must point into the stack pages since no married or
widowed contexts are present from older runs of the system."
objectMemory hasSpurMemoryManagerAPI
ifTrue: [objectMemory flushNewSpace]
ifFalse: [objectMemory incrementalGC]. "compact memory and compute the size of the memory actually in use"
"maximimize space for forwarding table"
objectMemory fullGC.
+ self bereaveAndNormalizeContextsAndFlushExternalPrimitives.
- objectMemory allObjectsDo:
- [:obj| | header fmt sz |
- header := self longAt: obj.
- fmt := objectMemory formatOfHeader: header.
- "Clean out context"
- (fmt = objectMemory indexablePointersFormat
- and: [objectMemory isContextHeader: header]) ifTrue:
- ["All contexts have been divorced. Bereave remaining widows."
- (self isMarriedOrWidowedContext: obj) ifTrue:
- [self markContextAsDead: obj].
- "Fill slots beyond top of stack with nil"
- (self fetchStackPointerOf: obj) + CtxtTempFrameStart
- to: (objectMemory numSlotsOf: obj) - 1
- do: [:i |
- objectMemory
- storePointerUnchecked: i
- ofObject: obj
- withValue: objectMemory nilObject]].
- "Clean out external functions from compiled methods"
- fmt >= objectMemory firstCompiledMethodFormat ifTrue:
- ["Its primitiveExternalCall"
- (self primitiveIndexOf: obj) = PrimitiveExternalCallIndex ifTrue:
- [self flushExternalPrimitiveOf: obj]]].
objectMemory hasSpurMemoryManagerAPI ifFalse:
[objectMemory clearRootsTable]!
Item was changed:
----- Method: StackInterpreterSimulator>>openAsMorph (in category 'UI') -----
openAsMorph
"Open a morphic view on this simulation."
+ | localImageName borderWidth window |
- | window localImageName |
localImageName := imageName
ifNotNil: [FileDirectory default localNameFor: imageName]
ifNil: [' synthetic image'].
window := (SystemWindow labelled: 'Simulation of ', localImageName) model: self.
window addMorph: (displayView := ImageMorph new image: displayForm)
frame: (0 at 0 corner: 1 at 0.8).
transcript := TranscriptStream on: (String new: 10000).
window addMorph: (PluggableTextMorph
on: transcript text: nil accept: nil
readSelection: nil menu: #codePaneMenu:shifted:)
frame: (0 at 0.8 corner: 0.7 at 1).
-
window addMorph: (PluggableTextMorph on: self
text: #byteCountText accept: nil
readSelection: nil menu: #utilitiesMenu:) hideScrollBarsIndefinitely
frame: (0.7 at 0.8 corner: 1 at 1).
+ borderWidth := [SystemWindow borderWidth] "Squeak 4.1"
+ on: MessageNotUnderstood
+ do: [:ex| 0]. "3.8"
+ borderWidth := borderWidth + window borderWidth.
window openInWorldExtent: (self desiredDisplayExtent
+ + (2 * borderWidth)
- + (2 * window borderWidth)
+ (0 at window labelHeight)
* (1@(1/0.8))) rounded.
^window!
Item was changed:
----- Method: StackInterpreterSimulator>>openAsMorphNoTranscript (in category 'UI') -----
openAsMorphNoTranscript
"Open a morphic view on this simulation."
+ | localImageName borderWidth window |
- | window localImageName |
localImageName := FileDirectory default localNameFor: imageName.
window := (SystemWindow labelled: 'Simulation of ' , localImageName) model: self.
window addMorph: (displayView := ImageMorph new image: displayForm)
frame: (0 at 0 corner: 1 at 0.95).
window addMorph: (PluggableTextMorph on: self
+ text: #byteCountText accept: nil
+ readSelection: nil menu: #utilitiesMenu:) hideScrollBarsIndefinitely
- text: #byteCountText accept: nil) hideScrollBarsIndefinitely
frame: (0 at 0.95 corner: 1 at 1).
+ borderWidth := [SystemWindow borderWidth] "Squeak 4.1"
+ on: MessageNotUnderstood
+ do: [:ex| 0]. "3.8"
+ borderWidth := borderWidth + window borderWidth.
window openInWorldExtent: (self desiredDisplayExtent
+ + (2 * borderWidth)
- + (2 * window borderWidth)
+ (0 at window labelHeight)
* (1@(1/0.95))) rounded!
Item was added:
+ ----- Method: StackInterpreterSimulator>>savedWindowSize (in category 'I/O primitives') -----
+ savedWindowSize
+ ^savedWindowSize ifNil: [0]!
Item was added:
+ ----- Method: StackInterpreterSimulator>>setDisplayForm: (in category 'spur bootstrap') -----
+ setDisplayForm: aForm
+ displayForm := aForm!
Item was added:
+ ----- Method: StackInterpreterSimulator>>shortPrintFrame: (in category 'debug printing') -----
+ shortPrintFrame: theFP
+ self transcript ensureCr.
+ ^super shortPrintFrame: theFP!
More information about the Vm-dev
mailing list