add word-defining words. implement the immediate-mode flag.

these are the idiomatic Forth words [, ], :, and ;. also, comma already existed.

an example of defining and calling a word at runtime is in the boot source

Force-Push: yes!!!!!
Change-Id: I5e5f66649616d9928600482fb7e504cd8bfe0d48

1 files changed, 170 insertions, 19 deletions

diff --git a/quine.asm b/quine.asm
index 155bca5..b1447cf 100644
--- a/quine.asm
+++ b/quine.asm
@@ -1584,10 +1584,10 @@ code_start:
 ;;;
 ;;; (overall start)
 ;;;            0x00 - 0x08                     Link (to next-oldest word)
-;;;            0x09 - 0x09  I0H0000M           Flags
-;;;                                                I - immediate
+;;;            0x09 - 0x09  HM00000I           Flags
 ;;;                                                H - hidden
 ;;;                                                M - metadata
+;;;                                                I - immediate
 ;;;                                                all other bits reserved
 ;;; (name start)
 ;;;            0x0a - 0x0a                     Null byte (terminates name)
@@ -5634,6 +5634,7 @@ cold_start:
   dq early_here, fetch, lit, 8, packalign, early_here_store
 
   ; This was "store_entry_flags".
+  ; TODO these parameters are in a counterintuitive order, swap them
   dq litstring, "entry-flags!", early_create, early_docol_codeword
   dq litstring, "swap", early_find, entry_to_execution_token, early_comma
   dq litstring, "lit", early_find, entry_to_execution_token, early_comma
@@ -5675,6 +5676,17 @@ cold_start:
   dq litstring, "swap", early_find, entry_to_execution_token, early_comma
   dq litstring, "drop", early_find, entry_to_execution_token, early_comma
   dq litstring, "exit", early_find, entry_to_execution_token, early_comma
+  dq litstring, "dup", early_find, entry_to_execution_token, early_comma
+  dq litstring, "entry-flags@", early_find, entry_to_execution_token
+  dq early_comma
+  dq litstring, "lit", early_find, entry_to_execution_token, early_comma
+  dq lit, 0x80, early_comma
+  dq litstring, "and", early_find, entry_to_execution_token, early_comma
+  dq litstring, "lit", early_find, entry_to_execution_token, early_comma
+  dq lit, 0x80, early_comma
+  dq litstring, "!=", early_find, entry_to_execution_token, early_comma
+  dq litstring, "0branch", early_find, entry_to_execution_token, early_comma
+  dq lit, 8*8, early_comma
   dq litstring, "2dup", early_find, entry_to_execution_token, early_comma
   dq litstring, "lit", early_find, entry_to_execution_token, early_comma
   dq lit, 10, early_comma
@@ -5684,7 +5696,7 @@ cold_start:
   dq lit, 4*8, early_comma
   dq litstring, "@", early_find, entry_to_execution_token, early_comma
   dq litstring, "branch", early_find, entry_to_execution_token, early_comma
-  dq lit, -18*8, early_comma
+  dq lit, -28*8, early_comma
   dq litstring, "swap", early_find, entry_to_execution_token, early_comma
   dq litstring, "drop", early_find, entry_to_execution_token, early_comma
   dq litstring, "exit", early_find, entry_to_execution_token, early_comma
@@ -7068,6 +7080,118 @@ cold_start:
   ; (heap pointer, storage pointer, string pointer, execution token)
   dq execute
 
