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

[commits at source.squeak.org]

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

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

Name: VMMaker.oscog-eem.359
Author: eem
Time: 9 September 2013, 5:04:34.147 pm
UUID: 40208f59-0823-4cea-a81a-98e6d484dc8a
Ancestors: VMMaker.oscog-eem.358

Eliminate most if not all integer format numbers in favour of
symbolic consants such as indexablePointersFormat.

Implement SpurMemoryManager>>instantiateClass:indexableSize:.

Move isIndexable: to ObjectMemory.

Replace isInstanceOfClassCharacter: with isCharacterObject: and put
it in ObjectMemory & SpurMemoryManager (yet to fix completely
commonVariable:at:put:cacheIndex: which is written to expect the
value inst var yielding a SmallInteger).

Fix (Foo)InterpreterSimulator>>openAsMorph to cope with a
missing image name.

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

Item was changed:
  ----- Method: CogVMSimulator>>openAsMorph (in category 'UI') -----
  openAsMorph
  	"Open a morphic view on this simulation."
  	| localImageName borderWidth theWindow |
+ 	localImageName := imageName
+ 							ifNotNil: [FileDirectory default localNameFor: imageName]
+ 							ifNil: [' synthetic image'].
- 	localImageName := FileDirectory default localNameFor: imageName.
  	theWindow := (SystemWindow labelled: 'Simulation of ', localImageName) model: self.
  
  	theWindow addMorph: (displayView := ImageMorph new image: displayForm)
  		frame: (0 at 0 corner: 1 at 0.8).
  
  	transcript := TranscriptStream on: (String new: 10000).
  	theWindow addMorph: (PluggableTextMorph
  							on: transcript text: nil accept: nil
  							readSelection: nil menu: #codePaneMenu:shifted:)
  			frame: (0 at 0.8 corner: 0.7 at 1).
  	theWindow addMorph: (PluggableTextMorph on: self
  						text: #byteCountText accept: nil
  						readSelection: nil menu: #utilitiesMenu:) hideScrollBarsIndefinitely
  			frame: (0.7 at 0.8 corner: 1 at 1).
  
  	borderWidth := [SystemWindow borderWidth] "Squeak 4.1"
  						on: MessageNotUnderstood
  						do: [:ex| 0]. "3.8"
  	borderWidth := borderWidth + theWindow borderWidth.
  	theWindow openInWorldExtent: (self desiredDisplayExtent
  								+ (2 * borderWidth)
  								+ (0 at theWindow labelHeight)
  								* (1@(1/0.8))) rounded!

Item was removed:
- ----- Method: Interpreter>>isIndexable: (in category 'object format') -----
- isIndexable: oop
- 	^(self formatOf: oop) >= 2!

Item was removed:
- ----- Method: InterpreterPrimitives>>isInstanceOfClassCharacter: (in category 'primitive support') -----
- isInstanceOfClassCharacter: oop
- 	<inline: true>
- 	"N.B.  Because Slang always inlines is:instanceOf:compactClassIndex:
- 	 (because is:instanceOf:compactClassIndex: has an inline: pragma) the
- 	 phrase (objectMemory splObj: ClassCharacter) is expanded in-place
- 	 and is _not_ evaluated if oop has a non-zero CompactClassIndex."
- 	^objectMemory
- 		is: oop
- 		instanceOf: (objectMemory splObj: ClassCharacter) 
- 		compactClassIndex: 0!

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."
  
  	| 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]].
- 	(objectMemory isIntegerObject: oop) ifTrue:
- 		[value := objectMemory integerValueOf: oop.
- 		value < 0 ifTrue: [self primitiveFail. value := 0].
- 		^value].
  
  	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>>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 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]]
- 			[spaceOkay := objectMemory sufficientSpaceToInstantiate: (self stackValue: 1) indexableSize: size.
- 			 spaceOkay ifTrue:
- 					[self
- 						pop: argumentCount + 1
- 						thenPush: (objectMemory instantiateClass: (self stackValue: 1) indexableSize: size)]
  				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]]]
- 					[self primitiveFailFor: PrimErrNoMemory]]
  		ifFalse:
  			[self primitiveFailFor: PrimErrBadArgument]!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveSize (in category 'indexing primitives') -----
  primitiveSize
  	| rcvr hdr fmt fixedFields totalLength |
  	rcvr := self stackTop.
  	((objectMemory isImmediate: rcvr) "Integers are not indexable"
  	 or: [hdr := objectMemory baseHeader: rcvr.
  		(fmt := objectMemory formatOfHeader: hdr) < 2]) "This is not an indexable object"
  		ifTrue:
  			[^self primitiveFailFor: PrimErrBadReceiver].
