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

commits at source.squeak.org commits at source.squeak.org
Wed Sep 18 21:02:08 UTC 2013


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

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

Name: VMMaker.oscog-eem.390
Author: eem
Time: 18 September 2013, 1:58:42.526 pm
UUID: 9a457234-c19a-4674-a6cf-44c247cfa544
Ancestors: VMMaker.oscog-eem.389

Fix odd bits calculations in instantiation primitives.

Fix class table page allocation (fill the puppy with nils).

Split store/FetchPointer:ofForwardedOrFree: into
store/FetchPointer:ofForwarded: etc.

Use the freeListsMask (note rename) when allocating.

Get singleStep to run the atEachStepBlock.

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

Item was changed:
+ ----- Method: Spur32BitMMLESimulator>>fetchFloatAt:into: (in category 'float primitives') -----
- ----- Method: Spur32BitMMLESimulator>>fetchFloatAt:into: (in category 'as yet unclassified') -----
  fetchFloatAt: floatBitsAddress into: aFloat
  	aFloat at: 2 put: (self long32At: floatBitsAddress).
  	aFloat at: 1 put: (self long32At: floatBitsAddress+4)!

Item was changed:
+ ----- Method: Spur32BitMMLESimulator>>storeFloatAt:from: (in category 'float primitives') -----
- ----- Method: Spur32BitMMLESimulator>>storeFloatAt:from: (in category 'as yet unclassified') -----
  storeFloatAt: floatBitsAddress from: aFloat
  	self long32At: floatBitsAddress put: (aFloat at: 2).
  	self long32At: floatBitsAddress+4 put: (aFloat at: 1)!

