https://github.com/akkartik/mu/blob/main/shell/primitives.mu
1 fn initialize-primitives _self: (addr global-table) {
2 var self/esi: (addr global-table) <- copy _self
3
4 append-primitive self, "+"
5 append-primitive self, "-"
6 append-primitive self, "*"
7 append-primitive self, "/"
8 append-primitive self, "%"
9 append-primitive self, "sqrt"
10 append-primitive self, "abs"
11 append-primitive self, "sgn"
12 append-primitive self, "<"
13 append-primitive self, ">"
14 append-primitive self, "<="
15 append-primitive self, ">="
16
17 append-primitive self, "apply"
18 append-primitive self, "="
19 append-primitive self, "no"
20 append-primitive self, "not"
21 append-primitive self, "dbg"
22
23 append-primitive self, "car"
24 append-primitive self, "cdr"
25 append-primitive self, "cons"
26
27 append-primitive self, "print"
28 append-primitive self, "clear"
29 append-primitive self, "lines"
30 append-primitive self, "columns"
31 append-primitive self, "up"
32 append-primitive self, "down"
33 append-primitive self, "left"
34 append-primitive self, "right"
35 append-primitive self, "cr"
36 append-primitive self, "pixel"
37 append-primitive self, "width"
38 append-primitive self, "height"
39
40 append-primitive self, "key"
41
42 append-primitive self, "stream"
43 append-primitive self, "write"
44
45 append-primitive self, "abort"
46
47 }
48
49 fn render-primitives screen: (addr screen), xmin: int, xmax: int, ymax: int {
50 var y/ecx: int <- copy ymax
51 y <- subtract 0x10
52 clear-rect screen, xmin, y, xmax, ymax, 0xdc/bg=green-bg
53 y <- increment
54 var tmpx/eax: int <- copy xmin
55 tmpx <- draw-text-rightward screen, "cursor graphics", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
56 y <- increment
57 var tmpx/eax: int <- copy xmin
58 tmpx <- draw-text-rightward screen, " print", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
59 tmpx <- draw-text-rightward screen, ": screen a -> a", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
60 y <- increment
61 var tmpx/eax: int <- copy xmin
62 tmpx <- draw-text-rightward screen, " lines columns", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
63 tmpx <- draw-text-rightward screen, ": screen -> number", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
64 y <- increment
65 var tmpx/eax: int <- copy xmin
66 tmpx <- draw-text-rightward screen, " up down left right", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
67 tmpx <- draw-text-rightward screen, ": screen", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
68 y <- increment
69 var tmpx/eax: int <- copy xmin
70 tmpx <- draw-text-rightward screen, " cr", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
71 tmpx <- draw-text-rightward screen, ": screen ", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
72 tmpx <- draw-text-rightward screen, "# move cursor down and to left margin", tmpx, xmax, y, 0x38/fg=trace, 0xdc/bg=green-bg
73 y <- increment
74 var tmpx/eax: int <- copy xmin
75 tmpx <- draw-text-rightward screen, "pixel graphics", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
76 y <- increment
77 var tmpx/eax: int <- copy xmin
78 tmpx <- draw-text-rightward screen, " width height", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
79 tmpx <- draw-text-rightward screen, ": screen -> number", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
80 y <- increment
81 var tmpx/eax: int <- copy xmin
82 tmpx <- draw-text-rightward screen, " pixel", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
83 tmpx <- draw-text-rightward screen, ": screen x y color", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
84 y <- increment
85 var tmpx/eax: int <- copy xmin
86 tmpx <- draw-text-rightward screen, "screen/keyboard", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
87 y <- increment
88 var tmpx/eax: int <- copy xmin
89 tmpx <- draw-text-rightward screen, " clear", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
90 tmpx <- draw-text-rightward screen, ": screen", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
91 y <- increment
92 var tmpx/eax: int <- copy xmin
93 tmpx <- draw-text-rightward screen, " key", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
94 tmpx <- draw-text-rightward screen, ": () -> grapheme?", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
95 y <- increment
96 var tmpx/eax: int <- copy xmin
97 tmpx <- draw-text-rightward screen, "streams", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
98 y <- increment
99 var tmpx/eax: int <- copy xmin
100 tmpx <- draw-text-rightward screen, " stream", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
101 tmpx <- draw-text-rightward screen, ": () -> stream ", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
102 y <- increment
103 var tmpx/eax: int <- copy xmin
104 tmpx <- draw-text-rightward screen, " write", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
105 tmpx <- draw-text-rightward screen, ": stream grapheme -> stream", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
106 y <- increment
107 var tmpx/eax: int <- copy xmin
108 tmpx <- draw-text-rightward screen, "fn apply set if while cons car cdr no not and or = ", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
109
110 tmpx <- draw-text-rightward screen, "< > <= >= + - * / % sqrt abs sgn", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
111 }
112
113 fn primitive-global? _x: (addr global) -> _/eax: boolean {
114 var x/eax: (addr global) <- copy _x
115 var value-ah/eax: (addr handle cell) <- get x, value
116 var value/eax: (addr cell) <- lookup *value-ah
117 compare value, 0/null
118 {
119 break-if-!=
120 return 0/false
121 }
122 var value-type/eax: (addr int) <- get value, type
123 compare *value-type, 4/primitive
124 {
125 break-if-=
126 return 0/false
127 }
128 return 1/true
129 }
130
131 fn append-primitive _self: (addr global-table), name: (addr array byte) {
132 var self/esi: (addr global-table) <- copy _self
133 compare self, 0
134 {
135 break-if-!=
136 abort "append primitive"
137 return
138 }
139 var final-index-addr/ecx: (addr int) <- get self, final-index
140 increment *final-index-addr
141 var curr-index/ecx: int <- copy *final-index-addr
142 var data-ah/eax: (addr handle array global) <- get self, data
143 var data/eax: (addr array global) <- lookup *data-ah
144 var curr-offset/esi: (offset global) <- compute-offset data, curr-index
145 var curr/esi: (addr global) <- index data, curr-offset
146 var curr-name-ah/eax: (addr handle array byte) <- get curr, name
147 copy-array-object name, curr-name-ah
148 var curr-value-ah/eax: (addr handle cell) <- get curr, value
149 new-primitive-function curr-value-ah, curr-index
150 }
151
152
153 fn apply-primitive _f: (addr cell), args-ah: (addr handle cell), out: (addr handle cell), _globals: (addr global-table), trace: (addr trace) {
154 var f/esi: (addr cell) <- copy _f
155 var f-index-a/ecx: (addr int) <- get f, index-data
156 var f-index/ecx: int <- copy *f-index-a
157 var globals/eax: (addr global-table) <- copy _globals
158 compare globals, 0
159 {
160 break-if-!=
161 abort "apply primitive"
162 return
163 }
164 var global-data-ah/eax: (addr handle array global) <- get globals, data
165 var global-data/eax: (addr array global) <- lookup *global-data-ah
166 var f-offset/ecx: (offset global) <- compute-offset global-data, f-index
167 var f-value/ecx: (addr global) <- index global-data, f-offset
168 var f-name-ah/ecx: (addr handle array byte) <- get f-value, name
169 var f-name/eax: (addr array byte) <- lookup *f-name-ah
170 {
171 var add?/eax: boolean <- string-equal? f-name, "+"
172 compare add?, 0/false
173 break-if-=
174 apply-add args-ah, out, trace
175 return
176 }
177 {
178 var subtract?/eax: boolean <- string-equal? f-name, "-"
179 compare subtract?, 0/false
180 break-if-=
181 apply-subtract args-ah, out, trace
182 return
183 }
184 {
185 var multiply?/eax: boolean <- string-equal? f-name, "*"
186 compare multiply?, 0/false
187 break-if-=
188 apply-multiply args-ah, out, trace
189 return
190 }
191 {
192 var divide?/eax: boolean <- string-equal? f-name, "/"
193 compare divide?, 0/false
194 break-if-=
195 apply-divide args-ah, out, trace
196 return
197 }
198
199
200
201
202
203
204 {
205 var remainder?/eax: boolean <- string-equal? f-name, "%"
206 compare remainder?, 0/false
207 break-if-=
208 apply-remainder args-ah, out, trace
209 return
210 }
211 {
212 var square-root?/eax: boolean <- string-equal? f-name, "sqrt"
213 compare square-root?, 0/false
214 break-if-=
215 apply-square-root args-ah, out, trace
216 return
217 }
218 {
219 var abs?/eax: boolean <- string-equal? f-name, "abs"
220 compare abs?, 0/false
221 break-if-=
222 apply-abs args-ah, out, trace
223 return
224 }
225 {
226 var sgn?/eax: boolean <- string-equal? f-name, "sgn"
227 compare sgn?, 0/false
228 break-if-=
229 apply-sgn args-ah, out, trace
230 return
231 }
232 {
233 var car?/eax: boolean <- string-equal? f-name, "car"
234 compare car?, 0/false
235 break-if-=
236 apply-car args-ah, out, trace
237 return
238 }
239 {
240 var cdr?/eax: boolean <- string-equal? f-name, "cdr"
241 compare cdr?, 0/false
242 break-if-=
243 apply-cdr args-ah, out, trace
244 return
245 }
246 {
247 var cons?/eax: boolean <- string-equal? f-name, "cons"
248 compare cons?, 0/false
249 break-if-=
250 apply-cons args-ah, out, trace
251 return
252 }
253 {
254 var structurally-equal?/eax: boolean <- string-equal? f-name, "="
255 compare structurally-equal?, 0/false
256 break-if-=
257 apply-structurally-equal args-ah, out, trace
258 return
259 }
260 {
261 var not?/eax: boolean <- string-equal? f-name, "no"
262 compare not?, 0/false
263 break-if-=
264 apply-not args-ah, out, trace
265 return
266 }
267 {
268 var not?/eax: boolean <- string-equal? f-name, "not"
269 compare not?, 0/false
270 break-if-=
271 apply-not args-ah, out, trace
272 return
273 }
274 {
275 var debug?/eax: boolean <- string-equal? f-name, "dbg"
276 compare debug?, 0/false
277 break-if-=
278 apply-debug args-ah, out, trace
279 return
280 }
281 {
282 var lesser?/eax: boolean <- string-equal? f-name, "<"
283 compare lesser?, 0/false
284 break-if-=
285 apply-< args-ah, out, trace
286 return
287 }
288 {
289 var greater?/eax: boolean <- string-equal? f-name, ">"
290 compare greater?, 0/false
291 break-if-=
292 apply-> args-ah, out, trace
293 return
294 }
295 {
296 var lesser-or-equal?/eax: boolean <- string-equal? f-name, "<="
297 compare lesser-or-equal?, 0/false
298 break-if-=
299 apply-<= args-ah, out, trace
300 return
301 }
302 {
303 var greater-or-equal?/eax: boolean <- string-equal? f-name, ">="
304 compare greater-or-equal?, 0/false
305 break-if-=
306 apply->= args-ah, out, trace
307 return
308 }
309 {
310 var print?/eax: boolean <- string-equal? f-name, "print"
311 compare print?, 0/false
312 break-if-=
313 apply-print args-ah, out, trace
314 return
315 }
316 {
317 var clear?/eax: boolean <- string-equal? f-name, "clear"
318 compare clear?, 0/false
319 break-if-=
320 apply-clear args-ah, out, trace
321 return
322 }
323 {
324 var lines?/eax: boolean <- string-equal? f-name, "lines"
325 compare lines?, 0/false
326 break-if-=
327 apply-lines args-ah, out, trace
328 return
329 }
330 {
331 var columns?/eax: boolean <- string-equal? f-name, "columns"
332 compare columns?, 0/false
333 break-if-=
334 apply-columns args-ah, out, trace
335 return
336 }
337 {
338 var up?/eax: boolean <- string-equal? f-name, "up"
339 compare up?, 0/false
340 break-if-=
341 apply-up args-ah, out, trace
342 return
343 }
344 {
345 var down?/eax: boolean <- string-equal? f-name, "down"
346 compare down?, 0/false
347 break-if-=
348 apply-down args-ah, out, trace
349 return
350 }
351 {
352 var left?/eax: boolean <- string-equal? f-name, "left"
353 compare left?, 0/false
354 break-if-=
355 apply-left args-ah, out, trace
356 return
357 }
358 {
359 var right?/eax: boolean <- string-equal? f-name, "right"
360 compare right?, 0/false
361 break-if-=
362 apply-right args-ah, out, trace
363 return
364 }
365 {
366 var cr?/eax: boolean <- string-equal? f-name, "cr"
367 compare cr?, 0/false
368 break-if-=
369 apply-cr args-ah, out, trace
370 return
371 }
372 {
373 var pixel?/eax: boolean <- string-equal? f-name, "pixel"
374 compare pixel?, 0/false
375 break-if-=
376 apply-pixel args-ah, out, trace
377 return
378 }
379 {
380 var width?/eax: boolean <- string-equal? f-name, "width"
381 compare width?, 0/false
382 break-if-=
383 apply-width args-ah, out, trace
384 return
385 }
386 {
387 var height?/eax: boolean <- string-equal? f-name, "height"
388 compare height?, 0/false
389 break-if-=
390 apply-height args-ah, out, trace
391 return
392 }
393 {
394 var wait-for-key?/eax: boolean <- string-equal? f-name, "key"
395 compare wait-for-key?, 0/false
396 break-if-=
397 apply-wait-for-key args-ah, out, trace
398 return
399 }
400 {
401 var stream?/eax: boolean <- string-equal? f-name, "stream"
402 compare stream?, 0/false
403 break-if-=
404 apply-stream args-ah, out, trace
405 return
406 }
407 {
408 var write?/eax: boolean <- string-equal? f-name, "write"
409 compare write?, 0/false
410 break-if-=
411 apply-write args-ah, out, trace
412 return
413 }
414 {
415 var abort?/eax: boolean <- string-equal? f-name, "abort"
416 compare abort?, 0/false
417 break-if-=
418 apply-abort args-ah, out, trace
419 return
420 }
421 abort "unknown primitive function"
422 }
423
424 fn apply-add _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
425 trace-text trace, "eval", "apply +"
426 var args-ah/eax: (addr handle cell) <- copy _args-ah
427 var _args/eax: (addr cell) <- lookup *args-ah
428 var args/esi: (addr cell) <- copy _args
429 {
430 var args-type/ecx: (addr int) <- get args, type
431 compare *args-type, 0/pair
432 break-if-=
433 error trace, "args to + are not a list"
434 return
435 }
436 var empty-args?/eax: boolean <- nil? args
437 compare empty-args?, 0/false
438 {
439 break-if-=
440 error trace, "+ needs 2 args but got 0"
441 return
442 }
443
444 var first-ah/eax: (addr handle cell) <- get args, left
445 var first/eax: (addr cell) <- lookup *first-ah
446 var first-type/ecx: (addr int) <- get first, type
447 compare *first-type, 1/number
448 {
449 break-if-=
450 error trace, "first arg for + is not a number"
451 return
452 }
453 var first-value/ecx: (addr float) <- get first, number-data
454
455 var right-ah/eax: (addr handle cell) <- get args, right
456 var right/eax: (addr cell) <- lookup *right-ah
457 {
458 var right-type/ecx: (addr int) <- get right, type
459 compare *right-type, 0/pair
460 break-if-=
461 error trace, "+ encountered non-pair"
462 return
463 }
464 {
465 var nil?/eax: boolean <- nil? right
466 compare nil?, 0/false
467 break-if-=
468 error trace, "+ needs 2 args but got 1"
469 return
470 }
471 var second-ah/eax: (addr handle cell) <- get right, left
472 var second/eax: (addr cell) <- lookup *second-ah
473 var second-type/edx: (addr int) <- get second, type
474 compare *second-type, 1/number
475 {
476 break-if-=
477 error trace, "second arg for + is not a number"
478 return
479 }
480 var second-value/edx: (addr float) <- get second, number-data
481
482 var result/xmm0: float <- copy *first-value
483 result <- add *second-value
484 new-float out, result
485 }
486
487 fn test-evaluate-missing-arg-in-add {
488 var t-storage: trace
489 var t/edi: (addr trace) <- address t-storage
490 initialize-trace t, 0x100/max-depth, 0x100/capacity, 0/visible
491
492 var nil-storage: (handle cell)
493 var nil-ah/ecx: (addr handle cell) <- address nil-storage
494 allocate-pair nil-ah
495 var one-storage: (handle cell)
496 var one-ah/edx: (addr handle cell) <- address one-storage
497 new-integer one-ah, 1
498 var add-storage: (handle cell)
499 var add-ah/ebx: (addr handle cell) <- address add-storage
500 new-symbol add-ah, "+"
501
502 var tmp-storage: (handle cell)
503 var tmp-ah/esi: (addr handle cell) <- address tmp-storage
504 new-pair tmp-ah, *one-ah, *nil-ah
505 new-pair tmp-ah, *add-ah, *tmp-ah
506
507
508 var globals-storage: global-table
509 var globals/edx: (addr global-table) <- address globals-storage
510 initialize-globals globals
511
512 evaluate tmp-ah, tmp-ah, *nil-ah, globals, t, 0/no-screen, 0/no-keyboard, 0/definitions-created, 0/call-number
513
514 }
515
516 fn apply-subtract _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
517 trace-text trace, "eval", "apply -"
518 var args-ah/eax: (addr handle cell) <- copy _args-ah
519 var _args/eax: (addr cell) <- lookup *args-ah
520 var args/esi: (addr cell) <- copy _args
521 {
522 var args-type/ecx: (addr int) <- get args, type
523 compare *args-type, 0/pair
524 break-if-=
525 error trace, "args to - are not a list"
526 return
527 }
528 var empty-args?/eax: boolean <- nil? args
529 compare empty-args?, 0/false
530 {
531 break-if-=
532 error trace, "- needs 2 args but got 0"
533 return
534 }
535
536 var first-ah/eax: (addr handle cell) <- get args, left
537 var first/eax: (addr cell) <- lookup *first-ah
538 var first-type/ecx: (addr int) <- get first, type
539 compare *first-type, 1/number
540 {
541 break-if-=
542 error trace, "first arg for - is not a number"
543 return
544 }
545 var first-value/ecx: (addr float) <- get first, number-data
546
547 var right-ah/eax: (addr handle cell) <- get args, right
548 var right/eax: (addr cell) <- lookup *right-ah
549 {
550 var right-type/ecx: (addr int) <- get right, type
551 compare *right-type, 0/pair
552 break-if-=
553 error trace, "- encountered non-pair"
554 return
555 }
556 {
557 var nil?/eax: boolean <- nil? right
558 compare nil?, 0/false
559 break-if-=
560 error trace, "- needs 2 args but got 1"
561 return
562 }
563 var second-ah/eax: (addr handle cell) <- get right, left
564 var second/eax: (addr cell) <- lookup *second-ah
565 var second-type/edx: (addr int) <- get second, type
566 compare *second-type, 1/number
567 {
568 break-if-=
569 error trace, "second arg for - is not a number"
570 return
571 }
572 var second-value/edx: (addr float) <- get second, number-data
573
574 var result/xmm0: float <- copy *first-value
575 result <- subtract *second-value
576 new-float out, result
577 }
578
579 fn apply-multiply _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
580 trace-text trace, "eval", "apply *"
581 var args-ah/eax: (addr handle cell) <- copy _args-ah
582 var _args/eax: (addr cell) <- lookup *args-ah
583 var args/esi: (addr cell) <- copy _args
584 {
585 var args-type/ecx: (addr int) <- get args, type
586 compare *args-type, 0/pair
587 break-if-=
588 error trace, "args to * are not a list"
589 return
590 }
591 var empty-args?/eax: boolean <- nil? args
592 compare empty-args?, 0/false
593 {
594 break-if-=
595 error trace, "* needs 2 args but got 0"
596 return
597 }
598
599 var first-ah/eax: (addr handle cell) <- get args, left
600 var first/eax: (addr cell) <- lookup *first-ah
601 var first-type/ecx: (addr int) <- get first, type
602 compare *first-type, 1/number
603 {
604 break-if-=
605 error trace, "first arg for * is not a number"
606 return
607 }
608 var first-value/ecx: (addr float) <- get first, number-data
609
610 var right-ah/eax: (addr handle cell) <- get args, right
611 var right/eax: (addr cell) <- lookup *right-ah
612 {
613 var right-type/ecx: (addr int) <- get right, type
614 compare *right-type, 0/pair
615 break-if-=
616 error trace, "* encountered non-pair"
617 return
618 }
619 {
620 var nil?/eax: boolean <- nil? right
621 compare nil?, 0/false
622 break-if-=
623 error trace, "* needs 2 args but got 1"
624 return
625 }
626 var second-ah/eax: (addr handle cell) <- get right, left
627 var second/eax: (addr cell) <- lookup *second-ah
628 var second-type/edx: (addr int) <- get second, type
629 compare *second-type, 1/number
630 {
631 break-if-=
632 error trace, "second arg for * is not a number"
633 return
634 }
635 var second-value/edx: (addr float) <- get second, number-data
636
637 var result/xmm0: float <- copy *first-value
638 result <- multiply *second-value
639 new-float out, result
640 }
641
642 fn apply-divide _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
643 trace-text trace, "eval", "apply /"
644 var args-ah/eax: (addr handle cell) <- copy _args-ah
645 var _args/eax: (addr cell) <- lookup *args-ah
646 var args/esi: (addr cell) <- copy _args
647 {
648 var args-type/ecx: (addr int) <- get args, type
649 compare *args-type, 0/pair
650 break-if-=
651 error trace, "args to / are not a list"
652 return
653 }
654 var empty-args?/eax: boolean <- nil? args
655 compare empty-args?, 0/false
656 {
657 break-if-=
658 error trace, "/ needs 2 args but got 0"
659 return
660 }
661
662 var first-ah/eax: (addr handle cell) <- get args, left
663 var first/eax: (addr cell) <- lookup *first-ah
664 var first-type/ecx: (addr int) <- get first, type
665 compare *first-type, 1/number
666 {
667 break-if-=
668 error trace, "first arg for / is not a number"
669 return
670 }
671 var first-value/ecx: (addr float) <- get first, number-data
672
673 var right-ah/eax: (addr handle cell) <- get args, right
674 var right/eax: (addr cell) <- lookup *right-ah
675 {
676 var right-type/ecx: (addr int) <- get right, type
677 compare *right-type, 0/pair
678 break-if-=
679 error trace, "/ encountered non-pair"
680 return
681 }
682 {
683 var nil?/eax: boolean <- nil? right
684 compare nil?, 0/false
685 break-if-=
686 error trace, "/ needs 2 args but got 1"
687 return
688 }
689 var second-ah/eax: (addr handle cell) <- get right, left
690 var second/eax: (addr cell) <- lookup *second-ah
691 var second-type/edx: (addr int) <- get second, type
692 compare *second-type, 1/number
693 {
694 break-if-=
695 error trace, "second arg for / is not a number"
696 return
697 }
698 var second-value/edx: (addr float) <- get second, number-data
699
700 var result/xmm0: float <- copy *first-value
701 result <- divide *second-value
702 new-float out, result
703 }
704
705 fn apply-remainder _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
706 trace-text trace, "eval", "apply %"
707 var args-ah/eax: (addr handle cell) <- copy _args-ah
708 var _args/eax: (addr cell) <- lookup *args-ah
709 var args/esi: (addr cell) <- copy _args
710 {
711 var args-type/ecx: (addr int) <- get args, type
712 compare *args-type, 0/pair
713 break-if-=
714 error trace, "args to % are not a list"
715 return
716 }
717 var empty-args?/eax: boolean <- nil? args
718 compare empty-args?, 0/false
719 {
720 break-if-=
721 error trace, "% needs 2 args but got 0"
722 return
723 }
724
725 var first-ah/eax: (addr handle cell) <- get args, left
726 var first/eax: (addr cell) <- lookup *first-ah
727 var first-type/ecx: (addr int) <- get first, type
728 compare *first-type, 1/number
729 {
730 break-if-=
731 error trace, "first arg for % is not a number"
732 return
733 }
734 var first-value/ecx: (addr float) <- get first, number-data
735
736 var right-ah/eax: (addr handle cell) <- get args, right
737 var right/eax: (addr cell) <- lookup *right-ah
738 {
739 var right-type/ecx: (addr int) <- get right, type
740 compare *right-type, 0/pair
741 break-if-=
742 error trace, "% encountered non-pair"
743 return
744 }
745 {
746 var nil?/eax: boolean <- nil? right
747 compare nil?, 0/false
748 break-if-=
749 error trace, "% needs 2 args but got 1"
750 return
751 }
752 var second-ah/eax: (addr handle cell) <- get right, left
753 var second/eax: (addr cell) <- lookup *second-ah
754 var second-type/edx: (addr int) <- get second, type
755 compare *second-type, 1/number
756 {
757 break-if-=
758 error trace, "second arg for % is not a number"
759 return
760 }
761 var second-value/edx: (addr float) <- get second, number-data
762
763 var quotient/xmm0: float <- copy *first-value
764 quotient <- divide *second-value
765 var quotient-int/eax: int <- truncate quotient
766 quotient <- convert quotient-int
767 var sub-result/xmm1: float <- copy quotient
768 sub-result <- multiply *second-value
769 var result/xmm0: float <- copy *first-value
770 result <- subtract sub-result
771 new-float out, result
772 }
773
774 fn apply-square-root _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
775 trace-text trace, "eval", "apply sqrt"
776 var args-ah/eax: (addr handle cell) <- copy _args-ah
777 var _args/eax: (addr cell) <- lookup *args-ah
778 var args/esi: (addr cell) <- copy _args
779 {
780 var args-type/ecx: (addr int) <- get args, type
781 compare *args-type, 0/pair
782 break-if-=
783 error trace, "args to sqrt are not a list"
784 return
785 }
786 var empty-args?/eax: boolean <- nil? args
787 compare empty-args?, 0/false
788 {
789 break-if-=
790 error trace, "sqrt needs 1 arg but got 0"
791 return
792 }
793
794 var first-ah/eax: (addr handle cell) <- get args, left
795 var first/eax: (addr cell) <- lookup *first-ah
796 var first-type/ecx: (addr int) <- get first, type
797 compare *first-type, 1/number
798 {
799 break-if-=
800 error trace, "arg for sqrt is not a number"
801 return
802 }
803 var first-value/ecx: (addr float) <- get first, number-data
804
805 var result/xmm0: float <- square-root *first-value
806 new-float out, result
807 }
808
809 fn apply-abs _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
810 trace-text trace, "eval", "apply abs"
811 var args-ah/eax: (addr handle cell) <- copy _args-ah
812 var _args/eax: (addr cell) <- lookup *args-ah
813 var args/esi: (addr cell) <- copy _args
814 {
815 var args-type/ecx: (addr int) <- get args, type
816 compare *args-type, 0/pair
817 break-if-=
818 error trace, "args to abs are not a list"
819 return
820 }
821 var empty-args?/eax: boolean <- nil? args
822 compare empty-args?, 0/false
823 {
824 break-if-=
825 error trace, "abs needs 1 arg but got 0"
826 return
827 }
828
829 var first-ah/eax: (addr handle cell) <- get args, left
830 var first/eax: (addr cell) <- lookup *first-ah
831 var first-type/ecx: (addr int) <- get first, type
832 compare *first-type, 1/number
833 {
834 break-if-=
835 error trace, "arg for abs is not a number"
836 return
837 }
838 var first-value/ecx: (addr float) <- get first, number-data
839
840 var result/xmm0: float <- copy *first-value
841 var zero: float
842 compare result, zero
843 {
844 break-if-float>=
845 var neg1/eax: int <- copy -1
846 var neg1-f/xmm1: float <- convert neg1
847 result <- multiply neg1-f
848 }
849 new-float out, result
850 }
851
852 fn apply-sgn _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
853 trace-text trace, "eval", "apply sgn"
854 var args-ah/eax: (addr handle cell) <- copy _args-ah
855 var _args/eax: (addr cell) <- lookup *args-ah
856 var args/esi: (addr cell) <- copy _args
857 {
858 var args-type/ecx: (addr int) <- get args, type
859 compare *args-type, 0/pair
860 break-if-=
861 error trace, "args to sgn are not a list"
862 return
863 }
864 var empty-args?/eax: boolean <- nil? args
865 compare empty-args?, 0/false
866 {
867 break-if-=
868 error trace, "sgn needs 1 arg but got 0"
869 return
870 }
871
872 var first-ah/eax: (addr handle cell) <- get args, left
873 var first/eax: (addr cell) <- lookup *first-ah
874 var first-type/ecx: (addr int) <- get first, type
875 compare *first-type, 1/number
876 {
877 break-if-=
878 error trace, "arg for sgn is not a number"
879 return
880 }
881 var first-value/ecx: (addr float) <- get first, number-data
882
883 var result/xmm0: float <- copy *first-value
884 var zero: float
885 $apply-sgn:core: {
886 compare result, zero
887 break-if-=
888 {
889 break-if-float>
890 var neg1/eax: int <- copy -1
891 result <- convert neg1
892 break $apply-sgn:core
893 }
894 {
895 break-if-float<
896 var one/eax: int <- copy 1
897 result <- convert one
898 break $apply-sgn:core
899 }
900 }
901 new-float out, result
902 }
903
904 fn apply-car _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
905 trace-text trace, "eval", "apply car"
906 var args-ah/eax: (addr handle cell) <- copy _args-ah
907 var _args/eax: (addr cell) <- lookup *args-ah
908 var args/esi: (addr cell) <- copy _args
909 {
910 var args-type/ecx: (addr int) <- get args, type
911 compare *args-type, 0/pair
912 break-if-=
913 error trace, "args to car are not a list"
914 return
915 }
916 var empty-args?/eax: boolean <- nil? args
917 compare empty-args?, 0/false
918 {
919 break-if-=
920 error trace, "car needs 1 arg but got 0"
921 return
922 }
923
924 var first-ah/edx: (addr handle cell) <- get args, left
925 var first/eax: (addr cell) <- lookup *first-ah
926 var first-type/ecx: (addr int) <- get first, type
927 compare *first-type, 0/pair
928 {
929 break-if-=
930 error trace, "arg for car is not a pair"
931 return
932 }
933
934 {
935 var nil?/eax: boolean <- nil? first
936 compare nil?, 0/false
937 break-if-=
938 copy-object first-ah, out
939 return
940 }
941
942 var result/eax: (addr handle cell) <- get first, left
943 copy-object result, out
944 }
945
946 fn apply-cdr _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
947 trace-text trace, "eval", "apply cdr"
948 var args-ah/eax: (addr handle cell) <- copy _args-ah
949 var _args/eax: (addr cell) <- lookup *args-ah
950 var args/esi: (addr cell) <- copy _args
951 {
952 var args-type/ecx: (addr int) <- get args, type
953 compare *args-type, 0/pair
954 break-if-=
955 error trace, "args to cdr are not a list"
956 return
957 }
958 var empty-args?/eax: boolean <- nil? args
959 compare empty-args?, 0/false
960 {
961 break-if-=
962 error trace, "cdr needs 1 arg but got 0"
963 return
964 }
965
966 var first-ah/edx: (addr handle cell) <- get args, left
967 var first/eax: (addr cell) <- lookup *first-ah
968 var first-type/ecx: (addr int) <- get first, type
969 compare *first-type, 0/pair
970 {
971 break-if-=
972 error trace, "arg for cdr is not a pair"
973 return
974 }
975
976 {
977 var nil?/eax: boolean <- nil? first
978 compare nil?, 0/false
979 break-if-=
980 copy-object first-ah, out
981 return
982 }
983
984 var result/eax: (addr handle cell) <- get first, right
985 copy-object result, out
986 }
987
988 fn apply-cons _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
989 trace-text trace, "eval", "apply cons"
990 var args-ah/eax: (addr handle cell) <- copy _args-ah
991 var _args/eax: (addr cell) <- lookup *args-ah
992 var args/esi: (addr cell) <- copy _args
993 {
994 var args-type/ecx: (addr int) <- get args, type
995 compare *args-type, 0/pair
996 break-if-=
997 error trace, "args to 'cons' are not a list"
998 return
999 }
1000 var empty-args?/eax: boolean <- nil? args
1001 compare empty-args?, 0/false
1002 {
1003 break-if-=
1004 error trace, "cons needs 2 args but got 0"
1005 return
1006 }
1007
1008 var first-ah/ecx: (addr handle cell) <- get args, left
1009
1010 var right-ah/eax: (addr handle cell) <- get args, right
1011 var right/eax: (addr cell) <- lookup *right-ah
1012 {
1013 var right-type/ecx: (addr int) <- get right, type
1014 compare *right-type, 0/pair
1015 break-if-=
1016 error trace, "'cons' encountered non-pair"
1017 return
1018 }
1019 {
1020 var nil?/eax: boolean <- nil? right
1021 compare nil?, 0/false
1022 break-if-=
1023 error trace, "'cons' needs 2 args but got 1"
1024 return
1025 }
1026 var second-ah/eax: (addr handle cell) <- get right, left
1027
1028 new-pair out, *first-ah, *second-ah
1029 }
1030
1031 fn apply-structurally-equal _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1032 trace-text trace, "eval", "apply '='"
1033 var args-ah/eax: (addr handle cell) <- copy _args-ah
1034 var _args/eax: (addr cell) <- lookup *args-ah
1035 var args/esi: (addr cell) <- copy _args
1036 {
1037 var args-type/ecx: (addr int) <- get args, type
1038 compare *args-type, 0/pair
1039 break-if-=
1040 error trace, "args to '=' are not a list"
1041 return
1042 }
1043 var empty-args?/eax: boolean <- nil? args
1044 compare empty-args?, 0/false
1045 {
1046 break-if-=
1047 error trace, "'=' needs 2 args but got 0"
1048 return
1049 }
1050
1051 var first-ah/ecx: (addr handle cell) <- get args, left
1052
1053 var right-ah/eax: (addr handle cell) <- get args, right
1054 var right/eax: (addr cell) <- lookup *right-ah
1055 {
1056 var right-type/ecx: (addr int) <- get right, type
1057 compare *right-type, 0/pair
1058 break-if-=
1059 error trace, "'=' encountered non-pair"
1060 return
1061 }
1062 {
1063 var nil?/eax: boolean <- nil? right
1064 compare nil?, 0/false
1065 break-if-=
1066 error trace, "'=' needs 2 args but got 1"
1067 return
1068 }
1069 var second-ah/edx: (addr handle cell) <- get right, left
1070
1071 var _first/eax: (addr cell) <- lookup *first-ah
1072 var first/ecx: (addr cell) <- copy _first
1073 var second/eax: (addr cell) <- lookup *second-ah
1074 var match?/eax: boolean <- cell-isomorphic? first, second, trace
1075 compare match?, 0/false
1076 {
1077 break-if-!=
1078 nil out
1079 return
1080 }
1081 new-integer out, 1/true
1082 }
1083
1084 fn apply-not _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1085 trace-text trace, "eval", "apply 'not'"
1086 var args-ah/eax: (addr handle cell) <- copy _args-ah
1087 var _args/eax: (addr cell) <- lookup *args-ah
1088 var args/esi: (addr cell) <- copy _args
1089 {
1090 var args-type/ecx: (addr int) <- get args, type
1091 compare *args-type, 0/pair
1092 break-if-=
1093 error trace, "args to 'not' are not a list"
1094 return
1095 }
1096 var empty-args?/eax: boolean <- nil? args
1097 compare empty-args?, 0/false
1098 {
1099 break-if-=
1100 error trace, "'not' needs 1 arg but got 0"
1101 return
1102 }
1103
1104 var first-ah/eax: (addr handle cell) <- get args, left
1105 var first/eax: (addr cell) <- lookup *first-ah
1106
1107 var nil?/eax: boolean <- nil? first
1108 compare nil?, 0/false
1109 {
1110 break-if-!=
1111 nil out
1112 return
1113 }
1114 new-integer out, 1
1115 }
1116
1117 fn apply-debug _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1118 trace-text trace, "eval", "apply 'debug'"
1119 var args-ah/eax: (addr handle cell) <- copy _args-ah
1120 var _args/eax: (addr cell) <- lookup *args-ah
1121 var args/esi: (addr cell) <- copy _args
1122 {
1123 var args-type/ecx: (addr int) <- get args, type
1124 compare *args-type, 0/pair
1125 break-if-=
1126 error trace, "args to 'debug' are not a list"
1127 return
1128 }
1129 var empty-args?/eax: boolean <- nil? args
1130 compare empty-args?, 0/false
1131 {
1132 break-if-=
1133 error trace, "'debug' needs 1 arg but got 0"
1134 return
1135 }
1136
1137 var first-ah/eax: (addr handle cell) <- get args, left
1138 dump-cell-from-cursor-over-full-screen first-ah, 7/fg 0/bg
1139 {
1140 var foo/eax: byte <- read-key 0/keyboard
1141 compare foo, 0
1142 loop-if-=
1143 }
1144
1145 }
1146
1147 fn apply-< _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1148 trace-text trace, "eval", "apply '<'"
1149 var args-ah/eax: (addr handle cell) <- copy _args-ah
1150 var _args/eax: (addr cell) <- lookup *args-ah
1151 var args/esi: (addr cell) <- copy _args
1152 {
1153 var args-type/ecx: (addr int) <- get args, type
1154 compare *args-type, 0/pair
1155 break-if-=
1156 error trace, "args to '<' are not a list"
1157 return
1158 }
1159 var empty-args?/eax: boolean <- nil? args
1160 compare empty-args?, 0/false
1161 {
1162 break-if-=
1163 error trace, "'<' needs 2 args but got 0"
1164 return
1165 }
1166
1167 var first-ah/ecx: (addr handle cell) <- get args, left
1168
1169 var right-ah/eax: (addr handle cell) <- get args, right
1170 var right/eax: (addr cell) <- lookup *right-ah
1171 {
1172 var right-type/ecx: (addr int) <- get right, type
1173 compare *right-type, 0/pair
1174 break-if-=
1175 error trace, "'<' encountered non-pair"
1176 return
1177 }
1178 {
1179 var nil?/eax: boolean <- nil? right
1180 compare nil?, 0/false
1181 break-if-=
1182 error trace, "'<' needs 2 args but got 1"
1183 return
1184 }
1185 var second-ah/edx: (addr handle cell) <- get right, left
1186
1187 var _first/eax: (addr cell) <- lookup *first-ah
1188 var first/ecx: (addr cell) <- copy _first
1189 var first-type/eax: (addr int) <- get first, type
1190 compare *first-type, 1/number
1191 {
1192 break-if-=
1193 error trace, "first arg for '<' is not a number"
1194 return
1195 }
1196 var first-value/ecx: (addr float) <- get first, number-data
1197 var first-float/xmm0: float <- copy *first-value
1198 var second/eax: (addr cell) <- lookup *second-ah
1199 var second-type/edx: (addr int) <- get second, type
1200 compare *second-type, 1/number
1201 {
1202 break-if-=
1203 error trace, "second arg for '<' is not a number"
1204 return
1205 }
1206 var second-value/eax: (addr float) <- get second, number-data
1207 compare first-float, *second-value
1208 {
1209 break-if-float<
1210 nil out
1211 return
1212 }
1213 new-integer out, 1/true
1214 }
1215
1216 fn apply-> _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1217 trace-text trace, "eval", "apply '>'"
1218 var args-ah/eax: (addr handle cell) <- copy _args-ah
1219 var _args/eax: (addr cell) <- lookup *args-ah
1220 var args/esi: (addr cell) <- copy _args
1221 {
1222 var args-type/ecx: (addr int) <- get args, type
1223 compare *args-type, 0/pair
1224 break-if-=
1225 error trace, "args to '>' are not a list"
1226 return
1227 }
1228 var empty-args?/eax: boolean <- nil? args
1229 compare empty-args?, 0/false
1230 {
1231 break-if-=
1232 error trace, "'>' needs 2 args but got 0"
1233 return
1234 }
1235
1236 var first-ah/ecx: (addr handle cell) <- get args, left
1237
1238 var right-ah/eax: (addr handle cell) <- get args, right
1239 var right/eax: (addr cell) <- lookup *right-ah
1240 {
1241 var right-type/ecx: (addr int) <- get right, type
1242 compare *right-type, 0/pair
1243 break-if-=
1244 error trace, "'>' encountered non-pair"
1245 return
1246 }
1247 {
1248 var nil?/eax: boolean <- nil? right
1249 compare nil?, 0/false
1250 break-if-=
1251 error trace, "'>' needs 2 args but got 1"
1252 return
1253 }
1254 var second-ah/edx: (addr handle cell) <- get right, left
1255
1256 var _first/eax: (addr cell) <- lookup *first-ah
1257 var first/ecx: (addr cell) <- copy _first
1258 var first-type/eax: (addr int) <- get first, type
1259 compare *first-type, 1/number
1260 {
1261 break-if-=
1262 error trace, "first arg for '>' is not a number"
1263 return
1264 }
1265 var first-value/ecx: (addr float) <- get first, number-data
1266 var first-float/xmm0: float <- copy *first-value
1267 var second/eax: (addr cell) <- lookup *second-ah
1268 var second-type/edx: (addr int) <- get second, type
1269 compare *second-type, 1/number
1270 {
1271 break-if-=
1272 error trace, "second arg for '>' is not a number"
1273 return
1274 }
1275 var second-value/eax: (addr float) <- get second, number-data
1276 compare first-float, *second-value
1277 {
1278 break-if-float>
1279 nil out
1280 return
1281 }
1282 new-integer out, 1/true
1283 }
1284
1285 fn apply-<= _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1286 trace-text trace, "eval", "apply '<='"
1287 var args-ah/eax: (addr handle cell) <- copy _args-ah
1288 var _args/eax: (addr cell) <- lookup *args-ah
1289 var args/esi: (addr cell) <- copy _args
1290 {
1291 var args-type/ecx: (addr int) <- get args, type
1292 compare *args-type, 0/pair
1293 break-if-=
1294 error trace, "args to '<=' are not a list"
1295 return
1296 }
1297 var empty-args?/eax: boolean <- nil? args
1298 compare empty-args?, 0/false
1299 {
1300 break-if-=
1301 error trace, "'<=' needs 2 args but got 0"
1302 return
1303 }
1304
1305 var first-ah/ecx: (addr handle cell) <- get args, left
1306
1307 var right-ah/eax: (addr handle cell) <- get args, right
1308 var right/eax: (addr cell) <- lookup *right-ah
1309 {
1310 var right-type/ecx: (addr int) <- get right, type
1311 compare *right-type, 0/pair
1312 break-if-=
1313 error trace, "'<=' encountered non-pair"
1314 return
1315 }
1316 {
1317 var nil?/eax: boolean <- nil? right
1318 compare nil?, 0/false
1319 break-if-=
1320 error trace, "'<=' needs 2 args but got 1"
1321 return
1322 }
1323 var second-ah/edx: (addr handle cell) <- get right, left
1324
1325 var _first/eax: (addr cell) <- lookup *first-ah
1326 var first/ecx: (addr cell) <- copy _first
1327 var first-type/eax: (addr int) <- get first, type
1328 compare *first-type, 1/number
1329 {
1330 break-if-=
1331 error trace, "first arg for '<=' is not a number"
1332 return
1333 }
1334 var first-value/ecx: (addr float) <- get first, number-data
1335 var first-float/xmm0: float <- copy *first-value
1336 var second/eax: (addr cell) <- lookup *second-ah
1337 var second-type/edx: (addr int) <- get second, type
1338 compare *second-type, 1/number
1339 {
1340 break-if-=
1341 error trace, "second arg for '<=' is not a number"
1342 return
1343 }
1344 var second-value/eax: (addr float) <- get second, number-data
1345 compare first-float, *second-value
1346 {
1347 break-if-float<=
1348 nil out
1349 return
1350 }
1351 new-integer out, 1/true
1352 }
1353
1354 fn apply->= _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1355 trace-text trace, "eval", "apply '>='"
1356 var args-ah/eax: (addr handle cell) <- copy _args-ah
1357 var _args/eax: (addr cell) <- lookup *args-ah
1358 var args/esi: (addr cell) <- copy _args
1359 {
1360 var args-type/ecx: (addr int) <- get args, type
1361 compare *args-type, 0/pair
1362 break-if-=
1363 error trace, "args to '>=' are not a list"
1364 return
1365 }
1366 var empty-args?/eax: boolean <- nil? args
1367 compare empty-args?, 0/false
1368 {
1369 break-if-=
1370 error trace, "'>=' needs 2 args but got 0"
1371 return
1372 }
1373
1374 var first-ah/ecx: (addr handle cell) <- get args, left
1375
1376 var right-ah/eax: (addr handle cell) <- get args, right
1377 var right/eax: (addr cell) <- lookup *right-ah
1378 {
1379 var right-type/ecx: (addr int) <- get right, type
1380 compare *right-type, 0/pair
1381 break-if-=
1382 error trace, "'>=' encountered non-pair"
1383 return
1384 }
1385 {
1386 var nil?/eax: boolean <- nil? right
1387 compare nil?, 0/false
1388 break-if-=
1389 error trace, "'>=' needs 2 args but got 1"
1390 return
1391 }
1392 var second-ah/edx: (addr handle cell) <- get right, left
1393
1394 var _first/eax: (addr cell) <- lookup *first-ah
1395 var first/ecx: (addr cell) <- copy _first
1396 var first-type/eax: (addr int) <- get first, type
1397 compare *first-type, 1/number
1398 {
1399 break-if-=
1400 error trace, "first arg for '>=' is not a number"
1401 return
1402 }
1403 var first-value/ecx: (addr float) <- get first, number-data
1404 var first-float/xmm0: float <- copy *first-value
1405 var second/eax: (addr cell) <- lookup *second-ah
1406 var second-type/edx: (addr int) <- get second, type
1407 compare *second-type, 1/number
1408 {
1409 break-if-=
1410 error trace, "second arg for '>=' is not a number"
1411 return
1412 }
1413 var second-value/eax: (addr float) <- get second, number-data
1414 compare first-float, *second-value
1415 {
1416 break-if-float>=
1417 nil out
1418 return
1419 }
1420 new-integer out, 1/true
1421 }
1422
1423 fn apply-print _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1424 trace-text trace, "eval", "apply 'print'"
1425 var args-ah/eax: (addr handle cell) <- copy _args-ah
1426 var _args/eax: (addr cell) <- lookup *args-ah
1427 var args/esi: (addr cell) <- copy _args
1428 {
1429 var args-type/ecx: (addr int) <- get args, type
1430 compare *args-type, 0/pair
1431 break-if-=
1432 error trace, "args to 'print' are not a list"
1433 return
1434 }
1435 var empty-args?/eax: boolean <- nil? args
1436 compare empty-args?, 0/false
1437 {
1438 break-if-=
1439 error trace, "'print' needs 2 args but got 0"
1440 return
1441 }
1442
1443 var first-ah/eax: (addr handle cell) <- get args, left
1444 var first/eax: (addr cell) <- lookup *first-ah
1445 var first-type/ecx: (addr int) <- get first, type
1446 compare *first-type, 5/screen
1447 {
1448 break-if-=
1449 error trace, "first arg for 'print' is not a screen"
1450 return
1451 }
1452 var screen-ah/eax: (addr handle screen) <- get first, screen-data
1453 var _screen/eax: (addr screen) <- lookup *screen-ah
1454 var screen/ecx: (addr screen) <- copy _screen
1455
1456 var right-ah/eax: (addr handle cell) <- get args, right
1457 var right/eax: (addr cell) <- lookup *right-ah
1458 {
1459 var right-type/ecx: (addr int) <- get right, type
1460 compare *right-type, 0/pair
1461 break-if-=
1462 error trace, "'print' encountered non-pair"
1463 return
1464 }
1465 {
1466 var nil?/eax: boolean <- nil? right
1467 compare nil?, 0/false
1468 break-if-=
1469 error trace, "'print' needs 2 args but got 1"
1470 return
1471 }
1472 var second-ah/eax: (addr handle cell) <- get right, left
1473 var stream-storage: (stream byte 0x100)
1474 var stream/edi: (addr stream byte) <- address stream-storage
1475 print-cell second-ah, stream, trace
1476 draw-stream-wrapping-right-then-down-from-cursor-over-full-screen screen, stream, 7/fg, 0/bg
1477
1478 copy-object second-ah, out
1479 }
1480
1481 fn apply-clear _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1482 trace-text trace, "eval", "apply 'clear'"
1483 var args-ah/eax: (addr handle cell) <- copy _args-ah
1484 var _args/eax: (addr cell) <- lookup *args-ah
1485 var args/esi: (addr cell) <- copy _args
1486 {
1487 var args-type/ecx: (addr int) <- get args, type
1488 compare *args-type, 0/pair
1489 break-if-=
1490 error trace, "args to 'clear' are not a list"
1491 return
1492 }
1493 var empty-args?/eax: boolean <- nil? args
1494 compare empty-args?, 0/false
1495 {
1496 break-if-=
1497 error trace, "'clear' needs 1 arg but got 0"
1498 return
1499 }
1500
1501 var first-ah/eax: (addr handle cell) <- get args, left
1502 var first/eax: (addr cell) <- lookup *first-ah
1503 var first-type/ecx: (addr int) <- get first, type
1504 compare *first-type, 5/screen
1505 {
1506 break-if-=
1507 error trace, "first arg for 'clear' is not a screen"
1508 return
1509 }
1510 var screen-ah/eax: (addr handle screen) <- get first, screen-data
1511 var _screen/eax: (addr screen) <- lookup *screen-ah
1512 var screen/ecx: (addr screen) <- copy _screen
1513
1514 clear-screen screen
1515 }
1516
1517 fn apply-up _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1518 trace-text trace, "eval", "apply 'up'"
1519 var args-ah/eax: (addr handle cell) <- copy _args-ah
1520 var _args/eax: (addr cell) <- lookup *args-ah
1521 var args/esi: (addr cell) <- copy _args
1522 {
1523 var args-type/ecx: (addr int) <- get args, type
1524 compare *args-type, 0/pair
1525 break-if-=
1526 error trace, "args to 'up' are not a list"
1527 return
1528 }
1529 var empty-args?/eax: boolean <- nil? args
1530 compare empty-args?, 0/false
1531 {
1532 break-if-=
1533 error trace, "'up' needs 1 arg but got 0"
1534 return
1535 }
1536
1537 var first-ah/eax: (addr handle cell) <- get args, left
1538 var first/eax: (addr cell) <- lookup *first-ah
1539 var first-type/ecx: (addr int) <- get first, type
1540 compare *first-type, 5/screen
1541 {
1542 break-if-=
1543 error trace, "first arg for 'up' is not a screen"
1544 return
1545 }
1546 var screen-ah/eax: (addr handle screen) <- get first, screen-data
1547 var _screen/eax: (addr screen) <- lookup *screen-ah
1548 var screen/ecx: (addr screen) <- copy _screen
1549
1550 move-cursor-up screen
1551 }
1552
1553 fn apply-down _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1554 trace-text trace, "eval", "apply 'down'"
1555 var args-ah/eax: (addr handle cell) <- copy _args-ah
1556 var _args/eax: (addr cell) <- lookup *args-ah
1557 var args/esi: (addr cell) <- copy _args
1558 {
1559 var args-type/ecx: (addr int) <- get args, type
1560 compare *args-type, 0/pair
1561 break-if-=
1562 error trace, "args to 'down' are not a list"
1563 return
1564 }
1565 var empty-args?/eax: boolean <- nil? args
1566 compare empty-args?, 0/false
1567 {
1568 break-if-=
1569 error trace, "'down' needs 1 arg but got 0"
1570 return
1571 }
1572
1573 var first-ah/eax: (addr handle cell) <- get args, left
1574 var first/eax: (addr cell) <- lookup *first-ah
1575 var first-type/ecx: (addr int) <- get first, type
1576 compare *first-type, 5/screen
1577 {
1578 break-if-=
1579 error trace, "first arg for 'down' is not a screen"
1580 return
1581 }
1582 var screen-ah/eax: (addr handle screen) <- get first, screen-data
1583 var _screen/eax: (addr screen) <- lookup *screen-ah
1584 var screen/ecx: (addr screen) <- copy _screen
1585
1586 move-cursor-down screen
1587 }
1588
1589 fn apply-left _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1590 trace-text trace, "eval", "apply 'left'"
1591 var args-ah/eax: (addr handle cell) <- copy _args-ah
1592 var _args/eax: (addr cell) <- lookup *args-ah
1593 var args/esi: (addr cell) <- copy _args
1594 {
1595 var args-type/ecx: (addr int) <- get args, type
1596 compare *args-type, 0/pair
1597 break-if-=
1598 error trace, "args to 'left' are not a list"
1599 return
1600 }
1601 var empty-args?/eax: boolean <- nil? args
1602 compare empty-args?, 0/false
1603 {
1604 break-if-=
1605 error trace, "'left' needs 1 arg but got 0"
1606 return
1607 }
1608
1609 var first-ah/eax: (addr handle cell) <- get args, left
1610 var first/eax: (addr cell) <- lookup *first-ah
1611 var first-type/ecx: (addr int) <- get first, type
1612 compare *first-type, 5/screen
1613 {
1614 break-if-=
1615 error trace, "first arg for 'left' is not a screen"
1616 return
1617 }
1618 var screen-ah/eax: (addr handle screen) <- get first, screen-data
1619 var _screen/eax: (addr screen) <- lookup *screen-ah
1620 var screen/ecx: (addr screen) <- copy _screen
1621
1622 move-cursor-left screen
1623 }
1624
1625 fn apply-right _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1626 trace-text trace, "eval", "apply 'right'"
1627 var args-ah/eax: (addr handle cell) <- copy _args-ah
1628 var _args/eax: (addr cell) <- lookup *args-ah
1629 var args/esi: (addr cell) <- copy _args
1630 {
1631 var args-type/ecx: (addr int) <- get args, type
1632 compare *args-type, 0/pair
1633 break-if-=
1634 error trace, "args to 'right' are not a list"
1635 return
1636 }
1637 var empty-args?/eax: boolean <- nil? args
1638 compare empty-args?, 0/false
1639 {
1640 break-if-=
1641 error trace, "'right' needs 1 arg but got 0"
1642 return
1643 }
1644
1645 var first-ah/eax: (addr handle cell) <- get args, left
1646 var first/eax: (addr cell) <- lookup *first-ah
1647 var first-type/ecx: (addr int) <- get first, type
1648 compare *first-type, 5/screen
1649 {
1650 break-if-=
1651 error trace, "first arg for 'right' is not a screen"
1652 return
1653 }
1654 var screen-ah/eax: (addr handle screen) <- get first, screen-data
1655 var _screen/eax: (addr screen) <- lookup *screen-ah
1656 var screen/ecx: (addr screen) <- copy _screen
1657
1658 move-cursor-right screen
1659 }
1660
1661 fn apply-cr _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1662 trace-text trace, "eval", "apply 'cr'"
1663 var args-ah/eax: (addr handle cell) <- copy _args-ah
1664 var _args/eax: (addr cell) <- lookup *args-ah
1665 var args/esi: (addr cell) <- copy _args
1666 {
1667 var args-type/ecx: (addr int) <- get args, type
1668 compare *args-type, 0/pair
1669 break-if-=
1670 error trace, "args to 'cr' are not a list"
1671 return
1672 }
1673 var empty-args?/eax: boolean <- nil? args
1674 compare empty-args?, 0/false
1675 {
1676 break-if-=
1677 error trace, "'cr' needs 1 arg but got 0"
1678 return
1679 }
1680
1681 var first-ah/eax: (addr handle cell) <- get args, left
1682 var first/eax: (addr cell) <- lookup *first-ah
1683 var first-type/ecx: (addr int) <- get first, type
1684 compare *first-type, 5/screen
1685 {
1686 break-if-=
1687 error trace, "first arg for 'cr' is not a screen"
1688 return
1689 }
1690 var screen-ah/eax: (addr handle screen) <- get first, screen-data
1691 var _screen/eax: (addr screen) <- lookup *screen-ah
1692 var screen/ecx: (addr screen) <- copy _screen
1693
1694 move-cursor-to-left-margin-of-next-line screen
1695 }
1696
1697 fn apply-pixel _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1698 trace-text trace, "eval", "apply 'pixel'"
1699 var args-ah/eax: (addr handle cell) <- copy _args-ah
1700 var _args/eax: (addr cell) <- lookup *args-ah
1701 var args/esi: (addr cell) <- copy _args
1702 {
1703 var args-type/ecx: (addr int) <- get args, type
1704 compare *args-type, 0/pair
1705 break-if-=
1706 error trace, "args to 'pixel' are not a list"
1707 return
1708 }
1709 var empty-args?/eax: boolean <- nil? args
1710 compare empty-args?, 0/false
1711 {
1712 break-if-=
1713 error trace, "'pixel' needs 4 args but got 0"
1714 return
1715 }
1716
1717 var first-ah/eax: (addr handle cell) <- get args, left
1718 var first/eax: (addr cell) <- lookup *first-ah
1719 var first-type/ecx: (addr int) <- get first, type
1720 compare *first-type, 5/screen
1721 {
1722 break-if-=
1723 error trace, "first arg for 'pixel' is not a screen"
1724 return
1725 }
1726 var screen-ah/eax: (addr handle screen) <- get first, screen-data
1727 var _screen/eax: (addr screen) <- lookup *screen-ah
1728 var screen/edi: (addr screen) <- copy _screen
1729
1730 var rest-ah/eax: (addr handle cell) <- get args, right
1731 var _rest/eax: (addr cell) <- lookup *rest-ah
1732 var rest/esi: (addr cell) <- copy _rest
1733 {
1734 var rest-type/ecx: (addr int) <- get rest, type
1735 compare *rest-type, 0/pair
1736 break-if-=
1737 error trace, "'pixel' encountered non-pair"
1738 return
1739 }
1740 {
1741 var rest-nil?/eax: boolean <- nil? rest
1742 compare rest-nil?, 0/false
1743 break-if-=
1744 error trace, "'pixel' needs 4 args but got 1"
1745 return
1746 }
1747 var second-ah/eax: (addr handle cell) <- get rest, left
1748 var second/eax: (addr cell) <- lookup *second-ah
1749 var second-type/ecx: (addr int) <- get second, type
1750 compare *second-type, 1/number
1751 {
1752 break-if-=
1753 error trace, "second arg for 'pixel' is not an int (x coordinate)"
1754 return
1755 }
1756 var second-value/eax: (addr float) <- get second, number-data
1757 var x/edx: int <- convert *second-value
1758
1759 var rest-ah/eax: (addr handle cell) <- get rest, right
1760 var _rest/eax: (addr cell) <- lookup *rest-ah
1761 rest <- copy _rest
1762 {
1763 var rest-type/ecx: (addr int) <- get rest, type
1764 compare *rest-type, 0/pair
1765 break-if-=
1766 error trace, "'pixel' encountered non-pair"
1767 return
1768 }
1769 {
1770 var rest-nil?/eax: boolean <- nil? rest
1771 compare rest-nil?, 0/false
1772 break-if-=
1773 error trace, "'pixel' needs 4 args but got 2"
1774 return
1775 }
1776 var third-ah/eax: (addr handle cell) <- get rest, left
1777 var third/eax: (addr cell) <- lookup *third-ah
1778 var third-type/ecx: (addr int) <- get third, type
1779 compare *third-type, 1/number
1780 {
1781 break-if-=
1782 error trace, "third arg for 'pixel' is not an int (y coordinate)"
1783 return
1784 }
1785 var third-value/eax: (addr float) <- get third, number-data
1786 var y/ebx: int <- convert *third-value
1787
1788 var rest-ah/eax: (addr handle cell) <- get rest, right
1789 var _rest/eax: (addr cell) <- lookup *rest-ah
1790 rest <- copy _rest
1791 {
1792 var rest-type/ecx: (addr int) <- get rest, type
1793 compare *rest-type, 0/pair
1794 break-if-=
1795 error trace, "'pixel' encountered non-pair"
1796 return
1797 }
1798 {
1799 var rest-nil?/eax: boolean <- nil? rest
1800 compare rest-nil?, 0/false
1801 break-if-=
1802 error trace, "'pixel' needs 4 args but got 3"
1803 return
1804 }
1805 var fourth-ah/eax: (addr handle cell) <- get rest, left
1806 var fourth/eax: (addr cell) <- lookup *fourth-ah
1807 var fourth-type/ecx: (addr int) <- get fourth, type
1808 compare *fourth-type, 1/number
1809 {
1810 break-if-=
1811 error trace, "fourth arg for 'pixel' is not an int (color; 0..0xff)"
1812 return
1813 }
1814 var fourth-value/eax: (addr float) <- get fourth, number-data
1815 var color/eax: int <- convert *fourth-value
1816 pixel screen, x, y, color
1817
1818 }
1819
1820 fn apply-wait-for-key _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1821 trace-text trace, "eval", "apply 'key'"
1822 var args-ah/eax: (addr handle cell) <- copy _args-ah
1823 var _args/eax: (addr cell) <- lookup *args-ah
1824 var args/esi: (addr cell) <- copy _args
1825 {
1826 var args-type/ecx: (addr int) <- get args, type
1827 compare *args-type, 0/pair
1828 break-if-=
1829 error trace, "args to 'key' are not a list"
1830 return
1831 }
1832 var empty-args?/eax: boolean <- nil? args
1833 compare empty-args?, 0/false
1834 {
1835 break-if-=
1836 error trace, "'key' needs 1 arg but got 0"
1837 return
1838 }
1839
1840 var first-ah/eax: (addr handle cell) <- get args, left
1841 var first/eax: (addr cell) <- lookup *first-ah
1842 var first-type/ecx: (addr int) <- get first, type
1843 compare *first-type, 6/keyboard
1844 {
1845 break-if-=
1846 error trace, "first arg for 'key' is not a keyboard"
1847 return
1848 }
1849 var keyboard-ah/eax: (addr handle gap-buffer) <- get first, keyboard-data
1850 var _keyboard/eax: (addr gap-buffer) <- lookup *keyboard-ah
1851 var keyboard/ecx: (addr gap-buffer) <- copy _keyboard
1852 var result/eax: int <- wait-for-key keyboard
1853
1854 new-integer out, result
1855 }
1856
1857 fn wait-for-key keyboard: (addr gap-buffer) -> _/eax: int {
1858
1859 {
1860 compare keyboard, 0/real-keyboard
1861 break-if-!=
1862 var key/eax: byte <- read-key 0/real-keyboard
1863 var result/eax: int <- copy key
1864 return result
1865 }
1866
1867 var g/eax: grapheme <- read-from-gap-buffer keyboard
1868 var result/eax: int <- copy g
1869 return result
1870 }
1871
1872 fn apply-stream _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1873 trace-text trace, "eval", "apply stream"
1874 allocate-stream out
1875 }
1876
1877 fn apply-write _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1878 trace-text trace, "eval", "apply 'write'"
1879 var args-ah/eax: (addr handle cell) <- copy _args-ah
1880 var _args/eax: (addr cell) <- lookup *args-ah
1881 var args/esi: (addr cell) <- copy _args
1882 {
1883 var args-type/ecx: (addr int) <- get args, type
1884 compare *args-type, 0/pair
1885 break-if-=
1886 error trace, "args to 'write' are not a list"
1887 return
1888 }
1889 var empty-args?/eax: boolean <- nil? args
1890 compare empty-args?, 0/false
1891 {
1892 break-if-=
1893 error trace, "'write' needs 2 args but got 0"
1894 return
1895 }
1896
1897 var first-ah/edx: (addr handle cell) <- get args, left
1898 var first/eax: (addr cell) <- lookup *first-ah
1899 var first-type/ecx: (addr int) <- get first, type
1900 compare *first-type, 3/stream
1901 {
1902 break-if-=
1903 error trace, "first arg for 'write' is not a stream"
1904 return
1905 }
1906 var stream-data-ah/eax: (addr handle stream byte) <- get first, text-data
1907 var _stream-data/eax: (addr stream byte) <- lookup *stream-data-ah
1908 var stream-data/ebx: (addr stream byte) <- copy _stream-data
1909
1910 var right-ah/eax: (addr handle cell) <- get args, right
1911 var right/eax: (addr cell) <- lookup *right-ah
1912 {
1913 var right-type/ecx: (addr int) <- get right, type
1914 compare *right-type, 0/pair
1915 break-if-=
1916 error trace, "'write' encountered non-pair"
1917 return
1918 }
1919 {
1920 var nil?/eax: boolean <- nil? right
1921 compare nil?, 0/false
1922 break-if-=
1923 error trace, "'write' needs 2 args but got 1"
1924 return
1925 }
1926 var second-ah/eax: (addr handle cell) <- get right, left
1927 var second/eax: (addr cell) <- lookup *second-ah
1928 var second-type/ecx: (addr int) <- get second, type
1929 compare *second-type, 1/number
1930 {
1931 break-if-=
1932 error trace, "second arg for 'write' is not a number/grapheme"
1933 return
1934 }
1935 var second-value/eax: (addr float) <- get second, number-data
1936 var x-float/xmm0: float <- copy *second-value
1937 var x/eax: int <- convert x-float
1938 var x-grapheme/eax: grapheme <- copy x
1939 write-grapheme stream-data, x-grapheme
1940
1941 copy-object first-ah, out
1942 }
1943
1944 fn apply-lines _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1945 trace-text trace, "eval", "apply 'lines'"
1946 var args-ah/eax: (addr handle cell) <- copy _args-ah
1947 var _args/eax: (addr cell) <- lookup *args-ah
1948 var args/esi: (addr cell) <- copy _args
1949 {
1950 var args-type/ecx: (addr int) <- get args, type
1951 compare *args-type, 0/pair
1952 break-if-=
1953 error trace, "args to 'lines' are not a list"
1954 return
1955 }
1956 var empty-args?/eax: boolean <- nil? args
1957 compare empty-args?, 0/false
1958 {
1959 break-if-=
1960 error trace, "'lines' needs 1 arg but got 0"
1961 return
1962 }
1963
1964 var first-ah/eax: (addr handle cell) <- get args, left
1965 var first/eax: (addr cell) <- lookup *first-ah
1966 var first-type/ecx: (addr int) <- get first, type
1967 compare *first-type, 5/screen
1968 {
1969 break-if-=
1970 error trace, "first arg for 'lines' is not a screen"
1971 return
1972 }
1973 var screen-ah/eax: (addr handle screen) <- get first, screen-data
1974 var _screen/eax: (addr screen) <- lookup *screen-ah
1975 var screen/edx: (addr screen) <- copy _screen
1976
1977 var dummy/eax: int <- copy 0
1978 var height/ecx: int <- copy 0
1979 dummy, height <- screen-size screen
1980 var result/xmm0: float <- convert height
1981 new-float out, result
1982 }
1983
1984 fn apply-abort _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1985 abort "aa"
1986 }
1987
1988 fn apply-columns _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1989 trace-text trace, "eval", "apply 'columns'"
1990 var args-ah/eax: (addr handle cell) <- copy _args-ah
1991 var _args/eax: (addr cell) <- lookup *args-ah
1992 var args/esi: (addr cell) <- copy _args
1993 {
1994 var args-type/ecx: (addr int) <- get args, type
1995 compare *args-type, 0/pair
1996 break-if-=
1997 error trace, "args to 'columns' are not a list"
1998 return
1999 }
2000 var empty-args?/eax: boolean <- nil? args
2001 compare empty-args?, 0/false
2002 {
2003 break-if-=
2004 error trace, "'columns' needs 1 arg but got 0"
2005 return
2006 }
2007
2008 var first-ah/eax: (addr handle cell) <- get args, left
2009 var first/eax: (addr cell) <- lookup *first-ah
2010 var first-type/ecx: (addr int) <- get first, type
2011 compare *first-type, 5/screen
2012 {
2013 break-if-=
2014 error trace, "first arg for 'columns' is not a screen"
2015 return
2016 }
2017 var screen-ah/eax: (addr handle screen) <- get first, screen-data
2018 var _screen/eax: (addr screen) <- lookup *screen-ah
2019 var screen/edx: (addr screen) <- copy _screen
2020
2021 var width/eax: int <- copy 0
2022 var dummy/ecx: int <- copy 0
2023 width, dummy <- screen-size screen
2024 var result/xmm0: float <- convert width
2025 new-float out, result
2026 }
2027
2028 fn apply-width _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
2029 trace-text trace, "eval", "apply 'width'"
2030 var args-ah/eax: (addr handle cell) <- copy _args-ah
2031 var _args/eax: (addr cell) <- lookup *args-ah
2032 var args/esi: (addr cell) <- copy _args
2033 {
2034 var args-type/ecx: (addr int) <- get args, type
2035 compare *args-type, 0/pair
2036 break-if-=
2037 error trace, "args to 'width' are not a list"
2038 return
2039 }
2040 var empty-args?/eax: boolean <- nil? args
2041 compare empty-args?, 0/false
2042 {
2043 break-if-=
2044 error trace, "'width' needs 1 arg but got 0"
2045 return
2046 }
2047
2048 var first-ah/eax: (addr handle cell) <- get args, left
2049 var first/eax: (addr cell) <- lookup *first-ah
2050 var first-type/ecx: (addr int) <- get first, type
2051 compare *first-type, 5/screen
2052 {
2053 break-if-=
2054 error trace, "first arg for 'width' is not a screen"
2055 return
2056 }
2057 var screen-ah/eax: (addr handle screen) <- get first, screen-data
2058 var _screen/eax: (addr screen) <- lookup *screen-ah
2059 var screen/edx: (addr screen) <- copy _screen
2060
2061 var width/eax: int <- copy 0
2062 var dummy/ecx: int <- copy 0
2063 width, dummy <- screen-size screen
2064 width <- shift-left 3/log2-font-width
2065 var result/xmm0: float <- convert width
2066 new-float out, result
2067 }
2068
2069 fn apply-height _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
2070 trace-text trace, "eval", "apply 'height'"
2071 var args-ah/eax: (addr handle cell) <- copy _args-ah
2072 var _args/eax: (addr cell) <- lookup *args-ah
2073 var args/esi: (addr cell) <- copy _args
2074 {
2075 var args-type/ecx: (addr int) <- get args, type
2076 compare *args-type, 0/pair
2077 break-if-=
2078 error trace, "args to 'height' are not a list"
2079 return
2080 }
2081 var empty-args?/eax: boolean <- nil? args
2082 compare empty-args?, 0/false
2083 {
2084 break-if-=
2085 error trace, "'height' needs 1 arg but got 0"
2086 return
2087 }
2088
2089 var first-ah/eax: (addr handle cell) <- get args, left
2090 var first/eax: (addr cell) <- lookup *first-ah
2091 var first-type/ecx: (addr int) <- get first, type
2092 compare *first-type, 5/screen
2093 {
2094 break-if-=
2095 error trace, "first arg for 'height' is not a screen"
2096 return
2097 }
2098 var screen-ah/eax: (addr handle screen) <- get first, screen-data
2099 var _screen/eax: (addr screen) <- lookup *screen-ah
2100 var screen/edx: (addr screen) <- copy _screen
2101
2102 var dummy/eax: int <- copy 0
2103 var height/ecx: int <- copy 0
2104 dummy, height <- screen-size screen
2105 height <- shift-left 4/log2-font-height
2106 var result/xmm0: float <- convert height
2107 new-float out, result
2108 }