VM Maker: VMMakerUI-eem.7.mcz

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

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

Name: VMMakerUI-eem.7
Author: eem
Time: 26 December 2019, 6:41:54.306274 pm
UUID: 3f8bdf1c-f5cb-4643-8294-2e0822731c44
Ancestors: VMMakerUI-eem.6

Extend the CogOopInspector to allow switching between printOop: format and longOopFormat:.

Extend PluggableTextAttribute to pass in the model and string if the action block takes two agruments, hence allowing deferring oop parsing until the click action.

=============== Diff against VMMakerUI-eem.6 ===============

Item was changed:
  ----- Method: CogAbstractFrameInspector>>addressFromString: (in category 'private') -----
  addressFromString: aString
+ ^(ExtendedNumberParser on: aString readStream skipSeparators) nextInteger!
- ^(ExtendedNumberParser on: ((ReadStream on: aString) skipSeparators; yourself)) nextInteger!

Item was added:
+ ----- Method: CogOopInspector>>interpretOopString: (in category 'evaluating') -----
+ interpretOopString: aStringContainingAnOop
+ ^self copy
+ oop: (ExtendedNumberParser on: aStringContainingAnOop readStream skipSeparators) nextInteger;
+ displayPinnable: aStringContainingAnOop withBlanksTrimmed!

Item was changed:
  ----- Method: CogOopInspector>>printer: (in category 'accessing') -----
  printer: anObject
 
+ printer := anObject.
+ self changed: #text!
- printer := anObject.!

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

Item was added:
+ ----- Method: CogOopInspector>>textMenu: (in category 'accessing - ui') -----
+ textMenu: aMenuMorph
+ aMenuMorph
+ addTitle: 'Select print format';
+ add: #printOop: action: [self printer: #printOop:on:oopAttribute:];
+ add: #longPrintOop: action: [self printer: #longPrintOop:on:oopAttribute:].
+ ^aMenuMorph!

Item was added:
+ ----- Method: NewObjectMemory>>printHeaderTypeOf:on: (in category '*VMMakerUI-debug printing') -----
+ printHeaderTypeOf: obj on: aStream
+ <doNotGenerate>
+ aStream nextPutAll:
+ ((self headerType: obj) caseOf: {
+ [HeaderTypeFree] -> [' HeaderTypeFree (4 bytes)'].
+ [HeaderTypeShort] -> [' HeaderTypeShort (4 bytes)'].
+ [HeaderTypeClass] -> [' HeaderTypeClass (8 bytes)'].
+ [HeaderTypeSizeAndClass] -> [' HeaderTypeSizeAndClass (12 bytes)'] })!

Item was added:
+ ----- Method: PluggableTextAttribute>>actOnClickFor:in:at: (in category '*VMMakerUI-convenience') -----
+ actOnClickFor: model in: aParagraph at: clickPoint
+ "Override to pass in the string with this attribute to the block if it takes two arguments."
+ | range |
+ (evalBlock notNil and: [evalBlock numArgs = 2]) ifFalse:
+ [^super actOnClickFor: model in: aParagraph at: clickPoint].
+ range := aParagraph text
+ rangeOf: self
+ startingAt: (aParagraph characterBlockAtPoint: clickPoint) stringIndex.
+ evalBlock value: model value: (aParagraph text string copyFrom: range first to: range last).
+ ^true!

Item was added:
+ ----- Method: SpurMemoryManager>>printHeaderTypeOf:on: (in category '*VMMakerUI-debug printing') -----
+ printHeaderTypeOf: objOop on: aStream
+ <doNotGenerate>
+ aStream
+ nextPutAll: ((self numSlotsOfAny: objOop) >= self numSlotsMask
+ ifTrue: [' hdr16 ']
+ ifFalse: [' hdr8 ']);
+ nextPut: ((self isImmutable: objOop) ifTrue: [$i] ifFalse: [$.]);
+ nextPut: ((self isRemembered: objOop) ifTrue: [$r] ifFalse: [$.]);
+ nextPut: ((self isPinned: objOop) ifTrue: [$p] ifFalse: [$.]);
+ nextPut: ((self isMarked: objOop) ifTrue: [$m] ifFalse: [$.]);
+ nextPut: ((self isGrey: objOop) ifTrue: [$g] ifFalse: [$.])!

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

Item was added:
+ ----- Method: StackInterpreter>>hexnp:withAttribute: (in category '*VMMakerUI-debug printing') -----
+ hexnp: anInteger withAttribute: oopTextAttribute
+ <doNotGenerate>
+ ^(anInteger storeStringBase: 16) asText addAttribute: oopTextAttribute!

Item was changed:
  ----- 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 '. fmt printOn: aStream base: 16.
- 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 '. (objectMemory rawHashBitsOf: oop) printOn: aStream base: 16. aStream cr.
- 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)].
+ aStream cr]].
- 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. aStream cr]].
- [column := 1. self cr]].
  column = 1 ifFalse:
+ [aStream cr]]!
- [self cr]]!

Item was added:
+ ----- Method: StackInterpreter>>printHexnp:on: (in category '*VMMakerUI-debug printing') -----
+ printHexnp: anInteger on: aStream
+ <doNotGenerate>
+ anInteger printOn: aStream base: 16!

Item was added:
+ ----- Method: StackInterpreter>>shortPrintOop:on: (in category '*VMMakerUI-debug printing') -----
+ shortPrintOop: oop on: aStream
+ <doNotGenerate>
+ oop printOn: aStream base: 16.
+ (objectMemory isImmediate: oop) ifTrue:
+ [((objectMemory isIntegerObject: oop)
+  or: [objectMemory isImmediateCharacter: oop]) ifTrue:
+ [^aStream nextPutAll: (self shortPrint: oop); cr].
+ (objectMemory isImmediateFloat: oop) ifTrue:
+ [^aStream nextPut: $=; print: (objectMemory floatValueOf: oop); cr].
+ ^aStream nextPutAll: ' unknown immediate'; cr].
+ (objectMemory addressCouldBeObj: oop) ifFalse:
+ [^aStream nextPutAll: ((oop bitAnd: objectMemory allocationUnit - 1) ~= 0
+ ifTrue: [' is misaligned']
+ ifFalse: [self whereIs: oop]); cr].
+ ((objectMemory isFreeObject: oop)
+ or: [objectMemory isForwarded: oop]) ifTrue:
+ [^self printOop: oop on: aStream oopAttribute: nil].
+ aStream nextPutAll: ': a(n) '.
+ self printNameOfClass: (objectMemory fetchClassOfNonImm: oop) count: 5 on: aStream.
+ aStream cr!

Item was changed:
  ----- 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.
+ (self textMenu: MenuMorph new) ifNotNil:
+ [textSpec menu: #textMenu:].
  windowSpec children add: textSpec.
  ^(builder build: windowSpec)
  paneColor: (coInterpreter ifNotNil: [coInterpreter windowColorToUse] ifNil: [self defaultWindowColor]);
  yourself!

Item was added:
+ ----- Method: VMObjectInspector>>textMenu: (in category 'accessing - ui') -----
+ textMenu: aMenuMorph
+ "Subclasses wishing to have a text menu should override."
+ ^nil!