Vm-dev January 2023

vm-dev@lists.squeakfoundation.org

17 participants
74 discussions

VM Maker: VMMaker.oscog.seperateMarking-WoC.3289.mcz
by commits＠source.squeak.org 03 Jan '23

03 Jan '23

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!

1 0

VM Maker: VMMaker.oscog.seperateMarking-WoC.3288.mcz
by commits＠source.squeak.org 01 Jan '23

01 Jan '23

Tom Braun uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog.seperateMarking-WoC.3288.mcz ==================== Summary ==================== Name: VMMaker.oscog.seperateMarking-WoC.3288 Author: WoC Time: 1 January 2023, 11:47:15.540709 pm UUID: a12bbefc-9aa1-478b-9947-761365a4bf8b Ancestors: VMMaker.oscog.seperateMarking-WoC.3287 add missing pragma for translation (mysteriously got not pushed with the last commit and had to be restored after image died :() ) =============== Diff against VMMaker.oscog.seperateMarking-WoC.3287 =============== Item was changed: ----- Method: CoInterpreter>>markAndTraceStackPage: (in category 'object memory support') ----- markAndTraceStackPage: thePage + | theSP theFP frameRcvrOffset callerFP oop marker | - | theSP theFP frameRcvrOffset callerFP oop | <var: #thePage type: #'StackPage *'> <var: #theSP type: #'char *'> <var: #theFP type: #'char *'> <var: #frameRcvrOffset type: #'char *'> <var: #callerFP type: #'char *'> <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]. - [objectMemory markAndTrace: oop]. theSP := theSP + objectMemory wordSize]. (self frameHasContext: theFP) ifTrue: [self assert: (objectMemory isContext: (self frameContext: theFP)). + marker markAndTrace: (self frameContext: theFP)]. - objectMemory markAndTrace: (self frameContext: theFP)]. (self isMachineCodeFrame: theFP) ifTrue: [self markAndTraceMachineCodeMethod: (self mframeCogMethod: theFP)] + ifFalse: [marker markAndTrace: (self iframeMethod: theFP)]. - ifFalse: [objectMemory 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]. - [objectMemory markAndTrace: oop]. theSP := theSP + objectMemory wordSize]! Item was changed: ----- Method: StackInterpreter>>markAndTraceStackPage: (in category 'object memory support') ----- markAndTraceStackPage: thePage + | theSP theFP frameRcvrOffset callerFP oop marker | - | theSP theFP frameRcvrOffset callerFP oop | <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 markAndTrace: oop]. - [objectMemory 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). - objectMemory markAndTrace: (self frameContext: theFP)]. - objectMemory 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]. - [objectMemory markAndTrace: oop]. theSP := theSP + objectMemory wordSize]!

1 0

VM Maker: VMMaker.oscog.seperateMarking-WoC.3287.mcz
by commits＠source.squeak.org 01 Jan '23

01 Jan '23

