Vm-dev December 2016

vm-dev@lists.squeakfoundation.org

34 participants
102 discussions

VM Maker: Cog-nice.334.mcz
by commits＠source.squeak.org 27 Dec '16

27 Dec '16

Nicolas Cellier uploaded a new version of Cog to project VM Maker: http://source.squeak.org/VMMaker/Cog-nice.334.mcz ==================== Summary ==================== Name: Cog-nice.334 Author: nice Time: 27 December 2016, 11:49:26.812179 pm UUID: e96956f0-be65-4755-962c-6f6a51a62c89 Ancestors: Cog-eem.333 In Win64 X64 ABI, RSI and RDI are non volatile (hence callee saved rather than caller saved). See MSDN Caller/Callee Saved Registers in x64 calling convention https://msdn.microsoft.com/en-us/library/6t169e9c.aspx =============== Diff against Cog-eem.333 =============== Item was changed: ----- Method: BochsX64Alien>>smashCallerSavedRegistersWithValuesFrom:by: (in category 'accessing-abstract') ----- smashCallerSavedRegistersWithValuesFrom: base by: step + (CogX64Compiler isSysV + ifTrue: [#(rax: rcx: rdx: rsi: rdi: r8: r9: r10: r11:)] + ifFalse: [#(rax: rcx: rdx: r8: r9: r10: r11:)]) - #(rax: rcx: rdx: rsi: rdi: r8: r9: r10: r11:) withIndexDo: [:accessor :index| self perform: accessor with: index - 1 * step + base]!

1 0

VM Maker: VMMaker.oscog-eem.2054.mcz
by commits＠source.squeak.org 27 Dec '16

27 Dec '16

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2054.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.2054 Author: eem Time: 27 December 2016, 1:02:47.238029 pm UUID: 43b2e0a0-dfbf-4e89-9372-0611324eb20f Ancestors: VMMaker.oscog-eem.2053 SpurPlanningCompactor: Move the initial scan for firstFreeObject and firstMobileObject to the earliest point and hence bail out when the heap is already compacted. =============== Diff against VMMaker.oscog-eem.2053 =============== Item was changed: ----- Method: SpurPlanningCompactor>>compact (in category 'compaction - api') ----- compact "Sweep all of old space, sliding unpinned marked objects down over free and unmarked objects. Let the segmentManager mark which segments contain pinned objects via notePinned:." | onePass | <inline: #never> "for profiling" + self initializeScanCheckingForFullyCompactedHeap ifTrue: + [^self unmarkObjectsInFullyCompactedHeap]. + self initializeCompaction. - self initializeCompaction; - initializeScan. [onePass := self planCompactSavingForwarders. self updatePointers. self copyAndUnmark. manager checkFreeSpace: GCModeFull. onePass or: [biasForGC]] whileFalse: [self reinitializeScan; updateSavedFirstFieldsSpaceIfNecessary]. self endCompaction! Item was changed: ----- Method: SpurPlanningCompactor>>initializeCompaction (in category 'compaction') ----- initializeCompaction manager checkFreeSpace: GCModeFull. self selectSavedFirstFieldsSpace. self unpinRememberedSet. manager resetFreeListHeads; totalFreeOldSpace: 0; + beginSlidingCompaction. + savedFirstFieldsSpace top: savedFirstFieldsSpace start - manager bytesPerOop! - beginSlidingCompaction! Item was removed: - ----- Method: SpurPlanningCompactor>>initializeScan (in category 'compaction') ----- - initializeScan - savedFirstFieldsSpace top: savedFirstFieldsSpace start - manager bytesPerOop. - firstFreeObject := manager hiddenRootsObject. - self reinitializeScan! Item was added: + ----- Method: SpurPlanningCompactor>>initializeScanCheckingForFullyCompactedHeap (in category 'compaction') ----- + initializeScanCheckingForFullyCompactedHeap + "Scan for firstFreeObject and firstMobileObject from the start of memory. + Answer if the heap is already fully compacted." + firstFreeObject := manager hiddenRootsObject. + self reinitializeScan. + ^firstMobileObject >= manager endOfMemory! Item was added: + ----- Method: SpurPlanningCompactor>>unmarkObjectsInFullyCompactedHeap (in category 'compaction') ----- + unmarkObjectsInFullyCompactedHeap + self unmarkInitialImmobileObjects. + manager unmarkSurvivingObjectsForCompact!

1 0

VM Maker: VMMaker.oscog-eem.2053.mcz
by commits＠source.squeak.org 27 Dec '16

27 Dec '16

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2053.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.2053 Author: eem Time: 27 December 2016, 12:23:37.587924 pm UUID: 950c6120-20c1-45c9-a864-0abafd71fd83 Ancestors: VMMaker.oscog-eem.2052 Spur: Move the attemptToShrink from fullGC to globalGarbageCollect so that it is included in lemming debugging. Make checkHeapFreeSpaceIntegrity check totalFreeOldSpace and hence catch SpurPlannngCompactor not freeing a free object at the end of an already compacted heap. Fix the free space leak checker invocations for the allocateSlots*InOldSpace:... One cannot invoke the leak checker until the allocated object's header has been filled in. Shows how long its been since the free space leak checker has been run :-/. Fix a slip in the refactoring of initializeScan to use reinitializeScan. =============== Diff against VMMaker.oscog-eem.2052 =============== Item was changed: ----- Method: Spur32BitMemoryManager>>allocateSlotsForPinningInOldSpace:bytes:format:classIndex: (in category 'allocation') ----- allocateSlotsForPinningInOldSpace: numSlots bytes: totalBytes format: formatField classIndex: classIndex "Answer the oop of a chunk of space in oldSpace with numSlots slots. Try and allocate in a segment that already includes pinned objects. The header of the result will have been filled-in but not the contents." <var: #totalBytes type: #usqInt> <inline: false> | chunk | chunk := self allocateOldSpaceChunkOfBytes: totalBytes suchThat: [:f| (segmentManager segmentContainingObj: f) containsPinned]. chunk ifNil: [chunk := self allocateOldSpaceChunkOfBytes: totalBytes. + chunk ifNil: + [^nil]. + (segmentManager segmentContainingObj: chunk) containsPinned: true]. - chunk ifNotNil: - [(segmentManager segmentContainingObj: chunk) containsPinned: true]]. - self checkFreeSpace: GCModeNewSpace. - chunk ifNil: - [^nil]. numSlots >= self numSlotsMask ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word" [self flag: #endianness. self longAt: chunk put: numSlots. self longAt: chunk + 4 put: self numSlotsMask << self numSlotsHalfShift. self long64At: chunk + self baseHeaderSize put: ((self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex) bitOr: 1 << self pinnedBitShift). + self checkFreeSpace: GCModeNewSpace. ^chunk + self baseHeaderSize]. self long64At: chunk put: ((self headerForSlots: numSlots format: formatField classIndex: classIndex) bitOr: 1 << self pinnedBitShift). + self checkFreeSpace: GCModeNewSpace. ^chunk! Item was changed: ----- Method: Spur32BitMemoryManager>>allocateSlotsInOldSpace:bytes:format:classIndex: (in category 'allocation') ----- allocateSlotsInOldSpace: numSlots bytes: totalBytes format: formatField classIndex: classIndex "Answer the oop of a chunk of space in oldSpace with numSlots slots. The header will have been filled-in but not the contents. If no memory is available answer nil." <var: #totalBytes type: #usqInt> <inline: false> | chunk | chunk := self allocateOldSpaceChunkOfBytes: totalBytes. - self checkFreeSpace: GCModeNewSpace. chunk ifNil: [^nil]. numSlots >= self numSlotsMask ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word" [self flag: #endianness. self longAt: chunk put: numSlots. self longAt: chunk + 4 put: self numSlotsMask << self numSlotsHalfShift. self long64At: chunk + self baseHeaderSize put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex). + self checkFreeSpace: GCModeNewSpace. ^chunk + self baseHeaderSize]. self long64At: chunk put: (self headerForSlots: numSlots format: formatField classIndex: classIndex). + self checkFreeSpace: GCModeNewSpace. ^chunk! Item was changed: ----- Method: Spur64BitMemoryManager>>allocateSlotsForPinningInOldSpace:bytes:format:classIndex: (in category 'allocation') ----- allocateSlotsForPinningInOldSpace: numSlots bytes: totalBytes format: formatField classIndex: classIndex "Answer the oop of a chunk of space in oldSpace with numSlots slots. Try and allocate in a segment that already includes pinned objects. The header of the result will have been filled-in but not the contents." <var: #totalBytes type: #usqInt> <inline: false> | chunk | chunk := self allocateOldSpaceChunkOfBytes: totalBytes suchThat: [:f| (segmentManager segmentContainingObj: f) containsPinned]. chunk ifNil: + [chunk := self allocateOldSpaceChunkOfBytes: totalBytes. + chunk ifNil: + [^nil]. + (segmentManager segmentContainingObj: chunk) containsPinned: true]. - [chunk := self allocateOldSpaceChunkOfBytes: totalBytes]. - self checkFreeSpace: GCModeNewSpace. - chunk ifNil: - [^nil]. numSlots >= self numSlotsMask ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word" [self longAt: chunk put: numSlots + (self numSlotsMask << self numSlotsFullShift). self longAt: chunk + self baseHeaderSize put: ((self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex) bitOr: 1 << self pinnedBitShift). + self checkFreeSpace: GCModeNewSpace. ^chunk + self baseHeaderSize]. self longAt: chunk put: ((self headerForSlots: numSlots format: formatField classIndex: classIndex) bitOr: 1 << self pinnedBitShift). + self checkFreeSpace: GCModeNewSpace. ^chunk! Item was changed: ----- Method: Spur64BitMemoryManager>>allocateSlotsInOldSpace:bytes:format:classIndex: (in category 'allocation') ----- allocateSlotsInOldSpace: numSlots bytes: totalBytes format: formatField classIndex: classIndex "Answer the oop of a chunk of space in oldSpace with numSlots slots. The header will have been filled-in but not the contents. If no memory is available answer nil." <var: #totalBytes type: #usqInt> <inline: false> | chunk | chunk := self allocateOldSpaceChunkOfBytes: totalBytes. - self checkFreeSpace: GCModeNewSpace. chunk ifNil: [^nil]. numSlots >= self numSlotsMask ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word" [self longAt: chunk put: numSlots + (self numSlotsMask << self numSlotsFullShift). self longAt: chunk + self baseHeaderSize put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex). + self checkFreeSpace: GCModeNewSpace. ^chunk + self baseHeaderSize]. self longAt: chunk put: (self headerForSlots: numSlots format: formatField classIndex: classIndex). + self checkFreeSpace: GCModeNewSpace. ^chunk! Item was changed: ----- Method: SpurMemoryManager>>checkHeapFreeSpaceIntegrity (in category 'debug support') ----- checkHeapFreeSpaceIntegrity "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 | - | ok | <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); cr. self eek. 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'; cr. self eek. ok := false] ifFalse: [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'; cr. self eek. ok := false]]]]]. self allOldSpaceEntitiesDo: [:obj| | fieldOop | (self isFreeObject: obj) ifTrue: [(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0 ifTrue: [coInterpreter print: 'leak in free chunk '; printHex: obj; print: ' is unmapped?!! '; cr. self eek. 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'; cr. self eek. 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'; cr. self eek. + ok := false]]]. + total := total + (self bytesInObject: obj)] - ok := false].]]] ifFalse: [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'; cr. self eek. ok := false]]]]]. + total ~= totalFreeOldSpace ifTrue: + [coInterpreter print: 'incorrect totalFreeOldSpace; expected '; printNum: totalFreeOldSpace; print: ' found '; printNum: total; cr. + self eek. + ok := false]. ^ok! Item was changed: ----- Method: SpurMemoryManager>>fullGC (in category 'gc - global') ----- fullGC "Perform a full lazy compacting GC. Answer the size of the largest free chunk." <returnTypeC: #usqLong> <inline: #never> "for profiling" needGCFlag := false. gcStartUsecs := self ioUTCMicrosecondsNow. statMarkCount := 0. coInterpreter preGCAction: GCModeFull. self globalGarbageCollect. - self attemptToShrink. coInterpreter postGCAction: GCModeFull. statFullGCs := statFullGCs + 1. statGCEndUsecs := self ioUTCMicrosecondsNow. statFullGCUsecs := statFullGCUsecs + (statGCEndUsecs - gcStartUsecs). ^(freeLists at: 0) ~= 0 ifTrue: [self bytesInObject: self findLargestFreeChunk] ifFalse: [0]! Item was changed: ----- Method: SpurMemoryManager>>globalGarbageCollect (in category 'gc - global') ----- globalGarbageCollect <inline: true> "inline into fullGC" self assert: self validObjStacks. self assert: (self isEmptyObjStack: markStack). self assert: (self isEmptyObjStack: weaklingStack). "Mark objects /before/ scavenging, to empty the rememberedTable of unmarked roots." self markObjects: true. scavenger forgetUnmarkedRememberedObjects. self doScavenge: MarkOnTenure. "Mid-way the leak check must be more lenient. Unmarked classes will have been expunged from the table, but unmarked instances will not yet have been reclaimed." self runLeakCheckerFor: GCModeFull excludeUnmarkedObjs: true classIndicesShouldBeValid: true. segmentManager prepareForGlobalSweep. "for notePinned:" compactor compact. + self attemptToShrink. self setHeapSizeAtPreviousGC. self assert: self validObjStacks. self assert: (self isEmptyObjStack: markStack). self assert: (self isEmptyObjStack: weaklingStack). self assert: self allObjectsUnmarked. self runLeakCheckerFor: GCModeFull! Item was changed: ----- Method: SpurPlanningCompactor>>initializeScan (in category 'compaction') ----- initializeScan savedFirstFieldsSpace top: savedFirstFieldsSpace start - manager bytesPerOop. + firstFreeObject := manager hiddenRootsObject. self reinitializeScan!

1 0

VM Maker: VMMaker.oscog-eem.2052.mcz
by commits＠source.squeak.org 27 Dec '16

27 Dec '16

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2052.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.2052 Author: eem Time: 26 December 2016, 9:43:10.758538 pm UUID: 3121f1fe-286c-435b-8669-bb50f8cbe31f Ancestors: VMMaker.oscog-eem.2051 Fix the regression in VMMaker.oscog-eem.2050's buildCodeGeneratorForInterpreter:includeAPIMethods:initializeClasses:. Fix setting of optionsDictionary on instantiating a simulator. =============== Diff against VMMaker.oscog-eem.2051 =============== Item was changed: ----- Method: CogVMSimulator class>>initializeWithOptions:objectMemoryClass: (in category 'class initialization') ----- initializeWithOptions: optionsDictionaryOrArray objectMemoryClass: objectMemoryClassOrNil "The relevant ObjectMemory, Interpreter and Cogit classes must be initialized in order. This happens notionally every time we start the simulator, but in fact happens when ever we instantiate a simulator." initializationOptions := optionsDictionaryOrArray isArray ifTrue: [Dictionary newFromPairs: optionsDictionaryOrArray] ifFalse: [optionsDictionaryOrArray]. + (self allSuperclasses copyUpThrough: InterpreterPrimitives) do: + [:sc| sc initializationOptions: initializationOptions]. + (objectMemoryClassOrNil ifNil: [self objectMemoryClass]) initializeWithOptions: initializationOptions. self initializeWithOptions: initializationOptions. (self cogitClass withAllSuperclasses copyUpTo: Cogit) reverseDo: [:c| c initializeWithOptions: initializationOptions]! Item was changed: ----- Method: StackInterpreterSimulator class>>initializeWithOptions:objectMemoryClass: (in category 'class initialization') ----- initializeWithOptions: optionsDictionaryOrArray objectMemoryClass: objectMemoryClassOrNil "The relevant ObjectMemory and Interpreter classes must be initialized in order. This happens notionally every time we start the simulator, but in fact happens when ever we instantiate a simulator." initializationOptions := optionsDictionaryOrArray isArray ifTrue: [Dictionary newFromPairs: optionsDictionaryOrArray] ifFalse: [optionsDictionaryOrArray]. + + (self allSuperclasses copyUpThrough: InterpreterPrimitives) do: + [:sc| sc initializationOptions: initializationOptions]. + (objectMemoryClassOrNil ifNil: [self objectMemoryClass]) initializeWithOptions: initializationOptions. self initializeWithOptions: initializationOptions! Item was changed: ----- Method: VMMaker>>buildCodeGeneratorForInterpreter:includeAPIMethods:initializeClasses: (in category 'generate sources') ----- buildCodeGeneratorForInterpreter: interpreterClass includeAPIMethods: getAPIMethods initializeClasses: initializeClasses "Answer the code generator for translating the interpreter." | cg interpreterClasses | initializeClasses ifTrue: [interpreterClass initializeWithOptions: optionsDictionary. interpreterClass hasCogit ifTrue: [interpreterClass cogitClass initializeWithOptions: optionsDictionary]. interpreterClass objectMemoryClass initializationOptions: optionsDictionary]. (cg := self createCodeGenerator) vmClass: interpreterClass. "Construct interpreterClasses as all classes from interpreterClass & objectMemoryClass up to VMClass in superclass to subclass order." interpreterClasses := OrderedCollection new. {interpreterClass. interpreterClass objectMemoryClass} do: [:vmClass| | theClass | theClass := vmClass. [theClass ~~ VMClass] whileTrue: + [theClass initializationOptions: interpreterClass initializationOptions. - [theClass initializationOptions: optionsDictionary. interpreterClasses addFirst: theClass. theClass := theClass superclass]]. interpreterClasses addFirst: VMClass; addAllLast: (cg nonStructClassesForTranslationClasses: interpreterClasses). initializeClasses ifTrue: [interpreterClasses do: [:ic| (ic respondsTo: #initializeWithOptions:) + ifTrue: [ic initializeWithOptions: interpreterClass initializationOptions] - ifTrue: [ic initializeWithOptions: optionsDictionary] ifFalse: [ic initialize]]. (cg structClassesForTranslationClasses: interpreterClasses) do: [:structClass| structClass initialize]]. cg addStructClasses: (cg structClassesForTranslationClasses: interpreterClasses). interpreterClasses do: [:ic| cg addClass: ic]. getAPIMethods ifTrue: [interpreterClass cogitClass ifNotNil: [:cogitClass| cg includeAPIFrom: (self buildCodeGeneratorForCogit: cogitClass includeAPIMethods: false initializeClasses: false)]]. ^cg!

1 0

VM Maker: VMMaker.oscog-eem.2051.mcz
by commits＠source.squeak.org 27 Dec '16

