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 ;; The INTERPRET word reads and interprets user input. It's behavior depends on
 246 ;; the current STATE. It provides special handling for integers. (TODO)
 247 forth INTERPRET, 'INTERPRET'
 248   dq READ_WORD
 249   dq FIND
 250   dq TCFA
 251   dq EXEC
 252   dq EXIT
 253
 254 ;; .U prints the value on the stack as an unsigned integer in hexadecimal.
 255 forth_asm DOTU, '.U'
 256   mov [.length], 0
 257   mov [.printed_length], 1
 258   pop rax                       ; RAX = value to print
 259   push rsi                      ; Save value of RSI
 260
 261   ;; We start by constructing the buffer to print in reverse
 262
 263 .loop:
 264   mov rdx, 0
 265   mov rbx, $10
 266   div rbx                       ; Put remainer in RDX and quotient in RAX
 267
 268   ;; Place the appropriate character in the buffer
 269   mov rsi, .chars
 270   add rsi, rdx
 271   mov bl, [rsi]
 272   mov rdi, .rbuffer
 273   add rdi, [.length]
 274   mov [rdi], bl
 275   inc [.length]
 276
 277   ;; .printed_length is the number of characters that we ulitmately want to
 278   ;; print. If we have printed a non-zero character, then we should update
 279   ;; .printed_length.
 280   cmp bl, '0'
 281   je .skip_updating_real_length
 282   mov rbx, [.length]
 283   mov [.printed_length], rbx
 284 .skip_updating_real_length:
 285
 286   cmp [.length], 16
 287   jle .loop
 288
 289   ;; Flip buffer around, since it is currently reversed
 290   mov rcx, [.printed_length]
 291 .flip:
 292   mov rsi, .rbuffer
 293   add rsi, rcx
 294   dec rsi
 295   mov al, [rsi]
 296
 297   mov rdi, .buffer
 298   add rdi, [.printed_length]
 299   sub rdi, rcx
 300   mov [rdi], al
 301
 302   loop .flip
 303
 304   ;; Print the buffer
 305   mov rax, 1
 306   mov rdi, 1
 307   mov rsi, .buffer
 308   mov rdx, [.printed_length]
 309   syscall
 310
 311   ;; Restore RSI and continue execution
 312   pop rsi
 313   next
 314
 315 forth MAIN, 'MAIN'
 316   dq HELLO
 317   dq INTERPRET
 318   dq BRANCH, -8 * 2
 319   dq TERMINATE
 320
 321 segment readable writable
 322
 323 latest_entry dq initial_latest_entry
 324
 325 FIND.rsi dq ?
 326
 327 READ_WORD.rsi dq ?
 328 READ_WORD.rbp dq ?
 329
 330 DOTU.chars db '0123456789ABCDEF'
 331 DOTU.buffer rq 16               ; 64-bit number has no more than 16 digits in hex
 332 DOTU.rbuffer rq 16
 333 DOTU.length dq ?
 334 DOTU.printed_length dq ?
 335
 336 ;; Return stack
 337 rq $2000
 338 return_stack_top: