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

commits at source.squeak.org commits at source.squeak.org
Tue Sep 10 18:47:23 UTC 2013


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

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

Name: VMMaker.oscog-eem.362
Author: eem
Time: 10 September 2013, 11:44:33.364 am
UUID: f10a8564-4eb4-40f7-acc9-2b1b863c6971
Ancestors: VMMaker.oscog-eem.361

Fix bug in linear search of method dictionaries.

Remove most, if not all, uses of naked integers for formats
(e.g. 4 => objectMemory lastPointerFormat).

Restore lastPointerFormat of ObjectMeory to 4 from 5 (reserved fork ephemerons).

Remove badly-named StackInterpreter class>>patchInterp:

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

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveStringReplace (in category 'indexing primitives') -----
  primitiveStringReplace
  	" 
  	<array> primReplaceFrom: start to: stop with: replacement 
  	startingAt: repStart  
  	<primitive: 105>
  	"
  	| array start stop repl replStart hdr arrayFmt totalLength arrayInstSize replFmt replInstSize srcIndex |
  	array := self stackValue: 4.
  	start := self stackIntegerValue: 3.
  	stop := self stackIntegerValue: 2.
  	repl := self stackValue: 1.
  	replStart := self stackIntegerValue: 0.
  
  	self successful ifFalse: [^ self primitiveFail].
+ 	(objectMemory isImmediate: repl) ifTrue: "can happen in LgInt copy"
+ 		[^self primitiveFail].
- 	(objectMemory isIntegerObject: repl) ifTrue: ["can happen in LgInt copy"
- 			^ self primitiveFail].
  
  	hdr := objectMemory baseHeader: array.
  	arrayFmt := objectMemory formatOfHeader: hdr.
  	totalLength := objectMemory lengthOf: array baseHeader: hdr format: arrayFmt.
  	arrayInstSize := objectMemory fixedFieldsOf: array format: arrayFmt length: totalLength.
  	(start >= 1 and: [start - 1 <= stop and: [stop + arrayInstSize <= totalLength]])
  		ifFalse: [^ self primitiveFailFor: PrimErrBadIndex].
  
  	hdr := objectMemory baseHeader: repl.
  	replFmt := objectMemory formatOfHeader: hdr.
  	totalLength := objectMemory lengthOf: repl baseHeader: hdr format: replFmt.
  	replInstSize := objectMemory fixedFieldsOf: repl format: replFmt length: totalLength.
  	(replStart >= 1 and: [stop - start + replStart + replInstSize <= totalLength])
  		ifFalse: [^ self primitiveFailFor: PrimErrBadIndex].
  
  	"Array formats (without byteSize bits, if bytes array) must be same "
+ 	arrayFmt < objectMemory firstByteFormat
- 	arrayFmt < 8
  		ifTrue: [arrayFmt = replFmt
  				ifFalse: [^ self primitiveFailFor: PrimErrInappropriate]]
