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:
 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 on the stack and replaces it with the decimal number that the
 162 ;; string represents.
 163 PARSE_NUMBER:
 164   dq .start
 165 .start:
 166   pop [.length]                 ; Length
 167   pop rdi                       ; String pointer
 168   mov r8, 0                     ; Result
 169
 170   ;; Add (10^(rcx-1) * parse_char(rdi[length - rcx])) to the accumulated value
 171   ;; for each rcx.
 172   mov rcx, [.length]
 173 .loop:
 174   ;; First, calcuate 10^(rcx - 1)
 175   mov rax, 1
 176
 177   mov r9, rcx
 178   .exp_loop:
 179     dec r9
 180     jz .break
 181     mov rbx, 10
 182     mul rbx
 183     jmp .exp_loop
 184   .break:
 185
 186   ;; Now, rax = 10^(rcx - 1).
 187
 188   ;; We need to calulate the value of the character at rdi[length - rcx].
 189   mov rbx, rdi
 190   add rbx, [.length]
 191   sub rbx, rcx
 192   movzx rbx, byte [rbx]
 193   sub rbx, '0'
 194
 195   ;; Multiply this value by rax to get (10^(rcx-1) * parse_char(rdi[length - rcx])),
 196   ;; then add this to the result.
 197   mul rbx
 198
 199   ;; Add that value to r8
 200   add r8, rax
 201
 202   dec rcx
 203   jnz .loop
 204
 205   push r8
 206
 207   next
 208
 209 READ_NUMBER:
 210   dq docol
 211   dq READ_WORD
 212   dq PARSE_NUMBER
 213   dq EXIT
 214
 215 ;; Takes a string (in the form of a pointer and a length on the stack) and
 216 ;; prints it to standard output.
 217 TELL:
 218   dq .start
 219 .start:
 220   mov rbx, rsi
 221   mov rcx, rax
 222
 223   mov rax, 1
 224   mov rdi, 1
 225   pop rdx     ; Length
 226   pop rsi     ; Buffer
 227   syscall
 228
 229   mov rax, rcx
 230   mov rsi, rbx
 231   next
 232
 233 ;; Exit the program cleanly.
 234 TERMINATE:
 235   dq .start
 236 .start:
 237   mov rax, $3C
 238   mov rdi, 0
 239   syscall
 240
 241 PUSH_HELLO_CHARS:
 242   dq docol
 243   dq LIT, $A
 244   dq LIT, 'o'
 245   dq LIT, 'l'
 246   dq LIT, 'l'
 247   dq LIT, 'e'
 248   dq LIT, 'H'
 249   dq EXIT
 250
 251 PUSH_YOU_TYPED:
 252   dq .start
 253 .start:
 254   push you_typed_string
 255   push you_typed_string.length
 256   next
 257
 258 HELLO:
 259   dq docol
 260   dq LIT, 'H', EMIT
 261   dq LIT, 'e', EMIT
 262   dq LIT, 'l', EMIT
 263   dq LIT, 'l', EMIT
 264   dq LIT, 'o', EMIT
 265   dq LIT, '!', EMIT
 266   dq NEWLINE
 267   dq EXIT
 268
 269 ;; .U prints the value on the stack as an unsigned integer in hexadecimal.
 270 DOTU:
 271   dq .start
 272 .start:
 273   mov [.length], 0
 274   mov [.printed_length], 1
 275   pop rax                       ; RAX = value to print
 276   push rsi                      ; Save value of RSI
 277
 278   ;; We start by constructing the buffer to print in reverse
 279
 280 .loop:
 281   mov rdx, 0
 282   mov rbx, $10
 283   div rbx                       ; Put remainer in RDX and quotient in RAX
 284
 285   ;; Place the appropriate character in the buffer
 286   mov rsi, .chars
 287   add rsi, rdx
 288   mov bl, [rsi]
 289   mov rdi, .rbuffer
 290   add rdi, [.length]
 291   mov [rdi], bl
 292   inc [.length]
 293
 294   ;; .printed_length is the number of characters that we ulitmately want to
 295   ;; print. If we have printed a non-zero character, then we should update
 296   ;; .printed_length.
 297   cmp bl, '0'
 298   je .skip_updating_real_length
 299   mov rbx, [.length]
 300   mov [.printed_length], rbx
 301 .skip_updating_real_length:
 302
 303   cmp [.length], 16
 304   jle .loop
 305
 306   ;; Flip buffer around, since it is currently reversed
 307   mov rcx, [.printed_length]
 308 .flip:
 309   mov rsi, .rbuffer
 310   add rsi, rcx
 311   dec rsi
 312   mov al, [rsi]
 313
 314   mov rdi, .buffer
 315   add rdi, [.printed_length]
 316   sub rdi, rcx
 317   mov [rdi], al
 318
 319   loop .flip
 320
 321   ;; Print the buffer
 322   mov rax, 1
 323   mov rdi, 1
 324   mov rsi, .buffer
 325   mov rdx, [.printed_length]
 326   syscall
 327
 328   ;; Restore RSI and continue execution
 329   pop rsi
 330   next
 331
 332 MAIN:
 333   dq docol
 334   dq HELLO
 335   dq READ_NUMBER, DOTU, NEWLINE
 336   dq BRANCH, -8 * 4
 337   dq TERMINATE
 338
 339 segment readable writable
 340
 341 you_typed_string db 'You typed: '
 342 .length = $ - you_typed_string
 343
 344 READ_WORD.rsi dq ?
 345 READ_WORD.rax dq ?
 346 READ_WORD.max_size = $FF
 347 READ_WORD.buffer rb READ_WORD.max_size
 348 READ_WORD.length db ?
 349 READ_WORD.char_buffer db ?
 350
 351 DOTU.chars db '0123456789ABCDEF'
 352 DOTU.buffer rq 16               ; 64-bit number has no more than 16 digits in hex
 353 DOTU.rbuffer rq 16
 354 DOTU.length dq ?
 355 DOTU.printed_length dq ?
 356
 357 PARSE_NUMBER.length dq ?
 358
 359 ;; Return stack
 360 rq $2000
 361 return_stack_top: