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 segment readable executable
  27
  28 main:
  29   cld                        ; Clear direction flag so LODSQ does the right thing.
  30   mov rbp, return_stack_top  ; Initialize return stack
  31
  32   mov rsi, program
  33   next
  34
  35 program: dq MAIN
  36
  37 ;; The codeword is the code that will be executed at the beginning of a forth
  38 ;; word. It needs to save the old RSI and update it to point to the next word to
  39 ;; execute.
  40 docol:
  41   pushr rsi            ; Save old value of RSI on return stack; we will continue execution there after we are done executing this word
  42   lea rsi, [rax + 8]   ; RAX currently points to the address of the codeword, so we want to continue at RAX+8
  43   next                 ; Execute word pointed to by RSI
  44
  45 ;; This word is called at the end of a Forth definition. It just needs to
  46 ;; restore the old value of RSI (saved by 'docol') and resume execution.
  47 EXIT:
  48   dq .start
  49 .start:
  50   popr rsi
  51   next
  52
  53 ;; LIT is a special word that reads the next "word pointer" and causes it to be
  54 ;; placed on the stack rather than executed.
  55 LIT:
  56   dq .start
  57 .start:
  58   lodsq
  59   push rax
  60   next
  61
  62 ;; 0BRANCH is the fundamental mechanism for branching. If the top of the stack
  63 ;; is zero, we jump by the given offset. 0BRANCH is given the offset as an
  64 ;; integer after the word.
  65 ZBRANCH:
  66   dq .start
  67 .start:
  68   ;; Compare top of stack to see if we should branch
  69   pop rax
  70   cmp rax, 0
  71   jnz .dont_branch
  72 .do_branch:
  73   add rsi, [rsi] ; [RSI], which is the next word, contains the offset; we add this to the instruction pointer.
  74   next           ; Then, we can just continue execution as normal
  75 .dont_branch:
  76   add rsi, 8     ; We need to skip over the next word, which contains the offset.
  77   next
  78
  79 ;; Expects a character on the stack and prints it to standard output.
  80 EMIT:
  81   dq .start
  82 .start:
  83   pushr rsi
  84   pushr rax
  85   mov rax, 1
  86   mov rdi, 1
  87   lea rsi, [rsp]
  88   mov rdx, 1
  89   syscall
  90   add rsp, 8
  91   popr rax
  92   popr rsi
  93   next
  94
  95 ;; Prints a newline to standard output.
  96 NEWLINE:
  97   dq docol
  98   dq LIT, $A
  99   dq EMIT
 100   dq EXIT
 101
 102 ;; Read a word from standard input and push it onto the stack as a pointer and a
 103 ;; size. The pointer is valid until the next call to READ_WORD.
 104 READ_WORD:  ; 400170
 105   dq .start
 106 .start:
 107   mov [.rsi], rsi
 108   mov [.rax], rax
 109
 110 .skip_whitespace:
 111   ;; Read characters into .char_buffer until one of them is not whitespace.
 112   mov rax, 0
 113   mov rdi, 0
 114   mov rsi, .char_buffer
 115   mov rdx, 1
 116   syscall
 117
 118   cmp [.char_buffer], ' '
 119   je .skip_whitespace
 120   cmp [.char_buffer], $A
 121   je .skip_whitespace
 122
 123 .alpha:
 124   ;; We got a character that wasn't whitespace. Now read the actual word.
 125   mov [.length], 0
 126
 127 .read_alpha:
 128   mov al, [.char_buffer]
 129   movzx rbx, [.length]
 130   mov rsi, .buffer
 131   add rsi, rbx
 132   mov [rsi], al
 133   inc [.length]
 134
 135   mov rax, 0
 136   mov rdi, 0
 137   mov rsi, .char_buffer
 138   mov rdx, 1
 139   syscall
 140
 141   cmp [.char_buffer], ' '
 142   je .end
 143   cmp [.char_buffer], $A
 144   jne .read_alpha
 145
 146 .end:
 147   push .buffer
 148   movzx rax, [.length]
 149   push rax
 150
 151   mov rsi, [.rsi]
 152   mov rax, [.rax]
 153
 154   next
 155
 156 ;; Takes a string (in the form of a pointer and a length on the stack) and
 157 ;; prints it to standard output.
 158 TELL:
 159   dq .start
 160 .start:
 161   mov rbx, rsi
 162   mov rcx, rax
 163
 164   mov rax, 1
 165   mov rdi, 1
 166   pop rdx     ; Length
 167   pop rsi     ; Buffer
 168   syscall
 169
 170   mov rax, rcx
 171   mov rsi, rbx
 172   next
 173
 174 ;; Exit the program cleanly.
 175 TERMINATE:
 176   dq .start
 177 .start:
 178   mov rax, $3C
 179   mov rdi, 0
 180   syscall
 181
 182 PUSH_HELLO_CHARS:
 183   dq docol
 184   dq LIT, $A
 185   dq LIT, 'o'
 186   dq LIT, 'l'
 187   dq LIT, 'l'
 188   dq LIT, 'e'
 189   dq LIT, 'H'
 190   dq EXIT
 191
 192 PUSH_YOU_TYPED:
 193   dq .start
 194 .start:
 195   push you_typed_string
 196   push you_typed_string.length
 197   next
 198
 199 HELLO:
 200   dq docol
 201   dq LIT, 'H', EMIT
 202   dq LIT, 'e', EMIT
 203   dq LIT, 'l', EMIT
 204   dq LIT, 'l', EMIT
 205   dq LIT, 'o', EMIT
 206   dq LIT, '!', EMIT
 207   dq NEWLINE
 208   dq EXIT
 209
 210 MAIN:
 211   dq docol
 212   dq HELLO
 213   dq READ_WORD
 214   dq LIT, you_typed_string
 215   dq LIT, you_typed_string.length
 216   dq TELL
 217   dq TELL
 218   dq NEWLINE
 219   dq HELLO
 220   dq TERMINATE
 221
 222 segment readable writable
 223
 224 you_typed_string db 'You typed: '
 225 .length = $ - you_typed_string
 226
 227 READ_WORD.rsi dq ?
 228 READ_WORD.rax dq ?
 229 READ_WORD.max_size = $FF
 230 READ_WORD.buffer rb READ_WORD.max_size
 231 READ_WORD.length db ?
 232 READ_WORD.char_buffer db ?
 233
 234 ;; Return stack
 235 rq $2000
 236 return_stack_top: