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

commits at source.squeak.org commits at source.squeak.org
Mon Oct 21 17:12:39 UTC 2013


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

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

Name: VMMaker.oscog-eem.471
Author: eem
Time: 21 October 2013, 10:09:42.395 am
UUID: 51970cea-207a-46a1-85a3-b1296656e2df
Ancestors: VMMaker.oscog-eem.470

Implement rebuilding the free tree after sweep.  Refactor
addToFreeList:bytes: to extract addToFreeTree:bytes:.
Fix reverseSmallListHeads.

Use the iterative freeTreeNodesDo: for totalFreeListBytes.

Add a containsPinned flag to SpurSegmentInfo and update it in
sweep.  Also add a preferredPinningSegment to the seg mgr for
clustering pinned objects, when we get to it.

=============== Diff against VMMaker.oscog-eem.470 ===============

Item was changed:
  CogClass subclass: #SpurMemoryManager
(excessive size, no diff calculated)

Item was changed:
  ----- Method: SpurMemoryManager>>addToFreeList:bytes: (in category 'free space') -----
  addToFreeList: freeChunk bytes: chunkBytes
  	"Add freeChunk to the relevant freeList.
  	 For the benefit of sortedFreeObject:, if freeChunk is large, answer the treeNode it
  	 is added to, if it is added to the next list of a freeTreeNode, otherwise answer 0."
+ 	| index |
- 	| childBytes parent child index |
  	"coInterpreter transcript ensureCr. coInterpreter print: 'freeing '. self printFreeChunk: freeChunk."
  	self assert: (self isFreeObject: freeChunk).
  	self assert: chunkBytes = (self bytesInObject: freeChunk).
  	index := chunkBytes / self allocationUnit.
  	index < self numFreeLists ifTrue:
  		[self storePointer: self freeChunkNextIndex ofFreeChunk: freeChunk withValue: (freeLists at: index).
  		 freeLists at: index put: freeChunk.
  		 freeListsMask := freeListsMask bitOr: 1 << index.
  		 ^0].
  
+ 	^self addToFreeTree: freeChunk bytes: chunkBytes!
- 	self
- 		storePointer: self freeChunkNextIndex ofFreeChunk: freeChunk withValue: 0;
- 		storePointer: self freeChunkParentIndex ofFreeChunk: freeChunk withValue: 0;
- 		storePointer: self freeChunkSmallerIndex ofFreeChunk: freeChunk withValue: 0;
- 		storePointer: self freeChunkLargerIndex ofFreeChunk: freeChunk withValue: 0.
- 	"Large chunk list organized as a tree, each node of which is a list of chunks of the same size.
- 	 Beneath the node are smaller and larger blocks."
- 	parent := 0.
- 	child := freeLists at: 0.
- 	[child ~= 0] whileTrue:
- 		[childBytes := self bytesInObject: child.
- 		 childBytes = chunkBytes ifTrue: "size match; add to list at node."
- 			[self storePointer: self freeChunkNextIndex
- 					ofFreeChunk: freeChunk
- 						withValue: (self fetchPointer: self freeChunkNextIndex ofObject: child);
- 				storePointer: self freeChunkNextIndex
- 					ofFreeChunk: child
- 						withValue: freeChunk.
- 			 ^child].
- 		 "walk down the tree"
- 		 parent := child.
- 		 child := self fetchPointer: (childBytes > chunkBytes
- 										ifTrue: [self freeChunkSmallerIndex]
- 										ifFalse: [self freeChunkLargerIndex])
- 					ofObject: child].
- 	parent = 0 ifTrue:
- 		[self assert: (freeLists at: 0) = 0.
- 		 freeLists at: 0 put: freeChunk.
- 		 freeListsMask := freeListsMask bitOr: 1.
- 		 ^0].
- 	"insert in tree"
- 	self storePointer: self freeChunkParentIndex
- 			ofFreeChunk: freeChunk
- 				withValue: parent.
- 	self storePointer: (childBytes > chunkBytes
- 									ifTrue: [self freeChunkSmallerIndex]
- 									ifFalse: [self freeChunkLargerIndex])
- 			ofFreeChunk: parent
- 				withValue: freeChunk.
- 	^0!

Item was added:
+ ----- Method: SpurMemoryManager>>addToFreeTree:bytes: (in category 'free space') -----
+ addToFreeTree: freeChunk bytes: chunkBytes
+ 	"Add freeChunk to the large free chunk tree.
+ 	 For the benefit of sortedFreeObject:, answer the treeNode it is added
+ 	 to, if it is added to the next list of a freeTreeNode, otherwise answer 0."
+ 	| childBytes parent child |
+ 	self assert: chunkBytes = (self bytesInObject: freeChunk).
+ 	self assert: chunkBytes / self allocationUnit >= self numFreeLists.
+ 
+ 	self
+ 		storePointer: self freeChunkNextIndex ofFreeChunk: freeChunk withValue: 0;
+ 		storePointer: self freeChunkParentIndex ofFreeChunk: freeChunk withValue: 0;
+ 		storePointer: self freeChunkSmallerIndex ofFreeChunk: freeChunk withValue: 0;
+ 		storePointer: self freeChunkLargerIndex ofFreeChunk: freeChunk withValue: 0.
+ 	"Large chunk list organized as a tree, each node of which is a list of chunks of the same size.
+ 	 Beneath the node are smaller and larger blocks."
+ 	parent := 0.
+ 	child := freeLists at: 0.
+ 	[child ~= 0] whileTrue:
+ 		[childBytes := self bytesInObject: child.
+ 		 childBytes = chunkBytes ifTrue: "size match; add to list at node."
+ 			[self storePointer: self freeChunkNextIndex
+ 					ofFreeChunk: freeChunk
+ 						withValue: (self fetchPointer: self freeChunkNextIndex ofObject: child);
+ 				storePointer: self freeChunkNextIndex
+ 					ofFreeChunk: child
+ 						withValue: freeChunk.
+ 			 ^child].
+ 		 "walk down the tree"
+ 		 parent := child.
+ 		 child := self fetchPointer: (childBytes > chunkBytes
+ 										ifTrue: [self freeChunkSmallerIndex]
+ 										ifFalse: [self freeChunkLargerIndex])
+ 					ofObject: child].
+ 	parent = 0 ifTrue:
+ 		[self assert: (freeLists at: 0) = 0.
+ 		 freeLists at: 0 put: freeChunk.
+ 		 freeListsMask := freeListsMask bitOr: 1.
+ 		 ^0].
+ 	"insert in tree"
+ 	self storePointer: self freeChunkParentIndex
+ 			ofFreeChunk: freeChunk
+ 				withValue: parent.
+ 	self storePointer: (childBytes > chunkBytes
+ 									ifTrue: [self freeChunkSmallerIndex]
+ 									ifFalse: [self freeChunkLargerIndex])
+ 			ofFreeChunk: parent
+ 				withValue: freeChunk.
+ 	^0!

Item was removed:
- ----- Method: SpurMemoryManager>>bytesInFreeTree: (in category 'free space') -----
- bytesInFreeTree: freeNode
- 	| freeBytes bytesInObj listNode |
- 	freeNode = 0 ifTrue: [^0].
- 	freeBytes := 0.
- 	bytesInObj := self bytesInObject: freeNode.
- 	self assert: bytesInObj / self allocationUnit >= self numFreeLists.
- 	listNode := freeNode.
- 	[listNode ~= 0] whileTrue:
- 		["self printFreeChunk: listNode"
- 		 self assert: (self isValidFreeObject: listNode).
- 		 freeBytes := freeBytes + bytesInObj.
- 		 self assert: bytesInObj = (self bytesInObject: listNode).
- 		 listNode := self fetchPointer: self freeChunkNextIndex ofFreeChunk: listNode].
- 	^freeBytes
- 	+ (self bytesInFreeTree: (self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: freeNode))
- 	+ (self bytesInFreeTree: (self fetchPointer: self freeChunkLargerIndex ofFreeChunk: freeNode))!

Item was changed:
  ----- Method: SpurMemoryManager>>freeUnmarkedObjectsNilUnmarkedWeaklingSlotsAndSortAndCoallesceFreeSpace (in category 'gc - global') -----
  freeUnmarkedObjectsNilUnmarkedWeaklingSlotsAndSortAndCoallesceFreeSpace
  	"Sweep all of old space, freeing unmarked objects, nilling the unmarked slots of weaklings,
  	 coallescing free chunks, and sorting free space.  Small free chunks are sorted in address
+ 	 order on each small list head.  Large free chunks are sorted on the sortedFreeChunks list.
+ 	 Record the highest N objects in highestObjects, for the first cycle of exactFitCompact.
+ 	 Let the segmentManager mark which segments contain pinned objects via notePinned:"
+ 	| lastLargeFree highestObjectsWraps |
- 	 order on each small list head.  Large free chunks are sorted on the sortedFreeChunks list."
- 	| lastLargeFree |
  	self checkFreeSpace.
  	scavenger forgetUnmarkedRememberedObjects.
+ 	segmentManager prepareForGlobalSweep."for notePinned:"
- 	self checkFreeSpace.
  	"for sorting free space throw away the list heads, rebuilding them for small free chunks below."
  	self resetFreeListHeads.
+ 	highestObjects
+ 		top: freeStart;
+ 		start: freeStart;
+ 		limit: scavenger eden limit.
+ 	highestObjectsWraps := 0.
+ 	self assert: highestObjects limit - highestObjects start // self wordSize >= 1024.
  	sortedFreeChunks := lastLargeFree := 0.
  	self allOldSpaceEntitiesForCoallescingDo:
  		[:o|
  		(self isMarked: o)
  			ifTrue:
  				[self setIsMarkedOf: o to: false.
  				 ((self isWeakNonImm: o)
  				 and: [self nilUnmarkedWeaklingSlots: o]) ifTrue:
+ 					[coInterpreter signalFinalization: o].
+ 				 (self isPinned: o) ifTrue:
+ 					[segmentManager notePinned: o].
+ 				 lastLargeFree ~= 0 ifTrue:
+ 					[self longAt: highestObjects top put: o.
+ 					 (highestObjects top: (highestObjects top + self wordSize)) >= highestObjects limit ifTrue:
+ 						[highestObjects top: highestObjects start.
+ 						 highestObjectsWraps := highestObjectsWraps + 1]]]
- 					[coInterpreter signalFinalization: o]]
  			ifFalse: "unmarked; two cases, an unreachable object or a free chunk."
  				[| here next |
  				 self assert: (self isRemembered: o) not. "scavenger should have cleared this above"
  				 here := o.
  				 next := self objectAfter: here limit: endOfMemory.
  				 (self isMarked: next) ifFalse: "coallescing; rare case"
  					[self assert: (self isRemembered: o) not.
  					 [statCoallesces := statCoallesces + 1.
  					  here := self coallesce: here and: next.
  					  next := self objectAfter: here limit: endOfMemory.
  					  next = endOfMemory or: [self isMarked: next]] whileFalse].
  				 (self isLargeFreeObject: here)
  					ifTrue:
  						[lastLargeFree = 0
  							ifTrue: [sortedFreeChunks := here]
  							ifFalse:
  								[self setFree: here.
  								 self storePointer: self freeChunkNextAddressIndex ofFreeChunk: lastLargeFree withValue: here].
  						 lastLargeFree := here]
  					ifFalse:
  						[self freeSmallObject: here]]].
  	lastLargeFree ~= 0 ifTrue:
  		[self storePointer: self freeChunkNextAddressIndex ofFreeChunk: lastLargeFree withValue: 0].
  	totalFreeOldSpace := self reverseSmallListHeads.
  	totalFreeOldSpace := totalFreeOldSpace + self rebuildFreeTreeFromSortedFreeChunks.
+ 	self checkFreeSpace.
+ 	self touch: highestObjectsWraps!
- 	self checkFreeSpace!

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 := scavengeInProgress := marking := false.
  	becomeEffectsFlags := 0.
  	statScavenges := statIncrGCs := statFullGCs := 0.
  	statScavengeGCUsecs := statIncrGCUsecs := statFullGCUsecs := statGCEndUsecs := 0.
  	statSGCDeltaUsecs := statIGCDeltaUsecs := statFGCDeltaUsecs := 0.
  	statGrowMemory := statShrinkMemory := statRootTableCount := statTenures := statSurvivorCount := 0.
  	statRootTableOverflows := statSweepCount := statMarkCount := statSpecialMarkCount := statMkFwdCount := 0.
  	statCoallesces := 0.
  
  	"We can initialize things that are allocated but are lazily initialized."
  	unscannedEphemerons := SpurContiguousObjStack new.
+ 	highestObjects := SpurContiguousObjStack new.
  
  	"we can initialize things that are virtual in C."
  	scavenger := SpurGenerationScavengerSimulator new manager: self; yourself.
  	segmentManager := SpurSegmentManager new manager: self; yourself.
  
  	"We can also initialize here anything that is only for simulation."
  	heapMap := self wordSize = 4 ifTrue: [CogCheck32BitHeapMap new].
  
  	"N.B. We *don't* initialize extraRoots because we don't simulate it."!

Item was added:
+ ----- Method: SpurMemoryManager>>rebuildFreeTreeFromSortedFreeChunks (in category 'free space') -----
+ rebuildFreeTreeFromSortedFreeChunks
+ 	"post sweep and pre compact, rebuild the large
+ 	 free chunk tree from the sortedFreeChunks list."
+ 	| freeChunk bytes totalBytes |
+ 	freeChunk := sortedFreeChunks.
+ 	totalBytes := 0.
+ 	[freeChunk ~= 0] whileTrue:
+ 		[bytes := self bytesInObject: freeChunk.
+ 		 totalBytes := totalBytes + bytes.
+ 		 self addToFreeTree: freeChunk bytes: bytes.
+ 		 freeChunk := self fetchPointer: self freeChunkNextAddressIndex
+ 							ofObject: freeChunk].
+ 	^totalBytes!

Item was removed:
- ----- Method: SpurMemoryManager>>resetSmallFreeListHeads (in category 'free space') -----
- resetSmallFreeListHeads
- 	1 to: self numFreeLists - 1 do:
- 		[:i| freeLists at: i put: 0]!

Item was changed:
  ----- Method: SpurMemoryManager>>reverseSmallListHeads (in category 'free space') -----
  reverseSmallListHeads
  	"After freeUnmarkedObjectsNilUnmarkedWeaklingSlotsAndSortAndCoallesceFreeSpace
  	 all small free chunks will be on the free lists in reverse address order.  Reverse each list,
  	 summing the ammount of space.  Answer the sum of bytes of free space on these small lists."
  	| total |
  	total := 0.
+ 	freeListsMask := 0.
  	1 to: self numFreeLists - 1 do:
  		[:i| | bytes node prev next |
  		 bytes := i * self allocationUnit.
  		 node := freeLists at: i.
+ 		 node ~= 0 ifTrue:
+ 			[self assert: (self bytesInObject: node) = bytes.
+ 			 freeListsMask := freeListsMask + (1 << i).
+ 			 prev := 0.
+ 			 [node ~= 0] whileTrue:
+ 				[next := self fetchPointer: self freeChunkNextIndex ofObject: node.
+ 				 self storePointer: self freeChunkNextIndex ofFreeChunk: node withValue: prev.
+ 				 prev := node.
+ 				 node := next.
+ 				 total := total + bytes].
+ 			 freeLists at: i put: prev]].
- 		 prev := 0.
- 		 [node ~= 0] whileTrue:
- 			[next := self fetchPointer: self freeChunkNextIndex ofObject: node.
- 			 self storePointer: self freeChunkNextIndex ofFreeChunk: node withValue: prev.
- 			 prev := node.
- 			 node := next.
- 			 total := total + bytes].
- 		 freeLists at: i put: node].
  	^total!

Item was changed:
  ----- Method: SpurMemoryManager>>totalFreeListBytes (in category 'free space') -----
  totalFreeListBytes
+ 	| totalFreeBytes bytesInChunk listNode |
+ 	totalFreeBytes := 0.
- 	| freeBytes bytesInObj obj |
- 	freeBytes := 0.
  	1 to: self numFreeLists - 1 do:
  		[:i| 
+ 		bytesInChunk := i * self allocationUnit.
+ 		listNode := freeLists at: i.
+ 		[listNode ~= 0] whileTrue:
+ 			[totalFreeBytes := totalFreeBytes + bytesInChunk.
+ 			 self assert: (self isValidFreeObject: listNode).
+ 			 self assert: bytesInChunk = (self bytesInObject: listNode).
+ 			 listNode := self fetchPointer: self freeChunkNextIndex ofFreeChunk: listNode]].
+ 
+ 	self freeTreeNodesDo:
+ 		[:treeNode|
+ 		 bytesInChunk := self bytesInObject: treeNode.
+ 		 self assert: bytesInChunk / self allocationUnit >= self numFreeLists.
+ 		 listNode := treeNode.
+ 		 [listNode ~= 0] whileTrue:
+ 			["self printFreeChunk: listNode"
+ 			 self assert: (self isValidFreeObject: listNode).
+ 			 totalFreeBytes := totalFreeBytes + bytesInChunk.
+ 			 self assert: bytesInChunk = (self bytesInObject: listNode).
+ 			 listNode := self fetchPointer: self freeChunkNextIndex ofFreeChunk: listNode]].
+ 	^totalFreeBytes!
- 		bytesInObj := i * self allocationUnit.
- 		obj := freeLists at: i.
- 		[obj ~= 0] whileTrue:
- 			[freeBytes := freeBytes + bytesInObj.
- 			 self assert: (self isValidFreeObject: obj).
- 			 self assert: bytesInObj = (self bytesInObject: obj).
- 			 obj := self fetchPointer: self freeChunkNextIndex ofFreeChunk: obj]].
- 	^freeBytes + (self bytesInFreeTree: (freeLists at: 0))!

Item was changed:
  VMStructType subclass: #SpurSegmentInfo
+ 	instanceVariableNames: 'segStart segSize swizzle containsPinned'
- 	instanceVariableNames: 'segStart segSize swizzle'
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'VMMaker-SpurMemoryManager'!

Item was added:
+ ----- Method: SpurSegmentInfo>>containsPinned (in category 'accessing') -----
+ containsPinned
+ 	"Answer the value of containsPinned"
+ 
+ 	^ containsPinned!

Item was added:
+ ----- Method: SpurSegmentInfo>>containsPinned: (in category 'accessing') -----
+ containsPinned: anObject
+ 	"Set the value of containsPinned"
+ 
+ 	^containsPinned := anObject!

Item was added:
+ ----- Method: SpurSegmentInfo>>initialize (in category 'initialization') -----
+ initialize
+ 	segSize := segStart := swizzle := 0.
+ 	containsPinned := false!

Item was changed:
  ----- Method: SpurSegmentInfo>>printOn: (in category 'printing') -----
  printOn: aStream
  	<doNotGenerate>
  	super printOn: aStream.
  	self class instVarNames do:
  		[:name| | iv |
  		iv := self instVarNamed: name.
  		aStream space; nextPutAll: name; space; print: iv.
+ 		(iv isInteger and: [iv ~= 0]) ifTrue:
- 		iv isInteger ifTrue:
  			[aStream nextPut: $/.  iv storeOn: aStream base: 16]]!

Item was changed:
  CogClass subclass: #SpurSegmentManager
+ 	instanceVariableNames: 'manager numSegments numSegInfos segments firstSegmentSize canSwizzle sweepIndex preferredPinningSegment'
- 	instanceVariableNames: 'manager numSegments numSegInfos segments firstSegmentSize canSwizzle'
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'VMMaker-SpurMemoryManager'!
  
  !SpurSegmentManager commentStamp: 'eem 10/6/2013 10:32' prior: 0!
  Instances of SpurSegmentManager manage oldSpace, which is organized as a sequence of segments.  Segments can be obtained from the operating system and returned to the operating system when empty and shrinkage is required.  Segments are kept invisible from the SpurMemoryManager by using "bridge" objects, "fake" pinned objects to bridge the gaps between segments.  A pinned object header occupies the last 16 bytes of each segment, and the pinned object's size is the distance to the start of the next segment.  So when the memory manager enumerates objects it skips over these bridges and memory appears linear.  The constraint is that segments obtained from the operating system must be at a higher address than the first segment.  The maximum size of large objects, being an overflow slot size, should be big enough to bridge the gaps, because in 32-bits the maximum size is 2^32 slots.  In 64-bits the maximum size of large objects is 2^56 slots, or 2^59 bits, which we hope will suffice.
  
  When an image is written to a snapshot file the second word of the header of the bridge at the end of each segment is replaced by the size of the following segment, the segments are written to the file, and the second word of each bridge is restored.  Hence the length of each segment is derived from the bridge at the end of the preceeding segment.  The length of the first segment is stored in the image header as firstSegmentBytes.  The start of each segment is also derived from the bridge as a delta from the start of the previous segment.  The start of The first segment is stored in the image header as startOfMemory.
  
  On load all segments are read into one single segment, eliminating the bridge objects, and computing the swizzle distance for each segment, based on where the segments were in memory when the image file was written, and where the coallesced segment ends up on load.  Then the segment is traversed, swizzling pointers by selecting the relevant swizzle for each oop's segment.
  
  Instance Variables
  	numSegments:		<Integer>
  	segments:			<Array of SpurSegmentInfo>
  	manager:			<SpurMemoryManager>
  
  numSegments
  	- the number of segments
  
  segments
  	- the start addresses, lengths and offsets to adjust oops on image load, for each segment
  
  manager
  	- the SpurMemoryManager whose oldSpace is managed (simulation only).!

Item was added:
+ ----- Method: SpurSegmentManager>>notePinned: (in category 'pinning') -----
+ notePinned: objOop
+ 	"Let the segmentManager mark which segments contain pinned objects"
+ 	self assert: (manager isPinned: objOop).
+ 	(manager isSegmentBridge: objOop) ifFalse:
+ 		[[(segments at: sweepIndex) segStart + (segments at: sweepIndex) segSize < objOop] whileTrue:
+ 			[sweepIndex := sweepIndex + 1].
+ 		 (segments at: sweepIndex) containsPinned: true]!

Item was added:
+ ----- Method: SpurSegmentManager>>prepareForGlobalSweep (in category 'pinning') -----
+ prepareForGlobalSweep
+ 	"Let the segmentManager mark which segments contain pinned objects via notePinned:"
+ 	sweepIndex := 0.
+ 	0 to: numSegments - 1 do:
+ 		[:i| (segments at: i) containsPinned: false]!



More information about the Vm-dev mailing list