[Vm-dev] VM Maker: VMMaker.oscog-eem.959.mcz
commits at source.squeak.org
commits at source.squeak.org
Mon Dec 1 22:36:55 UTC 2014
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!
More information about the Vm-dev
mailing list