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