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 rcx     ; Length
 202   pop rdi     ; 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 * 22            ; Check if word is found
 292
 293   ;; - Word is found -
 294
 295   dq STATE, GET, ZBRANCH, 8 * 11 ; Check whether we are in compilation or immediate mode
 296
 297   ;; (Word found, compilation mode)
 298   dq DUP_, IS_IMMEDIATE, NOT_, ZBRANCH, 8 * 6 ; 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 DROP, DROP
 304   dq EXIT
 305
 306   ;; (Word found, immediate mode)
 307   ;; Execute word
 308   dq TCFA
 309   ;; Stack is (word length addr)
 310   dq SWAP, DROP
 311   dq SWAP, DROP
 312   ;; Stack is (addr)
 313   dq EXEC
 314   dq EXIT
 315
 316   ;; - No word is found, assume it is an integer literal -
 317   ;; Stack is (word length addr)
 318   dq DROP
 319   dq PARSE_NUMBER
 320
 321   dq STATE, GET, ZBRANCH, 8 * 5 ; Check whether we are in compilation or immediate mode
 322
 323   ;; (Number, compilation mode)
 324   dq LIT, LIT, COMMA
 325   dq COMMA
 326   dq EXIT
 327
 328   ;; (Number, immediate mode)
 329   dq EXIT
 330
 331 ;; .U prints the value on the stack as an unsigned integer in hexadecimal.
 332 forth_asm DOTU, '.U'
 333   mov [.length], 0
 334   mov [.printed_length], 1
 335   pop rax                       ; RAX = value to print
 336   push rsi                      ; Save value of RSI
 337
 338   ;; We start by constructing the buffer to print in reverse
 339
 340 .loop:
 341   mov rdx, 0
 342   mov rbx, $10
 343   div rbx                       ; Put remainer in RDX and quotient in RAX
 344
 345   ;; Place the appropriate character in the buffer
 346   mov rsi, .chars
 347   add rsi, rdx
 348   mov bl, [rsi]
 349   mov rdi, .rbuffer
 350   add rdi, [.length]
 351   mov [rdi], bl
 352   inc [.length]
 353
 354   ;; .printed_length is the number of characters that we ulitmately want to
 355   ;; print. If we have printed a non-zero character, then we should update
 356   ;; .printed_length.
 357   cmp bl, '0'
 358   je .skip_updating_real_length
 359   mov rbx, [.length]
 360   mov [.printed_length], rbx
 361 .skip_updating_real_length:
 362
 363   cmp [.length], 16
 364   jle .loop
 365
 366   ;; Flip buffer around, since it is currently reversed
 367   mov rcx, [.printed_length]
 368 .flip:
 369   mov rsi, .rbuffer
 370   add rsi, rcx
 371   dec rsi
 372   mov al, [rsi]
 373
 374   mov rdi, .buffer
 375   add rdi, [.printed_length]
 376   sub rdi, rcx
 377   mov [rdi], al
 378
 379   loop .flip
 380
 381   ;; Print the buffer
 382   mov rax, 1
 383   mov rdi, 1
 384   mov rsi, .buffer
 385   mov rdx, [.printed_length]
 386   syscall
 387
 388   ;; Restore RSI and continue execution
 389   pop rsi
 390   next
 391
 392 ;; Takes a value and an address, and stores the value at the given address.
 393 forth_asm PUT, '!'
 394   pop rbx                       ; Address
 395   pop rax                       ; Value
 396   mov [rbx], rax
 397   next
 398
 399 ;; Takes an address and returns the value at the given address.
 400 forth_asm GET, '@'
 401   pop rax
 402   mov rax, [rax]
 403   push rax
 404   next
 405
 406 forth_asm PUT_BYTE, 'C!'
 407   pop rbx
 408   pop rax                       ; Value
 409   mov [rbx], al
 410   next
 411
 412 forth_asm GET_BYTE, 'C@'
 413   pop rax
 414   movzx rax, byte [rax]
 415   push rax
 416   next
 417
 418 ;; Add two integers on the stack.
 419 forth_asm PLUS, '+'
 420   pop rax
 421   pop rbx
 422   add rax, rbx
 423   push rax
 424   next
 425
 426 ;; Calculate difference between two integers on the stack. The second number is
 427 ;; subtracted from the first.
 428 forth_asm MINUS, '-'
 429   pop rax
 430   pop rbx
 431   sub rbx, rax
 432   push rbx
 433   next
 434
 435 ;; Given two integers a and b on the stack, pushes the quotient and remainder of
 436 ;; division of a by b.
 437 forth_asm TIMESMOD, '/MOD'
 438   pop rbx                       ; b
 439   pop rax                       ; a
 440   mov rdx, 0
 441   div rbx
 442   push rax                      ; a / b
 443   push rdx                      ; a % b
 444   next
 445
 446 ;; Get the location of the STATE variable. It can be set with '!' and read with
 447 ;; '@'.
 448 forth STATE, 'STATE'
 449   dq LIT, var_STATE
 450   dq EXIT
 451
 452 ;; Get the location of the LATEST variable. It can be set with '!' and read with
 453 ;; '@'.
 454 forth LATEST, 'LATEST'
 455   dq LIT, latest_entry
 456   dq EXIT
 457
 458 ;; Get the location at which compiled words are expected to be added. This
 459 ;; pointer is usually modified automatically when calling ',', but we can also
 460 ;; read it manually with 'HERE'.
 461 forth HERE, 'HERE'
 462   dq LIT, here
 463   dq EXIT
 464
 465 forth COMMA, ','
 466   dq HERE, GET, PUT             ; Set the memory at the address pointed to by HERE
 467   dq HERE, GET, LIT, 8, PLUS    ; Calculate new address for HERE to point to
 468   dq HERE, PUT                  ; Update HERE to point to the new address
 469   dq EXIT
 470
 471 ;; Read user input until next " character is found. Push a string containing the
 472 ;; input on the stack as (buffer length). Note that the buffer is only valid
 473 ;; until the next call to S" and that no more than 255 character can be read.
 474 forth_asm READ_STRING, 'S"'
 475   push rsi
 476
 477   mov [.length], 0
 478
 479 .read_char:
 480   mov rax, 0
 481   mov rdi, 0
 482   mov rsi, .char_buffer
 483   mov rdx, 1
 484   syscall
 485
 486   mov al, [.char_buffer]
 487   cmp al, '"'
 488   je .done
 489
 490   mov rdx, .buffer
 491   add rdx, [.length]
 492   mov [rdx], al
 493   inc [.length]
 494   jmp .read_char
 495
 496 .done:
 497   pop rsi
 498
 499   push .buffer
 500   push [.length]
 501
 502   next
 503
 504 ;; CREATE inserts a new header in the dictionary, and updates LATEST so that it
 505 ;; points to the header. To compile a word, the user can then call ',' to
 506 ;; continue to append data after the header.
 507 ;;
 508 ;; It takes the name of the word as a string (address length) on the stack.
 509 forth_asm CREATE, 'CREATE'
 510   pop rcx                       ; Word string length
 511   pop rdx                       ; Word string pointer
 512
 513   mov rdi, [here]               ; rdi = Address at which to insert this entry
 514   mov rax, [latest_entry]       ; rax = Address of the previous entry
 515   mov [rdi], rax                ; Insert link to previous entry
 516   mov [latest_entry], rdi       ; Update LATEST to point to this word
 517
 518   add rdi, 8
 519   mov [rdi], byte 0             ; Insert immediate flag
 520
 521   add rdi, 1
 522   mov [rdi], byte cl            ; Insert length
 523
 524   ;; Insert word string
 525   add rdi, 1
 526
 527   push rsi
 528   mov rsi, rdx                  ; rsi = Word string pointer
 529   rep movsb
 530   pop rsi
 531
 532   ;; Update HERE
 533   mov [here], rdi
 534
 535   next
 536
 537 ;; Mark the last added word as immediate.
 538 forth IMMEDIATE, 'IMMEDIATE', 1
 539   dq LIT, 1
 540   dq LATEST, GET
 541   dq LIT, 8, PLUS
 542   dq PUT_BYTE
 543   dq EXIT
 544
 545 ;; Given the address of a word, return 0 if the given word is not immediate.
 546 forth IS_IMMEDIATE, 'IMMEDIATE?'
 547   dq LIT, 8, PLUS
 548   dq GET_BYTE
 549   dq EXIT
 550
 551 ;; Enter immediate mode, immediately
 552 forth INTO_IMMEDIATE, '[', 1
 553   dq LIT, 0, STATE, PUT_BYTE
 554   dq EXIT
 555
 556 ;; Enter compilation mode
 557 forth OUTOF_IMMEDIATE, ']'
 558   dq LIT, 1, STATE, PUT_BYTE
 559   dq EXIT
 560
 561 forth_asm TICK, "'"
 562   lodsq
 563   push rax
 564   next
 565
 566 forth_asm ROT, 'ROT'
 567   pop rax
 568   pop rbx
 569   pop rdx
 570   push rax
 571   push rdx
 572   push rbx
 573   next
 574
 575 forth_asm PICK, 'PICK'
 576   pop rax
 577   lea rax, [rsp + 8 * rax]
 578   mov rax, [rax]
 579   push rax
 580   next
 581
 582 forth_asm EQL, '='
 583   pop rax
 584   pop rbx
 585   cmp rax, rbx
 586   je .eq
 587 .noteq:
 588   push 0
 589   next
 590 .eq:
 591   push 1
 592   next
 593
 594 forth MAIN, 'MAIN'
 595   dq HELLO
 596   dq INTERPRET
 597   dq BRANCH, -8 * 2
 598   dq TERMINATE
 599
 600 segment readable writable
 601
 602 ;; The LATEST variable holds a pointer to the word that was last added to the
 603 ;; dictionary. This pointer is updated as new words are added, and its value is
 604 ;; used by FIND to look up words.
 605 latest_entry dq initial_latest_entry
 606
 607 ;; The STATE variable is 0 when the interpreter is executing, and non-zero when
 608 ;; it is compiling.
 609 var_STATE dq 0
 610
 611 FIND.rsi dq ?
 612
 613 READ_WORD.rsi dq ?
 614 READ_WORD.rbp dq ?
 615
 616 READ_STRING.char_buffer db ?
 617 READ_STRING.buffer rb $FF
 618 READ_STRING.length dq ?
 619
 620 DOTU.chars db '0123456789ABCDEF'
 621 DOTU.buffer rq 16               ; 64-bit number has no more than 16 digits in hex
 622 DOTU.rbuffer rq 16
 623 DOTU.length dq ?
 624 DOTU.printed_length dq ?
 625
 626 ;; Reserve space for compiled words, accessed through HERE.
 627 here dq here_top
 628 here_top rq $4000
 629
 630 ;; Return stack
 631 rq $2000
 632 return_stack_top: