main.asm

   1 ;; vim: syntax=fasm
   2
   3 ;; At compile-time we load the module given by the environment variable
   4 ;; OS_INCLUDE. This module should define the following macros:
   5 ;;
   6 ;; Each of these functions should preserve the value of RSI and RSP. They may
   7 ;; use other registers as they like.
   8 ;;
   9 ;; os_initialize
  10 ;;   Called at initialization.
  11 ;;
  12 ;; os_print_string
  13 ;;   Takes a string buffer in RCX and the length in RDX, and prints the string
  14 ;;   to the console.
  15 ;;
  16 ;; os_read_char
  17 ;;   Wait for the user to type a key, and then put the corresponding ASCII byte
  18 ;;   into the buffer pointed to by RCX.
  19 ;;
  20 ;; os_terminate
  21 ;;   Shut down the system.
  22 include '%OS_INCLUDE%'
  23
  24 ;; Print a string of a given length.
  25 ;;
  26 ;; Input:
  27 ;; - RCX = Pointer to buffer
  28 ;; - RDX = Buffer length
  29 ;;
  30 ;; Clobbers: RAX, RCX, R11, RDI, RSI
  31 macro sys_print_string {
  32   push r8
  33   push r9
  34   push r10
  35
  36   call os_print_string
  37
  38   pop r10
  39   pop r9
  40   pop r8
  41 }
  42
  43 ;; Read a character from the user into the given buffer.
  44 ;;
  45 ;; Input:
  46 ;; - RSI = Character buffer
  47 ;;
  48 ;; Output:
  49 ;; - BYTE [RSI] = Character
  50 ;;
  51 ;; Clobbers: RAX, RCX, R11, RDI, RSI, RDX
  52 macro sys_read_char {
  53   push rbx
  54   push r8
  55   push r9
  56   push r10
  57   push r15
  58
  59   mov rcx, rsi
  60   call os_read_char
  61
  62   pop r15
  63   pop r10
  64   pop r9
  65   pop r8
  66   pop rbx
  67 }
  68
  69 macro sys_terminate code {
  70   mov rax, code
  71   call os_terminate
  72 }
  73
  74 ;; The code in this macro is placed at the end of each Forth word. When we are
  75 ;; executing a definition, this code is what causes execution to resume at the
  76 ;; next word in that definition.
  77 macro next {
  78   ;; RSI points to the address of the definition of the next word to execute.
  79   lodsq                   ; Load value at RSI into RAX and increment RSI
  80   ;; Now RAX contains the location of the next word to execute. The first 8
  81   ;; bytes of this word is the address of the codeword, which is what we want
  82   ;; to execute.
  83   jmp qword [rax]         ; Jump to the codeword of the current word
  84 }
  85
  86 ;; pushr and popr work on the return stack, whose location is stored in the
  87 ;; register RBP.
  88 macro pushr x {
  89   sub rbp, 8
  90   mov qword [rbp], x
  91 }
  92 macro popr x {
  93   mov x, [rbp]
  94   add rbp, 8
  95 }
  96
  97 ;; The following macro generates the dictionary header. It updates the
  98 ;; initial_latest_entry variable, which is used as the initial value of the
  99 ;; latest_entry variable that is made available at runtime.
 100 ;;
 101 ;; The header contains a link to the previous entry, the length of the name of
 102 ;; the word and the word itself as a string literal.
 103 ;;
 104 ;; This macro also defines a label LABEL_entry.
 105 initial_latest_entry = 0
 106 macro header label, name, immediate {
 107   local .string_end
 108
 109 label#_entry:
 110   dq initial_latest_entry
 111   if immediate eq
 112     db 0
 113   else
 114     db 1
 115   end if
 116   db .string_end - ($ + 1)
 117   db name
 118   .string_end:
 119 label:
 120
 121 initial_latest_entry = label#_entry
 122 }
 123
 124 ;; Define a Forth word that is implemented in assembly. See 'header' for details.
 125 macro forth_asm label, name, immediate {
 126   header label, name, immediate
 127   dq .start
 128 .start:
 129 }
 130
 131 section '.text' code readable executable
 132
 133 include "impl.asm"      ; Misc. subroutines
 134 include "bootstrap.asm" ; Forth words encoded in Assembly
 135
 136 main:
 137   cld                        ; Clear direction flag so LODSQ does the right thing.
 138   mov rbp, return_stack_top  ; Initialize return stack
 139
 140   call os_initialize
 141
 142   mov rax, MAIN
 143   jmp qword [rax]
 144
 145 program: dq MAIN
 146
 147 ;; The codeword is the code that will be executed at the beginning of a forth
 148 ;; word. It needs to save the old RSI and update it to point to the next word to
 149 ;; execute.
 150 header DOCOL, 'DOCOL'
 151   pushr rsi            ; Save old value of RSI on return stack; we will continue execution there after we are done executing this word
 152   lea rsi, [rax + 8]   ; RAX currently points to the address of the codeword, so we want to continue at RAX+8
 153   next                 ; Execute word pointed to by RSI
 154
 155 ;; This word is called at the end of a Forth definition. It just needs to
 156 ;; restore the old value of RSI (saved by 'DOCOL') and resume execution.
 157 forth_asm EXIT, 'EXIT'
 158   popr rsi
 159   next
 160
 161 ;; LIT is a special word that reads the next "word pointer" and causes it to be
 162 ;; placed on the stack rather than executed.
 163 forth_asm LIT, 'LIT'
 164   lodsq
 165   push rax
 166   next
 167
 168 ;; When LITSTRING is encountered while executing a word, it instead reads a
 169 ;; string from the definition of that word, and places that string on the stack
 170 ;; as (buffer, length).
 171 forth_asm LITSTRING, 'LITSTRING'
 172   lodsb
 173   push rsi ; Buffer
 174   movzx rax, al
 175   push rax ; Length
 176   add rsi, rax ; Skip over string before resuming execution
 177   next
 178
 179 ;; Given a string (a pointer following by a size), return the location of the
 180 ;; dictionary entry for that word. If no such word exists, return 0.
 181 forth_asm FIND, 'FIND'
 182   mov [.rsi], rsi
 183
 184   pop [find.search_length]
 185   pop [find.search_buffer]
 186   mov rsi, [latest_entry]       ; Start with the last added word
 187   call find
 188   push rsi
 189
 190   mov rsi, [.rsi]
 191   next
 192   push rsi
 193
 194   mov rsi, [.rsi]
 195   next
 196
 197 ;; Given an entry in the dictionary, return a pointer to the codeword of that
 198 ;; entry.
 199 forth_asm TCFA, '>CFA'
 200   pop rax
 201   add rax, 8 + 1                ; [rax] = length of name
 202   movzx rbx, byte [rax]
 203   inc rax
 204   add rax, rbx                  ; [rax] = codeword
 205   push rax
 206   next
 207
 208 ;; BRANCH is the fundamental mechanism for branching. BRANCH reads the next word
 209 ;; as a signed integer literal and jumps by that offset.
 210 forth_asm BRANCH, 'BRANCH'
 211   add rsi, [rsi] ; [RSI], which is the next word, contains the offset; we add this to the instruction pointer.
 212   next           ; Then, we can just continue execution as normal
 213
 214 ;; 0BRANCH is like BRANCH, but it jumps only if the top of the stack is zero.
 215 forth_asm ZBRANCH, '0BRANCH'
 216   ;; Compare top of stack to see if we should branch
 217   pop rax
 218   cmp rax, 0
 219   jnz .dont_branch
 220 .do_branch:
 221   jmp BRANCH.start
 222 .dont_branch:
 223   add rsi, 8     ; We need to skip over the next word, which contains the offset.
 224   next
 225
 226 ;; Duplicate the top of the stack.
 227 forth_asm DUP_, 'DUP'
 228   push qword [rsp]
 229   next
 230
 231 ;; Execute the codeword at the given address.
 232 forth_asm EXEC, 'EXEC'
 233   pop rax
 234   jmp qword [rax]
 235
 236 ;; Expects a character on the stack and prints it to standard output.
 237 forth_asm EMIT, 'EMIT'
 238   pushr rsi
 239   pushr rax
 240
 241   lea rcx, [rsp]
 242   mov rdx, 1
 243   sys_print_string
 244
 245   add rsp, 8
 246   popr rax
 247   popr rsi
 248   next
 249
 250 ;; Read a single character from the current input stream. Usually, this will wait
 251 ;; for the user to press a key, and then return the corresponding character. When
 252 ;; reading from a special buffer, it will instead return the next characater from
 253 ;; that buffer.
 254 ;;
 255 ;; The ASCII character code is placed on the stack.
 256 forth_asm KEY, 'KEY'
 257   call .impl
 258   push rax
 259   next
 260
 261 ;; Result in RAX
 262 .impl:
 263   ;; Are we reading from user input or from the input buffer?
 264   cmp [input_buffer], 0
 265   jne .from_buffer
 266
 267   ;; Reading user input
 268   push rsi
 269   mov rsi, .buffer
 270   sys_read_char
 271   pop rsi
 272
 273   movzx rax, byte [.buffer]
 274   ret
 275
 276 .from_buffer:
 277   ;; Reading from buffer
 278   mov rax, [input_buffer]
 279   movzx rax, byte [rax]
 280
 281   inc [input_buffer]
 282   dec [input_buffer_length]
 283   ret
 284
 285 ;; Read a word and push it onto the stack as a pointer and a size. The pointer
 286 ;; is valid until the next call to READ_WORD.
 287 forth_asm READ_WORD, 'READ-WORD'
 288   push rsi
 289 .skip_whitespace:
 290   ;; Read characters until one of them is not whitespace.
 291   call KEY.impl
 292   ;; We consider newlines and spaces to be whitespace.
 293   cmp al, ' '
 294   je .skip_whitespace
 295   cmp al, $A
 296   je .skip_whitespace
 297
 298   ;; We got a character that wasn't whitespace. Now read the actual word.
 299   mov [.length], 0
 300
 301 .read_alpha:
 302   movzx rbx, [.length]
 303   mov rsi, .buffer
 304   add rsi, rbx
 305   mov [rsi], al
 306   inc [.length]
 307
 308   call KEY.impl
 309
 310   cmp al, ' '
 311   je .end
 312   cmp al, $A
 313   jne .read_alpha
 314
 315 .end:
 316   pop rsi
 317   push .buffer
 318   movzx rax, [.length]
 319   push rax
 320
 321   next
 322
 323 ;; Takes a string on the stack and replaces it with the decimal number that the
 324 ;; string represents.
 325 forth_asm PARSE_NUMBER, 'PARSE-NUMBER'
 326   pop rcx     ; Length
 327   pop rdi     ; String pointer
 328
 329   push rsi
 330   call parse_number
 331   pop rsi
 332
 333   push rax                      ; Result
 334   next
 335
 336 ;; Takes a string (in the form of a pointer and a length on the stack) and
 337 ;; prints it to standard output.
 338 forth_asm TELL, 'TELL'
 339   pushr rax
 340   pushr rsi
 341
 342   pop rdx ; Length
 343   pop rcx ; Buffer
 344   sys_print_string
 345
 346   popr rsi
 347   popr rax
 348   next
 349
 350 ;; Exit the program cleanly.
 351 forth_asm TERMINATE, 'TERMINATE'
 352   sys_terminate 0
 353
 354 ;; Duplicate a pair of elements.
 355 forth_asm PAIRDUP, '2DUP'
 356   pop rbx
 357   pop rax
 358   push rax
 359   push rbx
 360   push rax
 361   push rbx
 362   next
 363
 364 ;; Swap the top two elements on the stack.
 365 forth_asm SWAP, 'SWAP'
 366   pop rax
 367   pop rbx
 368   push rax
 369   push rbx
 370   next
 371
 372 ;; Remove the top element from the stack.
 373 forth_asm DROP, 'DROP'
 374   add rsp, 8
 375   next
 376
 377 forth_asm NOT_, 'NOT'
 378   pop rax
 379   cmp rax, 0
 380   jz .false
 381 .true:
 382   push 0
 383   next
 384 .false:
 385   push 1
 386   next
 387
 388 ;; .U prints the value on the stack as an unsigned integer in hexadecimal.
 389 forth_asm DOTU, '.U'
 390   mov [.length], 0
 391   mov [.printed_length], 1
 392   pop rax                       ; RAX = value to print
 393   push rsi                      ; Save value of RSI
 394
 395   ;; We start by constructing the buffer to print in reverse
 396
 397 .loop:
 398   mov rdx, 0
 399   mov rbx, $10
 400   div rbx                       ; Put remainer in RDX and quotient in RAX
 401
 402   ;; Place the appropriate character in the buffer
 403   mov rsi, .chars
 404   add rsi, rdx
 405   mov bl, [rsi]
 406   mov rdi, .rbuffer
 407   add rdi, [.length]
 408   mov [rdi], bl
 409   inc [.length]
 410
 411   ;; .printed_length is the number of characters that we ulitmately want to
 412   ;; print. If we have printed a non-zero character, then we should update
 413   ;; .printed_length.
 414   cmp bl, '0'
 415   je .skip_updating_real_length
 416   mov rbx, [.length]
 417   mov [.printed_length], rbx
 418 .skip_updating_real_length:
 419
 420   cmp [.length], 16
 421   jle .loop
 422
 423   ;; Flip buffer around, since it is currently reversed
 424   mov rcx, [.printed_length]
 425 .flip:
 426   mov rsi, .rbuffer
 427   add rsi, rcx
 428   dec rsi
 429   mov al, [rsi]
 430
 431   mov rdi, .buffer
 432   add rdi, [.printed_length]
 433   sub rdi, rcx
 434   mov [rdi], al
 435
 436   loop .flip
 437
 438   ;; Print the buffer
 439   mov rcx, .buffer
 440   mov rdx, [.printed_length]
 441   sys_print_string
 442
 443   ;; Restore RSI and continue execution
 444   pop rsi
 445   next
 446
 447 ;; Takes a value and an address, and stores the value at the given address.
 448 forth_asm PUT, '!'
 449   pop rbx                       ; Address
 450   pop rax                       ; Value
 451   mov [rbx], rax
 452   next
 453
 454 ;; Takes an address and returns the value at the given address.
 455 forth_asm GET, '@'
 456   pop rax
 457   mov rax, [rax]
 458   push rax
 459   next
 460
 461 forth_asm PUT_BYTE, 'C!'
 462   pop rbx
 463   pop rax                       ; Value
 464   mov [rbx], al
 465   next
 466
 467 forth_asm GET_BYTE, 'C@'
 468   pop rax
 469   movzx rax, byte [rax]
 470   push rax
 471   next
 472
 473 ;; Add two integers on the stack.
 474 forth_asm PLUS, '+'
 475   pop rax
 476   pop rbx
 477   add rax, rbx
 478   push rax
 479   next
 480
 481 ;; Calculate difference between two integers on the stack. The second number is
 482 ;; subtracted from the first.
 483 forth_asm MINUS, '-'
 484   pop rax
 485   pop rbx
 486   sub rbx, rax
 487   push rbx
 488   next
 489
 490 ;; Given two integers a and b on the stack, pushes the quotient and remainder of
 491 ;; division of a by b.
 492 forth_asm TIMESMOD, '/MOD'
 493   pop rbx                       ; b
 494   pop rax                       ; a
 495   mov rdx, 0
 496   div rbx
 497   push rax                      ; a / b
 498   push rdx                      ; a % b
 499   next
 500
 501 ;; Read input until next " character is found. Push a string containing the
 502 ;; input on the stack as (buffer length). Note that the buffer is only valid
 503 ;; until the next call to S" and that no more than 255 characters can be read.
 504 forth_asm READ_STRING, 'S"'
 505   ;; If the input buffer is set, we should read from there instead.
 506   cmp [input_buffer], 0
 507   jne read_string_buffer
 508
 509   push rsi
 510
 511   mov [.length], 0
 512
 513 .read_char:
 514   mov rsi, .char_buffer
 515   sys_read_char
 516
 517   mov al, [.char_buffer]
 518   cmp al, '"'
 519   je .done
 520
 521   mov rdx, .buffer
 522   add rdx, [.length]
 523   mov [rdx], al
 524   inc [.length]
 525   jmp .read_char
 526
 527 .done:
 528   pop rsi
 529
 530   push .buffer
 531   push [.length]
 532
 533   next
 534
 535 read_string_buffer:
 536   push rsi
 537
 538   ;; We borrow READ_STRING's buffer. They won't mind.
 539   mov [READ_STRING.length], 0
 540
 541 .read_char:
 542   mov rbx, [input_buffer]
 543   mov al, [rbx]
 544   cmp al, '"'
 545   je .done
 546
 547   mov rdx, READ_STRING.buffer
 548   add rdx, [READ_STRING.length]
 549   mov [rdx], al
 550   inc [READ_STRING.length]
 551
 552   inc [input_buffer]
 553   dec [input_buffer_length]
 554
 555   jmp .read_char
 556
 557 .done:
 558   pop rsi
 559
 560   ;; Skip closing "
 561   inc [input_buffer]
 562   dec [input_buffer_length]
 563
 564   push READ_STRING.buffer
 565   push [READ_STRING.length]
 566
 567   next
 568
 569 ;; CREATE inserts a new header in the dictionary, and updates LATEST so that it
 570 ;; points to the header. To compile a word, the user can then call ',' to
 571 ;; continue to append data after the header.
 572 ;;
 573 ;; It takes the name of the word as a string (address length) on the stack.
 574 forth_asm CREATE, 'CREATE'
 575   pop rcx                       ; Word string length
 576   pop rdx                       ; Word string pointer
 577
 578   mov rdi, [here]               ; rdi = Address at which to insert this entry
 579   mov rax, [latest_entry]       ; rax = Address of the previous entry
 580   mov [rdi], rax                ; Insert link to previous entry
 581   mov [latest_entry], rdi       ; Update LATEST to point to this word
 582
 583   add rdi, 8
 584   mov [rdi], byte 0             ; Insert immediate flag
 585
 586   add rdi, 1
 587   mov [rdi], byte cl            ; Insert length
 588
 589   ;; Insert word string
 590   add rdi, 1
 591
 592   push rsi
 593   mov rsi, rdx                  ; rsi = Word string pointer
 594   rep movsb
 595   pop rsi
 596
 597   ;; Update HERE
 598   mov [here], rdi
 599
 600   next
 601
 602 forth_asm TICK, "'"
 603   lodsq
 604   push rax
 605   next
 606
 607 forth_asm ROT, 'ROT'
 608   pop rax
 609   pop rbx
 610   pop rdx
 611   push rax
 612   push rdx
 613   push rbx
 614   next
 615
 616 forth_asm PICK, 'PICK'
 617   pop rax
 618   lea rax, [rsp + 8 * rax]
 619   mov rax, [rax]
 620   push rax
 621   next
 622
 623 forth_asm EQL, '='
 624   pop rax
 625   pop rbx
 626   cmp rax, rbx
 627   je .eq
 628 .noteq:
 629   push 0
 630   next
 631 .eq:
 632   push 1
 633   next
 634
 635 forth MAIN, 'MAIN'
 636   dq SYSCODE
 637   dq INTERPRET_STRING
 638   dq INTERPRET
 639   dq BRANCH, -8 * 2
 640   dq TERMINATE
 641
 642 ;; Built-in variables:
 643
 644 forth STATE, 'STATE'
 645   dq LIT, var_STATE
 646   dq EXIT
 647
 648 forth LATEST, 'LATEST'
 649   dq LIT, latest_entry
 650   dq EXIT
 651
 652 forth HERE, 'HERE'
 653   dq LIT, here
 654   dq EXIT
 655
 656 forth SYSCODE, 'SYSCODE'
 657   dq LIT, sysf
 658   dq LIT, sysf.len
 659   dq EXIT
 660
 661 forth INPUT_BUFFER, 'INPUT-BUFFER'
 662   dq LIT, input_buffer
 663   dq EXIT
 664
 665 forth INPUT_LENGTH, 'INPUT-LENGTH'
 666   dq LIT, input_buffer_length
 667   dq EXIT
 668
 669 section '.data' readable writable
 670
 671 ;; The LATEST variable holds a pointer to the word that was last added to the
 672 ;; dictionary. This pointer is updated as new words are added, and its value is
 673 ;; used by FIND to look up words.
 674 latest_entry dq initial_latest_entry
 675
 676 ;; The STATE variable is 0 when the interpreter is executing, and non-zero when
 677 ;; it is compiling.
 678 var_STATE dq 0
 679
 680 ;; The interpreter can read either from standard input or from a buffer. When
 681 ;; input-buffer is set (non-null), words like READ-WORD and S" will use this
 682 ;; buffer instead of reading user input.
 683 input_buffer dq 0
 684 input_buffer_length dq 0
 685
 686 FIND.rsi dq ?
 687
 688 READ_WORD.rsi dq ?
 689 READ_WORD.rbp dq ?
 690
 691 READ_STRING.char_buffer db ?
 692 READ_STRING.buffer rb $FF
 693 READ_STRING.length dq ?
 694
 695 DOTU.chars db '0123456789ABCDEF'
 696 DOTU.buffer rq 16               ; 64-bit number has no more than 16 digits in hex
 697 DOTU.rbuffer rq 16
 698 DOTU.length dq ?
 699 DOTU.printed_length dq ?
 700
 701 KEY.buffer dq ?
 702
 703 READ_WORD.buffer rb $FF
 704 READ_WORD.length db ?
 705
 706 ;; Reserve space for compiled words, accessed through HERE.
 707 here dq here_top
 708 here_top rq $4000
 709
 710 ;; Return stack
 711 rq $2000
 712 return_stack_top:
 713
 714 ;; We store some Forth code in sys.f that defined common words that the user
 715 ;; would expect to have available at startup. To execute these words, we just
 716 ;; include the file directly in the binary, and then interpret it at startup.
 717 sysf file 'sys.f'
 718 sysf.len = $ - sysf
 719