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