From 99025b9d34ccad778f11258e186b0bd8dc9c71a4 Mon Sep 17 00:00:00 2001 From: Wojciech Kosior Date: Thu, 3 Sep 2020 20:29:45 +0200 Subject: rename tclasm.tcl to tclasm_old.tcl (prepare for redesign of the stack machine) --- tclasm.tcl | 352 ------------------------------------------------------------- 1 file changed, 352 deletions(-) mode change 100755 => 100644 tclasm.tcl (limited to 'tclasm.tcl') 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 -} -- cgit v1.2.3