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, 0x17/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, 0x17/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, 0x17/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 macroexpand read-result-ah, globals, trace
613 var nil-h: (handle cell)
614 var nil-ah/eax: (addr handle cell) <- address nil-h
615 allocate-pair nil-ah
616 var eval-result-h: (handle cell)
617 var eval-result-ah/edi: (addr handle cell) <- address eval-result-h
618
619
620 debug-print "^", 4/fg, 0/bg
621 evaluate read-result-ah, eval-result-ah, *nil-ah, globals, trace, screen-cell, keyboard-cell, 1/call-number
622 debug-print "$", 4/fg, 0/bg
623 var error?/eax: boolean <- has-errors? trace
624 {
625 compare error?, 0/false
626 break-if-=
627 return
628 }
629
630
631
632 maybe-stash-gap-buffer-to-global globals, read-result-ah, _in-ah
633 clear-stream out
634 print-cell eval-result-ah, out, trace
635 mark-lines-dirty trace
636 }
637
638 fn read-evaluate-and-move-to-globals _in-ah: (addr handle gap-buffer), globals: (addr global-table) {
639 var in-ah/eax: (addr handle gap-buffer) <- copy _in-ah
640 var in/eax: (addr gap-buffer) <- lookup *in-ah
641 var read-result-h: (handle cell)
642 var read-result-ah/esi: (addr handle cell) <- address read-result-h
643 read-cell in, read-result-ah, 0/no-trace
644 macroexpand read-result-ah, globals, 0/no-trace
645 var nil-storage: (handle cell)
646 var nil-ah/eax: (addr handle cell) <- address nil-storage
647 allocate-pair nil-ah
648 var eval-result-storage: (handle cell)
649 var eval-result/edi: (addr handle cell) <- address eval-result-storage
650 debug-print "^", 4/fg, 0/bg
651 evaluate read-result-ah, eval-result, *nil-ah, globals, 0/no-trace, 0/no-screen-cell, 0/no-keyboard-cell, 1/call-number
652 debug-print "$", 4/fg, 0/bg
653 move-gap-buffer-to-global globals, read-result-ah, _in-ah
654 }
655
656 fn test-run-integer {
657 var sandbox-storage: sandbox
658 var sandbox/esi: (addr sandbox) <- address sandbox-storage
659 initialize-sandbox-with sandbox, "1"
660
661 edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
662
663 var screen-on-stack: screen
664 var screen/edi: (addr screen) <- address screen-on-stack
665 initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
666
667 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
668
669 check-screen-row screen, 1/y, " 1 ", "F - test-run-integer/0"
670 check-screen-row screen, 2/y, " ... ", "F - test-run-integer/1"
671 check-screen-row screen, 3/y, " => 1 ", "F - test-run-integer/2"
672 }
673
674 fn test-run-error-invalid-integer {
675 var sandbox-storage: sandbox
676 var sandbox/esi: (addr sandbox) <- address sandbox-storage
677 initialize-sandbox-with sandbox, "1a"
678
679 edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
680
681 var screen-on-stack: screen
682 var screen/edi: (addr screen) <- address screen-on-stack
683 initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
684
685 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
686
687 check-screen-row screen, 1/y, " 1a ", "F - test-run-error-invalid-integer/0"
688 check-screen-row screen, 2/y, " ... ", "F - test-run-error-invalid-integer/0"
689 check-screen-row screen, 3/y, " invalid number ", "F - test-run-error-invalid-integer/2"
690 }
691
692 fn test-run-with-spaces {
693 var sandbox-storage: sandbox
694 var sandbox/esi: (addr sandbox) <- address sandbox-storage
695 initialize-sandbox-with sandbox, " 1 \n"
696
697 edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
698
699 var screen-on-stack: screen
700 var screen/edi: (addr screen) <- address screen-on-stack
701 initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
702
703 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
704
705 check-screen-row screen, 1/y, " 1 ", "F - test-run-with-spaces/0"
706 check-screen-row screen, 2/y, " ", "F - test-run-with-spaces/1"
707 check-screen-row screen, 3/y, " ... ", "F - test-run-with-spaces/2"
708 check-screen-row screen, 4/y, " => 1 ", "F - test-run-with-spaces/3"
709 }
710
711 fn test-run-quote {
712 var sandbox-storage: sandbox
713 var sandbox/esi: (addr sandbox) <- address sandbox-storage
714 initialize-sandbox-with sandbox, "'a"
715
716 edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
717
718 var screen-on-stack: screen
719 var screen/edi: (addr screen) <- address screen-on-stack
720 initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
721
722 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
723
724 check-screen-row screen, 1/y, " 'a ", "F - test-run-quote/0"
725 check-screen-row screen, 2/y, " ... ", "F - test-run-quote/1"
726 check-screen-row screen, 3/y, " => a ", "F - test-run-quote/2"
727 }
728
729 fn test-run-dotted-list {
730 var sandbox-storage: sandbox
731 var sandbox/esi: (addr sandbox) <- address sandbox-storage
732 initialize-sandbox-with sandbox, "'(a . b)"
733
734 edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
735
736 var screen-on-stack: screen
737 var screen/edi: (addr screen) <- address screen-on-stack
738 initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
739
740 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
741
742 check-screen-row screen, 1/y, " '(a . b) ", "F - test-run-dotted-list/0"
743 check-screen-row screen, 2/y, " ... ", "F - test-run-dotted-list/1"
744 check-screen-row screen, 3/y, " => (a . b) ", "F - test-run-dotted-list/2"
745 }
746
747 fn test-run-dot-and-list {
748 var sandbox-storage: sandbox
749 var sandbox/esi: (addr sandbox) <- address sandbox-storage
750 initialize-sandbox-with sandbox, "'(a . (b))"
751
752 edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
753
754 var screen-on-stack: screen
755 var screen/edi: (addr screen) <- address screen-on-stack
756 initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
757
758 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
759
760 check-screen-row screen, 1/y, " '(a . (b)) ", "F - test-run-dot-and-list/0"
761 check-screen-row screen, 2/y, " ... ", "F - test-run-dot-and-list/1"
762 check-screen-row screen, 3/y, " => (a b) ", "F - test-run-dot-and-list/2"
763 }
764
765 fn test-run-final-dot {
766 var sandbox-storage: sandbox
767 var sandbox/esi: (addr sandbox) <- address sandbox-storage
768 initialize-sandbox-with sandbox, "'(a .)"
769
770 edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
771
772 var screen-on-stack: screen
773 var screen/edi: (addr screen) <- address screen-on-stack
774 initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
775
776 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
777
778 check-screen-row screen, 1/y, " '(a .) ", "F - test-run-final-dot/0"
779 check-screen-row screen, 2/y, " ... ", "F - test-run-final-dot/1"
780 check-screen-row screen, 3/y, " '. )' makes no sense ", "F - test-run-final-dot/2"
781
782 }
783
784 fn test-run-double-dot {
785 var sandbox-storage: sandbox
786 var sandbox/esi: (addr sandbox) <- address sandbox-storage
787 initialize-sandbox-with sandbox, "'(a . .)"
788
789 edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
790
791 var screen-on-stack: screen
792 var screen/edi: (addr screen) <- address screen-on-stack
793 initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
794
795 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
796
797 check-screen-row screen, 1/y, " '(a . .) ", "F - test-run-double-dot/0"
798 check-screen-row screen, 2/y, " ... ", "F - test-run-double-dot/1"
799 check-screen-row screen, 3/y, " '. .' makes no sense ", "F - test-run-double-dot/2"
800
801 }
802
803 fn test-run-multiple-expressions-after-dot {
804 var sandbox-storage: sandbox
805 var sandbox/esi: (addr sandbox) <- address sandbox-storage
806 initialize-sandbox-with sandbox, "'(a . b c)"
807
808 edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
809
810 var screen-on-stack: screen
811 var screen/edi: (addr screen) <- address screen-on-stack
812 initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
813
814 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
815
816 check-screen-row screen, 1/y, " '(a . b c) ", "F - test-run-multiple-expressions-after-dot/0"
817 check-screen-row screen, 2/y, " ... ", "F - test-run-multiple-expressions-after-dot/1"
818 check-screen-row screen, 3/y, " cannot have multiple expressions between '.' and ')' ", "F - test-run-multiple-expressions-after-dot/2"
819
820 }
821
822 fn test-run-stream {
823 var sandbox-storage: sandbox
824 var sandbox/esi: (addr sandbox) <- address sandbox-storage
825 initialize-sandbox-with sandbox, "[a b]"
826
827 edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
828
829 var screen-on-stack: screen
830 var screen/edi: (addr screen) <- address screen-on-stack
831 initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
832
833 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
834
835 check-screen-row screen, 1/y, " [a b] ", "F - test-run-stream/0"
836 check-screen-row screen, 2/y, " ... ", "F - test-run-stream/1"
837 check-screen-row screen, 3/y, " => [a b] ", "F - test-run-stream/2"
838 }
839
840 fn test-run-move-cursor-into-trace {
841 var sandbox-storage: sandbox
842 var sandbox/esi: (addr sandbox) <- address sandbox-storage
843 initialize-sandbox-with sandbox, "12"
844
845 edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
846
847 var screen-on-stack: screen
848 var screen/edi: (addr screen) <- address screen-on-stack
849 initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
850
851 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
852
853 check-screen-row screen, 1/y, " 12 ", "F - test-run-move-cursor-into-trace/pre-0"
854 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " | ", "F - test-run-move-cursor-into-trace/pre-0/cursor"
855 check-screen-row screen, 2/y, " ... ", "F - test-run-move-cursor-into-trace/pre-1"
856 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-run-move-cursor-into-trace/pre-1/cursor"
857 check-screen-row screen, 3/y, " => 12 ", "F - test-run-move-cursor-into-trace/pre-2"
858 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-run-move-cursor-into-trace/pre-2/cursor"
859
860 edit-sandbox sandbox, 0xd/ctrl-m, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
861
862 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
863
864 check-screen-row screen, 1/y, " 12 ", "F - test-run-move-cursor-into-trace/trace-0"
865 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-run-move-cursor-into-trace/trace-0/cursor"
866 check-screen-row screen, 2/y, " ... ", "F - test-run-move-cursor-into-trace/trace-1"
867 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ||| ", "F - test-run-move-cursor-into-trace/trace-1/cursor"
868 check-screen-row screen, 3/y, " => 12 ", "F - test-run-move-cursor-into-trace/trace-2"
869 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-run-move-cursor-into-trace/trace-2/cursor"
870
871 edit-sandbox sandbox, 0xd/ctrl-m, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
872
873 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
874
875 check-screen-row screen, 1/y, " 12 ", "F - test-run-move-cursor-into-trace/input-0"
876 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " | ", "F - test-run-move-cursor-into-trace/input-0/cursor"
877 check-screen-row screen, 2/y, " ... ", "F - test-run-move-cursor-into-trace/input-1"
878 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-run-move-cursor-into-trace/input-1/cursor"
879 check-screen-row screen, 3/y, " => 12 ", "F - test-run-move-cursor-into-trace/input-2"
880 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-run-move-cursor-into-trace/input-2/cursor"
881 }
882
883 fn has-trace? _self: (addr sandbox) -> _/eax: boolean {
884 var self/esi: (addr sandbox) <- copy _self
885 var trace-ah/eax: (addr handle trace) <- get self, trace
886 var _trace/eax: (addr trace) <- lookup *trace-ah
887 var trace/edx: (addr trace) <- copy _trace
888 compare trace, 0
889 {
890 break-if-!=
891 return 0/false
892 }
893 var first-free/ebx: (addr int) <- get trace, first-free
894 compare *first-free, 0
895 {
896 break-if->
897 return 0/false
898 }
899 return 1/true
900 }