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 ;; BRANCH is the fundamental mechanism for branching. BRANCH reads the next word
  63 ;; as a signed integer literal and jumps by that offset.
  64 BRANCH:
  65   dq .start
  66 .start:
  67   add rsi, [rsi] ; [RSI], which is the next word, contains the offset; we add this to the instruction pointer.
  68   next           ; Then, we can just continue execution as normal
  69
  70 ;; 0BRANCH is like BRANCH, but it jumps only if the top of the stack is zero.
  71 ZBRANCH:
  72   dq .start
  73 .start:
  74   ;; Compare top of stack to see if we should branch
  75   pop rax
  76   cmp rax, 0
  77   jnz .dont_branch
  78 .do_branch:
  79   jmp BRANCH.start
  80 .dont_branch:
  81   add rsi, 8     ; We need to skip over the next word, which contains the offset.
  82   next
  83
  84 ;; Expects a character on the stack and prints it to standard output.
  85 EMIT:
  86   dq .start
  87 .start:
  88   pushr rsi
  89   pushr rax
  90   mov rax, 1
  91   mov rdi, 1
  92   lea rsi, [rsp]
  93   mov rdx, 1
  94   syscall
  95   add rsp, 8
  96   popr rax
  97   popr rsi
  98   next
  99
 100 ;; Prints a newline to standard output.
 101 NEWLINE:
 102   dq docol
 103   dq LIT, $A
 104   dq EMIT
 105   dq EXIT
 106
 107 ;; Read a word from standard input and push it onto the stack as a pointer and a
 108 ;; size. The pointer is valid until the next call to READ_WORD.
 109 READ_WORD:  ; 400170
 110   dq .start
 111 .start:
 112   mov [.rsi], rsi
 113   mov [.rax], rax
 114
 115 .skip_whitespace:
 116   ;; Read characters into .char_buffer until one of them is not whitespace.
 117   mov rax, 0
 118   mov rdi, 0
 119   mov rsi, .char_buffer
 120   mov rdx, 1
 121   syscall
 122
 123   cmp [.char_buffer], ' '
 124   je .skip_whitespace
 125   cmp [.char_buffer], $A
 126   je .skip_whitespace
 127
 128 .alpha:
 129   ;; We got a character that wasn't whitespace. Now read the actual word.
 130   mov [.length], 0
 131
 132 .read_alpha:
 133   mov al, [.char_buffer]
 134   movzx rbx, [.length]
 135   mov rsi, .buffer
 136   add rsi, rbx
 137   mov [rsi], al
 138   inc [.length]
 139
 140   mov rax, 0
 141   mov rdi, 0
 142   mov rsi, .char_buffer
 143   mov rdx, 1
 144   syscall
 145
 146   cmp [.char_buffer], ' '
 147   je .end
 148   cmp [.char_buffer], $A
 149   jne .read_alpha
 150
 151 .end:
 152   push .buffer
 153   movzx rax, [.length]
 154   push rax
 155
 156   mov rsi, [.rsi]
 157   mov rax, [.rax]
 158
 159   next
 160
 161 ;; Takes a string (in the form of a pointer and a length on the stack) and
 162 ;; prints it to standard output.
 163 TELL:
 164   dq .start
 165 .start:
 166   mov rbx, rsi
 167   mov rcx, rax
 168
 169   mov rax, 1
 170   mov rdi, 1
 171   pop rdx     ; Length
 172   pop rsi     ; Buffer
 173   syscall
 174
 175   mov rax, rcx
 176   mov rsi, rbx
 177   next
 178
 179 ;; Exit the program cleanly.
 180 TERMINATE:
 181   dq .start
 182 .start:
 183   mov rax, $3C
 184   mov rdi, 0
 185   syscall
 186
 187 PUSH_HELLO_CHARS:
 188   dq docol
 189   dq LIT, $A
 190   dq LIT, 'o'
 191   dq LIT, 'l'
 192   dq LIT, 'l'
 193   dq LIT, 'e'
 194   dq LIT, 'H'
 195   dq EXIT
 196
 197 PUSH_YOU_TYPED:
 198   dq .start
 199 .start:
 200   push you_typed_string
 201   push you_typed_string.length
 202   next
 203
 204 HELLO:
 205   dq docol
 206   dq LIT, 'H', EMIT
 207   dq LIT, 'e', EMIT
 208   dq LIT, 'l', EMIT
 209   dq LIT, 'l', EMIT
 210   dq LIT, 'o', EMIT
 211   dq LIT, '!', EMIT
 212   dq NEWLINE
 213   dq EXIT
 214
 215 MAIN:
 216   dq docol
 217   dq HELLO
 218   dq READ_WORD
 219   dq LIT, you_typed_string
 220   dq LIT, you_typed_string.length
 221   dq TELL
 222   dq TELL
 223   dq NEWLINE
 224   dq BRANCH, -72
 225   dq HELLO
 226   dq TERMINATE
 227
 228 segment readable writable
 229
 230 you_typed_string db 'You typed: '
 231 .length = $ - you_typed_string
 232
 233 READ_WORD.rsi dq ?
 234 READ_WORD.rax dq ?
 235 READ_WORD.max_size = $FF
 236 READ_WORD.buffer rb READ_WORD.max_size
 237 READ_WORD.length db ?
 238 READ_WORD.char_buffer db ?
 239
 240 ;; Return stack
 241 rq $2000
 242 return_stack_top: