[Vm-dev] VM Maker: VMMakerUI-eem.6.mcz

commits at source.squeak.org commits at source.squeak.org
Thu Dec 26 03:51:51 UTC 2019


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

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

Name: VMMakerUI-eem.6
Author: eem
Time: 25 December 2019, 7:51:49.345438 pm
UUID: 5daf2d41-fd3c-4482-9e58-54949d9f555c
Ancestors: VMMakerUI-eem.5

Implement the rump of a CogOopInspector (it still needs the support printing routines debugging fully; lots of unimplemented methods as yet, and the inspecor needs a buildWith and a menu to select the printing method (long vs short, etc).

=============== Diff against VMMakerUI-eem.5 ===============

Item was removed:
- ----- Method: CogAbstractFrameInspector>>buildWith: (in category 'building') -----
- buildWith: builder
- 
- 	| windowSpec frameTextSpec |
- 	(windowSpec := builder pluggableWindowSpec new)
- 		model: self;
- 		label: #windowTitle;
- 		extent: 400 at 200;
- 		children: OrderedCollection new.
- 	(frameTextSpec := builder pluggableTextSpec new)
- 		model: self;
- 		getText: #text;
- 		frame: (0 at 0 corner: 1 at 1);
- 		yourself.
- 	windowSpec children add: frameTextSpec.
- 	^(builder build: windowSpec)
- 		paneColor: (coInterpreter ifNotNil: [coInterpreter windowColorToUse] ifNil: [self defaultWindowColor]);
- 		yourself!

Item was changed:
  ----- Method: CogAbstractFrameInspector>>interpretFramePointer:value:at: (in category 'evaluating') -----
  interpretFramePointer: fieldName value: fieldValueString at: address
+ 	(CogFrameInspector on: coInterpreter)
+ 		framePointer: (coInterpreter stackPages longAt: address);
+ 		displayPinnable: fieldName, ' ', fieldValueString!
- 	| fp inspector |
- 	fp := coInterpreter stackPages longAt: address.
- 	inspector := CogFrameInspector on: coInterpreter.
- 	inspector framePointer: fp.
- 	inspector displayPinnable: fieldName, ' ', fieldValueString!

Item was changed:
  ----- Method: CogAbstractFrameInspector>>interpretOop:value:at: (in category 'evaluating') -----
  interpretOop: fieldName value: valueString at: address
+ 	(CogOopInspector on: coInterpreter)
+ 		oop: (coInterpreter longAt: address);
+ 		displayPinnable: fieldName, ' ', valueString!
- 	coInterpreter transcript nextPutAll: fieldName; space; nextPutAll: valueString; cr.
- 	coInterpreter printOop: (objectMemory longAt: address)!

Item was added:
+ CogVMObjectInspector subclass: #CogOopInspector
+ 	instanceVariableNames: 'printer oop'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'VMMakerUI-SqueakInspectors'!
+ 
+ !CogOopInspector commentStamp: 'eem 12/25/2019 19:48' prior: 0!
+ A CogOopInspector is an inspector for an oop (ordinary object pointer) in the Cog VM.  It supports longPrintOop: and printOop: formats.!

Item was added:
+ ----- Method: CogOopInspector>>coInterpreter: (in category 'initialization') -----
+ coInterpreter: aStackInterpreter
+ 	super coInterpreter: aStackInterpreter.
+ 	printer := #printOop:on:oopAttribute:!

Item was added:
+ ----- Method: CogOopInspector>>oop (in category 'accessing') -----
+ oop
+ 
+ 	^ oop!

Item was added:
+ ----- Method: CogOopInspector>>oop: (in category 'accessing') -----
+ oop: anObject
+ 
+ 	oop := anObject.!

Item was added:
+ ----- Method: CogOopInspector>>printer (in category 'accessing') -----
+ printer
+ 
+ 	^ printer!

Item was added:
+ ----- Method: CogOopInspector>>printer: (in category 'accessing') -----
+ printer: anObject
+ 
+ 	printer := anObject.!

Item was added:
+ ----- Method: CogOopInspector>>text (in category 'accessing - ui') -----
+ text
+ 	^Text streamContents:
+ 		[:s| coInterpreter perform: printer with: oop with: s with: (PluggableTextAttribute evalBlock: [:oopString| self interpretOopString: oopString])]!

Item was changed:
  ----- Method: CogProcessorAlienInspector>>buildWith: (in category 'building') -----
  buildWith: builder
+ 	"Override to use a fixed pitch font."
- 
  	| windowSpec registerTextSpec |
  	(windowSpec := builder pluggableWindowSpec new)
  		model: self;
  		label: #windowTitle;
  		extent: 400 at 200;
  		children: OrderedCollection new.
  	(registerTextSpec := builder pluggableTextSpec new)
  		model: self;
  		font: Preferences standardFixedFont;
  		getText: #text;
  		frame: (0 at 0 corner: 1 at 1);
  		yourself.
  	windowSpec children add: registerTextSpec.
  	^(builder build: windowSpec)
  		paneColor: (coInterpreter ifNotNil: [coInterpreter windowColorToUse] ifNil: [self defaultWindowColor]);
  		yourself!

Item was added:
+ ----- Method: CogVMSimulator>>printHex:on: (in category '*VMMakerUI-debug printing') -----
+ printHex: anInteger on: aStream
+ 	<doNotGenerate>
+ 	aStream next: 8 - (anInteger digitLength * 2) put: Character space.
+ 	anInteger storeOn: aStream base: 16!

Item was added:
+ ----- Method: CogVMSimulator>>printStringOf:on: (in category '*VMMakerUI-debug printing') -----
+ printStringOf: oop on: aStream
+ 	<doNotGenerate>
+ 	| fmt len cnt max i |
+ 	(objectMemory isImmediate: oop) ifTrue:
+ 		[^self].
+ 	(objectMemory addressCouldBeObj: oop) ifFalse:
+ 		[^self].
+ 	fmt := objectMemory formatOf: oop.
+ 	fmt < objectMemory firstByteFormat ifTrue: [^self].
+ 
+ 	cnt := (max := 128) min: (len := objectMemory lengthOf: oop).
+ 	i := 0.
+ 
+ 	((objectMemory is: oop
+ 		  instanceOf: (objectMemory splObj: ClassByteArray)
+ 		  compactClassIndex: classByteArrayCompactIndex)
+ 	or: [(objectMemory isLargeIntegerInstance: oop)])
+ 		ifTrue:
+ 			[[i < cnt] whileTrue:
+ 				[self printHex: (objectMemory fetchByte: i ofObject: oop) on: aStream.
+ 				 i := i + 1]]
+ 		ifFalse:
+ 			[[i < cnt] whileTrue:
+ 				[aStream nextPut: (objectMemory fetchByte: i ofObject: oop) asCharacter.
+ 				 i := i + 1]].
+ 	len > max ifTrue:
+ 		[aStream nextPutAll: '...']!

Item was added:
+ ----- Method: StackInterpreter>>hex:withAttribute: (in category '*VMMakerUI-debug printing') -----
+ hex: anInteger withAttribute: oopTextAttribute
+ 	<doNotGenerate>
+ 	^((String new: 8 - (anInteger digitLength * 2) withAll: Character space), (anInteger storeStringBase: 16)) asText addAttribute: oopTextAttribute!

Item was added:
+ ----- Method: StackInterpreter>>longPrintOop:on:oopAttribute: (in category '*VMMakerUI-debug printing') -----
+ longPrintOop: oop on: aStream oopAttribute: oopTextAttribute
+ 	<doNotGenerate>
+ 	| fmt lastIndex startIP bytecodesPerLine column field |
+ 	((objectMemory isImmediate: oop)
+ 	 or: [(objectMemory addressCouldBeObj: oop) not
+ 	 or: [(oop bitAnd: objectMemory allocationUnit - 1) ~= 0
+ 	 or: [(objectMemory isFreeObject: oop)
+ 	 or: [objectMemory isForwarded: oop]]]]) ifTrue:
+ 		[^self printOop: oop on: aStream oopAttribute: oopTextAttribute].
+ 	self printHex: oop on: aStream.
+ 	(objectMemory fetchClassOfNonImm: oop)
+ 		ifNil: [aStream nextPutAll: ' has a nil class!!!!']
+ 		ifNotNil: [:class|
+ 			aStream nextPutAll: ': a(n) '.
+ 			self printNameOfClass: class count: 5 on: aStream.
+ 			aStream nextPutAll: ' ('.
+ 			objectMemory hasSpurMemoryManagerAPI ifTrue:
+ 				[self printHexnp: (objectMemory compactClassIndexOf: oop) on: aStream. aStream nextPutAll: '=>'].
+ 			aStream nextPutAll: (self hexnp: class withAttribute: oopTextAttribute); nextPut: $)].
+ 	fmt := objectMemory formatOf: oop.
+ 	aStream nextPutAll: ' format '; nextPutAll: (self hexnp: fmt).
+ 	fmt > objectMemory lastPointerFormat
+ 		ifTrue: [aStream nextPutAll: ' nbytes '; print: (objectMemory numBytesOf: oop)]
+ 		ifFalse: [(objectMemory isIndexableFormat: fmt) ifTrue:
+ 					[| len |
+ 					len := objectMemory lengthOf: oop.
+ 					aStream nextPutAll: ' size '; print: len - (objectMemory fixedFieldsOf: oop format: fmt length: len)]].
+ 	objectMemory printHeaderTypeOf: oop on: aStream.
+ 	aStream
+ 		nextPutAll: ' hash '; nextPutAll: (self hexnp: (objectMemory rawHashBitsOf: oop));
+ 		cr.
+ 	(fmt between: objectMemory firstByteFormat and: objectMemory firstCompiledMethodFormat - 1) ifTrue:
+ 		[self printStringOf: oop on: aStream. ^aStream cr].
+ 	(fmt between: objectMemory firstLongFormat and: objectMemory firstByteFormat - 1) ifTrue:
+ 		[0 to: ((objectMemory num32BitUnitsOf: oop) min: 256) - 1 do:
+ 			[:i|
+ 			field := objectMemory fetchLong32: i ofObject: oop.
+ 			aStream space; print: i; space. (self printHex: field on: aStream). aStream space; cr].
+ 		 ^self].
+ 	objectMemory hasSpurMemoryManagerAPI ifTrue:
+ 		[fmt = objectMemory sixtyFourBitIndexableFormat ifTrue:
+ 			[0 to: ((objectMemory num64BitUnitsOf: oop) min: 256) - 1 do:
+ 				[:i|
+ 				field := objectMemory fetchLong64: i ofObject: oop.
+ 				aStream space; print: i; space. (self printHex: field on: aStream). aStream space; cr].
+ 			 ^self].
+ 		 (fmt between: objectMemory firstShortFormat and: objectMemory firstShortFormat + 1) ifTrue:
+ 			[0 to: ((objectMemory num16BitUnitsOf: oop) min: 256) - 1 do:
+ 				[:i|
+ 				field := objectMemory fetchShort16: i ofObject: oop.
+ 				aStream space; print: i; space. (self printHex: field on: aStream). aStream space; cr].
+ 			 ^self]].
+ 	"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:
+ 			[:i|
+ 			field := objectMemory fetchPointer: i - 1 ofObject: oop.
+ 			aStream space; print: i - 1; space; nextPutAll: (self hex: field withAttribute: oopTextAttribute); space.
+ 			(i = 1 and: [objectMemory isCompiledMethod: oop])
+ 				ifTrue: [self printMethodHeaderOop: field on: aStream]
+ 				ifFalse: [aStream nextPutAll: (self shortPrint: field)].
+ 			self cr]].
+ 	(objectMemory isCompiledMethod: oop)
+ 		ifFalse:
+ 			[startIP > lastIndex ifTrue: [aStream nextPutAll: '...'; 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:
+ 					[aStream nextPutAll: (oop+objectMemory baseHeaderSize+index-1) hex; nextPutAll: ': '].
+ 				byte := objectMemory fetchByte: index - 1 ofObject: oop.
+ 				aStream space. byte printOn: aStream base: 16. aStream nextPut: $/. byte printOn: aStream.
+ 				column := column + 1.
+ 				column > bytecodesPerLine ifTrue:
+ 					[column := 1. self cr]].
+ 			column = 1 ifFalse:
+ 				[self cr]]!

Item was added:
+ ----- Method: StackInterpreter>>printNameOfClass:count:on: (in category '*VMMakerUI-debug printing') -----
+ printNameOfClass: classOop count: cnt on: aStream
+ 	"Details: The count argument is used to avoid a possible infinite recursion if classOop is a corrupted object."
+ 	<doNotGenerate>
+ 	| numSlots |
+ 	classNameIndex ifNil:
+ 		[^aStream nextPutAll: '??nil cnidx??'].
+ 	(classOop isNil or: [classOop = 0 or: [cnt <= 0]]) ifTrue:
+ 		[^aStream nextPutAll: 'bad class'].
+ 	numSlots := objectMemory numSlotsOf: classOop.
+ 	(numSlots = metaclassNumSlots
+ 	 and: [metaclassNumSlots > thisClassIndex]) ifTrue:
+ 		[self printNameOfClass: (objectMemory fetchPointer: thisClassIndex ofObject: classOop) count: cnt - 1 on: aStream.
+ 		 ^aStream nextPutAll: ' class'].
+ 	numSlots <= classNameIndex ifTrue:
+ 		[^aStream nextPutAll: 'bad class'].
+ 	self printStringOf: (objectMemory fetchPointer: classNameIndex ofObject: classOop) on: aStream!

Item was added:
+ ----- Method: StackInterpreter>>printOop:on:oopAttribute: (in category '*VMMakerUI-debug printing') -----
+ printOop: oop on: aStream oopAttribute: oopTextAttribute
+ 	<doNotGenerate>
+ 	| cls fmt lastIndex startIP bytecodesPerLine column |
+ 	<inline: false>
+ 	(objectMemory isImmediate: oop) ifTrue:
+ 		[^self shortPrintOop: oop on: aStream].
+ 	self printHex: oop on: aStream.
+ 	(objectMemory addressCouldBeObj: oop) ifFalse:
+ 		[^aStream nextPutAll: ((oop bitAnd: objectMemory allocationUnit - 1) ~= 0
+ 						ifTrue: [' is misaligned']
+ 						ifFalse: [self whereIs: oop]); cr].
+ 	(objectMemory isFreeObject: oop) ifTrue:
+ 		[aStream nextPutAll: ' is a free chunk of size '; print: (objectMemory sizeOfFree: oop).
+ 		 objectMemory hasSpurMemoryManagerAPI ifTrue:
+ 			[aStream nextPutAll: ' 0th: '. self printHex: (objectMemory fetchPointer: 0 ofFreeChunk: oop) on: aStream.
+ 			 objectMemory printHeaderTypeOf: oop on: aStream].
+ 		 ^aStream cr].
+ 	(objectMemory isForwarded: oop) ifTrue:
+ 		[aStream
+ 			nextPutAll: ' is a forwarded object to '. self printHex: (objectMemory followForwarded: oop) on: aStream.
+ 		aStream nextPutAll: ' of slot size '; print: (objectMemory numSlotsOfAny: oop).
+ 		 objectMemory printHeaderTypeOf: oop on: aStream.
+ 		 ^aStream cr].
+ 	aStream nextPutAll: ': a(n) '.
+ 	self printNameOfClass: (cls := objectMemory fetchClassOfNonImm: oop) count: 5 on: aStream.
+ 	cls = (objectMemory splObj: ClassFloat) ifTrue:
+ 		[^aStream cr; print: (objectMemory dbgFloatValueOf: oop); cr].
+ 	fmt := objectMemory formatOf: oop.
+ 	fmt > objectMemory lastPointerFormat ifTrue:
+ 		[aStream nextPutAll: ' nbytes '; print: (objectMemory numBytesOf: oop)].
+ 	aStream 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:
+ 			[aStream nextPutAll: ' datasize '; print: (self sizeOfAlienData: oop).
+ 			aStream nextPutAll: ((self isIndirectAlien: oop)
+ 							ifTrue: [' indirect @ ']
+ 							ifFalse:
+ 								[(self isPointerAlien: oop)
+ 									ifTrue: [' pointer @ ']
+ 									ifFalse: [' direct @ ']]).
+ 			 self printHex: (self startOfAlienData: oop) on: aStream. ^aStream cr].
+ 		 (objectMemory isWordsNonImm: oop) ifTrue:
+ 			[lastIndex := 64 min: ((objectMemory numBytesOf: oop) / objectMemory wordSize).
+ 			 lastIndex > 0 ifTrue:
+ 				[1 to: lastIndex do:
+ 					[:index|
+ 					self printHex: (objectMemory fetchLong32: index - 1 ofObject: oop) on: aStream.
+ 					index \\ self elementsPerPrintOopLine = 0 ifTrue:
+ 						[aStream cr]].
+ 				lastIndex \\ self elementsPerPrintOopLine = 0 ifFalse:
+ 					[aStream cr]].
+ 			^self].
+ 		self printStringOf: oop on: aStream.
+ 		^aStream 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|
+ 			aStream space; nextPutAll: (self hex: (objectMemory fetchPointer: index - 1 ofObject: oop) withAttribute: oopTextAttribute); space.
+ 			aStream nextPutAll: (self shortPrint: (objectMemory fetchPointer: index - 1 ofObject: oop)).
+ 			index \\ self elementsPerPrintOopLine = 0 ifTrue:
+ 				[aStream cr]].
+ 		lastIndex \\ self elementsPerPrintOopLine = 0 ifFalse:
+ 			[aStream cr]].
+ 	(objectMemory isCompiledMethod: oop)
+ 		ifFalse:
+ 			[startIP > 64 ifTrue: [aStream nextPutAll: '...'; 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:
+ 					[aStream nextPutAll: (oop+objectMemory baseHeaderSize+index-1) hex; print: ': '].
+ 				byte := objectMemory fetchByte: index - 1 ofObject: oop.
+ 				aStream space. byte printOn: aStream base: 16. aStream nextPut: $/. byte printOn: aStream.
+ 				column := column + 1.
+ 				column > bytecodesPerLine ifTrue:
+ 					[column := 1. aStream cr]].
+ 			column = 1 ifFalse:
+ 				[aStream cr]]!

Item was added:
+ ----- Method: VMObjectInspector>>buildWith: (in category 'accessing - ui') -----
+ buildWith: builder
+ 	| windowSpec textSpec |
+ 	(windowSpec := builder pluggableWindowSpec new)
+ 		model: self;
+ 		label: #windowTitle;
+ 		extent: 400 at 200;
+ 		children: OrderedCollection new.
+ 	(textSpec := builder pluggableTextSpec new)
+ 		model: self;
+ 		getText: #text;
+ 		frame: (0 at 0 corner: 1 at 1);
+ 		yourself.
+ 	windowSpec children add: textSpec.
+ 	^(builder build: windowSpec)
+ 		paneColor: (coInterpreter ifNotNil: [coInterpreter windowColorToUse] ifNil: [self defaultWindowColor]);
+ 		yourself!



More information about the Vm-dev mailing list