; memory map M[.]
; code 0..500
; global 1000..1100
; symtab 2000..2999

; global
; 1000 CH
; 1001 CS
; 1002 CP

1 call boot2
2 call main
3 end

; isNum c
20 fun 1
21 get 1
22 lit 48
23 ge
24 get 1
25 lit 57
26 le
27 and
28 ret 2

;; isSpace c
29 fun 1
30 get 1
31 lit 32
32 eq
33 get 1
34 lit 10
35 eq
36 or
37 get 1
38 lit 0
39 lt
40 or
41 ret 2

;; readc {c}
60 fun 2
61 sys 3
62 put 1
63 get 1
64 st 1000
65 get 1
66 sys 2
67 get 1
68 ret 2

;65 get 1
;66 ret 2

;; readi c { n pos}
70 fun 3
71 get 3
72 lit 48
73 sub
74 put 2
75 get 2
76 put 1
77 jmp x
loop:
78 get 2
79 lit 10
80 mul
81 ld 1000
82 add
83 lit 48
84 sub
85 put 2
x: 
86 call readc
87 call isspace
88 not
89 jt loop
90 get 1
91 jf y
92 get 2
93 ret 4
y:
94 lit 0
95 get 2
96 sub
97 ret 4

;; boot {op arg i}
100 fun 4
101 call readc
102 call readi
103 put 3
104 jmp x
loop:
105 call readc
106 call readi
107 put 2
108 get 3
109 sys 1
110 lit 32
111 sys 2
112 get 2
113 sys 1
114 lit 10
115 sys 2
116 call readc
117 call readi
118 put 3
x:
119 get 3
120 lit 0
121 ne
122 jt loop
123 ret 4

; test boot 
; with some s-object

; 32 17
; 23 0
; 38 1
; 0

; 130 boot2 {op arg i}
130 fun 4
131 lit 301000
132 st CS
133 lit 159
134 put 1
135 call readc
136 call readi
137 put 3
138 jmp x
loop:
139 call readc
140 call readi
141 put 2
142 ld CS
143 get 1
144 get 2
145 lit 8
146 shl
147 get 3
148 or
149 stx
150 inc 1
151 call readc
152 call readi
153 put 3
x:
154 get 3
155 lit 0
156 ne
157 jt loop
158 ret 4

; test boot2 with simple
; program

; testboot2
; 159 fun 1
; 160 lit 1
; 161 lit 2
; 162 add
; 163 sys 1
; 164 ret 1

; global
; 1003 freecell
; 1004 base ads of symtab
; 1005 tkval

; newcell c { k }
170 fun 2
171 ld 1003
172 put 1
173 ld 1003
174 lit 4
175 add
176 st 1003
177 ld 1004
178 get 1
179 get 2
180 stx
181 get 1
182 ret 3

; 183 search i c
183 fun 1
184 ld 1004
185 get 2
186 ldx
187 lit 0
188 eq
189 jf x
190 ld 1004
191 get 2
192 get 1
193 call 170
194 stx
x:
195 ld 1004
196 get 2
197 ldx
198 ret 3

; 200 lex { i }
200 fun 2
201 jmp x
loop:
202 ld 1000
203 lit 0
204 lt
205 jt y 
x:
206 call readc
207 call isspace
208 jt loop
y:
209 ld 1000
210 call isnum
211 jf z
212 ld 1000
213 call readi
214 st 1005
215 lit 1
216 ret 2
z:
217 lit 0
218 put 1
219 jmp w
loop2:
220 get 1
221 lit 2
222 add
223 ld 1000
224 call search
225 put 1
226 jmp v
loop3:
227 get 1
228 lit 1
229 add
230 ld 1000
231 call search
232 put 1
v:
233 ld 1004
234 get 1
235 ldx
236 ld 1000
237 ne
238 jt loop3
239 call readc
240 st 1000
w:
241 ld 1000
242 call isspace
243 not
244 jt loop2
245 get 1
246 ret 2

; 250 testlex { i }
250 fun 2
251 lit 100
252 array
253 st sym
254 call lex
255 put 1
256 jmp x
loop:
257 get 1
258 sys 1
259 lit 32
260 sys 2
261 call lex
262 put 1
x:
263 ld tkval
264 lit 0
265 ne
266 jt loop
267 ret 2

; testlex with simple input
1 2 3 aa bb x 9
0

; now the final stage

; initsym { i j }
270 fun 3
271 lit 4
272 st freecell
273 lit 1000
274 array
275 st sym
276 call lex
277 put 2
278 jmp x
loop:
279 call lex
280 put 1
281 ld sym
282 get 2
283 lit 3
284 add
285 ld tkval
286 stx
287 call lex
288 put 2
x:
289 get 2
290 lit 1
291 gt
292 jt loop
293 ret 3

; outc op arg
300 fun 1
301 ld CS
302 ld CP
303 get 1
304 lit 8
305 shl
306 get 2
307 or
308 stx
309 ld CP
310 lit 1
311 add
312 st CP
313 ret 3

; asm { i j op }
320 fun 4
321 call lex
322 put 3
323 jmp x
loop:
324 ld sym
325 get 3
326 lit 3
327 add
328 ldx
329 put 1
330 lit 0
331 st tkval
332 get 1
333 lit 23
334 gt
335 jf y
336 call lex
337 put 2
y:
338 get 1
339 ld tkval
340 call outc
341 call lex
342 put 3
x:
343 get 3
344 lit 1
345 gt
346 jt loop
347 ret 4

; main
350 fun 1
351 call initsym
352 lit 301000
353 st CS
354 lit 370
355 st CP
356 call asm
357 lit 6
358 call fac
359 sys 1
360 ret 1

; s-code symbol table

add 1  sub 2  mul 3  div 4
and 5  or 6  xor 7  not 8
eq 9  ne 10  lt 11
le 12  gt 14  ge 13
shl 15 shr 16  mod 17
ldx 18   stx 19
array 22  end 23

get 24   put 25
ld 26   st 27
jmp 28  jt 29  jf 30
lit 31  call 32
inc 34  dec 35  sys 36
fun 38  ret 40
0

; 370 fac 
; fac n
;   if n == 0 ret 1
;   else return n * fac(n-1)
 
fun 1
get 1
lit 0
eq
jf 3
lit 1
ret 2
get 1
get 1
lit 1
sub
call 370
mul
ret 2
0