summaryrefslogtreecommitdiff
path: root/gdb/gdbtk/library/tracedlg.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'gdb/gdbtk/library/tracedlg.tcl')
-rw-r--r--gdb/gdbtk/library/tracedlg.tcl800
1 files changed, 0 insertions, 800 deletions
diff --git a/gdb/gdbtk/library/tracedlg.tcl b/gdb/gdbtk/library/tracedlg.tcl
deleted file mode 100644
index 1a84b41c8b8..00000000000
--- a/gdb/gdbtk/library/tracedlg.tcl
+++ /dev/null
@@ -1,800 +0,0 @@
-# Trace configuration dialog for Insight
-# Copyright (C) 1997, 1998, 1999, 2001, 2002, 2003 Red Hat, Inc.
-#
-# This program is free software; you can redistribute it and/or modify it
-# under the terms of the GNU General Public License (GPL) as published by
-# the Free Software Foundation; either version 2 of the License, or (at
-# your option) any later version.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-
-
-# -----------------------------------------------------------------
-# Implements the Tracepoint configuration dialog box. This (modal)
-# dialog will be called upon to interact with gdb's tracepoint routines
-# allowing the user to add/edit tracepoints. Specifically, user can
-# specify:
-#
-# - What data to collect: locals, registers, "all registers", "all locals",
-# user-defined (globals)
-# - Number of passes which we should collect the data
-# - An ignore count after which data will start being collected
-# This method will destroy itself when the dialog is released. It returns
-# either one if a tracepoint was set/edited successfully or zero if
-# the user bails out (cancel or destroy buttons).
-
-itcl::class TraceDlg {
- inherit ManagedWin
-
- # ------------------------------------------------------------------
- # CONSTRUCTOR: create new trace dialog
- # ------------------------------------------------------------------
- constructor {args} {
-
- eval itk_initialize $args
- build_win
- title
- }
-
- # ------------------------------------------------------------------
- # DESTRUCTOR - destroy window containing widget
- # ------------------------------------------------------------------
- destructor {
-
- # Remove this window and all hooks
- if {$ActionsDlg != ""} {
- catch {delete object $ActionsDlg}
- }
- }
-
- # ------------------------------------------------------------------
- # METHOD: build_win - build the Trace dialog box (cache this?)
- # ------------------------------------------------------------------
- method build_win {} {
-
- set f $itk_interior
-
- # Need to set the title to either "Add Tracepoint" or "Edit Tracepoint",
- # depending on the location of the given tracepoint.
- # !! Why can I not do this?
-
- # If we have multiple lines, we "add" if we have any new ones ONLY..
- set nums {}
- set lown -1
- set highn -1
- set lowl -1
- set highl 0
- set functions {}
- set last_function {}
- set display_lines {}
- set display_number {}
-
- # Look at all lines
- foreach line $Lines {
- set num [gdb_tracepoint_exists "$File:$line"]
- if {$num == -1} {
- set New 1
- } else {
- set Exists 1
- }
-
- set function [gdb_get_function "$File:$line"]
- if {"$last_function" != "$function"} {
- lappend functions $function
- set last_function $function
- }
-
- if {$lown == -1 && $num != -1} {
- set lown $num
- }
- if {$lowl == -1} {
- set lowl $line
- }
-
- lappend Number $num
- if {$num > $highn} {
- set highn $num
- }
- if {$num != -1 && $num < $lown} {
- set lown $num
- }
- if {$line > $highl} {
- set highl $line
- }
- if {$line < $lowl} {
- set lowl $line
- }
- }
-
- # Look at all addresses
- foreach addr $Addresses {
- set num [gdb_tracepoint_exists "*$addr"]
- if {$num == -1} {
- set New 1
- } else {
- set Exists 1
- }
-
- set function [gdb_get_function "*$addr"]
- if {"$last_function" != "$function"} {
- lappend functions $function
- set last_function $function
- }
-
- if {$lown == -1 && $num != -1} {
- set lown $num
- }
- if {$lowl == -1} {
- set lowl $addr
- }
-
- lappend Number $num
- if {$num > $highn} {
- set highn $num
- }
- if {$num != -1 && $num < $lown} {
- set lown $num
- }
- if {$addr > $highl} {
- set highl $addr
- }
- if {$addr < $lowl} {
- set lowl $addr
- }
- }
-
- if {$Lines != {}} {
- if {[llength $Lines] == 1} {
- set Number $lown
- set display_number [concat $Number]
- set display_lines [concat $Lines]
- set multiline 0
- } else {
- # range of numbers
- set display_number "$lown-$highn"
- set display_lines "$lowl-$highl"
- set multiline 1
- }
- } elseif {$Addresses != {}} {
- if {[llength $Addresses] == 1} {
- set Number $lown
- set display_number [concat $Number]
- set display_lines [concat $Addresses]
- set multiline 0
- } else {
- # range of numbers
- set display_number "$lown-$highn"
- set display_lines "$lowl-$highl"
- set multiline 1
- }
- } elseif {$Number != {}} {
- set New 0
- set multiline 0
- set display_number $Number
- }
-
- # The three frames of this dialog
- set bbox [frame $f.bbox]; # for holding OK,CANCEL DELETE buttons
- Labelledframe $f.exp -text "Experiment"
- set exp [$f.exp get_frame]; # the "Experiment" frame
- Labelledframe $f.act -text "Actions"
- set act [$f.act get_frame]; # the "Actions" frame
-
- # Setup the button box
- button $bbox.ok -text OK -command "$this ok" -width 6
- button $bbox.cancel -text CANCEL -command "$this cancel"
- set Delete [button $bbox.delete -text DELETE -command "$this delete_tp"]
- pack $bbox.ok $bbox.cancel -side left -padx 10 -expand yes
- pack $bbox.delete -side right -padx 10 -expand yes
-
- # Setup the "Experiment" frame
- if {$New} {
- set hit_count "N/A"
- set thread "N/A"
- set _TPassCount 0
- if {!$Exists} {
- $Delete configure -state disabled
- }
- } else {
- if {!$multiline} {
- set stuff [gdb_get_tracepoint_info $Number]
- # 0=file 1=func 2=line 3=addr 4=disposition 5=passCount 6=stepCount
- # 7=thread 8=hitCount 9=actions
- set enabled [lindex $stuff 4]
- set _TPassCount [lindex $stuff 5]
- set thread [lindex $stuff 7]
- set hit_count [lindex $stuff 8]
- set actions [lindex $stuff 9]
- if {$File == {}} {
- set File [lindex $stuff 0]
- }
- if {$Lines == {} && $Addresses == {}} {
- set Addresses [lindex $stuff 3]
- set display_lines $Addresses
- }
- if {$functions == {}} {
- set functions [lindex $stuff 1]
- }
- } else {
- # ummm...
- set hit_count "N/A"
- set thread "N/A"
-
- # !! Assumptions...
- set stuff [gdb_get_tracepoint_info [lindex $Number 0]]
- set _TPassCount [lindex $stuff 5]
- set actions [lindex $stuff 9]
- }
- }
-
- # Number
- label $exp.numlbl -text {Number:}
- label $exp.number -text $display_number
-
- # File
- label $exp.fillbl -text {File:}
- label $exp.file -text $File
- # Line
- if {$Lines != {}} {
- label $exp.linlbl -text {Line(s):}
- } else {
- label $exp.linlbl -text {Address(es):}
- }
- label $exp.line -text $display_lines
-
- # Function
- if {[llength $functions] > 1} {
- # Do not allow this until we clean up the action dialog...
- tk_messageBox -type ok -icon error \
- -message "Cannot set tracepoint ranges across functions!"
- after idle [code delete object $this]
- }
- #set functions [join $functions ,]
- label $exp.funlbl -text {Function:}
- label $exp.funct -text [concat $functions]
-
- # Hit count
- label $exp.hitlbl -text {Hit Count:}
- label $exp.hit -text $hit_count
-
- # Thread
- label $exp.thrlbl -text {Thread:}
- label $exp.thread -text $thread
-
- # Place these onto the screen
- grid $exp.numlbl -row 0 -column 0 -sticky w -padx 10 -pady 1
- grid $exp.number -row 0 -column 1 -sticky w -padx 10 -pady 1
- grid $exp.funlbl -row 0 -column 2 -sticky w -padx 10 -pady 1
- grid $exp.funct -row 0 -column 3 -sticky w -padx 10 -pady 1
- grid $exp.hitlbl -row 1 -column 0 -sticky w -padx 10 -pady 1
- grid $exp.hit -row 1 -column 1 -sticky w -padx 10 -pady 1
- grid $exp.fillbl -row 1 -column 2 -sticky w -padx 10 -pady 1
- grid $exp.file -row 1 -column 3 -sticky w -padx 10 -pady 1
- grid $exp.thrlbl -row 2 -column 0 -sticky w -padx 10 -pady 1
- grid $exp.thread -row 2 -column 1 -sticky w -padx 10 -pady 1
- grid $exp.linlbl -row 2 -column 2 -sticky w -padx 10 -pady 1
- grid $exp.line -row 2 -column 3 -sticky w -padx 10 -pady 1
-
- # Configure columns
- grid columnconfigure $exp 0 -weight 1
- grid columnconfigure $exp 1 -weight 1
- grid columnconfigure $exp 2 -weight 1
- grid columnconfigure $exp 3 -weight 1
-
- # The "Actions" Frame
- set pass_frame [frame $act.pass]
- set act_frame [frame $act.actions]
- set new_frame [frame $act.new]
-
- # Pack these frames
- pack $pass_frame -fill x
- pack $act_frame -fill both -expand 1
- pack $new_frame -side top -fill x
-
- # Passes
- label $pass_frame.lbl -text {Number of Passes:}
- entry $pass_frame.ent -textvariable _TPassCount -width 5
- pack $pass_frame.lbl -side left -padx 10 -pady 5
- pack $pass_frame.ent -side right -padx 10 -pady 5
-
- # Actions
- set ActionLB $act_frame.lb
- iwidgets::scrolledlistbox $act_frame.lb -hscrollmode dynamic \
- -vscrollmode dynamic -selectmode multiple -exportselection 0 \
- -dblclickcommand [code $this edit] \
- -selectioncommand [code $this set_delete_action_state $ActionLB $new_frame.del_but] \
- -background $::Colors(bg)
- [$ActionLB component listbox] configure -background $::Colors(bg)
- label $act_frame.lbl -text {Actions}
- pack $act_frame.lbl -side top
- pack $act_frame.lb -side bottom -fill both -expand 1 -padx 5 -pady 5
-
- # New actions
- combobox::combobox $new_frame.combo -maxheight 15 -editable 0 \
- -font global/fixed -command [code $this set_action_type] \
- -bg $::Colors(textbg)
- $new_frame.combo list insert end collect while-stepping
- $new_frame.combo entryset collect
-
- button $new_frame.add_but -text {Add} -command "$this add_action"
- pack $new_frame.combo $new_frame.add_but -side left -fill x \
- -padx 5 -pady 5
-
- button $new_frame.del_but -text {Delete} -state disabled \
- -command "$this delete_action"
- pack $new_frame.del_but -side right -fill x \
- -padx 5 -pady 5
-
- # Pack the main frames
- pack $bbox -side bottom -padx 5 -pady 8 -fill x
- pack $f.exp -side top -padx 5 -pady 2 -fill x
- pack $f.act -side top -padx 5 -pady 2 -expand yes -fill both
-
- # If we are not new, add all actions
- if {!$New} {
- add_all_actions $actions
- }
-
- # !! FOR SOME REASON, THE *_FRAMES DO NOT GET MAPPED WHENEVER THE USER
- # WAITS A FEW SECONDS TO PLACE THIS DIALOG ON THE SCREEN. This is here
- # as a workaround so that the action-related widgets don't disappear...
- #update idletasks
- }
-
- method set_action_type {widget action} {
- set ActionType $action
- }
-
- method add_action {} {
-
- if {"$ActionType" == "while-stepping"} {
- if {$WhileStepping} {
- # We are only allowed on of these...
- tk_messageBox -icon error -type ok \
- -message "A tracepoint may only have one while-stepping action."
- return
- }
- set whilestepping 1
- set step_args "-Steps 1"
- } else {
- set whilestepping 0
- set step_args {}
- }
-
- #debug "ADDING ACTION FOR $File:[lindex $Lines 0]"
- if {$Lines != {}} {
- set ActionsDlg [eval ManagedWin::open ActionDlg -File $File \
- -Line [lindex $Lines 0] \
- -WhileStepping $whilestepping -Number [lindex $Number 0]\
- -Callback "\\\{$this done\\\}" $step_args]
- } else {
- set ActionsDlg [eval ManagedWin::open ActionDlg -File $File \
- -Address [lindex $Addresses 0] \
- -WhileStepping $whilestepping -Number [lindex $Number 0]\
- -Callback "\\\{$this done\\\}" $step_args]
- }
- }
-
- method delete_action {} {
- # If we just delete these from the action list, they will get deleted
- # when the user presses OK.
-
- set selected_elem [lsort -integer -decreasing [$ActionLB curselection]]
- foreach elem $selected_elem {
- $ActionLB delete $elem
- }
- }
-
- method set_delete_action_state {list but} {
- if {[$list curselection] == ""} {
- $but configure -state disabled
- } else {
- $but configure -state normal
- }
- }
-
- method done {status {steps 0} {data {}}} {
-
- # We have just returned from the ActionDlg: must reinstall our grab
-# after idle grab $this
-
- switch $status {
- cancel {
- # Don't do anything
- set ActionsDlg {}
- return
- }
- add {
- add_action_to_list $steps $data
- set ActionsDlg {}
- }
- delete {
- # do something
- set ActionsDlg {}
- }
- modify {
- # Delete the current selection and insert the new one in its place
- $ActionLB delete $Selection
- add_action_to_list $steps $data $Selection
- set ActionsDlg {}
- }
- default {
- debug "Unknown status from ActionDlg : \"$status\""
- }
- }
- }
-
- method add_action_to_list {steps data {index {}}} {
-
- set data [join $data ,]
-
- if {$steps > 0} {
- if {"$index" == ""} {
- set index "end"
- }
- $ActionLB insert $index "while-stepping ($steps): $data"
- set WhileStepping 1
- } else {
- if {"$index" == ""} {
- set index 0
- }
- $ActionLB insert $index "collect: $data"
- }
- }
-
- # ------------------------------------------------------------------
- # METHOD: cancel - cancel the dialog and do not set the trace
- # ------------------------------------------------------------------
- method cancel {} {
- ::delete object $this
- }
-
- # ------------------------------------------------------------------
- # METHOD: ok - validate the tracepoint and install it
- # ------------------------------------------------------------------
- method ok {} {
-
- # We "dismiss" the dialog here...
- wm withdraw [winfo toplevel [namespace tail $this]]
-
- set actions [get_actions]
- # Check that we are collecting data
-
- # This is silly, but, hey, it works.
- # Lines is the line number where the tp is
- # in case of a tp-range it is the set of lines for that range
- if {$Lines != {}} {
- for {set i 0} {$i < [llength $Number]} {incr i} {
- set number [lindex $Number $i]
- set line [lindex $Lines $i]
-
- if {$number == -1} {
- #debug "Adding new tracepoint at $File:$line $_TPassCount $actions"
- set err [catch {gdb_add_tracepoint $File:$line $_TPassCount $actions} errTxt]
- } else {
- if {$New && $Exists} {
- set result [tk_messageBox -icon error -type yesno \
- -message "Overwrite actions for tracepoint \#$number at $File:$line?" \
- -title "Query"]
- if {"$result" == "no"} {
- continue
- }
- }
- if {$New == 0 && $Exists == 1} {
- set tpnum [gdb_tracepoint_exists "$File:$line"]
- if {$tpnum == -1} {
- tk_messageBox -type ok -icon error -message "Tracepoint was deleted"
- ::delete object $this
- return
- }
- }
-
- #debug "Editing tracepoint \#$Number: $_TPassCount $actions"
- set err [catch {gdb_edit_tracepoint $number $_TPassCount $actions} errTxt]
- }
-
- if {$err} {
- if {$number == -1} {
- set str "adding new tracepoint at $File:$line"
- } else {
- set str "editing tracepoint $number at $File:$line"
- }
- tk_messageBox -type ok -icon error -message "Error $str: $errTxt"
- }
- }
- } else {
- # Async
- for {set i 0} {$i < [llength $Number]} {incr i} {
- set number [lindex $Number $i]
- set addr [lindex $Addresses $i]
- if {$number == -1} {
- #debug "Adding new tracepoint at $addr in $File; $_TPassCount $actions"
- set err [catch {gdb_add_tracepoint {} $_TPassCount $actions $addr} errTxt]
- } else {
- if {$New && $Exists} {
- set result [tk_messageBox -icon error -type yesno \
- -message "Overwrite actions for tracepoint \#$number at $File:$line?" \
- -title "Query"]
- if {"$result" == "no"} {
- continue
- }
- }
- if {$New == 0 && $Exists == 1} {
- set num [gdb_tracepoint_exists "$File:$Line"]
- if {$num == -1} {
- tk_messageBox -type ok -icon error -message "Tracepoint was deleted"
- ::delete object $this
- return
- }
- }
-
- #debug "Editing tracepoint \#$Number: $_TPassCount $actions"
- set err [catch {gdb_edit_tracepoint $number $_TPassCount $actions} errTxt]
- }
-
- if {$err} {
- if {$number == -1} {
- set str "adding new tracepoint at $addr in $File"
- } else {
- set str "editing tracepoint $number at $addr in $File"
- }
- tk_messageBox -type ok -icon error -message "Error $str: $errTxt"
- }
- }
- }
-
- ::delete object $this
- }
-
- method cmd {line} {
- $line
- }
-
- method delete_tp {} {
- debug "deleting tracepoint $Number"
- set err [catch {gdb_cmd "delete tracepoints $Number"} errTxt]
- debug "done deleting tracepoint $Number"
- ::delete object $this
- }
-
- method get_data {action} {
-
- set data {}
- foreach a $action {
- set datum [string trim $a \ \r\n\t,]
- if {"$datum" == "collect" || "$datum" == ""} {
- continue
- }
-
- lappend data $datum
- }
-
- return $data
- }
-
- method add_all_actions {actions} {
-
- set length [llength $actions]
- for {set i 0} {$i < $length} {incr i} {
- set action [lindex $actions $i]
-
- if {[regexp "collect" $action]} {
- set steps 0
- set data [get_data $action]
- } elseif {[regexp "while-stepping" $action]} {
- scan $action "while-stepping %d" steps
- incr i
- set action [lindex $actions $i]
- set data [get_data $action]
- } elseif {[regexp "end" $action]} {
- continue
- }
-
- # Now have an action: data and steps
- add_action_to_list $steps $data
- }
- }
-
- method get_actions {} {
-
- set actions {}
- set list [$ActionLB get 0 end]
- foreach action $list {
- if {[regexp "collect" $action]} {
- scan $action "collect: %s" data
- set steps 0
- set whilestepping 0
- } elseif {[regexp "while-stepping" $action]} {
- scan $action "while-stepping (%d): %s" steps data
- set whilestepping 1
- } else {
- debug "unknown action: $action"
- continue
- }
-
- lappend actions [list $steps $data]
- }
-
- return $actions
- }
-
- method edit {} {
-
- set Selection [$ActionLB curselection]
- if {$Selection != ""} {
- set action [$ActionLB get $Selection]
- if [regexp "collect" $action] {
- scan $action "collect: %s" data
- set steps 0
- set whilestepping 0
- } elseif [regexp "while-stepping" $action] {
- scan $action "while-stepping (%d): %s" steps data
- set whilestepping 1
- } else {
- debug "unknown action: $action"
- return
- }
-
- set data [split $data ,]
- set len [llength $data]
- set real_data {}
- set special 0
- for {set i 0} {$i < $len} {incr i} {
- set a [lindex $data $i]
- if {[string range $a 0 1] == "\$("} {
- set special 1
- set b $a
- } elseif {$special} {
- lappend b $a
- if {[string index $a [expr {[string length $a]-1}]] == ")"} {
- lappend real_data [join $b ,]
- set special 0
- }
- } else {
- lappend real_data $a
- }
- }
-
- # !! lindex $Lines 0 -- better way?
- if {$Lines != {}} {
- ManagedWin::open ActionDlg -File $File -Line [lindex $Lines 0] \
- -WhileStepping $whilestepping -Number [lindex $Number 0] \
- -Callback [list [code $this done]] -Data $real_data -Steps $steps
- } else {
- ManagedWin::open ActionDlg -File $File -Address [lindex $Addresses 0] \
- -WhileStepping $whilestepping -Number [lindex $Number 0] \
- -Callback [list [code $this done]] -Data $real_data -Steps $steps
- }
- }
- }
-
- method get_selection {} {
-
- set action [$ActionLB curselection]
- return [$ActionLB get $action]
- }
-
- # ------------------------------------------------------------------
- # METHOD: title - Title the trace dialog.
- #
- # This is needed to title the window after the dialog has
- # been created. The window manager actually sets our title
- # after we've been created, so we need to do this in an
- # "after idle".
- # ------------------------------------------------------------------
- method title {} {
- if {$New} {
- set display_number "N/A"
- wm title [winfo toplevel [namespace tail $this]] "Add Tracepoint"
- } else {
- wm title [winfo toplevel [namespace tail $this]] "Edit Tracepoint"
- }
- }
-
- # PUBLIC DATA
- public variable File {}
- public variable Lines {}
- public variable Addresses {}
- public variable Number {}
-
- # PROTECTED DATA
- protected variable Delete
- protected variable _TPassCount
- protected variable ActionType {}
- protected variable ActionLB
- protected variable Actions
- protected variable WhileStepping 0
- protected variable Selection {}
- protected variable New 0; # set whenever there is a new tp to add
- protected variable Exists 0; # set whenever a tracepoint in the range exists
- protected variable Dismissed 0; # has this dialog been dismissed already?
- protected variable ActionsDlg {}
-}
-
-proc gdb_add_tracepoint {where passes actions {addr {}}} {
- #debug "gdb_add_tracepoint $where $passes $actions $addr"
-
- # Install the tracepoint
- if {$where == "" && $addr != ""} {
- set where "*$addr"
- }
-
- #debug "trace $where"
- set err [catch {gdb_cmd "trace $where"} errTxt]
-
- if {$err} {
- tk_messageBox -type ok -icon error -message $errTxt
- return
- }
-
- # Get the number for this tracepoint
- set number [gdb_tracepoint_exists $where]
-
- # If there is a pass count, add that, too
- set err [catch {gdb_cmd "passcount $passes $number"} errTxt]
-
- if {$err} {
- tk_messageBox -type ok -icon error -message $errTxt
- return
- }
-
- set real_actions {}
- foreach action $actions {
- set steps [lindex $action 0]
- set data [lindex $action 1]
-
- if {$steps} {
- lappend real_actions "while-stepping $steps"
- lappend real_actions "collect $data"
- lappend real_actions "end"
- } else {
- lappend real_actions "collect $data"
- }
- }
-
- if {[llength $real_actions] > 0} {
- lappend real_actions "end"
- }
-
- set err [catch {gdb_actions $number $real_actions} errTxt]
- if $err {
- set errTxt "$errTxt Tracepoint will be installed with no actions"
- tk_messageBox -type ok -icon error -message $errTxt
- return
- }
-}
-
-proc gdb_edit_tracepoint {number passes actions} {
- #debug "gdb_edit_tracepoint $number $passes $actions"
-
- # If there is a pass count, add that, too
- set err [catch {gdb_cmd "passcount $passes $number"} errTxt]
-
- if $err {
- tk_messageBox -type ok -icon error -message $errTxt
- return
- }
-
- set real_actions {}
- foreach action $actions {
- set steps [lindex $action 0]
- set data [lindex $action 1]
-
- if $steps {
- lappend real_actions "while-stepping $steps"
- lappend real_actions "collect $data"
- lappend real_actions "end"
- } else {
- lappend real_actions "collect $data"
- }
- }
-
- if {[llength $real_actions] > 0} {
- lappend real_actions "end"
- }
-
- gdb_actions $number $real_actions
-}
View Lorry Controller Status