https://github.com/akkartik/mu/blob/main/shell/sandbox.mu
1 type sandbox {
2 data: (handle gap-buffer)
3 value: (handle stream byte)
4 screen-var: (handle cell)
5 keyboard-var: (handle cell)
6 trace: (handle trace)
7 cursor-in-data?: boolean
8 cursor-in-keyboard?: boolean
9 cursor-in-trace?: boolean
10 }
11
12 fn initialize-sandbox _self: (addr sandbox), fake-screen-and-keyboard?: boolean {
13 var self/esi: (addr sandbox) <- copy _self
14 var data-ah/eax: (addr handle gap-buffer) <- get self, data
15 allocate data-ah
16 var data/eax: (addr gap-buffer) <- lookup *data-ah
17 initialize-gap-buffer data, 0x1000/4KB
18
19 var value-ah/eax: (addr handle stream byte) <- get self, value
20 populate-stream value-ah, 0x1000/4KB
21
22 {
23 compare fake-screen-and-keyboard?, 0/false
24 break-if-=
25 var screen-ah/eax: (addr handle cell) <- get self, screen-var
26 new-fake-screen screen-ah, 5/width, 4/height, 1/enable-pixel-graphics
27 var keyboard-ah/eax: (addr handle cell) <- get self, keyboard-var
28 new-fake-keyboard keyboard-ah, 0x10/keyboard-capacity
29 }
30
31 var trace-ah/eax: (addr handle trace) <- get self, trace
32 allocate trace-ah
33 var trace/eax: (addr trace) <- lookup *trace-ah
34 initialize-trace trace, 0x8000/lines, 0x80/visible-lines
35 var cursor-in-data?/eax: (addr boolean) <- get self, cursor-in-data?
36 copy-to *cursor-in-data?, 1/true
37 }
38
39
40
41 fn initialize-sandbox-with _self: (addr sandbox), s: (addr array byte) {
42 var self/esi: (addr sandbox) <- copy _self
43 var data-ah/eax: (addr handle gap-buffer) <- get self, data
44 allocate data-ah
45 var data/eax: (addr gap-buffer) <- lookup *data-ah
46 initialize-gap-buffer-with data, s
47 }
48
49 fn allocate-sandbox-with _out: (addr handle sandbox), s: (addr array byte) {
50 var out/eax: (addr handle sandbox) <- copy _out
51 allocate out
52 var out-addr/eax: (addr sandbox) <- lookup *out
53 initialize-sandbox-with out-addr, s
54 }
55
56 fn write-sandbox out: (addr stream byte), _self: (addr sandbox) {
57 var self/eax: (addr sandbox) <- copy _self
58 var data-ah/eax: (addr handle gap-buffer) <- get self, data
59 var data/eax: (addr gap-buffer) <- lookup *data-ah
60 {
61 var len/eax: int <- gap-buffer-length data
62 compare len, 0
63 break-if-!=
64 return
65 }
66 write out, " (sandbox . "
67 append-gap-buffer data, out
68 write out, ")\n"
69 }
70
71
72
73 fn render-sandbox screen: (addr screen), _self: (addr sandbox), xmin: int, ymin: int, xmax: int, ymax: int, globals: (addr global-table) {
74 clear-rect screen, xmin, ymin, xmax, ymax, 0/bg=black
75 var self/esi: (addr sandbox) <- copy _self
76
77 var data-ah/eax: (addr handle gap-buffer) <- get self, data
78 var _data/eax: (addr gap-buffer) <- lookup *data-ah
79 var data/edx: (addr gap-buffer) <- copy _data
80 var x/eax: int <- copy xmin
81 var y/ecx: int <- copy ymin
82 y <- maybe-render-empty-screen screen, self, xmin, y
83 y <- maybe-render-keyboard screen, self, xmin, y
84 var cursor-in-sandbox?/ebx: (addr boolean) <- get self, cursor-in-data?
85 x, y <- render-gap-buffer-wrapping-right-then-down screen, data, x, y, xmax, ymax, *cursor-in-sandbox?
86 y <- increment
87
88 var trace-ah/eax: (addr handle trace) <- get self, trace
89 var _trace/eax: (addr trace) <- lookup *trace-ah
90 var trace/edx: (addr trace) <- copy _trace
91 var cursor-in-trace?/eax: (addr boolean) <- get self, cursor-in-trace?
92 y <- render-trace screen, trace, xmin, y, xmax, ymax, *cursor-in-trace?
93
94 $render-sandbox:value: {
95 var value-ah/eax: (addr handle stream byte) <- get self, value
96 var _value/eax: (addr stream byte) <- lookup *value-ah
97 var value/esi: (addr stream byte) <- copy _value
98 rewind-stream value
99 var done?/eax: boolean <- stream-empty? value
100 compare done?, 0/false
101 break-if-!=
102 var x/eax: int <- copy 0
103 x, y <- draw-text-wrapping-right-then-down screen, "=> ", xmin, y, xmax, ymax, xmin, y, 7/fg, 0/bg
104 var x2/edx: int <- copy x
105 var dummy/eax: int <- draw-stream-rightward screen, value, x2, xmax, y, 7/fg=grey, 0/bg
106 }
107 y <- add 2
108 y <- maybe-render-screen screen, self, xmin, y
109
110 var cursor-in-data?/eax: (addr boolean) <- get self, cursor-in-data?
111 compare *cursor-in-data?, 0/false
112 {
113 break-if-=
114 render-sandbox-menu screen, self
115 return
116 }
117 var cursor-in-trace?/eax: (addr boolean) <- get self, cursor-in-trace?
118 compare *cursor-in-trace?, 0/false
119 {
120 break-if-=
121 render-trace-menu screen
122 return
123 }
124 var cursor-in-keyboard?/eax: (addr boolean) <- get self, cursor-in-keyboard?
125 compare *cursor-in-keyboard?, 0/false
126 {
127 break-if-=
128 render-keyboard-menu screen
129 return
130 }
131 }
132
133 fn maybe-render-empty-screen screen: (addr screen), _self: (addr sandbox), xmin: int, ymin: int -> _/ecx: int {
134 var self/esi: (addr sandbox) <- copy _self
135 var screen-obj-cell-ah/eax: (addr handle cell) <- get self, screen-var
136 var screen-obj-cell/eax: (addr cell) <- lookup *screen-obj-cell-ah
137 compare screen-obj-cell, 0
138 {
139 break-if-!=
140 return ymin
141 }
142 var screen-obj-cell-type/ecx: (addr int) <- get screen-obj-cell, type
143 compare *screen-obj-cell-type, 5/screen
144 {
145 break-if-=
146 return ymin
147 }
148 var y/ecx: int <- copy ymin
149 var screen-obj-ah/eax: (addr handle screen) <- get screen-obj-cell, screen-data
150 var _screen-obj/eax: (addr screen) <- lookup *screen-obj-ah
151 var screen-obj/edx: (addr screen) <- copy _screen-obj
152 var x/eax: int <- draw-text-rightward screen, "screen: ", xmin, 0x99/xmax, y, 7/fg, 0/bg
153 y <- render-empty-screen screen, screen-obj, x, y
154 return y
155 }
156
157 fn maybe-render-screen screen: (addr screen), _self: (addr sandbox), xmin: int, ymin: int -> _/ecx: int {
158 var self/esi: (addr sandbox) <- copy _self
159 var screen-obj-cell-ah/eax: (addr handle cell) <- get self, screen-var
160 var screen-obj-cell/eax: (addr cell) <- lookup *screen-obj-cell-ah
161 compare screen-obj-cell, 0
162 {
163 break-if-!=
164 return ymin
165 }
166 var screen-obj-cell-type/ecx: (addr int) <- get screen-obj-cell, type
167 compare *screen-obj-cell-type, 5/screen
168 {
169 break-if-=
170 return ymin
171 }
172 var screen-obj-ah/eax: (addr handle screen) <- get screen-obj-cell, screen-data
173 var _screen-obj/eax: (addr screen) <- lookup *screen-obj-ah
174 var screen-obj/edx: (addr screen) <- copy _screen-obj
175 {
176 var screen-empty?/eax: boolean <- fake-screen-empty? screen-obj
177 compare screen-empty?, 0/false
178 break-if-=
179 return ymin
180 }
181 var x/eax: int <- draw-text-rightward screen, "screen: ", xmin, 0x99/xmax, ymin, 7/fg, 0/bg
182 var y/ecx: int <- copy ymin
183 y <- render-screen screen, screen-obj, x, y
184 return y
185 }
186
187 fn render-empty-screen screen: (addr screen), _target-screen: (addr screen), xmin: int, ymin: int -> _/ecx: int {
188 var target-screen/esi: (addr screen) <- copy _target-screen
189 var screen-y/edi: int <- copy ymin
190
191 {
192 set-cursor-position screen, xmin, screen-y
193 move-cursor-right screen
194 var width/edx: (addr int) <- get target-screen, width
195 var x/ebx: int <- copy 0
196 {
197 compare x, *width
198 break-if->=
199 draw-code-point-at-cursor screen, 0x2d/horizontal-bar, 0x18/fg, 0/bg
200 move-cursor-right screen
201 x <- increment
202 loop
203 }
204 screen-y <- increment
205 }
206
207 var height/edx: (addr int) <- get target-screen, height
208 var y/ecx: int <- copy 0
209 {
210 compare y, *height
211 break-if->=
212 set-cursor-position screen, xmin, screen-y
213 draw-code-point-at-cursor screen, 0x7c/vertical-bar, 0x18/fg, 0/bg
214 move-cursor-right screen
215 var width/edx: (addr int) <- get target-screen, width
216 var x/ebx: int <- copy 0
217 {
218 compare x, *width
219 break-if->=
220 draw-code-point-at-cursor screen, 0x20/space, 0x18/fg, 0/bg
221 move-cursor-right screen
222 x <- increment
223 loop
224 }
225 draw-code-point-at-cursor screen, 0x7c/vertical-bar, 0x18/fg, 0/bg
226 y <- increment
227 screen-y <- increment
228 loop
229 }
230
231 {
232 set-cursor-position screen, xmin, screen-y
233 move-cursor-right screen
234 var width/edx: (addr int) <- get target-screen, width
235 var x/ebx: int <- copy 0
236 {
237 compare x, *width
238 break-if->=
239 draw-code-point-at-cursor screen, 0x2d/horizontal-bar, 0x18/fg, 0/bg
240 move-cursor-right screen
241 x <- increment
242 loop
243 }
244 screen-y <- increment
245 }
246 return screen-y
247 }
248
249 fn render-screen screen: (addr screen), _target-screen: (addr screen), xmin: int, ymin: int -> _/ecx: int {
250 var target-screen/esi: (addr screen) <- copy _target-screen
251 var screen-y/edi: int <- copy ymin
252
253 {
254 set-cursor-position screen, xmin, screen-y
255 move-cursor-right screen
256 var width/edx: (addr int) <- get target-screen, width
257 var x/ebx: int <- copy 0
258 {
259 compare x, *width
260 break-if->=
261 draw-code-point-at-cursor screen, 0x2d/horizontal-bar, 0x18/fg, 0/bg
262 move-cursor-right screen
263 x <- increment
264 loop
265 }
266 screen-y <- increment
267 }
268
269 {
270 var height/edx: (addr int) <- get target-screen, height
271 var y/ecx: int <- copy 0
272 {
273 compare y, *height
274 break-if->=
275 set-cursor-position screen, xmin, screen-y
276 draw-code-point-at-cursor screen, 0x7c/vertical-bar, 0x18/fg, 0/bg
277 move-cursor-right screen
278 var width/edx: (addr int) <- get target-screen, width
279 var x/ebx: int <- copy 0
280 {
281 compare x, *width
282 break-if->=
283 print-screen-cell-of-fake-screen screen, target-screen, x, y
284 move-cursor-right screen
285 x <- increment
286 loop
287 }
288 draw-code-point-at-cursor screen, 0x7c/vertical-bar, 0x18/fg, 0/bg
289 y <- increment
290 screen-y <- increment
291 loop
292 }
293 }
294
295 {
296
297 var tmp/eax: int <- copy xmin
298 tmp <- add 1/margin-left
299 tmp <- shift-left 3/log2-font-width
300 var left: int
301 copy-to left, tmp
302 tmp <- copy ymin
303 tmp <- add 1/margin-top
304 tmp <- shift-left 4/log2-font-height
305 var top: int
306 copy-to top, tmp
307 var pixels-ah/eax: (addr handle array byte) <- get target-screen, pixels
308 var _pixels/eax: (addr array byte) <- lookup *pixels-ah
309 var pixels/edi: (addr array byte) <- copy _pixels
310 compare pixels, 0
311 break-if-=
312 var y/ebx: int <- copy 0
313 var height-addr/edx: (addr int) <- get target-screen, height
314 var height/edx: int <- copy *height-addr
315 height <- shift-left 4/log2-font-height
316 {
317 compare y, height
318 break-if->=
319 var width-addr/edx: (addr int) <- get target-screen, width
320 var width/edx: int <- copy *width-addr
321 width <- shift-left 3/log2-font-width
322 var x/eax: int <- copy 0
323 {
324 compare x, width
325 break-if->=
326 {
327 var idx/ecx: int <- pixel-index target-screen, x, y
328 var color-addr/ecx: (addr byte) <- index pixels, idx
329 var color/ecx: byte <- copy-byte *color-addr
330 var color2/ecx: int <- copy color
331 compare color2, 0
332 break-if-=
333 var x2/eax: int <- copy x
334 x2 <- add left
335 var y2/ebx: int <- copy y
336 y2 <- add top
337 pixel screen, x2, y2, color2
338 }
339 x <- increment
340 loop
341 }
342 y <- increment
343 loop
344 }
345 }
346
347 {
348 set-cursor-position screen, xmin, screen-y
349 move-cursor-right screen
350 var width/edx: (addr int) <- get target-screen, width
351 var x/ebx: int <- copy 0
352 {
353 compare x, *width
354 break-if->=
355 draw-code-point-at-cursor screen, 0x2d/horizontal-bar, 0x18/fg, 0/bg
356 move-cursor-right screen
357 x <- increment
358 loop
359 }
360 screen-y <- increment
361 }
362 return screen-y
363 }
364
365 fn has-keyboard? _self: (addr sandbox) -> _/eax: boolean {
366 var self/esi: (addr sandbox) <- copy _self
367 var keyboard-obj-cell-ah/eax: (addr handle cell) <- get self, keyboard-var
368 var keyboard-obj-cell/eax: (addr cell) <- lookup *keyboard-obj-cell-ah
369 compare keyboard-obj-cell, 0
370 {
371 break-if-!=
372 return 0/false
373 }
374 var keyboard-obj-cell-type/ecx: (addr int) <- get keyboard-obj-cell, type
375 compare *keyboard-obj-cell-type, 6/keyboard
376 {
377 break-if-=
378 return 0/false
379 }
380 var keyboard-obj-ah/eax: (addr handle gap-buffer) <- get keyboard-obj-cell, keyboard-data
381 var _keyboard-obj/eax: (addr gap-buffer) <- lookup *keyboard-obj-ah
382 var keyboard-obj/edx: (addr gap-buffer) <- copy _keyboard-obj
383 compare keyboard-obj, 0
384 {
385 break-if-!=
386 return 0/false
387 }
388 return 1/true
389 }
390
391 fn maybe-render-keyboard screen: (addr screen), _self: (addr sandbox), xmin: int, ymin: int -> _/ecx: int {
392 var self/esi: (addr sandbox) <- copy _self
393 var keyboard-obj-cell-ah/eax: (addr handle cell) <- get self, keyboard-var
394 var keyboard-obj-cell/eax: (addr cell) <- lookup *keyboard-obj-cell-ah
395 compare keyboard-obj-cell, 0
396 {
397 break-if-!=
398 return ymin
399 }
400 var keyboard-obj-cell-type/ecx: (addr int) <- get keyboard-obj-cell, type
401 compare *keyboard-obj-cell-type, 6/keyboard
402 {
403 break-if-=
404 return ymin
405 }
406 var keyboard-obj-ah/eax: (addr handle gap-buffer) <- get keyboard-obj-cell, keyboard-data
407 var _keyboard-obj/eax: (addr gap-buffer) <- lookup *keyboard-obj-ah
408 var keyboard-obj/edx: (addr gap-buffer) <- copy _keyboard-obj
409 var x/eax: int <- draw-text-rightward screen, "keyboard: ", xmin, 0x99/xmax, ymin, 7/fg, 0/bg
410 var y/ecx: int <- copy ymin
411 var cursor-in-keyboard?/esi: (addr boolean) <- get self, cursor-in-keyboard?
412 y <- render-keyboard screen, keyboard-obj, x, y, *cursor-in-keyboard?
413 y <- increment
414 return y
415 }
416
417
418 fn render-keyboard screen: (addr screen), _keyboard: (addr gap-buffer), xmin: int, ymin: int, render-cursor?: boolean -> _/ecx: int {
419 var keyboard/esi: (addr gap-buffer) <- copy _keyboard
420 var width/edx: int <- copy 0x10/keyboard-capacity
421 var y/edi: int <- copy ymin
422
423 {
424 set-cursor-position screen, xmin, y
425 move-cursor-right screen
426 var x/ebx: int <- copy 0
427 {
428 compare x, width
429 break-if->=
430 draw-code-point-at-cursor screen, 0x2d/horizontal-bar, 0x18/fg, 0/bg
431 move-cursor-right screen
432 x <- increment
433 loop
434 }
435 y <- increment
436 }
437
438 var x/eax: int <- copy xmin
439 draw-code-point screen, 0x7c/vertical-bar, x, y, 0x18/fg, 0/bg
440 x <- increment
441 x <- render-gap-buffer screen, keyboard, x, y, render-cursor?
442 x <- copy xmin
443 x <- add 1
444 x <- add 0x10/keyboard-capacity
445 draw-code-point screen, 0x7c/vertical-bar, x, y, 0x18/fg, 0/bg
446 y <- increment
447
448 {
449 set-cursor-position screen, xmin, y
450 move-cursor-right screen
451 var x/ebx: int <- copy 0
452 {
453 compare x, width
454 break-if->=
455 draw-code-point-at-cursor screen, 0x2d/horizontal-bar, 0x18/fg, 0/bg
456 move-cursor-right screen
457 x <- increment
458 loop
459 }
460 y <- increment
461 }
462 return y
463 }
464
465 fn print-screen-cell-of-fake-screen screen: (addr screen), _target: (addr screen), x: int, y: int {
466 var target/ecx: (addr screen) <- copy _target
467 var data-ah/eax: (addr handle array screen-cell) <- get target, data
468 var data/eax: (addr array screen-cell) <- lookup *data-ah
469 var index/ecx: int <- screen-cell-index target, x, y
470 var offset/ecx: (offset screen-cell) <- compute-offset data, index
471 var src-cell/esi: (addr screen-cell) <- index data, offset
472 var src-grapheme/eax: (addr grapheme) <- get src-cell, data
473 var src-color/ecx: (addr int) <- get src-cell, color
474 var src-background-color/edx: (addr int) <- get src-cell, background-color
475 draw-grapheme-at-cursor screen, *src-grapheme, *src-color, *src-background-color
476 }
477
478 fn render-sandbox-menu screen: (addr screen), _self: (addr sandbox) {
479 var _width/eax: int <- copy 0
480 var height/ecx: int <- copy 0
481 _width, height <- screen-size screen
482 var width/edx: int <- copy _width
483 var y/ecx: int <- copy height
484 y <- decrement
485 var height/ebx: int <- copy y
486 height <- increment
487 clear-rect screen, 0/x, y, width, height, 0/bg=black
488 set-cursor-position screen, 0/x, y
489 draw-text-rightward-from-cursor screen, " ctrl-r ", width, 0/fg, 7/bg=grey
490 draw-text-rightward-from-cursor screen, " run main ", width, 7/fg, 0/bg
491 draw-text-rightward-from-cursor screen, " ctrl-s ", width, 0/fg, 7/bg=grey
492 draw-text-rightward-from-cursor screen, " run sandbox ", width, 7/fg, 0/bg
493 $render-sandbox-menu:render-tab: {
494 var self/eax: (addr sandbox) <- copy _self
495 var has-trace?/eax: boolean <- has-trace? self
496 compare has-trace?, 0/false
497 {
498 break-if-=
499 draw-text-rightward-from-cursor screen, " tab ", width, 0/fg, 9/bg=blue
500 draw-text-rightward-from-cursor screen, " to trace ", width, 7/fg, 0/bg
501 break $render-sandbox-menu:render-tab
502 }
503 draw-text-rightward-from-cursor screen, " tab ", width, 0/fg, 0x18/bg=keyboard
504 draw-text-rightward-from-cursor screen, " to keyboard ", width, 7/fg, 0/bg
505 }
506 draw-text-rightward-from-cursor screen, " ctrl-a ", width, 0/fg, 7/bg=grey
507 draw-text-rightward-from-cursor screen, " << ", width, 7/fg, 0/bg
508 draw-text-rightward-from-cursor screen, " ctrl-b ", width, 0/fg, 7/bg=grey
509 draw-text-rightward-from-cursor screen, " <word ", width, 7/fg, 0/bg
510 draw-text-rightward-from-cursor screen, " ctrl-f ", width, 0/fg, 7/bg=grey
511 draw-text-rightward-from-cursor screen, " word> ", width, 7/fg, 0/bg
512 draw-text-rightward-from-cursor screen, " ctrl-e ", width, 0/fg, 7/bg=grey
513 draw-text-rightward-from-cursor screen, " >> ", width, 7/fg, 0/bg
514 }
515
516 fn render-keyboard-menu screen: (addr screen) {
517 var width/eax: int <- copy 0
518 var height/ecx: int <- copy 0
519 width, height <- screen-size screen
520 var y/ecx: int <- copy height
521 y <- decrement
522 var height/edx: int <- copy y
523 height <- increment
524 clear-rect screen, 0/x, y, width, height, 0/bg=black
525 set-cursor-position screen, 0/x, y
526 draw-text-rightward-from-cursor screen, " ctrl-r ", width, 0/fg, 7/bg=grey
527 draw-text-rightward-from-cursor screen, " run main ", width, 7/fg, 0/bg
528 draw-text-rightward-from-cursor screen, " ctrl-s ", width, 0/fg, 7/bg=grey
529 draw-text-rightward-from-cursor screen, " run sandbox ", width, 7/fg, 0/bg
530 draw-text-rightward-from-cursor screen, " tab ", width, 0/fg, 3/bg=cyan
531 draw-text-rightward-from-cursor screen, " to sandbox ", width, 7/fg, 0/bg
532 }
533
534 fn edit-sandbox _self: (addr sandbox), key: byte, globals: (addr global-table), real-screen: (addr screen), real-keyboard: (addr keyboard), data-disk: (addr disk) {
535 var self/esi: (addr sandbox) <- copy _self
536 var g/edx: grapheme <- copy key
537
538 {
539 compare g, 0x13/ctrl-s
540 break-if-!=
541
542
543
544
545 store-state data-disk, self, globals
546
547 var data-ah/eax: (addr handle gap-buffer) <- get self, data
548 var _data/eax: (addr gap-buffer) <- lookup *data-ah
549 var data/ecx: (addr gap-buffer) <- copy _data
550 var value-ah/eax: (addr handle stream byte) <- get self, value
551 var _value/eax: (addr stream byte) <- lookup *value-ah
552 var value/edx: (addr stream byte) <- copy _value
553 var trace-ah/eax: (addr handle trace) <- get self, trace
554 var _trace/eax: (addr trace) <- lookup *trace-ah
555 var trace/ebx: (addr trace) <- copy _trace
556 clear-trace trace
557 var screen-cell/eax: (addr handle cell) <- get self, screen-var
558 clear-screen-cell screen-cell
559 var keyboard-cell/esi: (addr handle cell) <- get self, keyboard-var
560 rewind-keyboard-cell keyboard-cell
561 set-cursor-position 0, 0, 0
562 run data, value, globals, trace, screen-cell, keyboard-cell
563 return
564 }
565
566 {
567 compare g, 9/tab
568 break-if-!=
569
570 {
571 var cursor-in-data?/eax: (addr boolean) <- get self, cursor-in-data?
572 compare *cursor-in-data?, 0/false
573 break-if-=
574 var has-trace?/eax: boolean <- has-trace? self
575 compare has-trace?, 0/false
576 {
577 break-if-=
578 var cursor-in-data?/eax: (addr boolean) <- get self, cursor-in-data?
579 copy-to *cursor-in-data?, 0/false
580 var cursor-in-trace?/eax: (addr boolean) <- get self, cursor-in-trace?
581 copy-to *cursor-in-trace?, 1/false
582 return
583 }
584 var has-keyboard?/eax: boolean <- has-keyboard? self
585 compare has-keyboard?, 0/false
586 {
587 break-if-=
588 var cursor-in-data?/eax: (addr boolean) <- get self, cursor-in-data?
589 copy-to *cursor-in-data?, 0/false
590 var cursor-in-keyboard?/eax: (addr boolean) <- get self, cursor-in-keyboard?
591 copy-to *cursor-in-keyboard?, 1/false
592 return
593 }
594 return
595 }
596
597 {
598 var cursor-in-trace?/eax: (addr boolean) <- get self, cursor-in-trace?
599 compare *cursor-in-trace?, 0/false
600 break-if-=
601 copy-to *cursor-in-trace?, 0/false
602 var cursor-target/ecx: (addr boolean) <- get self, cursor-in-keyboard?
603 var has-keyboard?/eax: boolean <- has-keyboard? self
604 compare has-keyboard?, 0/false
605 {
606 break-if-!=
607 cursor-target <- get self, cursor-in-data?
608 }
609 copy-to *cursor-target, 1/true
610 return
611 }
612
613 {
614 var cursor-in-keyboard?/eax: (addr boolean) <- get self, cursor-in-keyboard?
615 compare *cursor-in-keyboard?, 0/false
616 break-if-=
617 copy-to *cursor-in-keyboard?, 0/false
618 var cursor-in-data?/eax: (addr boolean) <- get self, cursor-in-data?
619 copy-to *cursor-in-data?, 1/true
620 return
621 }
622 return
623 }
624
625 {
626 var cursor-in-data?/eax: (addr boolean) <- get self, cursor-in-data?
627 compare *cursor-in-data?, 0/false
628 break-if-=
629 var data-ah/eax: (addr handle gap-buffer) <- get self, data
630 var data/eax: (addr gap-buffer) <- lookup *data-ah
631 edit-gap-buffer data, g
632 return
633 }
634
635 {
636 var cursor-in-keyboard?/eax: (addr boolean) <- get self, cursor-in-keyboard?
637 compare *cursor-in-keyboard?, 0/false
638 break-if-=
639 var keyboard-cell-ah/eax: (addr handle cell) <- get self, keyboard-var
640 var keyboard-cell/eax: (addr cell) <- lookup *keyboard-cell-ah
641 compare keyboard-cell, 0
642 {
643 break-if-!=
644 return
645 }
646 var keyboard-cell-type/ecx: (addr int) <- get keyboard-cell, type
647 compare *keyboard-cell-type, 6/keyboard
648 {
649 break-if-=
650 return
651 }
652 var keyboard-ah/eax: (addr handle gap-buffer) <- get keyboard-cell, keyboard-data
653 var keyboard/eax: (addr gap-buffer) <- lookup *keyboard-ah
654 edit-gap-buffer keyboard, g
655 return
656 }
657
658 {
659 var cursor-in-trace?/eax: (addr boolean) <- get self, cursor-in-trace?
660 compare *cursor-in-trace?, 0/false
661 break-if-=
662 var trace-ah/eax: (addr handle trace) <- get self, trace
663 var trace/eax: (addr trace) <- lookup *trace-ah
664 edit-trace trace, g
665 return
666 }
667 }
668
669 fn run in: (addr gap-buffer), out: (addr stream byte), globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell), keyboard-cell: (addr handle cell) {
670 var read-result-storage: (handle cell)
671 var read-result/esi: (addr handle cell) <- address read-result-storage
672 read-cell in, read-result, trace
673 var error?/eax: boolean <- has-errors? trace
674 {
675 compare error?, 0/false
676 break-if-=
677 return
678 }
679 var nil-storage: (handle cell)
680 var nil-ah/eax: (addr handle cell) <- address nil-storage
681 allocate-pair nil-ah
682 var eval-result-storage: (handle cell)
683 var eval-result/edi: (addr handle cell) <- address eval-result-storage
684 debug-print "^", 4/fg, 0/bg
685 evaluate read-result, eval-result, *nil-ah, globals, trace, screen-cell, keyboard-cell, 1/call-number
686 debug-print "$", 4/fg, 0/bg
687 var error?/eax: boolean <- has-errors? trace
688 {
689 compare error?, 0/false
690 break-if-=
691 return
692 }
693 clear-stream out
694 print-cell eval-result, out, trace
695 mark-lines-dirty trace
696 }
697
698 fn test-run-integer {
699 var sandbox-storage: sandbox
700 var sandbox/esi: (addr sandbox) <- address sandbox-storage
701 initialize-sandbox sandbox, 0/no-screen-or-keyboard
702
703 edit-sandbox sandbox, 0x31/1, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
704
705 edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
706
707 var screen-on-stack: screen
708 var screen/edi: (addr screen) <- address screen-on-stack
709 initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
710
711 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 0/no-globals
712 check-screen-row screen, 0/y, "1 ", "F - test-run-integer/0"
713 check-screen-row screen, 1/y, "... ", "F - test-run-integer/1"
714 check-screen-row screen, 2/y, "=> 1 ", "F - test-run-integer/2"
715 }
716
717 fn test-run-with-spaces {
718 var sandbox-storage: sandbox
719 var sandbox/esi: (addr sandbox) <- address sandbox-storage
720 initialize-sandbox sandbox, 0/no-screen-or-keyboard
721
722 edit-sandbox sandbox, 0x20/space, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
723 edit-sandbox sandbox, 0x31/1, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
724 edit-sandbox sandbox, 0x20/space, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
725 edit-sandbox sandbox, 0xa/newline, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
726
727 edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
728
729 var screen-on-stack: screen
730 var screen/edi: (addr screen) <- address screen-on-stack
731 initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
732
733 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 0/no-globals
734 check-screen-row screen, 0/y, " 1 ", "F - test-run-with-spaces/0"
735 check-screen-row screen, 1/y, " ", "F - test-run-with-spaces/1"
736 check-screen-row screen, 2/y, "... ", "F - test-run-with-spaces/2"
737 check-screen-row screen, 3/y, "=> 1 ", "F - test-run-with-spaces/3"
738 }
739
740 fn test-run-quote {
741 var sandbox-storage: sandbox
742 var sandbox/esi: (addr sandbox) <- address sandbox-storage
743 initialize-sandbox sandbox, 0/no-screen-or-keyboard
744
745 edit-sandbox sandbox, 0x27/quote, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
746 edit-sandbox sandbox, 0x61/a, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
747
748 edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
749
750 var screen-on-stack: screen
751 var screen/edi: (addr screen) <- address screen-on-stack
752 initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
753
754 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 0/no-globals
755 check-screen-row screen, 0/y, "'a ", "F - test-run-quote/0"
756 check-screen-row screen, 1/y, "... ", "F - test-run-quote/1"
757 check-screen-row screen, 2/y, "=> a ", "F - test-run-quote/2"
758 }
759
760 fn test-run-dotted-list {
761 var sandbox-storage: sandbox
762 var sandbox/esi: (addr sandbox) <- address sandbox-storage
763 initialize-sandbox sandbox, 0/no-screen-or-keyboard
764
765 edit-sandbox sandbox, 0x27/quote, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
766 edit-sandbox sandbox, 0x28/open-paren, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
767 edit-sandbox sandbox, 0x61/a, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
768 edit-sandbox sandbox, 0x20/space, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
769 edit-sandbox sandbox, 0x2e/dot, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
770 edit-sandbox sandbox, 0x20/space, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
771 edit-sandbox sandbox, 0x62/b, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
772 edit-sandbox sandbox, 0x29/close-paren, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
773
774 edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
775
776 var screen-on-stack: screen
777 var screen/edi: (addr screen) <- address screen-on-stack
778 initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
779
780 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 0/no-globals
781 check-screen-row screen, 0/y, "'(a . b) ", "F - test-run-dotted-list/0"
782 check-screen-row screen, 1/y, "... ", "F - test-run-dotted-list/1"
783 check-screen-row screen, 2/y, "=> (a . b) ", "F - test-run-dotted-list/2"
784 }
785
786 fn test-run-dot-and-list {
787 var sandbox-storage: sandbox
788 var sandbox/esi: (addr sandbox) <- address sandbox-storage
789 initialize-sandbox sandbox, 0/no-screen-or-keyboard
790
791 edit-sandbox sandbox, 0x27/quote, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
792 edit-sandbox sandbox, 0x28/open-paren, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
793 edit-sandbox sandbox, 0x61/a, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
794 edit-sandbox sandbox, 0x20/space, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
795 edit-sandbox sandbox, 0x2e/dot, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
796 edit-sandbox sandbox, 0x20/space, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
797 edit-sandbox sandbox, 0x28/open-paren, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
798 edit-sandbox sandbox, 0x62/b, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
799 edit-sandbox sandbox, 0x29/close-paren, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
800 edit-sandbox sandbox, 0x29/close-paren, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
801
802 edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
803
804 var screen-on-stack: screen
805 var screen/edi: (addr screen) <- address screen-on-stack
806 initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
807
808 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 0/no-globals
809 check-screen-row screen, 0/y, "'(a . (b)) ", "F - test-run-dot-and-list/0"
810 check-screen-row screen, 1/y, "... ", "F - test-run-dot-and-list/1"
811 check-screen-row screen, 2/y, "=> (a b) ", "F - test-run-dot-and-list/2"
812 }
813
814 fn test-run-final-dot {
815 var sandbox-storage: sandbox
816 var sandbox/esi: (addr sandbox) <- address sandbox-storage
817 initialize-sandbox sandbox, 0/no-screen-or-keyboard
818
819 edit-sandbox sandbox, 0x27/quote, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
820 edit-sandbox sandbox, 0x28/open-paren, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
821 edit-sandbox sandbox, 0x61/a, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
822 edit-sandbox sandbox, 0x20/space, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
823 edit-sandbox sandbox, 0x2e/dot, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
824 edit-sandbox sandbox, 0x29/close-paren, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
825
826 edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
827
828 var screen-on-stack: screen
829 var screen/edi: (addr screen) <- address screen-on-stack
830 initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
831
832 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 0/no-globals
833 check-screen-row screen, 0/y, "'(a .) ", "F - test-run-final-dot/0"
834 check-screen-row screen, 1/y, "... ", "F - test-run-final-dot/1"
835 check-screen-row screen, 2/y, "'. )' makes no sense ", "F - test-run-final-dot/2"
836
837 }
838
839 fn test-run-double-dot {
840 var sandbox-storage: sandbox
841 var sandbox/esi: (addr sandbox) <- address sandbox-storage
842 initialize-sandbox sandbox, 0/no-screen-or-keyboard
843
844 edit-sandbox sandbox, 0x27/quote, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
845 edit-sandbox sandbox, 0x28/open-paren, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
846 edit-sandbox sandbox, 0x61/a, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
847 edit-sandbox sandbox, 0x20/space, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
848 edit-sandbox sandbox, 0x2e/dot, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
849 edit-sandbox sandbox, 0x20/space, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
850 edit-sandbox sandbox, 0x2e/dot, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
851 edit-sandbox sandbox, 0x29/close-paren, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
852
853 edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
854
855 var screen-on-stack: screen
856 var screen/edi: (addr screen) <- address screen-on-stack
857 initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
858
859 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 0/no-globals
860 check-screen-row screen, 0/y, "'(a . .) ", "F - test-run-double-dot/0"
861 check-screen-row screen, 1/y, "... ", "F - test-run-double-dot/1"
862 check-screen-row screen, 2/y, "'. .' makes no sense ", "F - test-run-double-dot/2"
863
864 }
865
866 fn test-run-multiple-expressions-after-dot {
867 var sandbox-storage: sandbox
868 var sandbox/esi: (addr sandbox) <- address sandbox-storage
869 initialize-sandbox sandbox, 0/no-screen-or-keyboard
870
871 edit-sandbox sandbox, 0x27/quote, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
872 edit-sandbox sandbox, 0x28/open-paren, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
873 edit-sandbox sandbox, 0x61/a, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
874 edit-sandbox sandbox, 0x20/space, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
875 edit-sandbox sandbox, 0x2e/dot, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
876 edit-sandbox sandbox, 0x20/space, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
877 edit-sandbox sandbox, 0x62/b, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
878 edit-sandbox sandbox, 0x20/space, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
879 edit-sandbox sandbox, 0x63/c, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
880 edit-sandbox sandbox, 0x29/close-paren, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
881
882 edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
883
884 var screen-on-stack: screen
885 var screen/edi: (addr screen) <- address screen-on-stack
886 initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
887
888 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 0/no-globals
889 check-screen-row screen, 0/y, "'(a . b c) ", "F - test-run-multiple-expressions-after-dot/0"
890 check-screen-row screen, 1/y, "... ", "F - test-run-multiple-expressions-after-dot/1"
891 check-screen-row screen, 2/y, "cannot have multiple expressions between '.' and ')' ", "F - test-run-multiple-expressions-after-dot/2"
892
893 }
894
895 fn test-run-error-invalid-integer {
896 var sandbox-storage: sandbox
897 var sandbox/esi: (addr sandbox) <- address sandbox-storage
898 initialize-sandbox sandbox, 0/no-screen-or-keyboard
899
900 edit-sandbox sandbox, 0x31/1, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
901 edit-sandbox sandbox, 0x61/a, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
902
903 edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
904
905 var screen-on-stack: screen
906 var screen/edi: (addr screen) <- address screen-on-stack
907 initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
908
909 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 0/no-globals
910 check-screen-row screen, 0/y, "1a ", "F - test-run-error-invalid-integer/0"
911 check-screen-row screen, 1/y, "... ", "F - test-run-error-invalid-integer/0"
912 check-screen-row screen, 2/y, "invalid number ", "F - test-run-error-invalid-integer/2"
913 }
914
915 fn test-run-move-cursor-into-trace {
916 var sandbox-storage: sandbox
917 var sandbox/esi: (addr sandbox) <- address sandbox-storage
918 initialize-sandbox sandbox, 0/no-screen-or-keyboard
919
920 edit-sandbox sandbox, 0x31/1, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
921 edit-sandbox sandbox, 0x32/2, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
922
923 edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
924
925 var screen-on-stack: screen
926 var screen/edi: (addr screen) <- address screen-on-stack
927 initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
928
929 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 0/no-globals
930 check-screen-row screen, 0/y, "12 ", "F - test-run-move-cursor-into-trace/pre-0"
931 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " | ", "F - test-run-move-cursor-into-trace/pre-0/cursor"
932 check-screen-row screen, 1/y, "... ", "F - test-run-move-cursor-into-trace/pre-1"
933 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-run-move-cursor-into-trace/pre-1/cursor"
934 check-screen-row screen, 2/y, "=> 12 ", "F - test-run-move-cursor-into-trace/pre-2"
935 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-run-move-cursor-into-trace/pre-2/cursor"
936
937 edit-sandbox sandbox, 9/tab, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
938
939 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 0/no-globals
940 check-screen-row screen, 0/y, "12 ", "F - test-run-move-cursor-into-trace/trace-0"
941 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " ", "F - test-run-move-cursor-into-trace/trace-0/cursor"
942 check-screen-row screen, 1/y, "... ", "F - test-run-move-cursor-into-trace/trace-1"
943 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "||| ", "F - test-run-move-cursor-into-trace/trace-1/cursor"
944 check-screen-row screen, 2/y, "=> 12 ", "F - test-run-move-cursor-into-trace/trace-2"
945 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-run-move-cursor-into-trace/trace-2/cursor"
946
947 edit-sandbox sandbox, 9/tab, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
948
949 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 0/no-globals
950 check-screen-row screen, 0/y, "12 ", "F - test-run-move-cursor-into-trace/input-0"
951 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " | ", "F - test-run-move-cursor-into-trace/input-0/cursor"
952 check-screen-row screen, 1/y, "... ", "F - test-run-move-cursor-into-trace/input-1"
953 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-run-move-cursor-into-trace/input-1/cursor"
954 check-screen-row screen, 2/y, "=> 12 ", "F - test-run-move-cursor-into-trace/input-2"
955 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-run-move-cursor-into-trace/input-2/cursor"
956 }
957
958 fn has-trace? _self: (addr sandbox) -> _/eax: boolean {
959 var self/esi: (addr sandbox) <- copy _self
960 var trace-ah/eax: (addr handle trace) <- get self, trace
961 var _trace/eax: (addr trace) <- lookup *trace-ah
962 var trace/edx: (addr trace) <- copy _trace
963 compare trace, 0
964 {
965 break-if-!=
966 return 0/false
967 }
968 var first-free/ebx: (addr int) <- get trace, first-free
969 compare *first-free, 0
970 {
971 break-if->
972 return 0/false
973 }
974 return 1/true
975 }