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

commits at source.squeak.org commits at source.squeak.org
Thu Dec 18 22:05:20 UTC 2014


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

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

Name: VMMaker.oscog-eem.992
Author: eem
Time: 18 December 2014, 2:02:17.161 pm
UUID: bbbe8c5f-97d3-42fe-b068-76c6890a1733
Ancestors: VMMaker.oscog-eem.991

64-bit Spur:
Correct a few comparisons and shifts in small float
code to make comparisons in generated C correct.

Move loadFloatOrInt: into the ObjectMemory
hierarchies to allow Spur64BitMemoryManager
to generate better code.

Make printOopShortInner: small-float savvy.

Make printHexnp: 64-bit aware.

Can now interact with a 64-bit Spur image.

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

Item was removed:
- ----- Method: Interpreter>>loadFloatOrIntFrom: (in category 'utilities') -----
- loadFloatOrIntFrom: floatOrInt
- 	"If floatOrInt is an integer, then convert it to a C double float and return it.
- 	 If it is a Float, then load its value and return it.
- 	 Otherwise fail -- ie return with primErrorCode non-zero."
- 
- 	<inline: true>
- 	<returnTypeC: #double>
- 
- 	(self isIntegerObject: floatOrInt) ifTrue:
- 		[^(self integerValueOf: floatOrInt) asFloat].
- 	^self floatValueOf: floatOrInt!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveSmallFloatAdd (in category 'arithmetic float primitives') -----
  primitiveSmallFloatAdd
  	<option: #Spur64BitMemoryManager>
  	| rcvr arg |
  	<var: #rcvr type: #double>
  	<var: #arg type: #double>
  
  	rcvr := objectMemory smallFloatValueOf: (self stackValue: 1).
+ 	arg := objectMemory loadFloatOrIntFrom: self stackTop.
- 	arg := self loadFloatOrIntFrom: self stackTop.
  	self successful ifTrue:
  		[self pop: 2 thenPushFloat: rcvr + arg]!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveSmallFloatDivide (in category 'arithmetic float primitives') -----
  primitiveSmallFloatDivide
  	<option: #Spur64BitMemoryManager>
  	| rcvr arg |
  	<var: #rcvr type: #double>
  	<var: #arg type: #double>
  
  	rcvr := objectMemory smallFloatValueOf: (self stackValue: 1).
+ 	arg := objectMemory loadFloatOrIntFrom: self stackTop.
- 	arg := self loadFloatOrIntFrom: self stackTop.
  	self successful ifTrue:
  		[self pop: 2 thenPushFloat: rcvr / arg]!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveSmallFloatEqual (in category 'arithmetic float primitives') -----
  primitiveSmallFloatEqual
  	<option: #Spur64BitMemoryManager>
  	| rcvr arg |
  	<var: #rcvr type: #double>
  	<var: #arg type: #double>
  
  	rcvr := objectMemory smallFloatValueOf: (self stackValue: 1).
+ 	arg := objectMemory loadFloatOrIntFrom: self stackTop.
- 	arg := self loadFloatOrIntFrom: self stackTop.
  	self successful ifTrue:
  		[self pop: 2 thenPushBool: rcvr = arg]!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveSmallFloatGreaterOrEqual (in category 'arithmetic float primitives') -----
  primitiveSmallFloatGreaterOrEqual
  	<option: #Spur64BitMemoryManager>
  	| rcvr arg |
  	<var: #rcvr type: #double>
  	<var: #arg type: #double>
  
  	rcvr := objectMemory smallFloatValueOf: (self stackValue: 1).
+ 	arg := objectMemory loadFloatOrIntFrom: self stackTop.
- 	arg := self loadFloatOrIntFrom: self stackTop.
  	self successful ifTrue:
  		[self pop: 2 thenPushBool: rcvr >= arg]!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveSmallFloatGreaterThan (in category 'arithmetic float primitives') -----
  primitiveSmallFloatGreaterThan
  	<option: #Spur64BitMemoryManager>
  	| rcvr arg |
  	<var: #rcvr type: #double>
  	<var: #arg type: #double>
  
  	rcvr := objectMemory smallFloatValueOf: (self stackValue: 1).
+ 	arg := objectMemory loadFloatOrIntFrom: self stackTop.
- 	arg := self loadFloatOrIntFrom: self stackTop.
  	self successful ifTrue:
  		[self pop: 2 thenPushBool: rcvr > arg]!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveSmallFloatLessOrEqual (in category 'arithmetic float primitives') -----
  primitiveSmallFloatLessOrEqual
  	<option: #Spur64BitMemoryManager>
  	| rcvr arg |
  	<var: #rcvr type: #double>
  	<var: #arg type: #double>
  
  	rcvr := objectMemory smallFloatValueOf: (self stackValue: 1).
+ 	arg := objectMemory loadFloatOrIntFrom: self stackTop.
- 	arg := self loadFloatOrIntFrom: self stackTop.
  	self successful ifTrue:
  		[self pop: 2 thenPushBool: rcvr <= arg]!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveSmallFloatLessThan (in category 'arithmetic float primitives') -----
  primitiveSmallFloatLessThan
  	<option: #Spur64BitMemoryManager>
  	| rcvr arg |
  	<var: #rcvr type: #double>
  	<var: #arg type: #double>
  
  	rcvr := objectMemory smallFloatValueOf: (self stackValue: 1).
+ 	arg := objectMemory loadFloatOrIntFrom: self stackTop.
- 	arg := self loadFloatOrIntFrom: self stackTop.
  	self successful ifTrue:
  		[self pop: 2 thenPushBool: rcvr < arg]!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveSmallFloatMultiply (in category 'arithmetic float primitives') -----
  primitiveSmallFloatMultiply
  	<option: #Spur64BitMemoryManager>
  	| rcvr arg |
  	<var: #rcvr type: #double>
  	<var: #arg type: #double>
  
  	rcvr := objectMemory smallFloatValueOf: (self stackValue: 1).
+ 	arg := objectMemory loadFloatOrIntFrom: self stackTop.
- 	arg := self loadFloatOrIntFrom: self stackTop.
  	self successful ifTrue:
  		[self pop: 2 thenPushFloat: rcvr * arg]!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveSmallFloatNotEqual (in category 'arithmetic float primitives') -----
  primitiveSmallFloatNotEqual
  	<option: #Spur64BitMemoryManager>
  	| rcvr arg |
  	<var: #rcvr type: #double>
  	<var: #arg type: #double>
  
  	rcvr := objectMemory smallFloatValueOf: (self stackValue: 1).
+ 	arg := objectMemory loadFloatOrIntFrom: self stackTop.
- 	arg := self loadFloatOrIntFrom: self stackTop.
  	self successful ifTrue:
  		[self pop: 2 thenPushBool: (rcvr = arg) not]!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveSmallFloatSubtract (in category 'arithmetic float primitives') -----
  primitiveSmallFloatSubtract
  	<option: #Spur64BitMemoryManager>
  	| rcvr arg |
  	<var: #rcvr type: #double>
  	<var: #arg type: #double>
  
  	rcvr := objectMemory smallFloatValueOf: (self stackValue: 1).
+ 	arg := objectMemory loadFloatOrIntFrom: self stackTop.
- 	arg := self loadFloatOrIntFrom: self stackTop.
  	self successful ifTrue:
  		[self pop: 2 thenPushFloat: rcvr - arg]!

Item was removed:
- ----- Method: NewspeakInterpreter>>loadFloatOrIntFrom: (in category 'utilities') -----
- loadFloatOrIntFrom: floatOrInt
- 	"If floatOrInt is an integer, then convert it to a C double float and return it.
- 	 If it is a Float, then load its value and return it.
- 	 Otherwise fail -- ie return with primErrorCode non-zero."
- 
- 	<inline: true>
- 	<returnTypeC: #double>
- 
- 	(self isIntegerObject: floatOrInt) ifTrue:
- 		[^(self integerValueOf: floatOrInt) asFloat].
- 	^self floatValueOf: floatOrInt!

