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

commits at source.squeak.org commits at source.squeak.org
Tue Sep 24 22:07:32 UTC 2013


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

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

Name: VMMaker.oscog-eem.408
Author: eem
Time: 24 September 2013, 3:03:59.462 pm
UUID: d156deea-74a3-4c80-8a1c-b7ead517f77f
Ancestors: VMMaker.oscog-eem.407

Implement tree reorganization on removing an interior node of the
free chunk tree.  Plus fix the tree traversal which was nonsense.
Add an assert to allocateSlotsInOldSpace:format:classIndex: to check
that totalFreeOldSpace is maintained correctly.

Remember to set the identityHash in the copy when scavenging.

More protocol.

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

Item was changed:
  ----- Method: BalloonEngineBase>>loadTransformFrom:into:length: (in category 'loading state') -----
  loadTransformFrom: transformOop into: destPtr length: n
  	"Load a transformation from transformOop into the float array
  	defined by destPtr. The transformation is assumed to be either
  	an array or a FloatArray of length n."
  	<inline: false>
  	<var: #destPtr type:'float *'>
  	transformOop = interpreterProxy nilObject ifTrue:[^false].
+ 	(interpreterProxy isImmediate: transformOop)
- 	(interpreterProxy isIntegerObject: transformOop)
  		ifTrue:[^interpreterProxy primitiveFail].
  	(interpreterProxy slotSizeOf: transformOop) = n 
  		ifFalse:[^interpreterProxy primitiveFail].
  	(interpreterProxy isWords: transformOop) 
  		ifTrue:[self loadWordTransformFrom: transformOop into: destPtr length: n]
  		ifFalse:[self loadArrayTransformFrom: transformOop into: destPtr length: n].
  	^true!

Item was added:
+ ----- Method: Spur32BitMMLESimulator>>floatValueOf: (in category 'simulation only') -----
+ floatValueOf: obj
+ 	"hack around the CoInterpreter/ObjectMemory split refactoring"
+ 	^coInterpreter floatValueOf: obj!

Item was added:
+ ----- Method: Spur32BitMMLESimulator>>halfWordHighInLong32: (in category 'memory access') -----
+ halfWordHighInLong32: long32
+ 	"Used by Balloon"
+ 
+ 	^long32 bitAnd: 16rFFFF!

Item was added:
+ ----- Method: Spur32BitMMLESimulator>>halfWordLowInLong32: (in category 'memory access') -----
+ halfWordLowInLong32: long32
+ 	"Used by Balloon"
+ 
+ 	^long32 bitShift: -16!

Item was added:
+ ----- Method: Spur32BitMMLESimulator>>isFloatObject: (in category 'simulation only') -----
+ isFloatObject: oop
+ 	"hack around the CoInterpreter/ObjectMemory split refactoring"
+ 	^coInterpreter isFloatObject: oop!

Item was added:
+ ----- Method: Spur32BitMMLESimulator>>pushFloat: (in category 'simulation only') -----
+ pushFloat: f
+ 	"hack around the CoInterpreter/ObjectMemory split refactoring"
+ 	^coInterpreter pushFloat: f!

Item was added:
+ ----- Method: Spur32BitMMLESimulator>>stackFloatValue: (in category 'simulation only') -----
+ stackFloatValue: offset
+ 	"hack around the CoInterpreter/ObjectMemory split refactoring"
+ 	^coInterpreter stackFloatValue: offset!

Item was changed:
  ----- Method: Spur32BitMemoryManager>>allocateSlotsInOldSpace:format:classIndex: (in category 'allocation') -----
  allocateSlotsInOldSpace: numSlots 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."
  	| bytes chunk |
  	bytes := self objectBytesForSlots: numSlots.
  	chunk := self allocateOldSpaceChunkOfBytes: bytes.
+ 	self assert: totalFreeOldSpace = self totalFreeListBytes.
  	chunk ifNil:
  		[^nil].
  	numSlots >= self numSlotsMask ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word"
  		[self flag: #endianness.
  		 self longAt: chunk put: numSlots.
  		 self longAt: chunk + 4 put: self numSlotsMask << self numSlotsHalfShift.
  		 self longLongAt: chunk + self baseHeaderSize
  			put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex).
  		 ^chunk + self baseHeaderSize].
  	self longLongAt: chunk put: (self headerForSlots: numSlots format: formatField classIndex: classIndex).
  	^chunk!

Item was changed:
  ----- Method: SpurGenerationScavenger>>copyAndForward: (in category 'scavenger') -----
  copyAndForward: survivor
  	"copyAndForward: survivor copies a survivor object either to
  	 futureSurvivorSpace or, if it is to be promoted, to oldSpace.
  	 It leaves a forwarding pointer behind."
  	<inline: true>
+ 	| bytesInObject newLocation hash |
- 	| bytesInObject newLocation |
  	bytesInObject := manager bytesInObject: survivor.
  	newLocation := ((self shouldBeTenured: survivor)
  					  or: [futureSurvivorStart + bytesInObject > futureSpace limit])
  						ifTrue: [self copyToOldSpace: survivor]
  						ifFalse: [self copyToFutureSpace: survivor bytes: bytesInObject].
+ 	hash := manager rawHashBitsOf: survivor.
+ 	hash ~= 0 ifTrue:
+ 		[manager setHashBitsOf: newLocation to: hash].
  	manager forward: survivor to: newLocation.
  	^newLocation!

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.  N.B.  the chunk is simply a pointer, it has
  	 no valid header.  The caller *must* fill in the header correctly."
  	| index chunk nextIndex nodeBytes parent child smaller larger |
+ 	"for debugging:" "totalFreeOldSpace := self totalFreeListBytes"
  	totalFreeOldSpace := totalFreeOldSpace - chunkBytes. "be optimistic (& don't wait for the write)"
  	index := chunkBytes / self allocationUnit.
  	(index < NumFreeLists and: [1 << index <= freeListsMask]) ifTrue:
  		[(chunk := freeLists at: index) ~= 0 ifTrue:
  			[self assert: chunk = (self startOfObject: chunk).
  			^self unlinkFreeChunk: chunk atIndex: index].
  		 "first search for free chunks of a multiple of chunkBytes in size"
  		 nextIndex := index.
  		 [1 << index <= freeListsMask
  		  and: [(nextIndex := nextIndex + index) < NumFreeLists]] whileTrue:
  			[((freeListsMask anyMask: 1 << index)
  			 and: [(chunk := freeLists at: index) ~= 0]) ifTrue:
  				[self assert: chunk = (self startOfObject: 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]].
  		 "now get desperate and use the first that'll fit"
  		 nextIndex := index.
  		 [1 << index >= freeListsMask
  		  and: [(nextIndex := nextIndex + 1) < NumFreeLists]] whileTrue:
  			[(freeListsMask anyMask: 1 << index) ifTrue:
  				[(chunk := freeLists at: index) ~= 0 ifTrue:
  					[self assert: chunk = (self startOfObject: 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."
- 	 of the same size. Beneath the node are smaller and larger blocks."
  	parent := 0.
  	child := freeLists at: 0.
  	[child ~= 0] whileTrue:
+ 		[| childBytes |
+ 		 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 storePointer: self freeChunkNextIndex
+ 					ofFreeChunk: child
+ 					withValue: (self fetchPointer: self freeChunkNextIndex
+ 									ofFreeChunk: chunk).
+ 				 ^self startOfObject: chunk].
+ 			 child := 0]. "break out of loop to remove interior node"
+ 		childBytes < chunkBytes
+ 			ifTrue: "walk down the tree"
+ 				[child := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: child]
+ 			ifFalse:
+ 				[parent := child.
+ 				 nodeBytes := childBytes.
+ 				 child := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: child]].
- 		[nodeBytes := self bytesInObject: child.
- 		 parent := child.
- 		 nodeBytes = chunkBytes
- 			ifTrue: "size match; try to remove from list at node."
- 				[chunk := self fetchPointer: self freeChunkNextIndex
- 								ofFreeChunk: child.
- 				 chunk ~= 0 ifTrue:
- 					[self storePointer: self freeChunkNextIndex
- 						ofFreeChunk: child
- 						withValue: (self fetchPointer: self freeChunkNextIndex
- 										ofFreeChunk: chunk).
- 					 ^self startOfObject: chunk].
- 				 child := 0] "break out of loop to remove interior node"
- 			ifFalse:"walk down the tree"
- 				[child := self fetchPointer: (nodeBytes > chunkBytes
- 												ifTrue: [self freeChunkSmallerIndex]
- 												ifFalse: [self freeChunkLargerIndex])
- 								ofFreeChunk: child]].
  	parent = 0 ifTrue:
  		[totalFreeOldSpace := totalFreeOldSpace + chunkBytes. "optimism was unfounded"
  		 self halt].
  
  	"self printFreeChunk: parent"
+ 	self assert: nodeBytes >= chunkBytes.
  	self assert: (self bytesInObject: parent) = nodeBytes.
+ 
  	"attempt to remove from list"
  	chunk := self fetchPointer: self freeChunkNextIndex
  					ofFreeChunk: parent.
  	chunk ~= 0 ifTrue:
  		[self storePointer: self freeChunkNextIndex
  			ofFreeChunk: parent
  			withValue: (self fetchPointer: self freeChunkNextIndex
  							ofFreeChunk: chunk).
  		 chunkBytes ~= nodeBytes ifTrue:
  			[self freeChunkWithBytes: nodeBytes - chunkBytes
  					at: (self startOfObject: chunk) + chunkBytes].
  		 ^self startOfObject: chunk].
+ 
  	"no list; remove an interior node"
  	chunk := parent.
+ 
+ 	smaller := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: chunk.
+ 	larger := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: chunk.
  	parent := self fetchPointer: self freeChunkParentIndex ofFreeChunk: chunk.
+ 
  	"no parent; stitch the subnodes back into the root"
  	parent = 0 ifTrue:
+ 		[smaller = 0
- 		[smaller := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: chunk.
- 		 larger := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: chunk.
- 		 smaller = 0
  			ifTrue: [freeLists at: 0 put: larger]
  			ifFalse:
  				[freeLists at: 0 put: smaller.
  				 larger ~= 0 ifTrue:
  					[self addFreeSubTree: larger]].
  		"coInterpreter transcript ensureCr.
  		 coInterpreter print: 'new free tree root '.
  		 (freeLists at: 0) = 0 ifTrue: [coInterpreter print: '0'] ifFalse: [self printFreeChunk: (freeLists at: 0)].
  		 coInterpreter cr."
  		 chunkBytes ~= nodeBytes ifTrue:
  			[self freeChunkWithBytes: nodeBytes - chunkBytes
  					at: (self startOfObject: chunk) + chunkBytes].
  		 ^self startOfObject: chunk].
+ 
  	"remove node from tree; reorder tree simply.  two cases (which have mirrors, for four total):
  	 case 1. interior node has one child, P = parent, N = node, S = subtree (mirrored for large vs small)
  			___				  ___
  			| P |				  | P |
  		    _/_				_/_
  		    | N |		=>		| S |
  		 _/_
+ 		 | S |
+ 
+ 	 case 2: interior node has two children, , P = parent, N = node, L = smaller, left subtree, R = larger, right subtree.
- 		 | S |"
- 	self halt.
- 	"case 2: interior node has two children, , P = parent, N = node, L = smaller, left subtree, R = larger, right subtree.
  	 add the left subtree to the bottom left of the right subtree (mirrored for large vs small) 
  			___				  ___
  			| P |				  | P |
  		    _/_				_/_
  		    | N |		=>		| R |
  		 _/_  _\_		    _/_
  		 | L | | R |		    | L |"
+ 
+ 	smaller = 0
+ 		ifTrue: [self storePointer: (chunk = (self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: parent)
+ 									ifTrue: [self freeChunkSmallerIndex]
+ 									ifFalse: [self freeChunkLargerIndex])
+ 					ofFreeChunk: parent
+ 					withValue: larger]
+ 		ifFalse:
+ 			[self storePointer: (chunk = (self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: parent)
+ 									ifTrue: [self freeChunkSmallerIndex]
+ 									ifFalse: [self freeChunkLargerIndex])
+ 					ofFreeChunk: parent
+ 					withValue: smaller.
+ 			 larger ~= 0 ifTrue:
+ 				[self addFreeSubTree: larger]].
+ 	chunkBytes ~= nodeBytes ifTrue:
+ 		[self freeChunkWithBytes: nodeBytes - chunkBytes
+ 				at: (self startOfObject: chunk) + chunkBytes].
+ 	^self startOfObject: chunk!
- 	self halt!

Item was changed:
  ----- Method: SpurMemoryManager>>bytesInFreeTree: (in category 'free space') -----
  bytesInFreeTree: freeNode
  	| freeBytes bytesInObject next |
  	freeNode = 0 ifTrue: [^0].
  	freeBytes := 0.
  	bytesInObject := self bytesInObject: freeNode.
  	self assert: bytesInObject / self allocationUnit >= NumFreeLists.
  	next := freeNode.
  	[next ~= 0] whileTrue:
  		[freeBytes := freeBytes + bytesInObject.
  		 self assert: bytesInObject = (self bytesInObject: next).
  		 next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: next].
  	^freeBytes
+ 	+ (self bytesInFreeTree: (self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: freeNode))
+ 	+ (self bytesInFreeTree: (self fetchPointer: self freeChunkLargerIndex ofFreeChunk: freeNode))!
- 	+ (self bytesInFreeTree: (self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: next))
- 	+ (self bytesInFreeTree: (self fetchPointer: self freeChunkLargerIndex ofFreeChunk: next))!

Item was changed:
  ----- Method: SpurMemoryManager>>printFreeChunk: (in category 'debug printing') -----
  printFreeChunk: freeChunk
  	<doNotGenerate>
  	| numBytes |
  	numBytes := self bytesInObject: freeChunk.
  	coInterpreter
+ 		print: 'freeChunk '; printHexPtrnp: freeChunk;
- 		print: 'freeChunk @ '; printHexPtr: freeChunk;
  		print: ' bytes '; printNum: numBytes;
+ 		print: ' next '; printHexPtrnp: (self fetchPointer: self freeChunkNextIndex
+ 											ofFreeChunk: freeChunk).
- 		print: ' next '; print: (self fetchPointer: self freeChunkNextIndex
- 									ofFreeChunk: freeChunk) hex.
  	numBytes / self allocationUnit > NumFreeLists ifTrue:
  		[coInterpreter
+ 			print: ' ^ '; printHexPtrnp: (self fetchPointer: self freeChunkParentIndex
+ 											ofFreeChunk: freeChunk);
+ 			print: ' < '; printHexPtrnp: (self fetchPointer: self freeChunkSmallerIndex
+ 											ofFreeChunk: freeChunk);
+ 			print: ' > '; printHexPtrnp: (self fetchPointer: self freeChunkLargerIndex
+ 											ofFreeChunk: freeChunk)].
- 			print: ' ^ '; print: (self fetchPointer: self freeChunkParentIndex
- 									ofFreeChunk: freeChunk) hex;
- 			print: ' < '; print: (self fetchPointer: self freeChunkSmallerIndex
- 									ofFreeChunk: freeChunk) hex;
- 			print: ' > '; print: (self fetchPointer: self freeChunkLargerIndex
- 									ofFreeChunk: freeChunk) hex].
  	coInterpreter cr!

Item was changed:
  ----- Method: StackInterpreter>>printHexPtr: (in category 'debug printing') -----
  printHexPtr: p
+ 	"Print p in hex, padded to 10 characters in the form '    0x1234'"
- 	"Print p in hex, passed to 10 characters in the form '    0x1234'"
  	<inline: true>
  	<var: #p type: #'void *'>
  	self printHex: (self oopForPointer: p)!

Item was added:
+ ----- Method: StackInterpreter>>printHexPtrnp: (in category 'debug printing') -----
+ printHexPtrnp: p
+ 	"Print p in hex, unpadded, in the form '0x1234'"
+ 	<inline: true>
+ 	<var: #p type: #'void *'>
+ 	self printHexnp: (self oopForPointer: p)!



More information about the Vm-dev mailing list