From 264aba4d929da6899af0672fcda7cc7a877099ec Mon Sep 17 00:00:00 2001 From: Kartik Agaram Date: Sun, 15 Nov 2020 23:23:05 -0800 Subject: 7249 --- html/apps/tile/data.mu.html | 211 ++-- html/apps/tile/environment.mu.html | 2151 +++++++++++++++++++----------------- html/apps/tile/rpn.mu.html | 1609 ++++++++++++++------------- html/apps/tile/value.mu.html | 592 +++++----- html/apps/tile/word.mu.html | 20 +- 5 files changed, 2366 insertions(+), 2217 deletions(-) (limited to 'html/apps/tile') diff --git a/html/apps/tile/data.mu.html b/html/apps/tile/data.mu.html index 3e3eacd4..9cfd5f38 100644 --- a/html/apps/tile/data.mu.html +++ b/html/apps/tile/data.mu.html @@ -444,11 +444,11 @@ if ('onhashchange' in window) { 385 var body-ah/edi: (addr handle line) <- address body-storage 386 function-body functions, function-name, body-ah 387 var body/eax: (addr line) <- lookup *body-ah -388 var result/eax: int <- line-length body +388 var result/eax: int <- num-words-in-line body 389 return result 390 } 391 -392 fn line-length _in: (addr line) -> _/eax: int { +392 fn num-words-in-line _in: (addr line) -> _/eax: int { 393 var in/esi: (addr line) <- copy _in 394 var curr-ah/ecx: (addr handle word) <- get in, data 395 var result/edi: int <- copy 0 @@ -678,73 +678,146 @@ if ('onhashchange' in window) { 619 move-final-element-to-start-of-line list 620 } 621 -622 fn push-to-call-path-element list: (addr handle call-path-element), new: (addr handle word) { -623 var new-element-storage: (handle call-path-element) -624 var new-element-ah/edi: (addr handle call-path-element) <- address new-element-storage -625 allocate new-element-ah -626 var new-element/eax: (addr call-path-element) <- lookup *new-element-ah -627 # save word -628 var dest/ecx: (addr handle word) <- get new-element, word -629 copy-object new, dest -630 # save next -631 var dest2/ecx: (addr handle call-path-element) <- get new-element, next -632 copy-object list, dest2 -633 # return -634 copy-object new-element-ah, list -635 } -636 -637 fn drop-from-call-path-element _list: (addr handle call-path-element) { -638 var list-ah/esi: (addr handle call-path-element) <- copy _list -639 var list/eax: (addr call-path-element) <- lookup *list-ah -640 var next/eax: (addr handle call-path-element) <- get list, next -641 copy-object next, _list -642 } -643 -644 fn drop-nested-calls _list: (addr handle call-path-element) { -645 var list-ah/esi: (addr handle call-path-element) <- copy _list -646 var list/eax: (addr call-path-element) <- lookup *list-ah -647 var next-ah/edi: (addr handle call-path-element) <- get list, next -648 var next/eax: (addr call-path-element) <- lookup *next-ah -649 compare next, 0 -650 break-if-= -651 copy-object next-ah, _list -652 drop-nested-calls _list -653 } -654 -655 fn dump-call-path-element screen: (addr screen), _x-ah: (addr handle call-path-element) { -656 var x-ah/ecx: (addr handle call-path-element) <- copy _x-ah -657 var _x/eax: (addr call-path-element) <- lookup *x-ah -658 var x/esi: (addr call-path-element) <- copy _x -659 var word-ah/eax: (addr handle word) <- get x, word -660 var word/eax: (addr word) <- lookup *word-ah -661 print-word screen, word -662 var next-ah/ecx: (addr handle call-path-element) <- get x, next -663 var next/eax: (addr call-path-element) <- lookup *next-ah -664 compare next, 0 -665 { -666 break-if-= -667 print-string screen, " " -668 dump-call-path-element screen, next-ah -669 return -670 } -671 print-string screen, "\n" -672 } -673 -674 fn dump-call-paths screen: (addr screen), _x-ah: (addr handle call-path) { -675 var x-ah/ecx: (addr handle call-path) <- copy _x-ah -676 var x/eax: (addr call-path) <- lookup *x-ah -677 compare x, 0 -678 break-if-= -679 var src/ecx: (addr handle call-path-element) <- get x, data -680 dump-call-path-element screen, src -681 var next-ah/ecx: (addr handle call-path) <- get x, next -682 var next/eax: (addr call-path) <- lookup *next-ah -683 compare next, 0 -684 { -685 break-if-= -686 dump-call-paths screen, next-ah -687 } -688 } +622 fn move-final-element-to-end-of-line list: (addr handle call-path-element) { +623 var final-ah/eax: (addr handle call-path-element) <- copy list +624 var final/eax: (addr call-path-element) <- lookup *final-ah +625 var val-ah/ecx: (addr handle word) <- get final, word +626 var val/eax: (addr word) <- lookup *val-ah +627 var new-ah/edx: (addr handle word) <- get val, next +628 var target/eax: (addr word) <- lookup *new-ah +629 compare target, 0 +630 break-if-= +631 copy-object new-ah, val-ah +632 move-final-element-to-end-of-line list +633 } +634 +635 fn push-to-call-path-element list: (addr handle call-path-element), new: (addr handle word) { +636 var new-element-storage: (handle call-path-element) +637 var new-element-ah/edi: (addr handle call-path-element) <- address new-element-storage +638 allocate new-element-ah +639 var new-element/eax: (addr call-path-element) <- lookup *new-element-ah +640 # save word +641 var dest/ecx: (addr handle word) <- get new-element, word +642 copy-object new, dest +643 # save next +644 var dest2/ecx: (addr handle call-path-element) <- get new-element, next +645 copy-object list, dest2 +646 # return +647 copy-object new-element-ah, list +648 } +649 +650 fn drop-from-call-path-element _list: (addr handle call-path-element) { +651 var list-ah/esi: (addr handle call-path-element) <- copy _list +652 var list/eax: (addr call-path-element) <- lookup *list-ah +653 var next/eax: (addr handle call-path-element) <- get list, next +654 copy-object next, _list +655 } +656 +657 fn drop-nested-calls _list: (addr handle call-path-element) { +658 var list-ah/esi: (addr handle call-path-element) <- copy _list +659 var list/eax: (addr call-path-element) <- lookup *list-ah +660 var next-ah/edi: (addr handle call-path-element) <- get list, next +661 var next/eax: (addr call-path-element) <- lookup *next-ah +662 compare next, 0 +663 break-if-= +664 copy-object next-ah, _list +665 drop-nested-calls _list +666 } +667 +668 fn dump-call-path-element screen: (addr screen), _x-ah: (addr handle call-path-element) { +669 var x-ah/ecx: (addr handle call-path-element) <- copy _x-ah +670 var _x/eax: (addr call-path-element) <- lookup *x-ah +671 var x/esi: (addr call-path-element) <- copy _x +672 var word-ah/eax: (addr handle word) <- get x, word +673 var word/eax: (addr word) <- lookup *word-ah +674 print-word screen, word +675 var next-ah/ecx: (addr handle call-path-element) <- get x, next +676 var next/eax: (addr call-path-element) <- lookup *next-ah +677 compare next, 0 +678 { +679 break-if-= +680 print-string screen, " " +681 dump-call-path-element screen, next-ah +682 return +683 } +684 print-string screen, "\n" +685 } +686 +687 fn dump-call-paths screen: (addr screen), _x-ah: (addr handle call-path) { +688 var x-ah/ecx: (addr handle call-path) <- copy _x-ah +689 var x/eax: (addr call-path) <- lookup *x-ah +690 compare x, 0 +691 break-if-= +692 var src/ecx: (addr handle call-path-element) <- get x, data +693 dump-call-path-element screen, src +694 var next-ah/ecx: (addr handle call-path) <- get x, next +695 var next/eax: (addr call-path) <- lookup *next-ah +696 compare next, 0 +697 { +698 break-if-= +699 dump-call-paths screen, next-ah +700 } +701 } +702 +703 fn function-width _self: (addr function) -> _/eax: int { +704 var self/esi: (addr function) <- copy _self +705 var args/ecx: (addr handle word) <- get self, args +706 var arg-width/eax: int <- word-list-length args +707 var result/edi: int <- copy arg-width +708 result <- add 4 # function-header-indent + body-indent +709 var body-ah/eax: (addr handle line) <- get self, body +710 var body-width/eax: int <- body-width body-ah +711 body-width <- add 1 # right margin +712 body-width <- add 2 # body-indent for "≡ " +713 compare result, body-width +714 { +715 break-if->= +716 result <- copy body-width +717 } +718 return result +719 } +720 +721 fn body-width lines: (addr handle line) -> _/eax: int { +722 var curr-ah/esi: (addr handle line) <- copy lines +723 var result/edi: int <- copy 0 +724 { +725 var curr/eax: (addr line) <- lookup *curr-ah +726 compare curr, 0 +727 break-if-= +728 { +729 var words/ecx: (addr handle word) <- get curr, data +730 var curr-len/eax: int <- word-list-length words +731 compare curr-len, result +732 break-if-<= +733 result <- copy curr-len +734 } +735 curr-ah <- get curr, next +736 loop +737 } +738 return result +739 } +740 +741 fn function-height _self: (addr function) -> _/eax: int { +742 var self/esi: (addr function) <- copy _self +743 var body-ah/eax: (addr handle line) <- get self, body +744 var result/eax: int <- line-list-length body-ah +745 result <- increment # for function header +746 return result +747 } +748 +749 fn line-list-length lines: (addr handle line) -> _/eax: int { +750 var curr-ah/esi: (addr handle line) <- copy lines +751 var result/edi: int <- copy 0 +752 { +753 var curr/eax: (addr line) <- lookup *curr-ah +754 compare curr, 0 +755 break-if-= +756 curr-ah <- get curr, next +757 result <- increment +758 loop +759 } +760 return result +761 } diff --git a/html/apps/tile/environment.mu.html b/html/apps/tile/environment.mu.html index a2080d59..3fedae36 100644 --- a/html/apps/tile/environment.mu.html +++ b/html/apps/tile/environment.mu.html @@ -101,7 +101,7 @@ if ('onhashchange' in window) { 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 + 44 clear-canvas env 45 tmp <- add 2 # repl-margin-left 46 move-cursor screen, 3, tmp # input-row 47 } @@ -141,7 +141,7 @@ if ('onhashchange' in window) { 81 break-if-= 82 #? print-string 0, "processing function definition\n" 83 var functions/ecx: (addr handle function) <- get self, functions - 84 process-sandbox-define sandbox, functions, key + 84 process-sandbox-define sandbox, functions, key 85 break $process:body 86 } 87 #? print-string 0, "processing sandbox\n" @@ -307,9 +307,9 @@ if ('onhashchange' in window) { 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 + 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 @@ -329,14 +329,14 @@ if ('onhashchange' in window) { 269 { 270 break-if-!= 271 # toggle display of subsidiary stack - 272 toggle-cursor-word sandbox + 272 toggle-cursor-word sandbox 273 break $process-sandbox:body 274 } 275 compare key, 0xc # ctrl-l 276 $process-sandbox:new-line: { 277 break-if-!= 278 # new line in sandbox - 279 append-line sandbox + 279 append-line sandbox 280 break $process-sandbox:body 281 } 282 # word-based motions @@ -411,7 +411,7 @@ if ('onhashchange' in window) { 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 # move cursor to start of initial word + 354 # move cursor to start of word 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 @@ -423,13 +423,13 @@ if ('onhashchange' in window) { 363 compare key, 5 # ctrl-e 364 $process-sandbox:end-of-line: { 365 break-if-!= - 366 # move cursor to final word of sandbox - 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 # move cursor to end of final word + 366 # move cursor up past all calls and to start of line + 367 var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path + 368 drop-nested-calls cursor-call-path-ah + 369 move-final-element-to-end-of-line cursor-call-path-ah + 370 # move cursor to end of word + 371 var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah + 372 var cursor-word-ah/eax: (addr handle word) <- get cursor-call-path, word 373 var cursor-word/eax: (addr word) <- lookup *cursor-word-ah 374 cursor-to-end cursor-word 375 # this works because expanded words lie to the right of their bodies @@ -560,7 +560,7 @@ if ('onhashchange' in window) { 500 } 501 # otherwise insert key within current word 502 var g/edx: grapheme <- copy key - 503 var print?/eax: boolean <- real-grapheme? key + 503 var print?/eax: boolean <- real-grapheme? key 504 $process-sandbox:real-grapheme: { 505 compare print?, 0 # false 506 break-if-= @@ -582,986 +582,986 @@ if ('onhashchange' in window) { 522 compare key, 0x1b # esc 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 # if 'enter' pressed, perform rename - 530 compare key, 0xa # enter - 531 $process-sandbox-rename:commit: { - 532 break-if-!= - 533 #? print-string 0, "rename\n" - 534 # new line - 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 # move word at cursor to new line - 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 #? print-string 0, "cursor before at word " - 547 #? { - 548 #? var cursor-word/eax: (addr word) <- lookup *word-at-cursor-ah - 549 #? print-word 0, cursor-word - 550 #? print-string 0, "\n" - 551 #? } - 552 move-word-contents word-at-cursor-ah, new-line-word-ah - 553 # copy name to word at cursor - 554 copy-word-contents-before-cursor new-name-ah, word-at-cursor-ah - 555 #? print-string 0, "cursor after at word " - 556 #? { - 557 #? var cursor-word/eax: (addr word) <- lookup *word-at-cursor-ah - 558 #? print-word 0, cursor-word - 559 #? print-string 0, "\n" - 560 #? var foo/eax: int <- copy cursor-word - 561 #? print-int32-hex 0, foo - 562 #? print-string 0, "\n" - 563 #? } - 564 #? print-string 0, "new name word " - 565 #? { - 566 #? var new-name/eax: (addr word) <- lookup *new-name-ah - 567 #? print-word 0, new-name - 568 #? print-string 0, "\n" - 569 #? var foo/eax: int <- copy new-name - 570 #? print-int32-hex 0, foo - 571 #? print-string 0, "\n" - 572 #? } - 573 } - 574 # prepend '=' to name - 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 # append name to new line - 581 chain-words new-line-word-ah, new-name-ah - 582 # new-line->next = sandbox->data - 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 # sandbox->data = new-line - 587 copy-handle new-line-h, sandbox-slot - 588 # clear partial-name-for-cursor-word - 589 var empty: (handle word) - 590 copy-handle empty, new-name-ah - 591 #? # XXX - 592 #? var cursor-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path - 593 #? var cursor/eax: (addr call-path-element) <- lookup *cursor-ah - 594 #? var word-at-cursor-ah/eax: (addr handle word) <- get cursor, word - 595 #? print-string 0, "cursor after rename: " - 596 #? { - 597 #? var cursor-word/eax: (addr word) <- lookup *word-at-cursor-ah - 598 #? print-word 0, cursor-word - 599 #? print-string 0, " -- " - 600 #? var foo/eax: int <- copy cursor-word - 601 #? print-int32-hex 0, foo - 602 #? print-string 0, "\n" - 603 #? } - 604 break $process-sandbox-rename:body - 605 } - 606 # - 607 compare key, 0x7f # del (backspace on Macs) - 608 $process-sandbox-rename:backspace: { - 609 break-if-!= - 610 # if not at start, delete grapheme before cursor - 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 # false - 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 # otherwise insert key within current word - 622 var print?/eax: boolean <- real-grapheme? key - 623 $process-sandbox-rename:real-grapheme: { - 624 compare print?, 0 # false - 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 # silently ignore other hotkeys - 631 } - 632 } - 633 - 634 # collect new name in partial-name-for-function, and then define the last line - 635 # of the sandbox to be a new function with that name. Replace the last line - 636 # with a call to the appropriate function. - 637 # Precondition: cursor-call-path is a singleton (not within a call) - 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 # if 'esc' pressed, cancel define - 643 compare key, 0x1b # esc - 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 # if 'enter' pressed, perform define - 651 compare key, 0xa # enter - 652 $process-sandbox-define:commit: { - 653 break-if-!= - 654 #? print-string 0, "define\n" - 655 # create new function - 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 # set function name to new-name - 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 # move final line to body - 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 # + 525 clear-object new-name-ah + 526 break $process-sandbox-rename:body + 527 } + 528 # if 'enter' pressed, perform rename + 529 compare key, 0xa # enter + 530 $process-sandbox-rename:commit: { + 531 break-if-!= + 532 #? print-string 0, "rename\n" + 533 # new line + 534 var new-line-h: (handle line) + 535 var new-line-ah/eax: (addr handle line) <- address new-line-h + 536 allocate new-line-ah + 537 var new-line/eax: (addr line) <- lookup *new-line-ah + 538 initialize-line new-line + 539 var new-line-word-ah/ecx: (addr handle word) <- get new-line, data + 540 { + 541 # move word at cursor to new line + 542 var cursor-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path + 543 var cursor/eax: (addr call-path-element) <- lookup *cursor-ah + 544 var word-at-cursor-ah/eax: (addr handle word) <- get cursor, word + 545 #? print-string 0, "cursor before at word " + 546 #? { + 547 #? var cursor-word/eax: (addr word) <- lookup *word-at-cursor-ah + 548 #? print-word 0, cursor-word + 549 #? print-string 0, "\n" + 550 #? } + 551 move-word-contents word-at-cursor-ah, new-line-word-ah + 552 # copy name to word at cursor + 553 copy-word-contents-before-cursor new-name-ah, word-at-cursor-ah + 554 #? print-string 0, "cursor after at word " + 555 #? { + 556 #? var cursor-word/eax: (addr word) <- lookup *word-at-cursor-ah + 557 #? print-word 0, cursor-word + 558 #? print-string 0, "\n" + 559 #? var foo/eax: int <- copy cursor-word + 560 #? print-int32-hex 0, foo + 561 #? print-string 0, "\n" + 562 #? } + 563 #? print-string 0, "new name word " + 564 #? { + 565 #? var new-name/eax: (addr word) <- lookup *new-name-ah + 566 #? print-word 0, new-name + 567 #? print-string 0, "\n" + 568 #? var foo/eax: int <- copy new-name + 569 #? print-int32-hex 0, foo + 570 #? print-string 0, "\n" + 571 #? } + 572 } + 573 # prepend '=' to name + 574 { + 575 var new-name/eax: (addr word) <- lookup *new-name-ah + 576 cursor-to-start new-name + 577 add-grapheme-to-word new-name, 0x3d # '=' + 578 } + 579 # append name to new line + 580 chain-words new-line-word-ah, new-name-ah + 581 # new-line->next = sandbox->data + 582 var new-line-next/ecx: (addr handle line) <- get new-line, next + 583 var sandbox-slot/edx: (addr handle line) <- get sandbox, data + 584 copy-object sandbox-slot, new-line-next + 585 # sandbox->data = new-line + 586 copy-handle new-line-h, sandbox-slot + 587 # clear partial-name-for-cursor-word + 588 clear-object new-name-ah + 589 #? var cursor-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path + 590 #? var cursor/eax: (addr call-path-element) <- lookup *cursor-ah + 591 #? var word-at-cursor-ah/eax: (addr handle word) <- get cursor, word + 592 #? print-string 0, "cursor after rename: " + 593 #? { + 594 #? var cursor-word/eax: (addr word) <- lookup *word-at-cursor-ah + 595 #? print-word 0, cursor-word + 596 #? print-string 0, " -- " + 597 #? var foo/eax: int <- copy cursor-word + 598 #? print-int32-hex 0, foo + 599 #? print-string 0, "\n" + 600 #? } + 601 break $process-sandbox-rename:body + 602 } + 603 # + 604 compare key, 0x7f # del (backspace on Macs) + 605 $process-sandbox-rename:backspace: { + 606 break-if-!= + 607 # if not at start, delete grapheme before cursor + 608 var new-name/eax: (addr word) <- lookup *new-name-ah + 609 var at-start?/eax: boolean <- cursor-at-start? new-name + 610 compare at-start?, 0 # false + 611 { + 612 break-if-!= + 613 var new-name/eax: (addr word) <- lookup *new-name-ah + 614 delete-before-cursor new-name + 615 } + 616 break $process-sandbox-rename:body + 617 } + 618 # otherwise insert key within current word + 619 var print?/eax: boolean <- real-grapheme? key + 620 $process-sandbox-rename:real-grapheme: { + 621 compare print?, 0 # false + 622 break-if-= + 623 var new-name/eax: (addr word) <- lookup *new-name-ah + 624 add-grapheme-to-word new-name, key + 625 break $process-sandbox-rename:body + 626 } + 627 # silently ignore other hotkeys + 628 } + 629 } + 630 + 631 # collect new name in partial-name-for-function, and then define the last line + 632 # of the sandbox to be a new function with that name. Replace the last line + 633 # with a call to the appropriate function. + 634 # Precondition: cursor-call-path is a singleton (not within a call) + 635 fn process-sandbox-define _sandbox: (addr sandbox), functions: (addr handle function), key: grapheme { + 636 $process-sandbox-define:body: { + 637 var sandbox/esi: (addr sandbox) <- copy _sandbox + 638 var new-name-ah/edi: (addr handle word) <- get sandbox, partial-name-for-function + 639 # if 'esc' pressed, cancel define + 640 compare key, 0x1b # esc + 641 $process-sandbox-define:cancel: { + 642 break-if-!= + 643 clear-object new-name-ah + 644 break $process-sandbox-define:body + 645 } + 646 # if 'enter' pressed, perform define + 647 compare key, 0xa # enter + 648 $process-sandbox-define:commit: { + 649 break-if-!= + 650 #? print-string 0, "define\n" + 651 # create new function + 652 var new-function: (handle function) + 653 var new-function-ah/ecx: (addr handle function) <- address new-function + 654 allocate new-function-ah + 655 var _new-function/eax: (addr function) <- lookup *new-function-ah + 656 var new-function/ebx: (addr function) <- copy _new-function + 657 var dest/edx: (addr handle function) <- get new-function, next + 658 copy-object functions, dest + 659 copy-object new-function-ah, functions + 660 # set function name to new-name + 661 var new-name/eax: (addr word) <- lookup *new-name-ah + 662 var dest/edx: (addr handle array byte) <- get new-function, name + 663 word-to-string new-name, dest + 664 # move final line to body + 665 var body-ah/eax: (addr handle line) <- get new-function, body + 666 allocate body-ah + 667 var body/eax: (addr line) <- lookup *body-ah + 668 var body-contents/ecx: (addr handle word) <- get body, data + 669 var final-line-storage: (handle line) + 670 var final-line-ah/eax: (addr handle line) <- address final-line-storage + 671 final-line sandbox, final-line-ah + 672 var final-line/eax: (addr line) <- lookup *final-line-ah + 673 var final-line-contents/eax: (addr handle word) <- get final-line, data + 674 copy-object final-line-contents, body-contents + 675 # + 676 copy-unbound-words-to-args functions + 677 # + 678 var empty-word: (handle word) + 679 copy-handle empty-word, final-line-contents + 680 construct-call functions, final-line-contents + 681 # clear partial-name-for-function 682 var empty-word: (handle word) - 683 copy-handle empty-word, final-line-contents - 684 construct-call functions, final-line-contents - 685 # clear partial-name-for-function - 686 var empty-word: (handle word) - 687 copy-handle empty-word, new-name-ah - 688 # update cursor - 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 # leak - 692 initialize-path-from-line final-line, cursor-call-path-ah - 693 break $process-sandbox-define:body - 694 } - 695 # - 696 compare key, 0x7f # del (backspace on Macs) - 697 $process-sandbox-define:backspace: { - 698 break-if-!= - 699 # if not at start, delete grapheme before cursor - 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 # false - 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 # otherwise insert key within current word - 711 var print?/eax: boolean <- real-grapheme? key - 712 $process-sandbox-define:real-grapheme: { - 713 compare print?, 0 # false - 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 # silently ignore other hotkeys - 720 } - 721 } - 722 - 723 # extract from the body of the first function in 'functions' all words that - 724 # aren't defined in the rest of 'functions'. Prepend them in reverse order. - 725 # Assumes function body is a single line for now. - 726 fn copy-unbound-words-to-args _functions: (addr handle function) { - 727 # target - 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 # next - 733 var functions-ah/edx: (addr handle function) <- get target, next - 734 # src - 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 # is it a number? - 744 { - 745 var is-int?/eax: boolean <- word-is-decimal-integer? curr - 746 compare is-int?, 0 # false - 747 break-if-!= $copy-unbound-words-to-args:loop-iter - 748 } - 749 # is it a pre-existing function? - 750 var bound?/ebx: boolean <- bound-function? curr, functions-ah - 751 compare bound?, 0 # false - 752 break-if-!= - 753 # is it already bound as an arg? - 754 var dup?/ebx: boolean <- arg-exists? _functions, curr # _functions = target-ah - 755 compare dup?, 0 # false - 756 break-if-!= $copy-unbound-words-to-args:loop-iter - 757 # push copy of curr before dest-ah - 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 # true - 772 { - 773 ## numbers - 774 # if w == "+" return true - 775 var subresult/eax: boolean <- word-equal? w, "+" + 683 copy-handle empty-word, new-name-ah + 684 # update cursor + 685 var final-line/eax: (addr line) <- lookup final-line-storage + 686 var cursor-call-path-ah/ecx: (addr handle call-path-element) <- get sandbox, cursor-call-path + 687 allocate cursor-call-path-ah # leak + 688 initialize-path-from-line final-line, cursor-call-path-ah + 689 break $process-sandbox-define:body + 690 } + 691 # + 692 compare key, 0x7f # del (backspace on Macs) + 693 $process-sandbox-define:backspace: { + 694 break-if-!= + 695 # if not at start, delete grapheme before cursor + 696 var new-name/eax: (addr word) <- lookup *new-name-ah + 697 var at-start?/eax: boolean <- cursor-at-start? new-name + 698 compare at-start?, 0 # false + 699 { + 700 break-if-!= + 701 var new-name/eax: (addr word) <- lookup *new-name-ah + 702 delete-before-cursor new-name + 703 } + 704 break $process-sandbox-define:body + 705 } + 706 # otherwise insert key within current word + 707 var print?/eax: boolean <- real-grapheme? key + 708 $process-sandbox-define:real-grapheme: { + 709 compare print?, 0 # false + 710 break-if-= + 711 var new-name/eax: (addr word) <- lookup *new-name-ah + 712 add-grapheme-to-word new-name, key + 713 break $process-sandbox-define:body + 714 } + 715 # silently ignore other hotkeys + 716 } + 717 } + 718 + 719 # extract from the body of the first function in 'functions' all words that + 720 # aren't defined in the rest of 'functions'. Prepend them in reverse order. + 721 # Assumes function body is a single line for now. + 722 fn copy-unbound-words-to-args _functions: (addr handle function) { + 723 # target + 724 var target-ah/eax: (addr handle function) <- copy _functions + 725 var _target/eax: (addr function) <- lookup *target-ah + 726 var target/esi: (addr function) <- copy _target + 727 var dest-ah/edi: (addr handle word) <- get target, args + 728 # next + 729 var functions-ah/edx: (addr handle function) <- get target, next + 730 # src + 731 var line-ah/eax: (addr handle line) <- get target, body + 732 var line/eax: (addr line) <- lookup *line-ah + 733 var curr-ah/eax: (addr handle word) <- get line, data + 734 var curr/eax: (addr word) <- lookup *curr-ah + 735 { + 736 compare curr, 0 + 737 break-if-= + 738 $copy-unbound-words-to-args:loop-iter: { + 739 # is it a number? + 740 { + 741 var is-int?/eax: boolean <- word-is-decimal-integer? curr + 742 compare is-int?, 0 # false + 743 break-if-!= $copy-unbound-words-to-args:loop-iter + 744 } + 745 # is it a pre-existing function? + 746 var bound?/ebx: boolean <- bound-function? curr, functions-ah + 747 compare bound?, 0 # false + 748 break-if-!= + 749 # is it already bound as an arg? + 750 var dup?/ebx: boolean <- arg-exists? _functions, curr # _functions = target-ah + 751 compare dup?, 0 # false + 752 break-if-!= $copy-unbound-words-to-args:loop-iter + 753 # push copy of curr before dest-ah + 754 var rest-h: (handle word) + 755 var rest-ah/ecx: (addr handle word) <- address rest-h + 756 copy-object dest-ah, rest-ah + 757 copy-word curr, dest-ah + 758 chain-words dest-ah, rest-ah + 759 } + 760 var next-ah/ecx: (addr handle word) <- get curr, next + 761 curr <- lookup *next-ah + 762 loop + 763 } + 764 } + 765 + 766 fn bound-function? w: (addr word), functions-ah: (addr handle function) -> _/ebx: boolean { + 767 var result/ebx: boolean <- copy 1 # true + 768 { + 769 ## numbers + 770 # if w == "+" return true + 771 var subresult/eax: boolean <- word-equal? w, "+" + 772 compare subresult, 0 # false + 773 break-if-!= + 774 # if w == "-" return true + 775 subresult <- word-equal? w, "-" 776 compare subresult, 0 # false 777 break-if-!= - 778 # if w == "-" return true - 779 subresult <- word-equal? w, "-" + 778 # if w == "*" return true + 779 subresult <- word-equal? w, "*" 780 compare subresult, 0 # false 781 break-if-!= - 782 # if w == "*" return true - 783 subresult <- word-equal? w, "*" - 784 compare subresult, 0 # false - 785 break-if-!= - 786 ## strings/arrays - 787 # if w == "len" return true - 788 subresult <- word-equal? w, "len" - 789 compare subresult, 0 # false - 790 break-if-!= - 791 ## files - 792 # if w == "open" return true - 793 subresult <- word-equal? w, "open" + 782 ## strings/arrays + 783 # if w == "len" return true + 784 subresult <- word-equal? w, "len" + 785 compare subresult, 0 # false + 786 break-if-!= + 787 ## files + 788 # if w == "open" return true + 789 subresult <- word-equal? w, "open" + 790 compare subresult, 0 # false + 791 break-if-!= + 792 # if w == "read" return true + 793 subresult <- word-equal? w, "read" 794 compare subresult, 0 # false 795 break-if-!= - 796 # if w == "read" return true - 797 subresult <- word-equal? w, "read" + 796 # if w == "slurp" return true + 797 subresult <- word-equal? w, "slurp" 798 compare subresult, 0 # false 799 break-if-!= - 800 # if w == "slurp" return true - 801 subresult <- word-equal? w, "slurp" + 800 # if w == "lines" return true + 801 subresult <- word-equal? w, "lines" 802 compare subresult, 0 # false 803 break-if-!= - 804 # if w == "lines" return true - 805 subresult <- word-equal? w, "lines" - 806 compare subresult, 0 # false - 807 break-if-!= - 808 ## screens - 809 # if w == "fake-screen" return true - 810 subresult <- word-equal? w, "fake-screen" + 804 ## screens + 805 # if w == "fake-screen" return true + 806 subresult <- word-equal? w, "fake-screen" + 807 compare subresult, 0 # false + 808 break-if-!= + 809 # if w == "print" return true + 810 subresult <- word-equal? w, "print" 811 compare subresult, 0 # false 812 break-if-!= - 813 # if w == "print" return true - 814 subresult <- word-equal? w, "print" + 813 # if w == "move" return true + 814 subresult <- word-equal? w, "move" 815 compare subresult, 0 # false 816 break-if-!= - 817 # if w == "move" return true - 818 subresult <- word-equal? w, "move" + 817 # if w == "up" return true + 818 subresult <- word-equal? w, "up" 819 compare subresult, 0 # false 820 break-if-!= - 821 # if w == "up" return true - 822 subresult <- word-equal? w, "up" + 821 # if w == "down" return true + 822 subresult <- word-equal? w, "down" 823 compare subresult, 0 # false 824 break-if-!= - 825 # if w == "down" return true - 826 subresult <- word-equal? w, "down" + 825 # if w == "left" return true + 826 subresult <- word-equal? w, "left" 827 compare subresult, 0 # false 828 break-if-!= - 829 # if w == "left" return true - 830 subresult <- word-equal? w, "left" + 829 # if w == "right" return true + 830 subresult <- word-equal? w, "right" 831 compare subresult, 0 # false 832 break-if-!= - 833 # if w == "right" return true - 834 subresult <- word-equal? w, "right" - 835 compare subresult, 0 # false - 836 break-if-!= - 837 ## hacks - 838 # if w == "dup" return true - 839 subresult <- word-equal? w, "dup" + 833 ## hacks + 834 # if w == "dup" return true + 835 subresult <- word-equal? w, "dup" + 836 compare subresult, 0 # false + 837 break-if-!= + 838 # if w == "swap" return true + 839 subresult <- word-equal? w, "swap" 840 compare subresult, 0 # false 841 break-if-!= - 842 # if w == "swap" return true - 843 subresult <- word-equal? w, "swap" - 844 compare subresult, 0 # false - 845 break-if-!= - 846 # return w in functions - 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 # construct a call to `f` with copies of exactly its args - 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 # append args in reverse - 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 # append name - 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 #? print-string 0, "cursor call path: " - 902 #? dump-call-path-element 0, cursor-call-path - 903 #? print-string 0, "expanded words:\n" - 904 #? dump-call-paths 0, expanded-words - 905 var already-expanded?/eax: boolean <- find-in-call-paths expanded-words, cursor-call-path - 906 compare already-expanded?, 0 # false - 907 { - 908 break-if-!= - 909 #? print-string 0, "expand\n" - 910 # if not already-expanded, insert - 911 insert-in-call-path expanded-words cursor-call-path - 912 #? print-string 0, "expanded words now:\n" - 913 #? dump-call-paths 0, expanded-words - 914 break $toggle-cursor-word:body - 915 } - 916 { - 917 break-if-= - 918 # otherwise delete - 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 # clear cursor - 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 } + 842 # return w in functions + 843 var out-h: (handle function) + 844 var out/eax: (addr handle function) <- address out-h + 845 callee functions-ah, w, out + 846 var found?/eax: (addr function) <- lookup *out + 847 result <- copy found? + 848 } + 849 return result + 850 } + 851 + 852 fn arg-exists? _f-ah: (addr handle function), arg: (addr word) -> _/ebx: boolean { + 853 var f-ah/eax: (addr handle function) <- copy _f-ah + 854 var f/eax: (addr function) <- lookup *f-ah + 855 var args-ah/eax: (addr handle word) <- get f, args + 856 var result/ebx: boolean <- word-exists? args-ah, arg + 857 return result + 858 } + 859 + 860 # construct a call to `f` with copies of exactly its args + 861 fn construct-call _f-ah: (addr handle function), _dest-ah: (addr handle word) { + 862 var f-ah/eax: (addr handle function) <- copy _f-ah + 863 var _f/eax: (addr function) <- lookup *f-ah + 864 var f/esi: (addr function) <- copy _f + 865 # append args in reverse + 866 var args-ah/eax: (addr handle word) <- get f, args + 867 var dest-ah/edi: (addr handle word) <- copy _dest-ah + 868 copy-words-in-reverse args-ah, dest-ah + 869 # append name + 870 var name-ah/eax: (addr handle array byte) <- get f, name + 871 var name/eax: (addr array byte) <- lookup *name-ah + 872 append-word-at-end-with dest-ah, name + 873 } + 874 + 875 fn word-index _words: (addr handle word), _n: int, out: (addr handle word) { + 876 $word-index:body: { + 877 var n/ecx: int <- copy _n + 878 { + 879 compare n, 0 + 880 break-if-!= + 881 copy-object _words, out + 882 break $word-index:body + 883 } + 884 var words-ah/eax: (addr handle word) <- copy _words + 885 var words/eax: (addr word) <- lookup *words-ah + 886 var next/eax: (addr handle word) <- get words, next + 887 n <- decrement + 888 word-index next, n, out + 889 } + 890 } + 891 + 892 fn toggle-cursor-word _sandbox: (addr sandbox) { + 893 $toggle-cursor-word:body: { + 894 var sandbox/esi: (addr sandbox) <- copy _sandbox + 895 var expanded-words/edi: (addr handle call-path) <- get sandbox, expanded-words + 896 var cursor-call-path/ecx: (addr handle call-path-element) <- get sandbox, cursor-call-path + 897 #? print-string 0, "cursor call path: " + 898 #? dump-call-path-element 0, cursor-call-path + 899 #? print-string 0, "expanded words:\n" + 900 #? dump-call-paths 0, expanded-words + 901 var already-expanded?/eax: boolean <- find-in-call-paths expanded-words, cursor-call-path + 902 compare already-expanded?, 0 # false + 903 { + 904 break-if-!= + 905 #? print-string 0, "expand\n" + 906 # if not already-expanded, insert + 907 insert-in-call-path expanded-words cursor-call-path + 908 #? print-string 0, "expanded words now:\n" + 909 #? dump-call-paths 0, expanded-words + 910 break $toggle-cursor-word:body + 911 } + 912 { + 913 break-if-= + 914 # otherwise delete + 915 delete-in-call-path expanded-words cursor-call-path + 916 } + 917 } + 918 } + 919 + 920 fn append-line _sandbox: (addr sandbox) { + 921 var sandbox/esi: (addr sandbox) <- copy _sandbox + 922 var line-ah/ecx: (addr handle line) <- get sandbox, data + 923 { + 924 var line/eax: (addr line) <- lookup *line-ah + 925 var next-line-ah/edx: (addr handle line) <- get line, next + 926 var next-line/eax: (addr line) <- lookup *next-line-ah + 927 compare next-line, 0 + 928 break-if-= + 929 line-ah <- copy next-line-ah + 930 loop + 931 } + 932 var line/eax: (addr line) <- lookup *line-ah + 933 var final-line-ah/edx: (addr handle line) <- get line, next + 934 allocate final-line-ah + 935 var final-line/eax: (addr line) <- lookup *final-line-ah + 936 initialize-line final-line + 937 var final-prev/eax: (addr handle line) <- get final-line, prev + 938 copy-object line-ah, final-prev + 939 # clear cursor + 940 var final-line/eax: (addr line) <- lookup *final-line-ah + 941 var word-ah/ecx: (addr handle word) <- get final-line, data + 942 var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path + 943 var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah + 944 var dest/eax: (addr handle word) <- get cursor-call-path, word + 945 copy-object word-ah, dest + 946 } + 947 + 948 ############# + 949 # Visualize + 950 ############# 951 - 952 ############# - 953 # Visualize - 954 ############# - 955 - 956 fn evaluate-environment _env: (addr environment), stack: (addr value-stack) { - 957 var env/esi: (addr environment) <- copy _env - 958 # functions - 959 var functions/edx: (addr handle function) <- get env, functions - 960 # line - 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 #? print-string 0, "== render\n" - 971 var env/esi: (addr environment) <- copy _env - 972 clear-canvas env - 973 # screen - 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 # repl-col - 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 # repl-margin-left - 981 # functions - 982 var functions/edx: (addr handle function) <- get env, functions - 983 # sandbox - 984 var sandbox-ah/eax: (addr handle sandbox) <- get env, sandboxes - 985 var sandbox/eax: (addr sandbox) <- lookup *sandbox-ah - 986 # bindings - 987 var bindings-storage: table - 988 var bindings/ebx: (addr table) <- address bindings-storage - 989 initialize-table bindings, 0x10 - 990 #? print-string 0, "render-sandbox {\n" - 991 render-sandbox screen, functions, bindings, sandbox, 3, repl-col - 992 #? print-string 0, "render-sandbox }\n" - 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 # line - 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 # cursor row, col -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 # render all but final line without stack -1013 #? print-string 0, "render all but final line\n" -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 # it's enough to pass in the first word of the path, because if the path isn't a singleton the word is guaranteed to be unique -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 # at most one of the following dialogs will be rendered -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 # expanded-words -1042 var expanded-words/edi: (addr handle call-path) <- get sandbox, expanded-words -1043 # cursor-word -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 #? print-string 0, "word at cursor: " -1050 #? print-word 0, cursor-word -1051 #? print-string 0, "\n" -1052 # cursor-call-path -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 # first line -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 # final line -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 # curr-path -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 # leak -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 # clear a space for the dialog -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 # render a little menu for the dialog -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 + 952 fn evaluate-environment _env: (addr environment), stack: (addr value-stack) { + 953 var env/esi: (addr environment) <- copy _env + 954 # functions + 955 var functions/edx: (addr handle function) <- get env, functions + 956 # line + 957 var sandbox-ah/esi: (addr handle sandbox) <- get env, sandboxes + 958 var sandbox/eax: (addr sandbox) <- lookup *sandbox-ah + 959 var line-ah/eax: (addr handle line) <- get sandbox, data + 960 var _line/eax: (addr line) <- lookup *line-ah + 961 var line/esi: (addr line) <- copy _line + 962 evaluate functions, 0, line, 0, stack + 963 } + 964 + 965 fn render _env: (addr environment) { + 966 #? print-string 0, "== render\n" + 967 var env/esi: (addr environment) <- copy _env + 968 clear-canvas env + 969 # screen + 970 var screen-ah/eax: (addr handle screen) <- get env, screen + 971 var _screen/eax: (addr screen) <- lookup *screen-ah + 972 var screen/edi: (addr screen) <- copy _screen + 973 # repl-col + 974 var _repl-col/eax: (addr int) <- get env, code-separator-col + 975 var repl-col/ecx: int <- copy *_repl-col + 976 repl-col <- add 2 # repl-margin-left + 977 # functions + 978 var functions/edx: (addr handle function) <- get env, functions + 979 # sandbox + 980 var sandbox-ah/eax: (addr handle sandbox) <- get env, sandboxes + 981 var sandbox/eax: (addr sandbox) <- lookup *sandbox-ah + 982 # bindings + 983 var bindings-storage: table + 984 var bindings/ebx: (addr table) <- address bindings-storage + 985 initialize-table bindings, 0x10 + 986 #? print-string 0, "render-sandbox {\n" + 987 render-sandbox screen, functions, bindings, sandbox, 3, repl-col + 988 #? print-string 0, "render-sandbox }\n" + 989 } + 990 + 991 fn render-sandbox screen: (addr screen), functions: (addr handle function), bindings: (addr table), _sandbox: (addr sandbox), top-row: int, left-col: int { + 992 var sandbox/esi: (addr sandbox) <- copy _sandbox + 993 # line + 994 var curr-line-ah/eax: (addr handle line) <- get sandbox, data + 995 var _curr-line/eax: (addr line) <- lookup *curr-line-ah + 996 var curr-line/ecx: (addr line) <- copy _curr-line + 997 # + 998 var curr-row/edx: int <- copy top-row + 999 # cursor row, col +1000 var cursor-row: int +1001 var cursor-row-addr: (addr int) +1002 var tmp/eax: (addr int) <- address cursor-row +1003 copy-to cursor-row-addr, tmp +1004 var cursor-col: int +1005 var cursor-col-addr: (addr int) +1006 tmp <- address cursor-col +1007 copy-to cursor-col-addr, tmp +1008 # render all but final line without stack +1009 #? print-string 0, "render all but final line\n" +1010 { +1011 var next-line-ah/eax: (addr handle line) <- get curr-line, next +1012 var next-line/eax: (addr line) <- lookup *next-line-ah +1013 compare next-line, 0 +1014 break-if-= +1015 { +1016 var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path +1017 var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah +1018 var cursor-word-ah/eax: (addr handle word) <- get cursor-call-path, word +1019 var cursor-word/eax: (addr word) <- lookup *cursor-word-ah +1020 # it's enough to pass in the first word of the path, because if the path isn't a singleton the word is guaranteed to be unique +1021 render-line-without-stack screen, curr-line, curr-row, left-col, cursor-word, cursor-row-addr, cursor-col-addr +1022 } +1023 curr-line <- copy next-line +1024 curr-row <- add 2 +1025 loop +1026 } +1027 # +1028 render-final-line-with-stack screen, functions, bindings, sandbox, curr-row, left-col, cursor-row-addr, cursor-col-addr +1029 # at most one of the following dialogs will be rendered +1030 render-rename-dialog screen, sandbox, cursor-row, cursor-col +1031 render-define-dialog screen, sandbox, cursor-row, cursor-col +1032 move-cursor screen, cursor-row, cursor-col +1033 } +1034 +1035 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) { +1036 var sandbox/esi: (addr sandbox) <- copy _sandbox +1037 # expanded-words +1038 var expanded-words/edi: (addr handle call-path) <- get sandbox, expanded-words +1039 # cursor-word +1040 var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path +1041 var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah +1042 var cursor-word-ah/eax: (addr handle word) <- get cursor-call-path, word +1043 var _cursor-word/eax: (addr word) <- lookup *cursor-word-ah +1044 var cursor-word/ebx: (addr word) <- copy _cursor-word +1045 #? print-string 0, "word at cursor: " +1046 #? print-word 0, cursor-word +1047 #? print-string 0, "\n" +1048 # cursor-call-path +1049 var cursor-call-path: (addr handle call-path-element) +1050 { +1051 var src/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path +1052 copy-to cursor-call-path, src +1053 } +1054 # first line +1055 var first-line-ah/eax: (addr handle line) <- get sandbox, data +1056 var _first-line/eax: (addr line) <- lookup *first-line-ah +1057 var first-line/edx: (addr line) <- copy _first-line +1058 # final line +1059 var final-line-storage: (handle line) +1060 var final-line-ah/eax: (addr handle line) <- address final-line-storage +1061 final-line sandbox, final-line-ah +1062 var final-line/eax: (addr line) <- lookup *final-line-ah +1063 # curr-path +1064 var curr-path-storage: (handle call-path-element) +1065 var curr-path/ecx: (addr handle call-path-element) <- address curr-path-storage +1066 allocate curr-path # leak +1067 initialize-path-from-line final-line, curr-path +1068 # +1069 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 +1070 } +1071 +1072 fn final-line _sandbox: (addr sandbox), out: (addr handle line) { +1073 var sandbox/esi: (addr sandbox) <- copy _sandbox +1074 var curr-line-ah/ecx: (addr handle line) <- get sandbox, data +1075 { +1076 var curr-line/eax: (addr line) <- lookup *curr-line-ah +1077 var next-line-ah/edx: (addr handle line) <- get curr-line, next +1078 var next-line/eax: (addr line) <- lookup *next-line-ah +1079 compare next-line, 0 +1080 break-if-= +1081 curr-line-ah <- copy next-line-ah +1082 loop +1083 } +1084 copy-object curr-line-ah, out +1085 } +1086 +1087 fn render-rename-dialog screen: (addr screen), _sandbox: (addr sandbox), cursor-row: int, cursor-col: int { +1088 var sandbox/edi: (addr sandbox) <- copy _sandbox +1089 var rename-word-mode-ah?/ecx: (addr handle word) <- get sandbox, partial-name-for-cursor-word +1090 var rename-word-mode?/eax: (addr word) <- lookup *rename-word-mode-ah? +1091 compare rename-word-mode?, 0 +1092 break-if-= +1093 # clear a space for the dialog +1094 var top-row/eax: int <- copy cursor-row +1095 top-row <- subtract 3 +1096 var bottom-row/ecx: int <- copy cursor-row +1097 bottom-row <- add 3 +1098 var left-col/edx: int <- copy cursor-col +1099 left-col <- subtract 0x10 +1100 var right-col/ebx: int <- copy cursor-col +1101 right-col <- add 0x10 +1102 clear-rect screen, top-row, left-col, bottom-row, right-col +1103 draw-box screen, top-row, left-col, bottom-row, right-col +1104 # render a little menu for the dialog +1105 var menu-row/ecx: int <- copy bottom-row +1106 menu-row <- decrement +1107 var menu-col/edx: int <- copy left-col +1108 menu-col <- add 2 +1109 move-cursor screen, menu-row, menu-col +1110 start-reverse-video screen +1111 print-string screen, " esc " +1112 reset-formatting screen +1113 print-string screen, " cancel " 1114 start-reverse-video screen -1115 print-string screen, " esc " +1115 print-string screen, " enter " 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 # draw the word, positioned appropriately around the cursor -1123 var start-col/ecx: int <- copy cursor-col -1124 var word-ah?/edx: (addr handle word) <- get sandbox, partial-name-for-cursor-word +1117 print-string screen, " rename " +1118 # draw the word, positioned appropriately around the cursor +1119 var start-col/ecx: int <- copy cursor-col +1120 var word-ah?/edx: (addr handle word) <- get sandbox, partial-name-for-cursor-word +1121 var word/eax: (addr word) <- lookup *word-ah? +1122 var cursor-index/eax: int <- cursor-index word +1123 start-col <- subtract cursor-index +1124 move-cursor screen, cursor-row, start-col 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 # clear a space for the dialog -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 # render a little menu for the dialog -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 +1126 print-word screen, word +1127 } +1128 +1129 fn render-define-dialog screen: (addr screen), _sandbox: (addr sandbox), cursor-row: int, cursor-col: int { +1130 var sandbox/edi: (addr sandbox) <- copy _sandbox +1131 var define-function-mode-ah?/ecx: (addr handle word) <- get sandbox, partial-name-for-function +1132 var define-function-mode?/eax: (addr word) <- lookup *define-function-mode-ah? +1133 compare define-function-mode?, 0 +1134 break-if-= +1135 # clear a space for the dialog +1136 var top-row/eax: int <- copy cursor-row +1137 top-row <- subtract 3 +1138 var bottom-row/ecx: int <- copy cursor-row +1139 bottom-row <- add 3 +1140 var left-col/edx: int <- copy cursor-col +1141 left-col <- subtract 0x10 +1142 var right-col/ebx: int <- copy cursor-col +1143 right-col <- add 0x10 +1144 clear-rect screen, top-row, left-col, bottom-row, right-col +1145 draw-box screen, top-row, left-col, bottom-row, right-col +1146 # render a little menu for the dialog +1147 var menu-row/ecx: int <- copy bottom-row +1148 menu-row <- decrement +1149 var menu-col/edx: int <- copy left-col +1150 menu-col <- add 2 +1151 move-cursor screen, menu-row, menu-col +1152 start-reverse-video screen +1153 print-string screen, " esc " +1154 reset-formatting screen +1155 print-string screen, " cancel " 1156 start-reverse-video screen -1157 print-string screen, " esc " +1157 print-string screen, " enter " 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 # draw the word, positioned appropriately around the cursor -1165 var start-col/ecx: int <- copy cursor-col -1166 var word-ah?/edx: (addr handle word) <- get sandbox, partial-name-for-function +1159 print-string screen, " define " +1160 # draw the word, positioned appropriately around the cursor +1161 var start-col/ecx: int <- copy cursor-col +1162 var word-ah?/edx: (addr handle word) <- get sandbox, partial-name-for-function +1163 var word/eax: (addr word) <- lookup *word-ah? +1164 var cursor-index/eax: int <- cursor-index word +1165 start-col <- subtract cursor-index +1166 move-cursor screen, cursor-row, start-col 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 # Render just the words in 'line'. -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 # curr-word -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 # loop-carried dependency -1184 var curr-col/ecx: int <- copy left-col -1185 # -1186 { -1187 compare curr-word, 0 -1188 break-if-= -1189 #? print-string 0, "-- word in penultimate lines: " -1190 #? { -1191 #? var foo/eax: int <- copy curr-word -1192 #? print-int32-hex 0, foo -1193 #? } -1194 #? print-string 0, "\n" -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 # margin-right -1203 } -1204 # cache cursor column if necessary -1205 { -1206 compare curr-word, cursor-word -1207 break-if-!= -1208 #? print-string 0, "Cursor at " -1209 #? print-int32-decimal 0, curr-row -1210 #? print-string 0, ", " -1211 #? print-int32-decimal 0, old-col -1212 #? print-string 0, "\n" -1213 #? print-string 0, "contents: " -1214 #? print-word 0, cursor-word -1215 #? print-string 0, "\n" -1216 #? { -1217 #? var foo/eax: int <- copy cursor-word -1218 #? print-int32-hex 0, foo -1219 #? print-string 0, "\n" -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 # loop update -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 # input-row - 1 -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 # Render the line of words in line, along with the state of the stack under each word. -1260 # Also render any expanded function calls using recursive calls. -1261 # -1262 # Along the way, compute the column the cursor should be positioned at (cursor-col-addr). -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 #? print-string 0, "render-line\n" -1265 #? dump-table bindings -1266 # curr-word -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 # loop-carried dependency -1272 var curr-col/ecx: int <- copy left-col -1273 # -1274 { -1275 compare curr-word, 0 -1276 break-if-= -1277 #? print-string 0, "-- word " -1278 #? print-word 0, curr-word -1279 #? print-string 0, "\n" -1280 # if necessary, first render columns for subsidiary stack -1281 $render-line:subsidiary: { -1282 { -1283 #? print-string 0, "check sub\n" -1284 var display-subsidiary-stack?/eax: boolean <- find-in-call-paths expanded-words, curr-path -1285 compare display-subsidiary-stack?, 0 # false -1286 break-if-= $render-line:subsidiary -1287 } -1288 #? print-string 0, "render subsidiary stack\n" -1289 # does function exist? -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 # obtain stack at call site -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 # construct new bindings -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 # obtain body -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 # - render subsidiary stack -1333 push-to-call-path-element curr-path, callee-body-first-word # leak -1334 #? print-string 0, "subsidiary {\n" -1335 #? dump-table callee-bindings -1336 #? syscall_exit -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 #? print-string 0, "}\n" -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 # render main column -1348 var old-col/edx: int <- copy curr-col -1349 var bindings2-storage: table -1350 var bindings2/ebx: (addr table) <- address bindings2-storage -1351 #? print-string 0, "deep-copy {\n" -1352 deep-copy-table bindings, bindings2 -1353 #? print-string 0, "}\n" -1354 #? print-string 0, "render column {\n" -1355 curr-col <- render-column screen, functions, bindings2, first-line, line, curr-word, top-row, curr-col -1356 #? print-string 0, "}\n" -1357 # cache cursor column if necessary -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 # false -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 # loop update -1375 #? print-string 0, "next word\n" -1376 var next-word-ah/edx: (addr handle word) <- get curr-word, next -1377 curr-word <- lookup *next-word-ah -1378 #? { -1379 #? var foo/eax: int <- copy curr-word -1380 #? print-int32-hex 0, foo -1381 #? print-string 0, "\n" -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 # Render: -1397 # - starting at top-row, left-col: final-word -1398 # - starting somewhere below at left-col: the stack result from interpreting first-world to final-word (inclusive) -1399 # -1400 # Return the farthest column written. -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 #? print-string 0, "render-column\n" -1403 #? dump-table bindings -1404 var max-width/esi: int <- copy 0 -1405 { -1406 # compute stack -1407 var stack: value-stack -1408 var stack-addr/edi: (addr value-stack) <- address stack -1409 initialize-value-stack stack-addr, 0x10 # max-words -1410 # copy bindings -1411 var bindings2-storage: table -1412 var bindings2/ebx: (addr table) <- address bindings2-storage -1413 #? print-string 0, "deep copy table {\n" -1414 deep-copy-table bindings, bindings2 -1415 #? print-string 0, "}\n" -1416 evaluate functions, bindings2, first-line, final-word, stack-addr -1417 # indent stack -1418 var indented-col/ebx: int <- copy left-col -1419 indented-col <- add 1 # margin-right -1420 # render stack -1421 var curr-row/edx: int <- copy top-row -1422 curr-row <- add 2 # stack-margin-top -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 # spaces on either side of items on the stack -1443 -1444 # render word, initialize result -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 # post-process right-col -1456 var right-col/ecx: int <- copy left-col -1457 right-col <- add max-width -1458 right-col <- add 1 # margin-right -1459 #? print-int32-decimal 0, left-col -1460 #? print-string 0, " => " -1461 #? print-int32-decimal 0, right-col -1462 #? print-string 0, "\n" -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 # wordstar-style cheatsheet of shortcuts -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 # 64 = half the size of the menu -1484 move-cursor screen, *nrows, menu-start +1168 print-word screen, word +1169 } +1170 +1171 # Render just the words in 'line'. +1172 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) { +1173 # curr-word +1174 var line/eax: (addr line) <- copy _line +1175 var first-word-ah/eax: (addr handle word) <- get line, data +1176 var _curr-word/eax: (addr word) <- lookup *first-word-ah +1177 var curr-word/esi: (addr word) <- copy _curr-word +1178 # +1179 # loop-carried dependency +1180 var curr-col/ecx: int <- copy left-col +1181 # +1182 { +1183 compare curr-word, 0 +1184 break-if-= +1185 #? print-string 0, "-- word in penultimate lines: " +1186 #? { +1187 #? var foo/eax: int <- copy curr-word +1188 #? print-int32-hex 0, foo +1189 #? } +1190 #? print-string 0, "\n" +1191 var old-col/edx: int <- copy curr-col +1192 reset-formatting screen +1193 move-cursor screen, curr-row, curr-col +1194 print-word screen, curr-word +1195 { +1196 var max-width/eax: int <- word-length curr-word +1197 curr-col <- add max-width +1198 curr-col <- add 1 # margin-right +1199 } +1200 # cache cursor column if necessary +1201 { +1202 compare curr-word, cursor-word +1203 break-if-!= +1204 #? print-string 0, "Cursor at " +1205 #? print-int32-decimal 0, curr-row +1206 #? print-string 0, ", " +1207 #? print-int32-decimal 0, old-col +1208 #? print-string 0, "\n" +1209 #? print-string 0, "contents: " +1210 #? print-word 0, cursor-word +1211 #? print-string 0, "\n" +1212 #? { +1213 #? var foo/eax: int <- copy cursor-word +1214 #? print-int32-hex 0, foo +1215 #? print-string 0, "\n" +1216 #? } +1217 var dest/ecx: (addr int) <- copy cursor-row-addr +1218 var src/eax: int <- copy curr-row +1219 copy-to *dest, src +1220 dest <- copy cursor-col-addr +1221 copy-to *dest, old-col +1222 var cursor-index-in-word/eax: int <- cursor-index curr-word +1223 add-to *dest, cursor-index-in-word +1224 } +1225 # loop update +1226 var next-word-ah/edx: (addr handle word) <- get curr-word, next +1227 var _curr-word/eax: (addr word) <- lookup *next-word-ah +1228 curr-word <- copy _curr-word +1229 loop +1230 } +1231 } +1232 +1233 fn call-depth-at-cursor _sandbox: (addr sandbox) -> _/eax: int { +1234 var sandbox/esi: (addr sandbox) <- copy _sandbox +1235 var cursor-call-path/edi: (addr handle call-path-element) <- get sandbox, cursor-call-path +1236 var result/eax: int <- call-path-element-length cursor-call-path +1237 result <- add 2 # input-row - 1 +1238 return result +1239 } +1240 +1241 fn call-path-element-length _x: (addr handle call-path-element) -> _/eax: int { +1242 var curr-ah/ecx: (addr handle call-path-element) <- copy _x +1243 var result/edi: int <- copy 0 +1244 { +1245 var curr/eax: (addr call-path-element) <- lookup *curr-ah +1246 compare curr, 0 +1247 break-if-= +1248 curr-ah <- get curr, next +1249 result <- increment +1250 loop +1251 } +1252 return result +1253 } +1254 +1255 # Render the line of words in line, along with the state of the stack under each word. +1256 # Also render any expanded function calls using recursive calls. +1257 # +1258 # Along the way, compute the column the cursor should be positioned at (cursor-col-addr). +1259 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 { +1260 #? print-string 0, "render-line\n" +1261 #? dump-table bindings +1262 # curr-word +1263 var line/esi: (addr line) <- copy _line +1264 var first-word-ah/eax: (addr handle word) <- get line, data +1265 var curr-word/eax: (addr word) <- lookup *first-word-ah +1266 # +1267 # loop-carried dependency +1268 var curr-col/ecx: int <- copy left-col +1269 # +1270 { +1271 compare curr-word, 0 +1272 break-if-= +1273 #? print-string 0, "-- word " +1274 #? print-word 0, curr-word +1275 #? print-string 0, "\n" +1276 # if necessary, first render columns for subsidiary stack +1277 $render-line:subsidiary: { +1278 { +1279 #? print-string 0, "check sub\n" +1280 var display-subsidiary-stack?/eax: boolean <- find-in-call-paths expanded-words, curr-path +1281 compare display-subsidiary-stack?, 0 # false +1282 break-if-= $render-line:subsidiary +1283 } +1284 #? print-string 0, "render subsidiary stack\n" +1285 # does function exist? +1286 var callee/edi: (addr function) <- copy 0 +1287 { +1288 var callee-h: (handle function) +1289 var callee-ah/ecx: (addr handle function) <- address callee-h +1290 callee functions, curr-word, callee-ah +1291 var _callee/eax: (addr function) <- lookup *callee-ah +1292 callee <- copy _callee +1293 compare callee, 0 +1294 break-if-= $render-line:subsidiary +1295 } +1296 move-cursor screen, top-row, curr-col +1297 start-color screen, 8, 7 +1298 print-word screen, curr-word +1299 { +1300 var word-len/eax: int <- word-length curr-word +1301 curr-col <- add word-len +1302 curr-col <- add 2 +1303 increment top-row +1304 } +1305 # obtain stack at call site +1306 var stack-storage: value-stack +1307 var stack/edx: (addr value-stack) <- address stack-storage +1308 initialize-value-stack stack, 0x10 +1309 { +1310 var prev-word-ah/eax: (addr handle word) <- get curr-word, prev +1311 var prev-word/eax: (addr word) <- lookup *prev-word-ah +1312 compare prev-word, 0 +1313 break-if-= +1314 var bindings2-storage: table +1315 var bindings2/ebx: (addr table) <- address bindings2-storage +1316 deep-copy-table bindings, bindings2 +1317 evaluate functions, bindings2, first-line, prev-word, stack +1318 } +1319 # construct new bindings +1320 var callee-bindings-storage: table +1321 var callee-bindings/esi: (addr table) <- address callee-bindings-storage +1322 initialize-table callee-bindings, 0x10 +1323 bind-args callee, stack, callee-bindings +1324 # obtain body +1325 var callee-body-ah/eax: (addr handle line) <- get callee, body +1326 var callee-body/eax: (addr line) <- lookup *callee-body-ah +1327 var callee-body-first-word/edx: (addr handle word) <- get callee-body, data +1328 # - render subsidiary stack +1329 push-to-call-path-element curr-path, callee-body-first-word # leak +1330 #? print-string 0, "subsidiary {\n" +1331 #? dump-table callee-bindings +1332 #? syscall_exit +1333 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 +1334 #? print-string 0, "}\n" +1335 drop-from-call-path-element curr-path +1336 # +1337 move-cursor screen, top-row, curr-col +1338 print-code-point screen, 0x21d7 # ⇗ +1339 # +1340 curr-col <- add 2 +1341 decrement top-row +1342 } +1343 # render main column +1344 var old-col/edx: int <- copy curr-col +1345 var bindings2-storage: table +1346 var bindings2/ebx: (addr table) <- address bindings2-storage +1347 #? print-string 0, "deep-copy {\n" +1348 deep-copy-table bindings, bindings2 +1349 #? print-string 0, "}\n" +1350 #? print-string 0, "render column {\n" +1351 curr-col <- render-column screen, functions, bindings2, first-line, line, curr-word, top-row, curr-col +1352 #? print-string 0, "}\n" +1353 # cache cursor column if necessary +1354 $render-line:cache-cursor-column: { +1355 { +1356 var found?/eax: boolean <- call-path-element-match? curr-path, cursor-call-path +1357 compare found?, 0 # false +1358 break-if-= $render-line:cache-cursor-column +1359 } +1360 var dest/edi: (addr int) <- copy cursor-row-addr +1361 { +1362 var src/eax: int <- copy top-row +1363 copy-to *dest, src +1364 } +1365 dest <- copy cursor-col-addr +1366 copy-to *dest, old-col +1367 var cursor-index-in-word/eax: int <- cursor-index curr-word +1368 add-to *dest, cursor-index-in-word +1369 } +1370 # loop update +1371 #? print-string 0, "next word\n" +1372 var next-word-ah/edx: (addr handle word) <- get curr-word, next +1373 curr-word <- lookup *next-word-ah +1374 #? { +1375 #? var foo/eax: int <- copy curr-word +1376 #? print-int32-hex 0, foo +1377 #? print-string 0, "\n" +1378 #? } +1379 increment-final-element curr-path +1380 loop +1381 } +1382 return curr-col +1383 } +1384 +1385 fn callee functions: (addr handle function), word: (addr word), out: (addr handle function) { +1386 var stream-storage: (stream byte 0x10) +1387 var stream/esi: (addr stream byte) <- address stream-storage +1388 emit-word word, stream +1389 find-function functions, stream, out +1390 } +1391 +1392 # Render: +1393 # - starting at top-row, left-col: final-word +1394 # - starting somewhere below at left-col: the stack result from interpreting first-world to final-word (inclusive) +1395 # +1396 # Return the farthest column written. +1397 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 { +1398 #? print-string 0, "render-column\n" +1399 #? dump-table bindings +1400 var max-width/esi: int <- copy 0 +1401 { +1402 # compute stack +1403 var stack: value-stack +1404 var stack-addr/edi: (addr value-stack) <- address stack +1405 initialize-value-stack stack-addr, 0x10 # max-words +1406 # copy bindings +1407 var bindings2-storage: table +1408 var bindings2/ebx: (addr table) <- address bindings2-storage +1409 #? print-string 0, "deep copy table {\n" +1410 deep-copy-table bindings, bindings2 +1411 #? print-string 0, "}\n" +1412 evaluate functions, bindings2, first-line, final-word, stack-addr +1413 # indent stack +1414 var indented-col/ebx: int <- copy left-col +1415 indented-col <- add 1 # margin-right +1416 # render stack +1417 var curr-row/edx: int <- copy top-row +1418 curr-row <- add 2 # stack-margin-top +1419 var _max-width/eax: int <- value-stack-max-width stack-addr +1420 max-width <- copy _max-width +1421 { +1422 var top-addr/ecx: (addr int) <- get stack-addr, top +1423 compare *top-addr, 0 +1424 break-if-<= +1425 decrement *top-addr +1426 var data-ah/eax: (addr handle array value) <- get stack-addr, data +1427 var data/eax: (addr array value) <- lookup *data-ah +1428 var top/ecx: int <- copy *top-addr +1429 var dest-offset/ecx: (offset value) <- compute-offset data, top +1430 var val/eax: (addr value) <- index data, dest-offset +1431 render-value-at screen, curr-row, indented-col, val, max-width +1432 var height/eax: int <- value-height val +1433 curr-row <- add height +1434 loop +1435 } +1436 } +1437 +1438 max-width <- add 2 # spaces on either side of items on the stack +1439 +1440 # render word, initialize result +1441 reset-formatting screen +1442 move-cursor screen, top-row, left-col +1443 print-word screen, final-word +1444 { +1445 var size/eax: int <- word-length final-word +1446 compare size, max-width +1447 break-if-<= +1448 max-width <- copy size +1449 } +1450 +1451 # post-process right-col +1452 var right-col/ecx: int <- copy left-col +1453 right-col <- add max-width +1454 right-col <- add 1 # margin-right +1455 #? print-int32-decimal 0, left-col +1456 #? print-string 0, " => " +1457 #? print-int32-decimal 0, right-col +1458 #? print-string 0, "\n" +1459 return right-col +1460 } +1461 +1462 fn clear-canvas _env: (addr environment) { +1463 var env/esi: (addr environment) <- copy _env +1464 var screen-ah/edi: (addr handle screen) <- get env, screen +1465 var _screen/eax: (addr screen) <- lookup *screen-ah +1466 var screen/edi: (addr screen) <- copy _screen +1467 clear-screen screen +1468 var nrows/eax: (addr int) <- get env, nrows +1469 var _repl-col/ecx: (addr int) <- get env, code-separator-col +1470 var repl-col/ecx: int <- copy *_repl-col +1471 draw-vertical-line screen, 1, *nrows, repl-col +1472 # wordstar-style cheatsheet of shortcuts +1473 move-cursor screen, *nrows, 0 +1474 start-reverse-video screen +1475 print-string screen, " ctrl-q " +1476 reset-formatting screen +1477 print-string screen, " quit " +1478 var menu-start/ebx: int <- copy repl-col +1479 menu-start <- subtract 0x48 # 72 = half the size of the menu +1480 move-cursor screen, *nrows, menu-start +1481 start-reverse-video screen +1482 print-string screen, " ctrl-a " +1483 reset-formatting screen +1484 print-string screen, " ⏮ " 1485 start-reverse-video screen -1486 print-string screen, " ctrl-a " +1486 print-string screen, " ctrl-b " 1487 reset-formatting screen -1488 print-string screen, " ⏮ " +1488 print-string screen, " ◀ word " 1489 start-reverse-video screen -1490 print-string screen, " ctrl-b " +1490 print-string screen, " ctrl-f " 1491 reset-formatting screen -1492 print-string screen, " ◀ word " +1492 print-string screen, " word ▶ " 1493 start-reverse-video screen -1494 print-string screen, " ctrl-f " +1494 print-string screen, " ctrl-e " 1495 reset-formatting screen -1496 print-string screen, " word ▶ " +1496 print-string screen, " ⏭ " 1497 start-reverse-video screen -1498 print-string screen, " ctrl-e " +1498 print-string screen, " ctrl-l " 1499 reset-formatting screen -1500 print-string screen, " ⏭ " +1500 print-string screen, " new line " 1501 start-reverse-video screen 1502 print-string screen, " ctrl-u " 1503 reset-formatting screen -1504 print-string screen, " clear line " +1504 print-string screen, " clear " 1505 start-reverse-video screen 1506 print-string screen, " ctrl-n " 1507 reset-formatting screen @@ -1571,96 +1571,161 @@ if ('onhashchange' in window) { 1511 reset-formatting screen 1512 print-string screen, " define function " 1513 # primitives -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 # currently defined functions -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 # only single-line functions supported for now -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 # if g == newline return true -1571 compare g, 0xa -1572 { -1573 break-if-!= -1574 return 1 # true -1575 } -1576 # if g == tab return true -1577 compare g, 9 -1578 { -1579 break-if-!= -1580 return 1 # true -1581 } -1582 # if g < 32 return false -1583 compare g, 0x20 -1584 { -1585 break-if->= -1586 return 0 # false -1587 } -1588 # if g <= 255 return true -1589 compare g, 0xff -1590 { -1591 break-if-> -1592 return 1 # true -1593 } -1594 # if (g&0xff == Esc) it's an escape sequence -1595 and-with g, 0xff -1596 compare g, 0x1b # Esc -1597 { -1598 break-if-!= -1599 return 0 # false -1600 } -1601 # otherwise return true -1602 return 1 # true -1603 } +1514 var dummy/eax: int <- render-primitives screen, *nrows, repl-col +1515 # currently defined functions +1516 render-functions screen, repl-col, env +1517 } +1518 +1519 # return value: top-most row written to +1520 fn render-primitives screen: (addr screen), bottom-margin-row: int, right-col: int -> _/eax: int { +1521 # render primitives from the bottom of the screen upward +1522 var row/ecx: int <- copy bottom-margin-row +1523 row <- subtract 1 +1524 var col/edx: int <- copy 1 +1525 move-cursor screen, row, col +1526 row, col <- render-primitive-group screen, row, col, right-col, "numbers: ", "+ - * " +1527 row, col <- render-primitive-group screen, row, col, right-col, "arrays: ", "len " +1528 row, col <- render-primitive-group screen, row, col, right-col, "files: ", "open read slurp lines " +1529 row, col <- render-primitive-group screen, row, col, right-col, "misc: ", "dup swap " # hack: keep these at the right of the bottom row +1530 row, col <- render-primitive-group screen, row, col, right-col, "screens: ", "fake-screen print move up down left right " +1531 # finally print heading up top +1532 row <- decrement +1533 move-cursor screen, row, 1 +1534 start-bold screen +1535 print-string screen, "primitives:" +1536 reset-formatting screen +1537 return row +1538 } +1539 +1540 # start at row, col and print the given strings +1541 # move up one row if there isn't enough room before right-col +1542 # return row, col printed until +1543 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 { +1544 var row/ecx: int <- copy _row +1545 var col/edx: int <- copy _col +1546 # decrement row if necessary +1547 var new-col/ebx: int <- copy col +1548 var heading/esi: (addr array byte) <- copy _heading +1549 var len1/eax: int <- length heading +1550 new-col <- add len1 +1551 var contents/edi: (addr array byte) <- copy _contents +1552 var len2/eax: int <- length contents +1553 new-col <- add len2 +1554 var bound/eax: int <- copy right-col +1555 bound <- decrement +1556 { +1557 compare new-col, bound +1558 break-if-<= +1559 row <- decrement +1560 col <- copy 1 +1561 } +1562 move-cursor screen, row, col +1563 start-color screen, 0xf6, 7 +1564 print-string screen, heading +1565 reset-formatting screen +1566 print-string screen, contents +1567 return row, new-col +1568 } +1569 +1570 fn render-functions screen: (addr screen), right-col: int, _env: (addr environment) { +1571 var row/ecx: int <- copy 1 +1572 var dummy-col/edx: int <- copy right-col +1573 var env/esi: (addr environment) <- copy _env +1574 var functions/esi: (addr handle function) <- get env, functions +1575 { +1576 var curr/eax: (addr function) <- lookup *functions +1577 compare curr, 0 +1578 break-if-= +1579 row, dummy-col <- render-function-right-aligned screen, row, right-col, curr +1580 functions <- get curr, next +1581 row <- add 1 # inter-function-margin +1582 loop +1583 } +1584 } +1585 +1586 # print function starting at row, right-aligned before right-col +1587 # return row, col printed until +1588 fn render-function-right-aligned screen: (addr screen), row: int, right-col: int, f: (addr function) -> _/ecx: int, _/edx: int { +1589 var col/edx: int <- copy right-col +1590 col <- subtract 1 # function-right-margin +1591 var col2/ebx: int <- copy col +1592 var width/eax: int <- function-width f +1593 col <- subtract width +1594 var new-row/ecx: int <- copy row +1595 var height/eax: int <- function-height f +1596 new-row <- add height +1597 new-row <- decrement +1598 col <- subtract 1 # function-left-padding +1599 start-color screen, 0, 0xf7 +1600 clear-rect screen, row, col, new-row, col2 +1601 col <- add 1 +1602 #? var dummy/eax: grapheme <- read-key-from-real-keyboard +1603 render-function screen, row, col, f +1604 new-row <- add 1 # function-bottom-margin +1605 col <- subtract 1 # function-left-padding +1606 col <- subtract 1 # function-left-margin +1607 reset-formatting screen +1608 return new-row, col +1609 } +1610 +1611 # render function starting at row, col +1612 # only single-line functions supported for now +1613 fn render-function screen: (addr screen), row: int, col: int, _f: (addr function) { +1614 var f/esi: (addr function) <- copy _f +1615 var args/ecx: (addr handle word) <- get f, args +1616 move-cursor screen, row, col +1617 print-words-in-reverse screen, args +1618 var name-ah/eax: (addr handle array byte) <- get f, name +1619 var name/eax: (addr array byte) <- lookup *name-ah +1620 start-bold screen +1621 print-string screen, name +1622 reset-formatting screen +1623 start-color screen, 0, 0xf7 +1624 increment row +1625 add-to col, 2 +1626 move-cursor screen, row, col +1627 print-string screen, "≡ " +1628 var body-ah/eax: (addr handle line) <- get f, body +1629 var body/eax: (addr line) <- lookup *body-ah +1630 var body-words-ah/eax: (addr handle word) <- get body, data +1631 print-words screen, body-words-ah +1632 } +1633 +1634 fn real-grapheme? g: grapheme -> _/eax: boolean { +1635 # if g == newline return true +1636 compare g, 0xa +1637 { +1638 break-if-!= +1639 return 1 # true +1640 } +1641 # if g == tab return true +1642 compare g, 9 +1643 { +1644 break-if-!= +1645 return 1 # true +1646 } +1647 # if g < 32 return false +1648 compare g, 0x20 +1649 { +1650 break-if->= +1651 return 0 # false +1652 } +1653 # if g <= 255 return true +1654 compare g, 0xff +1655 { +1656 break-if-> +1657 return 1 # true +1658 } +1659 # if (g&0xff == Esc) it's an escape sequence +1660 and-with g, 0xff +1661 compare g, 0x1b # Esc +1662 { +1663 break-if-!= +1664 return 0 # false +1665 } +1666 # otherwise return true +1667 return 1 # true +1668 } diff --git a/html/apps/tile/rpn.mu.html b/html/apps/tile/rpn.mu.html index c67a5d75..dad0a274 100644 --- a/html/apps/tile/rpn.mu.html +++ b/html/apps/tile/rpn.mu.html @@ -141,814 +141,809 @@ if ('onhashchange' in window) { 81 var type-addr/eax: (addr int) <- get target-val, type 82 copy-to *type-addr, 0 # int 83 var target-string-ah/eax: (addr handle array byte) <- get target-val, text-data - 84 var empty: (handle array byte) - 85 copy-handle empty, target-string-ah - 86 var target/eax: (addr int) <- get target-val, int-data - 87 copy-to *target, result - 88 break $evaluate:process-word - 89 } - 90 compare *target-type-addr, 2 # array of ints - 91 { - 92 break-if-!= - 93 # compute length - 94 var src-ah/eax: (addr handle array value) <- get target-val, array-data - 95 var src/eax: (addr array value) <- lookup *src-ah - 96 var result/ebx: int <- length src - 97 # save result into target-val - 98 var type-addr/eax: (addr int) <- get target-val, type - 99 copy-to *type-addr, 0 # int -100 var target-array-ah/eax: (addr handle array value) <- get target-val, array-data -101 var empty: (handle array value) -102 copy-handle empty, target-array-ah -103 var target/eax: (addr int) <- get target-val, int-data -104 copy-to *target, result -105 break $evaluate:process-word -106 } -107 } -108 ## files -109 { -110 var is-open?/eax: boolean <- stream-data-equal? curr-stream, "open" -111 compare is-open?, 0 -112 break-if-= -113 # pop target-val from out -114 var out2/esi: (addr value-stack) <- copy out -115 var top-addr/ecx: (addr int) <- get out2, top -116 compare *top-addr, 0 -117 break-if-<= -118 var data-ah/eax: (addr handle array value) <- get out2, data -119 var data/eax: (addr array value) <- lookup *data-ah -120 var top/edx: int <- copy *top-addr -121 top <- decrement -122 var dest-offset/edx: (offset value) <- compute-offset data, top -123 var target-val/edx: (addr value) <- index data, dest-offset -124 # check target-val is a string -125 var target-type-addr/eax: (addr int) <- get target-val, type -126 compare *target-type-addr, 1 # string -127 break-if-!= -128 # open target-val as a filename and save the handle in target-val -129 var src-ah/eax: (addr handle array byte) <- get target-val, text-data -130 var src/eax: (addr array byte) <- lookup *src-ah -131 var result-ah/ecx: (addr handle buffered-file) <- get target-val, file-data -132 open src, 0, result-ah # write? = false -133 # save result into target-val -134 var type-addr/eax: (addr int) <- get target-val, type -135 copy-to *type-addr, 3 # file -136 var target-string-ah/eax: (addr handle array byte) <- get target-val, text-data -137 var filename-ah/ecx: (addr handle array byte) <- get target-val, filename -138 copy-object target-string-ah, filename-ah -139 var empty: (handle array byte) -140 copy-handle empty, target-string-ah -141 break $evaluate:process-word -142 } -143 { -144 var is-read?/eax: boolean <- stream-data-equal? curr-stream, "read" -145 compare is-read?, 0 -146 break-if-= -147 # pop target-val from out -148 var out2/esi: (addr value-stack) <- copy out -149 var top-addr/ecx: (addr int) <- get out2, top -150 compare *top-addr, 0 -151 break-if-<= -152 var data-ah/eax: (addr handle array value) <- get out2, data -153 var data/eax: (addr array value) <- lookup *data-ah -154 var top/edx: int <- copy *top-addr -155 top <- decrement -156 var dest-offset/edx: (offset value) <- compute-offset data, top -157 var target-val/edx: (addr value) <- index data, dest-offset -158 # check target-val is a file -159 var target-type-addr/eax: (addr int) <- get target-val, type -160 compare *target-type-addr, 3 # file -161 break-if-!= -162 # read a line from the file and save in target-val -163 # read target-val as a filename and save the handle in target-val -164 var file-ah/eax: (addr handle buffered-file) <- get target-val, file-data -165 var file/eax: (addr buffered-file) <- lookup *file-ah -166 var s: (stream byte 0x100) -167 var s-addr/ecx: (addr stream byte) <- address s -168 read-line-buffered file, s-addr -169 var target/eax: (addr handle array byte) <- get target-val, text-data -170 stream-to-array s-addr, target -171 # save result into target-val -172 var type-addr/eax: (addr int) <- get target-val, type -173 copy-to *type-addr, 1 # string -174 var target-file-ah/eax: (addr handle buffered-file) <- get target-val, file-data -175 var empty: (handle buffered-file) -176 copy-handle empty, target-file-ah -177 break $evaluate:process-word -178 } -179 { -180 var is-slurp?/eax: boolean <- stream-data-equal? curr-stream, "slurp" -181 compare is-slurp?, 0 -182 break-if-= -183 # pop target-val from out -184 var out2/esi: (addr value-stack) <- copy out -185 var top-addr/ecx: (addr int) <- get out2, top -186 compare *top-addr, 0 -187 break-if-<= -188 var data-ah/eax: (addr handle array value) <- get out2, data -189 var data/eax: (addr array value) <- lookup *data-ah -190 var top/edx: int <- copy *top-addr -191 top <- decrement -192 var dest-offset/edx: (offset value) <- compute-offset data, top -193 var target-val/edx: (addr value) <- index data, dest-offset -194 # check target-val is a file -195 var target-type-addr/eax: (addr int) <- get target-val, type -196 compare *target-type-addr, 3 # file -197 break-if-!= -198 # slurp all contents from file and save in target-val -199 # read target-val as a filename and save the handle in target-val -200 var file-ah/eax: (addr handle buffered-file) <- get target-val, file-data -201 var file/eax: (addr buffered-file) <- lookup *file-ah -202 var s: (stream byte 0x100) -203 var s-addr/ecx: (addr stream byte) <- address s -204 slurp file, s-addr -205 var target/eax: (addr handle array byte) <- get target-val, text-data -206 stream-to-array s-addr, target -207 # save result into target-val -208 var type-addr/eax: (addr int) <- get target-val, type -209 copy-to *type-addr, 1 # string -210 var target-file-ah/eax: (addr handle buffered-file) <- get target-val, file-data -211 var empty: (handle buffered-file) -212 copy-handle empty, target-file-ah -213 break $evaluate:process-word -214 } -215 { -216 var is-lines?/eax: boolean <- stream-data-equal? curr-stream, "lines" -217 compare is-lines?, 0 -218 break-if-= -219 # pop target-val from out -220 var out2/esi: (addr value-stack) <- copy out -221 var top-addr/ecx: (addr int) <- get out2, top -222 compare *top-addr, 0 -223 break-if-<= -224 var data-ah/eax: (addr handle array value) <- get out2, data -225 var data/eax: (addr array value) <- lookup *data-ah -226 var top/edx: int <- copy *top-addr -227 top <- decrement -228 var dest-offset/edx: (offset value) <- compute-offset data, top -229 var target-val/edx: (addr value) <- index data, dest-offset -230 # check target-val is a file -231 var target-type-addr/eax: (addr int) <- get target-val, type -232 compare *target-type-addr, 3 # file -233 break-if-!= -234 # read all lines from file and save as an array of strings in target-val -235 # read target-val as a filename and save the handle in target-val -236 var file-ah/eax: (addr handle buffered-file) <- get target-val, file-data -237 var file/eax: (addr buffered-file) <- lookup *file-ah -238 var s: (stream byte 0x100) -239 var s-addr/ecx: (addr stream byte) <- address s -240 slurp file, s-addr -241 var tmp-ah/eax: (addr handle array byte) <- get target-val, text-data -242 stream-to-array s-addr, tmp-ah -243 var tmp/eax: (addr array byte) <- lookup *tmp-ah -244 #? enable-screen-type-mode -245 #? print-string 0, tmp -246 var h: (handle array (handle array byte)) -247 { -248 var ah/edx: (addr handle array (handle array byte)) <- address h -249 split-string tmp, 0xa, ah -250 } -251 var target/eax: (addr handle array value) <- get target-val, array-data -252 save-lines h, target -253 # save result into target-val -254 var type-addr/eax: (addr int) <- get target-val, type -255 copy-to *type-addr, 2 # array -256 var target-file-ah/eax: (addr handle buffered-file) <- get target-val, file-data -257 var empty-file: (handle buffered-file) -258 copy-handle empty-file, target-file-ah -259 var target-text-ah/eax: (addr handle array byte) <- get target-val, text-data -260 var empty-text: (handle array byte) -261 copy-handle empty-text, target-text-ah -262 break $evaluate:process-word -263 } -264 ## screens -265 { -266 var is-fake-screen?/eax: boolean <- stream-data-equal? curr-stream, "fake-screen" -267 compare is-fake-screen?, 0 -268 break-if-= -269 var out2/esi: (addr value-stack) <- copy out -270 var top-addr/ecx: (addr int) <- get out2, top -271 compare *top-addr, 0 -272 break-if-<= -273 # pop width and height from out -274 var _nrows/eax: int <- pop-int-from-value-stack out2 -275 var nrows/edx: int <- copy _nrows -276 var _ncols/eax: int <- pop-int-from-value-stack out2 -277 var ncols/ebx: int <- copy _ncols -278 # define a new screen with those dimensions -279 var screen-h: (handle screen) -280 var screen-ah/eax: (addr handle screen) <- address screen-h -281 allocate screen-ah -282 var screen/eax: (addr screen) <- lookup screen-h -283 initialize-screen screen, nrows, ncols -284 # push screen to stack -285 var data-ah/eax: (addr handle array value) <- get out2, data -286 var data/eax: (addr array value) <- lookup *data-ah -287 var top/edx: int <- copy *top-addr -288 increment *top-addr -289 var dest-offset/edx: (offset value) <- compute-offset data, top -290 var target-val/edx: (addr value) <- index data, dest-offset -291 var type/eax: (addr int) <- get target-val, type -292 copy-to *type, 4 # screen -293 var dest/eax: (addr handle screen) <- get target-val, screen-data -294 copy-handle screen-h, dest -295 break $evaluate:process-word -296 } -297 { -298 var is-print?/eax: boolean <- stream-data-equal? curr-stream, "print" -299 compare is-print?, 0 -300 break-if-= -301 var out2/esi: (addr value-stack) <- copy out -302 var top-addr/ecx: (addr int) <- get out2, top -303 compare *top-addr, 0 -304 break-if-<= -305 # pop string from out -306 var top-addr/ecx: (addr int) <- get out2, top -307 compare *top-addr, 0 -308 break-if-<= -309 decrement *top-addr -310 var data-ah/eax: (addr handle array value) <- get out2, data -311 var _data/eax: (addr array value) <- lookup *data-ah -312 var data/edi: (addr array value) <- copy _data -313 var top/eax: int <- copy *top-addr -314 var dest-offset/edx: (offset value) <- compute-offset data, top -315 var s/esi: (addr value) <- index data, dest-offset -316 # select target screen from top of out (but don't pop it) -317 compare *top-addr, 0 -318 break-if-<= -319 var top/eax: int <- copy *top-addr -320 top <- decrement -321 var dest-offset/edx: (offset value) <- compute-offset data, top -322 var target-val/edx: (addr value) <- index data, dest-offset -323 var type/eax: (addr int) <- get target-val, type -324 compare *type, 4 # screen -325 break-if-!= -326 # print string to target screen -327 var dest-ah/eax: (addr handle screen) <- get target-val, screen-data -328 var dest/eax: (addr screen) <- lookup *dest-ah -329 var r/ecx: (addr int) <- get dest, cursor-row -330 var c/edx: (addr int) <- get dest, cursor-col -331 render-value-at dest, *r, *c, s, 0 -332 break $evaluate:process-word -333 } -334 { -335 var is-move?/eax: boolean <- stream-data-equal? curr-stream, "move" -336 compare is-move?, 0 -337 break-if-= -338 var out2/esi: (addr value-stack) <- copy out -339 # pop args -340 var _r/eax: int <- pop-int-from-value-stack out2 -341 var r/ecx: int <- copy _r -342 var _c/eax: int <- pop-int-from-value-stack out2 -343 var c/edx: int <- copy _c -344 # select screen from top of out (but don't pop it) -345 var top-addr/ebx: (addr int) <- get out2, top -346 compare *top-addr, 0 -347 break-if-<= -348 var data-ah/eax: (addr handle array value) <- get out2, data -349 var _data/eax: (addr array value) <- lookup *data-ah -350 var data/edi: (addr array value) <- copy _data -351 var top/eax: int <- copy *top-addr -352 top <- decrement -353 var target-offset/eax: (offset value) <- compute-offset data, top -354 var target-val/ebx: (addr value) <- index data, target-offset -355 var type/eax: (addr int) <- get target-val, type -356 compare *type, 4 # screen -357 break-if-!= -358 var target-ah/eax: (addr handle screen) <- get target-val, screen-data -359 var target/eax: (addr screen) <- lookup *target-ah -360 move-cursor target, r, c -361 break $evaluate:process-word -362 } -363 { -364 var is-up?/eax: boolean <- stream-data-equal? curr-stream, "up" -365 compare is-up?, 0 -366 break-if-= -367 var out2/esi: (addr value-stack) <- copy out -368 var top-addr/ebx: (addr int) <- get out2, top -369 compare *top-addr, 0 -370 break-if-<= -371 # pop args -372 var _d/eax: int <- pop-int-from-value-stack out2 -373 var d/ecx: int <- copy _d -374 # select screen from top of out (but don't pop it) -375 compare *top-addr, 0 -376 break-if-<= -377 var data-ah/eax: (addr handle array value) <- get out2, data -378 var _data/eax: (addr array value) <- lookup *data-ah -379 var data/edi: (addr array value) <- copy _data -380 var top/eax: int <- copy *top-addr -381 top <- decrement -382 var target-offset/eax: (offset value) <- compute-offset data, top -383 var target-val/ebx: (addr value) <- index data, target-offset -384 var type/eax: (addr int) <- get target-val, type -385 compare *type, 4 # screen -386 break-if-!= -387 var target-ah/eax: (addr handle screen) <- get target-val, screen-data -388 var _target/eax: (addr screen) <- lookup *target-ah -389 var target/edi: (addr screen) <- copy _target -390 var r/edx: (addr int) <- get target, cursor-row -391 var c/eax: (addr int) <- get target, cursor-col -392 var col/eax: int <- copy *c -393 { -394 compare d, 0 -395 break-if-<= -396 compare *r, 1 -397 break-if-<= -398 print-string target "│" -399 decrement *r -400 move-cursor target, *r, col -401 d <- decrement -402 loop -403 } -404 break $evaluate:process-word -405 } -406 { -407 var is-down?/eax: boolean <- stream-data-equal? curr-stream, "down" -408 compare is-down?, 0 -409 break-if-= -410 var out2/esi: (addr value-stack) <- copy out -411 var top-addr/ebx: (addr int) <- get out2, top -412 compare *top-addr, 0 -413 break-if-<= -414 # pop args -415 var _d/eax: int <- pop-int-from-value-stack out2 -416 var d/ecx: int <- copy _d -417 # select screen from top of out (but don't pop it) -418 compare *top-addr, 0 -419 break-if-<= -420 var data-ah/eax: (addr handle array value) <- get out2, data -421 var _data/eax: (addr array value) <- lookup *data-ah -422 var data/edi: (addr array value) <- copy _data -423 var top/eax: int <- copy *top-addr -424 top <- decrement -425 var target-offset/eax: (offset value) <- compute-offset data, top -426 var target-val/ebx: (addr value) <- index data, target-offset -427 var type/eax: (addr int) <- get target-val, type -428 compare *type, 4 # screen -429 break-if-!= -430 var target-ah/eax: (addr handle screen) <- get target-val, screen-data -431 var _target/eax: (addr screen) <- lookup *target-ah -432 var target/edi: (addr screen) <- copy _target -433 var bound-a/ebx: (addr int) <- get target, num-rows -434 var bound/ebx: int <- copy *bound-a -435 var r/edx: (addr int) <- get target, cursor-row -436 var c/eax: (addr int) <- get target, cursor-col -437 var col/eax: int <- copy *c -438 { -439 compare d, 0 -440 break-if-<= -441 compare *r, bound -442 break-if->= -443 print-string target "│" -444 increment *r -445 move-cursor target, *r, col -446 d <- decrement -447 loop -448 } -449 break $evaluate:process-word -450 } -451 { -452 var is-left?/eax: boolean <- stream-data-equal? curr-stream, "left" -453 compare is-left?, 0 -454 break-if-= -455 var out2/esi: (addr value-stack) <- copy out -456 var top-addr/ebx: (addr int) <- get out2, top -457 compare *top-addr, 0 -458 break-if-<= -459 # pop args -460 var _d/eax: int <- pop-int-from-value-stack out2 -461 var d/ecx: int <- copy _d -462 # select screen from top of out (but don't pop it) -463 compare *top-addr, 0 -464 break-if-<= -465 var data-ah/eax: (addr handle array value) <- get out2, data -466 var _data/eax: (addr array value) <- lookup *data-ah -467 var data/edi: (addr array value) <- copy _data -468 var top/eax: int <- copy *top-addr -469 top <- decrement -470 var target-offset/eax: (offset value) <- compute-offset data, top -471 var target-val/ebx: (addr value) <- index data, target-offset -472 var type/eax: (addr int) <- get target-val, type -473 compare *type, 4 # screen -474 break-if-!= -475 var target-ah/eax: (addr handle screen) <- get target-val, screen-data -476 var _target/eax: (addr screen) <- lookup *target-ah -477 var target/edi: (addr screen) <- copy _target -478 var c/edx: (addr int) <- get target, cursor-col -479 var r/eax: (addr int) <- get target, cursor-row -480 var row/eax: int <- copy *r -481 { -482 compare d, 0 -483 break-if-<= -484 compare *c, 1 -485 break-if-<= -486 print-string target "─" -487 decrement *c -488 decrement *c # second one to undo the print above -489 move-cursor target, row, *c -490 d <- decrement -491 loop -492 } -493 break $evaluate:process-word -494 } -495 { -496 var is-right?/eax: boolean <- stream-data-equal? curr-stream, "right" -497 compare is-right?, 0 -498 break-if-= -499 var out2/esi: (addr value-stack) <- copy out -500 var top-addr/ebx: (addr int) <- get out2, top -501 compare *top-addr, 0 -502 break-if-<= -503 # pop args -504 var _d/eax: int <- pop-int-from-value-stack out2 -505 var d/ecx: int <- copy _d -506 # select screen from top of out (but don't pop it) -507 compare *top-addr, 0 -508 break-if-<= -509 var data-ah/eax: (addr handle array value) <- get out2, data -510 var _data/eax: (addr array value) <- lookup *data-ah -511 var data/edi: (addr array value) <- copy _data -512 var top/eax: int <- copy *top-addr -513 top <- decrement -514 var target-offset/eax: (offset value) <- compute-offset data, top -515 var target-val/ebx: (addr value) <- index data, target-offset -516 var type/eax: (addr int) <- get target-val, type -517 compare *type, 4 # screen -518 break-if-!= -519 var target-ah/eax: (addr handle screen) <- get target-val, screen-data -520 var _target/eax: (addr screen) <- lookup *target-ah -521 var target/edi: (addr screen) <- copy _target -522 var bound-a/ebx: (addr int) <- get target, num-rows -523 var bound/ebx: int <- copy *bound-a -524 var c/edx: (addr int) <- get target, cursor-col -525 var r/eax: (addr int) <- get target, cursor-row -526 var row/eax: int <- copy *r -527 { -528 compare d, 0 -529 break-if-<= -530 compare *c, bound -531 break-if->= -532 print-string target "─" -533 # no increment; the print took care of it -534 move-cursor target, row, *c -535 d <- decrement -536 loop -537 } -538 break $evaluate:process-word -539 } -540 ## HACKS: we're trying to avoid turning this into Forth -541 { -542 var is-dup?/eax: boolean <- stream-data-equal? curr-stream, "dup" -543 compare is-dup?, 0 -544 break-if-= -545 # read src-val from out -546 var out2/esi: (addr value-stack) <- copy out -547 var top-addr/ecx: (addr int) <- get out2, top -548 compare *top-addr, 0 -549 break-if-<= -550 var data-ah/eax: (addr handle array value) <- get out2, data -551 var data/eax: (addr array value) <- lookup *data-ah -552 var top/ecx: int <- copy *top-addr -553 top <- decrement -554 var offset/edx: (offset value) <- compute-offset data, top -555 var src-val/edx: (addr value) <- index data, offset -556 # push a copy of it -557 top <- increment -558 var offset/ebx: (offset value) <- compute-offset data, top -559 var target-val/ebx: (addr value) <- index data, offset -560 copy-object src-val, target-val -561 # commit -562 var top-addr/ecx: (addr int) <- get out2, top -563 increment *top-addr -564 break $evaluate:process-word -565 } -566 { -567 var is-swap?/eax: boolean <- stream-data-equal? curr-stream, "swap" -568 compare is-swap?, 0 -569 break-if-= -570 # read top-val from out -571 var out2/esi: (addr value-stack) <- copy out -572 var top-addr/ecx: (addr int) <- get out2, top -573 compare *top-addr, 0 -574 break-if-<= -575 var data-ah/eax: (addr handle array value) <- get out2, data -576 var data/eax: (addr array value) <- lookup *data-ah -577 var top/ecx: int <- copy *top-addr -578 top <- decrement -579 var offset/edx: (offset value) <- compute-offset data, top -580 var top-val/edx: (addr value) <- index data, offset -581 # read next val from out -582 top <- decrement -583 var offset/ebx: (offset value) <- compute-offset data, top -584 var pen-top-val/ebx: (addr value) <- index data, offset -585 # swap -586 var tmp: value -587 var tmp-a/eax: (addr value) <- address tmp -588 copy-object top-val, tmp-a -589 copy-object pen-top-val, top-val -590 copy-object tmp-a, pen-top-val -591 break $evaluate:process-word -592 } -593 ### if curr-stream defines a binding, save top of stack to bindings -594 { -595 var done?/eax: boolean <- stream-empty? curr-stream -596 compare done?, 0 # false -597 break-if-!= -598 var new-byte/eax: byte <- read-byte curr-stream -599 compare new-byte, 0x3d # '=' -600 break-if-!= -601 # pop target-val from out -602 var out2/esi: (addr value-stack) <- copy out -603 var top-addr/ecx: (addr int) <- get out2, top -604 compare *top-addr, 0 -605 break-if-<= -606 var data-ah/eax: (addr handle array value) <- get out2, data -607 var data/eax: (addr array value) <- lookup *data-ah -608 var top/edx: int <- copy *top-addr -609 top <- decrement -610 var dest-offset/edx: (offset value) <- compute-offset data, top -611 var target-val/edx: (addr value) <- index data, dest-offset -612 # create binding from curr-stream to target-val -613 var key-h: (handle array byte) -614 var key/ecx: (addr handle array byte) <- address key-h -615 stream-to-array curr-stream, key -616 bind-in-table bindings, key, target-val -617 break $evaluate:process-word -618 } -619 rewind-stream curr-stream -620 ### if curr-stream is a known function name, call it appropriately -621 { -622 var callee-h: (handle function) -623 var callee-ah/eax: (addr handle function) <- address callee-h -624 find-function functions, curr-stream, callee-ah -625 var callee/eax: (addr function) <- lookup *callee-ah -626 compare callee, 0 -627 break-if-= -628 perform-call callee, out, functions -629 break $evaluate:process-word -630 } -631 ### if it's a name, push its value -632 { -633 compare bindings, 0 -634 break-if-= -635 var tmp: (handle array byte) -636 var curr-string-ah/edx: (addr handle array byte) <- address tmp -637 stream-to-array curr-stream, curr-string-ah # unfortunate leak -638 var curr-string/eax: (addr array byte) <- lookup *curr-string-ah -639 var val-storage: (handle value) -640 var val-ah/edi: (addr handle value) <- address val-storage -641 lookup-binding bindings, curr-string, val-ah -642 var val/eax: (addr value) <- lookup *val-ah -643 compare val, 0 -644 break-if-= -645 push-value-stack out, val -646 break $evaluate:process-word -647 } -648 ### if the word starts with a quote and ends with a quote, turn it into a string -649 { -650 var start/eax: byte <- stream-first curr-stream -651 compare start, 0x22 # double-quote -652 break-if-!= -653 var end/eax: byte <- stream-final curr-stream -654 compare end, 0x22 # double-quote -655 break-if-!= -656 var h: (handle array byte) -657 var s/eax: (addr handle array byte) <- address h -658 unquote-stream-to-array curr-stream, s # leak -659 push-string-to-value-stack out, *s -660 break $evaluate:process-word -661 } -662 ### if the word starts with a '[' and ends with a ']', turn it into an array -663 { -664 var start/eax: byte <- stream-first curr-stream -665 compare start, 0x5b # '[' -666 break-if-!= -667 var end/eax: byte <- stream-final curr-stream -668 compare end, 0x5d # ']' -669 break-if-!= -670 # wastefully create a new input string to strip quotes -671 var h: (handle array value) -672 var input-ah/eax: (addr handle array byte) <- address h -673 unquote-stream-to-array curr-stream, input-ah # leak -674 # wastefully parse input into int-array -675 # TODO: support parsing arrays of other types -676 var input/eax: (addr array byte) <- lookup *input-ah -677 var h2: (handle array int) -678 var int-array-ah/esi: (addr handle array int) <- address h2 -679 parse-array-of-decimal-ints input, int-array-ah # leak -680 var _int-array/eax: (addr array int) <- lookup *int-array-ah -681 var int-array/esi: (addr array int) <- copy _int-array -682 var len/ebx: int <- length int-array -683 # push value-array of same size as int-array -684 var h3: (handle array value) -685 var value-array-ah/eax: (addr handle array value) <- address h3 -686 populate value-array-ah, len -687 push-array-to-value-stack out, *value-array-ah -688 # copy int-array into value-array -689 var _value-array/eax: (addr array value) <- lookup *value-array-ah -690 var value-array/edi: (addr array value) <- copy _value-array -691 var i/eax: int <- copy 0 -692 { -693 compare i, len -694 break-if->= -695 var src-addr/ecx: (addr int) <- index int-array, i -696 var src/ecx: int <- copy *src-addr -697 var dest-offset/edx: (offset value) <- compute-offset value-array, i -698 var dest-val/edx: (addr value) <- index value-array, dest-offset -699 var dest/edx: (addr int) <- get dest-val, int-data -700 copy-to *dest, src -701 i <- increment -702 loop -703 } -704 break $evaluate:process-word + 84 clear-object target-string-ah + 85 var target/eax: (addr int) <- get target-val, int-data + 86 copy-to *target, result + 87 break $evaluate:process-word + 88 } + 89 compare *target-type-addr, 2 # array of ints + 90 { + 91 break-if-!= + 92 # compute length + 93 var src-ah/eax: (addr handle array value) <- get target-val, array-data + 94 var src/eax: (addr array value) <- lookup *src-ah + 95 var result/ebx: int <- length src + 96 # save result into target-val + 97 var type-addr/eax: (addr int) <- get target-val, type + 98 copy-to *type-addr, 0 # int + 99 var target-array-ah/eax: (addr handle array value) <- get target-val, array-data +100 clear-object target-array-ah +101 var target/eax: (addr int) <- get target-val, int-data +102 copy-to *target, result +103 break $evaluate:process-word +104 } +105 } +106 ## files +107 { +108 var is-open?/eax: boolean <- stream-data-equal? curr-stream, "open" +109 compare is-open?, 0 +110 break-if-= +111 # pop target-val from out +112 var out2/esi: (addr value-stack) <- copy out +113 var top-addr/ecx: (addr int) <- get out2, top +114 compare *top-addr, 0 +115 break-if-<= +116 var data-ah/eax: (addr handle array value) <- get out2, data +117 var data/eax: (addr array value) <- lookup *data-ah +118 var top/edx: int <- copy *top-addr +119 top <- decrement +120 var dest-offset/edx: (offset value) <- compute-offset data, top +121 var target-val/edx: (addr value) <- index data, dest-offset +122 # check target-val is a string +123 var target-type-addr/eax: (addr int) <- get target-val, type +124 compare *target-type-addr, 1 # string +125 break-if-!= +126 # open target-val as a filename and save the handle in target-val +127 var src-ah/eax: (addr handle array byte) <- get target-val, text-data +128 var src/eax: (addr array byte) <- lookup *src-ah +129 var result-ah/ecx: (addr handle buffered-file) <- get target-val, file-data +130 open src, 0, result-ah # write? = false +131 # save result into target-val +132 var type-addr/eax: (addr int) <- get target-val, type +133 copy-to *type-addr, 3 # file +134 var target-string-ah/eax: (addr handle array byte) <- get target-val, text-data +135 var filename-ah/ecx: (addr handle array byte) <- get target-val, filename +136 copy-object target-string-ah, filename-ah +137 clear-object target-string-ah +138 break $evaluate:process-word +139 } +140 { +141 var is-read?/eax: boolean <- stream-data-equal? curr-stream, "read" +142 compare is-read?, 0 +143 break-if-= +144 # pop target-val from out +145 var out2/esi: (addr value-stack) <- copy out +146 var top-addr/ecx: (addr int) <- get out2, top +147 compare *top-addr, 0 +148 break-if-<= +149 var data-ah/eax: (addr handle array value) <- get out2, data +150 var data/eax: (addr array value) <- lookup *data-ah +151 var top/edx: int <- copy *top-addr +152 top <- decrement +153 var dest-offset/edx: (offset value) <- compute-offset data, top +154 var target-val/edx: (addr value) <- index data, dest-offset +155 # check target-val is a file +156 var target-type-addr/eax: (addr int) <- get target-val, type +157 compare *target-type-addr, 3 # file +158 break-if-!= +159 # read a line from the file and save in target-val +160 # read target-val as a filename and save the handle in target-val +161 var file-ah/eax: (addr handle buffered-file) <- get target-val, file-data +162 var file/eax: (addr buffered-file) <- lookup *file-ah +163 var s: (stream byte 0x100) +164 var s-addr/ecx: (addr stream byte) <- address s +165 read-line-buffered file, s-addr +166 var target/eax: (addr handle array byte) <- get target-val, text-data +167 stream-to-array s-addr, target +168 # save result into target-val +169 var type-addr/eax: (addr int) <- get target-val, type +170 copy-to *type-addr, 1 # string +171 var target-file-ah/eax: (addr handle buffered-file) <- get target-val, file-data +172 clear-object target-file-ah +173 break $evaluate:process-word +174 } +175 { +176 var is-slurp?/eax: boolean <- stream-data-equal? curr-stream, "slurp" +177 compare is-slurp?, 0 +178 break-if-= +179 # pop target-val from out +180 var out2/esi: (addr value-stack) <- copy out +181 var top-addr/ecx: (addr int) <- get out2, top +182 compare *top-addr, 0 +183 break-if-<= +184 var data-ah/eax: (addr handle array value) <- get out2, data +185 var data/eax: (addr array value) <- lookup *data-ah +186 var top/edx: int <- copy *top-addr +187 top <- decrement +188 var dest-offset/edx: (offset value) <- compute-offset data, top +189 var target-val/edx: (addr value) <- index data, dest-offset +190 # check target-val is a file +191 var target-type-addr/eax: (addr int) <- get target-val, type +192 compare *target-type-addr, 3 # file +193 break-if-!= +194 # slurp all contents from file and save in target-val +195 # read target-val as a filename and save the handle in target-val +196 var file-ah/eax: (addr handle buffered-file) <- get target-val, file-data +197 var file/eax: (addr buffered-file) <- lookup *file-ah +198 var s: (stream byte 0x100) +199 var s-addr/ecx: (addr stream byte) <- address s +200 slurp file, s-addr +201 var target/eax: (addr handle array byte) <- get target-val, text-data +202 stream-to-array s-addr, target +203 # save result into target-val +204 var type-addr/eax: (addr int) <- get target-val, type +205 copy-to *type-addr, 1 # string +206 var target-file-ah/eax: (addr handle buffered-file) <- get target-val, file-data +207 clear-object target-file-ah +208 break $evaluate:process-word +209 } +210 { +211 var is-lines?/eax: boolean <- stream-data-equal? curr-stream, "lines" +212 compare is-lines?, 0 +213 break-if-= +214 # pop target-val from out +215 var out2/esi: (addr value-stack) <- copy out +216 var top-addr/ecx: (addr int) <- get out2, top +217 compare *top-addr, 0 +218 break-if-<= +219 var data-ah/eax: (addr handle array value) <- get out2, data +220 var data/eax: (addr array value) <- lookup *data-ah +221 var top/edx: int <- copy *top-addr +222 top <- decrement +223 var dest-offset/edx: (offset value) <- compute-offset data, top +224 var target-val/edx: (addr value) <- index data, dest-offset +225 # check target-val is a file +226 var target-type-addr/eax: (addr int) <- get target-val, type +227 compare *target-type-addr, 3 # file +228 break-if-!= +229 # read all lines from file and save as an array of strings in target-val +230 # read target-val as a filename and save the handle in target-val +231 var file-ah/eax: (addr handle buffered-file) <- get target-val, file-data +232 var file/eax: (addr buffered-file) <- lookup *file-ah +233 var s: (stream byte 0x100) +234 var s-addr/ecx: (addr stream byte) <- address s +235 slurp file, s-addr +236 var tmp-ah/eax: (addr handle array byte) <- get target-val, text-data +237 stream-to-array s-addr, tmp-ah +238 var tmp/eax: (addr array byte) <- lookup *tmp-ah +239 #? enable-screen-type-mode +240 #? print-string 0, tmp +241 var h: (handle array (handle array byte)) +242 { +243 var ah/edx: (addr handle array (handle array byte)) <- address h +244 split-string tmp, 0xa, ah +245 } +246 var target/eax: (addr handle array value) <- get target-val, array-data +247 save-lines h, target +248 # save result into target-val +249 var type-addr/eax: (addr int) <- get target-val, type +250 copy-to *type-addr, 2 # array +251 var target-file-ah/eax: (addr handle buffered-file) <- get target-val, file-data +252 var empty-file: (handle buffered-file) +253 copy-handle empty-file, target-file-ah +254 var target-text-ah/eax: (addr handle array byte) <- get target-val, text-data +255 var empty-text: (handle array byte) +256 copy-handle empty-text, target-text-ah +257 break $evaluate:process-word +258 } +259 ## screens +260 { +261 var is-fake-screen?/eax: boolean <- stream-data-equal? curr-stream, "fake-screen" +262 compare is-fake-screen?, 0 +263 break-if-= +264 var out2/esi: (addr value-stack) <- copy out +265 var top-addr/ecx: (addr int) <- get out2, top +266 compare *top-addr, 0 +267 break-if-<= +268 # pop width and height from out +269 var _nrows/eax: int <- pop-int-from-value-stack out2 +270 var nrows/edx: int <- copy _nrows +271 var _ncols/eax: int <- pop-int-from-value-stack out2 +272 var ncols/ebx: int <- copy _ncols +273 # define a new screen with those dimensions +274 var screen-h: (handle screen) +275 var screen-ah/eax: (addr handle screen) <- address screen-h +276 allocate screen-ah +277 var screen/eax: (addr screen) <- lookup screen-h +278 initialize-screen screen, nrows, ncols +279 # push screen to stack +280 var data-ah/eax: (addr handle array value) <- get out2, data +281 var data/eax: (addr array value) <- lookup *data-ah +282 var top/edx: int <- copy *top-addr +283 increment *top-addr +284 var dest-offset/edx: (offset value) <- compute-offset data, top +285 var target-val/edx: (addr value) <- index data, dest-offset +286 var type/eax: (addr int) <- get target-val, type +287 copy-to *type, 4 # screen +288 var dest/eax: (addr handle screen) <- get target-val, screen-data +289 copy-handle screen-h, dest +290 break $evaluate:process-word +291 } +292 { +293 var is-print?/eax: boolean <- stream-data-equal? curr-stream, "print" +294 compare is-print?, 0 +295 break-if-= +296 var out2/esi: (addr value-stack) <- copy out +297 var top-addr/ecx: (addr int) <- get out2, top +298 compare *top-addr, 0 +299 break-if-<= +300 # pop string from out +301 var top-addr/ecx: (addr int) <- get out2, top +302 compare *top-addr, 0 +303 break-if-<= +304 decrement *top-addr +305 var data-ah/eax: (addr handle array value) <- get out2, data +306 var _data/eax: (addr array value) <- lookup *data-ah +307 var data/edi: (addr array value) <- copy _data +308 var top/eax: int <- copy *top-addr +309 var dest-offset/edx: (offset value) <- compute-offset data, top +310 var s/esi: (addr value) <- index data, dest-offset +311 # select target screen from top of out (but don't pop it) +312 compare *top-addr, 0 +313 break-if-<= +314 var top/eax: int <- copy *top-addr +315 top <- decrement +316 var dest-offset/edx: (offset value) <- compute-offset data, top +317 var target-val/edx: (addr value) <- index data, dest-offset +318 var type/eax: (addr int) <- get target-val, type +319 compare *type, 4 # screen +320 break-if-!= +321 # print string to target screen +322 var dest-ah/eax: (addr handle screen) <- get target-val, screen-data +323 var dest/eax: (addr screen) <- lookup *dest-ah +324 var r/ecx: (addr int) <- get dest, cursor-row +325 var c/edx: (addr int) <- get dest, cursor-col +326 render-value-at dest, *r, *c, s, 0 +327 break $evaluate:process-word +328 } +329 { +330 var is-move?/eax: boolean <- stream-data-equal? curr-stream, "move" +331 compare is-move?, 0 +332 break-if-= +333 var out2/esi: (addr value-stack) <- copy out +334 # pop args +335 var _r/eax: int <- pop-int-from-value-stack out2 +336 var r/ecx: int <- copy _r +337 var _c/eax: int <- pop-int-from-value-stack out2 +338 var c/edx: int <- copy _c +339 # select screen from top of out (but don't pop it) +340 var top-addr/ebx: (addr int) <- get out2, top +341 compare *top-addr, 0 +342 break-if-<= +343 var data-ah/eax: (addr handle array value) <- get out2, data +344 var _data/eax: (addr array value) <- lookup *data-ah +345 var data/edi: (addr array value) <- copy _data +346 var top/eax: int <- copy *top-addr +347 top <- decrement +348 var target-offset/eax: (offset value) <- compute-offset data, top +349 var target-val/ebx: (addr value) <- index data, target-offset +350 var type/eax: (addr int) <- get target-val, type +351 compare *type, 4 # screen +352 break-if-!= +353 var target-ah/eax: (addr handle screen) <- get target-val, screen-data +354 var target/eax: (addr screen) <- lookup *target-ah +355 move-cursor target, r, c +356 break $evaluate:process-word +357 } +358 { +359 var is-up?/eax: boolean <- stream-data-equal? curr-stream, "up" +360 compare is-up?, 0 +361 break-if-= +362 var out2/esi: (addr value-stack) <- copy out +363 var top-addr/ebx: (addr int) <- get out2, top +364 compare *top-addr, 0 +365 break-if-<= +366 # pop args +367 var _d/eax: int <- pop-int-from-value-stack out2 +368 var d/ecx: int <- copy _d +369 # select screen from top of out (but don't pop it) +370 compare *top-addr, 0 +371 break-if-<= +372 var data-ah/eax: (addr handle array value) <- get out2, data +373 var _data/eax: (addr array value) <- lookup *data-ah +374 var data/edi: (addr array value) <- copy _data +375 var top/eax: int <- copy *top-addr +376 top <- decrement +377 var target-offset/eax: (offset value) <- compute-offset data, top +378 var target-val/ebx: (addr value) <- index data, target-offset +379 var type/eax: (addr int) <- get target-val, type +380 compare *type, 4 # screen +381 break-if-!= +382 var target-ah/eax: (addr handle screen) <- get target-val, screen-data +383 var _target/eax: (addr screen) <- lookup *target-ah +384 var target/edi: (addr screen) <- copy _target +385 var r/edx: (addr int) <- get target, cursor-row +386 var c/eax: (addr int) <- get target, cursor-col +387 var col/eax: int <- copy *c +388 { +389 compare d, 0 +390 break-if-<= +391 compare *r, 1 +392 break-if-<= +393 print-string target "│" +394 decrement *r +395 move-cursor target, *r, col +396 d <- decrement +397 loop +398 } +399 break $evaluate:process-word +400 } +401 { +402 var is-down?/eax: boolean <- stream-data-equal? curr-stream, "down" +403 compare is-down?, 0 +404 break-if-= +405 var out2/esi: (addr value-stack) <- copy out +406 var top-addr/ebx: (addr int) <- get out2, top +407 compare *top-addr, 0 +408 break-if-<= +409 # pop args +410 var _d/eax: int <- pop-int-from-value-stack out2 +411 var d/ecx: int <- copy _d +412 # select screen from top of out (but don't pop it) +413 compare *top-addr, 0 +414 break-if-<= +415 var data-ah/eax: (addr handle array value) <- get out2, data +416 var _data/eax: (addr array value) <- lookup *data-ah +417 var data/edi: (addr array value) <- copy _data +418 var top/eax: int <- copy *top-addr +419 top <- decrement +420 var target-offset/eax: (offset value) <- compute-offset data, top +421 var target-val/ebx: (addr value) <- index data, target-offset +422 var type/eax: (addr int) <- get target-val, type +423 compare *type, 4 # screen +424 break-if-!= +425 var target-ah/eax: (addr handle screen) <- get target-val, screen-data +426 var _target/eax: (addr screen) <- lookup *target-ah +427 var target/edi: (addr screen) <- copy _target +428 var bound-a/ebx: (addr int) <- get target, num-rows +429 var bound/ebx: int <- copy *bound-a +430 var r/edx: (addr int) <- get target, cursor-row +431 var c/eax: (addr int) <- get target, cursor-col +432 var col/eax: int <- copy *c +433 { +434 compare d, 0 +435 break-if-<= +436 compare *r, bound +437 break-if->= +438 print-string target "│" +439 increment *r +440 move-cursor target, *r, col +441 d <- decrement +442 loop +443 } +444 break $evaluate:process-word +445 } +446 { +447 var is-left?/eax: boolean <- stream-data-equal? curr-stream, "left" +448 compare is-left?, 0 +449 break-if-= +450 var out2/esi: (addr value-stack) <- copy out +451 var top-addr/ebx: (addr int) <- get out2, top +452 compare *top-addr, 0 +453 break-if-<= +454 # pop args +455 var _d/eax: int <- pop-int-from-value-stack out2 +456 var d/ecx: int <- copy _d +457 # select screen from top of out (but don't pop it) +458 compare *top-addr, 0 +459 break-if-<= +460 var data-ah/eax: (addr handle array value) <- get out2, data +461 var _data/eax: (addr array value) <- lookup *data-ah +462 var data/edi: (addr array value) <- copy _data +463 var top/eax: int <- copy *top-addr +464 top <- decrement +465 var target-offset/eax: (offset value) <- compute-offset data, top +466 var target-val/ebx: (addr value) <- index data, target-offset +467 var type/eax: (addr int) <- get target-val, type +468 compare *type, 4 # screen +469 break-if-!= +470 var target-ah/eax: (addr handle screen) <- get target-val, screen-data +471 var _target/eax: (addr screen) <- lookup *target-ah +472 var target/edi: (addr screen) <- copy _target +473 var c/edx: (addr int) <- get target, cursor-col +474 var r/eax: (addr int) <- get target, cursor-row +475 var row/eax: int <- copy *r +476 { +477 compare d, 0 +478 break-if-<= +479 compare *c, 1 +480 break-if-<= +481 print-string target "─" +482 decrement *c +483 decrement *c # second one to undo the print above +484 move-cursor target, row, *c +485 d <- decrement +486 loop +487 } +488 break $evaluate:process-word +489 } +490 { +491 var is-right?/eax: boolean <- stream-data-equal? curr-stream, "right" +492 compare is-right?, 0 +493 break-if-= +494 var out2/esi: (addr value-stack) <- copy out +495 var top-addr/ebx: (addr int) <- get out2, top +496 compare *top-addr, 0 +497 break-if-<= +498 # pop args +499 var _d/eax: int <- pop-int-from-value-stack out2 +500 var d/ecx: int <- copy _d +501 # select screen from top of out (but don't pop it) +502 compare *top-addr, 0 +503 break-if-<= +504 var data-ah/eax: (addr handle array value) <- get out2, data +505 var _data/eax: (addr array value) <- lookup *data-ah +506 var data/edi: (addr array value) <- copy _data +507 var top/eax: int <- copy *top-addr +508 top <- decrement +509 var target-offset/eax: (offset value) <- compute-offset data, top +510 var target-val/ebx: (addr value) <- index data, target-offset +511 var type/eax: (addr int) <- get target-val, type +512 compare *type, 4 # screen +513 break-if-!= +514 var target-ah/eax: (addr handle screen) <- get target-val, screen-data +515 var _target/eax: (addr screen) <- lookup *target-ah +516 var target/edi: (addr screen) <- copy _target +517 var bound-a/ebx: (addr int) <- get target, num-rows +518 var bound/ebx: int <- copy *bound-a +519 var c/edx: (addr int) <- get target, cursor-col +520 var r/eax: (addr int) <- get target, cursor-row +521 var row/eax: int <- copy *r +522 { +523 compare d, 0 +524 break-if-<= +525 compare *c, bound +526 break-if->= +527 print-string target "─" +528 # no increment; the print took care of it +529 move-cursor target, row, *c +530 d <- decrement +531 loop +532 } +533 break $evaluate:process-word +534 } +535 ## HACKS: we're trying to avoid turning this into Forth +536 { +537 var is-dup?/eax: boolean <- stream-data-equal? curr-stream, "dup" +538 compare is-dup?, 0 +539 break-if-= +540 # read src-val from out +541 var out2/esi: (addr value-stack) <- copy out +542 var top-addr/ecx: (addr int) <- get out2, top +543 compare *top-addr, 0 +544 break-if-<= +545 var data-ah/eax: (addr handle array value) <- get out2, data +546 var data/eax: (addr array value) <- lookup *data-ah +547 var top/ecx: int <- copy *top-addr +548 top <- decrement +549 var offset/edx: (offset value) <- compute-offset data, top +550 var src-val/edx: (addr value) <- index data, offset +551 # push a copy of it +552 top <- increment +553 var offset/ebx: (offset value) <- compute-offset data, top +554 var target-val/ebx: (addr value) <- index data, offset +555 copy-object src-val, target-val +556 # commit +557 var top-addr/ecx: (addr int) <- get out2, top +558 increment *top-addr +559 break $evaluate:process-word +560 } +561 { +562 var is-swap?/eax: boolean <- stream-data-equal? curr-stream, "swap" +563 compare is-swap?, 0 +564 break-if-= +565 # read top-val from out +566 var out2/esi: (addr value-stack) <- copy out +567 var top-addr/ecx: (addr int) <- get out2, top +568 compare *top-addr, 0 +569 break-if-<= +570 var data-ah/eax: (addr handle array value) <- get out2, data +571 var data/eax: (addr array value) <- lookup *data-ah +572 var top/ecx: int <- copy *top-addr +573 top <- decrement +574 var offset/edx: (offset value) <- compute-offset data, top +575 var top-val/edx: (addr value) <- index data, offset +576 # read next val from out +577 top <- decrement +578 var offset/ebx: (offset value) <- compute-offset data, top +579 var pen-top-val/ebx: (addr value) <- index data, offset +580 # swap +581 var tmp: value +582 var tmp-a/eax: (addr value) <- address tmp +583 copy-object top-val, tmp-a +584 copy-object pen-top-val, top-val +585 copy-object tmp-a, pen-top-val +586 break $evaluate:process-word +587 } +588 ### if curr-stream defines a binding, save top of stack to bindings +589 { +590 var done?/eax: boolean <- stream-empty? curr-stream +591 compare done?, 0 # false +592 break-if-!= +593 var new-byte/eax: byte <- read-byte curr-stream +594 compare new-byte, 0x3d # '=' +595 break-if-!= +596 # pop target-val from out +597 var out2/esi: (addr value-stack) <- copy out +598 var top-addr/ecx: (addr int) <- get out2, top +599 compare *top-addr, 0 +600 break-if-<= +601 var data-ah/eax: (addr handle array value) <- get out2, data +602 var data/eax: (addr array value) <- lookup *data-ah +603 var top/edx: int <- copy *top-addr +604 top <- decrement +605 var dest-offset/edx: (offset value) <- compute-offset data, top +606 var target-val/edx: (addr value) <- index data, dest-offset +607 # create binding from curr-stream to target-val +608 var key-h: (handle array byte) +609 var key/ecx: (addr handle array byte) <- address key-h +610 stream-to-array curr-stream, key +611 bind-in-table bindings, key, target-val +612 break $evaluate:process-word +613 } +614 rewind-stream curr-stream +615 ### if curr-stream is a known function name, call it appropriately +616 { +617 var callee-h: (handle function) +618 var callee-ah/eax: (addr handle function) <- address callee-h +619 find-function functions, curr-stream, callee-ah +620 var callee/eax: (addr function) <- lookup *callee-ah +621 compare callee, 0 +622 break-if-= +623 perform-call callee, out, functions +624 break $evaluate:process-word +625 } +626 ### if it's a name, push its value +627 { +628 compare bindings, 0 +629 break-if-= +630 var tmp: (handle array byte) +631 var curr-string-ah/edx: (addr handle array byte) <- address tmp +632 stream-to-array curr-stream, curr-string-ah # unfortunate leak +633 var curr-string/eax: (addr array byte) <- lookup *curr-string-ah +634 var val-storage: (handle value) +635 var val-ah/edi: (addr handle value) <- address val-storage +636 lookup-binding bindings, curr-string, val-ah +637 var val/eax: (addr value) <- lookup *val-ah +638 compare val, 0 +639 break-if-= +640 push-value-stack out, val +641 break $evaluate:process-word +642 } +643 ### if the word starts with a quote and ends with a quote, turn it into a string +644 { +645 var start/eax: byte <- stream-first curr-stream +646 compare start, 0x22 # double-quote +647 break-if-!= +648 var end/eax: byte <- stream-final curr-stream +649 compare end, 0x22 # double-quote +650 break-if-!= +651 var h: (handle array byte) +652 var s/eax: (addr handle array byte) <- address h +653 unquote-stream-to-array curr-stream, s # leak +654 push-string-to-value-stack out, *s +655 break $evaluate:process-word +656 } +657 ### if the word starts with a '[' and ends with a ']', turn it into an array +658 { +659 var start/eax: byte <- stream-first curr-stream +660 compare start, 0x5b # '[' +661 break-if-!= +662 var end/eax: byte <- stream-final curr-stream +663 compare end, 0x5d # ']' +664 break-if-!= +665 # wastefully create a new input string to strip quotes +666 var h: (handle array value) +667 var input-ah/eax: (addr handle array byte) <- address h +668 unquote-stream-to-array curr-stream, input-ah # leak +669 # wastefully parse input into int-array +670 # TODO: support parsing arrays of other types +671 var input/eax: (addr array byte) <- lookup *input-ah +672 var h2: (handle array int) +673 var int-array-ah/esi: (addr handle array int) <- address h2 +674 parse-array-of-decimal-ints input, int-array-ah # leak +675 var _int-array/eax: (addr array int) <- lookup *int-array-ah +676 var int-array/esi: (addr array int) <- copy _int-array +677 var len/ebx: int <- length int-array +678 # push value-array of same size as int-array +679 var h3: (handle array value) +680 var value-array-ah/eax: (addr handle array value) <- address h3 +681 populate value-array-ah, len +682 push-array-to-value-stack out, *value-array-ah +683 # copy int-array into value-array +684 var _value-array/eax: (addr array value) <- lookup *value-array-ah +685 var value-array/edi: (addr array value) <- copy _value-array +686 var i/eax: int <- copy 0 +687 { +688 compare i, len +689 break-if->= +690 var src-addr/ecx: (addr int) <- index int-array, i +691 var src/ecx: int <- copy *src-addr +692 var dest-offset/edx: (offset value) <- compute-offset value-array, i +693 var dest-val/edx: (addr value) <- index value-array, dest-offset +694 var dest/edx: (addr int) <- get dest-val, int-data +695 copy-to *dest, src +696 i <- increment +697 loop +698 } +699 break $evaluate:process-word +700 } +701 ### otherwise assume it's a literal number and push it +702 { +703 var n/eax: int <- parse-decimal-int-from-stream curr-stream +704 push-int-to-value-stack out, n 705 } -706 ### otherwise assume it's a literal number and push it -707 { -708 var n/eax: int <- parse-decimal-int-from-stream curr-stream -709 push-int-to-value-stack out, n -710 } -711 } -712 # termination check -713 compare curr, end -714 break-if-= -715 # update -716 var next-word-ah/edx: (addr handle word) <- get curr, next -717 curr <- lookup *next-word-ah -718 # -719 loop -720 } -721 # process next line if necessary -722 var line/eax: (addr line) <- copy scratch -723 var next-line-ah/eax: (addr handle line) <- get line, next -724 var next-line/eax: (addr line) <- lookup *next-line-ah -725 compare next-line, 0 -726 break-if-= -727 evaluate functions, bindings, next-line, end, out -728 } -729 -730 fn test-evaluate { -731 var line-storage: line -732 var line/esi: (addr line) <- address line-storage -733 var first-word-ah/eax: (addr handle word) <- get line-storage, data -734 allocate-word-with first-word-ah, "3" -735 append-word-with *first-word-ah, "=a" -736 var next-line-ah/eax: (addr handle line) <- get line-storage, next -737 allocate next-line-ah -738 var next-line/eax: (addr line) <- lookup *next-line-ah -739 var first-word-ah/eax: (addr handle word) <- get next-line, data -740 allocate-word-with first-word-ah, "a" -741 var functions-storage: (handle function) -742 var functions/ecx: (addr handle function) <- address functions-storage -743 var table-storage: table -744 var table/ebx: (addr table) <- address table-storage -745 initialize-table table, 0x10 -746 var stack-storage: value-stack -747 var stack/edi: (addr value-stack) <- address stack-storage -748 initialize-value-stack stack, 0x10 -749 evaluate functions, table, line, 0, stack -750 var x/eax: int <- pop-int-from-value-stack stack -751 check-ints-equal x, 3, "F - test-evaluate" -752 } -753 -754 fn find-function first: (addr handle function), name: (addr stream byte), out: (addr handle function) { -755 var curr/esi: (addr handle function) <- copy first -756 $find-function:loop: { -757 var _f/eax: (addr function) <- lookup *curr -758 var f/ecx: (addr function) <- copy _f -759 compare f, 0 -760 break-if-= -761 var curr-name-ah/eax: (addr handle array byte) <- get f, name -762 var curr-name/eax: (addr array byte) <- lookup *curr-name-ah -763 var done?/eax: boolean <- stream-data-equal? name, curr-name -764 compare done?, 0 # false -765 { -766 break-if-= -767 copy-handle *curr, out -768 break $find-function:loop -769 } -770 curr <- get f, next -771 loop -772 } -773 } -774 -775 fn perform-call _callee: (addr function), caller-stack: (addr value-stack), functions: (addr handle function) { -776 var callee/ecx: (addr function) <- copy _callee -777 # create bindings for args -778 var table-storage: table -779 var table/esi: (addr table) <- address table-storage -780 initialize-table table, 0x10 -781 bind-args callee, caller-stack, table -782 # obtain body -783 var body-ah/eax: (addr handle line) <- get callee, body -784 var body/eax: (addr line) <- lookup *body-ah -785 # perform call -786 var stack-storage: value-stack -787 var stack/edi: (addr value-stack) <- address stack-storage -788 initialize-value-stack stack, 0x10 -789 #? print-string-to-real-screen "about to enter recursive eval\n" -790 evaluate functions, table, body, 0, stack -791 #? print-string-to-real-screen "exited recursive eval\n" -792 # pop target-val from out -793 var top-addr/ecx: (addr int) <- get stack, top -794 compare *top-addr, 0 -795 break-if-<= -796 var data-ah/eax: (addr handle array value) <- get stack, data -797 var data/eax: (addr array value) <- lookup *data-ah -798 var top/edx: int <- copy *top-addr -799 top <- decrement -800 var dest-offset/edx: (offset value) <- compute-offset data, top -801 var target-val/edx: (addr value) <- index data, dest-offset -802 # stitch target-val into caller-stack -803 push-value-stack caller-stack, target-val -804 } -805 -806 # pop args from the caller-stack and bind them to successive args -807 # implies: function args are stored in reverse order -808 fn bind-args _callee: (addr function), _caller-stack: (addr value-stack), table: (addr table) { -809 var callee/ecx: (addr function) <- copy _callee -810 var curr-arg-ah/eax: (addr handle word) <- get callee, args -811 var curr-arg/eax: (addr word) <- lookup *curr-arg-ah -812 # -813 var curr-key-storage: (handle array byte) -814 var curr-key/edx: (addr handle array byte) <- address curr-key-storage -815 { -816 compare curr-arg, 0 -817 break-if-= -818 # create binding -819 word-to-string curr-arg, curr-key -820 { -821 # pop target-val from caller-stack -822 var caller-stack/esi: (addr value-stack) <- copy _caller-stack -823 var top-addr/ecx: (addr int) <- get caller-stack, top -824 compare *top-addr, 0 -825 break-if-<= -826 decrement *top-addr -827 var data-ah/eax: (addr handle array value) <- get caller-stack, data -828 var data/eax: (addr array value) <- lookup *data-ah -829 var top/ebx: int <- copy *top-addr -830 var dest-offset/ebx: (offset value) <- compute-offset data, top -831 var target-val/ebx: (addr value) <- index data, dest-offset -832 # create binding from curr-key to target-val -833 bind-in-table table, curr-key, target-val -834 } -835 # -836 var next-arg-ah/edx: (addr handle word) <- get curr-arg, next -837 curr-arg <- lookup *next-arg-ah -838 loop -839 } -840 } -841 -842 # Copy of 'simplify' that just tracks the maximum stack depth needed -843 # Doesn't actually need to simulate the stack, since every word has a predictable effect. -844 fn max-stack-depth first-word: (addr word), final-word: (addr word) -> _/edi: int { -845 var curr-word/eax: (addr word) <- copy first-word -846 var curr-depth/ecx: int <- copy 0 -847 var result/edi: int <- copy 0 -848 $max-stack-depth:loop: { -849 $max-stack-depth:process-word: { -850 # handle operators -851 { -852 var is-add?/eax: boolean <- word-equal? curr-word, "+" -853 compare is-add?, 0 -854 break-if-= -855 curr-depth <- decrement -856 break $max-stack-depth:process-word -857 } -858 { -859 var is-sub?/eax: boolean <- word-equal? curr-word, "-" -860 compare is-sub?, 0 -861 break-if-= -862 curr-depth <- decrement -863 break $max-stack-depth:process-word -864 } -865 { -866 var is-mul?/eax: boolean <- word-equal? curr-word, "*" -867 compare is-mul?, 0 -868 break-if-= -869 curr-depth <- decrement -870 break $max-stack-depth:process-word -871 } -872 # otherwise it's an int (do we need error-checking?) -873 curr-depth <- increment -874 # update max depth if necessary -875 { -876 compare curr-depth, result -877 break-if-<= -878 result <- copy curr-depth -879 } -880 } -881 # if curr-word == final-word break -882 compare curr-word, final-word -883 break-if-= -884 # curr-word = curr-word->next -885 var next-word-ah/edx: (addr handle word) <- get curr-word, next -886 curr-word <- lookup *next-word-ah -887 # -888 loop -889 } -890 return result -891 } +706 } +707 # termination check +708 compare curr, end +709 break-if-= +710 # update +711 var next-word-ah/edx: (addr handle word) <- get curr, next +712 curr <- lookup *next-word-ah +713 # +714 loop +715 } +716 # process next line if necessary +717 var line/eax: (addr line) <- copy scratch +718 var next-line-ah/eax: (addr handle line) <- get line, next +719 var next-line/eax: (addr line) <- lookup *next-line-ah +720 compare next-line, 0 +721 break-if-= +722 evaluate functions, bindings, next-line, end, out +723 } +724 +725 fn test-evaluate { +726 var line-storage: line +727 var line/esi: (addr line) <- address line-storage +728 var first-word-ah/eax: (addr handle word) <- get line-storage, data +729 allocate-word-with first-word-ah, "3" +730 append-word-with *first-word-ah, "=a" +731 var next-line-ah/eax: (addr handle line) <- get line-storage, next +732 allocate next-line-ah +733 var next-line/eax: (addr line) <- lookup *next-line-ah +734 var first-word-ah/eax: (addr handle word) <- get next-line, data +735 allocate-word-with first-word-ah, "a" +736 var functions-storage: (handle function) +737 var functions/ecx: (addr handle function) <- address functions-storage +738 var table-storage: table +739 var table/ebx: (addr table) <- address table-storage +740 initialize-table table, 0x10 +741 var stack-storage: value-stack +742 var stack/edi: (addr value-stack) <- address stack-storage +743 initialize-value-stack stack, 0x10 +744 evaluate functions, table, line, 0, stack +745 var x/eax: int <- pop-int-from-value-stack stack +746 check-ints-equal x, 3, "F - test-evaluate" +747 } +748 +749 fn find-function first: (addr handle function), name: (addr stream byte), out: (addr handle function) { +750 var curr/esi: (addr handle function) <- copy first +751 $find-function:loop: { +752 var _f/eax: (addr function) <- lookup *curr +753 var f/ecx: (addr function) <- copy _f +754 compare f, 0 +755 break-if-= +756 var curr-name-ah/eax: (addr handle array byte) <- get f, name +757 var curr-name/eax: (addr array byte) <- lookup *curr-name-ah +758 var done?/eax: boolean <- stream-data-equal? name, curr-name +759 compare done?, 0 # false +760 { +761 break-if-= +762 copy-handle *curr, out +763 break $find-function:loop +764 } +765 curr <- get f, next +766 loop +767 } +768 } +769 +770 fn perform-call _callee: (addr function), caller-stack: (addr value-stack), functions: (addr handle function) { +771 var callee/ecx: (addr function) <- copy _callee +772 # create bindings for args +773 var table-storage: table +774 var table/esi: (addr table) <- address table-storage +775 initialize-table table, 0x10 +776 bind-args callee, caller-stack, table +777 # obtain body +778 var body-ah/eax: (addr handle line) <- get callee, body +779 var body/eax: (addr line) <- lookup *body-ah +780 # perform call +781 var stack-storage: value-stack +782 var stack/edi: (addr value-stack) <- address stack-storage +783 initialize-value-stack stack, 0x10 +784 #? print-string-to-real-screen "about to enter recursive eval\n" +785 evaluate functions, table, body, 0, stack +786 #? print-string-to-real-screen "exited recursive eval\n" +787 # pop target-val from out +788 var top-addr/ecx: (addr int) <- get stack, top +789 compare *top-addr, 0 +790 break-if-<= +791 var data-ah/eax: (addr handle array value) <- get stack, data +792 var data/eax: (addr array value) <- lookup *data-ah +793 var top/edx: int <- copy *top-addr +794 top <- decrement +795 var dest-offset/edx: (offset value) <- compute-offset data, top +796 var target-val/edx: (addr value) <- index data, dest-offset +797 # stitch target-val into caller-stack +798 push-value-stack caller-stack, target-val +799 } +800 +801 # pop args from the caller-stack and bind them to successive args +802 # implies: function args are stored in reverse order +803 fn bind-args _callee: (addr function), _caller-stack: (addr value-stack), table: (addr table) { +804 var callee/ecx: (addr function) <- copy _callee +805 var curr-arg-ah/eax: (addr handle word) <- get callee, args +806 var curr-arg/eax: (addr word) <- lookup *curr-arg-ah +807 # +808 var curr-key-storage: (handle array byte) +809 var curr-key/edx: (addr handle array byte) <- address curr-key-storage +810 { +811 compare curr-arg, 0 +812 break-if-= +813 # create binding +814 word-to-string curr-arg, curr-key +815 { +816 # pop target-val from caller-stack +817 var caller-stack/esi: (addr value-stack) <- copy _caller-stack +818 var top-addr/ecx: (addr int) <- get caller-stack, top +819 compare *top-addr, 0 +820 break-if-<= +821 decrement *top-addr +822 var data-ah/eax: (addr handle array value) <- get caller-stack, data +823 var data/eax: (addr array value) <- lookup *data-ah +824 var top/ebx: int <- copy *top-addr +825 var dest-offset/ebx: (offset value) <- compute-offset data, top +826 var target-val/ebx: (addr value) <- index data, dest-offset +827 # create binding from curr-key to target-val +828 bind-in-table table, curr-key, target-val +829 } +830 # +831 var next-arg-ah/edx: (addr handle word) <- get curr-arg, next +832 curr-arg <- lookup *next-arg-ah +833 loop +834 } +835 } +836 +837 # Copy of 'simplify' that just tracks the maximum stack depth needed +838 # Doesn't actually need to simulate the stack, since every word has a predictable effect. +839 fn max-stack-depth first-word: (addr word), final-word: (addr word) -> _/edi: int { +840 var curr-word/eax: (addr word) <- copy first-word +841 var curr-depth/ecx: int <- copy 0 +842 var result/edi: int <- copy 0 +843 $max-stack-depth:loop: { +844 $max-stack-depth:process-word: { +845 # handle operators +846 { +847 var is-add?/eax: boolean <- word-equal? curr-word, "+" +848 compare is-add?, 0 +849 break-if-= +850 curr-depth <- decrement +851 break $max-stack-depth:process-word +852 } +853 { +854 var is-sub?/eax: boolean <- word-equal? curr-word, "-" +855 compare is-sub?, 0 +856 break-if-= +857 curr-depth <- decrement +858 break $max-stack-depth:process-word +859 } +860 { +861 var is-mul?/eax: boolean <- word-equal? curr-word, "*" +862 compare is-mul?, 0 +863 break-if-= +864 curr-depth <- decrement +865 break $max-stack-depth:process-word +866 } +867 # otherwise it's an int (do we need error-checking?) +868 curr-depth <- increment +869 # update max depth if necessary +870 { +871 compare curr-depth, result +872 break-if-<= +873 result <- copy curr-depth +874 } +875 } +876 # if curr-word == final-word break +877 compare curr-word, final-word +878 break-if-= +879 # curr-word = curr-word->next +880 var next-word-ah/edx: (addr handle word) <- get curr-word, next +881 curr-word <- lookup *next-word-ah +882 # +883 loop +884 } +885 return result +886 } diff --git a/html/apps/tile/value.mu.html b/html/apps/tile/value.mu.html index 6da9cb3d..e982b2bd 100644 --- a/html/apps/tile/value.mu.html +++ b/html/apps/tile/value.mu.html @@ -130,7 +130,7 @@ if ('onhashchange' in window) { 71 print-int32-decimal screen, val 72 break $render-integer:body 73 } - 74 var bg/eax: int <- hash-color val + 74 var bg/eax: int <- hash-color val 75 var fg/ecx: int <- copy 7 76 { 77 compare bg, 2 @@ -174,7 +174,7 @@ if ('onhashchange' in window) { 115 var x/ecx: (addr value) <- index a, off 116 render-value-at screen, row, col, x, 0 117 { -118 var w/eax: int <- value-width x, 0 +118 var w/eax: int <- value-width x, 0 119 add-to col, w 120 increment col 121 } @@ -186,301 +186,299 @@ if ('onhashchange' in window) { 127 128 fn render-screen screen: (addr screen), row: int, col: int, _target-screen: (addr screen) { 129 reset-formatting screen -130 start-color screen, 0xf2, 7 -131 move-cursor screen, row, col -132 var target-screen/esi: (addr screen) <- copy _target-screen -133 var ncols-a/ecx: (addr int) <- get target-screen, num-cols -134 print-upper-border screen, *ncols-a -135 var r/edx: int <- copy 1 -136 var nrows-a/ebx: (addr int) <- get target-screen, num-rows -137 { -138 compare r, *nrows-a -139 break-if-> -140 increment row # mutate arg -141 move-cursor screen, row, col -142 print-string screen, " " -143 var c/edi: int <- copy 1 -144 { -145 compare c, *ncols-a -146 break-if-> -147 print-screen-cell-of-fake-screen screen, target-screen, r, c -148 c <- increment -149 loop -150 } -151 print-string screen, " " -152 r <- increment -153 loop -154 } -155 increment row # mutate arg -156 move-cursor screen, row, col -157 start-color screen, 0xf2, 7 -158 print-lower-border screen, *ncols-a -159 } -160 -161 fn hash-color val: int -> _/eax: int { -162 var result/eax: int <- try-modulo val, 7 # assumes that 7 is always the background color -163 return result -164 } -165 -166 fn print-screen-cell-of-fake-screen screen: (addr screen), _target: (addr screen), _row: int, _col: int { -167 start-color screen, 0, 0xf6 -168 var target/esi: (addr screen) <- copy _target -169 var row/ecx: int <- copy _row -170 var col/edx: int <- copy _col -171 # if cursor is at screen-cell, add some fancy -172 { -173 var cursor-row/eax: (addr int) <- get target, cursor-row -174 compare *cursor-row, row -175 break-if-!= -176 var cursor-col/eax: (addr int) <- get target, cursor-col -177 compare *cursor-col, col -178 break-if-!= -179 start-blinking screen -180 start-color screen, 0, 1 -181 } -182 var g/eax: grapheme <- screen-grapheme-at target, row, col -183 { -184 compare g, 0 -185 break-if-!= -186 g <- copy 0x20 # space -187 } -188 print-grapheme screen, g -189 reset-formatting screen -190 } -191 -192 fn print-upper-border screen: (addr screen), width: int { -193 print-code-point screen, 0x250c # top-left corner -194 var i/eax: int <- copy 0 -195 { -196 compare i, width -197 break-if->= -198 print-code-point screen, 0x2500 # horizontal line -199 i <- increment -200 loop -201 } -202 print-code-point screen, 0x2510 # top-right corner -203 } -204 -205 fn print-lower-border screen: (addr screen), width: int { -206 print-code-point screen, 0x2514 # bottom-left corner -207 var i/eax: int <- copy 0 -208 { -209 compare i, width -210 break-if->= -211 print-code-point screen, 0x2500 # horizontal line -212 i <- increment -213 loop -214 } -215 print-code-point screen, 0x2518 # bottom-right corner -216 } -217 -218 fn value-width _v: (addr value), top-level: boolean -> _/eax: int { -219 var v/esi: (addr value) <- copy _v -220 var type/eax: (addr int) <- get v, type -221 { -222 compare *type, 0 # int -223 break-if-!= -224 var v-int/edx: (addr int) <- get v, int-data -225 var result/eax: int <- decimal-size *v-int -226 return result -227 } -228 { -229 compare *type, 1 # string -230 break-if-!= -231 var s-ah/eax: (addr handle array byte) <- get v, text-data -232 var s/eax: (addr array byte) <- lookup *s-ah -233 compare s, 0 -234 break-if-= -235 var result/eax: int <- length s -236 compare result, 0xd # max string size -237 { -238 break-if-<= -239 result <- copy 0xd -240 } -241 # if it's a nested string, include space for quotes -242 # we don't do this for the top-level, where the quotes will overflow -243 # into surrounding padding. -244 compare top-level, 0 # false -245 { -246 break-if-!= -247 result <- add 2 -248 } -249 return result -250 } -251 { -252 compare *type, 2 # array -253 break-if-!= -254 var a-ah/eax: (addr handle array value) <- get v, array-data -255 var a/eax: (addr array value) <- lookup *a-ah -256 compare a, 0 -257 break-if-= -258 var result/eax: int <- array-width a -259 return result -260 } -261 { -262 compare *type, 3 # file handle -263 break-if-!= -264 var f-ah/eax: (addr handle buffered-file) <- get v, file-data -265 var f/eax: (addr buffered-file) <- lookup *f-ah -266 compare f, 0 -267 break-if-= -268 # TODO: visualizing file handles -269 return 4 -270 } -271 { -272 compare *type, 4 # screen -273 break-if-!= -274 var screen-ah/eax: (addr handle screen) <- get v, screen-data -275 var screen/eax: (addr screen) <- lookup *screen-ah -276 compare screen, 0 -277 break-if-= -278 var ncols/ecx: (addr int) <- get screen, num-cols -279 var result/eax: int <- copy *ncols -280 result <- add 2 # left/right margins -281 return *ncols -282 } -283 return 0 -284 } -285 -286 # keep sync'd with render-array-at -287 fn array-width _a: (addr array value) -> _/eax: int { -288 var a/esi: (addr array value) <- copy _a -289 var max/ecx: int <- length a -290 var i/eax: int <- copy 0 -291 var result/edi: int <- copy 0 -292 { -293 compare i, max -294 break-if->= -295 { -296 compare i, 0 -297 break-if-= -298 result <- increment # for space -299 } -300 var off/ecx: (offset value) <- compute-offset a, i -301 var x/ecx: (addr value) <- index a, off -302 { -303 var w/eax: int <- value-width x, 0 -304 result <- add w -305 } -306 i <- increment -307 loop -308 } -309 # we won't add 2 for surrounding brackets since we don't surround arrays in -310 # spaces like other value types -311 return result -312 } -313 -314 fn value-height _v: (addr value) -> _/eax: int { -315 var v/esi: (addr value) <- copy _v -316 var type/eax: (addr int) <- get v, type -317 { -318 compare *type, 3 # file handle -319 break-if-!= -320 # TODO: visualizing file handles -321 return 1 -322 } -323 { -324 compare *type, 4 # screen -325 break-if-!= -326 var screen-ah/eax: (addr handle screen) <- get v, screen-data -327 var screen/eax: (addr screen) <- lookup *screen-ah -328 compare screen, 0 -329 break-if-= -330 var nrows/ecx: (addr int) <- get screen, num-rows -331 var result/eax: int <- copy *nrows -332 result <- add 2 # top and bottom border -333 return result -334 } -335 return 1 -336 } -337 -338 fn deep-copy-value _src: (addr value), _dest: (addr value) { -339 #? print-string 0, "deep-copy-value\n" -340 var src/esi: (addr value) <- copy _src -341 var dest/edi: (addr value) <- copy _dest -342 var type/ebx: (addr int) <- get src, type -343 var y/ecx: (addr int) <- get dest, type -344 copy-object type, y -345 compare *type, 0 # int -346 { -347 break-if-!= -348 #? print-string 0, "int value\n" -349 var x/eax: (addr int) <- get src, int-data -350 y <- get dest, int-data -351 copy-object x, y -352 return -353 } -354 compare *type, 1 # string -355 { -356 break-if-!= -357 #? print-string 0, "string value\n" -358 var src-ah/eax: (addr handle array byte) <- get src, text-data -359 var src/eax: (addr array byte) <- lookup *src-ah -360 var dest-ah/edx: (addr handle array byte) <- get dest, text-data -361 copy-array-object src, dest-ah -362 return -363 } -364 compare *type, 2 # array -365 { -366 break-if-!= -367 #? print-string 0, "array value\n" -368 var src-ah/eax: (addr handle array value) <- get src, array-data -369 var _src/eax: (addr array value) <- lookup *src-ah -370 var src/esi: (addr array value) <- copy _src -371 var n/ecx: int <- length src -372 var dest-ah/edx: (addr handle array value) <- get dest, array-data -373 populate dest-ah, n -374 var _dest/eax: (addr array value) <- lookup *dest-ah -375 var dest/edi: (addr array value) <- copy _dest -376 var i/eax: int <- copy 0 -377 { -378 compare i, n -379 break-if->= -380 { -381 var offset/edx: (offset value) <- compute-offset src, i -382 var src-element/eax: (addr value) <- index src, offset -383 var dest-element/ecx: (addr value) <- index dest, offset -384 deep-copy-value src-element, dest-element -385 } -386 i <- increment -387 loop -388 } -389 copy-array-object src, dest-ah -390 return -391 } -392 compare *type, 3 # file -393 { -394 break-if-!= -395 #? print-string 0, "file value\n" -396 var src-filename-ah/eax: (addr handle array byte) <- get src, filename -397 var _src-filename/eax: (addr array byte) <- lookup *src-filename-ah -398 var src-filename/ecx: (addr array byte) <- copy _src-filename -399 var dest-filename-ah/ebx: (addr handle array byte) <- get dest, filename -400 copy-array-object src-filename, dest-filename-ah -401 var src-file-ah/eax: (addr handle buffered-file) <- get src, file-data -402 var src-file/eax: (addr buffered-file) <- lookup *src-file-ah -403 var dest-file-ah/edx: (addr handle buffered-file) <- get dest, file-data -404 copy-file src-file, dest-file-ah, src-filename -405 return -406 } -407 compare *type, 4 # screen -408 { -409 break-if-!= -410 #? print-string 0, "screen value\n" -411 var src-screen-ah/eax: (addr handle screen) <- get src, screen-data -412 var _src-screen/eax: (addr screen) <- lookup *src-screen-ah -413 var src-screen/ecx: (addr screen) <- copy _src-screen -414 var dest-screen-ah/eax: (addr handle screen) <- get dest, screen-data -415 allocate dest-screen-ah -416 var dest-screen/eax: (addr screen) <- lookup *dest-screen-ah -417 copy-object src-screen, dest-screen -418 var dest-screen-data-ah/ebx: (addr handle array screen-cell) <- get dest-screen, data -419 var src-screen-data-ah/eax: (addr handle array screen-cell) <- get src-screen, data -420 var src-screen-data/eax: (addr array screen-cell) <- lookup *src-screen-data-ah -421 copy-array-object src-screen-data, dest-screen-data-ah -422 return -423 } -424 } +130 move-cursor screen, row, col +131 var target-screen/esi: (addr screen) <- copy _target-screen +132 var ncols-a/ecx: (addr int) <- get target-screen, num-cols +133 print-upper-border screen, *ncols-a +134 var r/edx: int <- copy 1 +135 var nrows-a/ebx: (addr int) <- get target-screen, num-rows +136 { +137 compare r, *nrows-a +138 break-if-> +139 increment row # mutate arg +140 move-cursor screen, row, col +141 print-string screen, " " +142 var c/edi: int <- copy 1 +143 { +144 compare c, *ncols-a +145 break-if-> +146 print-screen-cell-of-fake-screen screen, target-screen, r, c +147 c <- increment +148 loop +149 } +150 print-string screen, " " +151 r <- increment +152 loop +153 } +154 increment row # mutate arg +155 move-cursor screen, row, col +156 print-lower-border screen, *ncols-a +157 } +158 +159 fn hash-color val: int -> _/eax: int { +160 var result/eax: int <- try-modulo val, 7 # assumes that 7 is always the background color +161 return result +162 } +163 +164 fn print-screen-cell-of-fake-screen screen: (addr screen), _target: (addr screen), _row: int, _col: int { +165 start-color screen, 0, 0xf6 +166 var target/esi: (addr screen) <- copy _target +167 var row/ecx: int <- copy _row +168 var col/edx: int <- copy _col +169 # if cursor is at screen-cell, add some fancy +170 { +171 var cursor-row/eax: (addr int) <- get target, cursor-row +172 compare *cursor-row, row +173 break-if-!= +174 var cursor-col/eax: (addr int) <- get target, cursor-col +175 compare *cursor-col, col +176 break-if-!= +177 start-blinking screen +178 start-color screen, 0, 1 +179 } +180 var g/eax: grapheme <- screen-grapheme-at target, row, col +181 { +182 compare g, 0 +183 break-if-!= +184 g <- copy 0x20 # space +185 } +186 print-grapheme screen, g +187 reset-formatting screen +188 } +189 +190 fn print-upper-border screen: (addr screen), width: int { +191 print-code-point screen, 0x250c # top-left corner +192 var i/eax: int <- copy 0 +193 { +194 compare i, width +195 break-if->= +196 print-code-point screen, 0x2500 # horizontal line +197 i <- increment +198 loop +199 } +200 print-code-point screen, 0x2510 # top-right corner +201 } +202 +203 fn print-lower-border screen: (addr screen), width: int { +204 print-code-point screen, 0x2514 # bottom-left corner +205 var i/eax: int <- copy 0 +206 { +207 compare i, width +208 break-if->= +209 print-code-point screen, 0x2500 # horizontal line +210 i <- increment +211 loop +212 } +213 print-code-point screen, 0x2518 # bottom-right corner +214 } +215 +216 fn value-width _v: (addr value), top-level: boolean -> _/eax: int { +217 var v/esi: (addr value) <- copy _v +218 var type/eax: (addr int) <- get v, type +219 { +220 compare *type, 0 # int +221 break-if-!= +222 var v-int/edx: (addr int) <- get v, int-data +223 var result/eax: int <- decimal-size *v-int +224 return result +225 } +226 { +227 compare *type, 1 # string +228 break-if-!= +229 var s-ah/eax: (addr handle array byte) <- get v, text-data +230 var s/eax: (addr array byte) <- lookup *s-ah +231 compare s, 0 +232 break-if-= +233 var result/eax: int <- length s +234 compare result, 0xd # max string size +235 { +236 break-if-<= +237 result <- copy 0xd +238 } +239 # if it's a nested string, include space for quotes +240 # we don't do this for the top-level, where the quotes will overflow +241 # into surrounding padding. +242 compare top-level, 0 # false +243 { +244 break-if-!= +245 result <- add 2 +246 } +247 return result +248 } +249 { +250 compare *type, 2 # array +251 break-if-!= +252 var a-ah/eax: (addr handle array value) <- get v, array-data +253 var a/eax: (addr array value) <- lookup *a-ah +254 compare a, 0 +255 break-if-= +256 var result/eax: int <- array-width a +257 return result +258 } +259 { +260 compare *type, 3 # file handle +261 break-if-!= +262 var f-ah/eax: (addr handle buffered-file) <- get v, file-data +263 var f/eax: (addr buffered-file) <- lookup *f-ah +264 compare f, 0 +265 break-if-= +266 # TODO: visualizing file handles +267 return 4 +268 } +269 { +270 compare *type, 4 # screen +271 break-if-!= +272 var screen-ah/eax: (addr handle screen) <- get v, screen-data +273 var screen/eax: (addr screen) <- lookup *screen-ah +274 compare screen, 0 +275 break-if-= +276 var ncols/ecx: (addr int) <- get screen, num-cols +277 var result/eax: int <- copy *ncols +278 result <- add 2 # left/right margins +279 return *ncols +280 } +281 return 0 +282 } +283 +284 # keep sync'd with render-array-at +285 fn array-width _a: (addr array value) -> _/eax: int { +286 var a/esi: (addr array value) <- copy _a +287 var max/ecx: int <- length a +288 var i/eax: int <- copy 0 +289 var result/edi: int <- copy 0 +290 { +291 compare i, max +292 break-if->= +293 { +294 compare i, 0 +295 break-if-= +296 result <- increment # for space +297 } +298 var off/ecx: (offset value) <- compute-offset a, i +299 var x/ecx: (addr value) <- index a, off +300 { +301 var w/eax: int <- value-width x, 0 +302 result <- add w +303 } +304 i <- increment +305 loop +306 } +307 # we won't add 2 for surrounding brackets since we don't surround arrays in +308 # spaces like other value types +309 return result +310 } +311 +312 fn value-height _v: (addr value) -> _/eax: int { +313 var v/esi: (addr value) <- copy _v +314 var type/eax: (addr int) <- get v, type +315 { +316 compare *type, 3 # file handle +317 break-if-!= +318 # TODO: visualizing file handles +319 return 1 +320 } +321 { +322 compare *type, 4 # screen +323 break-if-!= +324 var screen-ah/eax: (addr handle screen) <- get v, screen-data +325 var screen/eax: (addr screen) <- lookup *screen-ah +326 compare screen, 0 +327 break-if-= +328 var nrows/ecx: (addr int) <- get screen, num-rows +329 var result/eax: int <- copy *nrows +330 result <- add 2 # top and bottom border +331 return result +332 } +333 return 1 +334 } +335 +336 fn deep-copy-value _src: (addr value), _dest: (addr value) { +337 #? print-string 0, "deep-copy-value\n" +338 var src/esi: (addr value) <- copy _src +339 var dest/edi: (addr value) <- copy _dest +340 var type/ebx: (addr int) <- get src, type +341 var y/ecx: (addr int) <- get dest, type +342 copy-object type, y +343 compare *type, 0 # int +344 { +345 break-if-!= +346 #? print-string 0, "int value\n" +347 var x/eax: (addr int) <- get src, int-data +348 y <- get dest, int-data +349 copy-object x, y +350 return +351 } +352 compare *type, 1 # string +353 { +354 break-if-!= +355 #? print-string 0, "string value\n" +356 var src-ah/eax: (addr handle array byte) <- get src, text-data +357 var src/eax: (addr array byte) <- lookup *src-ah +358 var dest-ah/edx: (addr handle array byte) <- get dest, text-data +359 copy-array-object src, dest-ah +360 return +361 } +362 compare *type, 2 # array +363 { +364 break-if-!= +365 #? print-string 0, "array value\n" +366 var src-ah/eax: (addr handle array value) <- get src, array-data +367 var _src/eax: (addr array value) <- lookup *src-ah +368 var src/esi: (addr array value) <- copy _src +369 var n/ecx: int <- length src +370 var dest-ah/edx: (addr handle array value) <- get dest, array-data +371 populate dest-ah, n +372 var _dest/eax: (addr array value) <- lookup *dest-ah +373 var dest/edi: (addr array value) <- copy _dest +374 var i/eax: int <- copy 0 +375 { +376 compare i, n +377 break-if->= +378 { +379 var offset/edx: (offset value) <- compute-offset src, i +380 var src-element/eax: (addr value) <- index src, offset +381 var dest-element/ecx: (addr value) <- index dest, offset +382 deep-copy-value src-element, dest-element +383 } +384 i <- increment +385 loop +386 } +387 copy-array-object src, dest-ah +388 return +389 } +390 compare *type, 3 # file +391 { +392 break-if-!= +393 #? print-string 0, "file value\n" +394 var src-filename-ah/eax: (addr handle array byte) <- get src, filename +395 var _src-filename/eax: (addr array byte) <- lookup *src-filename-ah +396 var src-filename/ecx: (addr array byte) <- copy _src-filename +397 var dest-filename-ah/ebx: (addr handle array byte) <- get dest, filename +398 copy-array-object src-filename, dest-filename-ah +399 var src-file-ah/eax: (addr handle buffered-file) <- get src, file-data +400 var src-file/eax: (addr buffered-file) <- lookup *src-file-ah +401 var dest-file-ah/edx: (addr handle buffered-file) <- get dest, file-data +402 copy-file src-file, dest-file-ah, src-filename +403 return +404 } +405 compare *type, 4 # screen +406 { +407 break-if-!= +408 #? print-string 0, "screen value\n" +409 var src-screen-ah/eax: (addr handle screen) <- get src, screen-data +410 var _src-screen/eax: (addr screen) <- lookup *src-screen-ah +411 var src-screen/ecx: (addr screen) <- copy _src-screen +412 var dest-screen-ah/eax: (addr handle screen) <- get dest, screen-data +413 allocate dest-screen-ah +414 var dest-screen/eax: (addr screen) <- lookup *dest-screen-ah +415 copy-object src-screen, dest-screen +416 var dest-screen-data-ah/ebx: (addr handle array screen-cell) <- get dest-screen, data +417 var src-screen-data-ah/eax: (addr handle array screen-cell) <- get src-screen, data +418 var src-screen-data/eax: (addr array screen-cell) <- lookup *src-screen-data-ah +419 copy-array-object src-screen-data, dest-screen-data-ah +420 return +421 } +422 } diff --git a/html/apps/tile/word.mu.html b/html/apps/tile/word.mu.html index 3c66be45..89adc88b 100644 --- a/html/apps/tile/word.mu.html +++ b/html/apps/tile/word.mu.html @@ -337,7 +337,7 @@ if ('onhashchange' in window) { 278 break-if-= 279 # recurse 280 var next-ah/ecx: (addr handle word) <- get words-a, next -281 print-words screen, next-ah +281 print-words-in-reverse screen, next-ah 282 # print 283 print-word screen, words-a 284 print-string screen, " " @@ -612,6 +612,24 @@ if ('onhashchange' in window) { 553 var result/ebx: boolean <- word-exists? next-haystack-ah, _needle 554 return result 555 } +556 +557 fn word-list-length words: (addr handle word) -> _/eax: int { +558 var curr-ah/esi: (addr handle word) <- copy words +559 var result/edi: int <- copy 0 +560 { +561 var curr/eax: (addr word) <- lookup *curr-ah +562 compare curr, 0 +563 break-if-= +564 { +565 var word-len/eax: int <- word-length curr +566 result <- add word-len +567 result <- add 1 # inter-word-margin +568 } +569 curr-ah <- get curr, next +570 loop +571 } +572 return result +573 } -- cgit 1.4.1-2-gfad0