Item was changed:
  ----- Method: Spur32BitMemoryManager>>checkHeapIntegrity (in category 'debug support') -----
  checkHeapIntegrity
  	"Perform an integrity/leak check using the heapMap.  Assume
  	 clearLeakMapAndMapAccessibleObjects has set a bit at each
  	 object's header.  Scan all objects in the heap checking that every
  	 pointer points to a header.  Scan the rootTable, remapBuffer and
  	 extraRootTable checking that every entry is a pointer to a header.
  	 Check that the number of roots is correct and that all rootTable
  	 entries have their rootBit set. Answer if all checks pass."
  	| ok numRememberedRootsInHeap |
  	<inline: false>
  	ok := true.
  	numRememberedRootsInHeap := 0.
  	self allObjectsDo:
  		[:obj| | containsYoung fieldOop classIndex classOop |
  		(self isFreeObject: obj) ifFalse:
  			[containsYoung := false.
  			 (self isRemembered: obj) ifTrue:
  				[numRememberedRootsInHeap := numRememberedRootsInHeap + 1.
  				 (scavenger isInRememberedTable: 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.
- 					[fieldOop := self fetchPointer: 0 ofForwardedOrFreeObject: 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 isYoung: fieldOop) ifTrue:
  						[containsYoung := true]]
  				ifFalse:
  					[classOop := self classAtIndex: (classIndex := self classIndexOf: obj).
  					 (classOop isNil or: [classOop = nilObj]) ifTrue:
  						[coInterpreter print: 'object leak in '; printHex: obj; print: ' invalid class index '; printHex: classIndex; print: ' -> '; printHex: classOop; cr.
  						 self eek.
  						 ok := false].
  					 self baseHeaderSize to: (self lastPointerOf: obj) by: BytesPerOop do:
  						[:ptr|
  						 fieldOop := self longAt: obj + ptr.
  						 (self isNonImmediate: fieldOop) ifTrue:
  							[| fi |
  							 fi := ptr - self baseHeaderSize / self wordSize.
  							 (fieldOop bitAnd: self wordSize - 1) ~= 0
  								ifTrue:
  									[coInterpreter print: 'misaligned oop in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; cr.
  									 self eek.
  									 ok := false]
  								ifFalse:
  									[(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 isYoung: fieldOop) ifTrue:
  										[containsYoung := true]]]]].
  					(containsYoung and: [(self isYoung: obj) not]) ifTrue:
  						[(self isRemembered: obj) ifFalse:
  							[coInterpreter print: 'unremembered object '; printHex: obj; print: ' contains young oop(s)'; cr.
  							 self eek.
  							 ok := false]]]].
  	numRememberedRootsInHeap ~= scavenger rememberedSetSize ifTrue:
  		[coInterpreter
  			print: 'root count mismatch. #heap roots ';
  			printNum: numRememberedRootsInHeap;
  			print: '; #roots ';
  			printNum: scavenger rememberedSetSize;
  			cr.
  		"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 rootTable @ '; printNum: i; print: ' = '; printHex: obj; cr.
  				 self eek.
  				 ok := false]
  			ifFalse:
  				[(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0
  					ifTrue:
  						[coInterpreter print: 'object leak in rootTable @ '; printNum: i; print: ' = '; printHex: obj; cr.
  						 self eek.
  						 ok := false]
  					ifFalse:
  						[(self isYoung: obj) ifTrue:
  							[coInterpreter print: 'non-root in rootTable @ '; printNum: i; print: ' = '; printHex: obj; cr.
  							 self eek.
  							 ok := false]]]].
  	self flag: 'no support for remap buffer yet'.
  	"1 to: remapBufferCount do:
  		[:ri|
  		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]]]."
  	self flag: 'no support for extraRoots yet'.
  	"1 to: extraRootCount do:
  		[:ri|
  		obj := (extraRoots at: ri) at: 0.
  		(obj bitAnd: self wordSize - 1) ~= 0
  			ifTrue:
  				[coInterpreter print: 'misaligned extraRoot @ '; printNum: ri; print: ' => '; printHex: obj; cr.
  				 self eek.
  				 ok := false]
  			ifFalse:
  				[(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0
  					ifTrue:
  						[coInterpreter print: 'object leak in extraRoots @ '; printNum: ri; print: ' => '; printHex: obj; cr.
  						 self eek.
  						 ok := false]]]."
  	^ok!

Item was removed:
- ----- Method: Spur32BitMemoryManager>>fetchPointer:ofForwardedOrFreeObject: (in category 'heap management') -----
- fetchPointer: fieldIndex ofForwardedOrFreeObject: objOop
- 	^self longAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord)!

Item was added:
+ ----- Method: Spur32BitMemoryManager>>fetchPointer:ofFreeChunk: (in category 'heap management') -----
+ fetchPointer: fieldIndex ofFreeChunk: objOop
+ 	^self longAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord)!

Item was changed:
  ----- Method: Spur32BitMemoryManager>>instantiateClass:indexableSize: (in category 'allocation') -----
  instantiateClass: classObj indexableSize: nElements
  	| instSpec classFormat numSlots classIndex newObj fillValue |
  	classFormat := self formatOfClass: classObj.
  	instSpec := self instSpecOfClassFormat: classFormat.
  	fillValue := 0.
  	instSpec caseOf: {
  		[self arrayFormat]	->
  			[numSlots := nElements.
  			 fillValue := nilObj].
  		[self indexablePointersFormat]	->
  			[numSlots := (self fixedFieldsOfClassFormat: classFormat) + nElements.
  			 fillValue := nilObj].
  		[self weakArrayFormat]	->
  			[numSlots := nElements.
  			 fillValue := nilObj].
  		[self sixtyFourBitIndexableFormat]	->
  			[numSlots := nElements * 2].
  		[self firstLongFormat]	->
  			[numSlots := nElements].
  		[self firstShortFormat]	->
  			[numSlots := nElements + 1 // 2.
  			 instSpec := instSpec + (nElements bitAnd: 1)].
  		[self firstByteFormat]	->
  			[numSlots := nElements + 3 // 4.
+ 			 instSpec := instSpec + (4 - nElements bitAnd: 3)].
- 			 instSpec := instSpec + (nElements bitAnd: 3)].
  		[self firstCompiledMethodFormat]	->
  			[numSlots := nElements + 3 // 4.
+ 			 instSpec := instSpec + (4 - nElements bitAnd: 3)] }
- 			 instSpec := instSpec + (nElements bitAnd: 3)] }
  		otherwise: [^nil]. "non-indexable"
  	classIndex := self ensureBehaviorHash: classObj.
  	classIndex < 0 ifTrue:
  		[coInterpreter primitiveFailFor: classIndex negated.
  		 ^nil].
  	newObj := self allocateSlots: numSlots format: instSpec classIndex: classIndex.
  	newObj ifNotNil:
  		[self fillObj: newObj numSlots: numSlots with: fillValue].
  	^newObj!

