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
   7 # We need to explicitly redirect this to the OpenOCD command
   8 # as Tcl defines the exit proc
   9 proc exit {} {
  10         ocd_throw exit
  11 }
  12
  13 # All commands are registered with an 'ocd_' prefix, while the "real"
  14 # command is a wrapper that calls this function.  Its primary purpose is
  15 # to discard 'handler' command output,
  16 proc ocd_bouncer {name args} {
  17         set cmd [format "ocd_%s" $name]
  18         set type [eval ocd_command type $cmd $args]
  19         if {$type == "native"} {
  20                 return [eval $cmd $args]
  21         } else {if {$type == "simple"} {
  22                 if {[catch {eval $cmd $args}] == 0} {
  23                         return ""
  24                 } else {
  25                         set errmsg "Command handler execution failed"
  26                 }
  27         } else {if {$type == "group"} {
  28                 catch {eval ocd_usage $name $args}
  29                 set errmsg [format "%s: command requires more arguments" \
  30                         [concat $name " " $args]]
  31         } else {
  32                 set errmsg [format "Unknown command type: %s" $type]
  33         }}}
  34         return -code error $errmsg
  35 }
  36
  37 # Try flipping / and \ to find file if the filename does not
  38 # match the precise spelling
  39 proc find {filename} {
  40         if {[catch {ocd_find $filename} t]==0} {
  41                 return $t
  42         }
  43         if {[catch {ocd_find [string map {\ /} $filename} t]==0} {
  44                 return $t
  45         }
  46         if {[catch {ocd_find [string map {/ \\} $filename} t]==0} {
  47                 return $t
  48         }
  49         # make sure error message matches original input string
  50         return -code error "Can't find $filename"
  51 }
  52 add_usage_text find "<file>"
  53 add_help_text find "print full path to file according to OpenOCD search rules"
  54
  55 # Run script
  56 proc script {filename} {
  57         source [find $filename]
  58 }
  59 add_help_text script "filename of OpenOCD script (tcl) to run"
  60 add_usage_text script "<file>"
  61
  62 #########
  63
  64 # catch any exceptions, capture output and return output
  65 proc capture_catch {a} {
  66         catch {
  67                 capture {uplevel $a}
  68         } result
  69         return $result
  70 }