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

commits at source.squeak.org commits at source.squeak.org
Sun Jun 29 01:20:14 UTC 2014


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

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

Name: VMMaker.oscog-eem.785
Author: eem
Time: 28 June 2014, 6:17:27.821 pm
UUID: 39cb6f17-fd6b-4794-a7a2-91779a6fcee2
Ancestors: VMMaker.oscog-tpr.784

Fix sign and overflow issues in instantiating larger objects
and determining the size of large instances.

Rip out the UseRightShiftForDivide optimization.  It gets
unsigned division wrong, and C compilers can and will
optimize this correctly.

positive32BitValueOf: must answer a usqInt,
positive64BitValueOf: must answer a usqLong.

Fix some freeChunk accesses that used
fetchPointer:ofObject:.

=============== Diff against VMMaker.oscog-tpr.784 ===============

Item was changed:
  Object subclass: #CCodeGenerator
  	instanceVariableNames: 'vmClass structClasses translationDict asArgumentTranslationDict inlineList constants variables variableDeclarations scopeStack methods macros apiMethods kernelReturnTypes currentMethod headerFiles globalVariableUsage useSymbolicConstants generateDeadCode requiredSelectors logger suppressAsmLabels asmLabelCounts pools selectorTranslations optionsDictionary breakSrcInlineSelector breakDestInlineSelector vmMaker'
+ 	classVariableNames: 'NoRegParmsInAssertVMs'
- 	classVariableNames: 'NoRegParmsInAssertVMs UseRightShiftForDivide'
  	poolDictionaries: 'VMBasicConstants'
  	category: 'VMMaker-Translation to C'!
  
  !CCodeGenerator commentStamp: 'tpr 5/2/2003 14:30' prior: 0!
  This class oversees the translation of a subset of Smalltalk to C, allowing the comforts of Smalltalk during development and the efficiency and portability of C for the resulting interpreter.  
  See VMMaker for more useful info!

Item was changed:
  ----- Method: CCodeGenerator class>>initialize (in category 'class initialization') -----
  initialize
  	"CCodeGenerator initialize"
  
- 	UseRightShiftForDivide := true.
- 		"If UseRightShiftForDivide is true, the translator will generate a right-shift when it encounters a division by a constant that is a small power of two. For example, 'x / 8' will generate '((int) x >> 3)'. The coercion to int is done to make it clear that the C compiler should generate a signed shift."
- 		"Note: The Kernighan and Ritchie 2nd Edition C manual, p. 49, leaves the semantics of right-shifting a negative number open to the discretion of the compiler implementor. However, it strongly suggests that most compilers should generate an arithmetic right shift (i.e., shifting in the sign bit), which is the same as dividing by a power of two. If your compiler does not generate or simulate an arithmetic shift, then make this class variable false and re-translate."
- 
  	NoRegParmsInAssertVMs := true
  		"If NoRegParmsInAssertVMs is true the generator spits out an attribute turning off register parameters for static functions in the Assert and Debug VMs which makes debugging easier, since all functions can be safely called from gdb.  One might hope that -mregparm=0 would work but at least on Mac OS X's gcc 4.2.1 it does not and hence we have to use a per funciton attribute.  Sigh..."!

Item was changed:
  ----- Method: CCodeGenerator>>generateDivide:on:indent: (in category 'C translation') -----
  generateDivide: msgNode on: aStream indent: level
  	"Generate the C code for this message onto the given stream."
  
+ 	self emitCExpression: msgNode receiver on: aStream.
+ 	aStream nextPutAll: ' / '.
+ 	self emitCExpression: msgNode args first on: aStream!
- 	| rcvr arg divisor |
- 	rcvr := msgNode receiver.
- 	arg := msgNode args first.
- 	(arg isConstant and:
- 	 [UseRightShiftForDivide and:
- 	 [(divisor := arg value) isInteger and:
- 	 [divisor isPowerOfTwo and:
- 	 [divisor > 0 and:
- 	 [divisor <= (1 bitShift: 31)]]]]])
- 	ifTrue: [
- 		"use signed (arithmetic) right shift instead of divide"
- 		aStream nextPutAll: '((sqInt) '.
- 		self emitCExpression: rcvr on: aStream.
- 		aStream nextPutAll: ' >> ', (divisor log: 2) asInteger printString.
- 		aStream nextPutAll: ')'.
- 	] ifFalse: [
- 		self emitCExpression: rcvr on: aStream.
- 		aStream nextPutAll: ' / '.
- 		self emitCExpression: arg on: aStream].
- !

Item was changed:
  ----- Method: InterpreterPrimitives>>positive32BitValueOf: (in category 'primitive support') -----
  positive32BitValueOf: oop
  	"Convert the given object into an integer value.
  	The object may be either a positive SmallInteger or a four-byte LargePositiveInteger."
+ 	<returnTypeC: #usqInt>
- 
  	| value ok |
  	(objectMemory isIntegerObject: oop)
  		ifTrue:
  			[value := objectMemory integerValueOf: oop.
  			value < 0 ifTrue: [self primitiveFail. value := 0].
  			^value]
  		ifFalse:
  			[(objectMemory hasSpurMemoryManagerAPI
  			  and: [objectMemory isImmediate: oop]) ifTrue:
  				[self primitiveFail.
  				 ^0]].
  
  	ok := objectMemory isClassOfNonImm: oop
  			equalTo: (objectMemory splObj: ClassLargePositiveInteger)
  			compactClassIndex: ClassLargePositiveIntegerCompactIndex.
  	(ok and: [(objectMemory lengthOf: oop) = 4]) ifFalse:
  		[self primitiveFail.
  		 ^0].
  	^(objectMemory fetchByte: 0 ofObject: oop)
  	+ ((objectMemory fetchByte: 1 ofObject: oop) <<  8)
  	+ ((objectMemory fetchByte: 2 ofObject: oop) << 16)
  	+ ((objectMemory fetchByte: 3 ofObject: oop) << 24)!

Item was changed:
  ----- Method: InterpreterPrimitives>>positive64BitValueOf: (in category 'primitive support') -----
  positive64BitValueOf: oop
  	"Convert the given object into an integer value.
  	The object may be either a positive SmallInteger or an eight-byte LargePositiveInteger."
  