Item was removed:
- ----- Method: Spur32BitMemoryManager>>storePointer:ofForwardedOrFreeObject:withValue: (in category 'heap management') -----
- storePointer: fieldIndex ofForwardedOrFreeObject: objOop withValue: valuePointer
- 
- 	(self isForwarded: objOop) ifTrue:
- 		[(self isYoung: objOop) ifFalse: "most stores into young objects"
- 			[((self isNonImmediate: valuePointer) and: [self isYoung: valuePointer]) ifTrue:
- 				[self possibleRootStoreInto: objOop]]].
- 
- 	^self
- 		longAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord)
- 		put: valuePointer!

Item was added:
+ ----- Method: Spur32BitMemoryManager>>storePointer:ofForwarder:withValue: (in category 'heap management') -----
+ storePointer: fieldIndex ofForwarder: objOop withValue: valuePointer
+ 
+ 	self assert: (self isForwarded: objOop).
+ 	self assert: (self isOopForwarded: valuePointer) not.
+ 
+ 	(self isYoung: objOop) ifFalse: "most stores into young objects"
+ 		[((self isNonImmediate: valuePointer) and: [self isYoung: valuePointer]) ifTrue:
+ 			[self possibleRootStoreInto: objOop]].
+ 
+ 	^self
+ 		longAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord)
+ 		put: valuePointer!

Item was added:
+ ----- Method: Spur32BitMemoryManager>>storePointer:ofFreeChunk:withValue: (in category 'heap management') -----
+ storePointer: fieldIndex ofFreeChunk: objOop withValue: valuePointer
+ 
+ 	self assert: (self isFreeObject: objOop).
+ 
+ 	^self
+ 		longAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord)
+ 		put: valuePointer!

Item was changed:
  ----- Method: Spur64BitMemoryManager>>instantiateClass:indexableSize: (in category 'allocation') -----
  instantiateClass: classObj indexableSize: nElements
  	| instSpec classFormat numSlots classIndex newObj fillValue |
  	classFormat := self formatOfClass: classObj.
  	instSpec := self instSpecOfClassFormat: classFormat.
  	fillValue := 0.
  	instSpec caseOf: {
  		[self arrayFormat]	->
  			[numSlots := nElements.
  			 fillValue := nilObj].
  		[self indexablePointersFormat]	->
  			[numSlots := (self fixedFieldsOfClassFormat: classFormat) + nElements.
  			 fillValue := nilObj].
  		[self weakArrayFormat]	->
  			[numSlots := nElements.
  			 fillValue := nilObj].
  		[self sixtyFourBitIndexableFormat]	->
  			[numSlots := nElements].
  		[self firstLongFormat]	->
  			[numSlots := nElements + 1 // 2.
  			 instSpec := instSpec + (nElements bitAnd: 1)].
  		[self firstShortFormat]	->
  			[numSlots := nElements + 3 // 4.
+ 			 instSpec := instSpec + (4 - nElements bitAnd: 3)].
- 			 instSpec := instSpec + (nElements bitAnd: 3)].
  		[self firstByteFormat]	->
  			[numSlots := nElements + 7 // 8.
+ 			 instSpec := instSpec + (8 - nElements bitAnd: 7)].
- 			 instSpec := instSpec + (nElements bitAnd: 7)].
  		[self firstCompiledMethodFormat]	->
  			[numSlots := nElements + 7 // 8.
+ 			 instSpec := instSpec + (8 - nElements bitAnd: 7)] }
- 			 instSpec := instSpec + (nElements bitAnd: 7)] }
  		otherwise: [^nil]. "non-indexable"
  	classIndex := self ensureBehaviorHash: classObj.
  	classIndex < 0 ifTrue:
  		[coInterpreter primitiveFailFor: classIndex negated.
  		 ^nil].
  	newObj := self allocateSlots: numSlots format: instSpec classIndex: classIndex.
  	newObj ifNotNil:
  		[self fillObj: newObj numSlots: numSlots with: fillValue].
  	^newObj!

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

Item was changed:
  ----- Method: SpurMemoryManager>>addToFreeList: (in category 'free space') -----
  addToFreeList: freeChunk
  	| chunkBytes childBytes parent child index |
+ 	coInterpreter transcript ensureCr. coInterpreter print: 'freeing '. self printFreeChunk: freeChunk.
  	chunkBytes := self bytesInObject: freeChunk.
  	index := chunkBytes / self allocationUnit.
  	index < NumFreeLists ifTrue:
+ 		[self storePointer: self freeChunkNextIndex ofFreeChunk: freeChunk withValue: (freeLists at: index).
- 		[self storePointer: self freeChunkNextIndex
- 			ofForwardedOrFreeObject: freeChunk
- 			withValue: (freeLists at: index).
  		 freeLists at: index put: freeChunk.
+ 		 freeListsMask := freeListsMask bitOr: 1 << index.
  		 ^self].
+ 	freeListsMask := freeListsMask bitOr: 1.
  	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.
- 		storePointer: self freeChunkNextIndex ofForwardedOrFreeObject: freeChunk withValue: 0;
- 		storePointer: self freeChunkParentIndex ofForwardedOrFreeObject: freeChunk withValue: 0;
- 		storePointer: self freeChunkSmallerIndex ofForwardedOrFreeObject: freeChunk withValue: 0;
- 		storePointer: self freeChunkLargerIndex ofForwardedOrFreeObject: 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
- 			[self storePointerUnchecked: self freeChunkNextIndex
- 					ofObject: freeChunk
  						withValue: (self fetchPointer: self freeChunkNextIndex ofObject: child);
+ 				storePointer: self freeChunkNextIndex
+ 					ofFreeChunk: child
- 				storePointerUnchecked: self freeChunkNextIndex
- 					ofObject: child
  						withValue: freeChunk.
  			 ^self].
  		 "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.
  		 ^self].
  	"insert in tree"
+ 	self storePointer: self freeChunkParentIndex
+ 			ofFreeChunk: freeChunk
- 	self storePointerUnchecked: self freeChunkParentIndex
- 			ofObject: freeChunk
  				withValue: parent.