27 Dec '16

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2051.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.2051 Author: eem Time: 26 December 2016, 9:11:06.091387 pm UUID: facc9a57-b736-4608-9126-484f4da4905b Ancestors: VMMaker.oscog-eem.2050 Nuke the exportAPISelectors: nonsense since we can use isAPIMetod on the methods set (I guess since apiMethods were available separately?). =============== Diff against VMMaker.oscog-eem.2050 =============== Item was changed: ----- Method: CCodeGenerator>>emitCAPIExportHeaderOn: (in category 'C code generator') ----- emitCAPIExportHeaderOn: aStream "Store prototype declarations for all non-inlined methods on the given stream." + | apiMethods usedConstants | + apiMethods := self sortMethods: (methods select: [:m| m isAPIMethod]). + apiMethods do: - | api methodList usedConstants | - api := (vmClass translationClass exportAPISelectors: self options). - methodList := api - select: - [:s| - (methods includesKey: s) - or: [(vmClass whichClassIncludesSelector: s) - ifNil: [false] - ifNotNil: [:c|self shouldIncludeMethodFor: c selector: s]]] - thenCollect: - [:s| - methods - at: s - ifAbsent: [self compileToTMethodSelector: s - in: (vmClass whichClassIncludesSelector: s)]]. - methodList := self sortMethods: methodList. - methodList do: [:m| m static ifTrue: [logger ensureCr; show: m selector, ' excluded from export API because it is static'; cr]]. + self emitCFunctionPrototypes: apiMethods on: aStream. - self emitCFunctionPrototypes: methodList on: aStream. self emitGlobalCVariablesOn: aStream. + usedConstants := self emitCMacros: apiMethods on: aStream. - usedConstants := self emitCMacros: methodList on: aStream. self emitCConstants: usedConstants on: aStream! Item was removed: - ----- Method: CoInterpreter class>>exportAPISelectors: (in category 'translation') ----- - exportAPISelectors: options - "Yes this is a mess. When all exportAPI methods are marked with the <api> pragma - this can go away." - | omExports | - omExports := (self objectMemoryClass withAllSuperclasses copyUpTo: VMClass) - inject: Set new into: [:api :c| api addAll: (c exportAPISelectors: options); yourself]. - ^(self withAllSuperclasses copyUpTo: VMClass), (self ancilliaryClasses: options) - inject: omExports - into: [:set :class| set addAll: (self exportAPISelectorsFor: class); yourself]! Item was removed: - ----- Method: Cogit class>>exportAPISelectors: (in category 'translation') ----- - exportAPISelectors: options - ^((self withAllSuperclasses copyUpThrough: Cogit), (self ancilliaryClasses: options) collect: - [:c| self exportAPISelectorsFor: c]) fold: [:a :b| a, b]! Item was changed: ----- Method: Cogit class>>preGenerationHook: (in category 'translation') ----- preGenerationHook: aCCodeGenerator "Perform any last-minute changes to the code generator immediately before it performs code analysis and generation. In this case, make all non-exported methods private." - | exportAPISelectors | - exportAPISelectors := self exportAPISelectors: aCCodeGenerator options. aCCodeGenerator selectorsAndMethodsDo: [:s :m| + m isAPIMethod - (exportAPISelectors includes: s) ifTrue: [m static: false] ifFalse: [m export ifFalse: [m static: true]]]! Item was changed: ----- Method: Cogit class>>requiredMethodNames: (in category 'translation') ----- requiredMethodNames: options "self requiredMethodNames" + ^self tableFunctions! - ^(self exportAPISelectors: options) - addAll: self tableFunctions; - yourself! Item was removed: - ----- Method: ObjectMemory class>>requiredMethodNames: (in category 'translation') ----- - requiredMethodNames: options - "return the list of method names that should be retained for export or other support reasons" - ^self exportAPISelectors: options! Item was removed: - ----- Method: Spur32BitCoMemoryManager class>>exportAPISelectors: (in category 'translation') ----- - exportAPISelectors: options - ^(Set withAll: (self exportAPISelectorsFor: self)) - addAll: (SpurGenerationScavenger exportAPISelectors: options); - addAll: (self compactorClass exportAPISelectors: options); - yourself! Item was removed: - ----- Method: Spur64BitCoMemoryManager class>>exportAPISelectors: (in category 'translation') ----- - exportAPISelectors: options - ^(Set withAll: (self exportAPISelectorsFor: self)) - addAll: (SpurGenerationScavenger exportAPISelectors: options); - addAll: (self compactorClass exportAPISelectors: options); - yourself! Item was removed: - ----- Method: SpurMemoryManager class>>requiredMethodNames: (in category 'translation') ----- - requiredMethodNames: options - "return the list of method names that should be retained for export or other support reasons" - ^(self exportAPISelectors: options), - (SpurGenerationScavenger exportAPISelectors: options)! Item was removed: - ----- Method: StackInterpreter class>>exportAPISelectors: (in category 'translation') ----- - exportAPISelectors: options - | omExports | - omExports := (self objectMemoryClass withAllSuperclasses copyUpTo: VMClass) - inject: Set new - into: [:api :c| api addAll: (c exportAPISelectors: options); yourself]. - ^(self withAllSuperclasses copyUpTo: VMClass), (self ancilliaryClasses: options) - inject: omExports - into: [:set :class| set addAll: (self exportAPISelectorsFor: class); yourself]! Item was changed: ----- Method: StackInterpreter class>>preGenerationHook: (in category 'translation') ----- preGenerationHook: aCCodeGen "Perform any last-minute changes to the code generator immediately before it performs code analysis and generation. In this case, make all non-exported methods private." | publicMethodNames | self primitiveTable do: [:s| (s isSymbol and: [s ~~ #primitiveFail]) ifTrue: [(aCCodeGen methodNamed: s) returnType: #void]]. publicMethodNames := (self requiredMethodNames: aCCodeGen options) copyWithoutAll: (self primitiveTable copyWithout: #primitiveFail). aCCodeGen selectorsAndMethodsDo: [:s :m| + (m export or: [m isAPIMethod or: [publicMethodNames includes: s]]) ifTrue: - (m export or: [publicMethodNames includes: s]) ifTrue: [m static: false]]! Item was changed: ----- Method: StackInterpreter class>>requiredMethodNames: (in category 'translation') ----- requiredMethodNames: options + "Answer the list of method names that should be retained for export or other support reasons" - "return the list of method names that should be retained for export or other support reasons" | requiredList | + "A number of methods required by VM support code, specific platforms, etc" + requiredList := #( - requiredList := self exportAPISelectors: options. - requiredList addAll: (self objectMemoryClass requiredMethodNames: options). - "A number of methods required by VM support code, jitter, specific platforms etc" - requiredList addAll: #( assertValidExecutionPointe:r:s: characterForAscii: findClassOfMethod:forReceiver: findSelectorOfMethod: forceInterruptCheck forceInterruptCheckFromHeartbeat fullDisplayUpdate getCurrentBytecode getFullScreenFlag getInterruptKeycode getInterruptPending getSavedWindowSize getThisSessionID interpret loadInitialContext primitiveFail primitiveFailFor: primitiveFlushExternalPrimitives printAllStacks printCallStack printContext: printExternalHeadFrame printFramesInPage: printFrame: printHeadFrame printMemory printOop: printStackPages printStackPageList printStackPagesInUse printStackPageListInUse readableFormat: readImageFromFile:HeapSize:StartingAt: setFullScreenFlag: setInterruptKeycode: setInterruptPending: setInterruptCheckChain: setSavedWindowSize: success: + validInstructionPointer:inMethod:framePointer:) asSet. - validInstructionPointer:inMethod:framePointer:). "Nice to actually have all the primitives available" requiredList addAll: (self primitiveTable select: [:each| each isSymbol]). "InterpreterProxy is the internal analogue of sqVirtualMachine.c, so make sure to keep all those" InterpreterProxy organization categories do: [:cat | ((cat ~= 'initialize') and: [cat ~= 'private']) ifTrue: [requiredList addAll: (InterpreterProxy organization listAtCategoryNamed: cat)]]. ^requiredList! Item was removed: - ----- Method: VMClass class>>exportAPISelectors: (in category 'translation') ----- - exportAPISelectors: options - ^self exportAPISelectorsFor: self! Item was removed: - ----- Method: VMClass class>>exportAPISelectorsFor: (in category 'translation') ----- - exportAPISelectorsFor: aClass - ^(aClass selectors select: - [:s| | m | - ((m := aClass compiledMethodAt: s) pragmaAt: #api) notNil or: [(m pragmaAt: #api:) notNil]]) asSet!

1 0

VM Maker: VMMaker.oscog-eem.2050.mcz
by commits＠source.squeak.org 27 Dec '16

27 Dec '16

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2050.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.2050 Author: eem Time: 26 December 2016, 7:16:12.441075 pm UUID: d45b0fc7-802c-400f-a433-5d4c1941fdfd Ancestors: VMMaker.oscog-eem.2049 Slang: Fix inlining bugs due to an overcomplex and inaccurate completion check. Specifically: - inlineableFunctionCall:in: & inlineableSend:in: must see if a method wants to be inlined, so that completeness can be computed properly. - fix slips in tryToInlineMethodsIn: exiting too soon and always setting complete in a macro. - refactor checkForCompleteness:in: to checkForCompletenessIn: and simplify, setting complete if no incomplete send is found, rather than assuming completeness and then looking for inlineability, which is wrong. Have collectInlineList: set inline to false (rather than nil) if using asSpecified or asSpecifiedOrQuick. Fix pruneUnreachableMethods: to not delete <api> methods. Add cppIf:ifTrue: to statementsListsForInliningIn:'s filtering out. Slightly more flexible generateTruncateTo:on:indent:,probably not needed due to inlining fixes, but is goodness. Fix mis-initialization on code generation by setting the vmClass's objectmemoryClass's initializationOptions before asking it for its ancilliary classes. Spur: Include the compactorClass's exportAPISelectors:. Revert some now unnecessary <inline: #always> to <inline: true>. Declare savedFirstFieldsSpace correctly. Declatre the compactor's default return type correctly. General: Add printMethodImplementorsOf: for debugging. =============== Diff against VMMaker.oscog-eem.2049 =============== Item was changed: ----- Method: CCodeGenerator>>collectInlineList: (in category 'inlining') ----- collectInlineList: inlineFlagOrSymbol "Make a list of methods that should be inlined. If inlineFlagOrSymbol == #asSpecified only inline methods marked with <inline: true>. If inlineFlagOrSymbol == #asSpecifiedOrQuick only inline methods marked with <inline: true> or methods that are quick (^constant, ^inst var)." "Details: The method must not include any inline C, since the translator cannot currently map variable names in inlined C code. Methods to be inlined must be small or called from only one place." | selectorsOfMethodsNotToInline callsOf | self assert: (#(true false asSpecified asSpecifiedOrQuick) includes: inlineFlagOrSymbol). selectorsOfMethodsNotToInline := Set new: methods size. selectorsOfMethodsNotToInline addAll: macros keys. apiMethods ifNotNil: [selectorsOfMethodsNotToInline addAll: apiMethods keys]. methods do: [:m| m isStructAccessor ifTrue: [selectorsOfMethodsNotToInline add: m selector]]. "build dictionary to record the number of calls to each method" callsOf := Dictionary new: methods size * 2. methods keysAndValuesDo: [:s :m| (m isRealMethod and: [self shouldGenerateMethod: m]) ifTrue: [callsOf at: s put: 0]]. "For each method, scan its parse tree once or twice to: 1. determine if the method contains unrenamable C code or declarations or has a C builtin 2. determine how many nodes it has 3. increment the sender counts of the methods it calls" inlineList := Set new: methods size * 2. (methods reject: [:m| selectorsOfMethodsNotToInline includes: m selector]) do: [:m| | inlineIt hasUnrenamableCCode nodeCount | ((breakSrcInlineSelectors includes: m selector) and: [breakOnInline isNil]) ifTrue: [self halt]. inlineIt := #dontCare. (translationDict includesKey: m selector) ifTrue: [hasUnrenamableCCode := true] ifFalse: [hasUnrenamableCCode := m hasUnrenamableCCode. nodeCount := 0. m parseTree nodesDo: [:node| node isSend ifTrue: [callsOf at: node selector ifPresent: [:senderCount| callsOf at: node selector put: senderCount + 1]]. nodeCount := nodeCount + 1]. inlineIt := m extractInlineDirective]. "may be true, false, #always, #never or #dontCare" (hasUnrenamableCCode or: [inlineIt == false]) ifTrue: "don't inline if method has C code or contains negative inline directive" [inlineIt == true ifTrue: [logger ensureCr; nextPutAll: 'failed to inline '; nextPutAll: m selector; nextPutAll: ' as it contains unrenamable C declarations or C code'; cr; flush]. selectorsOfMethodsNotToInline add: m selector] ifFalse: [(inlineFlagOrSymbol caseOf: { [#asSpecified] -> [inlineIt == true]. [#asSpecifiedOrQuick] -> [inlineIt == true or: [m compiledMethod isQuick]]. [true] -> [nodeCount < 40 or: [inlineIt == true]]. [false] -> [false]}) ifTrue: "inline if method has no C code and is either small or contains inline directive" [inlineList add: m selector] ifFalse: [(#(asSpecified asSpecifiedOrQuick) includes: inlineFlagOrSymbol) ifTrue: [selectorsOfMethodsNotToInline add: m selector]]]]. + (#(asSpecified asSpecifiedOrQuick) includes: inlineFlagOrSymbol) + ifTrue: + [methods do: [:m| m inline ifNil: [m inline: (inlineList includes: m selector)]]] + ifFalse: + [callsOf associationsDo: + [:assoc| + (assoc value = 1 + and: [(selectorsOfMethodsNotToInline includes: assoc key) not]) ifTrue: + [inlineList add: assoc key]]]! - (#(asSpecified asSpecifiedOrQuick) includes: inlineFlagOrSymbol) ifFalse: - [callsOf associationsDo: - [:assoc| - (assoc value = 1 - and: [(selectorsOfMethodsNotToInline includes: assoc key) not]) ifTrue: - [inlineList add: assoc key]]]! Item was changed: ----- Method: CCodeGenerator>>generateTruncateTo:on:indent: (in category 'C translation') ----- generateTruncateTo: msgNode on: aStream indent: level "Generate the C code for this message onto the given stream." + | arg | + (self isConstantNode: msgNode args first valueInto: [:a| arg := a]) ifFalse: + [self error: 'can''t find method for inlining truncateTo:']. + self assert: (arg isInteger and: [arg isPowerOfTwo]). - self assert: msgNode args first isConstant. - self assert: msgNode args first value isInteger. - self assert: msgNode args first value isPowerOfTwo. aStream nextPut: $(. self emitCExpression: msgNode receiver on: aStream. + aStream nextPutAll: ' & ~'; print: arg - 1; nextPut: $)! - aStream nextPutAll: ' & ~'; print: msgNode args first value - 1; nextPut: $)! Item was added: + ----- Method: CCodeGenerator>>maybeBreakForTestOfInliningOf: (in category 'inlining') ----- + maybeBreakForTestOfInliningOf: aNodeOrSelector + "convenient for debugging..." + | selector | + selector := aNodeOrSelector isSymbol + ifTrue: [aNodeOrSelector] + ifFalse: + [aNodeOrSelector isSend + ifTrue: [aNodeOrSelector selector] + ifFalse: [^self]]. + ((breakSrcInlineSelectors includes: selector) + and: [breakDestInlineSelectors isEmpty + and: [breakOnInline == true]]) ifTrue: + [self halt: selector]! Item was changed: ----- Method: CCodeGenerator>>pruneUnreachableMethods (in category 'inlining') ----- pruneUnreachableMethods "Remove any methods that are not reachable. Retain methods needed by the translated classes - see implementors of requiredMethodNames" | neededSelectors newMethods previousSize visited | "add all the exported methods and all the called methods to the requiredSelectors" "keep all the fake methods (macros and struct accessors; these are needed to ensure correct code generation." neededSelectors := Set withAll: requiredSelectors. methods do: [ :m | m export ifTrue: [neededSelectors add: m selector]. + m isAPIMethod ifTrue: + [neededSelectors add: m selector]. m isRealMethod ifFalse: [neededSelectors add: m selector]]. "Now compute the transitive closure..." previousSize := neededSelectors size. visited := IdentitySet new: methods size. [neededSelectors do: [:s| (methods at: s ifAbsent: []) ifNotNil: [:m| (visited includes: m) ifFalse: [visited add: m. (m isRealMethod and: [self shouldGenerateMethod: m]) ifTrue: [neededSelectors addAll: m allCalls]]]]. neededSelectors size > previousSize] whileTrue: [previousSize := neededSelectors size]. "build a new dictionary of methods from the collection of all the ones to keep" newMethods := Dictionary new: neededSelectors size. neededSelectors do: [:sel| methods at: sel ifPresent: [:meth| newMethods at: sel put: meth]]. methods := newMethods! Item was added: + ----- Method: ObjectMemory>>printMethodImplementorsOf: (in category 'debug printing') ----- + printMethodImplementorsOf: anOop + "Scan the heap printing the oops of any and all methods that implement anOop" + <api> + | obj | + obj := self firstAccessibleObject. + [obj = nil] whileFalse: + [((self isCompiledMethod: obj) + and: [(self maybeSelectorOfMethod: obj) = anOop]) ifTrue: + [self printHex: obj; space; printOopShort: obj; cr]]! Item was changed: ----- Method: Spur32BitCoMemoryManager class>>exportAPISelectors: (in category 'translation') ----- exportAPISelectors: options ^(Set withAll: (self exportAPISelectorsFor: self)) addAll: (SpurGenerationScavenger exportAPISelectors: options); + addAll: (self compactorClass exportAPISelectors: options); yourself! Item was changed: ----- Method: Spur64BitCoMemoryManager class>>exportAPISelectors: (in category 'translation') ----- exportAPISelectors: options ^(Set withAll: (self exportAPISelectorsFor: self)) addAll: (SpurGenerationScavenger exportAPISelectors: options); + addAll: (self compactorClass exportAPISelectors: options); yourself! Item was added: + ----- Method: SpurMemoryManager>>printMethodImplementorsOf: (in category 'debug printing') ----- + printMethodImplementorsOf: anOop + "Scan the heap printing the oops of any and all methods that implement anOop" + <api> + self allObjectsDo: + [:obj| + ((self isCompiledMethod: obj) + and: [(coInterpreter maybeSelectorOfMethod: obj) = anOop]) ifTrue: + [coInterpreter printHex: obj; space; printOopShort: obj; cr]]! Item was changed: ----- Method: SpurMemoryManager>>slidingCompactionShouldRemapObj: (in category 'gc - scavenge/compact') ----- slidingCompactionShouldRemapObj: objOop + <inline: true> - <inline: #always> "Answer if the obj should be scavenged, or simply followed. Sent via the compactor from shouldRemapObj:. We test for being already scavenged because mapStackPages via mapInterpreterOops may be applied twice in the context of a global GC where a scavenge, followed by a scan-mark-free, and final compaction passes may result in scavenged fields being visited twice." ^(self isForwarded: objOop) or: [gcPhaseInProgress > 0 "Hence either scavengeInProgress or slidingCompactionInProgress" and: [self scavengeInProgress ifTrue: [(self isReallyYoungObject: objOop) and: [(self isInFutureSpace: objOop) not]] ifFalse: [compactor isMobile: objOop]]]! Item was changed: ----- Method: SpurMemoryManager>>vanillaShouldRemapObj: (in category 'gc - scavenge/compact') ----- vanillaShouldRemapObj: objOop + <inline: true> - <inline: #always> "Answer if the obj should be scavenged, or simply followed. Sent via the compactor from shouldRemapObj:. We test for being already scavenged because mapStackPages via mapInterpreterOops may be applied twice in the context of a global GC where a scavenge, followed by a scan-mark-free, and final compaction passes may result in scavenged fields being visited twice." ^(self isForwarded: objOop) or: [(self isReallyYoungObject: objOop) and: [(self isInFutureSpace: objOop) not]]! Item was added: + ----- Method: SpurPigCompactor class>>implicitReturnTypeFor: (in category 'translation') ----- + implicitReturnTypeFor: aSelector + "Answer the return type for methods that don't have an explicit return." + ^#void! Item was added: + ----- Method: SpurPlanningCompactor class>>declareCVarsIn: (in category 'translation') ----- + declareCVarsIn: aCCodeGenerator + aCCodeGenerator var: 'savedFirstFieldsSpace' type: #SpurContiguousObjStack! Item was added: + ----- Method: SpurPlanningCompactor class>>implicitReturnTypeFor: (in category 'translation') ----- + implicitReturnTypeFor: aSelector + "Answer the return type for methods that don't have an explicit return." + ^#void! Item was changed: ----- Method: SpurPlanningCompactor>>copyAndUnmarkObject:to:firstField: (in category 'compaction') ----- copyAndUnmarkObject: o to: toFinger firstField: firstField "Copy the object to toFinger, clearing its mark bit and restoring its firstField, which was overwritten with a forwarding pointer. Answer the number of bytes in the object, including overflow header." + <inline: true> - <inline: #always> | bytes numSlots destObj start | numSlots := manager rawNumSlotsOf: o. destObj := (manager objectWithRawSlotsHasOverflowHeader: numSlots) ifTrue: [toFinger + manager baseHeaderSize] ifFalse: [toFinger]. bytes := manager bytesInObject: o given: numSlots. start := manager startOfObject: o given: numSlots. manager mem: toFinger asVoidPointer cp: start asVoidPointer y: bytes; setIsMarkedOf: destObj to: false; storePointerUnchecked: 0 ofObject: destObj withValue: firstField. ^bytes! Item was changed: ----- Method: SpurPlanningCompactor>>isMobile: (in category 'private') ----- isMobile: obj + <inline: true> - <inline: #always> ^(self oop: obj isGreaterThanOrEqualTo: firstMobileObject andLessThanOrEqualTo: lastMobileObject) and: [(manager isPinned: obj) not]! Item was changed: ----- Method: SpurPlanningCompactor>>shouldRemapObj: (in category 'gc - scavenge/compact') ----- shouldRemapObj: objOop - <api> "Answer if the obj should be scavenged, or simply followed. Sent via the compactor from shouldRemapObj:. We test for being already scavenged because mapStackPages via mapInterpreterOops may be applied twice in the context of a global GC where a scavenge, followed by a scan-mark-free, and final compaction passes may result in scavenged fields being visited twice." + <api> + <inline: false> ^manager slidingCompactionShouldRemapObj: objOop! Item was changed: ----- Method: SpurPlanningCompactor>>updatePointersFrom:to:in: (in category 'compaction') ----- updatePointersFrom: start to: finish in: obj + <inline: true> - <inline: #always> start to: finish do: [:i| | oop fwd | oop := manager fetchPointer: i ofObject: obj. ((manager isNonImmediate: oop) and: [self isMobile: oop]) ifTrue: [self assert: (manager isMarked: oop). fwd := manager fetchPointer: 0 ofObject: oop. self assert: (self isPostMobile: fwd). manager storePointerUnchecked: i ofObject: obj withValue: fwd]]! Item was removed: - ----- Method: TMethod>>checkForCompleteness:in: (in category 'inlining') ----- - checkForCompleteness: stmtLists in: aCodeGen - "Set the complete flag if none of the given statement list nodes contains further candidates for inlining." - - complete := true. - stmtLists do: - [:stmtList| - stmtList statements do: - [:node| - [(self inlineableSend: node in: aCodeGen) ifTrue: - [complete := false. "more inlining to do" - ^self]]]]. - - parseTree - nodesDo: - [:node| - (self inlineableFunctionCall: node in: aCodeGen) ifTrue: - [complete := false. "more inlining to do" - ^self]] - unless: - [:node| - node isSend - and: [node selector == #cCode:inSmalltalk: - or: [aCodeGen isAssertSelector: node selector]]]! Item was added: + ----- Method: TMethod>>checkForCompletenessIn: (in category 'inlining support') ----- + checkForCompletenessIn: aCodeGen + "Set the complete flag if the parse tree contains no further candidates for inlining." + | foundIncompleteSend incompleteSends | + aCodeGen maybeBreakForTestOfInliningOf: selector. + + foundIncompleteSend := false. + incompleteSends := IdentitySet new. + + parseTree + nodesDo: + [:node| + node isSend ifTrue: + [(self methodIsEffectivelyComplete: node selector in: aCodeGen) + ifTrue: + [(self inlineableFunctionCall: node in: aCodeGen) ifTrue: + [complete := false. "more inlining to do" + ^self]] + ifFalse: + [foundIncompleteSend := true. + incompleteSends add: node]]] + unless: + [:node| + node isSend + and: [node selector == #cCode:inSmalltalk: + or: [aCodeGen isAssertSelector: node selector]]]. + + foundIncompleteSend ifFalse: + [complete := true]! Item was added: + ----- Method: TMethod>>incompleteSendsIn: (in category 'inlining support') ----- + incompleteSendsIn: aCodeGen + "Debugging support; answer the incomplete and inlineable sends in the receiver." + | incompleteSends inlineableSends | + aCodeGen maybeBreakForTestOfInliningOf: selector. + + incompleteSends := IdentitySet new. + inlineableSends := IdentitySet new. + + parseTree + nodesDo: + [:node| + node isSend ifTrue: + [(self methodIsEffectivelyComplete: node selector in: aCodeGen) + ifTrue: + [(self inlineableFunctionCall: node in: aCodeGen) ifTrue: + [inlineableSends add: node]] + ifFalse: + [incompleteSends add: node]]] + unless: + [:node| + node isSend + and: [node selector == #cCode:inSmalltalk: + or: [aCodeGen isAssertSelector: node selector]]]. + + ^{incompleteSends. inlineableSends}! Item was added: + ----- Method: TMethod>>inline: (in category 'accessing') ----- + inline: aBoolean + inline := aBoolean! 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 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) + and: [m mayBeInlined - and: [(m isFunctionalIn: aCodeGen) and: [(aCodeGen mayInline: m selector) + and: [aNode args allSatisfy: [:a| self isSubstitutableNode: a intoMethod: m in: aCodeGen]]]]]) - and: [aNode args allSatisfy: [:a| self isSubstitutableNode: a intoMethod: m in: aCodeGen]]]]) 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 mayBeInlined and: [(m isComplete and: [aCodeGen mayInline: m selector]) + or: [m checkForRequiredInlinability]]]]! - or: [m checkForRequiredInlinability]]]! Item was added: + ----- Method: TMethod>>mayBeInlined (in category 'accessing') ----- + mayBeInlined + ^inline == true or: [inline == nil or: [inline == #always]]! Item was added: + ----- Method: TMethod>>methodIsEffectivelyComplete:in: (in category 'inlining support') ----- + methodIsEffectivelyComplete: selector in: aCodeGen + "Answer if selector is effectively not inlineable in the receiver. + This is tricky because block inlining requires that certain methods must be inlined, which + can be at odds wuth the opportunistic strategy the inliner takes. Since the inliner only + inlines complete methods and certain methods may never be marked as complete (e.g. + recursive methods) we have to short-cut certain kinds of send. In particular, short-cut + sends that turn into jumps in the interpret routine (sharedCase and sharedLabel below)." + ^(aCodeGen methodNamed: selector) + ifNil: [true] "builtins or externals are not inlineable" + ifNotNil: + [:m| + m isComplete + "unlinable methods can't be inlined" + or: [m mayBeInlined not + "Methods which are inlined as jumps don't need inlining" + or: [m sharedCase notNil or: [m sharedLabel notNil]]]]! Item was changed: ----- Method: TMethod>>statementsListsForInliningIn: (in category 'inlining') ----- statementsListsForInliningIn: aCodeGen "Answer a collection of statement list nodes that are candidates for inlining. Currently, we cannot inline into the argument blocks of and: and or: messages. We do not want to inline code strings within cCode:inSmalltalk: blocks (those with a proper block for the cCode: argument are inlined in MessageNode>>asTranslatorNodeIn:). We do not want to inline code within assert: sends (because we want the assert to read nicely)." | stmtLists | stmtLists := OrderedCollection new: 10. parseTree nodesDo: [:node| node isStmtList ifTrue: [stmtLists add: node]] unless: [:node| node isSend and: [node selector == #cCode:inSmalltalk: or: [aCodeGen isAssertSelector: node selector]]]. parseTree nodesDo: [:node| node isSend ifTrue: [node selector = #cCode:inSmalltalk: ifTrue: [node nodesDo: [:ccisNode| stmtLists remove: ccisNode ifAbsent: []]]. + (node selector = #cppIf:ifTrue:ifFalse: or: [node selector = #cppIf:ifTrue:]) ifTrue: - node selector = #cppIf:ifTrue:ifFalse: ifTrue: [node args first nodesDo: [:inCondNode| stmtLists remove: inCondNode ifAbsent: []]]. ((node selector = #and:) or: [node selector = #or:]) ifTrue: "Note: the PP 2.3 compiler produces two arg nodes for these selectors" [stmtLists remove: node args first ifAbsent: []. stmtLists remove: node args last ifAbsent: []]. (#( #ifTrue: #ifFalse: #ifTrue:ifFalse: #ifFalse:ifTrue: #ifNil: #ifNotNil: #ifNil:ifNotNil: #ifNotNil:ifNil: ) includes: node selector) ifTrue: [stmtLists remove: node receiver ifAbsent: []]. (#(whileTrue whileTrue: whilefalse whileFalse:) includes: node selector) ifTrue: "Allow inlining if it is a [...] whileTrue/whileFalse. This is identified by having more than one statement in the receiver block in which case the C code wouldn't work anyways" [node receiver statements size = 1 ifTrue: [stmtLists remove: node receiver ifAbsent: []]]. (node selector = #to:do:) ifTrue: [stmtLists remove: node receiver ifAbsent: []. stmtLists remove: node args first ifAbsent: []]. (node selector = #to:by:do:) ifTrue: [stmtLists remove: node receiver ifAbsent: []. stmtLists remove: node args first ifAbsent: []. stmtLists remove: node args second ifAbsent: []]]. node isCaseStmt ifTrue: "don't inline cases" [node cases do: [:case| stmtLists remove: case ifAbsent: []]]]. ^stmtLists! Item was changed: ----- Method: TMethod>>tryToInlineMethodsIn: (in category 'inlining') ----- tryToInlineMethodsIn: aCodeGen "Expand any (complete) inline methods sent by this method. Set the complete flag when all inlining has been done. Answer if something was inlined." | didSomething statementLists | + "complete ifTrue: + [^false]." + self definedAsMacro ifTrue: + [complete ifTrue: + [^false]. + ^complete := true]. + - [complete := true. - ^false]. didSomething := self tryToInlineMethodStatementsIn: aCodeGen statementListsInto: [:stmtLists| statementLists := stmtLists]. didSomething := (self tryToInlineMethodExpressionsIn: aCodeGen) or: [didSomething]. didSomething ifTrue: + [writtenToGlobalVarsCache := nil]. - [writtenToGlobalVarsCache := nil. - ^didSomething]. complete ifFalse: + [self checkForCompletenessIn: aCodeGen. - [self checkForCompleteness: statementLists in: aCodeGen. complete ifTrue: [didSomething := true]]. "marking a method complete is progress" ^didSomething! Item was changed: ----- Method: VMMaker>>buildCodeGeneratorForInterpreter:includeAPIMethods:initializeClasses: (in category 'generate sources') ----- buildCodeGeneratorForInterpreter: interpreterClass includeAPIMethods: getAPIMethods initializeClasses: initializeClasses "Answer the code generator for translating the interpreter." | cg interpreterClasses | initializeClasses ifTrue: [interpreterClass initializeWithOptions: optionsDictionary. interpreterClass hasCogit ifTrue: + [interpreterClass cogitClass initializeWithOptions: optionsDictionary]. + interpreterClass objectMemoryClass initializationOptions: optionsDictionary]. - [interpreterClass cogitClass initializeWithOptions: optionsDictionary]]. (cg := self createCodeGenerator) vmClass: interpreterClass. "Construct interpreterClasses as all classes from interpreterClass & objectMemoryClass up to VMClass in superclass to subclass order." interpreterClasses := OrderedCollection new. {interpreterClass. interpreterClass objectMemoryClass} do: [:vmClass| | theClass | theClass := vmClass. [theClass ~~ VMClass] whileTrue: + [theClass initializationOptions: optionsDictionary. + interpreterClasses addFirst: theClass. - [interpreterClasses addFirst: theClass. theClass := theClass superclass]]. interpreterClasses addFirst: VMClass; addAllLast: (cg nonStructClassesForTranslationClasses: interpreterClasses). initializeClasses ifTrue: [interpreterClasses do: [:ic| (ic respondsTo: #initializeWithOptions:) ifTrue: [ic initializeWithOptions: optionsDictionary] ifFalse: [ic initialize]]. (cg structClassesForTranslationClasses: interpreterClasses) do: [:structClass| structClass initialize]]. cg addStructClasses: (cg structClassesForTranslationClasses: interpreterClasses). interpreterClasses do: [:ic| cg addClass: ic]. getAPIMethods ifTrue: [interpreterClass cogitClass ifNotNil: [:cogitClass| cg includeAPIFrom: (self buildCodeGeneratorForCogit: cogitClass includeAPIMethods: false initializeClasses: false)]]. ^cg!

1 0

Primitive table support for running older images
by David T. Lewis 26 Dec '16

26 Dec '16

I discovered that a recent update in VMMaker-dtl.387 (November 2016) breaks the VM for older images (including my own from about 10 or 15 years ago, not good). The reason is that some obsolete numbered primitives were removed to keep the primitive table in sync with Cog/Spur as much as possible. It is easy to revert the changes, and I plan to do that, but the issue begs for a more general solution. Given that the numbered primitive assignments change over time, and old primitives need to be retired to make room for the new, how best to provide continued support for older images with a current VM? The primitive table is initialized at compile time, and this works fine as long as the assignments do not change too often. On the other hand, if the table was initialized at run time, i.e. when first entering interpret(), then in principle it would be possible for the VM to examine the image to deduce its vintage, or it would be possible to explicitly request some version of the primitive table by means of a command line option to the VM. I played around wth this a bit in VMMaker, and I think that defining entire versions of the primitive table at runtime would require large methods that would probably to hard to understand and maintain. However, if we adopt a policy of using the latest primitive assignments as they appear in Cog/Spur for the default table at compile time, and then overriding those assignments as needed at run time, then it should be possible to maintain backward compatibility for old images without making too much of a mess out of the primitive table initialization. Thoughts? Dave

4 7

VM Maker: VMMaker.oscog-eem.2049.mcz
by commits＠source.squeak.org 25 Dec '16

25 Dec '16

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2049.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.2049 Author: eem Time: 25 December 2016, 1:02:36.91406 pm UUID: 82810f52-62c9-4dcf-aab4-3dfc7504f00f Ancestors: VMMaker.oscog-eem.2048 SpurPlanningCompactor: Solve the two GCs in a row bug by setting firstMobileObject to endOfMemory before scanning for free objects. Its value should not be a remnant from a previous compaction. fistFreeObject should be used as the start of each pass's enumeration, since this can ascend on each pass, whereas firstMobileObject must remain that of the first object whose first field has been saved in savedFirstFieldsSpace. Hence firstMobileObject should be reset before continuing in each of the continueOPERATIONFrom: methods. =============== Diff against VMMaker.oscog-eem.2048 =============== Item was changed: ----- Method: SpurPlanningCompactor>>continueCopyAndUnmarkMobileObjectsFrom: (in category 'compaction') ----- continueCopyAndUnmarkMobileObjectsFrom: anUnpinnedEntity "copyAndUnmarkMobileObjects has encountered a run of pinned objects around which + it cannot compact, but savedFirstFieldsSpace is still not full. Continue the pass with a + new firstFreeObject, resetting it before continuing. - it cannot compact, but savedFirstFieldsSpace is still not full. Continue the pass with new - firstFreeObject and firstMobileObject, resetting them before continuing. Answer if the end of the heap was reached (savedFirstFieldsSpace has not overflowed)." | result savedFirstFreeObject savedFirstMobileObject nextFreeObject | self assert: (self oop: anUnpinnedEntity isLessThan: manager endOfMemory). self deny: (manager isPinned: anUnpinnedEntity). savedFirstFreeObject := firstFreeObject. savedFirstMobileObject := firstMobileObject. nextFreeObject := self scanForFirstFreeAndFirstMobileObjectFrom: anUnpinnedEntity. + firstMobileObject := savedFirstMobileObject. nextFreeObject ifNil: [^true]. firstFreeObject := nextFreeObject. result := self copyAndUnmarkMobileObjects. firstFreeObject := savedFirstFreeObject. - firstMobileObject := savedFirstMobileObject. ^result! Item was changed: ----- Method: SpurPlanningCompactor>>continuePlanCompactSavingForwardersFrom: (in category 'compaction') ----- continuePlanCompactSavingForwardersFrom: anUnpinnedEntity "planCompactSavingForwarders has encountered a run of pinned objects around which + it cannot compact, but savedFirstFieldsSpace is still not full. Continue the pass with a + new firstFreeObject, resetting it before continuing. - it cannot compact, but savedFirstFieldsSpace is still not full. Continue the pass with new - firstFreeObject and firstMobileObject, resetting them before continuing. Answer if the end of the heap was reached (savedFirstFieldsSpace has not overflowed)." | result savedFirstFreeObject savedFirstMobileObject nextFreeObject | self assert: (self oop: anUnpinnedEntity isLessThan: manager endOfMemory). self deny: (manager isPinned: anUnpinnedEntity). savedFirstFreeObject := firstFreeObject. savedFirstMobileObject := firstMobileObject. nextFreeObject := self scanForFirstFreeAndFirstMobileObjectFrom: anUnpinnedEntity. + firstMobileObject := savedFirstMobileObject. nextFreeObject ifNil: [^true]. + firstFreeObject := nextFreeObject. result := self planCompactSavingForwarders. firstFreeObject := savedFirstFreeObject. - firstMobileObject := savedFirstMobileObject. ^result! Item was changed: ----- Method: SpurPlanningCompactor>>continueUpdatePointersInMobileObjectsFrom: (in category 'compaction') ----- continueUpdatePointersInMobileObjectsFrom: anUnpinnedEntity "updatePointersInMobileObjects has encountered a run of pinned objects around which planCompactSavingForwarders cannot compact, but savedFirstFieldsSpace is still not full. + Continue the pass with a new firstFreeObject , resetting it before continuing. - Continue the pass with new firstFreeObject and firstMobileObject, resetting them before continuing. Answer if the end of the heap was reached (savedFirstFieldsSpace has not overflowed)." | result savedFirstFreeObject savedFirstMobileObject nextFreeObject | self assert: (self oop: anUnpinnedEntity isLessThan: manager endOfMemory). self deny: (manager isPinned: anUnpinnedEntity). savedFirstFreeObject := firstFreeObject. savedFirstMobileObject := firstMobileObject. nextFreeObject := self scanForFirstFreeAndFirstMobileObjectFrom: anUnpinnedEntity. + firstMobileObject := savedFirstMobileObject. nextFreeObject ifNil: [^true]. + firstFreeObject := nextFreeObject. result := self updatePointersInMobileObjects. firstFreeObject := savedFirstFreeObject. - firstMobileObject := savedFirstMobileObject. ^result! Item was changed: ----- Method: SpurPlanningCompactor>>copyAndUnmark (in category 'compaction') ----- copyAndUnmark "Sweep the heap, unmarking all objects and moving mobile objects to their correct positions, restoring their savedFirstFields." | onePass | self unmarkInitialImmobileObjects. + "If savedFirstFieldsSpace is empty there is nothing to move, and no second pass." + savedFirstFieldsSpace top < savedFirstFieldsSpace start ifTrue: + [self assert: firstMobileObject >= manager endOfMemory. + ^self]. onePass := self copyAndUnmarkMobileObjects. onePass ifFalse: [self unmarkObjectsOverflowingSavedFirstFieldsSpace]! Item was changed: ----- Method: SpurPlanningCompactor>>copyAndUnmarkMobileObjects (in category 'compaction') ----- copyAndUnmarkMobileObjects "Sweep the mobile portion of the heap, moving objects to their eventual locations, and clearing their marked bits. Remember to update the savedFirstFields of pointer objects, as these have been forwarded. This enumeration matches that in planCompactSavingForwarders and updatePointersInMobileObjects." | toFinger top previousPin | toFinger := manager startOfObject: firstFreeObject. top := savedFirstFieldsSpace start - manager bytesPerOop. self deny: (manager isMarked: firstFreeObject). + manager allOldSpaceEntitiesForCompactingFrom: firstFreeObject do: - manager allOldSpaceEntitiesForCompactingFrom: firstMobileObject do: [:o| self assert: (previousPin isNil or: [toFinger < previousPin]). (manager isMarked: o) ifTrue: [(manager isPinned: o) ifTrue: [(manager isSegmentBridge: o) ifFalse: [manager setIsMarkedOf: o to: false. manager segmentManager notePinned: o]. previousPin ifNotNil: [self assert: previousPin > toFinger. ((manager isSegmentBridge: previousPin) and: [manager isSegmentBridge: o]) ifTrue: [self halt: 'empty segment']]. previousPin := o] ifFalse: [| availableSpace bytes next | (top := top + manager bytesPerOop) >= savedFirstFieldsSpace limit ifTrue: [self freeFrom: toFinger upTo: (manager startOfObject: o) previousPin: previousPin. ^false]. [previousPin notNil and: [availableSpace := (manager startOfObject: previousPin) - toFinger. bytes := manager bytesInObject: o. bytes ~= availableSpace and: [bytes + (2 * manager allocationUnit) < availableSpace]]] whileTrue: ["The object does not fit in the space between toFinger and previousPin. Move toFinger beyond previousPin and update previousPin appropriately." availableSpace > 0 ifTrue: [manager addFreeChunkWithBytes: availableSpace at: toFinger]. toFinger := manager addressAfter: previousPin. self assert: toFinger < manager endOfMemory. next := manager objectStartingAt: toFinger. next >= o ifTrue: [^self continueCopyAndUnmarkMobileObjectsFrom: next]. previousPin := (manager isPinned: next) ifTrue: [next]]. bytes := self copyAndUnmarkObject: o to: toFinger firstField: (manager longAt: top). toFinger := toFinger + bytes]]]. self freeFrom: toFinger upTo: manager endOfMemory previousPin: previousPin. ^true! Item was changed: ----- Method: SpurPlanningCompactor>>initializeScan (in category 'compaction') ----- initializeScan savedFirstFieldsSpace top: savedFirstFieldsSpace start - manager bytesPerOop. + self reinitializeScan! - firstFreeObject := self scanForFirstFreeAndFirstMobileObjectFrom: (manager objectAfter: manager hiddenRootsObject). - firstFreeObject ifNil: - [self error: 'uncompactable heap; no unmarked objects found']! Item was changed: ----- Method: SpurPlanningCompactor>>planCompactSavingForwarders (in category 'compaction') ----- planCompactSavingForwarders "Sweep the heap from firstFreeObject forwarding marked objects to where they can be moved to, saving their forwarding pointer in savedFirstFieldsSpace. Continue until either the end of the heap is reached or savedFirstFieldsSpace is full. Answer if the end of the heap was reached (savedFirstFieldsSpace has not overflowed). Note that this method is potentially recursive. If skipping a run of pinned objects causes the the algorithm to encounter another run of immobile objects it will recurse via continuePlanCompactSavingForwardersFrom:. This enumeration matches that in updatePointersInMobileObjects and copyAndUnmarkMobileObjects." | toFinger top previousPin | toFinger := manager startOfObject: firstFreeObject. top := savedFirstFieldsSpace top. self deny: (manager isMarked: firstFreeObject). + manager allOldSpaceEntitiesFrom: firstFreeObject do: - manager allOldSpaceEntitiesFrom: firstMobileObject do: [:o| self assert: (previousPin isNil or: [toFinger < previousPin]). (manager isMarked: o) ifTrue: [(manager isPinned: o) ifTrue: [previousPin ifNotNil: [self assert: previousPin > toFinger. ((manager isSegmentBridge: previousPin) and: [manager isSegmentBridge: o]) ifTrue: [self halt: 'empty segment']]. previousPin := o] ifFalse: [| availableSpace bytes next | (top := top + manager bytesPerOop) >= savedFirstFieldsSpace limit ifTrue: [savedFirstFieldsSpace top: top. ^false]. [previousPin notNil and: [availableSpace := (manager startOfObject: previousPin) - toFinger. bytes := manager bytesInObject: o. bytes ~= availableSpace and: [bytes + (2 * manager allocationUnit) < availableSpace]]] whileTrue: ["The object does not fit in the space between toFinger and previousPin. Move toFinger beyond previousPin and update previousPin appropriately." toFinger := manager addressAfter: previousPin. next := manager objectStartingAt: toFinger. next >= o ifTrue: [savedFirstFieldsSpace top: top. ^self continuePlanCompactSavingForwardersFrom: next]. previousPin := (manager isPinned: next) ifTrue: [next]]. lastMobileObject := o. manager longAt: top put: (manager fetchPointer: 0 ofObject: o); storePointerUnchecked: 0 "Don't use forward:to:; we dont want to alter the object in any way other than by setting the forwarding pointer" ofObject: o withValue: ((manager hasOverflowHeader: o) ifTrue: [toFinger + manager baseHeaderSize] ifFalse: [toFinger]). toFinger := toFinger + (manager bytesInObject: o)]]]. savedFirstFieldsSpace top: top. ^true! Item was changed: ----- Method: SpurPlanningCompactor>>reinitializeScan (in category 'compaction') ----- reinitializeScan + firstMobileObject := manager endOfMemory. firstFreeObject := self scanForFirstFreeAndFirstMobileObjectFrom: firstFreeObject. firstFreeObject ifNil: [self error: 'uncompactable heap; no unmarked objects found']! Item was changed: ----- Method: SpurPlanningCompactor>>updatePointers (in category 'compaction') ----- updatePointers "Sweep the heap, updating all objects to their eventual locations. Remember to update the savedFirstFields of pointer objects, as these have been forwarded." | onePass | + "If savedFirstFieldsSpace is empty there is nothing to do." + savedFirstFieldsSpace top < savedFirstFieldsSpace start ifTrue: + [^self]. coInterpreter mapInterpreterOops. self updatePointersInManagerHeapEntities. self updatePointersInSurvivingObjects. self updatePointersInInitialImmobileObjects. onePass := self updatePointersInMobileObjects. onePass ifFalse: [self updatePointersInObjectsOverflowingSavedFirstFieldsSpace]! Item was changed: ----- Method: SpurPlanningCompactor>>updatePointersInMobileObjects (in category 'compaction') ----- updatePointersInMobileObjects "Sweep the mobile portion of the heap, updating all references to objects to their eventual locations. Remember to update the savedFirstFields of pointer objects, as these have been forwarded. This enumeration matches that in planCompactSavingForwarders and copyAndUnmarkMobileObjects." | toFinger top previousPin | toFinger := manager startOfObject: firstFreeObject. top := savedFirstFieldsSpace start - manager bytesPerOop. self deny: (manager isMarked: firstFreeObject). + manager allOldSpaceEntitiesFrom: firstFreeObject do: - manager allOldSpaceEntitiesFrom: firstMobileObject do: [:o| self assert: (previousPin isNil or: [toFinger < previousPin]). (manager isMarked: o) ifTrue: [(manager isPinned: o) ifTrue: [self updatePointersIn: o startingAt: 0 savedFirstFieldPointer: nil. previousPin ifNotNil: [self assert: previousPin > toFinger. ((manager isSegmentBridge: previousPin) and: [manager isSegmentBridge: o]) ifTrue: [self halt: 'empty segment']]. previousPin := o] ifFalse: [| availableSpace bytes next | (top := top + manager bytesPerOop) >= savedFirstFieldsSpace limit ifTrue: [^false]. [previousPin notNil and: [availableSpace := (manager startOfObject: previousPin) - toFinger. bytes := manager bytesInObject: o. bytes ~= availableSpace and: [bytes + (2 * manager allocationUnit) < availableSpace]]] whileTrue: ["The object does not fit in the space between toFinger and previousPin. Move toFinger beyond previousPin and update previousPin appropriately." toFinger := manager addressAfter: previousPin. next := manager objectStartingAt: toFinger. next >= o ifTrue: [^self continueUpdatePointersInMobileObjectsFrom: next]. previousPin := (manager isPinned: next) ifTrue: [next]]. ((manager formatOf: o) <= manager lastPointerFormat and: [(manager numSlotsOf: o) > 0]) ifTrue: [| oop fwd | "Relocate the saved first field; Note that CompiledMethods can be excluded since their first field is either a SmallInteger or a reference to a CogMethod outside of oldSpace." oop := manager longAt: top. ((manager isNonImmediate: oop) and: [self isMobile: oop]) ifTrue: [self assert: (manager isMarked: oop). fwd := manager fetchPointer: 0 ofObject: oop. self assert: (self isPostMobile: fwd). manager longAt: top put: fwd]]. self updatePointersIn: o startingAt: 1 savedFirstFieldPointer: top. toFinger := toFinger + (manager bytesInObject: o)]]]. ^true!

1 0

VM Maker: VMMaker.oscog-eem.2048.mcz
by commits＠source.squeak.org 25 Dec '16

25 Dec '16

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2048.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.2048 Author: eem Time: 25 December 2016, 12:12:06.85768 pm UUID: ea2e348f-29b6-493f-8435-48a54725b7f1 Ancestors: VMMaker.oscog-eem.2047 First cut of SpurPlanningCompactor, a traditional two-finger sliding compactor adapted to handle pinned objects. It appears to work in the simulator with both CoInterpreter and StackInterpreter for a single GC, but does not handle Smalltalk garbageCollect; garbageCollect yet. Refacor scavengeInProgress into gcPhaseInProgress so that SpurPlanningCompactor can identify sliding compaction. Refactor shouldRemapObj:/remapObj: to double-dispatch throguh the compactor so that SpurPlanningCompactor can use its implicit forwarding test isMobile: to decide if a forwasrding pointer should be followed. Move globalGarbageCollect's segmentManager prepareForGlobalSweep send to immediately before compactor compact. Move nextInSortedFreeListLink:given: to SpurPigCompactor. Extract the printing in printOopsFrom:to: into printEntity:, which is useful on its own for debugging. Rename excludeUnmarkedNewSpaceObjs to excludeUnmarkedObjs throughout the leak checker; indeed any unmarked obj should be excluded immediately after the mark phase. Nuke a couple of unused methods and correct some comment spellings. =============== Diff against VMMaker.oscog-eem.2047 =============== Item was changed: ----- Method: CoInterpreter>>mapStackPages (in category 'object memory support') ----- mapStackPages <inline: #never> <var: #thePage type: #'StackPage *'> <var: #theSP type: #'char *'> <var: #theFP type: #'char *'> <var: #frameRcvrOffset type: #'char *'> <var: #callerFP type: #'char *'> <var: #theIPPtr type: #'char *'> | numLivePages | numLivePages := 0. 0 to: numStackPages - 1 do: [:i| | thePage theSP theFP frameRcvrOffset 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 := ((self isMachineCodeFrame: theFP) or: [(self iframeSavedIP: theFP) = 0]) ifTrue: [0] ifFalse: [theFP + FoxIFSavedIP]] 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]). frameRcvrOffset := self frameReceiverLocation: theFP. [theSP <= frameRcvrOffset] 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: - "forwarding scheme in SqueakV3 obj rep makes this hard to check." - objectMemory hasSpurMemoryManagerAPI ifTrue: [self assert: ((self isMarriedOrWidowedContext: (self frameContext: theFP)) and: [(self frameOfMarriedContext: (self frameContext: theFP)) = theFP])]]. (self isMachineCodeFrame: theFP) ifFalse: [(objectMemory shouldRemapObj: (self iframeMethod: theFP)) ifTrue: [theIPPtr ~= 0 ifTrue: [theIP := stackPages longAt: theIPPtr. theIP = cogit ceReturnToInterpreterPC ifTrue: [self assert: (self iframeSavedIP: theFP) > (self iframeMethod: theFP). theIPPtr := theFP + FoxIFSavedIP. theIP := stackPages longAt: theIPPtr] ifFalse: [self assert: theIP > (self iframeMethod: theFP)]. theIP := theIP - (self iframeMethod: theFP)]. stackPages longAt: theFP + FoxMethod put: (objectMemory remapObj: (self iframeMethod: theFP)). theIPPtr ~= 0 ifTrue: [stackPages longAt: theIPPtr put: theIP + (self iframeMethod: theFP)]]]. (callerFP := self frameCallerFP: theFP) ~= 0] whileTrue: [theSP := (theIPPtr := theFP + FoxCallerSavedIP) + objectMemory wordSize. theFP := callerFP]. theSP := theFP + FoxCallerSavedIP + objectMemory wordSize. [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: CogVMSimulator>>printHexnp: (in category 'debug printing') ----- printHexnp: anInteger traceOn ifTrue: + [transcript nextPutAll: ((anInteger ifNil: [0]) asInteger storeStringBase: 16)]! - [transcript nextPutAll: (anInteger asInteger storeStringBase: 16)]! Item was added: + ----- Method: Spur32BitCoMemoryManager>>methodHeaderFromSavedFirstField: (in category 'compaction') ----- + methodHeaderFromSavedFirstField: field + (self isIntegerObject: field) ifTrue: + [^field]. + self assert: ((self isNonImmediate: field) and: [field < newSpaceStart]). + self assert: (coInterpreter cCoerceSimple: field to: #'CogMethod *') objectHeader + = self nullHeaderForMachineCodeMethod. + ^(coInterpreter cCoerceSimple: field to: #'CogMethod *') methodHeader! Item was removed: - ----- Method: Spur32BitMMLECoSimulator>>runLeakCheckerFor:excludeUnmarkedNewSpaceObjs:classIndicesShouldBeValid: (in category 'debug support') ----- - runLeakCheckerFor: gcModes excludeUnmarkedNewSpaceObjs: excludeUnmarkedNewSpaceObjs classIndicesShouldBeValid: classIndicesShouldBeValid - (coInterpreter displayView isNil - and: [gcModes anyMask: checkForLeaks]) ifTrue: - [coInterpreter transcript nextPutAll: 'leak-checking...'; flush]. - ^super - runLeakCheckerFor: gcModes - excludeUnmarkedNewSpaceObjs: excludeUnmarkedNewSpaceObjs - classIndicesShouldBeValid: classIndicesShouldBeValid! Item was added: + ----- Method: Spur32BitMMLECoSimulator>>runLeakCheckerFor:excludeUnmarkedObjs:classIndicesShouldBeValid: (in category 'debug support') ----- + runLeakCheckerFor: gcModes excludeUnmarkedObjs: excludeUnmarkedObjs classIndicesShouldBeValid: classIndicesShouldBeValid + (coInterpreter displayView isNil + and: [gcModes anyMask: checkForLeaks]) ifTrue: + [coInterpreter transcript nextPutAll: 'leak-checking...'; flush]. + ^super + runLeakCheckerFor: gcModes + excludeUnmarkedObjs: excludeUnmarkedObjs + classIndicesShouldBeValid: classIndicesShouldBeValid! Item was removed: - ----- Method: Spur32BitMMLESimulator>>runLeakCheckerFor:excludeUnmarkedNewSpaceObjs:classIndicesShouldBeValid: (in category 'debug support') ----- - runLeakCheckerFor: gcModes excludeUnmarkedNewSpaceObjs: excludeUnmarkedNewSpaceObjs classIndicesShouldBeValid: classIndicesShouldBeValid - (coInterpreter displayView isNil - and: [gcModes anyMask: checkForLeaks]) ifTrue: - [coInterpreter transcript nextPutAll: 'leak-checking...'; flush]. - ^super - runLeakCheckerFor: gcModes - excludeUnmarkedNewSpaceObjs: excludeUnmarkedNewSpaceObjs - classIndicesShouldBeValid: classIndicesShouldBeValid! Item was added: + ----- Method: Spur32BitMMLESimulator>>runLeakCheckerFor:excludeUnmarkedObjs:classIndicesShouldBeValid: (in category 'debug support') ----- + runLeakCheckerFor: gcModes excludeUnmarkedObjs: excludeUnmarkedObjs classIndicesShouldBeValid: classIndicesShouldBeValid + (coInterpreter displayView isNil + and: [gcModes anyMask: checkForLeaks]) ifTrue: + [coInterpreter transcript nextPutAll: 'leak-checking...'; flush]. + ^super + runLeakCheckerFor: gcModes + excludeUnmarkedObjs: excludeUnmarkedObjs + classIndicesShouldBeValid: classIndicesShouldBeValid! Item was added: + ----- Method: Spur32BitMemoryManager>>bytesInObject:given: (in category 'object enumeration') ----- + bytesInObject: objOop given: rawNumSotsOfObjOop + "Answer the total number of bytes in an object including header and possible overflow size header, given the value of the object's numSlots field." + <returnTypeC: #usqInt> + <inline: true> + | numSlots | + numSlots := rawNumSotsOfObjOop = self numSlotsMask + ifTrue: [self rawOverflowSlotsOf: objOop] + ifFalse: [rawNumSotsOfObjOop = 0 ifTrue: [1] ifFalse: [rawNumSotsOfObjOop]]. + ^numSlots + (numSlots bitAnd: 1) << self shiftForWord + + (rawNumSotsOfObjOop = self numSlotsMask + ifTrue: [self baseHeaderSize + self baseHeaderSize] + ifFalse: [self baseHeaderSize])! Item was added: + ----- Method: Spur64BitCoMemoryManager>>methodHeaderFromSavedFirstField: (in category 'compaction') ----- + methodHeaderFromSavedFirstField: field + (self isIntegerObject: field) ifTrue: + [^field]. + self assert: ((self isNonImmediate: field) and: [field < newSpaceStart]). + self assert: (coInterpreter cCoerceSimple: field to: #'CogMethod *') objectHeader + = self nullHeaderForMachineCodeMethod. + ^(coInterpreter cCoerceSimple: field to: #'CogMethod *') methodHeader! Item was removed: - ----- Method: Spur64BitMMLECoSimulator>>runLeakCheckerFor:excludeUnmarkedNewSpaceObjs:classIndicesShouldBeValid: (in category 'debug support') ----- - runLeakCheckerFor: gcModes excludeUnmarkedNewSpaceObjs: excludeUnmarkedNewSpaceObjs classIndicesShouldBeValid: classIndicesShouldBeValid - (coInterpreter displayView isNil - and: [gcModes anyMask: checkForLeaks]) ifTrue: - [coInterpreter transcript nextPutAll: 'leak-checking...'; flush]. - ^super - runLeakCheckerFor: gcModes - excludeUnmarkedNewSpaceObjs: excludeUnmarkedNewSpaceObjs - classIndicesShouldBeValid: classIndicesShouldBeValid! Item was added: + ----- Method: Spur64BitMMLECoSimulator>>runLeakCheckerFor:excludeUnmarkedObjs:classIndicesShouldBeValid: (in category 'debug support') ----- + runLeakCheckerFor: gcModes excludeUnmarkedObjs: excludeUnmarkedObjs classIndicesShouldBeValid: classIndicesShouldBeValid + (coInterpreter displayView isNil + and: [gcModes anyMask: checkForLeaks]) ifTrue: + [coInterpreter transcript nextPutAll: 'leak-checking...'; flush]. + ^super + runLeakCheckerFor: gcModes + excludeUnmarkedObjs: excludeUnmarkedObjs + classIndicesShouldBeValid: classIndicesShouldBeValid! Item was removed: - ----- Method: Spur64BitMMLESimulator>>runLeakCheckerFor:excludeUnmarkedNewSpaceObjs:classIndicesShouldBeValid: (in category 'debug support') ----- - runLeakCheckerFor: gcModes excludeUnmarkedNewSpaceObjs: excludeUnmarkedNewSpaceObjs classIndicesShouldBeValid: classIndicesShouldBeValid - (coInterpreter displayView isNil - and: [gcModes anyMask: checkForLeaks]) ifTrue: - [coInterpreter transcript nextPutAll: 'leak-checking...'; flush]. - ^super - runLeakCheckerFor: gcModes - excludeUnmarkedNewSpaceObjs: excludeUnmarkedNewSpaceObjs - classIndicesShouldBeValid: classIndicesShouldBeValid! Item was added: + ----- Method: Spur64BitMMLESimulator>>runLeakCheckerFor:excludeUnmarkedObjs:classIndicesShouldBeValid: (in category 'debug support') ----- + runLeakCheckerFor: gcModes excludeUnmarkedObjs: excludeUnmarkedObjs classIndicesShouldBeValid: classIndicesShouldBeValid + (coInterpreter displayView isNil + and: [gcModes anyMask: checkForLeaks]) ifTrue: + [coInterpreter transcript nextPutAll: 'leak-checking...'; flush]. + ^super + runLeakCheckerFor: gcModes + excludeUnmarkedObjs: excludeUnmarkedObjs + classIndicesShouldBeValid: classIndicesShouldBeValid! Item was added: + ----- Method: Spur64BitMemoryManager>>bytesInObject:given: (in category 'object enumeration') ----- + bytesInObject: objOop given: rawNumSotsOfObjOop + "Answer the total number of bytes in an object including header and possible overflow size header, given the value of the object's numSlots field." + <returnTypeC: #usqInt> + <inline: true> + | numSlots | + numSlots := rawNumSotsOfObjOop = self numSlotsMask + ifTrue: [self rawOverflowSlotsOf: objOop] + ifFalse: [rawNumSotsOfObjOop = 0 ifTrue: [1] ifFalse: [rawNumSotsOfObjOop]]. + ^numSlots << self shiftForWord + + (rawNumSotsOfObjOop = self numSlotsMask + ifTrue: [self baseHeaderSize + self baseHeaderSize] + ifFalse: [self baseHeaderSize])! Item was added: + ----- Method: SpurGenerationScavenger>>relocateRememberedSet (in category 'remembered set') ----- + relocateRememberedSet + "For SpurPanningCompactor" + rememberedSet := manager firstIndexableField: manager rememberedSetObj! Item was changed: SharedPool subclass: #SpurMemoryManagementConstants instanceVariableNames: '' + classVariableNames: 'DontTenure MarkOnTenure MaxRTRefCount ScavengeInProgress SlidingCompactionInProgress TenureByAge TenureByClass TenureToShrinkRT' - classVariableNames: 'DontTenure MarkOnTenure MaxRTRefCount TenureByAge TenureByClass TenureToShrinkRT' poolDictionaries: '' category: 'VMMaker-SpurMemoryManager'! Item was changed: CogClass subclass: #SpurMemoryManager (excessive size, no diff calculated) Item was changed: ----- Method: SpurMemoryManager class>>initialize (in category 'class initialization') ----- initialize "SpurMemoryManager initialize" BitsPerByte := 8. "Initialize at least the become constants for the Spur bootstrap where the old ObjectMemory simulator is used before a Spur simulator is created.." self initializeSpurObjectRepresentationConstants. "An obj stack is a stack of objects stored in a hidden root slot, such as the markStack or the ephemeronQueue. It is a linked list of segments, with the hot end at the head of the list. It is a word object. The stack pointer is in ObjStackTopx and 0 means empty. The list goes through ObjStackNextx. We don't want to shrink objStacks, since they're used in GC and it's good to keep their memory around. So unused pages created by popping emptied pages are kept on the ObjStackFreex list. ObjStackNextx must be the last field for swizzleObjStackAt:." ObjStackPageSlots := 4092. "+ double header = 16k bytes per page in 32-bits" ObjStackTopx := 0. ObjStackMyx := 1. ObjStackFreex := 2. ObjStackNextx := 3. ObjStackFixedSlots := 4. ObjStackLimit := ObjStackPageSlots - ObjStackFixedSlots. "The hiddenHootsObject contains the classTable pages and up to 8 additional objects. Currently we use four; the three objStacks, the mark stack, the weaklings and the mourn queue, and the rememberedSet." MarkStackRootIndex := self basicNew classTableRootSlots. WeaklingStackRootIndex := MarkStackRootIndex + 1. MournQueueRootIndex := MarkStackRootIndex + 2. RememberedSetRootIndex := MarkStackRootIndex + 3. MarkObjectsForEnumerationPrimitives := false. "The remap buffer support is for compatibility; Spur doesn't GC during allocation. Eventually this should die." RemapBufferSize := 25. "Extra roots are for plugin support." + ExtraRootsSize := 2048. "max. # of external roots" + + "gcPhaseInProgress takes these values to identify phases as required." + ScavengeInProgress := 1. + SlidingCompactionInProgress := 2! - ExtraRootsSize := 2048 "max. # of external roots"! Item was changed: ----- Method: SpurMemoryManager>>addressCouldBeObj: (in category 'debug support') ----- addressCouldBeObj: address <api> <inline: false> ^(address bitAnd: self baseHeaderSize - 1) = 0 and: [(self isInOldSpace: address) or: [(self isInEden: address) or: [(self isInPastSpace: address) + or: [self scavengeInProgress and: [self isInFutureSpace: address]]]]]! - or: [scavengeInProgress and: [self isInFutureSpace: address]]]]]! Item was added: + ----- Method: SpurMemoryManager>>allOldSpaceEntitiesForCompactingFrom:do: (in category 'object enumeration') ----- + allOldSpaceEntitiesForCompactingFrom: initialObject do: aBlock + <inline: true> + | prevObj prevPrevObj objOop nextObj | + self assert: (self isOldObject: initialObject). + prevPrevObj := prevObj := nil. + objOop := initialObject. + [self assert: objOop \\ self allocationUnit = 0. + self oop: objOop isLessThan: endOfMemory] whileTrue: + [self assert: (self long64At: objOop) ~= 0. + nextObj := self objectAfter: objOop limit: endOfMemory. + aBlock value: objOop. + prevPrevObj := prevObj. + prevObj := objOop. + objOop := nextObj]. + self touch: prevPrevObj. + self touch: prevObj! Item was removed: - ----- Method: SpurMemoryManager>>anyMobileObjectsFrom:below: (in category 'compaction') ----- - anyMobileObjectsFrom: initialOop below: limit - self allOldSpaceEntitiesFrom: initialOop - do: [:objOop| | isMobile | "this variable is to avoid limitations in Slang's inliner" - isMobile := self isMobileObject: objOop. - isMobile ifTrue: - [^true]]. - ^false! Item was added: + ----- Method: SpurMemoryManager>>beginSlidingCompaction (in category 'gc - scavenge/compact') ----- + beginSlidingCompaction + gcPhaseInProgress := SlidingCompactionInProgress! Item was changed: ----- Method: SpurMemoryManager>>checkHeapIntegrity:classIndicesShouldBeValid: (in category 'debug support') ----- + checkHeapIntegrity: excludeUnmarkedObjs classIndicesShouldBeValid: classIndicesShouldBeValid - checkHeapIntegrity: excludeUnmarkedNewSpaceObjs classIndicesShouldBeValid: classIndicesShouldBeValid "Perform an integrity/leak check using the heapMap. Assume clearLeakMapAndMapAccessibleObjects has set a bit at each (non-free) object's header. Scan all objects in the heap checking that every pointer points to a header. Scan the rememberedSet, remapBuffer and extraRootTable checking that every entry is a pointer to a header. Check that the number of roots is correct and that all rememberedSet entries have their isRemembered: flag set. Answer if all checks pass." | ok numRememberedObjectsInHeap | <inline: false> ok := true. numRememberedObjectsInHeap := 0. 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); cr. self eek. 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 classIndex classOop | (self isFreeObject: obj) ifTrue: [coInterpreter print: 'young object '; printHex: obj; print: ' is free'; cr. self eek. ok := false] ifFalse: + [((self isMarked: obj) not and: [excludeUnmarkedObjs]) ifFalse: - [((self isMarked: obj) not and: [excludeUnmarkedNewSpaceObjs]) ifFalse: [(self isRemembered: obj) ifTrue: [coInterpreter print: 'young object '; printHex: obj; print: ' is remembered'; cr. self eek. ok := false]]. (self isForwarded: obj) ifTrue: [fieldOop := self fetchPointer: 0 ofMaybeForwardedObject: obj. (heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0 ifTrue: [coInterpreter print: 'object leak in forwarder '; printHex: obj; print: ' to unmapped '; printHex: fieldOop; cr. self eek. ok := false]] ifFalse: [classOop := self classOrNilAtIndex: (classIndex := self classIndexOf: obj). (classIndicesShouldBeValid and: [classOop = nilObj and: [(self isHiddenObj: obj) not]]) ifTrue: [coInterpreter print: 'object leak in '; printHex: obj; print: ' invalid class index '; printHex: classIndex; print: ' -> '; print: (classOop ifNil: ['nil'] ifNotNil: ['nilObj']); cr. self eek. ok := false]. 0 to: (self numPointerSlotsOf: obj) - 1 do: [:fi| fieldOop := self fetchPointer: fi ofObject: obj. (self isNonImmediate: fieldOop) ifTrue: [(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0 ifTrue: [coInterpreter print: 'object leak in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; cr. self eek. ok := false]]]]]]. self allOldSpaceEntitiesDo: [:obj| | containsYoung fieldOop classIndex classOop | (self isFreeObject: obj) ifTrue: [(heapMap heapMapAtWord: (self pointerForOop: obj)) ~= 0 ifTrue: [coInterpreter print: 'leak in free chunk '; printHex: obj; print: ' is mapped?!! '; cr. self eek. ok := false]. fieldOop := self fetchPointer: self freeChunkNextIndex ofFreeChunk: obj. (fieldOop ~= 0 and: [(heapMap heapMapAtWord: (self pointerForOop: obj)) ~= 0]) ifTrue: [coInterpreter print: 'leak in free chunk '; printHex: obj; print: ' @ 0 = '; printHex: fieldOop; print: ' is mapped'; cr. self eek. 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: obj)) ~= 0]) ifTrue: [coInterpreter print: 'leak in free chunk '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; print: ' is mapped'; cr. self eek. ok := false].]]] ifFalse: + [(excludeUnmarkedObjs and: [(self isMarked: obj)not]) ifTrue: [] ifFalse: [ + containsYoung := false. - [containsYoung := false. (self isRemembered: obj) ifTrue: [numRememberedObjectsInHeap := numRememberedObjectsInHeap + 1. (scavenger isInRememberedSet: obj) ifFalse: [coInterpreter print: 'remembered object '; printHex: obj; print: ' is not in remembered table'; cr. self eek. ok := false]]. (self isForwarded: obj) ifTrue: [fieldOop := self fetchPointer: 0 ofMaybeForwardedObject: obj. (heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0 ifTrue: [coInterpreter print: 'object leak in forwarder '; printHex: obj; print: ' to unmapped '; printHex: fieldOop; cr. self eek. ok := false]. (self isReallyYoung: fieldOop) ifTrue: [containsYoung := true]] ifFalse: [classOop := self classOrNilAtIndex: (classIndex := self classIndexOf: obj). (classIndicesShouldBeValid and: [classOop = nilObj and: [classIndex > self lastClassIndexPun]]) ifTrue: [coInterpreter print: 'object leak in '; printHex: obj; print: ' invalid class index '; printHex: classIndex; print: ' -> '; print: (classOop ifNil: ['nil'] ifNotNil: ['nilObj']); cr. self eek. ok := false]. 0 to: (self numPointerSlotsOf: obj) - 1 do: [:fi| fieldOop := self fetchPointer: fi ofObject: obj. (self isNonImmediate: fieldOop) ifTrue: + [(self heapMapAtWord: (self pointerForOop: fieldOop)) = 0 ifTrue: - [(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0 ifTrue: [coInterpreter print: 'object leak in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; cr. self eek. ok := false]. "don't be misled by CogMethods; they appear to be young, but they're not" (self isReallyYoung: fieldOop) ifTrue: [containsYoung := true]]]]. containsYoung ifTrue: [(self isRemembered: obj) ifFalse: [coInterpreter print: 'unremembered object '; printHex: obj; print: ' contains young oop(s)'; cr. self eek. + ok := false]]]]]. - ok := false]]]]. numRememberedObjectsInHeap ~= scavenger rememberedSetSize ifTrue: [coInterpreter print: 'root count mismatch. #heap roots '; printNum: numRememberedObjectsInHeap; print: '; #roots '; printNum: scavenger rememberedSetSize; cr. self eek. "But the system copes with overflow..." self flag: 'no support for remembered set overflow yet'. "ok := rootTableOverflowed and: [needGCFlag]"]. scavenger rememberedSetWithIndexDo: [:obj :i| (obj bitAnd: self wordSize - 1) ~= 0 ifTrue: [coInterpreter print: 'misaligned oop in remembered set @ '; printNum: i; print: ' = '; printHex: obj; cr. self eek. ok := false] ifFalse: [(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0 ifTrue: [coInterpreter print: 'object leak in remembered set @ '; printNum: i; print: ' = '; printHex: obj; cr. self eek. ok := false] ifFalse: [(self isYoung: obj) ifTrue: [coInterpreter print: 'non-root in remembered set @ '; printNum: i; print: ' = '; printHex: obj; cr. self eek. ok := false]]]]. self objStack: mournQueue do: [:i :page| | obj | obj := self fetchPointer: i ofObject: page. (obj bitAnd: self wordSize - 1) ~= 0 ifTrue: [coInterpreter print: 'misaligned oop in mournQueue @ '; printNum: i; print: ' in '; printHex: page; print: ' = '; printHex: obj; cr. self eek. ok := false] ifFalse: + [(excludeUnmarkedObjs and: [(self isMarked: obj) not]) ifFalse: - [(excludeUnmarkedNewSpaceObjs and: [(self isYoung: obj) and: [(self isMarked: obj) not]]) ifFalse: [(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0 ifTrue: [coInterpreter print: 'object leak in mournQueue @ '; printNum: i; print: ' in '; printHex: page; print: ' = '; printHex: obj; cr. self eek. ok := false]]]]. 1 to: remapBufferCount do: [:ri| | obj | obj := remapBuffer at: ri. (obj bitAnd: self wordSize - 1) ~= 0 ifTrue: [coInterpreter print: 'misaligned remapRoot @ '; printNum: ri; print: ' = '; printHex: obj; cr. self eek. ok := false] ifFalse: [(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0 ifTrue: [coInterpreter print: 'object leak in remapRoots @ '; printNum: ri; print: ' = '; printHex: obj; cr. self eek. ok := false]]]. 1 to: extraRootCount do: [:ri| | obj | obj := (extraRoots at: ri) at: 0. (obj bitAnd: self wordSize - 1) ~= 0 ifTrue: [coInterpreter print: 'misaligned extraRoot @ '; printNum: ri; print: ' => '; printHex: obj; cr. self eek. ok := false] ifFalse: [(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0 ifTrue: [coInterpreter print: 'object leak in extraRoots @ '; printNum: ri; print: ' => '; printHex: obj; cr. self eek. ok := false]]]. ^ok! Item was removed: - ----- Method: SpurMemoryManager>>copyAndForward:withBytes:toFreeChunk: (in category 'compaction') ----- - copyAndForward: objOop withBytes: bytes toFreeChunk: freeChunk - "Copy and forward objOop to freeChunk, the inner operation in compaction." - - <inline: true> - | startOfObj freeObj | - startOfObj := self startOfObject: objOop. - self mem: freeChunk asVoidPointer cp: startOfObj asVoidPointer y: bytes. - freeObj := freeChunk + (objOop - startOfObj). - "leave it to followRememberedForwarders to remember..." - "(self isRemembered: objOop) ifTrue: - [scavenger remember: freeObj]." - self forward: objOop to: freeObj! Item was changed: ----- Method: SpurMemoryManager>>doScavenge: (in category 'gc - scavenging') ----- doScavenge: tenuringCriterion "The inner shell for scavenge, abstrascted out so globalGarbageCollect can use it." <inline: false> + gcPhaseInProgress := ScavengeInProgress. - scavengeInProgress := true. pastSpaceStart := scavenger scavenge: tenuringCriterion. self assert: (self oop: pastSpaceStart isGreaterThanOrEqualTo: scavenger pastSpace start andLessThanOrEqualTo: scavenger pastSpace limit). freeStart := scavenger eden start. self initSpaceForAllocationCheck: (self addressOf: scavenger eden) limit: scavengeThreshold. + gcPhaseInProgress := 0! - scavengeInProgress := false! Item was added: + ----- Method: SpurMemoryManager>>endSlidingCompaction (in category 'gc - scavenge/compact') ----- + endSlidingCompaction + gcPhaseInProgress := 0! Item was changed: ----- Method: SpurMemoryManager>>globalGarbageCollect (in category 'gc - global') ----- globalGarbageCollect <inline: true> "inline into fullGC" self assert: self validObjStacks. self assert: (self isEmptyObjStack: markStack). self assert: (self isEmptyObjStack: weaklingStack). "Mark objects /before/ scavenging, to empty the rememberedTable of unmarked roots." self markObjects: true. scavenger forgetUnmarkedRememberedObjects. self doScavenge: MarkOnTenure. - segmentManager prepareForGlobalSweep. "for notePinned:" - compactor freeUnmarkedObjectsAndPrepareFreeSpace. - "Mid-way the leak check must be more lenient. Unmarked classes will have been expunged from the table, but unmarked instances will not yet have been reclaimed." self runLeakCheckerFor: GCModeFull + excludeUnmarkedObjs: true - excludeUnmarkedNewSpaceObjs: true classIndicesShouldBeValid: true. + segmentManager prepareForGlobalSweep. "for notePinned:" compactor compact. self setHeapSizeAtPreviousGC. self assert: self validObjStacks. self assert: (self isEmptyObjStack: markStack). self assert: (self isEmptyObjStack: weaklingStack). self assert: self allObjectsUnmarked. self runLeakCheckerFor: GCModeFull! Item was removed: - ----- Method: SpurMemoryManager>>inLineRunLeakCheckerFor:excludeUnmarkedNewSpaceObjs:classIndicesShouldBeValid: (in category 'debug support') ----- - inLineRunLeakCheckerFor: gcModes excludeUnmarkedNewSpaceObjs: excludeUnmarkedNewSpaceObjs classIndicesShouldBeValid: classIndicesShouldBeValid - <inline: true> - (gcModes anyMask: checkForLeaks) ifTrue: - [(gcModes anyMask: GCModeFull) - ifTrue: [coInterpreter reverseDisplayFrom: 0 to: 7] - ifFalse: [coInterpreter reverseDisplayFrom: 8 to: 15]. - self clearLeakMapAndMapAccessibleObjects. - self asserta: (self checkHeapIntegrity: excludeUnmarkedNewSpaceObjs classIndicesShouldBeValid: classIndicesShouldBeValid). - self asserta: coInterpreter checkInterpreterIntegrity. - self asserta: coInterpreter checkStackIntegrity. - self asserta: (coInterpreter checkCodeIntegrity: gcModes)]! Item was added: + ----- Method: SpurMemoryManager>>inLineRunLeakCheckerFor:excludeUnmarkedObjs:classIndicesShouldBeValid: (in category 'debug support') ----- + inLineRunLeakCheckerFor: gcModes excludeUnmarkedObjs: excludeUnmarkedObjs classIndicesShouldBeValid: classIndicesShouldBeValid + <inline: true> + (gcModes anyMask: checkForLeaks) ifTrue: + [(gcModes anyMask: GCModeFull) + ifTrue: [coInterpreter reverseDisplayFrom: 0 to: 7] + ifFalse: [coInterpreter reverseDisplayFrom: 8 to: 15]. + self clearLeakMapAndMapAccessibleObjects. + self asserta: (self checkHeapIntegrity: excludeUnmarkedObjs classIndicesShouldBeValid: classIndicesShouldBeValid). + self asserta: coInterpreter checkInterpreterIntegrity. + self asserta: coInterpreter checkStackIntegrity. + self asserta: (coInterpreter checkCodeIntegrity: gcModes)]! Item was changed: ----- Method: SpurMemoryManager>>initialize (in category 'initialization') ----- initialize "We can put all initializations that set something to 0 or to false here. In C all global variables are initialized to 0, and 0 is false." remapBuffer := Array new: RemapBufferSize. remapBufferCount := extraRootCount := 0. "see below" freeListsMask := totalFreeOldSpace := lowSpaceThreshold := 0. checkForLeaks := 0. + needGCFlag := signalLowSpace := marking := false. + becomeEffectsFlags := gcPhaseInProgress := 0. - needGCFlag := signalLowSpace := scavengeInProgress := marking := false. - becomeEffectsFlags := 0. statScavenges := statIncrGCs := statFullGCs := 0. statScavengeGCUsecs := statIncrGCUsecs := statFullGCUsecs := statGCEndUsecs := 0. statSGCDeltaUsecs := statIGCDeltaUsecs := statFGCDeltaUsecs := 0. statGrowMemory := statShrinkMemory := statRootTableCount := 0. statRootTableOverflows := statMarkCount := statCompactPassCount := statCoalesces := 0. "We can initialize things that are allocated but are lazily initialized." unscannedEphemerons := SpurContiguousObjStack new. "we can initialize things that are virtual in C." scavenger := SpurGenerationScavengerSimulator new manager: self; yourself. segmentManager := SpurSegmentManager new manager: self; yourself. compactor := self class compactorClass new manager: self; yourself. "We can also initialize here anything that is only for simulation." heapMap := CogCheck32BitHeapMap new. "N.B. We *don't* initialize extraRoots because we don't simulate it." maxOldSpaceSize := self class initializationOptions ifNotNil: [:initOpts| initOpts at: #maxOldSpaceSize ifAbsent: [0]] ifNil: [0]! Item was changed: ----- Method: SpurMemoryManager>>isInMemory: (in category 'plugin support') ----- isInMemory: address "Answer if the given address is in ST object memory." (self isInNewSpace: address) ifTrue: [^(self isInEden: address) or: [(self isInPastSpace: address) + or: [self scavengeInProgress and: [self isInFutureSpace: address]]]]. - or: [scavengeInProgress and: [self isInFutureSpace: address]]]]. ^segmentManager isInSegments: address! Item was added: + ----- Method: SpurMemoryManager>>methodHeaderFromSavedFirstField: (in category 'compaction') ----- + methodHeaderFromSavedFirstField: oop + self assert: (self isIntegerObject: oop). + ^oop! Item was removed: - ----- Method: SpurMemoryManager>>nextInSortedFreeListLink:given: (in category 'compaction') ----- - nextInSortedFreeListLink: freeChunk given: prevFree - "Answer the next free free chunk using the xor trick to use only one field, see e.g. - The Art of Computer Programming, Vol 1, D.E. Knuth, 3rd Ed, Sec 2.2.4 `Circular Lists', exercise. 18 - http://en.wikipedia.org/wiki/XOR_linked_list." - <api> - ^((self fetchPointer: self freeChunkNextIndex ofFreeChunk: freeChunk) bitXor: prevFree) asUnsignedInteger! Item was changed: ----- Method: SpurMemoryManager>>objectAfter:limit: (in category 'object enumeration') ----- objectAfter: objOop limit: limit "Object parsing. 1. all objects have at least a word following the header, for a forwarding pointer. + 2. objects with an overflow size have a preceding word with a saturated numSlots. If the word - 2. objects with an overflow size have a preceeing word with a saturated numSlots. If the word following an object doesn't have a saturated numSlots field it must be a single-header object. If the word following does have a saturated numSlots it must be the overflow size word." ^self subclassResponsibility! Item was added: + ----- Method: SpurMemoryManager>>objectWithRawSlotsHasOverflowHeader: (in category 'header access') ----- + objectWithRawSlotsHasOverflowHeader: rawNumSlots + ^rawNumSlots = self numSlotsMask! Item was added: + ----- Method: SpurMemoryManager>>prepareObjStackForPlanningCompactor: (in category 'compaction') ----- + prepareObjStackForPlanningCompactor: objStack + "SpurPlanningCompactor overwrites the first fields of all moved objects, and saves these + fields in a data structure from which they can only be retrieved while scanning the heap. + The first field of an objStack page is its stack index, and so to know how many fields in an + objStack page to update it is necessary to save the ObjStackTopx field somewhere temporarily. + We use the hash field." + + | stackOrNil | + objStack = nilObj ifTrue: + [^self]. + stackOrNil := objStack. + [self assert: (self numSlotsOfAny: stackOrNil) = ObjStackPageSlots. + self setHashBitsOf: stackOrNil to: (self fetchPointer: ObjStackTopx ofObject: stackOrNil). + (stackOrNil := self fetchPointer: ObjStackNextx ofObject: stackOrNil) ~= 0] whileTrue! Item was added: + ----- Method: SpurMemoryManager>>prepareObjStacksForPlanningCompactor (in category 'compaction') ----- + prepareObjStacksForPlanningCompactor + "SpurPlanningCompactor overwrites the first fields of all moved objects, and saves these + fields in a data structure from which they can only be retrieved while scanning the heap. + The first field of an objStack page is its stack index, and so to know how many fields in an + objStack page to update it is necessary to save the ObjStackTopx field somewhere temporarily. + We use the hash field." + + self + prepareObjStackForPlanningCompactor: markStack; + prepareObjStackForPlanningCompactor: weaklingStack; + prepareObjStackForPlanningCompactor: mournQueue! Item was added: + ----- Method: SpurMemoryManager>>printEntity: (in category 'debug printing') ----- + printEntity: oop + coInterpreter + printHex: oop; print: '/'; printNum: oop; space; + print: ((self isFreeObject: oop) ifTrue: ['free'] ifFalse: + [(self isSegmentBridge: oop) ifTrue: ['bridge'] ifFalse: + [(self isForwarded: oop) ifTrue: ['forwarder'] ifFalse: + ['object']]]); + space; printHex: (self bytesInObject: oop); print: '/'; printNum: (self bytesInObject: oop); cr! Item was changed: ----- Method: SpurMemoryManager>>printOopsFrom:to: (in category 'debug printing') ----- printOopsFrom: startAddress to: endAddress <api> | oop limit | oop := self objectBefore: startAddress. limit := endAddress asUnsignedIntegerPtr min: endOfMemory. oop := oop ifNil: [startAddress] ifNotNil: [(self objectAfter: oop) = startAddress ifTrue: [startAddress] ifFalse: [oop]]. [self oop: oop isLessThan: limit] whileTrue: + [self printEntity: oop. + oop := self objectAfter: oop]! - [coInterpreter - printHex: oop; print: '/'; printNum: oop; space; - print: ((self isFreeObject: oop) ifTrue: ['free'] ifFalse: - [(self isSegmentBridge: oop) ifTrue: ['bridge'] ifFalse: - [(self isForwarded: oop) ifTrue: ['forwarder'] ifFalse: - ['object']]]); - cr. - oop := self objectAfter: oop]! Item was added: + ----- Method: SpurMemoryManager>>relocateObjStackForPlanningCompactor: (in category 'compaction') ----- + relocateObjStackForPlanningCompactor: objStack + "Relocate all objStack pages that cmprise objStack." + | stackOrNil freeList next relocated result | + objStack = nilObj ifTrue: + [^objStack]. + stackOrNil := objStack. + freeList := self fetchPointer: ObjStackFreex ofObject: objStack. + [self assert: (self numSlotsOfAny: stackOrNil) = ObjStackPageSlots. + "There are four fixed slots in an obj stack, and a Topx of 0 indicates empty, so + if there were 5 slots in an oop stack, full would be 2, and the last 0-rel index is 4. + Hence the last index is topx + fixed slots - 1, or topx + ObjStackNextx" + next := self fetchPointer: ObjStackNextx ofObject: stackOrNil. + relocated := compactor + relocateObjectsInHeapEntity: stackOrNil + from: ObjStackFreex + to: ObjStackNextx + (self rawHashBitsOf: stackOrNil). + stackOrNil = objStack ifTrue: + [result := relocated]. + self setHashBitsOf: stackOrNil to: 0. + next ~= 0] + whileTrue: + [stackOrNil := next]. + [freeList ~= 0] whileTrue: + [self assert: (self numSlotsOfAny: freeList) = ObjStackPageSlots. + next := self fetchPointer: ObjStackFreex ofObject: freeList. + compactor + relocateObjectsInHeapEntity: freeList + from: ObjStackFreex + to: ObjStackFreex. + freeList := next]. + ^relocated! Item was added: + ----- Method: SpurMemoryManager>>relocateObjStacksForPlanningCompactor (in category 'compaction') ----- + relocateObjStacksForPlanningCompactor + "Relocate all non-empty objStack pages, following the objStacks from the roots." + + markStack := self relocateObjStackForPlanningCompactor: markStack. + weaklingStack := self relocateObjStackForPlanningCompactor: weaklingStack. + mournQueue := self relocateObjStackForPlanningCompactor: mournQueue! Item was changed: + ----- Method: SpurMemoryManager>>remapObj: (in category 'gc - scavenge/compact') ----- - ----- Method: SpurMemoryManager>>remapObj: (in category 'gc - scavenging') ----- remapObj: objOop "Scavenge or simply follow objOop. Answer the new location of objOop. The send should have been guarded by a send of shouldRemapOop:. + The method is called remapObj: for compatibility with ObjectMemory. + Defer to the compactor to choose the actual method, there being a + difference between the vanilla method and that used with a sliding + compactor where objects are not marked as forwarded." + <doNotGenerate> + ^compactor remapObj: objOop! - The method is called remapObj: for compatibility with ObjectMemory." - <api> - <inline: false> - | resolvedObj | - self assert: (self shouldRemapOop: objOop). - (self isForwarded: objOop) - ifTrue: - [resolvedObj := self followForwarded: objOop] - ifFalse: - [self deny: (self isInFutureSpace: objOop). - resolvedObj := objOop]. - (scavengeInProgress - and: [(self isReallyYoung: resolvedObj) "don't scavenge immediate, old, or CogMethod objects." - and: [(self isInFutureSpace: resolvedObj) not]]) ifTrue: - [^scavenger copyAndForward: resolvedObj]. - ^resolvedObj! Item was changed: ----- Method: SpurMemoryManager>>runLeakCheckerFor: (in category 'debug support') ----- runLeakCheckerFor: gcModes <inline: false> ^self inLineRunLeakCheckerFor: gcModes + excludeUnmarkedObjs: false - excludeUnmarkedNewSpaceObjs: false classIndicesShouldBeValid: true! Item was removed: - ----- Method: SpurMemoryManager>>runLeakCheckerFor:excludeUnmarkedNewSpaceObjs:classIndicesShouldBeValid: (in category 'debug support') ----- - runLeakCheckerFor: gcModes excludeUnmarkedNewSpaceObjs: excludeUnmarkedNewSpaceObjs classIndicesShouldBeValid: classIndicesShouldBeValid - <inline: false> - self inLineRunLeakCheckerFor: gcModes - excludeUnmarkedNewSpaceObjs: excludeUnmarkedNewSpaceObjs - classIndicesShouldBeValid: classIndicesShouldBeValid! Item was added: + ----- Method: SpurMemoryManager>>runLeakCheckerFor:excludeUnmarkedObjs:classIndicesShouldBeValid: (in category 'debug support') ----- + runLeakCheckerFor: gcModes excludeUnmarkedObjs: excludeUnmarkedObjs classIndicesShouldBeValid: classIndicesShouldBeValid + <inline: false> + self inLineRunLeakCheckerFor: gcModes + excludeUnmarkedObjs: excludeUnmarkedObjs + classIndicesShouldBeValid: classIndicesShouldBeValid! Item was added: + ----- Method: SpurMemoryManager>>scavengeInProgress (in category 'testing') ----- + scavengeInProgress + ^gcPhaseInProgress == ScavengeInProgress! Item was changed: ----- Method: SpurMemoryManager>>shortPrintObjectsFrom:to: (in category 'debug printing') ----- shortPrintObjectsFrom: startAddress to: endAddress <api> | oop | oop := self objectBefore: startAddress. oop := oop ifNil: [startAddress] ifNotNil: [(self objectAfter: oop) = startAddress ifTrue: [startAddress] ifFalse: [oop]]. [self oop: oop isLessThan: endAddress] whileTrue: [(self isFreeObject: oop) ifFalse: + [coInterpreter shortPrintOop: oop]. - [self shortPrintOop: oop]. oop := self objectAfter: oop]! Item was changed: + ----- Method: SpurMemoryManager>>shouldRemapObj: (in category 'gc - scavenge/compact') ----- - ----- Method: SpurMemoryManager>>shouldRemapObj: (in category 'gc - scavenging') ----- shouldRemapObj: objOop - <api> "Answer if the obj should be scavenged (or simply followed). The method is called + shouldRemapObj: for compatibility with ObjectMemory. Defer to the compactor + to choose the actual test, there being a difference between the vanilla test and + that used with a sliding compactor where objects are not marked as forwarded." + <doNotGenerate> + ^compactor shouldRemapObj: objOop! - shouldRemapObj: for compatibility with ObjectMemory. We test for being already - scavenged because mapStackPages via mapInterpreterOops may be applied twice - in the context of a global GC where a scavenge, followed by a scan-mark-free, and - final compaction passes may result in scvenged fields being visited twice." - ^(self isForwarded: objOop) - or: [(self isReallyYoungObject: objOop) - and: [(self isInFutureSpace: objOop) not]]! Item was changed: + ----- Method: SpurMemoryManager>>shouldRemapOop: (in category 'gc - scavenge/compact') ----- - ----- Method: SpurMemoryManager>>shouldRemapOop: (in category 'gc - scavenging') ----- shouldRemapOop: oop <api> "Answer if the oop should be scavenged.. The method is called shouldRemapOop: for compatibility with ObjectMemory." <inline: true> ^(self isNonImmediate: oop) and: [self shouldRemapObj: oop]! Item was added: + ----- Method: SpurMemoryManager>>slidingCompactionInProgress (in category 'testing') ----- + slidingCompactionInProgress + ^gcPhaseInProgress == SlidingCompactionInProgress! Item was added: + ----- Method: SpurMemoryManager>>slidingCompactionRemapObj: (in category 'gc - scavenge/compact') ----- + slidingCompactionRemapObj: objOop + "Scavenge or simply follow objOop. Answer the new location of objOop. + The send should have been guarded by a send of shouldRemapOop:. + The method is called remapObj: for compatibility with ObjectMemory." + <inline: true> + | resolvedObj | + self assert: (self shouldRemapOop: objOop). + (self isForwarded: objOop) + ifTrue: + [resolvedObj := self followForwarded: objOop] + ifFalse: + [self deny: (self isInFutureSpace: objOop). + resolvedObj := objOop]. + gcPhaseInProgress > 0 ifTrue: + [self scavengeInProgress + ifTrue: + [((self isReallyYoung: resolvedObj) "don't scavenge immediate, old, or CogMethod objects." + and: [(self isInFutureSpace: resolvedObj) not]) ifTrue: + [^scavenger copyAndForward: resolvedObj]] + ifFalse: + [self assert: self slidingCompactionInProgress. + (compactor isMobile: objOop) ifTrue: + [^self fetchPointer: 0 ofObject: objOop]]]. + ^resolvedObj! Item was added: + ----- Method: SpurMemoryManager>>slidingCompactionShouldRemapObj: (in category 'gc - scavenge/compact') ----- + slidingCompactionShouldRemapObj: objOop + <inline: #always> + "Answer if the obj should be scavenged, or simply followed. Sent via the compactor + from shouldRemapObj:. We test for being already scavenged because mapStackPages + via mapInterpreterOops may be applied twice in the context of a global GC where a + scavenge, followed by a scan-mark-free, and final compaction passes may result in + scavenged fields being visited twice." + ^(self isForwarded: objOop) + or: [gcPhaseInProgress > 0 "Hence either scavengeInProgress or slidingCompactionInProgress" + and: [self scavengeInProgress + ifTrue: [(self isReallyYoungObject: objOop) + and: [(self isInFutureSpace: objOop) not]] + ifFalse: [compactor isMobile: objOop]]]! Item was changed: ----- Method: SpurMemoryManager>>sqDeallocateMemorySegmentAt:OfSize: (in category 'simulation only') ----- sqDeallocateMemorySegmentAt: startAddress OfSize: ammount + "This is a nop in the simulator, except for SpurPlanningCompactor which may + release at the end of memory, allowing the simulator to shrink memory." + <doNotGenerate> + startAddress >= endOfMemory ifTrue: + [self halt]! - "This is a nop in the simulator." - <doNotGenerate>! Item was added: + ----- Method: SpurMemoryManager>>startOfObject:given: (in category 'object enumeration') ----- + startOfObject: objOop given: rawNumSlots + "Answer the start of objOop, which is either the address of the overflow + size word, or objOop itself, depending on the size of the object. This may + be applied to any kind of object, normal, forwarders or free chunks." + ^(self objectWithRawSlotsHasOverflowHeader: rawNumSlots) + ifTrue: [objOop - self baseHeaderSize] + ifFalse: [objOop]! Item was added: + ----- Method: SpurMemoryManager>>unmarkSurvivingObjectsForCompact (in category 'compaction') ----- + unmarkSurvivingObjectsForCompact + self allPastSpaceObjectsDo: + [:objOop| + (self isMarked: objOop) ifTrue: + [self setIsMarkedOf: objOop to: false]]! Item was added: + ----- Method: SpurMemoryManager>>vanillaRemapObj: (in category 'gc - scavenge/compact') ----- + vanillaRemapObj: objOop + "Scavenge or simply follow objOop. Answer the new location of objOop. + The send should have been guarded by a send of shouldRemapOop:. + The method is called remapObj: for compatibility with ObjectMemory." + <inline: true> + | resolvedObj | + self assert: (self shouldRemapOop: objOop). + (self isForwarded: objOop) + ifTrue: + [resolvedObj := self followForwarded: objOop] + ifFalse: + [self deny: (self isInFutureSpace: objOop). + resolvedObj := objOop]. + (self scavengeInProgress + and: [(self isReallyYoung: resolvedObj) "don't scavenge immediate, old, or CogMethod objects." + and: [(self isInFutureSpace: resolvedObj) not]]) ifTrue: + [^scavenger copyAndForward: resolvedObj]. + ^resolvedObj! Item was added: + ----- Method: SpurMemoryManager>>vanillaShouldRemapObj: (in category 'gc - scavenge/compact') ----- + vanillaShouldRemapObj: objOop + <inline: #always> + "Answer if the obj should be scavenged, or simply followed. Sent via the compactor + from shouldRemapObj:. We test for being already scavenged because mapStackPages + via mapInterpreterOops may be applied twice in the context of a global GC where a + scavenge, followed by a scan-mark-free, and final compaction passes may result in + scavenged fields being visited twice." + ^(self isForwarded: objOop) + or: [(self isReallyYoungObject: objOop) + and: [(self isInFutureSpace: objOop) not]]! Item was changed: ----- Method: SpurPigCompactor>>checkTraversableSortedFreeList (in category 'compaction - asserts') ----- checkTraversableSortedFreeList | prevFree prevPrevFree freeChunk | <api> <inline: false> prevFree := prevPrevFree := 0. firstFreeChunk = 0 ifTrue: [^lastFreeChunk = 0]. freeChunk := firstFreeChunk. manager allOldSpaceEntitiesDo: [:o| | objOop next limit | (manager isFreeObject: o) ifTrue: [self assert: o = freeChunk. + next := self nextInSortedFreeListLink: freeChunk given: prevFree. - next := manager nextInSortedFreeListLink: freeChunk given: prevFree. limit := next = 0 ifTrue: [manager endOfMemory] ifFalse: [next]. "coInterpreter transcript cr; print: freeChunk; tab; print: o; tab; print: prevFree; nextPutAll: '<->'; print: next; flush." objOop := freeChunk. [self oop: (objOop := manager objectAfter: objOop) isLessThan: limit] whileTrue: [self assert: (manager isFreeObject: objOop) not]. prevPrevFree := prevFree. prevFree := freeChunk. freeChunk := next]]. self assert: prevFree = lastFreeChunk. + self assert: (self nextInSortedFreeListLink: lastFreeChunk given: 0) = prevPrevFree. - self assert: (manager nextInSortedFreeListLink: lastFreeChunk given: 0) = prevPrevFree. self assert: freeChunk = 0. ^true! Item was changed: ----- Method: SpurPigCompactor>>compact (in category 'compaction - api') ----- compact "We'd like to use exact fit followed by best or first fit, but it doesn't work well enough in practice. So use pig compact. Fill large free objects starting from low memory with objects taken from the end of memory." <inline: #never> "for profiling" + self freeUnmarkedObjectsAndSortAndCoalesceFreeSpaceForPigCompact. manager statCompactPassCount: manager statCompactPassCount + 1. self assert: (firstFreeChunk = 0 or: [manager isFreeObject: firstFreeChunk]). 1 to: numCompactionPasses do: [:i| self pigCompact. self eliminateAndFreeForwardersForPigCompact]. "The free lists are zeroed in freeUnmarkedObjectsAndSortAndCoalesceFreeSpaceForPigCompact. They should still be zero here" self assert: manager freeListHeadsEmpty. self rebuildFreeListsForPigCompact! Item was changed: ----- Method: SpurPigCompactor>>eliminateAndFreeForwardersForPigCompact (in category 'compaction') ----- eliminateAndFreeForwardersForPigCompact "As the final phase of global garbage collect, sweep the heap to follow forwarders, then free forwarders, coalescing with free space as we go." <inline: false> | lowestForwarder | <var: #lowestForwarder type: #usqInt> self assert: (manager isForwarded: manager nilObject) not. self assert: (manager isForwarded: manager falseObject) not. self assert: (manager isForwarded: manager trueObject) not. self assert: (manager isForwarded: manager freeListsObj) not. self assert: (manager isForwarded: manager hiddenRootsObject) not. self assert: (manager isForwarded: manager classTableFirstPage) not. manager followSpecialObjectsOop. manager followForwardedObjStacks. coInterpreter mapInterpreterOops. scavenger followRememberedForwardersAndForgetFreeObjectsForPigCompact. + manager unmarkSurvivingObjectsForCompact. - self unmarkSurvivingObjectsForPigCompact. lowestForwarder := self sweepToFollowForwardersForPigCompact. self sweepToCoallesceFreeSpaceForPigCompactFrom: lowestForwarder. self assert: manager numberOfForwarders = 0! Item was removed: - ----- Method: SpurPigCompactor>>freeUnmarkedObjectsAndPrepareFreeSpace (in category 'compaction - api') ----- - freeUnmarkedObjectsAndPrepareFreeSpace - <inline: true> - self freeUnmarkedObjectsAndSortAndCoalesceFreeSpaceForPigCompact! Item was changed: ----- Method: SpurPigCompactor>>moveARunOfObjectsStartingAt:upTo: (in category 'compaction') ----- moveARunOfObjectsStartingAt: startAddress upTo: limit "Move the sequence of movable objects starting at startAddress. Answer the start of the next sequence of movable objects after a possible run of unmovable objects, or the limit, if there are no more movable objects, or 0 if no more compaction can be done. Compaction is done when the search through the freeList has reached the address from which objects are being moved from. There are two broad cases to be dealt with here. One is a run of smallish objects that can easily be moved into free chunks. The other is a large object that is unlikely to fit in the typical free chunk. This second pig needs careful handling; it needs to be moved to the lowest place it will fit and not cause the scan to skip lots of smaller free chunks looking in vain for somewhere to put it." <var: #startAddress type: #usqInt> <var: #limit type: #usqInt> <inline: false> | here hereObj hereObjHeader prevPrevFreeChunk prevFreeChunk thisFreeChunk maxFreeChunk | <var: #here type: #usqInt> <var: #there type: #usqInt> <var: #nextFree type: #usqInt> <var: #endOfFree type: #usqInt> <var: #destination type: #usqInt> <var: #maxFreeChunk type: #usqInt> here := startAddress. hereObj := manager objectStartingAt: startAddress. hereObjHeader := manager atLeastClassIndexHalfHeader: hereObj. prevPrevFreeChunk := prevFreeChunk := 0. thisFreeChunk := maxFreeChunk := firstFreeChunk. [thisFreeChunk ~= 0] whileTrue: [| freeBytes endOfFree nextFree destination there moved | "skip any initial immobile objects" [(manager isMobileObjectHeader: hereObjHeader)] whileFalse: [here := manager addressAfter: hereObj. here >= limit ifTrue: [^maxFreeChunk >= startAddress ifTrue: [0] ifFalse: [limit]]. hereObj := manager objectStartingAt: here. hereObjHeader := manager atLeastClassIndexHalfHeader: hereObj]. "grab a free chunk, and the following one, because we want to overwrite this one." self assert: ((manager isFreeObject: firstFreeChunk) and: [manager isFreeObject: thisFreeChunk]). freeBytes := manager bytesInObject: thisFreeChunk. + nextFree := self nextInSortedFreeListLink: thisFreeChunk given: prevFreeChunk. - nextFree := manager nextInSortedFreeListLink: thisFreeChunk given: prevFreeChunk. destination := manager startOfObject: thisFreeChunk. endOfFree := destination + freeBytes. moved := false. maxFreeChunk := maxFreeChunk max: nextFree. self assert: (nextFree = 0 or: [manager isFreeObject: nextFree]). "move as many objects as will fit in freeBytes..." [there := manager addressAfter: hereObj. "N.B. *must* add allocationUnit, not subtract, to avoid unsigned arithmetic issues when freeBytes = 0" (manager isMobileObjectHeader: hereObjHeader) and: [freeBytes > (there - here + manager allocationUnit) or: [freeBytes = (there - here)]]] whileTrue: [moved := true. manager mem: destination asVoidPointer cp: here asVoidPointer y: there - here. manager forwardUnchecked: hereObj to: destination + (hereObj - here). destination := destination + (there - here). freeBytes := freeBytes - (there - here). hereObj := manager objectStartingAt: there. here := there. hereObjHeader := manager atLeastClassIndexHalfHeader: hereObj]. moved ifTrue: "we did overwrite it; we need to repair the free list" [| nextNextFree | nextFree ~= 0 ifTrue: + [nextNextFree := self nextInSortedFreeListLink: nextFree given: thisFreeChunk. - [nextNextFree := manager nextInSortedFreeListLink: nextFree given: thisFreeChunk. self assert: (manager isFreeObject: nextFree)]. (destination > thisFreeChunk "if false couldn't move anything" and: [destination < endOfFree]) "if false, filled entire free chunk" ifTrue: [thisFreeChunk := manager initFreeChunkWithBytes: endOfFree - destination at: destination. self inSortedFreeListLink: prevFreeChunk to: thisFreeChunk given: prevPrevFreeChunk. self inSortedFreeListLink: thisFreeChunk to: nextFree given: prevFreeChunk. nextFree ~= 0 ifTrue: [self inSortedFreeListLink: nextFree to: nextNextFree given: thisFreeChunk]. prevPrevFreeChunk := prevFreeChunk. prevFreeChunk := thisFreeChunk. thisFreeChunk := nextFree] ifFalse: [self inSortedFreeListLink: prevFreeChunk to: nextFree given: prevPrevFreeChunk. nextFree ~= 0 ifTrue: [self inSortedFreeListLink: nextFree to: nextNextFree given: prevFreeChunk]. thisFreeChunk := nextFree]] ifFalse: "out of space (or immobile object); move on up the free list..." [prevPrevFreeChunk := prevFreeChunk. prevFreeChunk := thisFreeChunk. thisFreeChunk := nextFree]. (manager isMobileObjectHeader: hereObjHeader) ifFalse: [^maxFreeChunk >= startAddress ifTrue: [0] ifFalse: [there]]. "Was the loop stopped by a pig? If so, try and find space for it" there - here >= (manager averageObjectSizeInBytes * 8) ifTrue: "256b in 32 bit, 512b in 64 bit" [| usedChunk | usedChunk := self tryToMovePig: hereObj at: here end: there. "if it couldn't be moved we need to advance, so always set here to there whether the pig was moved or not." hereObj := manager objectStartingAt: there. here := there. hereObjHeader := manager atLeastClassIndexHalfHeader: hereObj. "In general it's a bad idea to reset the enumeration; it leads to N^2 behaviour when encountering pigs. But if the move affected the enumeration this is simpler than resetting the list pointers." (usedChunk = prevPrevFreeChunk or: [usedChunk = prevFreeChunk or: [usedChunk = thisFreeChunk]]) ifTrue: ["reset the scan for free space back to the start of the list" prevPrevFreeChunk := prevFreeChunk := 0. thisFreeChunk := firstFreeChunk]]. ((here > startAddress and: [there >= limit]) or: [maxFreeChunk >= startAddress]) ifTrue: [^maxFreeChunk >= startAddress ifTrue: [0] ifFalse: [there]]]. ^here! Item was added: + ----- Method: SpurPigCompactor>>nextInSortedFreeListLink:given: (in category 'compaction') ----- + nextInSortedFreeListLink: freeChunk given: prevFree + "Answer the next free free chunk using the xor trick to use only one field, see e.g. + The Art of Computer Programming, Vol 1, D.E. Knuth, 3rd Ed, Sec 2.2.4 `Circular Lists', exercise. 18 + http://en.wikipedia.org/wiki/XOR_linked_list." + <inline: true> + ^((manager fetchPointer: manager freeChunkNextIndex ofFreeChunk: freeChunk) bitXor: prevFree) asUnsignedInteger! Item was changed: ----- Method: SpurPigCompactor>>pigCompact (in category 'compaction') ----- pigCompact "Traverse the sorted free list, moving objects from the high-end of memory to the free objects in the low end of memory. Return when + the address at which objects are being copied to meets the address - the address at which objects are being copiecd to meets the address from which objects are being copied from." self cCode: '' inSmalltalk: [coInterpreter transcript nextPutAll: 'pig compacting...'; flush]. self sortedFreeListPairwiseReverseDo: [:low :high| | scanAddress | self cCode: '' inSmalltalk: [coInterpreter transcript nextPut: $.; flush]. scanAddress := manager addressAfter: low. [self oop: scanAddress isLessThan: high] whileTrue: [scanAddress := self moveARunOfObjectsStartingAt: scanAddress upTo: high. scanAddress = 0 ifTrue: [^self]]]. self assert: self checkTraversableSortedFreeList! Item was changed: ----- Method: SpurPigCompactor>>printSortedFreeList (in category 'debug printing') ----- printSortedFreeList <api> | freeChunk prevFree nextFree | (firstFreeChunk > 0 and: [lastFreeChunk > firstFreeChunk]) ifFalse: [coInterpreter print: 'sorted free list empty or corrupt'; cr. ^self]. freeChunk := firstFreeChunk. prevFree := 0. [((manager addressCouldBeObj: freeChunk) and: [manager isFreeObject: freeChunk]) ifFalse: [coInterpreter printHexnp: freeChunk; print: ' is not a free chunk!!' ; cr. ^self]. manager printFreeChunk: freeChunk printAsTreeNode: false. freeChunk ~= lastFreeChunk] whileTrue: + [nextFree := self nextInSortedFreeListLink: freeChunk given: prevFree. - [nextFree := manager nextInSortedFreeListLink: freeChunk given: prevFree. prevFree := freeChunk. freeChunk := nextFree]! Item was added: + ----- Method: SpurPigCompactor>>remapObj: (in category 'gc - scavenge/compact') ----- + remapObj: objOop + "Scavenge or simply follow objOop. Answer the new location of objOop. + The send should have been guarded by a send of shouldRemapOop:. + The method is called remapObj: for compatibility with ObjectMemory." + <api> + <inline: false> + ^manager vanillaRemapObj: objOop! Item was added: + ----- Method: SpurPigCompactor>>shouldRemapObj: (in category 'gc - scavenge/compact') ----- + shouldRemapObj: objOop + <api> + "Answer if the obj should be scavenged (or simply followed). The method is called + shouldRemapObj: for compatibility with ObjectMemory. Defer to the compactor + to choose the actual test, there being a difference between the vanilla test and + that used with a sliding compactor where objects are not marked as forwarded." + ^manager vanillaShouldRemapObj: objOop! Item was changed: ----- Method: SpurPigCompactor>>sortedFreeListDo: (in category 'compaction') ----- sortedFreeListDo: aBlock "Evaluate aBlock with ascending entries in the free list" | free nextFree prevFree prevPrevFree | <var: #free type: #usqInt> <var: #nextFree type: #usqInt> <var: #prevFree type: #usqInt> <var: #prevPrevFree type: #usqInt> <inline: true> free := firstFreeChunk. prevPrevFree := prevFree := 0. [free ~= 0] whileTrue: + [nextFree := self nextInSortedFreeListLink: free given: prevFree. - [nextFree := manager nextInSortedFreeListLink: free given: prevFree. self assert: (manager isFreeObject: free). self assert: (nextFree = 0 or: [nextFree > free and: [manager isFreeObject: nextFree]]). self assert: (prevFree = 0 or: [prevFree < free]). aBlock value: free. prevPrevFree := prevFree. prevFree := free. free := nextFree]! Item was changed: ----- Method: SpurPigCompactor>>sortedFreeListPairwiseReverseDo: (in category 'compaction') ----- sortedFreeListPairwiseReverseDo: aBinaryBlock "Evaluate aBinaryBlock with adjacent entries in the free list, from high address to low address. The second argument is in fact the start of the next free chunk, not the free chunk itself. Use endOfMemory - bridgeSize as the second argument in the first evaluation." | free prevFree prevPrevFree | <var: #free type: #usqInt> <var: #prevFree type: #usqInt> <var: #prevPrevFree type: #usqInt> <inline: true> free := lastFreeChunk. prevPrevFree := prevFree := 0. [free ~= 0] whileTrue: [aBinaryBlock value: free value: (prevFree = 0 ifTrue: [manager endOfMemory - manager bridgeSize] ifFalse: [manager startOfObject: prevFree]). "post evaluation of aBinaryBlock the value of free may be invalid because moveARunOfObjectsStartingAt:upTo: may have filled it. So reconstruct the position in the enumeration." prevFree = 0 ifTrue: [self assert: free = lastFreeChunk. prevFree := lastFreeChunk. + free := self nextInSortedFreeListLink: lastFreeChunk given: 0] - free := manager nextInSortedFreeListLink: lastFreeChunk given: 0] ifFalse: [self assert: (manager isFreeObject: prevFree). prevPrevFree = 0 ifTrue: [prevPrevFree := lastFreeChunk. + prevFree := self nextInSortedFreeListLink: lastFreeChunk given: 0] - prevFree := manager nextInSortedFreeListLink: lastFreeChunk given: 0] ifFalse: [self assert: (manager isFreeObject: prevPrevFree). + free := self nextInSortedFreeListLink: prevFree given: prevPrevFree. - free := manager nextInSortedFreeListLink: prevFree given: prevPrevFree. prevPrevFree := prevFree. prevFree := free]. + free := self nextInSortedFreeListLink: prevFree given: prevPrevFree]]! - free := manager nextInSortedFreeListLink: prevFree given: prevPrevFree]]! Item was changed: ----- Method: SpurPigCompactor>>tryToMovePig:at:end: (in category 'compaction') ----- tryToMovePig: pigObj at: pigStart end: pigEnd "Try to move a pig (a largish object) to a free chunk in low memory. Answer the freeChunk that was used to house the moved pig, or 0 if no free chunk could be found." | freeChunk prevFree prevPrevFree pigBytes nextNext | prevPrevFree := prevFree := 0. freeChunk := firstFreeChunk. pigBytes := pigEnd - pigStart. [freeChunk ~= 0 and: [freeChunk < pigObj]] whileTrue: [| next dest chunkBytes newChunk | + next := self nextInSortedFreeListLink: freeChunk given: prevFree. - next := manager nextInSortedFreeListLink: freeChunk given: prevFree. dest := manager startOfObject: freeChunk. chunkBytes := (manager addressAfter: freeChunk) - dest. "N.B. *must* add allocationUnit, not subtract, to avoid unsigned arithmetic issues when chunkBytes = 0" (chunkBytes = pigBytes or: [chunkBytes > (pigBytes + manager allocationUnit)]) ifTrue: [manager mem: dest asVoidPointer cp: pigStart asVoidPointer y: pigBytes. manager forwardUnchecked: pigObj to: dest + (pigObj - pigStart). next ~= 0 ifTrue: + [nextNext := self nextInSortedFreeListLink: next given: freeChunk]. - [nextNext := manager nextInSortedFreeListLink: next given: freeChunk]. "now either shorten the chunk, or remove it, adjusting the links to keep the list sorted." pigBytes < chunkBytes "if false, filled entire free chunk" ifTrue: [newChunk := manager initFreeChunkWithBytes: chunkBytes - pigBytes at: dest + pigBytes. self inSortedFreeListLink: prevFree to: newChunk given: prevPrevFree. self inSortedFreeListLink: newChunk to: next given: prevFree. next ~= 0 ifTrue: [self inSortedFreeListLink: next to: nextNext given: newChunk]] ifFalse: [self inSortedFreeListLink: prevFree to: next given: prevPrevFree. next ~= 0 ifTrue: [self inSortedFreeListLink: next to: nextNext given: prevFree]]. "self checkTraversableSortedFreeList". ^freeChunk]. prevPrevFree := prevFree. prevFree := freeChunk. freeChunk := next]. ^0! Item was removed: - ----- Method: SpurPigCompactor>>unmarkSurvivingObjectsForPigCompact (in category 'compaction') ----- - unmarkSurvivingObjectsForPigCompact - manager allPastSpaceObjectsDo: - [:objOop| - (manager isMarked: objOop) ifTrue: - [manager setIsMarkedOf: objOop to: false]]! Item was added: + CogClass subclass: #SpurPlanningCompactor + instanceVariableNames: 'manager scavenger coInterpreter biasForGC firstFreeObject firstMobileObject lastMobileObject savedFirstFieldsSpace savedFirstFieldsSpaceWasAllocated firstFieldOfRememberedSet' + classVariableNames: '' + poolDictionaries: 'SpurMemoryManagementConstants VMBasicConstants VMBytecodeConstants VMSpurObjectRepresentationConstants' + category: 'VMMaker-SpurMemoryManager'! + + !SpurPlanningCompactor commentStamp: 'eem 12/23/2016 17:50' prior: 0! + SpurPlanningCompactor implements the classic planning compaction algorithm for Spur. It makes at least three passes through the heap. The first pass plans where live movable objects will go, copying their forwarding field to the next slot in savedFirstFieldsSpace, and setting their forwarding pointer to point to their eventual location. The second pass updates all pointers in live pointer objects to point to objects' final destinations. The third pass moves objects to their final positions, unmarking objects as it does so. If the forwarding fields of live objects in the to-be-moved portion of the entire heap won't fit in savedFirstFieldsSpace, then additional passes are made until the entire heap has been compacted. + + Instance Variables + biasForGC <Boolean> + coInterpreter: <StackInterpreter> + firstFieldOfRememberedSet <Oop> + firstFreeObject <Oop> + firstMobileObject <Oop> + lastMobileObject <Oop> + manager: <SpurMemoryManager> + savedFirstFieldsSpace <SpurContiguousObjStack> + savedFirstFieldsSpaceWasAllocated <Boolean> + scavenger: <SpurGenerationScavenger> + + biasForGC + - true if compacting for GC, in which case do only one pass, or false if compacting for snapshot, in which case do as many passes as necessary to compact the entire heap. + + firstFieldOfRememberedSet + - the saved first field of the rememberedSet. The rememberedSet must be relocated specially because it is not a pointer object. And hence the first field needs to be extracted for proper relocation. + + firstFreeObject + - the first free object in a compaction pass. + + firstMobileObject + - the first mobile object in a compaction. Unpinned objects from the firstMobileObject through to the lastMobileObject are implicitly forwarded. + + lastMobileObject + - the last mobile object in a compaction. Unpinned objects from the firstMobileObject through to the lastMobileObject are implicitly forwarded. + + savedFirstFieldsSpace + - the space holding the saved first fields, each overwritten by a forwarding pointer, for the objects from firstMobileObject through to lastMobileObject. + + savedFirstFieldsSpaceWasAllocated + - if true, the memory for savedFirstFieldsSpace was obtained via a call of sqAllocateMemorySegmentOfSize:Above:AllocatedSizeInto:! Item was added: + ----- Method: SpurPlanningCompactor>>biasForGC (in category 'compaction - api') ----- + biasForGC + biasForGC := true! Item was added: + ----- Method: SpurPlanningCompactor>>biasForSnapshot (in category 'compaction - api') ----- + biasForSnapshot + biasForGC := false! Item was added: + ----- Method: SpurPlanningCompactor>>coInterpreter: (in category 'instance initialization') ----- + coInterpreter: aVMSimulator + <doNotGenerate> + coInterpreter := aVMSimulator! Item was added: + ----- Method: SpurPlanningCompactor>>compact (in category 'compaction - api') ----- + compact + "Sweep all of old space, sliding unpinned marked objects down over free and unmarked objects. + Let the segmentManager mark which segments contain pinned objects via notePinned:." + | onePass | + <inline: #never> "for profiling" + self initializeCompaction; + initializeScan. + [onePass := self planCompactSavingForwarders. + self updatePointers. + self copyAndUnmark. + manager checkFreeSpace: GCModeFull. + onePass or: [biasForGC]] whileFalse: + [self reinitializeScan; + updateSavedFirstFieldsSpaceIfNecessary]. + self endCompaction! Item was added: + ----- Method: SpurPlanningCompactor>>continueCopyAndUnmarkMobileObjectsFrom: (in category 'compaction') ----- + continueCopyAndUnmarkMobileObjectsFrom: anUnpinnedEntity + "copyAndUnmarkMobileObjects has encountered a run of pinned objects around which + it cannot compact, but savedFirstFieldsSpace is still not full. Continue the pass with new + firstFreeObject and firstMobileObject, resetting them before continuing. + Answer if the end of the heap was reached (savedFirstFieldsSpace has not overflowed)." + | result savedFirstFreeObject savedFirstMobileObject nextFreeObject | + self assert: (self oop: anUnpinnedEntity isLessThan: manager endOfMemory). + self deny: (manager isPinned: anUnpinnedEntity). + savedFirstFreeObject := firstFreeObject. + savedFirstMobileObject := firstMobileObject. + nextFreeObject := self scanForFirstFreeAndFirstMobileObjectFrom: anUnpinnedEntity. + nextFreeObject ifNil: + [^true]. + firstFreeObject := nextFreeObject. + result := self copyAndUnmarkMobileObjects. + firstFreeObject := savedFirstFreeObject. + firstMobileObject := savedFirstMobileObject. + ^result! Item was added: + ----- Method: SpurPlanningCompactor>>continuePlanCompactSavingForwardersFrom: (in category 'compaction') ----- + continuePlanCompactSavingForwardersFrom: anUnpinnedEntity + "planCompactSavingForwarders has encountered a run of pinned objects around which + it cannot compact, but savedFirstFieldsSpace is still not full. Continue the pass with new + firstFreeObject and firstMobileObject, resetting them before continuing. + Answer if the end of the heap was reached (savedFirstFieldsSpace has not overflowed)." + | result savedFirstFreeObject savedFirstMobileObject nextFreeObject | + self assert: (self oop: anUnpinnedEntity isLessThan: manager endOfMemory). + self deny: (manager isPinned: anUnpinnedEntity). + savedFirstFreeObject := firstFreeObject. + savedFirstMobileObject := firstMobileObject. + nextFreeObject := self scanForFirstFreeAndFirstMobileObjectFrom: anUnpinnedEntity. + nextFreeObject ifNil: + [^true]. + result := self planCompactSavingForwarders. + firstFreeObject := savedFirstFreeObject. + firstMobileObject := savedFirstMobileObject. + ^result! Item was added: + ----- Method: SpurPlanningCompactor>>continueUpdatePointersInMobileObjectsFrom: (in category 'compaction') ----- + continueUpdatePointersInMobileObjectsFrom: anUnpinnedEntity + "updatePointersInMobileObjects has encountered a run of pinned objects around which + planCompactSavingForwarders cannot compact, but savedFirstFieldsSpace is still not full. + Continue the pass with new firstFreeObject and firstMobileObject, resetting them before continuing. + Answer if the end of the heap was reached (savedFirstFieldsSpace has not overflowed)." + | result savedFirstFreeObject savedFirstMobileObject nextFreeObject | + self assert: (self oop: anUnpinnedEntity isLessThan: manager endOfMemory). + self deny: (manager isPinned: anUnpinnedEntity). + savedFirstFreeObject := firstFreeObject. + savedFirstMobileObject := firstMobileObject. + nextFreeObject := self scanForFirstFreeAndFirstMobileObjectFrom: anUnpinnedEntity. + nextFreeObject ifNil: + [^true]. + result := self updatePointersInMobileObjects. + firstFreeObject := savedFirstFreeObject. + firstMobileObject := savedFirstMobileObject. + ^result! Item was added: + ----- Method: SpurPlanningCompactor>>copyAndUnmark (in category 'compaction') ----- + copyAndUnmark + "Sweep the heap, unmarking all objects and moving mobile objects to their correct positions, + restoring their savedFirstFields." + | onePass | + self unmarkInitialImmobileObjects. + onePass := self copyAndUnmarkMobileObjects. + onePass ifFalse: + [self unmarkObjectsOverflowingSavedFirstFieldsSpace]! Item was added: + ----- Method: SpurPlanningCompactor>>copyAndUnmarkMobileObjects (in category 'compaction') ----- + copyAndUnmarkMobileObjects + "Sweep the mobile portion of the heap, moving objects to their eventual locations, and clearing their marked bits. + Remember to update the savedFirstFields of pointer objects, as these have been forwarded. + This enumeration matches that in planCompactSavingForwarders and updatePointersInMobileObjects." + + | toFinger top previousPin | + toFinger := manager startOfObject: firstFreeObject. + top := savedFirstFieldsSpace start - manager bytesPerOop. + self deny: (manager isMarked: firstFreeObject). + manager allOldSpaceEntitiesForCompactingFrom: firstMobileObject do: + [:o| + self assert: (previousPin isNil or: [toFinger < previousPin]). + (manager isMarked: o) ifTrue: + [(manager isPinned: o) + ifTrue: + [(manager isSegmentBridge: o) ifFalse: + [manager setIsMarkedOf: o to: false. + manager segmentManager notePinned: o]. + previousPin ifNotNil: + [self assert: previousPin > toFinger. + ((manager isSegmentBridge: previousPin) + and: [manager isSegmentBridge: o]) ifTrue: + [self halt: 'empty segment']]. + previousPin := o] + ifFalse: + [| availableSpace bytes next | + (top := top + manager bytesPerOop) >= savedFirstFieldsSpace limit ifTrue: + [self freeFrom: toFinger upTo: (manager startOfObject: o) previousPin: previousPin. + ^false]. + [previousPin notNil + and: [availableSpace := (manager startOfObject: previousPin) - toFinger. + bytes := manager bytesInObject: o. + bytes ~= availableSpace + and: [bytes + (2 * manager allocationUnit) < availableSpace]]] whileTrue: + ["The object does not fit in the space between toFinger and previousPin. + Move toFinger beyond previousPin and update previousPin appropriately." + availableSpace > 0 ifTrue: + [manager addFreeChunkWithBytes: availableSpace at: toFinger]. + toFinger := manager addressAfter: previousPin. + self assert: toFinger < manager endOfMemory. + next := manager objectStartingAt: toFinger. + next >= o ifTrue: + [^self continueCopyAndUnmarkMobileObjectsFrom: next]. + previousPin := (manager isPinned: next) ifTrue: [next]]. + bytes := self copyAndUnmarkObject: o to: toFinger firstField: (manager longAt: top). + toFinger := toFinger + bytes]]]. + self freeFrom: toFinger upTo: manager endOfMemory previousPin: previousPin. + ^true! Item was added: + ----- Method: SpurPlanningCompactor>>copyAndUnmarkObject:to:firstField: (in category 'compaction') ----- + copyAndUnmarkObject: o to: toFinger firstField: firstField + "Copy the object to toFinger, clearing its mark bit and restoring its firstField, which was overwritten with a forwarding pointer. + Answer the number of bytes in the object, including overflow header." + <inline: #always> + | bytes numSlots destObj start | + numSlots := manager rawNumSlotsOf: o. + destObj := (manager objectWithRawSlotsHasOverflowHeader: numSlots) + ifTrue: [toFinger + manager baseHeaderSize] + ifFalse: [toFinger]. + bytes := manager bytesInObject: o given: numSlots. + start := manager startOfObject: o given: numSlots. + manager + mem: toFinger asVoidPointer cp: start asVoidPointer y: bytes; + setIsMarkedOf: destObj to: false; + storePointerUnchecked: 0 ofObject: destObj withValue: firstField. + ^bytes! Item was added: + ----- Method: SpurPlanningCompactor>>endCompaction (in category 'compaction') ----- + endCompaction + manager + unmarkSurvivingObjectsForCompact; + endSlidingCompaction. + self repinRememberedSet. + self releaseSavedFirstFieldsSpace! Item was added: + ----- Method: SpurPlanningCompactor>>findHighestSuitableFreeBlock: (in category 'space management') ----- + findHighestSuitableFreeBlock: spaceEstimate + "If a freeBlock of size at least spaceEstimate exists high enough in the heap, choose it." + <inline: true> + manager findLargestFreeChunk ifNotNil: + [:largestFreeChunk| + (manager bytesInObject: largestFreeChunk) >= spaceEstimate ifTrue: + [^largestFreeChunk]]. + ^nil! Item was added: + ----- Method: SpurPlanningCompactor>>firstUnpinnedObjectFollowing: (in category 'private') ----- + firstUnpinnedObjectFollowing: pinnedObj + | nextObj | + self assert: (manager isPinned: pinnedObj). + nextObj := pinnedObj. + [nextObj := manager objectAfter: nextObj limit: manager endOfMemory. + nextObj >= manager endOfMemory ifTrue: + [^manager endOfMemory]. + manager isPinned: nextObj] whileTrue. + ^nextObj! Item was added: + ----- Method: SpurPlanningCompactor>>freeFrom:upTo:previousPin: (in category 'private') ----- + freeFrom: toFinger upTo: limit previousPin: previousPinOrNil + "Free from toFinger up to limit, dealing with a possible intervening run of pinned objects starting at previousPinOrNil." + | effectiveToFinger firstUnpinned | + self cCode: [] inSmalltalk: + [coInterpreter cr; cr; print: 'freeing at '; printHexnp: toFinger; print: ' up to '; printHexnp: limit; print: ' pin '; printHexnp: previousPinOrNil; cr]. + effectiveToFinger := toFinger. + previousPinOrNil ifNotNil: + [manager addFreeChunkWithBytes: (manager startOfObject: previousPinOrNil) - toFinger at: toFinger. + firstUnpinned := self firstUnpinnedObjectFollowing: previousPinOrNil. + firstUnpinned >= limit ifTrue: + [^self]. + effectiveToFinger := manager startOfObject: firstUnpinned]. + manager addFreeChunkWithBytes: limit - effectiveToFinger at: effectiveToFinger! Item was added: + ----- Method: SpurPlanningCompactor>>initialize (in category 'instance initialization') ----- + initialize + biasForGC := true. + savedFirstFieldsSpace := SpurContiguousObjStack new. + savedFirstFieldsSpaceWasAllocated := false! Item was added: + ----- Method: SpurPlanningCompactor>>initializeCompaction (in category 'compaction') ----- + initializeCompaction + manager checkFreeSpace: GCModeFull. + self selectSavedFirstFieldsSpace. + self unpinRememberedSet. + manager + resetFreeListHeads; + totalFreeOldSpace: 0; + beginSlidingCompaction! Item was added: + ----- Method: SpurPlanningCompactor>>initializeScan (in category 'compaction') ----- + initializeScan + savedFirstFieldsSpace top: savedFirstFieldsSpace start - manager bytesPerOop. + firstFreeObject := self scanForFirstFreeAndFirstMobileObjectFrom: (manager objectAfter: manager hiddenRootsObject). + firstFreeObject ifNil: + [self error: 'uncompactable heap; no unmarked objects found']! Item was added: + ----- Method: SpurPlanningCompactor>>isMobile: (in category 'private') ----- + isMobile: obj + <inline: #always> + ^(self oop: obj isGreaterThanOrEqualTo: firstMobileObject andLessThanOrEqualTo: lastMobileObject) + and: [(manager isPinned: obj) not]! Item was added: + ----- Method: SpurPlanningCompactor>>isPostMobile: (in category 'private') ----- + isPostMobile: obj + "For asserts" + ^self oop: obj isGreaterThanOrEqualTo: firstFreeObject andLessThanOrEqualTo: lastMobileObject! Item was added: + ----- Method: SpurPlanningCompactor>>manager: (in category 'instance initialization') ----- + manager: aSpurNBitMMXEndianSimulator + <doNotGenerate> + manager := aSpurNBitMMXEndianSimulator. + aSpurNBitMMXEndianSimulator coInterpreter ifNotNil: + [:coint| coInterpreter := coint]. + aSpurNBitMMXEndianSimulator scavenger ifNotNil: + [:scav| scavenger := scav]! Item was added: + ----- Method: SpurPlanningCompactor>>numPointerSlotsWhileCompactingOf:savedFirstFieldPointer: (in category 'private') ----- + numPointerSlotsWhileCompactingOf: obj savedFirstFieldPointer: firstFieldPtrOrNil + "This is a version of SpurMemoryManager>>numPointerSlotsOf: that deals with the + possibility of obj being a CompiledMethod whose header is in savedFirstFieldsSpace. + Answer the number of pointer fields in the given object. + Works with CompiledMethods, as well as ordinary objects." + <inline: true> + | fmt contextSize numLiterals header | + fmt := manager formatOf: obj. + fmt <= manager lastPointerFormat ifTrue: + [(fmt = manager indexablePointersFormat + and: [manager isContextNonImm: obj]) ifTrue: + ["contexts end at the stack pointer" + contextSize := coInterpreter fetchStackPointerOf: obj. + ^CtxtTempFrameStart + contextSize]. + ^manager numSlotsOf: obj "all pointers"]. + self deny: fmt = manager forwardedFormat. + fmt < manager firstCompiledMethodFormat ifTrue: [^0]. "no pointers" + + "CompiledMethod: contains both pointers and bytes" + self assert: firstFieldPtrOrNil notNil == (self isMobile: obj). + header := firstFieldPtrOrNil + ifNil: [manager methodHeaderOf: obj] + ifNotNil: [manager methodHeaderFromSavedFirstField: (manager longAt: firstFieldPtrOrNil)]. + numLiterals := manager literalCountOfMethodHeader: header. + ^numLiterals + LiteralStart! Item was added: + ----- Method: SpurPlanningCompactor>>planCompactSavingForwarders (in category 'compaction') ----- + planCompactSavingForwarders + "Sweep the heap from firstFreeObject forwarding marked objects to where they + can be moved to, saving their forwarding pointer in savedFirstFieldsSpace. + Continue until either the end of the heap is reached or savedFirstFieldsSpace is full. + Answer if the end of the heap was reached (savedFirstFieldsSpace has not overflowed). + + Note that this method is potentially recursive. If skipping a run of pinned objects + causes the the algorithm to encounter another run of immobile objects it will + recurse via continuePlanCompactSavingForwardersFrom:. + + This enumeration matches that in updatePointersInMobileObjects and copyAndUnmarkMobileObjects." + + | toFinger top previousPin | + toFinger := manager startOfObject: firstFreeObject. + top := savedFirstFieldsSpace top. + self deny: (manager isMarked: firstFreeObject). + manager allOldSpaceEntitiesFrom: firstMobileObject do: + [:o| + self assert: (previousPin isNil or: [toFinger < previousPin]). + (manager isMarked: o) ifTrue: + [(manager isPinned: o) + ifTrue: + [previousPin ifNotNil: + [self assert: previousPin > toFinger. + ((manager isSegmentBridge: previousPin) + and: [manager isSegmentBridge: o]) ifTrue: + [self halt: 'empty segment']]. + previousPin := o] + ifFalse: + [| availableSpace bytes next | + (top := top + manager bytesPerOop) >= savedFirstFieldsSpace limit ifTrue: + [savedFirstFieldsSpace top: top. + ^false]. + [previousPin notNil + and: [availableSpace := (manager startOfObject: previousPin) - toFinger. + bytes := manager bytesInObject: o. + bytes ~= availableSpace + and: [bytes + (2 * manager allocationUnit) < availableSpace]]] whileTrue: + ["The object does not fit in the space between toFinger and previousPin. + Move toFinger beyond previousPin and update previousPin appropriately." + toFinger := manager addressAfter: previousPin. + next := manager objectStartingAt: toFinger. + next >= o ifTrue: + [savedFirstFieldsSpace top: top. + ^self continuePlanCompactSavingForwardersFrom: next]. + previousPin := (manager isPinned: next) ifTrue: [next]]. + lastMobileObject := o. + manager + longAt: top put: (manager fetchPointer: 0 ofObject: o); + storePointerUnchecked: 0 "Don't use forward:to:; we dont want to alter the object in any way other than by setting the forwarding pointer" + ofObject: o + withValue: ((manager hasOverflowHeader: o) + ifTrue: [toFinger + manager baseHeaderSize] + ifFalse: [toFinger]). + toFinger := toFinger + (manager bytesInObject: o)]]]. + savedFirstFieldsSpace top: top. + ^true! Item was added: + ----- Method: SpurPlanningCompactor>>reinitializeScan (in category 'compaction') ----- + reinitializeScan + firstFreeObject := self scanForFirstFreeAndFirstMobileObjectFrom: firstFreeObject. + firstFreeObject ifNil: + [self error: 'uncompactable heap; no unmarked objects found']! Item was added: + ----- Method: SpurPlanningCompactor>>releaseSavedFirstFieldsSpace (in category 'space management') ----- + releaseSavedFirstFieldsSpace + <inline: true> + savedFirstFieldsSpaceWasAllocated ifTrue: + [manager + sqDeallocateMemorySegmentAt: savedFirstFieldsSpace start asVoidPointer + OfSize: savedFirstFieldsSpace limit - savedFirstFieldsSpace start. + savedFirstFieldsSpaceWasAllocated := false]! Item was added: + ----- Method: SpurPlanningCompactor>>relocateObjectsInHeapEntity:from:to: (in category 'compaction') ----- + relocateObjectsInHeapEntity: heapEntity from: startIndex to: finishIndex + "Sweep the fields in some non-pointer heap entity (objStackPage, rememberedSet), + updating all references to mobile objects to their eventual locations. Answer the + heapEntity's eventual location." + <inline: true> + startIndex to: finishIndex do: + [:i| | oop fwd | + oop := manager fetchPointer: i ofObject: heapEntity. + ((manager isNonImmediate: oop) and: [self isMobile: oop]) ifTrue: + [self assert: (manager isMarked: oop). + fwd := manager fetchPointer: 0 ofObject: oop. + self assert: (self isPostMobile: fwd). + manager storePointerUnchecked: i ofObject: heapEntity withValue: fwd]]. + ^(self isMobile: heapEntity) + ifTrue: [manager fetchPointer: 0 ofObject: heapEntity] + ifFalse: [heapEntity]! Item was added: + ----- Method: SpurPlanningCompactor>>remapObj: (in category 'gc - scavenge/compact') ----- + remapObj: objOop + "Scavenge or simply follow objOop. Answer the new location of objOop. + The send should have been guarded by a send of shouldRemapOop:. + The method is called remapObj: for compatibility with ObjectMemory." + <api> + <inline: false> + ^manager slidingCompactionRemapObj: objOop! Item was added: + ----- Method: SpurPlanningCompactor>>repinRememberedSet (in category 'private') ----- + repinRememberedSet + <inline: true> + scavenger rememberedSetSize > 0 ifTrue: + [manager storePointerUnchecked: 0 ofObject: manager rememberedSetObj withValue: firstFieldOfRememberedSet]. + manager setIsPinnedOf: manager rememberedSetObj to: true. + scavenger relocateRememberedSet! Item was added: + ----- Method: SpurPlanningCompactor>>scanForFirstFreeAndFirstMobileObjectFrom: (in category 'compaction') ----- + scanForFirstFreeAndFirstMobileObjectFrom: initialObject + "Scan from initialObject, setting firstMobileObject to the first marked object after + the first free object found. Answer the first free object found, or nil if none." + <inline: false> + | firstFree | + manager allOldSpaceEntitiesFrom: initialObject do: + [:o| + (manager isMarked: o) + ifTrue: + [firstFree ifNotNil: + [firstMobileObject := o. + ^firstFree]] + ifFalse: + [firstFree ifNil: + [firstFree := o]]]. + ^firstFree! Item was added: + ----- Method: SpurPlanningCompactor>>selectSavedFirstFieldsSpace (in category 'space management') ----- + selectSavedFirstFieldsSpace + "To compact the heap the algorithm must save the first field (used for the forwarding pointer) + of all moved objects. This is done in savedFirstFieldsSpace, a contiguous block of memory borrowed + for the duration of compaction. In a 32-bit system a typical upper bound on the space needed + is about 1/40 of the heap size. The default new space size of 4Mb provides an eden of about + 3.6 Mb, which would serve the needs of a 144 Mb heap. The default segment increment of + 16 Mb would serve the needs of a 640 Mb heap. Make an estimate of the size needed, and + either use eden, a large free chunk, or a newly-allocated segment, falling back on eden if + the alternatives can't be had." + <inline: true> + | spaceEstimate sizeOfEden | + spaceEstimate := manager endOfMemory - manager firstObject // 40. + sizeOfEden := scavenger eden limit - scavenger eden start. + spaceEstimate > sizeOfEden ifTrue: + [(self findHighestSuitableFreeBlock: spaceEstimate) ifNotNil: + [:highestSuitableFreeBlock| + (spaceEstimate > (manager sizeOfFree: highestSuitableFreeBlock) + and: [self useSegmentForSavedFirstFieldsSpace: spaceEstimate]) ifTrue: + [^self]. + (manager sizeOfFree: highestSuitableFreeBlock) > sizeOfEden ifTrue: + [self useFreeChunkForSavedFirstFieldsSpace: highestSuitableFreeBlock. + ^self]]]. + self useEdenForSavedFirstFieldsSpace! Item was added: + ----- Method: SpurPlanningCompactor>>shouldRemapObj: (in category 'gc - scavenge/compact') ----- + shouldRemapObj: objOop + <api> + "Answer if the obj should be scavenged, or simply followed. Sent via the compactor + from shouldRemapObj:. We test for being already scavenged because mapStackPages + via mapInterpreterOops may be applied twice in the context of a global GC where a + scavenge, followed by a scan-mark-free, and final compaction passes may result in + scavenged fields being visited twice." + ^manager slidingCompactionShouldRemapObj: objOop! Item was added: + ----- Method: SpurPlanningCompactor>>unmarkInitialImmobileObjects (in category 'compaction') ----- + unmarkInitialImmobileObjects + "Sweep the initial immobile heap, unmarking all objects up to the first mobile object." + manager allOldSpaceObjectsFrom: manager firstObject do: + [:o| + o >= firstMobileObject ifTrue: + [^self]. + manager setIsMarkedOf: o to: false]! Item was added: + ----- Method: SpurPlanningCompactor>>unmarkObjectsOverflowingSavedFirstFieldsSpace (in category 'compaction') ----- + unmarkObjectsOverflowingSavedFirstFieldsSpace + self shouldBeImplemented! Item was added: + ----- Method: SpurPlanningCompactor>>unpinRememberedSet (in category 'private') ----- + unpinRememberedSet + <inline: true> + firstFieldOfRememberedSet := manager fetchPointer: 0 ofObject: manager rememberedSetObj. + manager setIsPinnedOf: manager rememberedSetObj to: false! Item was added: + ----- Method: SpurPlanningCompactor>>updatePointers (in category 'compaction') ----- + updatePointers + "Sweep the heap, updating all objects to their eventual locations. + Remember to update the savedFirstFields of pointer objects, as these have been forwarded." + | onePass | + coInterpreter mapInterpreterOops. + self updatePointersInManagerHeapEntities. + self updatePointersInSurvivingObjects. + self updatePointersInInitialImmobileObjects. + onePass := self updatePointersInMobileObjects. + onePass ifFalse: + [self updatePointersInObjectsOverflowingSavedFirstFieldsSpace]! Item was added: + ----- Method: SpurPlanningCompactor>>updatePointersFrom:to:in: (in category 'compaction') ----- + updatePointersFrom: start to: finish in: obj + <inline: #always> + start to: finish do: + [:i| | oop fwd | + oop := manager fetchPointer: i ofObject: obj. + ((manager isNonImmediate: oop) and: [self isMobile: oop]) ifTrue: + [self assert: (manager isMarked: oop). + fwd := manager fetchPointer: 0 ofObject: oop. + self assert: (self isPostMobile: fwd). + manager storePointerUnchecked: i ofObject: obj withValue: fwd]]! Item was added: + ----- Method: SpurPlanningCompactor>>updatePointersIn:startingAt:savedFirstFieldPointer: (in category 'compaction') ----- + updatePointersIn: obj startingAt: startIndex savedFirstFieldPointer: firstFieldPtrOrNil + "Sweep the pointer fields in obj, updating all references to mobile objects to their eventual locations. + firstFieldPtrOrNil is supplied for mobile objects so that the first field of a compiled method (which is + its header, or reference to a CogMethod holding its header) can be retrieved." + <inline: true> + startIndex to: (self numPointerSlotsWhileCompactingOf: obj savedFirstFieldPointer: firstFieldPtrOrNil) - 1 do: + [:i| | oop fwd | + oop := manager fetchPointer: i ofObject: obj. + ((manager isNonImmediate: oop) and: [self isMobile: oop]) ifTrue: + [self assert: ((manager isMarked: oop) or: [obj = manager hiddenRootsObject]). + fwd := manager fetchPointer: 0 ofObject: oop. + self assert: (self isPostMobile: fwd). + manager storePointerUnchecked: i ofObject: obj withValue: fwd]]! Item was added: + ----- Method: SpurPlanningCompactor>>updatePointersInInitialImmobileObjects (in category 'compaction') ----- + updatePointersInInitialImmobileObjects + "Sweep the initial immobile heap, updating all references to mobile objects to their eventual locations." + manager allOldSpaceObjectsFrom: manager firstObject do: + [:o| + o >= firstFreeObject ifTrue: + [^self]. + self assert: (manager isMarked: o). + self updatePointersIn: o startingAt: 0 savedFirstFieldPointer: nil]! Item was added: + ----- Method: SpurPlanningCompactor>>updatePointersInManagerHeapEntities (in category 'compaction') ----- + updatePointersInManagerHeapEntities + "The special non-pointer objects containing pointers, which are the objStacks and the rememberedSet, + must be updated manually sicme they will not be recognized as containing pointers in the normal sweep." + manager relocateObjStacksForPlanningCompactor. + (scavenger rememberedSetSize > 0 + and: [self isMobile: firstFieldOfRememberedSet]) ifTrue: + [firstFieldOfRememberedSet := manager fetchPointer: 0 ofObject: firstFieldOfRememberedSet]. + self relocateObjectsInHeapEntity: manager rememberedSetObj from: 1 to: scavenger rememberedSetSize - 1 + "Note that we /must not/ set the rememberedSetObj here since it is a slot in the hiddenRootsObj + and will be updated normally in updatePointersInInitialImmobileObjects. So do not do + (self isMobile: manager rememberedSetObj) ifTrue: + [manager rememberedSetObj: (manager fetchPointer: 0 ofObject: manager rememberedSetObj)]"! Item was added: + ----- Method: SpurPlanningCompactor>>updatePointersInMobileObjects (in category 'compaction') ----- + updatePointersInMobileObjects + "Sweep the mobile portion of the heap, updating all references to objects to their eventual locations. + Remember to update the savedFirstFields of pointer objects, as these have been forwarded. + This enumeration matches that in planCompactSavingForwarders and copyAndUnmarkMobileObjects." + + | toFinger top previousPin | + toFinger := manager startOfObject: firstFreeObject. + top := savedFirstFieldsSpace start - manager bytesPerOop. + self deny: (manager isMarked: firstFreeObject). + manager allOldSpaceEntitiesFrom: firstMobileObject do: + [:o| + self assert: (previousPin isNil or: [toFinger < previousPin]). + (manager isMarked: o) ifTrue: + [(manager isPinned: o) + ifTrue: + [self updatePointersIn: o startingAt: 0 savedFirstFieldPointer: nil. + previousPin ifNotNil: + [self assert: previousPin > toFinger. + ((manager isSegmentBridge: previousPin) + and: [manager isSegmentBridge: o]) ifTrue: + [self halt: 'empty segment']]. + previousPin := o] + ifFalse: + [| availableSpace bytes next | + (top := top + manager bytesPerOop) >= savedFirstFieldsSpace limit ifTrue: + [^false]. + [previousPin notNil + and: [availableSpace := (manager startOfObject: previousPin) - toFinger. + bytes := manager bytesInObject: o. + bytes ~= availableSpace + and: [bytes + (2 * manager allocationUnit) < availableSpace]]] whileTrue: + ["The object does not fit in the space between toFinger and previousPin. + Move toFinger beyond previousPin and update previousPin appropriately." + toFinger := manager addressAfter: previousPin. + next := manager objectStartingAt: toFinger. + next >= o ifTrue: + [^self continueUpdatePointersInMobileObjectsFrom: next]. + previousPin := (manager isPinned: next) ifTrue: [next]]. + ((manager formatOf: o) <= manager lastPointerFormat + and: [(manager numSlotsOf: o) > 0]) ifTrue: + [| oop fwd | + "Relocate the saved first field; Note that CompiledMethods can be excluded since their + first field is either a SmallInteger or a reference to a CogMethod outside of oldSpace." + oop := manager longAt: top. + ((manager isNonImmediate: oop) and: [self isMobile: oop]) ifTrue: + [self assert: (manager isMarked: oop). + fwd := manager fetchPointer: 0 ofObject: oop. + self assert: (self isPostMobile: fwd). + manager longAt: top put: fwd]]. + self updatePointersIn: o startingAt: 1 savedFirstFieldPointer: top. + toFinger := toFinger + (manager bytesInObject: o)]]]. + ^true! Item was added: + ----- Method: SpurPlanningCompactor>>updatePointersInSurvivingObjects (in category 'compaction') ----- + updatePointersInSurvivingObjects + "Sweep pastSpace, updating all references to mobile objects to their eventual locations." + manager allPastSpaceObjectsDo: + [:o| + self assert: (manager isMarked: o). + self updatePointersIn: o startingAt: 0 savedFirstFieldPointer: nil]! Item was added: + ----- Method: SpurPlanningCompactor>>updateSavedFirstFieldsSpaceIfNecessary (in category 'space management') ----- + updateSavedFirstFieldsSpaceIfNecessary + "If savedFirstFieldsSpace is a free chunk then it may need to be repositioned if there is more than one pass." + + ((manager isInOldSpace: savedFirstFieldsSpace start) + and: [savedFirstFieldsSpaceWasAllocated not]) ifTrue: + [self useFreeChunkForSavedFirstFieldsSpace: manager findLargestFreeChunk]. + + savedFirstFieldsSpace top: savedFirstFieldsSpace start - manager bytesPerOop. + manager resetFreeListHeads! Item was added: + ----- Method: SpurPlanningCompactor>>useEdenForSavedFirstFieldsSpace (in category 'space management') ----- + useEdenForSavedFirstFieldsSpace + "Use teden to hold the savedFirstFieldsSpace." + <inline: true> + savedFirstFieldsSpace + start: scavenger eden start; + limit: scavenger eden limit! Item was added: + ----- Method: SpurPlanningCompactor>>useFreeChunkForSavedFirstFieldsSpace: (in category 'space management') ----- + useFreeChunkForSavedFirstFieldsSpace: highestSuitableFreeBlock + "Use the supplied free chunk to hold the savedFirstFieldsSpace. + Invoked when eden is found not to be big enough for the job." + <inline: true> + savedFirstFieldsSpace + start: highestSuitableFreeBlock; + limit: (manager addressAfter: highestSuitableFreeBlock)! Item was added: + ----- Method: SpurPlanningCompactor>>useSegmentForSavedFirstFieldsSpace: (in category 'space management') ----- + useSegmentForSavedFirstFieldsSpace: spaceEstimate + "Attempt to allocate a memory segment large enough to hold the savedFirstFieldsSpace. + Invoked when neither eden nor a large free chunk are found to be big enough for the + job." + | allocatedSize | + (manager "sent to the manager so that the simulator can increase memory to simulate a new segment" + sqAllocateMemorySegmentOfSize: spaceEstimate + Above: (self firstGapOfSizeAtLeast: spaceEstimate) + AllocatedSizeInto: (self cCode: [self addressOf: allocatedSize] + inSmalltalk: [[:sz| allocatedSize := sz]])) ifNotNil: + [:segAddress| + savedFirstFieldsSpaceWasAllocated := true. + savedFirstFieldsSpace + start: segAddress; + limit: segAddress + allocatedSize. + ^true]. + ^false! Item was added: + CogClass subclass: #SpurSlidingCompactor + instanceVariableNames: 'manager scavenger coInterpreter compactedCopySpace' + classVariableNames: '' + poolDictionaries: 'SpurMemoryManagementConstants VMBasicConstants VMSpurObjectRepresentationConstants' + category: 'VMMaker-SpurMemoryManager'! + + !SpurSlidingCompactor commentStamp: 'eem 12/17/2016 15:30' prior: 0! + SpurSlidingCompactor compacts memory completely by sliding objects down in memory. It does so by using a buffer (compactedCopySpace) to hold a copy of compacted objects in some region of the heap being compacted. Starting at the first object above free space (up until a pinned object), objects are copied into CCS until it fills up, and as objects are copied, their originals are forwarded to the location they would occupy. Once the CCS is full, or all of the heap has been copied to it, memory is scanned searching for oops in the range being compacted, and oops are updated to their actual positions. Then the contents of the CCS are block copied into place. The process repeats until all of the heap has been compacted. This will leave one contiguous free chunk in the topmost occupied segment (ignoring pinned objects). The number of passes made to follow forwarders is approximately the allocated size of the heap divided by the size of CCS; the larger CCS the more objects that can be compacted in one go (ignoring the effect of pinned objects). + + Instance Variables + coInterpreter: <StackInterpreter> + compactedCopySpace: <SpurNewSpaceSpace> + manager: <SpurMemoryManager> + scavenger: <SpurGenerationScavenger> + + compactedCopySpace + - a large contiguous region of memory used to copy objects into during compaction. The compactor may try and allocate a segment, use a large free chunk or use eden for this memory.! Item was added: + ----- Method: SpurSlidingCompactor>>biasForGC (in category 'compaction - api') ----- + biasForGC + <inline: true>! Item was added: + ----- Method: SpurSlidingCompactor>>biasForSnapshot (in category 'compaction - api') ----- + biasForSnapshot + <inline: true>! Item was added: + ----- Method: SpurSlidingCompactor>>compact (in category 'compaction - api') ----- + compact + "Sweep all of old space, sliding unpinned marked objects down over free and unmarked objects. + Let the segmentManager mark which segments contain pinned objects via notePinned:. + destination: nil or the start of a run of free and/or unmarked objects + pinnedObject: nil or the pinned object found in the sweep around which unpinned objects must be copied." + | destination pinnedObject | + <inline: #never> "for profiling" + manager checkFreeSpace: GCModeFull. + manager resetFreeListHeads. + self selectCompactedCopySpace. + destination := pinnedObject := nil. + manager allOldSpaceEntitiesFrom: manager firstObject do: + [:o| + (manager isMarked: o) + ifTrue: "forwarders should have been followed in markAndTrace:" + [self assert: (manager isForwarded: o) not. + destination + ifNil: + [manager setIsMarkedOf: o to: false. + (manager isPinned: o) ifTrue: + [manager segmentManager notePinned: o]] + ifNotNil: + [(manager isPinned: o) + ifTrue: + [manager segmentManager notePinned: o. + destination := self copyObjectsInCompactedCopySpaceTo: destination followingUpTo: o. + (manager startOfObject: o) - destination > manager allocationUnit + ifTrue: "Possible to move objects below the pinnedObject" + [pinnedObject + ifNil: [] + ifNotNil: []. + pinnedObject := o] + ifFalse: "Impossible; ensure there's a free chunk if necessary." + [pinnedObject + ifNil: [] + ifNotNil: []. + destination := nil]] "WAIT; NEED AT LEAST 2 WORDS FOR FREE CHUNK" + ifFalse: + [manager setIsMarkedOf: o to: false. + (self fitsInCompactedCopySpace: o) ifFalse: + [destination := self copyObjectsInCompactedCopySpaceTo: destination followingUpTo: o]. + (self fitsInCompactedCopySpace: o) + ifFalse: [destination := self slideHugeObject: o downTo: destination] + ifTrue: + [self copyToCompactedCopySpace: o andForwardTargetedAt: destination]]]] + ifFalse: "unmarked; two cases, an unreachable object or a free chunk. Should be faster to set free than to check if already free..." + [destination ifNil: [destination := manager startOfObject: o]. + manager setObjectFree: o]]! 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 *'> | 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: - "With SqueakV3 objectMemory can't assert since object body is yet to move." - objectMemory hasSpurMemoryManagerAPI 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: StackInterpreterSimulator>>printHexnp: (in category 'debug printing') ----- printHexnp: anInteger traceOn ifTrue: + [transcript nextPutAll: ((anInteger ifNil: [0]) storeStringBase: 16)]! - [transcript nextPutAll: (anInteger storeStringBase: 16)]!

1 0

[OpenSmalltalk/opensmalltalk-vm] 28630b: The extra +1 in size parameter passed to mprotect(...
by GitHub 24 Dec '16

24 Dec '16

Branch: refs/heads/Cog Home: https://github.com/OpenSmalltalk/opensmalltalk-vm Commit: 28630b8c60c35096175f6d6fddb5cd91d7868882 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/28630b8c60c3509617… Author: Ronie Salgado <roniesalg(a)gmail.com> Date: 2016-12-20 (Tue, 20 Dec 2016) Changed paths: M platforms/unix/vm/sqUnixSpurMemory.c M platforms/win32/vm/sqWin32SpurAlloc.c Log Message: ----------- The extra +1 in size parameter passed to mprotect(Unix) and VirtualProtect(Windows). Commit: 4d732c6db375be18a96a3c850f60a14538d2d867 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/4d732c6db375be18a9… Author: Ronie Salgado <roniesalg(a)gmail.com> Date: 2016-12-21 (Wed, 21 Dec 2016) Changed paths: M platforms/unix/vm/sqUnixSpurMemory.c Log Message: ----------- Computing the size after rounding down the start address. Commit: 11880398af1da706e7b61802c11985f12bef280e https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/11880398af1da706e7… Author: Nicolas Cellier <nicolas.cellier.aka.nice(a)gmail.com> Date: 2016-12-22 (Thu, 22 Dec 2016) Changed paths: M platforms/unix/vm/sqUnixSpurMemory.c M platforms/win32/vm/sqWin32SpurAlloc.c Log Message: ----------- Merge pull request #109 from ronsaldo/MProtectBug Bug when calling mprotect and VirtualAlloc with the SpurMemoryManager Compare: https://github.com/OpenSmalltalk/opensmalltalk-vm/compare/28293aa6b85e...11…

4 4

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Vm-dev December 2016