+ 	(fmt = objectMemory indexablePointersFormat
+ 	 and: [objectMemory isContextHeader: hdr]) ifTrue:
- 	(fmt = 3 and: [objectMemory isContextHeader: hdr]) ifTrue:
  		[^self primitiveContextSize].
  	totalLength := objectMemory lengthOf: rcvr baseHeader: hdr format: fmt.
  	fixedFields := objectMemory fixedFieldsOf: rcvr format: fmt length: totalLength.
  	self pop: argumentCount + 1 thenPush: (objectMemory integerObjectOf: totalLength - fixedFields)!

Item was changed:
  ----- Method: InterpreterSimulator>>openAsMorph (in category 'UI') -----
  openAsMorph
  	"Open a morphic view on this simulation."
  	| window localImageName |
+ 	localImageName := imageName
+ 							ifNotNil: [FileDirectory default localNameFor: imageName]
+ 							ifNil: [' synthetic image'].
- 	localImageName := FileDirectory default localNameFor: imageName.
  	window := (SystemWindow labelled: 'Simulation of ' , localImageName) model: self.
  
  	window addMorph: (displayView := ImageMorph new image: displayForm)
  		frame: (0 at 0 corner: 1 at 0.8).
  
  	transcript := TranscriptStream on: (String new: 10000).
  	window addMorph: (PluggableTextMorph on: transcript text: nil accept: nil
  			readSelection: nil menu: #codePaneMenu:shifted:)
  		frame: (0 at 0.8 corner: 0.7 at 1).
  
  	window addMorph: (PluggableTextMorph on: self
  						text: #byteCountText accept: nil) hideScrollBarsIndefinitely
  		frame: (0.7 at 0.8 corner: 1 at 1).
  
  	window openInWorld!

Item was removed:
- ----- Method: NewspeakInterpreter>>isIndexable: (in category 'object format') -----
- isIndexable: oop
- 	^(self formatOf: oop) >= 2!

Item was changed:
  ----- Method: NewspeakInterpreterSimulator>>openAsMorph (in category 'UI') -----
  openAsMorph
  	"Open a morphic view on this simulation."
  	| window localImageName |
+ 	localImageName := imageName
+ 							ifNotNil: [FileDirectory default localNameFor: imageName]
+ 							ifNil: [' synthetic image'].
- 	localImageName := FileDirectory default localNameFor: imageName.
  	window := (SystemWindow labelled: 'Simulation of ', localImageName) model: self.
  
  	window addMorph: (displayView := ImageMorph new image: displayForm)
  		frame: (0 at 0 corner: 1 at 0.8).
  
  	transcript := TranscriptStream on: (String new: 10000).
  	window addMorph: (PluggableTextMorph
  							on: transcript text: nil accept: nil
  							readSelection: nil menu: #codePaneMenu:shifted:)
  			frame: (0 at 0.8 corner: 0.7 at 1).
  
  	window addMorph: (PluggableTextMorph on: self
  						text: #byteCountText accept: nil
  						readSelection: nil menu: #utilitiesMenu:) hideScrollBarsIndefinitely
  			frame: (0.7 at 0.8 corner: 1 at 1).
  
  	window openInWorldExtent: (self desiredDisplayExtent
  								+ (2 * window borderWidth)
  								+ (0 at window labelHeight)
  								* (1@(1/0.8))) rounded!

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

Item was added:
+ ----- Method: ObjectMemory>>firstStringyFakeFormat (in category 'header access') -----
+ firstStringyFakeFormat
+ 	"A fake format for the interpreter used to mark indexable strings in
+ 	 the interpreter's at cache.  This is larger than any format."
+ 	^16!

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

Item was added:
+ ----- Method: ObjectMemory>>isCharacterObject: (in category 'interpreter access') -----
+ isCharacterObject: oop
+ 	<inline: true>
+ 	"N.B.  Because Slang always inlines is:instanceOf:compactClassIndex:
+ 	 (because is:instanceOf:compactClassIndex: has an inline: pragma) the
+ 	 phrase (self splObj: ClassCharacter) is expanded in-place
+ 	 and is _not_ evaluated if oop has a non-zero CompactClassIndex."
+ 	^self
+ 		is: oop
+ 		instanceOf: (self splObj: ClassCharacter) 
+ 		compactClassIndex: 0!

Item was added:
+ ----- Method: ObjectMemory>>isIndexable: (in category 'object format') -----
+ isIndexable: oop
+ 	^(self formatOf: oop) >= 2!

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

Item was changed:
  ----- Method: Spur32BitMemoryManager>>fillObj:numSlots:with: (in category 'allocation') -----
  fillObj: objOop numSlots: numSlots with: fillValue
  	objOop + self baseHeaderSize
+ 		to: objOop + self baseHeaderSize + (numSlots * 4) - 1
- 		to: objOop + self baseHeaderSize + (numSlots * 4)
  		by: self allocationUnit
  		do: [:p|
+ 			self assert: p < (self addressAfter: objOop).
  			self longAt: p put: fillValue;
  				longAt: p + 4 put: fillValue]!

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

Item was added:
+ ----- Method: Spur64BitMemoryManager>>instantiateClass:indexableSize: (in category 'allocation') -----
+ instantiateClass: classObj indexableSize: nElements
+ 	| instSpec classFormat numSlots classIndex newObj fillValue |
+ 	classFormat := self formatOfClass: classObj.
+ 	instSpec := self instSpecOfClassFormat: classFormat.
+ 	fillValue := 0.
+ 	instSpec caseOf: {
+ 		[self indexablePointersFormat]	->
+ 			[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 + (nElements bitAnd: 3)].
+ 		[self firstByteFormat]	->
+ 			[numSlots := nElements + 7 // 8.
+ 			 instSpec := instSpec + (nElements bitAnd: 7)].
+ 		[self firstCompiledMethodFormat]	->
+ 			[numSlots := nElements + 7 // 8.
+ 			 instSpec := instSpec + (nElements bitAnd: 7)] }
+ 		otherwise: [^nil]. "non-indexable"
+ 	classIndex := self hashBitsOf: classObj.
+ 	classIndex = 0 ifTrue:
+ 		[(self enterIntoClassTable: classObj) ifFalse:
+ 			[^nil].
+ 		classIndex := self hashBitsOf: classObj].
+ 	newObj := self allocateSlots: numSlots format: instSpec classIndex: classIndex.
+ 	newObj ifNotNil:
+ 		[self fillObj: newObj numSlots: numSlots with: fillValue].
+ 	^newObj!

Item was added:
+ ----- Method: SpurMemoryManager class>>vmProxyMajorVersion (in category 'simulation only') -----
+ vmProxyMajorVersion
+ 	"hack around the CoInterpreter/ObjectMemory split refactoring"
+ 	^StackInterpreter vmProxyMajorVersion!

Item was added:
+ ----- Method: SpurMemoryManager class>>vmProxyMinorVersion (in category 'simulation only') -----
+ vmProxyMinorVersion
+ 	"hack around the CoInterpreter/ObjectMemory split refactoring"
+ 	^StackInterpreter vmProxyMinorVersion!

Item was added:
+ ----- Method: SpurMemoryManager>>firstStringyFakeFormat (in category 'header format') -----
+ firstStringyFakeFormat
+ 	"A fake format for the interpreter used to mark indexable strings in
+ 	 the interpreter's at cache.  This is larger than any format."
+ 	^32!

Item was changed:
  ----- Method: SpurMemoryManager>>fixedFieldsOf:format:length: (in category 'object format') -----
  fixedFieldsOf: objOop format: fmt length: wordLength
  	| class |
  	<inline: true>
  	<asmLabel: false>
+ 	(fmt > self lastPointerFormat or: [fmt = 2]) ifTrue: [^0].  "indexable fields only"
- 	(fmt > self ephemeronFormat or: [fmt = 2]) ifTrue: [^0].  "indexable fields only"
  	fmt < 2 ifTrue: [^wordLength].  "fixed fields only (zero or more)"
  	class := self fetchClassOfNonImm: objOop.
  	^self fixedFieldsOfClassFormat: (self formatOfClass: class)!

Item was added:
+ ----- Method: SpurMemoryManager>>instantiateClass:indexableSize: (in category 'allocation') -----
+ instantiateClass: classObj indexableSize: nElements
+ 	^self subclassResponsibility!

Item was added:
+ ----- Method: SpurMemoryManager>>isArray: (in category 'object testing') -----
+ isArray: oop
+ 	"Answer true if this is an indexable object with pointer elements, e.g., an array"
+ 	^(self isNonImmediate: oop) and: [self isArrayNonImm: oop]!

Item was added:
+ ----- Method: SpurMemoryManager>>isArrayNonImm: (in category 'object testing') -----
+ isArrayNonImm: oop
+ 	"Answer true if this is an indexable object with pointer elements, e.g., an array"
+ 	^ (self formatOf: oop) = self arrayFormat!

Item was added:
+ ----- Method: SpurMemoryManager>>isCharacterObject: (in category 'object testing') -----
+ isCharacterObject: oop
+ 	^(oop bitAnd: self tagMask) = self characterTag!

Item was added:
+ ----- Method: SpurMemoryManager>>isInEden: (in category 'object testing') -----
+ isInEden: objOop
+ 	^objOop >= scavenger eden start
+ 	  and: [objOop < scavenger eden limit]!

Item was added:
+ ----- Method: SpurMemoryManager>>isIndexable: (in category 'object testing') -----
+ isIndexable: objOop
+ 	^(self formatOf: objOop) >= self sixtyFourBitIndexableFormat!

Item was added:
+ ----- Method: SpurMemoryManager>>isIndexableFormat: (in category 'object testing') -----
+ isIndexableFormat: format
+ 	^format >= self sixtyFourBitIndexableFormat!

Item was changed:
  ----- Method: SpurMemoryManager>>isIntegerObject: (in category 'object testing') -----
  isIntegerObject: oop
  	(#(	makeBaseFrameFor:
  		quickFetchInteger:ofObject:
  		frameOfMarriedContext:
  		addressCouldBeClassObj:
  		isMarriedOrWidowedContext:
  		shortPrint:
  		bytecodePrimAt
  		commonAt:
+ 		loadFloatOrIntFrom:
+ 		positive32BitValueOf:
+ 		primitiveExternalCall
+ 		checkedIntegerValueOf:) includes: thisContext sender method selector) ifFalse:
- 		loadFloatOrIntFrom:) includes: thisContext sender method selector) ifFalse:
  		[self halt].
  	^(oop bitAnd: 1) ~= 0!

Item was added:
+ ----- Method: SpurMemoryManager>>isPointers: (in category 'object testing') -----
+ isPointers: oop
+ 	"Answer if the argument has only fields that can hold oops. See comment in formatOf:"
+ 
+ 	^(self isNonImmediate: oop) and: [self isPointersNonImm: oop]!

Item was added:
+ ----- Method: SpurMemoryManager>>isPointersFormat: (in category 'object testing') -----
+ isPointersFormat: format
+ 	^format <= self lastPointerFormat!

Item was changed:
  ----- Method: SpurMemoryManager>>isPointersNonImm: (in category 'object testing') -----
  isPointersNonImm: objOop
  	"Answer if the argument has only fields that can hold oops. See comment in formatOf:"
+ 	^(self formatOf: objOop) <= self lastPointerFormat!
- 	^(self formatOf: objOop) <= 5!

Item was added:
+ ----- Method: SpurMemoryManager>>sizeBitsOfSafe: (in category 'object access') -----
+ sizeBitsOfSafe: objOop
+ 	^self sizeBitsOf: objOop!

Item was changed:
  ----- Method: StackInterpreter>>commonVariable:at:cacheIndex: (in category 'indexing primitive support') -----
  commonVariable: rcvr at: index cacheIndex: atIx 
  	"This code assumes the receiver has been identified at location atIx in the atCache."
  	| stSize fmt fixedFields result |
  	<inline: true>
  	stSize := atCache at: atIx+AtCacheSize.
  	((self oop: index isGreaterThanOrEqualTo: 1)
  	 and: [self oop: index isLessThanOrEqualTo: stSize]) ifTrue:
  		[fmt := atCache at: atIx+AtCacheFmt.
+ 		 fmt <= objectMemory weakArrayFormat ifTrue:
- 		 fmt <= 4 ifTrue:
  			[self assert: (objectMemory isContextNonInt: rcvr) not.
  			 fixedFields := atCache at: atIx+AtCacheFixedFields.
  			 ^objectMemory fetchPointer: index + fixedFields - 1 ofObject: rcvr].
+ 		 fmt < objectMemory firstByteFormat ifTrue:  "Bitmap"
- 		 fmt < 8 ifTrue:  "Bitmap"
  			[result := objectMemory fetchLong32: index - 1 ofObject: rcvr.
  			 ^self positive32BitIntegerFor: result].
+ 		 fmt >= objectMemory firstStringyFakeFormat  "Note fmt >= firstStringyFormat is an artificial flag for strings"
- 		 fmt >= 16  "Note fmt >= 16 is an artificial flag for strings"
  			ifTrue: "String"
  				[^self characterForAscii: (objectMemory fetchByte: index - 1 ofObject: rcvr)]
  			ifFalse:
+ 				[(fmt < objectMemory firstCompiledMethodFormat "ByteArray"
- 				[(fmt < 12 "ByteArray"
  				  or: [index >= (self firstByteIndexOfMethod: rcvr) "CompiledMethod"]) ifTrue:
  					[^objectMemory integerObjectOf: (objectMemory fetchByte: index - 1 ofObject: rcvr)]]].
  
+ 	^self primitiveFailFor: ((objectMemory isIndexable: rcvr)
+ 								ifFalse: [PrimErrBadReceiver]
+ 								ifTrue: [PrimErrBadIndex])!
- 	^self primitiveFailFor: ((objectMemory formatOf: rcvr) <= 1
- 								ifTrue: [PrimErrBadReceiver]
- 								ifFalse: [PrimErrBadIndex])!

Item was changed:
  ----- Method: StackInterpreter>>commonVariable:at:put:cacheIndex: (in category 'indexing primitive support') -----
  commonVariable: rcvr at: index put: value cacheIndex: atIx
  	"This code assumes the receiver has been identified at location atIx in the atCache."
  	| stSize fmt fixedFields valToPut isCharacter |
  	<inline: true>
  	stSize := atCache at: atIx+AtCacheSize.
  	((self oop: index isGreaterThanOrEqualTo: 1)
  	  and: [self oop: index isLessThanOrEqualTo: stSize]) ifTrue:
  		[fmt := atCache at: atIx+AtCacheFmt.
+ 		fmt <= objectMemory weakArrayFormat ifTrue:
- 		fmt <= 4 ifTrue:
  			[self assert: (objectMemory isContextNonInt: rcvr) not.
  			 fixedFields := atCache at: atIx+AtCacheFixedFields.
  			 ^objectMemory storePointer: index + fixedFields - 1 ofObject: rcvr withValue: value].
+ 		fmt < objectMemory firstByteFormat ifTrue:  "Bitmap"
- 		fmt < 8 ifTrue:  "Bitmap"
  			[valToPut := self positive32BitValueOf: value.
+ 			 self successful ifTrue:
+ 				[objectMemory storeLong32: index - 1 ofObject: rcvr withValue: valToPut.
+ 				^nil].
+ 			 ^self primitiveFailFor: PrimErrBadArgument].
+ 		fmt >= objectMemory firstStringyFakeFormat  "Note fmt >= firstStringyFormat is an artificial flag for strings"
+ 			ifTrue: [isCharacter := objectMemory isCharacterObject: value.
- 			self successful ifTrue: [objectMemory storeLong32: index - 1 ofObject: rcvr withValue: valToPut].
- 			^nil].
- 		fmt >= 16  "Note fmt >= 16 is an artificial flag for strings"
- 			ifTrue: [isCharacter := self isInstanceOfClassCharacter: value.
  					isCharacter ifFalse:
  						[^self primitiveFailFor: PrimErrBadArgument].
  					valToPut := objectMemory fetchPointer: CharacterValueIndex ofObject: value]
  			ifFalse:
+ 				[(fmt >= objectMemory firstCompiledMethodFormat and: [index < (self firstByteIndexOfMethod: rcvr)]) ifTrue: "CompiledMethod"
- 				[(fmt >= 12 and: [index < (self firstByteIndexOfMethod: rcvr)]) ifTrue: "CompiledMethod"
  					[^self primitiveFailFor: PrimErrBadIndex].
  				valToPut := value].
  		(objectMemory isIntegerObject: valToPut) ifTrue:
  			[valToPut := objectMemory integerValueOf: valToPut.
  			((valToPut >= 0) and: [valToPut <= 255]) ifFalse: [^self primitiveFailFor: PrimErrBadArgument].
  			^objectMemory storeByte: index - 1 ofObject: rcvr withValue: valToPut]].
  
+ 	^self primitiveFailFor: ((objectMemory isIndexable: rcvr)
+ 								ifFalse: [PrimErrBadReceiver]
+ 								ifTrue: [PrimErrBadIndex])!
- 	^self primitiveFailFor: ((objectMemory formatOf: rcvr) <= 1
- 								ifTrue: [PrimErrBadReceiver]
- 								ifFalse: [PrimErrBadIndex])!

Item was changed:
  ----- Method: StackInterpreter>>install:inAtCache:at:string: (in category 'indexing primitive support') -----
  install: rcvr inAtCache: cache at: atIx string: stringy
  	"Attempt to install the oop of this object in the given cache (at or atPut),
  	 along with its size, format and fixedSize. Answer if this was successful."
  	| hdr fmt totalLength fixedFields |
  	<var: #cache type: 'sqInt *'>
  
  	hdr := objectMemory baseHeader: rcvr.
  	fmt := objectMemory formatOfHeader: hdr.
+ 	(fmt = objectMemory indexablePointersFormat and: [objectMemory isContextHeader: hdr]) ifTrue:
- 	(fmt = 3 and: [objectMemory isContextHeader: hdr]) ifTrue:
  		["Contexts must not be put in the atCache, since their size is not constant"
  		self primitiveFailFor: PrimErrBadReceiver.
  		^false].
  	totalLength := objectMemory lengthOf: rcvr baseHeader: hdr format: fmt.
  	fixedFields := objectMemory fixedFieldsOf: rcvr format: fmt length: totalLength.
  
  	cache at: atIx+AtCacheOop put: rcvr.
  	cache at: atIx+AtCacheFmt put: (stringy
+ 										ifTrue: [fmt + objectMemory firstStringyFakeFormat]  "special flag for strings"
- 										ifTrue: [fmt + 16]  "special flag for strings"
  										ifFalse: [fmt]).
  	cache at: atIx+AtCacheFixedFields put: fixedFields.
  	cache at: atIx+AtCacheSize put: totalLength - fixedFields.
  	^true!

Item was removed:
- ----- Method: StackInterpreter>>isIndexable: (in category 'object format') -----
- isIndexable: oop
- 	^(objectMemory formatOf: oop) >= 2!

Item was changed:
  ----- Method: StackInterpreter>>snapshotCleanUp (in category 'image save/restore') -----
  snapshotCleanUp
  	"Clean up right before saving an image, sweeping memory and:
  	* nilling out all fields of contexts above the stack pointer. 
  	* flushing external primitives 
  	* clearing the root bit of any object in the root table
  	* bereaving widowed contexts.
  	 By ensuring that all contexts are single in a snapshot (i.e. that no married contexts
  	 exist) we can maintain the invariant that a married or widowed context's frame
  	 reference (in its sender field) must point into the stack pages since no married or
  	 widowed contexts are present from older runs of the system."
  	| oop header fmt sz |
  	oop := objectMemory firstObject.
  	[self oop: oop isLessThan: objectMemory freeStart] whileTrue:
  		[(objectMemory isFreeObject: oop) ifFalse:
  			[header := self longAt: oop.
  			 fmt := objectMemory formatOfHeader: header.
  			 "Clean out context"
+ 			 (fmt = objectMemory indexablePointersFormat
+ 			  and: [objectMemory isContextHeader: header]) ifTrue:
- 			 (fmt = 3 and: [objectMemory isContextHeader: header]) ifTrue:
  				["All contexts have been divorced. Bereave remaining widows."
  				 (self isMarriedOrWidowedContext: oop) ifTrue:
  					[self markContextAsDead: oop].
  				 sz := objectMemory sizeBitsOf: oop.
  				 (objectMemory lastPointerOf: oop) + BytesPerWord
  				 to: sz - BaseHeaderSize by: BytesPerWord
  				 do: [:i | self longAt: oop + i put: objectMemory nilObject]].
+ 			 "Clean out external functions from compiled methods"
+ 			 fmt >= objectMemory firstCompiledMethodFormat ifTrue:
+ 				["Its primitiveExternalCall"
- 			 "Clean out external functions"
- 			 fmt >= 12 ifTrue:
- 				["This is a compiled method"
  				 (self primitiveIndexOf: oop) = PrimitiveExternalCallIndex ifTrue:
+ 					[self flushExternalPrimitiveOf: oop]]].
- 					["Its primitiveExternalCall"
- 					 self flushExternalPrimitiveOf: oop]]].
  			oop := objectMemory objectAfter: oop].
  	objectMemory clearRootsTable!

Item was changed:
  ----- Method: StackInterpreter>>stObject:at: (in category 'indexing primitive support') -----
  stObject: array at: index
  	"Return what ST would return for <obj> at: index."
  
  	| hdr fmt totalLength fixedFields stSize |
  	<inline: false>
  	hdr := objectMemory baseHeader: array.
  	fmt := objectMemory formatOfHeader: hdr.
  	totalLength := objectMemory lengthOf: array baseHeader: hdr format: fmt.
  	fixedFields := objectMemory fixedFieldsOf: array format: fmt length: totalLength.
+ 	(fmt = objectMemory indexablePointersFormat
+ 	 and: [objectMemory isContextHeader: hdr])
- 	(fmt = 3 and: [objectMemory isContextHeader: hdr])
  		ifTrue:
  			[stSize := self stackPointerForMaybeMarriedContext: array.
  			((self oop: index isGreaterThanOrEqualTo: 1)
  			 and: [(self oop: index isLessThanOrEqualTo: stSize)
  			 and: [self isStillMarriedContext: array]]) ifTrue:
  				[^self noInlineTemporary: index - 1 in: (self frameOfMarriedContext: array)]]
  		ifFalse: [stSize := totalLength - fixedFields].
  	((self oop: index isGreaterThanOrEqualTo: (objectMemory firstValidIndexOfIndexableObject: array withFormat: fmt))
  	 and: [self oop: index isLessThanOrEqualTo: stSize]) ifTrue:
  		[^self subscript: array with: (index + fixedFields) format: fmt].
  	self primitiveFailFor: (fmt <= 1 ifTrue: [PrimErrBadReceiver] ifFalse: [PrimErrBadIndex]).
  	^0!

Item was changed:
  ----- Method: StackInterpreter>>stObject:at:put: (in category 'indexing primitive support') -----
  stObject: array at: index put: value
  	"Do what ST would return for <obj> at: index put: value."
  	| hdr fmt totalLength fixedFields stSize |
  	<inline: false>
  	hdr := objectMemory baseHeader: array.
  	fmt := objectMemory formatOfHeader: hdr.
  	totalLength := objectMemory lengthOf: array baseHeader: hdr format: fmt.
  	fixedFields := objectMemory fixedFieldsOf: array format: fmt length: totalLength.
+ 	(fmt = objectMemory indexablePointersFormat
- 	(fmt = 3
  	 and: [objectMemory isContextHeader: hdr])
  		ifTrue:
  			[stSize := self stackPointerForMaybeMarriedContext: array.
  			((self oop: index isGreaterThanOrEqualTo: 1)
  			 and: [(self oop: index isLessThanOrEqualTo: stSize)
  			 and: [self isStillMarriedContext: array]]) ifTrue:
  				[^self noInlineTemporary: index - 1 in: (self frameOfMarriedContext: array) put: value]]
  		ifFalse: [stSize := totalLength - fixedFields].
  	((self oop: index isGreaterThanOrEqualTo: (objectMemory firstValidIndexOfIndexableObject: array withFormat: fmt))
  	 and: [self oop: index isLessThanOrEqualTo: stSize])
  		ifTrue: [self subscript: array with: (index + fixedFields) storing: value format: fmt]
  		ifFalse: [self primitiveFailFor: (fmt <= 1 ifTrue: [PrimErrBadReceiver] ifFalse: [PrimErrBadIndex])].
  	^value!

Item was changed:
  ----- Method: StackInterpreter>>stSizeOf: (in category 'indexing primitive support') -----
  stSizeOf: oop
  	"Return the number of indexable fields in the given object. (i.e., what Smalltalk would return for <obj> size)."
  	"Note: Assume oop is not a SmallInteger!!"
  
  	| hdr fmt totalLength fixedFields |
  	<inline: false>
  	hdr := objectMemory baseHeader: oop.
  	fmt := objectMemory formatOfHeader: hdr.
  	totalLength := objectMemory lengthOf: oop baseHeader: hdr format: fmt.
  	fixedFields := objectMemory fixedFieldsOf: oop format: fmt length: totalLength.
+ 	fmt = objectMemory indexablePointersFormat ifTrue:
+ 		[self assert: (objectMemory isContextHeader: hdr) not].
- 	fmt = 3 ifTrue: [self assert: (objectMemory isContextHeader: hdr) not].
  	^totalLength - fixedFields!

Item was changed:
  ----- Method: StackInterpreterPrimitives>>primitiveInstVarAt (in category 'object access primitives') -----
  primitiveInstVarAt
  	| index rcvr hdr fmt totalLength fixedFields value |
  	index := self stackIntegerValue: 0.
  	rcvr := self stackValue: 1.
  	self successful ifFalse:
  		[^self primitiveFailFor: PrimErrBadArgument].
  	hdr := objectMemory baseHeader: rcvr.
  	fmt := objectMemory formatOfHeader: hdr.
  	totalLength := objectMemory lengthOf: rcvr baseHeader: hdr format: fmt.
  	fixedFields := objectMemory fixedFieldsOf: rcvr format: fmt length: totalLength.
  	(index >= 1 and: [index <= fixedFields]) ifFalse:
  		[^self primitiveFailFor: PrimErrBadIndex].
+ 	(fmt = objectMemory indexablePointersFormat
- 	(fmt = 3
  	 and: [objectMemory isContextHeader: hdr])
  		ifTrue: [value := self externalInstVar: index - 1 ofContext: rcvr]
  		ifFalse: [value := self subscript: rcvr with: index format: fmt].
  	self pop: argumentCount + 1 thenPush: value!

Item was changed:
  ----- Method: StackInterpreterPrimitives>>primitiveInstVarAtPut (in category 'object access primitives') -----
  primitiveInstVarAtPut
  	| newValue index rcvr hdr fmt totalLength fixedFields |
  	newValue := self stackTop.
  	index := self stackIntegerValue: 1.
  	rcvr := self stackValue: 2.
  	self successful ifFalse:
  		[^self primitiveFailFor: PrimErrBadArgument].
  	hdr := objectMemory baseHeader: rcvr.
  	fmt := objectMemory formatOfHeader: hdr.
  	totalLength := objectMemory lengthOf: rcvr baseHeader: hdr format: fmt.
  	fixedFields := objectMemory fixedFieldsOf: rcvr format: fmt length: totalLength.
  	(index >= 1 and: [index <= fixedFields]) ifFalse:
  		[^self primitiveFailFor: PrimErrBadIndex].
+ 	(fmt = objectMemory indexablePointersFormat
- 	(fmt = 3
  	 and: [objectMemory isContextHeader: hdr])
  		ifTrue: [self externalInstVar: index - 1 ofContext: rcvr put: newValue]
  		ifFalse: [self subscript: rcvr with: index storing: newValue format: fmt].
  	self pop: argumentCount + 1 thenPush: newValue!

Item was changed:
  ----- Method: StackInterpreterPrimitives>>primitiveObjectPointsTo (in category 'object access primitives') -----
  primitiveObjectPointsTo
  	"This primitive is assumed to be fast (see e.g. MethodDictionary>>includesKey:) so make it so.
  	 N.B.  Written to use literalHeaderOf: so that in Cog subclasses cogged methods (whose headers
  	 point to the machine code method) are still correctly scanned, for the header as well as literals."
  	| rcvr thang header fmt lastField methodHeader |
  	thang := self stackTop.
  	rcvr := self stackValue: 1.
  	(objectMemory isIntegerObject: rcvr) ifTrue:
  		[^self pop: 2 thenPushBool: false].
  
  	"Inlined version of lastPointerOf: for speed in determining if rcvr is a context."
  	header := objectMemory baseHeader: rcvr.
  	fmt := objectMemory formatOfHeader: header.
+ 	(objectMemory isPointersFormat: fmt)
- 	fmt <= 4
  		ifTrue:
+ 			[(fmt = objectMemory indexablePointersFormat
- 			[(fmt = 3
  			  and: [objectMemory isContextHeader: header]) 
  				ifTrue:
  	 				[(self isMarriedOrWidowedContext: rcvr) ifTrue:
  						[self externalWriteBackHeadFramePointers.
  						 (self isStillMarriedContext: rcvr) ifTrue:
  							[^self pop: 2
  									thenPushBool: (self marriedContext: rcvr
  														pointsTo: thang
  														stackDeltaForCurrentFrame: 2)]].
  					"contexts end at the stack pointer"
  					lastField := CtxtTempFrameStart + (self fetchStackPointerOf: rcvr) * BytesPerWord]
  				ifFalse:
  					[lastField := (objectMemory sizeBitsOfSafe: rcvr) - BaseHeaderSize]]
  		ifFalse:
+ 			[fmt < objectMemory firstCompiledMethodFormat "no pointers" ifTrue:
- 			[fmt < 12 "no pointers" ifTrue:
  				[^self pop: 2 thenPushBool: false].
  			"CompiledMethod: contains both pointers and bytes:"
  			methodHeader := self headerOf: rcvr.
  			methodHeader = thang ifTrue: [^self pop: 2 thenPushBool: true].
  			lastField := ((self literalCountOfHeader: methodHeader) + 1) * BytesPerWord].
  
  	BaseHeaderSize to: lastField by: BytesPerWord do:
  		[:i |
  		(self longAt: rcvr + i) = thang ifTrue:
  			[^self pop: 2 thenPushBool: true]].
  	self pop: 2 thenPushBool: false!

Item was changed:
  ----- Method: StackInterpreterSimulator>>openAsMorph (in category 'UI') -----
  openAsMorph
  	"Open a morphic view on this simulation."
  	| window localImageName |
+ 	localImageName := imageName
+ 							ifNotNil: [FileDirectory default localNameFor: imageName]
+ 							ifNil: [' synthetic image'].
- 	localImageName := FileDirectory default localNameFor: imageName.
  	window := (SystemWindow labelled: 'Simulation of ', localImageName) model: self.
  
  	window addMorph: (displayView := ImageMorph new image: displayForm)
  		frame: (0 at 0 corner: 1 at 0.8).
  
  	transcript := TranscriptStream on: (String new: 10000).
  	window addMorph: (PluggableTextMorph
  							on: transcript text: nil accept: nil
  							readSelection: nil menu: #codePaneMenu:shifted:)
  			frame: (0 at 0.8 corner: 0.7 at 1).
  
  	window addMorph: (PluggableTextMorph on: self
  						text: #byteCountText accept: nil
  						readSelection: nil menu: #utilitiesMenu:) hideScrollBarsIndefinitely
  			frame: (0.7 at 0.8 corner: 1 at 1).
  
  	window openInWorldExtent: (self desiredDisplayExtent
  								+ (2 * window borderWidth)
  								+ (0 at window labelHeight)
  								* (1@(1/0.8))) rounded!