VM Maker: VMMaker.oscog-eem.359.mcz

 
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@0 corner: 1@0.8).
 
  transcript := TranscriptStream on: (String new: 10000).
  theWindow addMorph: (PluggableTextMorph
  on: transcript text: nil accept: nil
  readSelection: nil menu: #codePaneMenu:shifted:)
  frame: (0@0.8 corner: 0.7@1).
  theWindow addMorph: (PluggableTextMorph on: self
  text: #byteCountText accept: nil
  readSelection: nil menu: #utilitiesMenu:) hideScrollBarsIndefinitely
  frame: (0.7@0.8 corner: 1@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@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@0 corner: 1@0.8).
 
  transcript := TranscriptStream on: (String new: 10000).
  window addMorph: (PluggableTextMorph on: transcript text: nil accept: nil
  readSelection: nil menu: #codePaneMenu:shifted:)
  frame: (0@0.8 corner: 0.7@1).
 
  window addMorph: (PluggableTextMorph on: self
  text: #byteCountText accept: nil) hideScrollBarsIndefinitely
  frame: (0.7@0.8 corner: 1@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@0 corner: 1@0.8).
 
  transcript := TranscriptStream on: (String new: 10000).
  window addMorph: (PluggableTextMorph
  on: transcript text: nil accept: nil
  readSelection: nil menu: #codePaneMenu:shifted:)
  frame: (0@0.8 corner: 0.7@1).
 
  window addMorph: (PluggableTextMorph on: self
  text: #byteCountText accept: nil
  readSelection: nil menu: #utilitiesMenu:) hideScrollBarsIndefinitely
  frame: (0.7@0.8 corner: 1@1).
 
  window openInWorldExtent: (self desiredDisplayExtent
  + (2 * window borderWidth)
  + (0@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@0 corner: 1@0.8).
 
  transcript := TranscriptStream on: (String new: 10000).
  window addMorph: (PluggableTextMorph
  on: transcript text: nil accept: nil
  readSelection: nil menu: #codePaneMenu:shifted:)
  frame: (0@0.8 corner: 0.7@1).
 
  window addMorph: (PluggableTextMorph on: self
  text: #byteCountText accept: nil
  readSelection: nil menu: #utilitiesMenu:) hideScrollBarsIndefinitely
  frame: (0.7@0.8 corner: 1@1).
 
  window openInWorldExtent: (self desiredDisplayExtent
  + (2 * window borderWidth)
  + (0@window labelHeight)
  * (1@(1/0.8))) rounded!