From 99025b9d34ccad778f11258e186b0bd8dc9c71a4 Mon Sep 17 00:00:00 2001
From: Wojciech Kosior <kwojtus@protonmail.com>
Date: Thu, 3 Sep 2020 20:29:45 +0200
Subject: rename tclasm.tcl to tclasm_old.tcl (prepare for redesign of the
 stack machine)

---
 Makefile                                           |   2 +-
 design/rom.s.tcl                                   |   2 +-
 tclasm.tcl                                         | 352 ---------------------
 tclasm_old.tcl                                     | 352 +++++++++++++++++++++
 tests/soc_simple_display/instructions.s.tcl        |   2 +-
 tests/stack_machine_old_add/instructions.s.tcl     |   2 +-
 .../stack_machine_old_cond_jump/instructions.s.tcl |   2 +-
 tests/stack_machine_old_div/instructions.s.tcl     |   2 +-
 tests/stack_machine_old_jump/instructions.s.tcl    |   2 +-
 .../instructions.s.tcl                             |   2 +-
 tests/stack_machine_old_mul/instructions.s.tcl     |   2 +-
 .../instructions.s.tcl                             |   2 +-
 tests/stack_machine_old_store/instructions.s.tcl   |   2 +-
 tests/stack_machine_old_sub/instructions.s.tcl     |   2 +-
 tests/stack_machine_old_swap/instructions.s.tcl    |   2 +-
 tests/stack_machine_old_tee/instructions.s.tcl     |   2 +-
 16 files changed, 366 insertions(+), 366 deletions(-)
 mode change 100755 => 100644 tclasm.tcl
 create mode 100755 tclasm_old.tcl

diff --git a/Makefile b/Makefile
index 2ebc598..cc93e93 100644
--- a/Makefile
+++ b/Makefile
@@ -102,7 +102,7 @@ test : $(TEST_TARGETS)
 tests/%.mem : tests/%.memv
 	$(IV) $(MACROASM_FLAGS) $^ -o $@
 
-%.mem : %.s.tcl tclasm.tcl
+%.mem : %.s.tcl tclasm_old.tcl tclasm.tcl
 	$< > $@
 
 tests/self/test.vvp : tests/self/operations.mem tests/self/test.v \
diff --git a/design/rom.s.tcl b/design/rom.s.tcl
index db142a0..4bfc73f 100755
--- a/design/rom.s.tcl
+++ b/design/rom.s.tcl
@@ -1,6 +1,6 @@
 #!/usr/bin/env tclsh
 
-source tclasm.tcl
+source tclasm_old.tcl
 
 ## also look at stack_machine_cond_jump test 
 
diff --git a/tclasm.tcl b/tclasm.tcl
old mode 100755
new mode 100644
index 99b01a1..e69de29
--- a/tclasm.tcl
+++ b/tclasm.tcl
@@ -1,352 +0,0 @@
-#!/bin/grep this[ ]script
-# this script is to be sourced, not executed by itself
-
-# procedures starting with "__" are internal and not to be used in asm code;
-# procedures starting with "_" are generalized procedures, that are not meant
-# to be directly used for code translated from webasm;
-# the rest are typical procedures webasm code will be mapped to
-
-proc __parse_binary {binary} {
-    set value 0
-
-    for {set bits_remaining $binary} \
-	{"$bits_remaining" != ""} \
-	{set bits_remaining [string range $bits_remaining 1 end]} {
-	    set value [expr $value * 2]
-
-	    if [string match 1* $bits_remaining] {
-		incr value
-	    } elseif [string match 0* $bits_remaining] {
-		# nothing
-	    } else {
-		error "'$binary' cannot be parsed as a binary number"
-	    }
-	}
-
-    return $value
-}
-
-proc __parse_number {number} {
-    if [string match h?* $number] {
-	set value 0x[string range $number 1 end]
-    } elseif [string match b?* $number] {
-	set value [__parse_binary [string range $number 1 end]]
-    } elseif [string match {d[0123456789]?*} $number] {
-	set value [string range $number 1 end]
-    } elseif [string match {-[0123456789]*} $number] {
-	set value $number
-    } elseif [string match {[0123456789]*} $number] {
-	set value $number
-    } else {
-	error "'$number' is not a properly formatted number"
-    }
-
-    return $value
-}
-
-proc __to_binary {number length {can_be_negative -neg_ok}} {
-    if [string equal $can_be_negative -neg_ok] {
-	set can_be_negative 1
-    } elseif [string equal $can_be_negative -no_neg] {
-	set can_be_negative 0
-    } else {
-	error "'$can_be_negative' is not a valid value for the\
-               'can_be_negative' argument"
-    }
-
-    set value [__parse_number $number]
-
-    if {$value < 0 && !$can_be_negative} {
-	error "value '$number' provided where negative values are not allowed"
-    }
-
-    if {($can_be_negative && $value >= 2 ** ($length - 1)) ||
-	$value >= 2 ** $length ||
-	$value < -(2 ** ($length - 1))} {
-	error "value '$number' doesn't fit into $length\
-	       bits[expr $can_be_negative ? "{ with sign}" : "{}"]"
-    }
-
-    for {set result ""} {$length > 0} {incr length -1} {
-	set result [expr $value % 2]$result
-	set value [expr $value >> 1]
-    }
-
-    return $result
-}
-
-# example: __encode_immediate im+=213
-#          __encode_immediate im<<=hAB
-#          __encode_immediate im=im
-#          __encode_immediate im=-33    # negative value only allowed for im=
-#          __encode_immediate im<<=b1101101
-proc __encode_immediate {im_modification} {
-    if [string equal $im_modification im=im] {
-	return 000000000000
-    } elseif [string match im<<=?* $im_modification] {
-	return 1[__to_binary [string range $im_modification 5 end] 11 -no_neg]
-    } elseif [string match im=?* $im_modification] {
-	return 01[__to_binary [string range $im_modification 3 end] 10]
-    } elseif [string match im+=?* $im_modification] {
-	return 001[__to_binary [string range $im_modification 4 end] 9 -no_neg]
-    } else {
-	error "'$im_modification' is not a valid im modification"
-    }
-}
-
-# example: __encode_access_type load
-#          __encode_access_type store
-proc __encode_access_type {type} {
-    if {"$type" == "load"} {
-	return 1
-    } elseif {"$type" == "store"} {
-	return 0
-    } else {
-	error "'$type' is not a valid memory access type"
-    }
-}
-
-# example: __encode_addressing @im
-#          __encode_addressing @im+sp
-proc __encode_addressing {address} {
-    if {"$address" == "@im"} {
-	return 1
-    } elseif {"$address" == "@im+sp"} {
-	return 0
-    } else {
-	error "'$address' is not a valid addressing"
-    }
-}
-
-# example: __encode_reg r0
-#          __encode_reg r1
-proc __encode_reg {register} {
-    if {"$register" == "r0"} {
-	return 1
-    } elseif {"$register" == "r1"} {
-	return 0
-    } else {
-	error "'$register' is not a valid register"
-    }
-v}
-
-# example: __encode_memory_access load r0 @im im=d1840
-#          __encode_memory_access store r1 @im+sp im<<=b1100011
-proc __encode_memory_access {type register address {im_modification im=im}} {
-    set type [__encode_access_type $type]
-    set address [__encode_addressing $address]
-    set register [__encode_reg $register]
-    set im_modification [__encode_immediate $im_modification]
-    return 1$type$address$register$im_modification    
-}
-
-# example: __encode_swap swap
-#          __encode_swap no_swap
-proc __encode_swap {swap_regs} {
-    if {"$swap_regs" == "swap"} {
-	return 1
-    } elseif {"$swap_regs" == "no_swap"} {
-	return 0
-    } else {
-	error "got '$swap_regs' where 'swap' or 'no_swap' was expected"
-    }
-}
-
-# example: __encode_swap swap
-#          __encode_swap no_swap
-proc __encode_cond {cond} {
-    if {"$cond" == "cond"} {
-	return 1
-    } elseif {"$cond" == "non-cond"} {
-	return 0
-    } else {
-	error "got '$cond' where 'cond' or 'non-cond' was expected"
-    }
-}
-
-# example: __encode_extended_instruction halt
-#          __encode_extended_instruction nop
-proc __encode_extended_instruction {instruction} {
-    if {"$instruction" == "nop"} {
-	return [__to_binary 0 9]
-    } elseif {"$instruction" == "halt"} {
-	return [__to_binary 1 9]
-    } elseif {"$instruction" == "set_sp"} {
-	return [__to_binary 2 9]
-    } elseif {"$instruction" == "add"} {
-	return [__to_binary 3 9]
-    } elseif {"$instruction" == "sub"} {
-	return [__to_binary 4 9]
-    } elseif {"$instruction" == "div"} {
-	return [__to_binary 5 9]
-    } elseif {"$instruction" == "mul"} {
-	return [__to_binary 6 9]
-    } elseif {"$instruction" == "tee"} {
-	return [__to_binary 7 9]
-    } else {
-	error "no such extended instruction: '$instruction'"
-    }
-}
-
-# example: _load r0 @im im+=2   # negative values are *not* allowed for im+=
-#          _load r1 @im im=im
-#          _load r0 @im+sp      # im=im is the default if not specified
-#          _load r0 @im im<<=12 # 12 is the value shifted, shift is always by 11
-#          _load r1 @im im=-9   # negative values are only allowed for im=
-#          _load r0 @im+sp im=0 # this results in using only sp for addressing
-proc _load {register address {im_modification im=im}} {
-    puts [__encode_memory_access load $register $address $im_modification]
-}
-
-# example: _store r0 @im im+=2   # same semantics as _load
-#          _store r1 @im im=im
-#          _store r0 @im+sp
-#          _store r0 @im im<<=12
-#          _store r1 @im im=-9
-#          _store r0 @im+sp im=0
-proc _store {register address {im_modification im=im}} {
-    puts [__encode_memory_access store $register $address $im_modification]
-}
-
-# example: _jump im<<=b1101011 cond swap
-#          _jump im=im non-cond
-proc _jump {{im_modification im=im} {cond non-cond} {swap_regs no_swap}} {
-    set swap_regs [__encode_swap $swap_regs]
-    set cond [__encode_cond $cond]
-    puts 01$cond$swap_regs[__encode_immediate $im_modification]
-}
-
-# example: _cond_jump im=h16A swap
-proc _cond_jump {{im_modification im=im} {swap_regs no_swap}} {
-    _jump $im_modification cond $swap_regs
-}
-
-# example: _extended_instruction nop swap  # it's really no longer a true nop...
-#          _extended_instruction halt
-proc _extended_instruction {instruction {swap_regs no_swap}} {
-    set swap_regs [__encode_swap $swap_regs]
-    set no_im_modification 000
-    set instruction [__encode_extended_instruction $instruction]
-    puts 000$swap_regs$no_im_modification$instruction
-}
-
-# example: _immediate im+=4 swap
-#          _immediate im<<=hFF
-#          _immediate im=im      # this one gives the same bit result as 'nop'
-proc _immediate {im_modification {swap_regs no_swap}} {
-    set swap_regs [__encode_swap $swap_regs]
-    set im_modification [__encode_immediate $im_modification]
-    puts 000$swap_regs$im_modification
-}
-
-# example: _exchange_im im<<=b10101010101 swap
-proc _exchange_im {{im_modification im=im} {swap_regs no_swap}} {
-    set swap_regs [__encode_swap $swap_regs]
-    set im_modification [__encode_immediate $im_modification]
-    puts 001$swap_regs$im_modification
-}
-
-proc _const {command number} {
-
-    set value [expr [__parse_number $number] + 0]
-    if {$value < 2 ** 9 && $value >= -(2 ** 9)} {
-	$command im=$value
-    } elseif {$value < 2 ** 20 && $value >= -(2 ** 20)} {
-	_immediate im=[expr $value >> 11]
-	$command im<<=[expr $value & 0x7ff]
-    } elseif {$value < 2 ** 32 && $value >= -(2 ** 31)} {
-	# remove sign
-	set value [expr $value & (2 ** 32 - 1)]
-
-	_immediate im<<=[expr $value >> 22]
-	_immediate im<<=[expr ($value >> 11) & 0x7ff]
-	$command im<<=[expr $value & 0x7ff]
-    } else {
-	error "number '$number' doesn't fit in 32 bits"
-    }
-}
-
-# example: stack up
-#          stack down
-proc stack {direction} {
-    if {"$direction" == "up"} {
-	_load r0 @im+sp im=4
-    } elseif {"$direction" == "down"} {
-	_store r0 @im+sp im=0
-    } else {
-	error "bad opcode: stack $direction"
-    }
-}
-
-# example: store im<<=00000000000
-proc store {{im_modification im=im}} {
-    _store r1 @im $im_modification
-}
-
-# example: load im=hDD
-proc load {{im_modification im=im}} {
-    _load r1 @im $im_modification
-}
-
-# example: jump        # if no address is given - im is used
-#          jump h4FFFE
-proc jump {{address im_address}} {
-    if {"$address" == "im_address"} {
-	_jump im=im
-    } else {
-	_const _jump $address
-    }
-}
-
-# example: cond_jump 
-#          cond_jump b100100110100111101 # same semantics as 'jump'
-proc cond_jump {{address im_address}} {
-    if {"$address" == "im_address"} {
-	_jump im=im cond
-    } else {
-	_const _cond_jump $address
-    }
-}
-
-foreach instruction {halt nop swap add sub div mul tee} {
-    proc $instruction {} "
-        _extended_instruction $instruction
-    "
-}
-
-proc swap {} {
-    _extended_instruction nop swap
-}
-
-
-# example: exchange_im im+=15
-proc exchange_im {{im_modification im=im}} {
-    _exchange_im $im_modification
-}
-
-# example: const -100249
-#          const hDEADBEEF # automatically translates to multiple instructions
-proc const {number} {
-    _const _exchange_im $number
-}
-
-# example: immediate b11101101010000010100010 # analogous to 'const' above
-proc immediate {number} {
-    _const _immediate $number
-}
-
-# example: set_sp h2FFFE # analogous to 'const' and 'immediate' above
-proc set_sp {number} {
-    immediate $number
-    _extended_instruction set_sp
-}
-
-# example: store@ h57574
-proc store@ {address_number} {
-    _const store $address_number
-}
-
-# example: load@ h20000
-proc load@ {address_number} {
-    _const load $address_number
-}
diff --git a/tclasm_old.tcl b/tclasm_old.tcl
new file mode 100755
index 0000000..99b01a1
--- /dev/null
+++ b/tclasm_old.tcl
@@ -0,0 +1,352 @@
+#!/bin/grep this[ ]script
+# this script is to be sourced, not executed by itself
+
+# procedures starting with "__" are internal and not to be used in asm code;
+# procedures starting with "_" are generalized procedures, that are not meant
+# to be directly used for code translated from webasm;
+# the rest are typical procedures webasm code will be mapped to
+
+proc __parse_binary {binary} {
+    set value 0
+
+    for {set bits_remaining $binary} \
+	{"$bits_remaining" != ""} \
+	{set bits_remaining [string range $bits_remaining 1 end]} {
+	    set value [expr $value * 2]
+
+	    if [string match 1* $bits_remaining] {
+		incr value
+	    } elseif [string match 0* $bits_remaining] {
+		# nothing
+	    } else {
+		error "'$binary' cannot be parsed as a binary number"
+	    }
+	}
+
+    return $value
+}
+
+proc __parse_number {number} {
+    if [string match h?* $number] {
+	set value 0x[string range $number 1 end]
+    } elseif [string match b?* $number] {
+	set value [__parse_binary [string range $number 1 end]]
+    } elseif [string match {d[0123456789]?*} $number] {
+	set value [string range $number 1 end]
+    } elseif [string match {-[0123456789]*} $number] {
+	set value $number
+    } elseif [string match {[0123456789]*} $number] {
+	set value $number
+    } else {
+	error "'$number' is not a properly formatted number"
+    }
+
+    return $value
+}
+
+proc __to_binary {number length {can_be_negative -neg_ok}} {
+    if [string equal $can_be_negative -neg_ok] {
+	set can_be_negative 1
+    } elseif [string equal $can_be_negative -no_neg] {
+	set can_be_negative 0
+    } else {
+	error "'$can_be_negative' is not a valid value for the\
+               'can_be_negative' argument"
+    }
+
+    set value [__parse_number $number]
+
+    if {$value < 0 && !$can_be_negative} {
+	error "value '$number' provided where negative values are not allowed"
+    }
+
+    if {($can_be_negative && $value >= 2 ** ($length - 1)) ||
+	$value >= 2 ** $length ||
+	$value < -(2 ** ($length - 1))} {
+	error "value '$number' doesn't fit into $length\
+	       bits[expr $can_be_negative ? "{ with sign}" : "{}"]"
+    }
+
+    for {set result ""} {$length > 0} {incr length -1} {
+	set result [expr $value % 2]$result
+	set value [expr $value >> 1]
+    }
+
+    return $result
+}
+
+# example: __encode_immediate im+=213
+#          __encode_immediate im<<=hAB
+#          __encode_immediate im=im
+#          __encode_immediate im=-33    # negative value only allowed for im=
+#          __encode_immediate im<<=b1101101
+proc __encode_immediate {im_modification} {
+    if [string equal $im_modification im=im] {
+	return 000000000000
+    } elseif [string match im<<=?* $im_modification] {
+	return 1[__to_binary [string range $im_modification 5 end] 11 -no_neg]
+    } elseif [string match im=?* $im_modification] {
+	return 01[__to_binary [string range $im_modification 3 end] 10]
+    } elseif [string match im+=?* $im_modification] {
+	return 001[__to_binary [string range $im_modification 4 end] 9 -no_neg]
+    } else {
+	error "'$im_modification' is not a valid im modification"
+    }
+}
+
+# example: __encode_access_type load
+#          __encode_access_type store
+proc __encode_access_type {type} {
+    if {"$type" == "load"} {
+	return 1
+    } elseif {"$type" == "store"} {
+	return 0
+    } else {
+	error "'$type' is not a valid memory access type"
+    }
+}
+
+# example: __encode_addressing @im
+#          __encode_addressing @im+sp
+proc __encode_addressing {address} {
+    if {"$address" == "@im"} {
+	return 1
+    } elseif {"$address" == "@im+sp"} {
+	return 0
+    } else {
+	error "'$address' is not a valid addressing"
+    }
+}
+
+# example: __encode_reg r0
+#          __encode_reg r1
+proc __encode_reg {register} {
+    if {"$register" == "r0"} {
+	return 1
+    } elseif {"$register" == "r1"} {
+	return 0
+    } else {
+	error "'$register' is not a valid register"
+    }
+v}
+
+# example: __encode_memory_access load r0 @im im=d1840
+#          __encode_memory_access store r1 @im+sp im<<=b1100011
+proc __encode_memory_access {type register address {im_modification im=im}} {
+    set type [__encode_access_type $type]
+    set address [__encode_addressing $address]
+    set register [__encode_reg $register]
+    set im_modification [__encode_immediate $im_modification]
+    return 1$type$address$register$im_modification    
+}
+
+# example: __encode_swap swap
+#          __encode_swap no_swap
+proc __encode_swap {swap_regs} {
+    if {"$swap_regs" == "swap"} {
+	return 1
+    } elseif {"$swap_regs" == "no_swap"} {
+	return 0
+    } else {
+	error "got '$swap_regs' where 'swap' or 'no_swap' was expected"
+    }
+}
+
+# example: __encode_swap swap
+#          __encode_swap no_swap
+proc __encode_cond {cond} {
+    if {"$cond" == "cond"} {
+	return 1
+    } elseif {"$cond" == "non-cond"} {
+	return 0
+    } else {
+	error "got '$cond' where 'cond' or 'non-cond' was expected"
+    }
+}
+
+# example: __encode_extended_instruction halt
+#          __encode_extended_instruction nop
+proc __encode_extended_instruction {instruction} {
+    if {"$instruction" == "nop"} {
+	return [__to_binary 0 9]
+    } elseif {"$instruction" == "halt"} {
+	return [__to_binary 1 9]
+    } elseif {"$instruction" == "set_sp"} {
+	return [__to_binary 2 9]
+    } elseif {"$instruction" == "add"} {
+	return [__to_binary 3 9]
+    } elseif {"$instruction" == "sub"} {
+	return [__to_binary 4 9]
+    } elseif {"$instruction" == "div"} {
+	return [__to_binary 5 9]
+    } elseif {"$instruction" == "mul"} {
+	return [__to_binary 6 9]
+    } elseif {"$instruction" == "tee"} {
+	return [__to_binary 7 9]
+    } else {
+	error "no such extended instruction: '$instruction'"
+    }
+}
+
+# example: _load r0 @im im+=2   # negative values are *not* allowed for im+=
+#          _load r1 @im im=im
+#          _load r0 @im+sp      # im=im is the default if not specified
+#          _load r0 @im im<<=12 # 12 is the value shifted, shift is always by 11
+#          _load r1 @im im=-9   # negative values are only allowed for im=
+#          _load r0 @im+sp im=0 # this results in using only sp for addressing
+proc _load {register address {im_modification im=im}} {
+    puts [__encode_memory_access load $register $address $im_modification]
+}
+
+# example: _store r0 @im im+=2   # same semantics as _load
+#          _store r1 @im im=im
+#          _store r0 @im+sp
+#          _store r0 @im im<<=12
+#          _store r1 @im im=-9
+#          _store r0 @im+sp im=0
+proc _store {register address {im_modification im=im}} {
+    puts [__encode_memory_access store $register $address $im_modification]
+}
+
+# example: _jump im<<=b1101011 cond swap
+#          _jump im=im non-cond
+proc _jump {{im_modification im=im} {cond non-cond} {swap_regs no_swap}} {
+    set swap_regs [__encode_swap $swap_regs]
+    set cond [__encode_cond $cond]
+    puts 01$cond$swap_regs[__encode_immediate $im_modification]
+}
+
+# example: _cond_jump im=h16A swap
+proc _cond_jump {{im_modification im=im} {swap_regs no_swap}} {
+    _jump $im_modification cond $swap_regs
+}
+
+# example: _extended_instruction nop swap  # it's really no longer a true nop...
+#          _extended_instruction halt
+proc _extended_instruction {instruction {swap_regs no_swap}} {
+    set swap_regs [__encode_swap $swap_regs]
+    set no_im_modification 000
+    set instruction [__encode_extended_instruction $instruction]
+    puts 000$swap_regs$no_im_modification$instruction
+}
+
+# example: _immediate im+=4 swap
+#          _immediate im<<=hFF
+#          _immediate im=im      # this one gives the same bit result as 'nop'
+proc _immediate {im_modification {swap_regs no_swap}} {
+    set swap_regs [__encode_swap $swap_regs]
+    set im_modification [__encode_immediate $im_modification]
+    puts 000$swap_regs$im_modification
+}
+
+# example: _exchange_im im<<=b10101010101 swap
+proc _exchange_im {{im_modification im=im} {swap_regs no_swap}} {
+    set swap_regs [__encode_swap $swap_regs]
+    set im_modification [__encode_immediate $im_modification]
+    puts 001$swap_regs$im_modification
+}
+
+proc _const {command number} {
+
+    set value [expr [__parse_number $number] + 0]
+    if {$value < 2 ** 9 && $value >= -(2 ** 9)} {
+	$command im=$value
+    } elseif {$value < 2 ** 20 && $value >= -(2 ** 20)} {
+	_immediate im=[expr $value >> 11]
+	$command im<<=[expr $value & 0x7ff]
+    } elseif {$value < 2 ** 32 && $value >= -(2 ** 31)} {
+	# remove sign
+	set value [expr $value & (2 ** 32 - 1)]
+
+	_immediate im<<=[expr $value >> 22]
+	_immediate im<<=[expr ($value >> 11) & 0x7ff]
+	$command im<<=[expr $value & 0x7ff]
+    } else {
+	error "number '$number' doesn't fit in 32 bits"
+    }
+}
+
+# example: stack up
+#          stack down
+proc stack {direction} {
+    if {"$direction" == "up"} {
+	_load r0 @im+sp im=4
+    } elseif {"$direction" == "down"} {
+	_store r0 @im+sp im=0
+    } else {
+	error "bad opcode: stack $direction"
+    }
+}
+
+# example: store im<<=00000000000
+proc store {{im_modification im=im}} {
+    _store r1 @im $im_modification
+}
+
+# example: load im=hDD
+proc load {{im_modification im=im}} {
+    _load r1 @im $im_modification
+}
+
+# example: jump        # if no address is given - im is used
+#          jump h4FFFE
+proc jump {{address im_address}} {
+    if {"$address" == "im_address"} {
+	_jump im=im
+    } else {
+	_const _jump $address
+    }
+}
+
+# example: cond_jump 
+#          cond_jump b100100110100111101 # same semantics as 'jump'
+proc cond_jump {{address im_address}} {
+    if {"$address" == "im_address"} {
+	_jump im=im cond
+    } else {
+	_const _cond_jump $address
+    }
+}
+
+foreach instruction {halt nop swap add sub div mul tee} {
+    proc $instruction {} "
+        _extended_instruction $instruction
+    "
+}
+
+proc swap {} {
+    _extended_instruction nop swap
+}
+
+
+# example: exchange_im im+=15
+proc exchange_im {{im_modification im=im}} {
+    _exchange_im $im_modification
+}
+
+# example: const -100249
+#          const hDEADBEEF # automatically translates to multiple instructions
+proc const {number} {
+    _const _exchange_im $number
+}
+
+# example: immediate b11101101010000010100010 # analogous to 'const' above
+proc immediate {number} {
+    _const _immediate $number
+}
+
+# example: set_sp h2FFFE # analogous to 'const' and 'immediate' above
+proc set_sp {number} {
+    immediate $number
+    _extended_instruction set_sp
+}
+
+# example: store@ h57574
+proc store@ {address_number} {
+    _const store $address_number
+}
+
+# example: load@ h20000
+proc load@ {address_number} {
+    _const load $address_number
+}
diff --git a/tests/soc_simple_display/instructions.s.tcl b/tests/soc_simple_display/instructions.s.tcl
index db142a0..4bfc73f 100755
--- a/tests/soc_simple_display/instructions.s.tcl
+++ b/tests/soc_simple_display/instructions.s.tcl
@@ -1,6 +1,6 @@
 #!/usr/bin/env tclsh
 
-source tclasm.tcl
+source tclasm_old.tcl
 
 ## also look at stack_machine_cond_jump test 
 
diff --git a/tests/stack_machine_old_add/instructions.s.tcl b/tests/stack_machine_old_add/instructions.s.tcl
index c3cfe4d..6894ecc 100755
--- a/tests/stack_machine_old_add/instructions.s.tcl
+++ b/tests/stack_machine_old_add/instructions.s.tcl
@@ -1,6 +1,6 @@
 #!/usr/bin/env tclsh
 
-source tclasm.tcl
+source tclasm_old.tcl
 
 ### store 2 values to memory, load them back, add them and store the result
 
diff --git a/tests/stack_machine_old_cond_jump/instructions.s.tcl b/tests/stack_machine_old_cond_jump/instructions.s.tcl
index 467a719..2cce62f 100755
--- a/tests/stack_machine_old_cond_jump/instructions.s.tcl
+++ b/tests/stack_machine_old_cond_jump/instructions.s.tcl
@@ -1,6 +1,6 @@
 #!/usr/bin/env tclsh
 
-source tclasm.tcl
+source tclasm_old.tcl
 
 ## also look at stack_machine_jump test 
 
diff --git a/tests/stack_machine_old_div/instructions.s.tcl b/tests/stack_machine_old_div/instructions.s.tcl
index e2d55dc..8a5f5df 100755
--- a/tests/stack_machine_old_div/instructions.s.tcl
+++ b/tests/stack_machine_old_div/instructions.s.tcl
@@ -1,6 +1,6 @@
 #!/usr/bin/env tclsh
 
-source tclasm.tcl
+source tclasm_old.tcl
 
 ### store 2 values to memory, load them back, divide one by another and store
 ### the result (both quotient and remainder); this is analogous to addition
diff --git a/tests/stack_machine_old_jump/instructions.s.tcl b/tests/stack_machine_old_jump/instructions.s.tcl
index f681fc9..359da35 100755
--- a/tests/stack_machine_old_jump/instructions.s.tcl
+++ b/tests/stack_machine_old_jump/instructions.s.tcl
@@ -1,6 +1,6 @@
 #!/usr/bin/env tclsh
 
-source tclasm.tcl
+source tclasm_old.tcl
 
 ## Let there be 2 pieces of code - each one storing a different value in memory
 ## and halting afterwards. Jump instruction should cause the second piece of
diff --git a/tests/stack_machine_old_load_store/instructions.s.tcl b/tests/stack_machine_old_load_store/instructions.s.tcl
index 13cabcb..40a657e 100755
--- a/tests/stack_machine_old_load_store/instructions.s.tcl
+++ b/tests/stack_machine_old_load_store/instructions.s.tcl
@@ -1,6 +1,6 @@
 #!/usr/bin/env tclsh
 
-source tclasm.tcl
+source tclasm_old.tcl
 
 ### another simple test - set stack to h7FFFC, store 4 numbers on stack (only 2
 ### will really get written to memory, other 2 will remain in r0 and r1),
diff --git a/tests/stack_machine_old_mul/instructions.s.tcl b/tests/stack_machine_old_mul/instructions.s.tcl
index 8473aef..969b19a 100755
--- a/tests/stack_machine_old_mul/instructions.s.tcl
+++ b/tests/stack_machine_old_mul/instructions.s.tcl
@@ -1,6 +1,6 @@
 #!/usr/bin/env tclsh
 
-source tclasm.tcl
+source tclasm_old.tcl
 
 ### store 4 values to memory; load 2 of them back, multiply them and store the
 ### result; load another 2, multiply them and store the result;
diff --git a/tests/stack_machine_old_multiinstructions_load_store/instructions.s.tcl b/tests/stack_machine_old_multiinstructions_load_store/instructions.s.tcl
index 58792d3..a6316a3 100755
--- a/tests/stack_machine_old_multiinstructions_load_store/instructions.s.tcl
+++ b/tests/stack_machine_old_multiinstructions_load_store/instructions.s.tcl
@@ -1,6 +1,6 @@
 #!/usr/bin/env tclsh
 
-source tclasm.tcl
+source tclasm_old.tcl
 
 ### do the same as in stack_machine_2 test, but use higher level instructions
 
diff --git a/tests/stack_machine_old_store/instructions.s.tcl b/tests/stack_machine_old_store/instructions.s.tcl
index ddc3a8e..d7e26b0 100755
--- a/tests/stack_machine_old_store/instructions.s.tcl
+++ b/tests/stack_machine_old_store/instructions.s.tcl
@@ -1,6 +1,6 @@
 #!/usr/bin/env tclsh
 
-source tclasm.tcl
+source tclasm_old.tcl
 
 ### simple test - write value hDEADBEEF to address h3ABCD
 
diff --git a/tests/stack_machine_old_sub/instructions.s.tcl b/tests/stack_machine_old_sub/instructions.s.tcl
index 3f8fb48..33873ef 100755
--- a/tests/stack_machine_old_sub/instructions.s.tcl
+++ b/tests/stack_machine_old_sub/instructions.s.tcl
@@ -1,6 +1,6 @@
 #!/usr/bin/env tclsh
 
-source tclasm.tcl
+source tclasm_old.tcl
 
 ### store 2 values to memory, load them back, substract them and store the
 ### result; this is analogous to addition test
diff --git a/tests/stack_machine_old_swap/instructions.s.tcl b/tests/stack_machine_old_swap/instructions.s.tcl
index c17314e..536a921 100755
--- a/tests/stack_machine_old_swap/instructions.s.tcl
+++ b/tests/stack_machine_old_swap/instructions.s.tcl
@@ -1,6 +1,6 @@
 #!/usr/bin/env tclsh
 
-source tclasm.tcl
+source tclasm_old.tcl
 
 set_sp h7FFFC
 const h00AD00DE
diff --git a/tests/stack_machine_old_tee/instructions.s.tcl b/tests/stack_machine_old_tee/instructions.s.tcl
index e75b564..7fccd6f 100755
--- a/tests/stack_machine_old_tee/instructions.s.tcl
+++ b/tests/stack_machine_old_tee/instructions.s.tcl
@@ -1,6 +1,6 @@
 #!/usr/bin/env tclsh
 
-source tclasm.tcl
+source tclasm_old.tcl
 
 set_sp h7FFFC
 const hABCDEF
-- 
cgit v1.2.3