+ 		ifFalse: [(arrayFmt bitAnd: objectMemory byteFormatMask) = (replFmt bitAnd: objectMemory byteFormatMask)
- 		ifFalse: [(arrayFmt bitAnd: 12) = (replFmt bitAnd: 12)
  				ifFalse: [^ self primitiveFailFor: PrimErrInappropriate]].
  
  	srcIndex := replStart + replInstSize - 1.
  	"- 1 for 0-based access"
  
+ 	arrayFmt <= objectMemory lastPointerFormat
+ 		ifTrue:
+ 			[start + arrayInstSize - 1 to: stop + arrayInstSize - 1 do: [:i |
- 	arrayFmt <= 4
- 		ifTrue: ["pointer type objects"
- 			start + arrayInstSize - 1 to: stop + arrayInstSize - 1 do: [:i |
  				objectMemory storePointer: i ofObject: array withValue: (objectMemory fetchPointer: srcIndex ofObject: repl).
  					srcIndex := srcIndex + 1]]
+ 		ifFalse:
+ 			[arrayFmt < objectMemory firstByteFormat
+ 				ifTrue: "32-bit-word type objects"
+ 					[start + arrayInstSize - 1 to: stop + arrayInstSize - 1
- 		ifFalse: [arrayFmt < 8
- 				ifTrue: ["32-bit-word type objects"
- 					start + arrayInstSize - 1 to: stop + arrayInstSize - 1
  						do: [:i | objectMemory storeLong32: i ofObject: array withValue: (objectMemory fetchLong32: srcIndex ofObject: repl).
  							srcIndex := srcIndex + 1]]
+ 				ifFalse: "byte-type objects"
+ 					[start + arrayInstSize - 1 to: stop + arrayInstSize - 1
- 				ifFalse: ["byte-type objects"
- 					start + arrayInstSize - 1 to: stop + arrayInstSize - 1
  						do: [:i |  objectMemory storeByte: i ofObject: array withValue: (objectMemory fetchByte: srcIndex ofObject: repl).
  							srcIndex := srcIndex + 1]]].
  	"We might consider  comparing stop - start to some value here and using forceInterruptCheck"
  
  	self pop: argumentCount "leave rcvr on stack"!

Item was changed:
  ----- Method: NewObjectMemory>>allocate:headerSize:h1:h2:h3:doFill:format: (in category 'allocation') -----
  allocate: byteSize headerSize: hdrSize h1: baseHeader h2: classOopArg h3: extendedSize doFill: doFill format: format
  	"Allocate a new object of the given size and number of header words. (Note: byteSize already includes space for the base header word.) Initialize the header fields of the new object and fill the remainder of the object with a value appropriate for the format.
  	May cause a GC"
  
  	| newObj classOop |
  	<inline: true>
  	<var: #i type: #usqInt>
  	<var: #end type: #usqInt>
  	newObj := self allocateChunk: byteSize + (hdrSize - 1 * BytesPerWord).
  	newObj = 0
  		ifTrue:
  			["remap classOop because GC may move the classOop"
  			hdrSize > 1 ifTrue: [self pushRemappableOop: classOopArg].
  			newObj := self allocateChunkAfterGC: byteSize + (hdrSize - 1 * BytesPerWord).
  			hdrSize > 1 ifTrue: [classOop := self popRemappableOop].
  			newObj = 0 ifTrue: [^newObj]]
  		ifFalse: [classOop := classOopArg].
  
  	hdrSize = 3 ifTrue:
  		[self longAt: newObj put: (extendedSize bitOr: HeaderTypeSizeAndClass).
  		 self longAt: newObj + BytesPerWord put: (classOop bitOr: HeaderTypeSizeAndClass).
  		 self longAt: newObj + (BytesPerWord*2) put: (baseHeader bitOr: HeaderTypeSizeAndClass).
  		 newObj := newObj + (BytesPerWord*2)].
  
  	hdrSize = 2 ifTrue:
  		[self longAt: newObj put: (classOop bitOr: HeaderTypeClass).
  		 self longAt: newObj + BytesPerWord put: (baseHeader bitOr: HeaderTypeClass).
  		 newObj := newObj + BytesPerWord].
  
  	hdrSize = 1 ifTrue:
  		[self longAt: newObj put: (baseHeader bitOr: HeaderTypeShort)].
  
  	"clear new object"
  	doFill ifTrue:
  		[| fillWord end i |
+ 		 fillWord := format <= self lastPointerFormat
- 		 fillWord := format <= 4
  						ifTrue: [nilObj] "if pointers, fill with nil oop"
  						ifFalse: [0].
  		 end := newObj + byteSize.
  		 i := newObj + BytesPerWord. "skip header"
  		 [i < end] whileTrue:
  			[self longAt: i put: fillWord.
  			 i := i + BytesPerWord].
  		 self assert: i = freeStart.].
  	DoExpensiveAssertionChecks ifTrue:
  		[self okayOop: newObj.
  		 self oopHasOkayClass: newObj.
  		 (self safeObjectAfter: newObj) = freeStart ifFalse:
  			[self error: 'allocate bug: did not set header of new oop correctly']].
  
  	^newObj!

Item was changed:
  ----- Method: NewObjectMemory>>eeAllocate:headerSize:h1:h2:h3:doFill:format: (in category 'allocation') -----
  eeAllocate: byteSize headerSize: hdrSize h1: baseHeader h2: classOop h3: extendedSize doFill: doFill format: format
  	"Allocate a new object of the given size and number of header words. (Note: byteSize already includes
  	 space for the base header word.) Initialize the header fields of the new object and fill the remainder of
  	 the object with the given value.  Will not cause a GC.  This version is for the execution engine"
  
  	| newObj |
  	<inline: true>
  	<asmLabel: false>
  	<var: #i type: 'usqInt'>
  	<var: #end type: 'usqInt'>
  	newObj := self allocateInterpreterChunk: byteSize + (hdrSize - 1 * BytesPerWord).
  	newObj = 0 ifTrue: [^newObj].
  	hdrSize = 3 ifTrue:
  		[self longAt: newObj put: (extendedSize bitOr: HeaderTypeSizeAndClass).
  		 self longAt: newObj + BytesPerWord put: (classOop bitOr: HeaderTypeSizeAndClass).
  		 self longAt: newObj + (BytesPerWord*2) put: (baseHeader bitOr: HeaderTypeSizeAndClass).
  		 newObj := newObj + (BytesPerWord*2)].
  
  	 hdrSize = 2 ifTrue:
  		[self longAt: newObj put: (classOop bitOr: HeaderTypeClass).
  		 self longAt: newObj + BytesPerWord put: (baseHeader bitOr: HeaderTypeClass).
  		 newObj := newObj + BytesPerWord].
  
  	 hdrSize = 1 ifTrue:
  		[self longAt: newObj put: (baseHeader bitOr: HeaderTypeShort)].
  
  	"clear new object"
  	doFill ifTrue:
  		[| fillWord end i |
+ 		 fillWord := format <= self lastPointerFormat
- 		 fillWord := format <= 4
  					ifTrue: [nilObj] "if pointers, fill with nil oop"
  					ifFalse: [0].
  		 end := newObj + byteSize.
  		 i := newObj + BytesPerWord.
  		 [i < end] whileTrue:
  			[self longAt: i put: fillWord.
  			 i := i + BytesPerWord]].
  
  	DoExpensiveAssertionChecks ifTrue:
  		[self okayOop: newObj.
  		 self oopHasOkayClass: newObj.
  		 (self safeObjectAfter: newObj) = freeStart ifFalse:
  			[self error: 'allocate bug: did not set header of new oop correctly']].
  
  	^newObj!

Item was changed:
  ----- Method: NewObjectMemory>>eeInstantiateAndInitializeClass:indexableSize: (in category 'interpreter access') -----
  eeInstantiateAndInitializeClass: classPointer indexableSize: size 
  	"NOTE: This method supports the backward-compatible split instSize field of the 
  	 class format word. The sizeHiBits will go away and other shifts change by 2 
  	 when the split fields get merged in an (incompatible) image change.
  	 Will *not* cause a GC.  The instantiated object is initialized."
  
  	| hash header1 header2 cClass byteSize format binc header3 hdrSize sizeHiBits bm1 classFormat |
  	<inline: false>
  	"cannot have a negative indexable field count"
  	self assert: size >= 0.
  	hash := self newObjectHash.
  	classFormat := self formatOfClass: classPointer.
  	"Low 2 bits are 0"
  	header1 := (classFormat bitAnd: 16r1FF00) bitOr: (hash bitAnd: HashMaskUnshifted) << HashBitsOffset.
  	header2 := classPointer.
  	header3 := 0.
  	sizeHiBits := (classFormat bitAnd: 16r60000) >> 9.
  	cClass := header1 bitAnd: CompactClassMask. "compact class field from format word"
  	byteSize := (classFormat bitAnd: SizeMask + Size4Bit) + sizeHiBits.
  		"size in bytes -- low 2 bits are 0"
  	"Note this byteSize comes from the format word of the class which is pre-shifted
  		to 4 bytes per field.  Need another shift for 8 bytes per word..."
  	byteSize := byteSize << (ShiftForWord-2).
  	format := self formatOfHeader: classFormat.
  	self flag: #sizeLowBits.
+ 	format < self firstByteFormat
- 	format < 8
  		ifTrue:
+ 			[format = self firstLongFormat
+ 				ifTrue: "long32 bitmaps"
+ 					[bm1 := BytesPerWord-1.
- 			[format = 6
- 				ifTrue: ["long32 bitmaps"
- 					bm1 := BytesPerWord-1.
  					byteSize := byteSize + (size * 4) + bm1 bitAnd: LongSizeMask. "round up"
  					binc := bm1 - ((size * 4) + bm1 bitAnd: bm1). "odd bytes"
  					"extra low bit (4) for 64-bit VM goes in 4-bit (betw hdr bits and sizeBits)"
  					header1 := header1 bitOr: (binc bitAnd: 4)]
+ 				ifFalse: "Arrays and 64-bit bitmaps"
+ 					[byteSize := byteSize + (size * BytesPerWord)]]
- 				ifFalse: [byteSize := byteSize + (size * BytesPerWord) "Arrays and 64-bit bitmaps"]
- 			]
  		ifFalse:
  			["Strings and Methods"
  			bm1 := BytesPerWord-1.
  			byteSize := byteSize + size + bm1 bitAnd: LongSizeMask. "round up"
  			binc := bm1 - (size + bm1 bitAnd: bm1). "odd bytes"
  			"low bits of byte size go in format field"
+ 			header1 := header1 bitOr: (binc bitAnd: 3) << self instFormatFieldLSB.
- 			header1 := header1 bitOr: (binc bitAnd: 3) << 8.
  			"extra low bit (4) for 64-bit VM goes in 4-bit (betw hdr bits and sizeBits)"
  			header1 := header1 bitOr: (binc bitAnd: 4)].
  	byteSize > 255
+ 		ifTrue: "requires size header word"
+ 			[header3 := byteSize.
- 		ifTrue: ["requires size header word"
- 			header3 := byteSize.
  			header1 := header1]
  		ifFalse: [header1 := header1 bitOr: byteSize].
+ 	hdrSize := header3 > 0
+ 					ifTrue: [3] "requires full header"
+ 					ifFalse: [cClass = 0 ifTrue: [2] ifFalse: [1]].
- 	header3 > 0
- 		ifTrue: ["requires full header"
- 			hdrSize := 3]
- 		ifFalse: [cClass = 0
- 				ifTrue: [hdrSize := 2]
- 				ifFalse: [hdrSize := 1]].
  	^self eeAllocate: byteSize headerSize: hdrSize h1: header1 h2: header2 h3: header3 doFill: true format: format!

Item was changed:
  ----- Method: NewObjectMemory>>eeInstantiateClass:indexableSize: (in category 'interpreter access') -----
  eeInstantiateClass: classPointer indexableSize: size 
  	"NOTE: This method supports the backward-compatible split instSize field of the 
  	 class format word. The sizeHiBits will go away and other shifts change by 2 
  	 when the split fields get merged in an (incompatible) image change.
  	 Will *not* cause a GC.
  	 Note that the instantiated object IS NOT FILLED and must be completed before
  	 returning it to Smalltalk. Since this call is used in routines that do just that we are
  	 safe.  Break this rule and die."
  	<api>
  	| hash header1 header2 cClass byteSize format binc header3 hdrSize sizeHiBits bm1 classFormat |
  	<inline: false>
  	"cannot have a negative indexable field count"
  	self assert: size >= 0.
  	hash := self newObjectHash.
  	classFormat := self formatOfClass: classPointer.
  	"Low 2 bits are 0"
  	header1 := (classFormat bitAnd: 16r1FF00) bitOr: (hash bitAnd: HashMaskUnshifted) << HashBitsOffset.
  	header2 := classPointer.
  	header3 := 0.
  	sizeHiBits := (classFormat bitAnd: 16r60000) >> 9.
  	cClass := header1 bitAnd: CompactClassMask. "compact class field from format word"
  	byteSize := (classFormat bitAnd: SizeMask + Size4Bit) + sizeHiBits.
  		"size in bytes -- low 2 bits are 0"
  	"Note this byteSize comes from the format word of the class which is pre-shifted
  		to 4 bytes per field.  Need another shift for 8 bytes per word..."
  	byteSize := byteSize << (ShiftForWord-2).
  	format := self formatOfHeader: classFormat.
  	self flag: #sizeLowBits.
+ 	format < self firstByteFormat
- 	format < 8
  		ifTrue:
+ 			[format = self firstLongFormat
+ 				ifTrue: "long32 bitmaps"
+ 					[bm1 := BytesPerWord-1.
- 			[format = 6
- 				ifTrue: ["long32 bitmaps"
- 					bm1 := BytesPerWord-1.
  					byteSize := byteSize + (size * 4) + bm1 bitAnd: LongSizeMask. "round up"
  					binc := bm1 - ((size * 4) + bm1 bitAnd: bm1). "odd bytes"
  					"extra low bit (4) for 64-bit VM goes in 4-bit (betw hdr bits and sizeBits)"
  					header1 := header1 bitOr: (binc bitAnd: 4)]
+ 				ifFalse: "Arrays and 64-bit bitmaps"
+ 					[byteSize := byteSize + (size * BytesPerWord)]]
- 				ifFalse: [byteSize := byteSize + (size * BytesPerWord) "Arrays and 64-bit bitmaps"]
- 			]
  		ifFalse:
  			["Strings and Methods"
  			bm1 := BytesPerWord-1.
  			byteSize := byteSize + size + bm1 bitAnd: LongSizeMask. "round up"
  			binc := bm1 - (size + bm1 bitAnd: bm1). "odd bytes"
  			"low bits of byte size go in format field"
+ 			header1 := header1 bitOr: (binc bitAnd: 3) << self instFormatFieldLSB.
- 			header1 := header1 bitOr: (binc bitAnd: 3) << 8.
  			"extra low bit (4) for 64-bit VM goes in 4-bit (betw hdr bits and sizeBits)"
  			header1 := header1 bitOr: (binc bitAnd: 4)].
  	byteSize > 255
+ 		ifTrue: "requires size header word"
+ 			[header3 := byteSize.
- 		ifTrue: ["requires size header word"
- 			header3 := byteSize.
  			header1 := header1]
  		ifFalse: [header1 := header1 bitOr: byteSize].
+ 	hdrSize := header3 > 0
+ 					ifTrue: [3] "requires full header"
+ 					ifFalse: [cClass = 0 ifTrue: [2] ifFalse: [1]].
- 	header3 > 0
- 		ifTrue: ["requires full header"
- 			hdrSize := 3]
- 		ifFalse: [cClass = 0
- 				ifTrue: [hdrSize := 2]
- 				ifFalse: [hdrSize := 1]].
  	^self eeAllocate: byteSize headerSize: hdrSize h1: header1 h2: header2 h3: header3!

Item was removed:
- ----- Method: NewObjectMemory>>eeInstantiateMethodContextByteSize: (in category 'interpreter access') -----
- eeInstantiateMethodContextByteSize: sizeInBytes 
- 	"This version of instantiateClass assumes that the total object 
- 	 size is under 256 bytes, the limit for objects with only one or 
- 	 two header words. Note that the size is specified in bytes 
- 	 and should include four bytes for the base header word.
- 	 Will *not* cause a GC."
- 	| hash header1 |
- 	self assert: (sizeInBytes = SmallContextSize or: [sizeInBytes = LargeContextSize]).
- 	self assert: sizeInBytes <= SizeMask.
- 	hash := self newObjectHash.
- 	header1 := (hash bitAnd: HashMaskUnshifted) << HashBitsOffset bitOr: self formatOfMethodContextMinusSize.
- 	self assert: (header1 bitAnd: CompactClassMask) > 0. "contexts must be compact"
- 	self assert: (header1 bitAnd: SizeMask) = 0.
- 	"OR size into header1.  Must not do this if size > SizeMask"
- 	header1 := header1 + sizeInBytes.
- 	^self eeAllocate: sizeInBytes headerSize: 1 h1: header1 h2: nil h3: nil!

Item was changed:
  ----- Method: NewObjectMemory>>firstValidIndexOfIndexableObject:withFormat: (in category 'indexing primitive support') -----
  firstValidIndexOfIndexableObject: obj withFormat: fmt
  	"Answer the one-relative index of the first valid index in an indexbale object
  	 with the given format.  This is 1 for all objects except compiled methods
  	 where the first index is beyond the last literal.
  	 Used for safer bounds-checking on methods."
+ 	^fmt >= self firstCompiledMethodFormat
- 	^fmt >= 12
  		ifTrue: [coInterpreter firstByteIndexOfMethod: obj]
  		ifFalse: [1]!

Item was changed:
  ----- Method: NewObjectMemory>>formatOfMethodContext (in category 'frame access') -----
  formatOfMethodContext
  	"Answer the class format word for MethodContext which is used to instantiate
  	 contexts without needing to fetch it from the class MethodContext itself."
  	^(ClassMethodContextCompactIndex << 12)
+ 	+ (self indexablePointersFormat << self instFormatFieldLSB) "Pointers+Variable"
- 	+ (3 << 8) "Pointers+Variable"
  	+ (CtxtTempFrameStart + (BaseHeaderSize / BytesPerWord) << 2)!

Item was changed:
  ----- Method: NewObjectMemory>>formatOfMethodContextMinusSize (in category 'frame access') -----
  formatOfMethodContextMinusSize
  	"Answer the class format word for MethodContext which is used to instantiate
  	 contexts without needing to fetch it from the class MethodContext itself."
  	^(ClassMethodContextCompactIndex << 12)
+ 	+ (self indexablePointersFormat << self instFormatFieldLSB) "Pointers+Variable"!
- 	+ (3 << 8) "Pointers+Variable"!

Item was changed:
  ----- Method: NewObjectMemory>>lastPointerOf: (in category 'object enumeration') -----
  lastPointerOf: oop 
  	"Return the byte offset of the last pointer field of the given object.  
  	 Can be used even when the type bits are not correct.
  	 Works with CompiledMethods, as well as ordinary objects."
  	<api>
  	<inline: true>
  	<asmLabel: false>
  	| fmt header contextSize numLiterals |
  	header := self baseHeader: oop.
  	fmt := self formatOfHeader: header.
+ 	fmt <= self lastPointerFormat ifTrue:
+ 		[(fmt = self indexablePointersFormat
- 	fmt <= 4 ifTrue:
- 		[(fmt = 3
  		  and: [self isContextHeader: header]) ifTrue:
  			["contexts end at the stack pointer"
  			contextSize := coInterpreter fetchStackPointerOf: oop.
  			^CtxtTempFrameStart + contextSize * BytesPerOop].
  		^(self sizeBitsOfSafe: oop) - BaseHeaderSize  "all pointers"].
+ 	fmt < self firstCompiledMethodFormat ifTrue: [^0]. "no pointers"
- 	fmt < 12 ifTrue: [^0]. "no pointers"
  
  	"CompiledMethod: contains both pointers and bytes"
  	numLiterals := coInterpreter literalCountOf: oop.
  	^numLiterals + LiteralStart * BytesPerOop!

Item was changed:
  ----- Method: NewObjectMemory>>lastPointerOf:recordWeakRoot: (in category 'object enumeration') -----
  lastPointerOf: oop recordWeakRoot: recordWeakRoot "<Boolean>"
  	"Return the byte offset of the last pointer field of the given object.  
  	 Works with CompiledMethods, as well as ordinary objects. 
  	 Can be used even when the type bits are not correct.
  	 This is a version of lastPointerOf: for markAndTrace:.
  	 Already overridden to trace stack pages for the StackInterpreter.
  	 Override to ask coInterpreter to determine literalCount of methods."
  	| fmt sz header contextSize numFields |
  	<inline: true>
  	<asmLabel: false>
  	header := self baseHeader: oop.
  	fmt := self formatOfHeader: header.
+ 	fmt <= self lastPointerFormat ifTrue:
+ 		[fmt >= self indexablePointersFormat ifTrue:
+ 			[fmt = self lastPointerFormat ifTrue:
- 	fmt <= 4 ifTrue:
- 		[fmt >= 3 ifTrue:
- 			[fmt = 4 ifTrue:
  				[(recordWeakRoot and: [weakRootCount >= 0]) ifTrue:
  					["And remember as weak root"
  					 (weakRootCount := weakRootCount + 1) <= WeakRootTableSize ifFalse:
  						[self error: 'weakRoots table overflow'].
  					 weakRoots at: weakRootCount put: oop].
  				"Do not trace the object's indexed fields if it's a weak class"
  				numFields := self nonWeakFieldsOf: oop. "so nonWeakFieldsOf: may be inlined"
  				^numFields * BytesPerWord].
  			"So fmt is 3"
  			(self isContextHeader: header) ifTrue:
  				[coInterpreter setTraceFlagOnContextsFramesPageIfNeeded: oop.
  				 "contexts end at the stack pointer avoiding having to init fields beyond it"
  				 contextSize := coInterpreter fetchStackPointerOf: oop.
  				 self assert: ReceiverIndex + contextSize < (self lengthOf: oop baseHeader: header format: fmt).
  				 ^CtxtTempFrameStart + contextSize * BytesPerOop]].
  		 sz := self sizeBitsOfSafe: oop.
  		 ^sz - BaseHeaderSize  "all pointers" ].
+ 	fmt < self firstCompiledMethodFormat ifTrue: [^0]. "no pointers"
- 	fmt < 12 ifTrue: [^0]. "no pointers"
  
  	"CompiledMethod: contains both pointers and bytes"
  	numFields := coInterpreter literalCountOf: oop. "so literalCountOf: may be inlined"
  	^numFields + LiteralStart * BytesPerOop!

Item was changed:
  ----- Method: NewObjectMemory>>lastPointerWhileForwarding: (in category 'gc -- compaction') -----
  lastPointerWhileForwarding: oop 
  	"The given object may have its header word in a forwarding block. Find  
  	 the offset of the last pointer in the object in spite of this obstacle."
  	| header fmt size contextSize numLiterals |
  	<inline: true>
  	header := self headerWhileForwardingOf: oop.
  	fmt := self formatOfHeader: header.
+ 	fmt <= self lastPointerFormat ifTrue:
+ 		[(fmt = self indexablePointersFormat
- 	fmt <= 4 ifTrue:
- 		[(fmt = 3
  		  and: [self isContextHeader: header]) ifTrue:
  			["contexts end at the stack pointer"
  			 contextSize := coInterpreter nacFetchStackPointerOf: oop.
  			 self assert: ReceiverIndex + contextSize < (self lengthOf: oop baseHeader: header format: fmt).
  			 ^CtxtTempFrameStart + contextSize * BytesPerOop].
  		 "do sizeBitsOf: using the header we obtained"
  		 size := (header bitAnd: TypeMask) = HeaderTypeSizeAndClass
  					ifTrue: [(self sizeHeader: oop) bitAnd: AllButTypeMask]
  					ifFalse: [header bitAnd: SizeMask].
  		 ^size - BaseHeaderSize].
+ 	fmt < self firstCompiledMethodFormat ifTrue: [^0]. "no pointers"
- 	fmt < 12 ifTrue: [^0]. "no pointers"
  	"CompiledMethod: contains both pointers and bytes"
  	self assert: (header bitAnd: MarkBit) = 0.
  	numLiterals := coInterpreter literalCountOf: oop.
  	^numLiterals + LiteralStart * BytesPerOop!

Item was changed:
  ----- Method: NewObjectMemory>>validate: (in category 'simulation') -----
  validate: oop
  	<doNotGenerate>
  	| header type cc sz fmt nextChunk | 
  	header := self longAt: oop.
  	type := header bitAnd: 3.
  	type = 2 ifFalse: [type = (self rightType: header) ifFalse: [self halt]].
  	sz := (header bitAnd: SizeMask) >> 2.
  	nextChunk := oop + ((self isFreeObject: oop)
  							ifTrue: [self sizeOfFree: oop]
  							ifFalse: [self sizeBitsOf: oop]).
  	nextChunk > freeStart ifTrue:
  		[oop = freeStart ifFalse: [self halt]].
  	(self headerType: nextChunk) = 0 ifTrue:
  		[(self headerType: (nextChunk + (BytesPerWord*2))) = 0 ifFalse: [self halt]].
  	(self headerType: nextChunk) = 1 ifTrue:
  		[(self headerType: (nextChunk + BytesPerWord)) = 1 ifFalse: [self halt]].
  	type = 2 ifTrue:
  		["free block" ^ self].
  	fmt := self formatOfHeader: header.
  	cc := self compactClassIndexOfHeader: header.
  	cc > 16 ifTrue: [self halt].	"up to 32 are legal, but not used"
  	type = 0 ifTrue:
  		["three-word header"
  		((self longAt: oop-BytesPerWord) bitAnd: 3) = type ifFalse: [self halt].
  		((self longAt: oop-(BytesPerWord*2)) bitAnd: 3) = type ifFalse: [self halt].
  		((self longAt: oop-BytesPerWord) = type) ifTrue: [self halt].	"Class word is 0"
  		sz = 0 ifFalse: [self halt]].
  	type = 1 ifTrue:
  		["two-word header"
  		((self longAt: oop-BytesPerWord) bitAnd: 3) = type ifFalse: [self halt].
  		cc > 0 ifTrue: [sz = 1 ifFalse: [self halt]].
  		sz = 0 ifTrue: [self halt]].
  	type = 3 ifTrue:
  		["one-word header"
  		cc = 0 ifTrue: [self halt]].
  	fmt = 5 ifTrue: [self halt].
  	fmt = 7 ifTrue: [self halt].
+ 	fmt >= self firstCompiledMethodFormat ifTrue: "must have integer header"
+ 		[(self isIntegerObject: (self longAt: oop + BytesPerWord)) ifFalse: [self halt]].!
- 	fmt >= 12 ifTrue:
- 		["CompiledMethod -- check for integer header"
- 		(self isIntegerObject: (self longAt: oop + BytesPerWord)) ifFalse: [self halt]].!

Item was changed:
  ----- Method: NewObjectMemory>>wordSwapFloatsFrom:to: (in category 'image segment in/out') -----
  wordSwapFloatsFrom: startOop to: stopAddr
  	"Swap the most and least significant words of Floats in a range of the image."
  	| oop temp |
  	oop := startOop.
  	[self oop: oop isLessThan: stopAddr] whileTrue:
  		[(self isFreeObject: oop) ifFalse:
+ 			[((self formatOf: oop) = self firstLongFormat
- 			[((self formatOf: oop) = 6
  			 and: [(self compactClassIndexOf: oop) = ClassFloatCompactIndex]) ifTrue:
  				[temp := self longAt: oop + BaseHeaderSize.
  				 self longAt: oop + BaseHeaderSize put: (self longAt: oop + BaseHeaderSize + 4).
  				 self longAt: oop + BaseHeaderSize + 4 put: temp]].
  		oop := self objectAfter: oop]!

Item was changed:
  ----- Method: NewObjectMemorySimulator>>firstIndexableField: (in category 'simulation only') -----
  firstIndexableField: oop
  	"NOTE: overridden from ObjectMemory to add coercion to CArray, so please duplicate any changes"
  	| hdr fmt totalLength fixedFields |
  	<returnTypeC: #'void *'>
  	hdr := self baseHeader: oop.
  	fmt := self formatOfHeader: hdr.
+ 	fmt <= self lastPointerFormat ifTrue:
- 	fmt <= 4 ifTrue: "<= 4 pointer"
  		["pointer; may need to delve into the class format word"
  		totalLength := self lengthOf: oop baseHeader: hdr format: fmt.
  		fixedFields := self fixedFieldsOf: oop format: fmt length: totalLength.
  		^self cCoerce: (self pointerForOop: oop + BaseHeaderSize + (fixedFields << ShiftForWord)) to: 'oop *'].
  	^self
  		cCoerce: (self pointerForOop: oop + BaseHeaderSize)
+ 		to: (fmt < self firstByteFormat
+ 				ifTrue: [fmt = self firstLongFormat
- 		to: (fmt < 8
- 				ifTrue: [fmt = 6
  						ifTrue: ["32 bit field objects" 'int *']
  						ifFalse: ["full word objects (bits)" 'oop *']]
  				ifFalse: ["byte objects (including CompiledMethod" 'char *'])!

Item was changed:
  ----- Method: NewObjectMemorySimulator>>storePointer:ofObject:withValue: (in category 'interpreter access') -----
  storePointer: index ofObject: oop withValue: valuePointer
  	"Override to ensure acess is within the heap, and within the object"
  	| fmt hdr |
  	self assert: oop >= self startOfMemory.
  	hdr := self baseHeader: oop.
  	fmt := self formatOfHeader: hdr.
+ 	self assert: ((fmt <= self lastPointerFormat or: [fmt >= self firstCompiledMethodFormat])
- 	self assert: ((fmt <= 4 or: [fmt >= 12])
  				and: [index >= 0 and: [index < (self lengthOf: oop baseHeader: hdr format: fmt)]]).
  	^super storePointer: index ofObject: oop withValue: valuePointer!

Item was changed:
  ----- Method: NewObjectMemorySimulator>>storePointerUnchecked:ofObject:withValue: (in category 'interpreter access') -----
  storePointerUnchecked: index ofObject: oop withValue: valuePointer
  	"Override to ensure acess is within the heap, and within the object"
  	| fmt hdr |
  	self assert: oop >= self startOfMemory.
  	hdr := self baseHeader: oop.
  	fmt := self formatOfHeader: hdr.
+ 	self assert: ((fmt <= self lastPointerFormat or: [fmt >= self firstCompiledMethodFormat])
- 	self assert: ((fmt <= 4 or: [fmt >= 12])
  				and: [index >= 0 and: [index < (self lengthOf: oop baseHeader: hdr format: fmt)]]).
  	^super storePointerUnchecked: index ofObject: oop withValue: valuePointer!

Item was changed:
  ----- Method: ObjectMemory>>allocate:headerSize:h1:h2:h3:doFill:format: (in category 'allocation') -----
  allocate: byteSize headerSize: hdrSize h1: baseHeader h2: classOop h3: extendedSize doFill: doFill format: format
  	"Allocate a new object of the given size and number of header words. (Note: byteSize already includes space for the base header word.) Initialize the header fields of the new object and fill the remainder of the object with a value appropriate for the format.
  	May cause a GC"
  
  	| newObj remappedClassOop |
  	<inline: true>
  	<var: #i type: 'usqInt'>
  	<var: #end type: 'usqInt'>
  	"remap classOop in case GC happens during allocation"
  	hdrSize > 1 ifTrue: [self pushRemappableOop: classOop].
  	newObj := self allocateChunk: byteSize + (hdrSize - 1 * BytesPerWord).
  	hdrSize > 1 ifTrue: [remappedClassOop := self popRemappableOop].
  
  	hdrSize = 3
  		ifTrue: [self longAt: newObj put: (extendedSize bitOr: HeaderTypeSizeAndClass).
  			self longAt: newObj + BytesPerWord put: (remappedClassOop bitOr: HeaderTypeSizeAndClass).
  			self longAt: newObj + (BytesPerWord*2) put: (baseHeader bitOr: HeaderTypeSizeAndClass).
  			newObj := newObj + (BytesPerWord*2)].
  
  	hdrSize = 2
  		ifTrue: [self longAt: newObj put: (remappedClassOop bitOr: HeaderTypeClass).
  			self longAt: newObj + BytesPerWord put: (baseHeader bitOr: HeaderTypeClass).
  			newObj := newObj + BytesPerWord].
  
  	hdrSize = 1
  		ifTrue: [self longAt: newObj put: (baseHeader bitOr: HeaderTypeShort)].
  	"clear new object"
  	doFill ifTrue:
  		[| fillWord end i |
+ 		 fillWord := format <= self lastPointerFormat
- 		 fillWord := format <= 4
  					ifTrue: [nilObj] "if pointers, fill with nil oop"
  					ifFalse: [0].
  		 end := newObj + byteSize.
  		 i := newObj + BytesPerWord.
  		 [i < end] whileTrue:
  			[self longAt: i put: fillWord.
  			 i := i + BytesPerWord]].
  	DoAssertionChecks
  		ifTrue: [self okayOop: newObj.
  			self oopHasOkayClass: newObj.
  			(self objectAfter: newObj) = freeBlock
  				ifFalse: [self error: 'allocate bug: did not set header of new oop correctly'].
  			(self objectAfter: freeBlock) = endOfMemory
  				ifFalse: [self error: 'allocate bug: did not set header of freeBlock correctly']].
  
  	^newObj!

Item was added:
+ ----- Method: ObjectMemory>>arrayFormat (in category 'header access') -----
+ arrayFormat
+ 	^2!

Item was added:
+ ----- Method: ObjectMemory>>baseHeaderSize (in category 'interpreter access') -----
+ baseHeaderSize
+ 	^BaseHeaderSize!

Item was added:
+ ----- Method: ObjectMemory>>byteFormatMask (in category 'header access') -----
+ byteFormatMask
+ 	^16rC!

Item was changed:
  ----- Method: ObjectMemory>>byteLengthOf: (in category 'indexing primitive support') -----
  byteLengthOf: obj
  	"Return the number of indexable bytes in the given object.
  	 This is basically a special copy of lengthOf: for BitBlt. But it is also
  	 whoorishly used for the Cogit."
  	<api>
  	| header sz fmt |
  	header := self baseHeader: obj.
  	sz := (header bitAnd: TypeMask) = HeaderTypeSizeAndClass
  			ifTrue: [(self sizeHeader: obj) bitAnd: AllButTypeMask]
  			ifFalse: [header bitAnd: SizeMask].
  	fmt := self formatOfHeader: header.
+ 	^fmt < self firstByteFormat
- 	^fmt < 8
  		ifTrue: [(sz - BaseHeaderSize)]  "words"
  		ifFalse: [(sz - BaseHeaderSize) - (fmt bitAnd: 3)]  "bytes"!

Item was changed:
  ----- Method: ObjectMemory>>byteSizeOf: (in category 'object format') -----
  byteSizeOf: oop
  	<api>
  	| header format size |
  	(self isIntegerObject: oop) ifTrue:[^0].
  	header := self baseHeader: oop.
  	format := self formatOfHeader: header.
  	size := (header bitAnd: TypeMask) = HeaderTypeSizeAndClass
  				ifTrue: [(self sizeHeader: oop) bitAnd: LongSizeMask]
  				ifFalse: [header bitAnd: SizeMask].
  	size := size - (header bitAnd: Size4Bit).
+ 	^format < self firstByteFormat
- 	^format < 8
  		ifTrue: [ size - BaseHeaderSize "32-bit longs"]
  		ifFalse: [ (size - BaseHeaderSize) - (format bitAnd: 3) "bytes"]!

Item was changed:
  ----- Method: ObjectMemory>>byteSwapByteObjectsFrom:to:flipFloatsIf: (in category 'image segment in/out') -----
  byteSwapByteObjectsFrom: startOop to: stopAddr flipFloatsIf: flipFloatWords
  	"Byte-swap the words of all bytes objects in a range of the 
  	image, including Strings, ByteArrays, and CompiledMethods. 
  	This returns these objects to their original byte ordering 
  	after blindly byte-swapping the entire image. For compiled 
  	methods, byte-swap only their bytecodes part.  For Floats
  	swap their most and least significant words if required."
  	| oop fmt temp wordAddr |
  	oop := startOop.
  	[self oop: oop isLessThan: stopAddr] whileTrue:
  		[(self isFreeObject: oop) ifFalse:
  			[fmt := self formatOf: oop.
+ 			fmt >= self firstByteFormat ifTrue:
- 			fmt >= 8 ifTrue:
  				["oop contains bytes; unswap"
  				wordAddr := oop + BaseHeaderSize.
+ 				fmt >= self firstCompiledMethodFormat ifTrue: "compiled method; start after methodHeader and literals"
- 				fmt >= 12 ifTrue: "compiled method; start after methodHeader and literals"
  					[wordAddr := wordAddr + ((self literalCountOf: oop) + LiteralStart * BytesPerOop)].
  				self reverseBytesFrom: wordAddr to: oop + (self sizeBitsOf: oop)].
+ 			fmt = self firstLongFormat  ifTrue: "Bitmap, Float etc"
- 			fmt = 6  ifTrue: "Bitmap, Float etc"
  				[(self compactClassIndexOf: oop) = ClassFloatCompactIndex
  					ifTrue:
  						[flipFloatWords ifTrue:
  							[temp := self longAt: oop + BaseHeaderSize.
  							 self longAt: oop + BaseHeaderSize put: (self longAt: oop + BaseHeaderSize + 4).
  							 self longAt: oop + BaseHeaderSize + 4 put: temp]]
  					ifFalse:
  						[BytesPerWord = 8 ifTrue:
  							["Object contains 32-bit half-words packed into 64-bit machine words."
  							wordAddr := oop + BaseHeaderSize.
  							self reverseWordsFrom: wordAddr to: oop + (self sizeBitsOf: oop)]]]].
  			oop := self objectAfter: oop]!

Item was changed:
  ----- Method: ObjectMemory>>changeClassOf:to: (in category 'interpreter access') -----
  changeClassOf: rcvr to: argClass
  	"Attempt to change the class of the receiver to the argument given that the
  	 format of the receiver matches the format of the argument.  If successful,
  	 answer 0, otherwise answer an error code indicating the reason for failure. 
  	 Fail if the receiver is an instance of a compact class and the argument isn't,
  	 or if the format of the receiver is incompatible with the format of the argument,
  	 or if the argument is a fixed class and the receiver's size differs from the size
  	 that an instance of the argument should have."
  	| classHdr sizeHiBits argClassInstByteSize argFormat rcvrFormat rcvrHdr ccIndex |
  	"Check what the format of the class says"
  	classHdr := self formatOfClass: argClass. "Low 2 bits are 0"
  
  	"Compute the size of instances of the class (used for fixed field classes only)"
  	sizeHiBits := (classHdr bitAnd: 16r60000) >> 9.
  	classHdr := classHdr bitAnd: 16r1FFFF.
  	argClassInstByteSize := (classHdr bitAnd: SizeMask) + sizeHiBits. "size in bytes -- low 2 bits are 0"
  
  	"Check the receiver's format against that of the class"
  	argFormat := self formatOfHeader: classHdr.
  	rcvrHdr := self baseHeader: rcvr.
  	rcvrFormat := self formatOfHeader: rcvrHdr.
  	"If the receiver is a byte object we need to clear the number of odd bytes from the format."
+ 	rcvrFormat > self firstByteFormat ifTrue:
- 	rcvrFormat > 8 ifTrue:
  		[rcvrFormat := rcvrFormat bitAnd: 16rC].
  	argFormat = rcvrFormat ifFalse:
  		[^PrimErrInappropriate]. "no way"
  
  	"For fixed field classes, the sizes must match.
  	Note: argClassInstByteSize-4 because base header is included in class size."
+ 	argFormat < self arrayFormat
- 	argFormat < 2
  		ifTrue:
  			[(argClassInstByteSize - BaseHeaderSize) ~= (self byteLengthOf: rcvr) ifTrue:
  				[^PrimErrBadReceiver]]
  		ifFalse:
+ 			[argFormat = self indexablePointersFormat ifTrue: "For indexable plus fixed fields the receiver must be at least big enough."
- 			[argFormat = 3 ifTrue: "For indexable plus fixed fields the receiver must be at least big enough."
  				[(argClassInstByteSize - BaseHeaderSize) > (self byteLengthOf: rcvr) ifTrue:
  					[^PrimErrBadReceiver]]].
  
  	(self headerTypeOfHeader: rcvrHdr) = HeaderTypeShort
  		ifTrue: "Compact classes. Check if the arg's class is compact and exchange ccIndex"
  			[ccIndex := classHdr bitAnd: CompactClassMask.
  			ccIndex = 0 ifTrue:
  				[^PrimErrInappropriate]. "class is not compact"
  			self cppIf: IMMUTABILITY
  				ifTrue: [(rcvrHdr bitAnd: ImmutabilityBit) ~= 0 ifTrue:
  							[^PrimErrNoModification]].
  			self baseHeader: rcvr put: ((rcvrHdr bitClear: CompactClassMask) bitOr: ccIndex)]
  		ifFalse: "Exchange the class pointer, which could make rcvr a root for argClass"
  			[self cppIf: IMMUTABILITY
  				ifTrue: [(rcvrHdr bitAnd: ImmutabilityBit) ~= 0 ifTrue:
  							[^PrimErrNoModification]].
  			"N.B. the recursive scan-mark algorithm uses the header word's size and compact class
  			 fields to determine the header type when it reuses the header type bits for the mark
  			 state.  So it is alas an invariant that non-compact headers have a 0 compact class field."
  			(self compactClassIndexOfHeader: rcvrHdr) ~= 0 ifTrue:
  				[self baseHeader: rcvr put: (rcvrHdr bitClear: CompactClassMask)].			
  			self longAt: rcvr - BaseHeaderSize put: (argClass bitOr: (self headerTypeOfHeader: rcvrHdr)).
  			(self oop: rcvr isLessThan: youngStart) ifTrue:
  				[self possibleRootStoreInto: rcvr value: argClass]].
  	"ok"
  	^0!

Item was changed:
  ----- Method: ObjectMemory>>checkHeapIntegrity (in category 'memory access') -----
  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 obj sz hdr fmt fi fieldOop numRootsInHeap |
  	<inline: false>
  	ok := true.
  	numRootsInHeap := 0.
  	obj := self firstObject.
  	[self oop: obj isLessThan: self startOfFreeSpace] whileTrue:
  		[(self isFreeObject: obj)
  			ifTrue:
  				[sz := self sizeOfFree: obj]
  			ifFalse:
  				[hdr := self baseHeader: obj.
  				 (self isYoungRootHeader: hdr) ifTrue:
  					[numRootsInHeap := numRootsInHeap + 1].
  				 (self compactClassIndexOfHeader: hdr) = 0 ifTrue:
  					[fieldOop := (self classHeader: obj) bitAnd: AllButTypeMask.
  					 ((self isIntegerObject: fieldOop)
  					   or: [(self heapMapAtWord: (self pointerForOop: fieldOop)) = 0]) ifTrue:
  						[self print: 'object leak in '; printHex: obj; print: ' class = '; printHex: fieldOop; cr.
  						 ok := false]].
  				 fmt := self formatOfHeader: hdr.
+ 				 (fmt <= self lastPointerFormat or: [fmt >= self firstCompiledMethodFormat]) ifTrue:
+ 					[fmt >= self firstCompiledMethodFormat
- 				 (fmt <= 4 "pointers" or: [fmt >= 12 "compiled method"]) ifTrue:
- 					[fmt >= 12
  						ifTrue: [fi := (self literalCountOf: obj) + LiteralStart]
+ 						ifFalse: [(fmt = self indexablePointersFormat and: [self isContextHeader: hdr])
- 						ifFalse: [(fmt = 3 and: [self isContextHeader: hdr])
  									ifTrue: [fi := CtxtTempFrameStart + (self fetchStackPointerOf: obj)]
  									ifFalse: [fi := self lengthOf: obj]].
  					[(fi := fi - 1) >= 0] whileTrue:
  						[fieldOop := self fetchPointer: fi ofObject: obj.
  						 (self isNonIntegerObject: fieldOop) ifTrue:
  							[(fieldOop bitAnd: BytesPerWord - 1) ~= 0
  								ifTrue:
  									[self print: 'misaligned oop in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; cr.
  									 ok := false]
  								ifFalse:
  									[(self heapMapAtWord: (self pointerForOop: fieldOop)) = 0 ifTrue:
  										[self print: 'object leak in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; cr.
  										 ok := false]]]]].
  				 sz := self sizeBitsOf: obj].
  		 obj := self oopFromChunk: obj + sz].
  	numRootsInHeap ~= rootTableCount ifTrue:
  		[self print: 'root count mismatch. #heap roots '; printNum: numRootsInHeap; print: '; #roots '; printNum: rootTableCount; cr.
  		"But the system copes with overflow..."
  		ok := rootTableOverflowed and: [allocationCount > allocationsBetweenGCs]].
  	1 to: rootTableCount do:
  		[:ri|
  		obj := rootTable at: ri.
  		(obj bitAnd: BytesPerWord - 1) ~= 0
  			ifTrue:
  				[self print: 'misaligned oop in rootTable @ '; printNum: ri; print: ' = '; printHex: obj; cr.
  				 ok := false]
  			ifFalse:
  				[(self heapMapAtWord: (self pointerForOop: obj)) = 0
  					ifTrue:
  						[self print: 'object leak in rootTable @ '; printNum: ri; print: ' = '; printHex: obj; cr.
  						 ok := false]
  					ifFalse:
  						[hdr := self baseHeader: obj.
  						 (self isYoungRootHeader: hdr) ifFalse:
  							[self print: 'non-root in rootTable @ '; printNum: ri; print: ' = '; printHex: obj; cr.
  							 ok := false]]]].
  	1 to: remapBufferCount do:
  		[:ri|
  		obj := remapBuffer at: ri.
  		(obj bitAnd: BytesPerWord - 1) ~= 0
  			ifTrue:
  				[self print: 'misaligned remapRoot @ '; printNum: ri; print: ' = '; printHex: obj; cr.
  				 ok := false]
  			ifFalse:
  				[(self heapMapAtWord: (self pointerForOop: obj)) = 0
  					ifTrue:
  						[self print: 'object leak in remapRoots @ '; printNum: ri; print: ' = '; printHex: obj; cr.
  						 ok := false]]].
  	1 to: extraRootCount do:
  		[:ri|
  		obj := (extraRoots at: ri) at: 0.
  		(obj bitAnd: BytesPerWord - 1) ~= 0
  			ifTrue:
  				[self print: 'misaligned extraRoot @ '; printNum: ri; print: ' => '; printHex: obj; cr.
  				 ok := false]
  			ifFalse:
  				[(self heapMapAtWord: (self pointerForOop: obj)) = 0
  					ifTrue:
  						[self print: 'object leak in extraRoots @ '; printNum: ri; print: ' => '; printHex: obj; cr.
  						 ok := false]]].
  	^ok!

Item was changed:
  ----- Method: ObjectMemory>>firstIndexableField: (in category 'object format') -----
  firstIndexableField: oop
  	"NOTE: overridden in various simulator subclasses to add coercion to CArray, so please duplicate any changes"
  	| hdr fmt totalLength fixedFields |
  	<returnTypeC: #'void *'>
  	hdr := self baseHeader: oop.
  	fmt := self formatOfHeader: hdr.
+ 	fmt <= self lastPointerFormat ifTrue:
- 	fmt <= 4 ifTrue: "<= 4 pointer"
  		["pointer; may need to delve into the class format word"
  		totalLength := self lengthOf: oop baseHeader: hdr format: fmt.
  		fixedFields := self fixedFieldsOf: oop format: fmt length: totalLength.
  		^self pointerForOop: oop + BaseHeaderSize + (fixedFields << ShiftForWord)].
  	^self pointerForOop: oop + BaseHeaderSize!

Item was added:
+ ----- Method: ObjectMemory>>firstLongFormat (in category 'header access') -----
+ firstLongFormat
+ 	^6!

Item was changed:
  ----- Method: ObjectMemory>>fixedFieldsOf:format:length: (in category 'object format') -----
  fixedFieldsOf: oop format: fmt length: wordLength
  "
  	NOTE: This code supports the backward-compatible extension to 8 bits of instSize.
  	When we revise the image format, it should become...
  	^ (classFormat >> 2 bitAnd: 16rFF) - 1
  "
  	| class classFormat |
  	<inline: true>
  	<asmLabel: false>
+ 	((fmt > self lastPointerFormat) or: [fmt = self arrayFormat]) ifTrue: [^0].  "indexable fields only"
- 	((fmt > 4) or: [fmt = 2]) ifTrue: [^0].  "indexable fields only"
  	fmt < 2 ifTrue: [^wordLength].  "fixed fields only (zero or more)"
  	
  	"fmt = 3 or 4: mixture of fixed and indexable fields, so must look at class format word"
  	class := self fetchClassOfNonImm: oop.
  	classFormat := self formatOfClass: class.
  	^(classFormat >> 11 bitAnd: 16rC0) + (classFormat >> 2 bitAnd: 16r3F) - 1!

Item was changed:
  ----- Method: ObjectMemory>>formatOf: (in category 'header access') -----
  formatOf: oop
  "       0      no fields
          1      fixed fields only (all containing pointers)
          2      indexable fields only (all containing pointers)
          3      both fixed and indexable fields (all containing pointers)
          4      both fixed and indexable weak fields (all containing pointers).
  
          5      unused (reserved for ephemerons?)
          6      indexable word fields only (no pointers)
          7      indexable long (64-bit) fields (only in 64-bit images)
   
      8-11      indexable byte fields only (no pointers) (low 2 bits are low 2 bits of size)
     12-15     compiled methods:
                     # of literal oops specified in method header,
                     followed by indexable bytes (same interpretation of low 2 bits as above)
  "
  	<inline: true>
+ 	^((self baseHeader: oop) >> self instFormatFieldLSB) bitAnd: 16rF!
- 	^((self baseHeader: oop) >> 8) bitAnd: 16rF!

Item was changed:
  ----- Method: ObjectMemory>>formatOfHeader: (in category 'header access') -----
  formatOfHeader: header
  "       0      no fields
          1      fixed fields only (all containing pointers)
          2      indexable fields only (all containing pointers)
          3      both fixed and indexable fields (all containing pointers)
          4      both fixed and indexable weak fields (all containing pointers).
  
          5      unused
          6      indexable word fields only (no pointers)
          7      indexable long (64-bit) fields (only in 64-bit images)
   
      8-11      indexable byte fields only (no pointers) (low 2 bits are low 2 bits of size)
     12-15     compiled methods:
                     # of literal oops specified in method header,
                     followed by indexable bytes (same interpretation of low 2 bits as above)
  "
  	<inline: true>
+ 	^header >> self instFormatFieldLSB bitAnd: 16rF!
- 	^header >> 8 bitAnd: 16rF!

Item was changed:
  ----- Method: ObjectMemory>>instantiateClass:indexableSize: (in category 'interpreter access') -----
+ instantiateClass: classPointer indexableSize: size
- instantiateClass: classPointer indexableSize: size 
  	"NOTE: This method supports the backward-compatible split instSize field of the 
  	class format word. The sizeHiBits will go away and other shifts change by 2 
  	when the split fields get merged in an (incompatible) image change."
  	<api>
  	| hash header1 header2 cClass byteSize format binc header3 hdrSize sizeHiBits bm1 classFormat |
  	<inline: false>
  	self assert: size >= 0. "'cannot have a negative indexable field count"
  	hash := self newObjectHash.
  	classFormat := self formatOfClass: classPointer.
  	"Low 2 bits are 0"
  	header1 := (classFormat bitAnd: 16r1FF00) bitOr: (hash bitAnd: HashMaskUnshifted) << HashBitsOffset.
  	header2 := classPointer.
  	sizeHiBits := (classFormat bitAnd: 16r60000) >> 9.
  	cClass := header1 bitAnd: CompactClassMask. "compact class field from format word"
  	byteSize := (classFormat bitAnd: SizeMask + Size4Bit) + sizeHiBits.
  		"size in bytes -- low 2 bits are 0"
  	"Note this byteSize comes from the format word of the class which is pre-shifted
  		to 4 bytes per field.  Need another shift for 8 bytes per word..."
  	byteSize := byteSize << (ShiftForWord-2).
  	format := self formatOfHeader: classFormat.
  	self flag: #sizeLowBits.
+ 	format < self firstByteFormat
- 	format < 8
  		ifTrue:
+ 			[format = self firstLongFormat
+ 				ifTrue: "long32 bitmaps"
+ 					[bm1 := BytesPerWord-1.
- 			[format = 6
- 				ifTrue: ["long32 bitmaps"
- 					bm1 := BytesPerWord-1.
  					byteSize := byteSize + (size * 4) + bm1 bitAnd: LongSizeMask. "round up"
  					binc := bm1 - ((size * 4) + bm1 bitAnd: bm1). "odd bytes"
  					"extra low bit (4) for 64-bit VM goes in 4-bit (betw hdr bits and sizeBits)"
  					header1 := header1 bitOr: (binc bitAnd: 4)]
+ 				ifFalse: "Arrays and 64-bit bitmaps"
+ 					[byteSize := byteSize + (size * BytesPerWord)]]
- 				ifFalse: [byteSize := byteSize + (size * BytesPerWord) "Arrays and 64-bit bitmaps"]]
  		ifFalse:
  			["Strings and Methods"
  			bm1 := BytesPerWord-1.
  			byteSize := byteSize + size + bm1 bitAnd: LongSizeMask. "round up"
  			binc := bm1 - (size + bm1 bitAnd: bm1). "odd bytes"
  			"low bits of byte size go in format field"
+ 			header1 := header1 bitOr: (binc bitAnd: 3) << self instFormatFieldLSB.
- 			header1 := header1 bitOr: (binc bitAnd: 3) << 8.
  			"extra low bit (4) for 64-bit VM goes in 4-bit (betw hdr bits and sizeBits)"
  			header1 := header1 bitOr: (binc bitAnd: 4)].
  	byteSize > 255 "requires size header word/full header"
  		ifTrue: [header3 := byteSize. hdrSize := 3]
  		ifFalse: [header1 := header1 bitOr: byteSize. hdrSize := cClass = 0 ifTrue: [2] ifFalse: [1]].
  	^self allocate: byteSize headerSize: hdrSize h1: header1 h2: header2 h3: header3 doFill: true format: format!

Item was changed:
  ----- Method: ObjectMemory>>isBytesNonInt: (in category 'header access') -----
  isBytesNonInt: oop
  	"Answer true if the argument contains indexable bytes. See comment in formatOf:"
  	"Note: Includes CompiledMethods."
  
+ 	^(self formatOf: oop)  >= self firstByteFormat!
- 	^ (self formatOf: oop)  >= 8!

Item was changed:
  ----- Method: ObjectMemory>>isCompiledMethod: (in category 'interpreter access') -----
  isCompiledMethod: oop
      "Answer whether the argument object is of compiled method format"
  	<api>
+     ^(self formatOf: oop) >= self firstCompiledMethodFormat!
-     ^(self formatOf: oop) >= 12!

Item was changed:
  ----- Method: ObjectMemory>>isCompiledMethodHeader: (in category 'interpreter access') -----
  isCompiledMethodHeader: objHeader
      "Answer whether the argument header has compiled method format"
+     ^(self formatOfHeader: objHeader) >= self firstCompiledMethodFormat!
-     ^(self formatOfHeader: objHeader) >= 12!

Item was changed:
  ----- Method: ObjectMemory>>isContextHeader: (in category 'contexts') -----
  isContextHeader: aHeader
  	<inline: true>
  	"c.f. {BlockContext. MethodContext. PseudoContext} collect: [:class| class -> class indexIfCompact]"
+ 	^(self compactClassIndexOf: aHeader) = 13			"BlockContext"
+ 		or: [(self compactClassIndexOf: aHeader) = 14]		"MethodContext"!
- 	^ ((aHeader >> 12) bitAnd: 16r1F) = 13			"BlockContext"
- 		or: [((aHeader >> 12) bitAnd: 16r1F) = 14]	"MethodContext"!

Item was changed:
  ----- Method: ObjectMemory>>isOopCompiledMethod: (in category 'interpreter access') -----
  isOopCompiledMethod: oop
+ 	"Answer whether the oop is an object of compiled method format"
-     "Answer whether the oop is an object of compiled method format"
  	<api>
+ 	^(self isNonIntegerObject: oop)
+ 	 and: [(self formatOf: oop) >= self firstCompiledMethodFormat]!
-     ^(self isNonIntegerObject: oop) and: [(self formatOf: oop) >= 12]!

Item was changed:
  ----- Method: ObjectMemory>>isPointersNonInt: (in category 'header access') -----
  isPointersNonInt: oop
+ 	"Answer if the argument has only fields that can hold oops. See comment in formatOf:"
- 	"Answer true if the argument has only fields that can hold oops. See comment in formatOf:"
  
+ 	^(self formatOf: oop) <= self lastPointerFormat!
- 	^ (self formatOf: oop) <= 4!

Item was changed:
  ----- Method: ObjectMemory>>isWeakNonInt: (in category 'header access') -----
  isWeakNonInt: oop
+ 	"Answer if the argument has only weak fields that can hold oops. See comment in formatOf:"
+ 	^(self formatOf: oop) = self lastPointerFormat!
- 	"Answer true if the argument has only weak fields that can hold oops. See comment in formatOf:"
- 	^ (self formatOf: oop) = 4!

Item was changed:
  ----- Method: ObjectMemory>>isWordsNonInt: (in category 'header access') -----
  isWordsNonInt: oop
  	"Answer true if the argument contains only indexable words (no oops). See comment in formatOf:"
  
+ 	^ (self formatOf: oop) = self firstLongFormat!
- 	^ (self formatOf: oop) = 6!

Item was changed:
  ----- Method: ObjectMemory>>isWordsOrBytesNonInt: (in category 'header access') -----
  isWordsOrBytesNonInt: oop
  	"Answer true if the contains only indexable words or bytes (no oops). See comment in formatOf:"
  	"Note: Excludes CompiledMethods."
  
  	| fmt |
  	fmt := self formatOf: oop.
+ 	^fmt = self firstLongFormat
+ 	  or: [fmt >= self firstByteFormat
+ 		  and: [fmt < self firstCompiledMethodFormat]]!
- 	^ fmt = 6 or: [(fmt >= 8) and: [fmt <= 11]]!

Item was changed:
  ----- Method: ObjectMemory>>lastPointerFormat (in category 'header access') -----
  lastPointerFormat
+ 	"N.B. 5 is unused and could be used for ephemerons.
+ 		7 is unused and could be used for 64-bit indexable."
+ 	^4!
- 	^5!

Item was changed:
  ----- Method: ObjectMemory>>lastPointerOf: (in category 'object enumeration') -----
  lastPointerOf: oop 
  	"Return the byte offset of the last pointer field of the given object.  
  	Works with CompiledMethods, as well as ordinary objects. 
  	Can be used even when the type bits are not correct."
  	<api>
  	<inline: true>
  	<asmLabel: false>
  	| fmt sz methodHeader header contextSize |
  	header := self baseHeader: oop.
  	fmt := self formatOfHeader: header.
+ 	fmt <= self lastPointerFormat ifTrue:
+ 		[(fmt = self indexablePointersFormat
+ 		  and: [self isContextHeader: header])
- 	fmt <= 4 ifTrue: [(fmt = 3 and: [self isContextHeader: header])
  					ifTrue: ["contexts end at the stack pointer"
  						contextSize := self fetchStackPointerOf: oop.
  						^ CtxtTempFrameStart + contextSize * BytesPerWord].
  				sz := self sizeBitsOfSafe: oop.
+ 				^sz - BaseHeaderSize "all pointers"].
+ 	fmt < self firstCompiledMethodFormat ifTrue: [^ 0]. "no pointers"
- 				^ sz - BaseHeaderSize  "all pointers"].
- 	fmt < 12 ifTrue: [^ 0]. "no pointers"
  
  	"CompiledMethod: contains both pointers and bytes:"
  	methodHeader := self longAt: oop + BaseHeaderSize.
+ 	^(methodHeader >> 10 bitAnd: 255) + LiteralStart * BytesPerWord!
- 	^ (methodHeader >> 10 bitAnd: 255) + LiteralStart * BytesPerWord!

Item was changed:
  ----- Method: ObjectMemory>>lastPointerOf:recordWeakRoot: (in category 'gc -- mark and sweep') -----
  lastPointerOf: oop recordWeakRoot: recordWeakRoot "<Boolean>"
  	"Return the byte offset of the last pointer field of the given object.  
  	 Works with CompiledMethods, as well as ordinary objects. 
  	 Can be used even when the type bits are not correct.
  	 This is a version of lastPointerOf: for markAndTrace:."
+ 	| fmt sz header contextSize numLiterals |
- 	| fmt sz header contextSize |
  	<inline: true>
  	header := self baseHeader: oop.
  	fmt := self formatOfHeader: header.
+ 	fmt <= self lastPointerFormat ifTrue:
+ 		[fmt >= self indexablePointersFormat ifTrue:
+ 			[fmt = self lastPointerFormat ifTrue:
- 	fmt <= 4 ifTrue:
- 		[fmt >= 3 ifTrue:
- 			[fmt = 4 ifTrue:
  				[(recordWeakRoot and: [weakRootCount >= 0]) ifTrue:
  					["And remember as weak root"
  					 (weakRootCount := weakRootCount + 1) <= WeakRootTableSize ifFalse:
  						[self error: 'weakRoots table overflow'].
  					 weakRoots at: weakRootCount put: oop].
  				"Do not trace the object's indexed fields if it's a weak class"
  				^(self nonWeakFieldsOf: oop) * BytesPerOop].
  			"So fmt is 3"
  			(self isContextHeader: header) ifTrue:
  				["contexts end at the stack pointer avoiding having to init fields beyond it"
  				 contextSize := self fetchStackPointerOf: oop.
  				 ^CtxtTempFrameStart + contextSize * BytesPerOop]].
  		 sz := self sizeBitsOfSafe: oop.
+ 		 ^sz - BaseHeaderSize  "all pointers"].
+ 	fmt < self firstCompiledMethodFormat ifTrue: [^0]. "no pointers"
- 		 ^sz - BaseHeaderSize  "all pointers" ].
- 	fmt < 12 ifTrue: [^0]. "no pointers"
  
  	"CompiledMethod: contains both pointers and bytes:"
+ 	numLiterals := self literalCountOf: oop.
+ 	^numLiterals + LiteralStart * BytesPerOop!
- 	^(self literalCountOf: oop) + LiteralStart * BytesPerOop!

Item was changed:
  ----- Method: ObjectMemory>>lastPointerWhileForwarding: (in category 'gc -- compaction') -----
  lastPointerWhileForwarding: oop 
  	"The given object may have its header word in a forwarding block. Find  
  	the offset of the last pointer in the object in spite of this obstacle. "
  	| header fmt size methodHeader contextSize |
  	<inline: true>
  	header := self headerWhileForwardingOf: oop.
  	fmt := self formatOfHeader: header.
+ 	fmt <= self lastPointerFormat ifTrue:
+ 		[(fmt = self indexablePointersFormat
- 	fmt <= 4 ifTrue:
- 		[(fmt = 3
  		  and: [self isContextHeader: header]) ifTrue:
  			["contexts end at the stack pointer"
  			contextSize := self nacFetchStackPointerOf: oop.
  			self assert: ReceiverIndex + contextSize < (self lengthOf: oop baseHeader: header format: fmt).
+ 			^CtxtTempFrameStart + contextSize * BytesPerWord].
- 			^ CtxtTempFrameStart + contextSize * BytesPerWord].
  		"do sizeBitsOf: using the header we obtained"
  		(header bitAnd: TypeMask) = HeaderTypeSizeAndClass
  			ifTrue: [size := (self sizeHeader: oop) bitAnd: AllButTypeMask]
  			ifFalse: [size := header bitAnd: SizeMask].
+ 		^size - BaseHeaderSize].
+ 	fmt < self firstCompiledMethodFormat ifTrue: [^ 0]. "no pointers"
- 		^ size - BaseHeaderSize].
- 	fmt < 12 ifTrue: [^ 0]. "no pointers"
  	methodHeader := self longAt: oop + BaseHeaderSize.
  	^(self literalCountOfHeader: methodHeader) * BytesPerWord + BaseHeaderSize!

Item was changed:
  ----- Method: ObjectMemory>>lengthOf:baseHeader:format: (in category 'indexing primitive support') -----
  lengthOf: oop baseHeader: hdr format: fmt
  	"Return the number of indexable bytes or words in the given object. Assume the given oop is not an integer. For a CompiledMethod, the size of the method header (in bytes) should be subtracted from the result of this method."
  
  	| sz |
  	<inline: true>
  	<asmLabel: false> 
  	(hdr bitAnd: TypeMask) = HeaderTypeSizeAndClass
  		ifTrue: [ sz := (self sizeHeader: oop) bitAnd: LongSizeMask ]
  		ifFalse: [ sz := (hdr bitAnd: SizeMask)].
  	sz := sz - (hdr bitAnd: Size4Bit).
+ 	fmt <= self lastPointerFormat
- 	fmt <= 4
  		ifTrue: [ ^ (sz - BaseHeaderSize) >> ShiftForWord "words"].
+ 	^fmt < self firstByteFormat
+ 		ifTrue: [(sz - BaseHeaderSize) >> 2 "32-bit longs"]
+ 		ifFalse: [(sz - BaseHeaderSize) - (fmt bitAnd: 3) "bytes"]!
- 	fmt < 8
- 		ifTrue: [ ^ (sz - BaseHeaderSize) >> 2 "32-bit longs"]
- 		ifFalse: [ ^ (sz - BaseHeaderSize) - (fmt bitAnd: 3) "bytes"]!

Item was changed:
  ----- Method: ObjectMemory>>safePrintStringOf: (in category 'debug printing') -----
  safePrintStringOf: oop
  	"Version of printStringOf: that copes with forwarding during garbage collection."
  	| fmt header cnt i |
  	<inline: false>
  	(self isIntegerObject: oop) ifTrue:
  		[^nil].
  	(oop between: self startOfMemory and: freeBlock) ifFalse:
  		[^nil].
  	(oop bitAnd: (BytesPerWord - 1)) ~= 0 ifTrue:
  		[^nil].
  	header := self headerWhileForwardingOf: oop.
  	fmt := self formatOfHeader: header.
+ 	fmt < self firstByteFormat ifTrue: [^nil].
- 	fmt < 8 ifTrue: [ ^nil ].
  
  	cnt := 100 min: (self lengthOf: oop baseHeader: header format: fmt).
  	i := 0.
  
  	[i < cnt] whileTrue:
  		[self printChar: (self fetchByte: i ofObject: oop).
  		 i := i + 1].
  	self flush.
  	^oop!

Item was changed:
  ----- Method: ObjectMemory>>sufficientSpaceToInstantiate:indexableSize: (in category 'allocation') -----
  sufficientSpaceToInstantiate: classOop indexableSize: size 
  	"Return the number of bytes required to allocate an instance of the given class with the given number of indexable fields."
  	"Details: For speed, over-estimate space needed for fixed fields or literals; the low space threshold is a blurry line."
  	<var: #size type: #usqInt>
  	| format allocSize |
  	<inline: true>
+ 	(format := self instSpecOfClass: classOop) < self firstByteFormat
- 	(format := self instSpecOfClass: classOop) < 8
  		ifTrue:
  			["indexable fields are words or pointers"
  			size ~= 0 ifTrue:
  				["fail if attempting to call new: on non-indexable class"
+ 				 format < self arrayFormat ifTrue:
- 				 format < 2 ifTrue:
  					[^false].
  				 "fail if attempting to allocate over 2 Gb, since this overflows 32-bit arithmetic"
  				 size >> (LongSizeNumBits - BytesPerWord) > 0 ifTrue:
  					[^false]].
  			allocSize := size * BytesPerWord]
  		ifFalse:
  			["indexable fields are bytes"
  			 "fail if attempting to allocate over 2 Gb, since this overflows 32-bit arithmetic"
  			 size >> LongSizeNumBits > 0 ifTrue:
  				[^false].
  			allocSize := size].
  	^self sufficientSpaceToAllocate: 2500 + allocSize!

Item was changed:
  ----- Method: ObjectMemory>>validate: (in category 'simulation') -----
  validate: oop
  	<doNotGenerate>
  	| header type cc sz fmt nextChunk | 
  	header := self longAt: oop.
  	type := header bitAnd: 3.
  	type = 2 ifFalse: [type = (self rightType: header) ifFalse: [self halt]].
  	sz := (header bitAnd: SizeMask) >> 2.
  	(self isFreeObject: oop)
  		ifTrue: [ nextChunk := oop + (self sizeOfFree: oop) ]
  		ifFalse: [  nextChunk := oop + (self sizeBitsOf: oop) ].
  	nextChunk > endOfMemory
  		ifTrue: [oop = endOfMemory ifFalse: [self halt]].
  	(self headerType: nextChunk) = 0 ifTrue: [
  		(self headerType: (nextChunk + (BytesPerWord*2))) = 0 ifFalse: [self halt]].
  	(self headerType: nextChunk) = 1 ifTrue: [
  		(self headerType: (nextChunk + BytesPerWord)) = 1 ifFalse: [self halt]].
  	type = 2 ifTrue:
  		["free block" ^ self].
  	fmt := self formatOfHeader: header.
  	cc := self compactClassIndexOfHeader: header.
  	cc > 16 ifTrue: [self halt].	"up to 32 are legal, but not used"
  	type = 0 ifTrue:
  		["three-word header"
  		((self longAt: oop-BytesPerWord) bitAnd: 3) = type ifFalse: [self halt].
  		((self longAt: oop-(BytesPerWord*2)) bitAnd: 3) = type ifFalse: [self halt].
  		((self longAt: oop-BytesPerWord) = type) ifTrue: [self halt].	"Class word is 0"
  		sz = 0 ifFalse: [self halt]].
  	type = 1 ifTrue:
  		["two-word header"
  		((self longAt: oop-BytesPerWord) bitAnd: 3) = type ifFalse: [self halt].
  		cc > 0 ifTrue: [sz = 1 ifFalse: [self halt]].
  		sz = 0 ifTrue: [self halt]].
  	type = 3 ifTrue:
  		["one-word header"
  		cc = 0 ifTrue: [self halt]].
  	fmt = 5 ifTrue: [self halt].
  	fmt = 7 ifTrue: [self halt].
+ 	fmt >= self firstCompiledMethodFormat ifTrue: "must have integer header"
+ 		[(self isIntegerObject: (self longAt: oop + BytesPerWord)) ifFalse: [self halt]].!
- 	fmt >= 12 ifTrue:
- 		["CompiledMethod -- check for integer header"
- 		(self isIntegerObject: (self longAt: oop + BytesPerWord)) ifFalse: [self halt]].!

Item was added:
+ ----- Method: SpurMemoryManager>>byteFormatMask (in category 'header format') -----
+ byteFormatMask
+ 	^16r18!

Item was removed:
- ----- Method: StackInterpreter class>>patchInterp: (in category 'translation') -----
- patchInterp: fileName
- 	"Interpreter patchInterp: 'Squeak VM PPC'"
- 	"This will patch out the unneccesary range check (a compare
- 	 and branch) in the inner interpreter dispatch loop."
- 	"NOTE: You must edit in the Interpeter file name, and the
- 	 number of instructions (delta) to count back to find the compare
- 	 and branch that we want to get rid of."
- 
- 	| delta f code len remnant i |
- 	delta := 6.
- 	f := FileStream fileNamed: fileName.
- 	f binary.
- 	code := Bitmap new: (len := f size) // 4.
- 	f nextInto: code.
- 	remnant := f next: len - (code size * 4).
- 	i := 0.
- 	["Look for a BCTR instruction"
- 	(i := code indexOf: 16r4E800420 startingAt: i + 1 ifAbsent: [0]) > 0] whileTrue:
- 		["Look for a CMPLWI FF, 6 instrs back"
- 	       ((code at: i - delta) bitAnd: 16rFFE0FFFF) = 16r280000FF ifTrue:
- 			["Copy dispatch instrs back over the compare"
- 			self inform: 'Patching at ', i hex.
- 			0 to: delta - 2 do: [ :j |
- 				code at: (i - delta) + j put: (code at: (i - delta) + j + 2)]]].
- 	f position: 0; nextPutAll: code; nextPutAll: remnant.
- 	f close.
- !

Item was changed:
  ----- Method: StackInterpreter>>lookupMethodInDictionary: (in category 'message sending') -----
  lookupMethodInDictionary: dictionary 
  	"This method lookup tolerates integers as Dictionary keys to support
  	 execution of images in which Symbols have been compacted out."
  	| length index mask wrapAround nextSelector methodArray |
  	<inline: true>
  	<asmLabel: false>
  	length := objectMemory fetchWordLengthOf: dictionary.
  	mask := length - SelectorStart - 1.
  	"Use linear search on small dictionaries; its cheaper.
  	 Also the limit can be set to force linear search of all dictionaries, which supports the
  	 booting of images that need rehashing (e.g. because a tracer has generated an image
  	 with different hashes but hasn't rehashed it yet.)"
  	mask <= methodDictLinearSearchLimit ifTrue:
  		[index := 0.
  		 [index <= mask] whileTrue:
+ 			[nextSelector := objectMemory fetchPointer: index + SelectorStart ofObject: dictionary.
- 			[nextSelector := objectMemory fetchPointer: index ofObject: dictionary.
  			 nextSelector = messageSelector ifTrue:
  				[methodArray := objectMemory fetchPointer: MethodArrayIndex ofObject: dictionary.
+ 				 newMethod := objectMemory fetchPointer: index ofObject: methodArray.
- 				 newMethod := objectMemory fetchPointer: index - SelectorStart ofObject: methodArray.
  				^true].
  		 index := index + 1].
  		 ^false].
  	index := SelectorStart + (mask bitAnd: ((objectMemory isImmediate: messageSelector)
  												ifTrue: [objectMemory integerValueOf: messageSelector]
  												ifFalse: [objectMemory hashBitsOf: messageSelector])).
  
  	"It is assumed that there are some nils in this dictionary, and search will 
  	 stop when one is encountered. However, if there are no nils, then wrapAround 
  	 will be detected the second time the loop gets to the end of the table."
  	wrapAround := false.
  	[true] whileTrue:
  		[nextSelector := objectMemory fetchPointer: index ofObject: dictionary.
  		 nextSelector = objectMemory nilObject ifTrue: [^ false].
  		 nextSelector = messageSelector ifTrue:
  			[methodArray := objectMemory fetchPointer: MethodArrayIndex ofObject: dictionary.
  			 newMethod := objectMemory fetchPointer: index - SelectorStart ofObject: methodArray.
  			^true].
  		 index := index + 1.
  		 index = length ifTrue:
  			[wrapAround ifTrue: [^false].
  			 wrapAround := true.
  			 index := SelectorStart]].
  	
  	^false "for Slang"!

Item was changed:
  ----- Method: StackInterpreter>>subscript:with:format: (in category 'indexing primitive support') -----
  subscript: array with: index format: fmt
  	"Note: This method assumes that the index is within bounds!!"
  
  	<inline: true>
  	<asmLabel: false> "If labelled icc duplicates when inlining stObject:at:"
+ 	fmt <= objectMemory lastPointerFormat ifTrue:
+ 		[^objectMemory fetchPointer: index - 1 ofObject: array].
+ 	fmt >= objectMemory firstByteFormat ifTrue:
+ 		[^objectMemory integerObjectOf:
+ 			(objectMemory fetchByte: index - 1 ofObject: array)].
+ 	"long-word type objects"
+ 	^self positive32BitIntegerFor:
+ 			(objectMemory fetchLong32: index - 1 ofObject: array)!
- 	fmt <= 4 ifTrue: [  "pointer type objects"
- 		^ objectMemory fetchPointer: index - 1 ofObject: array].
- 	fmt < 8 ifTrue: [  "long-word type objects"
- 		^ self positive32BitIntegerFor:
- 			(objectMemory fetchLong32: index - 1 ofObject: array)
- 	] ifFalse: [  "byte-type objects"
- 		^ objectMemory integerObjectOf:
- 			(objectMemory fetchByte: index - 1 ofObject: array)
- 	].!

Item was changed:
  ----- Method: StackInterpreter>>subscript:with:storing:format: (in category 'indexing primitive support') -----
  subscript: array with: index storing: oopToStore format: fmt 
  	"Note: This method assumes that the index is within bounds!!"
  	| valueToStore |
  	<inline: true>
+ 	fmt <= objectMemory lastPointerFormat
+ 		ifTrue:
+ 			[objectMemory
+ 				storePointer: index - 1
+ 				ofObject: array
- 	fmt <= 4
- 		ifTrue: ["pointer type objects"
- 			objectMemory storePointer: index - 1 ofObject: array
  				withValue: oopToStore]
+ 		ifFalse:
+ 			[fmt >= objectMemory firstByteFormat
+ 				ifTrue:
+ 					[(objectMemory isIntegerObject: oopToStore) ifFalse:
+ 						[primFailCode := PrimErrBadIndex].
+ 					 valueToStore := objectMemory integerValueOf: oopToStore.
+ 					 (valueToStore >= 0 and: [valueToStore <= 255]) ifFalse:
+ 						[primFailCode := PrimErrBadArgument].
+ 					self successful ifTrue:
+ 						[objectMemory
+ 							storeByte: index - 1
+ 							ofObject: array
+ 							withValue: valueToStore]]
+ 				ifFalse: "long-word type objects"
+ 					[valueToStore := self positive32BitValueOf: oopToStore.
+ 					self successful ifTrue:
+ 						[objectMemory
+ 							storeLong32: index - 1
+ 							ofObject: array
+ 							withValue: valueToStore]]]!
- 		ifFalse: [fmt < 8
- 				ifTrue: ["long-word type objects"
- 					valueToStore := self positive32BitValueOf: oopToStore.
- 					self successful
- 						ifTrue: [objectMemory storeLong32: index - 1 ofObject: array
- 									withValue: valueToStore]]
- 				ifFalse: ["byte-type objects"
- 					(objectMemory isIntegerObject: oopToStore)
- 						ifFalse: [self success: false].
- 					valueToStore := objectMemory integerValueOf: oopToStore.
- 					(valueToStore >= 0
- 							and: [valueToStore <= 255])
- 						ifFalse: [self success: false].
- 					self successful
- 						ifTrue: [objectMemory
- 								storeByte: index - 1
- 								ofObject: array
- 								withValue: valueToStore]]]!

Item was changed:
  ----- Method: StackInterpreter>>updateObjectsPostByteSwapFrom:to: (in category 'image save/restore') -----
  updateObjectsPostByteSwapFrom: startOop to: stopAddr 
  	"Byte-swap the words of all bytes objects in a range of the 
  	 image, including Strings, ByteArrays, and CompiledMethods.
  	 This returns these objects to their original byte ordering 
  	 after blindly byte-swapping the entire image. For compiled 
  	 methods, byte-swap only their bytecodes part.
  	 Ensure floats are in platform-order."
  	| oop fmt wordAddr methodHeader swapFloatWords temp |
  	swapFloatWords := objectMemory vmEndianness ~= imageFloatsBigEndian.
  	self assert: ClassFloatCompactIndex ~= 0.
  	oop := startOop.
  	[self oop: oop isLessThan: stopAddr] whileTrue:
  		[(objectMemory isFreeObject: oop) ifFalse:
  			[fmt := objectMemory formatOf: oop.
+ 			 fmt >= self firstByteFormat ifTrue: "oop contains bytes"
- 			 fmt >= 8 ifTrue: "oop contains bytes"
  				[wordAddr := oop + BaseHeaderSize.
+ 				fmt >= self firstCompiledMethodFormat ifTrue: "compiled method; start after methodHeader and literals"
- 				fmt >= 12 ifTrue: "compiled method; start after methodHeader and literals"
  					[methodHeader := self longAt: oop + BaseHeaderSize.
  					 wordAddr := wordAddr + BytesPerWord + ((methodHeader >> 10 bitAnd: 255) * BytesPerWord)].
  				objectMemory reverseBytesFrom: wordAddr to: oop + (objectMemory sizeBitsOf: oop)].
+ 			 fmt = self firstLongFormat ifTrue: "Bitmap, Float etc"
- 			 fmt = 6 ifTrue: "Bitmap, Float etc"
  				[(swapFloatWords
  				  and: [(objectMemory compactClassIndexOf: oop) = ClassFloatCompactIndex])
  					ifTrue:
  						[temp := self longAt: oop + BaseHeaderSize.
  						 self longAt: oop + BaseHeaderSize put: (self longAt: oop + BaseHeaderSize + 4).
  						 self longAt: oop + BaseHeaderSize + 4 put: temp]
  					ifFalse:
  						[BytesPerWord = 8 ifTrue: "Object contains 32-bit half-words packed into 64-bit machine words."
  							[wordAddr := oop + BaseHeaderSize.
  							 objectMemory reverseWordsFrom: wordAddr to: oop + (objectMemory sizeBitsOf: oop)]]]].
  			oop := objectMemory objectAfter: oop]!



More information about the Vm-dev mailing list