forth

commit 937eeaf9644e79c69f4d975c0f2025070f137fba
parent 7b25cf69ab44609948328847545e02f941436bda
Author: Christian Ermann <christianermann@gmail.com>
Date:   Sat, 15 Jun 2024 19:21:12 -0400

Add base.forth and load into dictionary at startup

Diffstat:
M
Dockerfile
 | 
1
+
A
base.forth
 | 
42
++++++++++++++++++++++++++++++++++++++++++
M
forth.asm
 | 
91
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-----

3 files changed, 129 insertions(+), 5 deletions(-)
diff --git a/Dockerfile b/Dockerfile
@@ -9,6 +9,7 @@ RUN apt-get update && apt-get -y upgrade && \
 
 COPY forth.asm /
 COPY efi.asm /
+COPY base.forth /
 COPY run.sh /
 
 RUN fasm forth.asm BOOTX64.EFI
diff --git a/base.forth b/base.forth
@@ -0,0 +1,42 @@
+
+: [COMPILE] IMMEDIATE
+    WORD FIND
+    >CFA ,
+;
+
+: CODE
+    WORD CREATE
+    LATEST @ >CFA 8 + ,
+    LATEST @ HIDDEN
+    ]
+;
+
+: NEXT IMMEDIATE
+    48 C,
+    AD C,
+    FF C,
+    20 C,
+;
+
+: ;CODE IMMEDIATE
+    [COMPILE] NEXT
+    ALIGN
+    LATEST @ HIDDEN
+    [COMPILE] [
+;
+
+: RAX IMMEDIATE 0 ;
+: RCX IMMEDIATE 1 ;
+: RDX IMMEDIATE 3 ;
+: RBX IMMEDIATE 4 ;
+: R8  IMMEDIATE 41 C, 0 ;
+: R9  IMMEDIATE 41 C, 1 ;
+
+: PUSH IMMEDIATE 50 + C, ;
+: POP  IMMEDIATE 58 + C, ;
+
+: CALL-INDIRECT IMMEDIATE
+    FF C,
+    10 + C,
+;
+
diff --git a/forth.asm b/forth.asm
@@ -268,6 +268,8 @@ main:
     initialize_stack
     mov rbp, return_stack_top
     mov rsi, program
+    mov [input_buffer], forth_base
+    mov [input_buffer.len], forth_base.len
     NEXT
 }
 
@@ -343,10 +345,32 @@ set_program initialize_stack_s3, program_s3
 defcode "KEY", 3, 0, KEY
 ; Read a character.
 ;
-    call sys_read_char
+    call _KEY
     push rax
     NEXT
 
+_KEY:
+    cmp [input_buffer], 0
+    jne .buffer
+
+.stdin:
+    call sys_read_char
+    ret
+
+.buffer:
+    cmp [input_buffer.len], 0
+    je .buffer_empty
+    mov rax, [input_buffer]
+    movzx rax, byte [rax]
+    inc [input_buffer]
+    dec [input_buffer.len]
+    ret
+
+.buffer_empty:
+    mov [input_buffer], 0
+    jmp .stdin
+
+
 defcode "WORD", 4, 0, WORD_
 ; Read a word.
 ;
@@ -378,7 +402,8 @@ _WORD:
 ; After a non-whitespace character is found, RDI is used to hold the address
 ; of the next character to be stored.
 ;
-    call sys_read_char
+    
+    call _KEY
     cmp al, ' '
     je .skip_whitespace
     cmp al, 0xA
@@ -404,7 +429,7 @@ _WORD:
 .next_char:
 ; Keep processing characters until we find the end of the word.
 ;
-    call sys_read_char
+    call _KEY
     cmp al, ' '
     je .end
     cmp al, 0xA
@@ -894,7 +919,10 @@ defcode "HERE", 4, 0, HERE
 defcode "CREATE", 6, 0, CREATE
     pop rcx ; string length
     pop rbx ; string address
+    call _CREATE
+    NEXT
 
+_CREATE:
     mov rdi, [here] ; address of new header
     mov rax, [latest] ; address of last entry
     stosq ; add link to last entry
@@ -922,7 +950,7 @@ defcode "CREATE", 6, 0, CREATE
     mov rax, [here]
     mov [latest], rax
     mov [here], rdi
-    NEXT
+    ret
 
 defcode ",", 1, 0, COMMA
     pop rax
@@ -935,6 +963,13 @@ _COMMA:
     mov [here], rdi
     ret
 
+defcode "C,", 2,  0, CHAR_COMMA
+    pop rax
+    mov rdi, [here]
+    stosb
+    mov [here], rdi
+    NEXT
+
 defcode "LIT", 3, 0, LIT
     lodsq
     push rax
@@ -959,6 +994,12 @@ defcode "HIDDEN", 6, 0, HIDDEN
     xor [rdi], rcx
     NEXT
 
+defcode "IMMEDIATE", 9, FLAG_IMMEDIATE, IMMEDIATE
+    mov rdi, [latest]
+    add rdi, 8
+    xor byte [rdi], FLAG_IMMEDIATE
+    NEXT
+
 defcode "+", 1, 0, PLUS
     pop rbx
     pop rcx
@@ -982,6 +1023,40 @@ defword ";", 1, FLAG_IMMEDIATE, SEMICOLON
     dq LEFT_BRACKET          ; Switch to IMMEDIATE mode
     dq EXIT
 
+defcode "ALIGN", 5, 0, ALIGN_
+    mov rax, [here]
+    add rax, 7
+    and rax, 0xFFFFFFFFFFFFFFF8
+    mov [here], rax
+    NEXT
+
+defcode "DUP", 3, 0, DUP_
+    pop rcx
+    push rcx
+    push rcx
+    NEXT
+
+defcode "DROP", 4, 0, DROP
+    pop rcx
+    NEXT
+
+defword "CONSTANT", 8, 0, CONSTANT
+    dq WORD_
+    dq CREATE
+    dq LIT, DOCOL
+    dq COMMA
+    dq LIT, LIT
+    dq COMMA
+    dq COMMA
+    dq LIT, EXIT
+    dq COMMA
+    dq EXIT
+
+defword "FIELD", 5, 0, FIELD
+    dq DUP_
+    dq CONSTANT
+    dq EXIT
+
 ;------------------------------------------------------------------------------
 ;
 ; Section 8 - String operations
@@ -1072,7 +1147,6 @@ defcode "WORDS", 5, 0, WORDS
     NEXT
 
 
-
 section '.data' data readable writable
 
 version_string db 'soup forth v0.1', 0xA
@@ -1081,6 +1155,9 @@ version_string db 'soup forth v0.1', 0xA
 unrecognized_msg db 'unrecognized word', 0xA
 .length = $ - unrecognized_msg
 
+input_buffer dq 0
+input_buffer.len dq 0
+
 code_EMIT.char_buffer db ?
 
 code_DOT.buffer rb 64
@@ -1108,6 +1185,10 @@ state dq 0
 FLAG_IMMEDIATE = 0x40
 FLAG_HIDDEN = 0x20
 
+forth_base:
+file './base.forth'
+forth_base.len = $ - forth_base
+
 align 4096
 return_stack rb 8192
 return_stack_top: