[Vm-dev] VM Maker: VMMaker.oscog-eem.2724.mcz

commits at source.squeak.org commits at source.squeak.org
Tue Mar 10 04:26:40 UTC 2020


Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2724.mcz

==================== Summary ====================

Name: VMMaker.oscog-eem.2724
Author: eem
Time: 9 March 2020, 9:25:33.195338 pm
UUID: 8312b062-c234-4dbb-bc52-8541f45811bb
Ancestors: VMMaker.oscog-nice.2723

SpurMemoryManager/SpurPlanningCompactor:
Fix one bug thrown up by Marcel's EphemeronLink example.  The planning compactor failed to update objects in the mournQueue objStack.

Make sure prepareObjStacksForPlanningCompactor is actually invoked (!!).

Refactor a couple of obj stack routines to take an "also do contents" flag, printObjStack:printContents:, relocateObjStackForPlanningCompactor:andContents:, the last one fixing the bug in question.

Refactor runLeakCheckerForFreeSpace: into runLeakCheckerForFreeSpace:ignoring: to allow the most recenty allocated object in clone (the shallowCopy primitive) to be ignored, because its contents are not yet initialized when the free space check is done.

Make sure to run the free space integrity check as part of leak checking.

Fix a comment typo.

Simulator:
StackInterpreter: fix simulaiton of primitiveHighBit on 64-bits.
Make withSimulatorFetchPointerMovedAsideDo: monotonic, allowing the free space checker to be run in the context of the leak checker.

VMMaker initialization, hack fix initialization in the current Squeak Git support context.

=============== Diff against VMMaker.oscog-nice.2723 ===============

Item was changed:
  ----- Method: ImageLeakChecker class>>prepareToBeAddedToCodeGenerator: (in category 'translation') -----
  prepareToBeAddedToCodeGenerator: aCodeGen
  	aCodeGen
  		removeMethodForSelector: #become:with:;
  		removeMethodForSelector: #fullGC;
  		removeMethodForSelector: #growOldSpaceByAtLeast:;
  		removeMethodForSelector: #runLeakCheckerFor:;
+ 		removeMethodForSelector: #runLeakCheckerForFreeSpace:ignoring:;
- 		removeMethodForSelector: #runLeakCheckerForFreeSpace:;
  		removeMethodForSelector: #runLeakCheckerFor:excludeUnmarkedObjs:classIndicesShouldBeValid:;
  		removeMethodForSelector: #inLineRunLeakCheckerFor:excludeUnmarkedObjs:classIndicesShouldBeValid:;
  		removeMethodForSelector: #scheduleScavenge;
  		removeMethodForSelector: #tenuringIncrementalGC!

Item was removed:
- ----- Method: ImageLeakChecker>>runLeakCheckerForFreeSpace: (in category 'implementation') -----
- runLeakCheckerForFreeSpace: gcModes!

Item was added:
+ ----- Method: ImageLeakChecker>>runLeakCheckerForFreeSpace:ignoring: (in category 'implementation') -----
+ runLeakCheckerForFreeSpace: gcModes ignoring: anOop!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveHighBit (in category 'arithmetic integer primitives') -----
  primitiveHighBit
  	| integerReceiverOop leadingZeroCount highestBitZeroBased |
  	integerReceiverOop := self stackTop.
  	"Convert the receiver Oop to use a single tag bit"
  	objectMemory numSmallIntegerTagBits > 1 ifTrue:
+ 		[integerReceiverOop := (integerReceiverOop >>> (objectMemory numSmallIntegerTagBits-1) bitOr: 1)].
- 		[integerReceiverOop := (integerReceiverOop >>> (self numSmallIntegerTagBits-1) bitOr: 1)].
  	self cppIf: #'__GNUC__' defined
  		ifTrue:
  			["Note: in gcc, result is undefined if input is zero (for compatibility with BSR fallback when no CLZ instruction available).
  			but input is never zero because we pass the oop with tag bits set, so we are safe"
  			objectMemory wordSize = 4
  				ifTrue: [leadingZeroCount := self __builtin_clz: integerReceiverOop]
  				ifFalse: [leadingZeroCount := self __builtin_clzll: integerReceiverOop].
  			leadingZeroCount = 0
  				ifTrue:
  					["highBit is not defined for negative Integer"
  					self primitiveFail]
  				ifFalse:
  					["Nice bit trick: 1-based high-bit is (32 - clz) - 1 to account for tag bit.
  					This is like two-complement - clz - 1 on 5 bits, or in other words a bit-invert operation clz ^16r1F"
  					self pop: 1 thenPushInteger: (leadingZeroCount bitXor: (BytesPerWord * 8 - 1))].
  			^self].
  	self cppIf: #'__GNUC__' defined not & (#'_MSC_VER' defined | #'__ICC' defined)
  		ifTrue:
  			["In MSVC, _lzcnt and _lzcnt64 builtins do not fallback to BSR when not supported by CPU
  			Instead of messing with __cpuid() we always use the BSR intrinsic"
  			
  			"Trick: we test the oop sign rather than the integerValue. Assume oop are signed (so far, they are, sqInt are signed)"
  			integerReceiverOop < 0 ifTrue: [self primitiveFail] ifFalse: [		
  			"Setting this variable is useless, but VMMaker will generate an automatic initialization at a worse place if this isn't initialized explicitly."
  			highestBitZeroBased := 0.
  			"We do not even test the return value, because integerReceiverOop is never zero"
  			self cCode: [objectMemory wordSize = 4
  					ifTrue: [self _BitScanReverse: (self addressOf: highestBitZeroBased) _: integerReceiverOop]
  					ifFalse: [self _BitScanReverse64: (self addressOf: highestBitZeroBased) _: integerReceiverOop]]
  				inSmalltalk: [highestBitZeroBased := integerReceiverOop highBit - 1].
  			"thanks to the tag bit, the +1 operation for getting 1-based rank is not necessary"
  			self pop: 1 thenPushInteger: highestBitZeroBased].
  			^self].
  	self cppIf:  #'__GNUC__' defined not & #'_MSC_VER' defined not & #'__ICC' defined not
  		ifTrue:
  			["not gcc/clang, nor MSVC/ICC, you have to implement if your compiler provide useful builtins"
  			self cCode:
  					[self primitiveFail]
  				inSmalltalk: "Simulate so that the simulatror is closer to the actual VM"
  					[integerReceiverOop < 0
  						ifTrue: [self primitiveFail]
  						ifFalse: [self pop: 1 thenPushInteger: integerReceiverOop highBit - 1]]]!

Item was changed:
  ----- Method: Spur32BitMMLESimulator>>checkHeapIntegrity:classIndicesShouldBeValid: (in category 'debug support') -----
  checkHeapIntegrity: excludeUnmarkedObjs classIndicesShouldBeValid: classIndicesShouldBeValid
  	"Almost all of the time spent in SourMemoryManager>>checkHeapIntegrity:classIndicesShouldBeValid: used to go into the asserts in fetchPointer:ofObject: in the simulator class overrides.
+ 	 Since we know here the indices used are valid we temporarily remove them to claw back that performance."
- 	 Since we know here the indices used are valid we temporarily remove them to claw back that poerformance."
  	^self withSimulatorFetchPointerMovedAsideDo:
  		[super checkHeapIntegrity: excludeUnmarkedObjs classIndicesShouldBeValid: classIndicesShouldBeValid]!

Item was changed:
  ----- Method: Spur64BitMMLECoSimulator>>checkHeapIntegrity:classIndicesShouldBeValid: (in category 'debug support') -----
  checkHeapIntegrity: excludeUnmarkedObjs classIndicesShouldBeValid: classIndicesShouldBeValid
  	"Almost all of the time spent in SourMemoryManager>>checkHeapIntegrity:classIndicesShouldBeValid: used to go into the asserts in fetchPointer:ofObject: in the simulator class overrides.
+ 	 Since we know here the indices used are valid we temporarily remove them to claw back that performance."
- 	 Since we know here the indices used are valid we temporarily remove them to claw back that poerformance."
  	^self withSimulatorFetchPointerMovedAsideDo:
  		[super checkHeapIntegrity: excludeUnmarkedObjs classIndicesShouldBeValid: classIndicesShouldBeValid]!

