git.gag.com Git - fw/openocd/blob - src/helper/startup.tcl

   1 # Defines basic Tcl procs that must exist for OpenOCD scripts to work.
   2 #
   3 # Embedded into OpenOCD executable
   4 #
   5
   6 # All commands are registered with an 'ocd_' prefix, while the "real"
   7 # command is a wrapper that calls this function.  Its primary purpose is
   8 # to discard 'handler' command output.
   9 # Due to the two nested proc calls, this wrapper has to explicitly run
  10 # the wrapped command in the stack frame two levels above.
  11 proc ocd_bouncer {name args} {
  12         set cmd [format "ocd_%s" $name]
  13         set type [eval ocd_command type $cmd $args]
  14         set errcode error
  15         set skiplevel [expr [eval info level] > 1 ? 2 : 1]
  16         if {$type == "native"} {
  17                 return [uplevel $skiplevel $cmd $args]
  18         } else {if {$type == "simple"} {
  19                 set errcode [catch {uplevel $skiplevel $cmd $args}]
  20                 if {$errcode == 0} {
  21                         return ""
  22                 } else {
  23                         # 'classic' commands output error message as part of progress output
  24                         set errmsg ""
  25                 }
  26         } else {if {$type == "group"} {
  27                 catch {eval ocd_usage $name $args}
  28                 set errmsg [format "%s: command requires more arguments" \
  29                         [concat $name " " $args]]
  30         } else {
  31                 set errmsg [format "invalid subcommand \"%s\"" $args]
  32         }}}
  33         return -code $errcode $errmsg
  34 }
  35
  36 # Try flipping / and \ to find file if the filename does not
  37 # match the precise spelling
  38 proc find {filename} {
  39         if {[catch {ocd_find $filename} t]==0} {
  40                 return $t
  41         }
  42         if {[catch {ocd_find [string map {\ /} $filename} t]==0} {
  43                 return $t
  44         }
  45         if {[catch {ocd_find [string map {/ \\} $filename} t]==0} {
  46                 return $t
  47         }
  48         # make sure error message matches original input string
  49         return -code error "Can't find $filename"
  50 }
  51 add_usage_text find "<file>"
  52 add_help_text find "print full path to file according to OpenOCD search rules"
  53
  54 # Find and run a script
  55 proc script {filename} {
  56         uplevel #0 [list source [find $filename]]
  57 }
  58 add_help_text script "filename of OpenOCD script (tcl) to run"
  59 add_usage_text script "<file>"
  60
  61 #########
  62