main.asm

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