VM Maker: VMMakerUI-eem.6.mcz

 
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@200;
- children: OrderedCollection new.
- (frameTextSpec := builder pluggableTextSpec new)
- model: self;
- getText: #text;
- frame: (0@0 corner: 1@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@200;
  children: OrderedCollection new.
  (registerTextSpec := builder pluggableTextSpec new)
  model: self;
  font: Preferences standardFixedFont;
  getText: #text;
  frame: (0@0 corner: 1@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@200;
+ children: OrderedCollection new.
+ (textSpec := builder pluggableTextSpec new)
+ model: self;
+ getText: #text;
+ frame: (0@0 corner: 1@1);
+ yourself.
+ windowSpec children add: textSpec.
+ ^(builder build: windowSpec)
+ paneColor: (coInterpreter ifNotNil: [coInterpreter windowColorToUse] ifNil: [self defaultWindowColor]);
+ yourself!