+ 	<returnTypeC: #usqLong>
- 	<returnTypeC: #sqLong>
  	| sz value ok |
+ 	<var: #value type: #usqLong>
- 	<var: #value type: #sqLong>
  	(objectMemory isIntegerObject: oop) ifTrue:
+ 		[(objectMemory integerValueOf: oop) < 0 ifTrue:
+ 			[^self primitiveFail].
+ 		 ^objectMemory integerValueOf: oop].
- 		[value := objectMemory integerValueOf: oop.
- 		 value < 0 ifTrue: [^self primitiveFail].
- 		 ^value].
  
  	ok := objectMemory
  			isClassOfNonImm: oop
  			equalTo: (objectMemory splObj: ClassLargePositiveInteger)
  			compactClassIndex: ClassLargePositiveIntegerCompactIndex.
  	(ok and: [(sz := objectMemory lengthOf: oop) <= (self sizeof: #sqLong)]) ifFalse:
  		[^self primitiveFail].
  
  	value := 0.
  	0 to: sz - 1 do: [:i |
+ 		value := value + ((self cCoerce: (objectMemory fetchByte: i ofObject: oop) to: #usqLong) <<  (i*8))].
- 		value := value + ((self cCoerce: (objectMemory fetchByte: i ofObject: oop) to: #sqLong) <<  (i*8))].
  	^value!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveNewWithArg (in category 'object access primitives') -----
  primitiveNewWithArg
  	"Allocate a new indexable instance. Fail if the allocation would leave less than lowSpaceThreshold bytes free. May cause a GC."
  	| size spaceOkay |
  	size := self positive32BitValueOf: self stackTop.
  	self cppIf: NewspeakVM
  		ifTrue: "For the mirror prims check that the class obj is actually a valid class."
  			[(argumentCount < 2
  			  or: [self addressCouldBeClassObj: (self stackValue: 1)]) ifFalse:
  				[self primitiveFailFor: PrimErrBadArgument]].
+ 	self successful "positive32BitValueOf: succeds only for non-negative integers < 2^32"
- 	(self successful and: [size >= 0])
  		ifTrue:
  			[objectMemory hasSpurMemoryManagerAPI
  				ifTrue:
  					[(objectMemory instantiateClass: (self stackValue: 1) indexableSize: size)
  						ifNotNil: [:obj| self pop: argumentCount + 1 thenPush: obj]
  						ifNil: [self primitiveFailFor: PrimErrNoMemory]]
  				ifFalse:
  					[spaceOkay := objectMemory sufficientSpaceToInstantiate: (self stackValue: 1) indexableSize: size.
  					 spaceOkay
  						ifTrue:
  							[self
  								pop: argumentCount + 1
  								thenPush: (objectMemory instantiateClass: (self stackValue: 1) indexableSize: size)]
  						ifFalse:
  							[self primitiveFailFor: PrimErrNoMemory]]]
  		ifFalse:
  			[self primitiveFailFor: PrimErrBadArgument]!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveSizeInBytes (in category 'memory space primitives') -----
  primitiveSizeInBytes
  	<option: #SpurObjectMemory>
+ 	| byteSize |
+ 	byteSize := objectMemory totalByteSizeOf: self stackTop.
  	self pop: argumentCount + 1
+ 		 thenPush: (self positive64BitIntegerFor: byteSize)!
- 		 thenPushInteger: (objectMemory totalByteSizeOf: self stackTop)!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveSizeInBytesOfInstance (in category 'memory space primitives') -----
  primitiveSizeInBytesOfInstance
  	"Answer the byte size of an instance of the receiver.  If num args > 0
  	 then the last argument is a variable size and the size answered is the
  	 size of an instance of the receiver with that many indexable elements."
  	<option: #SpurObjectMemory>
+ 	| byteSize err |
- 	| byteSizeOrErr |
  	self cppIf: NewspeakVM
  		ifTrue: "Support VMMirror>>byteSizeOfInstanceOf:WithIndexableVariables:"
  			[argumentCount > 2 ifTrue:
  				[^self primitiveFailFor: PrimErrBadNumArgs]]
  		ifFalse:
  			[argumentCount > 1 ifTrue:
  				[^self primitiveFailFor: PrimErrBadNumArgs]].
+ 	err := -1.
  	argumentCount >= 1 ifTrue:
  		[(objectMemory isIntegerObject: self stackTop) ifFalse:
  			[^self primitiveFailFor: PrimErrBadArgument].
+ 		 byteSize := objectMemory
+ 						byteSizeOfInstanceOf: (self stackValue: 1)
+ 						withIndexableSlots: (objectMemory integerValueOf: self stackTop)
+ 						errInto: [:code| err := code].
+ 		 err >= 0 ifTrue:
+ 			[^self primitiveFailFor: err].
+ 		 ^self pop: argumentCount + 1 thenPush: (self positive64BitIntegerFor: byteSize)].
+ 	byteSize := objectMemory
+ 						byteSizeOfInstanceOf: (self stackValue: 0)
+ 						errInto: [:code| err := code].
+ 	err >= 0 ifTrue:
+ 		[^self primitiveFailFor: err].
+ 	self pop: 1 thenPushInteger: byteSize!
- 		 byteSizeOrErr := objectMemory
- 								byteSizeOfInstanceOf: (self stackValue: 1)
- 								withIndexableSlots: (objectMemory integerValueOf: self stackTop).
- 		 byteSizeOrErr < 0 ifTrue:
- 			[^self primitiveFailFor: byteSizeOrErr negated].
- 		 ^self pop: argumentCount + 1 thenPushInteger: byteSizeOrErr].
- 	byteSizeOrErr := objectMemory byteSizeOfInstanceOf: (self stackValue: 0).
- 	byteSizeOrErr < 0 ifTrue:
- 		[^self primitiveFailFor: byteSizeOrErr negated].
- 	self pop: 1 thenPushInteger: byteSizeOrErr!

Item was changed:
  ----- Method: Spur32BitMemoryManager>>allocateSlotsForPinningInOldSpace:bytes:format:classIndex: (in category 'allocation') -----
  allocateSlotsForPinningInOldSpace: numSlots bytes: totalBytes format: formatField classIndex: classIndex
  	"Answer the oop of a chunk of space in oldSpace with numSlots slots.  Try and
  	 allocate in a segment that already includes pinned objects.  The header of the
  	 result will have been filled-in but not the contents."
+ 	<var: #totalBytes type: #usqInt>
  	<inline: false>
  	| chunk |
  	chunk := self allocateOldSpaceChunkOfBytes: totalBytes
  				   suchThat: [:f| (segmentManager segmentContainingObj: f) containsPinned].
  	chunk ifNil:
  		[chunk := self allocateOldSpaceChunkOfBytes: totalBytes.
  		 chunk ifNotNil:
  			[(segmentManager segmentContainingObj: chunk) containsPinned: true]].
  	self checkFreeSpace.
  	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 long64At: chunk + self baseHeaderSize
  			put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex).
  		 ^chunk + self baseHeaderSize].
  	self long64At: chunk put: (self headerForSlots: numSlots format: formatField classIndex: classIndex).
  	^chunk!

Item was changed:
  ----- Method: Spur32BitMemoryManager>>allocateSlotsInOldSpace:bytes:format:classIndex: (in category 'allocation') -----
  allocateSlotsInOldSpace: numSlots bytes: totalBytes format: formatField classIndex: classIndex
  	"Answer the oop of a chunk of space in oldSpace with numSlots slots.  The header
  	 will have been filled-in but not the contents."
+ 	<var: #totalBytes type: #usqInt>
  	<inline: false>
  	| chunk |
  	chunk := self allocateOldSpaceChunkOfBytes: totalBytes.
  	self checkFreeSpace.
  	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 long64At: chunk + self baseHeaderSize
  			put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex).
  		 ^chunk + self baseHeaderSize].
  	self long64At: chunk put: (self headerForSlots: numSlots format: formatField classIndex: classIndex).
  	^chunk!

Item was changed:
  ----- Method: Spur32BitMemoryManager>>instantiateClass:indexableSize: (in category 'instantiation') -----
  instantiateClass: classObj indexableSize: nElements
+ 	<var: #nElements type: #usqInt>
  	| instSpec classFormat numSlots classIndex newObj fillValue |
  	classFormat := self formatOfClass: classObj.
  	instSpec := self instSpecOfClassFormat: classFormat.
  	fillValue := 0.
  	instSpec caseOf: {
  		[self arrayFormat]	->
+ 			[nElements > self maxSlotsForAlloc ifTrue:
+ 				[^nil].
+ 			 numSlots := nElements.
- 			[numSlots := nElements.
  			 fillValue := nilObj].
  		[self indexablePointersFormat]	->
+ 			[nElements > (self maxSlotsForAlloc - (self fixedFieldsOfClassFormat: classFormat)) ifTrue:
+ 				[^nil].
+ 			 numSlots := (self fixedFieldsOfClassFormat: classFormat) + nElements.
- 			[numSlots := (self fixedFieldsOfClassFormat: classFormat) + nElements.
  			 fillValue := nilObj].
  		[self weakArrayFormat]	->
+ 			[nElements > (self maxSlotsForAlloc - (self fixedFieldsOfClassFormat: classFormat)) ifTrue:
+ 				[^nil].
+ 			 numSlots := (self fixedFieldsOfClassFormat: classFormat) + nElements.
- 			[numSlots := (self fixedFieldsOfClassFormat: classFormat) + nElements.
  			 fillValue := nilObj].
  		[self sixtyFourBitIndexableFormat]	->
+ 			[nElements > (self maxSlotsForAlloc / 2) ifTrue:
+ 				[^nil].
+ 			 numSlots := nElements * 2].
- 			[numSlots := nElements * 2].
  		[self firstLongFormat]	->
+ 			[nElements > self maxSlotsForAlloc ifTrue:
+ 				[^nil].
+ 			 numSlots := nElements].
- 			[numSlots := nElements].
  		[self firstShortFormat]	->
  			[numSlots := nElements + 1 // 2.
+ 			 numSlots > self maxSlotsForAlloc ifTrue:
+ 				[^nil].
  			 instSpec := instSpec + (nElements bitAnd: 1)].
  		[self firstByteFormat]	->
  			[numSlots := nElements + 3 // 4.
+ 			 numSlots > self maxSlotsForAlloc ifTrue:
+ 				[^nil].
  			 instSpec := instSpec + (4 - nElements bitAnd: 3)].
  		[self firstCompiledMethodFormat]	->
  			[numSlots := nElements + 3 // 4.
+ 			 numSlots > self maxSlotsForAlloc ifTrue:
+ 				[^nil].
  			 instSpec := instSpec + (4 - nElements bitAnd: 3)] }
  		otherwise: ["some Squeak images include funky fixed subclasses of abstract variable
  					 superclasses. e.g. DirectoryEntry as a subclass of ArrayedCollection.
  					 Allow fixed classes to be instantiated here iff nElements = 0."
  					 (nElements ~= 0 or: [instSpec > self lastPointerFormat]) ifTrue:
  						[^nil].
  					 numSlots := self fixedFieldsOfClassFormat: classFormat]. "non-indexable"
  	classIndex := self ensureBehaviorHash: classObj.
  	classIndex < 0 ifTrue:
  		[coInterpreter primitiveFailFor: classIndex negated.
  		 ^nil].
  	numSlots > self maxSlotsForNewSpaceAlloc
  		ifTrue: [newObj := self allocateSlotsInOldSpace: numSlots format: instSpec classIndex: classIndex]
  		ifFalse: [newObj := self allocateSlots: numSlots format: instSpec classIndex: classIndex].
  	newObj ifNotNil:
  		[self fillObj: newObj numSlots: numSlots with: fillValue].
  	^newObj!

Item was changed:
  ----- Method: Spur32BitMemoryManager>>largeObjectBytesForSlots: (in category 'allocation') -----
  largeObjectBytesForSlots: numSlots
  	"Answer the total number of bytes in an object with an overflow header, including header bytes."
+ 	<returnTypeC: #usqInt>
  	^self baseHeaderSize + self baseHeaderSize "double header"
  	+ (numSlots + (numSlots bitAnd: 1) * self bytesPerSlot) "roundTo allocationUnit"!

Item was added:
+ ----- Method: Spur32BitMemoryManager>>maxSlotsForAlloc (in category 'instantiation') -----
+ maxSlotsForAlloc
+ 	"Answer the maximum number of slots we are willing to attempt to allocate in an object.
+ 	 Must fit in 32-bits; c.f. bytesInObject:. Chosen so that maxSlotsForAlloc * self bytesPerWord is +ve."
+ 	^512*1024*1024-1!

Item was changed:
  ----- Method: Spur32BitMemoryManager>>objectBytesForSlots: (in category 'object enumeration') -----
  objectBytesForSlots: numSlots
  	"Answer the total number of bytes in an object with the given
  	 number of slots, including header and possible overflow size header."
+ 	<returnTypeC: #usqInt>
  	^(numSlots = 0
  		ifTrue: [self allocationUnit] "always at least one slot for forwarding pointer"
  		ifFalse: [numSlots + (numSlots bitAnd: 1) << self shiftForWord])
  	+ (numSlots >= self numSlotsMask
  		ifTrue: [self baseHeaderSize + self baseHeaderSize]
  		ifFalse: [self baseHeaderSize])!

Item was changed:
  ----- Method: Spur32BitMemoryManager>>smallObjectBytesForSlots: (in category 'allocation') -----
  smallObjectBytesForSlots: numSlots
  	"Answer the total number of bytes in an object without an overflow header, including header bytes."
  	<api>
+ 	<returnTypeC: #usqInt>
  	^self baseHeaderSize "single header"
  	+ (numSlots <= 1
  		ifTrue: [self allocationUnit] "at least one slot for the forwarding pointer"
  		ifFalse: [numSlots + (numSlots bitAnd: 1) * self bytesPerSlot]) "round up to allocationUnit"!

Item was changed:
  ----- Method: Spur64BitMemoryManager>>allocateSlotsForPinningInOldSpace:bytes:format:classIndex: (in category 'allocation') -----
  allocateSlotsForPinningInOldSpace: numSlots bytes: totalBytes format: formatField classIndex: classIndex
  	"Answer the oop of a chunk of space in oldSpace with numSlots slots.  Try and
  	 allocate in a segment that already includes pinned objects.  The header of the
  	 result will have been filled-in but not the contents."
+ 	<var: #totalBytes type: #usqInt>
  	<inline: false>
  	| chunk |
  	chunk := self allocateOldSpaceChunkOfBytes: totalBytes
  				   suchThat: [:f| (segmentManager segmentContainingObj: f) containsPinned].
  	chunk ifNil:
  		[chunk := self allocateOldSpaceChunkOfBytes: totalBytes].
  	self checkFreeSpace.
  	chunk ifNil:
  		[^nil].
  	numSlots >= self numSlotsMask ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word"
  		[self longAt: chunk
  			put: numSlots + (self numSlotsMask << self numSlotsFullShift).
  		 self longAt: chunk + self baseHeaderSize
  			put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex).
  		 ^chunk + self baseHeaderSize].
  	self longAt: chunk
  		put: (self headerForSlots: numSlots format: formatField classIndex: classIndex).
  	^chunk!

Item was changed:
  ----- Method: Spur64BitMemoryManager>>allocateSlotsInOldSpace:bytes:format:classIndex: (in category 'allocation') -----
  allocateSlotsInOldSpace: numSlots bytes: totalBytes format: formatField classIndex: classIndex
  	"Answer the oop of a chunk of space in oldSpace with numSlots slots.  The header
  	 will have been filled-in but not the contents."
+ 	<var: #totalBytes type: #usqInt>
  	<inline: false>
  	| chunk |
  	chunk := self allocateOldSpaceChunkOfBytes: totalBytes.
  	self checkFreeSpace.
  	chunk ifNil:
  		[^nil].
  	numSlots >= self numSlotsMask ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word"
  		[self longAt: chunk
  			put: numSlots + (self numSlotsMask << self numSlotsFullShift).
  		 self longAt: chunk + self baseHeaderSize
  			put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex).
  		 ^chunk + self baseHeaderSize].
  	self longAt: chunk
  		put: (self headerForSlots: numSlots format: formatField classIndex: classIndex).
  	^chunk!

Item was changed:
  ----- Method: Spur64BitMemoryManager>>instantiateClass:indexableSize: (in category 'instantiation') -----
  instantiateClass: classObj indexableSize: nElements
+ 	<var: #nElements type: #usqInt>
  	| 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 := (self fixedFieldsOfClassFormat: classFormat) + 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)].
  		[self firstByteFormat]	->
  			[numSlots := nElements + 7 // 8.
  			 instSpec := instSpec + (8 - nElements bitAnd: 7)].
  		[self firstCompiledMethodFormat]	->
  			[numSlots := nElements + 7 // 8.
  			 instSpec := instSpec + (8 - nElements bitAnd: 7)] }
  		otherwise: ["some Squeak images include funky fixed subclasses of abstract variable
  					 superclasses. e.g. DirectoryEntry as a subclass of ArrayedCollection.
  					 Allow fixed classes to be instantiated here iff nElements = 0."
  					 (nElements ~= 0 or: [instSpec > self lastPointerFormat]) ifTrue:
  						[^nil].
  					 numSlots := self fixedFieldsOfClassFormat: classFormat]. "non-indexable"
  	classIndex := self ensureBehaviorHash: classObj.
  	classIndex < 0 ifTrue:
  		[coInterpreter primitiveFailFor: classIndex negated.
  		 ^nil].
  	numSlots > self maxSlotsForNewSpaceAlloc
+ 		ifTrue:
+ 			[numSlots > self maxSlotsForAlloc ifTrue:
+ 				[^nil].
+ 			 newObj := self allocateSlotsInOldSpace: numSlots format: instSpec classIndex: classIndex]
+ 		ifFalse:
+ 			[newObj := self allocateSlots: numSlots format: instSpec classIndex: classIndex].
- 		ifTrue: [newObj := self allocateSlotsInOldSpace: numSlots format: instSpec classIndex: classIndex]
- 		ifFalse: [newObj := self allocateSlots: numSlots format: instSpec classIndex: classIndex].
  	newObj ifNotNil:
  		[self fillObj: newObj numSlots: numSlots with: fillValue].
  	^newObj!

Item was changed:
  ----- Method: Spur64BitMemoryManager>>largeObjectBytesForSlots: (in category 'allocation') -----
  largeObjectBytesForSlots: numSlots
  	"Answer the total number of bytes in an object with an overflow header, including header bytes."
+ 	<returnTypeC: #usqInt>
  	^self baseHeaderSize + self baseHeaderSize "double header"
  	+ (numSlots * self bytesPerSlot) "no rounding; bytesPerSlot = allocationUnit"!

Item was added:
+ ----- Method: Spur64BitMemoryManager>>maxSlotsForAlloc (in category 'instantiation') -----
+ maxSlotsForAlloc
+ 	"Answer the maximum number of slots we are willing to attempt to allocate in an object.
+ 	 Must fit in 32-bits; c.f. bytesInObject:"
+ 	^1024*1024*1024*1024!

Item was changed:
  ----- Method: Spur64BitMemoryManager>>objectBytesForSlots: (in category 'object enumeration') -----
  objectBytesForSlots: numSlots
  	"Answer the total number of bytes in an object with the given
  	 number of slots, including header and possible overflow size header."
+ 	<returnTypeC: #usqInt>
  	^(numSlots max: 1) << self shiftForWord
  	+ (numSlots >= self numSlotsMask
  		ifTrue: [self baseHeaderSize + self baseHeaderSize]
  		ifFalse: [self baseHeaderSize])!

Item was changed:
  ----- Method: Spur64BitMemoryManager>>smallObjectBytesForSlots: (in category 'allocation') -----
  smallObjectBytesForSlots: numSlots
  	"Answer the total number of bytes in an object without an overflow header, including header bytes."
+ 	<returnTypeC: #usqInt>
  	^self baseHeaderSize "single header"
  	+ (numSlots < 1
  		ifTrue: [self allocationUnit] "at least one slot for the forwarding pointer"
  		ifFalse: [numSlots * self bytesPerSlot])!

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 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.
+ 		 self assert: ((self oop: freeChunk + chunkBytes isLessThanOrEqualTo: child)
- 		 self assert: ((self oop: freeChunk + chunkBytes isLessThan: child)
  						or: [self oop: freeChunk isGreaterThanOrEqualTo: child + childBytes]).
  		 childBytes = chunkBytes ifTrue: "size match; add to list at node."
  			[self storePointer: self freeChunkNextIndex
  					ofFreeChunk: freeChunk
+ 						withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: child);
- 						withValue: (self fetchPointer: self freeChunkNextIndex ofObject: child);
  				storePointer: self freeChunkNextIndex
  					ofFreeChunk: child
  						withValue: freeChunk.
  			 ^child].
  		 "walk down the tree"
  		 parent := child.
  		 child := self fetchPointer: (childBytes > chunkBytes
  										ifTrue: [self freeChunkSmallerIndex]
  										ifFalse: [self freeChunkLargerIndex])
  					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>>allocateBytes:classIndex: (in category 'allocation') -----
  allocateBytes: numBytes classIndex: classIndex
  	"Allocate an object of numBytes.  Answer nil if no available memory.
  	 classIndex must be that of a byte class (e.g. ByteString).
  	 The object is *NOT FILLED*."
+ 	<var: #numBytes type: #usqInt>
  	self assert: (coInterpreter addressCouldBeClassObj: (self classAtIndex: classIndex)).
  	self assert: (self instSpecOfClass: (self classAtIndex: classIndex)) = self firstByteFormat.
  	^self
  		allocateSlots: (numBytes + self bytesPerSlot - 1 // self bytesPerSlot)
  		format: (self byteFormatForNumBytes: numBytes)
  		classIndex: classIndex!

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 storePointer: self freeChunkNextIndex
  						ofFreeChunk: child
  						withValue: (self fetchPointer: self freeChunkNextIndex
  										ofFreeChunk: chunk).
  					 ^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 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 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 storePointer: self freeChunkNextIndex ofFreeChunk: prev withValue: next].
  							 ^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 storePointer: self freeChunkNextIndex ofFreeChunk: prev withValue: next]. 
  								 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 storePointer: self freeChunkNextIndex ofFreeChunk: prev withValue: next]. 
  								 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 storePointer: self freeChunkNextIndex
  						ofFreeChunk: prev
  						withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: node).
  					 ^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 storePointer: self freeChunkNextIndex
  				ofFreeChunk: acceptedNode
  				withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: acceptedChunk).
  			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 storePointer: self freeChunkNextIndex
  						ofFreeChunk: child
  						withValue: (self fetchPointer: self freeChunkNextIndex
  										ofFreeChunk: node).
  					 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 storePointer: self freeChunkNextIndex ofFreeChunk: prev withValue: next].
  							 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 assert: (self isValidFreeObject: 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 storePointer: self freeChunkNextIndex
  							ofFreeChunk: prev
  							withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: node).
  						 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 added:
+ ----- Method: SpurMemoryManager>>allocateSlotsForPinningInOldSpace:bytes:format:classIndex: (in category 'allocation') -----
+ allocateSlotsForPinningInOldSpace: numSlots bytes: totalBytes format: formatField classIndex: classIndex
+ 	"Answer the oop of a chunk of space in oldSpace with numSlots slots.  Try and
+ 	 allocate in a segment that already includes pinned objects.  The header of the
+ 	 result will have been filled-in but not the contents."
+ 	<var: #totalBytes type: #usqInt>
+ 	^self subclassResponsibility!

Item was changed:
  ----- Method: SpurMemoryManager>>allocateSlotsInOldSpace:bytes:format:classIndex: (in category 'allocation') -----
  allocateSlotsInOldSpace: numSlots bytes: totalBytes format: formatField classIndex: classIndex
  	"Answer the oop of a chunk of space in oldSpace with numSlots slots.  The header
  	 will have been filled-in but not the contents."
+ 	<var: #totalBytes type: #usqInt>
  	^self subclassResponsibility!

Item was removed:
- ----- Method: SpurMemoryManager>>byteSizeOfInstanceOf: (in category 'indexing primitive support') -----
- byteSizeOfInstanceOf: classObj
- 	| instSpec classFormat numSlots |
- 	classFormat := self formatOfClass: classObj.
- 	instSpec := self instSpecOfClassFormat: classFormat.
- 	(self isFixedSizePointerFormat: instSpec) ifFalse:
- 		[^PrimErrBadReceiver negated]. "indexable"
- 	numSlots := self fixedFieldsOfClassFormat: classFormat.
- 	^self objectBytesForSlots: numSlots!

