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 ;; Define a Forth word that is implemented in Forth. (The body will be a list of
  91 ;; 'dq' statements.)
  92 macro forth label, name, immediate {
  93   header label, name, immediate
  94   dq DOCOL
  95 }
  96
  97 segment readable executable
  98
  99 entry main
 100
 101 include "impl.asm"
 102
 103 main:
 104   cld                        ; Clear direction flag so LODSQ does the right thing.
 105   mov rbp, return_stack_top  ; Initialize return stack
 106
 107   mov rax, MAIN
 108   jmp qword [rax]
 109
 110 program: dq MAIN
 111
 112 ;; The codeword is the code that will be executed at the beginning of a forth
 113 ;; word. It needs to save the old RSI and update it to point to the next word to
 114 ;; execute.
 115 header DOCOL, 'DOCOL'
 116   pushr rsi            ; Save old value of RSI on return stack; we will continue execution there after we are done executing this word
 117   lea rsi, [rax + 8]   ; RAX currently points to the address of the codeword, so we want to continue at RAX+8
 118   next                 ; Execute word pointed to by RSI
 119
 120 ;; This word is called at the end of a Forth definition. It just needs to
 121 ;; restore the old value of RSI (saved by 'DOCOL') and resume execution.
 122 forth_asm EXIT, 'EXIT'
 123   popr rsi
 124   next
 125
 126 ;; LIT is a special word that reads the next "word pointer" and causes it to be
 127 ;; placed on the stack rather than executed.
 128 forth_asm LIT, 'LIT'
 129   lodsq
 130   push rax
 131   next
 132
 133 ;; Given a string (a pointer following by a size), return the location of the
 134 ;; dictionary entry for that word. If no such word exists, return 0.
 135 forth_asm FIND, 'FIND'
 136   mov [.rsi], rsi
 137
 138   pop [find.search_length]
 139   pop [find.search_buffer]
 140   mov rsi, [latest_entry]       ; Start with the last added word
 141   call find
 142   push rsi
 143
 144   mov rsi, [.rsi]
 145   next
 146   push rsi
 147
 148   mov rsi, [.rsi]
 149   next
 150
 151 ;; Given an entry in the dictionary, return a pointer to the codeword of that
 152 ;; entry.
 153 forth_asm TCFA, '>CFA'
 154   pop rax
 155   add rax, 8 + 1                ; [rax] = length of name
 156   movzx rbx, byte [rax]
 157   inc rax
 158   add rax, rbx                  ; [rax] = codeword
 159   push rax
 160   next
 161
 162 ;; BRANCH is the fundamental mechanism for branching. BRANCH reads the next word
 163 ;; as a signed integer literal and jumps by that offset.
 164 forth_asm BRANCH, 'BRANCH'
 165   add rsi, [rsi] ; [RSI], which is the next word, contains the offset; 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 is zero.
 169 forth_asm ZBRANCH, '0BRANCH'
 170   ;; Compare top of stack to see if we should branch
 171   pop rax
 172   cmp rax, 0
 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 the offset.
 178   next
 179
 180 ;; Duplicate the top of the stack.
 181 forth_asm DUP_, 'DUP'
 182   push qword [rsp]
 183   next
 184
 185 ;; Execute the codeword at the given address.
 186 forth_asm EXEC, 'EXEC'
 187   pop rax
 188   jmp qword [rax]
 189
 190 ;; Expects a character on the stack and prints it to standard output.
 191 forth_asm EMIT, 'EMIT'
 192   pushr rsi
 193   pushr rax
 194
 195   lea rcx, [rsp]
 196   mov rdx, 1
 197   sys_print_string
 198
 199   add rsp, 8
 200   popr rax
 201   popr rsi
 202   next
 203
 204 ;; Prints a newline to standard output.
 205 forth NEWLINE, 'NEWLINE'
 206   dq LIT, $A
 207   dq EMIT
 208   dq EXIT
 209
 210 ;; Prints a space to standard output.
 211 forth SPACE, 'SPACE'
 212   dq LIT, ' '
 213   dq EMIT
 214   dq EXIT
 215
 216 ;; Read a word from standard input and push it onto the stack as a pointer and a
 217 ;; size. The pointer is valid until the next call to READ_WORD.
 218 forth_asm READ_WORD, 'READ-WORD'
 219   mov [.rsi], rsi
 220
 221   call read_word
 222   push rdi                      ; Buffer
 223   push rdx                      ; Length
 224
 225   mov rsi, [.rsi]
 226   next
 227
 228 ;; Takes a string on the stack and replaces it with the decimal number that the
 229 ;; string represents.
 230 forth_asm PARSE_NUMBER, 'PARSE-NUMBER'
 231   pop rcx     ; Length
 232   pop rdi     ; String pointer
 233
 234   push rsi
 235   call parse_number
 236   pop rsi
 237
 238   push rax                      ; Result
 239   next
 240
 241 forth READ_NUMBER, 'READ-NUMBER'
 242   dq READ_WORD
 243   dq PARSE_NUMBER
 244   dq EXIT
 245
 246 ;; Takes a string (in the form of a pointer and a length on the stack) and
 247 ;; prints it to standard output.
 248 forth_asm TELL, 'TELL'
 249   pushr rax
 250   pushr rsi
 251
 252   pop rdx ; Length
 253   pop rcx ; Buffer
 254   sys_print_string
 255
 256   popr rsi
 257   popr rax
 258   next
 259
 260 ;; Exit the program cleanly.
 261 forth_asm TERMINATE, 'TERMINATE'
 262   mov rax, $3C
 263   mov rdi, 0
 264   syscall
 265
 266 ;; Duplicate a pair of elements.
 267 forth_asm PAIRDUP, '2DUP'
 268   pop rbx
 269   pop rax
 270   push rax
 271   push rbx
 272   push rax
 273   push rbx
 274   next
 275
 276 ;; Swap the top two elements on the stack.
 277 forth_asm SWAP, 'SWAP'
 278   pop rax
 279   pop rbx
 280   push rax
 281   push rbx
 282   next
 283
 284 ;; Remove the top element from the stack.
 285 forth_asm DROP, 'DROP'
 286   add rsp, 8
 287   next
 288
 289 forth_asm NOT_, 'NOT'
 290   pop rax
 291   cmp rax, 0
 292   jz .false
 293 .true:
 294   push 0
 295   next
 296 .false:
 297   push 1
 298   next
 299
 300 ;; The INTERPRET word reads and interprets user input. It's behavior depends on
 301 ;; the current STATE. It provides special handling for integers.
 302 forth INTERPRET, 'INTERPRET'
 303   ;; Read word
 304   dq READ_WORD
 305   dq PAIRDUP
 306   ;; Stack is (word length word length).
 307   dq FIND                       ; Try to find word
 308   dq DUP_
 309   dq ZBRANCH, 8 * 22            ; Check if word is found
 310
 311   ;; - Word is found -
 312
 313   dq STATE, GET, ZBRANCH, 8 * 11 ; Check whether we are in compilation or immediate mode
 314
 315   ;; (Word found, compilation mode)
 316   dq DUP_, IS_IMMEDIATE, NOT_, ZBRANCH, 8 * 6 ; If the word is immediate, continue as we would in immediate mode
 317
 318   ;; Otherwise, we want to compile this word
 319   dq TCFA
 320   dq COMMA
 321   dq DROP, DROP
 322   dq EXIT
 323
 324   ;; (Word found, immediate mode)
 325   ;; Execute word
 326   dq TCFA
 327   ;; Stack is (word length addr)
 328   dq SWAP, DROP
 329   dq SWAP, DROP
 330   ;; Stack is (addr)
 331   dq EXEC
 332   dq EXIT
 333
 334   ;; - No word is found, assume it is an integer literal -
 335   ;; Stack is (word length addr)
 336   dq DROP
 337   dq PARSE_NUMBER
 338
 339   dq STATE, GET, ZBRANCH, 8 * 5 ; Check whether we are in compilation or immediate mode
 340
 341   ;; (Number, compilation mode)
 342   dq LIT, LIT, COMMA
 343   dq COMMA
 344   dq EXIT
 345
 346   ;; (Number, immediate mode)
 347   dq EXIT
 348
 349 ;; .U prints the value on the stack as an unsigned integer in hexadecimal.
 350 forth_asm DOTU, '.U'
 351   mov [.length], 0
 352   mov [.printed_length], 1
 353   pop rax                       ; RAX = value to print
 354   push rsi                      ; Save value of RSI
 355
 356   ;; We start by constructing the buffer to print in reverse
 357
 358 .loop:
 359   mov rdx, 0
 360   mov rbx, $10
 361   div rbx                       ; Put remainer in RDX and quotient in RAX
 362
 363   ;; Place the appropriate character in the buffer
 364   mov rsi, .chars
 365   add rsi, rdx
 366   mov bl, [rsi]
 367   mov rdi, .rbuffer
 368   add rdi, [.length]
 369   mov [rdi], bl
 370   inc [.length]
 371
 372   ;; .printed_length is the number of characters that we ulitmately want to
 373   ;; print. If we have printed a non-zero character, then we should update
 374   ;; .printed_length.
 375   cmp bl, '0'
 376   je .skip_updating_real_length
 377   mov rbx, [.length]
 378   mov [.printed_length], rbx
 379 .skip_updating_real_length:
 380
 381   cmp [.length], 16
 382   jle .loop
 383
 384   ;; Flip buffer around, since it is currently reversed
 385   mov rcx, [.printed_length]
 386 .flip:
 387   mov rsi, .rbuffer
 388   add rsi, rcx
 389   dec rsi
 390   mov al, [rsi]
 391
 392   mov rdi, .buffer
 393   add rdi, [.printed_length]
 394   sub rdi, rcx
 395   mov [rdi], al
 396
 397   loop .flip
 398
 399   ;; Print the buffer
 400   mov rcx, .buffer
 401   mov rdx, [.printed_length]
 402   sys_print_string
 403
 404   ;; Restore RSI and continue execution
 405   pop rsi
 406   next
 407
 408 ;; Takes a value and an address, and stores the value at the given address.
 409 forth_asm PUT, '!'
 410   pop rbx                       ; Address
 411   pop rax                       ; Value
 412   mov [rbx], rax
 413   next
 414
 415 ;; Takes an address and returns the value at the given address.
 416 forth_asm GET, '@'
 417   pop rax
 418   mov rax, [rax]
 419   push rax
 420   next
 421
 422 forth_asm PUT_BYTE, 'C!'
 423   pop rbx
 424   pop rax                       ; Value
 425   mov [rbx], al
 426   next
 427
 428 forth_asm GET_BYTE, 'C@'
 429   pop rax
 430   movzx rax, byte [rax]
 431   push rax
 432   next
 433
 434 ;; Add two integers on the stack.
 435 forth_asm PLUS, '+'
 436   pop rax
 437   pop rbx
 438   add rax, rbx
 439   push rax
 440   next
 441
 442 ;; Calculate difference between two integers on the stack. The second number is
 443 ;; subtracted from the first.
 444 forth_asm MINUS, '-'
 445   pop rax
 446   pop rbx
 447   sub rbx, rax
 448   push rbx
 449   next
 450
 451 ;; Given two integers a and b on the stack, pushes the quotient and remainder of
 452 ;; division of a by b.
 453 forth_asm TIMESMOD, '/MOD'
 454   pop rbx                       ; b
 455   pop rax                       ; a
 456   mov rdx, 0
 457   div rbx
 458   push rax                      ; a / b
 459   push rdx                      ; a % b
 460   next
 461
 462 ;; Get the location of the STATE variable. It can be set with '!' and read with
 463 ;; '@'.
 464 forth STATE, 'STATE'
 465   dq LIT, var_STATE
 466   dq EXIT
 467
 468 ;; Get the location of the LATEST variable. It can be set with '!' and read with
 469 ;; '@'.
 470 forth LATEST, 'LATEST'
 471   dq LIT, latest_entry
 472   dq EXIT
 473
 474 ;; Get the location at which compiled words are expected to be added. This
 475 ;; pointer is usually modified automatically when calling ',', but we can also
 476 ;; read it manually with 'HERE'.
 477 forth HERE, 'HERE'
 478   dq LIT, here
 479   dq EXIT
 480
 481 forth COMMA, ','
 482   dq HERE, GET, PUT             ; Set the memory at the address pointed to by HERE
 483   dq HERE, GET, LIT, 8, PLUS    ; Calculate new address for HERE to point to
 484   dq HERE, PUT                  ; Update HERE to point to the new address
 485   dq EXIT
 486
 487 ;; Read user input until next " character is found. Push a string containing the
 488 ;; input on the stack as (buffer length). Note that the buffer is only valid
 489 ;; until the next call to S" and that no more than 255 character can be read.
 490 forth_asm READ_STRING, 'S"'
 491   push rsi
 492
 493   mov [.length], 0
 494
 495 .read_char:
 496   mov rax, 0
 497   mov rdi, 0
 498   mov rsi, .char_buffer
 499   mov rdx, 1
 500   syscall
 501
 502   mov al, [.char_buffer]
 503   cmp al, '"'
 504   je .done
 505
 506   mov rdx, .buffer
 507   add rdx, [.length]
 508   mov [rdx], al
 509   inc [.length]
 510   jmp .read_char
 511
 512 .done:
 513   pop rsi
 514
 515   push .buffer
 516   push [.length]
 517
 518   next
 519
 520 ;; CREATE inserts a new header in the dictionary, and updates LATEST so that it
 521 ;; points to the header. To compile a word, the user can then call ',' to
 522 ;; continue to append data after the header.
 523 ;;
 524 ;; It takes the name of the word as a string (address length) on the stack.
 525 forth_asm CREATE, 'CREATE'
 526   pop rcx                       ; Word string length
 527   pop rdx                       ; Word string pointer
 528
 529   mov rdi, [here]               ; rdi = Address at which to insert this entry
 530   mov rax, [latest_entry]       ; rax = Address of the previous entry
 531   mov [rdi], rax                ; Insert link to previous entry
 532   mov [latest_entry], rdi       ; Update LATEST to point to this word
 533
 534   add rdi, 8
 535   mov [rdi], byte 0             ; Insert immediate flag
 536
 537   add rdi, 1
 538   mov [rdi], byte cl            ; Insert length
 539
 540   ;; Insert word string
 541   add rdi, 1
 542
 543   push rsi
 544   mov rsi, rdx                  ; rsi = Word string pointer
 545   rep movsb
 546   pop rsi
 547
 548   ;; Update HERE
 549   mov [here], rdi
 550
 551   next
 552
 553 ;; Mark the last added word as immediate.
 554 forth IMMEDIATE, 'IMMEDIATE', 1
 555   dq LIT, 1
 556   dq LATEST, GET
 557   dq LIT, 8, PLUS
 558   dq PUT_BYTE
 559   dq EXIT
 560
 561 ;; Given the address of a word, return 0 if the given word is not immediate.
 562 forth IS_IMMEDIATE, 'IMMEDIATE?'
 563   dq LIT, 8, PLUS
 564   dq GET_BYTE
 565   dq EXIT
 566
 567 ;; Enter immediate mode, immediately
 568 forth INTO_IMMEDIATE, '[', 1
 569   dq LIT, 0, STATE, PUT_BYTE
 570   dq EXIT
 571
 572 ;; Enter compilation mode
 573 forth OUTOF_IMMEDIATE, ']'
 574   dq LIT, 1, STATE, PUT_BYTE
 575   dq EXIT
 576
 577 forth_asm TICK, "'"
 578   lodsq
 579   push rax
 580   next
 581
 582 forth_asm ROT, 'ROT'
 583   pop rax
 584   pop rbx
 585   pop rdx
 586   push rax
 587   push rdx
 588   push rbx
 589   next
 590
 591 forth_asm PICK, 'PICK'
 592   pop rax
 593   lea rax, [rsp + 8 * rax]
 594   mov rax, [rax]
 595   push rax
 596   next
 597
 598 forth_asm EQL, '='
 599   pop rax
 600   pop rbx
 601   cmp rax, rbx
 602   je .eq
 603 .noteq:
 604   push 0
 605   next
 606 .eq:
 607   push 1
 608   next
 609
 610 forth MAIN, 'MAIN'
 611   dq INTERPRET
 612   dq BRANCH, -8 * 2
 613   dq TERMINATE
 614
 615 segment readable writable
 616
 617 ;; The LATEST variable holds a pointer to the word that was last added to the
 618 ;; dictionary. This pointer is updated as new words are added, and its value is
 619 ;; used by FIND to look up words.
 620 latest_entry dq initial_latest_entry
 621
 622 ;; The STATE variable is 0 when the interpreter is executing, and non-zero when
 623 ;; it is compiling.
 624 var_STATE dq 0
 625
 626 FIND.rsi dq ?
 627
 628 READ_WORD.rsi dq ?
 629 READ_WORD.rbp dq ?
 630
 631 READ_STRING.char_buffer db ?
 632 READ_STRING.buffer rb $FF
 633 READ_STRING.length dq ?
 634
 635 DOTU.chars db '0123456789ABCDEF'
 636 DOTU.buffer rq 16               ; 64-bit number has no more than 16 digits in hex
 637 DOTU.rbuffer rq 16
 638 DOTU.length dq ?
 639 DOTU.printed_length dq ?
 640
 641 ;; Reserve space for compiled words, accessed through HERE.
 642 here dq here_top
 643 here_top rq $4000
 644
 645 ;; Return stack
 646 rq $2000
 647 return_stack_top: