path: root/tclasm.tcl

#!/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]