[Vm-dev] VM Maker: VMMaker.oscog-eem.1048.mcz
commits at source.squeak.org
commits at source.squeak.org
Tue Feb 10 22:58:54 UTC 2015
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.1048.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.1048
Author: eem
Time: 10 February 2015, 2:57:18.714 pm
UUID: 8c759c0d-f612-4018-8a05-45ec7f6af78f
Ancestors: VMMaker.oscog-eem.1047
Refactor leak checking code so that GCModes are
flags and coincide with flags for what GC events to
leak check. Hence ensure leak checking is actually
run when requested. As part of this move the shrink action from postGCAction: into the memory
managers and hence allow Spur to not shrink on scavenge.
Fix bugs with immediate character printing.
Allow printing the mark state of free chunks.
Spur:
Fix some dumb slips in the image segment code.
Fix bogus assert in remapObj: and only copy-and-forward
there-in in the right cicumstance.
=============== Diff against VMMaker.oscog-eem.1047 ===============
Item was changed:
----- Method: CoInterpreter>>checkCodeIntegrity: (in category 'object memory support') -----
+ checkCodeIntegrity: gcModes
- checkCodeIntegrity: fullGCFlag
"Perform an integrity/leak check using the heapMap. Assume
clearLeakMapAndMapAccessibleObjects has set a bit at each
object's header. Check that all object references in machine
code are valid. Answer if all checks pass."
+ ^cogit checkIntegrityOfObjectReferencesInCode: gcModes!
- ^cogit checkIntegrityOfObjectReferencesInCode: fullGCFlag!
Item was changed:
----- Method: CoInterpreter>>printFrame:WithSP: (in category 'debug printing') -----
printFrame: theFP WithSP: theSP
<api>
| theMethod theMethodEnd numArgs numTemps rcvrAddress topThing |
<inline: false>
<var: #theFP type: #'char *'>
<var: #theSP type: #'char *'>
<var: #addr type: #'char *'>
<var: #rcvrAddress type: #'char *'>
<var: #cogMethod type: #'CogBlockMethod *'>
<var: #homeMethod type: #'CogMethod *'>
self cCode: '' inSmalltalk: [self transcript ensureCr].
+ (stackPages couldBeFramePointer: theFP) ifNil:
+ [self printHexPtr: theFP; print: ' is not in the stack zone?!!'; cr.
+ ^nil].
(self isMachineCodeFrame: theFP)
ifTrue:
[| cogMethod homeMethod |
cogMethod := self mframeCogMethod: theFP.
homeMethod := self mframeHomeMethod: theFP.
theMethod := homeMethod asInteger.
theMethodEnd := homeMethod asInteger + homeMethod blockSize.
numArgs := cogMethod cmNumArgs.
numTemps := self temporaryCountOfMethodHeader: homeMethod methodHeader]
ifFalse:
[theMethod := self frameMethodObject: theFP.
theMethodEnd := theMethod + (objectMemory sizeBitsOfSafe: theMethod).
numArgs := self iframeNumArgs: theFP.
numTemps := self tempCountOf: theMethod].
(self frameIsBlockActivation: theFP) ifTrue:
[| rcvrOrClosure |
"No BlockLocalTempCounter in the Cogit's C code, so quick hack is to use numCopied + numArgs"
rcvrOrClosure := self pushedReceiverOrClosureOfFrame: theFP.
((objectMemory isNonImmediate: rcvrOrClosure)
and: [(objectMemory addressCouldBeObj: rcvrOrClosure)
and: [(objectMemory fetchClassOfNonImm: rcvrOrClosure) = (objectMemory splObj: ClassBlockClosure)]])
ifTrue: [numTemps := numArgs + (self stSizeOf: rcvrOrClosure)]
ifFalse: [numTemps := numArgs]].
self shortPrintFrame: theFP.
(self isBaseFrame: theFP) ifTrue:
[self printFrameOop: '(caller ctxt'
at: theFP + (self frameStackedReceiverOffset: theFP) + (2 * objectMemory wordSize).
self printFrameOop: '(saved ctxt'
at: theFP + (self frameStackedReceiverOffset: theFP) + (1 * objectMemory wordSize)].
self printFrameOop: 'rcvr/clsr'
at: theFP + FoxCallerSavedIP + ((numArgs + 1) * objectMemory wordSize).
numArgs to: 1 by: -1 do:
[:i|
self printFrameOop: 'arg' index: numArgs - i at: theFP + FoxCallerSavedIP + (i * objectMemory wordSize)].
self printFrameThing: 'caller ip'
at: theFP + FoxCallerSavedIP
extraString: ((stackPages longAt: theFP + FoxCallerSavedIP) = cogit ceReturnToInterpreterPC ifTrue:
['ceReturnToInterpreter']).
self printFrameThing: 'saved fp' at: theFP + FoxSavedFP.
self printFrameMethodFor: theFP.
(self isMachineCodeFrame: theFP) ifTrue:
[self printFrameFlagsForFP: theFP].
self printFrameOop: 'context' at: theFP + FoxThisContext.
(self isMachineCodeFrame: theFP) ifFalse:
[self printFrameFlagsForFP: theFP].
(self isMachineCodeFrame: theFP)
ifTrue: [rcvrAddress := theFP + FoxMFReceiver]
ifFalse:
[self printFrameThing: 'saved ip'
at: theFP + FoxIFSavedIP
extra: ((self iframeSavedIP: theFP) = 0
ifTrue: [0]
ifFalse: [(self iframeSavedIP: theFP) - theMethod + 2 - objectMemory baseHeaderSize]).
rcvrAddress := theFP + FoxIFReceiver].
self printFrameOop: 'receiver' at: rcvrAddress.
topThing := stackPages longAt: theSP.
(self oop: topThing isGreaterThanOrEqualTo: theMethod andLessThan: theMethodEnd)
ifTrue:
[rcvrAddress - objectMemory wordSize to: theSP + objectMemory wordSize by: objectMemory wordSize negated do:
[:addr| | index |
index := rcvrAddress - addr / objectMemory wordSize + numArgs.
index <= numTemps
ifTrue: [self printFrameOop: 'temp' index: index - 1 at: addr]
ifFalse: [self printFrameOop: ((self frameIsBlockActivation: theFP)
ifTrue: ['temp/stck']
ifFalse: ['stck'])
at: addr]].
self printFrameThing: 'frame ip'
at: theSP
extra: ((self isMachineCodeFrame: theFP)
ifTrue: [topThing - theMethod]
ifFalse: [topThing - theMethod + 2 - objectMemory baseHeaderSize])]
ifFalse:
[rcvrAddress - objectMemory wordSize to: theSP by: objectMemory wordSize negated do:
[:addr| | index |
index := rcvrAddress - addr / objectMemory wordSize + numArgs.
index <= numTemps
ifTrue: [self printFrameOop: 'temp' index: index - 1 at: addr]
ifFalse: [self printFrameOop: ((self frameIsBlockActivation: theFP)
ifTrue: ['temp/stck']
ifFalse: ['stck'])
at: addr]]]!
Item was changed:
----- Method: Cogit>>checkIntegrityOfObjectReferencesInCode: (in category 'debugging') -----
+ checkIntegrityOfObjectReferencesInCode: gcModes
- checkIntegrityOfObjectReferencesInCode: fullGCFlag
<api>
"Answer if all references to objects in machine-code are valid."
| cogMethod ok count |
<var: #cogMethod type: #'CogMethod *'>
cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
ok := true.
[cogMethod < methodZone limitZony] whileTrue:
[cogMethod cmType ~= CMFree ifTrue:
[cogMethod cmRefersToYoung ifTrue:
[(count := methodZone occurrencesInYoungReferrers: cogMethod) ~= 1 ifTrue:
[coInterpreter print: 'young referrer CM '; printHex: cogMethod asInteger.
count = 0
ifTrue: [coInterpreter print: ' is not in youngReferrers'; cr]
ifFalse: [coInterpreter print: ' is in youngReferrers '; printNum: count; print: ' times!!'; cr].
ok := false]].
(objectRepresentation checkValidOopReference: cogMethod selector) ifFalse:
[coInterpreter print: 'object leak in CM '; printHex: cogMethod asInteger; print: ' selector'; cr.
ok := false].
cogMethod cmType = CMMethod
ifTrue:
[self assert: cogMethod objectHeader = objectMemory nullHeaderForMachineCodeMethod.
(objectRepresentation checkValidObjectReference: cogMethod methodObject) ifFalse:
[coInterpreter print: 'object leak in CM '; printHex: cogMethod asInteger; print: ' methodObject'; cr.
ok := false].
(objectMemory isOopCompiledMethod: cogMethod methodObject) ifFalse:
[coInterpreter print: 'non-method in CM '; printHex: cogMethod asInteger; print: ' methodObject'; cr.
ok := false].
(self mapFor: cogMethod
performUntil: #checkIfValidOopRef:pc:cogMethod:
arg: cogMethod asInteger) ~= 0
ifTrue: [ok := false].
+ (objectMemory hasSpurMemoryManagerAPI
+ or: [gcModes anyMask: GCModeNewSpace]) ifTrue:
- fullGCFlag ifFalse:
[(((objectMemory isYoungObject: cogMethod methodObject)
or: [objectMemory isYoung: cogMethod selector])
and: [cogMethod cmRefersToYoung not]) ifTrue:
[coInterpreter print: 'CM '; printHex: cogMethod asInteger; print: ' refers to young but not marked as such'; cr.
ok := false]]]
ifFalse:
[cogMethod cmType = CMClosedPIC
ifTrue:
[(self checkValidObjectReferencesInClosedPIC: cogMethod) ifFalse:
[ok := false]]
ifFalse:
[cogMethod cmType = CMOpenPIC
ifTrue:
[(self mapFor: cogMethod
performUntil: #checkIfValidOopRef:pc:cogMethod:
arg: cogMethod asInteger) ~= 0
ifTrue: [ok := false]]]]].
cogMethod := methodZone methodAfter: cogMethod].
^ok!
Item was changed:
----- Method: Cogit>>cogitPostGCAction: (in category 'jit - api') -----
cogitPostGCAction: gcMode
<api>
(gcMode = GCModeFull
and: [objectRepresentation allYoungObjectsAgeInFullGC]) ifTrue:
[methodZone voidYoungReferrersPostTenureAll].
"Post-GC update every full method's objectHeader to whatever it needs to be"
self assert: self allMethodsHaveCorrectHeader.
"The youngReferrers should be correct after a GC since that is the point at which it is
pruned. But at other times false positives or free methods on the list are acceptable."
+ self assert: ((gcMode noMask: GCModeFull+GCModeNewSpace) or: [methodZone kosherYoungReferrers])!
- self assert: (gcMode = GCModeBecome or: [methodZone kosherYoungReferrers])!
Item was changed:
----- Method: Cogit>>mapObjectReferencesInMachineCode: (in category 'jit - api') -----
mapObjectReferencesInMachineCode: gcMode
<api>
"Update all references to objects in machine code."
gcMode caseOf: {
+ [GCModeNewSpace] -> [self mapObjectReferencesInMachineCodeForYoungGC].
- [GCModeScavenge] -> [self mapObjectReferencesInMachineCodeForYoungGC].
- [GCModeIncr] -> [self mapObjectReferencesInMachineCodeForYoungGC].
[GCModeFull] -> [self mapObjectReferencesInMachineCodeForFullGC].
[GCModeBecome] -> [self mapObjectReferencesInMachineCodeForBecome] }.
(self asserta: methodZone freeStart <= methodZone youngReferrers) ifFalse:
[self error: 'youngReferrers list overflowed']!
Item was changed:
----- 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 + objectMemory wordSize].
+ objectMemory leakCheckNewSpaceGC ifTrue:
- 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: NewCoObjectMemorySimulator>>incrementalGC (in category 'gc -- mark and sweep') -----
incrementalGC
"If we're /not/ a clone, clone the VM and push it over the cliff.
If it survives, destroy the clone and continue. We should be OK until next time."
+ (self leakCheckNewSpaceGC
- (self leakCheckIncrementalGC
and: [parent isNil]) ifTrue:
[coInterpreter cr; print: 'Incremental GC number '; print: statIncrGCs; tab; flush.
coInterpreter cloneSimulation objectMemory incrementalGC.
Smalltalk garbageCollect].
^super incrementalGC!
Item was changed:
----- Method: NewObjectMemory>>become:with:twoWay:copyHash: (in category 'become') -----
become: array1 with: array2 twoWay: twoWayFlag copyHash: copyHashFlag
"All references to each object in array1 are swapped with all references to the corresponding object in array2. That is, all pointers to one object are replaced with with pointers to the other. The arguments must be arrays of the same length.
Returns PrimNoErr if the primitive succeeds."
"Implementation: Uses forwarding blocks to update references as done in compaction."
| start |
+ self runLeakCheckerFor: GCModeBecome.
- self leakCheckBecome ifTrue:
- [self runLeakCheckerForFullGC: true].
(self isArray: array1) ifFalse:
[^PrimErrBadReceiver].
((self isArray: array2)
and: [(self lastPointerOf: array1) = (self lastPointerOf: array2)]) ifFalse:
[^PrimErrBadArgument].
(twoWayFlag or: [copyHashFlag])
ifTrue: [(self containOnlyOops: array1 and: array2) ifFalse: [^PrimErrInappropriate]]
ifFalse: [(self containOnlyOops: array1) ifFalse: [^PrimErrInappropriate]].
(self prepareForwardingTableForBecoming: array1 with: array2 twoWay: twoWayFlag) ifFalse:
[^PrimErrNoMemory]. "fail; not enough space for forwarding table"
(self allYoung: array1 and: array2)
ifTrue: [start := youngStart"sweep only the young objects plus the roots"]
ifFalse: [start := self startOfMemory"sweep all objects"].
coInterpreter preBecomeAction.
self mapPointersInObjectsFrom: start to: freeStart.
twoWayFlag
ifTrue: [self restoreHeadersAfterBecoming: array1 with: array2]
ifFalse: [self restoreHeadersAfterForwardBecome: copyHashFlag].
coInterpreter postBecomeAction: 0.
self initializeMemoryFirstFree: freeStart. "re-initialize memory used for forwarding table"
+ self runLeakCheckerFor: GCModeBecome.
- self leakCheckBecome ifTrue:
- [self runLeakCheckerForFullGC: true].
^PrimNoErr "success"!
Item was changed:
----- Method: NewObjectMemory>>fullGC (in category 'garbage collection') -----
fullGC
"Do a mark/sweep garbage collection of the entire object memory.
Free inaccessible objects but do not move them."
<inline: false>
fullGCLock > 0 ifTrue:
[self warning: 'aborting fullGC because fullGCLock > 0'.
^self].
+ self runLeakCheckerFor: GCModeFull.
- self runLeakCheckerForFullGC: true.
self preGCAction: GCModeFull.
needGCFlag := false.
gcStartUsecs := self ioUTCMicrosecondsNow.
statSweepCount := statMarkCount := statMkFwdCount := statCompMoveCount := 0.
self clearRootsTable.
self initWeakTableForIncrementalGC: false.
youngStart := self startOfMemory. "process all of memory"
self markPhase: true.
"Sweep phase returns the number of survivors.
Use the up-to-date version instead the one from startup."
totalObjectCount := self sweepPhaseForFullGC.
+ self runLeakCheckerFor: GCModeFull.
- self runLeakCheckerForFullGC: true.
self fullCompaction.
statFullGCs := statFullGCs + 1.
statGCEndUsecs := self ioUTCMicrosecondsNow.
statFullGCUsecs := statFullGCUsecs + (statGCEndUsecs - gcStartUsecs).
self capturePendingFinalizationSignals.
youngStart := freeStart. "reset the young object boundary"
+ self attemptToShrink.
self postGCAction: GCModeFull.
+ self runLeakCheckerFor: GCModeFull!
- self runLeakCheckerForFullGC: true!
Item was changed:
----- Method: NewObjectMemory>>incrementalGC (in category 'garbage collection') -----
incrementalGC
"Do a mark/sweep garbage collection of just the young object
area of object memory (i.e., objects above youngStart), using
the root table to identify objects containing pointers to
young objects from the old object area."
| survivorCount weDidGrow |
<inline: false>
rootTableOverflowed ifTrue:
["root table overflow; cannot do an incremental GC because some roots are missing.
(this should be very rare)"
statRootTableOverflows := statRootTableOverflows + 1.
^self fullGC].
+ self runLeakCheckerFor: GCModeNewSpace.
+ coInterpreter preGCAction: GCModeNewSpace.
- self runLeakCheckerForFullGC: false.
- coInterpreter preGCAction: GCModeIncr.
needGCFlag := false.
gcStartUsecs := self ioUTCMicrosecondsNow.
statSweepCount := statMarkCount := statMkFwdCount := statCompMoveCount := 0.
self initWeakTableForIncrementalGC: true.
"implicitly process memory from youngStart to freeStart"
self markPhase: false.
self assert: weakRootCount <= WeakRootTableSize.
1 to: weakRootCount do:
[:i| self finalizeReference: (weakRoots at: i)].
survivorCount := self sweepPhase.
+ self runLeakCheckerFor: GCModeNewSpace.
- self runLeakCheckerForFullGC: false.
self incrementalCompaction.
statIncrGCs := statIncrGCs + 1.
statGCEndUsecs := self ioUTCMicrosecondsNow.
statIGCDeltaUsecs := statGCEndUsecs - gcStartUsecs.
statIncrGCUsecs := statIncrGCUsecs + statIGCDeltaUsecs.
self capturePendingFinalizationSignals.
statRootTableCount := rootTableCount.
statSurvivorCount := survivorCount.
weDidGrow := false.
(((survivorCount > tenuringThreshold)
or: [rootTableCount >= RootTableRedZone])
or: [forceTenureFlag == true]) ifTrue:
["move up the young space boundary if
* there are too many survivors:
this limits the number of objects that must be
processed on future incremental GC's
* we're about to overflow the roots table:
this limits the number of full GCs that may be caused
by root table overflows in the near future"
forceTenureFlag := false.
statTenures := statTenures + 1.
self clearRootsTable.
((self freeSize < growHeadroom)
and: [gcBiasToGrow > 0]) ifTrue:
[self biasToGrow.
weDidGrow := true].
youngStart := freeStart].
+ self attemptToShrink.
+ coInterpreter postGCAction: GCModeNewSpace.
- coInterpreter postGCAction: GCModeIncr.
+ self runLeakCheckerFor: GCModeNewSpace.
- self runLeakCheckerForFullGC: false.
weDidGrow ifTrue:
[self biasToGrowCheckGCLimit]!
Item was changed:
----- Method: NewObjectMemory>>leakCheckBecome (in category 'debug support') -----
leakCheckBecome
<api>
+ ^(checkForLeaks bitAnd: GCModeBecome) ~= 0!
- ^(checkForLeaks bitAnd: 4) ~= 0!
Item was changed:
----- Method: NewObjectMemory>>leakCheckFullGC (in category 'debug support') -----
leakCheckFullGC
<api>
+ ^(checkForLeaks bitAnd: GCModeFull) ~= 0!
- ^(checkForLeaks bitAnd: 1) ~= 0!
Item was removed:
- ----- Method: NewObjectMemory>>leakCheckIncrementalGC (in category 'debug support') -----
- leakCheckIncrementalGC
- <api>
- ^(checkForLeaks bitAnd: 2) ~= 0!
Item was added:
+ ----- Method: NewObjectMemory>>runLeakCheckerFor: (in category 'debug support') -----
+ runLeakCheckerFor: gcModes
+ <inline: false>
+ (gcModes anyMask: checkForLeaks) ifTrue:
+ [(gcModes anyMask: GCModeFull)
+ 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: gcModes).
+ self validate "simulation only"]!
Item was removed:
- ----- Method: NewObjectMemory>>runLeakCheckerForFullGC: (in category 'debug support') -----
- runLeakCheckerForFullGC: fullGCFlag
- <inline: false>
- (fullGCFlag
- ifTrue: [self leakCheckFullGC]
- ifFalse: [self leakCheckNewSpaceGC]) 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: NewObjectMemory>>setCheckForLeaks: (in category 'debug support') -----
+ setCheckForLeaks: integerFlags
- setCheckForLeaks: anInteger
"0 = do nothing.
1 = check for leaks on fullGC.
2 = check for leaks on incrementalGC.
+ 8 = check for leaks on become"
+ checkForLeaks := integerFlags!
- 4 = check for leaks on become
- 7 = check for leaks on all three."
- checkForLeaks := anInteger!
Item was changed:
----- Method: NewObjectMemorySimulator>>incrementalGC (in category 'gc -- mark and sweep') -----
incrementalGC
"If we're /not/ a clone, clone the VM and push it over the cliff.
If it survives, destroy the clone and continue. We should be OK until next time."
+ (self leakCheckNewSpaceGC
- (self leakCheckIncrementalGC
and: [parent isNil]) ifTrue:
[coInterpreter cr; print: 'Incremental GC number '; print: statIncrGCs; tab; flush.
coInterpreter cloneSimulation objectMemory incrementalGC.
Smalltalk garbageCollect].
^super incrementalGC!
Item was added:
+ ----- Method: ObjectMemory>>attemptToShrink (in category 'allocation') -----
+ attemptToShrink
+ "Attempt to shrink memory after successfully reclaiming lots of memory."
+ | freeSizeNow |
+ freeSizeNow := self freeSize.
+ (freeSizeNow > shrinkThreshold
+ and: [freeSizeNow > growHeadroom]) ifTrue:
+ [self shrinkObjectMemory: freeSizeNow - growHeadroom]!
Item was changed:
----- Method: ObjectMemory>>fullGC (in category 'garbage collection') -----
fullGC
"Do a mark/sweep garbage collection of the entire object memory. Free inaccessible objects but do not move them."
<inline: false>
DoAssertionChecks ifTrue:
[self reverseDisplayFrom: 0 to: 7.
self clearLeakMapAndMapAccessibleObjects.
self checkHeapIntegrity].
self preGCAction: GCModeFull.
gcStartUsecs := self ioUTCMicrosecondsNow.
statSweepCount := statMarkCount := statMkFwdCount := statCompMoveCount := 0.
self clearRootsTable.
self initWeakTableForIncrementalGC: false.
youngStart := self startOfMemory. "process all of memory"
self markPhase.
"Sweep phase returns the number of survivors.
Use the up-to-date version instead the one from startup."
totalObjectCount := self sweepPhase.
self fullCompaction.
allocationCount := 0.
statFullGCs := statFullGCs + 1.
statGCEndTime := self ioMicroMSecs.
statFullGCUsecs := statFullGCUsecs + (self ioUTCMicrosecondsNow - gcStartUsecs).
self capturePendingFinalizationSignals.
youngStart := freeBlock. "reset the young object boundary"
+ self attemptToShrink.
self postGCAction: GCModeFull.
DoAssertionChecks ifTrue:
[self clearLeakMapAndMapAccessibleObjects.
self checkHeapIntegrity.
self reverseDisplayFrom: 0 to: 7]!
Item was changed:
----- Method: ObjectMemory>>incrementalGC (in category 'garbage collection') -----
incrementalGC
"Do a mark/sweep garbage collection of just the young object
area of object memory (i.e., objects above youngStart), using
the root table to identify objects containing pointers to
young objects from the old object area."
| survivorCount weDidGrow |
<inline: false>
rootTableOverflowed ifTrue:
["root table overflow; cannot do an incremental GC because some roots are missing.
(this should be very rare)"
statRootTableOverflows := statRootTableOverflows + 1.
^self fullGC].
DoAssertionChecks ifTrue:
[self reverseDisplayFrom: 8 to: 15.
self checkHeapIntegrity.
self checkInterpreterIntegrity.
self validate].
+ self preGCAction: GCModeNewSpace.
- self preGCAction: GCModeIncr.
"incremental GC and compaction"
gcStartUsecs := self ioUTCMicrosecondsNow.
statSweepCount := statMarkCount := statMkFwdCount := statCompMoveCount := 0.
self initWeakTableForIncrementalGC: true.
self markPhase.
self assert: weakRootCount <= WeakRootTableSize.
1 to: weakRootCount do:[:i| self finalizeReference: (weakRoots at: i)].
survivorCount := self sweepPhase.
self incrementalCompaction.
statAllocationCount := allocationCount.
allocationCount := 0.
statIncrGCs := statIncrGCs + 1.
statGCEndTime := self ioMicroMSecs.
statIGCDeltaUsecs := self ioUTCMicrosecondsNow - gcStartUsecs.
statIncrGCUsecs := statIncrGCUsecs + statIGCDeltaUsecs.
self capturePendingFinalizationSignals.
self forceInterruptCheck. "Force an an interrupt check ASAP.We could choose to be clever here and only do this under certain time conditions. Keep it simple for now"
statRootTableCount := rootTableCount.
statSurvivorCount := survivorCount.
weDidGrow := false.
(((survivorCount > tenuringThreshold)
or: [rootTableCount >= RootTableRedZone])
or: [forceTenureFlag == true])
ifTrue: ["move up the young space boundary if
* there are too many survivors:
this limits the number of objects that must be
processed on future incremental GC's
* we're about to overflow the roots table
this limits the number of full GCs that may be caused
by root table overflows in the near future"
forceTenureFlag := false.
statTenures := statTenures + 1.
self clearRootsTable.
(((self sizeOfFree: freeBlock) < growHeadroom) and:
[gcBiasToGrow > 0])
ifTrue: [self biasToGrow.
weDidGrow := true].
youngStart := freeBlock].
+ self attemptToShrink.
+ self postGCAction: GCModeNewSpace.
- self postGCAction: GCModeIncr.
DoAssertionChecks ifTrue:
[self validate.
self checkHeapIntegrity.
self checkInterpreterIntegrity.
self reverseDisplayFrom: 8 to: 15].
weDidGrow ifTrue: [self biasToGrowCheckGCLimit]!
Item was removed:
- ----- Method: ObjectMemory>>unsignedIntegerSuffix (in category 'as yet unclassified') -----
- unsignedIntegerSuffix
- "Answer the suffix that should be appended to unsigned integer literals in generated code."
-
- ^self wordSize = 4 ifTrue: ['UL'] ifFalse: ['ULL']!
Item was added:
+ ----- Method: Spur32BitMMLECoSimulator>>runLeakCheckerFor:excludeUnmarkedNewSpaceObjs:classIndicesShouldBeValid: (in category 'debug support') -----
+ runLeakCheckerFor: gcModes excludeUnmarkedNewSpaceObjs: excludeUnmarkedNewSpaceObjs classIndicesShouldBeValid: classIndicesShouldBeValid
+ (coInterpreter displayView isNil
+ and: [gcModes anyMask: checkForLeaks]) ifTrue:
+ [coInterpreter transcript nextPutAll: 'leak-checking...'; flush].
+ ^super
+ runLeakCheckerFor: gcModes
+ excludeUnmarkedNewSpaceObjs: excludeUnmarkedNewSpaceObjs
+ classIndicesShouldBeValid: classIndicesShouldBeValid!
Item was removed:
- ----- Method: Spur32BitMMLECoSimulator>>runLeakCheckerForFullGC:excludeUnmarkedNewSpaceObjs:classIndicesShouldBeValid: (in category 'debug support') -----
- runLeakCheckerForFullGC: fullGCFlag excludeUnmarkedNewSpaceObjs: excludeUnmarkedNewSpaceObjs classIndicesShouldBeValid: classIndicesShouldBeValid
- (coInterpreter displayView isNil
- and: [fullGCFlag
- ifTrue: [self leakCheckFullGC]
- ifFalse: [self leakCheckNewSpaceGC]]) ifTrue:
- [coInterpreter transcript nextPutAll: 'leak-checking...'; flush].
- ^super
- runLeakCheckerForFullGC: fullGCFlag
- excludeUnmarkedNewSpaceObjs: excludeUnmarkedNewSpaceObjs
- classIndicesShouldBeValid: classIndicesShouldBeValid!
Item was added:
+ ----- Method: Spur32BitMMLESimulator>>runLeakCheckerFor:excludeUnmarkedNewSpaceObjs:classIndicesShouldBeValid: (in category 'debug support') -----
+ runLeakCheckerFor: gcModes excludeUnmarkedNewSpaceObjs: excludeUnmarkedNewSpaceObjs classIndicesShouldBeValid: classIndicesShouldBeValid
+ (coInterpreter displayView isNil
+ and: [gcModes anyMask: checkForLeaks]) ifTrue:
+ [coInterpreter transcript nextPutAll: 'leak-checking...'; flush].
+ ^super
+ runLeakCheckerFor: gcModes
+ excludeUnmarkedNewSpaceObjs: excludeUnmarkedNewSpaceObjs
+ classIndicesShouldBeValid: classIndicesShouldBeValid!
Item was removed:
- ----- Method: Spur32BitMMLESimulator>>runLeakCheckerForFullGC:excludeUnmarkedNewSpaceObjs:classIndicesShouldBeValid: (in category 'debug support') -----
- runLeakCheckerForFullGC: fullGCFlag excludeUnmarkedNewSpaceObjs: excludeUnmarkedNewSpaceObjs classIndicesShouldBeValid: classIndicesShouldBeValid
- (coInterpreter displayView isNil
- and: [fullGCFlag
- ifTrue: [self leakCheckFullGC]
- ifFalse: [self leakCheckNewSpaceGC]]) ifTrue:
- [coInterpreter transcript nextPutAll: 'leak-checking...'; flush].
- ^super
- runLeakCheckerForFullGC: fullGCFlag
- excludeUnmarkedNewSpaceObjs: excludeUnmarkedNewSpaceObjs
- classIndicesShouldBeValid: classIndicesShouldBeValid!
Item was added:
+ ----- Method: Spur64BitMMLESimulator>>runLeakCheckerFor:excludeUnmarkedNewSpaceObjs:classIndicesShouldBeValid: (in category 'debug support') -----
+ runLeakCheckerFor: gcModes excludeUnmarkedNewSpaceObjs: excludeUnmarkedNewSpaceObjs classIndicesShouldBeValid: classIndicesShouldBeValid
+ (coInterpreter displayView isNil
+ and: [gcModes anyMask: checkForLeaks]) ifTrue:
+ [coInterpreter transcript nextPutAll: 'leak-checking...'; flush].
+ ^super
+ runLeakCheckerFor: gcModes
+ excludeUnmarkedNewSpaceObjs: excludeUnmarkedNewSpaceObjs
+ classIndicesShouldBeValid: classIndicesShouldBeValid!
Item was removed:
- ----- Method: Spur64BitMMLESimulator>>runLeakCheckerForFullGC:excludeUnmarkedNewSpaceObjs:classIndicesShouldBeValid: (in category 'debug support') -----
- runLeakCheckerForFullGC: fullGCFlag excludeUnmarkedNewSpaceObjs: excludeUnmarkedNewSpaceObjs classIndicesShouldBeValid: classIndicesShouldBeValid
- (coInterpreter displayView isNil
- and: [fullGCFlag
- ifTrue: [self leakCheckFullGC]
- ifFalse: [self leakCheckNewSpaceGC]]) ifTrue:
- [coInterpreter transcript nextPutAll: 'leak-checking...'; flush].
- ^super
- runLeakCheckerForFullGC: fullGCFlag
- excludeUnmarkedNewSpaceObjs: excludeUnmarkedNewSpaceObjs
- classIndicesShouldBeValid: classIndicesShouldBeValid!
Item was changed:
----- Method: SpurMemoryManager>>allInstancesOf: (in category 'primitive support') -----
allInstancesOf: aClass
"Attempt to answer an array of all objects, excluding those that may
be garbage collected as a side effect of allocating the result array.
If no memory is available answer the number of instances as a SmallInteger.
Since objects are at least 16 bytes big, and the largest SmallInteger covers
1/4 of the address space, the count can never overflow."
| classIndex freeChunk ptr start limit count bytes |
classIndex := self rawHashBitsOf: aClass.
classIndex = 0 ifTrue:
[freeChunk := self allocateSlots: 0 format: self arrayFormat classIndex: ClassArrayCompactIndex.
^freeChunk].
MarkObjectsForEnumerationPrimitives ifTrue:
[self markObjects: true]. "may not want to revive objects unnecessarily; but marking is sloooow."
freeChunk := self allocateLargestFreeChunk.
start := freeChunk + self baseHeaderSize.
limit := self addressAfter: freeChunk.
(self isClassAtUniqueIndex: aClass)
ifTrue:
[self uniqueIndex: classIndex allInstancesInto: start limit: limit resultsInto: [:c :p| count := c. ptr := p]]
ifFalse:
[self ambiguousClass: aClass allInstancesInto: start limit: limit resultsInto: [:c :p| count := c. ptr := p]].
self assert: (self isEmptyObjStack: markStack).
MarkObjectsForEnumerationPrimitives
ifTrue:
[self assert: self allObjectsUnmarked.
self emptyObjStack: weaklingStack]
ifFalse:
[self assert: (self isEmptyObjStack: weaklingStack)].
(count > (ptr - start / self bytesPerOop) "not enough room"
or: [limit ~= ptr and: [limit - ptr <= self allocationUnit]]) ifTrue: "can't split a single word"
[self freeObject: freeChunk.
^self integerObjectOf: count].
count < self numSlotsMask ifTrue:
[| smallObj |
smallObj := self allocateSlots: count format: self arrayFormat classIndex: ClassArrayCompactIndex.
0 to: count - 1 do:
[:i|
self storePointerUnchecked: i ofObject: smallObj withValue: (self fetchPointer: i ofFreeChunk: freeChunk)].
self freeChunkWithBytes: (self bytesInObject: freeChunk) at: (self startOfObject: freeChunk).
self beRootIfOld: smallObj.
self checkFreeSpace.
^smallObj].
bytes := self largeObjectBytesForSlots: count.
start := self startOfObject: freeChunk.
self freeChunkWithBytes: limit - start - bytes at: start + bytes.
totalFreeOldSpace := totalFreeOldSpace - bytes.
self rawOverflowSlotsOf: freeChunk put: count.
self set: freeChunk classIndexTo: ClassArrayCompactIndex formatTo: self arrayFormat.
self possibleRootStoreInto: freeChunk.
self checkFreeSpace.
+ self runLeakCheckerFor: GCModeFull.
- self runLeakCheckerForFullGC: false.
^freeChunk
!
Item was changed:
----- Method: SpurMemoryManager>>allObjects (in category 'primitive support') -----
allObjects
"Attempt to answer an array of all objects, excluding those that may
be garbage collected as a side effect of allocating the result array.
If no memory is available answer the number of objects as a SmallInteger.
Since objects are at least 16 bytes big, and the largest SmallInteger covers
1/4 of the address space, the count can never overflow."
| freeChunk ptr start limit count bytes |
MarkObjectsForEnumerationPrimitives ifTrue:
[self markObjects: true]. "may not want to revive objects unnecessarily; but marking is sloooow."
freeChunk := self allocateLargestFreeChunk.
ptr := start := freeChunk + self baseHeaderSize.
limit := self addressAfter: freeChunk.
count := 0.
self allHeapEntitiesDo:
[:obj| "continue enumerating even if no room so as to unmark all objects."
(MarkObjectsForEnumerationPrimitives
ifTrue: [self isMarked: obj]
ifFalse: [true]) ifTrue:
[(self isNormalObject: obj)
ifTrue:
[MarkObjectsForEnumerationPrimitives ifTrue:
[self setIsMarkedOf: obj to: false].
count := count + 1.
ptr < limit ifTrue:
[self longAt: ptr put: obj.
ptr := ptr + self bytesPerOop]]
ifFalse:
[MarkObjectsForEnumerationPrimitives ifTrue:
[(self isSegmentBridge: obj) ifFalse:
[self setIsMarkedOf: obj to: false]]]]].
self assert: (self isEmptyObjStack: markStack).
MarkObjectsForEnumerationPrimitives
ifTrue:
[self assert: self allObjectsUnmarked.
self emptyObjStack: weaklingStack]
ifFalse:
[self assert: (self isEmptyObjStack: weaklingStack)].
self assert: count >= self numSlotsMask.
(count > (ptr - start / self bytesPerOop) "not enough room"
or: [limit ~= ptr and: [limit - ptr <= self allocationUnit]]) ifTrue: "can't split a single word"
[self freeChunkWithBytes: (self bytesInObject: freeChunk) at: (self startOfObject: freeChunk).
self checkFreeSpace.
^self integerObjectOf: count].
bytes := self largeObjectBytesForSlots: count.
start := self startOfObject: freeChunk.
self freeChunkWithBytes: limit - start - bytes at: start + bytes.
totalFreeOldSpace := totalFreeOldSpace - bytes.
self rawOverflowSlotsOf: freeChunk put: count.
self set: freeChunk classIndexTo: ClassArrayCompactIndex formatTo: self arrayFormat.
self possibleRootStoreInto: freeChunk.
self checkFreeSpace.
+ self runLeakCheckerFor: GCModeFull.
- self runLeakCheckerForFullGC: false.
^freeChunk
!
Item was changed:
----- Method: SpurMemoryManager>>assignClassIndicesAndPinFrom:to:outPointers: (in category 'image segment in/out') -----
assignClassIndicesAndPinFrom: segmentStart to: segmentLimit outPointers: outPointerArray
"This is part of loadImageSegmentFrom:outPointers:.
Make a final pass, assigning the real class indices and/or pinning pinned objects."
| objOop topHashBit |
+ topHashBit := 1 << (self identityHashFieldWidth - 1).
- topHashBit := 1 << self identityHashFieldWidth - 1.
objOop := self objectStartingAt: segmentStart.
[objOop < segmentLimit] whileTrue:
[| classRef classOop classIndex |
"In the segment, class indices are offset indexes into the segment data,
or into outPointers. See mapOopsFrom:to:outPointers:outHashes:."
classRef := (self classIndexOf: objOop) - self firstClassIndexPun.
classOop := (classRef anyMask: topHashBit)
ifTrue: [self fetchPointer: classRef - topHashBit ofObject: outPointerArray]
ifFalse: [classRef * self allocationUnit + segmentStart].
classIndex := self rawHashBitsOf: classOop.
self assert: (classIndex > self lastClassIndexPun
and: [(self classOrNilAtIndex: classIndex) = classOop]).
self setClassIndexOf: objOop to: classIndex.
((self isInNewSpace: objOop)
and: [self isPinned: objOop]) ifTrue:
[| oldClone |
oldClone := self cloneInOldSpaceForPinning: objOop.
oldClone ~= 0 ifTrue:
[self setIsPinnedOf: oldClone to: true.
self forward: objOop to: oldClone]].
objOop := self objectAfter: objOop limit: segmentLimit].
!
Item was added:
+ ----- Method: SpurMemoryManager>>attemptToShrink (in category 'growing/shrinking memory') -----
+ attemptToShrink
+ "Attempt to shrink memory after successfully reclaiming lots of memory."
+ (totalFreeOldSpace > shrinkThreshold
+ and: [totalFreeOldSpace > growHeadroom]) ifTrue:
+ [segmentManager shrinkObjectMemory: totalFreeOldSpace - growHeadroom]!
Item was changed:
----- Method: SpurMemoryManager>>become:with:twoWay:copyHash: (in category 'become api') -----
become: array1 with: array2 twoWay: twoWayFlag copyHash: copyHashFlag
"All references to each object in array1 are swapped with all references to the
corresponding object in array2. That is, all pointers to one object are replaced
with with pointers to the other. The arguments must be arrays of the same length.
Answers PrimNoErr if the primitive succeeds, otherwise a relevant error code."
"Implementation: Uses lazy forwarding to defer updating references until message send."
| ec |
self assert: becomeEffectsFlags = 0.
+ self runLeakCheckerFor: GCModeBecome.
- self leakCheckBecome ifTrue:
- [self runLeakCheckerForFullGC: true].
(self isArray: array1) ifFalse:
[^PrimErrBadReceiver].
((self isArray: array2)
and: [(self numSlotsOf: array1) = (self numSlotsOf: array2)]) ifFalse:
[^PrimErrBadArgument].
(twoWayFlag or: [copyHashFlag])
ifTrue:
[ec := self containsOnlyValidBecomeObjects: array1 and: array2]
ifFalse:
[self followForwardedObjectFields: array2 toDepth: 0.
ec := self containsOnlyValidBecomeObjects: array1].
ec ~= 0 ifTrue:
[becomeEffectsFlags := 0.
^ec].
coInterpreter preBecomeAction.
twoWayFlag
ifTrue:
[self innerBecomeObjectsIn: array1 and: array2 copyHash: copyHashFlag]
ifFalse:
[self innerBecomeObjectsIn: array1 to: array2 copyHash: copyHashFlag].
self followSpecialObjectsOop.
"N.B. perform coInterpreter's postBecomeAction: *before* postBecomeScanClassTable:
to allow the coInterpreter to void method cache entries by spotting classIndices that
refer to forwarded objects. postBecomeScanClassTable: follows forwarders in the table."
coInterpreter postBecomeAction: becomeEffectsFlags.
self postBecomeScanClassTable: becomeEffectsFlags.
becomeEffectsFlags := 0.
self assert: self validClassTableHashes.
+ self runLeakCheckerFor: GCModeBecome.
- self leakCheckBecome ifTrue:
- [self runLeakCheckerForFullGC: true].
^PrimNoErr "success"!
Item was changed:
----- Method: SpurMemoryManager>>checkHeapIntegrity:classIndicesShouldBeValid: (in category 'debug support') -----
checkHeapIntegrity: excludeUnmarkedNewSpaceObjs classIndicesShouldBeValid: classIndicesShouldBeValid
"Perform an integrity/leak check using the heapMap. Assume clearLeakMapAndMapAccessibleObjects
has set a bit at each object's header. Scan all objects in the heap checking that every pointer points
to a header. Scan the rememberedSet, remapBuffer and extraRootTable checking that every entry is
a pointer to a header. Check that the number of roots is correct and that all rememberedSet entries
have their isRemembered: flag set. Answer if all checks pass."
| ok numRememberedObjectsInHeap |
<inline: false>
ok := true.
numRememberedObjectsInHeap := 0.
"Excuse the duplication but performance is at a premium and we avoid
some tests by splitting the newSpace and oldSpace enumerations."
self allNewSpaceEntitiesDo:
[:obj| | fieldOop classIndex classOop |
((self isFreeObject: obj)
or: [(self isMarked: obj) not and: [excludeUnmarkedNewSpaceObjs]]) ifFalse:
[(self isRemembered: obj) ifTrue:
[coInterpreter print: 'young object '; printHex: obj; print: ' is remembered'; cr.
self eek.
ok := false]].
(self isForwarded: obj)
ifTrue:
[fieldOop := self fetchPointer: 0 ofMaybeForwardedObject: obj.
(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0 ifTrue:
[coInterpreter print: 'object leak in forwarder '; printHex: obj; print: ' to unmapped '; printHex: fieldOop; cr.
self eek.
ok := false]]
ifFalse:
[classOop := self classOrNilAtIndex: (classIndex := self classIndexOf: obj).
(classIndicesShouldBeValid
and: [classOop = nilObj
and: [(self isHiddenObj: obj) not]]) ifTrue:
[coInterpreter print: 'object leak in '; printHex: obj; print: ' invalid class index '; printHex: classIndex; print: ' -> '; print: (classOop ifNil: ['nil'] ifNotNil: ['nilObj']); cr.
self eek.
ok := false].
0 to: (self numPointerSlotsOf: obj) - 1 do:
[:fi|
fieldOop := self fetchPointer: fi ofObject: obj.
(self isNonImmediate: fieldOop) ifTrue:
[(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0 ifTrue:
[coInterpreter print: 'object leak in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; cr.
self eek.
ok := false]]]]].
self allOldSpaceEntitiesDo:
[:obj| | containsYoung fieldOop classIndex classOop |
(self isFreeObject: obj) ifFalse:
[containsYoung := false.
(self isRemembered: obj) ifTrue:
[numRememberedObjectsInHeap := numRememberedObjectsInHeap + 1.
(scavenger isInRememberedSet: obj) ifFalse:
[coInterpreter print: 'remembered object '; printHex: obj; print: ' is not in remembered table'; cr.
self eek.
ok := false]].
(self isForwarded: obj)
ifTrue:
[fieldOop := self fetchPointer: 0 ofMaybeForwardedObject: obj.
(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0 ifTrue:
[coInterpreter print: 'object leak in forwarder '; printHex: obj; print: ' to unmapped '; printHex: fieldOop; cr.
self eek.
ok := false].
(self isReallyYoung: fieldOop) ifTrue:
[containsYoung := true]]
ifFalse:
[classOop := self classOrNilAtIndex: (classIndex := self classIndexOf: obj).
(classIndicesShouldBeValid
and: [classOop = nilObj
and: [classIndex > self lastClassIndexPun]]) ifTrue:
[coInterpreter print: 'object leak in '; printHex: obj; print: ' invalid class index '; printHex: classIndex; print: ' -> '; print: (classOop ifNil: ['nil'] ifNotNil: ['nilObj']); cr.
self eek.
ok := false].
0 to: (self numPointerSlotsOf: obj) - 1 do:
[:fi|
fieldOop := self fetchPointer: fi ofObject: obj.
(self isNonImmediate: fieldOop) ifTrue:
[(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0 ifTrue:
[coInterpreter print: 'object leak in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; cr.
self eek.
ok := false].
"don't be misled by CogMethods; they appear to be young, but they're not"
(self isReallyYoung: fieldOop) ifTrue:
[containsYoung := true]]]].
+ containsYoung ifTrue:
+ [(self isRemembered: obj) ifFalse:
+ [coInterpreter print: 'unremembered object '; printHex: obj; print: ' contains young oop(s)'; cr.
+ self eek.
+ ok := false]]]].
- containsYoung ifTrue:
- [(self isRemembered: obj) ifFalse:
- [coInterpreter print: 'unremembered object '; printHex: obj; print: ' contains young oop(s)'; cr.
- self eek.
- ok := false]]]].
numRememberedObjectsInHeap ~= scavenger rememberedSetSize ifTrue:
[coInterpreter
print: 'root count mismatch. #heap roots ';
printNum: numRememberedObjectsInHeap;
print: '; #roots ';
printNum: scavenger rememberedSetSize;
cr.
self eek.
"But the system copes with overflow..."
self flag: 'no support for remembered set overflow yet'.
"ok := rootTableOverflowed and: [needGCFlag]"].
scavenger rememberedSetWithIndexDo:
[:obj :i|
(obj bitAnd: self wordSize - 1) ~= 0
ifTrue:
[coInterpreter print: 'misaligned oop in remembered set @ '; printNum: i; print: ' = '; printHex: obj; cr.
self eek.
ok := false]
ifFalse:
[(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0
ifTrue:
[coInterpreter print: 'object leak in remembered set @ '; printNum: i; print: ' = '; printHex: obj; cr.
self eek.
ok := false]
ifFalse:
[(self isYoung: obj) ifTrue:
[coInterpreter print: 'non-root in remembered set @ '; printNum: i; print: ' = '; printHex: obj; cr.
self eek.
ok := false]]]].
1 to: remapBufferCount do:
[:ri| | obj |
obj := remapBuffer at: ri.
(obj bitAnd: self wordSize - 1) ~= 0
ifTrue:
[coInterpreter print: 'misaligned remapRoot @ '; printNum: ri; print: ' = '; printHex: obj; cr.
self eek.
ok := false]
ifFalse:
[(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0 ifTrue:
[coInterpreter print: 'object leak in remapRoots @ '; printNum: ri; print: ' = '; printHex: obj; cr.
self eek.
ok := false]]].
1 to: extraRootCount do:
[:ri| | obj |
obj := (extraRoots at: ri) at: 0.
(obj bitAnd: self wordSize - 1) ~= 0
ifTrue:
[coInterpreter print: 'misaligned extraRoot @ '; printNum: ri; print: ' => '; printHex: obj; cr.
self eek.
ok := false]
ifFalse:
[(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0 ifTrue:
[coInterpreter print: 'object leak in extraRoots @ '; printNum: ri; print: ' => '; printHex: obj; cr.
self eek.
ok := false]]].
^ok!
Item was changed:
----- Method: SpurMemoryManager>>fullGC (in category 'gc - global') -----
fullGC
"Perform a full lazy compacting GC. Answer the size of the largest free chunk."
<returnTypeC: #usqLong>
<inline: #never> "for profiling"
needGCFlag := false.
gcStartUsecs := self ioUTCMicrosecondsNow.
statMarkCount := 0.
coInterpreter preGCAction: GCModeFull.
self globalGarbageCollect.
+ self attemptToShrink.
coInterpreter postGCAction: GCModeFull.
statFullGCs := statFullGCs + 1.
statGCEndUsecs := self ioUTCMicrosecondsNow.
statFullGCUsecs := statFullGCUsecs + (statGCEndUsecs - gcStartUsecs).
^(freeLists at: 0) ~= 0
ifTrue: [self bytesInObject: self findLargestFreeChunk]
ifFalse: [0]!
Item was changed:
----- Method: SpurMemoryManager>>globalGarbageCollect (in category 'gc - global') -----
globalGarbageCollect
<inline: true> "inline into fullGC"
self assert: self validObjStacks.
self assert: (self isEmptyObjStack: markStack).
self assert: (self isEmptyObjStack: weaklingStack).
self markObjects: true.
self freeUnmarkedObjectsAndSortAndCoalesceFreeSpaceForPigCompact.
"Mid-way the leak check must be more lenient. Unmarked classes will have been
expunged from the table, but unmarked instances will not yet have been reclaimed."
+ self runLeakCheckerFor: GCModeFull
- self runLeakCheckerForFullGC: true
excludeUnmarkedNewSpaceObjs: true
classIndicesShouldBeValid: true.
self compact.
self setHeapSizeAtPreviousGC.
self assert: self validObjStacks.
self assert: (self isEmptyObjStack: markStack).
self assert: (self isEmptyObjStack: weaklingStack).
self assert: self allObjectsUnmarked.
+ self runLeakCheckerFor: GCModeFull!
- self runLeakCheckerForFullGC: true!
Item was added:
+ ----- Method: SpurMemoryManager>>inLineRunLeakCheckerFor:excludeUnmarkedNewSpaceObjs:classIndicesShouldBeValid: (in category 'debug support') -----
+ inLineRunLeakCheckerFor: gcModes excludeUnmarkedNewSpaceObjs: excludeUnmarkedNewSpaceObjs classIndicesShouldBeValid: classIndicesShouldBeValid
+ <inline: true>
+ (gcModes anyMask: checkForLeaks) ifTrue:
+ [(gcModes anyMask: GCModeFull)
+ ifTrue: [coInterpreter reverseDisplayFrom: 0 to: 7]
+ ifFalse: [coInterpreter reverseDisplayFrom: 8 to: 15].
+ self clearLeakMapAndMapAccessibleObjects.
+ self assert: (self checkHeapIntegrity: excludeUnmarkedNewSpaceObjs classIndicesShouldBeValid: classIndicesShouldBeValid).
+ self assert: coInterpreter checkInterpreterIntegrity.
+ self assert: coInterpreter checkStackIntegrity.
+ self assert: (coInterpreter checkCodeIntegrity: gcModes)]!
Item was changed:
----- Method: SpurMemoryManager>>leakCheckBecome (in category 'debug support') -----
leakCheckBecome
<api>
+ ^(checkForLeaks bitAnd: GCModeBecome) ~= 0!
- ^(checkForLeaks bitAnd: 4) ~= 0!
Item was changed:
----- Method: SpurMemoryManager>>leakCheckFullGC (in category 'debug support') -----
leakCheckFullGC
<api>
+ ^(checkForLeaks bitAnd: GCModeFull) ~= 0!
- ^(checkForLeaks bitAnd: 1) ~= 0!
Item was changed:
----- Method: SpurMemoryManager>>leakCheckImageSegments (in category 'debug support') -----
leakCheckImageSegments
+ ^(checkForLeaks bitAnd: GCModeImageSegment) ~= 0!
- <api>
- ^(checkForLeaks bitAnd: 16) ~= 0!
Item was added:
+ ----- Method: SpurMemoryManager>>leakCheckIncremental (in category 'debug support') -----
+ leakCheckIncremental
+ <api>
+ ^(checkForLeaks bitAnd: GCModeIncremental) ~= 0!
Item was removed:
- ----- Method: SpurMemoryManager>>leakCheckIncrementalGC (in category 'debug support') -----
- leakCheckIncrementalGC
- <api>
- ^(checkForLeaks bitAnd: 8) ~= 0!
Item was changed:
----- Method: SpurMemoryManager>>leakCheckNewSpaceGC (in category 'debug support') -----
leakCheckNewSpaceGC
<api>
+ ^(checkForLeaks bitAnd: GCModeNewSpace) ~= 0!
- ^(checkForLeaks bitAnd: 2) ~= 0!
Item was changed:
----- Method: SpurMemoryManager>>loadImageSegmentFrom:outPointers: (in category 'image segment in/out') -----
loadImageSegmentFrom: segmentWordArray outPointers: outPointerArray
"This primitive is called from Squeak as...
<imageSegment> loadSegmentFrom: aWordArray outPointers: anArray."
"This primitive will load a binary image segment created by primitiveStoreImageSegment.
It expects the outPointer array to be of the proper size, and the wordArray to be well formed.
It will return as its value the original array of roots, and the erstwhile segmentWordArray will
have been truncated to a size of one word, i.e. retaining the version stamp. If this primitive
should fail, the segmentWordArray will, sadly, have been reduced to an unrecognizable and
unusable jumble. But what more could you have done with it anyway?"
<inline: false>
| segmentLimit segmentStart segVersion errorCode |
segmentLimit := self numSlotsOf: segmentWordArray.
(self objectBytesForSlots: segmentLimit) < (self allocationUnit "version info" + self baseHeaderSize "one object header") ifTrue:
[^PrimErrBadArgument].
"Verify format. If the format is wrong, word-swap (since ImageSegment data are 32-bit longs).
If it is still wrong, undo the damage and fail."
segVersion := self longAt: segmentWordArray + self baseHeaderSize.
(coInterpreter readableFormat: (segVersion bitAnd: 16rFFFFFF "low 3 bytes")) ifFalse:
[self reverseBytesIn32BitWordsFrom: segmentWordArray + self baseHeaderSize
to: (self addressAfter: segmentWordArray).
segVersion := self longAt: segmentWordArray + self baseHeaderSize.
(coInterpreter readableFormat: (segVersion bitAnd: 16rFFFFFF "low 3 bytes")) ifFalse:
[self reverseBytesIn32BitWordsFrom: segmentWordArray + self baseHeaderSize
to: (self addressAfter: segmentWordArray).
^PrimErrBadArgument]].
segmentStart := segmentWordArray + self baseHeaderSize + self allocationUnit.
segmentLimit := segmentLimit * self bytesPerOop + segmentWordArray + self baseHeaderSize.
"Notionally reverse the Byte type objects if the data is from opposite endian machine.
Test top byte. $d on the Mac or $s on the PC. Rest of word is equal. If Spur is ever
ported to big-endian machines then the segment may have to be byte/word swapped,
but so far it only runs on little-endian machines, so for now just fail if endinanness is wrong."
self flag: #endianness.
(segVersion >> 24 bitAnd: 16rFF) ~= (self imageSegmentVersion >> 24 bitAnd: 16rFF) ifTrue:
"Reverse the byte-type objects once"
[true
ifTrue: [^PrimErrBadArgument]
ifFalse:
[self byteSwapByteObjectsFrom: (self objectStartingAt: segmentStart)
to: segmentLimit
flipFloatsIf: false]].
"scan through mapping oops and validating class references. Defer entering any
class objects into the class table and/or pinning objects until a second pass."
errorCode := self mapOopsAndValidateClassRefsFrom: segmentStart to: segmentLimit outPointers: outPointerArray.
errorCode ~= 0 ifTrue:
[^errorCode].
"Scan for classes contained in the segment, entering them into the class table.
Classes are at the front, after the root array and have the remembered bit set."
errorCode := self enterClassesIntoClassTableFrom: segmentStart to: segmentLimit.
errorCode ~= 0 ifTrue:
[^errorCode].
"Make a final pass, assigning class indices and/or pinning pinned objects"
self assignClassIndicesAndPinFrom: segmentStart to: segmentLimit outPointers: outPointerArray.
"Finally evaporate the container, leaving the newly loaded objects in place."
(self hasOverflowHeader: segmentWordArray)
ifTrue: [self rawOverflowSlotsOf: segmentWordArray put: self allocationUnit / self bytesPerOop]
ifFalse: [self rawNumSlotsOf: segmentWordArray put: self allocationUnit / self bytesPerOop].
+ self runLeakCheckerFor: GCModeImageSegment.
- self leakCheckImageSegments ifTrue:
- [self runLeakCheckerForFullGC: true].
^self objectStartingAt: segmentStart!
Item was changed:
----- Method: SpurMemoryManager>>mapOopsAndValidateClassRefsFrom:to:outPointers: (in category 'image segment in/out') -----
mapOopsAndValidateClassRefsFrom: segmentStart to: segmentLimit outPointers: outPointerArray
"This is part of loadImageSegmentFrom:outPointers:.
Scan through mapping oops and validating class references. Defer
entering any class objects into the class table and/or pinning objects
until the second pass in assignClassIndicesAndPinFrom:to:outPointers:."
| numOutPointers objOop topHashBit topOopBit |
numOutPointers := self numSlotsOf: outPointerArray.
+ topHashBit := 1 << (self identityHashFieldWidth - 1).
- topHashBit := 1 << self identityHashFieldWidth - 1.
topOopBit := 1 << self bytesPerOop * 8 - 1.
objOop := self objectStartingAt: segmentStart.
[objOop < segmentLimit] whileTrue:
[| classIndex hash oop mappedOop |
(self isMarked: objOop) ifTrue:
[^PrimErrInappropriate].
classIndex := (self classIndexOf: objOop) - self firstClassIndexPun.
"validate the class ref, but don't update it until any internal classes have been added to the class table."
(classIndex anyMask: topHashBit)
ifTrue:
[classIndex - topHashBit >= numOutPointers ifTrue:
[^PrimErrBadIndex].
mappedOop := self fetchPointer: classIndex - topHashBit ofObject: outPointerArray.
hash := self rawHashBitsOf: mappedOop.
(hash > self lastClassIndexPun and: [(self classOrNilAtIndex: hash) = mappedOop]) ifFalse:
[^PrimErrInappropriate]]
ifFalse: "The class is contained within the segment."
[(oop := classIndex * self allocationUnit + segmentStart) >= segmentLimit ifTrue:
[^PrimErrBadIndex].
(self rawHashBitsOf: oop) ~= 0 ifTrue:
[^PrimErrInappropriate]].
0 to: (self numPointerSlotsOf: objOop) - 1 do:
[:i|
oop := self fetchPointer: i ofObject: objOop.
(self isNonImmediate: oop) ifTrue:
[(oop anyMask: topOopBit)
ifTrue:
[(oop := oop - topOopBit / self bytesPerOop) >= numOutPointers ifTrue:
[^PrimErrBadIndex].
mappedOop := self fetchPointer: oop ofObject: outPointerArray]
ifFalse:
[(oop bitAnd: self allocationUnit - 1) ~= 0 ifTrue:
[^PrimErrInappropriate].
(mappedOop := oop + segmentStart) >= segmentLimit ifTrue:
[^PrimErrBadIndex]].
self storePointerUnchecked: i ofObject: objOop withValue: mappedOop]].
objOop := self objectAfter: objOop limit: segmentLimit].
^0!
Item was changed:
----- Method: SpurMemoryManager>>mapOopsFrom:to:outPointers:outHashes: (in category 'image segment in/out') -----
mapOopsFrom: segStart to: segAddr outPointers: outPointerArray outHashes: savedOutHashes
"This is part of storeImageSegmentInto:outPointers:roots:.
Now scan, adding out pointers to the outPointersArray; all objects in arrayOfObjects
have had their hashes set to point to their copies in segmentWordArray. Answer the
outIndex if the scan succeded. Fail if outPointers is too small and answer -1."
| objOop outIndex topHashBit topOopBit |
outIndex := 0.
self fillObj: outPointerArray numSlots: (self numSlotsOf: outPointerArray) with: nilObj.
+ topHashBit := 1 << (self identityHashFieldWidth - 1).
- topHashBit := 1 << self identityHashFieldWidth - 1.
topOopBit := 1 << self bytesPerOop * 8 - 1.
objOop := self objectStartingAt: segStart.
[objOop < segAddr] whileTrue:
[| oop segIndex |
oop := self fetchClassOfNonImm: objOop.
(self isMarked: oop) ifFalse: "oop is a new outPointer; allocate its oop"
[outIndex := self newOutPointer: oop at: outIndex in: outPointerArray hashes: savedOutHashes topHashBit: topHashBit.
outIndex = 0 ifTrue:"no room in outPointers; fail"
[^-1]].
"Set the clone's class index to an offset index into segmentWordArray.
Use an offset so that code cannot confuse a clone with e.g. a forwarder."
segIndex := self rawHashBitsOf: oop.
self setClassIndexOf: objOop to: segIndex + self firstClassIndexPun.
0 to: (self numPointerSlotsOf: objOop) - 1 do:
[:i|
oop := self fetchPointer: i ofObject: objOop.
(self isNonImmediate: oop) ifTrue:
[(self isMarked: oop) ifFalse: "oop is a new outPointer; allocate its oop"
[outIndex := self newOutPointer: oop at: outIndex in: outPointerArray hashes: savedOutHashes topHashBit: topHashBit.
outIndex = 0 ifTrue: "no room in outPointers; fail"
[^-1]].
oop := self mappedOopOf: oop topHashBit: topHashBit topOopBit: topOopBit..
self storePointerUnchecked: i ofObject: objOop withValue: oop]].
objOop := self objectAfter: objOop limit: segAddr].
^outIndex!
Item was changed:
----- Method: SpurMemoryManager>>markObjects: (in category 'gc - global') -----
markObjects: objectsShouldBeUnmarkedAndUnmarkedClassesShouldBeExpunged
<inline: #never> "for profiling"
"Mark all accessible objects. objectsShouldBeUnmarkedAndUnmarkedClassesShouldBeExpunged
is true if all objects are unmarked and/or if unmarked classes shoud be removed from the class table."
"If the incremental collector is running mark bits may be set; stop it and clear them if necessary."
self cCode: '' inSmalltalk: [coInterpreter transcript nextPutAll: 'marking...'; flush].
+ self runLeakCheckerFor: GCModeFull.
- self runLeakCheckerForFullGC: true.
self shutDownIncrementalGC: objectsShouldBeUnmarkedAndUnmarkedClassesShouldBeExpunged.
self initializeUnscannedEphemerons.
self initializeMarkStack.
self initializeWeaklingStack.
self markAccessibleObjectsAndFireEphemerons.
self expungeDuplicateAndUnmarkedClasses: objectsShouldBeUnmarkedAndUnmarkedClassesShouldBeExpunged.
self nilUnmarkedWeaklingSlots!
Item was changed:
----- Method: SpurMemoryManager>>objectsReachableFromRoots: (in category 'image segment in/out') -----
objectsReachableFromRoots: arrayOfRoots
"Answer an Array of all the objects only reachable from the argument, an Array of root objects,
starting with arrayOfRoots. If there is no space, answer a SmallInteger whose value is the
number of slots required. This is used to collect the objects to include in an image segment
on Spur, separate from creating the segment, hence simplifying the implementation.
Thanks to Igor Stasenko for this idea."
| freeChunk ptr start limit count oop objOop |
self assert: (self isArray: arrayOfRoots).
"Mark all objects except those only reachable from the arrayOfRoots by marking
each object in arrayOfRoots and then marking all reachable objects (from the
system roots). This leaves unmarked only objects reachable from the arrayOfRoots.
N.B. A side-effect of the marking is that all forwarders in arrayOfRoots will be followed."
self assert: self allObjectsUnmarked.
self markObjectsIn: arrayOfRoots.
self markObjects: false.
"After the mark phase all unreachable weak slots will have been nilled
and all active ephemerons fired."
self assert: (self isEmptyObjStack: markStack).
self assert: (self isEmptyObjStack: weaklingStack).
self assert: self noUnscannedEphemerons.
"Use the largest free chunk to answer the result."
freeChunk := self allocateLargestFreeChunk.
ptr := start := freeChunk + self baseHeaderSize.
limit := self addressAfter: freeChunk.
count := 0.
"First put the arrayOfRoots; order is important."
count := count + 1.
ptr < limit ifTrue:
[self longAt: ptr put: arrayOfRoots.
ptr := ptr + self bytesPerOop].
0 to: (self numSlotsOf: arrayOfRoots) - 1 do:
[:i|
oop := self fetchPointer: i ofObject: arrayOfRoots.
(self isNonImmediate: oop) ifTrue:
[self push: oop onObjStack: markStack]].
"Now collect the unmarked objects reachable from the roots."
[self isEmptyObjStack: markStack] whileFalse:
[objOop := self popObjStack: markStack.
count := count + 1.
ptr < limit ifTrue:
[self longAt: ptr put: objOop.
ptr := ptr + self bytesPerOop].
oop := self fetchClassOfNonImm: objOop.
(self isMarked: oop) ifFalse:
[self setIsMarkedOf: objOop to: true.
self push: oop onObjStack: markStack].
((self isContextNonImm: objOop)
and: [coInterpreter isStillMarriedContext: objOop]) "widow now, before the loop"
ifTrue:
[0 to: (coInterpreter numSlotsOfMarriedContext: objOop) - 1 do:
[:i|
oop := coInterpreter fetchPointer: i ofMarriedContext: objOop.
((self isImmediate: oop)
or: [self isMarked: oop]) ifFalse:
[self setIsMarkedOf: objOop to: true.
self push: oop onObjStack: markStack]]]
ifFalse:
[0 to: (self numPointerSlotsOf: objOop) - 1 do:
[:i|
oop := self fetchPointer: i ofObject: objOop.
((self isImmediate: oop)
or: [self isMarked: oop]) ifFalse:
[self setIsMarkedOf: objOop to: true.
self push: oop onObjStack: markStack]]]].
self unmarkAllObjects.
totalFreeOldSpace := totalFreeOldSpace - (self bytesInObject: freeChunk).
"Now try and allocate the result"
(count > (ptr - start / self bytesPerOop) "not enough room"
or: [limit ~= ptr and: [limit - ptr <= self allocationUnit]]) ifTrue: "can't split a single word"
[self freeChunkWithBytes: (self bytesInObject: freeChunk) at: (self startOfObject: freeChunk).
self checkFreeSpace.
^self integerObjectOf: count].
"There's room; set the format, & classIndex and shorten."
self setFormatOf: freeChunk to: self arrayFormat.
self setClassIndexOf: freeChunk to: ClassArrayCompactIndex.
self shorten: freeChunk toIndexableSize: count.
self possibleRootStoreInto: freeChunk.
self checkFreeSpace.
+ self runLeakCheckerFor: GCModeImageSegment.
- self runLeakCheckerForFullGC: false.
^freeChunk!
Item was changed:
----- Method: SpurMemoryManager>>printHeaderTypeOf: (in category 'debug printing') -----
printHeaderTypeOf: objOop
coInterpreter
+ print: ((self numSlotsOfAny: objOop) >= self numSlotsMask
- print: ((self numSlotsOf: objOop) >= self numSlotsMask
ifTrue: [' hdr16 ']
ifFalse: [' hdr8 ']);
printChar: ((self isImmutable: objOop) ifTrue: [$i] ifFalse: [$.]);
printChar: ((self isRemembered: objOop) ifTrue: [$r] ifFalse: [$.]);
printChar: ((self isPinned: objOop) ifTrue: [$p] ifFalse: [$.]);
printChar: ((self isMarked: objOop) ifTrue: [$m] ifFalse: [$.]);
printChar: ((self isGrey: objOop) ifTrue: [$g] ifFalse: [$.])!
Item was changed:
----- Method: SpurMemoryManager>>remapObj: (in category 'gc - scavenging') -----
remapObj: objOop
"Scavenge or simply follow objOop. Answer the new location of objOop.
The send should have been guarded by a send of shouldRemapOop:.
The method is called remapObj: for compatibility with ObjectMemory."
<api>
<inline: false>
| resolvedObj |
self assert: (self shouldRemapOop: objOop).
(self isForwarded: objOop)
ifTrue:
+ [resolvedObj := self followForwarded: objOop]
- [resolvedObj := self followForwarded: objOop.
- (self isInFutureSpace: resolvedObj) ifTrue: "already scavenged"
- [^resolvedObj]]
ifFalse:
+ [self deny: (self isInFutureSpace: objOop).
- [self deny: (self isInFutureSpace: resolvedObj).
resolvedObj := objOop].
(scavengeInProgress
+ and: [(self isReallyYoung: resolvedObj) "don't scavenge immediate, old, or CogMethod objects."
+ and: [(self isInFutureSpace: resolvedObj) not]]) ifTrue:
- and: [self isReallyYoung: resolvedObj]) ifTrue: "a becommed or compacted object whose target is in old space, or a CogMethod."
[^scavenger copyAndForward: resolvedObj].
^resolvedObj!
Item was changed:
----- Method: SpurMemoryManager>>return:restoringObjectsIn:savedHashes:and:savedHashes: (in category 'image segment in/out') -----
return: errCode restoringObjectsIn: firstArray savedHashes: firstSavedHashes and: secondArray savedHashes: secondSavedHashes
self restoreObjectsIn: firstArray savedHashes: firstSavedHashes.
self restoreObjectsIn: secondArray savedHashes: secondSavedHashes.
+ self runLeakCheckerFor: GCModeImageSegment.
- self leakCheckImageSegments ifTrue:
- [self runLeakCheckerForFullGC: true].
self assert: self allObjectsUnmarked.
^errCode!
Item was added:
+ ----- Method: SpurMemoryManager>>runLeakCheckerFor: (in category 'debug support') -----
+ runLeakCheckerFor: gcModes
+ <inline: false>
+ ^self
+ inLineRunLeakCheckerFor: gcModes
+ excludeUnmarkedNewSpaceObjs: false
+ classIndicesShouldBeValid: true!
Item was added:
+ ----- Method: SpurMemoryManager>>runLeakCheckerFor:excludeUnmarkedNewSpaceObjs:classIndicesShouldBeValid: (in category 'debug support') -----
+ runLeakCheckerFor: gcModes excludeUnmarkedNewSpaceObjs: excludeUnmarkedNewSpaceObjs classIndicesShouldBeValid: classIndicesShouldBeValid
+ <inline: false>
+ self inLineRunLeakCheckerFor: gcModes
+ excludeUnmarkedNewSpaceObjs: excludeUnmarkedNewSpaceObjs
+ classIndicesShouldBeValid: classIndicesShouldBeValid!
Item was added:
+ ----- Method: SpurMemoryManager>>runLeakCheckerForFullGC (in category 'debug support') -----
+ runLeakCheckerForFullGC
+ <doNotGenerate>
+ "Support for the Spur bootstrap"
+ self runLeakCheckerFor: GCModeFull!
Item was removed:
- ----- Method: SpurMemoryManager>>runLeakCheckerForFullGC: (in category 'debug support') -----
- runLeakCheckerForFullGC: fullGCFlag
- ^self runLeakCheckerForFullGC: fullGCFlag excludeUnmarkedNewSpaceObjs: false classIndicesShouldBeValid: true!
Item was removed:
- ----- Method: SpurMemoryManager>>runLeakCheckerForFullGC:excludeUnmarkedNewSpaceObjs:classIndicesShouldBeValid: (in category 'debug support') -----
- runLeakCheckerForFullGC: fullGCFlag excludeUnmarkedNewSpaceObjs: excludeUnmarkedNewSpaceObjs classIndicesShouldBeValid: classIndicesShouldBeValid
- <inline: false>
- (fullGCFlag
- ifTrue: [self leakCheckFullGC or: [self leakCheckImageSegments]]
- ifFalse: [self leakCheckNewSpaceGC]) ifTrue:
- [fullGCFlag
- ifTrue: [coInterpreter reverseDisplayFrom: 0 to: 7]
- ifFalse: [coInterpreter reverseDisplayFrom: 8 to: 15].
- self clearLeakMapAndMapAccessibleObjects.
- self assert: (self checkHeapIntegrity: excludeUnmarkedNewSpaceObjs classIndicesShouldBeValid: classIndicesShouldBeValid).
- self assert: coInterpreter checkInterpreterIntegrity.
- self assert: coInterpreter checkStackIntegrity.
- self assert: (coInterpreter checkCodeIntegrity: fullGCFlag)]!
Item was changed:
----- Method: SpurMemoryManager>>scavengingGCTenuringIf: (in category 'gc - scavenging') -----
scavengingGCTenuringIf: tenuringCriterion
"Run the scavenger."
<inline: false>
self assert: remapBufferCount = 0.
(self asserta: scavenger eden limit - freeStart > coInterpreter interpreterAllocationReserveBytes) ifFalse:
[coInterpreter tab;
printNum: scavenger eden limit - freeStart; space;
printNum: coInterpreter interpreterAllocationReserveBytes; space;
printNum: coInterpreter interpreterAllocationReserveBytes - (scavenger eden limit - freeStart); cr].
self checkMemoryMap.
self checkFreeSpace.
+ self runLeakCheckerFor: GCModeNewSpace.
- self runLeakCheckerForFullGC: false.
coInterpreter
+ preGCAction: GCModeNewSpace;
- preGCAction: GCModeScavenge;
"would prefer this to be in mapInterpreterOops, but
compatibility with ObjectMemory dictates it goes here."
flushMethodCacheFrom: newSpaceStart to: newSpaceLimit.
needGCFlag := false.
gcStartUsecs := coInterpreter ioUTCMicrosecondsNow.
self doScavenge: tenuringCriterion.
statScavenges := statScavenges + 1.
statGCEndUsecs := coInterpreter ioUTCMicrosecondsNow.
statSGCDeltaUsecs := statGCEndUsecs - gcStartUsecs.
statScavengeGCUsecs := statScavengeGCUsecs + statSGCDeltaUsecs.
statRootTableCount := scavenger rememberedSetSize.
+ coInterpreter postGCAction: GCModeNewSpace.
- coInterpreter postGCAction: GCModeScavenge.
+ self runLeakCheckerFor: GCModeNewSpace.
- self runLeakCheckerForFullGC: false.
self checkFreeSpace!
Item was changed:
----- Method: SpurMemoryManager>>setCheckForLeaks: (in category 'spur bootstrap') -----
+ setCheckForLeaks: integerFlags
- setCheckForLeaks: anInteger
" 0 = do nothing.
+ 1 = check for leaks on fullGC (GCModeFull).
+ 2 = check for leaks on scavenger (GCModeNewSpace).
+ 4 = check for leaks on incremental (GCModeIncremental)
+ 8 = check for leaks on become
+ 16 = check for leaks on image segments"
+ checkForLeaks := integerFlags!
- 1 = check for leaks on fullGC.
- 2 = check for leaks on scavenger.
- 4 = check for leaks on become
- 8 = check for leaks on truly incremental.
- 15 = check for leaks on all four."
- checkForLeaks := anInteger!
Item was removed:
- ----- Method: SpurMemoryManager>>shrinkObjectMemory: (in category 'growing/shrinking memory') -----
- shrinkObjectMemory: delta
- "Attempt to shrink the object memory by the given delta amount."
- <doNotGenerate>
- segmentManager shrinkObjectMemory: delta!
Item was changed:
----- Method: SpurMemoryManager>>storeImageSegmentInto:outPointers:roots: (in category 'image segment in/out') -----
storeImageSegmentInto: segmentWordArray outPointers: outPointerArray roots: arrayOfRoots
"This primitive is called from Squeak as...
<imageSegment> storeSegmentFor: arrayOfRoots into: aWordArray outPointers: anArray.
This primitive will store a binary image segment (in the same format as objercts in the heap) of the
set of objects in arrayOfObjects. All pointers from within the set to objects outside the set will be
copied into the array of outPointers. In their place in the image segment will be an oop equal to the
offset in the outPointer array (the first would be 4). but with the high bit set.
Since Spur has a class table the load primitive must insert classes that have instances in the class
table. This primitive marks such classes using the isRemembered bit, which isn't meaningful as a
remembered bit in the segment.
The primitive expects the segmentWordArray and outPointerArray to be more than adequately long.
In this case it returns normally, and truncates the two arrays to exactly the right size.
The primitive can fail for the following reasons with the specified failure codes:
PrimErrWritePastObject: the segmentWordArray is too small
PrimErrBadIndex: the outPointerArray is too small
PrimErrNoMemory: additional allocations failed
PrimErrLimitExceeded: there is no room in the hash field to store object oops."
<inline: false>
| arrayOfObjects savedInHashes savedOutHashes fillValue segStart segAddr endSeg outIndex |
+ self runLeakCheckerFor: GCModeImageSegment.
- self leakCheckImageSegments ifTrue:
- [self runLeakCheckerForFullGC: true].
"First compute the transitive closure, collecting the sequence of objects to be stored in the arrayOfObjects array."
arrayOfObjects := self objectsReachableFromRoots: arrayOfRoots.
arrayOfObjects ifNil:
[^PrimErrNoMemory].
self assert: self allObjectsUnmarked. "work to be done when the incremental GC is written"
"The scheme is to copy the objects into segmentWordArray, and then map the oops in sementWordArray.
Therefore the primitive needs to both map efficiently originals to copies in segmentWordArray and
be able to undo any side-effects if the primitive fails because either sementWordArray or outPointerArray
is too small. The mapping is done by having the originals (either the objects in arrayOfObjects or the
objects in outPointerArray) refer to their mapped locations through their identityHash, and saving their
identityHashes in two ByteArrays, one that mirrors arrayOfObjects, and one that mirrors outPointerArray.
Since arrayOfObjects and its saved hashes, and outPointerArray and its saved hashes, can be enumerated
side-by-side, the hashes can be restored to the originals. So the hash of an object in arrayOfObjects
is set to its offset in segmentWordArray / self allocationUnit, and the hash of an object in outPointerArray
is set to its index in outPointerArray plus the top hash bit. Oops in segmentWordArray are therefore
mapped by accessing the original oop's identityHash, testing the bottom bit to distinguish between internal
and external oops. The saved hash arrays are initialized with an out-of-range hash value so that the first
unused entry can be identified."
savedInHashes := self allocateSlots: (self numSlotsForBytes: (self numSlotsOf: arrayOfObjects) * 4)
format: self firstLongFormat
classIndex: self thirtyTwoBitLongsClassIndexPun.
savedOutHashes := self allocateSlots: (self numSlotsForBytes: (self numSlotsOf: outPointerArray) * 4)
format: self firstLongFormat
classIndex: self thirtyTwoBitLongsClassIndexPun.
(savedInHashes isNil or: [savedOutHashes isNil]) ifTrue:
[self freeObject: arrayOfObjects.
^PrimErrNoMemory].
fillValue := self wordSize = 4 ifTrue: [self maxIdentityHash + 1] ifFalse: [self maxIdentityHash + 1 << 32 + (self maxIdentityHash + 1)].
self fillObj: savedInHashes numSlots: (self numSlotsOf: savedInHashes) with: fillValue.
self fillObj: savedOutHashes numSlots: (self numSlotsOf: savedOutHashes) with: fillValue.
"Both to expand the max size of segment and to reduce the length of the
load-time pass that adds classes to the class table, move classes to the
front of arrayOfObjects, leaving the root array as the first element."
self moveClassesForwardsIn: arrayOfObjects.
segAddr := segmentWordArray + self baseHeaderSize.
endSeg := self addressAfter: segmentWordArray.
"Write a version number for byte order and version check."
segAddr >= endSeg ifTrue: [^PrimErrGenericFailure].
self long32At: segAddr put: self imageSegmentVersion.
self long32At: segAddr + 4 put: self imageSegmentVersion.
segStart := segAddr := segAddr + self allocationUnit.
"Copy all reachable objects to the segment."
0 to: (self numSlotsOf: arrayOfObjects) - 1 do:
[:i| | newSegAddrOrError objOop |
objOop := self fetchPointer: i ofObject: arrayOfObjects.
self deny: ((self isImmediate: objOop) or: [self isForwarded: objOop]).
self storeLong32: i ofObject: savedInHashes withValue: (self rawHashBitsOf: objOop).
newSegAddrOrError := self copyObj: objOop toAddr: segAddr startAt: segStart stopAt: endSeg.
newSegAddrOrError < segStart ifTrue:
[^self return: newSegAddrOrError
restoringObjectsIn: arrayOfObjects savedHashes: savedInHashes
and: outPointerArray savedHashes: savedOutHashes].
segAddr := newSegAddrOrError].
"Check that it can be safely shortened."
(endSeg ~= segAddr
and: [endSeg - segAddr < (self baseHeaderSize + self bytesPerOop)]) ifTrue:
[^self return: PrimErrWritePastObject
restoringObjectsIn: arrayOfObjects savedHashes: savedInHashes
and: outPointerArray savedHashes: savedOutHashes].
"Now scan, adding out pointers to the outPointersArray; all objects in arrayOfObjects
have their hashes set to point to their copies in segmentWordArray."
(outIndex := self mapOopsFrom: segStart
to: segAddr
outPointers: outPointerArray
outHashes: savedOutHashes) < 0 ifTrue: "no room in outPointers; fail"
[^self return: PrimErrBadIndex
restoringObjectsIn: arrayOfObjects savedHashes: savedInHashes
and: outPointerArray savedHashes: savedOutHashes].
"We're done. Shorten the results, restore hashes and return."
self shorten: segmentWordArray toIndexableSize: segAddr - (segmentWordArray + self baseHeaderSize) / 4.
self shorten: outPointerArray toIndexableSize: outIndex.
^self return: PrimNoErr
restoringObjectsIn: arrayOfObjects savedHashes: savedInHashes
and: outPointerArray savedHashes: savedOutHashes!
Item was changed:
----- Method: StackInterpreter class>>initializeMiscConstants (in category 'initialization') -----
initializeMiscConstants
super initializeMiscConstants.
STACKVM := true.
+ "These flags function to identify a GC operation, or
+ to specify what operations the leak checker should be run for."
+ GCModeFull := 1. "stop-the-world global GC"
+ GCModeNewSpace := 2. "Spur's scavenge, or V3's incremental"
+ GCModeIncremental := 4. "incremental global gc (Dijkstra tri-colour marking); as yet unimplemented"
+ GCModeBecome := 8. "v3 post-become sweeping"
+ GCModeImageSegment := 16. "just a flag for leak checking image segments"
- GCModeFull := 1.
- GCModeIncr := 2.
- GCModeScavenge := 3.
- GCModeBecome := 4.
StackPageTraceInvalid := -1.
StackPageUnreached := 0.
StackPageReachedButUntraced := 1.
StackPageTraced := 2.
DumpStackOnLowSpace := 0.
PrimitiveExternalCallIndex := 117. "Primitive index for #primitiveExternalCall"
MillisecondClockMask := 16r1FFFFFFF.
"Note: The external primitive table should actually be dynamically sized but for the sake of inferior platforms (e.g., Mac :-) who cannot allocate memory in any reasonable way, we keep it static (and cross our fingers...)"
MaxExternalPrimitiveTableSize := 4096. "entries"
MaxJumpBuf := 32. "max. callback depth"
FailImbalancedPrimitives := true!
Item was changed:
----- Method: StackInterpreter>>loadInitialContext (in category 'initialization') -----
loadInitialContext
<inline: false>
| activeProc activeContext |
self cCode: [] inSmalltalk: [self initExtensions].
+ objectMemory runLeakCheckerFor: GCModeFull.
- objectMemory runLeakCheckerForFullGC: true.
activeProc := self activeProcess.
activeContext := objectMemory fetchPointer: SuspendedContextIndex ofObject: activeProc.
self marryContextInNewStackPageAndInitializeInterpreterRegisters: activeContext!
Item was changed:
----- Method: StackInterpreter>>postGCAction: (in category 'object memory support') -----
postGCAction: gcModeArg
+ "Signal the gc semaphore"
- "Shrink free memory and signal the gc semaphore"
- (gcModeArg = GCModeFull or: [gcModeArg = GCModeIncr]) ifTrue:"but *not* become and *not* scavenge"
- [| freeSizeNow |
- freeSizeNow := objectMemory freeSize.
- (freeSizeNow > objectMemory shrinkThreshold
- and: [freeSizeNow > objectMemory growHeadroom]) ifTrue:
- ["Attempt to shrink memory after successfully reclaiming lots of memory"
- objectMemory shrinkObjectMemory: freeSizeNow - objectMemory growHeadroom]].
-
self signalSemaphoreWithIndex: gcSemaphoreIndex!
Item was changed:
----- Method: StackInterpreter>>printFrame: (in category 'debug printing') -----
printFrame: theFP
+ | thePage frameAbove theSP |
- | thePage theSP |
<inline: false>
<var: #theFP type: #'char *'>
- <var: #thePage type: #'StackPage *'>
<var: #theSP type: #'char *'>
+ <var: #frameAbove type: #'char *'>
+ <var: #thePage type: #'StackPage *'>
+ (stackPages couldBeFramePointer: theFP) ifFalse:
+ [self printHexPtr: theFP; print: ' is not in the stack zone?!!'; cr.
+ ^nil].
+ frameAbove := nil.
theFP = framePointer
ifTrue: [theSP := stackPointer]
ifFalse:
[thePage := stackPages stackPageFor: theFP.
(stackPages isFree: thePage) ifTrue:
[self printHexPtr: theFP; print: ' is on a free page?!!'; cr.
^nil].
(thePage ~= stackPage
and: [theFP = thePage headFP])
ifTrue: [theSP := thePage headSP]
ifFalse:
+ [frameAbove := self safeFindFrameAbove: theFP
+ on: thePage
+ startingFrom: ((thePage = stackPage
+ and: [framePointer
+ between: thePage realStackLimit
+ and: thePage baseAddress])
+ ifTrue: [framePointer]
+ ifFalse: [thePage headFP]).
+ theSP := frameAbove ifNotNil:
+ [self frameCallerSP: frameAbove]]].
- [theSP := self findSPOrNilOf: theFP
- on: thePage
- startingFrom: ((thePage = stackPage
- and: [framePointer
- between: thePage realStackLimit
- and: thePage baseAddress])
- ifTrue: [framePointer]
- ifFalse: [thePage headFP])]].
theSP ifNil:
[self print: 'could not find sp; using bogus value'; cr.
theSP := self frameReceiverOffset: theFP].
+ self printFrame: theFP WithSP: theSP.
+ frameAbove ifNotNil:
+ [self printFrameThing: 'frame pc' at: frameAbove + FoxCallerSavedIP]!
- self printFrame: theFP WithSP: theSP!
Item was changed:
----- Method: StackInterpreter>>printFrame:WithSP: (in category 'debug printing') -----
printFrame: theFP WithSP: theSP
<api>
| theMethod numArgs topThing |
<inline: false>
<var: #theFP type: #'char *'>
<var: #theSP type: #'char *'>
<var: #addr type: #'char *'>
self cCode: '' inSmalltalk: [self transcript ensureCr].
+ (stackPages couldBeFramePointer: theFP) ifFalse:
+ [self printHexPtr: theFP; print: ' is not in the stack zone?!!'; cr.
+ ^nil].
theMethod := self frameMethod: theFP.
numArgs := self frameNumArgs: theFP.
self shortPrintFrame: theFP.
self printFrameOop: 'rcvr/clsr'
at: theFP + FoxCallerSavedIP + ((numArgs + 1) * objectMemory wordSize).
numArgs to: 1 by: -1 do:
[:i| self printFrameOop: 'arg' at: theFP + FoxCallerSavedIP + (i * objectMemory wordSize)].
self printFrameThing: 'cllr ip/ctxt' at: theFP + FoxCallerSavedIP.
self printFrameThing: 'saved fp' at: theFP + FoxSavedFP.
self printFrameOop: 'method' at: theFP + FoxMethod.
self printFrameFlagsForFP: theFP.
self printFrameThing: 'context' at: theFP + FoxThisContext.
self printFrameOop: 'receiver' at: theFP + FoxReceiver.
topThing := stackPages longAt: theSP.
(topThing >= theMethod
and: [topThing <= (theMethod + (objectMemory sizeBitsOfSafe: theMethod))])
ifTrue:
[theFP + FoxReceiver - objectMemory wordSize to: theSP + objectMemory wordSize by: objectMemory wordSize negated do:
[:addr|
self printFrameOop: 'temp/stck' at: addr].
self printFrameThing: 'frame ip' at: theSP]
ifFalse:
[theFP + FoxReceiver - objectMemory wordSize to: theSP by: objectMemory wordSize negated do:
[:addr|
self printFrameOop: 'temp/stck' at: addr]]!
Item was changed:
----- Method: StackInterpreter>>printOop: (in category 'debug printing') -----
printOop: oop
| cls fmt lastIndex startIP bytecodesPerLine column |
<inline: false>
(objectMemory isImmediate: oop) ifTrue:
[^self shortPrintOop: oop].
self printHex: oop.
(objectMemory addressCouldBeObj: oop) ifFalse:
[^self print: ((oop bitAnd: objectMemory allocationUnit - 1) ~= 0
ifTrue: [' is misaligned']
ifFalse: [self whereIs: oop]); cr].
(objectMemory isFreeObject: oop) ifTrue:
[self print: ' is a free chunk of size '; printNum: (objectMemory sizeOfFree: oop).
objectMemory hasSpurMemoryManagerAPI ifTrue:
+ [self print: ' 0th: '; printHex: (objectMemory fetchPointer: 0 ofFreeChunk: oop).
+ objectMemory printHeaderTypeOf: oop].
- [self print: ' 0th: '; printHex: (objectMemory fetchPointer: 0 ofFreeChunk: oop)].
^self cr].
(objectMemory isForwarded: oop) ifTrue:
+ [self
- [^self
print: ' is a forwarded object to '; printHex: (objectMemory followForwarded: oop);
+ print: ' of slot size '; printNum: (objectMemory numSlotsOfAny: oop).
+ objectMemory printHeaderTypeOf: oop.
+ ^self cr].
- print: ' of slot size '; printNum: (objectMemory numSlotsOfAny: oop); cr].
self print: ': a(n) '.
self printNameOfClass: (cls := objectMemory fetchClassOfNonImm: oop) count: 5.
cls = (objectMemory splObj: ClassFloat) ifTrue:
[^self cr; printFloat: (objectMemory dbgFloatValueOf: oop); cr].
fmt := objectMemory formatOf: oop.
fmt > objectMemory lastPointerFormat ifTrue:
[self print: ' nbytes '; printNum: (objectMemory numBytesOf: oop)].
self cr.
(fmt between: objectMemory firstLongFormat and: objectMemory firstCompiledMethodFormat - 1) ifTrue:
["This will answer false if splObj: ClassAlien is nilObject"
(self is: oop KindOfClass: (objectMemory splObj: ClassAlien)) ifTrue:
[self print: ' datasize '; printNum: (self sizeOfAlienData: oop).
self print: ((self isIndirectAlien: oop)
ifTrue: [' indirect @ ']
ifFalse:
[(self isPointerAlien: oop)
ifTrue: [' pointer @ ']
ifFalse: [' direct @ ']]).
^self printHex: (self startOfAlienData: oop) asUnsignedInteger; cr].
(objectMemory isWords: oop) ifTrue:
[lastIndex := 64 min: ((objectMemory numBytesOf: oop) / objectMemory wordSize).
lastIndex > 0 ifTrue:
[1 to: lastIndex do:
[:index|
self space; printHex: (objectMemory fetchLong32: index - 1 ofObject: oop).
(index \\ self elementsPerPrintOopLine) = 0 ifTrue:
[self cr]].
(lastIndex \\ self elementsPerPrintOopLine) = 0 ifFalse:
[self cr]].
^self].
^self printStringOf: oop; cr].
"this is nonsense. apologies."
startIP := (objectMemory lastPointerOf: oop) + objectMemory bytesPerOop - objectMemory baseHeaderSize / objectMemory bytesPerOop.
lastIndex := 256 min: startIP.
lastIndex > 0 ifTrue:
[1 to: lastIndex do:
[:index|
self cCode: [self printHex: (objectMemory fetchPointer: index - 1 ofObject: oop); space]
inSmalltalk: [self space; printHex: (objectMemory fetchPointer: index - 1 ofObject: oop); space.
self print: (self shortPrint: (objectMemory fetchPointer: index - 1 ofObject: oop))].
(index \\ self elementsPerPrintOopLine) = 0 ifTrue:
[self cr]].
(lastIndex \\ self elementsPerPrintOopLine) = 0 ifFalse:
[self cr]].
(objectMemory isCompiledMethod: oop)
ifFalse:
[startIP > 64 ifTrue: [self print: '...'; cr]]
ifTrue:
[startIP := startIP * objectMemory wordSize + 1.
lastIndex := objectMemory lengthOf: oop.
lastIndex - startIP > 100 ifTrue:
[lastIndex := startIP + 100].
bytecodesPerLine := 8.
column := 1.
startIP to: lastIndex do:
[:index| | byte |
column = 1 ifTrue:
[self cCode: 'printf("0x%08x: ", oop+BaseHeaderSize+index-1)'
inSmalltalk: [self print: (oop+objectMemory baseHeaderSize+index-1) hex; print: ': ']].
byte := objectMemory fetchByte: index - 1 ofObject: oop.
self cCode: 'printf(" %02x/%-3d", byte,byte)'
inSmalltalk: [self space; print: (byte radix: 16); printChar: $/; printNum: byte].
column := column + 1.
column > bytecodesPerLine ifTrue:
[column := 1. self cr]].
column = 1 ifFalse:
[self cr]]!
Item was changed:
----- Method: StackInterpreter>>printOopShortInner: (in category 'debug printing') -----
printOopShortInner: oop
| classOop name nameLen |
<var: #name type: #'char *'>
<inline: true>
(objectMemory isImmediate: oop) ifTrue:
[(objectMemory isImmediateCharacter: oop) ifTrue:
[^self
printChar: $$;
printChar: (objectMemory characterValueOf: oop);
printChar: $(;
+ printHexnp: (objectMemory characterValueOf: oop);
- printHexnp: (objectMemory integerValueOf: oop);
printChar: $)].
(objectMemory isIntegerObject: oop) ifTrue:
[^self
printNum: (objectMemory integerValueOf: oop);
printChar: $(;
printHexnp: (objectMemory integerValueOf: oop);
printChar: $)].
(objectMemory isImmediateFloat: oop) ifTrue:
[^self
printFloat: (objectMemory dbgFloatValueOf: oop);
printChar: $(;
printHexnp: oop;
printChar: $)].
^self print: 'unknown immediate '; printHexnp: oop].
(objectMemory addressCouldBeObj: oop) ifFalse:
[^self print: ((oop bitAnd: objectMemory allocationUnit - 1) ~= 0
ifTrue: [' is misaligned']
ifFalse: [self whereIs: oop])].
(objectMemory isFreeObject: oop) ifTrue:
[^self print: ' is a free chunk'].
(objectMemory isForwarded: oop) ifTrue:
[^self print: ' is a forwarder to '; printHexnp: (objectMemory followForwarded: oop)].
(self isFloatObject: oop) ifTrue:
[^self printFloat: (objectMemory dbgFloatValueOf: oop)].
classOop := objectMemory fetchClassOfNonImm: oop.
(objectMemory addressCouldBeObj: classOop) ifFalse:
[^self print: 'a ??'].
(objectMemory numSlotsOf: classOop) = metaclassNumSlots ifTrue:
[^self printNameOfClass: oop count: 5].
oop = objectMemory nilObject ifTrue: [^self print: 'nil'].
oop = objectMemory trueObject ifTrue: [^self print: 'true'].
oop = objectMemory falseObject ifTrue: [^self print: 'false'].
nameLen := self lengthOfNameOfClass: classOop.
nameLen = 0 ifTrue: [^self print: 'a ??'].
name := self nameOfClass: classOop.
nameLen = 10 ifTrue:
[(self str: name n: 'ByteString' cmp: 10) = 0 "strncmp is weird" ifTrue:
[^self printChar: $'; printStringOf: oop; printChar: $'].
(self str: name n: 'ByteSymbol' cmp: 10) = 0 "strncmp is weird" ifTrue:
[self printChar: $#; printStringOf: oop. ^self]].
(nameLen = 9 and: [(self str: name n: 'Character' cmp: 9) = 0]) ifTrue:
[^self printChar: $$; printChar: (objectMemory integerValueOf: (objectMemory fetchPointer: 0 ofObject: oop))].
self print: 'a(n) '.
self
cCode: [0 to: nameLen - 1 do: [:i| self printChar: (name at: i)]]
inSmalltalk:
[name isString
ifTrue: [self print: name]
ifFalse: [0 to: nameLen - 1 do: [:i| self printChar: (name at: i)]]].
"Try to spot association-like things; they're all subclasses of LookupKey"
((objectMemory isPointersNonImm: oop)
and: [(objectMemory instanceSizeOf: classOop) = (ValueIndex + 1)
and: [(objectMemory isBytes: (objectMemory fetchPointer: KeyIndex ofObject: oop))]]) ifTrue:
[| classLookupKey |
classLookupKey := objectMemory fetchClassOfNonImm: (objectMemory splObj: SchedulerAssociation).
[classLookupKey = objectMemory nilObject ifTrue:
[^self].
(objectMemory instanceSizeOf: classLookupKey) = (KeyIndex + 1)] whileFalse:
[classLookupKey := self superclassOf: classLookupKey].
(self includesBehavior: classOop ThatOf: classLookupKey) ifTrue:
[self space;
printOopShort: (objectMemory fetchPointer: KeyIndex ofObject: oop);
print: ' -> ';
printHexnp: (objectMemory fetchPointer: ValueIndex ofObject: oop)]]!
Item was added:
+ ----- Method: StackInterpreter>>safeFindFrameAbove:on:startingFrom: (in category 'frame access') -----
+ safeFindFrameAbove: theFP on: thePage startingFrom: startFrame
+ "Search for the previous frame to theFP (the frame that theFP calls).
+ DO NOT CALL THIS WITH theFP == localFP OR theFP == framePointer!!"
+ <var: #theFP type: #'char *'>
+ <var: #thePage type: #'StackPage *'>
+ <var: #startFrame type: #'char *'>
+ <returnTypeC: #'char *'>
+ | aFrame prevFrame |
+ <inline: true>
+ <var: #aFrame type: #'char *'>
+ <var: #prevFrame type: #'char *'>
+ self assert: (stackPages isFree: thePage) not.
+ startFrame = theFP ifTrue:
+ [^nil].
+ aFrame := startFrame.
+ [prevFrame := aFrame.
+ aFrame := self frameCallerFP: aFrame.
+ aFrame ~= 0] whileTrue:
+ [theFP = aFrame ifTrue:
+ [^prevFrame]].
+ ^nil!
Item was removed:
- ----- Method: StackInterpreterSimulator>>preGCAction: (in category 'debugging traps') -----
- preGCAction: gcMode
- "self halt."
- ^super preGCAction: gcMode!
Item was changed:
SharedPool subclass: #VMBasicConstants
instanceVariableNames: ''
+ classVariableNames: 'BaseHeaderSize Byte0Mask Byte0Shift Byte1Mask Byte1Shift Byte1ShiftNegated Byte2Mask Byte2Shift Byte3Mask Byte3Shift Byte3ShiftNegated Byte4Mask Byte4Shift Byte4ShiftNegated Byte5Mask Byte5Shift Byte5ShiftNegated Byte6Mask Byte6Shift Byte7Mask Byte7Shift Byte7ShiftNegated Bytes3to0Mask Bytes7to4Mask BytesPerOop BytesPerWord COGMTVM COGVM DisownVMLockOutFullGC DoAssertionChecks DoExpensiveAssertionChecks GCModeBecome GCModeFull GCModeImageSegment GCModeIncremental GCModeNewSpace IMMUTABILITY MULTIPLEBYTECODESETS NewspeakVM PrimErrBadArgument PrimErrBadIndex PrimErrBadMethod PrimErrBadNumArgs PrimErrBadReceiver PrimErrGenericFailure PrimErrInappropriate PrimErrLimitExceeded PrimErrNamedInternal PrimErrNoCMemory PrimErrNoMemory PrimErrNoModification PrimErrNotFound PrimErrObjectIsPinned PrimErrObjectMayMove PrimErrUnsupported PrimErrWritePastObject PrimNoErr STACKVM SistaVM VMBIGENDIAN'
- classVariableNames: 'BaseHeaderSize Byte0Mask Byte0Shift Byte1Mask Byte1Shift Byte1ShiftNegated Byte2Mask Byte2Shift Byte3Mask Byte3Shift Byte3ShiftNegated Byte4Mask Byte4Shift Byte4ShiftNegated Byte5Mask Byte5Shift Byte5ShiftNegated Byte6Mask Byte6Shift Byte7Mask Byte7Shift Byte7ShiftNegated Bytes3to0Mask Bytes7to4Mask BytesPerOop BytesPerWord COGMTVM COGVM DisownVMLockOutFullGC DoAssertionChecks DoExpensiveAssertionChecks GCModeBecome GCModeFull GCModeIncr GCModeScavenge IMMUTABILITY MULTIPLEBYTECODESETS NewspeakVM PrimErrBadArgument PrimErrBadIndex PrimErrBadMethod PrimErrBadNumArgs PrimErrBadReceiver PrimErrGenericFailure PrimErrInappropriate PrimErrLimitExceeded PrimErrNamedInternal PrimErrNoCMemory PrimErrNoMemory PrimErrNoModification PrimErrNotFound PrimErrObjectIsPinned PrimErrObjectMayMove PrimErrUnsupported PrimErrWritePastObject PrimNoErr STACKVM SistaVM VMBIGENDIAN'
poolDictionaries: ''
category: 'VMMaker-Interpreter'!
!VMBasicConstants commentStamp: '<historical>' prior: 0!
I am a shared pool for basic constants upon which the VM as a whole depends.
self ensureClassPool.
self classPool declare: #BytesPerWord from: VMSqueakV3ObjectRepresentationConstants classPool.
self classPool declare: #BaseHeaderSize from: VMSqueakV3ObjectRepresentationConstants classPool
(ObjectMemory classPool keys select: [:k| k beginsWith: 'Byte']) do:
[:k| self classPool declare: k from: ObjectMemory classPool]!
More information about the Vm-dev
mailing list