diff --git a/src/BaselineOfTinyrossa/BaselineOfTinyrossa.class.st b/src/BaselineOfTinyrossa/BaselineOfTinyrossa.class.st index 8d32fa7..abc1536 100644 --- a/src/BaselineOfTinyrossa/BaselineOfTinyrossa.class.st +++ b/src/BaselineOfTinyrossa/BaselineOfTinyrossa.class.st @@ -25,6 +25,10 @@ BaselineOfTinyrossa >> baseline: spec [ spec baseline: 'LibUnix' with: [ spec repository: 'github://janvrany/pharo-hacks'. ]. + + spec baseline: 'Roassal3' with: [ + spec repository: 'github://ObjectProfile/Roassal3:v0.9.2' + ]. spec package: #'Tinyrossa' with:[ @@ -49,7 +53,8 @@ BaselineOfTinyrossa >> baseline: spec [ spec requires: 'Tinyrossa-Tests' ]; package: #'Tinyrossa-Tools-Pharo' with: [ - spec requires: 'Tinyrossa' + spec requires: 'Tinyrossa'. + spec requires: 'Roassal3'. ]; yourself. ] diff --git a/src/Tinyrossa-Tools-Pharo/TRCFG.extension.st b/src/Tinyrossa-Tools-Pharo/TRCFG.extension.st new file mode 100644 index 0000000..cb17f17 --- /dev/null +++ b/src/Tinyrossa-Tools-Pharo/TRCFG.extension.st @@ -0,0 +1,39 @@ +Extension { #name : #TRCFG } + +{ #category : #'*Tinyrossa-Tools-Pharo' } +TRCFG >> gtInspectorCFGIn: composite [ + + composite roassal3 title: 'CFG'; initializeCanvas: [ + | canvas blocksG edges | + + canvas := RSCanvas new. + blocksG := RSGroup new. + self preorderDo:[:block | + | box label node | + + label := RSLabel new text: block name. + box := RSShapeFactory box + border: (RSBorder new width: 2; color: Color black); + cornerRadius: 5; + color: (Color gray: 0.9); + width: label encompassingRectangle width + 16; + height: label encompassingRectangle height + 16. + RSLocation new center; outer; stick: label on: box. + node := (RSComposite new model: block; shapes: { box . label }) @ RSDraggable. + + blocksG add: node. + canvas add: node + ]. + + edges := RSEdgeBuilder arrowedLine + attachPoint: RSBorderAttachPoint new; + yourself. + + edges + canvas: canvas; "moveBehind;" width: 2; + shapes: blocksG; connectToAll: #successors. + + RSVerticalLineLayout on: blocksG. + canvas @ RSCanvasController + ] +] diff --git a/src/Tinyrossa-Tools-Pharo/TRCompilation.extension.st b/src/Tinyrossa-Tools-Pharo/TRCompilation.extension.st index 2d75a44..8412b68 100644 --- a/src/Tinyrossa-Tools-Pharo/TRCompilation.extension.st +++ b/src/Tinyrossa-Tools-Pharo/TRCompilation.extension.st @@ -29,6 +29,13 @@ TRCompilation >> gtInspectorANFIn: composite [ ] +{ #category : #'*Tinyrossa-Tools-Pharo' } +TRCompilation >> gtInspectorCFGIn: composite [ + + + cfg gtInspectorCFGIn: composite. +] + { #category : #'*Tinyrossa-Tools-Pharo' } TRCompilation >> gtInspectorInstructionsIn: composite [ diff --git a/src/Tinyrossa-Tools-Pharo/TRILBlock.extension.st b/src/Tinyrossa-Tools-Pharo/TRILBlock.extension.st new file mode 100644 index 0000000..d460c1c --- /dev/null +++ b/src/Tinyrossa-Tools-Pharo/TRILBlock.extension.st @@ -0,0 +1,36 @@ +Extension { #name : #TRILBlock } + +{ #category : #'*Tinyrossa-Tools-Pharo' } +TRILBlock >> gtInspectorTRILIn: composite [ + + + | printer builder | + + builder := [ :node | + | printed | + + printed := printer hasPrinted: node. + { node. + printer print: node. + printed ifTrue:[ #() ] ifFalse: [ node children collect: builder ] } + ]. + + composite fastTreeTable + title: 'TRIL'; + rootsExpanded; + display: [ :comp | printer := TRILNodePrinter new. treetops collect: builder ]; + children: [ :item | item third ]; + column: 'Node' evaluated: [ :item | item second ]; + column: 'ID' evaluated: [ :item | printer printId: item first ]; + column: 'Location' evaluated: [ :item | + | node | + + node := item first. + node location notNil ifTrue:[ + node location gtDisplayString + ] ifFalse:[ + '' + ]]; + yourself. + +] diff --git a/src/Tinyrossa/TRCFG.class.st b/src/Tinyrossa/TRCFG.class.st index dfb44c4..863f4d4 100644 --- a/src/Tinyrossa/TRCFG.class.st +++ b/src/Tinyrossa/TRCFG.class.st @@ -4,7 +4,8 @@ Class { #instVars : [ 'compilation', 'blocks', - 'entry' + 'entry', + 'nextBlockId' ], #pools : [ 'TRILOpcodes' @@ -34,8 +35,9 @@ TRCFG >> addBlockNamed: aStringOrNil [ aStringOrNil notNil ifTrue: [ name := aStringOrNil. ] ifFalse: [ - name := 'BB_' , (blocks size printLeftPaddedWith: $0 to: 3 base: 10) + name := 'BB_' , (nextBlockId printLeftPaddedWith: $0 to: 3 base: 10) ]. + nextBlockId := nextBlockId + 1. self assert: (blocks contains: [:e | e name = name ]) not. @@ -87,6 +89,7 @@ TRCFG >> initializeWithCompilation: aTRCompilation [ compilation := aTRCompilation. blocks := Set new. entry := nil. + nextBlockId := 0. ] { #category : #enumerating } diff --git a/src/Tinyrossa/TRILBlock.class.st b/src/Tinyrossa/TRILBlock.class.st index c77291f..0980247 100644 --- a/src/Tinyrossa/TRILBlock.class.st +++ b/src/Tinyrossa/TRILBlock.class.st @@ -278,6 +278,17 @@ TRILBlock >> successor2 [ ^ successor2 ] +{ #category : #accessing } +TRILBlock >> successors [ + successor2 isNil ifTrue:[ + successor1 isNil ifTrue:[ ^#() ]. + ^ { successor1 } + ]. + + successor1 isNil ifTrue:[ ^ { successor2 } ]. + ^ { successor1 . successor2 } +] + { #category : #accessing } TRILBlock >> treetops [ ^ { bbstartNode } , treetops , { bbendNode } diff --git a/src/Tinyrossa/TRILOpcode.class.st b/src/Tinyrossa/TRILOpcode.class.st index 2b3ef76..d8b505f 100644 --- a/src/Tinyrossa/TRILOpcode.class.st +++ b/src/Tinyrossa/TRILOpcode.class.st @@ -260,7 +260,7 @@ TRILOpcode >> name [ TRILOpcode >> printOn:aStream [ "append a printed representation of the receiver to the argument, aStream" - self class name printOn: aStream. + aStream nextPutAll: self class name. aStream nextPutAll:' named: '. name storeOn:aStream. ]