debuggers: import openocd-0.7.0

Initial check-in of openocd-0.7.0 as it can be downloaded from
http://sourceforge.net/projects/openocd/files/openocd/0.7.0/

Any modifications will follow.

Change-Id: I6949beaefd589e046395ea0cb80f4e1ab1654d55

debuggers/openocd/jimtcl/examples/client-server.tcl

@@ -0,0 +1,83 @@
+proc bgerror {msg} {
+	puts "bgerror: $msg"
+	#exit 0
+}
+
+proc verbose {msg} {
+	puts $msg
+}
+
+if {[os.fork] == 0} {
+	verbose "child: waiting a bit"
+
+	# This will be our client
+
+	sleep .1
+
+	set f [socket stream localhost:9876]
+	fconfigure $f -buffering line
+
+	set done 0
+
+	proc onread {f} {
+		if {[$f gets buf] > 0} {
+			verbose "child: read response '$buf'"
+		} else {
+			verbose "child: read got eof"
+			set ::done 1
+		}
+	}
+
+	proc onwrite {f} {
+		verbose "child: sending request"
+		$f puts -nonewline "GET / HTTP/1.0\r\n\r\n"
+		$f writable {}
+	}
+
+	$f readable [list onread $f]
+	$f writable [list onwrite $f]
+
+	alarm 10
+	catch -signal {
+		verbose "child: in event loop"
+		vwait done
+		verbose "child: done event loop"
+	}
+	alarm 0
+	$f close
+	exit 0
+}
+
+verbose "parent: opening socket"
+set done 0
+
+# This will be our server
+set f [socket stream.server 0.0.0.0:9876]
+
+proc server_onread {f} {
+	verbose "parent: onread (server) got connection on $f"
+	set cfd [$f accept]
+	verbose "parent: onread accepted $cfd"
+
+	verbose "parent: read request '[string trim [$cfd gets]]'"
+
+	$cfd puts "Thanks for the request"
+	$cfd close
+
+	verbose "parent: sent response"
+
+	incr ::done
+}
+
+$f readable [list server_onread $f]
+
+alarm 10
+catch -signal {
+	vwait done
+}
+alarm 0
+$f close
+
+sleep .5
+
+return "ok"

debuggers/openocd/jimtcl/examples/dnstest.tcl

@@ -0,0 +1,22 @@
+lappend auto_path [pwd]
+package require dns
+
+# Use google's DNS
+dns::configure -nameserver 8.8.8.8
+
+puts "Resolve with udp"
+set tok [dns::resolve www.tcl.tk]
+puts status=[dns::status $tok]
+puts address=[dns::address $tok]
+puts names=[dns::name $tok]
+dns::cleanup $tok
+
+# Now with tcp
+dns::configure -protocol tcp
+
+puts "Resolve with tcp"
+set tok [dns::resolve www.google.com]
+puts status=[dns::status $tok]
+puts address=[dns::address $tok]
+puts names=[dns::name $tok]
+dns::cleanup $tok

debuggers/openocd/jimtcl/examples/jtclsh.tcl

@@ -0,0 +1,36 @@
+# Simple example of how the history extension
+# can be used to provide line editing and history
+
+# Build jimsh with the history extension and enable line editing (the default)
+# ./configure --with-ext=history
+
+package require history
+
+set histfile [env HOME]/.jtclsh
+history load $histfile
+while 1 {
+	if {[history getline "jim> " cmd] < 0} {
+		break
+	}
+	if {$cmd eq "h"} {
+		history show
+		continue
+	}
+	# Don't bother adding single char commands to the history
+	if {[string length $cmd] > 1} {
+		history add $cmd
+		history save $histfile
+	}
+	# jimsh also does:
+	# - check for a complete command: [info complete]
+	# - handle other non-error return codes and changes the prompt: [info returncodes]
+	# - displays the complete error message: [errorInfo]
+	try {
+		set result [eval $cmd]
+		if {$result ne {}} {
+			puts $result
+		}
+	} on error msg {
+		puts $msg
+	}
+}

debuggers/openocd/jimtcl/examples/metakit.tcl

