aboutsummaryrefslogtreecommitdiff
path: root/tclasm.tcl
blob: e552b4dd5745acb9654136fc7f5e2562ee96cee0 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
#!/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 _load {address_part} {
    puts 010111100[__to_binary $address_part 7]
}

proc _load+ {address_part} {
    puts 010011100[__to_binary $address_part 7]
}

proc _set_sp {address_part} {
    puts 010000000[__to_binary $address_part 7]
}

proc halt {} {
    puts 0000000000000000
}