forth

commit a3094c0c26956e84c96ed93bfa85c5e5ff49edc0
parent c1b4a9229c10361e62fca55cf01cd6003da63b2b
Author: Christian Ermann <christianermann@gmail.com>
Date:   Sat, 16 Mar 2024 14:19:10 -0400

Add ':', ';', and associated words

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

1 file changed, 240 insertions(+), 3 deletions(-)
diff --git a/forth.asm b/forth.asm
@@ -267,6 +267,7 @@ main:
     call sys_initialize
     call sys_clear_screen
     initialize_stack
+    mov rbp, return_stack_top
     mov rsi, program
     NEXT
 }
@@ -386,12 +387,16 @@ defcode "FIND", 4, 0, FIND
 
 postpone {
 _FIND:
-    mov rdx, link
+    mov rdx, [latest]
 
 .match_word:
     test rdx, rdx     ; check if null (start of dictionary / out of words)
     je .end
 
+    movzx rax, byte [rdx + 8] ; al = flags
+    test al, FLAG_HIDDEN
+    jnz .next_word
+
     movzx rax, byte [rdx + 9] ; al = name length
     
     ; TEMP: print current word for debugging
@@ -573,13 +578,42 @@ defcode "INTERPRET", 9, 0, INTERPRET
     mov rdi, rdx
     call _TO_CFA
 
-    jmp qword [rdi]
+.check_state:
+    mov rax, [state]
+    test rax, rax
+    jz .execute_word
+
+.check_immediate:
+    movzx rax, byte [rdx + 8]
+    test al, FLAG_IMMEDIATE
+    jnz .execute_word
+    mov rax, rdi
+    call _COMMA
+    NEXT
+
+.execute_word:
+    mov rax, rdi
+    jmp qword [rax]
 
 .try_number:
     call _TO_NUMBER
     test rcx, rcx
     jnz .not_found
-    push rax
+    mov rbx, rax
+
+.check_state_number:
+    mov rax, [state]
+    test rax, rax
+    jz .execute_number
+
+    mov rax, LIT
+    call _COMMA
+    mov rax, rbx
+    call _COMMA
+    NEXT
+
+.execute_number:
+    push rbx
     NEXT
 
 .not_found:
@@ -724,6 +758,188 @@ program_s5:
 
 ;set_program initialize_stack_s5, program_s5
 
+;------------------------------------------------------------------------------
+;
+; Section 6 - Memory
+;
+
+defcode "!", 1, 0, STORE_
+    pop rbx
+    pop rax
+    mov [rbx], rax
+    NEXT
+
+defcode "@", 1, 0, FETCH
+    pop rbx
+    mov rax, [rbx]
+    push rax
+    NEXT
+
+defcode "C@", 2, 0, FETCH_CHAR
+    pop rbx
+    movzx rax, byte [rbx]
+    push rax
+    NEXT
+
+;------------------------------------------------------------------------------
+;
+; Section 7 - Defining Words
+;
+
+defcode "LATEST", 6, 0, LATEST
+    push latest
+    NEXT
+
+defcode "HERE", 4, 0, HERE
+    push here
+    NEXT
+
+defcode "CREATE", 6, 0, CREATE
+    pop rcx ; string length
+    pop rbx ; string address
+
+    mov rdi, [here] ; address of new header
+    mov rax, [latest] ; address of last entry
+    stosq ; add link to last entry
+    mov [latest], rdi ; Update LATEST to point to this word
+
+    ; Store flags byte
+    xor rax, rax
+    stosb
+
+    ; Store length byte
+    mov rax, rcx
+    stosb
+
+    ; Store name
+    push rsi
+    mov rsi, rbx
+    rep movsb
+    pop rsi
+
+    ; Align to nearest 8-byte boundary
+    add rdi, 7
+    and rdi, 0xFFFFFFFFFFFFFFF8
+
+    ; Update LATEST and HERE
+    mov rax, [here]
+    mov [latest], rax
+    mov [here], rdi
+    NEXT
+
+defcode ",", 1, 0, COMMA
+    pop rax
+    call _COMMA
+    NEXT
+
+_COMMA:
+    mov rdi, [here]
+    stosq
+    mov [here], rdi
+    ret
+
+defcode "LIT", 3, 0, LIT
+    lodsq
+    push rax
+    NEXT
+
+defcode "[", 1, FLAG_IMMEDIATE, LEFT_BRACKET
+    mov [state], 0
+    NEXT
+
+defcode "]", 1, 0, RIGHT_BRACKET
+    mov [state], 1
+    NEXT
+
+defcode "STATE", 5, 0, STATE
+    push [state]
+    NEXT
+
+defcode "HIDDEN", 6, 0, HIDDEN
+    pop rdi
+    add rdi, 8
+    mov rcx, FLAG_HIDDEN
+    xor [rdi], rcx
+    NEXT
+
+defcode "+", 1, 0, PLUS
+    pop rbx
+    pop rcx
+    add rbx, rcx
+    push rbx
+    NEXT
+
+defword ":", 1, 0, COLON
+    dq WORD_
+    dq CREATE                ; Create header
+    dq LIT, DOCOL            ; Put DOCOL on stack...
+    dq COMMA                 ; ...then append to definition
+    dq LATEST, FETCH, HIDDEN ; Set HIDDEN
+    dq RIGHT_BRACKET         ; Switch to COMPILE mode
+    dq EXIT
+
+defword ";", 1, FLAG_IMMEDIATE, SEMICOLON
+    dq LIT, EXIT             ; Put EXIT on stack...
+    dq COMMA                 ; ...then append EXIT
+    dq LATEST, FETCH, HIDDEN ; Unset HIDDEN
+    dq LEFT_BRACKET          ; Switch to IMMEDIATE mode
+    dq EXIT
+
+;------------------------------------------------------------------------------
+;
+; Section 8 - String operations
+;
+
+defcode 'S"', 2, 0, S_QUOTE
+    mov rdx, .buffer
+    mov [.length], 0
+
+.next_char:
+    call sys_read_char
+    cmp al, '"'
+    je .end
+
+.store_char:
+    mov byte [rdx], al
+    inc rdx
+    inc [.length]
+    jmp .next_char
+
+.end:
+    push .buffer
+    push [.length]
+    NEXT
+
+defcode 'S\"', 3, 0, S_BACKSLASH_QUOTE
+    mov rdx, .buffer
+    mov [.length], 0
+
+.next_char:
+    call sys_read_char
+    cmp al, '"'
+    je .end
+    cmp al, '\'
+    jne .store_char
+
+.handle_escape:
+    call sys_read_char
+    cmp al, 'n'
+    jne .next_char
+
+    mov al, 0xA
+
+.store_char:
+    mov byte [rdx], al
+    inc rdx
+    inc [.length]
+    jmp .next_char
+
+.end:
+    push .buffer
+    push [.length]
+    NEXT
+
+
 section '.data' data readable writable
 
 version_string db 'soup forth v0.1', 0xA
@@ -739,4 +955,25 @@ code_U_DOT.buffer rb 64
 
 _WORD.buffer rb 64
 
+code_S_QUOTE.buffer rb 64
+code_S_QUOTE.length dq ?
+
+code_S_BACKSLASH_QUOTE.buffer rb 64
+code_S_BACKSLASH_QUOTE.length dq ?
+
 BASE db 16
+
+latest dq link
+
+here dq here_top
+here_top rq 0x4000
+
+state dq 0
+
+FLAG_IMMEDIATE = 0x40
+FLAG_HIDDEN = 0x20
+
+align 4096
+return_stack rb 8192
+return_stack_top:
+