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 from standard input and push it onto the stack as a pointer and a
 199 ;; size. The pointer is valid until the next call to READ_WORD.
 200 forth_asm READ_WORD, 'READ-WORD'
 201   mov [.rsi], rsi
 202
 203   call read_word
 204   push rdi                      ; Buffer
 205   push rdx                      ; Length
 206
 207   mov rsi, [.rsi]
 208   next
 209
 210 ;; Read a word from a buffer. Expects (buffer buffer-length) on the stack.
 211 ;; Updates buffer and buffer-length, such that the word has been removed from
 212 ;; the buffer. Appends (word-buffer word-buffer-length) to the stack.
 213 forth_asm POP_WORD, 'POP-WORD'
 214   pushr rsi
 215
 216   pop rcx ; Length
 217   pop rsi ; Buffer
 218
 219   call pop_word
 220
 221   push rsi ; Updated buffer
 222   push rcx ; Length of updated buffer
 223   push rdi ; Word buffer
 224   push rdx ; Length of word buffer
 225
 226   popr rsi
 227   next
 228
 229 ;; Takes a string on the stack and replaces it with the decimal number that the
 230 ;; string represents.
 231 forth_asm PARSE_NUMBER, 'PARSE-NUMBER'
 232   pop rcx     ; Length
 233   pop rdi     ; String pointer
 234
 235   push rsi
 236   call parse_number
 237   pop rsi
 238
 239   push rax                      ; Result
 240   next
 241
 242 ;; Takes a string (in the form of a pointer and a length on the stack) and
 243 ;; prints it to standard output.
 244 forth_asm TELL, 'TELL'
 245   pushr rax
 246   pushr rsi
 247
 248   pop rdx ; Length
 249   pop rcx ; Buffer
 250   sys_print_string
 251
 252   popr rsi
 253   popr rax
 254   next
 255
 256 ;; Exit the program cleanly.
 257 forth_asm TERMINATE, 'TERMINATE'
 258   mov rax, $3C
 259   mov rdi, 0
 260   syscall
 261
 262 ;; Duplicate a pair of elements.
 263 forth_asm PAIRDUP, '2DUP'
 264   pop rbx
 265   pop rax
 266   push rax
 267   push rbx
 268   push rax
 269   push rbx
 270   next
 271
 272 ;; Swap the top two elements on the stack.
 273 forth_asm SWAP, 'SWAP'
 274   pop rax
 275   pop rbx
 276   push rax
 277   push rbx
 278   next
 279
 280 ;; Remove the top element from the stack.
 281 forth_asm DROP, 'DROP'
 282   add rsp, 8
 283   next
 284
 285 forth_asm NOT_, 'NOT'
 286   pop rax
 287   cmp rax, 0
 288   jz .false
 289 .true:
 290   push 0
 291   next
 292 .false:
 293   push 1
 294   next
 295
 296 ;; .U prints the value on the stack as an unsigned integer in hexadecimal.
 297 forth_asm DOTU, '.U'
 298   mov [.length], 0
 299   mov [.printed_length], 1
 300   pop rax                       ; RAX = value to print
 301   push rsi                      ; Save value of RSI
 302
 303   ;; We start by constructing the buffer to print in reverse
 304
 305 .loop:
 306   mov rdx, 0
 307   mov rbx, $10
 308   div rbx                       ; Put remainer in RDX and quotient in RAX
 309
 310   ;; Place the appropriate character in the buffer
 311   mov rsi, .chars
 312   add rsi, rdx
 313   mov bl, [rsi]
 314   mov rdi, .rbuffer
 315   add rdi, [.length]
 316   mov [rdi], bl
 317   inc [.length]
 318
 319   ;; .printed_length is the number of characters that we ulitmately want to
 320   ;; print. If we have printed a non-zero character, then we should update
 321   ;; .printed_length.
 322   cmp bl, '0'
 323   je .skip_updating_real_length
 324   mov rbx, [.length]
 325   mov [.printed_length], rbx
 326 .skip_updating_real_length:
 327
 328   cmp [.length], 16
 329   jle .loop
 330
 331   ;; Flip buffer around, since it is currently reversed
 332   mov rcx, [.printed_length]
 333 .flip:
 334   mov rsi, .rbuffer
 335   add rsi, rcx
 336   dec rsi
 337   mov al, [rsi]
 338
 339   mov rdi, .buffer
 340   add rdi, [.printed_length]
 341   sub rdi, rcx
 342   mov [rdi], al
 343
 344   loop .flip
 345
 346   ;; Print the buffer
 347   mov rcx, .buffer
 348   mov rdx, [.printed_length]
 349   sys_print_string
 350
 351   ;; Restore RSI and continue execution
 352   pop rsi
 353   next
 354
 355 ;; Takes a value and an address, and stores the value at the given address.
 356 forth_asm PUT, '!'
 357   pop rbx                       ; Address
 358   pop rax                       ; Value
 359   mov [rbx], rax
 360   next
 361
 362 ;; Takes an address and returns the value at the given address.
 363 forth_asm GET, '@'
 364   pop rax
 365   mov rax, [rax]
 366   push rax
 367   next
 368
 369 forth_asm PUT_BYTE, 'C!'
 370   pop rbx
 371   pop rax                       ; Value
 372   mov [rbx], al
 373   next
 374
 375 forth_asm GET_BYTE, 'C@'
 376   pop rax
 377   movzx rax, byte [rax]
 378   push rax
 379   next
 380
 381 ;; Add two integers on the stack.
 382 forth_asm PLUS, '+'
 383   pop rax
 384   pop rbx
 385   add rax, rbx
 386   push rax
 387   next
 388
 389 ;; Calculate difference between two integers on the stack. The second number is
 390 ;; subtracted from the first.
 391 forth_asm MINUS, '-'
 392   pop rax
 393   pop rbx
 394   sub rbx, rax
 395   push rbx
 396   next
 397
 398 ;; Given two integers a and b on the stack, pushes the quotient and remainder of
 399 ;; division of a by b.
 400 forth_asm TIMESMOD, '/MOD'
 401   pop rbx                       ; b
 402   pop rax                       ; a
 403   mov rdx, 0
 404   div rbx
 405   push rax                      ; a / b
 406   push rdx                      ; a % b
 407   next
 408
 409 ;; Read user input until next " character is found. Push a string containing the
 410 ;; input on the stack as (buffer length). Note that the buffer is only valid
 411 ;; until the next call to S" and that no more than 255 character can be read.
 412 forth_asm READ_STRING, 'S"'
 413   push rsi
 414
 415   mov [.length], 0
 416
 417 .read_char:
 418   mov rax, 0
 419   mov rdi, 0
 420   mov rsi, .char_buffer
 421   mov rdx, 1
 422   syscall
 423
 424   mov al, [.char_buffer]
 425   cmp al, '"'
 426   je .done
 427
 428   mov rdx, .buffer
 429   add rdx, [.length]
 430   mov [rdx], al
 431   inc [.length]
 432   jmp .read_char
 433
 434 .done:
 435   pop rsi
 436
 437   push .buffer
 438   push [.length]
 439
 440   next
 441
 442 ;; CREATE inserts a new header in the dictionary, and updates LATEST so that it
 443 ;; points to the header. To compile a word, the user can then call ',' to
 444 ;; continue to append data after the header.
 445 ;;
 446 ;; It takes the name of the word as a string (address length) on the stack.
 447 forth_asm CREATE, 'CREATE'
 448   pop rcx                       ; Word string length
 449   pop rdx                       ; Word string pointer
 450
 451   mov rdi, [here]               ; rdi = Address at which to insert this entry
 452   mov rax, [latest_entry]       ; rax = Address of the previous entry
 453   mov [rdi], rax                ; Insert link to previous entry
 454   mov [latest_entry], rdi       ; Update LATEST to point to this word
 455
 456   add rdi, 8
 457   mov [rdi], byte 0             ; Insert immediate flag
 458
 459   add rdi, 1
 460   mov [rdi], byte cl            ; Insert length
 461
 462   ;; Insert word string
 463   add rdi, 1
 464
 465   push rsi
 466   mov rsi, rdx                  ; rsi = Word string pointer
 467   rep movsb
 468   pop rsi
 469
 470   ;; Update HERE
 471   mov [here], rdi
 472
 473   next
 474
 475 forth_asm TICK, "'"
 476   lodsq
 477   push rax
 478   next
 479
 480 forth_asm ROT, 'ROT'
 481   pop rax
 482   pop rbx
 483   pop rdx
 484   push rax
 485   push rdx
 486   push rbx
 487   next
 488
 489 forth_asm PICK, 'PICK'
 490   pop rax
 491   lea rax, [rsp + 8 * rax]
 492   mov rax, [rax]
 493   push rax
 494   next
 495
 496 forth_asm EQL, '='
 497   pop rax
 498   pop rbx
 499   cmp rax, rbx
 500   je .eq
 501 .noteq:
 502   push 0
 503   next
 504 .eq:
 505   push 1
 506   next
 507
 508 forth MAIN, 'MAIN'
 509   dq INTERPRET
 510   dq BRANCH, -8 * 2
 511   dq TERMINATE
 512
 513 ;; Built-in variables:
 514
 515 forth STATE, 'STATE'
 516   dq LIT, var_STATE
 517   dq EXIT
 518
 519 forth LATEST, 'LATEST'
 520   dq LIT, latest_entry
 521   dq EXIT
 522
 523 forth HERE, 'HERE'
 524   dq LIT, here
 525   dq EXIT
 526
 527 forth SYSCODE, 'SYSCODE'
 528   dq LIT, sysf
 529   dq LIT, sysf.len
 530   dq EXIT
 531
 532 segment readable writable
 533
 534 ;; The LATEST variable holds a pointer to the word that was last added to the
 535 ;; dictionary. This pointer is updated as new words are added, and its value is
 536 ;; used by FIND to look up words.
 537 latest_entry dq initial_latest_entry
 538
 539 ;; The STATE variable is 0 when the interpreter is executing, and non-zero when
 540 ;; it is compiling.
 541 var_STATE dq 0
 542
 543 FIND.rsi dq ?
 544
 545 READ_WORD.rsi dq ?
 546 READ_WORD.rbp dq ?
 547
 548 READ_STRING.char_buffer db ?
 549 READ_STRING.buffer rb $FF
 550 READ_STRING.length dq ?
 551
 552 DOTU.chars db '0123456789ABCDEF'
 553 DOTU.buffer rq 16               ; 64-bit number has no more than 16 digits in hex
 554 DOTU.rbuffer rq 16
 555 DOTU.length dq ?
 556 DOTU.printed_length dq ?
 557
 558 ;; Reserve space for compiled words, accessed through HERE.
 559 here dq here_top
 560 here_top rq $4000
 561
 562 ;; Return stack
 563 rq $2000
 564 return_stack_top:
 565
 566 segment readable
 567
 568 ;; We store some Forth code in sys.f that defined common words that the user
 569 ;; would expect to have available at startup. To execute these words, we just
 570 ;; include the file directly in the binary, and then interpret it at startup.
 571 sysf file 'sys.f'
 572 sysf.len = $ - sysf
 573