+ 	 self storePointer: (childBytes > chunkBytes
- 	 self storePointerUnchecked: (childBytes > chunkBytes
  									ifTrue: [self freeChunkSmallerIndex]
  									ifFalse: [self freeChunkLargerIndex])
+ 			ofFreeChunk: parent
- 			ofObject: parent
  				withValue: 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.  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 |
  	index := chunkBytes / self allocationUnit.
+ 	(index < NumFreeLists and: [1 << index >= freeListsMask]) ifTrue:
- 	index < NumFreeLists ifTrue:
  		[(chunk := freeLists at: index) ~= 0 ifTrue:
  			[^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:
- 		 [(nextIndex := nextIndex + index) < NumFreeLists] whileTrue:
- 			[(chunk := freeLists at: index) ~= 0 ifTrue:
  				[self unlinkFreeChunk: chunk atIndex: index.
  				 self assert: (self bytesInObject: chunk) = index * self allocationUnit.
  				 self freeChunkWithBytes: index * self allocationUnit - chunkBytes
  					at: (self startOfFreeChunk: 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 unlinkFreeChunk: chunk atIndex: index.
+ 					 self assert: (self bytesInObject: chunk) = index * self allocationUnit.
+ 					 self freeChunkWithBytes: index * self allocationUnit - chunkBytes
+ 						at: (self startOfFreeChunk: chunk) + chunkBytes.
+ 					^chunk].
+ 				 freeListsMask := freeListsMask - (1 << index)]]].
- 		 [(nextIndex := nextIndex + 1) < NumFreeLists] whileTrue:
- 			[(chunk := freeLists at: index) ~= 0 ifTrue:
- 				[self unlinkFreeChunk: chunk atIndex: index.
- 				 self assert: (self bytesInObject: chunk) = index * self allocationUnit.
- 				 self freeChunkWithBytes: index * self allocationUnit - chunkBytes
- 					at: (self startOfFreeChunk: chunk) + chunkBytes.
- 				^chunk]]].
  
  	"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."
  	parent := 0.
  	child := freeLists at: 0.
  	[child ~= 0] whileTrue:
  		[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.
- 								ofForwardedOrFreeObject: child.
  				 chunk ~= 0 ifTrue:
  					[self storePointer: self freeChunkNextIndex
+ 						ofFreeChunk: child
- 						ofForwardedOrFreeObject: child
  						withValue: (self fetchPointer: self freeChunkNextIndex
+ 										ofFreeChunk: chunk).
- 										ofForwardedOrFreeObject: chunk).
  					 ^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]].
- 								ofObject: child]].
  	parent = 0 ifTrue:
  		[self halt].
  	"self printFreeChunk: parent"
  	self assert: (self bytesInObject: parent) = nodeBytes.
  	"attempt to remove from list"
  	chunk := self fetchPointer: self freeChunkNextIndex
+ 					ofFreeChunk: parent.
- 					ofForwardedOrFreeObject: parent.
  	chunk ~= 0 ifTrue:
  		[self storePointer: self freeChunkNextIndex
+ 			ofFreeChunk: parent
- 			ofForwardedOrFreeObject: parent
  			withValue: (self fetchPointer: self freeChunkNextIndex
+ 							ofFreeChunk: chunk).
- 							ofForwardedOrFreeObject: chunk).
  		 chunkBytes ~= nodeBytes ifTrue:
  			[self freeChunkWithBytes: nodeBytes - chunkBytes
  					at: (self startOfFreeChunk: chunk) + chunkBytes].
  		 ^chunk].
  	"no list; remove an interior node"
  	chunk := parent.
+ 	parent := self fetchPointer: self freeChunkParentIndex ofFreeChunk: chunk.
- 	parent := self fetchPointer: self freeChunkParentIndex ofForwardedOrFreeObject: chunk.
  	"no parent; stitch the subnodes back into the root"
  	parent = 0 ifTrue:
+ 		[smaller := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: chunk.
+ 		 larger := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: chunk.
- 		[smaller := self fetchPointer: self freeChunkSmallerIndex ofForwardedOrFreeObject: chunk.
- 		 larger := self fetchPointer: self freeChunkLargerIndex ofForwardedOrFreeObject: 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 startOfFreeChunk: chunk) + chunkBytes].
  		 ^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 |"
  	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 |"
  	self halt!

Item was changed:
  ----- Method: SpurMemoryManager>>enterIntoClassTable: (in category 'class table') -----
  enterIntoClassTable: aBehavior
  	"Enter aBehavior into the class table and answer 0.  Otherwise answer a primitive failure code."
  	| initialMajorIndex majorIndex minorIndex page |
  	majorIndex := classTableIndex >> self classTableMajorIndexShift.
  	initialMajorIndex := majorIndex.
  	"classTableIndex should never index the first page; it's reserved for known classes"
  	self assert: initialMajorIndex > 0.
  	minorIndex := classTableIndex bitAnd: self classTableMinorIndexMask.
  
  	[page := self fetchPointer: majorIndex ofObject: classTableRootObj.
  	 page = nilObj ifTrue:
  		[page := self allocateSlots: self classTablePageSize
  					format: self arrayFormat
  					classIndex: self arrayClassIndexPun.
  		 page ifNil:
  			[^PrimErrNoMemory].
+ 		 self fillObj: page numSlots: self classTablePageSize with: nilObj.
  		 self storePointer: majorIndex
  			ofObject: classTableRootObj
  			withValue: page.
  		 minorIndex := 0].
  	 minorIndex to: self classTablePageSize - 1 do:
  		[:i|
  		(self fetchPointer: i ofObject: page) = nilObj ifTrue:
  			[classTableIndex := majorIndex << self classTableMajorIndexShift + i.
  			 self storePointer: i
  				ofObject: page
  				withValue: aBehavior.
  			 self setHashBitsOf: aBehavior to: classTableIndex.
  			 self assert: (self classAtIndex: (self rawHashBitsOf: aBehavior)) = aBehavior.
  			 "now fault-in method lookup chain."
  			 self scanClassPostBecome: aBehavior
  				effects: BecamePointerObjectFlag+BecameCompiledMethodFlag.
  			 ^0]].
  	 majorIndex := (majorIndex + 1 bitAnd: self classIndexMask) max: 1.
  	 majorIndex = initialMajorIndex ifTrue: "wrapped; table full"
  		[^PrimErrLimitExceeded]] repeat!

Item was added:
+ ----- Method: SpurMemoryManager>>fetchPointer:ofFreeChunk: (in category 'heap management') -----
+ fetchPointer: fieldIndex ofFreeChunk: objOop
+ 	^self subclassResponsibility!

Item was added:
+ ----- Method: SpurMemoryManager>>fetchPointer:ofMaybeForwardedObject: (in category 'heap management') -----
+ fetchPointer: fieldIndex ofMaybeForwardedObject: objOop
+ 	^self subclassResponsibility!

Item was added:
+ ----- Method: SpurMemoryManager>>fetchPointer:ofObject: (in category 'object access') -----
+ fetchPointer: fieldIndex ofObject: objOop
+ 	^self subclassResponsibility!

Item was changed:
  ----- Method: SpurMemoryManager>>followForwarded: (in category 'become api') -----
  followForwarded: objOop
  	| referent |
  	self assert: (self isForwarded: objOop).
+ 	referent := self fetchPointer: 0 ofMaybeForwardedObject: objOop.
- 	referent := self fetchPointer: 0 ofForwardedOrFreeObject: objOop.
  	self assert: (self isForwarded: referent) not.
  	^referent!

Item was changed:
  ----- Method: SpurMemoryManager>>forward:to: (in category 'become implementation') -----
  forward: obj1 to: obj2
  	self setFormatOf: obj1 to: self forwardedFormat.
  	self setClassIndexOf: obj1 to: self isForwardedObjectClassIndexPun.
+ 	self storePointer: 0 ofForwarder: obj1 withValue: obj2!
- 	self storePointer: 0 ofForwardedOrFreeObject: obj1 withValue: obj2!

Item was changed:
  ----- Method: SpurMemoryManager>>initialize (in category 'initialization') -----
  initialize
  	freeLists := CArrayAccessor on: (Array new: NumFreeLists withAll: 0).
+ 	freeListsMask := 0.
  	checkForLeaks := 0.
  	needGCFlag := signalLowSpace := scavengeInProgress := false.
  	becomeEffectsFlags := 0.
  	heapMap := self wordSize = 4 ifTrue: [CogCheck32BitHeapMap new].
  	statScavenges := 0.
  	statScavengeGCUsecs := statIncrGCUsecs := statFullGCUsecs := 0.
  	statSGCDeltaUsecs := statIGCDeltaUsecs := statFGCDeltaUsecs := 0!