Item was changed:
  ----- Method: Spur64BitMMLESimulator>>checkHeapIntegrity:classIndicesShouldBeValid: (in category 'debug support') -----
  checkHeapIntegrity: excludeUnmarkedObjs classIndicesShouldBeValid: classIndicesShouldBeValid
  	"Almost all of the time spent in SourMemoryManager>>checkHeapIntegrity:classIndicesShouldBeValid: used to go into the asserts in fetchPointer:ofObject: in the simulator class overrides.
+ 	 Since we know here the indices used are valid we temporarily remove them to claw back that performance."
- 	 Since we know here the indices used are valid we temporarily remove them to claw back that poerformance."
  	^self withSimulatorFetchPointerMovedAsideDo:
  		[super checkHeapIntegrity: excludeUnmarkedObjs classIndicesShouldBeValid: classIndicesShouldBeValid]!

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.
  	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 ignoring: chunk + self baseHeaderSize.
- 		 self checkFreeSpace: GCModeNewSpace.
  		 ^chunk + self baseHeaderSize].
  	self longAt: chunk
  		put: (self headerForSlots: numSlots format: formatField classIndex: classIndex).
+ 	self checkFreeSpace: GCModeNewSpace ignoring: chunk.
- 	self checkFreeSpace: GCModeNewSpace.
  	^chunk!

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, 32k bytes per page in 64 bits"
- 	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 hiddenRootsObject 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."
- 	"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!

Item was changed:
  ----- Method: SpurMemoryManager>>checkFreeSpace: (in category 'debug support') -----
  checkFreeSpace: gcModes
  	<api>
  	self assert: self bitsSetInFreeSpaceMaskForAllFreeLists.
  	self assert: totalFreeOldSpace = self totalFreeListBytes.
  	(gcModes > 0
  	 and: [checkForLeaks allMask: (GCModeFreeSpace bitOr: gcModes)]) ifTrue:
+ 		[self runLeakCheckerForFreeSpace: GCModeFreeSpace ignoring: nil]!
- 		[self runLeakCheckerForFreeSpace: GCModeFreeSpace]!

Item was added:
+ ----- Method: SpurMemoryManager>>checkFreeSpace:ignoring: (in category 'debug support') -----
+ checkFreeSpace: gcModes ignoring: anOopToIgnore
+ 	<api>
+ 	self assert: self bitsSetInFreeSpaceMaskForAllFreeLists.
+ 	self assert: totalFreeOldSpace = self totalFreeListBytes.
+ 	(gcModes > 0
+ 	 and: [checkForLeaks allMask: (GCModeFreeSpace bitOr: gcModes)]) ifTrue:
+ 		[self runLeakCheckerForFreeSpace: GCModeFreeSpace ignoring: anOopToIgnore]!

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 |
  	<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:
+ 				[obj ~= freeSpaceCheckOopToIgnore ifTrue:
+ 					[0 to: (self numPointerSlotsOf: obj) - 1 do:
+ 						[:fi|
+ 						 fieldOop := self fetchPointer: fi ofObject: obj.
+ 						 (self isNonImmediate: fieldOop) ifTrue:
+ 							[(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) ~= 0 ifTrue:
+ 								[coInterpreter print: 'object leak in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; print: ' is free'; 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; 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 isLilliputianSize: (self bytesInObject: obj)) ifFalse:
  					[fieldOop := self fetchPointer: self freeChunkPrevIndex ofFreeChunk: obj.
  					 (fieldOop ~= 0
  					 and: [(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0]) ifTrue:
  						[coInterpreter print: 'leak in free chunk '; printHex: obj; print: ' @ 0 = '; printHex: fieldOop; print: ' is unmapped'; 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)]
  			ifFalse:
+ 				[obj ~= freeSpaceCheckOopToIgnore ifTrue:
+ 					[0 to: (self numPointerSlotsOf: obj) - 1 do:
+ 						[:fi|
+ 						 (self isForwarded: obj)
+ 							ifTrue: 
+ 								[self assert: fi = 0. "I'm now trying to use forwarders in GC algorithms..."
+ 								 fieldOop := self fetchPointer: fi ofMaybeForwardedObject: obj] 
+ 							ifFalse: "We keep #fetchPointer:ofObject: API here for assertions"
+ 								[fieldOop := self fetchPointer: fi ofObject: obj].
+ 						 (self isNonImmediate: fieldOop) ifTrue:
+ 							[(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) ~= 0 ifTrue:
+ 								[coInterpreter print: 'object leak in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; print: ' is free'; cr.
+ 								 self eek.
+ 								 ok := false]]]]]].
- 				[0 to: (self numPointerSlotsOf: obj) - 1 do:
- 					[:fi|
- 					 (self isForwarded: obj)
- 						ifTrue: 
- 							[self assert: fi = 0. "I'm now trying to use forwarders in GC algorithms..."
- 							 fieldOop := self fetchPointer: fi ofMaybeForwardedObject: obj] 
- 						ifFalse: "We keep #fetchPointer:ofObject: API here for assertions"
- 							[fieldOop := self fetchPointer: fi ofObject: obj].
- 					 (self isNonImmediate: fieldOop) ifTrue:
- 						[(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) ~= 0 ifTrue:
- 							[coInterpreter print: 'object leak in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; print: ' is free'; 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>>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 = 0.
+ 		 self asserta: coInterpreter checkInterpreterIntegrity = 0.
  		 self asserta: coInterpreter checkStackIntegrity.
+ 		 self asserta: (coInterpreter checkCodeIntegrity: gcModes).
+ 		 (gcModes anyMask: GCModeFreeSpace) ifTrue:
+ 			[self clearLeakMapAndMapAccessibleFreeSpace.
+ 			 self asserta: self checkHeapFreeSpaceIntegrity]]!
- 		 self asserta: (coInterpreter checkCodeIntegrity: gcModes)]!

Item was changed:
  ----- Method: SpurMemoryManager>>printObjStack: (in category 'obj stacks') -----
  printObjStack: objStack
  	<api>
+ 	self printObjStack: objStack printContents: false!
- 	objStack = nilObj
- 		ifTrue:
- 			[coInterpreter print: 'nil'; cr]
- 		ifFalse:
- 			[self printObjStackPage: objStack
- 				myIndex: (self fetchPointer: ObjStackMyx ofObject: objStack)
- 				pageType: ObjStackMyx]!

Item was added:
+ ----- Method: SpurMemoryManager>>printObjStack:printContents: (in category 'obj stacks') -----
+ printObjStack: objStack printContents: printContents
+ 	<api>
+ 	objStack = nilObj
+ 		ifTrue:
+ 			[coInterpreter print: 'nil'; cr]
+ 		ifFalse:
+ 			[self printObjStackPage: objStack
+ 				myIndex: (self fetchPointer: ObjStackMyx ofObject: objStack)
+ 				pageType: ObjStackMyx
+ 				printContents: printContents]!

Item was added:
+ ----- Method: SpurMemoryManager>>printObjStackPage:myIndex:pageType:printContents: (in category 'obj stacks') -----
+ printObjStackPage: objStackPage myIndex: myx pageType: pageType printContents: printContents
+ 	| freeOrNextPage page isFirstPage isNextPage isFreePage |
+ 	<inline: false>
+ 	isFirstPage := pageType = ObjStackMyx.
+ 	isNextPage := pageType = ObjStackNextx.
+ 	isFreePage := pageType = ObjStackFreex.
+ 	self printObjStackPage: objStackPage
+ 		myIndex: myx
+ 		tag: (isFirstPage ifTrue: ['head'] ifFalse: [isFreePage ifTrue: ['free'] ifFalse: ['next']]).
+ 	(isFirstPage or: [isNextPage]) ifTrue:
+ 		[coInterpreter tab; print: 'topx: '; printNum: (self fetchPointer: ObjStackTopx ofObject: objStackPage); print: ' next: '; printHex: (self fetchPointer: ObjStackNextx ofObject: objStackPage).
+ 		 isFirstPage ifTrue:
+ 			[coInterpreter print: ' free: '; printHex: (self fetchPointer: ObjStackFreex ofObject: objStackPage)].
+ 		 coInterpreter cr].
+ 	isFirstPage ifTrue:
+ 		[freeOrNextPage := self fetchPointer: ObjStackFreex ofObject: objStackPage.
+ 		 [freeOrNextPage ~= 0] whileTrue:
+ 			[self printObjStackPage: freeOrNextPage myIndex: myx pageType: ObjStackFreex printContents: false.
+ 			 page := self fetchPointer: ObjStackFreex ofObject: freeOrNextPage.
+ 			 (page = freeOrNextPage
+ 			  or: [page = objStackPage]) ifTrue:
+ 				[coInterpreter print: 'circularity in free page list!!!!'; cr.
+ 				 page := 0].
+ 			 freeOrNextPage := page]].
+ 	freeOrNextPage := self fetchPointer: ObjStackNextx ofObject: objStackPage.
+ 	freeOrNextPage ~= 0 ifTrue:
+ 		[self printObjStackPage: freeOrNextPage myIndex: myx pageType: ObjStackNextx printContents: printContents].
+ 	printContents ifTrue:
+ 		[| index |
+ 		index := (self fetchPointer: ObjStackTopx ofObject: objStackPage) + ObjStackNextx.
+ 		[index >= ObjStackFixedSlots] whileTrue:
+ 			[coInterpreter space; printHex: (self fetchPointer: index ofObject: objStackPage).
+ 			 index := index - 1].
+ 		(self fetchPointer: ObjStackTopx ofObject: objStackPage) + ObjStackNextx >= ObjStackFixedSlots ifTrue:
+ 			[coInterpreter cr]]!

Item was removed:
- ----- Method: SpurMemoryManager>>relocateObjStackForPlanningCompactor: (in category 'compaction') -----
- relocateObjStackForPlanningCompactor: objStack
- 	"Relocate all objStack pages that comprise 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>>relocateObjStackForPlanningCompactor:andContents: (in category 'compaction') -----
+ relocateObjStackForPlanningCompactor: objStack andContents: relocateContents
+ 	"Relocate all objStack pages that comprise 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 + (relocateContents ifTrue: [self rawHashBitsOf: stackOrNil] ifFalse: [0]).
+ 	 stackOrNil = objStack ifTrue:
+ 		[result := relocated].
+ 	 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 changed:
  ----- Method: SpurMemoryManager>>relocateObjStacksForPlanningCompactor (in category 'compaction') -----
  relocateObjStacksForPlanningCompactor
  	"Relocate all non-empty objStack pages, following the objStacks from the roots."
  
+ 	self assert: (self isEmptyObjStack: markStack).
+ 	markStack := self relocateObjStackForPlanningCompactor: markStack andContents: false.
+ 	self assert: (self isEmptyObjStack: weaklingStack).
+ 	weaklingStack := self relocateObjStackForPlanningCompactor: weaklingStack andContents: false.
+ 	mournQueue := self relocateObjStackForPlanningCompactor: mournQueue andContents: true.!
- 	markStack := self relocateObjStackForPlanningCompactor: markStack.
- 	weaklingStack := self relocateObjStackForPlanningCompactor: weaklingStack.
- 	mournQueue := self relocateObjStackForPlanningCompactor: mournQueue!

Item was removed:
- ----- Method: SpurMemoryManager>>runLeakCheckerForFreeSpace: (in category 'debug support') -----
- runLeakCheckerForFreeSpace: gcModes
- 	<inline: false>
- 	(gcModes anyMask: GCModeFreeSpace) ifTrue:
- 		[coInterpreter reverseDisplayFrom: 16 to: 19.
- 		 self clearLeakMapAndMapAccessibleFreeSpace.
- 		 self asserta: self checkHeapFreeSpaceIntegrity]!

Item was added:
+ ----- Method: SpurMemoryManager>>runLeakCheckerForFreeSpace:ignoring: (in category 'debug support') -----
+ runLeakCheckerForFreeSpace: gcModes ignoring: anOopOrNil
+ 	"Check free space integrity by setting bits in the map corresponding to all free space objects
+ 	 and checking tat no pointer field refers to a free object.  anOopOrNil is provided to filter-out
+ 	 the as-yet-to-be initialized object in primitiveShallowCopy/primitiveClone."
+ 	<inline: false>
+ 	(gcModes anyMask: GCModeFreeSpace) ifTrue:
+ 		[coInterpreter reverseDisplayFrom: 16 to: 19.
+ 		 self clearLeakMapAndMapAccessibleFreeSpace.
+ 		 freeSpaceCheckOopToIgnore := anOopOrNil.
+ 		 self asserta: self checkHeapFreeSpaceIntegrity.
+ 		 freeSpaceCheckOopToIgnore := nil]!

Item was changed:
  ----- Method: SpurMemoryManager>>withSimulatorFetchPointerMovedAsideDo: (in category 'debug support') -----
  withSimulatorFetchPointerMovedAsideDo: aBlock
  	"For performance, remove the simulator implementation of fetchPointer:ofObject:
  	 while aBlock is running and answer the block's result."
  	| theMethod |
  	theMethod := self class lookupSelector: #fetchPointer:ofObject:.
+ 	self deny: theMethod isNil.
+ 	theMethod methodClass == SpurMemoryManager
+ 		ifTrue: [theMethod := nil]
+ 		ifFalse: [theMethod methodClass basicRemoveSelector: #fetchPointer:ofObject:].
- 	self deny: (theMethod isNil or: [theMethod methodClass == SpurMemoryManager]).
- 	theMethod methodClass basicRemoveSelector: #fetchPointer:ofObject:.
  	^aBlock ensure:
+ 		[theMethod ifNotNil:
+ 			[theMethod methodClass
+ 				basicAddSelector: #fetchPointer:ofObject:
+ 				withMethod: theMethod]]!
- 		[theMethod methodClass
- 			basicAddSelector: #fetchPointer:ofObject:
- 			withMethod: theMethod]!

Item was changed:
  ----- Method: SpurPlanningCompactor>>initializeCompaction (in category 'compaction') -----
  initializeCompaction
  	manager checkFreeSpace: GCModeFull.
  	self selectSavedFirstFieldsSpace.
  	self unpinRememberedSet.
  	manager
  		resetFreeListHeads;
+ 		prepareObjStacksForPlanningCompactor;
  		totalFreeOldSpace: 0;
  		beginSlidingCompaction.
  	savedFirstFieldsSpace top: savedFirstFieldsSpace start - manager bytesPerOop!

Item was changed:
  ----- Method: SpurSelectiveCompactorSimulator>>compact (in category 'api') -----
  compact
  	self talk: '~~ Start selective compaction ~~'.
  	self tellMeNumSegmentAndTotalFreeSpace.
  	self tellMeWhichSegmentsAreBeingCompacted.
  	super compact.
  	self tellMeNumSegmentAndTotalFreeSpace.
  	self tellMeWhichSegmentsAreBeingCompacted.
+ 	manager runLeakCheckerForFreeSpace: GCModeFreeSpace ignoring: nil.
- 	manager runLeakCheckerForFreeSpace: GCModeFreeSpace.
  	self talk: '~~ Finished selective compaction ~~'.
  	!

Item was changed:
  ----- Method: VMMaker class>>initialize (in category 'initialisation') -----
  initialize
  	"VMMaker initialize"
  	DirNames := Dictionary new.
  	DirNames
  		at: #coreVMDir put: 'vm';
  		at: #platformsDir put: 'platforms';
  		at: #pluginsDir put: 'plugins';
  		at: #sourceDir put: 'src'.
  
  	"Try and decide where the Cog source tree is.  Two configurations are likely.
  	 One is that the VMMaker image is running in the image directory in the
  	 source tree and hence everything will be at '..'.
  	 Another is where the source tree is at the same level as the VMMaker image,
  	 in which case it is likely called oscogvm or Cog."
  	#('../platforms' 'oscogvm/platforms' 'Cog/platforms' '../oscogvm/platforms')
  		with: #('..' 'oscogvm' 'Cog' '../oscogvm')
+ 		do: ((Smalltalk classNamed: #FileLocator)
- 		do: ((Smalltalk classNamed: #FileSystem)
  				ifNotNil:
+ 					[:classFileLocator|
+ 					 [:dir :path|
+ 					  (classFileLocator cwd / dir) isDirectory ifTrue:
- 					[[:dir :path|
- 					  (FileLocator cwd / dir) isDirectory ifTrue:
  						[DirNames at: #sourceTree put: path.
  						 ^self]]]
  				ifNil:
  					[[:dir :path|
  					  (FileDirectory default directoryExists: dir) ifTrue:
  						[DirNames at: #sourceTree put: path.
  						 ^self]]])!



More information about the Vm-dev mailing list