diff options
author | Wojciech Kosior <kwojtus@protonmail.com> | 2020-09-05 12:59:45 +0200 |
---|---|---|
committer | Wojciech Kosior <kwojtus@protonmail.com> | 2020-09-05 12:59:45 +0200 |
commit | b59715e09322f8c094126b57ba6d0424b9892a3f (patch) | |
tree | 7bf992351768b9133417f429b169b7b50225d0ae /tclasm.tcl | |
parent | dc41391380effbe0d16d024e290b87a7f5d39bf2 (diff) | |
download | AGH-engineering-thesis-b59715e09322f8c094126b57ba6d0424b9892a3f.tar.gz AGH-engineering-thesis-b59715e09322f8c094126b57ba6d0424b9892a3f.zip |
add first simple bench for new stack machine
Diffstat (limited to 'tclasm.tcl')
-rw-r--r-- | tclasm.tcl | 85 |
1 files changed, 85 insertions, 0 deletions
@@ -0,0 +1,85 @@ +#!/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 low-level 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} { + set value [__parse_number $number] + + if {$value >= 2 ** $length || + $value < -(2 ** ($length - 1))} { + error "value '$number' doesn't fit into $length bits" + } + + for {set result ""} {$length > 0} {incr length -1} { + set result [expr $value % 2]$result + set value [expr $value >> 1] + } + + return $result +} + +proc _im {value} { + puts 1[__to_binary $value 15] +} + +proc _const {value} { + puts 010100000[__to_binary $value 7] +} + +proc _store {address_part} { + puts 011111100[__to_binary $address_part 7] +} + +proc _store+ {address_part} { + puts 011011100[__to_binary $address_part 7] +} + +proc _set_sp {address_part} { + puts 010000000[__to_binary $address_part 7] +} + +proc halt {} { + puts 0000000000000000 +} |