tcl: [1/3] prepare for jimtcl 0.81 'expr' syntax change

Jimtcl commit 1843b79a03dd ("expr: TIP 526, only support a single
arg") drops the support for multi-argument syntax for the TCL
command 'expr'.

In the TCL scripts distributed with OpenOCD there are 1700+ lines
that should be modified before switching to jimtcl 0.81.

Apply the script below on every script in tcl folder. It fixes
more than 92% of the lines

%<---%<---%<---%<---%<---%<---%<---%<---%<---%<---%<---%<---%<---
 #!/usr/bin/perl -Wpi

 my $re_sym = qr{[a-z_][a-z0-9_]*}i;
 my $re_var = qr{(?:\$|\$::)$re_sym};
 my $re_const = qr{0x[0-9a-f]+|[0-9]+|[0-9]*\.[0-9]*}i;
 my $re_item = qr{(?:~\s*)?(?:$re_var|$re_const)};
 my $re_op = qr{<<|>>|[+\-*/&|]};
 my $re_expr = qr{(
     (?:\(\s*(?:$re_item|(?-1))\s*\)|$re_item)
     \s*$re_op\s*
     (?:$re_item|(?-1)|\(\s*(?:$re_item|(?-1))\s*\))
 )}x;

 # [expr [dict get $regsC100 SYM] + HEXNUM]
 s/\[expr (\[dict get $re_var $re_sym\s*\] \+ *$re_const)\]/\[expr \{$1\}\]/;

 # [ expr (EXPR) ]
 # [ expr EXPR ]
 # note: $re_expr captures '$3'
 s/\[(\s*expr\s*)\((\s*$re_expr\s*)\)(\s*)\]/\[$1\{$2\}$4\]/;
 s/\[(\s*expr\s*)($re_expr)(\s*)\]/\[$1\{$2\}$4\]/;
%<---%<---%<---%<---%<---%<---%<---%<---%<---%<---%<---%<---%<---

Change-Id: I0d6bddc6abf6dd29062f2b4e72b5a2b5080293b9
Signed-off-by: Antonio Borneo <borneo.antonio@gmail.com>
Reviewed-on: http://openocd.zylin.com/6159
Tested-by: jenkins
Reviewed-by: Tomas Vanek <vanekt@fbl.cz>

1 files changed, 15 insertions, 15 deletions

diff --git a/tcl/tools/memtest.tcl b/tcl/tools/memtest.tcl
index 02f94d3..f3567ef 100644
--- a/tcl/tools/memtest.tcl
+++ b/tcl/tools/memtest.tcl
@@ -74,7 +74,7 @@ proc memTestDataBus { address } {
 # *
 #***********************************************************************************
 proc memTestAddressBus { baseAddress nBytes } {
-    set addressMask [expr $nBytes - 1]
+    set addressMask [expr {$nBytes - 1}]
     set pattern 0xAAAAAAAA
     set antipattern 0x55555555
 
@@ -83,16 +83,16 @@ proc memTestAddressBus { baseAddress nBytes } {
     echo "addressMask: [convertToHex $addressMask]"
 
     echo "memTestAddressBus: Writing the default pattern at each of the power-of-two offsets..."
-    for {set offset 32} {[expr $offset & $addressMask] != 0} {set offset [expr $offset << 1] } {
-	set addr [expr $baseAddress + $offset]
+    for {set offset 32} {[expr {$offset & $addressMask}] != 0} {set offset [expr {$offset << 1}] } {
+	set addr [expr {$baseAddress + $offset}]
 	memwrite32 $addr $pattern
     }
 
     echo "memTestAddressBus: Checking for address bits stuck high..."
     memwrite32 $baseAddress $antipattern
 
-    for {set offset 32} {[expr $offset & $addressMask] != 0} {set offset [expr $offset << 1]} {
-	set addr [expr $baseAddress + $offset]
+    for {set offset 32} {[expr {$offset & $addressMask}] != 0} {set offset [expr {$offset << 1}]} {
+	set addr [expr {$baseAddress + $offset}]
 	set data [memread32 $addr]
 
 	if {$data != $pattern} {
@@ -103,8 +103,8 @@ proc memTestAddressBus { baseAddress nBytes } {
 
     echo "memTestAddressBus: Checking for address bits stuck low or shorted..."
     memwrite32 $baseAddress $pattern
-    for {set testOffset 32} {[expr $testOffset & $addressMask] != 0} {set testOffset [expr $testOffset << 1] } {
-	set addr [expr $baseAddress + $testOffset]
+    for {set testOffset 32} {[expr {$testOffset & $addressMask}] != 0} {set testOffset [expr {$testOffset << 1}] } {
+	set addr [expr {$baseAddress + $testOffset}]
 	memwrite32 $addr $antipattern
 
 	set data [memread32 $baseAddress]
@@ -113,8 +113,8 @@ proc memTestAddressBus { baseAddress nBytes } {
 	    return $pattern
 	}
 
-	for {set offset 32} {[expr $offset & $addressMask] != 0} {set offset [expr $offset << 1]} {
-	    set addr [expr $baseAddress + $offset]
+	for {set offset 32} {[expr {$offset & $addressMask}] != 0} {set offset [expr {$offset << 1}]} {
+	    set addr [expr {$baseAddress + $offset}]
 	    set data [memread32 $baseAddress]
 
             if {(($data != $pattern) && ($offset != $testOffset))} {
@@ -122,7 +122,7 @@ proc memTestAddressBus { baseAddress nBytes } {
 		return $pattern
 	    }
         }
-	set addr [expr $baseAddress + $testOffset]
+	set addr [expr {$baseAddress + $testOffset}]
 	memwrite32 $addr $pattern
     }
 }
@@ -153,12 +153,12 @@ proc memTestDevice { baseAddress nBytes } {
 
     echo "memTestDevice: Filling memory with a known pattern..."
     for {set pattern 1; set offset 0} {$offset < $nBytes} {incr pattern; incr offset 32} {
-	memwrite32 [expr $baseAddress + $offset] $pattern
+	memwrite32 [expr {$baseAddress + $offset}] $pattern
     }
 
     echo "memTestDevice: Checking each location and inverting it for the second pass..."
     for {set pattern 1; set offset 0} {$offset < $nBytes} {incr pattern; incr offset 32} {
-	set addr [expr $baseAddress + $offset]
+	set addr [expr {$baseAddress + $offset}]
 	set data [memread32 $addr]
 
 	if {$data != $pattern} {
@@ -167,13 +167,13 @@ proc memTestDevice { baseAddress nBytes } {
 	}
 
 	set antiPattern [expr ~$pattern]
-	memwrite32 [expr $baseAddress + $offset] $antiPattern
+	memwrite32 [expr {$baseAddress + $offset}] $antiPattern
     }
 
     echo "memTestDevice: Checking each location for the inverted pattern and zeroing it..."
     for {set pattern 1; set offset 0} {$offset < $nBytes} {incr pattern; incr offset 32} {
-	set antiPattern [expr ~$pattern & ((1<<32) - 1)]
-	set addr [expr $baseAddress + $offset]
+	set antiPattern [expr {~$pattern & ((1<<32) - 1)}]
+	set addr [expr {$baseAddress + $offset}]
 	set data [memread32 $addr]
 	set dataHex [convertToHex $data]
 	set antiPatternHex [convertToHex $antiPattern]