@@ -0,0 +1,112 @@
+package require mk
+
+# These will become subcommands of every view handle
+
+# Looping using cursors
+proc {mk.view each} {view arrayVar script} {
+    upvar 1 $arrayVar array
+    for {set cur $view!0} {[cursor valid $cur]} {cursor incr cur} {
+        set array [cursor get $cur]
+        uplevel 1 $script
+    }
+}
+
+# Shortcuts to avoid cursors for one-time operations
+proc {mk.view set} {view pos args} {
+    tailcall cursor set $view!$pos {*}$args
+}
+proc {mk.view append} {view args} {
+    tailcall cursor set $view!end+1 {*}$args
+}
+proc {mk.view insert} {view pos args} {
+    # Note that this only inserts fresh rows and doesn't set any data
+    tailcall cursor insert $view!$pos {*}$args
+}
+
+# Dump a view to stdout
+proc {mk.view dump} {view} {
+    $view each row {puts "  $row"}
+}
+
+# -----------------------------------------------------------------------------
+
+# Open an in-memory database
+set db [storage]
+
+# Specify the view structure, creating new views and restructuring existing
+# ones as necessary
+$db structure firstview  {key string first string}
+$db structure secondview {key string second string}
+
+# Open them.
+[$db view firstview] as fstview
+# Or equivalently (using pipeline notation)
+$db view secondview | as sndview
+
+# Use the helpers defined above to populate the first view
+$fstview set 0 key foo first bar
+$fstview append key hello first world
+$fstview insert 0
+$fstview set 0 key metakit first example
+
+# Or use cursors directly. A end-X/end+X cursor moves automatically when
+# the view size changes.
+set cur $sndview!end+1
+cursor set $cur key foo second baz
+cursor set $cur key hello second goodbye
+cursor set $cur key silly second examples
+
+puts "First view:"
+$fstview dump
+puts "Second view:"
+$sndview dump
+
+puts "\nNow trying view operations. Note that all the binary operations"
+puts "are left-biased when it comes to conflicting property values.\n"
+
+puts "Join on key:" ;# Common subset of the two outer joins below
+$fstview join $sndview key | dump
+puts "Outer join on key:" ;# Will yield more rows than an inner join
+$fstview join $sndview -outer key | dump
+puts "Outer join on key, in reverse order:"
+$sndview join $fstview -outer key | dump
+
+puts "Cartesian product:"
+$fstview product $sndview | dump
+
+puts "Pairing:"
+$fstview pair $sndview | dump
+puts "Pairing, in reverse order:"
+$sndview pair $fstview | dump
+
+puts "Complex pipeline (fetch rows 3,5,.. from the cartesian product and sort"
+puts "them on the 'first' property):"
+$fstview product $sndview | range 3 end 2 | sort first | dump
+# Slice step defaults to 1. Sorting may be performed on several properties at
+# a time, prepending a "-" (minus sign) will cause the sort order to be reversed.
+
+puts "Another one (fetch the unique key values from the cartesian product):"
+$fstview product $sndview | project key | unique | dump
+# Use "without" to remove certain properties.
+
+puts "Keys in the cartesian product not in the reverse pairing:"
+[$fstview product $sndview | project key | unique] minus [$sndview pair $fstview | unique] | dump
+# Union "union", intersection "intersect" and symmetric difference "different"
+# are also available. They all work only if the rows are unique.
+
+puts "Create a subview:"
+$fstview product $sndview | group subv key | as complexview | dump
+# Not so informative as subviews are not displayed properly. Several grouping
+# properties may be specified.
+puts "Get its values for row #0:"
+cursor get $complexview!0 subv | dump
+puts "And flatten it back:"
+$complexview flatten subv | dump
+
+puts "Remove a row:"
+cursor remove $sndview!1
+$sndview dump
+# Several rows may be removed at once by specifying a row count
+puts "Clear the view:"
+$sndview resize 0
+$sndview dump

debuggers/openocd/jimtcl/examples/ootest.tcl

@@ -0,0 +1,139 @@
+package require oo
+
+# Create a class, the usual bank account, with two instance variables:
+class Account {
+	balance 0
+	name "Unknown"
+}
+
+# We have some class methods predefined
+# Note we can call (e.g.) either Account.methods or 'Account methods'
+puts "---- class Account ----"
+puts "Account vars=[Account vars]"
+puts "Account methods=[Account methods]"
+puts ""
+
+# Now flesh out the class with some methods
+# Could use 'Account method' here instead
+Account method deposit {amount} {
+	set balance [+ $balance $amount]
+}
+Account method see {} {
+	set balance
+}
+Account method withdraw {amount} {
+	if {$amount > $balance} {error "Sorry $name, can only withdraw $balance"}
+	set balance [- $balance $amount]
+}
+Account method describe {} {
+	puts "I am object $self of class [$self classname]"
+	puts "My 'see' method returns [$self see]"
+	puts "My variables are:"
+	foreach i [$self vars] {
+		puts "  $i=[set $i]"
+	}
+}
+
+# Now an instance, initialisition some fields
+set a [Account new {name "Bob Smith"}]
+
+puts "---- object Account ----"
+# We can use class methods on the instance too
+puts a.vars=[$a vars]
+puts a.classname=[$a classname]
+
+# Now object methods
+$a deposit 100
+puts "deposit 100 -> [$a see]"
+
+$a withdraw 40
+puts "withdraw 40 -> [$a see]"
+
+catch {$a withdraw 1000} res
+puts "withdraw 1000 -> $res\n"
+
+# Tell me something about the object
+$a describe
+puts ""
+
+# Now create a new subclass
+class CreditAccount Account {
+	limit -1000
+	balance -20
+}
+# Override the 'withdraw' method to allow overdrawing
+CreditAccount method withdraw {amount} {
+	if {$balance - $amount < $limit} {error "Sorry $name, that would exceed your credit limit of [expr -$limit]"}
+	set balance [- $balance $amount]
+}
+# Override the 'describe' method, but invoke the baseclass method first
+CreditAccount method describe {} {
+	# First invoke the base class 'describe'
+	super describe
+	if {$balance < 0} {
+		puts "*** Account is in debit"
+	}
+}
+
+puts "---- class CreditAccount ----"
+puts "CreditAccount vars=[CreditAccount vars]"
+puts "CreditAccount methods=[CreditAccount methods]"
+puts ""
+
+puts "---- object CreditAccount ----"
+set b [CreditAccount new {name "John White"}]
+
+puts b.vars=[$b vars]
+puts b.classname=[$b classname]
+
+puts "initial balance -> [$b see]"
+$b deposit 100
+puts "deposit 100 -> [$b see]"
+
+$b withdraw 40
+puts "withdraw 40 -> [$b see]"
+
+$b withdraw 1000
+puts "withdraw 1000 -> [$b see]"
+puts ""
+
+# Tell me something about the object
+$b describe
+puts ""
+
+# 'eval' is similar to 'dict with' for an object, except it operates
+# in it's own scope. A list of variables can be imported into the object scope.
+# It is useful for ad-hoc operations for which it is not worth defining a method.
+set total 0
+$a eval total { incr total $balance }
+incr total [$b get balance]
+puts "Total of accounts [$a get name] and [$b eval {return "$name (Credit Limit: $limit)"}] is: $total"
+
+# Can we find all objects in the system?
+# Almost. We can't really distinguish those which aren't real classes.
+# This will get all references which aren't simple lambdas.
+puts "---- All objects ----"
+Account new {name "Terry Green" balance 20}
+set x [Account]
+lambda {} {dummy}
+ref blah blah
+
+foreach r [info references] {
+	if {[getref $r] ne {}} {
+		try {
+			$r eval {
+				puts [format "Found %14s: Owner: %14s, Balance: %+5d, in object %s" [$self classname] $name $balance $self]
+			}
+		} on error msg {
+			puts "Not an object: $r"
+		}
+	}
+}
+unset r
+
+# And goodbye
+$a destroy
+
+# Let the garbage collection take care of this one
+unset b
+collect

debuggers/openocd/jimtcl/examples/parray.tcl

@@ -0,0 +1,17 @@
+# Example of using the 'putter' function to redirect parray output
+
+set a {1 one 2 two 3 three}
+
+# Use 'curry' to create a single command from two words
+stderr puts "curry"
+parray a * [curry stderr puts]
+
+# Same thing, but an alias instead
+stderr puts "\nalias"
+alias stderr_puts stderr puts
+parray a * stderr_puts
+
+# Now use a lambda to accumulate the results in a buffer
+stderr puts "\nlamba"
+parray a * [lambda {msg} {lappend ::lines $msg}]
+stderr puts [join $lines \n]

debuggers/openocd/jimtcl/examples/pipe.tcl

@@ -0,0 +1,16 @@
+lassign [socket pipe] r w
+
+# Note, once the exec has the fh (via dup), close it
+# so that the pipe data is accessible
+exec ps aux >@$w &
+$w close
+
+$r readable {
+	puts [$r gets]
+	if {[eof $r]} {
+		$r close
+		set done 1
+	}
+}
+
+vwait done

debuggers/openocd/jimtcl/examples/popen.tcl

@@ -0,0 +1,20 @@
+# Internally, open "|..." calls out to popen from tclcompat.tcl
+#
+# This code is compatible with Tcl
+
+# Write to a pipe
+set f [open |[list cat | sed -e "s/line/This is line/" >temp.out] w]
+puts "Creating temp.out with pids: [pid $f]"
+foreach n {1 2 3 4 5} {
+	puts $f "line $n"
+}
+close $f
+
+# Read from a pipe
+set f [open "|cat temp.out"]
+puts "Reading temp.out with pids: [pid $f]"
+while {[gets $f buf] >= 0} {
+	puts $buf
+}
+close $f
+file delete temp.out

debuggers/openocd/jimtcl/examples/sqlite3test.tcl

@@ -0,0 +1,10 @@
+package require sqlite3
+
+set db [sqlite3.open :memory:]
+$db query {CREATE TABLE plays (id, author, title)}
+$db query {INSERT INTO plays (id, author, title) VALUES (1, 'Goethe', 'Faust');}
+$db query {INSERT INTO plays (id, author, title) VALUES (2, 'Shakespeare', 'Hamlet');}
+$db query {INSERT INTO plays (id, author, title) VALUES (3, 'Sophocles', 'Oedipus Rex');}
+set res [$db query "SELECT * FROM plays"]
+$db close
+foreach r $res {puts $r(author)}

debuggers/openocd/jimtcl/examples/tcp.client

@@ -0,0 +1,9 @@
+# Example of sending via a connected tcp socket
+
+set s [socket stream 127.0.0.1:20000]
+
+foreach i [range 1 20] {
+	$s puts "1 << $i"
+
+	puts [$s gets]
+}

debuggers/openocd/jimtcl/examples/tcp.server

@@ -0,0 +1,39 @@
+# Example of a udp server which sends a response
+
+# Listen on port 20000. No host specified means 0.0.0.0
+set s [socket stream.server 20000]
+
+$s readable {
+	# Clean up children
+	os.wait -nohang 0
+	set sock [$s accept]
+
+	# Make this server forking so we can accept multiple
+	# simultaneous connections
+	if {[os.fork] == 0} {
+		$s close
+
+		$sock buffering line
+
+		# Get the request (max 80 chars) - need the source address
+		while {[$sock gets buf] >= 0} {
+			set buf [string trim $buf]
+			puts -nonewline "read '$buf'"
+
+			try {
+				set result "$buf = [expr $buf]"
+			} on error {msg} {
+				set result "Error: $buf => $msg"
+			}
+
+			puts ", sending '$result'"
+
+			# Send the result back to where it came from
+			$sock puts $result
+		}
+	}
+
+	$sock close
+}
+
+vwait done

debuggers/openocd/jimtcl/examples/timedread.tcl

@@ -0,0 +1,19 @@
+# Tests that SIGALRM can interrupt read
+set f [open "/dev/urandom" r]
+
+set count 0
+set error NONE
+
+signal handle SIGALRM
+catch -signal {
+	alarm 0.5
+	while {1} {
+		incr count [string bytelength [read $f 100]]
+	}
+	alarm 0
+	signal default SIGALRM
+} error
+
+puts "Read $count bytes in 0.5 seconds: Got $error"
+
+$f close

debuggers/openocd/jimtcl/examples/udp.client

@@ -0,0 +1,28 @@
+# Example of sending from an unconnected socket
+
+set s [socket dgram]
+
+foreach i [range 1 5] {
+	# Specify the address and port with sendto
+	$s sendto "$i + $i + 10" 127.0.0.1:20000
+
+	# Receive the response - max length of 100
+	puts [$s recvfrom 100]
+}
+
+$s close
+
+# Now sending via a connected udp socket
+
+set s [socket dgram 127.0.0.1:20000]
+$s buffering none
+
+foreach i [range 5 10] {
+	# Socket is connected, so can just use puts here
+	# No need to flush because we set 'buffering none' above.
+	$s puts -nonewline "$i * $i"
+	#$s flush
+
+	# Receive the response - max length of 100
+	puts [$s recvfrom 100]
+}

debuggers/openocd/jimtcl/examples/udp.server

@@ -0,0 +1,25 @@
+# Example of a udp server which sends a response
+
+# Listen on port 20000. No host specified means 0.0.0.0
+set s [socket dgram.server 20000]
+
+# For each request...
+$s readable {
+	# Get the request (max 80 chars) - need the source address
+	set buf [$s recvfrom 80 addr]
+
+	puts -nonewline "read '$buf' from $addr"
+
+	try {
+		set result "$buf = [expr $buf]"
+	} on error {msg} {
+		set result "Error: $buf => $msg"
+	}
+
+	puts ", sending '$result' to $addr"
+
+	# Send the result back to where it came from
+	$s sendto $result $addr
+}
+
+vwait done

debuggers/openocd/jimtcl/examples/udp2.client

@@ -0,0 +1,13 @@
+# Example of sending via a connected udp socket
+
+set s [socket dgram 127.0.0.1:20000]
+
+foreach i [range 1 20] {
+	# Socket is connected, so can just use puts here
+	# But remember to flush to ensure that each message is separate
+	$s puts -nonewline "$i * $i"
+	$s flush
+
+	# Receive the response - max length of 100
+	puts [$s recvfrom 100]
+}

debuggers/openocd/jimtcl/examples/udp6.client

@@ -0,0 +1,27 @@
+# Example of sending from an unconnected ipv6 socket
+
+set s [socket -ipv6 dgram]
+
+foreach i [range 1 5] {
+	# Specify the address and port with sendto
+	$s sendto "$i + $i + 10" {[::1]:20000}
+
+	# Receive the response - max length of 100
+	puts [$s recvfrom 100]
+}
+
+$s close
+
+# Now sending via a connected udp socket
+
+set s [socket -ipv6 dgram {[::1]:20000}]
+
+foreach i [range 5 10] {
+	# Socket is connected, so can just use puts here
+	# But remember to flush to ensure that each message is separate
+	$s puts -nonewline "$i * $i"
+	$s flush
+
+	# Receive the response - max length of 100
+	puts [$s recvfrom 100]
+}

debuggers/openocd/jimtcl/examples/udp6.server

@@ -0,0 +1,26 @@
+# Example of a udp server listening on ipv6 which sends a response
+# Note that on many hosts, this will also respond to ipv4 requests too
+
+# Listen on port 20000.
+set s [socket -ipv6 dgram.server {[::]:20000}]
+
+# For each request...
+$s readable {
+	# Get the request (max 80 chars) - need the source address
+	set buf [$s recvfrom 80 addr]
+
+	puts -nonewline "read '$buf' from $addr"
+
+	try {
+		set result "$buf = [expr $buf]"
+	} on error {msg} {
+		set result "Error: $buf => $msg"
+	}
+
+	puts ", sending '$result'"
+
+	# Send the result back to where it came from
+	$s sendto $result $addr
+}
+
+vwait done