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

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

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

Name: VMMaker.oscog-eem.959
Author: eem
Time: 1 December 2014, 2:34:28.523 pm
UUID: e20df829-a81a-4af0-ab05-a80eb5730705
Ancestors: VMMaker.oscog-eem.958

Reimplement primitiveCopyObject to work for both
pointer and bits objects.  This to support a good
Object>>clone for Spur.

Fix shortPrint: and simulated use of dbgFloatValueOf:,
moving it to the ObjectMemory hierarchy.

Fix Spur's isWordsOrBytes[NonImm]:.

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

Item was removed:
- ----- Method: CogVMSimulator>>shortPrint: (in category 'debug support') -----
- shortPrint: oop
- | name classOop |
- (objectMemory isImmediate: oop) ifTrue:
- [(objectMemory isImmediateCharacter: oop) ifTrue:
- [^(objectMemory characterValueOf: oop) < 256
- ifTrue:
- ['=$' , (objectMemory characterValueOf: oop) printString ,
- ' (' , (String with: (Character value: (objectMemory characterValueOf: oop))) , ')']
- ifFalse:
- ['=$' , (objectMemory characterValueOf: oop) printString, '(???)']].
- (objectMemory isIntegerObject: oop) ifTrue:
- [^ '=' , (objectMemory integerValueOf: oop) printString ,
- ' (' , (objectMemory integerValueOf: oop) hex , ')'].
- ^'= UNKNOWN IMMEDIATE', ' (' , (objectMemory integerValueOf: oop) hex , ')'].
- (objectMemory addressCouldBeObj: oop) ifFalse:
- [^(oop bitAnd: objectMemory allocationUnit - 1) ~= 0
- ifTrue: [' is misaligned']
- ifFalse: [self whereIs: oop]].
- (objectMemory isFreeObject: oop) ifTrue:
- [^' is a free chunk of size ', (objectMemory sizeOfFree: oop) printString].
- (objectMemory isForwarded: oop) ifTrue:
- [^' is a forwarded object to ', (objectMemory followForwarded: oop) hex,
- ' of slot size ', (objectMemory numSlotsOfAny: oop) printString].
- classOop := objectMemory fetchClassOfNonImm: oop.
- (objectMemory numSlotsOf: classOop) = metaclassNumSlots ifTrue:
- [^'class ' , (self nameOfClass: oop)].
- name := self nameOfClass: classOop.
- name size = 0 ifTrue: [name := '??'].
- name = 'String' ifTrue: [^ (self stringOf: oop) printString].
- name = 'ByteString' ifTrue: [^ (self stringOf: oop) printString].
- name = 'Symbol' ifTrue: [^ '#' , (self stringOf: oop)].
- name = 'ByteSymbol' ifTrue: [^ '#' , (self stringOf: oop)].
- name = 'Character' ifTrue: "SpurMemoryManager has immediate Characters; ObjectMemory does not"
- [^ '=' , (Character value: (objectMemory integerValueOf:
- (objectMemory fetchPointer: 0 ofObject: oop))) printString].
- name = 'UndefinedObject' ifTrue: [^ 'nil'].
- name = 'False' ifTrue: [^ 'false'].
- name = 'True' ifTrue: [^ 'true'].
- name = 'Float' ifTrue: [^ '=' , (self dbgFloatValueOf: oop) printString].
- "Try to spot association-like things; they're all subclasses of LookupKey"
- ((objectMemory isPointersNonImm: oop)
- and: [((objectMemory instanceSizeOf: classOop) between: ValueIndex + 1 and: ValueIndex + 2)
- and: [(objectMemory isBytes: (objectMemory fetchPointer: KeyIndex ofObject: oop))]]) ifTrue:
- [| classLookupKey |
- classLookupKey := objectMemory fetchClassOfNonImm: (objectMemory splObj: SchedulerAssociation).
- [classLookupKey = objectMemory nilObject ifTrue:
- [^(('AEIOU' includes: name first) ifTrue: ['an '] ifFalse: ['a ']), name].
-  (objectMemory instanceSizeOf: classLookupKey) = (KeyIndex + 1)] whileFalse:
- [classLookupKey := self superclassOf: classLookupKey].
- (self includesBehavior: classOop ThatOf: classLookupKey) ifTrue:
- [^(('AEIOU' includes: name first) ifTrue: ['an '] ifFalse: ['a ']), name,
- ' ', (self shortPrint: (objectMemory fetchPointer: KeyIndex ofObject: oop)),
- ' -> ',
- (objectMemory fetchPointer: ValueIndex ofObject: oop) hex8]].
- ^(('AEIOU' includes: name first) ifTrue: ['an '] ifFalse: ['a ']), name!

