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