Item was changed:
  ----- Method: SpurMemoryManager>>possibleRootStoreInto: (in category 'store check') -----
  possibleRootStoreInto: destObj
  	(#(	storePointer:ofObject:withValue:
+ 		storePointer:ofForwarder:withValue:
- 		storePointer:ofForwardedOrFreeObject:withValue:
  		inPlaceBecome:and:copyHashFlag:) includes: thisContext sender method selector) ifFalse:
  		[self halt].
  	(self isRemembered: destObj) ifFalse:
  		[scavenger remember: destObj.
  		 self setIsRememberedOf: destObj to: true]!

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

Item was changed:
  ----- Method: SpurMemoryManager>>printReferencesTo: (in category 'debug printing') -----
  printReferencesTo: anOop
  	"Scan the heap printing the oops of any and all objects that refer to anOop"
  	<api>
  	self allObjectsDo:
  		[:obj| | i |
  		((self isPointersNonImm: obj) or: [self isCompiledMethod: obj])
  			ifTrue:
  				[(self isCompiledMethod: obj)
  					ifTrue:
  						[i := (coInterpreter literalCountOf: obj) + LiteralStart]
  					ifFalse:
  						[(self isContextNonImm: obj)
  							ifTrue: [i := CtxtTempFrameStart + (coInterpreter fetchStackPointerOf: obj)]
  							ifFalse: [i := self lengthOf: obj]].
  				[(i := i - 1) >= 0] whileTrue:
  					[anOop = (self fetchPointer: i ofObject: obj) ifTrue:
  						[coInterpreter printHex: obj; print: ' @ '; printNum: i; space; printOopShort: obj; cr.
  						 i := 0]]]
  			ifFalse:
  				[((self isForwarded: obj)
+ 				 and: [(self fetchPointer: 0 ofMaybeForwardedObject: obj) = anOop]) ifTrue:
- 				 and: [(self fetchPointer: 0 ofForwardedOrFreeObject: obj) = anOop]) ifTrue:
  					[coInterpreter printHex: obj; print: ' => '; printHex: anOop; cr]]]!

Item was added:
+ ----- Method: SpurMemoryManager>>storePointer:ofForwarder:withValue: (in category 'heap management') -----
+ storePointer: fieldIndex ofForwarder: objOop withValue: valuePointer
+ 
+ 	^self subclassResponsibility!

Item was added:
+ ----- Method: SpurMemoryManager>>storePointer:ofFreeChunk:withValue: (in category 'heap management') -----
+ storePointer: fieldIndex ofFreeChunk: objOop withValue: valuePointer
+ 
+ 	^self subclassResponsibility!

Item was changed:
  ----- Method: SpurMemoryManager>>unlinkFreeChunk:atIndex: (in category 'free space') -----
  unlinkFreeChunk: chunk atIndex: index
  	<inline: true>
  	self assert: ((self bytesInObject: chunk) = index * self allocationUnit
  				and: [index > 1 "a.k.a. (self bytesInObject: chunk) > self allocationUnit"]).
  	freeLists
  		at: index
  		put: (self
  				fetchPointer: self freeChunkNextIndex
+ 				ofFreeChunk: chunk).
- 				ofForwardedOrFreeObject: chunk).
  	^chunk!

Item was added:
+ ----- Method: StackInterpreterSimulator>>framePointer (in category 'spur bootstrap') -----
+ framePointer
+ 	^framePointer!

Item was changed:
  ----- Method: StackInterpreterSimulator>>singleStep (in category 'testing') -----
  singleStep
  	self assertValidExecutionPointers.
+ 	atEachStepBlock value. "N.B. may be nil"
  	self dispatchOn: currentBytecode in: BytecodeTable.
  	self incrementByteCount!



More information about the Vm-dev mailing list