From b59715e09322f8c094126b57ba6d0424b9892a3f Mon Sep 17 00:00:00 2001
From: Wojciech Kosior <kwojtus@protonmail.com>
Date: Sat, 5 Sep 2020 12:59:45 +0200
Subject: add first simple bench for new stack machine

---
 tclasm.tcl | 85 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 85 insertions(+)

(limited to 'tclasm.tcl')

diff --git a/tclasm.tcl b/tclasm.tcl
index e69de29..27c92ae 100644
--- a/tclasm.tcl
+++ b/tclasm.tcl
@@ -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
+}
-- 
cgit v1.2.3