;;
;; This macro also defines a label LABEL_entry.
initial_latest_entry = 0
-macro header label, name {
+macro header label, name, immediate {
local .string_end
label#_entry:
dq initial_latest_entry
+ if immediate eq
+ db 0
+ else
+ db 1
+ end if
db .string_end - ($ + 1)
db name
.string_end:
}
;; Define a Forth word that is implemented in assembly. See 'header' for details.
-macro forth_asm label, name {
- header label, name
+macro forth_asm label, name, immediate {
+ header label, name, immediate
dq .start
.start:
}
;; Define a Forth word that is implemented in Forth. (The body will be a list of
;; 'dq' statements.)
-macro forth label, name {
- header label, name
+macro forth label, name, immediate {
+ header label, name, immediate
dq DOCOL
}
;; entry.
forth_asm TCFA, '>CFA'
pop rax
- add rax, 8 ; [rax] = length of name
+ add rax, 8 + 1 ; [rax] = length of name
movzx rbx, byte [rax]
inc rax
add rax, rbx ; [rax] = codeword
add rsp, 8
next
+forth_asm NOT_, 'NOT'
+ pop rax
+ cmp rax, 0
+ jz .false
+.true:
+ push 0
+ next
+.false:
+ push 1
+ next
+
;; The INTERPRET word reads and interprets user input. It's behavior depends on
-;; the current STATE. It provides special handling for integers. (TODO)
+;; the current STATE. It provides special handling for integers.
forth INTERPRET, 'INTERPRET'
;; Read word
dq READ_WORD
;; Stack is (word length word length).
dq FIND ; Try to find word
dq DUP_
- dq ZBRANCH, 8 * 8 ; Check if word is found
+ dq ZBRANCH, 8 * 20 ; Check if word is found
- ;; Word is found, execute it
+ ;; - Word is found -
+
+ dq STATE, GET, ZBRANCH, 8 * 9 ; Check whether we are in compilation or immediate mode
+
+ ;; (Word found, compilation mode)
+ dq DUP_, IS_IMMEDIATE, NOT_, ZBRANCH, 8 * 4 ; If the word is immediate, continue as we would in immediate mode
+
+ ;; Otherwise, we want to compile this word
+ dq TCFA
+ dq COMMA
+ dq EXIT
+
+ ;; (Word found, immediate mode)
+ ;; Execute word
dq TCFA
;; Stack is (word length addr)
dq SWAP, DROP
dq EXEC
dq EXIT
- ;; No word is found, assume it is an integer literal
+ ;; - No word is found, assume it is an integer literal -
;; Stack is (word length addr)
dq DROP
dq PARSE_NUMBER
+
+ dq STATE, GET, ZBRANCH, 8 * 5 ; Check whether we are in compilation or immediate mode
+
+ ;; (Number, compilation mode)
+ dq LIT, LIT, COMMA
+ dq COMMA
+ dq EXIT
+
+ ;; (Number, immediate mode)
dq EXIT
;; .U prints the value on the stack as an unsigned integer in hexadecimal.
push rax
next
+forth_asm PUT_BYTE, 'C!'
+ pop rbx
+ pop rax ; Value
+ mov [rbx], al
+ next
+
+forth_asm GET_BYTE, 'C@'
+ pop rax
+ movzx rax, byte [rax]
+ push rax
+ next
+
;; Add two integers on the stack.
forth_asm PLUS, '+'
pop rax
mov [latest_entry], rdi ; Update LATEST to point to this word
add rdi, 8
- mov [rdi], rcx ; Insert length
+ mov [rdi], byte 0 ; Insert immediate flag
+
+ add rdi, 1
+ mov [rdi], byte cl ; Insert length
;; Insert word string
add rdi, 1
next
+;; Mark the last added word as immediate.
+forth IMMEDIATE, 'IMMEDIATE', 1
+ dq LIT, 1
+ dq LATEST, GET
+ dq LIT, 8, PLUS
+ dq PUT
+ dq EXIT
+
+;; Given the address of a word, return 0 if the given word is not immediate.
+forth IS_IMMEDIATE, 'IMMEDIATE?'
+ dq LIT, 8, PLUS
+ dq GET_BYTE
+ dq EXIT
+
+;; Enter immediate mode, immediately
+forth INTO_IMMEDIATE, '[', 1
+ dq LIT, 0, STATE, PUT_BYTE
+ dq EXIT
+
+;; Enter compilation mode
+forth OUTOF_IMMEDIATE, ']'
+ dq LIT, 1, STATE, PUT_BYTE
+ dq EXIT
+
forth MAIN, 'MAIN'
dq HELLO
dq INTERPRET