Item was added:
+ ----- Method: SpurMemoryManager>>byteSizeOfInstanceOf:errInto: (in category 'indexing primitive support') -----
+ byteSizeOfInstanceOf: classObj errInto: errBlock
+ 	| instSpec classFormat numSlots |
+ 	classFormat := self formatOfClass: classObj.
+ 	instSpec := self instSpecOfClassFormat: classFormat.
+ 	(self isFixedSizePointerFormat: instSpec) ifFalse:
+ 		[^errBlock value: PrimErrBadReceiver]. "indexable"
+ 	numSlots := self fixedFieldsOfClassFormat: classFormat.
+ 	^self objectBytesForSlots: numSlots!

Item was removed:
- ----- Method: SpurMemoryManager>>byteSizeOfInstanceOf:withIndexableSlots: (in category 'indexing primitive support') -----
- byteSizeOfInstanceOf: classObj withIndexableSlots: nElements
- 	| instSpec classFormat numSlots |
- 	<var: 'numSlots' type: #usqInt>
- 	classFormat := self formatOfClass: classObj.
- 	instSpec := self instSpecOfClassFormat: classFormat.
- 	instSpec caseOf: {
- 		[self arrayFormat]	->
- 			[numSlots := nElements].
- 		[self indexablePointersFormat]	->
- 			[numSlots := (self fixedFieldsOfClassFormat: classFormat) + nElements].
- 		[self weakArrayFormat]	->
- 			[numSlots := (self fixedFieldsOfClassFormat: classFormat) + nElements].
- 		[self sixtyFourBitIndexableFormat]	->
- 			[numSlots := self bytesPerSlot = 4 ifTrue: [nElements * 2] ifFalse: [nElements]].
- 		[self firstLongFormat]	->
- 			[numSlots := self bytesPerSlot = 4 ifTrue: [nElements] ifFalse: [nElements + 1 // 2]].
- 		[self firstShortFormat]	->
- 			[numSlots := self bytesPerSlot = 4 ifTrue: [nElements + 1 // 2] ifFalse: [nElements + 3 // 4]].
- 		[self firstByteFormat]	->
- 			[numSlots := nElements + (self bytesPerSlot - 1) // self bytesPerSlot].
- 		[self firstCompiledMethodFormat]	-> "Assume nElements is derived from CompiledMethod>>basicSize."
- 			[numSlots := nElements + (self bytesPerSlot - 1) // self bytesPerSlot] }
- 		otherwise: [^PrimErrBadReceiver negated]. "non-indexable"
- 	numSlots >= (1 << (self bytesPerSlot * 8 - self logBytesPerSlot)) ifTrue:
- 		[^PrimErrLimitExceeded negated].
- 	^self objectBytesForSlots: numSlots!

Item was added:
+ ----- Method: SpurMemoryManager>>byteSizeOfInstanceOf:withIndexableSlots:errInto: (in category 'indexing primitive support') -----
+ byteSizeOfInstanceOf: classObj withIndexableSlots: nElements errInto: errorBlock
+ 	| instSpec classFormat numSlots |
+ 	<var: 'numSlots' type: #usqInt>
+ 	classFormat := self formatOfClass: classObj.
+ 	instSpec := self instSpecOfClassFormat: classFormat.
+ 	instSpec caseOf: {
+ 		[self arrayFormat]	->
+ 			[numSlots := nElements].
+ 		[self indexablePointersFormat]	->
+ 			[numSlots := (self fixedFieldsOfClassFormat: classFormat) + nElements].
+ 		[self weakArrayFormat]	->
+ 			[numSlots := (self fixedFieldsOfClassFormat: classFormat) + nElements].
+ 		[self sixtyFourBitIndexableFormat]	->
+ 			[numSlots := self bytesPerSlot = 4 ifTrue: [nElements * 2] ifFalse: [nElements]].
+ 		[self firstLongFormat]	->
+ 			[numSlots := self bytesPerSlot = 4 ifTrue: [nElements] ifFalse: [nElements + 1 // 2]].
+ 		[self firstShortFormat]	->
+ 			[numSlots := self bytesPerSlot = 4 ifTrue: [nElements + 1 // 2] ifFalse: [nElements + 3 // 4]].
+ 		[self firstByteFormat]	->
+ 			[numSlots := nElements + (self bytesPerSlot - 1) // self bytesPerSlot].
+ 		[self firstCompiledMethodFormat]	-> "Assume nElements is derived from CompiledMethod>>basicSize."
+ 			[numSlots := nElements + (self bytesPerSlot - 1) // self bytesPerSlot] }
+ 		otherwise: [^errorBlock value: PrimErrBadReceiver negated]. "non-indexable"
+ 	numSlots >= (1 << (self bytesPerSlot * 8 - self logBytesPerSlot)) ifTrue:
+ 		[^errorBlock value: PrimErrLimitExceeded].
+ 	^self objectBytesForSlots: numSlots!

Item was changed:
  ----- Method: SpurMemoryManager>>inFreeTreeReplace:with: (in category 'free space') -----
  inFreeTreeReplace: treeNode with: newNode
  	"Part of reorderReversedTreeList:.  Switch treeNode with newNode in
  	 the tree, but do nothing to the list linked through freeChunkNextIndex."
  	| relative |
  	"copy parent, smaller, larger"
  	self freeChunkParentIndex to: self freeChunkLargerIndex do:
  		[:i|
+ 		relative := self fetchPointer: i ofFreeChunk: treeNode.
- 		relative := self fetchPointer: i ofObject: treeNode.
  		i = self freeChunkParentIndex
  			ifTrue:
  				[relative = 0
  					ifTrue: "update root to point to newNode"
  						[self assert: (freeLists at: 0) = treeNode.
  						 freeLists at: 0 put: newNode]
  					ifFalse: "replace link from parent to treeNode with link to newNode."
+ 						[self storePointer: (treeNode = (self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: relative)
- 						[self storePointer: (treeNode = (self fetchPointer: self freeChunkSmallerIndex ofObject: relative)
  												ifTrue: [self freeChunkSmallerIndex]
  												ifFalse: [self freeChunkLargerIndex])
  							ofFreeChunk: relative
  							withValue: newNode]]
  			ifFalse:
  				[relative ~= 0 ifTrue:
+ 					[self assert: (self fetchPointer: self freeChunkParentIndex ofFreeChunk: relative) = treeNode.
- 					[self assert: (self fetchPointer: self freeChunkParentIndex ofObject: relative) = treeNode.
  					 self storePointer: self freeChunkParentIndex ofFreeChunk: relative withValue: newNode]].
  		self storePointer: i ofFreeChunk: newNode withValue: relative.
  		self storePointer: i ofFreeChunk: treeNode withValue: 0]!

Item was changed:
  ----- Method: SpurMemoryManager>>inOrderPrintFreeTree:printList: (in category 'debug printing') -----
  inOrderPrintFreeTree: freeChunk printList: printNextList
  	"print free chunks in freeTree in order."
  	<api>
  	| next |
+ 	(next := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: freeChunk) ~= 0 ifTrue:
- 	(next := self fetchPointer: self freeChunkSmallerIndex ofObject: freeChunk) ~= 0 ifTrue:
  		[self inOrderPrintFreeTree: next printList: printNextList].
  	self printFreeChunk: freeChunk isNextChunk: false.
  	printNextList ifTrue:
  		[next := freeChunk.
+ 		 [(next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: next) ~= 0] whileTrue:
- 		 [(next := self fetchPointer: self freeChunkNextIndex ofObject: next) ~= 0] whileTrue:
  			[coInterpreter tab.
  			 self printFreeChunk: next isNextChunk: true]].
+ 	(next := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: freeChunk) ~= 0 ifTrue:
- 	(next := self fetchPointer: self freeChunkLargerIndex ofObject: freeChunk) ~= 0 ifTrue:
  		[self inOrderPrintFreeTree: next printList: printNextList]!

Item was changed:
  ----- Method: SpurMemoryManager>>initializeObjectMemory: (in category 'initialization') -----
  initializeObjectMemory: bytesToShift
+ 	"Initialize object memory variables at startup time. Assume endOfMemory at al are
+ 	 initialised by the image-reading code via setHeapBase:memoryLimit:endOfMemory:.
+ 	 endOfMemory is assumed to point to the end of the last object in the image.
+ 	 Assume: image reader also initializes the following variables:
- 	"Initialize object memory variables at startup time. Assume endOfMemory is initially set (by the image-reading code) to the end of the last object in the image. Initialization redefines endOfMemory to be the end of the object allocation area based on the total available memory, but reserving some space for forwarding blocks."
- 	"Assume: image reader initializes the following variables:
- 		memory
- 		memoryLimit
  		specialObjectsOop
+ 		lastHash"
- 		lastHash
- 	"
  	<inline: false>
  	| freeListObj |
  	"Catch mis-initializations leading to bad translations to C"
  	self assert: BaseHeaderSize = self baseHeaderSize.
+ 	self assert: (self maxSlotsForAlloc * BytesPerWord) asInteger > 0.
  	self bootstrapping ifFalse:
  		[self
  			initSegmentBridgeWithBytes: self bridgeSize
  			at: endOfMemory - self bridgeSize].
  	segmentManager adjustSegmentSwizzlesBy: bytesToShift.
  	"image may be at a different address; adjust oops for new location"
  	self adjustAllOopsBy: bytesToShift.
  	specialObjectsOop := segmentManager swizzleObj: specialObjectsOop.
  
  	"heavily used special objects"
  	nilObj		:= self splObj: NilObject.
  	falseObj	:= self splObj: FalseObject.
  	trueObj		:= self splObj: TrueObject.
  
  	"In Cog we insist that nil, true & false are next to each other (Cogit generates tighter
  	 conditional branch code as a result).  In addition, Spur places the free lists and
  	 class table root page immediately following them."
  	self assert: nilObj = oldSpaceStart.
  	self assert: falseObj = (self objectAfter: nilObj).
  	self assert: trueObj = (self objectAfter: falseObj).
  	freeListObj := self objectAfter: trueObj.
  	self reInitializeClassTablePostLoad: (self objectAfter: freeListObj).
  	markStack := self swizzleObjStackAt: MarkStackRootIndex.
  	weaklingStack := self swizzleObjStackAt: WeaklingStackRootIndex.
  	ephemeronQueue := self swizzleObjStackAt: EphemeronQueueRootIndex.
  	self assert: self validObjStacks.
  	self assert: (self isEmptyObjStack: markStack).
  	self assert: (self isEmptyObjStack: weaklingStack).
  
  	self initializeFreeSpacePostLoad: freeListObj.
  	segmentManager collapseSegmentsPostSwizzle.
  	self computeFreeSpacePostSwizzle.
  	self bootstrapping ifFalse:
  		[self initializeNewSpaceVariables].
  	self initializeOldSpaceFirstFree: freeOldSpaceStart. "initializes endOfMemory, freeStart"
  	segmentManager checkSegments.
  
  	"These defaults should depend on machine size; e.g. too small on a powerful laptop, too big on a Pi."
  	growHeadroom := 16*1024*1024.		"headroom when growing"
  	shrinkThreshold := 32*1024*1024.		"free space before shrinking"
  	self setHeapSizeAtPreviousGC.
  	heapGrowthToSizeGCRatio := 0.333333. "By default GC after scavenge if heap has grown by a third since the last GC"!

Item was changed:
  ----- Method: SpurMemoryManager>>instantiateClass:indexableSize: (in category 'instantiation') -----
  instantiateClass: classObj indexableSize: nElements
+ 	<var: #nElements type: #usqInt>
  	^self subclassResponsibility!

Item was changed:
  ----- Method: SpurMemoryManager>>largeObjectBytesForSlots: (in category 'allocation') -----
  largeObjectBytesForSlots: numSlots
  	"Answer the total number of bytes in an object with an overflow header, including header bytes."
+ 	<returnTypeC: #usqInt>
  	^self subclassResponsibility!

Item was added:
+ ----- Method: SpurMemoryManager>>maxSlotsForAlloc (in category 'instantiation') -----
+ maxSlotsForAlloc
+ 	"Answer the maximum number of slots we are willing to attempt to allocate in an object.
+ 	 Must fit in 32-bits; c.f. bytesInObject:"
+ 	^self subclassResponsibility!

Item was changed:
  ----- Method: SpurMemoryManager>>objectBytesForSlots: (in category 'allocation') -----
  objectBytesForSlots: numSlots
  	"Answer the total number of bytes in an object with the given
  	 number of slots, including header and possible overflow size header."
+ 	<returnTypeC: #usqInt>
  	self subclassResponsibility!

Item was changed:
  ----- Method: SpurMemoryManager>>rebuildFreeTreeFrom: (in category 'free space') -----
  rebuildFreeTreeFrom: sortedFreeChunks
  	"post sweep and pre compact, rebuild the large free chunk tree from the
  	 sortedFreeChunks list, such that the lists are ordered from low to high address."
  	| freeChunk bytes totalBytes |
  	"first add all the chunks to the tree.  This will result in almost address-sorted lists.
  	 We will need to reorder the lists."
  	freeChunk := sortedFreeChunks.
  	totalBytes := 0.
  	[freeChunk ~= 0] whileTrue:
  		[bytes := self bytesInObject: freeChunk.
  		 totalBytes := totalBytes + bytes.
  		 self addToFreeTree: freeChunk bytes: bytes.
  		 freeChunk := self fetchPointer: self freeChunkNextAddressIndex
+ 							ofFreeChunk: freeChunk].
- 							ofObject: freeChunk].
  	"now reorder the lists to ensure they're in address order, apart from the list head, which should be highest."
  	self freeTreeNodesDo:
  		[:treeNode| | newTreeNode |
  		newTreeNode := self reorderReversedTreeList: treeNode.
  		newTreeNode].
  	^totalBytes!

Item was changed:
  ----- Method: SpurMemoryManager>>reorderReversedTreeList: (in category 'free space') -----
  reorderReversedTreeList: treeNode
  	"Once the freeTree has been rebuilt from the sortedFreeChunks list
  	 each list will be in a weird order, the list in reverse order, high to low,
  	 but the tree node, because it is inserted first, will be the lowest address.
  	 Reverse the list so it is sorted low to high, but make the highest address
  	 node the first, as this will be allocated from last."
  	| first next node prev |
  	"first becomes the new head, as this is the last one we want to allocate and we allocate from the list first."
+ 	first := self fetchPointer: self freeChunkNextIndex ofFreeChunk: treeNode.
- 	first := self fetchPointer: self freeChunkNextIndex ofObject: treeNode.
  	"no next node, so no change"
  	first = 0 ifTrue:
  		[^treeNode].
+ 	node := self fetchPointer: self freeChunkNextIndex ofFreeChunk: first.
- 	node := self fetchPointer: self freeChunkNextIndex ofObject: first.
  	self storePointer: self freeChunkNextIndex ofFreeChunk: first withValue: treeNode.
  	self inFreeTreeReplace: treeNode with: first.
  	prev := 0.
  	[node ~= 0] whileTrue:
+ 		[next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node.
- 		[next := self fetchPointer: self freeChunkNextIndex ofObject: node.
  		 self storePointer: self freeChunkNextIndex ofFreeChunk: node withValue: prev.
  		 prev := node.
  		 node := next].
  	self storePointer: self freeChunkNextIndex ofFreeChunk: treeNode withValue: prev.
  	^first!

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

Item was changed:
  ----- Method: SpurMemoryManager>>smallObjectBytesForSlots: (in category 'allocation') -----
  smallObjectBytesForSlots: numSlots
  	"Answer the total number of bytes in an object without an overflow header, including header bytes."
+ 	<returnTypeC: #usqInt>
  	^self subclassResponsibility!

Item was changed:
  ----- Method: SpurMemoryManager>>sortFreeListAt: (in category 'free space') -----
  sortFreeListAt: i
  	"Sort the individual free list i so that the lowest address is at the head of the list.
  	 Use an insertion sort with a scan for initially sorted elements."
  
  	| list next head |
  	list := freeLists at: i. "list of objects to be inserted"
  	list = 0 ifTrue: "empty list; we're done"
  		[^self].
  	head := list.
  	"scan list to find find first out-of-order element"
+ 	[(next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: list) > list]
- 	[(next := self fetchPointer: self freeChunkNextIndex ofObject: list) > list]
  		whileTrue:
  			[list := next].
  	"no out-of-order elements; list was already sorted; we're done"
  	next = 0 ifTrue:
  		[^self].
  	"detatch already sorted list"
  	self storePointer: self freeChunkNextIndex ofFreeChunk: list withValue: 0.
  	list := next.
  	[list ~= 0] whileTrue:
  		[| node prev |
  		 "grab next node to be inserted"
+ 		 next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: list.
- 		 next := self fetchPointer: self freeChunkNextIndex ofObject: list.
  		 "search sorted list for insertion point"
  		 prev := 0. "prev node for insertion sort"
  		 node := head. "current node for insertion sort"
  		 [node ~= 0
  		  and: [self oop: node isLessThan: list]] whileTrue:
  			[prev := node.
+ 			 node := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node].
- 			 node := self fetchPointer: self freeChunkNextIndex ofObject: node].
  		 "insert the node into the sorted list"
  		 self assert: (node = 0 or: [node > list]).
  		 prev = 0
  			ifTrue:
  				[head := list]
  			ifFalse:
  				[self storePointer: self freeChunkNextIndex
  					ofFreeChunk: prev
  					withValue: list].
  		 self storePointer: self freeChunkNextIndex
  			ofFreeChunk: list
  			withValue: node.
  		list := next].
  	"replace the list with the sorted list"
  	freeLists at: i put: head!



More information about the Vm-dev mailing list