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