main.asm

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