rename tclasm.tcl to tclasm_old.tcl (prepare for redesign of the stack machine)

1 files changed, 0 insertions, 352 deletions

diff --git a/tclasm.tcl b/tclasm.tcl
index 99b01a1..e69de29 100755..100644
--- 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
-}