+
+  dq litstring, "hide-entry", early_create, early_docol_codeword
+  dq litstring, "dup", early_find, entry_to_execution_token, early_comma
+  dq litstring, "entry-flags@", early_find, entry_to_execution_token
+  dq early_comma
+  dq litstring, "lit", early_find, entry_to_execution_token, early_comma
+  dq lit, 0x80, early_comma
+  dq litstring, "or", early_find, entry_to_execution_token, early_comma
+  dq litstring, "entry-flags!", early_find, entry_to_execution_token
+  dq early_comma
+  dq litstring, "exit", early_find, entry_to_execution_token, early_comma
+  dq early_here, fetch, lit, 8, packalign, early_here_store
+
+
+  dq litstring, "unhide-entry", early_create, early_docol_codeword
+  dq litstring, "dup", early_find, entry_to_execution_token, early_comma
+  dq litstring, "entry-flags@", early_find, entry_to_execution_token
+  dq early_comma
+  dq litstring, "lit", early_find, entry_to_execution_token, early_comma
+  dq lit, 0x80, early_comma
+  dq litstring, "invert", early_find, entry_to_execution_token, early_comma
+  dq litstring, "and", early_find, entry_to_execution_token, early_comma
+  dq litstring, "entry-flags!", early_find, entry_to_execution_token
+  dq early_comma
+  dq litstring, "exit", early_find, entry_to_execution_token, early_comma
+  dq early_here, fetch, lit, 8, packalign, early_here_store
+
+
+  dq litstring, "set-word-immediate", early_create, early_docol_codeword
+  dq litstring, "dup", early_find, entry_to_execution_token, early_comma
+  dq litstring, "entry-flags@", early_find, entry_to_execution_token
+  dq early_comma
+  dq litstring, "lit", early_find, entry_to_execution_token, early_comma
+  dq lit, 0x01, early_comma
+  dq litstring, "or", early_find, entry_to_execution_token, early_comma
+  dq litstring, "entry-flags!", early_find, entry_to_execution_token
+  dq early_comma
+  dq litstring, "exit", early_find, entry_to_execution_token, early_comma
+  dq early_here, fetch, lit, 8, packalign, early_here_store
+
+
+  dq litstring, "[", early_create, early_docol_codeword
+  dq litstring, "interpreter-flags", early_find
+  dq entry_to_execution_token, early_comma
+  dq litstring, "@", early_find, entry_to_execution_token, early_comma
+  dq litstring, "lit", early_find, entry_to_execution_token, early_comma
+  dq lit, 0x01, early_comma
+  dq litstring, "invert", early_find, entry_to_execution_token, early_comma
+  dq litstring, "and", early_find, entry_to_execution_token, early_comma
+  dq litstring, "interpreter-flags", early_find
+  dq entry_to_execution_token, early_comma
+  dq litstring, "!", early_find, entry_to_execution_token, early_comma
+  dq litstring, "exit", early_find, entry_to_execution_token, early_comma
+  dq early_here, fetch, lit, 8, packalign, early_here_store
+
+  ; Run some imperative code to fix the flags.
+  dq litstring, "set-word-immediate", early_find, entry_to_execution_token
+  dq swap, litstring, "[", early_find, roll3, execute
+
+
+  dq litstring, "]", early_create, early_docol_codeword
+  dq litstring, "interpreter-flags", early_find
+  dq entry_to_execution_token, early_comma
+  dq litstring, "@", early_find, entry_to_execution_token, early_comma
+  dq litstring, "lit", early_find, entry_to_execution_token, early_comma
+  dq lit, 0x01, early_comma
+  dq litstring, "or", early_find, entry_to_execution_token, early_comma
+  dq litstring, "interpreter-flags", early_find
+  dq entry_to_execution_token, early_comma
+  dq litstring, "!", early_find, entry_to_execution_token, early_comma
+  dq litstring, "exit", early_find, entry_to_execution_token, early_comma
+  dq early_here, fetch, lit, 8, packalign, early_here_store
+
+
+  dq litstring, ":", early_create, early_docol_codeword
+  dq litstring, "word", early_find, entry_to_execution_token, early_comma
+  dq litstring, "value@", early_find, entry_to_execution_token, early_comma
+  dq litstring, "create", early_find, entry_to_execution_token, early_comma
+  dq litstring, "dropstring", early_find, entry_to_execution_token
+  dq early_comma
+  dq litstring, "docol", early_find, entry_to_execution_token, early_comma
+  dq litstring, ",", early_find, entry_to_execution_token, early_comma
+  dq litstring, "latest", early_find, entry_to_execution_token, early_comma
+  dq litstring, "@", early_find, entry_to_execution_token, early_comma
+  dq litstring, "hide-entry", early_find, entry_to_execution_token
+  dq early_comma
+  ; If this feels backwards, imagine to yourself that everything that ISN'T
+  ; defining a word body is part of an implicit [ ... ] sequence. Doing so
+  ; doesn't really change anything, but may make you happier.
+  dq litstring, "]", early_find, entry_to_execution_token, early_comma
+  dq litstring, "exit", early_find, entry_to_execution_token, early_comma
+  dq early_here, fetch, lit, 8, packalign, early_here_store
+
+
+  dq litstring, ";", early_create, early_docol_codeword
+  dq litstring, "lit", early_find, entry_to_execution_token, early_comma
+  dq litstring, "exit", early_find, entry_to_execution_token, early_comma
+  dq litstring, ",", early_find, entry_to_execution_token, early_comma
+  dq litstring, "latest", early_find, entry_to_execution_token, early_comma
+  dq litstring, "@", early_find, entry_to_execution_token, early_comma
+  dq litstring, "unhide-entry", early_find, entry_to_execution_token
+  dq early_comma
+  ; As above.
+  dq litstring, "[", early_find, entry_to_execution_token, early_comma
+  dq litstring, "exit", early_find, entry_to_execution_token, early_comma
+  dq early_here, fetch, lit, 8, packalign, early_here_store
+
+  ; Run some imperative code to fix the flags.
+  dq litstring, "set-word-immediate", early_find, entry_to_execution_token
+  dq swap, litstring, ";", early_find, roll3, execute
+
+
   dq litstring, "interpret", early_create, early_docol_codeword
   ; Start of the loop.
   dq litstring, "word", early_find, entry_to_execution_token, early_comma
@@ -7094,13 +7218,12 @@ cold_start:
   dq lit, 0, early_comma
   dq litstring, "!=", early_find, entry_to_execution_token, early_comma
   dq litstring, "0branch", early_find, entry_to_execution_token, early_comma
-  dq lit, 16*8, early_comma
+  dq lit, 27*8, early_comma
 
-  ; If the word is in the dictionary, get the execution token, then...
+  ; If the word is in the dictionary, check what mode we're in, then...
   dq litstring, "dropstring-with-result", early_find, entry_to_execution_token
   dq early_comma
-  dq litstring, "entry-to-execution-token", 0, early_find
-  dq entry_to_execution_token, early_comma
+  ; (entry pointer)
   dq litstring, "interpreter-flags", early_find, entry_to_execution_token
   dq early_comma
   dq litstring, "@", early_find, entry_to_execution_token, early_comma
@@ -7108,19 +7231,35 @@ cold_start:
   dq lit, 0x01, early_comma
   dq litstring, "and", early_find, entry_to_execution_token, early_comma
   dq litstring, "0branch", early_find, entry_to_execution_token, early_comma
-  dq lit, 4*8, early_comma
+  dq lit, 15*8, early_comma
 
-  ; ... if we're in compile mode, append it to the heap.
+  ; ... if we're in compile mode, there's still a chance it's an immediate
+  ; word, in which case we branch over to interpret mode...
+  dq litstring, "dup", early_find, entry_to_execution_token, early_comma
+  dq litstring, "entry-flags@", early_find, entry_to_execution_token, early_comma
+  dq litstring, "lit", early_find, entry_to_execution_token, early_comma
+  dq lit, 1, early_comma
+  dq litstring, "and", early_find, entry_to_execution_token, early_comma
+  dq litstring, "lit", early_find, entry_to_execution_token, early_comma
+  dq lit, 0, early_comma
+  dq litstring, "=", early_find, entry_to_execution_token, early_comma
+  dq litstring, "0branch", early_find, entry_to_execution_token, early_comma
+  dq lit, 5*8, early_comma
+  ; ... but it's a regular word, so append it to the heap.
+  dq litstring, "entry-to-execution-token", 0, early_find
+  dq entry_to_execution_token, early_comma
   dq litstring, ",", early_find, entry_to_execution_token, early_comma
   ; o/~ Like a whirlpool and it never ends. o/~
   dq litstring, "branch", early_find, entry_to_execution_token, early_comma
-  dq lit, -28*8, early_comma
+  dq lit, -38*8, early_comma
 
