forth

commit 5aecec2fd011a0e770dbc5b5e3b0c7ee21644d1e
parent c54d77850972826175e624f376825362906ece84
Author: Christian Ermann <christianermann@gmail.com>
Date:   Sat, 16 Dec 2023 18:08:10 -0500

Add INTERPRET

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

1 file changed, 57 insertions(+), 13 deletions(-)
diff --git a/forth.asm b/forth.asm
@@ -323,7 +323,12 @@ defcode "KEY", 3, 0, KEY
     NEXT
 
 defcode "WORD", 4, 0, WORD_
+    call _WORD
+    push rcx
+    push rdx
+    NEXT
 
+_WORD:
 .skip_whitespace_and_comments:
     call sys_read_char
     cmp al, 0x20
@@ -347,17 +352,20 @@ defcode "WORD", 4, 0, WORD_
     jne .store_char
 
 .end:
-    mov rcx, .buffer       
+    mov rcx, .buffer
     sub rdx, rcx
-    push rcx
-    push rdx
-    NEXT
+    ret
 
 defcode "FIND", 4, 0, FIND
     pop rcx    ; string length
     pop rdi    ; string address
-
     push rsi
+    call _FIND
+    pop rsi
+    push rdx
+    NEXT
+
+_FIND:
     mov rdx, link
 
 .match_word:
@@ -396,26 +404,61 @@ defcode "FIND", 4, 0, FIND
     jne .next_word
 
 .end:
-    pop rsi
-    push rdx
-    mov rax, rdx
-    NEXT
+    ret
 
 .next_word:
     mov rdx, [rdx]
     jmp .match_word
 
 
+defcode ">CFA", 4, 0, TO_CFA
+    pop rdi
+    call _TO_CFA
+    push rdi
+    NEXT
+
+_TO_CFA:
+    xor rax, rax
+    movzx rax, byte [rdi + 9] ; al = name length
+
+    ; skip past flags, length, and name, then align to 8-byte boundary
+    lea rdi, [rdi + 9 + rax + 7]
+    and rdi, 0xFFFFFFFFFFFFFFF8
+
+    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
+
+    mov rdi, rdx
+    call _TO_CFA
+
+    jmp qword [rdi]
+
+.not_found:
+    NEXT
+
+
 macro initialize_stack_s4 {
     push version_string
     push version_string.length
-    mov rdx, [link]
+    push version_string
+    push version_string.length
 }
 
 program_s4:
     dq TYPE
-    dq WORD_
-    dq FIND
+    dq INTERPRET
 
 set_program initialize_stack_s4, program_s4
 
@@ -542,6 +585,7 @@ code_EMIT.char_buffer db ?
 
 code_DOT.buffer rb 64
 code_U_DOT.buffer rb 64
-code_WORD_.buffer rb 64
+
+_WORD.buffer rb 64
 
 BASE db 16