aboutsummaryrefslogtreecommitdiff
path: root/tclasm.tcl
blob: 5af74c4afd2a6e24cf7aeb6d2da4c5eecf963b28 (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
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
#!/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 _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
}


# 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
}


# Instructions, that grow stack

proc tee {} {
    puts 0001000000000000
}


proc _const {value_part} {
    puts 010100000[__to_binary $value_part 7]
}

proc const {value} {
    _with_im _const $value
}


# Instructions, that shrink stack

proc add {} {
    puts 0011000000000000
}


proc sub {} {
    puts 0011000000000001
}


proc div {} {
    puts 0011000000000010
}


proc mul {} {
    puts 0011000000000011
}


proc _cond_jump {address_part} {
    puts 011100001[__to_binary $address_part 7]
}

proc cond_jump {address} {
    _with_im _cond_jump $address
}


# translate instructions in the file given as command line argument
source [lindex $argv 0]