-  ; ... if we're in interpret mode, run it.
+  ; ... if we're in interpret mode, or the word is immediate, run it.
+  dq litstring, "entry-to-execution-token", 0, early_find
+  dq entry_to_execution_token, early_comma
   dq litstring, "execute", early_find, entry_to_execution_token, early_comma
   ; o/~ Like a whirlpool and it never ends. o/~
   dq litstring, "branch", early_find, entry_to_execution_token, early_comma
-  dq lit, -31*8, early_comma ; ...
+  dq lit, -42*8, early_comma
 
   ; If it's not in the dictionary, check whether it's a decimal number.
   dq litstring, "drop", early_find, entry_to_execution_token, early_comma
@@ -7155,7 +7294,7 @@ cold_start:
   dq litstring, ",", early_find, entry_to_execution_token, early_comma
   ; o/~ Like a whirlpool and it never ends. o/~
   dq litstring, "branch", early_find, entry_to_execution_token, early_comma
-  dq lit, -52*8, early_comma
+  dq lit, -63*8, early_comma
 
   ; We're in interpret mode; push the number to the stack. Or at least, that's
   ; what the code we're interpreting will see. Really it's already on the
@@ -7164,7 +7303,7 @@ cold_start:
   dq early_comma
   ; o/~ Like a whirlpool and it never ends. o/~
   dq litstring, "branch", early_find, entry_to_execution_token, early_comma
-  dq lit, -55*8, early_comma
+  dq lit, -66*8, early_comma
 
   ; If it's neither in the dictionary nor a number, exit.
   dq litstring, "dropstring", early_find, entry_to_execution_token
@@ -8080,7 +8219,7 @@ defword reverse_stringlen, 0
 ;   address of final null byte in alignment padding of total length up to 8
 ; Stack out:
 ;   number of null bytes (from end) until nearest non-null byte, or 8
-defword reverse_padding_len,  0
+defword reverse_padding_len, 0
   dq $ + 8
   pop.qreg rdi
 
@@ -9984,13 +10123,25 @@ defword find_in, 0
   dq docol
   ; It will be more convenient to have the dictionary pointer on top.
   dq swap
+
   ; If the dictionary pointer is null, exit.
+  ; (name string to find, current word pointer)
   dq dup, lit, 0, eq, zbranch, 4*8, swap, drop, exit
+
+  ; Check this entry's "hidden" flag.
+  ; (name string to find, current word pointer)
+  dq dup, fetch_entry_flags, lit, 0x80, and, lit, 0x80, ne, zbranch, 8*8
+
   ; Test whether this entry is a match.
+  ; (name string to find, current word pointer)
   dq dup2, lit, 10, add, stringcmp, zbranch, 4*8
+
   ; If we're here, it's not a match; traverse the pointer and repeat.
-  dq fetch, branch, -18*8
+  ; (name string to find, current word pointer)
+  dq fetch, branch, -28*8
+
   ; If we're here, it's a match. Clean up our working state and exit.
+  ; (name string to find, current word pointer)
   dq swap, drop, exit
 
 ;   This is the backend for early_next_newer_entry_in; it will eventually also
@@ -10028,7 +10179,7 @@ defword next_newer_entry_in, 0
 defword guess_entry_end_in, 0
   dq docol
   ; Check whether the entry is flagged as metadata...
-  dq dup, fetch_entry_flags, lit, 0x01, and, lit, 0x01, eq, zbranch, 6*8
+  dq dup, fetch_entry_flags, lit, 0x40, and, lit, 0x40, eq, zbranch, 6*8
   ; ... if so, return the same entry address as the result, which means we're
   ; saying the length is zero.
   dq swap, drop, swap, drop, exit
@@ -10732,11 +10883,11 @@ defword self_raw, 0
 ; be flagged as metadata. For convenience's sake, we use a single metadata
 ; word both to delimit the segment end, and to hold the boot source. Cute,
 ; right?
-defword boot_source, 1
+defword boot_source, 0x40
   ; Keep in mind that these words don't exist in memory, so branching won't
   ; have the intended effect. Any logic that requires branching needs to be
   ; written to the heap instead, and branch while running there.
-  dq "0 sys-exit"
+  dq ": fribble 5 . ; fribble 0 sys-exit"
   dq 0