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 ;; .U prints the value on the stack as an unsigned integer in hexadecimal.
 216 DOTU:
 217   dq .start
 218 .start:
 219   mov [.length], 0
 220   pop rax                       ; RAX = value to print
 221   push rsi                      ; Save value of RSI
 222
 223   ;; We start by constructing the buffer to print in reverse
 224
 225 .loop:
 226   mov rdx, 0
 227   mov rbx, $10
 228   div rbx                       ; Put remainer in RDX and quotient in RAX
 229
 230   ;; Place the appropriate character in the buffer
 231   mov rsi, .chars
 232   add rsi, rdx
 233   mov bl, [rsi]
 234   mov rdi, .rbuffer
 235   add rdi, [.length]
 236   mov [rdi], bl
 237   inc [.length]
 238
 239   ;; .printed_length is the number of characters that we ulitmately want to
 240   ;; print. If we have printed a non-zero character, then we should update
 241   ;; .printed_length.
 242   cmp bl, '0'
 243   je .skip_updating_real_length
 244   mov rbx, [.length]
 245   mov [.printed_length], rbx
 246 .skip_updating_real_length:
 247
 248   cmp [.length], 16
 249   jle .loop
 250
 251   ;; Flip buffer around, since it is currently reversed
 252   mov rcx, [.printed_length]
 253 .flip:
 254   mov rsi, .rbuffer
 255   add rsi, rcx
 256   dec rsi
 257   mov al, [rsi]
 258
 259   mov rdi, .buffer
 260   add rdi, [.printed_length]
 261   sub rdi, rcx
 262   mov [rdi], al
 263
 264   loop .flip
 265
 266   ;; Print the buffer
 267   mov rax, 1
 268   mov rdi, 1
 269   mov rsi, .buffer
 270   mov rdx, [.printed_length]
 271   syscall
 272
 273   ;; Restore RSI and continue execution
 274   pop rsi
 275   next
 276
 277 MAIN:
 278   dq docol
 279   dq HELLO
 280   dq LIT, 1234567890, DOTU, NEWLINE
 281   dq LIT, $ABCD, DOTU, NEWLINE
 282   dq LIT, $1234ABCD5678EFAB, DOTU, NEWLINE
 283   dq TERMINATE
 284
 285 segment readable writable
 286
 287 you_typed_string db 'You typed: '
 288 .length = $ - you_typed_string
 289
 290 READ_WORD.rsi dq ?
 291 READ_WORD.rax dq ?
 292 READ_WORD.max_size = $FF
 293 READ_WORD.buffer rb READ_WORD.max_size
 294 READ_WORD.length db ?
 295 READ_WORD.char_buffer db ?
 296
 297 DOTU.chars db '0123456789ABCDEF'
 298 DOTU.buffer rq 16               ; 64-bit number has no more than 16 digits in hex
 299 DOTU.rbuffer rq 16
 300 DOTU.length dq ?
 301 DOTU.printed_length dq ?
 302
 303 ;; Return stack
 304 rq $2000
 305 return_stack_top: