main.asm

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