Item was added:
+ ----- Method: ObjectMemory>>loadFloatOrIntFrom: (in category 'interpreter access') -----
+ loadFloatOrIntFrom: floatOrInt
+ 	"If floatOrInt is an integer, then convert it to a C double float and return it.
+ 	 If it is a Float, then load its value and return it.
+ 	 Otherwise fail -- ie return with primErrorCode non-zero."
+ 
+ 	<inline: true>
+ 	<returnTypeC: #double>
+ 
+ 	(self isIntegerObject: floatOrInt) ifTrue:
+ 		[^(self integerValueOf: floatOrInt) asFloat].
+ 	^self floatValueOf: floatOrInt!

Item was added:
+ ----- Method: Spur32BitMemoryManager>>loadFloatOrIntFrom: (in category 'interpreter access') -----
+ loadFloatOrIntFrom: floatOrInt
+ 	"If floatOrInt is an integer, then convert it to a C double float and return it.
+ 	 If it is a Float, then load its value and return it.
+ 	 Otherwise fail -- ie return with primErrorCode non-zero."
+ 
+ 	<inline: true>
+ 	<returnTypeC: #double>
+ 
+ 	(self isIntegerObject: floatOrInt) ifTrue:
+ 		[^(self integerValueOf: floatOrInt) asFloat].
+ 	^self floatValueOf: floatOrInt!

Item was changed:
  ----- Method: Spur64BitMemoryManager>>exponentOfSmallFloat: (in category 'interpreter access') -----
  exponentOfSmallFloat: oop
  	"Answer the exponent of the argument, a SmallFloat.
  	 See section 61-bit Immediate Floats in the SpurMemoryManager class comment.
  				msb                                              lsb 
  				[8expsubset][52mantissa][1s][3tags]"
  	| exp |
  	self assert: (oop bitAnd: self tagMask) = self smallFloatTag.
+ 	^oop asUnsignedInteger <= 15
- 	^oop <= 15
  		ifTrue: [0]
  		ifFalse:
