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 EMIT:
  63   dq .start
  64 .start:
  65   pushr rsi
  66   pushr rax
  67   mov rax, 1
  68   mov rdi, 1
  69   lea rsi, [rsp]
  70   mov rdx, 1
  71   syscall
  72   add rsp, 8
  73   popr rax
  74   popr rsi
  75   next
  76
  77 NEWLINE:
  78   dq docol
  79   dq LIT, $A
  80   dq EMIT
  81   dq EXIT
  82
  83 ;; Read a word from standard input and push it onto the stack as a pointer and a
  84 ;; size. The pointer is valid until the next call to READ_WORD.
  85 READ_WORD:  ; 400170
  86   dq .start
  87 .start:
  88   mov [.rsi], rsi
  89   mov [.rax], rax
  90
  91 .skip_whitespace:
  92   ;; Read characters into .char_buffer until one of them is not whitespace.
  93   mov rax, 0
  94   mov rdi, 0
  95   mov rsi, .char_buffer
  96   mov rdx, 1
  97   syscall
  98
  99   cmp [.char_buffer], ' '
 100   je .skip_whitespace
 101   cmp [.char_buffer], $A
 102   je .skip_whitespace
 103
 104 .alpha:
 105   ;; We got a character that wasn't whitespace. Now read the actual word.
 106   mov [.length], 0
 107
 108 .read_alpha:
 109   mov al, [.char_buffer]
 110   movzx rbx, [.length]
 111   mov rsi, .buffer
 112   add rsi, rbx
 113   mov [rsi], al
 114   inc [.length]
 115
 116   mov rax, 0
 117   mov rdi, 0
 118   mov rsi, .char_buffer
 119   mov rdx, 1
 120   syscall
 121
 122   cmp [.char_buffer], ' '
 123   je .end
 124   cmp [.char_buffer], $A
 125   jne .read_alpha
 126
 127 .end:
 128   push .buffer
 129   movzx rax, [.length]
 130   push rax
 131
 132   mov rsi, [.rsi]
 133   mov rax, [.rax]
 134
 135   next
 136
 137 TYPE:
 138   dq .start
 139 .start:
 140   mov rbx, rsi
 141   mov rcx, rax
 142
 143   mov rax, 1
 144   mov rdi, 1
 145   pop rdx     ; Length
 146   pop rsi     ; Buffer
 147   syscall
 148
 149   mov rax, rcx
 150   mov rsi, rbx
 151   next
 152
 153 PUSH_HELLO_CHARS:
 154   dq docol
 155   dq LIT, $A
 156   dq LIT, 'o'
 157   dq LIT, 'l'
 158   dq LIT, 'l'
 159   dq LIT, 'e'
 160   dq LIT, 'H'
 161   dq EXIT
 162
 163 PUSH_YOU_TYPED:
 164   dq .start
 165 .start:
 166   push you_typed_string
 167   push you_typed_string.length
 168   next
 169
 170 HELLO:
 171   dq docol
 172   dq LIT, 'H', EMIT
 173   dq LIT, 'e', EMIT
 174   dq LIT, 'l', EMIT
 175   dq LIT, 'l', EMIT
 176   dq LIT, 'o', EMIT
 177   dq LIT, '!', EMIT
 178   dq NEWLINE
 179   dq EXIT
 180
 181 TERMINATE:
 182   dq .start
 183 .start:
 184   mov rax, $3C
 185   mov rdi, 0
 186   syscall
 187
 188 MAIN:
 189   dq docol
 190   dq HELLO
 191   dq READ_WORD
 192   dq LIT, you_typed_string
 193   dq LIT, you_typed_string.length
 194   dq TYPE
 195   dq TYPE
 196   dq NEWLINE
 197   dq HELLO
 198   dq TERMINATE
 199
 200 segment readable writable
 201
 202 you_typed_string db 'You typed: '
 203 .length = $ - you_typed_string
 204
 205 READ_WORD.rsi dq ?
 206 READ_WORD.rax dq ?
 207 READ_WORD.max_size = $FF
 208 READ_WORD.buffer rb READ_WORD.max_size
 209 READ_WORD.length db ?
 210 READ_WORD.char_buffer db ?
 211
 212
 213 ;; Return stack
 214 rq $2000
 215 return_stack_top: