#!/usr/bin/tclsh
# 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
}
# _im and _with_im are needed to construct higher-level
# multiinstructions, that use an immediate value
proc _im {value} {
puts 1[__to_binary $value 15]
}
proc _with_im {command number} {
set value [expr [__parse_number $number] + 0]
if {$value < 2 ** 6 && $value >= -(2 ** 6)} {
$command $value
} elseif {$value < 2 ** 21 && $value >= -(2 ** 21)} {
_im [expr $value >> 7]
$command [expr $value & 0x7F]
} elseif {$value < 2 ** 32 && $value >= -(2 ** 31)} {
_im [expr $value >> 22]
_im [expr ($value >> 7) & 0x7FFF]
$command [expr $value & 0x7F]
} else {
error "number '$number' doesn't fit in 32 bits"
}
}
# Load and store instructions, different variants */
proc _store {address_part} {
puts 011111100[__to_binary $address_part 7]
}
proc store {address} {
_with_im _store $address
}
proc _store+ {address_part} {
puts 011011100[__to_binary $address_part 7]
}
proc store+ {address} {
_with_im _store+ $address
}
proc _storeb {address_part} {
puts 011111000[__to_binary $address_part 7]
}
proc storeb {address} {
_with_im _storeb $address
}
proc _storeb+ {address_part} {
puts 011011000[__to_binary $address_part 7]
}
proc storeb+ {address} {
_with_im _storeb+ $address
}
proc _storew {address_part} {
puts 011111010[__to_binary $address_part 7]
}
proc storew {address} {
_with_im _storew $address
}
proc _storew+ {address_part} {
puts 011011010[__to_binary $address_part 7]
}
proc storew+ {address} {
_with_im _storew+ $address
}
proc _load {address_part} {
puts 010111100[__to_binary $address_part 7]
}
proc load {address} {
_with_im _load $address
}
proc _load+ {address_part} {
puts 010011100[__to_binary $address_part 7]
}
proc load+ {address} {
_with_im _load+ $address
}
proc _loadbzx {address_part} {
puts 010111000[__to_binary $address_part 7]
}
proc loadbzx {address} {
_with_im _loadbzx $address
}
proc _loadbzx+ {address_part} {
puts 010011000[__to_binary $address_part 7]
}
proc loadbzx+ {address} {
_with_im _loadbzx+ $address
}
proc _loadbsx {address_part} {
puts 010111001[__to_binary $address_part 7]
}
proc loadbsx {address} {
_with_im _loadbsx $address
}
proc _loadbsx+ {address_part} {
puts 010011001[__to_binary $address_part 7]
}
proc loadbsx+ {address} {
_with_im _loadbsx+ $address
}
proc _loadwzx {address_part} {
puts 010111010[__to_binary $address_part 7]
}
proc loadwzx {address} {
_with_im _loadwzx $address
}
proc _loadwzx+ {address_part} {
puts 010011010[__to_binary $address_part 7]
}
proc loadwzx+ {address} {
_with_im _loadwzx+ $address
}
proc _loadwsx {address_part} {
puts 010111011[__to_binary $address_part 7]
}
proc loadwsx {address} {
_with_im _loadwsx $address
}
proc _loadwsx+ {address_part} {
puts 010011011[__to_binary $address_part 7]
}
proc loadwsx+ {address} {
_with_im _loadwsx+ $address
}
# Instructions, that do not change stack size
proc halt {} {
puts 0000000000000000
}
proc nop {} {
puts 0000000000000001
}
proc swap {} {
puts 0000000000000010
}
proc _set_sp {address_part} {
puts 010000000[__to_binary $address_part 7]
}
proc set_sp {address} {
_with_im _set_sp $address
}
proc _jump {address_part} {
puts 010000001[__to_binary $address_part 7]
}
proc jump {address} {
_with_im _jump $address
}
proc _add_sp {number_part} {
puts 010000010[__to_binary $number_part 7]
}
proc add_sp {number} {
_with_im _add_sp $number
}
# Instructions, that grow stack
proc tee {} {
puts 0001000000000000
}
proc get_frame {} {
puts 0001000000000001
}
proc _const {value_part} {
puts 010100000[__to_binary $value_part 7]
}
proc const {value} {
_with_im _const $value
}
proc _call {address_part} {
puts 010100001[__to_binary $address_part 7]
}
proc call {address} {
_with_im _call $address
}
# Instructions, that shrink stack
proc add {} {
puts 0011000000000000
}
proc sub {} {
puts 0011000000000001
}
proc div {} {
puts 0011000000000010
}
proc mul {} {
puts 0011000000000011
}
proc drop {} {
puts 0011000000000100
}
proc eq {} {
puts 0011000000000111
}
proc lt {} {
puts 0011000000001000
}
proc ult {} {
puts 0011000000001001
}
proc le {} {
puts 0011000000001010
}
proc ule {} {
puts 0011000000001011
}
proc gt {} {
puts 0011000000001100
}
proc ugt {} {
puts 0011000000001101
}
proc ge {} {
puts 0011000000001110
}
proc uge {} {
puts 0011000000001111
}
proc rem {} {
puts 0011000000010000
}
proc ret {} {
puts 0011000010000000
}
proc _cond_jump {address_part} {
puts 011100001[__to_binary $address_part 7]
}
proc cond_jump {address} {
_with_im _cond_jump $address
}
proc _cond_jump_n {address_part} {
puts 011100010[__to_binary $address_part 7]
}
proc cond_jump_n {address} {
_with_im _cond_jump_n $address
}
# translate instructions in the file given as command line argument
source [lindex $argv 0]
