--- a/VDBInstructionListApplication.st Tue Jun 26 14:17:50 2018 +0100
+++ b/VDBInstructionListApplication.st Tue Jun 26 13:19:02 2018 +0100
@@ -11,7 +11,9 @@
"{ NameSpace: Smalltalk }"
VDBAbstractTreeApplication subclass:#VDBInstructionListApplication
- instanceVariableNames:'instructionListHolder selectedInstructionHolder'
+ instanceVariableNames:'instructionListHolder instructionBasicBlocks
+ selectedInstructionHolder selectedInstructionBranchTargetAddress
+ selectedInstructionBasicBlock'
classVariableNames:''
poolDictionaries:''
category:'VDB-UI-Others'
@@ -38,6 +40,17 @@
"Created: / 22-06-2018 / 12:25:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+!VDBInstructionListApplication class methodsFor:'utilities'!
+
+instructions: aCollection title: aString
+ ^ self new
+ instructionList: aCollection;
+ title: aString;
+ yourself
+
+ "Created: / 26-06-2018 / 11:03:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
!VDBInstructionListApplication methodsFor:'accessing'!
instructionList: aCollection
@@ -48,6 +61,33 @@
!VDBInstructionListApplication methodsFor:'aspects'!
+backgroundColorFor: aVDBPresenter
+ selectedInstructionBranchTargetAddress notNil ifTrue:[
+ aVDBPresenter isInstructionPresenter ifTrue:[
+ aVDBPresenter instruction address = selectedInstructionBranchTargetAddress ifTrue:[
+ ^ Color blue lighter lighter
+ ].
+ ].
+ ].
+ selectedInstructionBasicBlock notNil ifTrue:[
+ (selectedInstructionBasicBlock includesAddress: aVDBPresenter address) ifTrue:[
+ ^ Color yellow lighter lighter
+ ].
+ ].
+ ^ nil
+
+ "Created: / 26-06-2018 / 11:26:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (format): / 27-06-2018 / 16:08:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+foregroundColorFor: aVDBAbstractPresenter
+ ^ aVDBAbstractPresenter isInstructionsAndSourcePresenter
+ ifTrue:[ Color gray ]
+ ifFalse:[ nil ]
+
+ "Created: / 26-06-2018 / 13:07:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
instructionListHolder
"return/create the 'instructionListHolder' value holder (automatically generated)"
@@ -108,6 +148,12 @@
!VDBInstructionListApplication methodsFor:'change & update'!
+enqueueDelayedUpdateBasicBlocks
+ self enqueueDelayedUpdate: #delayedUpdateBasicBlocks
+
+ "Created: / 26-06-2018 / 12:20:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
update:aspect with:param from:sender
"Invoked when an object that I depend upon sends a change notification."
@@ -115,13 +161,52 @@
self enqueueDelayedUpdateInternalList.
^ self.
].
+ sender == selectedInstructionHolder ifTrue:[
+ self updateAfterSelectedInstructionChanged.
+ ].
super update:aspect with:param from:sender
- "Modified: / 22-06-2018 / 12:38:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 26-06-2018 / 12:46:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+updateAfterSelectedInstructionChanged
+ | selected |
+
+ selected := self selectedInstructionHolder value.
+ selected notNil ifTrue:[
+ selected isBranchInstruction ifTrue:[
+ selectedInstructionBranchTargetAddress := selected branchTargetAddress.
+ ] ifFalse:[
+ selectedInstructionBranchTargetAddress := nil.
+ ].
+ instructionBasicBlocks size > 1 ifTrue:[
+ selectedInstructionBasicBlock := instructionBasicBlocks detect:[:e | e includesAddress: selected address ] ifNone: [ nil ]
+ ] ifFalse:[
+ selectedInstructionBasicBlock := nil.
+ ].
+ ] ifFalse:[
+ selectedInstructionBranchTargetAddress := nil.
+ selectedInstructionBasicBlock := nil.
+
+ ].
+
+ self enqueueDelayedInvalidateInternalList.
+
+ "Created: / 26-06-2018 / 11:33:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 03-07-2018 / 14:56:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!VDBInstructionListApplication methodsFor:'change & update-delayed'!
+delayedUpdateBasicBlocks
+ instructionBasicBlocks := VDBInstructionBasicBlock analyze: instructionListHolder value.
+ self enqueueDelayedInvalidateInternalList.
+
+ "Created: / 26-06-2018 / 12:20:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 27-06-2018 / 14:47:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (format): / 27-06-2018 / 16:04:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
delayedUpdateInternalList
| root |
@@ -142,10 +227,11 @@
root children do:[:each | each expand ].
internalListView notNil ifTrue:[
internalListView invalidate.
- ]
+ ].
+ self enqueueDelayedUpdateBasicBlocks.
"Created: / 27-02-2015 / 15:47:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 25-06-2018 / 17:19:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 26-06-2018 / 12:45:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
delayedUpdateSelection
@@ -161,6 +247,20 @@
"Modified: / 22-06-2018 / 15:08:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+!VDBInstructionListApplication methodsFor:'private'!
+
+instructionPresentersDo: aBlock
+ self internalListHolder root children do:[:each |
+ each isInstructionPresenter ifTrue:[
+ aBlock value: each
+ ] ifFalse:[
+ each children do: aBlock
+ ].
+ ]
+
+ "Created: / 26-06-2018 / 12:30:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
!VDBInstructionListApplication methodsFor:'queries'!
canSelect: anItem