Tom Braun uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog.seperateMarking-WoC.3287.mcz ==================== Summary ==================== Name: VMMaker.oscog.seperateMarking-WoC.3287 Author: WoC Time: 1 January 2023, 8:57:40.199509 pm UUID: 22f43b30-f5ec-4dd7-8b40-18f5d271f3e5 Ancestors: VMMaker.oscog.seperateMarking-eem.3286 A somewhat stable version of the incremental GC. Some intricate changes to code generation (more static polymorphism) Changes to code generation: - extended static polymorphism to support multiple versions of the same method in one class and some support structure around it to choose the right version to be generated - method to:generate: to generate a renamed version of a polymorphic method (neccessary because some handwritten C code expects the method fullGC to exits, that normally does not get generated anymore) - added some pragmas to existing methods to determine which version is to be generated - pushed some methods to subclasses in order to get them generated correctly GC bug fixes: - don't delete references of weak objects to old space objects during scavenging, as it is difficult to know if is ok to delete the object is ok (see SpurIncrementalGarbageCollector>>isOkToClearReference: for a better explanation) - handle when segmentToFill is full and we would put more into than there is space to accommodate - fix off by one error during compaction (don;t skip the last segment when compacting it) - when having finished marking weakling make sure the marking stack is really empty - do not apply write barrier during nilling weakling, as this can result in having elements on the marking stack although we just finished and expect (demand!) it to be empty - enable TempVectReadBarrier (please use generateSqueakSpurIncrementalStack64VM to generate a valid VM with incremental GC) - primitve for visualizing the heap - make sure EphemeronStack is set to nil if it does not exist otherwise =============== Diff against VMMaker.oscog.seperateMarking-eem.3286 =============== Item was changed: Object subclass: #CCodeGenerator + instanceVariableNames: 'vmClass structClasses translationDict asArgumentTranslationDict inlineList constants variables variableDeclarations scopeStack methods macros apiMethods apiVariables kernelReturnTypes currentMethod headerFiles globalVariableUsage useSymbolicConstants generateDeadCode requiredSelectors previousCommentMarksInlining previousCommenter logger suppressAsmLabels asmLabelCounts pools selectorTranslations staticallyResolvedPolymorphicReceivers recursivelyResolvedPolymorphicReceivers optionsDictionary breakSrcInlineSelectors breakDestInlineSelectors breakOnInline vmMaker accessorDepthCache beganInlining mappingForRecursivePolymophism removedForPolymorphism recursivePolymorphicMethodsMap toGenerate' - instanceVariableNames: 'vmClass structClasses translationDict asArgumentTranslationDict inlineList constants variables variableDeclarations scopeStack methods macros apiMethods apiVariables kernelReturnTypes currentMethod headerFiles globalVariableUsage useSymbolicConstants generateDeadCode requiredSelectors previousCommentMarksInlining previousCommenter logger suppressAsmLabels asmLabelCounts pools selectorTranslations staticallyResolvedPolymorphicReceivers optionsDictionary breakSrcInlineSelectors breakDestInlineSelectors breakOnInline vmMaker accessorDepthCache beganInlining' classVariableNames: 'NoRegParmsInAssertVMs' poolDictionaries: 'VMBasicConstants' category: 'VMMaker-Translation to C'! !CCodeGenerator commentStamp: 'tpr 5/2/2003 14:30' prior: 0! This class oversees the translation of a subset of Smalltalk to C, allowing the comforts of Smalltalk during development and the efficiency and portability of C for the resulting interpreter. See VMMaker for more useful info! Item was added: + ----- Method: CCodeGenerator>>READMEForExplanationOnStaticPolymorphism (in category 'helpers polymorphic resolving') ----- + READMEForExplanationOnStaticPolymorphism + + "static polymophism enables to have multiple classes with the same methods that get resolved at code generation time + (slang -> C). There are two mechanisms depending on your needs: + + (1) static polymorphism for having multiple classes implementing the same methods and selecting which to generate in which case + (2) static polymorphism to have one class generate multiple variants of the same method + + Why to use: + + (1) You want to keep an object oriented programming scheme in slang. This limits you to uniquely named methods. Should two classes use the methods with the same names and you want to be able to use both variants this enables you to do so. + + (2) Imagine you use (1) and have classes A and B both using static polymorphism. Imagine you have a class C that uses A and/or B and gets used by A and/or B. Lets say C calls a method on A and A calls a method on C. This method on C calls a method implemented by A and B, but because B is the default the method from B will get called here, possibly resulting in invalid behaviour. (2) helps with propagating this info and causes the correct method from A to be called. + + How do you use it: + + (1) In all classes implementing the same methods you want to be able to resolve statically you call in declareCVarsIn: the method CCodeGenerator>>staticallyResolveMethodNamed:forClass:to:. This will remove the method named as the first parameter and rename it to the third parameter. It is important to call this in all classes with this methods so the method names get resolved everywhere. The standard is to generate the third parameter by using (self staticallyResolvePolymorphicSelector: key). For an example see SpurGarbageCollector>>declareCVarsIn:. + + In all classes where you want to use your polymorphic methods you now can call CCodeGenerator>>staticallyResolvedPolymorphicReceiver:to:in: in #declareCVarsIn: to resolve every occurence of the receiver in the first parameter to the class given in the second parameter only in the class given in the third parameter. This means you can define how to resolve receivers for other classes, a feature you should use very carefully as this can be confusing to understand. + + If you want to resolve self to your own class you have to implement #hasPolymorphicSelectors on the class side. If it returns true, all sends with self as the receiver will get resolved to the current class. It is recommended to overwrite staticallyResolvePolymorphicSelector: in this case too, as possibly not all methods get statically resolved and therefore renamed. Internally staticallyResolvePolymorphicSelector: is used to get method name to be used when it is determined a receiver want polymorphic resolving. In this case every call to self would cause resolving the method name, even when it should not be resolved. By overwriting staticallyResolvePolymorphicSelector: to only resolve methods that are present in all classes that should be polymorphic you can avoid this. For an example see SpurGarbageCollector>>staticallyResolvePolymorphicSelector: + + (2) To use call CCodeGenerator>>recursivelyResolvePolymorpicReceiver:toVariants:in:default:. This will result in all methods and the transitive closure of methods using the receiver given as the first parameter to get resolved to a variant for every class given in the collection that is the second parameter. This is done in the class that is the third parameter (you should probably only call this for self) and if no type info is present the method will get resolved to the class given as the fourth parameter (the fourth parameter has to be a class that is part of the collection that is the second parameter). + + Lets call the methods in the transitive closure described above recursive polymorphic methods (rpm). If nothing is known about a rpm it gets resolved to the given default. If the rpm is a part of another rpm that has a defined type it is resolved to the same type. + + You can resolve classes to a specific class part of the recursive polymophism by using CCodeGenerator>>forRecursivePolymorphismResolve:as:. If a method is known to belong to a class that is the first parameter it will get resolved as if it part of the second parameter. This is useful when you know the methods of a class should always be resolved to one specific part (e.g. because it is a helper class for a specific part of an algorithm) + + With the pragma #staticallyResolveMethod:to: you can overwrite how a specific method should be resolved. Helpful when a method should be resolved to a type independent given type information, because some invariants rely one variant of the polymorphic method is always called (takes precedence over all other rules described here!!) + + With the pragma #staticallyResolveReceiver:to: you can define how a receiver should be resolved on a method base. Helpful if you do not want to define how to resolve a receiver for a complete class (CCodeGenerator>>staticallyResolvedPolymorphicReceiver:to:in:) or the algorithm is not able to determine the type of a receiver (e.g because it is hidden behind a call. 'objectMemory gc' would reference the gc defined by objectMemory, but because it is only checked against objectMemory and not gc (because that would require to resolve that too somehow) the algorithm normally would not know how to to reolve it. With the pragma you can define how to resolve 'objectMemory gc' + + Should the algorithm find a call to a method that is polymorphicly defined through (1), but have no type information for it it will cause a halt during resolving. You should then take a look at the comment directly above the halt and hopefully be able to resolve the problem (of you not having defined the type for a call enough (and hopefully not me having made an error))"! Item was added: + ----- Method: CCodeGenerator>>addPolymorphicVariantsFor:referencing:with:default: (in category 'helpers polymorphic resolving') ----- + addPolymorphicVariantsFor: aTMethod referencing: variableName with: classArray default: defaultClass + + | tMethod | + tMethod := methods at: aTMethod selector. + methods at: aTMethod selector put: (aTMethod asPolymorphicBaseFor: classArray toResolve: variableName default: defaultClass). + classArray + do: [:class | | copy polymorphicMethod | + "make a copy to make sure we get no side effects on the copies" + copy := tMethod veryDeepCopy. + polymorphicMethod := copy asPolymorphicFor: variableName resolveTo: class. + + (methods at: aTMethod selector ifAbsent: []) ifNotNil: + [:conflict | + ((aTMethod definingClass inheritsFrom: conflict definingClass) + or: [aTMethod definingClass = conflict definingClass]) ifFalse: + [self error: 'Method name conflict: ', aTMethod selector]]. + methods at: polymorphicMethod selector put: polymorphicMethod]! Item was added: + ----- Method: CCodeGenerator>>forRecursivePolymorphismResolve:as: (in category 'public') ----- + forRecursivePolymorphismResolve: aClass as: anotherClass + + (mappingForRecursivePolymophism ifNil: [mappingForRecursivePolymophism := Dictionary new]) + at: aClass + put: anotherClass! Item was added: + ----- Method: CCodeGenerator>>generate:from: (in category 'nil') ----- + generate: anUnknownSelector from: aKnownSelector + + (toGenerate ifNil: [toGenerate := OrderedCollection new]) + add: aKnownSelector -> anUnknownSelector! Item was added: + ----- Method: CCodeGenerator>>getClassFor:in: (in category 'helpers polymorphic resolving') ----- + getClassFor: receiverSymbol in: aClass + + ^ (receiverSymbol = 'self' and: [aClass hasPolymorphicSelectors]) + ifTrue: [aClass] + ifFalse: [staticallyResolvedPolymorphicReceivers + at: aClass + ifPresent: [:dictionary | dictionary at: receiverSymbol ifAbsent: [nil]] + ifAbsent: [nil]]! Item was added: + ----- Method: CCodeGenerator>>getClassFromPragmasIn:ifMatching: (in category 'helpers polymorphic resolving') ----- + getClassFromPragmasIn: aTMethod ifMatching: receiverSymbol + + ^ (aTMethod pragmasAt: #staticallyResolveReceiver:to:) + ifNotNil: [:pragmas | + pragmas + detect: [:pragma | receiverSymbol = (pragma argumentAt: 1)] + ifFound: [:pragma | Smalltalk at: (pragma argumentAt: 2)] + ifNone: []]! Item was added: + ----- Method: CCodeGenerator>>hasPolymorphicMethod:in: (in category 'helpers polymorphic resolving') ----- + hasPolymorphicMethod: aSelector in: aClass + + ^ aClass withAllSuperclasses + anySatisfy: [:class | (recursivePolymorphicMethodsMap at: class ifAbsent: [{}]) includes: aSelector]! Item was removed: - ----- Method: CCodeGenerator>>ifStaticallyResolvedPolymorphicReceiverThenUpdateSelectorIn: (in category 'public') ----- - ifStaticallyResolvedPolymorphicReceiverThenUpdateSelectorIn: aSendNode - "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 | - staticallyResolvedPolymorphicReceivers ifNil: [^self]. - aSendNode receiver isVariable ifFalse: - [^self]. - class := staticallyResolvedPolymorphicReceivers - at: aSendNode receiver name - ifAbsent: [^self]. - aSendNode selector: (class staticallyResolvePolymorphicSelector: aSendNode selector)! Item was added: + ----- 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]. + "(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 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: [ + aSendNode + setSelectorForPolymorphism: (class staticallyResolvePolymorphicSelector: aSendNode selector)] + + ! Item was removed: - ----- Method: CCodeGenerator>>ifStaticallyResolvedPolymorphicReceiverThenUpdateSelectorIn:fromMethodIn: (in category 'public') ----- - ifStaticallyResolvedPolymorphicReceiverThenUpdateSelectorIn: aSendNode fromMethodIn: 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 | - staticallyResolvedPolymorphicReceivers ifNil: [^self]. - aSendNode receiver isVariable ifFalse: - [^self]. - - class := (aSendNode receiver name = 'self' and: [aClass hasPolymorphicSelectors]) - ifTrue: [aClass] - ifFalse: [staticallyResolvedPolymorphicReceivers - at: aSendNode receiver name - ifAbsent: [^self]]. - - aSendNode selector: (class staticallyResolvePolymorphicSelector: aSendNode selector)! Item was changed: ----- Method: CCodeGenerator>>isConstantNode:valueInto: (in category 'utilities') ----- isConstantNode: aNode valueInto: aBlock "Answer if aNode evaluates to a constant, and if so, evaluate aBlock with the value of that constant." aNode isConstant ifTrue: [(aNode isDefine and: [self defineAtCompileTime: aNode name]) ifTrue: [^false]. aBlock value: aNode value. ^true]. (aNode isVariable and: [aNode name = #nil]) ifTrue: [aBlock value: nil. ^true]. aNode isSend ifTrue: + [(self anyMethodNamed: aNode unmodifiedSelector) - [(self anyMethodNamed: aNode selector) ifNil: [(VMBasicConstants valueOfBasicSelector: aNode selector) ifNotNil: [:value| aBlock value: value. ^true]. aNode constantNumbericValueOrNil ifNotNil: [:value| aBlock value: value. ^true]] ifNotNil: [:m| (m isMacroWithDefinition not and: [m statements size = 1 and: [m statements last isReturn]]) ifTrue: [^self isConstantNode: m statements last expression valueInto: aBlock]]]. ^false! Item was added: + ----- Method: CCodeGenerator>>isReceiverProbablyPolymorpicSendReturningConstant: (in category 'helpers polymorphic resolving') ----- + isReceiverProbablyPolymorpicSendReturningConstant: aSendNode + + ^ aSendNode receiver isSend + and: [aSendNode receiver oldSelector notNil + and: [methods + at: aSendNode receiver selector + ifPresent: [:method | method isReturnConstant] + ifAbsent: [false]]]! 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 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]! - m prepareMethodIn: self]! Item was added: + ----- Method: CCodeGenerator>>recursivelyResolvePolymorpicReceiver:toVariants:in:default: (in category 'public') ----- + recursivelyResolvePolymorpicReceiver: variableName toVariants: classArray in: aClass default: defaultClass + "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." + | methodsInClass methodsReferencingReceiver missingSelectors notGeneratedMethods oldMissingSelectorsSize | + ((recursivelyResolvedPolymorphicReceivers ifNil: [recursivelyResolvedPolymorphicReceivers := Dictionary new]) + at: aClass + ifAbsentPut: [Dictionary new]) + at: variableName + put: classArray. + + "not generated methods can forward to the polymophic target. Scan them for use, so we can methods that use them include into the transitice closure of referencing methods" + notGeneratedMethods := Dictionary newFrom: (((Pragma allNamed: #doNotGenerate in: aClass) + collect: [:ea | | selector | + selector := ea method selector. + "some methods cannot be converted. Ignore them and print them for the developer to do something about it" + [selector -> (ea method asTranslationMethodOfClass: TMethod)] + on: Error + do: [Transcript showln: selector , ' of notGenerated methods could not be translated to a TMethod. Should it be relevant for polymorphism please fix it'. + selector]]) + select: [:ea | ea isSymbol not]). + + + + methodsInClass := methods select: [:each | each definingClass = aClass]. + methodsReferencingReceiver := methodsInClass select: [:method | (method allReferencedVariablesUsing: self) includes: variableName]. + + missingSelectors := self transitiveClosureOfMethods: methodsReferencingReceiver , notGeneratedMethods in: aClass. + oldMissingSelectorsSize := missingSelectors size. + + "do not start to generate not generated methods now. We just wanted to get their transistive closure" + missingSelectors := missingSelectors copyWithoutAll: notGeneratedMethods keys. + self assert: missingSelectors size = (oldMissingSelectorsSize - notGeneratedMethods size). + + missingSelectors do: [:selector | methods + at: selector + ifPresent: [:method | + (recursivePolymorphicMethodsMap ifNil: [recursivePolymorphicMethodsMap := Dictionary new]) + at: aClass + ifPresent: [:set | set add: method selector] + ifAbsentPut: [Set with: method selector]. + self + addPolymorphicVariantsFor: method + referencing: variableName + with: classArray + default: defaultClass] + ifAbsent: []].! Item was added: + ----- Method: CCodeGenerator>>resolve:inSelfSend:in:to:ifFound: (in category 'helpers polymorphic resolving') ----- + resolve: receiverSymbol inSelfSend: aSendNode in: aClass to: receiverClass ifFound: aReturnBlock + + (receiverSymbol = 'self' and: [self hasPolymorphicMethod: aSendNode selector in: aClass]) + ifTrue: [ + aSendNode + setSelectorForPolymorphism: ((methods at: aSendNode selector) polymorphicSelectorForClass: receiverClass). + aReturnBlock value]! Item was added: + ----- Method: CCodeGenerator>>resolve:to:ifFound: (in category 'helpers polymorphic resolving') ----- + resolve: aSendNode to: receiverClass ifFound: aReturnBlock + + | newSelector | + newSelector := methods + at: aSendNode selector + ifPresent: [:method | (method isPolymorphic or: [method isPolymorphicBase]) + ifTrue: [method polymorphicSelectorForClass: receiverClass] + ifFalse: [nil]] + ifAbsent: ["when a class uses normal static polymorphism it removes selectors in favour of the prefixed ones. + Lookup if this is the case here, if so resolve to the one specific to receiverClass" + removedForPolymorphism + at: aSendNode selector + ifPresent: [:mapping | mapping at: receiverClass ifAbsent: [nil]] + ifAbsent: [nil]]. + newSelector + ifNotNil: [aSendNode + setSelectorForPolymorphism: newSelector. + aReturnBlock value] ! Item was added: + ----- Method: CCodeGenerator>>resolvePolymorphicMethod:in:fromMethod:in:ifMatch: (in category 'helpers polymorphic resolving') ----- + resolvePolymorphicMethod: receiverSymbol in: aSendNode fromMethod: aTMethod in: aClass ifMatch: aReturnBlock + + self resolve: receiverSymbol inSelfSend: aSendNode in: aClass to: aTMethod receiverClass ifFound: aReturnBlock. + + receiverSymbol = aTMethod receiverToResolve + ifTrue: [self resolve: aSendNode to: aTMethod receiverClass 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 receiverClass + 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 receiverClass]) keys + detect: [:key | dictionary includesKey: key] + ifFound: [:class | + aSendNode + setSelectorForPolymorphism: (dictionary at: class). + aReturnBlock value]]. + + (self hasPolymorphicMethod: aSendNode selector in: aTMethod receiverClass) + ifTrue: [self halt]! Item was added: + ----- Method: CCodeGenerator>>resolvePolymorphicMethod:in:to:on:in:ifMatch: (in category 'helpers polymorphic resolving') ----- + resolvePolymorphicMethod: receiverSymbol in: aSendNode to: receiverClass on: receiverToResolve in: aClass ifMatch: aReturnBlock + + self resolve: receiverSymbol inSelfSend: aSendNode in: aClass to: receiverClass ifFound: aReturnBlock. + + receiverSymbol = receiverToResolve + ifTrue: [self resolve: aSendNode to: receiverClass 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: receiverClass + 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 = receiverClass]) keys + detect: [:key | dictionary includesKey: key] + ifFound: [:class | + aSendNode + setSelectorForPolymorphism: (dictionary at: class). + aReturnBlock value]]. + + (self hasPolymorphicMethod: aSendNode selector in: receiverClass) + ifTrue: [self halt]! Item was added: + ----- 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 ]. + + self resolve: receiverSymbol inSelfSend: aSendNode in: aClass to: calledMethod default ifFound: aReturnBlock. + + 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]]] + ifAbsent: [] . + + ! Item was changed: ----- Method: CCodeGenerator>>staticallyResolveMethodNamed:forClass:to: (in category 'public') ----- staticallyResolveMethodNamed: selector forClass: aClass to: staticallyResolvedSelector "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." | method | method := methods removeKey: selector ifAbsent: + ["self halt. "self logger cr; nextPutAll: 'warning: did not find ', selector, ' to be able to map to ', staticallyResolvedSelector. - [self logger cr; nextPutAll: 'warning: did not find ', selector, ' to be able to map to ', staticallyResolvedSelector. ^self]. method selector: staticallyResolvedSelector. + methods at: staticallyResolvedSelector put: method. + + (removedForPolymorphism ifNil: [removedForPolymorphism := Dictionary new]) + at: selector + ifPresent: [:set | set at: aClass put: staticallyResolvedSelector ] + ifAbsentPut: [Dictionary with: aClass -> staticallyResolvedSelector] + ! - methods at: staticallyResolvedSelector put: method! Item was removed: - ----- Method: CCodeGenerator>>staticallyResolvedPolymorphicReceiver:to: (in category 'public') ----- - staticallyResolvedPolymorphicReceiver: variableName to: 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." - (staticallyResolvedPolymorphicReceivers ifNil: [staticallyResolvedPolymorphicReceivers := Dictionary new]) - at: variableName - put: aClass! Item was added: + ----- Method: CCodeGenerator>>staticallyResolvedPolymorphicReceiver:to:in: (in category 'public') ----- + staticallyResolvedPolymorphicReceiver: variableName to: aClass in: theClassWithTheVariable + "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." + ((staticallyResolvedPolymorphicReceivers ifNil: [staticallyResolvedPolymorphicReceivers := Dictionary new]) + at: theClassWithTheVariable + ifAbsentPut: [Dictionary new]) + at: variableName + put: aClass! Item was added: + ----- Method: CCodeGenerator>>transitiveClosureOfMethods:in: (in category 'helpers polymorphic resolving') ----- + transitiveClosureOfMethods: aTMethodDictionary in: aClass + + | alreadySeenSelectors toVisit toVisitNext | + alreadySeenSelectors := Set newFrom: aTMethodDictionary keys. + toVisit := OrderedCollection newFrom: aTMethodDictionary keys. + toVisitNext := OrderedCollection new. + + [toVisit + do: [:each | (SystemNavigation default allCallsOn: each fromBehaviors: (aClass withAllSuperclasses copyUpTo: VMClass )sorted: false) + do: [:method | |selector | + selector := method selector. + (alreadySeenSelectors includes: selector) + ifFalse: [alreadySeenSelectors add: selector. + toVisitNext add: selector] ]]. + toVisit := toVisitNext. + toVisitNext := OrderedCollection new. + + toVisit notEmpty] whileTrue. + + ^ alreadySeenSelectors! 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." + <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: 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 *'> + <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: InterpreterPrimitives>>primitiveFullGC (in category 'memory space primitives') ----- primitiveFullGC "Do a full garbage collection. In SqueakV3ObjectMemory, answer the number of bytes available (including swap space if dynamic memory management is supported). In Spur, answer the size of the largest free chunk." + <staticallyResolveReceiver: 'objectMemory' to: #SpurIncrementalGarbageCollector> objectMemory hasSpurMemoryManagerAPI ifTrue: [self methodReturnInteger: objectMemory fullGC. ^self]. objectMemory incrementalGC. "maximimize space for forwarding table" objectMemory fullGC. self methodReturnInteger: (objectMemory bytesLeft: true)! Item was changed: ----- Method: InterpreterPrimitives>>primitiveObjectsAccessibleFromRoots (in category 'image segment in/out') ----- primitiveObjectsAccessibleFromRoots "This primitive is called from Squeak as... arrayOfRoots uniquelyAccessibleObjects" "This primitive answers an array of the receiver and every object in its proper tree of subParts (ie, that is not refered to from anywhere else outside the tree)." "This primitive could be used to implement the primitiveStoreImageSegment segment, thanks to a suggestion from Igor Stassenko. Currently it is used only to debug that primitive." + <staticallyResolveReceiver: 'objectMemory' to: #SpurIncrementalGarbageCollector> - | arrayOfRoots result | arrayOfRoots := self stackTop. "Essential type checks" (objectMemory isArray: arrayOfRoots) "Must be indexable pointers" ifFalse: [^self primitiveFail]. result := objectMemory objectsAccessibleFromRoots: arrayOfRoots. (objectMemory hasSpurMemoryManagerAPI and: [(objectMemory isIntegerObject: result) and: [(objectMemory integerValueOf: result) = PrimErrNoMemory]]) ifTrue: [objectMemory fullGC. arrayOfRoots := self stackTop. result := objectMemory objectsAccessibleFromRoots: arrayOfRoots]. (objectMemory isIntegerObject: result) ifTrue: [self primitiveFailFor: (objectMemory integerValueOf: result)] ifFalse: [self methodReturnValue: result]! Item was changed: ----- Method: InterpreterPrimitives>>primitiveStoreImageSegment (in category 'image segment in/out') ----- primitiveStoreImageSegment "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 the Squeak image file) of the receiver and every object in its proper tree of subParts (ie, that is not refered to from anywhere else outside the tree). All pointers from within the tree to objects outside the tree 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." "The primitive expects the array and wordArray to be more than adequately long. In this case it returns normally, and truncates the two arrays to exactly the right size. To simplify truncation, both incoming arrays are required to be 256 bytes or more long (ie with 3-word headers). If either array is too small, the primitive will fail, but in no other case. During operation of the primitive, it is necessary to convert from both internal and external oops to their mapped values. To make this fast, the headers of the original objects in question are replaced by the mapped values (and this is noted by adding the forbidden XX header type). Tables are kept of both kinds of oops, as well as of the original headers for restoration. To be specific, there are two similar two-part tables, the outpointer array, and one in the upper fifth of the segmentWordArray. Each grows oops from the bottom up, and preserved headers from halfway up. In case of either success or failure, the headers must be restored. In the event of primitive failure, the table of outpointers must also be nilled out (since the garbage in the high half will not have been discarded." + <staticallyResolveReceiver: 'objectMemory' to: #SpurStopTheWorldGarbageCollector> - | outPointerArray segmentWordArray arrayOfRoots ecode | outPointerArray := self stackTop. segmentWordArray := self stackValue: 1. arrayOfRoots := self stackValue: 2. "Essential type checks" ((objectMemory isArray: arrayOfRoots) "Must be indexable pointers" and: [(objectMemory isArray: outPointerArray) "Must be indexable pointers" and: [objectMemory isWords: segmentWordArray]]) "Must be indexable words" ifFalse: [^self primitiveFail]. ecode := objectMemory storeImageSegmentInto: segmentWordArray outPointers: outPointerArray roots: arrayOfRoots. (objectMemory hasSpurMemoryManagerAPI and: [ecode = PrimErrNeedCompaction]) ifTrue: [objectMemory fullGC. outPointerArray := self stackTop. segmentWordArray := self stackValue: 1. arrayOfRoots := self stackValue: 2. ecode := objectMemory storeImageSegmentInto: segmentWordArray outPointers: outPointerArray roots: arrayOfRoots]. ecode = PrimNoErr ifTrue: [self pop: 3] "...leaving the receiver on the stack as return value" ifFalse: [self primitiveFailFor: ecode]! Item was added: + TMethod subclass: #PolymorphicBaseTMethod + instanceVariableNames: 'classes default receiverToResolve' + classVariableNames: '' + poolDictionaries: '' + category: 'VMMaker-Translation to C'! Item was added: + ----- Method: PolymorphicBaseTMethod>>classes (in category 'accessing') ----- + classes + + ^ classes! Item was added: + ----- Method: PolymorphicBaseTMethod>>classes: (in category 'accessing') ----- + classes: anObject + + classes := anObject.! Item was added: + ----- Method: PolymorphicBaseTMethod>>default (in category 'accessing') ----- + default + + ^ default! Item was added: + ----- Method: PolymorphicBaseTMethod>>default: (in category 'accessing') ----- + default: anObject + + default := anObject.! Item was added: + ----- Method: PolymorphicBaseTMethod>>isPolymorphicBase (in category 'testing') ----- + isPolymorphicBase + + ^ true! Item was added: + ----- Method: PolymorphicBaseTMethod>>printOn: (in category 'as yet unclassified') ----- + printOn: aStream + + super printOn: aStream. + aStream + nextPut: $<; + nextPutAll: self default name; + nextPut: $>! Item was added: + ----- Method: PolymorphicBaseTMethod>>receiverToResolve (in category 'accessing') ----- + receiverToResolve + + ^ receiverToResolve! Item was added: + ----- Method: PolymorphicBaseTMethod>>receiverToResolve: (in category 'accessing') ----- + receiverToResolve: anObject + + receiverToResolve := anObject.! Item was added: + TMethod subclass: #PolymorphicTMethod + instanceVariableNames: 'receiverToResolve receiverClass' + classVariableNames: '' + poolDictionaries: '' + category: 'VMMaker-Translation to C'! Item was added: + ----- Method: PolymorphicTMethod>>isPolymorphic (in category 'testing') ----- + isPolymorphic + + ^ true! Item was added: + ----- Method: PolymorphicTMethod>>printOn: (in category 'as yet unclassified') ----- + printOn: aStream + + super printOn: aStream. + aStream + nextPut: $<; + nextPutAll: self receiverClass name; + nextPut: $>! Item was added: + ----- Method: PolymorphicTMethod>>receiverClass (in category 'accessing') ----- + receiverClass + + ^ receiverClass! Item was added: + ----- Method: PolymorphicTMethod>>receiverClass: (in category 'accessing') ----- + receiverClass: anObject + + receiverClass := anObject.! Item was added: + ----- Method: PolymorphicTMethod>>receiverToResolve (in category 'accessing') ----- + receiverToResolve + + ^ receiverToResolve! Item was added: + ----- Method: PolymorphicTMethod>>receiverToResolve: (in category 'accessing') ----- + receiverToResolve: anObject + + receiverToResolve := anObject.! Item was changed: ----- Method: Spur64BitMemoryManager>>setIsMarkedOf:to: (in category 'header access') ----- setIsMarkedOf: objOop to: aBoolean self assert: (self isFreeObject: objOop) not. + gc assertSettingGCFlagsIsOk: objOop. + - "gc assertSettingGCFlagsIsOk: objOop." self longAt: objOop put: (aBoolean ifTrue: [(self longAt: objOop) bitOr: 1 << self markedBitFullShift] ifFalse: [(self longAt: objOop) bitAnd: (1 << self markedBitFullShift) bitInvert64])! Item was changed: ----- Method: SpurGarbageCollector class>>declareCVarsIn: (in category 'as yet unclassified') ----- declareCVarsIn: aCCodeGenerator super declareCVarsIn: aCCodeGenerator. aCCodeGenerator + var: #allocatorShouldAllocateBlack type: #usqInt. + + "do not generate polymorphic methods for abstract baseclass SpurGarbageCollector" + self = SpurGarbageCollector ifTrue: [^ self]. + + aCCodeGenerator + staticallyResolvedPolymorphicReceiver: 'marker' to: self markerClass in: self; + staticallyResolvedPolymorphicReceiver: 'compactor' to: self compactorClass in: self. + + self selectorsInIncrementalAndStopTheWorldGC + do: [:key | + aCCodeGenerator + staticallyResolveMethodNamed: key + forClass: self + to: (self staticallyResolvePolymorphicSelector: key)].! - var: #allocatorShouldAllocateBlack type: #usqInt.! Item was added: + ----- Method: SpurGarbageCollector class>>hasPolymorphicSelectors (in category 'as yet unclassified') ----- + hasPolymorphicSelectors + "when using the incremental gc we have polymorphic selectors and have to resolve them" + + ^ self ~= SpurGarbageCollector and: [SpurMemoryManager wantsIncrementalGC]! Item was added: + ----- Method: SpurGarbageCollector class>>selectorsInIncrementalAndStopTheWorldGC (in category 'as yet unclassified') ----- + selectorsInIncrementalAndStopTheWorldGC + + ^ SpurIncrementalGarbageCollector selectors intersection: SpurStopTheWorldGarbageCollector selectors! Item was added: + ----- Method: SpurGarbageCollector class>>staticallyResolvePolymorphicSelector: (in category 'as yet unclassified') ----- + staticallyResolvePolymorphicSelector: aSelectorSymbol + + ^ (self selectorsInIncrementalAndStopTheWorldGC includes: aSelectorSymbol) + ifTrue: [super staticallyResolvePolymorphicSelector: aSelectorSymbol] + ifFalse: [aSelectorSymbol]! Item was changed: ----- Method: SpurGarbageCollector>>assertSettingGCFlagsIsOk: (in category 'as yet unclassified') ----- assertSettingGCFlagsIsOk: objOop + ^ self subclassResponsibility! - <doNotGenerate>! Item was changed: ----- Method: SpurGarbageCollector>>doScavenge: (in category 'scavenge') ----- doScavenge: tenuringCriterion - "The inner shell for scavenge, abstrascted out so globalGarbageCollect can use it." - <inline: false> - manager doAllocationAccountingForScavenge. - manager gcPhaseInProgress: ScavengeInProgress. - manager pastSpaceStart: (scavenger scavenge: tenuringCriterion). - self assert: (self - oop: manager pastSpaceStart - isGreaterThanOrEqualTo: scavenger pastSpace start - andLessThanOrEqualTo: scavenger pastSpace limit). - manager freeStart: scavenger eden start. - manager gcPhaseInProgress: 0. - manager resetAllocationAccountingAfterGC. + self subclassResponsibility! - self incrementalCollect! Item was changed: ----- Method: SpurGarbageCollector>>isIncremental (in category 'testing') ----- isIncremental + self subclassResponsibility! - ^ false! Item was added: + ----- Method: SpurGarbageCollector>>isOkToClearReference: (in category 'testing') ----- + isOkToClearReference: objOop + + self subclassResponsibility! Item was changed: ----- Method: SpurGarbageCollector>>isOkToScavengeRememberedObject: (in category 'testing') ----- isOkToScavengeRememberedObject: objOop + self subclassResponsibility! - ^ true! Item was changed: ----- Method: SpurGarbageCollector>>markObjects: (in category 'as yet unclassified') ----- markObjects: objectsShouldBeUnmarkedAndUnmarkedClassesShouldBeExpunged + self subclassResponsibility! - marker markersMarkObjects: objectsShouldBeUnmarkedAndUnmarkedClassesShouldBeExpunged! Item was changed: ----- Method: SpurGarbageCollector>>scavengingGCTenuringIf: (in category 'scavenge') ----- scavengingGCTenuringIf: tenuringCriterion + + "implementation, although the same, implemented in subclasses to generate static polymorphic methods from them" + self subclassResponsibility! - "Run the scavenger." - <inline: false> - self assert: manager remapBufferCount = 0. - (self asserta: scavenger eden limit - manager freeStart > coInterpreter interpreterAllocationReserveBytes) ifFalse: - [coInterpreter tab; - printNum: scavenger eden limit - manager freeStart; space; - printNum: coInterpreter interpreterAllocationReserveBytes; space; - printNum: coInterpreter interpreterAllocationReserveBytes - (scavenger eden limit - manager freeStart); cr]. - manager checkMemoryMap. - manager checkFreeSpace: GCModeNewSpace. - manager runLeakCheckerFor: GCModeNewSpace. - - coInterpreter - preGCAction: GCModeNewSpace; - "would prefer this to be in mapInterpreterOops, but - compatibility with ObjectMemory dictates it goes here." - flushMethodCacheFrom: manager newSpaceStart to: manager oldSpaceStart. - manager needGCFlag: false. - - manager gcStartUsecs: coInterpreter ioUTCMicrosecondsNow. - - self doScavenge: tenuringCriterion. - - manager statScavenges: manager statScavenges + 1. - manager statGCEndUsecs: coInterpreter ioUTCMicrosecondsNow. - manager statSGCDeltaUsecs: manager statGCEndUsecs - manager gcStartUsecs. - manager statScavengeGCUsecs: manager statScavengeGCUsecs + manager statSGCDeltaUsecs. - manager statRootTableCount: scavenger rememberedSetSize. - - scavenger logScavenge. - - coInterpreter postGCAction: GCModeNewSpace. - - manager runLeakCheckerFor: GCModeNewSpace. - manager checkFreeSpace: GCModeNewSpace! Item was added: + ----- Method: SpurGarbageCollector>>writeBarrierFor:at:with: (in category 'barrier') ----- + writeBarrierFor: anObject at: index with: value + + self subclassResponsibility! Item was changed: ----- Method: SpurGenerationScavenger class>>declareCVarsIn: (in category 'translation') ----- declareCVarsIn: aCCodeGenerator #(eden futureSpace pastSpace) do: [:var| aCCodeGenerator var: var type: #SpurNewSpaceSpace]. aCCodeGenerator var: #rememberedSet type: #'sqInt *'; var: #tenuringProportion type: #double; var: #scavengeLogRecord type: #SpurScavengeLogRecord; + var: #scavengeLog type: #'FILE *'. + + SpurMemoryManager wantsIncrementalGC + ifTrue: [aCCodeGenerator + recursivelyResolvePolymorpicReceiver: 'manager' toVariants: {SpurIncrementalGarbageCollector. SpurStopTheWorldGarbageCollector} in: self default: SpurIncrementalGarbageCollector]! - var: #scavengeLog type: #'FILE *'! Item was changed: ----- Method: SpurGenerationScavenger>>processWeakSurvivor: (in category 'weakness and ephemerality') ----- processWeakSurvivor: weakObj "Process a weak survivor on the weakList. Those of its fields which have not survived the scavenge should be nilled, and if any are, the coInterpreter should be informed via fireFinalization:. Answer if the weakObj has any young referents." | weakObjShouldMourn hasYoungReferents numStrongSlots | weakObjShouldMourn := hasYoungReferents := false. "N.B. generateToByDoLimitExpression:negative:on: guards against (unsigned)0 - 1 going +ve" numStrongSlots := manager numFixedSlotsOf: weakObj. 0 to: numStrongSlots - 1 do: [:i| | referent | referent := manager fetchPointer: i ofObject: weakObj. ((manager isNonImmediate: referent) and: [manager isYoungObject: referent]) ifTrue: [hasYoungReferents := true]]. numStrongSlots to: (manager numSlotsOf: weakObj) - 1 do: [:i| | referent | referent := manager fetchPointer: i ofObject: weakObj. "Referent could be forwarded due to scavenging or a become:, don't assume." (manager isNonImmediate: referent) ifTrue: [(manager isForwarded: referent) ifTrue: [referent := manager followForwarded: referent. "weakObj is either young or already in remembered table; no need to check" self assert: ((manager isReallyYoungObject: weakObj) or: [manager isRemembered: weakObj]). manager storePointerUnchecked: i ofObject: weakObj withValue: referent]. (self isMaybeOldScavengeSurvivor: referent) ifTrue: [(manager isYoungObject: referent) ifTrue: [hasYoungReferents := true]] ifFalse: + [(manager gc isOkToClearReference: referent) - [(self isOkToClearReference: referent) ifTrue: [ weakObjShouldMourn := true. manager storePointerUnchecked: i ofObject: weakObj withValue: manager nilObject]]]]. weakObjShouldMourn ifTrue: [coInterpreter fireFinalization: weakObj]. ^hasYoungReferents! Item was changed: ----- Method: SpurGenerationScavenger>>scavengeRememberedSetStartingAt: (in category 'scavenger') ----- scavengeRememberedSetStartingAt: n "scavengeRememberedSetStartingAt: n traverses objects in the remembered set starting at the nth one. If the object does not refer to any new objects, it is removed from the set. Otherwise, its new referents are scavenged. Defer scavenging ephemerons until after a complete scavenge has been performed, so that triggered ephemerons can be fired. Move them to the front of the set and count them in numRememberedEphemerons for later scanning." <inline: false> | destIndex sourceIndex referrer | sourceIndex := destIndex := n. [sourceIndex < rememberedSetSize] whileTrue: ["*Don't* follow forwarding pointers here. oldSpace objects may refer + to these roots, and so they can't be removed in the scavenge (old objects + could point to forwarding pointers that are in the young space and need + to be updated. As it would be costly to add such old objects to the remembered + set just update the forwarding pointers and keep them here in the remembered set)." - to these roots, and so they can't be removed in the scavenge." referrer := rememberedSet at: sourceIndex. "Any potential firing ephemerons should not be scanned yet. Move any to the front of the set to save time in later scanning." ((manager isEphemeron: referrer) and: [(self isScavengeSurvivor: ((manager keyOfEphemeron: referrer))) not]) ifTrue: [self assert: destIndex >= numRememberedEphemerons. rememberedSet at: destIndex put: (rememberedSet at: numRememberedEphemerons); at: numRememberedEphemerons put: referrer. numRememberedEphemerons := numRememberedEphemerons + 1. destIndex := destIndex + 1] ifFalse: [((manager gc isOkToScavengeRememberedObject: referrer) and: [self scavengeReferentsOf: referrer]) ifTrue: [rememberedSet at: destIndex put: referrer. destIndex := destIndex + 1] ifFalse: [manager setIsRememberedOf: referrer to: false]]. sourceIndex := sourceIndex + 1]. rememberedSetSize := destIndex. self assert: self noUnfiredEphemeronsAtEndOfRememberedSet! Item was changed: ----- Method: SpurHybridCompactor class>>declareCVarsIn: (in category 'translation') ----- declareCVarsIn: aCCodeGenerator aCCodeGenerator + staticallyResolvedPolymorphicReceiver: 'planningCompactor' to: SpurPlanningCompactor in: self; + staticallyResolvedPolymorphicReceiver: 'selectiveCompactor' to: SpurSweeper in: self"SpurSelectiveCompactor" "The selector mangling is easier this way"! - staticallyResolvedPolymorphicReceiver: 'planningCompactor' to: SpurPlanningCompactor; - staticallyResolvedPolymorphicReceiver: 'selectiveCompactor' to: SpurSweeper"SpurSelectiveCompactor" "The selector mangling is easier this way"! Item was added: + SpurGarbageCollector subclass: #SpurHybridGarbageCollector + instanceVariableNames: 'isInIncrementalMode incrementalGC stopTheWorldGC' + classVariableNames: '' + poolDictionaries: '' + category: 'VMMaker-SpurGarbageCollector'! Item was added: + ----- Method: SpurHybridGarbageCollector class>>classesForTranslation (in category 'translation') ----- + classesForTranslation + + ^ super classesForTranslation , {SpurMarker . SpurIncrementalMarker . SpurAllAtOnceMarker . SpurPlanningCompactor . SpurIncrementalSweeper . SpurIncrementalCompactor . SpurIncrementalSweepAndCompact }! Item was added: + ----- Method: SpurHybridGarbageCollector class>>declareCVarsIn: (in category 'translation') ----- + declareCVarsIn: aCCodeGenerator + + aCCodeGenerator + staticallyResolvedPolymorphicReceiver: 'incrementalGC' to: SpurIncrementalGarbageCollector in: self; + staticallyResolvedPolymorphicReceiver: 'stopTheWorldGC' to: SpurStopTheWorldGarbageCollector in: self! Item was added: + ----- Method: SpurHybridGarbageCollector>>initialize (in category 'as yet unclassified') ----- + initialize + + isInIncrementalMode := true. + incrementalGC := SpurIncrementalGarbageCollector new. + stopTheWorldGC := SpurStopTheWorldGarbageCollector new.! Item was added: + ----- Method: SpurHybridGarbageCollector>>writeBarrierFor:at:with: (in category 'as yet unclassified') ----- + writeBarrierFor: anObject at: index with: value + + self isInIncrementalMode + ifTrue: [incrementalGC writeBarrierFor: anObject at: index with: value] + ifFalse: ["does nothing"]! Item was changed: ----- Method: SpurIncrementalCompactor class>>declareCVarsIn: (in category 'as yet unclassified') ----- declareCVarsIn: aCCodeGenerator + aCCodeGenerator var: #segmentToFill type: #'SpurSegmentInfo *'. + + SpurMemoryManager wantsIncrementalGC + ifTrue: [| incrementalSelectors | + incrementalSelectors := SpurIncrementalCompactor selectors , SpurIncrementalSweeper selectors , SpurIncrementalSweepAndCompact selectors. + + (incrementalSelectors intersection: SpurPlanningCompactor selectors) + do: [:key | + aCCodeGenerator + staticallyResolveMethodNamed: key + forClass: self + to: (self staticallyResolvePolymorphicSelector: key)]]! - aCCodeGenerator var: #segmentToFill type: #'SpurSegmentInfo *'.! Item was changed: ----- Method: SpurIncrementalCompactor>>compactSegment:freeStart:segIndex: (in category 'incremental compaction') ----- compactSegment: segInfo freeStart: initialFreeStart segIndex: segIndex <var: 'segInfo' type: #'SpurSegmentInfo *'> | fillStart | fillStart := initialFreeStart. self deny: segIndex = 0. "Cannot compact seg 0" manager segmentManager allEntitiesInSegment: segInfo exceptTheLastBridgeDo: [:entity| (manager isFreeObject: entity) ifTrue: [manager detachFreeObject: entity. "To avoid confusing too much Spur (especially the leak/free checks), we mark the free chunk as a word object." manager set: entity classIndexTo: manager wordSizeClassIndexPun formatTo: manager wordIndexableFormat] ifFalse: ["During the mutator runs new forwarding references can be created. Ignore them as they get resolved with the other forwarders in this segment in the next marking pass" (manager isForwarded: entity) ifFalse: [| bytesToCopy | "Copy the object in segmentToFill and replace it by a forwarder." bytesToCopy := manager bytesInBody: entity. + + (self oop: fillStart + bytesToCopy isLessThan: (segmentToFill segLimit - manager bridgeSize)) + ifFalse: ["somebody allocated a new object we did not knew about at the moment of planning :( -> it does not fit anymore and we cannot free the whole segment. Make sure to unmark the segment as beeing compacted as it would be completetly freed otherwise!!" + coInterpreter cr; print: 'segments if full. Abort compacting of: '; printHex: segmentToFill segStart ; tab; flush. + self unmarkSegmentAsBeingCompacted: (manager segInfoAt: currentSegment). + currentSegment := currentSegment + 1. + ^ fillStart]. self migrate: entity sized: bytesToCopy to: fillStart. fillStart := fillStart + bytesToCopy. self assert: (self oop: fillStart isLessThan: (segmentToFill segLimit - manager bridgeSize))]]]. currentSegment := currentSegment + 1. ^ fillStart! Item was changed: ----- Method: SpurIncrementalCompactor>>doIncrementalCompact (in category 'incremental compaction') ----- doIncrementalCompact <inline: #never> | segInfo | currentSegment to: manager numSegments - 1 do: [:i | segInfo := manager segInfoAt: i. (self isSegmentBeingCompacted: segInfo) ifTrue: [currentSegment := i. coInterpreter cr; print: 'Compact from: '; printHex: segInfo segStart; print: ' to: '; printHex: segInfo segStart + segInfo segSize; print: ' into: ' ; printHex: segmentToFill segStart; tab; flush. currentHeapPointer := self compactSegment: segInfo freeStart: currentHeapPointer segIndex: i. self assert: manager totalFreeOldSpace = manager totalFreeListBytes. self assert: (self oop: currentHeapPointer isLessThan: (segmentToFill segLimit - manager bridgeSize)). "guarantee heap parsability for the segmentToFill, for example when invoking checkHeapFreeSpaceIntegrityForIncrementalGC where we walk to whole heap and could enter segmentToFill in an invalid state" self occupyRestOfFreeCompactedIntoSegment. coInterpreter cr; print: 'Pointer now: '; printHex: currentHeapPointer; tab; flush. self flag: #Todo. "for now we compact one segment at a time" + ^ currentSegment = manager numSegments "compact will increment currentSegment and therefore we cannot compare against numSegments to not skip the last segment" - ^ currentSegment = (manager numSegments - 1) ifTrue: [true] ifFalse: [false]]]. ^ true! Item was changed: ----- Method: SpurIncrementalCompactor>>markSegmentAsBeingCompacted: (in category 'segment access') ----- markSegmentAsBeingCompacted: segInfo <var: 'segInfo' type: #'SpurSegmentInfo *'> "Swizzle is abused bit 16 isBeingCompacted bits 0-15 occupation" + self assert: (manager numSegments > 1 and: [segInfo ~= (self addressOf: (manager segmentManager segments at: 0))]). - self assert: (manager numSegments > 1 and: [segInfo ~= (manager segInfoAt: 0)]). segInfo swizzle: (segInfo swizzle bitOr: 1 << 16)! Item was added: + ----- Method: SpurIncrementalCompactor>>unmarkSegmentAsBeingCompacted: (in category 'segment access') ----- + unmarkSegmentAsBeingCompacted: segInfo + <var: 'segInfo' type: #'SpurSegmentInfo *'> + "Swizzle is abused bit 16 isBeingCompacted bits 0-15 occupation" + segInfo swizzle: (segInfo swizzle bitAnd: 16rFFFF)! Item was changed: ----- Method: SpurIncrementalGarbageCollector class>>classesForTranslation (in category 'translation') ----- classesForTranslation + ^ super classesForTranslation , {SpurMarker . SpurIncrementalMarker . SpurAllAtOnceMarker . SpurStopTheWorldGarbageCollector . SpurPlanningCompactor . SpurIncrementalSweeper . SpurIncrementalCompactor . SpurIncrementalSweepAndCompact }! - ^ super classesForTranslation , {SpurMarker . SpurIncrementalMarker . SpurAllAtOnceMarker . SpurPlanningCompactor . SpurIncrementalSweeper . SpurIncrementalCompactor . SpurIncrementalSweepAndCompact }! Item was changed: ----- Method: SpurIncrementalGarbageCollector class>>declareCVarsIn: (in category 'translation') ----- declareCVarsIn: aCCodeGenerator super declareCVarsIn: aCCodeGenerator. + aCCodeGenerator + var: 'phase' declareC: 'sqInt phase = 0'; + var: 'checkSetGCFlags' declareC: 'sqInt checkSetGCFlags = 1'. - aCCodeGenerator var: 'phase' declareC: 'sqInt phase = 0'. aCCodeGenerator + staticallyResolvedPolymorphicReceiver: 'allAtOnceMarker' to: SpurAllAtOnceMarker in: self. + + aCCodeGenerator + forRecursivePolymorphismResolve: SpurIncrementalMarker as: self; + forRecursivePolymorphismResolve: SpurIncrementalCompactor as: self; + forRecursivePolymorphismResolve: SpurIncrementalSweepAndCompact as: self; + forRecursivePolymorphismResolve: SpurIncrementalSweeper as: self. + + "just important when doiing incremental compaction, therefore doin it here" + aCCodeGenerator + forRecursivePolymorphismResolve: SpurAllAtOnceMarker as: SpurStopTheWorldGarbageCollector; + forRecursivePolymorphismResolve: SpurPlanningCompactor as: SpurStopTheWorldGarbageCollector! - staticallyResolvedPolymorphicReceiver: 'marker' to: self markerClass; - staticallyResolvedPolymorphicReceiver: 'allAtOnceMarker' to: SpurAllAtOnceMarker! Item was changed: ----- Method: SpurIncrementalGarbageCollector>>assertSettingGCFlagsIsOk: (in category 'as yet unclassified') ----- assertSettingGCFlagsIsOk: objOop checkSetGCFlags ifFalse: [^ self]. "do not color young objects. They have an extra state we do not want to change" self assert: (manager isOldObject: objOop). (manager isOldObject: objOop) ifFalse: [self cCode: 'raise(SIGINT)']. "while sweeping: do not color objects behind the currently point the sweeper is at. This would infer with the next marking pass" self assert: (self allocatorShouldAllocateBlack not or: [objOop >= self compactor currentSweepingEntity]). (self allocatorShouldAllocateBlack not or: [objOop >= self compactor currentSweepingEntity]) + ifFalse: [self cCode: 'raise(SIGINT)']! - ifFalse: [self cCode: 'error("foo")'.]! Item was changed: ----- Method: SpurIncrementalGarbageCollector>>doIncrementalCollect (in category 'as yet unclassified') ----- doIncrementalCollect 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. manager setCheckForLeaks: GCCheckFreeSpace + GCModeFull; runLeakCheckerFor: GCModeFull excludeUnmarkedObjs: true classIndicesShouldBeValid: true; checkFreeSpace: GCModeFull. ^ 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. manager setCheckForLeaks: GCCheckFreeSpace + GCModeFull; runLeakCheckerFor: GCModeFull; checkFreeSpace: GCModeFull. compactor assertNoSegmentBeingCompacted. phase := InCompactingPhase. ^ self]]. phase = InCompactingPhase ifTrue: [ "self cCode: 'raise(SIGINT)'." coInterpreter cr; print: 'start compacting '; tab; flush. compactor incrementalCompact ifTrue: [ coInterpreter cr; print: 'finish compacting '; tab; flush. manager setCheckForLeaks: GCCheckFreeSpace + GCModeFull; runLeakCheckerFor: GCModeFull; checkFreeSpace: GCModeFull. phase := InMarkingPhase. ^ self]]! Item was added: + ----- Method: SpurIncrementalGarbageCollector>>doScavenge: (in category 'scavenge') ----- + doScavenge: tenuringCriterion + + "The inner shell for scavenge, abstrascted out so globalGarbageCollect can use it." + <inline: false> + manager doAllocationAccountingForScavenge. + manager gcPhaseInProgress: ScavengeInProgress. + manager pastSpaceStart: (scavenger scavenge: tenuringCriterion). + self assert: (self + oop: manager pastSpaceStart + isGreaterThanOrEqualTo: scavenger pastSpace start + andLessThanOrEqualTo: scavenger pastSpace limit). + manager freeStart: scavenger eden start. + manager gcPhaseInProgress: 0. + manager resetAllocationAccountingAfterGC. + + self incrementalCollect! Item was changed: ----- Method: SpurIncrementalGarbageCollector>>fullGC (in category 'global') ----- fullGC "We need to be able to make a full GC, e.g. when we save the image. Use the made progress and finish the collection" + <returnTypeC: #usqLong> + <inline: #never> "for profiling" "incredible hacky solution. Will later on be replaced with the old collection, but for now use this to keep the state transitions consistent" self assert: manager validObjStacks. coInterpreter cr; print: 'start fullGC '; tab; flush. coInterpreter setGCMode: GCModeNewSpace. self doScavengeWithoutIncrementalCollect: MarkOnTenure. coInterpreter setGCMode: GCModeIncremental. phase = InMarkingPhase ifTrue: [ "end marking" [phase = InMarkingPhase] whileTrue: [self doIncrementalCollect]]. "end this collection cycle" [phase ~= InMarkingPhase] whileTrue: [self doIncrementalCollect]. "resolve forwarders in young space" coInterpreter setGCMode: GCModeNewSpace. self doScavengeWithoutIncrementalCollect: MarkOnTenure. coInterpreter setGCMode: GCModeIncremental. "mark completely" [phase = InMarkingPhase] whileTrue: [self doIncrementalCollect]. "do rest of collection" [phase ~= InMarkingPhase] whileTrue: [self doIncrementalCollect]. manager setHeapSizeAtPreviousGC. coInterpreter cr; print: 'end fullGC '; tab; flush. ^(manager freeLists at: 0) ~= 0 ifTrue: [manager bytesInBody: manager findLargestFreeChunk] ifFalse: [0]! Item was changed: ----- Method: SpurIncrementalGarbageCollector>>incrementalCollect (in category 'global') ----- incrementalCollect + | startTime | self flag: #Todo. "where to put this?" manager statScavenges = 0 ifTrue: [manager makeAllObjectsWhite.]. + startTime := coInterpreter ioUTCMicrosecondsNow. + self doIncrementalCollect. + coInterpreter cr; print: 'time: '; printNum: coInterpreter ioUTCMicrosecondsNow - startTime; tab; flush. self assert: manager validObjStacks.! Item was added: + ----- Method: SpurIncrementalGarbageCollector>>isOkToGrey (in category 'as yet unclassified') ----- + isOkToGrey + + ^ checkSetGCFlags! Item was added: + ----- Method: SpurIncrementalGarbageCollector>>scavengingGCTenuringIf: (in category 'scavenge') ----- + scavengingGCTenuringIf: tenuringCriterion + "Run the scavenger." + <inline: false> + self assert: manager remapBufferCount = 0. + (self asserta: scavenger eden limit - manager freeStart > coInterpreter interpreterAllocationReserveBytes) ifFalse: + [coInterpreter tab; + printNum: scavenger eden limit - manager freeStart; space; + printNum: coInterpreter interpreterAllocationReserveBytes; space; + printNum: coInterpreter interpreterAllocationReserveBytes - (scavenger eden limit - manager freeStart); cr]. + manager checkMemoryMap. + manager checkFreeSpace: GCModeNewSpace. + manager runLeakCheckerFor: GCModeNewSpace. + + coInterpreter + preGCAction: GCModeNewSpace; + "would prefer this to be in mapInterpreterOops, but + compatibility with ObjectMemory dictates it goes here." + flushMethodCacheFrom: manager newSpaceStart to: manager oldSpaceStart. + manager needGCFlag: false. + + manager gcStartUsecs: coInterpreter ioUTCMicrosecondsNow. + + self doScavenge: tenuringCriterion. + + manager statScavenges: manager statScavenges + 1. + manager statGCEndUsecs: coInterpreter ioUTCMicrosecondsNow. + manager statSGCDeltaUsecs: manager statGCEndUsecs - manager gcStartUsecs. + manager statScavengeGCUsecs: manager statScavengeGCUsecs + manager statSGCDeltaUsecs. + manager statRootTableCount: scavenger rememberedSetSize. + + scavenger logScavenge. + + coInterpreter postGCAction: GCModeNewSpace. + + manager runLeakCheckerFor: GCModeNewSpace. + manager checkFreeSpace: GCModeNewSpace! Item was added: + ----- Method: SpurIncrementalGarbageCollector>>writeBarrierFor:at:with: (in category 'barrier') ----- + writeBarrierFor: anObject at: index with: value + "a dijkstra style write barrier with the addition of the generation check + objects that are not able to contain pointers are ignored too, as the write barries + should ensure we lose no references and this objects do not hold any of them" + <inline: true> + + self flag: #Todo. "we probably want the oldObject check to be the first one as it is only a pointer comparison and no dereferencing is needed" + + "((manager isImmediate: value) not and: [(manager isPureBitsNonImm: value)]) + ifTrue: [coInterpreter cr; print: 'saw: '; printHexnp: value; tab; flush]." + + (self marking and: [(manager isImmediate: value) not and: [(manager isOldObject: anObject) and: [(manager isOldObject: value) and: [manager isMarked: anObject]]]]) + ifTrue: [marker markAndShouldScan: value]! Item was changed: ----- Method: SpurIncrementalMarker>>finishMarking (in category 'as yet unclassified') ----- finishMarking "marks the structures needed during GC" <inline: #never> "lets assume there are not too many for now" self markWeaklingsAndMarkAndFireEphemerons. + [(manager isEmptyObjStack: manager markStack) not] + whileTrue: [self incrementalMark]. + + self assert: (manager isEmptyObjStack: manager markStack). + "self assert: self allReferencedClassesAreMarked." self allReferencedClassesAreMarked not ifTrue: [self cCode: 'raise(SIGINT)']. manager expungeDuplicateAndUnmarkedClasses: true ignoringClassesInYoungSpace: true. + + "Young space weaklings are not included in the weak set here. If weaklings from young space contain references to old space and the object behind it gets freed during sweeping a scavenge can try to access such an object. Therefore collect all young space weaklings here and nil their references (do it in the end to not include not existing weak objects from previous marking passes" self collectWeaklingsFromYoungSpaceInWeakSet. manager nilUnmarkedWeaklingSlotsExcludingYoungObjects: true. self assert: (manager isEmptyObjStack: manager markStack). isCurrentlyMarking := false. marking := false! Item was changed: ----- Method: SpurIncrementalMarker>>incrementalMark (in category 'marking - incremental') ----- incrementalMark "does one marking cycle. Breaks after a certain amount of slots is marked and the last object, that amount is crossed in, is completely scanned" | currentObj slotsLeft | "manager objStack: manager markStack do: [:index :page | Transcript showln: (manager fetchPointer: index ofObject: page)]. manager sizeOfObjStack: manager markStack" currentObj := manager popObjStack: manager markStack. "skip young objects. They get already scanned as they are part of the roots" [(currentObj notNil) and: [(manager isNonImmediate: currentObj) and: [manager isYoung: currentObj]]] whileTrue: [(manager isInClassTable: currentObj) ifTrue: [manager setIsMarkedOf: currentObj to: true]. currentObj := manager popObjStack: manager markStack]. currentObj ifNil: [^ true]. "there is nothing more on the stack and we are done" slotsLeft := SlotLimitPerPass. [ | slotNumber slotsToVisit startIndex | "after passing the limit we push the current index on the stack. Is the currentObj only an index? " (manager isImmediate: currentObj) ifTrue: [startIndex := manager integerValueOf: currentObj. currentObj := manager popObjStack: manager markStack.] ifFalse: [startIndex := 0. self assert: (manager isFreeObject: currentObj) not. (manager isForwarded: currentObj) ifTrue: [currentObj := manager followForwarded: currentObj]. + self assert: (manager isYoung: currentObj) not. self markAndTraceClassOf: currentObj. "eager color the object black. Either it will get scanned completely and the color is correct or we have at least scanned some of the slots. In the second case the mutator could modify one of the slots of the object that already were scanned and we would could lose this object. Therefore color the object early to trigger the write barrier on writes. There will be some overhead (trigger the barrier always although only the already scanned slots are technically black) but it seems we need to do this for correctness" self blackenObject: currentObj]. slotNumber := manager numStrongSlotsOfInephemeral: currentObj. slotsToVisit := slotNumber - startIndex. slotsLeft - slotsToVisit < 0 ifTrue: [ | countThatCanBeVisited | countThatCanBeVisited := slotsToVisit - slotsLeft. self markFrom: startIndex nSlots: countThatCanBeVisited of: currentObj. "If we need to abort earlier we push the index and the currently scanned object on the marking stack. Otherwise it is not possible for immediates to be on the stack (they have no fields to be scanned) -> we can use the immediated to detect this pattern" (manager topOfObjStack: manager markStack) ~= currentObj ifTrue: [manager push: currentObj onObjStack: manager markStack]. manager push: (manager integerObjectOf: startIndex + countThatCanBeVisited) onObjStack: manager markStack. "we need to abort early to not run into some extreme corner cases (giant objects) that would explode our mark time assumptions" ^ false] ifFalse: ["we can mark all" slotsLeft := slotsLeft - slotsToVisit. self markFrom: startIndex nSlots: slotsToVisit of: currentObj]. currentObj := manager popObjStack: manager markStack. [(currentObj notNil) and: [(manager isNonImmediate: currentObj) and: [manager isYoung: currentObj]]] whileTrue: [(manager isInClassTable: currentObj) ifTrue: [manager setIsMarkedOf: currentObj to: true]. currentObj := manager popObjStack: manager markStack]. "repeat while there still are objects" currentObj notNil] whileTrue. ^ true! Item was changed: ----- Method: SpurIncrementalMarker>>markFrom:nSlots:of: (in category 'as yet unclassified') ----- markFrom: startIndex nSlots: anAmount of: objOop startIndex to: startIndex + anAmount - 1 do: [:index | | slot | slot := manager fetchPointer: index ofObject: objOop. (manager isNonImmediate: slot) ifTrue: [ + self flag: #Todo. "can we use unchecked fix?" (manager isForwarded: slot) ifTrue: [slot := manager fixFollowedField: index ofObject: objOop withInitialValue: slot]. self markAndShouldScan: slot]]! Item was removed: - ----- Method: SpurIncrementalMarker>>writeBarrierFor:at:with: (in category 'barrier') ----- - writeBarrierFor: anObject at: index with: value - "a dijkstra style write barrier with the addition of the generation check - objects that are not able to contain pointers are ignored too, as the write barries - should ensure we lose no references and this objects do not hold any of them" - <inline: true> - - self flag: #Todo. "we probably want the oldObject check to be the first one as it is only a pointer comparison and no dereferencing is needed" - - "((manager isImmediate: value) not and: [(manager isPureBitsNonImm: value)]) - ifTrue: [coInterpreter cr; print: 'saw: '; printHexnp: value; tab; flush]." - - (self marking and: [(manager isImmediate: value) not and: [(manager isOldObject: anObject) and: [(manager isOldObject: value) and: [manager isMarked: anObject]]]]) - ifTrue: [self markAndShouldScan: value]! Item was removed: - ----- Method: SpurIncrementalMarkerSimulator>>writeBarrierFor:at:with: (in category 'barrier') ----- - writeBarrierFor: anObject at: index with: value - - GCEventLog - contextToKeepOnEvent: #writeBarrier - do: [super writeBarrierFor: anObject at: index with: value] - ! Item was changed: ----- Method: SpurIncrementalSweepAndCompact class>>declareCVarsIn: (in category 'nil') ----- + declareCVarsIn: aCCodeGenerator + + SpurMemoryManager wantsIncrementalGC + ifTrue: [| incrementalSelectors | + incrementalSelectors := SpurIncrementalCompactor selectors , SpurIncrementalSweeper selectors , SpurIncrementalSweepAndCompact selectors. + + (incrementalSelectors intersection: SpurPlanningCompactor selectors) + do: [:key | + aCCodeGenerator + staticallyResolveMethodNamed: key + forClass: self + to: (self staticallyResolvePolymorphicSelector: key)]]! - declareCVarsIn: aCCodeGenerator! Item was added: + ----- Method: SpurIncrementalSweepAndCompact class>>hasPolymorphicSelectors (in category 'nil') ----- + hasPolymorphicSelectors + "when using the incremental gc we have polymorphic selectors and have to resolve them" + + ^ SpurMemoryManager wantsIncrementalGC! Item was added: + ----- Method: SpurIncrementalSweepAndCompact class>>staticallyResolvePolymorphicSelector: (in category 'as yet unclassified') ----- + staticallyResolvePolymorphicSelector: aSelectorSymbol + + | incrementalSelectors | + incrementalSelectors := SpurIncrementalCompactor selectors , SpurIncrementalSweeper selectors , SpurIncrementalSweepAndCompact selectors. + incrementalSelectors := (incrementalSelectors intersection: SpurPlanningCompactor selectors). + + ^ (incrementalSelectors includes: aSelectorSymbol) + ifTrue: [super staticallyResolvePolymorphicSelector: aSelectorSymbol] + ifFalse: [aSelectorSymbol]! Item was changed: ----- Method: SpurIncrementalSweeper class>>declareCVarsIn: (in category 'as yet unclassified') ----- + declareCVarsIn: aCCodeGenerator + + SpurMemoryManager wantsIncrementalGC + ifTrue: [| incrementalSelectors | + incrementalSelectors := SpurIncrementalCompactor selectors , SpurIncrementalSweeper selectors , SpurIncrementalSweepAndCompact selectors. + + (incrementalSelectors intersection: SpurPlanningCompactor selectors) + do: [:key | + aCCodeGenerator + staticallyResolveMethodNamed: key + forClass: self + to: (self staticallyResolvePolymorphicSelector: key)]]! - declareCVarsIn: aCCodeGenerator! Item was changed: ----- Method: SpurMarker class>>declareCVarsIn: (in category 'translation') ----- declareCVarsIn: aCCodeGenerator "resolve keys present in both the incremental marker and the all at once mark when incremental GC is selected for generation" + self = SpurMarker ifTrue: [^ self]. SpurMemoryManager wantsIncrementalGC ifFalse: [^ self]. self selectorsInAllAtOnceMarkerAndIncrementalMarker do: [:key | aCCodeGenerator staticallyResolveMethodNamed: key forClass: self to: (self staticallyResolvePolymorphicSelector: key)] ! Item was changed: ----- Method: SpurMarker class>>selectorsInAllAtOnceMarkerAndIncrementalMarker (in category 'as yet unclassified') ----- selectorsInAllAtOnceMarkerAndIncrementalMarker + ^ (SpurAllAtOnceMarker selectors intersection: SpurIncrementalMarker selectors)! - | subclasses otherMarker | - subclasses := SpurMarker allSubclasses - select: [:ea | (ea name endsWith: 'Simulator') not]. "ignore simulators as they never get generated" - self assert: subclasses size = 2. "code written with SpurAllAtOnceMarker and SpurIncrementalMarker in mind. If you extend the class hierarchy you potentially have to change this method too" - - otherMarker := subclasses detect: [:class | class ~= self]. - - ^ (self selectors intersection: otherMarker selectors)! Item was added: + ----- Method: SpurMarker>>markAndShouldScan: (in category 'as yet unclassified') ----- + markAndShouldScan: objOop + + self subclassResponsibility! Item was removed: - ----- Method: SpurMarker>>writeBarrierFor:at:with: (in category 'barrier') ----- - writeBarrierFor: anObject at: index with: value! 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]! - staticallyResolvedPolymorphicReceiver: 'marker' to: SpurIncrementalMarker; - "hack!! see SpurMemoryManager>>staticallyResolvePolymorphicSelector: why we use this" - staticallyResolvedPolymorphicReceiver: 'objectMemory' to: SpurMemoryManager]! 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." + <staticallyResolveMethod: 'setIsMarkedOf:to:' to: #SpurStopTheWorldGarbageCollector> | freeChunk ptr start limit count bytes | gc markObjectsForEnumerationPrimitives ifTrue: [gc finishGCPass. + self assert: self allObjectsWhite. + gc markObjectsCompletely. + self assert: self noObjectGrey]. "may not want to revive objects unnecessarily; but marking is sloooow." - self assert: self allObjectsUnmarked. - gc markObjectsCompletely]. "may not want to revive objects unnecessarily; but marking is sloooow." freeChunk := self allocateLargestFreeChunk. "N.B. Does /not/ update totalFreeOldSpace" 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." (gc markObjectsForEnumerationPrimitives ifTrue: [self isMarked: obj] ifFalse: [true]) ifTrue: [(self isNormalObject: obj) ifTrue: [gc markObjectsForEnumerationPrimitives ifTrue: [self setIsMarkedOf: obj to: false]. count := count + 1. ptr < limit ifTrue: [self longAt: ptr put: obj. ptr := ptr + self bytesPerOop]] ifFalse: [gc markObjectsForEnumerationPrimitives ifTrue: [(self isSegmentBridge: obj) ifFalse: [self setIsMarkedOf: obj to: false]]]]]. self assert: (self isEmptyObjStack: markStack). gc 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 bytesInBody: freeChunk) at: (self startOfObject: freeChunk). self checkFreeSpace: GCModeFull. ^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. gc maybeModifyGCFlagsOf: freeChunk. self possibleRootStoreInto: freeChunk. coInterpreter cr; print: 'allObjects in: '; printHex: freeChunk; tab; flush. + self assert: self allObjectsWhite. - self assert: self allObjectsUnmarked. self checkFreeSpace: GCModeFull. self runLeakCheckerFor: GCModeFull. ^freeChunk! Item was changed: ----- Method: SpurMemoryManager>>allObjectsWhite (in category 'gc - global') ----- allObjectsWhite self allObjectsDo: + [:o| ((self isMarked: o) or: [self isGrey: o]) ifTrue: [self cCode: 'raise(SIGINT)'. bogon := o. ^false]]. - [:o| ((self isMarked: o) or: [self isGrey: o]) ifTrue: [bogon := o. ^false]]. ^true! Item was changed: ----- Method: SpurMemoryManager>>ambiguousClass:allInstancesInto:limit:resultsInto: (in category 'primitive support') ----- ambiguousClass: aClass allInstancesInto: start limit: limit resultsInto: binaryBlock "Dea with ambiguity and normalize indices." <inline: true> + <staticallyResolveMethod: 'setIsMarkedOf:to:' to: #SpurStopTheWorldGarbageCollector> | expectedIndex count ptr | count := 0. ptr := start. expectedIndex := self rawHashBitsOf: aClass. self allHeapEntitiesDo: [:obj| | actualIndex | "continue enumerating even if no room so as to unmark all objects and/or normalize class indices." (gc markObjectsForEnumerationPrimitives ifTrue: [self isMarked: obj] ifFalse: [true]) ifTrue: [(self isNormalObject: obj) ifTrue: [gc markObjectsForEnumerationPrimitives ifTrue: [self setIsMarkedOf: obj to: false]. actualIndex := self classIndexOf: obj. (self classOrNilAtIndex: actualIndex) = aClass ifTrue: [actualIndex ~= expectedIndex ifTrue: [self setClassIndexOf: obj to: expectedIndex]. count := count + 1. ptr < limit ifTrue: [self longAt: ptr put: obj. ptr := ptr + self bytesPerOop]]] ifFalse: [gc markObjectsForEnumerationPrimitives ifTrue: [(self isSegmentBridge: obj) ifFalse: [self setIsMarkedOf: obj to: false]]]]]. self purgeDuplicateClassTableEntriesFor: aClass. binaryBlock value: count value: ptr ! Item was added: + ----- Method: SpurMemoryManager>>collectAsNumberInto:limit:resultsInto: (in category 'primitive support') ----- + collectAsNumberInto: start limit: limit resultsInto: binaryBlock + + <inline: true> + | count ptr | + count := 0. + ptr := start. + self allHeapEntitiesDo: + [:obj| | entry | + entry := (self bytesInBody: obj) >> self shiftForWord. + self assert: entry < (2 << 57). + + entry := entry + (((self isFreeObject: obj) + ifTrue: [0] + ifFalse: [1]) << 56). + + count := count + 1. + ptr < limit ifTrue: + [self longAt: ptr put: entry. + ptr := ptr + self bytesPerOop]]. + + binaryBlock value: count value: ptr + ! Item was changed: ----- Method: SpurMemoryManager>>gc (in category 'accessing') ----- gc + <doNotGenerate> ^ gc! Item was added: + ----- Method: SpurMemoryManager>>getMarkObjectsForEnumerationPrimitives (in category 'gc - incremental') ----- + getMarkObjectsForEnumerationPrimitives + + ^ MarkObjectsForEnumerationPrimitives! Item was changed: ----- Method: SpurMemoryManager>>initializeObjectMemory: (in category 'initialization') ----- initializeObjectMemory: bytesToShift "Initialize object memory variables at startup time. Assume endOfMemory at al are initialised by the image-reading code via setHeapBase:memoryLimit:endOfMemory:. endOfMemory is assumed to point to the end of the last object in the image. Assume: image reader also initializes the following variables: specialObjectsOop lastHash" <inline: false> | freeListObj | "Catch mis-initializations leading to bad translations to C" self assert: self baseHeaderSize = self baseHeaderSize. self assert: (self maxSlotsForAlloc * self wordSize) asInteger > 0. self bootstrapping ifFalse: [self initSegmentBridgeWithBytes: self bridgeSize at: endOfMemory - self bridgeSize]. segmentManager adjustSegmentSwizzlesBy: bytesToShift. "image may be at a different address; adjust oops for new location" self adjustAllOopsBy: bytesToShift. specialObjectsOop := segmentManager swizzleObj: specialObjectsOop. "heavily used special objects" nilObj := self splObj: NilObject. falseObj := self splObj: FalseObject. trueObj := self splObj: TrueObject. "In Cog we insist that nil, true & false are next to each other (Cogit generates tighter conditional branch code as a result). In addition, Spur places the free lists and class table root page immediately following them." self assert: nilObj = oldSpaceStart. self assert: falseObj = (self oldSpaceObjectAfter: nilObj). self assert: trueObj = (self oldSpaceObjectAfter: falseObj). freeListObj := self oldSpaceObjectAfter: trueObj. self setHiddenRootsObj: (self oldSpaceObjectAfter: freeListObj). markStack := self swizzleObjStackAt: MarkStackRootIndex. weaklingStack := self swizzleObjStackAt: WeaklingStackRootIndex. mournQueue := self swizzleObjStackAt: MournQueueRootIndex. + (self addressCouldBeObj: (self fetchPointer: EphemeronStackRootIndex ofObject: hiddenRootsObj)) + ifFalse: [self storePointerUnchecked: EphemeronStackRootIndex ofObject: hiddenRootsObj withValue: nilObj]. ephemeronStack := self swizzleObjStackAt: EphemeronStackRootIndex. self assert: self validObjStacks. self assert: (self isEmptyObjStack: markStack). self assert: (self isEmptyObjStack: weaklingStack). self assert: (self isEmptyObjStack: ephemeronStack). self initializeFreeSpacePostLoad: freeListObj. segmentManager collapseSegmentsPostSwizzle. self updateFreeLists. self computeFreeSpacePostSwizzle. compactor postSwizzleAction. self initializeOldSpaceFirstFree: freeOldSpaceStart. "initializes endOfMemory, freeStart, free space" self initializeNewSpaceVariables. scavenger initializeRememberedSet. segmentManager checkSegments. compactor biasForGC. "These defaults should depend on machine size; e.g. too small on a powerful laptop, too big on a Pi." growHeadroom := 16*1024*1024. "headroom when growing" shrinkThreshold := 32*1024*1024. "free space before shrinking" self setHeapSizeAtPreviousGC. heapGrowthToSizeGCRatio := 0.333333. "By default GC after scavenge if heap has grown by a third since the last GC"! Item was added: + ----- 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 changed: ----- Method: SpurMemoryManager>>nilUnmarkedWeaklingSlotsIn:excludingYoungObjects: (in category 'weakness and ephemerality') ----- nilUnmarkedWeaklingSlotsIn: aWeakling excludingYoungObjects: aBoolean "Nil the unmarked slots in aWeakling and answer if any unmarked slots were found." <inline: true> | anyUnmarked | anyUnmarked := false. self assert: (self allStrongSlotsOfWeaklingAreMarked: aWeakling excludingYoungObjects: aBoolean). "N.B. generateToByDoLimitExpression:negative:on: guards against (unsigned)0 - 1 going +ve" (self numStrongSlotsOfWeakling: aWeakling) to: (self numSlotsOf: aWeakling) - 1 do: [:i| | referent | referent := self fetchPointer: i ofObject: aWeakling. (self isNonImmediate: referent) ifTrue: [(self isUnambiguouslyForwarder: referent) ifTrue: + [ + referent := self uncheckedFixFollowedField: i ofObject: aWeakling withInitialValue: referent. + ((self isOldObject: aWeakling) and: [(self isYoungObject: referent) and: [(self isRemembered: aWeakling) not]]) + ifTrue: [scavenger remember: aWeakling]]. - [referent := self fixFollowedField: i ofObject: aWeakling withInitialValue: referent]. ((self isImmediate: referent) or: [self isMarked: referent]) ifFalse: [((self isYoung: referent) and: [aBoolean]) ifFalse: [self storePointerUnchecked: i ofObject: aWeakling withValue: nilObj. anyUnmarked := true]]]]. ^anyUnmarked! Item was changed: ----- Method: SpurMemoryManager>>noElementOfFreeSpaceIsInSegment: (in category 'debug support') ----- noElementOfFreeSpaceIsInSegment: segInfo "Check that no free space on teh system's free lists is in the segment. N.B. This is slightly different to there is no free space in the segment." <var: 'segInfo' type: #'SpurSegmentInfo *'> self allFreeObjectsDo: + [:freeBird| (segmentManager is: freeBird inSegment: segInfo) ifTrue: [ self cCode: 'raise(SIGINT)'.^false]]. - [:freeBird| (segmentManager is: freeBird inSegment: segInfo) ifTrue: [^false]]. ^true! Item was added: + ----- Method: SpurMemoryManager>>noObjectGrey (in category 'gc - global') ----- + noObjectGrey + self allObjectsDo: + [:o| (self isGrey: o) ifTrue: [self cCode: 'raise(SIGINT)'. bogon := o. ^false]]. + ^true! Item was changed: ----- Method: SpurMemoryManager>>objectsReachableFromRoots: (in category 'image segment in/out') ----- objectsReachableFromRoots: arrayOfRoots "This is part of storeImageSegmentInto:outPointers:roots:. 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 roots | <var: #freeChunk type: #usqInt> "& hence start & ptr are too; limit is also because of addressAfter:" + + "do not check if it is ok to set gc flags" + <staticallyResolveMethod: 'setIsMarkedOf:to:' to: #SpurStopTheWorldGarbageCollector> + <staticallyResolveMethod: 'unmarkObjectsIn:' to: #SpurStopTheWorldGarbageCollector> + <staticallyResolveMethod: 'unmarkAllObjects' to: #SpurStopTheWorldGarbageCollector> + <inline: #never> 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." gc finishGCPassWithoutPreviousScavenge. roots := self followMaybeForwarded: arrayOfRoots. self assert: self allObjectsUnmarked. self markObjectsIn: roots. gc markObjectsCompletely. "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. "Now unmark the roots before collecting the transitive closure of unmarked objects accessible from the roots." self unmarkObjectsIn: roots. "Use the largest free chunk to answer the result." freeChunk := self allocateLargestFreeChunk. "N.B. Does /not/ update totalFreeOldSpace" totalFreeOldSpace := totalFreeOldSpace - (self bytesInBody: freeChunk). "but must update so that growth in the markStack does not cause assert fails." ptr := start := freeChunk + self baseHeaderSize. limit := self addressAfter: freeChunk. count := 0. "First put the roots; order is important." self noCheckPush: roots onObjStack: markStack. "Now collect the roots and the transitive closure of unmarked objects from them." [self isEmptyObjStack: markStack] whileFalse: [objOop := self popObjStack: markStack. self assert: (self isMarked: objOop). 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: oop to: true. self noCheckPush: oop onObjStack: markStack]. ((self isContextNonImm: objOop) and: [coInterpreter isStillMarriedContext: objOop]) "widow now, before the copy 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: oop to: true. self noCheckPush: 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: oop to: true. self noCheckPush: oop onObjStack: markStack]]]]. self unmarkAllObjects. "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 freeObject: freeChunk. self checkFreeSpace: GCCheckImageSegment. ^self integerObjectOf: count]. "There's room; set the format, & classIndex and shorten." self setFormatOf: freeChunk to: self arrayFormat. self setClassIndexOf: freeChunk to: ClassArrayCompactIndex. gc maybeModifyGCFlagsOf: freeChunk. self shorten: freeChunk toIndexableSize: count. (self isForwarded: freeChunk) ifTrue: [freeChunk := self followForwarded: freeChunk]. self possibleRootStoreInto: freeChunk. self checkFreeSpace: GCCheckImageSegment. self runLeakCheckerFor: GCCheckImageSegment. ^freeChunk! Item was changed: ----- Method: SpurMemoryManager>>push:onObjStack: (in category 'obj stacks') ----- push: objOop onObjStack: objStack <inline: true> self assert: (self addressCouldBeOop: objOop). + (gc isIncremental and: [objStack = self markStack and: [self isYoung: objOop]] ) + ifTrue: [self cCode: 'raise(SIGINT)']. (self isImmediate: objOop) ifTrue: [self assert: objStack = markStack. self assert: (self addressCouldBeObj: (self topOfObjStack: (0 = (self fetchPointer: ObjStackTopx ofObject: objStack) ifTrue: [self fetchPointer: ObjStackNextx ofObject: objStack] ifFalse: [objStack])))] ifFalse: "There should be no weaklings on the mark stack." [self assert: (objStack = markStack and: [self isWeakNonImm: objOop]) not. "There should only be weaklings on the weaklingStack" self assert: (objStack ~= weaklingStack or: [self isWeakNonImm: objOop])]. ^self noCheckPush: objOop onObjStack: objStack! Item was changed: ----- Method: SpurMemoryManager>>storeImageSegmentInto:outPointers:roots: (in category 'image segment in/out') ----- storeImageSegmentInto: segmentWordArrayArg outPointers: outPointerArrayArg roots: arrayOfRootsArg "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 objects 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 8), but with the high bit set. Since Spur has a class table the load primitive must insert classes that have instances into 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: PrimErrGenericError: the segmentWordArray is too small for the version stamp PrimErrWritePastObject: the segmentWordArray is too small to contain the reachable objects PrimErrBadIndex: the outPointerArray is too small PrimErrNoMemory: additional allocations failed PrimErrLimitExceeded: there is no room in the hash field to store out pointer indices or class references." + + "ignore incremental gc safety mechanisms as this is a special case" + <staticallyResolveMethod: 'copyObj:toAddr:stopAt:savedFirstFields:index:' to: #SpurStopTheWorldGarbageCollector> + <staticallyResolveMethod: 'return:restoringObjectsIn:upTo:savedFirstFields:' to: #SpurStopTheWorldGarbageCollector> + <staticallyResolveMethod: 'return:restoringObjectsIn:savedFirstFields:and:savedHashes:' to: #SpurStopTheWorldGarbageCollector> + <staticallyResolveMethod: 'mapOopsFrom:to:outPointers:outHashes:' to: #SpurStopTheWorldGarbageCollector> + <inline: false> | segmentWordArray outPointerArray arrayOfRoots arrayOfObjects savedFirstFields savedOutHashes segStart segAddr endSeg outIndex numClassesInSegment | <var: 'segAddr' type: #usqInt> ((self isObjImmutable: segmentWordArrayArg) or: [self isObjImmutable: outPointerArrayArg]) ifTrue: [^PrimErrNoModification]. "Since segmentWordArrayArg & outPointerArrayArg may get shortened, they can't be pinned." ((self isPinned: segmentWordArrayArg) or: [self isPinned: outPointerArrayArg]) ifTrue: [^PrimErrObjectIsPinned]. (self numSlotsOf: outPointerArrayArg) > self maxIdentityHash ifTrue: [^PrimErrLimitExceeded]. self runLeakCheckerFor: GCCheckImageSegment. "First scavenge to collect any new space garbage that refers to the graph." self scavengingGC. segmentWordArray := self updatePostScavenge: segmentWordArrayArg. outPointerArray := self updatePostScavenge: outPointerArrayArg. arrayOfRoots := self updatePostScavenge: arrayOfRootsArg. self deny: (self forwardersIn: outPointerArray). self deny: (self forwardersIn: arrayOfRoots). "Now compute the transitive closure, collecting the sequence of objects to be stored in the arrayOfObjects array. Included in arrayOfObjects are the arrayOfRoots and all its contents. All objects have been unmarked." arrayOfObjects := self objectsReachableFromRoots: arrayOfRoots. arrayOfObjects ifNil: [^PrimErrNoMemory]. "If objectsReachableFromRoots: answers an integer there is not enough continuous free space in which to allocate the reachable objects. If there is sufficient free space then answer an error code to prompt a compacting GC and a retry." (self isIntegerObject: arrayOfObjects) ifTrue: [totalFreeOldSpace - self allocationUnit >= (self integerValueOf: arrayOfObjects) ifTrue: [^PrimErrNeedCompaction]. ^PrimErrNoMemory]. self assert: self allObjectsUnmarked. "work to be done when the incremental GC is written" self deny: (self forwardersIn: arrayOfObjects). "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." numClassesInSegment := self moveClassesForwardsIn: arrayOfObjects. "The scheme is to copy the objects into segmentWordArray, and then map the oops in segmentWordArray. 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 segmentWordArray or outPointerArray is too small. The mapping is done by having the objects to be stored in arrayOfObjects refer to their mapped locations through their first field, just like a forwarding pointer, but without becoming a forwarder, saving their first field in savedFirstFields, and the objects in outPointerArray pointing to their locations in the outPointerArray through their identityHashes, saved in savedOutHashes. Since arrayOfObjects and its savedFirstFields, and outPointerArray and its saved hashes, can be enumerated side-by-side, the hashes can be restored to the originals. So the first field of the heap object corresponding to an object in arrayOfObjects is set to its location in segmentWordArray, and the hash of an object in outPointerArray is set to its index in outPointerArray plus the top hash bit. Classes in arrayOfObjects have their marked bit set. Oops in objects in segmentWordArray are therefore mapped by accessing the original oop, and following its first field. Class indices in segmentWordArray are mapped by fetching the original class, and testing its marked bit. If marked, the first field is followed to access the class copy in the segment. Out pointers (objects and classes, which are unmarked), the object's identityHash is set (eek!!!!) to its index in the outPointerArray. So savedOutHashes parallels the outPointerArray. The saved hash array is initialized with an out-of-range hash value so that the first unused entry can be identified." savedFirstFields := self noInlineAllocateSlots: (self numSlotsOf: arrayOfObjects) format: self wordIndexableFormat classIndex: self wordSizeClassIndexPun. savedOutHashes := self noInlineAllocateSlots: (self numSlotsForBytes: (self numSlotsOf: outPointerArray) * 4) format: self firstLongFormat classIndex: self thirtyTwoBitLongsClassIndexPun. (savedFirstFields isNil or: [savedOutHashes isNil]) ifTrue: [self freeObject: arrayOfObjects. (savedFirstFields notNil and: [self isInOldSpace: savedFirstFields]) ifTrue: [self freeObject: savedFirstFields]. (savedOutHashes notNil and: [self isInOldSpace: savedOutHashes]) ifTrue: [self freeObject: savedOutHashes]. ^PrimErrNoMemory]. self fillObj: savedFirstFields numSlots: (self numSlotsOf: savedFirstFields) with: 0. self fillObj: savedOutHashes numSlots: (self numSlotsOf: savedOutHashes) with: self savedOutHashFillValue. 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. self assert: arrayOfRoots = (self fetchPointer: 0 ofObject: arrayOfObjects). "Copy all reachable objects to the segment, setting the marked bit for all objects (clones) in the segment, and the remembered bit for all classes (clones) in the segment." 0 to: (self numSlotsOf: arrayOfObjects) - 1 do: [:i| | newSegAddrOrError objOop | "Check that classes in the segment are addressable. Since the top bit of the hash field is used to tag classes external to the segment, the segment offset must not inadvertently set this bit. This limit still allows for a million or more classes." (i = numClassesInSegment and: [segAddr - segStart / self allocationUnit + self lastClassIndexPun >= TopHashBit]) ifTrue: [^self return: PrimErrLimitExceeded restoringObjectsIn: arrayOfObjects upTo: i savedFirstFields: savedFirstFields]. objOop := self fetchPointer: i ofObject: arrayOfObjects. self deny: ((self isImmediate: objOop) or: [self isForwarded: objOop]). newSegAddrOrError := self copyObj: objOop toAddr: segAddr stopAt: endSeg savedFirstFields: savedFirstFields index: i. (self oop: newSegAddrOrError isLessThan: segStart) ifTrue: [^self return: newSegAddrOrError restoringObjectsIn: arrayOfObjects upTo: i savedFirstFields: savedFirstFields]. segAddr := newSegAddrOrError]. "Check that it can be safely shortened." (endSeg ~= segAddr and: [endSeg - segAddr < (self baseHeaderSize + self bytesPerOop)]) ifTrue: [^self return: PrimErrWritePastObject restoringObjectsIn: arrayOfObjects upTo: -1 savedFirstFields: savedFirstFields]. "Now scan, adding out pointers to the outPointersArray; all objects in arrayOfObjects have their first field pointing to the corresponding copy in segmentWordArray." (outIndex := self mapOopsFrom: segStart to: segAddr outPointers: outPointerArray outHashes: savedOutHashes) < 0 ifTrue: "no room in outPointers; fail" [^self return: PrimErrBadIndex restoringObjectsIn: arrayOfObjects savedFirstFields: savedFirstFields 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 savedFirstFields: savedFirstFields and: outPointerArray savedHashes: savedOutHashes! Item was changed: ----- Method: SpurMemoryManager>>storePointer:ofObject:withValue: (in category 'object access') ----- storePointer: fieldIndex ofObject: objOop withValue: valuePointer "Note must check here for stores of young objects into old ones." <inline: true> self assert: (self isForwarded: objOop) not. + (self isForwarded: objOop) + ifTrue: [self cCode: 'raise(SIGINT)']. (self isOldObject: objOop) ifTrue: "most stores into young objects" [(self isYoung: valuePointer) ifTrue: [self possibleRootStoreInto: objOop]]. self longAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord) put: valuePointer. + gc writeBarrierFor: objOop at: fieldIndex with: valuePointer. - self marker writeBarrierFor: objOop at: fieldIndex with: valuePointer. ^ valuePointer! Item was added: + ----- Method: SpurMemoryManager>>uncheckedFixFollowedField:ofObject:withInitialValue: (in category 'forwarding') ----- + uncheckedFixFollowedField: fieldIndex ofObject: anObject withInitialValue: initialValue + "Private helper for nilUnmarkedWeaklingSlotsIn:excludingYoungObjects:. It is important to use an unchecked pointer store to not trigger the write barrier and possibly add elements to the mark stack although we are currently finishing marking and do not visit the mark stack anymore (the consequence would be we have a grey object and possibly cause errors later on)" + <inline: #never> + | objOop | + self assert: (self isOopForwarded: initialValue). + "inlined followForwarded: for speed (one less test)" + objOop := initialValue. + [objOop := self fetchPointer: 0 ofMaybeForwardedObject: objOop. + self isOopForwarded: objOop] whileTrue. + self storePointerUnchecked: fieldIndex ofObject: anObject withValue: objOop. + ^objOop! Item was changed: ----- Method: SpurMemoryManager>>uniqueIndex:allInstancesInto:limit:resultsInto: (in category 'primitive support') ----- uniqueIndex: classIndex allInstancesInto: start limit: limit resultsInto: binaryBlock <inline: true> + <staticallyResolveMethod: 'setIsMarkedOf:to:' to: #SpurStopTheWorldGarbageCollector> | count ptr | count := 0. ptr := start. self allHeapEntitiesDo: [:obj| "continue enumerating even if no room so as to unmark all objects." (gc markObjectsForEnumerationPrimitives ifTrue: [self isMarked: obj] ifFalse: [true]) ifTrue: [(self isNormalObject: obj) ifTrue: [gc markObjectsForEnumerationPrimitives ifTrue: [self setIsMarkedOf: obj to: false]. (self classIndexOf: obj) = classIndex ifTrue: [count := count + 1. ptr < limit ifTrue: [self longAt: ptr put: obj. ptr := ptr + self bytesPerOop]]] ifFalse: [gc markObjectsForEnumerationPrimitives ifTrue: [(self isSegmentBridge: obj) ifFalse: [self setIsMarkedOf: obj to: false]]]]]. binaryBlock value: count value: ptr ! Item was changed: ----- Method: SpurMemoryManager>>validObjectColors (in category 'debug support') ----- validObjectColors | currentSweepingEntityT | currentSweepingEntityT := gc compactor sweeper currentSweepingEntity ifNil: [self firstObject]. self allOldSpaceEntitiesFrom: currentSweepingEntityT do: [:obj | ((self isMarked: obj) and: [(self isPointers: obj) and: [(self isContext: obj) not]]) ifTrue: [| slotCount | slotCount := self numSlotsOf: obj. 0 to: slotCount - 1 do: [:index | | slot | slot := self fetchPointer: index ofObject: obj. ((self isNonImmediate: slot) and: [(self isOldObject: slot) and: [(self isForwarded: slot) not]]) ifTrue: [(slot >= currentSweepingEntityT and: [(self isMarked: slot) not]) ifTrue: [self halt. coInterpreter longPrintOop: (self firstReferenceTo:(self firstReferenceTo: obj)). self printReferencesTo: (self firstReferenceTo: obj). self printReferencesTo: obj. self printRelativePositionOf: obj. self printRelativePositionOf: slot. coInterpreter longPrintOop: obj. coInterpreter longPrintOop: slot. + self cCode: 'raise(SIGINT)'. + ^ false]]]]]. ^ true! Item was changed: ----- Method: SpurMemoryManager>>weaklingStack (in category 'spur bootstrap') ----- weaklingStack + + <cmacro: '() GIV(weaklingStack)'> ^weaklingStack! Item was added: + ----- Method: SpurPlanningCompactor class>>hasPolymorphicSelectors (in category 'nil') ----- + hasPolymorphicSelectors + "when using the incremental gc we have polymorphic selectors and have to resolve them" + + ^ SpurMemoryManager wantsIncrementalGC! Item was added: + ----- Method: SpurPlanningCompactor class>>staticallyResolvePolymorphicSelector: (in category 'nil') ----- + staticallyResolvePolymorphicSelector: aSelectorSymbol + + | incrementalSelectors | + incrementalSelectors := SpurIncrementalCompactor selectors , SpurIncrementalSweeper selectors , SpurIncrementalSweepAndCompact selectors. + incrementalSelectors := (incrementalSelectors intersection: SpurPlanningCompactor selectors). + + ^ (incrementalSelectors includes: aSelectorSymbol) + ifTrue: [super staticallyResolvePolymorphicSelector: aSelectorSymbol] + ifFalse: [aSelectorSymbol]! Item was changed: ----- Method: SpurSegmentManager>>allObjectsAreForwardedInSegment:includingFreeSpace: (in category 'testing') ----- allObjectsAreForwardedInSegment: segInfo includingFreeSpace: includeFreeSpace "Answer if all objects in the segment are forwarded to somewhere outside the segment. If includeFreeSpace is true, answer false if there is any unforwarded free space in the segment." <var: 'segInfo' type: #'SpurSegmentInfo *'> self allEntitiesInSegment: segInfo exceptTheLastBridgeDo: [:thing| (manager isFreeObject: thing) ifTrue: [includeFreeSpace ifTrue: [^false]] ifFalse: + [self flag: #Todo. "does not work because free objects seem to be collections" + (manager isForwarded: thing) ifFalse: - [(manager isForwarded: thing) ifFalse: [^false]. (self is: (manager fetchPointer: 0 ofMaybeForwardedObject: thing) inSegment: segInfo) ifTrue: [^false]]]. ^true! Item was added: + ----- Method: SpurStopTheWorldGarbageCollector>>assertSettingGCFlagsIsOk: (in category 'as yet unclassified') ----- + assertSettingGCFlagsIsOk: objOop + "please keep this method. Needed to generate polymorpic version for this method"! Item was changed: ----- Method: SpurStopTheWorldGarbageCollector>>canReactToShiftSegment:to: (in category 'as yet unclassified') ----- + canReactToShiftSegment: segmentAddress to: anIndex! - canReactToShiftSegment: segmentAddress to: anIndex - - <doNotGenerate>! Item was added: + ----- Method: SpurStopTheWorldGarbageCollector>>doScavenge: (in category 'as yet unclassified') ----- + doScavenge: tenuringCriterion + + "needed to generate polymorphic version of this method" + "The inner shell for scavenge, abstrascted out so globalGarbageCollect can use it." + <inline: false> + manager doAllocationAccountingForScavenge. + manager gcPhaseInProgress: ScavengeInProgress. + manager pastSpaceStart: (scavenger scavenge: tenuringCriterion). + self assert: (self + oop: manager pastSpaceStart + isGreaterThanOrEqualTo: scavenger pastSpace start + andLessThanOrEqualTo: scavenger pastSpace limit). + manager freeStart: scavenger eden start. + manager gcPhaseInProgress: 0. + manager resetAllocationAccountingAfterGC.! Item was changed: ----- Method: SpurStopTheWorldGarbageCollector>>globalGarbageCollect (in category 'as yet unclassified') ----- globalGarbageCollect <inline: true> "inline into fullGC" + self cCode: [] inSmalltalk: [manager preGlobalGCActions]. - manager preGlobalGCActions. self assert: self validObjStacks. self assert: (self isEmptyObjStack: manager markStack). self assert: (self isEmptyObjStack: manager weaklingStack). "Mark objects /before/ scavenging, to empty the rememberedTable of unmarked roots." self markObjects: true. manager gcMarkEndUsecs: coInterpreter ioUTCMicrosecondsNow. scavenger forgetUnmarkedRememberedObjects. coInterpreter setGCMode: GCModeNewSpace. self doScavenge: MarkOnTenure. coInterpreter setGCMode: GCModeFull. "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." manager runLeakCheckerFor: GCModeFull excludeUnmarkedObjs: true classIndicesShouldBeValid: true. manager compactionStartUsecs: coInterpreter ioUTCMicrosecondsNow. manager segmentManager prepareForGlobalSweep. "for notePinned:" compactor compact. manager attemptToShrink. manager setHeapSizeAtPreviousGC. self assert: manager validObjStacks. self assert: (manager isEmptyObjStack: manager markStack). self assert: (manager isEmptyObjStack: manager weaklingStack). self assert: manager allObjectsUnmarked. manager runLeakCheckerFor: GCModeFull! Item was changed: ----- Method: SpurStopTheWorldGarbageCollector>>incrementalCollect (in category 'global') ----- incrementalCollect + "not supported in a stop the world GC -> no op"! - "not supported in a stop the world GC -> no op" - - <doNotGenerate>! Item was added: + ----- Method: SpurStopTheWorldGarbageCollector>>isIncremental (in category 'as yet unclassified') ----- + isIncremental + + ^ false! Item was added: + ----- Method: SpurStopTheWorldGarbageCollector>>isOkToClearReference: (in category 'testing') ----- + isOkToClearReference: objOop + + "nop here"! Item was changed: ----- Method: SpurStopTheWorldGarbageCollector>>isOkToDeleteSegment: (in category 'testing') ----- + isOkToDeleteSegment: segment! - isOkToDeleteSegment: segment - - <doNotGenerate>! Item was added: + ----- Method: SpurStopTheWorldGarbageCollector>>isOkToScavengeRememberedObject: (in category 'as yet unclassified') ----- + isOkToScavengeRememberedObject: objOop! Item was added: + ----- Method: SpurStopTheWorldGarbageCollector>>markObjects: (in category 'as yet unclassified') ----- + markObjects: objectsShouldBeUnmarkedAndUnmarkedClassesShouldBeExpunged + + marker markersMarkObjects: objectsShouldBeUnmarkedAndUnmarkedClassesShouldBeExpunged! Item was changed: ----- Method: SpurStopTheWorldGarbageCollector>>markObjectsForEnumerationPrimitives (in category 'as yet unclassified') ----- markObjectsForEnumerationPrimitives + ^ manager getMarkObjectsForEnumerationPrimitives! - ^ manager markObjectsForEnumerationPrimitives! Item was added: + ----- Method: SpurStopTheWorldGarbageCollector>>scavengingGCTenuringIf: (in category 'as yet unclassified') ----- + scavengingGCTenuringIf: tenuringCriterion + "Run the scavenger." + <inline: false> + self assert: manager remapBufferCount = 0. + (self asserta: scavenger eden limit - manager freeStart > coInterpreter interpreterAllocationReserveBytes) ifFalse: + [coInterpreter tab; + printNum: scavenger eden limit - manager freeStart; space; + printNum: coInterpreter interpreterAllocationReserveBytes; space; + printNum: coInterpreter interpreterAllocationReserveBytes - (scavenger eden limit - manager freeStart); cr]. + manager checkMemoryMap. + manager checkFreeSpace: GCModeNewSpace. + manager runLeakCheckerFor: GCModeNewSpace. + + coInterpreter + preGCAction: GCModeNewSpace; + "would prefer this to be in mapInterpreterOops, but + compatibility with ObjectMemory dictates it goes here." + flushMethodCacheFrom: manager newSpaceStart to: manager oldSpaceStart. + manager needGCFlag: false. + + manager gcStartUsecs: coInterpreter ioUTCMicrosecondsNow. + + self doScavenge: tenuringCriterion. + + manager statScavenges: manager statScavenges + 1. + manager statGCEndUsecs: coInterpreter ioUTCMicrosecondsNow. + manager statSGCDeltaUsecs: manager statGCEndUsecs - manager gcStartUsecs. + manager statScavengeGCUsecs: manager statScavengeGCUsecs + manager statSGCDeltaUsecs. + manager statRootTableCount: scavenger rememberedSetSize. + + scavenger logScavenge. + + coInterpreter postGCAction: GCModeNewSpace. + + manager runLeakCheckerFor: GCModeNewSpace. + manager checkFreeSpace: GCModeNewSpace! Item was added: + ----- Method: SpurStopTheWorldGarbageCollector>>writeBarrierFor:at:with: (in category 'as yet unclassified') ----- + writeBarrierFor: anObject at: index with: value! Item was changed: ----- Method: StackInterpreter class>>initializePrimitiveTable (in category 'initialization') ----- (excessive size, no diff calculated) Item was changed: ----- Method: StackInterpreter>>checkForEventsMayContextSwitch: (in category 'process primitive support') ----- checkForEventsMayContextSwitch: mayContextSwitch "Check for possible interrupts and handle one if necessary. Answer if a context switch has occurred." | switched sema now | <inline: false> <var: #now type: #usqLong> + <staticallyResolveReceiver: 'objectMemory' to: #SpurIncrementalGarbageCollector> statCheckForEvents := statCheckForEvents + 1. "restore the stackLimit if it has been smashed." self restoreStackLimit. self externalWriteBackHeadFramePointers. self assert: stackPage = stackPages mostRecentlyUsedPage. "Allow the platform to do anything it needs to do synchronously." self ioSynchronousCheckForEvents. self checkCogCompiledCodeCompactionCalledFor. objectMemory needGCFlag ifTrue: ["sufficientSpaceAfterGC: runs the incremental GC and then, if not enough space is available, the fullGC." + self cr; print: 'context switch '; tab; flush. (objectMemory sufficientSpaceAfterGC: 0) ifFalse: [self setSignalLowSpaceFlagAndSaveProcess]]. mayContextSwitch ifFalse: [^false]. switched := false. (profileProcess ~= objectMemory nilObject or: [nextProfileTick > 0 and:[self ioHighResClock >= nextProfileTick]]) ifTrue: [self zeroNextProfileTick. "Take a sample (if not already done so) for the profiler if it is active. This must be done before any of the synchronousSignals below or else we will attribute a pause in ioRelinquishProcessor to the newly activated process." profileProcess = objectMemory nilObject ifTrue: [profileProcess := self activeProcess. profileMethod := objectMemory nilObject]. "and signal the profiler semaphore if it is present" (profileSemaphore ~= objectMemory nilObject and: [self synchronousSignal: profileSemaphore]) ifTrue: [switched := true]]. self cppIf: #LRPCheck ifTrue: [self checkDeliveryOfLongRunningPrimitiveSignal ifTrue: [switched := true]]. objectMemory signalLowSpace ifTrue: [objectMemory signalLowSpace: false. "reset flag" sema := objectMemory splObj: TheLowSpaceSemaphore. (sema ~= objectMemory nilObject and: [self synchronousSignal: sema]) ifTrue: [switched := true]]. "inIOProcessEvents prevents reentrancy into ioProcessEvents and allows disabling ioProcessEvents e.g. for native GUIs. We would like to manage that here but can't since the platform code may choose to call ioProcessEvents itself in various places." false ifTrue: [((now := self ioUTCMicroseconds) >= nextPollUsecs and: [inIOProcessEvents = 0]) ifTrue: [statIOProcessEvents := statIOProcessEvents + 1. inIOProcessEvents := inIOProcessEvents + 1. self ioProcessEvents. "sets interruptPending if interrupt key pressed; may callback" inIOProcessEvents > 0 ifTrue: [inIOProcessEvents := inIOProcessEvents - 1]. nextPollUsecs := now + 20000 "msecs to wait before next call to ioProcessEvents. Note that strictly speaking we might need to update 'now' at this point since ioProcessEvents could take a very long time on some platforms"]] ifFalse: [(now := self ioUTCMicroseconds) >= nextPollUsecs ifTrue: [statIOProcessEvents := statIOProcessEvents + 1. self ioProcessEvents. "sets interruptPending if interrupt key pressed; may callback" nextPollUsecs := now + 20000 "msecs to wait before next call to ioProcessEvents. Note that strictly speaking we might need to update 'now' at this point since ioProcessEvents could take a very long time on some platforms"]]. interruptPending ifTrue: [interruptPending := false. "reset interrupt flag" sema := objectMemory splObj: TheInterruptSemaphore. (sema ~= objectMemory nilObject and: [self synchronousSignal: sema]) ifTrue: [switched := true]]. nextWakeupUsecs ~= 0 ifTrue: [now >= nextWakeupUsecs ifTrue: [nextWakeupUsecs := 0. "set timer interrupt to 0 for 'no timer'" sema := objectMemory splObj: TheTimerSemaphore. (sema ~= objectMemory nilObject and: [self synchronousSignal: sema]) ifTrue: [switched := true]]]. "signal any pending finalizations" pendingFinalizationSignals > 0 ifTrue: [pendingFinalizationSignals := 0. sema := objectMemory splObj: TheFinalizationSemaphore. (sema ~= objectMemory nilObject and: [self synchronousSignal: sema]) ifTrue: [switched := true]]. "signal all semaphores in semaphoresToSignal" self signalExternalSemaphores ifTrue: [switched := true]. ^switched! Item was changed: ----- Method: StackInterpreter>>incrementalMarkAndTraceInterpreterOops (in category 'object memory support') ----- incrementalMarkAndTraceInterpreterOops "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." + <staticallyResolveReceiver: 'marker' to: #SpurIncrementalMarker> | oop marker | - - "do not remove. Necessary for resolving polymorphic receiver" marker := objectMemory marker. "Must mark stack pages first to initialize the per-page trace flags for full garbage collect before any subsequent tracing." self incrementalMarkAndTraceStackPages. self incrementalMarkAndTraceTraceLog. self incrementalMarkAndTracePrimTraceLog. marker markAndShouldScan: objectMemory specialObjectsOop. "also covers nilObj, trueObj, falseObj, and compact classes" (objectMemory isImmediate: newMethod) ifFalse: [marker markAndShouldScan: newMethod]. self incrementalTraceProfileState. tempOop = 0 ifFalse: [marker markAndShouldScan: tempOop]. tempOop2 = 0 ifFalse: [marker markAndShouldScan: tempOop2]. "V3 memory manager support" 1 to: objectMemory remapBufferCount do: [:i | oop := objectMemory remapBuffer at: i. (objectMemory isImmediate: oop) ifFalse: [marker markAndShouldScan: oop]]! Item was changed: ----- Method: StackInterpreter>>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). 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)]. marker markAndShouldScan: (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 markAndShouldScan: oop]. theSP := theSP + objectMemory wordSize]! Item was changed: ----- Method: StackInterpreter>>incrementalTraceProfileState (in category 'object memory support') ----- incrementalTraceProfileState + <staticallyResolveReceiver: 'marker' to: #SpurIncrementalMarker> - "do not remove. Necessary for resolving polymorphic receiver" | marker | marker := objectMemory marker. objectMemory hasSpurMemoryManagerAPI ifTrue: [self followForwardingPointersInProfileState]. marker pushOnMarkingStackAndMakeGreyIfNecessary: profileProcess. marker pushOnMarkingStackAndMakeGreyIfNecessary: profileMethod. marker pushOnMarkingStackAndMakeGreyIfNecessary: 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]. marker pushOnMarkingStackAndMakeGreyIfNecessary: longRunningPrimitiveCheckMethod]. longRunningPrimitiveCheckSemaphore ~= nil ifTrue: [(objectMemory isForwarded: longRunningPrimitiveCheckSemaphore) ifTrue: [longRunningPrimitiveCheckSemaphore := objectMemory followForwarded: longRunningPrimitiveCheckSemaphore]. marker pushOnMarkingStackAndMakeGreyIfNecessary: longRunningPrimitiveCheckSemaphore]]! 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." + <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 + <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]]. - [longRunningPrimitiveCheckMethod := self 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 *'> + <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." + <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>>retryPrimitiveOnFailure (in category 'primitive support') ----- retryPrimitiveOnFailure "In Spur two cases of primitive failure are handled specially. A primitive may fail due to validation encountering a forwarder. On failure, check the accessorDepth for the primitive and if non-negative scan the args to the depth, following any forwarders. Retry the primitive if any are found. Hence lazily and transparently following forwarders on primitive failure. Additionally a primitive might fail due to an allocation failing. Retry if external primitives have failed with PrimErrNoMemory after running first the scavenger and then on a subsequent failure, the global mark-sweep collector. Hence lazily and transparently GC on memory exhaustion." <option: #SpurObjectMemory> + <staticallyResolveReceiver: 'objectMemory' to: #SpurIncrementalGarbageCollector> <inline: false> | primitiveIndex gcDone followDone canRetry retry retried | primitiveIndex := self primitiveIndexOf: newMethod. self assert: (self saneFunctionPointerForFailureOfPrimIndex: primitiveIndex). gcDone := 0. followDone := canRetry := retried := false. [retry := false. primFailCode = PrimErrNoMemory ifTrue: [(gcDone := gcDone + 1) = 1 ifTrue: [canRetry := primitiveIndex = PrimNumberExternalCall]. canRetry ifTrue: [gcDone = 1 ifTrue: [objectMemory scavengingGC]. gcDone = 2 ifTrue: [objectMemory fullGC]. retry := gcDone <= 2]] ifFalse: [followDone ifFalse: [followDone := true. retry := self checkForAndFollowForwardedPrimitiveState]]. retry] whileTrue: [self assert: primFailCode ~= 0. retried := true. self initPrimCall. self cCode: [] inSmalltalk: [self maybeMapPrimitiveFunctionPointerBackToSomethingEvaluable]. self dispatchFunctionPointer: primitiveFunctionPointer]. ^retried! Item was changed: ----- Method: StackInterpreterPrimitives>>primitiveFullGC (in category 'memory space primitives') ----- primitiveFullGC "Do a full garbage collection. In SqueakV3ObjectMemory, answer the number of bytes available (including swap space if dynamic memory management is supported). In Spur, answer the size of the largest free chunk." + + "because pragma does not get resolved correctly from super we need to inlude it here" + <staticallyResolveReceiver: 'objectMemory' to: #SpurIncrementalGarbageCollector> self externalWriteBackHeadFramePointers. super primitiveFullGC! Item was changed: ----- Method: StackInterpreterPrimitives>>primitiveGCInfo (in category 'system control primitives') ----- primitiveGCInfo "VM parameters are numbered as follows: 0 stopTheWorld (0) or incremental gc (1) 1 if incremental gc: current gc phase -> 0 marking; 1 sweeping; 2 compacting if stopTheWorld -> -1 2 eden start 3 eden limit 4 freeStart 5 scavengeThreshold 6 amount of old space segments " + + <staticallyResolveReceiver: 'objectMemory gc' to: #SpurIncrementalGarbageCollector> | result staticCount oldSpaceSegmentCount segmentInfoCount | staticCount := 8. segmentInfoCount := 5. oldSpaceSegmentCount := objectMemory numSegments. result := objectMemory instantiateClass: (objectMemory splObj: ClassArray) indexableSize: staticCount + (oldSpaceSegmentCount * segmentInfoCount). objectMemory storePointerUnchecked: 0 ofObject: result withValue: (objectMemory integerObjectOf: (objectMemory gc isIncremental ifTrue: [1] ifFalse: [0])). objectMemory storePointerUnchecked: 1 ofObject: result withValue: (objectMemory integerObjectOf: (objectMemory gc isIncremental ifTrue: [objectMemory gc phase] ifFalse: [-1])). objectMemory storePointerUnchecked: 2 ofObject: result withValue: (objectMemory integerObjectOf: objectMemory scavenger eden start). objectMemory storePointerUnchecked: 3 ofObject: result withValue: (objectMemory integerObjectOf: objectMemory scavenger eden limit). objectMemory storePointerUnchecked: 4 ofObject: result withValue: (objectMemory integerObjectOf: objectMemory freeStart). objectMemory storePointerUnchecked: 5 ofObject: result withValue: (objectMemory integerObjectOf: objectMemory scavengeThreshold). objectMemory storePointerUnchecked: 6 ofObject: result withValue: (objectMemory integerObjectOf: objectMemory statSurvivorCount). objectMemory storePointerUnchecked: 7 ofObject: result withValue: (self positiveMachineIntegerFor: oldSpaceSegmentCount). 0 to: oldSpaceSegmentCount - 1 do: [:index | | baseIndex segInfo | segInfo := objectMemory segInfoAt: index. baseIndex := staticCount + (index * segmentInfoCount). objectMemory storePointerUnchecked: baseIndex ofObject: result withValue: (objectMemory integerObjectOf: segInfo segStart). objectMemory storePointerUnchecked: baseIndex + 1 ofObject: result withValue: (objectMemory integerObjectOf: segInfo segSize). objectMemory storePointerUnchecked: baseIndex + 2 ofObject: result withValue: (objectMemory integerObjectOf: (segInfo swizzle bitAnd: 16rFFFF)). objectMemory storePointerUnchecked: baseIndex + 3 ofObject: result withValue: (objectMemory integerObjectOf: segInfo containsPinned). objectMemory storePointerUnchecked: baseIndex + 4 ofObject: result withValue: (objectMemory integerObjectOf: (segInfo swizzle bitOr: 1 << 16))]. objectMemory beRootIfOld: result. self methodReturnValue: result! Item was added: + ----- Method: StackInterpreterPrimitives>>primitiveMemoryMap (in category 'system control primitives') ----- + primitiveMemoryMap + "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 memoryMap. + (objectMemory isIntegerObject: result) ifTrue: + [objectMemory growToAccomodateContainerWithNumSlots: (objectMemory integerValueOf: result). + result := objectMemory memoryMap. + (objectMemory isIntegerObject: result) ifTrue: + [^self primitiveFailFor: PrimErrNoMemory]]. + self methodReturnValue: result! Item was added: + ----- Method: TMethod>>asPolymorphicBaseFor:toResolve:default: (in category 'as yet unclassified') ----- + asPolymorphicBaseFor: aClassCollection toResolve: aSymbol default: defaultClass + + | method | + self assert: (aClassCollection includes: defaultClass). + + method := PolymorphicBaseTMethod new. + + method + copyFrom: self; + classes: aClassCollection; + default: defaultClass; + receiverToResolve: aSymbol. + + ^ method! Item was added: + ----- Method: TMethod>>asPolymorphicFor:resolveTo: (in category 'as yet unclassified') ----- + asPolymorphicFor: aSymbol resolveTo: aClass + + | method | + method := PolymorphicTMethod new. + + method + copyFrom: self; + receiverToResolve: aSymbol; + receiverClass: aClass; + selector: (self polymorphicSelectorForClass: aClass). + + ^ method! Item was added: + ----- Method: TMethod>>isPolymorphic (in category 'testing') ----- + isPolymorphic + + ^ false! Item was added: + ----- Method: TMethod>>isPolymorphicBase (in category 'testing') ----- + isPolymorphicBase + + ^ false! Item was added: + ----- Method: TMethod>>polymorphicSelectorForClass: (in category 'as yet unclassified') ----- + polymorphicSelectorForClass: aClass + + ^ ((aClass name select: [:ea| ea isUppercase]), '_', self selector) asSymbol! Item was added: + ----- Method: TMethod>>pragmasAt: (in category 'accessing') ----- + pragmasAt: aSelector + ^self compiledMethod pragmasAt: aSelector! Item was changed: ----- Method: TMethod>>prepareMethodIn: (in category 'transformations') ----- prepareMethodIn: aCodeGen "Record sends of builtin operators, map sends of the special selector dispatchOn:in: with case statement nodes, and map sends of caseOf:[otherwise:] to switch statements. Declare limit variables for to:[by:]do: loops with limits that potentially have side-effects. As a hack also update the types of variables introduced to implement cascades correctly. This has to be done at the same time as this is done, so why not piggy back here?" aCodeGen maybeBreakForTestToInline: selector in: self. extraVariableNumber ifNotNil: [declarations keysAndValuesDo: [:varName :decl| decl isBlock ifTrue: [self assert: ((varName beginsWith: 'cascade') and: [varName last isDigit]). locals add: varName. self declarationAt: varName put: (decl value: self value: aCodeGen), ' ', varName]]]. + aCodeGen pushScope: declarations while:"N.B. nodesWithParentsDo: is bottom-up, hence replacement is destructive and conserved." [parseTree nodesWithParentsDo: [:node :parent| node isSend ifTrue: + [aCodeGen ifStaticallyResolvedPolymorphicReceiverThenUpdateSelectorIn: node fromMethod: self in: self definingClass. - [aCodeGen ifStaticallyResolvedPolymorphicReceiverThenUpdateSelectorIn: node fromMethodIn: self definingClass. (aCodeGen isBuiltinSelector: node selector) ifTrue: [node isBuiltinOperator: true. "If a to:by:do:'s limit has side-effects, declare the limit variable, otherwise delete it from the args" node selector = #to:by:do: ifTrue: [self ensureToByDoLoopLimitIsSafeAndEfficient: node in: aCodeGen]] ifFalse: [(aCodeGen isStackAccessor: node selector) ifTrue: "compute and cache the accessor depth early, before inlining destroys the accessor chains" [self export ifTrue: [aCodeGen accessorDepthForMethod: self]] ifFalse: [(CaseStatements includes: node selector) ifTrue: [parent replaceNodesIn: (Dictionary newFromPairs: { node. self buildCaseStmt: node in: aCodeGen})]. (#(caseOf: #caseOf:otherwise:) includes: node selector) ifTrue: [parent replaceNodesIn: (Dictionary newFromPairs: { node. self buildSwitchStmt: node parent: parent })]. (#(printf: fprintf: f:printf: f:wprintf:) includes: node selector) ifTrue: [self transformPrintf: node in: aCodeGen]. (node receiver isVariable and: [node receiver name = #Character and: [node selector isUnary]]) ifTrue: [parent replaceNodesIn: (Dictionary newFromPairs: { node. TConstantNode new setValue: (Character perform: node selector) })]]]]]]! Item was changed: TParseNode subclass: #TSendNode + instanceVariableNames: 'selector receiver arguments isBuiltinOperator oldSelector' - instanceVariableNames: 'selector receiver arguments isBuiltinOperator' classVariableNames: '' poolDictionaries: '' category: 'VMMaker-Translation to C'! Item was added: + ----- Method: TSendNode>>oldSelector (in category 'accessing') ----- + oldSelector + + ^ oldSelector! Item was added: + ----- Method: TSendNode>>oldSelector: (in category 'accessing') ----- + oldSelector: aClass + + oldSelector := aClass! Item was added: + ----- Method: TSendNode>>setSelectorForPolymorphism: (in category 'nil') ----- + setSelectorForPolymorphism: newSelector + + self + oldSelector: self selector; + selector: newSelector! Item was changed: ----- Method: TSendNode>>shouldExcludeReceiverAsFirstArgument: (in category 'C code generation') ----- shouldExcludeReceiverAsFirstArgument: aCodeGen "Only include the receiver as the first argument in certain cases. The receiver is always included if it is an expression. If it is a variable: If the vmClass says it is an implicit variable, don't include it. If the method's definingClass says it is an implicit variable, don't include it. If the variable is 'self' and the method being called is not in the method set (i.e. it is some external code), don't include it. If it is a struct send of something the vm says is an implicit variable, don't include it." | m | (aCodeGen isAssertSelector: selector) ifTrue: [^true]. (receiver isSend and: [(receiver shouldExcludeReceiverAsFirstArgument: aCodeGen) or: [receiver receiver isVariable and: [(self isSelfReference: receiver receiver in: aCodeGen) or: [self isStructReference: receiver receiver in: aCodeGen]]]]) ifTrue: + [^aCodeGen isNonArgumentImplicitReceiverVariableName: receiver unmodifiedSelector]. - [^aCodeGen isNonArgumentImplicitReceiverVariableName: receiver selector]. ^receiver isVariable and: [(aCodeGen isNonArgumentImplicitReceiverVariableName: receiver name) or: [(self isSelfReference: receiver in: aCodeGen) and: [(m := aCodeGen methodNamed: selector) isNil or: [#(implicit nil) includes: m typeForSelf]]]]! Item was added: + ----- Method: TSendNode>>unmodifiedSelector (in category 'accessing') ----- + unmodifiedSelector + + ^ self oldSelector ifNil: [selector]! Item was changed: ----- Method: VMClass class>>initializeMiscConstants (in category 'initialization') ----- initializeMiscConstants "Falsify the `what type of VM is this?' flags that are defined in the various interp.h files. Subclass implementations need to include a super initializeMiscConstants" | omc | VMBIGENDIAN class. "Mention this for the benefit of CCodeGenerator>>emitCConstantsOn:" SPURVM := STACKVM := COGVM := COGMTVM := false. InitializationOptions ifNil: [InitializationOptions := Dictionary new]. omc := InitializationOptions at: #ObjectMemory ifAbsent: nil. (omc isNil and: [self defaultObjectMemoryClass notNil]) ifTrue: [omc := InitializationOptions at: #ObjectMemory put: self defaultObjectMemoryClass name]. omc := omc ifNotNil: [Smalltalk at: omc]. InitializationOptions at: #SqueakV3ObjectMemory "the good ole default" ifAbsentPut: (omc ifNil: [true] ifNotNil: [omc includesBehavior: ObjectMemory]); at: #SpurObjectMemory "the new contender" ifAbsentPut: (omc ifNil: [false] ifNotNil: [omc includesBehavior: SpurMemoryManager]). omc validateInitializationOptions. "hack around edge cases" "Use ifAbsentPut: so that they will get copied back to the VMMaker's options and dead code will likely be eliminated." PharoVM := InitializationOptions at: #PharoVM ifAbsentPut: [false]. NewspeakVM := InitializationOptions at: #NewspeakVM ifAbsentPut: [false]. SistaVM := InitializationOptions at: #SistaVM ifAbsentPut: [false]. TempVectReadBarrier := InitializationOptions at: #TempVectReadBarrier ifAbsentPut: [false]. LowcodeVM := InitializationOptions at: #LowcodeVM ifAbsentPut: [false]. MULTIPLEBYTECODESETS := InitializationOptions at: #MULTIPLEBYTECODESETS ifAbsentPut: [false]. "Simulation only; on by default..." CloneOnGC := InitializationOptions at: #CloneOnGC ifAbsentPut: [true]. CloneOnScavenge := InitializationOptions at: #CloneOnScavenge ifAbsentPut: [true]. "These must be set only if specified, not defaulted, because they are set on the command line or in include files." InitializationOptions at: #VMBIGENDIAN ifPresent: [:value| VMBIGENDIAN := value]; at: #ObjectMemory ifPresent: [:value| SPURVM := value beginsWith: 'Spur']; at: #STACKVM ifPresent: [:value| STACKVM := value]; at: #COGVM ifPresent: [:value| COGVM := InitializationOptions at: #COGVM]; at: #COGMTVM ifPresent: [:value| COGMTVM := InitializationOptions at: #COGMTVM]. "consistency checks" SPURVM ifTrue: [(TempVectReadBarrier not and: [{SpurMemoryManager compactorClass}, (SpurMemoryManager compactorClass ancilliaryClasses) anySatisfy: + [:c| c == SpurSelectiveCompactor or: [c == SpurIncrementalSweepAndCompact]]]) ifTrue: - [:c| c == SpurSelectiveCompactor]]) ifTrue: [self error: 'Selective compactor requires read barrier']] ifFalse: [TempVectReadBarrier ifTrue: [self error: 'read barrier works with spur VM only...']. SistaVM ifTrue: [self error: 'Sista VM works with spur VM only...']]. "And not these; they're compile-time" IMMUTABILITY := InitializationOptions at: #IMMUTABILITY ifAbsent: [SPURVM] "Default as enabled for Spur VMs"! Item was added: + ----- Method: VMMaker class>>generateSqueakSpurIncrementalStack64VM (in category 'configurations') ----- + generateSqueakSpurIncrementalStack64VM + "No primitives since we can use those from the Cog VM" + ^VMMaker + generate: StackInterpreter + with: #(ObjectMemory Spur64BitMemoryManager + FailImbalancedPrimitives false + MULTIPLEBYTECODESETS true + TempVectReadBarrier true + bytecodeTableInitializer initializeBytecodeTableForSqueakV3PlusClosuresSistaV1Hybrid) + to: self sourceTree, '/src/spur64.stack' + platformDir: self sourceTree, '/platforms' + including: #()!

1 0

Building OSVM in Windows 11 and Cygwin64 ...
by Marcel Taeumel 01 Jan '23

01 Jan '23

Hi all! Has anybody tried to build OSVM in Windows 11 via Cygwin64? clang-8 does not work because "_alloca" cannot be found ... hmm... So, who implements _alloca? It's not msvcrt.dll ... how to find that out? Best, Marcel

5 9

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Vm-dev January 2023