Vm-dev January 2023

vm-dev@lists.squeakfoundation.org

17 participants
74 discussions

VM Maker: VMMaker.oscog-eem.3289.mcz
by commits＠source.squeak.org 12 Jan '23

12 Jan '23

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.3289.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.3289 Author: eem Time: 12 January 2023, 11:12:13.125301 am UUID: 9307c38e-b2fb-4e92-af64-d991d3caf7a7 Ancestors: VMMaker.oscog-eem.3288 Repair the damage after the previous commit, which was due to my not having implemented file out from an MCPatchTool correctly before Monticello-eem.785. So properly merge VMMaker.oscog.seperateMarking-WoC.3298 & VMMaker.oscog.seperateMarking-WoC.3299. =============== Diff against VMMaker.oscog-eem.3288 =============== Item was removed: - ----- Method: StackInterpreter>>checkForRequiredInlinability (in category 'stack bytecodes') ----- - checkForRequiredInlinability - "This is used in methods answering inlinability. - Always answer false. But if the receiver is marked as something that must be inlined (inline == #always) raise an error." - (inline == #always and: [complete]) ifTrue: - [self error: 'cannot inline method ', selector, ' marked as <inline: #always>']. - ^false!!TMethod methodsFor: #testing stamp: 'WoC 1/12/2023 12:48'! Item was removed: - ----- Method: StackInterpreter>>checkForRequiredInlinabilityIn: (in category 'stack bytecodes') ----- - checkForRequiredInlinabilityIn: aMethod - "This is used in methods answering inlinability. - Always answer false. But if the receiver is marked as something that must be inlined (inline == #always) raise an error." - (inline == #always and: [complete]) ifTrue: - [self error: 'cannot inline method ', selector, ' marked as <inline: #always> into: ', aMethod asString]. - ^false!!TMethod methodsFor: #inlining stamp: 'WoC 1/12/2023 12:47'! Item was changed: ----- Method: StackInterpreter>>extPushFullClosureBytecode (in category 'stack bytecodes') ----- extPushFullClosureBytecode "255 11111111 xxxxxxxx siyyyyyy push Closure Compiled block literal index xxxxxxxx (+ Extend A * 256) numCopied yyyyyy receiverOnStack: s = 1 ignoreOuterContext: i = 1 The compiler has pushed the values to be copied, if any. The receiver has been pushed on stack before if specified. Create a Closure with space for the copiedValues and pop numCopied values off the stack into the closure. Sets outerContext, compiledBlock, numArgs and receiver as specified.." | compiledBlockLiteralIndex compiledBlock byte numArgs numCopied receiverIsOnStack ignoreContext | compiledBlockLiteralIndex := self fetchByte + (extA << 8). extA := 0. compiledBlock := objectMemory followMaybeForwarded: (self literal: compiledBlockLiteralIndex). self assert: (objectMemory isOopCompiledMethod: compiledBlock). numArgs := self argumentCountOf: compiledBlock. byte := self fetchByte. numCopied := byte bitAnd: 1<< 6 - 1. receiverIsOnStack := byte anyMask: 1 << 7. ignoreContext := byte anyMask: 1 << 6. + self pushFullClosureNumArgs: numArgs copiedValues: numCopied compiledBlock: compiledBlock receiverIsOnStack: receiverIsOnStack ignoreContext: ignoreContext! - self pushFullClosureNumArgs: numArgs copiedValues: numCopied compiledBlock: compiledBlock receiverIsOnStack: receiverIsOnStack ignoreContext: ignoreContext!!TMethod methodsFor: #testing stamp: 'eem 12/15/2016 09:32'! Item was removed: - ----- Method: TMethod>>checkForRequiredInlinability (in category 'testing') ----- - checkForRequiredInlinability - "This is used in methods answering inlinability. - Always answer false. But if the receiver is marked as something that must be inlined (inline == #always) raise an error." - (inline == #always and: [complete]) ifTrue: - [self error: 'cannot inline method ', selector, ' marked as <inline: #always>']. - ^false! Item was added: + ----- Method: TMethod>>checkForRequiredInlinabilityIn: (in category 'testing') ----- + checkForRequiredInlinabilityIn: aMethod + "This is used in methods answering inlinability. + Always answer false. But if the receiver is marked as something that must be inlined (inline == #always) raise an error." + (inline == #always and: [complete]) ifTrue: + [self error: 'cannot inline method ', selector, ' marked as <inline: #always> into: ', aMethod asString]. + ^false! Item was changed: ----- Method: TMethod>>inlineableFunctionCall:in: (in category 'inlining') ----- inlineableFunctionCall: aNode in: aCodeGen "Answer if the given send node is a call to a 'functional' method--a method whose body is a single return statement of some expression and whose actual parameters can all be directly substituted." aCodeGen maybeBreakForTestToInline: aNode in: self. aNode isSend ifFalse: [^false]. ((aCodeGen shouldGenerateAsInterpreterProxySend: aNode) or: [aCodeGen isStructSend: aNode]) ifTrue: [^false]. ^(aCodeGen methodNamed: aNode selector) ifNil: [aNode asTransformedConstantPerform ifNil: [self isInlineableConditional: aNode in: aCodeGen] ifNotNil: [:n| self inlineableFunctionCall: n in: aCodeGen]] ifNotNil: [:m| (m ~~ self and: [((m isFunctionalIn: aCodeGen) or: [m mustBeInlined and: [m isComplete]]) and: [m mayBeInlined and: [(aCodeGen mayInline: m selector) and: [aNode args allSatisfy: [:a| self isSubstitutableNode: a intoMethod: m in: aCodeGen]]]]]) + or: [m checkForRequiredInlinabilityIn: self]]! - or: [m checkForRequiredInlinability]]! Item was changed: ----- Method: TMethod>>inlineableSend:in: (in category 'inlining') ----- inlineableSend: aNode in: aCodeGen "Answer if the given send node is a call to a method that can be inlined." | m | aCodeGen maybeBreakForTestToInline: aNode in: self. aNode isSend ifFalse: [^false]. m := aCodeGen methodNamed: aNode selector. "nil if builtin or external function" + ^m ~= nil and: [m ~~ self + and: [m unmodifiedSelector ~= self unmodifiedSelector and: [m mayBeInlined and: [(m isComplete and: [aCodeGen mayInline: m selector]) + or: [m checkForRequiredInlinabilityIn: self]]]]]! - or: [m checkForRequiredInlinability]]]]!

1 0

VM Maker: VMMaker.oscog-eem.3288.mcz
by commits＠source.squeak.org 12 Jan '23

12 Jan '23

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.3288.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.3288 Author: eem Time: 12 January 2023, 10:36:05.690572 am UUID: f51f1ed0-2a67-4403-a874-8b1ba1700ff5 Ancestors: VMMaker.oscog-eem.3287 Merge VMMaker.oscog.seperateMarking-WoC.3298 & VMMaker.oscog.seperateMarking-WoC.3299. =============== Diff against VMMaker.oscog-eem.3287 =============== Item was added: + ----- Method: StackInterpreter>>checkForRequiredInlinability (in category 'stack bytecodes') ----- + checkForRequiredInlinability + "This is used in methods answering inlinability. + Always answer false. But if the receiver is marked as something that must be inlined (inline == #always) raise an error." + (inline == #always and: [complete]) ifTrue: + [self error: 'cannot inline method ', selector, ' marked as <inline: #always>']. + ^false!!TMethod methodsFor: #testing stamp: 'WoC 1/12/2023 12:48'! Item was added: + ----- Method: StackInterpreter>>checkForRequiredInlinabilityIn: (in category 'stack bytecodes') ----- + checkForRequiredInlinabilityIn: aMethod + "This is used in methods answering inlinability. + Always answer false. But if the receiver is marked as something that must be inlined (inline == #always) raise an error." + (inline == #always and: [complete]) ifTrue: + [self error: 'cannot inline method ', selector, ' marked as <inline: #always> into: ', aMethod asString]. + ^false!!TMethod methodsFor: #inlining stamp: 'WoC 1/12/2023 12:47'! Item was changed: ----- Method: StackInterpreter>>extPushFullClosureBytecode (in category 'stack bytecodes') ----- extPushFullClosureBytecode "255 11111111 xxxxxxxx siyyyyyy push Closure Compiled block literal index xxxxxxxx (+ Extend A * 256) numCopied yyyyyy receiverOnStack: s = 1 ignoreOuterContext: i = 1 The compiler has pushed the values to be copied, if any. The receiver has been pushed on stack before if specified. Create a Closure with space for the copiedValues and pop numCopied values off the stack into the closure. Sets outerContext, compiledBlock, numArgs and receiver as specified.." | compiledBlockLiteralIndex compiledBlock byte numArgs numCopied receiverIsOnStack ignoreContext | compiledBlockLiteralIndex := self fetchByte + (extA << 8). extA := 0. + compiledBlock := objectMemory followMaybeForwarded: (self literal: compiledBlockLiteralIndex). - compiledBlock := self literal: compiledBlockLiteralIndex. self assert: (objectMemory isOopCompiledMethod: compiledBlock). numArgs := self argumentCountOf: compiledBlock. byte := self fetchByte. numCopied := byte bitAnd: 1<< 6 - 1. receiverIsOnStack := byte anyMask: 1 << 7. ignoreContext := byte anyMask: 1 << 6. + self pushFullClosureNumArgs: numArgs copiedValues: numCopied compiledBlock: compiledBlock receiverIsOnStack: receiverIsOnStack ignoreContext: ignoreContext!!TMethod methodsFor: #testing stamp: 'eem 12/15/2016 09:32'! - self pushFullClosureNumArgs: numArgs copiedValues: numCopied compiledBlock: compiledBlock receiverIsOnStack: receiverIsOnStack ignoreContext: ignoreContext! Item was added: + ----- Method: StackInterpreter>>inlineableFunctionCall:in: (in category 'stack bytecodes') ----- + inlineableFunctionCall: aNode in: aCodeGen + "Answer if the given send node is a call to a 'functional' method--a method whose body is a single return statement of some expression and whose actual parameters can all be directly substituted." + + aCodeGen maybeBreakForTestToInline: aNode in: self. + aNode isSend ifFalse: + [^false]. + ((aCodeGen shouldGenerateAsInterpreterProxySend: aNode) + or: [aCodeGen isStructSend: aNode]) ifTrue: + [^false]. + ^(aCodeGen methodNamed: aNode selector) + ifNil: + [aNode asTransformedConstantPerform + ifNil: [self isInlineableConditional: aNode in: aCodeGen] + ifNotNil: [:n| self inlineableFunctionCall: n in: aCodeGen]] + ifNotNil: + [:m| + (m ~~ self + and: [((m isFunctionalIn: aCodeGen) or: [m mustBeInlined and: [m isComplete]]) + and: [m mayBeInlined + and: [(aCodeGen mayInline: m selector) + and: [aNode args allSatisfy: [:a| self isSubstitutableNode: a intoMethod: m in: aCodeGen]]]]]) + or: [m checkForRequiredInlinabilityIn: self]]!!TMethod methodsFor: #inlining stamp: 'WoC 1/12/2023 12:48'! Item was added: + ----- Method: StackInterpreter>>inlineableSend:in: (in category 'stack bytecodes') ----- + inlineableSend: aNode in: aCodeGen + "Answer if the given send node is a call to a method that can be inlined." + + | m | + aCodeGen maybeBreakForTestToInline: aNode in: self. + aNode isSend ifFalse: [^false]. + m := aCodeGen methodNamed: aNode selector. "nil if builtin or external function" + + ^m ~= nil + and: [m ~~ self + and: [m unmodifiedSelector ~= self unmodifiedSelector + and: [m mayBeInlined + and: [(m isComplete and: [aCodeGen mayInline: m selector]) + or: [m checkForRequiredInlinabilityIn: self]]]]]!

1 0

(Squeak) Compiler bug?
by Florin Mateoc 12 Jan '23

12 Jan '23

Hi, Happy New Year everybody! I hope you will forgive my transgression, I know this is not about the VM, it is about the bytecode compiler, but I am only subscribed to this list, and the Squeak compiler is somewhere in between. I have recently stumbled upon a regression introduced by Compiler-eem.483 One of my generated (transformed) methods is apparently valid Smalltalk - it can still be compiled - but it cannot be decompiled anymore. I am not sure if this is a compiler bug, or a latent decompiler bug exposed by the changes in Compiler-eem.483 My method is below, it is a transformed variant of NativeImageSegment>>findRogueRootsPrep The bug is somehow caused by the literal #Marker. I have started at the bytecodes and they look ok to me, but the decompiler enters an (apparently unrelated) infinite loop. It is also not just about the literal itself or the immediate surrounding code, the method needs to be big/complex enough (over a certain number of literals?) to trigger the bug. findRogueRootsPrep1 "Part of the tool to track down unwanted pointers into the segment. Break all owner pointers in submorphs, scripts, and viewers in flaps." | wld players morphs | wld := arrayOfRoots detect: [:obj | obj isMorph and: [obj isWorldMorph]] ifNone: []. wld == nil ifTrue: [ (wld := arrayOfRoots detect: [:obj1 | obj1 isMorph] ifNone: [#Marker] ) == #Marker ifTrue: [ ^ self error: 'can''t find a root morph']]. morphs := IdentitySet new: 400. wld allMorphsAndBookPagesInto: morphs. players := wld presenter allExtantPlayers. "just the cached list" players do: [:pp | | scriptEditors | scriptEditors := pp class tileScriptNames collect: [:nn | pp scriptEditorFor: nn]. scriptEditors do: [:se | morphs addAll: se allMorphs]]. wld submorphs do: [:mm | "non showing flaps" (mm isKindOf: FlapTab) ifTrue: [ mm referent allMorphsAndBookPagesInto: morphs]]. morphs do: [:mm1 | "break the back pointers" mm1 isInMemory ifTrue: [ (mm1 respondsTo: #target) ifTrue: [ mm1 nearestOwnerThat: [:ow | | zzzTemp | ow == mm1 target ifTrue: [ mm1 target: nil. zzzTemp := true ] ifFalse: [ zzzTemp := false]. zzzTemp]]. (mm1 respondsTo: #arguments) ifTrue: [ mm1 arguments do: [:arg | arg == nil ifFalse: [ mm1 nearestOwnerThat: [:ow1 | | zzzTemp1 | ow1 == arg ifTrue: [ mm1 arguments at: (mm1 arguments indexOf: arg) put: nil. zzzTemp1 := true ] ifFalse: [ zzzTemp1 := false]. zzzTemp1]]]]. mm1 eventHandler == nil ifFalse: ["recipients point back up" (morphs includesAllOf: mm1 eventHandler allRecipients) ifTrue: [ mm1 eventHandler: nil]]. "temporary, until using Model for PartsBin" mm1 isMorphicModel ifTrue: [ mm1 model isMorphicModel ifTrue: [ mm1 model breakDependents]]. mm1 isTextMorph ifTrue: [ mm1 setContainer: nil]]]. (Smalltalk includesKey: #Owners) ifTrue: [ Smalltalk at: #Owners put: nil]. "in case findOwnerMap: is commented out" "self findOwnerMap: morphs." morphs do: [:mm2 | "break the back pointers" mm2 isInMemory ifTrue: [ mm2 privateOwner: nil]] Florin

3 11

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

12 Jan '23

Tom Braun uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog.seperateMarking-WoC.3299.mcz ==================== Summary ==================== Name: VMMaker.oscog.seperateMarking-WoC.3299 Author: WoC Time: 12 January 2023, 2:17:47.774666 pm UUID: 6e0c3202-e7a3-4072-9da4-f0c4c7de0950 Ancestors: VMMaker.oscog.seperateMarking-WoC.3298 resolve forwarded compiled blocks if neccessary (I currently see no better possibility than resolving them in the StackInterpreter. As far as I understand they are one literal in CompiledMethods and we would have to scan all literal of allCompiledMethods to resolve them...) =============== Diff against VMMaker.oscog.seperateMarking-WoC.3298 =============== Item was changed: ----- Method: StackInterpreter>>extPushFullClosureBytecode (in category 'stack bytecodes') ----- extPushFullClosureBytecode "255 11111111 xxxxxxxx siyyyyyy push Closure Compiled block literal index xxxxxxxx (+ Extend A * 256) numCopied yyyyyy receiverOnStack: s = 1 ignoreOuterContext: i = 1 The compiler has pushed the values to be copied, if any. The receiver has been pushed on stack before if specified. Create a Closure with space for the copiedValues and pop numCopied values off the stack into the closure. Sets outerContext, compiledBlock, numArgs and receiver as specified.." | compiledBlockLiteralIndex compiledBlock byte numArgs numCopied receiverIsOnStack ignoreContext | compiledBlockLiteralIndex := self fetchByte + (extA << 8). extA := 0. + compiledBlock := objectMemory followMaybeForwarded: (self literal: compiledBlockLiteralIndex). - compiledBlock := self literal: compiledBlockLiteralIndex. self assert: (objectMemory isOopCompiledMethod: compiledBlock). numArgs := self argumentCountOf: compiledBlock. byte := self fetchByte. numCopied := byte bitAnd: 1<< 6 - 1. receiverIsOnStack := byte anyMask: 1 << 7. ignoreContext := byte anyMask: 1 << 6. self pushFullClosureNumArgs: numArgs copiedValues: numCopied compiledBlock: compiledBlock receiverIsOnStack: receiverIsOnStack ignoreContext: ignoreContext!

1 0

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

12 Jan '23

Tom Braun uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog.seperateMarking-WoC.3298.mcz ==================== Summary ==================== Name: VMMaker.oscog.seperateMarking-WoC.3298 Author: WoC Time: 12 January 2023, 2:12:53.353326 pm UUID: 5cc47dc5-7a97-4729-ad2f-2b93f218341d Ancestors: VMMaker.oscog.seperateMarking-WoC.3297 slightly better error reporting for not inlineable functions (in which method did Slang try to inline them) =============== Diff against VMMaker.oscog.seperateMarking-WoC.3297 =============== Item was removed: - ----- Method: TMethod>>checkForRequiredInlinability (in category 'testing') ----- - checkForRequiredInlinability - "This is used in methods answering inlinability. - Always answer false. But if the receiver is marked as something that must be inlined (inline == #always) raise an error." - (inline == #always and: [complete]) ifTrue: - [self error: 'cannot inline method ', selector, ' marked as <inline: #always>']. - ^false! Item was added: + ----- Method: TMethod>>checkForRequiredInlinabilityIn: (in category 'testing') ----- + checkForRequiredInlinabilityIn: aMethod + "This is used in methods answering inlinability. + Always answer false. But if the receiver is marked as something that must be inlined (inline == #always) raise an error." + (inline == #always and: [complete]) ifTrue: + [self error: 'cannot inline method ', selector, ' marked as <inline: #always> into: ', aMethod asString]. + ^false! Item was changed: ----- Method: TMethod>>inlineableFunctionCall:in: (in category 'inlining') ----- inlineableFunctionCall: aNode in: aCodeGen "Answer if the given send node is a call to a 'functional' method--a method whose body is a single return statement of some expression and whose actual parameters can all be directly substituted." aCodeGen maybeBreakForTestToInline: aNode in: self. aNode isSend ifFalse: [^false]. ((aCodeGen shouldGenerateAsInterpreterProxySend: aNode) or: [aCodeGen isStructSend: aNode]) ifTrue: [^false]. ^(aCodeGen methodNamed: aNode selector) ifNil: [aNode asTransformedConstantPerform ifNil: [self isInlineableConditional: aNode in: aCodeGen] ifNotNil: [:n| self inlineableFunctionCall: n in: aCodeGen]] ifNotNil: [:m| (m ~~ self and: [((m isFunctionalIn: aCodeGen) or: [m mustBeInlined and: [m isComplete]]) and: [m mayBeInlined and: [(aCodeGen mayInline: m selector) and: [aNode args allSatisfy: [:a| self isSubstitutableNode: a intoMethod: m in: aCodeGen]]]]]) + or: [m checkForRequiredInlinabilityIn: self]]! - or: [m checkForRequiredInlinability]]! Item was changed: ----- Method: TMethod>>inlineableSend:in: (in category 'inlining') ----- inlineableSend: aNode in: aCodeGen "Answer if the given send node is a call to a method that can be inlined." | m | aCodeGen maybeBreakForTestToInline: aNode in: self. aNode isSend ifFalse: [^false]. m := aCodeGen methodNamed: aNode selector. "nil if builtin or external function" ^m ~= nil and: [m ~~ self and: [m unmodifiedSelector ~= self unmodifiedSelector and: [m mayBeInlined and: [(m isComplete and: [aCodeGen mayInline: m selector]) + or: [m checkForRequiredInlinabilityIn: self]]]]]! - or: [m checkForRequiredInlinability]]]]]!

1 0

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

11 Jan '23

Tom Braun uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog.seperateMarking-WoC.3297.mcz ==================== Summary ==================== Name: VMMaker.oscog.seperateMarking-WoC.3297 Author: WoC Time: 11 January 2023, 4:13:04.345352 pm UUID: 780fb35b-f951-40ed-b0fc-035c4f9caa78 Ancestors: VMMaker.oscog.seperateMarking-WoC.3296 - remove unneeded method (introduced to solve an error that lied somewehere else) - skip marking young objects =============== Diff against VMMaker.oscog.seperateMarking-WoC.3296 =============== Item was removed: - ----- Method: SpurIncrementalGarbageCollector>>doScavengeWithoutIncrementalCollect: (in category 'scavenge') ----- - doScavengeWithoutIncrementalCollect: tenuringCriterion - - super doScavengeWithoutIncrementalCollect: tenuringCriterion. - - coInterpreter resolveForwardersInStackPages.! 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: [self setIsMarkedOf: currentObj ]. 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 flag: #Todo. "young objects can fall out of a forwarder. Do not follow them" self assert: (manager isYoung: currentObj) not. + (manager isYoung: currentObj) + ifTrue: ["trick to skip young object" + startIndex := manager numStrongSlotsOfInephemeral: currentObj] + ifFalse: [self markAndTraceClassOf: currentObj. - 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]]. - "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: [self setIsMarkedOf: currentObj]. currentObj := manager popObjStack: manager markStack]. "repeat while there still are objects" currentObj notNil] whileTrue. ^ true!

1 0

(: Call for Papers :) Programming Experience Workshop PX/23 (hybrid/online)
by Marcel Taeumel 11 Jan '23

11 Jan '23

===== PX/23 Call for Papers ===== Submissions possible until Mon 16 Jan 2023 :) Welcome to the 9th Edition of the Programming Experience Workshop https://2023.programming-conference.org/home/px-2023 Co-located with <Programming> 2023 in Tokyo https://2023.programming-conference.org/ ## Abstract Some programming feels fun, other programming feels annoying. Why? For a while now the study of programming has forced improvements to be described through the Fordist lens of usability and productivity, where the thing that matters is how much software can get built, how quickly. But along the way, something has gone missing. What makes programmers feel the way they do when they’re programming? It’s not usually fun to spend an age doing something that could have been done easily, so efficiency and usability still matter, but they’re not the end of the story. Some environments, activities, contexts, languages, infrastructures make programming feel alive, others feel like working in a bureaucracy. This is not purely technologically determined, writing Lisp to do your taxes probably still isn’t fun, but it’s also not technologically neutral, writing XML to produce performance art is still likely to be <bureaucratic></bureaucratic>. Whilst we can probably mostly agree about what isn’t fun, what is remains more personal and without a space within the academy to describe it. In its past editions, PX set its focus on questions like: Do programmers create text that is transformed into running behavior (the old way), or do they operate on behavior directly (“liveness”); are they exploring the live domain to understand the true nature of the requirements; are they like authors creating new worlds; does visualization matter; is the experience immediate, immersive, vivid and continuous; do fluency, literacy, and learning matter; do they build tools, meta-tools; are they creating languages to express new concepts quickly and easily; and curiously, is joy relevant to the experience? In this 9th edition of PX, we will expand its focus to also cover the experience that programmers have. What makes it and what breaks it? For whom? What can we build to share the joy of programming with others? Here is a list of topic areas to get you thinking: - creating programs - experience of programming - exploratory programming - liveness - non-standard tools - visual, auditory, tactile, and other non-textual languages - text and more than text - program understanding - domain-specific languages - psychology of programming - error tolerance - user studies - theories about all that Correctness, performance, standard tools, foundations, and text-as-program are important traditional research areas, but the experience of programming and how to improve and evolve it are the focus of this workshop. We also welcome a wide spectrum of contributions on programming experience. ## Submissions Submissions are solicited for Programming Experience 2023 (PX/23). The thrust of the workshop is to explore the human experience of programming—what it feels like to program, or what it should feel like. The technical topics include exploratory programming, live programming, authoring, representation of active content, visualization, navigation, modularity mechanisms, immediacy, literacy, fluency, learning, tool building, language engineering, and theory building. Submissions by academics, professional programmers, and non-professional programmer are welcome. Submissions can be in any form and format, including but not limited to papers, presentations, demos, videos, panels, debates, essays, writers’ workshops, and art. Presentation slots are expected to be between 20 minutes and one hour (if time allows), depending on quality, form, and relevance to the workshop. Submissions of academic papers directed toward publication should be so marked, and the program committee will engage in peer review for all such papers. All artifacts are to be submitted via EasyChair [2]. Papers and essays must be written in English, provided as PDF documents, and strictly adhere to the ACM Format [3]. [...] ## Review Submissions of academic papers directed toward publication will undergo standard peer review; other submissions will be reviewed for relevance and quality; shepherding will be available. ## Publication Academic papers and essays accepted for publication will be published as part of ACM's Digital Library; video publication on Vimeo or other streaming site; other publication on the PX workshop website. ## Upcoming Deadlines (AoE) Submissions: Mon 16 Jan 2023 Notifications: Mon 6 Feb 2023 Pre-workshop versions: Mon 20 Feb 2023 Workshop (hybrid/online): Mon 13 or Tue 14 Mar 2023 Final versions: Mon 3 Apr 2023 ## More Information [1] https://2023.programming-conference.org/home/px-2023 [2] https://easychair.org/conferences/?conf=px23 [3] http://www.acm.org/publications/proceedings-template

2 1

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

11 Jan '23

Tom Braun uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog.seperateMarking-WoC.3296.mcz ==================== Summary ==================== Name: VMMaker.oscog.seperateMarking-WoC.3296 Author: WoC Time: 11 January 2023, 3:33:08.177499 pm UUID: 8b193fca-809a-4343-a3af-25392e3826cb Ancestors: VMMaker.oscog.seperateMarking-WoC.3295 corrected comment =============== Diff against VMMaker.oscog.seperateMarking-WoC.3295 =============== Item was changed: ----- Method: SpurIncrementalGarbageCollector>>isOkToClearReference: (in category 'testing') ----- isOkToClearReference: objOop + "This method gets called from scavenging to check if it is ok to clear pointer from weak objects to old space + the information if an old is dead is available the moment when marking finishes. Then nilUnmarkedWeaklingSlotsExcludingYoungObjects: + gets called and all weak slots of objects pointing to unmarked objects get set to nil. Therefore in scavenging we cannot know + if it is ok to clear a reference (either they are already cleared or we not know if they are dead or alive) and have to forbid it" - "when using incremental GC if an object is dead is only possible to determine in a small time window (in sweeping for objects behind the sweepers position). During marking the information is not complete and in compaction the mark bits are already cleared. For simplicity, forbid clearing them. - Now only at the end of marking weak references and ephermerons get cleared (in old and young space)" ^ (manager isOldObject: objOop) not!

1 0

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

11 Jan '23

Tom Braun uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog.seperateMarking-WoC.3295.mcz ==================== Summary ==================== Name: VMMaker.oscog.seperateMarking-WoC.3295 Author: WoC Time: 11 January 2023, 12:52:25.919544 am UUID: 140f57bd-5c97-4644-8e87-1440a7610e2e Ancestors: VMMaker.oscog.seperateMarking-WoC.3294 - Some performance optimizations for resolving polymorphism (especially the calculation of the transitive closure of methods) - new method to define a list of methods to be resolved with the recursive polymorphism mechanism (and use it on 4 methods in StackInterpreter) - counting marker now knows how many objects are in a segment - CompactingSweeper now tries to stay in 5 ms runtime (sometimes it shoots over and some expensive security mechanism for developing add some massive time overhead, but otherwise it goes in a good direction) - more debug printing and some debug texts reformatted - removed unused Simulator classes - added some methods to enable starting the simulator again (as there is not real class structure to switch between incremental and stop-the-world it is currently not running for incremental gc) - enabled stop-the-world gc for snapshotting (have to investigate if it works correctly, but I was able to save and open an image without problems) - added some debugging convenience methods - fix bridge bug =============== Diff against VMMaker.oscog.seperateMarking-WoC.3294 =============== Item was changed: ----- 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 | + "self halt." "make a copy to make sure we get no side effects on the copies" + copy := tMethod fasterDeepCopy. - 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 changed: ----- Method: CCodeGenerator>>hasPolymorphicMethod:in: (in category 'helpers polymorphic resolving') ----- hasPolymorphicMethod: aSelector in: aClass + "do we know the class direcly?" + recursivePolymorphicMethodsMap at: aClass + ifPresent: [:methodMap | (methodMap includes: aSelector) + ifTrue: [^ true]]. + + "do we now any if its superclasses" + ^ aClass allSuperclasses - ^ aClass withAllSuperclasses anySatisfy: [:class | (recursivePolymorphicMethodsMap at: class ifAbsent: [{}]) includes: aSelector]! 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 = #checkForEventsMayContextSwitch: and: [aSendNode selector = #sufficientSpaceAfterGC:]) ifTrue: [self halt]." - "for debugging. Please do not remove!!" - "(aTMethod selector = #slidingCompactionRemapObj: and: [aSendNode selector = #isMobile:]) ifTrue: [self halt]." (aSendNode receiver isVariable or: [(self hasPolymorphicMethod: aSendNode selector in: aClass ) or: [removedForPolymorphism includesKey: aSendNode selector]]) ifFalse: [^self]. + receiverSymbol := aSendNode receiver name. - receiverSymbol := aSendNode receiver name. + (aTMethod pragmasAt: #staticallyResolveMessagesTo:asIfCalledIn:) + ifNotNil: [:pragmas | + pragmas + detect: [:pragma | receiverSymbol = (pragma argumentAt: 1)] + ifFound: [:pragma | + "methods at: aSendNode selector." + self halt.] + ifNone: []]. + 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 were 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, you did not implement to method in the class you would it expect to be in (inspect dict and see if the class you would expect is listed there as a key. If not you did not call staticallyResolveMethodNamed:forClass:to: on the selector in the missing class, please investigate) 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." + + " + For easier debugging: + Browser fullOnClass: aTMethod definingClass selector: aTMethod selector. + " + + self error: 'Could not resolve: ' , aSendNode asString , ' in: ' , aTMethod asString + , '. Possible variants of the methods exist in: ' , dict associations asString]]. - self halt]]. "we have to find a class to resolve the selector" class ifNotNil: [ aSendNode setSelectorForPolymorphism: (class staticallyResolvePolymorphicSelector: aSendNode selector)] ! Item was added: + ----- Method: CCodeGenerator>>recursivelyResolvePolymorpicReceiver:toVariants:in:default:forMethodList: (in category 'public') ----- + recursivelyResolvePolymorpicReceiver: variableName toVariants: classArray in: aClass default: defaultClass forMethodList: aMethodCollection + "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." + ((recursivelyResolvedPolymorphicReceivers ifNil: [recursivelyResolvedPolymorphicReceivers := Dictionary new]) + at: aClass + ifAbsentPut: [Dictionary new]) + at: variableName + put: classArray. + + aMethodCollection 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 changed: ----- 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 keys anySatisfy: [:ea | key includesBehavior: ea]] + ifFound: [:class | | actualClass | + actualClass := dictionary keys detect: [:ea | class includesBehavior: ea]. - detect: [:key | dictionary includesKey: key] - ifFound: [:class | aSendNode + setSelectorForPolymorphism: (dictionary at: actualClass). - setSelectorForPolymorphism: (dictionary at: class). aReturnBlock value]]. (self hasPolymorphicMethod: aSendNode selector in: aTMethod receiverClass) ifTrue: [self halt]! 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 keys anySatisfy: [:ea | key includesBehavior: ea]] + ifFound: [:class | | actualClass | + actualClass := dictionary keys detect: [:ea | class includesBehavior: ea]. + aSendNode + setSelectorForPolymorphism: (dictionary at: actualClass). + aReturnBlock value]]. + - 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 ]] ifAbsent: [] . ! Item was changed: ----- Method: CCodeGenerator>>transitiveClosureOfMethods:in: (in category 'helpers polymorphic resolving') ----- transitiveClosureOfMethods: aTMethodDictionary in: aClass + | alreadySeenSelectors toVisit toVisitNext classes mappingSendsToSelectors | - | alreadySeenSelectors toVisit toVisitNext | alreadySeenSelectors := Set newFrom: aTMethodDictionary keys. toVisit := OrderedCollection newFrom: aTMethodDictionary keys. toVisitNext := OrderedCollection new. + + mappingSendsToSelectors := Dictionary new. + classes := (aClass withAllSuperclasses copyUpTo: VMClass). + + classes do: [:ea | + ea selectorsAndMethodsDo: [:selector :method | + + method + selectorsDo: [:sel | + mappingSendsToSelectors + at: sel + ifPresent: [:collection | collection add: selector] + ifAbsentPut: [OrderedCollection with: selector]]]]. + + mappingSendsToSelectors. + + [toVisit do: [:ea | + mappingSendsToSelectors at: ea + ifPresent: [:collection | collection + do: [:sender | + (alreadySeenSelectors includes: sender) + ifFalse: [alreadySeenSelectors add: sender. + toVisitNext add: sender]]]]. + toVisit := toVisitNext. + toVisitNext := OrderedCollection new. + + toVisit notEmpty] whileTrue. + + + + "old much slower code. When tested for StackInterpreter there were 3 methods difference. From a first glance I + could not determine why they should be included, but should the future show I simply overlooked something here the + old code for reference + + [toVisit + do: [:each | (SystemNavigation default allCallsOn: each fromBehaviors: (aClass withAllSuperclasses copyUpTo: VMClass) sorted: false) - [toVisit - do: [:each | (SystemNavigation default allCallsOn: each fromBehaviors: (aClass withAllSuperclasses copyUpTo: VMClass )sorted: false) do: [:method | |selector | selector := method selector. (alreadySeenSelectors includes: selector) + ifFalse: [ + selector = #getenv: ifTrue: [self halt]. + alreadySeenSelectors add: selector. - ifFalse: [alreadySeenSelectors add: selector. toVisitNext add: selector] ]]. toVisit := toVisitNext. toVisitNext := OrderedCollection new. + toVisit notEmpty] whileTrue." - toVisit notEmpty] whileTrue. ^ alreadySeenSelectors! Item was changed: + ----- Method: PolymorphicBaseTMethod>>printOn: (in category 'printing') ----- - ----- Method: PolymorphicBaseTMethod>>printOn: (in category 'as yet unclassified') ----- printOn: aStream super printOn: aStream. aStream nextPut: $<; nextPutAll: self default name; nextPut: $>! Item was changed: TMethod subclass: #PolymorphicTMethod + instanceVariableNames: 'receiverToResolve receiverClass oldSelector' - instanceVariableNames: 'receiverToResolve receiverClass' classVariableNames: '' poolDictionaries: '' category: 'VMMaker-Translation to C'! Item was added: + ----- Method: PolymorphicTMethod>>oldSelector (in category 'accessing') ----- + oldSelector + + ^ oldSelector! Item was added: + ----- Method: PolymorphicTMethod>>oldSelector: (in category 'accessing') ----- + oldSelector: anObject + + oldSelector := anObject.! Item was changed: + ----- Method: PolymorphicTMethod>>printOn: (in category 'printing') ----- - ----- 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>>smalltalkSelector (in category 'as yet unclassified') ----- + smalltalkSelector + + ^ oldSelector! Item was added: + ----- Method: PolymorphicTMethod>>unmodifiedSelector (in category 'as yet unclassified') ----- + unmodifiedSelector + "I am not sure if any of the other selector accesses are overloaded or used otherwise in the system + -> I write this to be extra sure it is only used where I want it to be used" + + ^ self oldSelector! Item was added: + ----- Method: SpurCountingIncrementalMarker>>getLifeObjectCountOf: (in category 'segment occupation') ----- + getLifeObjectCountOf: segInfo + + <var: 'segInfo' type: #'SpurSegmentInfo *'> + + "hack: use lastFreeObject (only used during snapshot, where GC is already done and we can ignore that it gets changed) to keep track of + how much life data is in the segment" + ^ self + cCode: [segInfo savedSegSize] + inSmalltalk: [segInfo savedSegSize ifNil: [0]]! Item was changed: ----- Method: SpurCountingIncrementalMarker>>getUsedMemoryOf: (in category 'segment occupation') ----- getUsedMemoryOf: segInfo <var: 'segInfo' type: #'SpurSegmentInfo *'> "hack: use lastFreeObject (only used during snapshot, where GC is already done and we can ignore that it gets changed) to keep track of how much life data is in the segment" + ^ self + cCode: [segInfo lastFreeObject] + inSmalltalk: [segInfo lastFreeObject ifNil: [0]]! - ^ segInfo lastFreeObject! Item was changed: ----- Method: SpurCountingIncrementalMarker>>initForNewMarkingPass (in category 'marking-initialization') ----- initForNewMarkingPass super initForNewMarkingPass. 0 to: manager numSegments - 1 + do: [:index | | segInfo | + segInfo := manager segInfoAt: index. + self + setUsedMemory: 0 for: segInfo; + setLifeObjectCount: 0 for: segInfo]! - do: [:index | - self setUsedMemory: 0 for: (manager segInfoAt: index)]! Item was changed: ----- Method: SpurCountingIncrementalMarker>>setIsMarkedOf: (in category 'header access') ----- setIsMarkedOf: objOop | segmentContainingObject | super setIsMarkedOf: objOop. self flag: #Todo. "we need a more efficient way to get the segment" segmentContainingObject := manager segmentManager segmentContainingObj: objOop. + self setUsedMemory: (self getUsedMemoryOf: segmentContainingObject) + (manager bytesInBody: objOop) + for: segmentContainingObject. + + self + setLifeObjectCount: (self getLifeObjectCountOf: segmentContainingObject) + 1 for: segmentContainingObject! Item was added: + ----- Method: SpurCountingIncrementalMarker>>setLifeObjectCount:for: (in category 'segment occupation') ----- + setLifeObjectCount: objectCount for: segInfo + + <var: 'segInfo' type: #'SpurSegmentInfo *'> + + "hack: use savedSegSize (only used during snapshot, where GC is already done and we can ignore that it gets changed) to keep track of + how much life objects are in the segment" + segInfo savedSegSize: objectCount! Item was changed: CogClass subclass: #SpurGarbageCollector instanceVariableNames: 'marker scavenger compactor manager coInterpreter allocatorShouldAllocateBlack' classVariableNames: '' + poolDictionaries: 'SpurMemoryManagementConstants VMSpurObjectRepresentationConstants' - poolDictionaries: 'SpurMemoryManagementConstants' category: 'VMMaker-SpurGarbageCollector'! Item was changed: ----- Method: SpurIncremental2PhaseGarbageCollector>>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. compactor assertNoSegmentBeingCompacted. 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. + manager clearLeakMapAndMapMarkedOrYoungObjects. + coInterpreter checkStackIntegrity. + coInterpreter cr; print: 'time for internal check: '; printNum: coInterpreter ioUTCMicrosecondsNow - startTime; tab; flush. 0 to: manager numSegments - 1 do: [:i | | segInfo | segInfo := manager segInfoAt: i. coInterpreter cr; print: 'occupation from marking: '; printNum: (compactor occupationOf: segInfo) * 100; tab; + print: '('; printNum: (marker getLifeObjectCountOf: segInfo); print: ' objects -> ' ;printNum: (compactor sizeClaimedIn: segInfo) ; print: ' bytes)' ;flush]. - print: '('; printNum: (compactor sizeClaimedIn: segInfo) ; print: ' bytes)' ;flush]. manager printSegmentOccupationFromMarkedObjects. ^ self] ifFalse: [coInterpreter cr; print: 'finish marking pass'; tab; flush. "manager runLeakCheckerFor: GCModeIncremental"]]. phase = InSweepingPhase ifTrue: [ coInterpreter cr; print: 'start sweeping '; tab; flush. compactor incrementalSweepAndCompact ifTrue: [ self allocatorShouldAllocateBlack: false. self assert: manager allObjectsWhite. "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. phase := InMarkingPhase. ^ self]]! Item was changed: SpurCompactor subclass: #SpurIncrementalCompactingSweeper + instanceVariableNames: 'isCurrentlyWorking currentSegmentsIndex currentsCycleSeenObjectCount currentSegmentsBridge currentObject segmentToFill shouldCompact currentCopyToPointer scStartTime maxObjectsToFree' + classVariableNames: 'InitialMaxObjectsToFree MaxOccupationForCompaction MinObjectToFree' - instanceVariableNames: 'isCurrentlyWorking currentSegmentsIndex currentsCycleSeenObjectCount currentSegmentsBridge currentObject segmentToFill shouldCompact currentCopyToPointer scStartTime' - classVariableNames: 'MaxObjectsToFree MaxOccupationForCompaction' poolDictionaries: '' category: 'VMMaker-SpurGarbageCollector'! !SpurIncrementalCompactingSweeper commentStamp: 'WoC 1/5/2023 23:21' prior: 0! A SpurIncrementalCompactingSweeper is an incremental sweeper that compacts too. It is a merge of SpurIncrementalSweeper and SpurIncrementalCompactor with slight changes to the algorithm to accomodate to the fact both parts run at the same time. It traverses the heap one time sweeps normal segments, compacts segments that are planned to be compacted (more on that later) and skips the segment that should get filled. The compaction is adapted from: Lazy Pointer Update for Low Heap Compaction Pause Times (Clément Béra; Eliot Miranda; Elisa Gonzalez Boix -> https://doi.org/10.1145/3359619.3359741) The SpurIncrementalCompactingSweeper is designed to run after the SpurCountingIncrementalMarker. The SpurCountingIncrementalMarker will write how many bytes of life data are in segments into the segmentInfo lastFreeObject. As a first step we decide if and when yes which segments should get compacted. We try to compact as many segments as possible, that are under a certain threshold (see MaxOccupationForCompaction what the actual value is), into the segmentToFill (an completetly empty segment we reserve or allocate when no empty segment is available) The interesting entry point for understanding the algorithm is doincrementalSweepAndCompact. We already planned the compaction (read from planCompactionAndReserveSpace) and reserved the segmentToFill (freePastSegmentsAndSetSegmentToFill or findOrAllocateSegmentToFill). We now scan the whole heap. When the current object is in a normal segment we just do a normal sweep. This includes unmarking marked objects and coalescing unmarked objects and free chunks to larger free chunks (the whole succession of free chunks and unmarked objects until the next marked object or end of segment (attention!! only until the end of the segment the first object of this succession is)). Should the current object we see be in the segmentToFill we skip the whole segment. We can safely skip it as it was empty previously (the mutator cannot allocate into the segmentToFill) and we only copy life objects here -> we do not need to do work here as everything here is life. If the current object is in a segment that should be compacted (the current object will then be at the beginning of the segment) we start to compact it into segmentToFill. Free chunks get detached and set to a different class (so other safety mechanism ignore them). Marked objects get unmarked and forwarded to the segmentToFill. Unmarked objects get ignored (we just unremember them). Instance Variables currentCopyToPointer: <Object> currentObject: <Object> currentSegmentsBridge: <Object> currentSegmentsIndex: <Object> currentsCycleSeenObjectCount: <Object> isCurrentlyWorking: <Object> segmentToFill: <Object> shouldCompact: <Object> currentCopyToPointer - xxxxx currentObject - xxxxx currentSegmentsBridge - xxxxx currentSegmentsIndex - xxxxx currentsCycleSeenObjectCount - xxxxx isCurrentlyWorking - xxxxx segmentToFill - xxxxx shouldCompact - xxxxx ! Item was changed: ----- Method: SpurIncrementalCompactingSweeper class>>declareCVarsIn: (in category 'translation') ----- declareCVarsIn: aCCodeGenerator + aCCodeGenerator + var: #segmentToFill type: #'SpurSegmentInfo *'; + var: 'maxObjectsToFree' declareC: 'sqInt maxObjectsToFree = ', InitialMaxObjectsToFree asString. - aCCodeGenerator var: #segmentToFill type: #'SpurSegmentInfo *'. SpurMemoryManager wantsIncrementalGC ifTrue: [ (self selectors intersection: SpurPlanningCompactor selectors) do: [:key | aCCodeGenerator staticallyResolveMethodNamed: key forClass: self to: (self staticallyResolvePolymorphicSelector: key)]]! Item was changed: ----- Method: SpurIncrementalCompactingSweeper class>>initialize (in category 'initialization') ----- initialize super initialize. "If the segment is occupied by more than MaxOccupationForCompaction, it's not worth compacting it, whatever the rest of the system looks like. MaxOccupationForCompaction is included in [0;16rFFFF]." MaxOccupationForCompaction := 16rD000. "81%" + + "a wild guesses" + MinObjectToFree := 1000. + InitialMaxObjectsToFree := 100000! - MaxObjectsToFree := 100000! Item was added: + ----- Method: SpurIncrementalCompactingSweeper>>calculateNextMaxObjectToFreeBasedOn: (in category 'sweep and compact') ----- + calculateNextMaxObjectToFreeBasedOn: runTime + + ^ (maxObjectsToFree / (runTime asFloat / 5000)) max: MinObjectToFree! Item was changed: ----- Method: SpurIncrementalCompactingSweeper>>cautiousBulkFreeChunkFrom: (in category 'incremental sweeping') ----- 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."]. 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]]). "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]] - (self canUseAsFreeSpace: next) and: [currentsCycleSeenObjectCount < MaxObjectsToFree]] whileTrue: [currentObj := next]. ^ manager addFreeChunkWithBytes: bytes at: start! Item was changed: ----- Method: SpurIncrementalCompactingSweeper>>compactSegment:freeStart:segIndex: (in category 'incremental compact') ----- 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. + currentsCycleSeenObjectCount := currentsCycleSeenObjectCount + 1. "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: [ (manager isMarked: entity) ifTrue: [manager makeWhite: entity. "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 would: fillStart + bytesToCopy overflowSegment: segmentToFill) ifFalse: [ self handleWouldBeCompactionOverflow: entity in: segInfo. ^ fillStart]. + + "let's make copying more expensive. Number is just a guess" + currentsCycleSeenObjectCount := currentsCycleSeenObjectCount + 100. - self migrate: entity sized: bytesToCopy to: fillStart. fillStart := fillStart + bytesToCopy. self assert: (self oop: fillStart isLessThan: (segmentToFill segLimit - manager bridgeSize))]] ifFalse: [self handleUnmarkedEntity: entity]]]. "we want to advance to the next segment from the bridge" currentObject := currentSegmentsBridge. ^ fillStart! Item was changed: ----- Method: SpurIncrementalCompactingSweeper>>doincrementalSweepAndCompact (in category 'sweep and compact') ----- doincrementalSweepAndCompact "Scan the heap for unmarked objects and free them. Coalescence " self assert: currentObject notNil. currentsCycleSeenObjectCount := 0. [self oop: currentObject isLessThan: manager endOfMemory] whileTrue: [ currentObject = currentSegmentsBridge ifTrue: [self advanceSegment] ifFalse: [self sweepOrCompactFromCurrentObject]. - (currentObject ~= currentSegmentsBridge and: [currentsCycleSeenObjectCount >= MaxObjectsToFree]) - ifTrue: [" | segInfo segIndex bytesAhead | - segIndex := (manager segmentIndexContainingObj: currentObject). - segInfo := manager segInfoAt: segIndex. - - bytesAhead := segInfo segSize - (currentObject - segInfo segStart). - - segIndex + 1 to: manager numSegments - do: [:index | | segment| - segment := manager segInfoAt: index. - bytesAhead := bytesAhead + segment segSize]." - - - - (coInterpreter ioUTCMicrosecondsNow - scStartTime) > 5000 - ifTrue: [^ false] - ifFalse: [currentsCycleSeenObjectCount := 0]]]. + "coInterpreter cr; + print: 'Arrived: '; + printNum: coInterpreter ioUTCMicrosecondsNow - scStartTime ; tab; + print: ' -> '; printNum: currentsCycleSeenObjectCount." + (currentObject ~= currentSegmentsBridge and: [currentsCycleSeenObjectCount >= maxObjectsToFree]) + ifTrue: [| runTime | + runTime := (coInterpreter ioUTCMicrosecondsNow - scStartTime). + runTime > 5000 + ifTrue: [ + maxObjectsToFree := self calculateNextMaxObjectToFreeBasedOn: runTime. + + coInterpreter cr; + print: 'Time in sweep and compact: '; + printNum: coInterpreter ioUTCMicrosecondsNow - scStartTime ; tab; + print: 'maxObjectsToFree now: '; printNum: maxObjectsToFree; tab; flush. + ^ false] + ifFalse: [ + maxObjectsToFree := self calculateNextMaxObjectToFreeBasedOn: runTime. + currentsCycleSeenObjectCount := 0]]]. + + coInterpreter cr; + print: 'Time in sweep and compact: '; + printNum: coInterpreter ioUTCMicrosecondsNow - scStartTime ; tab; flush. + - "set occupation for last segment" manager checkFreeSpace: GCModeIncremental. + manager heapMap clearLeakMapAndMapAccessibleObjects. + coInterpreter checkStackIntegrity. + ^ true! Item was changed: ----- Method: SpurIncrementalCompactingSweeper>>handleUnmarkedEntity: (in category 'compaction planning') ----- handleUnmarkedEntity: entity (manager isRemembered: entity) ifTrue: [self assert: (manager isFreeObject: entity) not. scavenger forgetObject: entity]. "To avoid confusing too much Spur (especially the leak/free checks), we don't make the dead object a free chunk, but make it a non pointer object to avoid the leak checker to try to follow the pointers of the dead object. Should we abort compacting this segment the object will get kept alife for one gc cycle" + manager set: entity classIndexTo: manager wordSizeClassIndexPun formatTo: manager wordIndexableFormat. + + currentsCycleSeenObjectCount := currentsCycleSeenObjectCount + 1.! - manager set: entity classIndexTo: manager wordSizeClassIndexPun formatTo: manager wordIndexableFormat! Item was changed: ----- Method: SpurIncrementalCompactingSweeper>>incrementalSweepAndCompact (in category 'api') ----- incrementalSweepAndCompact scStartTime := coInterpreter ioUTCMicrosecondsNow. self initIfNecessary. "should in between sweeper calls segments be removed the index would not be correct anymore. Reset it here so we can be sure it is correct" currentSegmentsIndex := manager segmentManager segmentIndexContainingObj: currentObject. "if the bridge between segments was small before and the segment directly after the current one was removed the position of the bridge moved. Update the current position to avoid this case" currentSegmentsBridge := manager segmentManager bridgeAt: currentSegmentsIndex. + " so expensive :( + self assert: manager validObjectColors." - self assert: manager validObjectColors. + coInterpreter cr; + print: 'Starting up '; + printNum: coInterpreter ioUTCMicrosecondsNow - scStartTime ; tab. + self doincrementalSweepAndCompact ifTrue: [self finishSweepAndCompact. ^ true]. "do not end on a bridge!! If a segment behind the current one currentObject is removed the size of the bridge can change from 8 bytes to 16 bytes and therefore invalidating currentObject that is now pointing to the overflow header instad of the bridges body. To not hove to implement some finicky update mechanism in the removal of segments just make sure we never reference the bridge before giving back the control to the mutator" self assert: (manager isSegmentBridge: currentObject) not. "skip empty segments. There is no work for us to do + they can be removed. As currentObject is always in the current segment it won't be valid anymore" self assert: (manager segmentManager isEmptySegment: self currentSegment) not. coInterpreter cr; print: 'current position: '; printHex: currentObject; tab; flush. ^ false! Item was changed: ----- Method: SpurIncrementalCompactingSweeper>>initialize (in category 'initialize-release') ----- initialize isCurrentlyWorking := false. currentSegmentsIndex := 0. currentsCycleSeenObjectCount := 0. currentSegmentsBridge := nil. currentObject := nil. segmentToFill := nil. shouldCompact := false. + currentCopyToPointer := nil. + maxObjectsToFree := MaxObjectsToFree! - currentCopyToPointer := nil! Item was changed: + ----- Method: SpurIncrementalCompactingSweeper>>isMobile: (in category 'testing') ----- - ----- Method: SpurIncrementalCompactingSweeper>>isMobile: (in category 'as yet unclassified') ----- isMobile: obj <inline: true> self flag: #Todo. "investigate this one here" ^ (manager isPinned: obj) not! Item was changed: ----- Method: SpurIncrementalCompactingSweeper>>setFreeChunkOfCompactedIntoSegment (in category 'incremental compact') ----- setFreeChunkOfCompactedIntoSegment shouldCompact ifFalse: [^ self]. self assert: segmentToFill notNil. self assert: (self oop: currentCopyToPointer isLessThan: (segmentToFill segLimit - manager bridgeSize)). + coInterpreter cr; + print: 'after compaction freeing from: '; printHex: currentCopyToPointer; + print: ' to: '; printHex: segmentToFill segSize - manager bridgeSize + segmentToFill segStart - currentCopyToPointer ; + tab; flush. + manager addFreeChunkWithBytes: segmentToFill segSize - manager bridgeSize + segmentToFill segStart - currentCopyToPointer at: currentCopyToPointer. "we have compacted into segmentToFill. It is now not empty anymore and we need to look for a new one" segmentToFill := nil ! Item was changed: + ----- Method: SpurIncrementalCompactingSweeper>>setInitialSweepingEntity (in category 'incremental sweeping') ----- - ----- Method: SpurIncrementalCompactingSweeper>>setInitialSweepingEntity (in category 'as yet unclassified') ----- setInitialSweepingEntity currentObject := manager firstObject! Item was changed: + ----- Method: SpurIncrementalCompactingSweeper>>sizeClaimedIn: (in category 'segment access') ----- - ----- Method: SpurIncrementalCompactingSweeper>>sizeClaimedIn: (in category 'as yet unclassified') ----- sizeClaimedIn: segment <var: 'segment' type: #'SpurSegmentInfo *'> ^ segment lastFreeObject! Item was changed: ----- Method: SpurIncrementalCompactingSweeper>>sweepOrCompactFromCurrentObject (in category 'sweep and compact') ----- sweepOrCompactFromCurrentObject self shouldCompactCurrentSegment ifTrue: [self doIncrementalCompact. "either we finished compacting the segment or we had to abort compaction as the segment to fill cannot take more objects from this segment. We have to continue sweeping. This is done by unmarking the current segment as beeing compacted and making sure the last object we nearly copied before (and we know was alive after marking) is kept alive for sweeping" self assert: ((manager isSegmentBridge: currentObject) + or: [(manager isMarked: currentObject) + and: [(self isSegmentAtIndexBeingCompacted: currentSegmentsIndex) not]])] - or: [(manager isMarked: currentObject) and: [(self isSegmentAtIndexBeingCompacted: currentSegmentsIndex) not]]). - - (coInterpreter ioUTCMicrosecondsNow - scStartTime) > 5000 - ifTrue: ["we just compacted a whole segment. Maybe this took a long time therefore set currentsCycleSeenObjectCount to max to force a check in doincrementalSweepAndCompact" - currentsCycleSeenObjectCount := MaxObjectsToFree]] ifFalse: [self doIncrementalSweep. currentObject := self nextCurrentObject] ! Item was changed: SpurGarbageCollector subclass: #SpurIncrementalGarbageCollector + instanceVariableNames: 'phase allAtOnceMarker checkSetGCFlags stopTheWorldGC' - instanceVariableNames: 'phase allAtOnceMarker checkSetGCFlags' classVariableNames: 'InCompactingPhase InMarkingPhase InSweepingPhase' poolDictionaries: '' category: 'VMMaker-SpurGarbageCollector'! !SpurIncrementalGarbageCollector commentStamp: 'WoC 1/5/2023 21:36' prior: 0! A SpurIncrementalGarbageCollector is a garbage collection algorithm. The GC is a mark and sweep with an additional compaction if certain conditions are fulfilled. This class manages SpurIncrementalMarker and SpurIncrementalSweepAndCompact (which in turn manages SpurIncrementalCompactor and SpurIncrementalSweeper). The 3 classes implementing the GC are therefore SpurIncrementalMarker, SpurIncrementalSweeper and SpurIncrementalCompactor. Instance Variables allAtOnceMarker: <SpurAllAtOnceMarker> checkSetGCFlags: <Bool> phase: <Number (InMarkingPhase|InSweepingPhase|InCompactingPhase)> allAtOnceMarker - an instance of SpurAllAtOnceMarker. We sometimes need parts of the old (stop-the-world) gc algorithm. This is the marking algorithm we can use through static polymorphism checkSetGCFlags - should we check if it ok to set gc flags or not phase - in which phase is the gc algorithm at the moment. Is either InMarkingPhase, InSweepingPhase or InCompactingPhase ! 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 + staticallyResolvedPolymorphicReceiver: 'allAtOnceMarker' to: SpurAllAtOnceMarker in: self; + staticallyResolvedPolymorphicReceiver: 'stopTheWorldGC' to: SpurStopTheWorldGarbageCollector in: self. - staticallyResolvedPolymorphicReceiver: 'allAtOnceMarker' to: SpurAllAtOnceMarker in: self. SpurMemoryManager gcClass = self ifTrue: [ self declareRecursivePolymorphismMappingForIncrementalClasses: aCCodeGenerator. "just important when doiing incremental compaction, therefore doin it here" aCCodeGenerator forRecursivePolymorphismResolve: SpurAllAtOnceMarker as: SpurStopTheWorldGarbageCollector; forRecursivePolymorphismResolve: SpurPlanningCompactor as: SpurStopTheWorldGarbageCollector]. ! Item was added: + ----- Method: SpurIncrementalGarbageCollector>>coInterpreter: (in category 'accessing') ----- + coInterpreter: anObject + + <doNotGenerate> + coInterpreter := anObject. + allAtOnceMarker coInterpreter: anObject! Item was added: + ----- Method: SpurIncrementalGarbageCollector>>doScavengeWithoutIncrementalCollect: (in category 'scavenge') ----- + doScavengeWithoutIncrementalCollect: tenuringCriterion + + super doScavengeWithoutIncrementalCollect: tenuringCriterion. + + coInterpreter resolveForwardersInStackPages.! Item was added: + ----- Method: SpurIncrementalGarbageCollector>>gcForSnapshot (in category 'as yet unclassified') ----- + gcForSnapshot + + self finishGCPass. + coInterpreter cr; print: 'finished incremental gc pass'; tab; flush. + + stopTheWorldGC fullGC. + coInterpreter cr; print: 'finished stop the world gc'; tab; flush. + ! Item was changed: ----- Method: SpurIncrementalGarbageCollector>>initialize (in category 'initialize-release') ----- initialize super initialize. checkSetGCFlags := true. phase := InMarkingPhase. + allAtOnceMarker := SpurAllAtOnceMarker new. + stopTheWorldGC := SpurStopTheWorldGarbageCollector new. + + stopTheWorldGC marker: allAtOnceMarker. + stopTheWorldGC compactor: SpurPlanningCompactor new! - allAtOnceMarker := SpurAllAtOnceMarker new! Item was added: + ----- Method: SpurIncrementalGarbageCollector>>isInSegmentToFill: (in category 'as yet unclassified') ----- + isInSegmentToFill: objOop + + ^ compactor segmentToFill notNil and: [manager segmentManager is: objOop inSegment: compactor segmentToFill]! Item was changed: ----- Method: SpurIncrementalGarbageCollector>>isOkToClearReference: (in category 'testing') ----- isOkToClearReference: objOop + "when using incremental GC if an object is dead is only possible to determine in a small time window (in sweeping for objects behind the sweepers position). During marking the information is not complete and in compaction the mark bits are already cleared. For simplicity, forbid clearing them. - "when using incremental GC if an object is life is only possible to determine in a small time window (in sweeping for objects behind the sweepers position). During marking the information is not complete and in compaction the mark bits are already cleared. For simlicity, forbid clearing them. Now only at the end of marking weak references and ephermerons get cleared (in old and young space)" ^ (manager isOldObject: objOop) not! Item was added: + ----- Method: SpurIncrementalGarbageCollector>>manager: (in category 'accessing') ----- + manager: anObject + + <doNotGenerate> + manager := anObject. + allAtOnceMarker manager: anObject ! Item was added: + ----- Method: SpurIncrementalGarbageCollector>>numSegmentsAboutToBeFreed (in category 'as yet unclassified') ----- + numSegmentsAboutToBeFreed + + | result | + result := 0. + + "start at 1 as segment 0 never gets compacted by design" + 1 to: manager numSegments - 1 + do: [:index | + (compactor isSegmentBeingCompacted: (manager segInfoAt: index)) + ifTrue: [result := result + 1]]. + + ^ result! Item was changed: ----- Method: SpurIncrementalGarbageCollector>>sufficientSpaceAfterGC: (in category 'as yet unclassified') ----- sufficientSpaceAfterGC: numBytes | heapSizePostGC | self assert: numBytes = 0. self scavengingGCTenuringIf: TenureByAge. heapSizePostGC := manager segmentManager totalOldSpaceCapacity - manager totalFreeOldSpace. (heapSizePostGC - manager heapSizeAtPreviousGC) asFloat / manager heapSizeAtPreviousGC >= manager heapGrowthToSizeGCRatio ifTrue: ["self fullGC"] "fullGC will attempt to shrink" ifFalse: "Also attempt to shrink if there is plenty of free space and no need to GC" [manager totalFreeOldSpace > (manager shrinkThreshold * 2) ifTrue: [manager attemptToShrink. ^true]]. + + self flag: #Todo. "we probably want here something more sophisticated, like tak into account how many + objects survived tenuring in the near past and how much work is still to be done until marking is finished + and the segments get freed. Until then just assume the compacted segments get freed soon enough" + [self numSegmentsAboutToBeFreed = 0 "lets wait until we get more space" + and: [manager totalFreeOldSpace < manager growHeadroom + and: [(manager growOldSpaceByAtLeast: 0) notNil]]] whileTrue: - [manager totalFreeOldSpace < manager growHeadroom - and: [(manager growOldSpaceByAtLeast: 0) notNil]] whileTrue: [manager totalFreeOldSpace >= manager growHeadroom ifTrue: [^true]]. manager lowSpaceThreshold > manager totalFreeOldSpace ifTrue: "space is low" [manager lowSpaceThreshold: 0. "avoid signalling low space twice" ^false]. ^true! Item was changed: ----- 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 flag: #Todo. "do I need the immediate check?" + (self isMarking and: [(manager isImmediate: value) not and: [(manager isOldObject: anObject) and: [(manager isOldObject: value) and: [manager isMarked: anObject]]]]) - (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 removed: - SpurIncrementalGarbageCollector subclass: #SpurIncrementalGarbageCollectorSimulator - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'VMMaker-SpurGarbageCollectorSimulation'! Item was removed: - ----- Method: SpurIncrementalGarbageCollectorSimulator>>doIncrementalCollect (in category 'as yet unclassified') ----- - doIncrementalCollect - - | context | - manager statScavenges \\ 50 = 0 ifTrue: [GCEventLog reset]. - "(manager statScavenges > 218 and: [phase = InSweepingPhase]) ifTrue: [self halt]." - "manager statScavenges = 320 ifTrue: [self halt]." - - "pop mutator context" - context := GCEventLog instance popContext. - self assert: (context kind = #mutator or: [context kind = #fullGC]). - super doIncrementalCollect. - - context kind = #fullGC - ifTrue: [GCEventLog instance pushContext: context] - ifFalse: [GCEventLog instance pushMutatorContext] - ! Item was removed: - ----- Method: SpurIncrementalGarbageCollectorSimulator>>fullGC (in category 'global') ----- - fullGC - - GCEventLog - inContext: #fullGC - do: [super fullGC]! Item was removed: - ----- Method: SpurIncrementalGarbageCollectorSimulator>>initialize (in category 'initialize-release') ----- - initialize - - super initialize. - GCEventLog reset! Item was removed: - ----- Method: SpurIncrementalGarbageCollectorSimulator>>manager: (in category 'accessing') ----- - manager: manager - - super manager: manager. - GCEventLog instance manager: manager! Item was removed: - SpurIncrementalMarker subclass: #SpurIncrementalMarkerSimulator - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'VMMaker-SpurGarbageCollectorSimulation'! Item was removed: - ----- Method: SpurIncrementalMarkerSimulator>>blackenObject: (in category 'as yet unclassified') ----- - blackenObject: obj - - ^ GCEventLog - register: (GCBlackenEvent address: obj) - expecting: {[:evt | (evt isKindOf: GCUngreyEvent) and: [evt address = obj]]. - [:evt | (evt isKindOf: GCMarkEvent) and: [evt address = obj]]} - doing: [super blackenObject: obj]! Item was removed: - ----- Method: SpurIncrementalMarkerSimulator>>finishMarking (in category 'as yet unclassified') ----- - finishMarking - - ^ GCEventLog - inContext: #finishMarking - do: [super finishMarking]! Item was removed: - ----- Method: SpurIncrementalMarkerSimulator>>incrementalMark (in category 'marking - incremental') ----- - incrementalMark - - ^ GCEventLog - inContext: #IncrementalMark - do: [super incrementalMark]! Item was removed: - ----- Method: SpurIncrementalMarkerSimulator>>incrementalMarkObjects (in category 'marking - incremental') ----- - incrementalMarkObjects - - ^ GCEventLog - inContext: #marking - do: [super incrementalMarkObjects]! Item was removed: - ----- Method: SpurIncrementalMarkerSimulator>>initForNewMarkingPassIfNecessary (in category 'marking-initialization') ----- - initForNewMarkingPassIfNecessary - - ^ GCEventLog - inContext: #markingInit - do: [super initForNewMarkingPassIfNecessary]! Item was removed: - ----- Method: SpurIncrementalMarkerSimulator>>pushAllRootsOnMarkStack (in category 'root-scanning') ----- - pushAllRootsOnMarkStack - - GCEventLog - inContext: #rootScanning - do: [super pushAllRootsOnMarkStack] ! Item was removed: - ----- Method: SpurIncrementalMarkerSimulator>>pushExtraRootsReferencesOnMarkingStack (in category 'root-scanning') ----- - pushExtraRootsReferencesOnMarkingStack - - GCEventLog - inContext: #extraRootScanning - do: [super pushExtraRootsReferencesOnMarkingStack] ! Item was removed: - ----- Method: SpurIncrementalMarkerSimulator>>pushHiddenRootsReferencesOnMarkingStack (in category 'root-scanning') ----- - pushHiddenRootsReferencesOnMarkingStack - - GCEventLog - inContext: #hiddenRootScanning - do: [super pushHiddenRootsReferencesOnMarkingStack] ! Item was removed: - ----- Method: SpurIncrementalMarkerSimulator>>pushNewSpaceReferencesOnMarkingStack (in category 'root-scanning') ----- - pushNewSpaceReferencesOnMarkingStack - - GCEventLog - inContext: #newSpaceScanning - do: [super pushNewSpaceReferencesOnMarkingStack]! Item was removed: - ----- Method: SpurIncrementalMarkerSimulator>>pushOnMarkingStackAndMakeGrey: (in category 'marking-stack') ----- - pushOnMarkingStackAndMakeGrey: obj - - super pushOnMarkingStackAndMakeGrey: obj - ! Item was removed: - ----- Method: SpurIncrementalMarkerSimulator>>pushStackReferencesOnMarkingStack (in category 'root-scanning') ----- - pushStackReferencesOnMarkingStack - - GCEventLog - inContext: #stackScanning - do: [super pushStackReferencesOnMarkingStack]! Item was changed: + ----- Method: SpurIncrementalSweepAndCompact>>biasForSnapshot (in category 'api') ----- - ----- Method: SpurIncrementalSweepAndCompact>>biasForSnapshot (in category 'as yet unclassified') ----- biasForSnapshot! Item was added: + ----- Method: SpurIncrementalSweepAndCompact>>isCurrentlyCompacting (in category 'as yet unclassified') ----- + isCurrentlyCompacting + + <doNotGenerate> + ^ compactor isCurrentlyCompacting! Item was added: + ----- Method: SpurIncrementalSweepAndCompact>>isSegmentBeingCompacted: (in category 'as yet unclassified') ----- + isSegmentBeingCompacted: segInfo + + <doNotGenerate> + ^ compactor isSegmentBeingCompacted: segInfo ! Item was changed: + ----- Method: SpurIncrementalSweepAndCompact>>manager: (in category 'initialization') ----- - ----- Method: SpurIncrementalSweepAndCompact>>manager: (in category 'as yet unclassified') ----- manager: manager <doNotGenerate> super manager: manager. sweeper manager: manager. compactor manager: manager! Item was removed: - SpurIncrementalSweepAndCompact subclass: #SpurIncrementalSweepAndCompactSimulator - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'VMMaker-SpurGarbageCollectorSimulation'! Item was removed: - ----- Method: SpurIncrementalSweepAndCompactSimulator>>incrementalCompact (in category 'api - incremental') ----- - incrementalCompact - - ^ GCEventLog - inContext: #compact - do: [super incrementalCompact] - ! Item was removed: - ----- Method: SpurIncrementalSweepAndCompactSimulator>>incrementalSweep (in category 'api - incremental') ----- - incrementalSweep - - ^ GCEventLog - inContext: #sweep - do: [super incrementalSweep] - ! Item was removed: - SpurIncrementalSweeper subclass: #SpurIncrementalSweeperSimulator - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'VMMaker-SpurGarbageCollectorSimulation'! Item was removed: - ----- Method: SpurIncrementalSweeperSimulator>>canUseAsFreeSpace: (in category 'as yet unclassified') ----- - canUseAsFreeSpace: objOop - - "objOop = 16r25FDBD8 ifTrue: [self halt]." - ^ super canUseAsFreeSpace: objOop! Item was removed: - ----- Method: SpurIncrementalSweeperSimulator>>doIncrementalSweeping (in category 'api - incremental') ----- - doIncrementalSweeping - - ^ GCEventLog - inContext: #doIncrementalSweep - do: [super doIncrementalSweeping]! Item was removed: - ----- Method: SpurIncrementalSweeperSimulator>>finishSweeping (in category 'as yet unclassified') ----- - finishSweeping - - ^ GCEventLog - inContext: #finishSweeping - do: [super finishSweeping]! Item was removed: - ----- Method: SpurIncrementalSweeperSimulator>>incrementalSweep (in category 'api - incremental') ----- - incrementalSweep - - ^ GCEventLog - inContext: #incrementalSweep - do: [super incrementalSweep]! Item was removed: - ----- Method: SpurIncrementalSweeperSimulator>>initIfNecessary (in category 'api - incremental') ----- - initIfNecessary - - ^ GCEventLog - inContext: #sweepInit - do: [super initIfNecessary]! Item was removed: - ----- Method: SpurIncrementalSweeperSimulator>>unmark: (in category 'api') ----- - unmark: objOop - - super unmark: objOop - "^ GCEventLog - register: (GCWhitenEvent address: objOop) - expecting: { - [:evt | evt = (GCUnmarkEvent address: objOop)]. - [:evt | evt = (GCUngreyEvent address: objOop)]} - doing: [super unmark: objOop]"! Item was changed: ----- Method: SpurMemoryManager class>>isNonArgumentImplicitReceiverVariableName: (in category 'translation') ----- isNonArgumentImplicitReceiverVariableName: aString + ^#('self' 'coInterpreter' 'manager' 'scavenger' 'segmentManager' 'compactor' 'planningCompactor' 'selectiveCompactor' 'heapMap' 'marker' 'sweeper' 'gc' 'allAtOnceMarker' 'stopTheWorldGC') includes: aString! - ^#('self' 'coInterpreter' 'manager' 'scavenger' 'segmentManager' 'compactor' 'planningCompactor' 'selectiveCompactor' 'heapMap' 'marker' 'sweeper' 'gc' 'allAtOnceMarker') includes: aString! Item was changed: ----- Method: SpurMemoryManager>>checkHeapFreeSpaceIntegrityForIncrementalGC (in category 'debug support') ----- checkHeapFreeSpaceIntegrityForIncrementalGC "Perform an integrity/leak check using the heapMap. Assume clearLeakMapAndMapAccessibleFreeSpace has set a bit at each free chunk's header. Scan all objects in the heap checking that no pointer points to a free chunk and that all free chunks that refer to others refer to marked chunks. Answer if all checks pass. Ignore unmarked objects during sweeping" | ok total | <inline: false> <var: 'total' type: #usqInt> ok := true. total := 0. 0 to: self numFreeLists - 1 do: [:i| (freeLists at: i) ~= 0 ifTrue: [(heapMap heapMapAtWord: (self pointerForOop: (freeLists at: i))) = 0 ifTrue: [coInterpreter print: 'leak in free list '; printNum: i; print: ' to non-free '; printHex: (freeLists at: i); eekcr. ok := false]]]. "Excuse the duplication but performance is at a premium and we avoid some tests by splitting the newSpace and oldSpace enumerations." self allNewSpaceEntitiesDo: [:obj| | fieldOop | (self isFreeObject: obj) ifTrue: [coInterpreter print: 'young object '; printHex: obj; print: ' is free'; eekcr. ok := false] ifFalse: [obj ~= freeSpaceCheckOopToIgnore ifTrue: + [0 to: (self numPointerSlotsOf: (self followMaybeForwarded: obj)) - 1 do: - [0 to: (self numPointerSlotsOf: obj) - 1 do: [:fi| fieldOop := self fetchPointer: fi ofObject: obj. (self isNonImmediate: fieldOop) ifTrue: [(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) ~= 0 ifTrue: [coInterpreter print: 'object leak in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; print: ' is free'; eekcr. ok := false]]]]]]. self allOldSpaceEntitiesDo: [:obj| | fieldOop | (self isFreeObject: obj) ifTrue: [ + (gc isInSegmentToFill: obj) not - (compactor compactor segmentToFill isNil or: [(self objectStartingAt: (compactor compactor segmentToFill segStart)) ~= obj]) ifTrue: [ (heapMap heapMapAtWord: (self pointerForOop: obj)) = 0 ifTrue: [coInterpreter print: 'leak in free chunk '; printHex: obj; print: ' is unmapped?!! '; eekcr. ok := false]. fieldOop := self fetchPointer: self freeChunkNextIndex ofFreeChunk: obj. (fieldOop ~= 0 and: [(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0]) ifTrue: [coInterpreter print: 'leak in free chunk '; printHex: obj; print: ' @ 0 = '; printHex: fieldOop; print: ' is unmapped'; eekcr. ok := false]. (self isLilliputianSize: (self bytesInBody: obj)) ifFalse: [fieldOop := self fetchPointer: self freeChunkPrevIndex ofFreeChunk: obj. (fieldOop ~= 0 and: [(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0]) ifTrue: [coInterpreter print: 'leak in free chunk '; printHex: obj; print: ' @ 0 = '; printHex: fieldOop; print: ' is unmapped'; eekcr. ok := false]]. (self isLargeFreeObject: obj) ifTrue: [self freeChunkParentIndex to: self freeChunkLargerIndex do: [:fi| fieldOop := self fetchPointer: fi ofFreeChunk: obj. (fieldOop ~= 0 and: [(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0]) ifTrue: [coInterpreter print: 'leak in free chunk '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; print: ' is unmapped'; eekcr. ok := false]]]. total := total + (self bytesInBody: obj)]] ifFalse: [(obj ~= freeSpaceCheckOopToIgnore and: "during sweeping ignore unmarked objects behind the current sweeping position" [(gc inSweepingAheadOfSweepersPosition: obj) not or: [self isMarked: obj]]) ifTrue: [0 to: (self numPointerSlotsOf: obj) - 1 do: [:fi| (self isForwarded: obj) ifTrue: [self assert: fi = 0. "I'm now trying to use forwarders in GC algorithms..." fieldOop := self fetchPointer: fi ofMaybeForwardedObject: obj] ifFalse: "We keep #fetchPointer:ofObject: API here for assertions" [fieldOop := self fetchPointer: fi ofObject: obj]. (self isNonImmediate: fieldOop) ifTrue: [(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) ~= 0 ifTrue: [coInterpreter print: 'object leak in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; print: ' is free'; eekcr. ok := false]]]]]]. total - totalFreeOldSpace ~= 0 ifTrue: [coInterpreter print: 'incorrect totalFreeOldSpace; expected '; printNum: totalFreeOldSpace; print: ' found '; printNum: total; eekcr. ok := false]. ^ok! Item was changed: ----- Method: SpurMemoryManager>>checkHeapFreeSpaceIntegrityForStopTheWorldGC (in category 'debug support') ----- checkHeapFreeSpaceIntegrityForStopTheWorldGC "Perform an integrity/leak check using the heapMap. Assume clearLeakMapAndMapAccessibleFreeSpace has set a bit at each free chunk's header. Scan all objects in the heap checking that no pointer points to a free chunk and that all free chunks that refer to others refer to marked chunks. Answer if all checks pass." | ok total | <inline: false> <var: 'total' type: #usqInt> ok := true. total := 0. 0 to: self numFreeLists - 1 do: [:i| (freeLists at: i) ~= 0 ifTrue: [(heapMap heapMapAtWord: (self pointerForOop: (freeLists at: i))) = 0 ifTrue: [coInterpreter print: 'leak in free list '; printNum: i; print: ' to non-free '; printHex: (freeLists at: i); eekcr. ok := false]]]. "Excuse the duplication but performance is at a premium and we avoid some tests by splitting the newSpace and oldSpace enumerations." self allNewSpaceEntitiesDo: [:obj| | fieldOop | (self isFreeObject: obj) ifTrue: [coInterpreter print: 'young object '; printHex: obj; print: ' is free'; eekcr. ok := false] ifFalse: [obj ~= freeSpaceCheckOopToIgnore ifTrue: [0 to: (self numPointerSlotsOf: obj) - 1 do: [:fi| fieldOop := self fetchPointer: fi ofObject: obj. (self isNonImmediate: fieldOop) ifTrue: [(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) ~= 0 ifTrue: [coInterpreter print: 'object leak in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; print: ' is free'; eekcr. ok := false]]]]]]. self allOldSpaceEntitiesDo: [:obj| | fieldOop | (self isFreeObject: obj) ifTrue: [ + (gc isInSegmentToFill: obj) not - (compactor compactor segmentToFill isNil or: [(self objectStartingAt: (compactor compactor segmentToFill segStart)) ~= obj]) ifTrue: [ (heapMap heapMapAtWord: (self pointerForOop: obj)) = 0 ifTrue: [coInterpreter print: 'leak in free chunk '; printHex: obj; print: ' is unmapped?!! '; eekcr. ok := false]. fieldOop := self fetchPointer: self freeChunkNextIndex ofFreeChunk: obj. (fieldOop ~= 0 and: [(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0]) ifTrue: [coInterpreter print: 'leak in free chunk '; printHex: obj; print: ' @ 0 = '; printHex: fieldOop; print: ' is unmapped'; eekcr. ok := false]. (self isLilliputianSize: (self bytesInBody: obj)) ifFalse: [fieldOop := self fetchPointer: self freeChunkPrevIndex ofFreeChunk: obj. (fieldOop ~= 0 and: [(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0]) ifTrue: [coInterpreter print: 'leak in free chunk '; printHex: obj; print: ' @ 0 = '; printHex: fieldOop; print: ' is unmapped'; eekcr. ok := false]]. (self isLargeFreeObject: obj) ifTrue: [self freeChunkParentIndex to: self freeChunkLargerIndex do: [:fi| fieldOop := self fetchPointer: fi ofFreeChunk: obj. (fieldOop ~= 0 and: [(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0]) ifTrue: [coInterpreter print: 'leak in free chunk '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; print: ' is unmapped'; eekcr. ok := false]]]. total := total + (self bytesInBody: obj)]] ifFalse: [obj ~= freeSpaceCheckOopToIgnore ifTrue: [0 to: (self numPointerSlotsOf: obj) - 1 do: [:fi| (self isForwarded: obj) ifTrue: [self assert: fi = 0. "I'm now trying to use forwarders in GC algorithms..." fieldOop := self fetchPointer: fi ofMaybeForwardedObject: obj] ifFalse: "We keep #fetchPointer:ofObject: API here for assertions" [fieldOop := self fetchPointer: fi ofObject: obj]. (self isNonImmediate: fieldOop) ifTrue: [(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) ~= 0 ifTrue: [coInterpreter print: 'object leak in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; print: ' is free'; eekcr. ok := false]]]]]]. total - totalFreeOldSpace ~= 0 ifTrue: [coInterpreter print: 'incorrect totalFreeOldSpace; expected '; printNum: totalFreeOldSpace; print: ' found '; printNum: total; eekcr. ok := false]. ^ok! Item was changed: ----- Method: SpurMemoryManager>>checkHeapIntegrity:classIndicesShouldBeValid: (in category 'debug support') ----- (excessive size, no diff calculated) Item was added: + ----- Method: SpurMemoryManager>>clearLeakMapAndMapInSweepingLifeOrYoungObjects (in category 'debug support - leak/mark map') ----- + clearLeakMapAndMapInSweepingLifeOrYoungObjects + "Perform an integrity/leak check using the heapMap. Set a bit at each object's header." + <inline: false> + heapMap clearHeapMap. + self allObjectsDo: + [:oop|( (self isMarked: oop) or: [(self isYoung: oop) or: [oop < gc compactor currentObject]]) ifTrue: [heapMap heapMapAtWord: (self pointerForOop: oop) Put: 1]]! Item was added: + ----- Method: SpurMemoryManager>>clearLeakMapAndMapMarkedObjects (in category 'debug support - leak/mark map') ----- + clearLeakMapAndMapMarkedObjects + "Perform an integrity/leak check using the heapMap. Set a bit at each object's header." + <inline: false> + heapMap clearHeapMap. + self allObjectsDo: + [:oop| (self isMarked: oop) ifTrue: [heapMap heapMapAtWord: (self pointerForOop: oop) Put: 1]]! Item was added: + ----- Method: SpurMemoryManager>>clearLeakMapAndMapMarkedOrYoungObjects (in category 'debug support - leak/mark map') ----- + clearLeakMapAndMapMarkedOrYoungObjects + "Perform an integrity/leak check using the heapMap. Set a bit at each object's header." + <inline: false> + heapMap clearHeapMap. + self allObjectsDo: + [:oop|( (self isMarked: oop) or: [self isYoung: oop] )ifTrue: [heapMap heapMapAtWord: (self pointerForOop: oop) Put: 1]]! Item was changed: ----- Method: SpurMemoryManager>>garbageCollectForSnapshot (in category 'snapshot') ----- garbageCollectForSnapshot self flushNewSpace. "There is no place to put newSpace in the snapshot file." self flag: 'If we wanted to shrink the rememberedSet prior to snapshot this is the place to do it.'. compactor biasForSnapshot. + gc gcForSnapshot. - self fullGC. compactor biasForGC. segmentManager prepareForSnapshot. self checkFreeSpace: GCModeFull! Item was changed: ----- Method: SpurMemoryManager>>growOldSpaceByAtLeast: (in category 'growing/shrinking memory') ----- growOldSpaceByAtLeast: minAmmount "Attempt to grow memory by at least minAmmount. Answer the size of the new segment, or nil if the attempt failed." | ammount headroom total start interval | <var: #segInfo type: #'SpurSegmentInfo *'> "statGrowMemory counts attempts, not successes." + + "self debugger." statGrowMemory := statGrowMemory + 1."we need to include overhead for a new object header plus the segment bridge." ammount := minAmmount + (self baseHeaderSize * 2 + self bridgeSize). "round up to the nearest power of two." ammount := 1 << (ammount - 1) highBit. "and grow by at least growHeadroom." ammount := ammount max: growHeadroom. "Now apply the maxOldSpaceSize limit, if one is in effect." maxOldSpaceSize > 0 ifTrue: [total := segmentManager totalBytesInSegments. total >= maxOldSpaceSize ifTrue: [needGCFlag := true. ^nil]. headroom := maxOldSpaceSize - total. headroom < ammount ifTrue: [headroom < (minAmmount + (self baseHeaderSize * 2 + self bridgeSize)) ifTrue: [needGCFlag := true. ^nil]. ammount := headroom]]. start := coInterpreter ioUTCMicrosecondsNow. ^(segmentManager addSegmentOfSize: ammount) ifNil: [needGCFlag := true. nil] ifNotNil: [:segInfo| self assimilateNewSegment: segInfo. "and add the new free chunk to the free list; done here instead of in assimilateNewSegment: for the assert" self addFreeChunkWithBytes: segInfo segSize - self bridgeSize at: segInfo segStart. self assert: (self addressAfter: (self objectStartingAt: segInfo segStart)) = (segInfo segLimit - self bridgeSize). self checkFreeSpace: GCCheckFreeSpace. segmentManager checkSegments. interval := coInterpreter ioUTCMicrosecondsNow - start. interval > statMaxAllocSegmentTime ifTrue: [statMaxAllocSegmentTime := interval]. segInfo segSize]! Item was added: + ----- Method: SpurMemoryManager>>printFreeSpaceStatisticsWithUnmarkedAsFreeSpace (in category 'debug printing') ----- + printFreeSpaceStatisticsWithUnmarkedAsFreeSpace + + "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 objectCount | + segInfo := self segInfoAt: index. + bigFreeChunkMemory := 0. + freeSpace := 0. + occupiedSpace := 0. + objectCount := 0. + + + segmentManager + allEntitiesInSegment: segInfo + exceptTheLastBridgeDo: [:oop | | oopSize slotCount | + oopSize := self bytesInBody: oop. + slotCount := oopSize >> 3. + + (self isFreeOop: oop) + ifTrue: [ + freeSpace := freeSpace + oopSize. + + slotCount < 64 + ifTrue: [ + sizeCount at: slotCount put: ((sizeCount at: slotCount) + 1)] + ifFalse: [sizeCount at: 0 put: ((sizeCount at: 0) + 1). + bigFreeChunkMemory := bigFreeChunkMemory + oopSize]] + ifFalse: [objectCount := objectCount + 1. + occupiedSpace := occupiedSpace + oopSize]]. + + coInterpreter cr; + print: 'Segment '; + printNum: index; + print: ' (starting at: '; + printHex: segInfo segStart; tab; + print: 'max bytes: '; tab; + printNum: segInfo segSize; + print: ')'; + cr; cr; flush. + + coInterpreter cr; + print: 'Currently occupied space: '; tab; + printNum: occupiedSpace; tab; + print: 'From '; printNum: objectCount; print: ' objects'; 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 bytes: '; + 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: SpurMemoryManager>>printSegmentOccupationFromMarkedObjects (in category 'debug printing') ----- printSegmentOccupationFromMarkedObjects "used for debugging" <export: true> coInterpreter cr; print: '----------------------------------------- '; cr; print: '----------------------------------------- '; cr. 0 to: self numSegments -1 + do: [:index | | segInfo occupiedSpace objectCount | - do: [:index | | segInfo occupiedSpace | segInfo := self segInfoAt: index. occupiedSpace := 0. + objectCount := 0. segmentManager allEntitiesInSegment: segInfo exceptTheLastBridgeDo: [:oop | | oopSize | oopSize := self bytesInBody: oop. (self isFreeOop: oop) ifFalse: [ (self isMarked: oop) + ifTrue: [occupiedSpace := occupiedSpace + oopSize. + objectCount := objectCount + 1]]]. - ifTrue: [occupiedSpace := occupiedSpace + oopSize]]]. coInterpreter cr; print: 'Segment '; + printNum: index; tab; + printNum: objectCount; print: ' objects -> ' ; + printNum: occupiedSpace; print: ' bytes -> '; + printNum: (occupiedSpace asFloat / (segInfo segSize)) * 100; print: ' % occupation'; - printNum: index; - print: ' (starting at: '; - printHex: segInfo segStart; - print: ')'; - cr; flush. - - coInterpreter - print: 'Currently occupied space: '; tab; - printNum: occupiedSpace; tab; - print: 'Resulting in an occupation percentage of: '; tab; - printNum: (occupiedSpace asFloat / (segInfo segSize)) * 100; flush. ]. coInterpreter cr; cr; print: '----------------------------------------- '; cr; print: '----------------------------------------- '; cr. ! Item was changed: ----- Method: SpurMemoryManager>>validObjectColors (in category 'debug support') ----- validObjectColors | currentSweepingEntityT | currentSweepingEntityT := gc sweepersCurrentSweepingEntity 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: [ "for the 2 phase incremental gc. When we call this method while already having compacted some objects they are not marked anymore as we unmark them and do not sweep the segmentToFill" + (gc isInSegmentToFill: slot) not - (compactor segmentToFill notNil and: [(self segmentManager is: slot inSegment: compactor segmentToFill) 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 removed: - ----- Method: SpurPlanningCompactor>>segmentToFill (in category 'as yet unclassified') ----- - segmentToFill - - ^ nil! Item was changed: ----- Method: SpurSegmentManager>>collapseSegmentsPostSwizzle (in category 'snapshot') ----- collapseSegmentsPostSwizzle "The image has been loaded, old segments reconstructed, and the heap swizzled into a single contiguous segment. Collapse the segments into one." <inline: false> canSwizzle := false. self cCode: [] inSmalltalk: [segments ifNil: [self allocateOrExtendSegmentInfos]]. numSegments := 1. (segments at: 0) segStart: manager oldSpaceStart; segSize: (totalHeapSizeIncludingBridges := manager endOfMemory - manager oldSpaceStart). manager bootstrapping ifTrue: ["finally plant a bridge at the end of the coalesced segment and cut back the manager's notion of the end of memory to immediately before the bridge." self assert: manager endOfMemory = (segments at: 0) segLimit. manager initSegmentBridgeWithBytes: manager bridgeSize at: manager endOfMemory - manager bridgeSize]. self assert: (manager isSegmentBridge: (self bridgeAt: 0)). + self assert: (manager numSlotsOfAny: (self bridgeAt: 0)) = 1! - self assert: (manager numSlotsOfAny: (self bridgeAt: 0)) = 0! Item was changed: ----- Method: SpurSegmentManager>>isValidSegmentBridge: (in category 'testing') ----- isValidSegmentBridge: objOop "bridges bridge the gaps between segments. They are the last object in each segment." ^((manager addressCouldBeObj: objOop) or: [objOop = manager endOfMemory]) and: [(manager isSegmentBridge: objOop) and: [(manager hasOverflowHeader: objOop) + or: [(manager numSlotsOfAny: objOop) < 3]]]! - or: [(manager numSlotsOfAny: objOop) = 0]]]! Item was changed: ----- Method: SpurSegmentManager>>shrinkObjectMemory: (in category 'growing/shrinking memory') ----- shrinkObjectMemory: delta "Answer if any shrinkage was achieved." <inline: false> <var: #delta type: #usqInt> | shrinkage emptySeg | <var: #shrinkage type: #usqInt> <var: #emptySeg type: #'SpurSegmentInfo *'> manager checkFreeSpace: GCCheckFreeSpace. shrinkage := delta. [emptySeg := self findEmptySegNearestInSizeTo: shrinkage. (emptySeg isNil or: [emptySeg segSize > shrinkage]) ifTrue: [manager checkFreeSpace: GCCheckFreeSpace. ^shrinkage < delta]. shrinkage := shrinkage - emptySeg segSize. manager detachFreeObject: (manager objectStartingAt: emptySeg segStart). manager coInterpreter cr; print: 'remove segment starting: '; printHex: emptySeg segStart; print: ' to: '; printHex: emptySeg segStart + emptySeg segSize; tab; flush. + - - manager segmentToFill - ifNil: [manager coInterpreter cr; - print: 'segment to fill null '; tab; flush.] - ifNotNil: [manager coInterpreter cr; - print: 'segment to fill: '; - printHex: manager segmentToFill segStart; - print: ' to: '; - printHex: manager segmentToFill segStart + manager segmentToFill segSize; tab; flush.]. self removeSegment: emptySeg] repeat! Item was added: + ----- Method: SpurStopTheWorldGarbageCollector>>isInSegmentToFill: (in category 'as yet unclassified') ----- + isInSegmentToFill: objOop + + ^ false! Item was changed: ----- Method: StackInterpreter class>>declareCVarsIn: (in category 'translation') ----- declareCVarsIn: aCCodeGenerator | vmClass | self class == thisContext methodClass ifFalse: [^self]. "Don't duplicate decls in subclasses" vmClass := aCCodeGenerator vmClass. "Generate primitiveTable etc based on vmClass, not just StackInterpreter" aCCodeGenerator addHeaderFile: '<stdio.h> /* for printf */'; addHeaderFile: '<stdlib.h> /* for e.g. alloca */'; addHeaderFile: '<setjmp.h>'; addHeaderFile: '<wchar.h> /* for wint_t */'; addHeaderFile: '<signal.h>'; addHeaderFile: '"vmCallback.h"'; addHeaderFile: '"sqMemoryFence.h"'; addHeaderFile: '"sqImageFileAccess.h"'; addHeaderFile: '"sqSetjmpShim.h"'; addHeaderFile: '"dispdbg.h"'. LowcodeVM ifTrue: [aCCodeGenerator addHeaderFile: '"sqLowcodeFFI.h"']. vmClass declareInterpreterVersionIn: aCCodeGenerator defaultName: 'Stack'. aCCodeGenerator var: #interpreterProxy type: #'struct VirtualMachine*'. aCCodeGenerator declareVar: #sendTrace type: 'volatile int'; declareVar: #byteCount type: #usqLong. "see dispdbg.h" "These need to be pointers or unsigned." self declareC: #(instructionPointer method newMethod) as: #usqInt in: aCCodeGenerator. "These are all pointers; char * because Slang has no support for C pointer arithmetic." self declareC: #(localIP localSP localFP stackPointer framePointer stackLimit breakSelector) as: #'char *' in: aCCodeGenerator. aCCodeGenerator var: #breakSelectorLength declareC: 'sqInt breakSelectorLength = MinSmallInteger'. self declareC: #(stackPage overflowedPage) as: #'StackPage *' in: aCCodeGenerator. aCCodeGenerator var: #transcript type: #'FILE *'. aCCodeGenerator removeVariable: 'stackPages'. "this is an implicit receiver in the translated code." "This defines bytecodeSetSelector as 0 if MULTIPLEBYTECODESETS is not defined, for the benefit of the interpreter on slow machines." aCCodeGenerator addConstantForBinding: (self bindingOf: #MULTIPLEBYTECODESETS). MULTIPLEBYTECODESETS == false ifTrue: [aCCodeGenerator removeVariable: 'bytecodeSetSelector']. BytecodeSetHasExtensions == false ifTrue: [aCCodeGenerator removeVariable: 'extA'; removeVariable: 'extB']. aCCodeGenerator var: #methodCache declareC: 'sqIntptr_t methodCache[MethodCacheSize + 1 /* ', (MethodCacheSize + 1) printString, ' */]'. NewspeakVM ifTrue: [aCCodeGenerator var: #nsMethodCache declareC: 'sqIntptr_t nsMethodCache[NSMethodCacheSize + 1 /* ', (NSMethodCacheSize + 1) printString, ' */]'] ifFalse: [aCCodeGenerator removeVariable: #nsMethodCache; removeVariable: 'localAbsentReceiver'; removeVariable: 'localAbsentReceiverOrZero']. AtCacheTotalSize isInteger ifTrue: [aCCodeGenerator var: #atCache declareC: 'sqInt atCache[AtCacheTotalSize + 1 /* ', (AtCacheTotalSize + 1) printString, ' */]']. aCCodeGenerator var: #primitiveTable declareC: 'void (*primitiveTable[MaxPrimitiveIndex + 2 /* ', (MaxPrimitiveIndex + 2) printString, ' */])(void) = ', vmClass primitiveTableString. vmClass primitiveTable do: [:symbolOrNot| (symbolOrNot isSymbol and: [symbolOrNot ~~ #primitiveFail]) ifTrue: [(aCCodeGenerator methodNamed: symbolOrNot) ifNotNil: [:tMethod| tMethod returnType: #void]]]. vmClass objectMemoryClass hasSpurMemoryManagerAPI ifTrue: [aCCodeGenerator var: #primitiveAccessorDepthTable type: 'signed char' sizeString: 'MaxPrimitiveIndex + 2 /* ', (MaxPrimitiveIndex + 2) printString, ' */' array: (vmClass primitiveAccessorDepthTableUsing: aCCodeGenerator). aCCodeGenerator removeConstant: #PrimNumberInstVarAt; removeConstant: #PrimNumberPerform; removeConstant: # PrimNumberPerformWithArgs; removeConstant: #PrimNumberShallowCopy; removeConstant: #PrimNumberSlotAt; removeConstant: #PrimNumberFlushExternalPrimitives; removeConstant: #PrimNumberUnloadModule] ifFalse: [aCCodeGenerator removeVariable: #primitiveAccessorDepthTable; removeConstant: #PrimNumberVMParameter]. aCCodeGenerator var: #displayBits type: #'void *'; var: #primitiveCalloutPointer declareC: 'void *primitiveCalloutPointer = (void *)-1'. #('primitiveDoMixedArithmetic' 'upscaleDisplayIfHighDPI' ) do: [:var| aCCodeGenerator var: var declareC: 'sqInt ', var, ' = -1']. self declareC: #(displayWidth displayHeight displayDepth) as: #int in: aCCodeGenerator. aCCodeGenerator var: #primitiveFunctionPointer declareC: 'void (*primitiveFunctionPointer)()'; var: 'pcPreviousToFunction' declareC: 'sqInt (* const pcPreviousToFunction)(sqInt,sqInt) = ', (aCCodeGenerator cFunctionNameFor: PCPreviousToFunction); var: #externalPrimitiveTable declareC: 'void (*externalPrimitiveTable[MaxExternalPrimitiveTableSize + 1 /* ', (MaxExternalPrimitiveTableSize + 1) printString, ' */])(void)'; var: #interruptCheckChain declareC: 'void (*interruptCheckChain)(void) = 0'; var: #showSurfaceFn declareC: 'int (*showSurfaceFn)(sqIntptr_t, int, int, int, int)'. self declareCAsUSqLong: #(nextPollUsecs nextWakeupUsecs "these are high-frequency enough that they're overflowing quite quickly on modern hardware" statProcessSwitch statIOProcessEvents statForceInterruptCheck statCheckForEvents statStackOverflow statStackPageDivorce statIdleUsecs) in: aCCodeGenerator. aCCodeGenerator var: #nextProfileTick type: #sqLong. aCCodeGenerator var: #reenterInterpreter type: 'jmp_buf'. LowcodeVM ifTrue: [aCCodeGenerator var: #lowcodeCalloutState type: #'sqLowcodeCalloutState*'. self declareC: #(nativeSP nativeStackPointer shadowCallStackPointer) as: #'char *' in: aCCodeGenerator] ifFalse: [#(lowcodeCalloutState nativeSP nativeStackPointer shadowCallStackPointer) do: [:var| aCCodeGenerator removeVariable: var]]. (self instVarNames select: [:ivn| ivn beginsWith: 'longRunningPrimitive']) do: [:lrpmVar| aCCodeGenerator var: lrpmVar + declareC: '#if LRPCheck\', ((lrpmVar endsWith: 'Usecs') ifTrue: [#usqLong] ifFalse: [#sqInt]), ' ', lrpmVar, '\#endif']. + + SpurMemoryManager wantsIncrementalGC + ifTrue: [ + aCCodeGenerator + recursivelyResolvePolymorpicReceiver: 'objectMemory' toVariants: {SpurIncrementalGarbageCollector. SpurStopTheWorldGarbageCollector} in: self default: SpurIncrementalGarbageCollector forMethodList: #(mapInterpreterOops mapStackPages mapVMRegisters mapProfileState) + ]! - declareC: '#if LRPCheck\', ((lrpmVar endsWith: 'Usecs') ifTrue: [#usqLong] ifFalse: [#sqInt]), ' ', lrpmVar, '\#endif']! 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> <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> (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> | 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> (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: TMethod>>asPolymorphicBaseFor:toResolve:default: (in category 'static polymorphism') ----- - ----- 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 changed: + ----- Method: TMethod>>asPolymorphicFor:resolveTo: (in category 'static polymorphism') ----- - ----- Method: TMethod>>asPolymorphicFor:resolveTo: (in category 'as yet unclassified') ----- asPolymorphicFor: aSymbol resolveTo: aClass | method | method := PolymorphicTMethod new. method copyFrom: self; receiverToResolve: aSymbol; receiverClass: aClass; + oldSelector: self selector; selector: (self polymorphicSelectorForClass: aClass). ^ method! Item was added: + ----- Method: TMethod>>fasterDeepCopy (in category 'static polymorphism') ----- + fasterDeepCopy + + "copy of veryDeepCopy without the handling of dependents (I assume that is not + needed for TMethods + it makes a noticable performance difference)" + | copier new | + copier := DeepCopier new: self initialDeepCopierSize. + new := self veryDeepCopyWith: copier. + copier mapUniClasses. + copier references associationsDo: [:assoc | + assoc value veryDeepFixupWith: copier]. + ^ new! Item was changed: ----- Method: TMethod>>inlineFunctionCall:in: (in category 'inlining') ----- inlineFunctionCall: aSendNode in: aCodeGen "Answer the body of the called function, substituting the actual parameters for the formal argument variables in the method body. Assume caller has established that: 1. the method arguments are all substitutable nodes, and 2. the method to be inlined contains no additional embedded returns." | sel meth doNotRename argsForInlining substitutionDict | aCodeGen maybeBreakForInlineOf: aSendNode in: self. sel := aSendNode selector. meth := (aCodeGen methodNamed: sel) copy. meth ifNil: [^self inlineBuiltin: aSendNode in: aCodeGen]. doNotRename := Set withAll: args. argsForInlining := aSendNode argumentsForInliningCodeGenerator: aCodeGen. [meth args with: argsForInlining do: [ :argName :exprNode | exprNode isLeaf ifTrue: [doNotRename add: argName]]] on: Error do: [:ex | ex messageText = 'Other collection must be the same size' ifTrue: [ | errorMessage | errorMessage := 'In ' , self definingClass name, '>>' , self selector. errorMessage := errorMessage , ' for method ' , meth definingClass name, '>>' , meth selector. errorMessage := errorMessage , ' following args where expected {' , (argsForInlining joinSeparatedBy: ', ') , '}'. errorMessage := errorMessage , ' but got {' , (meth args joinSeparatedBy: ', ') , '}'. "the errorMessage is probably extremenly long and not that easy to read in the header of the Debugger window. => print it on the transcript for better readability (as multiline strings in window titles seem not to be supported :( " Transcript showln: errorMessage. + "Note: I (Tom Braun) found this exception to be triggered in two cases: + - I made an error in the code like forgetting a point and the next statement was interpreted as the receiver which is of course nonsene + - I introduced a new variable that should be ignored during code generation (like manager in all of the GC classes) + + Please take a look at: + Browser fullOnClass: self definingClass selector: self unmodifiedSelector + and look for + aSendNode asString " + self error: errorMessage] ifFalse: [ex signal]]. (meth statements size = 2 and: [meth statements first isSend and: [meth statements first selector == #flag:]]) ifTrue: [meth statements removeFirst]. meth renameVarsForInliningInto: self except: doNotRename in: aCodeGen. meth renameLabelsForInliningInto: self. self addVarsDeclarationsAndLabelsOf: meth except: doNotRename. substitutionDict := Dictionary new: meth args size * 2. meth args with: argsForInlining do: [ :argName :exprNode | (exprNode isVariable and: [exprNode name = argName]) ifFalse: [substitutionDict at: argName put: exprNode]. (doNotRename includes: argName) ifFalse: [locals remove: argName]]. meth parseTree bindVariablesIn: substitutionDict. ^meth parseTree endsWithReturn ifTrue: [meth parseTree copyWithoutReturn] ifFalse: [meth parseTree]! Item was changed: ----- Method: TMethod>>inlineableSend:in: (in category 'inlining') ----- inlineableSend: aNode in: aCodeGen "Answer if the given send node is a call to a method that can be inlined." | m | aCodeGen maybeBreakForTestToInline: aNode in: self. aNode isSend ifFalse: [^false]. m := aCodeGen methodNamed: aNode selector. "nil if builtin or external function" + ^m ~= nil and: [m ~~ self + and: [m unmodifiedSelector ~= self unmodifiedSelector and: [m mayBeInlined and: [(m isComplete and: [aCodeGen mayInline: m selector]) + or: [m checkForRequiredInlinability]]]]]! - or: [m checkForRequiredInlinability]]]]! Item was changed: + ----- Method: TMethod>>polymorphicSelectorForClass: (in category 'static polymorphism') ----- - ----- Method: TMethod>>polymorphicSelectorForClass: (in category 'as yet unclassified') ----- polymorphicSelectorForClass: aClass ^ ((aClass name select: [:ea| ea isUppercase]), '_', self selector) asSymbol! Item was added: + ----- Method: TMethod>>unmodifiedSelector (in category 'static polymorphism') ----- + unmodifiedSelector + "I am not sure if any of the other selector accesses are overloaded or used otherwise in the system + -> I write this to be extra sure it is only used where I want it to be used" + + ^ self selector! Item was changed: ----- 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 + gcClass SpurIncrementalGarbageCollector bytecodeTableInitializer initializeBytecodeTableForSqueakV3PlusClosuresSistaV1Hybrid) to: self sourceTree, '/src/spur64.stack' platformDir: self sourceTree, '/platforms' including: #()!

1 0

Re: [Vm-dev] [squeak-dev] linux armv8 VM builds from GitHub have weird date-naming
by Taeumel, Marcel 09 Jan '23

09 Jan '23

Hi Tim -- I think that "strftime" and/or "gmtime" are not working anymore correctly in our QEMU environment, that we set up on GitHub Actions in a Debian "Buster" container. See this extract from ".git_filters/RevDateURL.smudge": #!/usr/bin/env perl use POSIX qw(strftime); $myrev = `git log -n1 --format="%at"`; $myrev =~ s/\s+$//m; $ENV{'TZ'} = 'UTC'; $myrev = strftime "%Y%m%d%H%M", gmtime($myrev); $myrev =~ s/\s+$//m; "..." Not sure how to debug this locally. All assets have the wrong revision: https://github.com/OpenSmalltalk/opensmalltalk-vm/actions/runs/3834141967 Only a few of them were wrong a month ago: https://github.com/OpenSmalltalk/opensmalltalk-vm/actions/runs/3691011134 Hmm... anyway, the revision gets extracted via "scripts/ci/actions_build.sh": "..." echo "$(cat platforms/Cross/vm/sqSCCSVersion.h | .git_filters/RevDateURL.smudge)" > platforms/Cross/vm/sqSCCSVersion.h echo "$(cat platforms/Cross/plugins/sqPluginsSCCSVersion.h | .git_filters/RevDateURL.smudge)" > platforms/Cross/plugins/sqPluginsSCCSVersion.h "..." readonly ASSET_REVISION=$(grep -m1 "SvnRawRevisionString" "platforms/Cross/vm/sqSCCSVersion.h" | sed 's/[^0-9.]*$[0-9.]*$.*/\1/') "..." Which means that if our .smudge script does not work, the revision data cannot be extracted from sqSCCSVersion.h. Hmm... any perl-related year-2023-bug out there? :-D No clue. We could try: A) Bumping "Buster" to "Bullseye". Yet, "Buster" is not that old. 2021. B) Fix those "fatal warnings": fatal: detected dubious ownership in repository at '/home/runner/work/opensmalltalk-vm/opensmalltalk-vm' Maybe, "git log" is actually not working here... But those warnings have been around since we migrated to GHA in 2021. So... Maybe this is something that changed April 2022? https://github.blog/2022-04-18-highlights-from-git-2-36/#stricter-repositor… Hmm... Best, Marcel Am 07.01.2023 01:17:34 schrieb tim Rowledge <tim(a)rowledge.org>: The latest downloadable ARMv8 build - https://github.com/OpenSmalltalk/opensmalltalk-vm/releases/download/latest-… - has a weird looking directory structure. Normally I'd expect an sqcogspur64ARMv8linuxht directory I can drag out of the archive app and into my main Squeak directory, whereupon the contents get overlaid onto what was already there. Amongst other things I'd expect to find a new lib/squeak/5.0-20230103xxxxxxxx-64bit directory or similar. Instead it has lib/squeak/5.0-197001010000-64bit and I'm fairly sure we didn't have spur & cog in 1970. Who done broke the clock? tim -- tim Rowledge; tim(a)rowledge.org; http://www.rowledge.org/tim Long computations that yield zero are probably all for naught.

1 1

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Vm-dev January 2023