[Vm-dev] VM Maker: VMMaker.oscog.seperateMarking-WoC.3289.mcz
commits at source.squeak.org
commits at source.squeak.org
Tue Jan 3 17:34:18 UTC 2023
Tom Braun uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog.seperateMarking-WoC.3289.mcz
==================== Summary ====================
Name: VMMaker.oscog.seperateMarking-WoC.3289
Author: WoC
Time: 3 January 2023, 6:33:54.584721 pm
UUID: 373148ec-0dc6-4fce-a1b1-754ffa63c7ce
Ancestors: VMMaker.oscog.seperateMarking-WoC.3288
- fix bug in sweeper where it did not set the occupation correctly
- added pragmas in order to avoid the very ugly markAndTrace: resolution hack
- write call graph
- new helper method to print memory statistics
=============== Diff against VMMaker.oscog.seperateMarking-WoC.3288 ===============
Item was added:
+ ----- Method: CCodeGenerator>>buildCallGraph (in category 'call graph') -----
+ buildCallGraph
+
+ | graph |
+ graph := Dictionary new.
+
+
+ methods do:
+ [:m | m parseTree nodesWithParentsDo:
+ [:node :parent|
+ node isSend ifTrue: [
+ methods at: node selector
+ ifPresent: [:innerMethod |
+ graph
+ at: innerMethod definingClass -> innerMethod selector
+ ifPresent: [:set | set add: m definingClass -> m selector]
+ ifAbsentPut: [Set with: m definingClass -> m selector]
+ ]]]].
+
+ ^ graph!
Item was added:
+ ----- Method: CCodeGenerator>>buildCallGraphForGC (in category 'call graph') -----
+ buildCallGraphForGC
+
+ | interestingClasses |
+ interestingClasses := Set newFrom: {SpurIncrementalGarbageCollector . SpurStopTheWorldGarbageCollector . SpurGarbageCollector . SpurMarker . SpurAllAtOnceMarker . SpurIncrementalMarker . SpurCompactor . SpurIncrementalCompactor . SpurIncrementalSweepAndCompact . SpurIncrementalSweeper . SpurPlanningCompactor}.
+
+ ^ self
+ filterCallGraph: self buildCallGraph
+ for: interestingClasses!
Item was added:
+ ----- Method: CCodeGenerator>>createAndWriteCallGraph (in category 'call graph') -----
+ createAndWriteCallGraph
+
+ | vmm cg |
+ vmm := (VMMaker forPlatform: 'Cross')
+ interpreterClass: StackInterpreter;
+ options: #(ObjectMemory Spur64BitCoMemoryManager
+ TempVectReadBarrier true).
+ cg := [vmm buildCodeGeneratorForInterpreter]
+ on: Notification
+ do: [:ex|
+ ex tag == #getVMMaker
+ ifTrue: [ex resume: vmm]
+ ifFalse: [ex pass]].
+
+ cg vmClass preGenerationHook: cg.
+ cg inferTypesForImplicitlyTypedVariablesAndMethods.
+ cg prepareMethods.
+
+ cg writeCallGraphCSV: cg buildCallGraphForGC!
Item was added:
+ ----- Method: CCodeGenerator>>filterCallGraph:for: (in category 'call graph') -----
+ filterCallGraph: graph for: interestingClasses
+
+ | result toVisit toVisitNextRound |
+
+ result := graph associationsSelect: [:ea |
+ interestingClasses includes: ea key key ].
+
+ toVisit := (result gather: [:ea | ea]) asSet.
+
+ [toVisitNextRound := Set new.
+ toVisit do: [:ea | | callingMethod |
+ callingMethod := graph associationAt: ea ifAbsent: [].
+ callingMethod
+ ifNotNil: [
+ (result includesKey: callingMethod key)
+ ifFalse: [
+ result add: callingMethod.
+ toVisitNextRound add: callingMethod]]].
+
+ toVisit := (toVisitNextRound gather: [:ea | ea value]) asSet.
+ toVisit size > 0] whileTrue.
+
+ ^ result
+
+
+ !
Item was changed:
----- Method: CCodeGenerator>>ifStaticallyResolvedPolymorphicReceiverThenUpdateSelectorIn:fromMethod:in: (in category 'public') -----
ifStaticallyResolvedPolymorphicReceiverThenUpdateSelectorIn: aSendNode fromMethod: aTMethod in: aClass
"We allow a limited amount of polymorphism; if a class chooses, its selectors can be
prefixed with a given string to disambiguate. This hack allows us to use two different
compaction algorithms with the same API at the same time; the selection being done
by a class which holds the flag stating which algorithm is in effect at the current time."
| class receiverSymbol |
staticallyResolvedPolymorphicReceivers ifNil: [^self].
+ "for debugging. Please do not remove!!"
+ "aTMethod selector = #mapStackPages and: [aSendNode selector = #shouldRemapOop:]) ifTrue: [self halt]."
- "(aTMethod selector = #SSTWGC_unmarkObjectsIn: and: [aSendNode selector = #setIsMarkedOf:to:]) ifTrue: [self halt]."
(aSendNode receiver isVariable
or: [(self hasPolymorphicMethod: aSendNode selector in: aClass )
or: [removedForPolymorphism includesKey: aSendNode selector]])
ifFalse: [^self].
receiverSymbol := aSendNode receiver name.
class := (aTMethod pragmasAt: #staticallyResolveMethod:to:)
ifNotNil: [:pragmas |
pragmas
detect: [:pragma | aSendNode selector = (pragma argumentAt: 1)]
ifFound: [:pragma | "self halt."
self
resolve: aSendNode
to: (Smalltalk at: (pragma argumentAt: 2))
ifFound: [^self]]
ifNone: []].
+
+ class := (aTMethod pragmaAt: #declareTypeForStaticPolymorphism:)
+ ifNotNil: [:pragma | | typeHint classFromHint |
+ typeHint := pragma argumentAt: 1.
+ classFromHint := Smalltalk at: (pragma argumentAt: 1).
+
+ "if we look at a polymorphic base method do not resolve it to its default but the type hint if it knows it"
+ methods at: aSendNode selector
+ ifPresent: [:method |
+ method isPolymorphicBase
+ ifTrue: [(method classes includes: classFromHint)
+ ifTrue: [ | newSelector |
+ newSelector := method polymorphicSelectorForClass: classFromHint.
+ aSendNode setSelectorForPolymorphism: newSelector.
+ ^ self]].
+ method isPolymorphic
+ ifTrue: [self error: 'Should not happen']].
+
+ removedForPolymorphism at: aSendNode selector
+ ifPresent: [:dictionary |
+ dictionary at: classFromHint
+ ifPresent: [:selector |
+ aSendNode
+ setSelectorForPolymorphism: selector.
+ ^ self].
+
+ (mappingForRecursivePolymophism associationsSelect: [:assoc | assoc value = classFromHint]) keys
+ detect: [:key | dictionary includesKey: key]
+ ifFound: [:clazz |
+ aSendNode
+ setSelectorForPolymorphism: (dictionary at: clazz).
+ ^ self]
+
+ ]].
class ifNil: [self resolveRecursivePolymorphism: receiverSymbol in: aSendNode fromMethod: aTMethod in: aClass ifMatch: [^ self]].
class := class ifNil: [self getClassFromPragmasIn: aTMethod ifMatching: receiverSymbol].
class := class ifNil: [self getClassFor: receiverSymbol in: aClass].
class := class ifNil: [
removedForPolymorphism at: aSendNode selector
ifPresent: [: dict |
"you probably ask yourself: why am I here? This halt is triggered if we wre unable to resolve your method, although
it is polymorphic with a very high probability. You either have to declare to which type the method has to be resolved
or I forgot to include one case if the type should already be known
Please have a look what aTMethod to know in which method the problem occured and aSendNode to know the call in aTMethod that is not enough defined. Probably you want to include a pragma #staticallyResolveReceiver:to: to define of which type the receiver is. Should the current method be a Polymorphic(Base)TMethod it is probably interesting why resolveRecursivePolymorphism:in:fromMethod:in:ifMatch: above does not resolve it."
self halt]].
"we have to find a class to resolve the selector"
class
+ ifNotNil: [
- ifNotNil: [
aSendNode
+ setSelectorForPolymorphism: (class staticallyResolvePolymorphicSelector: aSendNode selector)]
- setSelectorForPolymorphism: (class staticallyResolvePolymorphicSelector: aSendNode selector)]
!
Item was changed:
----- Method: CCodeGenerator>>prepareMethods (in category 'utilities') -----
prepareMethods
| globals |
globals := Set new: 200.
globals addAll: variables.
methods do:
[:m |
m locals, m args do:
[:var |
(globals includes: var) ifTrue:
[self error: 'Local variable ''', var, ''' may mask global when inlining ', m selector].
((methods at: var ifAbsent: [nil]) ifNil: [false] ifNotNil: [:m1| m1 isStructAccessor not]) ifTrue:
[logger
ensureCr;
nextPutAll: 'Local variable name ''', var, ''' in ';
nextPutAll: m selector;
nextPutAll: ' may mask method when inlining';
cr]].
m bindClassVariablesIn: constants.
m prepareMethodIn: self].
+ toGenerate ifNotNil: [
+ toGenerate do:
+ [:each | | copy |
+ self assert: (methods includesKey: each key).
+ copy := (methods at: each key) veryDeepCopy.
+ copy selector: each value.
+ copy static: false.
+ self addMethod: copy]]
+ !
- toGenerate do:
- [:each | | copy |
- self assert: (methods includesKey: each key).
- copy := (methods at: each key) veryDeepCopy.
- copy selector: each value.
- copy static: false.
- self addMethod: copy]!
Item was changed:
----- Method: CCodeGenerator>>resolveRecursivePolymorphism:in:fromMethod:in:ifMatch: (in category 'helpers polymorphic resolving') -----
resolveRecursivePolymorphism: receiverSymbol in: aSendNode fromMethod: aTMethod in: aClass ifMatch: aReturnBlock
"- if the current TMethod is a base method we want to resolve it to the default
- if the current TMethod is a polymorphic method, meaning it got a type to resolve for, apply this type to submethods
- if the called method (from SendNode) is a polymorphic base method we resolve it to the default if we are not in a class associated with only one type. Should this be the case we resolve the method to this type"
"((aTMethod selector = #globalGarbageCollect) and: [aSendNode selector = #preGlobalGCActions]) ifTrue: [0 halt]."
aTMethod isPolymorphicBase
ifTrue: [self resolve: receiverSymbol inSelfSend: aSendNode in: aClass to: aTMethod default ifFound: aReturnBlock.
"if the polymorphic receiver is mentioned we resolve the method to the default"
self resolve: aSendNode to: aTMethod default ifFound: aReturnBlock.
"now get desperate. look if there is a method with the selectors name that is mentioned in a polymorphic context"
removedForPolymorphism at: aSendNode selector
ifPresent: [:dictionary | dictionary at: aTMethod default
ifPresent: [:selector |
aSendNode
setSelectorForPolymorphism: selector.
aReturnBlock value].
"is the TMethods receiverClass associated with one of the polymorphic classes implementing aSendNode selector?"
(mappingForRecursivePolymophism associationsSelect: [:assoc | assoc value = aTMethod default]) keys
detect: [:key | dictionary includesKey: key]
ifFound: [:class |
aSendNode
setSelectorForPolymorphism: (dictionary at: class).
aReturnBlock value]].
(self hasPolymorphicMethod: aSendNode selector in: aTMethod default)
ifTrue: [self halt]].
aTMethod isPolymorphic
ifTrue: [self resolvePolymorphicMethod: receiverSymbol in: aSendNode fromMethod: aTMethod in: aClass ifMatch: aReturnBlock].
methods at: aSendNode selector
ifPresent: [:calledMethod |
calledMethod isPolymorphicBase
ifTrue: [ | alternativeClass matchingClass |
"we have type info and the calledMethod does not care which type it is -> use type info"
aTMethod isPolymorphic
ifTrue: [
aSendNode
setSelectorForPolymorphism: (calledMethod polymorphicSelectorForClass: aTMethod receiverClass).
aReturnBlock value ].
+ "should we or one of our superclasses define the called method use the default because we call it ourself and there is no other info"
self resolve: receiverSymbol inSelfSend: aSendNode in: aClass to: calledMethod default ifFound: aReturnBlock.
+ "should the class be mapped to a fixed type use it to resolve the type of the method"
alternativeClass := mappingForRecursivePolymophism at: aClass ifAbsent: [nil].
(calledMethod classes includes: aClass)
ifTrue: [matchingClass := aClass]
ifFalse: [(calledMethod classes includes: alternativeClass)
ifTrue: [matchingClass := alternativeClass]].
matchingClass ifNotNil: [
aSendNode
setSelectorForPolymorphism: (calledMethod polymorphicSelectorForClass: matchingClass).
+ aReturnBlock value].
+
+ "we have no info about the method, but we know it is a polymorphic base -> resolve to default because we assume everyone wants the default"
+ Transcript show: 'Resolved ' , aSendNode asString.
+ aSendNode setSelectorForPolymorphism: (calledMethod polymorphicSelectorForClass: calledMethod default).
+ Transcript
+ show: ' to ' , aSendNode asString , ' in ' , aTMethod asString , ' because it is the default for the defined polymorphic method.';
+ cr.
+ aReturnBlock value
+ ]]
- aReturnBlock value]]]
ifAbsent: [] .
!
Item was added:
+ ----- Method: CCodeGenerator>>writeCallGraphCSV: (in category 'call graph') -----
+ writeCallGraphCSV: connections
+
+ | file |
+ file := FileStream fileNamed: 'output.csv'.
+
+ file
+ nextPutAll: 'source';
+ nextPut: Character tab;
+ nextPutAll: 'target';
+ cr; lf.
+
+ connections keysAndValuesDo: [:key :value |
+ "self halt."
+ value do: [:ea |
+ file
+ nextPutAll: ea asString;
+ nextPut: Character tab;
+ nextPutAll: key asString;
+ cr; lf]].
+
+
+ ^ connections!
Item was added:
+ ----- Method: CCodeGenerator>>writeCallGraphDot: (in category 'call graph') -----
+ writeCallGraphDot: connections
+
+ | file |
+ file := FileStream fileNamed: 'output.dot'.
+
+ file
+ nextPutAll: 'digraph{';
+ cr; lf.
+
+ connections keysAndValuesDo: [:key :value |
+ "self halt."
+ file
+ nextPut: Character tab;
+ nextPutAll: ((value asArray
+ collect: [:ea | '"' , ea asString , '"'] )
+ joinSeparatedBy: ', ');
+
+ nextPutAll: ' -> ';
+ nextPut: $";
+ nextPutAll: key asString;
+ nextPut: $";
+ nextPut: $;].
+
+ file
+ nextPutAll: '}';
+ close.
+
+ ^ connections!
Item was changed:
----- Method: CoInterpreter>>incrementalMarkAndTracePrimTraceLog (in category 'debug support') -----
incrementalMarkAndTracePrimTraceLog
"The prim trace log is a circular buffer of objects. If there is
an entry at primTraceLogIndex - 1 \\ PrimTraceBufferSize it has entries.
If there is something at primTraceLogIndex it has wrapped."
<inline: false>
+ <staticallyResolveReceiver: 'marker' to: #SpurIncrementalMarker>
| entryOop marker |
"do not remove. Necessary for resolving polymorphic receiver"
marker := objectMemory marker.
(primTraceLog at: (self safe: primTraceLogIndex - 1 mod: PrimTraceLogSize)) = 0 ifTrue:
[^self].
(primTraceLog at: primTraceLogIndex) ~= 0 ifTrue:
[primTraceLogIndex to: PrimTraceLogSize - 1 do:
[:i|
entryOop := primTraceLog at: i.
(entryOop ~= 0
and: [objectMemory isNonImmediate: entryOop]) ifTrue:
[marker markAndShouldScan: entryOop]]].
0 to: primTraceLogIndex - 1 do:
[:i|
entryOop := primTraceLog at: i.
(entryOop ~= 0
and: [objectMemory isNonImmediate: entryOop]) ifTrue:
[marker markAndShouldScan: entryOop]]!
Item was changed:
----- Method: CoInterpreter>>incrementalMarkAndTraceStackPage: (in category 'object memory support') -----
incrementalMarkAndTraceStackPage: thePage
| theSP theFP frameRcvrOffset callerFP oop marker |
<var: #thePage type: #'StackPage *'>
<var: #theSP type: #'char *'>
<var: #theFP type: #'char *'>
<var: #frameRcvrOffset type: #'char *'>
<var: #callerFP type: #'char *'>
+ <staticallyResolveReceiver: 'marker' to: #SpurIncrementalMarker>
<inline: false>
"do not remove. Necessary for resolving polymorphic receiver"
marker := objectMemory marker.
self assert: (stackPages isFree: thePage) not.
self assert: (self ifCurrentStackPageHasValidHeadPointers: thePage).
self assert: thePage trace ~= StackPageTraced.
thePage trace: StackPageTraced.
theSP := thePage headSP.
theFP := thePage headFP.
"Skip the instruction pointer on top of stack of inactive pages."
thePage = stackPage ifFalse:
[theSP := theSP + objectMemory wordSize].
[frameRcvrOffset := self frameReceiverLocation: theFP.
[theSP <= frameRcvrOffset] whileTrue:
[oop := stackPages longAt: theSP.
(objectMemory isOopForwarded: oop) ifTrue:
[oop := objectMemory followForwarded: oop.
stackPages longAt: theSP put: oop].
(objectMemory isImmediate: oop) ifFalse:
[marker markAndShouldScan: oop].
theSP := theSP + objectMemory wordSize].
(self frameHasContext: theFP) ifTrue:
[self assert: (objectMemory isContext: (self frameContext: theFP)).
marker markAndShouldScan: (self frameContext: theFP)].
(self isMachineCodeFrame: theFP)
ifTrue: [self markAndTraceMachineCodeMethod: (self mframeCogMethod: theFP)]
ifFalse: [marker markAndShouldScan: (self iframeMethod: theFP)].
(callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
[theSP := theFP + FoxCallerSavedIP + objectMemory wordSize.
theFP := callerFP].
theSP := theFP + FoxCallerSavedIP + objectMemory wordSize. "caller ip is ceBaseReturnPC"
[theSP <= thePage baseAddress] whileTrue:
[oop := stackPages longAt: theSP.
(objectMemory isOopForwarded: oop) ifTrue:
[oop := objectMemory followForwarded: oop.
stackPages longAt: theSP put: oop].
(objectMemory isImmediate: oop) ifFalse:
[marker markAndShouldScan: oop].
theSP := theSP + objectMemory wordSize]!
Item was changed:
----- Method: CoInterpreter>>incrementalMarkAndTraceTraceLog (in category 'object memory support') -----
incrementalMarkAndTraceTraceLog
"The trace log is a circular buffer of pairs of entries. If there is an entry at
traceLogIndex - 3 \\ TraceBufferSize it has entries. If there is something at
traceLogIndex it has wrapped."
<inline: false>
+ <staticallyResolveReceiver: 'marker' to: #SpurIncrementalMarker>
| limit marker |
"do not remove. Necessary for resolving polymorphic receiver"
marker := objectMemory marker.
limit := self safe: traceLogIndex - 3 mod: TraceBufferSize.
(traceLog at: limit) = 0 ifTrue: [^self].
(traceLog at: traceLogIndex) ~= 0 ifTrue:
[limit := TraceBufferSize - 3].
0 to: limit by: 3 do:
[:i| | oop |
oop := traceLog at: i.
(objectMemory isImmediate: oop) ifFalse:
[marker markAndShouldScan: oop].
oop := traceLog at: i + 1.
(objectMemory isImmediate: oop) ifFalse:
[marker markAndShouldScan: oop]]!
Item was changed:
----- Method: CoInterpreter>>mapVMRegisters (in category 'object memory support') -----
mapVMRegisters
"Map the oops in the interpreter's vm ``registers'' to their new values
during garbage collection or a become: operation."
"Assume: All traced variables contain valid oops.
N.B. Don't trace messageSelector and lkupClass; these are ephemeral, live
only during message lookup and because createActualMessageTo will not
cause a GC these cannot change during message lookup."
+ <declareTypeForStaticPolymorphism: #SpurStopTheWorldGarbageCollector>
- <staticallyResolveReceiver: 'objectMemory' to: #SpurIncrementalSweepAndCompact>
| mapInstructionPointer |
(objectMemory shouldRemapObj: method) ifTrue:
["i.e. interpreter instructionPointer in method as opposed to machine code?"
(mapInstructionPointer := instructionPointer > method) ifTrue:
[instructionPointer := instructionPointer - method]. "*rel to method"
method := objectMemory remapObj: method.
mapInstructionPointer ifTrue:
[instructionPointer := instructionPointer + method]]. "*rel to method"
(objectMemory shouldRemapOop: newMethod) ifTrue: "maybe oop due to object-as-method"
[newMethod := objectMemory remapObj: newMethod]!
Item was changed:
----- Method: CoInterpreter>>markAndTraceMachineCodeMethod: (in category 'gc -- mark and sweep') -----
markAndTraceMachineCodeMethod: aCogMethod
<var: #aCogMethod type: #'CogBlockMethod *'>
+ <declareTypeForStaticPolymorphism: #SpurStopTheWorldGarbageCollector>
| homeMethod |
<var: #homeMethod type: #'CogMethod *'>
homeMethod := self asCogHomeMethod: aCogMethod.
objectMemory markAndTrace: homeMethod methodObject!
Item was changed:
----- Method: CoInterpreter>>markAndTracePrimTraceLog (in category 'debug support') -----
markAndTracePrimTraceLog
"The prim trace log is a circular buffer of objects. If there is
an entry at primTraceLogIndex - 1 \\ PrimTraceBufferSize it has entries.
If there is something at primTraceLogIndex it has wrapped."
<inline: false>
+ <declareTypeForStaticPolymorphism: #SpurStopTheWorldGarbageCollector>
| entryOop |
(primTraceLog at: (self safe: primTraceLogIndex - 1 mod: PrimTraceLogSize)) = 0 ifTrue:
[^self].
(primTraceLog at: primTraceLogIndex) ~= 0 ifTrue:
[primTraceLogIndex to: PrimTraceLogSize - 1 do:
[:i|
entryOop := primTraceLog at: i.
(entryOop ~= 0
and: [objectMemory isNonImmediate: entryOop]) ifTrue:
[objectMemory markAndTrace: entryOop]]].
0 to: primTraceLogIndex - 1 do:
[:i|
entryOop := primTraceLog at: i.
(entryOop ~= 0
and: [objectMemory isNonImmediate: entryOop]) ifTrue:
[objectMemory markAndTrace: entryOop]]!
Item was changed:
----- Method: CoInterpreter>>markAndTraceStackPage: (in category 'object memory support') -----
markAndTraceStackPage: thePage
| theSP theFP frameRcvrOffset callerFP oop marker |
<var: #thePage type: #'StackPage *'>
<var: #theSP type: #'char *'>
<var: #theFP type: #'char *'>
<var: #frameRcvrOffset type: #'char *'>
<var: #callerFP type: #'char *'>
+ <declareTypeForStaticPolymorphism: #SpurStopTheWorldGarbageCollector>
<inline: false>
"do not remove. Necessary for resolving polymorphic receiver"
marker := objectMemory marker.
self assert: (stackPages isFree: thePage) not.
self assert: (self ifCurrentStackPageHasValidHeadPointers: thePage).
self assert: thePage trace ~= StackPageTraced.
thePage trace: StackPageTraced.
theSP := thePage headSP.
theFP := thePage headFP.
"Skip the instruction pointer on top of stack of inactive pages."
thePage = stackPage ifFalse:
[theSP := theSP + objectMemory wordSize].
[frameRcvrOffset := self frameReceiverLocation: theFP.
[theSP <= frameRcvrOffset] whileTrue:
[oop := stackPages longAt: theSP.
(objectMemory isOopForwarded: oop) ifTrue:
[oop := objectMemory followForwarded: oop.
stackPages longAt: theSP put: oop].
(objectMemory isImmediate: oop) ifFalse:
[marker markAndTrace: oop].
theSP := theSP + objectMemory wordSize].
(self frameHasContext: theFP) ifTrue:
[self assert: (objectMemory isContext: (self frameContext: theFP)).
marker markAndTrace: (self frameContext: theFP)].
(self isMachineCodeFrame: theFP)
ifTrue: [self markAndTraceMachineCodeMethod: (self mframeCogMethod: theFP)]
ifFalse: [marker markAndTrace: (self iframeMethod: theFP)].
(callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
[theSP := theFP + FoxCallerSavedIP + objectMemory wordSize.
theFP := callerFP].
theSP := theFP + FoxCallerSavedIP + objectMemory wordSize. "caller ip is ceBaseReturnPC"
[theSP <= thePage baseAddress] whileTrue:
[oop := stackPages longAt: theSP.
(objectMemory isOopForwarded: oop) ifTrue:
[oop := objectMemory followForwarded: oop.
stackPages longAt: theSP put: oop].
(objectMemory isImmediate: oop) ifFalse:
[marker markAndTrace: oop].
theSP := theSP + objectMemory wordSize]!
Item was changed:
----- Method: CoInterpreter>>markAndTraceTraceLog (in category 'object memory support') -----
markAndTraceTraceLog
"The trace log is a circular buffer of pairs of entries. If there is an entry at
traceLogIndex - 3 \\ TraceBufferSize it has entries. If there is something at
traceLogIndex it has wrapped."
<inline: false>
+ <declareTypeForStaticPolymorphism: #SpurStopTheWorldGarbageCollector>
| limit |
limit := self safe: traceLogIndex - 3 mod: TraceBufferSize.
(traceLog at: limit) = 0 ifTrue: [^self].
(traceLog at: traceLogIndex) ~= 0 ifTrue:
[limit := TraceBufferSize - 3].
0 to: limit by: 3 do:
[:i| | oop |
oop := traceLog at: i.
(objectMemory isImmediate: oop) ifFalse:
[objectMemory markAndTrace: oop].
oop := traceLog at: i + 1.
(objectMemory isImmediate: oop) ifFalse:
[objectMemory markAndTrace: oop]]!
Item was changed:
----- Method: CoInterpreterMT>>mapInterpreterOops (in category 'object memory support') -----
mapInterpreterOops
"Map all oops in the interpreter's state to their new values
during garbage collection or a become: operation."
"Assume: All traced variables contain valid oops."
<var: #vmThread type: #'CogVMThread *'>
+ <declareTypeForStaticPolymorphism: #SpurStopTheWorldGarbageCollector>
- <staticallyResolveReceiver: 'objectMemory' to: #SpurIncrementalSweepAndCompact>
super mapInterpreterOops.
"Per-thread state; trace each thread's own newMethod and stack of awol processes."
1 to: cogThreadManager getNumThreads do:
[:i| | vmThread |
vmThread := cogThreadManager vmThreadAt: i.
vmThread state ifNotNil:
[(vmThread newMethodOrNull notNil
and: [objectMemory shouldRemapOop: vmThread newMethodOrNull]) ifTrue:
[vmThread newMethodOrNull: (objectMemory remapObj: vmThread newMethodOrNull)].
0 to: vmThread awolProcIndex - 1 do:
[:j|
(objectMemory shouldRemapOop: (vmThread awolProcesses at: j)) ifTrue:
[vmThread awolProcesses at: j put: (objectMemory remapObj: (vmThread awolProcesses at: j))]]]]!
Item was changed:
----- Method: CoInterpreterMT>>markAndTraceInterpreterOops: (in category 'object memory support') -----
markAndTraceInterpreterOops: fullGCFlag
"Override to mark the awolProcesses"
<var: #vmThread type: #'CogVMThread *'>
+ <declareTypeForStaticPolymorphism: #SpurStopTheWorldGarbageCollector>
super markAndTraceInterpreterOops: fullGCFlag.
"Per-thread state; trace each thread's own newMethod and stack of awol processes."
1 to: cogThreadManager getNumThreads do:
[:i| | vmThread |
vmThread := cogThreadManager vmThreadAt: i.
vmThread state ifNotNil:
[vmThread newMethodOrNull ifNotNil:
[objectMemory markAndTrace: vmThread newMethodOrNull].
0 to: vmThread awolProcIndex - 1 do:
[:j| objectMemory markAndTrace: (vmThread awolProcesses at: j)]]]!
Item was added:
+ ----- Method: SpurIncrementalCompactor>>isCurrentlyCompacting (in category 'as yet unclassified') -----
+ isCurrentlyCompacting
+
+ ^ isCompacting!
Item was changed:
----- Method: SpurIncrementalGarbageCollector>>doIncrementalCollect (in category 'as yet unclassified') -----
doIncrementalCollect
+ | startTime |
+
phase = InMarkingPhase
ifTrue: [ | finishedMarking |
marker isCurrentlyMarking
ifFalse: [self assert: manager allObjectsUnmarked].
coInterpreter cr; print: 'start marking '; tab; flush.
finishedMarking := marker incrementalMarkObjects.
"self assert: manager validObjectColors."
finishedMarking
ifTrue: [
manager allPastSpaceObjectsDo: [:obj | self assert: (manager isWhite: obj)].
"when sweeping the mutator needs to allocate new objects black as we do not have any information about them.
We only know if they should get swept after the next marking -> keep them alive for this cycle"
self allocatorShouldAllocateBlack: true.
compactor setInitialSweepingEntity.
phase := InSweepingPhase.
"marking is done and thus all forwarding from the last compaction references are resolved
-> we can use the now free segments that were compacted during the last cycle"
compactor freePastSegmentsAndSetSegmentToFill.
self assert: manager noObjectGrey.
coInterpreter cr; print: 'finish marking '; tab; flush.
+ startTime := coInterpreter ioUTCMicrosecondsNow.
manager
setCheckForLeaks: GCCheckFreeSpace + GCModeFull;
runLeakCheckerFor: GCModeFull excludeUnmarkedObjs: true classIndicesShouldBeValid: true;
checkFreeSpace: GCModeFull.
+ coInterpreter cr; print: 'time for internal check: '; printNum: coInterpreter ioUTCMicrosecondsNow - startTime; tab; flush.
+
^ self]
ifFalse: [coInterpreter cr; print: 'finish marking pass'; tab; flush.manager runLeakCheckerFor: GCModeIncremental]].
phase = InSweepingPhase
ifTrue: [
coInterpreter cr; print: 'start sweeping '; tab; flush.
compactor incrementalSweep
ifTrue: [
self allocatorShouldAllocateBlack: false.
manager allOldSpaceObjectsDo: [:ea | self assert: (manager isWhite: ea) ].
"self assert: manager allObjectsUnmarked."
coInterpreter cr; print: 'finish sweeping '; tab; flush.
+ startTime := coInterpreter ioUTCMicrosecondsNow.
manager
setCheckForLeaks: GCCheckFreeSpace + GCModeFull;
runLeakCheckerFor: GCModeFull;
checkFreeSpace: GCModeFull.
+ coInterpreter cr; print: 'time for internal check: '; printNum: coInterpreter ioUTCMicrosecondsNow - startTime; tab; flush.
compactor assertNoSegmentBeingCompacted.
phase := InCompactingPhase.
^ self]].
phase = InCompactingPhase
ifTrue: [
"self cCode: 'raise(SIGINT)'."
coInterpreter cr; print: 'start compacting '; tab; flush.
+ compactor isCurrentlyCompacting
+ ifFalse: [manager printFreeSpaceStatistics].
compactor incrementalCompact
ifTrue: [
coInterpreter cr; print: 'finish compacting '; tab; flush.
+
+ startTime := coInterpreter ioUTCMicrosecondsNow.
manager
setCheckForLeaks: GCCheckFreeSpace + GCModeFull;
runLeakCheckerFor: GCModeFull;
checkFreeSpace: GCModeFull.
+ coInterpreter cr; print: 'time for internal check: '; printNum: coInterpreter ioUTCMicrosecondsNow - startTime; tab; flush.
phase := InMarkingPhase.
^ self]]!
Item was changed:
----- Method: SpurIncrementalMarker>>markAndTrace: (in category 'marking - incremental') -----
markAndTrace: objOop
+ "we do not want to call this method"
+ self cCode: 'raise(SIGINT)'!
- self halt.!
Item was changed:
----- Method: SpurIncrementalSweeper>>cautiousBulkFreeChunkFrom: (in category 'api - incremental') -----
cautiousBulkFreeChunkFrom: objOop
"The old space entity before objOop is necessarily a marked object. Attempts to free as many bytes
from objOop start as possible, looking ahead to free contiguous freechunks / unmarked objects"
| bytes start next currentObj |
self assert: (self canUseAsFreeSpace: objOop).
start := manager startOfObject: objOop.
currentObj := objOop.
bytes := 0.
[bytes := bytes + (manager bytesInBody: currentObj).
(manager isRemembered: currentObj)
ifTrue:
[self assert: (manager isFreeObject: currentObj) not.
scavenger forgetObject: currentObj].
(manager isFreeObject: currentObj)
ifTrue: [ "we need to unlink chunks for concurrent sweeping. In the stop the world sweeper we can just reset the freeLists but here we need to keep them
around so the mutator can still work between sweeping passes"
self flag: #Todo. "we want to optimize for lilliputian chunks!! For now it is ok(ish) but we have to do something about it.
At the moment I see 3 possibilities:
- have the lilliputian list always sorted (O(n) insert in the worst case!!)
- sort the lilliputian part before sweeping (O(n log n) at the start. but everytime before sweeping)
- be cheeky and discard the lilliputian list (problem: the mutator has no access to the list + it can insert unsorted chunks (for the duration of sweeping we could let it use a second list and just append it after sweeping)"
manager detachFreeObject: currentObj.
+ "self assert: manager totalFreeOldSpace = manager totalFreeListBytes."].
- "self assert: manager totalFreeOldSpace = manager totalFreeListBytes."
- currentSegmentUnused := currentSegmentUnused + (manager bytesInBody: currentSweepingEntity)].
+
next := manager objectStartingAt: start + bytes.
currentsCycleSeenObjectCount := currentsCycleSeenObjectCount + 1.
self assert: ((manager oop: next isLessThan: manager endOfMemory)
or: [next = manager endOfMemory and: [(self canUseAsFreeSpace: next) not]]).
"we found the end of a segment (old space segments always end in a bridge). Advance to the next"
+ "next = currentSegmentsBridge
+ ifTrue: [self cCode: 'raise(SIGINT)'.
+ self advanceSegment]."
- next = currentSegmentsBridge
- ifTrue: [self advanceSegment].
+ "should the next object not be usable as free space (because it is marked) abort the loop. Attention:
+ briges at the end of segments are marked and therefore we leave the loop here. This is important as the
+ newly created free space segment should not be bigger than there still is space left in the current segment"
(self canUseAsFreeSpace: next) and: [currentsCycleSeenObjectCount < MaxObjectsToFree]]
whileTrue: [currentObj := next].
+ currentSegmentUnused := currentSegmentUnused + bytes.
^ manager addFreeChunkWithBytes: bytes at: start!
Item was changed:
----- Method: SpurIncrementalSweeper>>doIncrementalSweeping (in category 'api - incremental') -----
doIncrementalSweeping
"Scan the heap for unmarked objects and free them. Coalescence "
self assert: currentSweepingEntity notNil.
currentsCycleSeenObjectCount := 0.
[self oop: currentSweepingEntity isLessThan: manager endOfMemory] whileTrue:
[ currentSweepingEntity = currentSegmentsBridge
ifTrue: [self advanceSegment]
ifFalse: [self sweepFromCurrentSweepingEntity].
currentSweepingEntity := self nextSweepingEntity.
currentsCycleSeenObjectCount >= MaxObjectsToFree
ifTrue: [^ false]].
+ "set occupation for last segment"
+ self setOccupationAtIndex: currentSegmentsIndex used: currentSegmentUsed unused: currentSegmentUnused.
manager checkFreeSpace: GCModeIncremental.
^ true!
Item was changed:
----- Method: SpurIncrementalSweeper>>nextSweepingEntity (in category 'as yet unclassified') -----
nextSweepingEntity
| nextEntity reservedSegmentsFreeChunk |
nextEntity := manager objectAfter: currentSweepingEntity limit: manager endOfMemory.
reservedSegmentsFreeChunk := self compactorsSegmentToFill ifNotNil: [manager objectStartingAt: self compactorsSegmentToFill segStart].
nextEntity = reservedSegmentsFreeChunk
ifTrue: [ | segmentIndex |
"reset the claim bit!! (would otherwise stay untouched which would trigger errors)
unused does not match here as long used stays 0 which will drop down the complete
calculation to 0"
segmentIndex := manager segmentManager segmentIndexContainingObj: nextEntity.
self
setOccupationAtIndex: segmentIndex
used: 0
unused: 1.
+ currentSegmentUsed := 0.
currentSegmentUnused := manager bytesInBody: reservedSegmentsFreeChunk.
nextEntity := manager objectAfter: nextEntity limit: manager endOfMemory].
^ nextEntity!
Item was changed:
----- Method: SpurIncrementalSweeper>>setOccupationAtIndex:used:unused: (in category 'compactor support') -----
setOccupationAtIndex: segmentIndex used: used unused: unused
"WARNING: Resets the isCompacted bit"
"Swizzle is abused bit 16 isBeingCompacted bits 0-15 occupation
Setting occupation resets the claim bit"
| occupation segInfo |
<var: 'segInfo' type: #'SpurSegmentInfo *'>
+
+ coInterpreter cr; print: '-------------------------------'; cr; flush.
+ coInterpreter cr; print: 'Segment '; printNum: segmentIndex; print: ' is occupied to: '; printNum: (used asFloat / (used + unused)) * 100; print: '%'; cr;
+ print: 'used: '; printNum: used; cr;
+ print: 'unused: '; printNum: unused; tab; flush; cr.
+
+ coInterpreter cr; print: '-------------------------------'; cr; flush.
+
segInfo := manager segInfoAt: segmentIndex.
"careful with overflow here..."
occupation := ((used asFloat / (used + unused)) * 16rFFFF) asInteger.
self assert: (occupation between: 0 and: 16rFFFF).
segInfo swizzle: occupation!
Item was changed:
----- Method: SpurMemoryManager class>>declareCVarsIn: (in category 'translation') -----
declareCVarsIn: aCCodeGenerator
self wantsIncrementalGC
ifTrue: [aCCodeGenerator
recursivelyResolvePolymorpicReceiver: 'gc' toVariants: {SpurIncrementalGarbageCollector. SpurStopTheWorldGarbageCollector} in: self default: SpurIncrementalGarbageCollector;
staticallyResolvedPolymorphicReceiver: 'gc' to: SpurIncrementalMarker in: SpurIncrementalGarbageCollector;
staticallyResolvedPolymorphicReceiver: 'compactor' to: SpurIncrementalSweepAndCompact in: self;
staticallyResolvedPolymorphicReceiver: 'marker' to: SpurIncrementalMarker in: self].
self class == thisContext methodClass ifFalse: [^self]. "Don't duplicate decls in subclasses"
aCCodeGenerator removeVariable: 'memory'. "memory is a simulation time thing only"
self declareCAsOop: #( freeStart scavengeThreshold newSpaceStart pastSpaceStart
oldSpaceStart lowSpaceThreshold freeOldSpaceStart endOfMemory)
in: aCCodeGenerator.
self declareCAsUSqLong: (self allInstVarNames select: [:ivn| ivn endsWith: 'Usecs']), #(statAllocatedBytes)
in: aCCodeGenerator.
aCCodeGenerator
var: #lastHash type: #usqInt;
var: #freeListsMask type: #usqInt;
var: #freeLists type: #'sqInt *';
var: #objStackInvalidBecause type: #'char *';
var: #unscannedEphemerons type: #SpurContiguousObjStack;
var: #heapGrowthToSizeGCRatio type: #float;
var: #heapSizeAtPreviousGC type: #usqInt;
var: #totalFreeOldSpace type: #usqInt;
var: #maxOldSpaceSize type: #usqInt.
aCCodeGenerator
var: #oldSpaceUsePriorToScavenge type: #sqLong.
aCCodeGenerator
var: #remapBuffer
declareC: 'sqInt remapBuffer[RemapBufferSize + 1 /* ', (RemapBufferSize + 1) printString, ' */]'.
aCCodeGenerator
var: #extraRoots
declareC: 'sqInt *extraRoots[ExtraRootsSize + 1 /* ', (ExtraRootsSize + 1) printString, ' */]'.
self wantsIncrementalGC
ifTrue: [aCCodeGenerator
- "hack!! see SpurMemoryManager>>staticallyResolvePolymorphicSelector: why we use this"
staticallyResolvedPolymorphicReceiver: 'manager gc' to: SpurIncrementalGarbageCollector in: SpurSegmentManager;
- staticallyResolvedPolymorphicReceiver: 'objectMemory' to: self in: StackInterpreter;
- staticallyResolvedPolymorphicReceiver: 'objectMemory' to: self in: CoInterpreter;
- staticallyResolvedPolymorphicReceiver: 'objectMemory' to: self in: CoInterpreterMT;
"the vm needs (from handwritten C code) the method fullGC. Generate it later on"
generate: #fullGC from: #SIGC_fullGC]!
Item was removed:
- ----- Method: SpurMemoryManager class>>staticallyResolvePolymorphicSelector: (in category 'as yet unclassified') -----
- staticallyResolvePolymorphicSelector: aSelectorSymbol
-
- "resolve markAndTrace: to the allAtOnce one, as we avoided using markAndTrace: for incremental marking we
- can (and have to) always resolve this to SpurAllAtOnceMarker>>markAndTrace:"
-
- ^ self wantsIncrementalGC
- ifTrue: [aSelectorSymbol = #markAndTrace:
- ifTrue: [SpurAllAtOnceMarker staticallyResolvePolymorphicSelector: aSelectorSymbol]
- ifFalse: [aSelectorSymbol]]
- ifFalse: [aSelectorSymbol]!
Item was added:
+ ----- Method: SpurMemoryManager>>collectFreeSpaceAsNumberInto:limit:resultsInto: (in category 'primitive support') -----
+ collectFreeSpaceAsNumberInto: start limit: limit resultsInto: binaryBlock
+
+ <inline: true>
+ | count ptr |
+ count := 0.
+ ptr := start.
+ self allOldSpaceEntitiesDo:
+ [:obj |
+ (self isFreeOop: obj)
+ ifTrue: [ | slotCount |
+ slotCount := (self bytesInBody: obj) >> self shiftForWord.
+
+ count := count + 1.
+ ptr < limit ifTrue:
+ [self longAt: ptr put: obj.
+ self longAt: ptr + self bytesPerOop put: slotCount.
+ ptr := ptr + (2 * self bytesPerOop)]]].
+
+ binaryBlock value: count value: ptr
+ !
Item was added:
+ ----- Method: SpurMemoryManager>>freeSpaceMap (in category 'primitive support') -----
+ freeSpaceMap
+
+ | freeChunk ptr start limit count bytes |
+ freeChunk := self allocateLargestFreeChunk. "N.B. Does /not/ update totalFreeOldSpace"
+ start := freeChunk + self baseHeaderSize.
+ limit := self addressAfter: freeChunk.
+ self collectFreeSpaceAsNumberInto: start limit: limit resultsInto: [:c :p| count := c. ptr := p].
+
+ (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 bytesInBody: freeChunk) at: (self startOfObject: freeChunk).
+ self beRootIfOld: smallObj.
+ self checkFreeSpace: GCModeFull.
+ ^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: (self rawHashBitsOf: (self splObj: ClassDoubleWordArray)) formatTo: self sixtyFourBitIndexableFormat.
+ gc maybeModifyGCFlagsOf: freeChunk.
+ self possibleRootStoreInto: freeChunk.
+ self checkFreeSpace: GCModeFull.
+ self runLeakCheckerFor: GCModeFull excludeUnmarkedObjs: true classIndicesShouldBeValid: true.
+ ^freeChunk!
Item was changed:
----- Method: SpurMemoryManager>>memoryMap (in category 'primitive support') -----
memoryMap
| freeChunk ptr start limit count bytes |
freeChunk := self allocateLargestFreeChunk. "N.B. Does /not/ update totalFreeOldSpace"
start := freeChunk + self baseHeaderSize.
limit := self addressAfter: freeChunk.
self collectAsNumberInto: start limit: limit resultsInto: [:c :p| count := c. ptr := p].
(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 bytesInBody: freeChunk) at: (self startOfObject: freeChunk).
self beRootIfOld: smallObj.
self checkFreeSpace: GCModeFull.
^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: (self rawHashBitsOf: (self splObj: ClassDoubleWordArray)) formatTo: self sixtyFourBitIndexableFormat.
gc maybeModifyGCFlagsOf: freeChunk.
self possibleRootStoreInto: freeChunk.
self checkFreeSpace: GCModeFull.
self runLeakCheckerFor: GCModeFull excludeUnmarkedObjs: true classIndicesShouldBeValid: true.
- self cCode: 'raise(SIGINT)'.
^freeChunk!
Item was added:
+ ----- Method: SpurMemoryManager>>printFreeSpaceStatistics (in category 'debug printing') -----
+ printFreeSpaceStatistics
+
+ "used for debugging"
+ <export: true>
+ <var: 'sizeCount' declareC:'static unsigned long long sizeCount[64] = {0}'>
+
+ | sizeCount |
+ self cCode:'' inSmalltalk:[
+ sizeCount := CArrayAccessor on: (DoubleWordArray new: 64).
+ ].
+
+ coInterpreter cr;
+ print: '----------------------------------------- '; cr;
+ print: '----------------------------------------- ';
+ cr.
+
+ 0 to: self numSegments -1
+ do: [:index | | segInfo bigFreeChunkMemory freeSpace occupiedSpace |
+ segInfo := self segInfoAt: index.
+ bigFreeChunkMemory := 0.
+ freeSpace := 0.
+ occupiedSpace := 0.
+
+ segmentManager
+ allEntitiesInSegment: segInfo
+ exceptTheLastBridgeDo: [:oop | | oopSize |
+ oopSize := self numSlotsOfAny: oop.
+
+ (self isFreeOop: oop)
+ ifTrue: [
+ "index > 0
+ ifTrue: [self cCode: 'raise(SIGINT)']."
+ freeSpace := freeSpace + oopSize.
+
+ oopSize < 64
+ ifTrue: [
+ sizeCount at: oopSize put: ((sizeCount at: oopSize) + 1)]
+ ifFalse: [sizeCount at: 0 put: ((sizeCount at: 0) + 1).
+ bigFreeChunkMemory := bigFreeChunkMemory + oopSize]]
+ ifFalse: [occupiedSpace := occupiedSpace + oopSize]].
+
+ coInterpreter cr;
+ print: 'Segment ';
+ printNum: index;
+ print: ' (starting at: ';
+ printHex: segInfo segStart; tab;
+ print: 'max slots: '; tab;
+ printNum: segInfo segSize >> 3;
+ print: ')';
+ cr; cr; flush.
+
+ coInterpreter cr;
+ print: 'Currently occupied space: '; tab;
+ printNum: occupiedSpace; cr;
+ print: 'Currently free space: '; tab;
+ printNum: freeSpace; cr;
+ print: 'Resulting in an occupation percentage of: '; tab;
+ printNum: (occupiedSpace asFloat / (occupiedSpace + freeSpace)) * 100;
+ cr; cr; flush.
+
+ coInterpreter tab;
+ print: 'big free chunks ';
+ printNum: (sizeCount at: 0);
+ print: ' reserving number of slots: ';
+ printNum: bigFreeChunkMemory;
+ cr; flush.
+ sizeCount at: 0 put: 0.
+
+
+ 1 to: 63
+ do: [:i |
+ (sizeCount at: i) > 0
+ ifTrue: [coInterpreter tab;
+ print: 'free chunk of size '; printNum: i; print: ': ';
+ printNum: (sizeCount at: i);
+ cr; flush.
+ sizeCount at: i put: 0.]].
+
+ coInterpreter cr;
+ print: '----------------------------------------- '; cr.].
+
+ coInterpreter cr;
+ print: '----------------------------------------- '; cr;
+ print: '----------------------------------------- ';
+ cr.
+ !
Item was changed:
----- Method: StackInterpreter class>>initializePrimitiveTable (in category 'initialization') -----
(excessive size, no diff calculated)
Item was changed:
----- Method: StackInterpreter>>mapInterpreterOops (in category 'object memory support') -----
mapInterpreterOops
"Map all oops in the interpreter's state to their new values
during garbage collection or a become: operation."
"Assume: All traced variables contain valid oops."
+ <declareTypeForStaticPolymorphism: #SpurStopTheWorldGarbageCollector>
- <staticallyResolveReceiver: 'objectMemory' to: #SpurIncrementalSweepAndCompact>
<inline: false>
self mapStackPages.
self mapMachineCode: self getGCMode.
self mapTraceLogs.
self mapVMRegisters.
self mapProfileState.
(tempOop ~= 0
and: [objectMemory shouldRemapOop: tempOop]) ifTrue:
[tempOop := objectMemory remapObj: tempOop].
(tempOop2 ~= 0
and: [objectMemory shouldRemapOop: tempOop2]) ifTrue:
[tempOop2 := objectMemory remapObj: tempOop2].
objectMemory hasSpurMemoryManagerAPI ifFalse:
[self getClassTagOfLinkedList]!
Item was changed:
----- Method: StackInterpreter>>mapProfileState (in category 'object memory support') -----
mapProfileState
+ <declareTypeForStaticPolymorphism: #SpurStopTheWorldGarbageCollector>
- <staticallyResolveReceiver: 'objectMemory' to: #SpurIncrementalSweepAndCompact>
(objectMemory shouldRemapObj: profileProcess) ifTrue:
[profileProcess := objectMemory remapObj: profileProcess].
(objectMemory shouldRemapObj: profileMethod) ifTrue:
[profileMethod := objectMemory remapObj: profileMethod].
(objectMemory shouldRemapObj: profileSemaphore) ifTrue:
[profileSemaphore := objectMemory remapObj: profileSemaphore].
self cppIf: #LRPCheck
ifTrue:
["The longRunningPrimitiveCheckMethod (LRPCM) is sampled in an interrupt. Be very careful with it.
If longRunningPrimitiveCheckSequenceNumber (LRPCSN) = statCheckForEvents then LRPCM has
been recenty sampled and could be mapped or not, but it must be newMethod and we can simply
copy newMethod. If LRPCSN ~= statCheckForEvents then LRPCM must be some extant object and
needs to be remapped."
self sqLowLevelMFence.
longRunningPrimitiveCheckMethod ifNotNil:
[longRunningPrimitiveCheckSequenceNumber = statCheckForEvents
ifTrue: [longRunningPrimitiveCheckMethod := newMethod]
ifFalse:
[(objectMemory shouldRemapObj: longRunningPrimitiveCheckMethod) ifTrue:
[longRunningPrimitiveCheckMethod := objectMemory remapObj: longRunningPrimitiveCheckMethod]].
self sqLowLevelMFence].
longRunningPrimitiveCheckSemaphore ifNotNil:
[(objectMemory shouldRemapObj: longRunningPrimitiveCheckSemaphore) ifTrue:
[longRunningPrimitiveCheckSemaphore := objectMemory remapObj: longRunningPrimitiveCheckSemaphore]]]!
Item was changed:
----- Method: StackInterpreter>>mapStackPages (in category 'object memory support') -----
mapStackPages
<inline: #never>
<var: #thePage type: #'StackPage *'>
<var: #theSP type: #'char *'>
<var: #theFP type: #'char *'>
<var: #callerFP type: #'char *'>
<var: #theIPPtr type: #'char *'>
+ <declareTypeForStaticPolymorphism: #SpurStopTheWorldGarbageCollector>
- <staticallyResolveReceiver: 'objectMemory' to: #SpurIncrementalSweepAndCompact>
| numLivePages |
numLivePages := 0.
0 to: numStackPages - 1 do:
[:i| | thePage theSP theFP callerFP theIPPtr theIP oop |
thePage := stackPages stackPageAt: i.
thePage isFree ifFalse:
[self assert: (self ifCurrentStackPageHasValidHeadPointers: thePage).
numLivePages := numLivePages + 1.
theSP := thePage headSP.
theFP := thePage headFP.
"Skip the instruction pointer on top of stack of inactive pages."
thePage = stackPage
ifTrue: [theIPPtr := 0]
ifFalse:
[theIPPtr := theSP.
theSP := theSP + objectMemory wordSize].
[self assert: (thePage addressIsInPage: theFP).
self assert: (thePage addressIsInPage: theSP).
self assert: (theIPPtr = 0 or: [thePage addressIsInPage: theIPPtr]).
[theSP <= (theFP + FoxReceiver)] whileTrue:
[oop := stackPages longAt: theSP.
(objectMemory shouldRemapOop: oop) ifTrue:
[stackPages longAt: theSP put: (objectMemory remapObj: oop)].
theSP := theSP + objectMemory wordSize].
(self frameHasContext: theFP) ifTrue:
[(objectMemory shouldRemapObj: (self frameContext: theFP)) ifTrue:
[stackPages
longAt: theFP + FoxThisContext
put: (objectMemory remapObj: (self frameContext: theFP))].
"With SqueakV3 objectMemory or SpurPlanningCompactor can't assert since object body is yet to move."
(objectMemory hasSpurMemoryManagerAPI
and: [objectMemory slidingCompactionInProgress not]) ifTrue:
[self assert: ((self isMarriedOrWidowedContext: (self frameContext: theFP))
and: [(self frameOfMarriedContext: (self frameContext: theFP)) = theFP])]].
(objectMemory shouldRemapObj: (self frameMethod: theFP)) ifTrue:
[theIPPtr ~= 0 ifTrue:
[self assert: (stackPages longAt: theIPPtr) > (self frameMethod: theFP).
theIP := (stackPages longAt: theIPPtr) - (self frameMethod: theFP)].
stackPages
longAt: theFP + FoxMethod
put: (objectMemory remapObj: (self frameMethod: theFP)).
theIPPtr ~= 0 ifTrue:
[stackPages longAt: theIPPtr put: theIP + (self frameMethod: theFP)]].
(callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
[theSP := (theIPPtr := theFP + FoxCallerSavedIP) + objectMemory wordSize.
theFP := callerFP].
theSP := theFP + FoxCallerContext. "a.k.a. FoxCallerSavedIP"
[theSP <= thePage baseAddress] whileTrue:
[oop := stackPages longAt: theSP.
(objectMemory shouldRemapOop: oop) ifTrue:
[stackPages longAt: theSP put: (objectMemory remapObj: oop)].
theSP := theSP + objectMemory wordSize]]].
stackPages recordLivePagesOnMapping: numLivePages!
Item was changed:
----- Method: StackInterpreter>>mapVMRegisters (in category 'object memory support') -----
mapVMRegisters
"Map the oops in the interpreter's vm ``registers'' to their new values
during garbage collection or a become: operation."
"Assume: All traced variables contain valid oops.
N.B. Don't trace messageSelector and lkupClass; these are ephemeral, live
only during message lookup and because createActualMessageTo will not
cause a GC these cannot change during message lookup."
+ <declareTypeForStaticPolymorphism: #SpurStopTheWorldGarbageCollector>
- <staticallyResolveReceiver: 'objectMemory' to: #SpurIncrementalSweepAndCompact>
(objectMemory shouldRemapObj: method) ifTrue:
[instructionPointer := instructionPointer - method. "*rel to method"
method := objectMemory remapObj: method.
instructionPointer := instructionPointer + method]. "*rel to method"
(objectMemory shouldRemapOop: newMethod) ifTrue: "maybe oop due to object-as-method"
[newMethod := objectMemory remapObj: newMethod]!
Item was changed:
----- Method: StackInterpreter>>markAndTraceInterpreterOops: (in category 'object memory support') -----
markAndTraceInterpreterOops: fullGCFlag
"Mark and trace all oops in the interpreter's state."
"Assume: All traced variables contain valid oops.
N.B. Don't trace messageSelector and lkupClass; these are ephemeral, live
only during message lookup and because createActualMessageTo will not
cause a GC these cannot change during message lookup."
+ <declareTypeForStaticPolymorphism: #SpurStopTheWorldGarbageCollector>
| oop |
"Must mark stack pages first to initialize the per-page trace
flags for full garbage collect before any subsequent tracing."
self markAndTraceStackPages: fullGCFlag.
self markAndTraceTraceLog.
self markAndTracePrimTraceLog.
objectMemory markAndTrace: objectMemory specialObjectsOop. "also covers nilObj, trueObj, falseObj, and compact classes"
(objectMemory isImmediate: newMethod) ifFalse:
[objectMemory markAndTrace: newMethod].
self traceProfileState.
tempOop = 0 ifFalse: [objectMemory markAndTrace: tempOop].
tempOop2 = 0 ifFalse: [objectMemory markAndTrace: tempOop2].
"V3 memory manager support"
1 to: objectMemory remapBufferCount do:
[:i |
oop := objectMemory remapBuffer at: i.
(objectMemory isImmediate: oop) ifFalse: [objectMemory markAndTrace: oop]]!
Item was changed:
----- Method: StackInterpreter>>markAndTraceStackPage: (in category 'object memory support') -----
markAndTraceStackPage: thePage
| theSP theFP frameRcvrOffset callerFP oop marker |
<var: #thePage type: #'StackPage *'>
<var: #theSP type: #'char *'>
<var: #theFP type: #'char *'>
<var: #frameRcvrOffset type: #'char *'>
<var: #callerFP type: #'char *'>
+ "<staticallyResolveReceiver: 'marker' to: #SpurAllAtOnceMarker>"
+ <declareTypeForStaticPolymorphism: #SpurStopTheWorldGarbageCollector>
- <staticallyResolveReceiver: 'marker' to: #SpurIncrementalMarker>
<inline: false>
"do not remove. Necessary for resolving polymorphic receiver"
marker := objectMemory marker.
self assert: (stackPages isFree: thePage) not.
self assert: (self ifCurrentStackPageHasValidHeadPointers: thePage).
self assert: thePage trace ~= StackPageTraced.
thePage trace: StackPageTraced.
theSP := thePage headSP.
theFP := thePage headFP.
"Skip the instruction pointer on top of stack of inactive pages."
thePage = stackPage ifFalse:
[theSP := theSP + objectMemory wordSize].
[frameRcvrOffset := self frameReceiverLocation: theFP.
[theSP <= frameRcvrOffset] whileTrue:
[oop := stackPages longAt: theSP.
(objectMemory isOopForwarded: oop) ifTrue:
[oop := objectMemory followForwarded: oop.
stackPages longAt: theSP put: oop].
(objectMemory isImmediate: oop) ifFalse:
[marker markAndTrace: oop].
theSP := theSP + objectMemory wordSize].
(self frameHasContext: theFP) ifTrue:
[self assert: (objectMemory isContext: (self frameContext: theFP)).
marker markAndTrace: (self frameContext: theFP)].
marker markAndTrace: (self iframeMethod: theFP).
(callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
[theSP := theFP + FoxCallerSavedIP + objectMemory wordSize.
theFP := callerFP].
theSP := theFP + FoxCallerSavedIP. "caller ip is frameCallerContext in a base frame"
[theSP <= thePage baseAddress] whileTrue:
[oop := stackPages longAt: theSP.
(objectMemory isOopForwarded: oop) ifTrue:
[oop := objectMemory followForwarded: oop.
stackPages longAt: theSP put: oop].
(objectMemory isImmediate: oop) ifFalse:
[marker markAndTrace: oop].
theSP := theSP + objectMemory wordSize]!
Item was changed:
----- Method: StackInterpreter>>traceProfileState (in category 'object memory support') -----
traceProfileState
+ <declareTypeForStaticPolymorphism: #SpurStopTheWorldGarbageCollector>
+
objectMemory hasSpurMemoryManagerAPI ifTrue:
[self followForwardingPointersInProfileState].
objectMemory markAndTrace: profileProcess.
objectMemory markAndTrace: profileMethod.
objectMemory markAndTrace: profileSemaphore.
self cppIf: #LRPCheck
ifTrue:
["The longRunningPrimitiveCheckMethod (LRPCM) is sampled in an interrupt. Be very careful with it.
If longRunningPrimitiveCheckSequenceNumber (LRPCSN) = statCheckForEvents then LRPCM has
been recenty sampled, but it must be newMethod and we don't need to trace it twice. If LRPCSN
~= statCheckForEvents then LRPCM must be some extant object and needs to be traced."
self sqLowLevelMFence.
(longRunningPrimitiveCheckMethod ~= nil
and: [longRunningPrimitiveCheckSequenceNumber ~= statCheckForEvents]) ifTrue:
[(objectMemory isForwarded: longRunningPrimitiveCheckMethod) ifTrue:
[longRunningPrimitiveCheckMethod := objectMemory followForwarded: longRunningPrimitiveCheckMethod].
objectMemory markAndTrace: longRunningPrimitiveCheckMethod].
longRunningPrimitiveCheckSemaphore ~= nil ifTrue:
[(objectMemory isForwarded: longRunningPrimitiveCheckSemaphore) ifTrue:
[longRunningPrimitiveCheckSemaphore := objectMemory followForwarded: longRunningPrimitiveCheckSemaphore].
objectMemory markAndTrace: longRunningPrimitiveCheckSemaphore]]!
Item was added:
+ ----- Method: StackInterpreterPrimitives>>primitiveFreeSpaceMap (in category 'system control primitives') -----
+ primitiveFreeSpaceMap
+ "creates a 64 bit array containing an entry for every entity in the heap. The first 8 say which type of object it is and the other 56 which size it has"
+
+ | result |
+ result := objectMemory freeSpaceMap.
+ (objectMemory isIntegerObject: result) ifTrue:
+ [objectMemory growToAccomodateContainerWithNumSlots: (objectMemory integerValueOf: result).
+ result := objectMemory freeSpaceMap.
+ (objectMemory isIntegerObject: result) ifTrue:
+ [^self primitiveFailFor: PrimErrNoMemory]].
+ self methodReturnValue: result!
More information about the Vm-dev
mailing list