forth

commit 4ec67972de20ffa64a37e15a9928d38daf75428c
parent 9a9af8891ca88147a6b39cc396db9163a78ed5b5
Author: Christian Ermann <christianermann@gmail.com>
Date:   Sun, 10 Mar 2024 15:49:57 -0400

Add defword, >NUMBER, BRANCH, and QUIT

Diffstat:
M
forth.asm
 | 
185
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++--------

1 file changed, 168 insertions(+), 17 deletions(-)
diff --git a/forth.asm b/forth.asm
@@ -191,6 +191,24 @@ section '.text' code readable executable
 code_#label_:             ; 8. This is where our assembly code will go.
 }
 
+macro defword name, name_length, flags, label_
+; Define a forth word.
+;
+{
+section '.rodata' data readable
+    align 8
+name_#label_:
+    dq link
+    link equ name_#label_
+    db flags
+    db name_length
+    db name
+
+    align 8
+label_:
+    dq DOCOL
+}
+
 ; You'll have noticed that the macro expects the `link` variable to hold the
 ; address of the previous word. As EXIT is our first word, we'll need to
 ; initialize `link` to 0. The `defcode` macro will take care of updating `link`
@@ -356,6 +374,7 @@ _WORD:
     sub rdx, rcx
     ret
 
+
 defcode "FIND", 4, 0, FIND
     pop rcx    ; string length
     pop rdi    ; string address
@@ -365,6 +384,7 @@ defcode "FIND", 4, 0, FIND
     push rdx
     NEXT
 
+postpone {
 _FIND:
     mov rdx, link
 
@@ -375,17 +395,17 @@ _FIND:
     movzx rax, byte [rdx + 9] ; al = name length
     
     ; TEMP: print current word for debugging
-    push rax
-    push rcx
-    push rdx
-    push rdi
-    lea rcx, [rdx + 10]
-    mov rdx, rax
-    call sys_print_string
-    pop rdi
-    pop rdx
-    pop rcx
-    pop rax
+    ;push rax
+    ;push rcx
+    ;push rdx
+    ;push rdi
+    ;lea rcx, [rdx + 10]
+    ;mov rdx, rax
+    ;call sys_print_string
+    ;pop rdi
+    ;pop rdx
+    ;pop rcx
+    ;pop rax
 
     cmp cl, al                ; check if word lengths match
     jne .next_word
@@ -409,6 +429,7 @@ _FIND:
 .next_word:
     mov rdx, [rdx]
     jmp .match_word
+}
 
 
 defcode ">CFA", 4, 0, TO_CFA
@@ -428,37 +449,161 @@ _TO_CFA:
     ret
 
 
+defcode ">NUMBER", 7, 0, TO_NUMBER
+    pop rcx ; string length
+    pop rdi ; string address
+    call _TO_NUMBER
+    push rax ; number
+    push rcx ; # of unparsed characters (0 => no error)
+    NEXT
+
+_TO_NUMBER:
+    ; Convert a string into a number.
+    ;   Args:
+    ;     RDI: string address
+    ;     RCX: string length
+    ;
+    ;   Returns:
+    ;     RAX: parsed number
+    ;     RCX: number of unparsed characters
+
+    ; initialize parsed number to 0
+    xor rax, rax
+
+    ; if string is empty, handle error
+    test rcx, rcx
+    jz .empty_string
+
+    ; RDX: base
+    ; RBX: current character
+    movzx rdx, byte [BASE]
+    movzx rbx, byte [rdi] ; read first character
+    inc rdi
+
+    ; if positive
+    ;  - push 0 on stack
+    ;  - jump to '.to_ascii'
+    push rax
+    cmp bl, 0x2D
+    jnz .to_ascii
+
+    ; if negative
+    ;  - push '-' on stack
+    pop rax
+    push rbx
+    dec rcx
+
+    ; if remaining string is non-empty
+    ;  - jump to '.read_char'
+    jnz .read_char
+
+    ; if remaining string is empty
+    ;  - return 1 as number of unparsed characters
+    pop rbx
+    mov rcx, 1
+    ret
+
+.empty_string:
+    mov rcx, -1
+    ret
+
+.next_char:
+    imul rax, rdx ; multiply value by base
+
+.read_char:
+    movzx rbx, byte [rdi]
+    inc rdi
+
+.to_ascii:
+    ; if value below "0"
+    ;  - stop parsing and return
+    sub rbx, 0x30
+    jb .handle_sign
+
+    ; if value is below "10"
+    ;  - start parsing the next character
+    cmp rbx, 10
+    jb .check_base
+
+    ; if value is below "A"
+    ;  - stop parsing and return
+    sub rbx, 17
+    jb .handle_sign
+
+    ; if value is above "A"
+    ;  - convert to numeric value
+    ;  - start parsing the next character
+    add rbx, 10
+
+.check_base:
+    ; if value is greater than or equal to base
+    ;  - stop parsing and return
+    cmp rbx, rdx
+    jge .handle_sign
+
+    ; if value is less than the base
+    ;  - start parsing the next character
+    add rax, rbx
+    dec rcx
+    jnz .next_char
+
+.handle_sign:
+    pop rbx
+    test rbx, rbx
+    jz .end
+    neg rax
+
+.end:
+    ret
+
+
 defcode "INTERPRET", 9, 0, INTERPRET
     call _WORD
 
     mov rdi, rcx
     mov rcx, rdx
+
     push rsi
     call _FIND
     pop rsi
 
     test rdx, rdx
-    jz .not_found
+    jz .try_number
 
     mov rdi, rdx
     call _TO_CFA
 
     jmp qword [rdi]
 
+.try_number:
+    call _TO_NUMBER
+    test rcx, rcx
+    jnz .not_found
+    push rax
+    NEXT
+
 .not_found:
+    mov rcx, unrecognized_msg
+    mov rdx, unrecognized_msg.length
+    call sys_print_string
     NEXT
 
+defcode "BRANCH", 6, 0, BRANCH
+    add rsi, [rsi]
+    NEXT
+
+defword "QUIT", 4, 0, QUIT
+    dq INTERPRET
+    dq BRANCH, -16
 
 macro initialize_stack_s4 {
     push version_string
     push version_string.length
-    push version_string
-    push version_string.length
 }
 
 program_s4:
     dq TYPE
-    dq INTERPRET
+    dq QUIT
 
 set_program initialize_stack_s4, program_s4
 
@@ -476,8 +621,11 @@ defcode ".", 1, 0, DOT
     xor r8, r8
 
 .check_negative:
+    ; if positive, start dividing to get digits
     test rax, rax
     jns .divide
+
+    ; if negative, negate and then start dividing to get digits
     neg rax
     inc r8
 
@@ -505,7 +653,7 @@ defcode ".", 1, 0, DOT
     add al, 48
     cmp al, 58
     jl .store_in_buffer
-    add al, 8
+    add al, 7
 
 .store_in_buffer:
     mov [rdx], al
@@ -560,7 +708,7 @@ defcode "U.", 2, 0, U_DOT
     mov rcx, .buffer
     mov rdx, rbx
     call sys_print_string
-    ret
+    NEXT
 
 macro initialize_stack_s5 {
     push 0xBADC0DE
@@ -581,6 +729,9 @@ section '.data' data readable writable
 version_string db 'soup forth v0.1', 0xA
 .length = $ - version_string
 
+unrecognized_msg db 'unrecognized word', 0xA
+.length = $ - unrecognized_msg
+
 code_EMIT.char_buffer db ?
 
 code_DOT.buffer rb 64