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