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 ;; The following macro generates the dictionary header. It updates the
  27 ;; initial_latest_entry variable, which is used as the initial value of the
  28 ;; latest_entry variable that is made available at runtime.
  29 ;;
  30 ;; The header contains a link to the previous entry, the length of the name of
  31 ;; the word and the word itself as a string literal.
  32 ;;
  33 ;; This macro also defines a label LABEL_entry.
  34 initial_latest_entry = 0
  35 macro header label, name {
  36   local .string_end
  37
  38 label#_entry:
  39   dq initial_latest_entry
  40   db .string_end - ($ + 1)
  41   db name
  42   .string_end:
  43 label:
  44
  45 initial_latest_entry = label#_entry
  46 }
  47
  48 ;; Define a Forth word that is implemented in assembly. See 'header' for details.
  49 macro forth_asm label, name {
  50   header label, name
  51   dq .start
  52 .start:
  53 }
  54
  55 ;; Define a Forth word that is implemented in Forth. (The body will be a list of
  56 ;; 'dq' statements.)
  57 macro forth label, name {
  58   header label, name
  59   dq docol
  60 }
  61
  62 segment readable executable
  63
  64 main:
  65   cld                        ; Clear direction flag so LODSQ does the right thing.
  66   mov rbp, return_stack_top  ; Initialize return stack
  67
  68   mov rsi, program
  69   next
  70
  71 program: dq MAIN
  72
  73 ;; The codeword is the code that will be executed at the beginning of a forth
  74 ;; word. It needs to save the old RSI and update it to point to the next word to
  75 ;; execute.
  76 docol:
  77   pushr rsi            ; Save old value of RSI on return stack; we will continue execution there after we are done executing this word
  78   lea rsi, [rax + 8]   ; RAX currently points to the address of the codeword, so we want to continue at RAX+8
  79   next                 ; Execute word pointed to by RSI
  80
  81 ;; This word is called at the end of a Forth definition. It just needs to
  82 ;; restore the old value of RSI (saved by 'docol') and resume execution.
  83 forth_asm EXIT, 'EXIT'
  84   popr rsi
  85   next
  86
  87 ;; LIT is a special word that reads the next "word pointer" and causes it to be
  88 ;; placed on the stack rather than executed.
  89 forth_asm LIT, 'LIT'
  90   lodsq
  91   push rax
  92   next
  93
  94 ;; Given a string (a pointer following by a size), return the location of the
  95 ;; dictionary entry for that word. If no such word exists, return 0.
  96 forth_asm FIND, 'FIND'
  97   mov [.rsi], rsi
  98   pop [.search_length]
  99   pop [.search_buffer]
 100
 101   ;; RSI contains the entry we are currently looking at
 102   mov rsi, [latest_entry]       ; Start with the last added word
 103
 104 .loop:
 105   movzx rcx, byte [rsi + 8]     ; Length of word being looked at
 106   cmp rcx, [.search_length]
 107   jne .next    ; If the words don't have the same length, we have the wrong word
 108
 109   ;; Otherwise, we need to compare strings
 110   lea rdx, [rsi + 8 + 1]        ; Location of character being compared in entry
 111   mov rdi, [.search_buffer]     ; Location of character being compared in search buffer
 112 .compare_char:
 113   mov al, [rdx]
 114   mov ah, [rdi]
 115   cmp al, ah
 116   jne .next                     ; They don't match; try again
 117   inc rdx                       ; These characters match; look at the next ones
 118   inc rdi
 119   loop .compare_char
 120
 121   jmp .found                    ; They match! We are done.
 122
 123 .next:
 124   mov rsi, [rsi]                ; Look at the previous entry
 125   cmp rsi, 0
 126   jnz .loop                    ; If there is no previous word, exit and return 0
 127
 128 .found:
 129   push rsi
 130
 131   mov rsi, [.rsi]
 132   next
 133
 134 ;; BRANCH is the fundamental mechanism for branching. BRANCH reads the next word
 135 ;; as a signed integer literal and jumps by that offset.
 136 forth_asm BRANCH, 'BRANCH'
 137   add rsi, [rsi] ; [RSI], which is the next word, contains the offset; we add this to the instruction pointer.
 138   next           ; Then, we can just continue execution as normal
 139
 140 ;; 0BRANCH is like BRANCH, but it jumps only if the top of the stack is zero.
 141 forth_asm ZBRANCH, '0BRANCH'
 142   ;; Compare top of stack to see if we should branch
 143   pop rax
 144   cmp rax, 0
 145   jnz .dont_branch
 146 .do_branch:
 147   jmp BRANCH.start
 148 .dont_branch:
 149   add rsi, 8     ; We need to skip over the next word, which contains the offset.
 150   next
 151
 152 ;; Expects a character on the stack and prints it to standard output.
 153 forth_asm EMIT, 'EMIT'
 154   pushr rsi
 155   pushr rax
 156   mov rax, 1
 157   mov rdi, 1
 158   lea rsi, [rsp]
 159   mov rdx, 1
 160   syscall
 161   add rsp, 8
 162   popr rax
 163   popr rsi
 164   next
 165
 166 ;; Prints a newline to standard output.
 167 forth NEWLINE, 'NEWLINE'
 168   dq LIT, $A
 169   dq EMIT
 170   dq EXIT
 171
 172 ;; Prints a space to standard output.
 173 forth SPACE, 'SPACE'
 174   dq LIT, ' '
 175   dq EMIT
 176   dq EXIT
 177
 178 ;; Read a word from standard input and push it onto the stack as a pointer and a
 179 ;; size. The pointer is valid until the next call to READ_WORD.
 180 forth_asm READ_WORD, 'READ-WORD'
 181   mov [.rsi], rsi
 182   mov [.rax], rax
 183
 184 .skip_whitespace:
 185   ;; Read characters into .char_buffer until one of them is not whitespace.
 186   mov rax, 0
 187   mov rdi, 0
 188   mov rsi, .char_buffer
 189   mov rdx, 1
 190   syscall
 191
 192   cmp [.char_buffer], ' '
 193   je .skip_whitespace
 194   cmp [.char_buffer], $A
 195   je .skip_whitespace
 196
 197 .alpha:
 198   ;; We got a character that wasn't whitespace. Now read the actual word.
 199   mov [.length], 0
 200
 201 .read_alpha:
 202   mov al, [.char_buffer]
 203   movzx rbx, [.length]
 204   mov rsi, .buffer
 205   add rsi, rbx
 206   mov [rsi], al
 207   inc [.length]
 208
 209   mov rax, 0
 210   mov rdi, 0
 211   mov rsi, .char_buffer
 212   mov rdx, 1
 213   syscall
 214
 215   cmp [.char_buffer], ' '
 216   je .end
 217   cmp [.char_buffer], $A
 218   jne .read_alpha
 219
 220 .end:
 221   push .buffer
 222   movzx rax, [.length]
 223   push rax
 224
 225   mov rsi, [.rsi]
 226   mov rax, [.rax]
 227
 228   next
 229
 230 ;; Takes a string on the stack and replaces it with the decimal number that the
 231 ;; string represents.
 232 forth_asm PARSE_NUMBER, 'PARSE-NUMBER'
 233   pop [.length]                 ; Length
 234   pop rdi                       ; String pointer
 235   mov r8, 0                     ; Result
 236
 237   ;; Add (10^(rcx-1) * parse_char(rdi[length - rcx])) to the accumulated value
 238   ;; for each rcx.
 239   mov rcx, [.length]
 240 .loop:
 241   ;; First, calcuate 10^(rcx - 1)
 242   mov rax, 1
 243
 244   mov r9, rcx
 245   .exp_loop:
 246     dec r9
 247     jz .break
 248     mov rbx, 10
 249     mul rbx
 250     jmp .exp_loop
 251   .break:
 252
 253   ;; Now, rax = 10^(rcx - 1).
 254
 255   ;; We need to calulate the value of the character at rdi[length - rcx].
 256   mov rbx, rdi
 257   add rbx, [.length]
 258   sub rbx, rcx
 259   movzx rbx, byte [rbx]
 260   sub rbx, '0'
 261
 262   ;; Multiply this value by rax to get (10^(rcx-1) * parse_char(rdi[length - rcx])),
 263   ;; then add this to the result.
 264   mul rbx
 265
 266   ;; Add that value to r8
 267   add r8, rax
 268
 269   dec rcx
 270   jnz .loop
 271
 272   push r8
 273
 274   next
 275
 276 forth READ_NUMBER, 'READ-NUMBER'
 277   dq READ_WORD
 278   dq PARSE_NUMBER
 279   dq EXIT
 280
 281 ;; Takes a string (in the form of a pointer and a length on the stack) and
 282 ;; prints it to standard output.
 283 forth_asm TELL, 'TELL'
 284   mov rbx, rsi
 285   mov rcx, rax
 286
 287   mov rax, 1
 288   mov rdi, 1
 289   pop rdx     ; Length
 290   pop rsi     ; Buffer
 291   syscall
 292
 293   mov rax, rcx
 294   mov rsi, rbx
 295   next
 296
 297 ;; Exit the program cleanly.
 298 forth_asm TERMINATE, 'TERMINATE'
 299   mov rax, $3C
 300   mov rdi, 0
 301   syscall
 302
 303 forth HELLO, 'HELLO'
 304   dq LIT, 'H', EMIT
 305   dq LIT, 'e', EMIT
 306   dq LIT, 'l', EMIT
 307   dq LIT, 'l', EMIT
 308   dq LIT, 'o', EMIT
 309   dq LIT, '!', EMIT
 310   dq NEWLINE
 311   dq EXIT
 312
 313 ;; .U prints the value on the stack as an unsigned integer in hexadecimal.
 314 forth_asm DOTU, '.U'
 315   mov [.length], 0
 316   mov [.printed_length], 1
 317   pop rax                       ; RAX = value to print
 318   push rsi                      ; Save value of RSI
 319
 320   ;; We start by constructing the buffer to print in reverse
 321
 322 .loop:
 323   mov rdx, 0
 324   mov rbx, $10
 325   div rbx                       ; Put remainer in RDX and quotient in RAX
 326
 327   ;; Place the appropriate character in the buffer
 328   mov rsi, .chars
 329   add rsi, rdx
 330   mov bl, [rsi]
 331   mov rdi, .rbuffer
 332   add rdi, [.length]
 333   mov [rdi], bl
 334   inc [.length]
 335
 336   ;; .printed_length is the number of characters that we ulitmately want to
 337   ;; print. If we have printed a non-zero character, then we should update
 338   ;; .printed_length.
 339   cmp bl, '0'
 340   je .skip_updating_real_length
 341   mov rbx, [.length]
 342   mov [.printed_length], rbx
 343 .skip_updating_real_length:
 344
 345   cmp [.length], 16
 346   jle .loop
 347
 348   ;; Flip buffer around, since it is currently reversed
 349   mov rcx, [.printed_length]
 350 .flip:
 351   mov rsi, .rbuffer
 352   add rsi, rcx
 353   dec rsi
 354   mov al, [rsi]
 355
 356   mov rdi, .buffer
 357   add rdi, [.printed_length]
 358   sub rdi, rcx
 359   mov [rdi], al
 360
 361   loop .flip
 362
 363   ;; Print the buffer
 364   mov rax, 1
 365   mov rdi, 1
 366   mov rsi, .buffer
 367   mov rdx, [.printed_length]
 368   syscall
 369
 370   ;; Restore RSI and continue execution
 371   pop rsi
 372   next
 373
 374 forth MAIN, 'MAIN'
 375   dq HELLO
 376   dq READ_WORD, FIND, DOTU, NEWLINE
 377   dq BRANCH, -8 * 5
 378   dq TERMINATE
 379
 380 segment readable writable
 381
 382 latest_entry dq initial_latest_entry
 383
 384 SPACE_string db 'SPACE'
 385 .length = $ - SPACE_string
 386 HELLO_string db 'HELLO'
 387 .length = $ - HELLO_string
 388 DOTU_string db '.U'
 389 .length = $ - DOTU_string
 390 HELLA_string db 'HELLA'
 391 .length = $ - HELLA_string
 392
 393
 394 you_typed_string db 'You typed: '
 395 .length = $ - you_typed_string
 396
 397 FIND.search_length dq ?
 398 FIND.search_buffer dq ?
 399 FIND.rsi dq ?
 400
 401 READ_WORD.rsi dq ?
 402 READ_WORD.rax dq ?
 403 READ_WORD.max_size = $FF
 404 READ_WORD.buffer rb READ_WORD.max_size
 405 READ_WORD.length db ?
 406 READ_WORD.char_buffer db ?
 407
 408 DOTU.chars db '0123456789ABCDEF'
 409 DOTU.buffer rq 16               ; 64-bit number has no more than 16 digits in hex
 410 DOTU.rbuffer rq 16
 411 DOTU.length dq ?
 412 DOTU.printed_length dq ?
 413
 414 PARSE_NUMBER.length dq ?
 415
 416 ;; Return stack
 417 rq $2000
 418 return_stack_top: