[Vm-dev] VM Maker: VMMaker.oscog-cb.2406.mcz

commits at source.squeak.org commits at source.squeak.org
Thu Jun 7 18:03:11 UTC 2018


ClementBera uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-cb.2406.mcz

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

Name: VMMaker.oscog-cb.2406
Author: cb
Time: 7 June 2018, 8:02:40.687927 pm
UUID: f05a0c4e-15d4-44ab-8ac2-333a6ac1577c
Ancestors: VMMaker.oscog-cb.2405

Added bytesBigEnoughForPrevPointer: abstraction and patch all callers to use that.

32 bits works, now fixing 64 bits.

=============== Diff against VMMaker.oscog-cb.2405 ===============

Item was added:
+ ----- Method: Spur32BitMemoryManager>>bytesBigEnoughForPrevPointer: (in category 'free space') -----
+ bytesBigEnoughForPrevPointer: chunkBytes
+ 	"Allocation unit, the minimum size, is enough for 2 pointers"
+ 	^ true!

Item was added:
+ ----- Method: Spur64BitMemoryManager>>bytesBigEnoughForPrevPointer: (in category 'free space') -----
+ bytesBigEnoughForPrevPointer: chunkBytes
+ 	^ chunkBytes ~= (self baseHeaderSize + self allocationUnit)!

Item was changed:
  ----- 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: (self isFreeObject: freeChunk).
  	self assert: chunkBytes = (self bytesInObject: freeChunk).
  	self assert: chunkBytes >= (self numFreeLists * self allocationUnit).
  	self
  		storePointer: self freeChunkNextIndex ofFreeChunk: freeChunk withValue: 0;
  		storePointer: self freeChunkPrevIndex 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.
  		 "check for overlap; could write this as self oop: (self objectAfter: freeChunk) isLessThanOrEqualTo: child...
  		  but that relies on headers being correct, etc.  So keep it clumsy..."
  		 self assert: ((self oop: freeChunk + chunkBytes - self baseHeaderSize isLessThanOrEqualTo: child)
  						or: [self oop: freeChunk isGreaterThanOrEqualTo: child + childBytes - self baseHeaderSize]).
  		 childBytes = chunkBytes ifTrue: "size match; add to list at node."
+ 			[self setNextFreeChunkOf: freeChunk withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: child) bytesBigEnoughForPrevPointer: true. 
+ 			 self setNextFreeChunkOf: child withValue: freeChunk bytesBigEnoughForPrevPointer: true.
- 			[self setNextFreeChunkOf: freeChunk withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: child) sizeIsOne: false. 
- 			 self setNextFreeChunkOf: child withValue: freeChunk sizeIsOne: false.
  			 ^child].
  		 "walk down the tree"
  		 parent := child.
  		 child := self fetchPointer: (childBytes > chunkBytes
  										ifTrue: [self freeChunkSmallerIndex]
  										ifFalse: [self freeChunkLargerIndex])
  					ofFreeChunk: child].
  	parent = 0 ifTrue:
  		[self assert: (freeLists at: 0) = 0.
  		 freeLists at: 0 put: freeChunk.
  		 freeListsMask := freeListsMask bitOr: 1.
  		 ^0].
  	self assert: (freeListsMask anyMask: 1).
  	"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 changed:
  ----- Method: SpurMemoryManager>>allocateLargestFreeChunk (in category 'free space') -----
  allocateLargestFreeChunk
  	"Answer the largest free chunk in the free lists."
  	<inline: false>
  	| freeChunk next |
  	"would like to use ifNotNil: but the ^next inside the ^blah ifNotNil: confused Slang"
  	freeChunk := self findLargestFreeChunk.
  	freeChunk ifNil: [^nil].
  	"This will be the node, not a list element.  Answer a list element in preference."
  	next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: freeChunk.
  	next ~= 0 ifTrue:
  		[self assert: (self bytesInObject: freeChunk) >= self numFreeLists. "findLargestFreeChunk searches only the tree"
  		 self 
  			setNextFreeChunkOf: freeChunk 
  			withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: next) 
+ 			bytesBigEnoughForPrevPointer: true.
- 			sizeIsOne: false.
  		 ^next].
  	self unlinkSolitaryFreeTreeNode: freeChunk.
  	^freeChunk!

Item was changed:
  ----- Method: SpurMemoryManager>>allocateOldSpaceChunkOfBytes: (in category 'free space') -----
  allocateOldSpaceChunkOfBytes: chunkBytes
  	"Answer a chunk of oldSpace from the free lists, if available,
  	 otherwise answer nil.  Break up a larger chunk if one of the
  	 exact size does not exist.  N.B.  the chunk is simply a pointer, it
  	 has no valid header.  The caller *must* fill in the header correctly."
  	<var: #chunkBytes type: #usqInt>
  	| initialIndex chunk index nodeBytes parent child |
  	"for debugging:" "totalFreeOldSpace := self totalFreeListBytes"
  	totalFreeOldSpace := totalFreeOldSpace - chunkBytes. "be optimistic (& don't wait for the write)"
  	initialIndex := chunkBytes / self allocationUnit.
  	(initialIndex < self numFreeLists and: [1 << initialIndex <= freeListsMask]) ifTrue:
  		[(freeListsMask anyMask: 1 << initialIndex) ifTrue:
  			[(chunk := freeLists at: initialIndex) ~= 0 ifTrue:
  				[self assert: chunk = (self startOfObject: chunk).
  				 self assert: (self isValidFreeObject: chunk).
  				^self unlinkFreeChunk: chunk atIndex: initialIndex].
  			 freeListsMask := freeListsMask - (1 << initialIndex)].
  		 "first search for free chunks of a multiple of chunkBytes in size"
  		 index := initialIndex.
  		 [(index := index + index) < self numFreeLists
  		  and: [1 << index <= freeListsMask]] whileTrue:
  			[(freeListsMask anyMask: 1 << index) ifTrue:
  				[(chunk := freeLists at: index) ~= 0 ifTrue:
  					[self assert: chunk = (self startOfObject: chunk).
  					 self assert: (self isValidFreeObject: chunk).
  					 self unlinkFreeChunk: chunk atIndex: index.
  					 self assert: (self bytesInObject: chunk) = (index * self allocationUnit).
  					 self freeChunkWithBytes: index * self allocationUnit - chunkBytes
  						at: (self startOfObject: chunk) + chunkBytes.
  					^chunk].
  				 freeListsMask := freeListsMask - (1 << index)]].
  		 "now get desperate and use the first that'll fit.
  		  Note that because the minimum free size is 16 bytes (2 * allocationUnit), to
  		  leave room for the forwarding pointer/next free link, we can only break chunks
  		  that are at least 16 bytes larger, hence start at initialIndex + 2."
  		 index := initialIndex + 1.
  		 [(index := index + 1) < self numFreeLists
  		  and: [1 << index <= freeListsMask]] whileTrue:
  			[(freeListsMask anyMask: 1 << index) ifTrue:
  				[(chunk := freeLists at: index) ~= 0 ifTrue:
  					[self assert: chunk = (self startOfObject: chunk).
  					 self assert: (self isValidFreeObject: chunk).
  					 self unlinkFreeChunk: chunk atIndex: index.
  					 self assert: (self bytesInObject: chunk) = (index * self allocationUnit).
  					 self freeChunkWithBytes: index * self allocationUnit - chunkBytes
  						at: (self startOfObject: chunk) + chunkBytes.
  					^chunk].
  				 freeListsMask := freeListsMask - (1 << index)]]].
  
  	"Large chunk, or no space on small free lists.  Search the large chunk list.
  	 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.
  	 When the search ends parent should hold the smallest chunk at least as
  	 large as chunkBytes, or 0 if none."
  	parent := 0.
  	child := freeLists at: 0.
  	[child ~= 0] whileTrue:
  		[| childBytes |
  		 self assert: (self isValidFreeObject: child).
  		 childBytes := self bytesInObject: child.
  		 childBytes = chunkBytes
  			ifTrue: "size match; try to remove from list at node."
  				[chunk := self fetchPointer: self freeChunkNextIndex
  								ofFreeChunk: child.
  				 chunk ~= 0 ifTrue:
  					[self assert: (self isValidFreeObject: chunk).
  					 self 
  						setNextFreeChunkOf: child 
  						withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: chunk) 
+ 						bytesBigEnoughForPrevPointer: true.
- 						sizeIsOne: false.
  					 ^self startOfObject: chunk].
  				 nodeBytes := childBytes.
  				 parent := child.
  				 child := 0] "break out of loop to remove interior node"
  			ifFalse:
  				["Note that because the minimum free size is 16 bytes (2 * allocationUnit), to
  				  leave room for the forwarding pointer/next free link, we can only break chunks
  				  that are at least 16 bytes larger, hence reject chunks < 2 * allocationUnit larger."
  				childBytes <= (chunkBytes + self allocationUnit)
  					ifTrue: "node too small; walk down the larger size of the tree"
  						[child := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: child]
  					ifFalse:
  						[parent := child. "parent will be smallest node >= chunkBytes + allocationUnit"
  						 nodeBytes := childBytes.
  						 child := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: child]]].
  	parent = 0 ifTrue:
  		[totalFreeOldSpace := totalFreeOldSpace + chunkBytes. "optimism was unfounded"
  		 ^nil].
  
  	"self printFreeChunk: parent"
  	self assert: (nodeBytes = chunkBytes or: [nodeBytes >= (chunkBytes + (2 * self allocationUnit))]).
  	self assert: (self bytesInObject: parent) = nodeBytes.
  
  	"attempt to remove from list"
  	chunk := self fetchPointer: self freeChunkNextIndex ofFreeChunk: parent.
  	chunk ~= 0 ifTrue:
  		[self assert: (chunkBytes = nodeBytes or: [chunkBytes + self allocationUnit < nodeBytes]).
  		self 
  			setNextFreeChunkOf: parent 
  			withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: chunk) 
+ 			bytesBigEnoughForPrevPointer: true.
- 			sizeIsOne: false.
  		 chunkBytes ~= nodeBytes ifTrue:
  			[self freeChunkWithBytes: nodeBytes - chunkBytes
  					at: (self startOfObject: chunk) + chunkBytes].
  		 ^self startOfObject: chunk].
  
  	"no list; remove the interior node"
  	chunk := parent.
  	self unlinkSolitaryFreeTreeNode: chunk.
  
  	"if there's space left over, add the fragment back."
  	chunkBytes ~= nodeBytes ifTrue:
  		[self freeChunkWithBytes: nodeBytes - chunkBytes
  				at: (self startOfObject: chunk) + chunkBytes].
  	^self startOfObject: chunk!

Item was changed:
  ----- Method: SpurMemoryManager>>allocateOldSpaceChunkOfBytes:suchThat: (in category 'free space') -----
  allocateOldSpaceChunkOfBytes: chunkBytes suchThat: acceptanceBlock
  	"Answer a chunk of oldSpace from the free lists that satisfies acceptanceBlock,
  	 if available, otherwise answer nil.  Break up a larger chunk if one of the exact
  	 size cannot be found.  N.B.  the chunk is simply a pointer, it has no valid header.
  	 The caller *must* fill in the header correctly."
  	<var: #chunkBytes type: #usqInt>
  	| initialIndex node next prev index child childBytes acceptedChunk acceptedNode |
  	<inline: true> "must inline for acceptanceBlock"
  	"for debugging:" "totalFreeOldSpace := self totalFreeListBytes"
  	totalFreeOldSpace := totalFreeOldSpace - chunkBytes. "be optimistic (& don't wait for the write)"
  	initialIndex := chunkBytes / self allocationUnit.
  	(initialIndex < self numFreeLists and: [1 << initialIndex <= freeListsMask]) ifTrue:
  		[(freeListsMask anyMask: 1 << initialIndex) ifTrue:
  			[(node := freeLists at: initialIndex) = 0
  				ifTrue: [freeListsMask := freeListsMask - (1 << initialIndex)]
  				ifFalse:
  					[prev := 0.
  					 [node ~= 0] whileTrue:
  						[self assert: node = (self startOfObject: node).
  						 self assert: (self isValidFreeObject: node).
  						 next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node.
  						 (acceptanceBlock value: node) ifTrue:
  							[prev = 0
  								ifTrue: [freeLists at: initialIndex put: next]
  								ifFalse: [self setNextFreeChunkOf: prev withValue: next chunkBytes: chunkBytes].
  							 ^node].
  						 prev := node.
  						 node := next]]].
  		 "first search for free chunks of a multiple of chunkBytes in size"
  		 index := initialIndex.
  		 [(index := index + initialIndex) < self numFreeLists
  		  and: [1 << index <= freeListsMask]] whileTrue:
  			[(freeListsMask anyMask: 1 << index) ifTrue:
  				[(node := freeLists at: index) = 0
  					ifTrue: [freeListsMask := freeListsMask - (1 << index)]
  					ifFalse:
  						[prev := 0.
  						 [node ~= 0] whileTrue:
  							[self assert: node = (self startOfObject: node).
  							 self assert: (self isValidFreeObject: node).
  							 next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node.
  							 (acceptanceBlock value: node) ifTrue:
  								[prev = 0
  									ifTrue: [freeLists at: index put: next]
  									ifFalse: [self setNextFreeChunkOf: prev withValue: next chunkBytes: chunkBytes]. 
  								 self freeChunkWithBytes: index * self allocationUnit - chunkBytes
  									at: (self startOfObject: node) + chunkBytes.
  								 ^node].
  							 prev := node.
  							 node := next]]]].
  		 "now get desperate and use the first that'll fit.
  		  Note that because the minimum free size is 16 bytes (2 * allocationUnit), to
  		  leave room for the forwarding pointer/next free link, we can only break chunks
  		  that are at least 16 bytes larger, hence start at initialIndex + 2."
  		 index := initialIndex + 1.
  		 [(index := index + 1) < self numFreeLists
  		  and: [1 << index <= freeListsMask]] whileTrue:
  			[(freeListsMask anyMask: 1 << index) ifTrue:
  				[(node := freeLists at: index) = 0
  					ifTrue: [freeListsMask := freeListsMask - (1 << index)]
  					ifFalse:
  						[prev := 0.
  						 [node ~= 0] whileTrue:
  							[self assert: node = (self startOfObject: node).
  							 self assert: (self isValidFreeObject: node).
  							 next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node.
  							 (acceptanceBlock value: node) ifTrue:
  								[prev = 0
  									ifTrue: [freeLists at: index put: next]
  									ifFalse: [self setNextFreeChunkOf: prev withValue: next chunkBytes: chunkBytes]. 
  								 self freeChunkWithBytes: index * self allocationUnit - chunkBytes
  									at: (self startOfObject: node) + chunkBytes.
  								 ^node].
  							 prev := node.
  							 node := next]]]]].
  
  	"Large chunk, or no space on small free lists.  Search the large chunk list.
  	 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.
  	 When the search ends parent should hold the smallest chunk at least as
  	 large as chunkBytes, or 0 if none.  acceptedChunk and acceptedNode save
  	 us from having to back-up when the acceptanceBlock filters-out all nodes
  	 of the right size, but there are nodes of the wrong size it does accept."
  	child := freeLists at: 0.
  	node := acceptedChunk := acceptedNode := 0.
  	[child ~= 0] whileTrue:
  		[self assert: (self isValidFreeObject: child).
  		 childBytes := self bytesInObject: child.
  		 childBytes = chunkBytes ifTrue: "size match; try to remove from list at node."
  			[node := child.
  			 [prev := node.
  			  node := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node.
  			  node ~= 0] whileTrue:
  				[(acceptanceBlock value: node) ifTrue:
  					[self assert: (self isValidFreeObject: node).
+ 					 self 
+ 						setNextFreeChunkOf: prev 
+ 						withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: node) 
+ 						bytesBigEnoughForPrevPointer: true.
- 					 self setNextFreeChunkOf: prev withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: node) sizeIsOne: false.
  					 ^self startOfObject: node]].
  			 (acceptanceBlock value: child) ifTrue:
  				[next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: child.
  				 next = 0
  					ifTrue: "no list; remove the interior node"
  						[self unlinkSolitaryFreeTreeNode: child]
  					ifFalse: "list; replace node with it"
  						[self inFreeTreeReplace: child with: next].
  				 ^self startOfObject: child]].
  		 child ~= 0 ifTrue:
  			["Note that because the minimum free size is 16 bytes (2 * allocationUnit), to
  			  leave room for the forwarding pointer/next free link, we can only break chunks
  			  that are at least 16 bytes larger, hence reject chunks < 2 * allocationUnit larger."
  			childBytes <= (chunkBytes + self allocationUnit)
  				ifTrue: "node too small; walk down the larger size of the tree"
  					[child := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: child]
  				ifFalse:
  					[self flag: 'we can do better here; preferentially choosing the lowest node. That would be a form of best-fit since we are trying to compact down'.
  					 node := child.
  					 child := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: node.
  					 acceptedNode = 0 ifTrue:
  						[acceptedChunk := node.
  						 "first search the list."
  						 [acceptedChunk := self fetchPointer: self freeChunkNextIndex
  													ofFreeChunk: acceptedChunk.
  						  (acceptedChunk ~= 0 and: [acceptanceBlock value: acceptedChunk]) ifTrue:
  							[acceptedNode := node].
  						  acceptedChunk ~= 0 and: [acceptedNode = 0]] whileTrue.
  						 "nothing on the list; will the node do?  This prefers
  						  acceptable nodes higher up the tree over acceptable
  						  list elements further down, but we haven't got all day..."
  						 (acceptedNode = 0
  						  and: [acceptanceBlock value: node]) ifTrue:
  							[acceptedNode := node.
  							 child := 0 "break out of loop now we have an acceptedNode"]]]]].
  
  	acceptedNode ~= 0 ifTrue:
  		[acceptedChunk ~= 0 ifTrue:
  			[self assert: (self bytesInObject: acceptedChunk) >= (chunkBytes + self allocationUnit).
  			 [next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: acceptedNode.
  			  next ~= acceptedChunk] whileTrue:
  				[acceptedNode := next].
  			 self 
  				setNextFreeChunkOf: acceptedNode 
  				withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: acceptedChunk) 
+ 				bytesBigEnoughForPrevPointer: true.
- 				sizeIsOne: false.
  			self freeChunkWithBytes: (self bytesInObject: acceptedChunk) - chunkBytes
  					at: (self startOfObject: acceptedChunk) + chunkBytes.
  			^self startOfObject: acceptedChunk].
  		next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: acceptedNode.
  		next = 0
  			ifTrue: "no list; remove the interior node"
  				[self unlinkSolitaryFreeTreeNode: acceptedNode]
  			ifFalse: "list; replace node with it"
  				[self inFreeTreeReplace: acceptedNode with: next].
  		 self assert: (self bytesInObject: acceptedNode) >= (chunkBytes + self allocationUnit).
  		 self freeChunkWithBytes: (self bytesInObject: acceptedNode) - chunkBytes
  				at: (self startOfObject: acceptedNode) + chunkBytes.
  		^self startOfObject: acceptedNode].
  
  	totalFreeOldSpace := totalFreeOldSpace + chunkBytes. "optimism was unfounded"
  	^nil!

Item was changed:
  ----- Method: SpurMemoryManager>>allocateOldSpaceChunkOfExactlyBytes: (in category 'free space') -----
  allocateOldSpaceChunkOfExactlyBytes: chunkBytes
  	"Answer a chunk of oldSpace from the free lists, if one of this size
  	 is available, otherwise answer nil.  N.B.  the chunk is simply a pointer,
  	 it has no valid header.  The caller *must* fill in the header correctly."
  	<var: #chunkBytes type: #usqInt>
  	| index node child |
  	"for debugging:" "totalFreeOldSpace := self totalFreeListBytes"
  
  	index := chunkBytes / self allocationUnit.
  	index < self numFreeLists ifTrue:
  		[(freeListsMask anyMask: 1 << index) ifTrue:
  			[(node := freeLists at: index) ~= 0 ifTrue:
  				[self assert: node = (self startOfObject: node).
  				 self assert: (self isValidFreeObject: node).
  				 totalFreeOldSpace := totalFreeOldSpace - chunkBytes.
  				 ^self unlinkFreeChunk: node atIndex: index].
  			 freeListsMask := freeListsMask - (1 << index)].
  		 ^nil].
  
  	"Large chunk.  Search the large chunk list.
  	 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.  When the search ends parent should hold the first chunk of
  	 the same size as chunkBytes, or 0 if none."
  	child := freeLists at: 0.
  	[child ~= 0] whileTrue:
  		[| childBytes |
  		 self assert: (self isValidFreeObject: child).
  		 childBytes := self bytesInObject: child.
  		 childBytes = chunkBytes
  			ifTrue: "size match; try to remove from list at node."
  				[node := self fetchPointer: self freeChunkNextIndex
  								ofFreeChunk: child.
  				 node ~= 0 ifTrue:
  					[self assert: (self isValidFreeObject: node).
  					 self 
  						setNextFreeChunkOf: child 
  						withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: node) 
+ 						bytesBigEnoughForPrevPointer: true. 
- 						sizeIsOne: false. 
  					 totalFreeOldSpace := totalFreeOldSpace - chunkBytes.
  					 ^self startOfObject: node].
  				 "nothing acceptable on node's list; answer the node."
  				 self unlinkSolitaryFreeTreeNode: child.
  				 totalFreeOldSpace := totalFreeOldSpace - chunkBytes.
  				 ^self startOfObject: child]
  			ifFalse:
  				[child := self fetchPointer: (childBytes < chunkBytes
  												ifTrue: [self freeChunkLargerIndex]
  												ifFalse: [self freeChunkSmallerIndex])
  							ofFreeChunk: child]].
  	^nil!

Item was changed:
  ----- Method: SpurMemoryManager>>allocateOldSpaceChunkOfExactlyBytes:suchThat: (in category 'free space') -----
  allocateOldSpaceChunkOfExactlyBytes: chunkBytes suchThat: acceptanceBlock
  	"Answer a chunk of oldSpace from the free lists that satisfies acceptanceBlock,
  	 if one of this size is available, otherwise answer nil.  N.B.  the chunk is simply a
  	 pointer, it has no valid header.  The caller *must* fill in the header correctly."
  	<var: #chunkBytes type: #usqInt>
  	| index node next prev child childBytes |
  	<inline: true> "must inline for acceptanceBlock"
  	"for debugging:" "totalFreeOldSpace := self totalFreeListBytes"
  
  	index := chunkBytes / self allocationUnit.
  	index < self numFreeLists ifTrue:
  		[(freeListsMask anyMask: 1 << index) ifTrue:
  			[(node := freeLists at: index) = 0
  				ifTrue: [freeListsMask := freeListsMask - (1 << index)]
  				ifFalse:
  					[prev := 0.
  					 [node ~= 0] whileTrue:
  						[self assert: node = (self startOfObject: node).
  						 self assert: (self isValidFreeObject: node).
  						 next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node.
  						 (acceptanceBlock value: node) ifTrue:
  							[prev = 0
  								ifTrue: [freeLists at: index put: next]
  								ifFalse: [self setNextFreeChunkOf: prev withValue: next chunkBytes: chunkBytes].
  							 totalFreeOldSpace := totalFreeOldSpace - chunkBytes.
  							 ^node].
  						 prev := node.
  						 node := next]]].
  		 ^nil].
  
  	"Large chunk.  Search the large chunk list.
  	 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.  When the search ends parent should hold the first chunk of
  	 the same size as chunkBytes, or 0 if none."
  	node := 0.
  	child := freeLists at: 0.
  	[child ~= 0] whileTrue:
  		[self "Sorry stepping over isValidFreeObject all the time was killing me"
  			cCode: [self assert: (self isValidFreeObject: child)]
  			inSmalltalk: [self assertValidFreeObject: child].
  		 childBytes := self bytesInObject: child.
  		 childBytes = chunkBytes
  			ifTrue: "size match; try to remove from list at node first."
  				[node := child.
  				 [prev := node.
  				  node := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node.
  				  node ~= 0] whileTrue:
  					[(acceptanceBlock value: node) ifTrue:
  						[self assert: (self isValidFreeObject: node).
  						 self 
  							setNextFreeChunkOf: prev 
  							withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: node) 
+ 							bytesBigEnoughForPrevPointer: true. 
- 							sizeIsOne: false. 
  						 totalFreeOldSpace := totalFreeOldSpace - chunkBytes.
  						 ^self startOfObject: node]].
  				 (acceptanceBlock value: child) ifFalse:
  					[^nil]. "node was right size but unaceptable."
  				 next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: child.
  				 next = 0
  					ifTrue: "no list; remove the interior node"
  						[self unlinkSolitaryFreeTreeNode: child]
  					ifFalse: "list; replace node with it"
  						[self inFreeTreeReplace: child with: next].
  				 totalFreeOldSpace := totalFreeOldSpace - chunkBytes.
  				 ^self startOfObject: child]
  			ifFalse: "no size match; walk down the tree"
  				[child := self fetchPointer: (childBytes < chunkBytes
  												ifTrue: [self freeChunkLargerIndex]
  												ifFalse: [self freeChunkSmallerIndex])
  							ofFreeChunk: child]].
  	^nil!

Item was changed:
  ----- Method: SpurMemoryManager>>assertValidFreeObject: (in category 'free space') -----
  assertValidFreeObject: objOop
  	<doNotGenerate> "If you want to generate this you want to use 'self assert: (self isValidFreeObject: objOop)' instead not to generate code in assertion-free VMs"
  	| chunk |
  	"duplicated assertions from isValidFreeObject: because I need to know what is wrong not only that it is not valid (I got bored of stepping inside isValidFreeObject:...)"
  	self assert: (self oop: (self addressAfter: objOop) isLessThanOrEqualTo: endOfMemory).
  	chunk := self fetchPointer: self freeChunkNextIndex ofFreeChunk: objOop.
  	self assert: (chunk = 0 or: [self isFreeOop: chunk]).
+ 	(self bytesBigEnoughForPrevPointer: (self bytesInObject: objOop)) ifTrue:
- 	(self bytesInObject: objOop) / self wordSize = 1 ifFalse:
  		["double linkedlist assertions"
  		 chunk := self fetchPointer: self freeChunkNextIndex ofFreeChunk: objOop.
  		 chunk = 0 ifFalse: 
  			[self assert: (self isFreeOop: chunk).
  			 self assert: objOop = (self fetchPointer: self freeChunkPrevIndex ofFreeChunk: chunk)].
  		 chunk := self fetchPointer: self freeChunkPrevIndex ofFreeChunk: objOop.
  		 chunk = 0 ifFalse: 
  			[self assert: (self isFreeOop: chunk).
  			 self assert: objOop = (self fetchPointer: self freeChunkNextIndex ofFreeChunk: chunk)].].
  	(self isLargeFreeObject: objOop) ifTrue: 
  		["Tree assertions"
  		chunk := self fetchPointer: self freeChunkParentIndex ofFreeChunk: objOop.
  		self assert: (chunk = 0 or: [(self isFreeOop: chunk) and: [self isLargeFreeObject: chunk]]).
  		chunk := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: objOop.
  		self assert: (chunk = 0 or: [(self isFreeOop: chunk) and: [self isLargeFreeObject: chunk]]).
  		chunk := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: objOop.
  		self assert: (chunk = 0 or: [(self isFreeOop: chunk) and: [self isLargeFreeObject: chunk]]). ]!

