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