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