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