neingeist
/
arduinisten
Archived
1
0
Fork 0
Code Releases Activity
You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
This repo is archived. You can view files and clone it, but cannot push or open issues/pull-requests.
master
Branches Tags
${ item.name }
Create tag ${ searchTerm }
Create branch ${ searchTerm }
from 'da63707eed'
${ noResults }
arduinisten/arduino-0018-windows/hardware/tools/avr/share/insight1.0/tracedlg.tcl

801 lines
22 KiB
Tcl
Raw Blame History

# 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 Git Blame Copy Permalink