forth.s (33463B)
1 .extern uart_put_char 2 .extern uart_get_char 3 .extern uart_put_string 4 5 #define w a0 6 #define x a1 7 #define y a2 8 #define psp sp 9 #define rsp s1 10 11 #define cell 4 12 #define dcell 8 13 14 #define link_offset 0 15 #define hash_offset 4 16 #define meta_offset 8 17 #define flag_offset 12 18 #define code_offset 16 19 20 #define load_cell lw 21 #define store_cell sw 22 23 .equ state_executing, 0 24 .equ state_compiling, 1 25 26 .equ flag_hidden, 0x20 27 .equ flag_immediate, 0x40 28 29 .macro next 30 ret 31 .endm 32 33 .macro push_addr addr 34 push w 35 la w, \addr 36 .endm 37 38 .macro push_imm imm 39 push w 40 li w, \imm 41 .endm 42 43 .macro push reg 44 store_cell \reg, -cell(psp) 45 addi psp, psp, -cell 46 .endm 47 48 .macro pop reg 49 load_cell \reg, 0(psp) 50 addi psp, psp, cell 51 .endm 52 53 .macro push_ret reg 54 store_cell \reg, -cell(rsp) 55 addi rsp, rsp, -cell 56 .endm 57 58 .macro pop_ret reg 59 load_cell \reg, 0(rsp) 60 addi rsp, rsp, cell 61 .endm 62 63 64 .macro this_link 65 .globl link_\+ 66 link_\+: 67 .endm 68 69 .macro prev_link 70 .int link_\+ 71 .endm 72 73 .macro link 74 this_link 75 prev_link 76 .endm 77 78 this_link 79 80 .macro defhead name, label, hash, code, flags=0 81 .section ".rodata" 82 .balign cell 83 .globl name_\label 84 name_\label: 85 link 86 .int \hash 87 .int meta_\label 88 .byte \flags 89 90 .balign cell 91 .globl code_\label 92 code_\label: 93 .int \label 94 95 .section ".text" 96 .balign cell 97 .globl \label 98 \label: 99 .endm 100 101 .macro defmeta name, label 102 .section ".rodata.meta" 103 .global meta_\label 104 meta_\label: 105 .byte length_\@ 106 1: 107 .ascii "\name" 108 .equ length_\@, . - 1b 109 .endm 110 111 .macro defcode name, label, hash, flags=0 112 defmeta "\name", \label 113 defhead "\name", \label, \hash, code_\label, flags=\flags 114 .endm 115 116 .macro defword name, label, hash, flags=0 117 defmeta "\name", \label 118 defhead "\name", \label, \hash, docol, flags=\flags 119 docol 120 .endm 121 122 .macro defvar name, label, hash, flags=0, initial=0 123 defmeta "\name", \label 124 defhead "\name", \label, \hash, dovar, flags=\flags 125 dovar _\label 126 .globl _\label 127 _\label: 128 .endm 129 130 .macro defconst name, label, hash, flags=0, value=0 131 defmeta "\name", \label 132 defhead "\name", \label, \hash, docon, flags=\flags 133 docon \value 134 .globl _\label 135 _\label: 136 .endm 137 138 .macro defconst_addr name, label, hash, flags=0, value=0 139 defmeta "\name", \label 140 defhead "\name", \label, \hash, docon, flags=\flags 141 docon_addr \value 142 .globl _\label 143 _\label: 144 .endm 145 146 .macro docol 147 push_ret ra 148 .endm 149 150 .macro exit 151 pop_ret ra 152 ret 153 .endm 154 155 .macro dovar address 156 push w 157 la w, \address 158 ret 159 .endm 160 161 .macro docon value 162 push w 163 li w, \value 164 ret 165 .endm 166 167 .macro docon_addr value 168 push w 169 la w, \value 170 ret 171 .endm 172 173 defcode "break", break, 0xC9648178 174 next 175 176 defcode "bye", bye, 0x71F39F63 177 la x, __sys_control 178 li y, 0x5555 179 store_cell y, 0(x) 180 next 181 182 # ----------------------------------------------------------------------------- 183 # constants and variables 184 # ----------------------------------------------------------------------------- 185 186 defconst_addr "sp0", sp_top, 0x0C41B8B2, value=__stacktop 187 defconst_addr "rp0", rp_top, 0x8AD91EDD, value=__stacktop_ret 188 defconst "bl", bl, 0x412BAEAB, value=0x20 189 190 defvar "state", state, 0x783132F6 191 .int state_executing 192 193 defvar "data-pointer", data_pointer, 0x491CB0B9 194 .int __here_start 195 196 defvar "code-pointer", code_pointer, 0xB6A06E40 197 .int __exec_start + 2*cell 198 199 defvar "exec-heap", exec_heap, 0xA351EB55 200 .int __exec_start 201 202 defvar "code-heap", code_heap, 0xB6C1CD9D 203 .int __code_start 204 205 defvar "mp", mp, 0x532E0998 206 .int __meta_start 207 208 defvar "latest", latest, 0x41704246 209 .int name_constant 210 211 defvar "base", base, 0x3DDC94D8 212 .int 10 213 214 defvar "delimiter", delimiter, 0x6C15B5FA 215 .int 0x20 # space 216 217 defvar "'source", tick_source, 0xEB4FEC0B 218 .int 0 # length 219 .int 0 # address 220 221 defvar "source-offset", source_offset, 0x7F8C1674 222 .int 0 223 224 defvar "source-id", source_id, 0x965ED1E2 225 .int 0 226 227 defvar "tib", tib, 0xC90B0194 228 .int _tib_len 229 .int _tib_addr 230 231 defvar "prompt", prompt, 0xDFE6493B 232 .int _prompt_len 233 .int _prompt_addr 234 235 defvar "okay", okay, 0xBA9EEB49 236 .int _okay_len 237 .int _okay_addr 238 239 defvar "unknown", unknown, 0x9B759FB9 240 .int _unknown_len 241 .int _unknown_addr 242 243 defvar "context", context, 0x8C87107C 244 .int _context_len 245 .int _context_addr 246 247 # ----------------------------------------------------------------------------- 248 # input and output 249 # ----------------------------------------------------------------------------- 250 251 defcode "type", type, 0x5127F14D 252 mv x, w 253 pop w 254 push_ret ra 255 jal uart_put_string 256 pop_ret ra 257 pop w 258 next 259 260 defcode "emit", emit, 0x2D88474A 261 push_ret ra 262 jal uart_put_char 263 pop_ret ra 264 pop w 265 next 266 267 defcode "key", key, 0x6815C86C 268 jal uart_get_char 269 next 270 271 defword "accept", accept, 0x08247E29 272 # ( dst-addr max-len -- len ) 273 lw x, 0*cell(psp) 274 sw w, 0*cell(psp) 275 mv y, w 276 blez y, _accept_done 277 li s3, 0x0A # '\n' 278 li s4, 0x0D # '\r' 279 _accept_loop: 280 jal uart_get_char 281 beq w, s3, _accept_done 282 beq w, s4, _accept_done 283 sb w, 0(x) 284 addi x, x, 1 285 addi y, y, -1 286 bgtz y, _accept_loop 287 _accept_done: 288 lw w, 0*cell(psp) 289 addi psp, psp, 1*cell 290 sub w, w, y 291 exit 292 293 defword "accept-tib", accept_tib, 0x18571723 294 # ( -- addr len flag ) 295 # reserve stack space and push w 296 addi psp, psp, -2*cell 297 sw w, 1*cell(psp) 298 # load tib addr and len 299 la x, _tib 300 lw w, 0*cell(x) 301 lw x, 1*cell(x) 302 sw x, 0*cell(psp) 303 jal accept 304 # reserve stack space and configure outputs 305 addi psp, psp, -2*cell 306 la x, _tib 307 lw x, 1*cell(x) 308 sw x, 1*cell(psp) 309 sw w, 0*cell(psp) 310 li w, -1 311 exit 312 313 defword "refill", refill, 0x238BAA91 314 # ( -- flag ) 315 # dispatch based on input source 316 la x, _source_id 317 lw x, 0(x) 318 slli x, x, 2 319 la y, _refill_dispatch_table 320 add x, x, y 321 lw x, 0(x) 322 # ( -- addr len flag ) 323 jalr x 324 addi psp, psp, 2*cell 325 beqz w, _refill_fail 326 lw x, -1*cell(psp) 327 lw w, -2*cell(psp) 328 _refill_okay: 329 la y, _tick_source 330 sw w, 0*cell(y) 331 sw x, 1*cell(y) 332 la y, _source_offset 333 sw zero, 0*cell(y) 334 li w, -1 335 _refill_fail: 336 exit 337 338 .section ".data" 339 _refill_dispatch_table: 340 .int accept_tib 341 342 defcode "apply-offset", apply_offset, 0x00000000 343 # ( addr len offset -- addr len ) 344 lw x, 0*cell(psp) 345 lw y, 1*cell(psp) 346 add y, y, w 347 sub w, x, w 348 sw y, 1*cell(psp) 349 addi psp, psp, 1*cell 350 next 351 352 defword "source@", source_fetch, 0x5F1E7A48 353 # ( -- addr len ) 354 jal tick_source 355 jal two_fetch 356 jal source_offset 357 jal fetch 358 jal apply_offset 359 exit 360 361 defword "source!", source_store, 0xC01F12FB 362 # ( addr len -- ) 363 jal tick_source 364 jal two_store 365 la x, _source_offset 366 sw zero, 0*cell(x) 367 exit 368 369 skip_escape: 370 addi x, x, 1 371 addi w, w, -1 372 blez w, _skip_escape_undo 373 lb y, 0(x) 374 addi y, y, -32 375 blez y, _skip_escape_undo 376 _skip_escape: 377 addi x, x, 1 378 addi w, w, -1 379 lb y, 0(x) 380 ret 381 _skip_escape_undo: 382 li y, 92 383 addi x, x, -1 384 addi w, w, 1 385 ret 386 387 defword "skip-while", skip_while, 0xBBFD4B86 388 # ( addr1 len1 -- addr2 len2 ) 389 lw x, 0*cell(psp) 390 blez w, _skip_while_done 391 la t0, _delimiter 392 lb t0, 0(t0) 393 li t1, 92 394 _skip_while_loop: 395 lb y, 0(x) 396 bne y, t1, _skip_while_continue 397 jal skip_escape 398 blez w, _skip_while_done 399 _skip_while_continue: 400 bne y, t0, _skip_while_done 401 addi x, x, 1 402 addi w, w, -1 403 bgtz w, _skip_while_loop 404 _skip_while_done: 405 sw x, 0*cell(psp) 406 exit 407 408 defword "skip-until", skip_until, 0x661D5D67 409 # (addr1 len1 -- addr2 len2 ) 410 lw x, 0*cell(psp) 411 blez w, _skip_until_done 412 la t0, _delimiter 413 lb t0, 0(t0) 414 li t1, 92 415 _skip_until_loop: 416 lb y, 0(x) 417 bne y, t1, _skip_until_continue 418 jal skip_escape 419 blez w, _skip_until_done 420 _skip_until_continue: 421 beq y, t0, _skip_until_done 422 addi x, x, 1 423 addi w, w, -1 424 bgtz w, _skip_until_loop 425 _skip_until_done: 426 sw x, 0*cell(psp) 427 exit 428 429 defword "parse", parse, 0x423B42EC 430 # ( delimiter -- addr len ) 431 jal delimiter 432 jal store 433 jal source_fetch 434 # find start of token 435 jal over 436 jal to_ret 437 jal skip_while 438 # find end of token 439 jal over 440 jal to_ret 441 jal skip_until 442 # compute lengths 443 jal drop 444 jal from_ret 445 jal tuck # addr 446 jal minus # len 447 # advance source to start of token 448 jal over 449 jal from_ret 450 jal minus # n skipped 451 jal source_offset 452 jal plus_store 453 exit 454 455 defword "parse-until", parse_until, 0x6266DA65 456 # ( delimiter -- addr len ) 457 # set delimiter 458 la x, _delimiter 459 sw w, 0(x) 460 # load source 461 la x, _tick_source 462 lw w, 0*cell(x) 463 lw x, 1*cell(x) 464 # apply offset 465 la y, _source_offset 466 lw y, 0*cell(y) 467 add x, x, y 468 sub w, w, y 469 push_ret x 470 # find end of token 471 push x 472 jal skip_until 473 # compute offset 474 lw w, 0*cell(psp) 475 la x, _tick_source 476 lw x, 1*cell(x) 477 sub y, w, x 478 addi y, y, 1 479 la x, _source_offset 480 sw y, 0(x) 481 # set outputs 482 pop_ret x 483 sw x, 0*cell(psp) 484 sub w, w, x 485 exit 486 487 defword "parse-word", parse_word, 0xB218226F 488 jal bl 489 jal parse 490 exit 491 492 defword "parse-word-advance", parse_word_advance, 0x50B4A758 493 jal parse_word 494 jal dup 495 jal source_offset 496 jal plus_store 497 exit 498 499 defword "parse-string", parse_string, 0x1740A6F6 500 # ( -- addr len ) 501 push_imm 0x22 502 jal parse_until 503 # copy string from 'source' before modifying 504 jal tuck 505 la x, _str_addr 506 push x 507 jal char_move 508 # translate escape sequences in-place 509 la x, _str_addr 510 push x 511 jal translate_escape 512 exit 513 514 defword "\"", double_quote, 0x270C92A5, flags=flag_immediate 515 # ( -- ) 516 jal parse_string 517 # lit-string 518 push w 519 la w, lit_string 520 jal compile_comma 521 # len [chars] 522 push w 523 jal lit_comma 524 la x, _code_pointer 525 lw x, 0(x) 526 push x 527 push_ret w 528 jal char_move 529 # set code pointer to after string 530 pop_ret x 531 la y, _code_pointer 532 lw t0, 0*cell(y) 533 add t0, t0, x 534 sw t0, 0*cell(y) 535 jal align_code 536 exit 537 538 defcode "translate-escape", translate_escape, 0x913F36AB 539 # ( addr len -- addr len ) 540 blez w, _translate_escape_done 541 lw x, 0*cell(psp) # src 542 mv y, x # dst 543 _translate_escape_loop: 544 lb t0, 0(x) 545 addi x, x, 1 546 addi y, y, 1 547 addi w, w, -1 548 blez w, _translate_escape_done 549 addi t0, t0, -92 550 beqz t0, _translate_escape 551 j _translate_escape_loop 552 _translate_escape: 553 lb t0, 0(x) 554 mv t1, t0 555 addi x, x, 1 556 addi w, w, -1 557 _translate_escape_lf: 558 addi t0, t0, -110 559 bnez t0, _translate_escape_cr 560 li t1, 0x0A 561 j _translate_escape_store 562 _translate_escape_cr: 563 addi t0, t0, -4 564 bnez t0, _translate_escape_store 565 li t1, 0x0D 566 _translate_escape_store: 567 sb t1, -1(y) 568 bgtz w, _translate_escape_loop 569 _translate_escape_done: 570 lw x, 0*cell(psp) 571 sub w, y, x 572 next 573 574 defword "|", line_comment, 0xF90C4A3B, flags=flag_immediate 575 push_imm 0x0A # '\n' 576 jal parse_until 577 jal two_drop 578 exit 579 580 defword "(", stack_comment, 0x2D0C9C17, flags=flag_immediate 581 push_imm 0x29 # ')' 582 jal parse_until 583 jal two_drop 584 exit 585 586 defcode ">number", to_number, 0x2F770E4C 587 mv x, w 588 pop w 589 mv y, zero # initial value 590 mv s3, zero # sign flag 591 la s4, _base 592 load_cell s4, 0(s4) 593 594 beqz x, _to_number_empty_string 595 596 lb t0, 0(w) 597 addi w, w, 1 598 addi x, x, -1 599 li t1, 0x2D # '-' 600 bne t0, t1, _to_number_digit_value 601 addi s3, s3, -1 602 bnez x, _to_number_loop 603 604 _to_number_empty_string: 605 addi x, x, -1 606 j _to_number_done 607 608 _to_number_invalid: 609 addi x, x, 1 610 j _to_number_sign 611 612 _to_number_loop: 613 mul y, y, s4 614 lb t0, 0(w) 615 addi w, w, 1 616 addi x, x, -1 617 618 _to_number_digit_value: 619 addi t0, t0, -48 620 bltz t0, _to_number_invalid 621 addi t1, t0, -10 622 bltz t1, _to_number_base 623 addi t0, t0, -7 624 addi t1, t0, -10 625 bltz t1, _to_number_invalid 626 627 _to_number_base: 628 bgt t0, s4, _to_number_invalid 629 add y, y, t0 630 bnez x, _to_number_loop 631 632 _to_number_sign: 633 beqz s3, _to_number_done 634 neg y, y 635 636 _to_number_done: 637 push y 638 mv w, x 639 next 640 641 defcode "#", base_10, 0x260C9112, flags=flag_immediate 642 la x, _base 643 li y, 10 644 sw y, 0(x) 645 next 646 647 defcode "$", base_16, 0x210C8933, flags=flag_immediate 648 la x, _base 649 li y, 16 650 sw y, 0(x) 651 next 652 653 defcode "%", base_2, 0x200C87A0, flags=flag_immediate 654 la x, _base 655 li y, 2 656 sw y, 0(x) 657 next 658 659 defword "'", tick, 0x220C8AC6, flags=flag_immediate 660 jal parse_word_advance 661 jal find 662 beqz w, _tick_done 663 _tick_found_word: 664 jal to_cfa 665 jal fetch 666 jal literal 667 _tick_done: 668 exit 669 670 defword "...", postpone, 0x0AC31C19, flags=flag_immediate 671 jal parse_word_advance 672 jal find 673 jal dup 674 jal q_branch 675 .int _postpone_fail 676 _postpone_found_word: 677 jal dup 678 jal macro_q 679 jal q_branch 680 .int _postpone_normal 681 _postpone_macro: 682 # stores `jal-to <xt>` into the current definition 683 jal to_cfa 684 jal fetch 685 jal compile_comma 686 j _postpone_done 687 _postpone_normal: 688 # stores `literal<xt> compile,` into the current definition 689 jal to_cfa 690 jal fetch 691 jal literal 692 push w 693 la w, compile_comma 694 jal compile_comma 695 j _postpone_done 696 _postpone_fail: 697 jal drop 698 _postpone_done: 699 exit 700 701 defword "push,", push_comma, 0x264FE863, flags=flag_immediate 702 push w 703 li w, 0xFEA12E23 # sw w, -4(psp) 704 jal lit_comma 705 push w 706 li w, 0xFFC10113 # addi psp, psp, -4 707 jal lit_comma 708 exit 709 710 defword "literal", literal, 0xECB9D8E4, flags=flag_immediate 711 jal push_comma 712 mv x, w 713 _literal_small_1: 714 # encode `addi w, zero, immed` 715 andi w, x, -1 # 0xFFF 716 slli w, w, 20 717 addi w, w, 0x513 718 # when immed > 4095, we need to use a 2 instruction sequence 719 li y, 0xFFF 720 bgtu x, y, _literal_large_1 721 # when bit 12 isn't set, we're done 722 srli y, x, 11 723 andi y, y, 1 724 beqz y, _literal_small_2 725 _literal_large_1: 726 # change `addi w, zero, immed` to `addi w, w, immed` 727 li y, 0xA 728 slli y, y, 15 729 add w, w, y 730 push w 731 # encode `lui w, immed` 732 li w, 0xFFFFF000 733 and w, x, w 734 # when bit 12 is set, we need to correct for sign ext. from 'addi' 735 srli y, x, 11 736 andi y, y, 1 737 beqz y, _literal_large_2 738 li y, 0x00001000 739 add w, w, y 740 _literal_large_2: 741 addi w, w, 0x537 742 jal lit_comma # emits `lui` 743 _literal_small_2: 744 jal lit_comma # emits `addi` 745 exit 746 747 defcode "word>hash", word_to_hash, 0x50E0A245 748 load_cell w, hash_offset(w) 749 next 750 751 defword "find", find, 0xBDF0855A 752 jal hash 753 jal latest 754 jal fetch 755 _find_loop: 756 jal dup 757 jal zero_equal 758 jal q_branch 759 .int _find_check_hidden 760 jal swap 761 jal drop 762 exit 763 _find_check_hidden: 764 jal dup 765 jal hidden_q 766 jal zero_equal 767 jal q_branch 768 .int _find_next_word 769 _find_check_hash: 770 jal two_dup 771 jal word_to_hash 772 jal equal 773 jal q_branch 774 .int _find_next_word 775 jal swap 776 jal drop 777 exit 778 _find_next_word: 779 jal fetch 780 jal branch 781 .int _find_loop 782 783 defcode ">cfa", to_cfa, 0x8CAC3233 784 addi w, w, code_offset 785 next 786 787 defcode "execute", execute, 0xA01E3D98 788 # Execute a word 789 # ( xt -- ) 790 mv x, w 791 pop w 792 jr x 793 # 'next' should be called by the executed word 794 795 defword "error-unknown", error_unknown, 0xCF846196 796 jal unknown 797 jal two_fetch 798 jal type 799 jal parse_word_advance 800 jal type 801 jal nl 802 jal emit 803 jal context 804 jal two_fetch 805 jal type 806 jal tick_source 807 jal two_fetch 808 jal type 809 jal nl 810 jal emit 811 exit 812 813 defword "interpret", interpret, 0x1F98C57A 814 _interpret_start: 815 # ( -- addr len ) 816 jal parse_word 817 beqz w, _interpret_parse_area_empty 818 _interpret_find_word: 819 jal two_dup 820 jal find 821 beqz w, _interpret_number 822 jal swap 823 jal source_offset 824 jal plus_store 825 jal nip 826 _interpret_word_found: 827 addi w, w, flag_offset 828 lb x, 0(w) 829 andi x, x, flag_immediate 830 addi w, w, code_offset - flag_offset 831 bnez x, _interpret_macro 832 _interpret_word: 833 load_cell w, 0(w) 834 jal compile_comma 835 j _interpret_start 836 _interpret_macro: 837 load_cell w, 0(w) 838 jal execute 839 j _interpret_start 840 _interpret_number: 841 jal drop 842 jal two_dup 843 jal to_number 844 bnez w, _interpret_number_fail 845 jal drop 846 jal swap 847 jal source_offset 848 jal plus_store 849 jal nip 850 jal literal 851 jal base_10 852 j _interpret_start 853 _interpret_number_fail: 854 jal two_drop 855 _interpret_retry: 856 # ( addr len -- addr len ) 857 jal one_minus 858 bnez w, _interpret_find_word 859 _interpret_unrecognized: 860 jal two_drop 861 jal error_unknown 862 j _interpret_start 863 _interpret_parse_area_empty: 864 # ( addr len=0 -- ) 865 addi psp, psp, cell 866 pop w 867 la x, _state 868 lw x, 0(x) 869 li y, state_executing 870 bne x, y, _interpret_done 871 jal interpret_execute 872 _interpret_done: 873 exit 874 875 defcode "nest-execution", nest_execution, 0xCCD56530 876 # ( -- exec-heap r: exec-heap ) 877 push w 878 # save exec heap address 879 la x, _exec_heap 880 lw w, 0(x) 881 push_ret w 882 # update exec heap to point past compiled code 883 la y, _code_pointer 884 lw y, 0(y) 885 sw y, 0(x) 886 next 887 888 defcode "unnest-execution", unnest_execution, 0x9AC2B97B 889 # ( r: exec-heap -- ) 890 # restore code compilation pointer 891 pop_ret x 892 la y, _code_pointer 893 sw x, 0(y) 894 # restore exec heap address 895 la y, _exec_heap 896 sw x, 0(y) 897 next 898 899 defword "(interpret-execute)", interpret_execute, 0x2477F685 900 # ( -- ) 901 # append 'exit' 902 jal exit_comma 903 # run! 904 jal nest_execution 905 jal execute 906 jal unnest_execution 907 # append 'docol' 908 jal docol_comma 909 exit 910 911 defcode "branch", branch, 0xB6873945 912 load_cell ra, 0(ra) 913 next 914 915 defcode "?branch", q_branch, 0x6AF3C1DE 916 bnez w, _branch_done 917 pop w 918 load_cell ra, 0(ra) 919 next 920 _branch_done: 921 pop w 922 addi ra, ra, cell 923 next 924 925 defword "quit", quit, 0x47878736 926 jal rp_top 927 jal rp_store 928 jal prompt 929 jal two_fetch 930 jal type 931 jal refill 932 jal drop # TODO: What should happen when 'refill' fails? 933 jal interpret 934 jal okay 935 jal two_fetch 936 jal type 937 j quit 938 939 defcode "read-line", read_line, 0xAF1308A2 940 # ( src dst n -- len flag ) 941 lw y, 1*cell(psp) # src 942 lw x, 0*cell(psp) # dst 943 addi psp, psp, 1*cell 944 blez w, _read_line_eof 945 _read_line_loop: 946 lb t0, 0(y) 947 beqz t0, _read_line_eof 948 sb t0, 0(x) 949 addi y, y, 1 950 addi x, x, 1 951 addi w, w, -1 952 addi t0, t0, -0x0A 953 beqz t0, _read_line_nl 954 bgtz w, _read_line_loop 955 _read_line_eof: 956 lw x, 0*cell(psp) 957 sub x, y, x 958 sw x, 0*cell(psp) 959 mv w, zero 960 next 961 _read_line_nl: 962 lw x, 0*cell(psp) 963 sub x, y, x 964 sw x, 0*cell(psp) 965 li w, -1 966 next 967 968 defword "tib-source!", tib_source_store, 0x93EE3A0D 969 # ( len -- ) 970 jal tib 971 jal fetch_second 972 jal swap 973 jal source_store 974 exit 975 976 defword "bootstrap", bootstrap, 0x15C160D9 977 push w 978 la w, __file_start 979 _bootstrap_loop: 980 jal dup 981 jal tib 982 jal two_fetch 983 jal read_line 984 beqz w, _bootstrap_done 985 _bootstrap_line: 986 jal drop 987 # store length 988 jal dup 989 addi w, w, -1 990 jal tib_source_store 991 # print line (for debugging) 992 #jal two_dup 993 #jal type 994 # increment source addr 995 jal plus 996 # interpret 997 jal to_ret 998 jal interpret 999 jal from_ret 1000 j _bootstrap_loop 1001 _bootstrap_done: 1002 jal two_drop 1003 exit 1004 1005 defcode "abort", abort, 0xA52BCAF9 1006 jal start 1007 1008 # ----------------------------------------------------------------------------- 1009 # memory access 1010 # ----------------------------------------------------------------------------- 1011 1012 defcode "!", store, 0x240C8DEC 1013 pop x 1014 store_cell x, 0(w) 1015 pop w 1016 next 1017 1018 defcode "@", fetch, 0xC50BF85F 1019 load_cell w, 0(w) 1020 next 1021 1022 defcode "c!", char_store, 0x9829F909 1023 pop x 1024 sb x, 0(w) 1025 pop w 1026 next 1027 1028 defcode "c@", char_fetch, 0x37296056 1029 lb w, 0(w) 1030 next 1031 1032 defcode "2!", two_store, 0x9CF2B11C 1033 pop x 1034 pop y 1035 store_cell x, 0(w) 1036 store_cell y, cell(w) 1037 pop w 1038 next 1039 1040 defcode "2@", two_fetch, 0x3DF21B8F 1041 load_cell y, cell(w) 1042 load_cell w, 0(w) 1043 push y 1044 next 1045 1046 defcode "@1", fetch_first, 0x9FD8152A 1047 # ( addr -- first-value ) 1048 lw w, 0*cell(w) 1049 next 1050 1051 defcode "@2", fetch_second, 0x9ED81397 1052 # ( addr -- second-value ) 1053 lw w, 1*cell(w) 1054 next 1055 1056 defcode "+!", plus_store, 0x08DC01D1 1057 pop x 1058 load_cell y, 0(w) 1059 add y, y, x 1060 store_cell y, 0(w) 1061 pop w 1062 next 1063 1064 defcode "-!", sub_store, 0x24CD235B 1065 pop x 1066 load_cell y, 0(w) 1067 sub y, y, x 1068 store_cell y, 0(w) 1069 pop w 1070 next 1071 1072 defcode "cells", cells, 0xD94ACBB2 1073 li x, cell 1074 mul w, w, x 1075 next 1076 1077 defcode "cell+", cell_plus, 0xB14A8CBA 1078 addi w, w, cell 1079 next 1080 1081 defcode "chars", chars, 0x5DA9662A 1082 next 1083 1084 defcode "char+", char_plus, 0x25A90E02 1085 addi w, w, 1 1086 next 1087 1088 defcode "cmove", char_move, 0x199E414F 1089 # ( src-addr dst-addr n -- ) 1090 lw x, 0*cell(psp) 1091 lw y, 1*cell(psp) 1092 beqz w, _cmove_done 1093 _cmove_loop: 1094 lb t0, 0(y) 1095 sb t0, 0(x) 1096 addi x, x, 1 1097 addi y, y, 1 1098 addi w, w, -1 1099 bnez w, _cmove_loop 1100 _cmove_done: 1101 lw w, 2*cell(psp) 1102 addi psp, psp, 3*cell 1103 next 1104 1105 # ----------------------------------------------------------------------------- 1106 # dictionary management 1107 # ----------------------------------------------------------------------------- 1108 1109 defword "here", here, 0x213B65CB 1110 jal data_pointer 1111 jal fetch 1112 exit 1113 1114 defcode "lit", lit, 0x404CD5B6 1115 push w 1116 load_cell w, 0(ra) 1117 addi ra, ra, cell 1118 next 1119 1120 defcode "lit-string", lit_string, 0xC7BE567C # TODO: ip -> ra, w=tos 1121 push w 1122 load_cell w, 0(ra) # len 1123 addi ra, ra, cell 1124 push ra # addr 1125 # align 1126 add ra, ra, w 1127 addi ra, ra, cell - 1 1128 andi ra, ra, -cell 1129 next 1130 1131 defword "allot", allot, 0xADB1A69F 1132 jal data_pointer 1133 jal plus_store 1134 exit 1135 1136 defcode ",", comma, 0x290C95CB 1137 la y, _data_pointer 1138 load_cell x, 0(y) 1139 store_cell w, 0(x) 1140 addi x, x, cell 1141 store_cell x, 0(y) 1142 pop w 1143 next 1144 1145 defcode "c,", char_comma, 0xA32A0A5A 1146 la y, _data_pointer 1147 load_cell x, 0(y) 1148 sb w, 0(x) 1149 addi x, x, 1 1150 store_cell x, 0(y) 1151 pop w 1152 next 1153 1154 defcode "lit," lit_comma, 0xD2F4416E 1155 # Store a cell-sized value into code space 1156 # ( cell -- ) 1157 la y, _code_pointer 1158 lw x, 0(y) 1159 sw w, 0(x) 1160 addi x, x, 1*cell 1161 sw x, 0(y) 1162 pop w 1163 next 1164 1165 defword "compile,", compile_comma, 0x8D0A6736 1166 # Compile a word into code space 1167 # ( xt -- ) 1168 jal jal_to 1169 jal lit_comma 1170 exit 1171 1172 defcode "align-data", align_data, 0x78D58E59 1173 la x, _data_pointer 1174 lw y, 0(x) 1175 addi y, y, cell-1 1176 andi y, y, -cell 1177 sw y, 0(x) 1178 next 1179 1180 defcode "align-code", align_code, 0xBC9CE4E0 1181 la x, _code_pointer 1182 lw y, 0(x) 1183 addi y, y, cell-1 1184 andi y, y, -cell 1185 sw y, 0(x) 1186 next 1187 1188 # ----------------------------------------------------------------------------- 1189 # stack manipulation 1190 # ----------------------------------------------------------------------------- 1191 1192 defcode "sp@", sp_fetch, 0xFC419F82 1193 # ( -- addr ) 1194 mv x, psp 1195 push w 1196 mv w, x 1197 next 1198 1199 defcode "sp!", sp_store, 0x1D41D375 1200 # ( addr -- ) 1201 mv psp, w 1202 pop w 1203 next 1204 1205 defcode "rp@", rp_fetch, 0x7AD905AD 1206 # ( -- addr ) 1207 push w 1208 mv w, rsp 1209 next 1210 1211 defcode "rp!", rp_store, 0x99D9367A 1212 # ( addr -- ) 1213 mv rsp, w 1214 pop w 1215 next 1216 1217 defcode ">r", to_ret, 0x47FCB8A9 1218 push_ret w 1219 pop w 1220 next 1221 1222 defcode "r>", from_ret, 0x135408B1 1223 push w 1224 pop_ret w 1225 next 1226 1227 defcode "r@", fetch_ret, 0x3D544ACF 1228 push w 1229 load_cell w, 0(rsp) 1230 next 1231 1232 defcode "2>r" two_to_ret, 0x69F5D439 1233 pop x 1234 push_ret x 1235 push_ret w 1236 pop w 1237 next 1238 1239 defcode "2r>", two_from_ret, 0xB54DEDC1 1240 push w 1241 pop_ret w 1242 pop_ret x 1243 push x 1244 next 1245 1246 defcode "dup", dup, 0xD330F226 1247 push w 1248 load_cell w, 0(psp) 1249 next 1250 1251 defcode "?dup", q_dup, 0xFD2928D3 1252 beqz w, _q_dup_done 1253 push w 1254 _q_dup_done: 1255 next 1256 1257 defcode "swap", swap, 0x64ED874E 1258 load_cell x, 0(psp) 1259 store_cell w, 0(psp) 1260 mv w, x 1261 next 1262 1263 defcode "drop", drop, 0xA9A58D8C 1264 pop w 1265 next 1266 1267 defcode "over", over, 0x31F6520F 1268 push w 1269 load_cell w, cell(psp) 1270 next 1271 1272 defcode "nip", nip, 0x21A41868 1273 addi psp, psp, cell 1274 next 1275 1276 defcode "tuck", tuck, 0x8E26FCE8 1277 load_cell x, 0(psp) 1278 store_cell w, 0(psp) 1279 push x 1280 next 1281 1282 defcode "2dup", two_dup, 0x5E46F4D6 1283 load_cell x, 0(psp) 1284 push w 1285 push x 1286 next 1287 1288 defcode "2drop", two_drop, 0xECFD129C 1289 addi psp, psp, cell 1290 pop w 1291 next 1292 1293 # ----------------------------------------------------------------------------- 1294 # math and logic 1295 # ----------------------------------------------------------------------------- 1296 1297 defcode "+", plus, 0x2E0C9DAA 1298 pop x 1299 add w, x, w 1300 next 1301 1302 defcode "-", minus, 0x280C9438 1303 pop x 1304 sub w, x, w 1305 next 1306 1307 defcode "1-", one_minus, 0x00000000 1308 addi w, w, -1 1309 next 1310 1311 defcode "abs", abs, 0x2A48023B 1312 bgtz w, _abs_positive 1313 not w, w 1314 addi w, w, 1 1315 _abs_positive: 1316 next 1317 1318 defcode "negate", negate, 0x757CBB5B 1319 not w, w 1320 addi w, w, 1 1321 next 1322 1323 defcode "*", times, 0x2F0C9F3D 1324 pop x 1325 mul w, x, w 1326 next 1327 1328 defcode "/", div, 0x2A0C975E 1329 pop x 1330 div w, x, w 1331 next 1332 1333 defcode "/mod", div_mod, 0x02E40C82 1334 lw x, 0(psp) 1335 rem y, x, w 1336 div w, x, w 1337 sw y, 0(psp) 1338 next 1339 1340 defcode "not", not_, 0x29B19C8A 1341 not w, w 1342 next 1343 1344 defcode "or", or_, 0x5D342984 1345 pop x 1346 or w, x, w 1347 next 1348 1349 defcode "and", and_, 0x0F29C2A6 1350 pop x 1351 and w, x, w 1352 next 1353 1354 defcode "xor", xor_, 0xCC6BDB7E 1355 pop x 1356 xor w, x, w 1357 next 1358 1359 defcode "lshift", lshift, 0x8DA53719 1360 pop x 1361 sll w, x, w 1362 next 1363 1364 defcode "rshift", rshift, 0x86294EF7 1365 pop x 1366 srl w, x, w 1367 next 1368 1369 defcode "ashift", ashift, 0x46A0EC68 1370 pop x 1371 sra w, x, w 1372 next 1373 1374 defcode "aligned", aligned, 0xC73174DF 1375 addi w, w, cell - 1 1376 andi w, w, -cell 1377 next 1378 1379 # ----------------------------------------------------------------------------- 1380 # comparison 1381 # ----------------------------------------------------------------------------- 1382 1383 defcode "0=", zero_equal, 0x14ED5DD6 1384 mv x, zero 1385 bnez w, _zero_done 1386 addi x, x, -1 1387 _zero_done: 1388 mv w, x 1389 next 1390 1391 defcode "=", equal, 0x380CAD68 1392 pop x 1393 beq w, x, _equal 1394 mv w, zero 1395 next 1396 _equal: 1397 li w, -1 1398 next 1399 1400 defcode "<>", not_equal, 0x93F7201F 1401 pop x 1402 bne w, x, _not_equal 1403 mv w, zero 1404 next 1405 _not_equal: 1406 li w, -1 1407 next 1408 1409 defcode ">", greater_than, 0x3B0CB221 1410 pop x 1411 bgt x, w, _greater_than 1412 mv w, zero 1413 next 1414 _greater_than: 1415 li w, -1 1416 next 1417 1418 defcode "<", less_than, 0x390CAEFB 1419 pop x 1420 blt x, w, _less_than 1421 mv w, zero 1422 next 1423 _less_than: 1424 li w, -1 1425 next 1426 1427 defcode "min", min, 0xC98F4557 1428 pop x 1429 bgt x, w, _min_greater_than 1430 mv w, x 1431 _min_greater_than: 1432 next 1433 1434 defcode "max", max, 0xD7A2E319 1435 pop x 1436 blt x, w, _max_less_than 1437 mv w, x 1438 _max_less_than: 1439 next 1440 1441 # ----------------------------------------------------------------------------- 1442 # compiler 1443 # ----------------------------------------------------------------------------- 1444 1445 defcode "jal-immed", jal_immed, 0xA914EF13 1446 # encode a value as an immediate for a 'jal' instruction 1447 mv x, w 1448 li y, 0x000FF000 # imm[19:12] 1449 and w, x, y 1450 li y, 0x00100000 # imm[20] 1451 and y, x, y 1452 slli y, y, 11 1453 add w, w, y 1454 li y, 0x00000800 # imm[11] 1455 and y, x, y 1456 slli y, y, 9 1457 add w, w, y 1458 andi y, x, 0x000007FE # imm[10:1] 1459 slli y, y, 20 1460 add w, w, y 1461 next 1462 1463 defword "jal-to", jal_to, 0xC38EF054 1464 # generate a 'jal ra, addr' instruction 1465 la x, _code_pointer 1466 load_cell x, 0(x) 1467 sub w, w, x 1468 jal jal_immed 1469 addi w, w, 0x000000EF # jal ra, imm 1470 exit 1471 1472 defword "dovar,", dovar_comma, 0x1F514E5B 1473 # push w 1474 # la w, <address> 1475 jal here 1476 jal literal 1477 # ret 1478 push w 1479 li w, 0x00008067 1480 jal lit_comma 1481 exit 1482 1483 defword "docon,", docon_comma, 0x76DCA1A4 1484 # push w 1485 # li w, <value> 1486 jal literal 1487 # ret 1488 push w 1489 li w, 0x00008067 1490 jal lit_comma 1491 exit 1492 1493 defword "docol,", docol_comma, 0xFAE1EE9E 1494 push w 1495 li w, 0xFE14AE23 # sw ra, -4(s1) 1496 jal lit_comma 1497 push w 1498 li w, 0xFFC48493 # addi s1, s1, -4 1499 jal lit_comma 1500 exit 1501 1502 defword "exit,", exit_comma, 0xD540F80B 1503 push w 1504 li w, 0x0004A083 # lw ra, 0(s1) 1505 jal lit_comma 1506 push w 1507 li w, 0x00448493 # addi s1, s1, 4 1508 jal lit_comma 1509 push w 1510 li w, 0x00008067 # ret 1511 jal lit_comma 1512 exit 1513 1514 defword "create-meta", create_meta, 0x001AE175 1515 # save meta address 1516 la y, _mp 1517 load_cell x, 0(y) 1518 push_ret x 1519 # store name length 1520 sb w, 0(x) 1521 addi x, x, 1 1522 # store name 1523 pop y 1524 _create_meta_loop: 1525 # w=len, x=dst, y=src 1526 lb t0, 0(y) 1527 sb t0, 0(x) 1528 addi w, w, -1 1529 addi x, x, 1 1530 addi y, y, 1 1531 bgtz w, _create_meta_loop 1532 _create_meta_done: 1533 # update meta address 1534 la y, _mp 1535 store_cell x, 0(y) 1536 pop_ret w 1537 exit 1538 1539 defword "string>header", string_to_header, 0x16FBE3AB 1540 jal latest 1541 jal fetch 1542 jal comma 1543 jal two_dup 1544 jal hash 1545 jal comma 1546 jal create_meta 1547 jal comma 1548 push_imm 0 1549 jal char_comma 1550 jal align_data 1551 # update latest 1552 la x, _data_pointer 1553 load_cell x, 0(x) 1554 addi x, x, -code_offset 1555 la y, _latest 1556 store_cell x, 0(y) 1557 # code field 1558 push w 1559 la w, _code_heap 1560 lw w, 0(w) 1561 jal comma 1562 exit 1563 1564 defword ":", define, 0x3F0CB86D, flags=flag_immediate 1565 jal parse_word_advance 1566 jal string_to_header 1567 jal latest 1568 jal fetch 1569 jal hide 1570 jal r_bracket 1571 jal docol_comma 1572 exit 1573 1574 defword "create", create, 0x26BB595D, flags=flag_immediate 1575 jal parse_word_advance 1576 jal string_to_header 1577 jal r_bracket 1578 jal dovar_comma 1579 jal l_bracket 1580 exit 1581 1582 defcode "hash", hash, 0xEDBF0FE3 # 32-bit fnv1a 1583 # ( addr len -- hash ) 1584 pop x 1585 li t0, 2166136261 # hash 1586 li t1, 16777619 # prime 1587 blez w, _hash_done 1588 _hash_loop: 1589 lb y, 0(x) 1590 addi x, x, 1 1591 addi w, w, -1 1592 xor t0, t0, y 1593 mul t0, t0, t1 1594 bgtz w, _hash_loop 1595 _hash_done: 1596 mv w, t0 1597 next 1598 1599 defword "[", l_bracket, 0xDE0C1FBA, flags=flag_immediate 1600 # set state 1601 la x, _state 1602 la y, state_executing 1603 sw y, 0(x) 1604 # save code pointer to code heap 1605 la x, _code_pointer 1606 lw x, 0(x) 1607 la y, _code_heap 1608 sw x, 0(y) 1609 # set code pointer to execution heap 1610 la x, _code_pointer 1611 la y, _exec_heap 1612 lw y, 0(y) 1613 sw y, 0(x) 1614 jal docol_comma 1615 exit 1616 1617 defword "]", r_bracket, 0xD80C1648, flags=flag_immediate 1618 # execute 1619 jal interpret_execute 1620 # set state 1621 la x, _state 1622 li y, state_compiling 1623 sw y, 0(x) 1624 # set code pointer back to code heap 1625 la x, _code_pointer 1626 la y, _code_heap 1627 lw y, 0(y) 1628 sw y, 0(x) 1629 exit 1630 1631 defcode "hide", hide, 0x60E02FAD 1632 addi w, w, flag_offset 1633 lb x, 0(w) 1634 ori x, x, flag_hidden 1635 sb x, 0(w) 1636 pop w 1637 next 1638 1639 defcode "show", show, 0xA947E23C 1640 addi w, w, flag_offset 1641 lb x, 0(w) 1642 andi x, x, ~flag_hidden 1643 sb x, 0(w) 1644 pop w 1645 next 1646 1647 defcode "hidden?", hidden_q, 0x6F436C72 1648 addi w, w, flag_offset 1649 lb w, 0(w) 1650 andi w, w, flag_hidden 1651 next 1652 1653 defword ";", semicolon, 0x3E0CB6DA, flags=flag_immediate 1654 jal exit_comma 1655 jal latest 1656 jal fetch 1657 jal show 1658 jal l_bracket 1659 exit 1660 1661 defcode "macro", macro, 0x36A3CAD3 1662 addi w, w, flag_offset 1663 lb x, 0(w) 1664 ori x, x, flag_immediate 1665 sb x, 0(w) 1666 pop w 1667 next 1668 1669 defcode "macro?", macro_q, 0xEFD87184 1670 addi w, w, flag_offset 1671 lb w, 0(w) 1672 andi w, w, flag_immediate 1673 next 1674 1675 defword ";macro", semicolon_macro, 0x599E1C06, flags=flag_immediate 1676 jal semicolon 1677 jal latest 1678 jal fetch 1679 jal macro 1680 exit 1681 1682 defword "variable", variable, 0x19385305, flags=flag_immediate 1683 jal create 1684 # initialize to zero 1685 push w 1686 mv w, zero 1687 jal comma 1688 exit 1689 1690 defword "constant", constant, 0x0691EA25, flags=flag_immediate 1691 jal parse_word_advance 1692 jal string_to_header 1693 jal r_bracket 1694 jal docon_comma 1695 jal l_bracket 1696 exit 1697 1698 1699 .section ".text" 1700 program: 1701 jal type 1702 jal quit 1703 1704 .section ".rodata" 1705 version_string: 1706 .ascii "soup forth rv32\n" 1707 version_string_len = (. - version_string) 1708 1709 _prompt_addr: 1710 .ascii "> " 1711 _prompt_len = (. - _prompt_addr) 1712 1713 _okay_addr: 1714 .ascii "ok\n" 1715 _okay_len = (. - _okay_addr) 1716 1717 _unknown_addr: 1718 .ascii "unknown: " 1719 _unknown_len = (. - _unknown_addr) 1720 1721 _context_addr: 1722 .ascii "context: " 1723 _context_len = (. - _context_addr) 1724 1725 __file_end: 1726 .int 0 1727 1728 .section ".data" 1729 .balign cell 1730 _tib_addr: 1731 .space 255 1732 _tib_len = (. - _tib_addr) 1733 1734 # this is used as a temporary location for strings inbetween parsing and 1735 # compilation. 1736 _str_addr: 1737 .space 255 1738 _str_len = (. - _str_addr) 1739 1740 .section ".text.boot" 1741 .globl start 1742 .balign cell 1743 start: 1744 la w, __stacktop_trap 1745 csrrw w, mscratch, w 1746 1747 la w, trap_table + 1 1748 csrw mtvec, w 1749 1750 la w, __exec_start 1751 li x, 0xFE14AE23 # sw ra, -4(s1) 1752 li y, 0xFFC48493 # addi s1, s1, -4 1753 sw x, 0(w) 1754 sw y, cell(w) 1755 1756 la psp, __stacktop 1757 la rsp, __stacktop_ret 1758 li w, 0xDEADC0DE 1759 1760 push_addr version_string 1761 push_imm version_string_len 1762 1763 jal program 1764