89fa493a3b
Updates command registration to provide top-level handlers for all commands, rather than falling back onto the 'unknown' command. Instead, that same handler is registered for placeholders, providing the same functionality under the root verb command name instead. This permits users to implement their own 'unknown' function, and it resolves some mind-bending breakage related to function object lookup while recursing. Changes 'ocd_bounce' to call 'ocd_command' and 'ocd_help' from the wrapper directly, rather than bouncing through their wrappers. This prevents endless recursion caused by the above changes, whereby the 'command' wrapper's type check would blow the stack to hell and gone.
71 lines
1.8 KiB
Tcl
71 lines
1.8 KiB
Tcl
# Defines basic Tcl procs that must exist for OpenOCD scripts to work.
|
|
#
|
|
# Embedded into OpenOCD executable
|
|
#
|
|
|
|
|
|
# We need to explicitly redirect this to the OpenOCD command
|
|
# as Tcl defines the exit proc
|
|
proc exit {} {
|
|
ocd_throw exit
|
|
}
|
|
|
|
# All commands are registered with an 'ocd_' prefix, while the "real"
|
|
# command is a wrapper that calls this function. Its primary purpose is
|
|
# to discard 'handler' command output,
|
|
proc ocd_bouncer {name args} {
|
|
set cmd [format "ocd_%s" $name]
|
|
set type [eval ocd_command type $cmd $args]
|
|
if {$type == "native"} {
|
|
return [eval $cmd $args]
|
|
} else {if {$type == "simple"} {
|
|
if {[catch {eval $cmd $args}] == 0} {
|
|
return ""
|
|
} else {
|
|
set errmsg "Command handler execution failed"
|
|
}
|
|
} else {if {$type == "group"} {
|
|
catch {eval ocd_help $name $args}
|
|
set errmsg [format "%s: command requires more arguments" \
|
|
[concat $name " " $args]]
|
|
} else {
|
|
set errmsg [format "Unknown command type: %s" $type]
|
|
}}}
|
|
return -code error $errmsg
|
|
}
|
|
|
|
# Try flipping / and \ to find file if the filename does not
|
|
# match the precise spelling
|
|
proc find {filename} {
|
|
if {[catch {ocd_find $filename} t]==0} {
|
|
return $t
|
|
}
|
|
if {[catch {ocd_find [string map {\ /} $filename} t]==0} {
|
|
return $t
|
|
}
|
|
if {[catch {ocd_find [string map {/ \\} $filename} t]==0} {
|
|
return $t
|
|
}
|
|
# make sure error message matches original input string
|
|
return -code error "Can't find $filename"
|
|
}
|
|
add_usage_text find "<file>"
|
|
add_help_text find "print full path to file according to OpenOCD search rules"
|
|
|
|
# Run script
|
|
proc script {filename} {
|
|
source [find $filename]
|
|
}
|
|
add_help_text script "filename of OpenOCD script (tcl) to run"
|
|
add_usage_text script "<file>"
|
|
|
|
#########
|
|
|
|
# catch any exceptions, capture output and return output
|
|
proc capture_catch {a} {
|
|
catch {
|
|
capture {uplevel $a}
|
|
} result
|
|
return $result
|
|
}
|