main.asm

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