+ 			[exp := oop asUnsignedInteger >> (self numTagBits + self smallFloatMantissaBits + 1).
- 			[exp := oop >> (self numTagBits + self smallFloatMantissaBits + 1).
  			 exp + self smallFloatExponentOffset - 1022]!

Item was added:
+ ----- Method: Spur64BitMemoryManager>>loadFloatOrIntFrom: (in category 'interpreter access') -----
+ loadFloatOrIntFrom: floatOrIntOop
+ 	"If floatOrInt is an integer, then convert it to a C double float and return it.
+ 	 If it is a Float, then load its value and return it.
+ 	 Otherwise fail -- ie return with primErrorCode non-zero."
+ 
+ 	<inline: true>
+ 	<returnTypeC: #double>
+ 	| result tagBits |
+ 	<var: #result type: #double>
+ 
+ 	(tagBits := floatOrIntOop bitAnd: self tagMask) ~= 0
+ 		ifTrue:
+ 			[tagBits = self smallFloatTag ifTrue:
+ 				[^self smallFloatValueOf: floatOrIntOop].
+ 			 tagBits = self smallIntegerTag ifTrue:
+ 				[^(self integerValueOf: floatOrIntOop) asFloat]]
+ 		ifFalse:
+ 			[(self classIndexOf: floatOrIntOop) = ClassFloatCompactIndex ifTrue:
+ 				[self cCode: '' inSmalltalk: [result := Float new: 2].
+ 				 self fetchFloatAt: floatOrIntOop + self baseHeaderSize into: result.
+ 				 ^result]].
+ 	coInterpreter primitiveFail.
+ 	^0.0!

Item was changed:
  ----- Method: Spur64BitMemoryManager>>smallFloatObjectOf: (in category 'interpreter access') -----
  smallFloatObjectOf: aFloat
  	"Encode the argument, aFloat in the SmallFloat range, as a tagged small float.
  	 See section 61-bit Immediate Floats in the SpurMemoryManager class comment.
  
  	 Encode:				[1s][     11 exponent     ][52mantissa] 
  	 rot sign:				[     11 exponent     ][52mantissa][1s] 
  	 sub exponent offset:	[ 000 ][8expsubset][52 mantissa][1s] 
  	 shift:					[8expsubset][52 mantissa][1s][ 000 ] 
  	 or/add tags:			[8expsubset][52mantissa][1s][3tags]"
  	<inline: true>
  	<var: #aFloat type: #double>
  	| rawFloat rot |
+ 	<var: #rot type: #'unsigned long'>
  	self assert: (self isSmallFloatValue: aFloat).
  	rawFloat := self cCode: [(self cCoerce: (self addressOf: aFloat) to: 'sqLong *') at: 0]
  					inSmalltalk: [(aFloat at: 1) << 32 + (aFloat at: 2)].
  	rot := self rotateLeft: rawFloat.
  	rot > 1 ifTrue:
  		[rot := rot - (self smallFloatExponentOffset << (self smallFloatMantissaBits + 1)).
  		 self assert: rot > 0].
  	^self cCode: [rot << self numTagBits + self smallFloatTag]
  		inSmalltalk: [((rot << self numTagBits) bitAnd: 16rFFFFFFFFFFFFFFFF) + self smallFloatTag]!

Item was changed:
  ----- Method: Spur64BitMemoryManager>>smallFloatValueOf: (in category 'interpreter access') -----
  smallFloatValueOf: oop
  	"Answer the C double precision floating point value of the argument, a SmallFloat.
  	 See section 61-bit Immediate Floats in the SpurMemoryManager class comment.
  							msb                                              lsb 
  	 Decode:				[8expsubset][52mantissa][1s][3tags] 
  	 shift away tags:		[ 000 ][8expsubset][52mantissa][1s] 
  	 add exponent offset:	[     11 exponent     ][52mantissa][1s] 
  	 rot sign:				[1s][     11 exponent     ][52mantissa]"
  	| rot |
  	<returnTypeC: #double>
  	self assert: (oop bitAnd: self tagMask) = self smallFloatTag.
+ 	rot := oop asUnsignedInteger >> self numTagBits.
- 	rot := oop >> self numTagBits.
  	rot > 1 ifTrue:
  		[rot := rot + (self smallFloatExponentOffset << (self smallFloatMantissaBits + 1))].
  	rot := self rotateRight: rot.
  	^self cCode: [(self cCoerce: (self addressOf: rot) to: #'double *') at: 0]
  		inSmalltalk:
  			[(Float new: 2)
  				at: 1 put: rot >> 32;
  				at: 2 put: (rot bitAnd: 16rFFFFFFFF);
  				yourself]!

Item was added:
+ ----- Method: SpurMemoryManager>>loadFloatOrIntFrom: (in category 'interpreter access') -----
+ loadFloatOrIntFrom: floatOrInt
+ 	"If floatOrInt is an integer, then convert it to a C double float and return it.
+ 	 If it is a Float, then load its value and return it.
+ 	 Otherwise fail -- ie return with primErrorCode non-zero."
+ 
+ 	self subclassResponsibility!

Item was removed:
- ----- Method: StackInterpreter>>loadFloatOrIntFrom: (in category 'utilities') -----
- loadFloatOrIntFrom: floatOrInt
- 	"If floatOrInt is an integer, then convert it to a C double float and return it.
- 	 If it is a Float, then load its value and return it.
- 	 Otherwise fail -- ie return with primErrorCode non-zero."
- 
- 	<inline: true>
- 	<returnTypeC: #double>
- 
- 	(objectMemory isIntegerObject: floatOrInt) ifTrue:
- 		[^(objectMemory integerValueOf: floatOrInt) asFloat].
- 	^objectMemory floatValueOf: floatOrInt!

Item was changed:
  ----- Method: StackInterpreter>>primitiveFloatAdd:toArg: (in category 'arithmetic float primitives') -----
  primitiveFloatAdd: rcvrOop toArg: argOop
  	| rcvr arg |
  	<var: #rcvr type: #double>
  	<var: #arg type: #double>
  
+ 	rcvr := objectMemory loadFloatOrIntFrom: rcvrOop.
+ 	arg := objectMemory loadFloatOrIntFrom: argOop.
- 	rcvr := self loadFloatOrIntFrom: rcvrOop.
- 	arg := self loadFloatOrIntFrom: argOop.
  	self successful ifTrue:
  		[self pop: 2 thenPushFloat: rcvr + arg]!

Item was changed:
  ----- Method: StackInterpreter>>primitiveFloatDivide:byArg: (in category 'arithmetic float primitives') -----
  primitiveFloatDivide: rcvrOop byArg: argOop
  	| rcvr arg |
  	<var: #rcvr type: #double>
  	<var: #arg type: #double>
  
+ 	rcvr := objectMemory loadFloatOrIntFrom: rcvrOop.
+ 	arg := objectMemory loadFloatOrIntFrom: argOop.
- 	rcvr := self loadFloatOrIntFrom: rcvrOop.
- 	arg := self loadFloatOrIntFrom: argOop.
  	self success: arg ~= 0.0.
  	self successful ifTrue:
  		[self pop: 2 thenPushFloat: rcvr / arg]!

Item was changed:
  ----- Method: StackInterpreter>>primitiveFloatEqual:toArg: (in category 'comparison float primitives') -----
  primitiveFloatEqual: rcvrOop toArg: argOop
  	| rcvr arg |
  	<var: #rcvr type: #double>
  	<var: #arg type: #double>
  
+ 	rcvr := objectMemory loadFloatOrIntFrom: rcvrOop.
+ 	arg := objectMemory loadFloatOrIntFrom: argOop.
- 	rcvr := self loadFloatOrIntFrom: rcvrOop.
- 	arg := self loadFloatOrIntFrom: argOop.
  	^rcvr = arg!

Item was changed:
  ----- Method: StackInterpreter>>primitiveFloatGreater:thanArg: (in category 'comparison float primitives') -----
  primitiveFloatGreater: rcvrOop thanArg: argOop
  	| rcvr arg |
  	<var: #rcvr type: #double>
  	<var: #arg type: #double>
  
+ 	rcvr := objectMemory loadFloatOrIntFrom: rcvrOop.
+ 	arg := objectMemory loadFloatOrIntFrom: argOop.
- 	rcvr := self loadFloatOrIntFrom: rcvrOop.
- 	arg := self loadFloatOrIntFrom: argOop.
  	^rcvr > arg!

Item was changed:
  ----- Method: StackInterpreter>>primitiveFloatGreaterOrEqual:toArg: (in category 'comparison float primitives') -----
  primitiveFloatGreaterOrEqual: rcvrOop toArg: argOop
  	| rcvr arg |
  	<var: #rcvr type: #double>
  	<var: #arg type: #double>
  
+ 	rcvr := objectMemory loadFloatOrIntFrom: rcvrOop.
+ 	arg := objectMemory loadFloatOrIntFrom: argOop.
- 	rcvr := self loadFloatOrIntFrom: rcvrOop.
- 	arg := self loadFloatOrIntFrom: argOop.
  	^rcvr >= arg!

Item was changed:
  ----- Method: StackInterpreter>>primitiveFloatLess:thanArg: (in category 'comparison float primitives') -----
  primitiveFloatLess: rcvrOop thanArg: argOop
  	| rcvr arg |
  	<var: #rcvr type: #double>
  	<var: #arg type: #double>
  
+ 	rcvr := objectMemory loadFloatOrIntFrom: rcvrOop.
+ 	arg := objectMemory loadFloatOrIntFrom: argOop.
- 	rcvr := self loadFloatOrIntFrom: rcvrOop.
- 	arg := self loadFloatOrIntFrom: argOop.
  	^rcvr < arg!

Item was changed:
  ----- Method: StackInterpreter>>primitiveFloatLessOrEqual:toArg: (in category 'comparison float primitives') -----
  primitiveFloatLessOrEqual: rcvrOop toArg: argOop
  	| rcvr arg |
  	<var: #rcvr type: #double>
  	<var: #arg type: #double>
  
+ 	rcvr := objectMemory loadFloatOrIntFrom: rcvrOop.
+ 	arg := objectMemory loadFloatOrIntFrom: argOop.
- 	rcvr := self loadFloatOrIntFrom: rcvrOop.
- 	arg := self loadFloatOrIntFrom: argOop.
  	^rcvr <= arg!

Item was changed:
  ----- Method: StackInterpreter>>primitiveFloatMultiply:byArg: (in category 'arithmetic float primitives') -----
  primitiveFloatMultiply: rcvrOop byArg: argOop
  	| rcvr arg |
  	<var: #rcvr type: #double>
  	<var: #arg type: #double>
  
+ 	rcvr := objectMemory loadFloatOrIntFrom: rcvrOop.
+ 	arg := objectMemory loadFloatOrIntFrom: argOop.
- 	rcvr := self loadFloatOrIntFrom: rcvrOop.
- 	arg := self loadFloatOrIntFrom: argOop.
  	self successful ifTrue:
  		[self pop: 2 thenPushFloat: rcvr * arg]!

Item was changed:
  ----- Method: StackInterpreter>>primitiveFloatSubtract:fromArg: (in category 'arithmetic float primitives') -----
  primitiveFloatSubtract: rcvrOop fromArg: argOop
  	| rcvr arg |
  	<var: #rcvr type: #double>
  	<var: #arg type: #double>
  
+ 	rcvr := objectMemory loadFloatOrIntFrom: rcvrOop.
+ 	arg := objectMemory loadFloatOrIntFrom: argOop.
- 	rcvr := self loadFloatOrIntFrom: rcvrOop.
- 	arg := self loadFloatOrIntFrom: argOop.
  	self successful ifTrue:
  		[self pop: 2 thenPushFloat: rcvr - arg]!

Item was changed:
  ----- Method: StackInterpreter>>printHexnp: (in category 'debug printing') -----
  printHexnp: n
  	"Print n in hex,  in the form '0x1234', unpadded"
+ 	self print: '0x%lx' f: n!
- 	self print: '0x%x' f: n!

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: $(;
+ 				printHexnp: (objectMemory integerValueOf: oop);
- 				printHex: (objectMemory integerValueOf: oop);
  				printChar: $)].
+ 		 (objectMemory isIntegerObject: oop) ifTrue:
+ 			[^self
+ 				printNum: (objectMemory integerValueOf: oop);
+ 				printChar: $(;
+ 				printHexnp: (objectMemory integerValueOf: oop);
+ 				printChar: $)].
+ 		 (objectMemory isImmediateFloat: oop) ifTrue:
+ 			[^self
+ 				printFloat: (objectMemory dbgFloatValueOf: oop);
+ 				printChar: $(;
+ 				printHexnp: oop;
+ 				printChar: $)].
+ 		 ^self print: 'unknown immediate '; printHexnp: oop].
- 		^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 '; printHexnp: (objectMemory followForwarded: oop)].
- 		[^self print: ' is a forwarder to '; printHex: (objectMemory followForwarded: oop)].
  	(self isFloatObject: oop) ifTrue:
  		[^self printFloat: (objectMemory 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: ' -> ';
+ 				printHexnp: (objectMemory fetchPointer: ValueIndex ofObject: oop)]]!
- 				printHex: (objectMemory fetchPointer: ValueIndex ofObject: oop)]]!



More information about the Vm-dev mailing list