2008-07-11 03:17:31 -05:00
#
# Defines basic Tcl procs that must be there for
# OpenOCD to work.
#
# Embedded into OpenOCD executable
#
2008-07-11 10:07:58 -05:00
# Help text list. A list of command + help text pairs.
#
# Commands can be more than one word and they are stored
# as "flash banks" "help text x x x"
proc add_help_text { cmd cmd_help} {
global ocd_helptext
lappend ocd_helptext [ list $cmd $cmd_help ]
}
2008-07-12 02:50:17 -05:00
proc get_help_text { } {
global ocd_helptext
return $ocd_helptext
}
2008-07-11 03:17:31 -05:00
# Show flash in human readable form
# This is an example of a human readable form of a low level fn
2009-09-21 13:40:55 -05:00
proc flash_banks { } {
set i 0
2008-07-11 03:17:31 -05:00
set result " "
2008-07-20 12:04:58 -05:00
foreach { a } [ ocd_flash_banks ] {
2008-07-11 03:17:31 -05:00
if { $i > 0 } {
set result " $ r e s u l t \n "
}
2008-07-16 07:44:00 -05:00
set result [ format " $ r e s u l t # % d : % s a t 0 x % 0 8 x , s i z e 0 x % 0 8 x , b u s w i d t h % d , c h i p w i d t h % d " $i $a ( name ) $a ( base ) $a ( size ) $a ( bus_width ) $a ( chip_width ) ]
2009-09-21 13:40:55 -05:00
set i [ expr $i + 1 ]
}
2008-07-11 03:17:31 -05:00
return $result
}
# We need to explicitly redirect this to the OpenOCD command
# as Tcl defines the exit proc
proc exit { } {
2008-07-20 12:04:58 -05:00
ocd_throw exit
2008-07-11 03:17:31 -05:00
}
2008-07-11 12:36:36 -05:00
# Print help text for a command. Word wrap
# help text that is too wide inside column.
2008-07-11 14:30:54 -05:00
proc help { args } {
2008-07-11 10:07:58 -05:00
global ocd_helptext
set cmd $args
foreach a [ lsort $ocd_helptext ] {
2008-07-11 12:46:17 -05:00
if { [ string length $cmd ] == 0 || [ string first $cmd $a ] != - 1 || [ string first $cmd [ lindex $a 1 ] ] != - 1 } {
2008-07-11 14:30:54 -05:00
set w 50
2008-07-11 12:36:36 -05:00
set cmdname [ lindex $a 0 ]
set h [ lindex $a 1 ]
set n 0
while 1 {
if { $n > [ string length $h ] } { break }
2009-09-21 13:40:55 -05:00
2008-07-11 12:36:36 -05:00
set next_a [ expr $n + $w ]
if { [ string length $h ] > $n + $w } {
set xxxx [ string range $h $n [ expr $n + $w ] ]
for { set lastpos [ expr [ string length $xxxx ] - 1 ] } { $lastpos >= 0 && [ string compare [ string range $xxxx $lastpos $lastpos ] " " ] != 0 } { set lastpos [ expr $lastpos-1 ] } {
}
# set next_a -1
if { $lastpos != -1 } {
set next_a [ expr $lastpos + $n + 1 ]
}
}
2009-09-21 13:40:55 -05:00
2008-07-11 12:36:36 -05:00
puts [ format " % - 2 5 s % s " $cmdname [ string range $h $n [ expr $next_a-1 ] ] ]
set cmdname " "
set n [ expr $next_a ]
}
2008-07-11 10:07:58 -05:00
}
}
}
2008-07-11 14:30:54 -05:00
add_help_text help " T c l i m p l e m e n t a t i o n o f h e l p c o m m a n d "
2008-07-11 10:07:58 -05:00
2008-07-11 03:17:31 -05:00
# If a fn is unknown to Tcl, we try to execute it as an OpenOCD command
2008-07-17 03:34:14 -05:00
#
# We also support two level commands. "flash banks" is translated to
# flash_banks
2008-07-11 03:17:31 -05:00
proc unknown { args } {
2008-07-17 03:34:14 -05:00
# do the name mangling from "flash banks" to "flash_banks"
if { [ llength $args ] >= 2 } {
set cmd_name " [ l i n d e x $ a r g s 0 ] _ [ l i n d e x $ a r g s 1 ] "
2009-05-18 08:07:37 -05:00
if { [ catch { info body $cmd_name } ] == 0 } {
# the command exists, try it...
return [ eval " $ c m d _ n a m e [ l r a n g e $ a r g s 2 e n d ] " ]
}
2008-07-11 03:17:31 -05:00
}
2008-07-17 03:34:14 -05:00
# This really is an unknown command.
2008-07-19 05:37:41 -05:00
return - code error " U n k n o w n c o m m a n d : $ a r g s "
2008-07-11 03:17:31 -05:00
}
2008-07-16 02:22:17 -05:00
2008-09-01 02:20:21 -05:00
proc new_target_name { } {
2008-10-24 10:53:22 -05:00
return [ target number [ expr [ target count] - 1 ] ]
2008-09-01 02:20:21 -05:00
}
2008-07-16 15:20:15 -05:00
# Try flipping / and \ to find file if the filename does not
# match the precise spelling
proc find { filename } {
2008-07-20 12:04:58 -05:00
if { [ catch { ocd_find $filename } t] == 0 } {
2008-07-16 15:20:15 -05:00
return $t
2008-10-24 10:53:22 -05:00
}
2008-07-20 12:04:58 -05:00
if { [ catch { ocd_find [ string map { \ / } $filename } t] == 0 } {
2008-07-16 15:20:15 -05:00
return $t
2008-10-24 10:53:22 -05:00
}
2008-07-20 12:04:58 -05:00
if { [ catch { ocd_find [ string map { / \ \ } $filename } t] == 0 } {
2008-07-16 15:20:15 -05:00
return $t
2008-10-24 10:53:22 -05:00
}
2008-07-16 15:20:15 -05:00
# make sure error message matches original input string
2008-07-22 03:58:44 -05:00
return - code error " C a n ' t f i n d $ f i l e n a m e "
2008-07-16 15:20:15 -05:00
}
add_help_text find " < f i l e > - p r i n t f u l l p a t h t o f i l e a c c o r d i n g t o O p e n O C D s e a r c h r u l e s "
# Run script
proc script { filename } {
source [ find $filename ]
}
add_help_text script " < f i l e n a m e > - f i l e n a m e o f O p e n O C D s c r i p t ( t c l ) t o r u n "
2008-07-21 13:24:43 -05:00
# Handle GDB 'R' packet. Can be overriden by configuration script,
# but it's not something one would expect target scripts to do
# normally
2009-08-30 12:30:14 -05:00
proc ocd_gdb_restart { target_id } {
2008-07-21 13:24:43 -05:00
# Fix!!! we're resetting all targets here! Really we should reset only
# one target
2008-07-21 13:06:36 -05:00
reset halt
2008-08-25 08:18:55 -05:00
}
2009-10-09 01:51:50 -05:00
# This reset logic may be overridden by board/target/... scripts as needed
# to provide a reset that, if possible, is close to a power-up reset.
#
# Exit requirements include: (a) JTAG must be working, (b) the scan
# chain was validated with "jtag arp_init" (or equivalent), (c) nothing
# stays in reset. No TAP-specific scans were performed. It's OK if
# some targets haven't been reset yet; they may need TAP-specific scans.
#
# The "mode" values include: halt, init, run (from "reset" command);
# startup (at OpenOCD server startup, when JTAG may not yet work); and
# potentially more (for reset types like cold, warm, etc)
proc init_reset { mode } {
jtag arp_init-reset
}
2009-09-14 08:54:49 -05:00
global in_process_reset
set in_process_reset 0
# Catch reset recursion
2008-09-12 01:56:00 -05:00
proc ocd_process_reset { MODE } {
2009-09-14 08:54:49 -05:00
global in_process_reset
if { $in_process_reset } {
set in_process_reset 0
return - code error " ' r e s e t ' c a n n o t b e i n v o k e d r e c u r s i v e l y "
}
2009-09-21 13:40:55 -05:00
2009-09-14 08:54:49 -05:00
set in_process_reset 1
2009-09-21 13:40:55 -05:00
set success [ expr [ catch { ocd_process_reset_inner $MODE } result] == 0 ]
2009-09-14 08:54:49 -05:00
set in_process_reset 0
2009-09-21 13:40:55 -05:00
2009-09-14 08:54:49 -05:00
if { $success } {
return $result
} else {
return - code error $result
}
}
proc ocd_process_reset_inner { MODE } {
2009-09-17 19:11:51 -05:00
set targets [ target names]
2008-09-12 01:56:00 -05:00
2008-10-24 10:53:22 -05:00
# If this target must be halted...
set halt - 1
if { 0 == [ string compare $MODE halt] } {
set halt 1
}
if { 0 == [ string compare $MODE init] } {
set halt 1 ;
}
if { 0 == [ string compare $MODE run ] } {
set halt 0 ;
}
if { $halt < 0 } {
return - error " I n v a l i d m o d e : $ M O D E , m u s t b e o n e o f : h a l t , i n i t , o r r u n " ;
}
2009-06-07 18:35:29 -05:00
# Target event handlers *might* change which TAPs are enabled
# or disabled, so we fire all of them. But don't issue any
2009-09-17 19:11:51 -05:00
# target "arp_*" commands, which may issue JTAG transactions,
2009-06-07 18:35:29 -05:00
# unless we know the underlying TAP is active.
2009-09-17 19:11:51 -05:00
#
# NOTE: ARP == "Advanced Reset Process" ... "advanced" is
# relative to a previous restrictive scheme
2009-06-07 18:35:29 -05:00
2009-09-17 19:11:51 -05:00
foreach t $targets {
2008-10-13 05:30:33 -05:00
# New event script.
$t invoke-event reset-start
2008-10-24 10:53:22 -05:00
}
2008-09-12 01:56:00 -05:00
2009-09-17 19:11:51 -05:00
# Use TRST or TMS/TCK operations to reset all the tap controllers.
# TAP reset events get reported; they might enable some taps.
2009-10-09 01:51:50 -05:00
init_reset $MODE
2008-09-12 01:56:00 -05:00
2009-06-07 18:35:29 -05:00
# Examine all targets on enabled taps.
2009-09-17 19:11:51 -05:00
foreach t $targets {
2009-06-07 18:35:29 -05:00
if { [ jtag tapisenabled [ $t cget - chain-position] ] } {
$t arp_examine
}
2008-10-24 10:53:22 -05:00
}
2008-09-12 01:56:00 -05:00
2009-09-17 19:11:51 -05:00
# Assert SRST, and report the pre/post events.
2009-09-23 17:03:41 -05:00
# Note: no target sees SRST before "pre" or after "post".
2009-09-17 19:11:51 -05:00
foreach t $targets {
2008-10-13 05:30:33 -05:00
$t invoke-event reset-assert-pre
2009-09-23 17:03:41 -05:00
}
foreach t $targets {
2008-10-13 05:30:33 -05:00
# C code needs to know if we expect to 'halt'
2009-06-07 18:35:29 -05:00
if { [ jtag tapisenabled [ $t cget - chain-position] ] } {
$t arp_reset assert $halt
}
2009-09-23 17:03:41 -05:00
}
foreach t $targets {
2008-10-13 05:30:33 -05:00
$t invoke-event reset-assert-post
2008-10-24 10:53:22 -05:00
}
2008-09-12 01:56:00 -05:00
2009-09-17 19:11:51 -05:00
# Now de-assert SRST, and report the pre/post events.
2009-09-23 17:03:41 -05:00
# Note: no target sees !SRST before "pre" or after "post".
2009-09-17 19:11:51 -05:00
foreach t $targets {
2008-10-13 05:30:33 -05:00
$t invoke-event reset-deassert-pre
2009-09-23 17:03:41 -05:00
}
foreach t $targets {
# Again, de-assert code needs to know if we 'halt'
2009-06-07 18:35:29 -05:00
if { [ jtag tapisenabled [ $t cget - chain-position] ] } {
$t arp_reset deassert $halt
}
2009-09-23 17:03:41 -05:00
}
foreach t $targets {
2008-10-13 05:30:33 -05:00
$t invoke-event reset-deassert-post
2008-10-24 10:53:22 -05:00
}
2008-09-12 01:56:00 -05:00
2009-09-17 19:11:51 -05:00
# Pass 1 - Now wait for any halt (requested as part of reset
# assert/deassert) to happen. Ideally it takes effect without
# first executing any instructions.
2008-10-24 10:53:22 -05:00
if { $halt } {
2009-09-17 19:11:51 -05:00
foreach t $targets {
2009-06-07 18:35:29 -05:00
if { [ jtag tapisenabled [ $t cget - chain-position] ] == 0 } {
continue
}
2008-10-24 10:53:22 -05:00
# Wait upto 1 second for target to halt. Why 1sec? Cause
# the JTAG tap reset signal might be hooked to a slow
# resistor/capacitor circuit - and it might take a while
# to charge
2009-09-21 13:40:55 -05:00
2008-10-24 10:53:22 -05:00
# Catch, but ignore any errors.
catch { $t arp_waitstate halted 1000 }
2009-09-21 13:40:55 -05:00
2008-10-24 10:53:22 -05:00
# Did we succeed?
set s [ $t curstate ]
2009-09-21 13:40:55 -05:00
2008-10-24 10:53:22 -05:00
if { 0 != [ string compare $s " h a l t e d " ] } {
2008-10-13 05:30:33 -05:00
return - error [ format " T A R G E T : % s - N o t h a l t e d " $t ]
2008-10-24 10:53:22 -05:00
}
2008-10-13 05:30:33 -05:00
}
2008-10-24 10:53:22 -05:00
}
2008-09-12 01:56:00 -05:00
2008-10-24 10:53:22 -05:00
# Pass 2 - if needed "init"
if { 0 == [ string compare init $MODE ] } {
2009-09-17 19:11:51 -05:00
foreach t $targets {
2009-06-07 18:35:29 -05:00
if { [ jtag tapisenabled [ $t cget - chain-position] ] == 0 } {
continue
}
2008-10-24 10:53:22 -05:00
set err [ catch " $ t a r p _ w a i t s t a t e h a l t e d 5 0 0 0 " ]
# Did it halt?
if { $err == 0 } {
2009-09-21 13:40:55 -05:00
$t invoke-event reset-init
2008-10-24 10:53:22 -05:00
}
2008-10-13 05:30:33 -05:00
}
2008-10-24 10:53:22 -05:00
}
2008-09-12 01:56:00 -05:00
2009-09-17 19:11:51 -05:00
foreach t $targets {
2008-10-13 05:30:33 -05:00
$t invoke-event reset-end
2008-10-24 10:53:22 -05:00
}
2008-09-12 01:56:00 -05:00
}
2008-10-16 08:02:36 -05:00
# stubs for targets scripts that do not have production procedure
proc production_info { } {
return " I m a g i n e a n e x p l a n a t i o n h e r e . . . "
}
2008-11-10 02:33:03 -06:00
add_help_text production_info " D i s p l a y s i n f o r m a t i o n o n p r o d u c t i o n p r o c e d u r e f o r t a r g e t s c r i p t . I m p l e m e n t t h i s p r o c e d u r e i n t a r g e t s c r i p t . "
2008-10-16 08:02:36 -05:00
proc production { firmwarefile serialnumber} {
puts " I m a g i n e p r o d u c t i o n p r o c e d u r e r u n n i n g s u c c e s s f u l l y . P r o g r a m m e d $ f i r m w a r e f i l e w i t h s e r i a l n u m b e r $ s e r i a l n u m b e r "
2008-10-24 10:53:22 -05:00
}
2008-10-16 08:02:36 -05:00
2008-11-10 02:33:03 -06:00
add_help_text production " < s e r i a l n u m b e r > - R u n s p r o d u c t i o n p r o c e d u r e . T h r o w s e x c e p t i o n i f p r o c e d u r e f a i l e d . P r i n t s p r o g r e s s m e s s a g e s . I m p l e m e n t t h i s p r o c e d u r e i n t h e t a r g e t s c r i p t . "
2008-10-16 08:02:36 -05:00
proc production_test { } {
puts " I m a g i n e n i f t y t e s t p r o c e d u r e h a v i n g r u n t o c o m p l e t i o n h e r e . "
}
2009-08-30 15:08:07 -05:00
add_help_text production_test " R u n s t e s t p r o c e d u r e . T h r o w s e x c e p t i o n i f p r o c e d u r e f a i l e d . P r i n t s p r o g r e s s m e s s a g e s . I m p l e m e n t i n t a r g e t s c r i p t . "
2008-10-16 08:02:36 -05:00
2008-11-04 05:08:19 -06:00
add_help_text cpu " < n a m e > - p r i n t s o u t t a r g e t o p t i o n s a n d a c o m m e n t o n C P U w h i c h m a t c h e s n a m e "
# A list of names of CPU and options required
set ocd_cpu_list {
{
2009-09-21 13:40:55 -05:00
name IXP42x
options { xscale - variant IXP42x}
2008-11-04 05:08:19 -06:00
comment { IXP42x cpu}
}
{
2009-09-21 13:40:55 -05:00
name arm7
options { arm7tdmi - variant arm7tdmi}
2008-11-04 05:08:19 -06:00
comment { vanilla ARM7}
}
}
# Invoked from Tcl code
proc ocd_cpu { args } {
set name $args
set result " "
global ocd_cpu_list
foreach a [ lsort $ocd_cpu_list ] {
if { [ string length $args ] == 0 || [ string first [ string toupper $name ] [ string toupper " $ a ( n a m e ) $ a ( o p t i o n s ) $ a ( c o m m e n t ) " ] ] != - 1 } {
2009-09-21 13:40:55 -05:00
lappend result $a
2008-11-04 05:08:19 -06:00
}
}
return $result
}
proc cpu { args } {
# 0123456789012345678901234567890123456789012345678901234567890123456789
puts " C P U O p t i o n s C o m m e n t "
foreach a [ lsort [ ocd_cpu $args ] ] {
puts [ format " % - 2 0 s % - 4 0 s % s " $a ( name ) $a ( options ) $a ( comment ) ]
}
}
2008-11-10 04:16:13 -06:00
proc power_restore { } {
puts " S e n s e d p o w e r r e s t o r e . "
reset init
}
add_help_text power_restore " O v e r r i d a b l e p r o c e d u r e r u n w h e n p o w e r r e s t o r e i s d e t e c t e d . R u n s ' r e s e t i n i t ' b y d e f a u l t . "
proc power_dropout { } {
puts " S e n s e d p o w e r d r o p o u t . "
}
proc srst_deasserted { } {
puts " S e n s e d n S R S T d e a s s e r t e d . "
reset init
}
add_help_text srst_deasserted " O v e r r i d a b l e p r o c e d u r e r u n w h e n s r s t d e a s s e r t i s d e t e c t e d . R u n s ' r e s e t i n i t ' b y d e f a u l t . "
proc srst_asserted { } {
puts " S e n s e d n S R S T a s s e r t e d . "
}
2009-02-17 05:54:30 -06:00
# catch any exceptions, capture output and return output
proc capture_catch { a } {
catch {
capture { uplevel $a }
} result
2009-09-21 13:40:55 -05:00
return $result
2009-02-17 05:54:30 -06:00
}
2009-10-06 03:10:57 -05:00
2009-10-09 01:51:50 -05:00
# Executed during "init". Can be overridden
# by board/target/... scripts
2009-10-06 03:10:57 -05:00
proc jtag_init { } {
if { [ catch { jtag arp_init} err] != 0 } {
# try resetting additionally
2009-10-09 01:51:50 -05:00
init_reset startup
2009-10-06 03:10:57 -05:00
}
2009-10-09 01:51:50 -05:00
}