src/main.asm

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