From ee1f6c47e1eff920068f4bceaf604f9535a2e8a9 Mon Sep 17 00:00:00 2001 From: Wojciech Kosior Date: Tue, 1 Sep 2020 10:54:59 +0200 Subject: start anew --- tclasm.tcl | 337 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 337 insertions(+) create mode 100755 tclasm.tcl (limited to 'tclasm.tcl') diff --git a/tclasm.tcl b/tclasm.tcl new file mode 100755 index 0000000..8c89eeb --- /dev/null +++ b/tclasm.tcl @@ -0,0 +1,337 @@ +#!/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] + } 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: _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 im=h1dd +# jump # im=im is the default if not specified +proc jump {{im_modification im=im}} { + _jump $im_modification non-cond +} + +# example: cond_jump im=h00FE +# cond_jump # im=im is the default if not specified +proc cond_jump {{im_modification im=im}} { + _jump $im_modification cond +} + +foreach instruction {halt nop swap add sub div mul} { + 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 +} -- cgit v1.2.3