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 # Help text list. A list of command + help text pairs.
  14 proc cmd_help {cmdname h indent} {
  15         set indent [expr $indent * 2]
  16
  17         set fmt_str [format "%%%ds%%-%ds %%s" $indent [expr 25 - $indent]]
  18         set w [expr 50 - $indent]
  19         set n 0
  20
  21         while 1 {
  22                 if {$n > [string length $h]} {break}
  23
  24                 set next_a [expr $n + $w]
  25                 if {[string length $h] > $n + $w} \
  26                 {
  27                         set xxxx [string range $h $n [expr $n + $w]]
  28                         for {set lastpos [expr [string length $xxxx] - 1]} \
  29                                 {$lastpos >= 0 && [string compare \
  30                                         [string range $xxxx $lastpos $lastpos] " "] != 0} \
  31                                 {set lastpos [expr $lastpos - 1]} \
  32                         {
  33                         }
  34                         #set next_a -1
  35                         if {$lastpos != -1} {
  36                                 set next_a [expr $lastpos + $n + 1]
  37                         }
  38                 }
  39
  40                 puts [format $fmt_str "" $cmdname \
  41                                 [string range $h $n [expr $next_a - 1]] ]
  42                 set cmdname ""
  43                 set n [expr $next_a]
  44         }
  45 }
  46
  47 # If a fn is unknown to Tcl, we try to execute it as an OpenOCD command
  48 #
  49 # We also support two level commands. "flash banks" is translated to
  50 # flash_banks
  51 proc unknown {args} {
  52         # do the name mangling from "flash banks" to "flash_banks"
  53         if {[llength $args]>=2} {
  54                 set cmd_name "[lindex $args 0]_[lindex $args 1]"
  55                 if {[catch {info body $cmd_name}]==0} {
  56                     # the command exists, try it...
  57                         return [eval "$cmd_name [lrange $args 2 end]"]
  58                 }
  59         }
  60         # This really is an unknown command.
  61         return -code error "Unknown command: $args"
  62 }
  63
  64 proc new_target_name { } {
  65         return [target number [expr [target count] - 1 ]]
  66 }
  67
  68 # Try flipping / and \ to find file if the filename does not
  69 # match the precise spelling
  70 proc find {filename} {
  71         if {[catch {ocd_find $filename} t]==0} {
  72                 return $t
  73         }
  74         if {[catch {ocd_find [string map {\ /} $filename} t]==0} {
  75                 return $t
  76         }
  77         if {[catch {ocd_find [string map {/ \\} $filename} t]==0} {
  78                 return $t
  79         }
  80         # make sure error message matches original input string
  81         return -code error "Can't find $filename"
  82 }
  83 add_help_text find "<file> - print full path to file according to OpenOCD search rules"
  84
  85 # Run script
  86 proc script {filename} {
  87         source [find $filename]
  88 }
  89
  90 add_help_text script "<filename> - filename of OpenOCD script (tcl) to run"
  91
  92 #########
  93
  94 # catch any exceptions, capture output and return output
  95 proc capture_catch {a} {
  96         catch {
  97                 capture {uplevel $a}
  98         } result
  99         return $result
 100 }