"

jv:vdb - Visual / VM Debugger

Copyright (C) 2015-now Jan Vrany

This software is licensed under 'Creative Commons Attribution-NonCommercial 4.0 International License'

You may find a full license text in LICENSE.txt or at http://creativecommons.org/licenses/by-nc/4.0/

"

"{ Package: 'jv:vdb' }"

"{ NameSpace: Smalltalk }"

VDBAbstractTreeApplication subclass:#VDBInstructionListApplication

	instanceVariableNames:'instructionListHolder instructionBasicBlocks

		selectedInstructionHolder selectedInstructionBranchTargetAddress

		selectedInstructionBasicBlock disassemblableHolder frameHolder

		canExecStepOverInstructionHolder canExecStepIntoInstructionHolder

		canExecBackOverInstructionHolder canExecBackIntoInstructionHolder'

	classVariableNames:''

	poolDictionaries:''

	category:'VDB-UI-Others'

!

!VDBInstructionListApplication class methodsFor:'documentation'!

copyright

"

jv:vdb - Visual / VM Debugger

Copyright (C) 2015-now Jan Vrany

This software is licensed under 'Creative Commons Attribution-NonCommercial 4.0 International License'

You may find a full license text in LICENSE.txt or at http://creativecommons.org/licenses/by-nc/4.0/

"

! !

!VDBInstructionListApplication class methodsFor:'accessing'!

defaultWindowTitle

    ^ self resources string:'Assembly'

    "Created: / 22-06-2018 / 12:25:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!VDBInstructionListApplication class methodsFor:'menu specs'!

contextMenu

    "This resource specification was automatically generated

     by the MenuEditor of ST/X."

    "Do not manually edit this!! If it is corrupted,

     the MenuEditor may not be able to read the specification."

    "

     MenuEditor new openOnClass:VDBInstructionListApplication andSelector:#contextMenu

     (Menu new fromLiteralArrayEncoding:(VDBInstructionListApplication contextMenu)) startUp

    "

    <resource: #menu>

    ^ 

     #(Menu

        (

         (MenuItem

            label: 'Context Menu Slice'

            isVisible: true

            submenuChannel: contextMenuApplSlice

            isMenuSlice: true

          )

         (MenuItem

            label: 'Item Menu Slice'

            isVisible: true

            submenuChannel: contextMenuItemSlice

            isMenuSlice: true

          )

         (MenuItem

            label: 'Copy Menu Slice'

            isVisible: true

            submenuChannel: contextMenuCopySlice

            isMenuSlice: true

          )

         (MenuItem

            label: '-'

            isVisible: true

          )

         (MenuItem

            label: 'Inspect Menu Slice'

            isVisible: true

            submenuChannel: contextMenuInspectSlice

            isMenuSlice: true

          )

         (MenuItem

            label: '-'

          )

         (MenuItem

            label: 'Pin Menu'

            itemValue: doPinMenuAs:item:

            isVisible: true

            labelImage: (ResourceRetriever VDBIconLibrary pin 'Pin Menu')

            argument: 'Disassembly Actions'

          )

         )

        nil

        nil

      )

    "Modified: / 01-09-2018 / 14:55:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

contextMenuApplSlice

    "This resource specification was automatically generated

     by the MenuEditor of ST/X."

    "Do not manually edit this!! If it is corrupted,

     the MenuEditor may not be able to read the specification."

    "

     MenuEditor new openOnClass:VDBInstructionListApplication andSelector:#contextMenuApplSlice

     (Menu new fromLiteralArrayEncoding:(VDBInstructionListApplication contextMenuApplSlice)) startUp

    "

    <resource: #menu>

    ^ 

     #(Menu

        (

         (MenuItem

            enabled: canShowCurrentHolder

            label: 'Show Current Instruction'

            itemValue: doShowCurrent

            isVisible: true

          )

         (MenuItem

            enabled: canShowBranchTargetHolder

            label: 'Show Branch Traget'

            itemValue: doShowBranchTarget

            isVisible: true

          )

         (MenuItem

            enabled: canShowSelectionHolder

            label: 'Show Selection'

            itemValue: doShowSelection

            isVisible: true

          )

         (MenuItem

            label: '-'

            isVisible: true

          )

         (MenuItem

            enabled: canExecStepOverInstructionHolder         

            label: 'Step Over'

            itemValue: doExecStepOverInstruction

            isVisible: true

            labelImage: (ResourceRetriever VDBIconLibrary actionStepOver6x16 'Step Over One Instruction')

          )

         (MenuItem

            enabled: canExecStepIntoInstructionHolder

            label: 'Step Into'

            itemValue: doExecStepIntoInstruction

            isVisible: true

            labelImage: (ResourceRetriever VDBIconLibrary actionStepInto6x16 'Step Into One Instruction')

          )

         (MenuItem

            label: '-'

            isVisible: true

          )

         (MenuItem

             enabled: canExecBackOverInstructionHolder

            label: 'Back Over'

            itemValue: doExecBackOverInstruction

            isVisible: true

          )

         (MenuItem

            enabled: canExecBackIntoInstructionHolder

            label: 'Back Into'

            itemValue: doExecBackIntoInstruction

            isVisible: true

          )

         (MenuItem

            label: '-'

            isVisible: true

          )

         )

        nil

        nil

      )

    "Modified: / 01-09-2018 / 22:02:42 / 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'!

disassemblable

    ^ self disassemblableHolder value

    "Created: / 10-06-2019 / 10:06:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

disassemblable: anObject

    self disassemblableHolder value: anObject

    "Created: / 10-06-2019 / 10:06:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

frame

    ^ self frameHolder value

    "Created: / 10-06-2019 / 12:44:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

frame: aGDBFrame

    ^ self frameHolder value: aGDBFrame

    "Created: / 10-06-2019 / 12:44:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

instructionList

    ^ self instructionListHolder value

    "Created: / 07-08-2018 / 13:27:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

instructionList: aCollection

    self instructionListHolder value: aCollection

    "Created: / 22-06-2018 / 12:48:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!VDBInstructionListApplication methodsFor:'aspects'!

backgroundColorFor: aVDBPresenter

    (self frame notNil and:[aVDBPresenter isInstructionPresenter]) ifTrue:[ 

        disassemblableHolder value address == aVDBPresenter address ifTrue:[ 

            ^ Color green.

        ].

    ].

    selectedInstructionBranchTargetAddress notNil ifTrue:[ 

        aVDBPresenter isInstructionPresenter ifTrue:[ 

            aVDBPresenter instruction address = selectedInstructionBranchTargetAddress ifTrue:[ 

                ^ Color blue lighter lighter

            ].

        ].

        selectedInstructionBasicBlock notNil ifTrue:[ 

            | successor2 |

            successor2 := selectedInstructionBasicBlock successor2.

            (successor2 notNil and:[ successor2 includesAddress: aVDBPresenter address] ) ifTrue:[

                ^ Color blue lighter 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: / 10-06-2019 / 14:52:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

disassemblableHolder

    disassemblableHolder isNil ifTrue:[

        disassemblableHolder := ValueHolder new.

        disassemblableHolder addDependent:self.

    ].

    ^ disassemblableHolder

    "Created: / 10-06-2019 / 10:03:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

disassemblableHolder:something

    "set the 'frameHolder' value holder (automatically generated)"

    |oldValue newValue|

    disassemblableHolder notNil ifTrue:[

        oldValue := disassemblableHolder value.

        disassemblableHolder removeDependent:self.

    ].

    disassemblableHolder := something.

    disassemblableHolder notNil ifTrue:[

        disassemblableHolder addDependent:self.

    ].

    newValue := disassemblableHolder value.

    oldValue ~~ newValue ifTrue:[

        self update:#value with:newValue from:disassemblableHolder.

    ].

    "Created: / 10-06-2019 / 10:03:44 / 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>"

!

frameHolder

    "return/create the 'frameHolder' value holder (automatically generated)"

    frameHolder isNil ifTrue:[

        frameHolder := ValueHolder new.

        frameHolder addDependent:self.

    ].

    ^ frameHolder

!

frameHolder:something

    "set the 'frameHolder' value holder (automatically generated)"

    |oldValue newValue|

    frameHolder notNil ifTrue:[

        oldValue := frameHolder value.

        frameHolder removeDependent:self.

    ].

    frameHolder := something.

    frameHolder notNil ifTrue:[

        frameHolder addDependent:self.

    ].

    newValue := frameHolder value.

    oldValue ~~ newValue ifTrue:[

        self update:#value with:newValue from:frameHolder.

    ].

!

instructionListHolder

    "return/create the 'instructionListHolder' value holder (automatically generated)"

    instructionListHolder isNil ifTrue:[

        instructionListHolder := ValueHolder new.

        instructionListHolder addDependent:self.

    ].

    ^ instructionListHolder

!

instructionListHolder:valueModel

    "set the 'instructionListHolder' value holder (automatically generated)"

    |oldValue newValue|

    instructionListHolder notNil ifTrue:[

        oldValue := instructionListHolder value.

        instructionListHolder removeDependent:self.

    ].

    instructionListHolder := valueModel.

    instructionListHolder notNil ifTrue:[

        instructionListHolder addDependent:self.

    ].

    newValue := instructionListHolder value.

    oldValue ~~ newValue ifTrue:[

        self update:#value with:newValue from:instructionListHolder.

    ].

!

selectedInstructionHolder

    "return/create the 'selectedInstructionHolder' value holder (automatically generated)"

    selectedInstructionHolder isNil ifTrue:[

        selectedInstructionHolder := ValueHolder new.

        selectedInstructionHolder addDependent:self.

    ].

    ^ selectedInstructionHolder

!

selectedInstructionHolder:valueModel

    "set the 'selectedInstructionHolder' value holder (automatically generated)"

    |oldValue newValue|

    selectedInstructionHolder notNil ifTrue:[

        oldValue := selectedInstructionHolder value.

        selectedInstructionHolder removeDependent:self.

    ].

    selectedInstructionHolder := valueModel.

    selectedInstructionHolder notNil ifTrue:[

        selectedInstructionHolder addDependent:self.

    ].

    newValue := selectedInstructionHolder value.

    oldValue ~~ newValue ifTrue:[

        self update:#value with:newValue from:selectedInstructionHolder.

    ].

! !

!VDBInstructionListApplication methodsFor:'change & update'!

enqueueDelayedUpdateBasicBlocks

    self enqueueMessage: #delayedUpdateBasicBlocks

    "Created: / 26-06-2018 / 12:20:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 18-02-2019 / 10:23:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

enqueueDelayedUpdateButtonEnablements

    self enqueueMessage: #delayedUpdateButtonEnablements

    "Created: / 03-10-2018 / 12:12:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 18-02-2019 / 10:23:46 / 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."

    sender == instructionListHolder ifTrue:[

        self enqueueDelayedUpdateInternalList.

        ^ self.

    ].

    sender == disassemblableHolder ifTrue:[ 

        self enqueueDelayedUpdateContents.

        ^ self.

    ].

    sender == frameHolder ifTrue:[ 

        self enqueueDelayedInvalidateInternalList.

        ^ self.

    ].

    sender == selectedInstructionHolder ifTrue:[ 

        self updateAfterSelectedInstructionChanged.

    ].

    super update:aspect with:param from:sender

    "Modified: / 23-01-2019 / 16:37:11 / jv"

    "Modified: / 10-06-2019 / 12:43:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

updateAfterSelectedInstructionChanged

    | selected |

    selected := self selectedInstructionHolder value.

    selected notNil ifTrue:[

        selected isBranch ifTrue:[ 

            selectedInstructionBranchTargetAddress := selected branchTarget.

        ] 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>"

!

updateButtonEnablements

    self enqueueDelayedUpdateButtonEnablements

    "Created: / 01-09-2018 / 14:49:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 10-06-2019 / 10:11:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!VDBInstructionListApplication methodsFor:'change & update-delayed'!

delayedInvalidateInternalList

    | frame |

    "/ First, force update of )cached) frames to get 

    "/ updated PC.

    frame := self frame.

    frame notNil ifTrue:[

        frame thread stack        

    ].    

    super delayedInvalidateInternalList

    "Created: / 03-10-2018 / 12:10:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 10-06-2019 / 12:45:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

delayedUpdateBasicBlocks

    | instructions |

    instructions := OrderedCollection new.

    self instructionsDo: [ :e | instructions add: e ].

    instructionBasicBlocks := VDBInstructionBasicBlock analyze: instructions.