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

[commits at source.squeak.org]

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

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

Name: VMMaker.oscog-eem.178
Author: eem
Time: 27 June 2012, 8:14:54.544 pm
UUID: 8a31722d-f528-4495-bcf0-33544f9c93af
Ancestors: VMMaker.oscog-eem.177

Fix receiver if isBytes: in printOopShortInner:.
Include inst var offset in longPrintOop:.
Make doesNotUnderstand: redirection warnings more informative.

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

Item was changed:
  ----- Method: CogVMSimulator>>doesNotUnderstand: (in category 'error handling') -----
  doesNotUnderstand: aMessage
  	"If this is a doit and the objectMemory understands, pass it on."
  	(thisContext findContextSuchThat: [:ctxt| ctxt selector == #evaluate:in:to:notifying:ifFail:logged:]) ifNotNil:
  		[(objectMemory class whichClassIncludesSelector: aMessage selector) ifNotNil:
  			[:implementingClass|
  			(implementingClass inheritsFrom: Object) ifTrue: "i.e. VMClass and below"
+ 				[Transcript nextPutAll: 'warning: redirecting ', aMessage selector, ' in ', thisContext sender printString, ' to objectMemory'; cr; flush.
- 				[Transcript nextPutAll: 'warning: redirecting to objectMemory'; cr; flush.
  				 aMessage lookupClass: nil.
  				^aMessage sentTo: objectMemory]].
  		(cogit class whichClassIncludesSelector: aMessage selector) ifNotNil:
  			[:implementingClass|
  			(implementingClass inheritsFrom: Object) ifTrue: "i.e. VMClass and below"
+ 				[Transcript nextPutAll: 'warning: redirecting ', aMessage selector, ' in ', thisContext sender printString, ' to cogit'; cr; flush.
- 				[Transcript nextPutAll: 'warning: redirecting to cogit'; cr; flush.
  				 aMessage lookupClass: nil.
  				^aMessage sentTo: cogit]]].
  	^super doesNotUnderstand: aMessage!

Item was changed:
  ----- Method: StackInterpreter>>longPrintOop: (in category 'debug printing') -----
  longPrintOop: oop
  	<api>
  	| fmt lastIndex startIP bytecodesPerLine |
  	((objectMemory isIntegerObject: oop)
  	 or: [(oop between: objectMemory startOfMemory and: objectMemory freeStart) not
  	 or: [(oop bitAnd: (BytesPerWord - 1)) ~= 0
  	 or: [(objectMemory isFreeObject: oop)
  	 or: [(fmt := objectMemory formatOf: oop) between: 5 and: 11]]]]) ifTrue:
  		[^self printOop: oop].
  	self printHex: oop;
  		print: ': a(n) ';
  		printNameOfClass: (objectMemory fetchClassOfNonInt: oop) count: 5.
  	fmt > 4 ifTrue:
  		[self print: ' nbytes '; printNum: (objectMemory byteSizeOf: oop)].
  	self cr.
+ 	lastIndex := 256 min: (startIP := (objectMemory lastPointerOf: oop) / BytesPerWord).
- 	lastIndex := 64 min: (startIP := (objectMemory lastPointerOf: oop) / BytesPerWord).
  	lastIndex > 0 ifTrue:
  		[1 to: lastIndex do:
+ 			[:i| | fieldOop |
+ 			fieldOop := objectMemory fetchPointer: i - 1 ofObject: oop.
+ 			self space; printNum: i - 1; space; printHex: fieldOop; space; printOopShort: fieldOop; cr]].
- 			[:index| | fieldOop |
- 			fieldOop := objectMemory fetchPointer: index - 1 ofObject: oop.
- 			self space; printHex: fieldOop; space; printOopShort: fieldOop; cr]].
  	(objectMemory isCompiledMethod: oop)
  		ifFalse:
  			[startIP > 64 ifTrue: [self print: '...'; cr]]
  		ifTrue:
  			[startIP := startIP * BytesPerWord + 1.
  			 lastIndex := objectMemory lengthOf: oop.
  			 lastIndex - startIP > 104 ifTrue:
  				[lastIndex := startIP + 103].
  			 bytecodesPerLine := 8.
  			 startIP to: lastIndex do:
  				[:index| | byte |
  				byte := objectMemory fetchByte: index - 1 ofObject: oop.
  				self cCode: 'printf(" %02x/%-3d", byte,byte)'
  					inSmalltalk: [self space; print: (byte radix: 16); printChar: $/; printNum: byte].
  				(index = lastIndex and: [(objectMemory lengthOf: oop) > index]) ifTrue:
  					[self print: '...'].
  				((index - startIP + 1) \\ bytecodesPerLine) = 0 ifTrue:
  					[self cr]].
  			((lastIndex - startIP + 1) \\ bytecodesPerLine) = 0 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 isIntegerObject: oop) ifTrue:
  		[self printNum: (objectMemory integerValueOf: oop);
  			printChar: $(;
  			printHex: (objectMemory integerValueOf: oop);
  			printChar: $).
  		 ^nil].
  	(oop between: objectMemory startOfMemory and: objectMemory freeStart) ifFalse:
  		[self printHex: oop; print: ' is not on the heap'.
  		 ^nil].
  	(oop bitAnd: (BytesPerWord - 1)) ~= 0 ifTrue:
  		[self printHex: oop; print: ' is misaligned'.
  		 ^nil].
  	(self isFloatObject: oop) ifTrue:
  		[self printFloat: (self dbgFloatValueOf: oop).
  		 ^nil].
  	classOop := objectMemory fetchClassOfNonInt: oop.
  	(objectMemory addressCouldBeObj: classOop) ifFalse:
  		[self print: 'a ??'. ^nil].
  	(objectMemory sizeBitsOf: classOop) = metaclassSizeBits ifTrue:
  		[self printNameOfClass: oop count: 5.
  		 ^nil].
  	oop = objectMemory nilObject ifTrue: [self print: 'nil'. ^nil].
  	oop = objectMemory trueObject ifTrue: [self print: 'true'. ^nil].
  	oop = objectMemory falseObject ifTrue: [self print: 'false'. ^nil].
  	nameLen := self lengthOfNameOfClass: classOop.
  	nameLen = 0 ifTrue: [self print: 'a ??'. ^nil].
  	name := self nameOfClass: classOop.
  	nameLen = 10 ifTrue:
  		[(self str: name n: 'ByteString' cmp: 10) not "strncmp is weird" ifTrue:
  			[self printChar: $'; printStringOf: oop; printChar: $'.
  			 ^nil].
  		 (self str: name n: 'ByteSymbol' cmp: 10) not "strncmp is weird" ifTrue:
  			[self printChar: $#; printStringOf: oop.
  			 ^nil]].
  	(nameLen = 9 and: [(self str: name n: 'Character' cmp: 9) not]) ifTrue:
  		[self printChar: $$; printChar: (objectMemory integerValueOf: (objectMemory fetchPointer: 0 ofObject: oop)).
  		 ^nil].
  	self cCode: [self prin: 'a(n) %.*s' t: nameLen f: name]
  		inSmalltalk: [self print: 'a(n) '; print: name].
  	"Try to spot association-like things; they're all subclasses of LookupKey"
  	((objectMemory instanceSizeOf: classOop) = (ValueIndex + 1)
  	 and: [(self superclassOf: classOop) = (self superclassOf: (objectMemory fetchClassOfNonInt: (objectMemory splObj: SchedulerAssociation)))
+ 	 and: [objectMemory isBytes: (objectMemory fetchPointer: KeyIndex ofObject: oop)]]) ifTrue:
- 	 and: [self isBytes: (objectMemory fetchPointer: KeyIndex ofObject: oop)]]) ifTrue:
  		[self space;
  			printOopShort: (objectMemory fetchPointer: KeyIndex ofObject: oop);
  			print: ' -> ';
  			printHex: (objectMemory fetchPointer: ValueIndex ofObject: oop)]!

Item was changed:
  ----- Method: StackInterpreterSimulator>>doesNotUnderstand: (in category 'error handling') -----
  doesNotUnderstand: aMessage
  	"If this is a doit and the objectMemory understands, pass it on."
  	(thisContext findContextSuchThat: [:ctxt| ctxt selector == #evaluate:in:to:notifying:ifFail:logged:]) ifNotNil:
  		[(objectMemory class whichClassIncludesSelector: aMessage selector) ifNotNil:
  			[:implementingClass|
  			(implementingClass inheritsFrom: Object) ifTrue: "i.e. VMClass and below"
+ 				[Transcript nextPutAll: 'warning: redirecting ', aMessage selector, ' in ', thisContext sender printString, ' to objectMemory'; cr; flush.
- 				[Transcript nextPutAll: 'warning: redirecting to objectMemory'; cr; flush.
  				 aMessage lookupClass: nil.
  				^aMessage sentTo: objectMemory]]].
  	^super doesNotUnderstand: aMessage!