Item was added:
+ ----- Method: SpurMemoryManager>>bytesBigEnoughForPrevPointer: (in category 'free space') -----
+ bytesBigEnoughForPrevPointer: chunkBytes
+ 	self subclassResponsibility!

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:
  				[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 bytesBigEnoughForPrevPointer: (self bytesInObject: obj)) ifTrue:
- 				(self bytesInObject: obj) / self wordSize = 1 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:
  				[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>>checkHeapIntegrity:classIndicesShouldBeValid: (in category 'debug support') -----
  checkHeapIntegrity: excludeUnmarkedObjs 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>
  	self cCode: []
  		inSmalltalk:
  			["Almost all of the time spent here 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."
  			(self class whichClassIncludesSelector: #fetchPointer:ofObject:) ~= SpurMemoryManager ifTrue:
  				[^self withSimulatorFetchPointerMovedAsideDo:
  					[self checkHeapIntegrity: excludeUnmarkedObjs
  						classIndicesShouldBeValid: classIndicesShouldBeValid]]].
  	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 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 bytesBigEnoughForPrevPointer: (self bytesInObject: obj)) ifTrue:
- 				(self bytesInObject: obj) / self wordSize = 1 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: 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.
  				 (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:
  									[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]]]]].
  	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:
  					[(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 added:
+ ----- Method: SpurMemoryManager>>setNextFreeChunkOf:withValue:bytesBigEnoughForPrevPointer: (in category 'free space') -----
+ setNextFreeChunkOf: freeChunk withValue: nextFreeChunk bytesBigEnoughForPrevPointer: bytesBigEnoughForPrevPointer 
+ 	<inline: true> "Inlining is quite important since bytesBigEnoughForPrevPointer is often true"
+ 	self 
+ 		storePointer: self freeChunkNextIndex 
+ 		ofFreeChunk: freeChunk 
+ 		withValue: nextFreeChunk.
+ 	(nextFreeChunk ~= 0 and: [bytesBigEnoughForPrevPointer]) ifTrue:
+ 		[self 
+ 			storePointer: self freeChunkPrevIndex 
+ 			ofFreeChunk: nextFreeChunk 
+ 			withValue: freeChunk]
+ 	
+ 	!

Item was changed:
  ----- Method: SpurMemoryManager>>setNextFreeChunkOf:withValue:chunkBytes: (in category 'free space') -----
  setNextFreeChunkOf: freeChunk withValue: nextFreeChunk chunkBytes: chunkBytes
- 	<inline: true>
  	self 
  		setNextFreeChunkOf: freeChunk 
  		withValue: nextFreeChunk 
+ 		bytesBigEnoughForPrevPointer: (self bytesBigEnoughForPrevPointer: chunkBytes) 
- 		sizeIsOne: chunkBytes / self wordSize = 1 
  	
  	!

Item was removed:
- ----- Method: SpurMemoryManager>>setNextFreeChunkOf:withValue:sizeIsOne: (in category 'free space') -----
- setNextFreeChunkOf: freeChunk withValue: nextFreeChunk sizeIsOne: sizeIsOne 
- 	<inline: true> "Inlining is quite important since sizeIsOne is often false"
- 	self 
- 		storePointer: self freeChunkNextIndex 
- 		ofFreeChunk: freeChunk 
- 		withValue: nextFreeChunk.
- 	"In 32 bits, there's always enough room, 
- 	 in 64 bits, size 1 is special."
- 	(nextFreeChunk = 0 or: [sizeIsOne]) ifFalse:
- 		[self 
- 			storePointer: self freeChunkPrevIndex 
- 			ofFreeChunk: nextFreeChunk 
- 			withValue: freeChunk]
- 	
- 	!

Item was changed:
  ----- Method: SpurMemoryManager>>swizzleFieldsOfFreeChunk: (in category 'snapshot') -----
  swizzleFieldsOfFreeChunk: chunk
  	<inline: true>
  	| field chunkBytes |
  	field := self fetchPointer: self freeChunkNextIndex ofFreeChunk: chunk.
  	field ~= 0 ifTrue:
  		[self storePointerNoAssert: self freeChunkNextIndex
  			ofFreeChunk: chunk
  			withValue: (segmentManager swizzleObj: field)].
+ 	(self bytesBigEnoughForPrevPointer: (chunkBytes := self bytesInObject: chunk)) ifTrue:
- 	(chunkBytes := self bytesInObject: chunk) / self wordSize = 1 ifFalse: 
  		[field := self fetchPointer: self freeChunkPrevIndex ofFreeChunk: chunk.
  		 field ~= 0 ifTrue:
  			[self storePointerNoAssert: self freeChunkPrevIndex
  				ofFreeChunk: chunk
  				withValue: (segmentManager swizzleObj: field)]].
  	chunkBytes >= (self numFreeLists * self allocationUnit) ifTrue:
  		[self freeChunkParentIndex to: self freeChunkLargerIndex do:
  			[:index|
  			 field := self fetchPointer: index ofFreeChunk: chunk.
  			 field ~= 0 ifTrue:
  				[self storePointerNoAssert: index
  					ofFreeChunk: chunk
  					withValue: (segmentManager swizzleObj: field)]]]!

Item was changed:
  ----- Method: SpurMemoryManager>>unlinkFreeChunk:chunkBytes: (in category 'free space') -----
  unlinkFreeChunk: freeChunk chunkBytes: chunkBytes
  	"Unlink a free object from the free lists. Do not alter totalFreeOldSpace. Used for coalescing."
  	| index node next prev |
  	index := chunkBytes / self allocationUnit.
  	
  	"Pathological 64 bits case - size 1 - single linked list"
+ 	
+ 	(self bytesBigEnoughForPrevPointer: chunkBytes) ifFalse:
- 	chunkBytes / self wordSize = 1 ifTrue: 
  		[node := freeLists at: index.
  			 prev := 0.
  			 [node ~= 0] whileTrue:
  				[self assert: node = (self startOfObject: node).
  				 self assert: (self isValidFreeObject: node).
  				 next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node.
  				 node = freeChunk ifTrue:
  					[prev = 0
  						ifTrue: [freeLists at: index put: next]
  						ifFalse: [self setNextFreeChunkOf: prev withValue: next chunkBytes: chunkBytes].
  					 ^self].
  				 prev := node.
  				 node := next].
  			 self error: 'freeChunk not found in free list of size 1'].
  	
  	prev := self fetchPointer: self freeChunkPrevIndex ofFreeChunk: freeChunk.
  	"Has prev element: update double linked list"
  	prev ~= 0 ifTrue:
  		[self 
  			setNextFreeChunkOf: prev 
  			withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: freeChunk) 
  			chunkBytes: chunkBytes.
  		 ^self].
  	
  	"Is the beginning of a list"
  	"Small chunk"
  	(index < self numFreeLists and: [1 << index <= freeListsMask]) ifTrue: [
  		^self unlinkFreeChunk: freeChunk atIndex: index].
  	"Large chunk"
  	 next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: freeChunk.
  	 next = 0
  		ifTrue: "no list; remove the interior node"
  			[self unlinkSolitaryFreeTreeNode: freeChunk]
  		ifFalse: "list; replace node with it"
  			[self inFreeTreeReplace: freeChunk with: next]
  	
  	
  
  	!

Item was changed:
  ----- Method: SpurMemoryManager>>updateFreeLists (in category 'initialization') -----
  updateFreeLists
  	"Snapshot did not guarantee the state of the freelist prevLink, so we need to update it.
  	 Effectively transforms the freechunk single linked list in double linked list."
  	|min|
  	"Small chunks"
  	"Skip in 64 bits size 1 which is single linked list - pathological case"
+ 	self wordSize = 8 ifTrue: [min := 2] ifFalse: [min := 1].
- 	self allocationUnit / self wordSize = 1 ifTrue: [min := 2] ifFalse: [min := 1].
  	min to: self numFreeLists - 1 do:
  		[:i| self updateListStartingAt: (freeLists at: i)].
  	"Large chunks"
  	self freeTreeNodesDo: [:freeNode |
  		self updateListStartingAt: freeNode.
  		freeNode]!




More information about the Vm-dev mailing list