https://github.com/akkartik/mu/blob/master/apps/tile/environment.mu
1 type environment {
2 screen: (handle screen)
3 functions: (handle function)
4 sandboxes: (handle sandbox)
5 nrows: int
6 ncols: int
7 code-separator-col: int
8 }
9
10 fn initialize-environment _env: (addr environment) {
11 var env/esi: (addr environment) <- copy _env
12
13 var functions/eax: (addr handle function) <- get env, functions
14 create-primitive-functions functions
15
16 var sandbox-ah/eax: (addr handle sandbox) <- get env, sandboxes
17 allocate sandbox-ah
18 var sandbox/eax: (addr sandbox) <- lookup *sandbox-ah
19 initialize-sandbox sandbox
20
21 var screen-ah/eax: (addr handle screen) <- get env, screen
22 var _screen/eax: (addr screen) <- lookup *screen-ah
23 var screen/edi: (addr screen) <- copy _screen
24 var nrows/eax: int <- copy 0
25 var ncols/ecx: int <- copy 0
26 nrows, ncols <- screen-size screen
27 var dest/edx: (addr int) <- get env, nrows
28 copy-to *dest, nrows
29 dest <- get env, ncols
30 copy-to *dest, ncols
31 var repl-col/ecx: int <- copy ncols
32 repl-col <- shift-right 1
33 dest <- get env, code-separator-col
34 copy-to *dest, repl-col
35 }
36
37 fn draw-screen _env: (addr environment) {
38 var env/esi: (addr environment) <- copy _env
39 var screen-ah/eax: (addr handle screen) <- get env, screen
40 var _screen/eax: (addr screen) <- lookup *screen-ah
41 var screen/edi: (addr screen) <- copy _screen
42 var dest/edx: (addr int) <- get env, code-separator-col
43 var tmp/eax: int <- copy *dest
44 clear-canvas env
45 tmp <- add 2
46 move-cursor screen, 3, tmp
47 }
48
49 fn initialize-environment-with-fake-screen _self: (addr environment), nrows: int, ncols: int {
50 var self/esi: (addr environment) <- copy _self
51 var screen-ah/eax: (addr handle screen) <- get self, screen
52 allocate screen-ah
53 var screen-addr/eax: (addr screen) <- lookup *screen-ah
54 initialize-screen screen-addr, nrows, ncols
55 initialize-environment self
56 }
57
58
59
60
61
62 fn process _self: (addr environment), key: grapheme {
63 $process:body: {
64 var self/esi: (addr environment) <- copy _self
65 var sandbox-ah/eax: (addr handle sandbox) <- get self, sandboxes
66 var _sandbox/eax: (addr sandbox) <- lookup *sandbox-ah
67 var sandbox/edi: (addr sandbox) <- copy _sandbox
68 var rename-word-mode-ah?/ecx: (addr handle word) <- get sandbox, partial-name-for-cursor-word
69 var rename-word-mode?/eax: (addr word) <- lookup *rename-word-mode-ah?
70 compare rename-word-mode?, 0
71 {
72 break-if-=
73
74 process-sandbox-rename sandbox, key
75 break $process:body
76 }
77 var define-function-mode-ah?/ecx: (addr handle word) <- get sandbox, partial-name-for-function
78 var define-function-mode?/eax: (addr word) <- lookup *define-function-mode-ah?
79 compare define-function-mode?, 0
80 {
81 break-if-=
82
83 var functions/ecx: (addr handle function) <- get self, functions
84 process-sandbox-define sandbox, functions, key
85 break $process:body
86 }
87
88 process-sandbox self, sandbox, key
89 }
90 }
91
92 fn process-sandbox _self: (addr environment), _sandbox: (addr sandbox), key: grapheme {
93 $process-sandbox:body: {
94 var self/esi: (addr environment) <- copy _self
95 var sandbox/edi: (addr sandbox) <- copy _sandbox
96 var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
97 var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah
98 var cursor-word-ah/ebx: (addr handle word) <- get cursor-call-path, word
99 var _cursor-word/eax: (addr word) <- lookup *cursor-word-ah
100 var cursor-word/ecx: (addr word) <- copy _cursor-word
101 compare key, 0x445b1b
102 $process-sandbox:key-left-arrow: {
103 break-if-!=
104
105
106 var at-start?/eax: boolean <- cursor-at-start? cursor-word
107 compare at-start?, 0
108 {
109 break-if-!=
110
111 cursor-left cursor-word
112 break $process-sandbox:body
113 }
114
115 {
116 var cursor-call-path/esi: (addr handle call-path-element) <- get sandbox, cursor-call-path
117 var expanded-words/edx: (addr handle call-path) <- get sandbox, expanded-words
118 var curr-word-is-expanded?/eax: boolean <- find-in-call-paths expanded-words, cursor-call-path
119 compare curr-word-is-expanded?, 0
120 break-if-=
121
122
123 var self/ecx: (addr environment) <- copy _self
124 var functions/ecx: (addr handle function) <- get self, functions
125 var body: (handle line)
126 var body-ah/eax: (addr handle line) <- address body
127 function-body functions, cursor-word-ah, body-ah
128 var body-addr/eax: (addr line) <- lookup *body-ah
129 var first-word-ah/edx: (addr handle word) <- get body-addr, data
130 var final-word-h: (handle word)
131 var final-word-ah/eax: (addr handle word) <- address final-word-h
132 final-word first-word-ah, final-word-ah
133 push-to-call-path-element cursor-call-path, final-word-ah
134
135 var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
136 var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah
137 var cursor-word-ah/eax: (addr handle word) <- get cursor-call-path, word
138 var cursor-word/eax: (addr word) <- lookup *cursor-word-ah
139 cursor-to-end cursor-word
140 break $process-sandbox:body
141 }
142
143 $process-sandbox:key-left-arrow-first-word: {
144 var prev-word-ah/edx: (addr handle word) <- get cursor-word, prev
145 var prev-word/eax: (addr word) <- lookup *prev-word-ah
146 compare prev-word, 0
147 break-if-!=
148 $process-sandbox:key-left-arrow-first-word-and-caller: {
149
150 {
151 var cursor-call-path-ah/edi: (addr handle call-path-element) <- get sandbox, cursor-call-path
152 var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah
153 var next-cursor-element-ah/edx: (addr handle call-path-element) <- get cursor-call-path, next
154 var next-cursor-element/eax: (addr call-path-element) <- lookup *next-cursor-element-ah
155 compare next-cursor-element, 0
156 break-if-= $process-sandbox:key-left-arrow-first-word-and-caller
157 copy-object next-cursor-element-ah, cursor-call-path-ah
158 }
159 var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
160 var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah
161 var cursor-word-ah/eax: (addr handle word) <- get cursor-call-path, word
162 var _cursor-word/eax: (addr word) <- lookup *cursor-word-ah
163 cursor-word <- copy _cursor-word
164 }
165 }
166
167 var prev-word-ah/edx: (addr handle word) <- get cursor-word, prev
168 var prev-word/eax: (addr word) <- lookup *prev-word-ah
169 {
170 compare prev-word, 0
171 break-if-=
172
173 cursor-to-end prev-word
174
175
176
177
178
179
180
181
182
183
184 var cursor-call-path/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
185 decrement-final-element cursor-call-path
186
187
188
189
190
191
192
193
194
195
196 }
197 break $process-sandbox:body
198 }
199 compare key, 0x435b1b
200 $process-sandbox:key-right-arrow: {
201 break-if-!=
202
203 var at-end?/eax: boolean <- cursor-at-end? cursor-word
204 compare at-end?, 0
205 {
206 break-if-!=
207
208 cursor-right cursor-word
209 break $process-sandbox:body
210 }
211
212 {
213 var next-word-ah/edx: (addr handle word) <- get cursor-word, next
214 var next-word/eax: (addr word) <- lookup *next-word-ah
215 compare next-word, 0
216 break-if-!=
217 var cursor-call-path-ah/edi: (addr handle call-path-element) <- get sandbox, cursor-call-path
218 var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah
219 var next-cursor-element-ah/ecx: (addr handle call-path-element) <- get cursor-call-path, next
220 var next-cursor-element/eax: (addr call-path-element) <- lookup *next-cursor-element-ah
221 compare next-cursor-element, 0
222 break-if-=
223 copy-object next-cursor-element-ah, cursor-call-path-ah
224 break $process-sandbox:body
225 }
226
227 var next-word-ah/edx: (addr handle word) <- get cursor-word, next
228 var next-word/eax: (addr word) <- lookup *next-word-ah
229 {
230 compare next-word, 0
231 break-if-=
232
233 cursor-to-start next-word
234
235 var cursor-call-path/ecx: (addr handle call-path-element) <- get sandbox, cursor-call-path
236 increment-final-element cursor-call-path
237
238
239 $process-sandbox:key-right-arrow-next-word-is-call-expanded: {
240
241 {
242 var expanded-words/eax: (addr handle call-path) <- get sandbox, expanded-words
243 var curr-word-is-expanded?/eax: boolean <- find-in-call-paths expanded-words, cursor-call-path
244 compare curr-word-is-expanded?, 0
245 break-if-= $process-sandbox:key-right-arrow-next-word-is-call-expanded
246 }
247 var callee-h: (handle function)
248 var callee-ah/edx: (addr handle function) <- address callee-h
249 var functions/ebx: (addr handle function) <- get self, functions
250 callee functions, next-word, callee-ah
251 var callee/eax: (addr function) <- lookup *callee-ah
252 var callee-body-ah/eax: (addr handle line) <- get callee, body
253 var callee-body/eax: (addr line) <- lookup *callee-body-ah
254 var callee-body-first-word/edx: (addr handle word) <- get callee-body, data
255 push-to-call-path-element cursor-call-path, callee-body-first-word
256
257 var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
258 var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah
259 var cursor-word-ah/eax: (addr handle word) <- get cursor-call-path, word
260 var cursor-word/eax: (addr word) <- lookup *cursor-word-ah
261 cursor-to-start cursor-word
262
263 break $process-sandbox:body
264 }
265 }
266 break $process-sandbox:body
267 }
268 compare key, 0xa
269 {
270 break-if-!=
271
272 toggle-cursor-word sandbox
273 break $process-sandbox:body
274 }
275 compare key, 0xc
276 $process-sandbox:new-line: {
277 break-if-!=
278
279 append-line sandbox
280 break $process-sandbox:body
281 }
282
283 compare key, 2
284 $process-sandbox:prev-word: {
285 break-if-!=
286
287 var prev-word-ah/edx: (addr handle word) <- get cursor-word, prev
288 var prev-word/eax: (addr word) <- lookup *prev-word-ah
289 {
290 compare prev-word, 0
291 break-if-=
292 cursor-to-end prev-word
293 var cursor-call-path/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
294 decrement-final-element cursor-call-path
295 break $process-sandbox:body
296 }
297
298 {
299 var cursor-call-path-ah/edi: (addr handle call-path-element) <- get sandbox, cursor-call-path
300 var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah
301 var caller-cursor-element-ah/ecx: (addr handle call-path-element) <- get cursor-call-path, next
302 var caller-cursor-element/eax: (addr call-path-element) <- lookup *caller-cursor-element-ah
303 compare caller-cursor-element, 0
304 break-if-=
305
306 var caller-word-ah/eax: (addr handle word) <- get caller-cursor-element, word
307 var caller-word/eax: (addr word) <- lookup *caller-word-ah
308 var word-before-caller-ah/eax: (addr handle word) <- get caller-word, prev
309 var word-before-caller/eax: (addr word) <- lookup *word-before-caller-ah
310 compare word-before-caller, 0
311 break-if-=
312
313 drop-from-call-path-element cursor-call-path-ah
314 decrement-final-element cursor-call-path-ah
315 break $process-sandbox:body
316 }
317 }
318 compare key, 6
319 $process-sandbox:next-word: {
320 break-if-!=
321
322
323 var next-word-ah/edx: (addr handle word) <- get cursor-word, next
324 var next-word/eax: (addr word) <- lookup *next-word-ah
325 {
326 compare next-word, 0
327 break-if-=
328
329 cursor-to-end next-word
330 var cursor-call-path/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
331 increment-final-element cursor-call-path
332 break $process-sandbox:body
333 }
334
335
336 var cursor-call-path-ah/edi: (addr handle call-path-element) <- get sandbox, cursor-call-path
337 var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah
338 var caller-cursor-element-ah/ecx: (addr handle call-path-element) <- get cursor-call-path, next
339 var caller-cursor-element/eax: (addr call-path-element) <- lookup *caller-cursor-element-ah
340 compare caller-cursor-element, 0
341 break-if-=
342
343 copy-object caller-cursor-element-ah, cursor-call-path-ah
344 break $process-sandbox:body
345 }
346
347 compare key, 1
348 $process-sandbox:start-of-line: {
349 break-if-!=
350
351 var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
352 drop-nested-calls cursor-call-path-ah
353 move-final-element-to-start-of-line cursor-call-path-ah
354
355 var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah
356 var cursor-word-ah/eax: (addr handle word) <- get cursor-call-path, word
357 var cursor-word/eax: (addr word) <- lookup *cursor-word-ah
358 cursor-to-start cursor-word
359
360
361 break $process-sandbox:body
362 }
363 compare key, 5
364 $process-sandbox:end-of-line: {
365 break-if-!=
366
367 var cursor-call-path-ah/ecx: (addr handle call-path-element) <- get sandbox, cursor-call-path
368 initialize-path-from-sandbox sandbox, cursor-call-path-ah
369 var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah
370 var dest/eax: (addr handle word) <- get cursor-call-path, word
371 final-word dest, dest
372
373 var cursor-word/eax: (addr word) <- lookup *cursor-word-ah
374 cursor-to-end cursor-word
375
376
377 break $process-sandbox:body
378 }
379 compare key, 0x15
380 $process-sandbox:clear-line: {
381 break-if-!=
382
383 initialize-sandbox sandbox
384 break $process-sandbox:body
385 }
386
387 var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
388 var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah
389 var next-cursor-element-ah/eax: (addr handle call-path-element) <- get cursor-call-path, next
390 var next-cursor-element/eax: (addr call-path-element) <- lookup *next-cursor-element-ah
391 compare next-cursor-element, 0
392 break-if-!= $process-sandbox:body
393
394 compare key, 0x7f
395 $process-sandbox:backspace: {
396 break-if-!=
397
398 var at-start?/eax: boolean <- cursor-at-start? cursor-word
399 compare at-start?, 0
400 {
401 break-if-!=
402 delete-before-cursor cursor-word
403 break $process-sandbox:body
404 }
405
406 var prev-word-ah/eax: (addr handle word) <- get cursor-word, prev
407 var prev-word/eax: (addr word) <- lookup *prev-word-ah
408 {
409 compare prev-word, 0
410 break-if-=
411 cursor-to-end prev-word
412 delete-next prev-word
413 var cursor-call-path/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
414 decrement-final-element cursor-call-path
415 }
416 break $process-sandbox:body
417 }
418 compare key, 0x20
419 $process-sandbox:space: {
420 break-if-!=
421
422
423 {
424 var at-start?/eax: boolean <- cursor-at-start? cursor-word
425 compare at-start?, 0
426 break-if-=
427 var prev-word-ah/eax: (addr handle word) <- get cursor-word, prev
428 append-word prev-word-ah
429 var cursor-call-path/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
430 decrement-final-element cursor-call-path
431 break $process-sandbox:body
432 }
433
434
435 {
436 var first-grapheme/eax: grapheme <- first-grapheme cursor-word
437 compare first-grapheme, 0x22
438 break-if-!=
439 var final-grapheme/eax: grapheme <- grapheme-before-cursor cursor-word
440 compare final-grapheme, 0x22
441 break-if-=
442 break $process-sandbox:space
443 }
444
445
446 {
447 var first-grapheme/eax: grapheme <- first-grapheme cursor-word
448 compare first-grapheme, 0x5b
449 break-if-!=
450 var final-grapheme/eax: grapheme <- grapheme-before-cursor cursor-word
451 compare final-grapheme, 0x5d
452 break-if-=
453 break $process-sandbox:space
454 }
455
456
457 append-word cursor-word-ah
458 var cursor-call-path/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
459 increment-final-element cursor-call-path
460
461 var at-end?/eax: boolean <- cursor-at-end? cursor-word
462 compare at-end?, 0
463 break-if-!= $process-sandbox:body
464
465
466 var next-word-ah/eax: (addr handle word) <- get cursor-word, next
467 var _next-word/eax: (addr word) <- lookup *next-word-ah
468 var next-word/ebx: (addr word) <- copy _next-word
469 {
470 var at-end?/eax: boolean <- cursor-at-end? cursor-word
471 compare at-end?, 0
472 break-if-!=
473 var g/eax: grapheme <- pop-after-cursor cursor-word
474 add-grapheme-to-word next-word, g
475 loop
476 }
477 cursor-to-start next-word
478 break $process-sandbox:body
479 }
480 compare key, 0xe
481 $process:rename-word: {
482 break-if-!=
483
484
485 var new-name-ah/eax: (addr handle word) <- get sandbox, partial-name-for-cursor-word
486 allocate new-name-ah
487 var new-name/eax: (addr word) <- lookup *new-name-ah
488 initialize-word new-name
489 break $process-sandbox:body
490 }
491 compare key, 4
492 $process:define-function: {
493 break-if-!=
494
495 var new-name-ah/eax: (addr handle word) <- get sandbox, partial-name-for-function
496 allocate new-name-ah
497 var new-name/eax: (addr word) <- lookup *new-name-ah
498 initialize-word new-name
499 break $process-sandbox:body
500 }
501
502 var g/edx: grapheme <- copy key
503 var print?/eax: boolean <- real-grapheme? key
504 $process-sandbox:real-grapheme: {
505 compare print?, 0
506 break-if-=
507 add-grapheme-to-word cursor-word, g
508 break $process-sandbox:body
509 }
510
511 }
512 }
513
514
515
516
517 fn process-sandbox-rename _sandbox: (addr sandbox), key: grapheme {
518 $process-sandbox-rename:body: {
519 var sandbox/esi: (addr sandbox) <- copy _sandbox
520 var new-name-ah/edi: (addr handle word) <- get sandbox, partial-name-for-cursor-word
521
522 compare key, 0x1b
523 $process-sandbox-rename:cancel: {
524 break-if-!=
525 var empty: (handle word)
526 copy-handle empty, new-name-ah
527 break $process-sandbox-rename:body
528 }
529
530 compare key, 0xa
531 $process-sandbox-rename:commit: {
532 break-if-!=
533
534
535 var new-line-h: (handle line)
536 var new-line-ah/eax: (addr handle line) <- address new-line-h
537 allocate new-line-ah
538 var new-line/eax: (addr line) <- lookup *new-line-ah
539 initialize-line new-line
540 var new-line-word-ah/ecx: (addr handle word) <- get new-line, data
541 {
542
543 var cursor-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
544 var cursor/eax: (addr call-path-element) <- lookup *cursor-ah
545 var word-at-cursor-ah/eax: (addr handle word) <- get cursor, word
546
547
548
549
550
551
552 move-word-contents word-at-cursor-ah, new-line-word-ah
553
554 copy-word-contents-before-cursor new-name-ah, word-at-cursor-ah
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573 }
574
575 {
576 var new-name/eax: (addr word) <- lookup *new-name-ah
577 cursor-to-start new-name
578 add-grapheme-to-word new-name, 0x3d
579 }
580
581 chain-words new-line-word-ah, new-name-ah
582
583 var new-line-next/ecx: (addr handle line) <- get new-line, next
584 var sandbox-slot/edx: (addr handle line) <- get sandbox, data
585 copy-object sandbox-slot, new-line-next
586
587 copy-handle new-line-h, sandbox-slot
588
589 var empty: (handle word)
590 copy-handle empty, new-name-ah
591
592
593
594
595
596
597
598
599
600
601
602
603
604 break $process-sandbox-rename:body
605 }
606
607 compare key, 0x7f
608 $process-sandbox-rename:backspace: {
609 break-if-!=
610
611 var new-name/eax: (addr word) <- lookup *new-name-ah
612 var at-start?/eax: boolean <- cursor-at-start? new-name
613 compare at-start?, 0
614 {
615 break-if-!=
616 var new-name/eax: (addr word) <- lookup *new-name-ah
617 delete-before-cursor new-name
618 }
619 break $process-sandbox-rename:body
620 }
621
622 var print?/eax: boolean <- real-grapheme? key
623 $process-sandbox-rename:real-grapheme: {
624 compare print?, 0
625 break-if-=
626 var new-name/eax: (addr word) <- lookup *new-name-ah
627 add-grapheme-to-word new-name, key
628 break $process-sandbox-rename:body
629 }
630
631 }
632 }
633
634
635
636
637
638 fn process-sandbox-define _sandbox: (addr sandbox), functions: (addr handle function), key: grapheme {
639 $process-sandbox-define:body: {
640 var sandbox/esi: (addr sandbox) <- copy _sandbox
641 var new-name-ah/edi: (addr handle word) <- get sandbox, partial-name-for-function
642
643 compare key, 0x1b
644 $process-sandbox-define:cancel: {
645 break-if-!=
646 var empty: (handle word)
647 copy-handle empty, new-name-ah
648 break $process-sandbox-define:body
649 }
650
651 compare key, 0xa
652 $process-sandbox-define:commit: {
653 break-if-!=
654
655
656 var new-function: (handle function)
657 var new-function-ah/ecx: (addr handle function) <- address new-function
658 allocate new-function-ah
659 var _new-function/eax: (addr function) <- lookup *new-function-ah
660 var new-function/ebx: (addr function) <- copy _new-function
661 var dest/edx: (addr handle function) <- get new-function, next
662 copy-object functions, dest
663 copy-object new-function-ah, functions
664
665 var new-name/eax: (addr word) <- lookup *new-name-ah
666 var dest/edx: (addr handle array byte) <- get new-function, name
667 word-to-string new-name, dest
668
669 var body-ah/eax: (addr handle line) <- get new-function, body
670 allocate body-ah
671 var body/eax: (addr line) <- lookup *body-ah
672 var body-contents/ecx: (addr handle word) <- get body, data
673 var final-line-storage: (handle line)
674 var final-line-ah/eax: (addr handle line) <- address final-line-storage
675 final-line sandbox, final-line-ah
676 var final-line/eax: (addr line) <- lookup *final-line-ah
677 var final-line-contents/eax: (addr handle word) <- get final-line, data
678 copy-object final-line-contents, body-contents
679
680 copy-unbound-words-to-args functions
681
682 var empty-word: (handle word)
683 copy-handle empty-word, final-line-contents
684 construct-call functions, final-line-contents
685
686 var empty-word: (handle word)
687 copy-handle empty-word, new-name-ah
688
689 var final-line/eax: (addr line) <- lookup final-line-storage
690 var cursor-call-path-ah/ecx: (addr handle call-path-element) <- get sandbox, cursor-call-path
691 allocate cursor-call-path-ah
692 initialize-path-from-line final-line, cursor-call-path-ah
693 break $process-sandbox-define:body
694 }
695
696 compare key, 0x7f
697 $process-sandbox-define:backspace: {
698 break-if-!=
699
700 var new-name/eax: (addr word) <- lookup *new-name-ah
701 var at-start?/eax: boolean <- cursor-at-start? new-name
702 compare at-start?, 0
703 {
704 break-if-!=
705 var new-name/eax: (addr word) <- lookup *new-name-ah
706 delete-before-cursor new-name
707 }
708 break $process-sandbox-define:body
709 }
710
711 var print?/eax: boolean <- real-grapheme? key
712 $process-sandbox-define:real-grapheme: {
713 compare print?, 0
714 break-if-=
715 var new-name/eax: (addr word) <- lookup *new-name-ah
716 add-grapheme-to-word new-name, key
717 break $process-sandbox-define:body
718 }
719
720 }
721 }
722
723
724
725
726 fn copy-unbound-words-to-args _functions: (addr handle function) {
727
728 var target-ah/eax: (addr handle function) <- copy _functions
729 var _target/eax: (addr function) <- lookup *target-ah
730 var target/esi: (addr function) <- copy _target
731 var dest-ah/edi: (addr handle word) <- get target, args
732
733 var functions-ah/edx: (addr handle function) <- get target, next
734
735 var line-ah/eax: (addr handle line) <- get target, body
736 var line/eax: (addr line) <- lookup *line-ah
737 var curr-ah/eax: (addr handle word) <- get line, data
738 var curr/eax: (addr word) <- lookup *curr-ah
739 {
740 compare curr, 0
741 break-if-=
742 $copy-unbound-words-to-args:loop-iter: {
743
744 {
745 var is-int?/eax: boolean <- word-is-decimal-integer? curr
746 compare is-int?, 0
747 break-if-!= $copy-unbound-words-to-args:loop-iter
748 }
749
750 var bound?/ebx: boolean <- bound-function? curr, functions-ah
751 compare bound?, 0
752 break-if-!=
753
754 var dup?/ebx: boolean <- arg-exists? _functions, curr
755 compare dup?, 0
756 break-if-!= $copy-unbound-words-to-args:loop-iter
757
758 var rest-h: (handle word)
759 var rest-ah/ecx: (addr handle word) <- address rest-h
760 copy-object dest-ah, rest-ah
761 copy-word curr, dest-ah
762 chain-words dest-ah, rest-ah
763 }
764 var next-ah/ecx: (addr handle word) <- get curr, next
765 curr <- lookup *next-ah
766 loop
767 }
768 }
769
770 fn bound-function? w: (addr word), functions-ah: (addr handle function) -> _/ebx: boolean {
771 var result/ebx: boolean <- copy 1
772 {
773
774
775 var subresult/eax: boolean <- word-equal? w, "+"
776 compare subresult, 0
777 break-if-!=
778
779 subresult <- word-equal? w, "-"
780 compare subresult, 0
781 break-if-!=
782
783 subresult <- word-equal? w, "*"
784 compare subresult, 0
785 break-if-!=
786
787
788 subresult <- word-equal? w, "len"
789 compare subresult, 0
790 break-if-!=
791
792
793 subresult <- word-equal? w, "open"
794 compare subresult, 0
795 break-if-!=
796
797 subresult <- word-equal? w, "read"
798 compare subresult, 0
799 break-if-!=
800
801 subresult <- word-equal? w, "slurp"
802 compare subresult, 0
803 break-if-!=
804
805 subresult <- word-equal? w, "lines"
806 compare subresult, 0
807 break-if-!=
808
809
810 subresult <- word-equal? w, "fake-screen"
811 compare subresult, 0
812 break-if-!=
813
814 subresult <- word-equal? w, "print"
815 compare subresult, 0
816 break-if-!=
817
818 subresult <- word-equal? w, "move"
819 compare subresult, 0
820 break-if-!=
821
822 subresult <- word-equal? w, "up"
823 compare subresult, 0
824 break-if-!=
825
826 subresult <- word-equal? w, "down"
827 compare subresult, 0
828 break-if-!=
829
830 subresult <- word-equal? w, "left"
831 compare subresult, 0
832 break-if-!=
833
834 subresult <- word-equal? w, "right"
835 compare subresult, 0
836 break-if-!=
837
838
839 subresult <- word-equal? w, "dup"
840 compare subresult, 0
841 break-if-!=
842
843 subresult <- word-equal? w, "swap"
844 compare subresult, 0
845 break-if-!=
846
847 var out-h: (handle function)
848 var out/eax: (addr handle function) <- address out-h
849 callee functions-ah, w, out
850 var found?/eax: (addr function) <- lookup *out
851 result <- copy found?
852 }
853 return result
854 }
855
856 fn arg-exists? _f-ah: (addr handle function), arg: (addr word) -> _/ebx: boolean {
857 var f-ah/eax: (addr handle function) <- copy _f-ah
858 var f/eax: (addr function) <- lookup *f-ah
859 var args-ah/eax: (addr handle word) <- get f, args
860 var result/ebx: boolean <- word-exists? args-ah, arg
861 return result
862 }
863
864
865 fn construct-call _f-ah: (addr handle function), _dest-ah: (addr handle word) {
866 var f-ah/eax: (addr handle function) <- copy _f-ah
867 var _f/eax: (addr function) <- lookup *f-ah
868 var f/esi: (addr function) <- copy _f
869
870 var args-ah/eax: (addr handle word) <- get f, args
871 var dest-ah/edi: (addr handle word) <- copy _dest-ah
872 copy-words-in-reverse args-ah, dest-ah
873
874 var name-ah/eax: (addr handle array byte) <- get f, name
875 var name/eax: (addr array byte) <- lookup *name-ah
876 append-word-at-end-with dest-ah, name
877 }
878
879 fn word-index _words: (addr handle word), _n: int, out: (addr handle word) {
880 $word-index:body: {
881 var n/ecx: int <- copy _n
882 {
883 compare n, 0
884 break-if-!=
885 copy-object _words, out
886 break $word-index:body
887 }
888 var words-ah/eax: (addr handle word) <- copy _words
889 var words/eax: (addr word) <- lookup *words-ah
890 var next/eax: (addr handle word) <- get words, next
891 n <- decrement
892 word-index next, n, out
893 }
894 }
895
896 fn toggle-cursor-word _sandbox: (addr sandbox) {
897 $toggle-cursor-word:body: {
898 var sandbox/esi: (addr sandbox) <- copy _sandbox
899 var expanded-words/edi: (addr handle call-path) <- get sandbox, expanded-words
900 var cursor-call-path/ecx: (addr handle call-path-element) <- get sandbox, cursor-call-path
901
902
903
904
905 var already-expanded?/eax: boolean <- find-in-call-paths expanded-words, cursor-call-path
906 compare already-expanded?, 0
907 {
908 break-if-!=
909
910
911 insert-in-call-path expanded-words cursor-call-path
912
913
914 break $toggle-cursor-word:body
915 }
916 {
917 break-if-=
918
919 delete-in-call-path expanded-words cursor-call-path
920 }
921 }
922 }
923
924 fn append-line _sandbox: (addr sandbox) {
925 var sandbox/esi: (addr sandbox) <- copy _sandbox
926 var line-ah/ecx: (addr handle line) <- get sandbox, data
927 {
928 var line/eax: (addr line) <- lookup *line-ah
929 var next-line-ah/edx: (addr handle line) <- get line, next
930 var next-line/eax: (addr line) <- lookup *next-line-ah
931 compare next-line, 0
932 break-if-=
933 line-ah <- copy next-line-ah
934 loop
935 }
936 var line/eax: (addr line) <- lookup *line-ah
937 var final-line-ah/edx: (addr handle line) <- get line, next
938 allocate final-line-ah
939 var final-line/eax: (addr line) <- lookup *final-line-ah
940 initialize-line final-line
941 var final-prev/eax: (addr handle line) <- get final-line, prev
942 copy-object line-ah, final-prev
943
944 var final-line/eax: (addr line) <- lookup *final-line-ah
945 var word-ah/ecx: (addr handle word) <- get final-line, data
946 var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
947 var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah
948 var dest/eax: (addr handle word) <- get cursor-call-path, word
949 copy-object word-ah, dest
950 }
951
952
953
954
955
956 fn evaluate-environment _env: (addr environment), stack: (addr value-stack) {
957 var env/esi: (addr environment) <- copy _env
958
959 var functions/edx: (addr handle function) <- get env, functions
960
961 var sandbox-ah/esi: (addr handle sandbox) <- get env, sandboxes
962 var sandbox/eax: (addr sandbox) <- lookup *sandbox-ah
963 var line-ah/eax: (addr handle line) <- get sandbox, data
964 var _line/eax: (addr line) <- lookup *line-ah
965 var line/esi: (addr line) <- copy _line
966 evaluate functions, 0, line, 0, stack
967 }
968
969 fn render _env: (addr environment) {
970
971 var env/esi: (addr environment) <- copy _env
972 clear-canvas env
973
974 var screen-ah/eax: (addr handle screen) <- get env, screen
975 var _screen/eax: (addr screen) <- lookup *screen-ah
976 var screen/edi: (addr screen) <- copy _screen
977
978 var _repl-col/eax: (addr int) <- get env, code-separator-col
979 var repl-col/ecx: int <- copy *_repl-col
980 repl-col <- add 2
981
982 var functions/edx: (addr handle function) <- get env, functions
983
984 var sandbox-ah/eax: (addr handle sandbox) <- get env, sandboxes
985 var sandbox/eax: (addr sandbox) <- lookup *sandbox-ah
986
987 var bindings-storage: table
988 var bindings/ebx: (addr table) <- address bindings-storage
989 initialize-table bindings, 0x10
990
991 render-sandbox screen, functions, bindings, sandbox, 3, repl-col
992
993 }
994
995 fn render-sandbox screen: (addr screen), functions: (addr handle function), bindings: (addr table), _sandbox: (addr sandbox), top-row: int, left-col: int {
996 var sandbox/esi: (addr sandbox) <- copy _sandbox
997
998 var curr-line-ah/eax: (addr handle line) <- get sandbox, data
999 var _curr-line/eax: (addr line) <- lookup *curr-line-ah
1000 var curr-line/ecx: (addr line) <- copy _curr-line
1001
1002 var curr-row/edx: int <- copy top-row
1003
1004 var cursor-row: int
1005 var cursor-row-addr: (addr int)
1006 var tmp/eax: (addr int) <- address cursor-row
1007 copy-to cursor-row-addr, tmp
1008 var cursor-col: int
1009 var cursor-col-addr: (addr int)
1010 tmp <- address cursor-col
1011 copy-to cursor-col-addr, tmp
1012
1013
1014 {
1015 var next-line-ah/eax: (addr handle line) <- get curr-line, next
1016 var next-line/eax: (addr line) <- lookup *next-line-ah
1017 compare next-line, 0
1018 break-if-=
1019 {
1020 var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
1021 var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah
1022 var cursor-word-ah/eax: (addr handle word) <- get cursor-call-path, word
1023 var cursor-word/eax: (addr word) <- lookup *cursor-word-ah
1024
1025 render-line-without-stack screen, curr-line, curr-row, left-col, cursor-word, cursor-row-addr, cursor-col-addr
1026 }
1027 curr-line <- copy next-line
1028 curr-row <- add 2
1029 loop
1030 }
1031
1032 render-final-line-with-stack screen, functions, bindings, sandbox, curr-row, left-col, cursor-row-addr, cursor-col-addr
1033
1034 render-rename-dialog screen, sandbox, cursor-row, cursor-col
1035 render-define-dialog screen, sandbox, cursor-row, cursor-col
1036 move-cursor screen, cursor-row, cursor-col
1037 }
1038
1039 fn render-final-line-with-stack screen: (addr screen), functions: (addr handle function), bindings: (addr table), _sandbox: (addr sandbox), top-row: int, left-col: int, cursor-row-addr: (addr int), cursor-col-addr: (addr int) {
1040 var sandbox/esi: (addr sandbox) <- copy _sandbox
1041
1042 var expanded-words/edi: (addr handle call-path) <- get sandbox, expanded-words
1043
1044 var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
1045 var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah
1046 var cursor-word-ah/eax: (addr handle word) <- get cursor-call-path, word
1047 var _cursor-word/eax: (addr word) <- lookup *cursor-word-ah
1048 var cursor-word/ebx: (addr word) <- copy _cursor-word
1049
1050
1051
1052
1053 var cursor-call-path: (addr handle call-path-element)
1054 {
1055 var src/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
1056 copy-to cursor-call-path, src
1057 }
1058
1059 var first-line-ah/eax: (addr handle line) <- get sandbox, data
1060 var _first-line/eax: (addr line) <- lookup *first-line-ah
1061 var first-line/edx: (addr line) <- copy _first-line
1062
1063 var final-line-storage: (handle line)
1064 var final-line-ah/eax: (addr handle line) <- address final-line-storage
1065 final-line sandbox, final-line-ah
1066 var final-line/eax: (addr line) <- lookup *final-line-ah
1067
1068 var curr-path-storage: (handle call-path-element)
1069 var curr-path/ecx: (addr handle call-path-element) <- address curr-path-storage
1070 allocate curr-path
1071 initialize-path-from-line final-line, curr-path
1072
1073 var dummy/ecx: int <- render-line screen, functions, bindings, first-line, final-line, expanded-words, top-row, left-col, curr-path, cursor-word, cursor-call-path, cursor-row-addr, cursor-col-addr
1074 }
1075
1076 fn final-line _sandbox: (addr sandbox), out: (addr handle line) {
1077 var sandbox/esi: (addr sandbox) <- copy _sandbox
1078 var curr-line-ah/ecx: (addr handle line) <- get sandbox, data
1079 {
1080 var curr-line/eax: (addr line) <- lookup *curr-line-ah
1081 var next-line-ah/edx: (addr handle line) <- get curr-line, next
1082 var next-line/eax: (addr line) <- lookup *next-line-ah
1083 compare next-line, 0
1084 break-if-=
1085 curr-line-ah <- copy next-line-ah
1086 loop
1087 }
1088 copy-object curr-line-ah, out
1089 }
1090
1091 fn render-rename-dialog screen: (addr screen), _sandbox: (addr sandbox), cursor-row: int, cursor-col: int {
1092 var sandbox/edi: (addr sandbox) <- copy _sandbox
1093 var rename-word-mode-ah?/ecx: (addr handle word) <- get sandbox, partial-name-for-cursor-word
1094 var rename-word-mode?/eax: (addr word) <- lookup *rename-word-mode-ah?
1095 compare rename-word-mode?, 0
1096 break-if-=
1097
1098 var top-row/eax: int <- copy cursor-row
1099 top-row <- subtract 3
1100 var bottom-row/ecx: int <- copy cursor-row
1101 bottom-row <- add 3
1102 var left-col/edx: int <- copy cursor-col
1103 left-col <- subtract 0x10
1104 var right-col/ebx: int <- copy cursor-col
1105 right-col <- add 0x10
1106 clear-rect screen, top-row, left-col, bottom-row, right-col
1107 draw-box screen, top-row, left-col, bottom-row, right-col
1108
1109 var menu-row/ecx: int <- copy bottom-row
1110 menu-row <- decrement
1111 var menu-col/edx: int <- copy left-col
1112 menu-col <- add 2
1113 move-cursor screen, menu-row, menu-col
1114 start-reverse-video screen
1115 print-string screen, " esc "
1116 reset-formatting screen
1117 print-string screen, " cancel "
1118 start-reverse-video screen
1119 print-string screen, " enter "
1120 reset-formatting screen
1121 print-string screen, " rename "
1122
1123 var start-col/ecx: int <- copy cursor-col
1124 var word-ah?/edx: (addr handle word) <- get sandbox, partial-name-for-cursor-word
1125 var word/eax: (addr word) <- lookup *word-ah?
1126 var cursor-index/eax: int <- cursor-index word
1127 start-col <- subtract cursor-index
1128 move-cursor screen, cursor-row, start-col
1129 var word/eax: (addr word) <- lookup *word-ah?
1130 print-word screen, word
1131 }
1132
1133 fn render-define-dialog screen: (addr screen), _sandbox: (addr sandbox), cursor-row: int, cursor-col: int {
1134 var sandbox/edi: (addr sandbox) <- copy _sandbox
1135 var define-function-mode-ah?/ecx: (addr handle word) <- get sandbox, partial-name-for-function
1136 var define-function-mode?/eax: (addr word) <- lookup *define-function-mode-ah?
1137 compare define-function-mode?, 0
1138 break-if-=
1139
1140 var top-row/eax: int <- copy cursor-row
1141 top-row <- subtract 3
1142 var bottom-row/ecx: int <- copy cursor-row
1143 bottom-row <- add 3
1144 var left-col/edx: int <- copy cursor-col
1145 left-col <- subtract 0x10
1146 var right-col/ebx: int <- copy cursor-col
1147 right-col <- add 0x10
1148 clear-rect screen, top-row, left-col, bottom-row, right-col
1149 draw-box screen, top-row, left-col, bottom-row, right-col
1150
1151 var menu-row/ecx: int <- copy bottom-row
1152 menu-row <- decrement
1153 var menu-col/edx: int <- copy left-col
1154 menu-col <- add 2
1155 move-cursor screen, menu-row, menu-col
1156 start-reverse-video screen
1157 print-string screen, " esc "
1158 reset-formatting screen
1159 print-string screen, " cancel "
1160 start-reverse-video screen
1161 print-string screen, " enter "
1162 reset-formatting screen
1163 print-string screen, " define "
1164
1165 var start-col/ecx: int <- copy cursor-col
1166 var word-ah?/edx: (addr handle word) <- get sandbox, partial-name-for-function
1167 var word/eax: (addr word) <- lookup *word-ah?
1168 var cursor-index/eax: int <- cursor-index word
1169 start-col <- subtract cursor-index
1170 move-cursor screen, cursor-row, start-col
1171 var word/eax: (addr word) <- lookup *word-ah?
1172 print-word screen, word
1173 }
1174
1175
1176 fn render-line-without-stack screen: (addr screen), _line: (addr line), curr-row: int, left-col: int, cursor-word: (addr word), cursor-row-addr: (addr int), cursor-col-addr: (addr int) {
1177
1178 var line/eax: (addr line) <- copy _line
1179 var first-word-ah/eax: (addr handle word) <- get line, data
1180 var _curr-word/eax: (addr word) <- lookup *first-word-ah
1181 var curr-word/esi: (addr word) <- copy _curr-word
1182
1183
1184 var curr-col/ecx: int <- copy left-col
1185
1186 {
1187 compare curr-word, 0
1188 break-if-=
1189
1190
1191
1192
1193
1194
1195 var old-col/edx: int <- copy curr-col
1196 reset-formatting screen
1197 move-cursor screen, curr-row, curr-col
1198 print-word screen, curr-word
1199 {
1200 var max-width/eax: int <- word-length curr-word
1201 curr-col <- add max-width
1202 curr-col <- add 1
1203 }
1204
1205 {
1206 compare curr-word, cursor-word
1207 break-if-!=
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221 var dest/ecx: (addr int) <- copy cursor-row-addr
1222 var src/eax: int <- copy curr-row
1223 copy-to *dest, src
1224 dest <- copy cursor-col-addr
1225 copy-to *dest, old-col
1226 var cursor-index-in-word/eax: int <- cursor-index curr-word
1227 add-to *dest, cursor-index-in-word
1228 }
1229
1230 var next-word-ah/edx: (addr handle word) <- get curr-word, next
1231 var _curr-word/eax: (addr word) <- lookup *next-word-ah
1232 curr-word <- copy _curr-word
1233 loop
1234 }
1235 }
1236
1237 fn call-depth-at-cursor _sandbox: (addr sandbox) -> _/eax: int {
1238 var sandbox/esi: (addr sandbox) <- copy _sandbox
1239 var cursor-call-path/edi: (addr handle call-path-element) <- get sandbox, cursor-call-path
1240 var result/eax: int <- call-path-element-length cursor-call-path
1241 result <- add 2
1242 return result
1243 }
1244
1245 fn call-path-element-length _x: (addr handle call-path-element) -> _/eax: int {
1246 var curr-ah/ecx: (addr handle call-path-element) <- copy _x
1247 var result/edi: int <- copy 0
1248 {
1249 var curr/eax: (addr call-path-element) <- lookup *curr-ah
1250 compare curr, 0
1251 break-if-=
1252 curr-ah <- get curr, next
1253 result <- increment
1254 loop
1255 }
1256 return result
1257 }
1258
1259
1260
1261
1262
1263 fn render-line screen: (addr screen), functions: (addr handle function), bindings: (addr table), first-line: (addr line), _line: (addr line), expanded-words: (addr handle call-path), top-row: int, left-col: int, curr-path: (addr handle call-path-element), cursor-word: (addr word), cursor-call-path: (addr handle call-path-element), cursor-row-addr: (addr int), cursor-col-addr: (addr int) -> _/ecx: int {
1264
1265
1266
1267 var line/esi: (addr line) <- copy _line
1268 var first-word-ah/eax: (addr handle word) <- get line, data
1269 var curr-word/eax: (addr word) <- lookup *first-word-ah
1270
1271
1272 var curr-col/ecx: int <- copy left-col
1273
1274 {
1275 compare curr-word, 0
1276 break-if-=
1277
1278
1279
1280
1281 $render-line:subsidiary: {
1282 {
1283
1284 var display-subsidiary-stack?/eax: boolean <- find-in-call-paths expanded-words, curr-path
1285 compare display-subsidiary-stack?, 0
1286 break-if-= $render-line:subsidiary
1287 }
1288
1289
1290 var callee/edi: (addr function) <- copy 0
1291 {
1292 var callee-h: (handle function)
1293 var callee-ah/ecx: (addr handle function) <- address callee-h
1294 callee functions, curr-word, callee-ah
1295 var _callee/eax: (addr function) <- lookup *callee-ah
1296 callee <- copy _callee
1297 compare callee, 0
1298 break-if-= $render-line:subsidiary
1299 }
1300 move-cursor screen, top-row, curr-col
1301 start-color screen, 8, 7
1302 print-word screen, curr-word
1303 {
1304 var word-len/eax: int <- word-length curr-word
1305 curr-col <- add word-len
1306 curr-col <- add 2
1307 increment top-row
1308 }
1309
1310 var stack-storage: value-stack
1311 var stack/edx: (addr value-stack) <- address stack-storage
1312 initialize-value-stack stack, 0x10
1313 {
1314 var prev-word-ah/eax: (addr handle word) <- get curr-word, prev
1315 var prev-word/eax: (addr word) <- lookup *prev-word-ah
1316 compare prev-word, 0
1317 break-if-=
1318 var bindings2-storage: table
1319 var bindings2/ebx: (addr table) <- address bindings2-storage
1320 deep-copy-table bindings, bindings2
1321 evaluate functions, bindings2, first-line, prev-word, stack
1322 }
1323
1324 var callee-bindings-storage: table
1325 var callee-bindings/esi: (addr table) <- address callee-bindings-storage
1326 initialize-table callee-bindings, 0x10
1327 bind-args callee, stack, callee-bindings
1328
1329 var callee-body-ah/eax: (addr handle line) <- get callee, body
1330 var callee-body/eax: (addr line) <- lookup *callee-body-ah
1331 var callee-body-first-word/edx: (addr handle word) <- get callee-body, data
1332
1333 push-to-call-path-element curr-path, callee-body-first-word
1334
1335
1336
1337 curr-col <- render-line screen, functions, callee-bindings, callee-body, callee-body, expanded-words, top-row, curr-col, curr-path, cursor-word, cursor-call-path, cursor-row-addr, cursor-col-addr
1338
1339 drop-from-call-path-element curr-path
1340
1341 move-cursor screen, top-row, curr-col
1342 print-code-point screen, 0x21d7
1343
1344 curr-col <- add 2
1345 decrement top-row
1346 }
1347
1348 var old-col/edx: int <- copy curr-col
1349 var bindings2-storage: table
1350 var bindings2/ebx: (addr table) <- address bindings2-storage
1351
1352 deep-copy-table bindings, bindings2
1353
1354
1355 curr-col <- render-column screen, functions, bindings2, first-line, line, curr-word, top-row, curr-col
1356
1357
1358 $render-line:cache-cursor-column: {
1359 {
1360 var found?/eax: boolean <- call-path-element-match? curr-path, cursor-call-path
1361 compare found?, 0
1362 break-if-= $render-line:cache-cursor-column
1363 }
1364 var dest/edi: (addr int) <- copy cursor-row-addr
1365 {
1366 var src/eax: int <- copy top-row
1367 copy-to *dest, src
1368 }
1369 dest <- copy cursor-col-addr
1370 copy-to *dest, old-col
1371 var cursor-index-in-word/eax: int <- cursor-index curr-word
1372 add-to *dest, cursor-index-in-word
1373 }
1374
1375
1376 var next-word-ah/edx: (addr handle word) <- get curr-word, next
1377 curr-word <- lookup *next-word-ah
1378
1379
1380
1381
1382
1383 increment-final-element curr-path
1384 loop
1385 }
1386 return curr-col
1387 }
1388
1389 fn callee functions: (addr handle function), word: (addr word), out: (addr handle function) {
1390 var stream-storage: (stream byte 0x10)
1391 var stream/esi: (addr stream byte) <- address stream-storage
1392 emit-word word, stream
1393 find-function functions, stream, out
1394 }
1395
1396
1397
1398
1399
1400
1401 fn render-column screen: (addr screen), functions: (addr handle function), bindings: (addr table), first-line: (addr line), line: (addr line), final-word: (addr word), top-row: int, left-col: int -> _/ecx: int {
1402
1403
1404 var max-width/esi: int <- copy 0
1405 {
1406
1407 var stack: value-stack
1408 var stack-addr/edi: (addr value-stack) <- address stack
1409 initialize-value-stack stack-addr, 0x10
1410
1411 var bindings2-storage: table
1412 var bindings2/ebx: (addr table) <- address bindings2-storage
1413
1414 deep-copy-table bindings, bindings2
1415
1416 evaluate functions, bindings2, first-line, final-word, stack-addr
1417
1418 var indented-col/ebx: int <- copy left-col
1419 indented-col <- add 1
1420
1421 var curr-row/edx: int <- copy top-row
1422 curr-row <- add 2
1423 var _max-width/eax: int <- value-stack-max-width stack-addr
1424 max-width <- copy _max-width
1425 {
1426 var top-addr/ecx: (addr int) <- get stack-addr, top
1427 compare *top-addr, 0
1428 break-if-<=
1429 decrement *top-addr
1430 var data-ah/eax: (addr handle array value) <- get stack-addr, data
1431 var data/eax: (addr array value) <- lookup *data-ah
1432 var top/ecx: int <- copy *top-addr
1433 var dest-offset/ecx: (offset value) <- compute-offset data, top
1434 var val/eax: (addr value) <- index data, dest-offset
1435 render-value-at screen, curr-row, indented-col, val, max-width
1436 var height/eax: int <- value-height val
1437 curr-row <- add height
1438 loop
1439 }
1440 }
1441
1442 max-width <- add 2
1443
1444
1445 reset-formatting screen
1446 move-cursor screen, top-row, left-col
1447 print-word screen, final-word
1448 {
1449 var size/eax: int <- word-length final-word
1450 compare size, max-width
1451 break-if-<=
1452 max-width <- copy size
1453 }
1454
1455
1456 var right-col/ecx: int <- copy left-col
1457 right-col <- add max-width
1458 right-col <- add 1
1459
1460
1461
1462
1463 return right-col
1464 }
1465
1466 fn clear-canvas _env: (addr environment) {
1467 var env/esi: (addr environment) <- copy _env
1468 var screen-ah/edi: (addr handle screen) <- get env, screen
1469 var _screen/eax: (addr screen) <- lookup *screen-ah
1470 var screen/edi: (addr screen) <- copy _screen
1471 clear-screen screen
1472 var nrows/eax: (addr int) <- get env, nrows
1473 var _repl-col/ecx: (addr int) <- get env, code-separator-col
1474 var repl-col/ecx: int <- copy *_repl-col
1475 draw-vertical-line screen, 1, *nrows, repl-col
1476
1477 move-cursor screen, *nrows, 0
1478 start-reverse-video screen
1479 print-string screen, " ctrl-q "
1480 reset-formatting screen
1481 print-string screen, " quit "
1482 var menu-start/ebx: int <- copy repl-col
1483 menu-start <- subtract 0x40
1484 move-cursor screen, *nrows, menu-start
1485 start-reverse-video screen
1486 print-string screen, " ctrl-a "
1487 reset-formatting screen
1488 print-string screen, " ⏮ "
1489 start-reverse-video screen
1490 print-string screen, " ctrl-b "
1491 reset-formatting screen
1492 print-string screen, " ◀ word "
1493 start-reverse-video screen
1494 print-string screen, " ctrl-f "
1495 reset-formatting screen
1496 print-string screen, " word ▶ "
1497 start-reverse-video screen
1498 print-string screen, " ctrl-e "
1499 reset-formatting screen
1500 print-string screen, " ⏭ "
1501 start-reverse-video screen
1502 print-string screen, " ctrl-u "
1503 reset-formatting screen
1504 print-string screen, " clear line "
1505 start-reverse-video screen
1506 print-string screen, " ctrl-n "
1507 reset-formatting screen
1508 print-string screen, " name value "
1509 start-reverse-video screen
1510 print-string screen, " ctrl-d "
1511 reset-formatting screen
1512 print-string screen, " define function "
1513
1514 var start-col/ecx: int <- copy repl-col
1515 start-col <- subtract 0x28
1516 move-cursor screen, 1, start-col
1517 print-string screen, "primitives:"
1518 start-col <- add 2
1519 move-cursor screen, 2, start-col
1520 print-string screen, "+ - * len"
1521 move-cursor screen, 3, start-col
1522 print-string screen, "open read slurp lines"
1523 move-cursor screen, 4, start-col
1524 print-string screen, "fake-screen print move"
1525 move-cursor screen, 5, start-col
1526 print-string screen, "up down left right"
1527 move-cursor screen, 6, start-col
1528 print-string screen, "dup swap"
1529
1530 start-col <- subtract 2
1531 move-cursor screen, 8, start-col
1532 print-string screen, "functions:"
1533 start-col <- add 2
1534 var row/ebx: int <- copy 9
1535 var functions/esi: (addr handle function) <- get env, functions
1536 {
1537 var curr/eax: (addr function) <- lookup *functions
1538 compare curr, 0
1539 break-if-=
1540 row <- render-function screen, row, start-col, curr
1541 functions <- get curr, next
1542 row <- increment
1543 loop
1544 }
1545 }
1546
1547
1548 fn render-function screen: (addr screen), row: int, col: int, _f: (addr function) -> _/ebx: int {
1549 var f/esi: (addr function) <- copy _f
1550 var args/ecx: (addr handle word) <- get f, args
1551 move-cursor screen, row, col
1552 print-words-in-reverse screen, args
1553 var name-ah/eax: (addr handle array byte) <- get f, name
1554 var name/eax: (addr array byte) <- lookup *name-ah
1555 start-bold screen
1556 print-string screen, name
1557 reset-formatting screen
1558 increment row
1559 add-to col, 2
1560 move-cursor screen, row, col
1561 print-string screen, "= "
1562 var body-ah/eax: (addr handle line) <- get f, body
1563 var body/eax: (addr line) <- lookup *body-ah
1564 var body-words-ah/eax: (addr handle word) <- get body, data
1565 print-words screen, body-words-ah
1566 return row
1567 }
1568
1569 fn real-grapheme? g: grapheme -> _/eax: boolean {
1570
1571 compare g, 0xa
1572 {
1573 break-if-!=
1574 return 1
1575 }
1576
1577 compare g, 9
1578 {
1579 break-if-!=
1580 return 1
1581 }
1582
1583 compare g, 0x20
1584 {
1585 break-if->=
1586 return 0
1587 }
1588
1589 compare g, 0xff
1590 {
1591 break-if->
1592 return 1
1593 }
1594
1595 and-with g, 0xff
1596 compare g, 0x1b
1597 {
1598 break-if-!=
1599 return 0
1600 }
1601
1602 return 1
1603 }