Item was added:
+ ----- Method: InterpreterPrimitives>>isAppropriateForCopyObject: (in category 'object access primitives') -----
+ isAppropriateForCopyObject: oop
+ ^objectMemory isPointersNonImm: oop!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveCopyObject (in category 'object access primitives') -----
  primitiveCopyObject
  "Primitive. Copy the state of the receiver from the argument.
+ Fail if receiver and argument are of a different class.
+ Fail if the receiver or argument are contexts (because of context-to-stack mapping).
- Fail if receiver and argument are of a different class.
- Fail if the receiver or argument are non-pointer objects.
  Fail if receiver and argument have different lengths (for indexable objects).
+ Fail if the objects are not in a fit state to be copied (e.g. married contexts and Cogged methods)"
- "
  | rcvr arg length |
+ self methodArgumentCount >= 1 ifFalse:
+ [^self primitiveFailFor: PrimErrBadNumArgs].
+ arg := self stackTop.
+ rcvr := self stackValue: 1.
+ (objectMemory isImmediate: rcvr) ifTrue:
+ [^self primitiveFailFor: PrimErrBadReceiver].
+ (objectMemory isImmediate: arg) ifTrue:
+ [^self primitiveFailFor: PrimErrBadArgument].
- self methodArgumentCount = 1 ifFalse:
- [^self primitiveFail].
- arg := self stackObjectValue: 0.
- rcvr := self stackObjectValue: 1.
 
+ (objectMemory fetchClassTagOfNonImm: rcvr)
+ ~= (objectMemory fetchClassTagOfNonImm: arg) ifTrue:
+ [^self primitiveFailFor: PrimErrBadArgument].
- self failed ifTrue:[^nil].
- (objectMemory isPointers: rcvr) ifFalse:
- [^self primitiveFail].
- (objectMemory fetchClassOfNonImm: rcvr) = (objectMemory fetchClassOfNonImm: arg) ifFalse:
- [^self primitiveFail].
- length := objectMemory lengthOf: rcvr.
- length = (objectMemory lengthOf: arg) ifFalse:
- [^self primitiveFail].
-
- "Now copy the elements"
- 0 to: length-1 do:[:i|
- objectMemory storePointer: i ofObject: rcvr withValue: (objectMemory fetchPointer: i ofObject: arg)].
 
+ (objectMemory isWordsOrBytesNonImm: rcvr)
+ ifTrue:
+ [length := objectMemory numBytesOf: rcvr.
+ ((objectMemory formatOf: rcvr) = (objectMemory formatOf: arg)
+  and: [length = (objectMemory numBytesOf: arg)]) ifFalse:
+ [^self primitiveFailFor: PrimErrBadArgument].
+ self mem: rcvr + objectMemory baseHeaderSize
+ cp: arg + objectMemory baseHeaderSize
+ y: length]
+ ifFalse:
+ [(self isAppropriateForCopyObject: rcvr) ifFalse:
+ [^self primitiveFailFor: PrimErrBadReceiver].
+ length := objectMemory numSlotsOf: rcvr.
+ ((self isAppropriateForCopyObject: arg)
+  and: [length = (objectMemory lengthOf: arg)]) ifFalse:
+ [^self primitiveFailFor: PrimErrBadArgument].
+ 0 to: length - 1 do:
+ [:i|
+ objectMemory
+ storePointer: i
+ ofObject: rcvr
+ withValue: (objectMemory fetchPointer: i ofObject: arg)]].
+
  "Note: The above could be faster for young receivers but I don't think it'll matter"
+ self pop: self methodArgumentCount "pop arg; answer receiver"!
- self pop: 1. "pop arg; answer receiver"
- !

Item was added:
+ ----- Method: NewObjectMemory>>dbgFloatValueOf: (in category 'interpreter access') -----
+ dbgFloatValueOf: oop
+ "Answer the C double precision floating point value of the argument,
+ or if it is not, answer 0."
+
+ | isFloat result |
+ <returnTypeC: #double>
+ <var: #result type: #double>
+ isFloat := self isFloatInstance: oop.
+ isFloat ifTrue:
+ [self cCode: '' inSmalltalk: [result := Float new: 2].
+ self fetchFloatAt: oop + self baseHeaderSize into: result.
+ ^result].
+ ^0.0!

Item was removed:
- ----- Method: NewspeakInterpreter>>dbgFloatValueOf: (in category 'utilities') -----
- dbgFloatValueOf: oop
- "This version answers the value of a float or nil if not a flat *WITHOUT* setting successFlag or any other such nonsense.  It is hence safe for use in debug printing.  Sheesh."
-
- | result |
- <returnTypeC: #double>
- <var: #result type: #double>
- self flag: #Dan.  "None of the float stuff has been converted for 64 bits"
- ((self isNonIntegerObject: oop)
- and: [(self fetchClassOfNonImm: oop) = (self splObj: ClassFloat)]) ifTrue:
- [self cCode: '' inSmalltalk: [result := Float new: 2].
- self fetchFloatAt: oop + self baseHeaderSize into: result.
- ^result].
- ^nil!

Item was added:
+ ----- Method: ObjectMemory>>dbgFloatValueOf: (in category 'interpreter access') -----
+ dbgFloatValueOf: oop
+ "Answer the C double precision floating point value of the argument,
+ or if it is not, answer 0."
+
+ | isFloat result |
+ <returnTypeC: #double>
+ <var: #result type: #double>
+ isFloat := self isFloatInstance: oop.
+ isFloat ifTrue:
+ [self cCode: '' inSmalltalk: [result := Float new: 2].
+ self fetchFloatAt: oop + self baseHeaderSize into: result.
+ ^result].
+ ^0.0!

Item was added:
+ ----- Method: ObjectMemory>>isImmediateFloat: (in category 'interpreter access') -----
+ isImmediateFloat: oop
+ ^false!

Item was added:
+ ----- Method: Spur32BitMemoryManager>>dbgFloatValueOf: (in category 'interpreter access') -----
+ dbgFloatValueOf: oop
+ "Answer the C double precision floating point value of the argument,
+ or if it is not, answer 0."
+
+ | isFloat result |
+ <returnTypeC: #double>
+ <var: #result type: #double>
+ isFloat := self isFloatInstance: oop.
+ isFloat ifTrue:
+ [self cCode: '' inSmalltalk: [result := Float new: 2].
+ self fetchFloatAt: oop + self baseHeaderSize into: result.
+ ^result].
+ ^0.0!

Item was added:
+ ----- Method: Spur32BitMemoryManager>>isImmediateFloat: (in category 'interpreter access') -----
+ isImmediateFloat: oop
+ ^false!

Item was added:
+ ----- Method: Spur64BitMemoryManager>>dbgFloatValueOf: (in category 'interpreter access') -----
+ dbgFloatValueOf: oop
+ "Answer the C double precision floating point value of the argument,
+ or if it is not, answer 0."
+
+ | result tagBits |
+ <returnTypeC: #double>
+ <var: #result type: #double>
+ (tagBits := oop bitAnd: self tagMask) ~= 0
+ ifTrue:
+ [tagBits = self smallFloatTag ifTrue:
+ [^self smallFloatValueOf: oop]]
+ ifFalse:
+ [(self classIndexOf: oop) = ClassFloatCompactIndex ifTrue:
+ [self cCode: '' inSmalltalk: [result := Float new: 2].
+ self fetchFloatAt: oop + self baseHeaderSize into: result.
+ ^result]].
+ ^0.0!

Item was added:
+ ----- Method: Spur64BitMemoryManager>>isImmediateFloat: (in category 'interpreter access') -----
+ isImmediateFloat: oop
+ <inline: true>
+ ^(oop bitAnd: self tagMask) = self smallFloatTag!

Item was added:
+ ----- Method: SpurMemoryManager>>dbgFloatValueOf: (in category 'interpreter access') -----
+ dbgFloatValueOf: oop
+ "Answer the C double precision floating point value of the argument,
+ or if it is not, answer 0."
+
+ self subclassResponsibility!

Item was changed:
  ----- Method: SpurMemoryManager>>isCompiledMethod: (in category 'object testing') -----
  isCompiledMethod: objOop
      "Answer whether the argument object is of compiled method format"
  <api>
+     ^(self formatOf: objOop) >= self firstCompiledMethodFormat!
-     ^(self formatOf: objOop) >= 24!

Item was added:
+ ----- Method: SpurMemoryManager>>isImmediateFloat: (in category 'interpreter access') -----
+ isImmediateFloat: oop
+ self subclassResponsibility!

Item was changed:
  ----- Method: SpurMemoryManager>>isWordsOrBytes: (in category 'object testing') -----
  isWordsOrBytes: oop
+ "Answer if the contains only indexable words or bytes (no oops). See comment in formatOf:"
+ "Note: Excludes CompiledMethods."
  ^(self isNonImmediate: oop)
   and: [self isWordsOrBytesNonImm: oop]!

Item was changed:
  ----- Method: SpurMemoryManager>>isWordsOrBytesNonImm: (in category 'object testing') -----
  isWordsOrBytesNonImm: objOop
+ "Answer if the contains only indexable words or bytes (no oops). See comment in formatOf:"
+ "Note: Excludes CompiledMethods."
+ ^self isPureBitsFormat: (self formatOf: objOop)!
- ^(self formatOf: objOop) >= self sixtyFourBitIndexableFormat!

Item was removed:
- ----- Method: StackInterpreter>>dbgFloatValueOf: (in category 'utilities') -----
- dbgFloatValueOf: oop
- "This version answers the value of a float or nil if not a flat *WITHOUT* setting successFlag or any other such nonsense.  It is hence safe for use in debug printing.  Sheesh."
-
- | result |
- <returnTypeC: #double>
- <var: #result type: #double>
- self flag: #Dan.  "None of the float stuff has been converted for 64 bits"
- ((objectMemory isNonImmediate: oop)
- and: [(objectMemory fetchClassOfNonImm: oop) = (objectMemory splObj: ClassFloat)]) ifTrue:
- [self cCode: '' inSmalltalk: [result := Float new: 2].
- objectMemory fetchFloatAt: oop + objectMemory baseHeaderSize into: result.
- ^result].
- ^nil!

Item was changed:
  ----- Method: StackInterpreter>>printOop: (in category 'debug printing') -----
  printOop: oop
  | cls fmt lastIndex startIP bytecodesPerLine column |
  <inline: false>
  (objectMemory isImmediate: oop) ifTrue:
  [^self shortPrintOop: oop].
  self printHex: oop.
  (objectMemory addressCouldBeObj: oop) ifFalse:
  [^self print: ((oop bitAnd: objectMemory allocationUnit - 1) ~= 0
  ifTrue: [' is misaligned']
  ifFalse: [self whereIs: oop]); cr].
  (objectMemory isFreeObject: oop) ifTrue:
  [^self print: ' is a free chunk of size '; printNum: (objectMemory sizeOfFree: oop); cr].
  (objectMemory isForwarded: oop) ifTrue:
  [^self
  print: ' is a forwarded object to '; printHex: (objectMemory followForwarded: oop);
  print: ' of slot size '; printNum: (objectMemory numSlotsOfAny: oop); cr].
  self print: ': a(n) '.
  self printNameOfClass: (cls := objectMemory fetchClassOfNonImm: oop) count: 5.
  cls = (objectMemory splObj: ClassFloat) ifTrue:
+ [^self cr; printFloat: (objectMemory dbgFloatValueOf: oop); cr].
- [^self cr; printFloat: (self dbgFloatValueOf: oop); cr].
  fmt := objectMemory formatOf: oop.
  fmt > objectMemory lastPointerFormat ifTrue:
  [self print: ' nbytes '; printNum: (objectMemory numBytesOf: oop)].
  self cr.
  (fmt between: objectMemory firstLongFormat and: objectMemory firstCompiledMethodFormat - 1) ifTrue:
  ["This will answer false if splObj: ClassAlien is nilObject"
  (self is: oop KindOfClass: (objectMemory splObj: ClassAlien)) ifTrue:
  [self print: ' datasize '; printNum: (self sizeOfAlienData: oop).
  self print: ((self isIndirectAlien: oop)
  ifTrue: [' indirect @ ']
  ifFalse:
  [(self isPointerAlien: oop)
  ifTrue: [' pointer @ ']
  ifFalse: [' direct @ ']]).
  ^self printHex: (self startOfAlienData: oop) asUnsignedInteger; cr].
  (objectMemory isWords: oop) ifTrue:
  [lastIndex := 64 min: ((objectMemory numBytesOf: oop) / objectMemory wordSize).
  lastIndex > 0 ifTrue:
  [1 to: lastIndex do:
  [:index|
  self space; printHex: (objectMemory fetchLong32: index - 1 ofObject: oop).
  (index \\ self elementsPerPrintOopLine) = 0 ifTrue:
  [self cr]].
  (lastIndex \\ self elementsPerPrintOopLine) = 0 ifFalse:
  [self cr]].
  ^self].
  ^self printStringOf: oop; cr].
  "this is nonsense.  apologies."
  startIP := (objectMemory lastPointerOf: oop) + objectMemory bytesPerOop - objectMemory baseHeaderSize / objectMemory bytesPerOop.
  lastIndex := 256 min: startIP.
  lastIndex > 0 ifTrue:
  [1 to: lastIndex do:
  [:index|
  self cCode: [self printHex: (objectMemory fetchPointer: index - 1 ofObject: oop); space]
  inSmalltalk: [self space; printHex: (objectMemory fetchPointer: index - 1 ofObject: oop); space.
  self print: (self shortPrint: (objectMemory fetchPointer: index - 1 ofObject: oop))].
  (index \\ self elementsPerPrintOopLine) = 0 ifTrue:
  [self cr]].
  (lastIndex \\ self elementsPerPrintOopLine) = 0 ifFalse:
  [self cr]].
  (objectMemory isCompiledMethod: oop)
  ifFalse:
  [startIP > 64 ifTrue: [self print: '...'; cr]]
  ifTrue:
  [startIP := startIP * objectMemory wordSize + 1.
  lastIndex := objectMemory lengthOf: oop.
  lastIndex - startIP > 100 ifTrue:
  [lastIndex := startIP + 100].
  bytecodesPerLine := 8.
  column := 1.
  startIP to: lastIndex do:
  [:index| | byte |
  column = 1 ifTrue:
  [self cCode: 'printf("0x%08x: ", oop+BaseHeaderSize+index-1)'
  inSmalltalk: [self print: (oop+objectMemory baseHeaderSize+index-1) hex; print: ': ']].
  byte := objectMemory fetchByte: index - 1 ofObject: oop.
  self cCode: 'printf(" %02x/%-3d", byte,byte)'
  inSmalltalk: [self space; print: (byte radix: 16); printChar: $/; printNum: byte].
  column := column + 1.
  column > bytecodesPerLine ifTrue:
  [column := 1. self cr]].
  column = 1 ifFalse:
  [self cr]]!

Item was changed:
  ----- Method: StackInterpreter>>printOopShortInner: (in category 'debug printing') -----
  printOopShortInner: oop
  | classOop name nameLen |
  <var: #name type: #'char *'>
  <inline: true>
  (objectMemory isImmediate: oop) ifTrue:
  [(objectMemory isImmediateCharacter: oop) ifTrue:
  [^self
  printChar: $$;
  printChar: (objectMemory characterValueOf: oop);
  printChar: $(;
  printHex: (objectMemory integerValueOf: oop);
  printChar: $)].
  ^self
  printNum: (objectMemory integerValueOf: oop);
  printChar: $(;
  printHex: (objectMemory integerValueOf: oop);
  printChar: $)].
  (objectMemory addressCouldBeObj: oop) ifFalse:
  [^self print: ((oop bitAnd: objectMemory allocationUnit - 1) ~= 0
  ifTrue: [' is misaligned']
  ifFalse: [self whereIs: oop])].
  (objectMemory isFreeObject: oop) ifTrue:
  [^self print: ' is a free chunk'].
  (objectMemory isForwarded: oop) ifTrue:
  [^self print: ' is a forwarder to '; printHex: (objectMemory followForwarded: oop)].
  (self isFloatObject: oop) ifTrue:
+ [^self printFloat: (objectMemory dbgFloatValueOf: oop)].
- [^self printFloat: (self dbgFloatValueOf: oop)].
  classOop := objectMemory fetchClassOfNonImm: oop.
  (objectMemory addressCouldBeObj: classOop) ifFalse:
  [^self print: 'a ??'].
  (objectMemory numSlotsOf: classOop) = metaclassNumSlots ifTrue:
  [^self printNameOfClass: oop count: 5].
  oop = objectMemory nilObject ifTrue: [^self print: 'nil'].
  oop = objectMemory trueObject ifTrue: [^self print: 'true'].
  oop = objectMemory falseObject ifTrue: [^self print: 'false'].
  nameLen := self lengthOfNameOfClass: classOop.
  nameLen = 0 ifTrue: [^self print: 'a ??'].
  name := self nameOfClass: classOop.
  nameLen = 10 ifTrue:
  [(self str: name n: 'ByteString' cmp: 10) = 0 "strncmp is weird" ifTrue:
  [^self printChar: $'; printStringOf: oop; printChar: $'].
  (self str: name n: 'ByteSymbol' cmp: 10) = 0 "strncmp is weird" ifTrue:
  [self printChar: $#; printStringOf: oop. ^self]].
  (nameLen = 9 and: [(self str: name n: 'Character' cmp: 9) = 0]) ifTrue:
  [^self printChar: $$; printChar: (objectMemory integerValueOf: (objectMemory fetchPointer: 0 ofObject: oop))].
  self print: 'a(n) '.
  self
  cCode: [0 to: nameLen - 1 do: [:i| self printChar: (name at: i)]]
  inSmalltalk:
  [name isString
  ifTrue: [self print: name]
  ifFalse: [0 to: nameLen - 1 do: [:i| self printChar: (name at: i)]]].
  "Try to spot association-like things; they're all subclasses of LookupKey"
  ((objectMemory isPointersNonImm: oop)
  and: [(objectMemory instanceSizeOf: classOop) = (ValueIndex + 1)
  and: [(objectMemory isBytes: (objectMemory fetchPointer: KeyIndex ofObject: oop))]]) ifTrue:
  [| classLookupKey |
  classLookupKey := objectMemory fetchClassOfNonImm: (objectMemory splObj: SchedulerAssociation).
  [classLookupKey = objectMemory nilObject ifTrue:
  [^self].
   (objectMemory instanceSizeOf: classLookupKey) = (KeyIndex + 1)] whileFalse:
  [classLookupKey := self superclassOf: classLookupKey].
  (self includesBehavior: classOop ThatOf: classLookupKey) ifTrue:
  [self space;
  printOopShort: (objectMemory fetchPointer: KeyIndex ofObject: oop);
  print: ' -> ';
  printHex: (objectMemory fetchPointer: ValueIndex ofObject: oop)]]!

Item was added:
+ ----- Method: StackInterpreter>>shortPrint: (in category 'simulation') -----
+ shortPrint: oop
+ <doNotGenerate>
+ | name classOop |
+ (objectMemory isImmediate: oop) ifTrue:
+ [(objectMemory isImmediateCharacter: oop) ifTrue:
+ [^(objectMemory characterValueOf: oop) < 256
+ ifTrue:
+ ['=$', (objectMemory characterValueOf: oop) printString,
+ ' (', (String with: (Character value: (objectMemory characterValueOf: oop))), ')']
+ ifFalse:
+ ['=$', (objectMemory characterValueOf: oop) printString, '(???)']].
+ (objectMemory isIntegerObject: oop) ifTrue:
+ [^'=', (objectMemory integerValueOf: oop) printString,
+ ' (', (objectMemory integerValueOf: oop) hex, ')'].
+ (objectMemory isImmediateFloat: oop) ifTrue:
+ [^ '=', (objectMemory floatValueOf: oop) printString, ' (', oop hex, ')'].
+ ^'= UNKNOWN IMMEDIATE', ' (', (objectMemory integerValueOf: oop) hex, ')'].
+ (objectMemory addressCouldBeObj: oop) ifFalse:
+ [^(oop bitAnd: objectMemory allocationUnit - 1) ~= 0
+ ifTrue: [' is misaligned']
+ ifFalse: [self whereIs: oop]].
+ (objectMemory isFreeObject: oop) ifTrue:
+ [^' is a free chunk of size ', (objectMemory sizeOfFree: oop) printString].
+ (objectMemory isForwarded: oop) ifTrue:
+ [^' is a forwarded object to ', (objectMemory followForwarded: oop) hex,
+ ' of slot size ', (objectMemory numSlotsOfAny: oop) printString].
+ (objectMemory isFloatInstance: oop) ifTrue:
+ [^'=', (objectMemory dbgFloatValueOf: oop) printString].
+ oop = objectMemory nilObject ifTrue:
+ [^'nil'].
+ oop = objectMemory falseObject ifTrue:
+ [^'false'].
+ oop = objectMemory trueObject ifTrue:
+ [^'true'].
+
+ classOop := objectMemory fetchClassOfNonImm: oop.
+ ((self objCouldBeClassObj: oop)
+ and: [(objectMemory numSlotsOf: classOop) = metaclassNumSlots]) ifTrue:
+ [^'class ', (self nameOfClass: oop)].
+ name := self nameOfClass: classOop.
+ name size = 0 ifTrue: [name := '??'].
+ (#('String'  'ByteString') includes: name) ifTrue:
+ [^(self stringOf: oop) printString].
+ (#('Symbol'  'ByteSymbol') includes: name) ifTrue:
+ [^'#', (self stringOf: oop)].
+ name = 'Character' ifTrue: "SpurMemoryManager has immediate Characters (see above); ObjectMemory does not"
+ [^'=', (Character value: (objectMemory integerValueOf:
+ (objectMemory fetchPointer: 0 ofObject: oop))) printString].
+
+ "Try to spot association-like things; they're all subclasses of LookupKey"
+ ((objectMemory isPointersNonImm: oop)
+ and: [((objectMemory instanceSizeOf: classOop) between: ValueIndex + 1 and: ValueIndex + 2)
+ and: [(objectMemory isBytes: (objectMemory fetchPointer: KeyIndex ofObject: oop))]]) ifTrue:
+ [| classLookupKey |
+ classLookupKey := objectMemory fetchClassOfNonImm: (objectMemory splObj: SchedulerAssociation).
+ [classLookupKey = objectMemory nilObject ifTrue:
+ [^(('AEIOU' includes: name first) ifTrue: ['an '] ifFalse: ['a ']), name].
+  (objectMemory instanceSizeOf: classLookupKey) = (KeyIndex + 1)] whileFalse:
+ [classLookupKey := self superclassOf: classLookupKey].
+ (self includesBehavior: classOop ThatOf: classLookupKey) ifTrue:
+ [^(('AEIOU' includes: name first) ifTrue: ['an '] ifFalse: ['a ']), name,
+ ' ', (self shortPrint: (objectMemory fetchPointer: KeyIndex ofObject: oop)),
+ ' -> ',
+ (objectMemory fetchPointer: ValueIndex ofObject: oop) hex8]].
+
+ ^(('AEIOU' includes: name first) ifTrue: ['an '] ifFalse: ['a ']), name!

Item was added:
+ ----- Method: StackInterpreterPrimitives>>isAppropriateForCopyObject: (in category 'object access primitives') -----
+ isAppropriateForCopyObject: oop
+ (objectMemory isPointersNonImm: oop) ifFalse:
+ [^false].
+ (objectMemory isContext: oop) ifTrue:
+ [^(self isStillMarriedContext: oop) not].
+ "Note there is no version in CoInterpreterPrimtiives such as
+ (objectMemory isCompiledMethod: oop) ifTrue:
+ [^(self methodHasCogMethod: oop) not].
+ because isPointersNonImm: excludes compiled methods and the
+ copy loop in primitiveCopyObject cannot handle compiled methods."
+ ^true!

Item was removed:
- ----- Method: StackInterpreterPrimitives>>primitiveCopyObject (in category 'object access primitives') -----
- primitiveCopyObject
- "Primitive. Copy the state of the receiver from the argument.
- Fail if receiver and argument are of a different class.
- Fail if the receiver or argument are non-pointer objects.
- Fail if the receiver or argument are contexts (because of context-to-stack mapping).
- Fail if receiver and argument have different lengths (for indexable objects).
- "
- | rcvr arg length |
- self methodArgumentCount = 1 ifFalse:
- [^self primitiveFail].
- arg := self stackObjectValue: 0.
- rcvr := self stackObjectValue: 1.
-
- self failed ifTrue:[^nil].
- (objectMemory isPointers: rcvr) ifFalse:
- [^self primitiveFail].
- ((objectMemory isContextNonImm: rcvr)
- or: [objectMemory isContextNonImm: arg]) ifTrue:
- [^self primitiveFail].
- (objectMemory fetchClassOfNonImm: rcvr) = (objectMemory fetchClassOfNonImm: arg) ifFalse:
- [^self primitiveFail].
- length := objectMemory lengthOf: rcvr.
- length = (objectMemory lengthOf: arg) ifFalse:
- [^self primitiveFail].
-
- "Now copy the elements"
- 0 to: length-1 do:
- [:i|
- objectMemory storePointer: i ofObject: rcvr withValue: (objectMemory fetchPointer: i ofObject: arg)].
-
- "Note: The above could be faster for young receivers but I don't think it'll matter"
- self pop: 1 "pop arg; answer receiver"
- !

Item was removed:
- ----- Method: StackInterpreterSimulator>>shortPrint: (in category 'debug support') -----
- shortPrint: oop
- | name classOop |
- (objectMemory isImmediate: oop) ifTrue:
- [(objectMemory isImmediateCharacter: oop) ifTrue:
- [^(objectMemory characterValueOf: oop) < 256
- ifTrue:
- ['=$' , (objectMemory characterValueOf: oop) printString ,
- ' (' , (String with: (Character value: (objectMemory characterValueOf: oop))) , ')']
- ifFalse:
- ['=$' , (objectMemory characterValueOf: oop) printString, '(???)']].
- (objectMemory isIntegerObject: oop) ifTrue:
- [^ '=' , (objectMemory integerValueOf: oop) printString ,
- ' (' , (objectMemory integerValueOf: oop) hex , ')'].
- ^'= UNKNOWN IMMEDIATE', ' (' , (objectMemory integerValueOf: oop) hex , ')'].
- (objectMemory addressCouldBeObj: oop) ifFalse:
- [^(oop bitAnd: objectMemory allocationUnit - 1) ~= 0
- ifTrue: [' is misaligned']
- ifFalse: [self whereIs: oop]].
- (objectMemory isFreeObject: oop) ifTrue:
- [^' is a free chunk of size ', (objectMemory sizeOfFree: oop) printString].
- (objectMemory isForwarded: oop) ifTrue:
- [^' is a forwarded object to ', (objectMemory followForwarded: oop) hex,
- ' of slot size ', (objectMemory numSlotsOfAny: oop) printString].
- classOop := objectMemory fetchClassOfNonImm: oop.
- classOop ifNil: [^' has a nil class!!!!'].
- (objectMemory numSlotsOf: classOop) = metaclassNumSlots ifTrue:
- [^'class ' , (self nameOfClass: oop)].
- name := self nameOfClass: classOop.
- name size = 0 ifTrue: [name := '??'].
- name = 'String' ifTrue: [^ (self stringOf: oop) printString].
- name = 'ByteString' ifTrue: [^ (self stringOf: oop) printString].
- name = 'Symbol' ifTrue: [^ '#' , (self stringOf: oop)].
- name = 'ByteSymbol' ifTrue: [^ '#' , (self stringOf: oop)].
- name = 'Character' ifTrue: "SpurMemoryManager has immediate Characters; ObjectMemory does not"
- [^ '=' , (Character value: (objectMemory integerValueOf:
- (objectMemory fetchPointer: 0 ofObject: oop))) printString].
- name = 'UndefinedObject' ifTrue: [^ 'nil'].
- name = 'False' ifTrue: [^ 'false'].
- name = 'True' ifTrue: [^ 'true'].
- name = 'Float' ifTrue: [^ '=' , (self dbgFloatValueOf: oop) printString].
- (#('Association' 'ReadOnlyVariableBinding' 'VariableBinding') includes: name) ifTrue:
- [^ '(' ,
- (self shortPrint: (self longAt: oop + objectMemory baseHeaderSize)) ,
- ' -> ' ,
- (self longAt: oop + objectMemory baseHeaderSize + objectMemory wordSize) hex8 , ')'].
- ^(('AEIOU' includes: name first) ifTrue: ['an '] ifFalse: ['a ']), name!