implement "key", which reads a byte of input from the buffer

sweeeeeeeet

nearly there now

also, fetch8 (aka 8@) and the 16- and 32-bit equivalents never actually returned their results. oops. fixed.

Force-Push: yes
Change-Id: I35e48036951e829625cc37ce99d789e97d98100b

1 files changed, 223 insertions, 2 deletions

diff --git a/quine.asm b/quine.asm
index 4c68373..9e6469f 100644
--- a/quine.asm
+++ b/quine.asm
@@ -2383,6 +2383,7 @@ cold_start:
   dq rbx, pop_reg64
   dq rax, rax, xor_reg64_reg64
   dq rbx, al, mov_reg8_indirect_reg64
+  dq rax, push_reg64
   dq pack_next, lit, 8, packalign, early_here_store
 
   ; This was "store16".
@@ -2397,6 +2398,7 @@ cold_start:
   dq rbx, pop_reg64
   dq rax, rax, xor_reg64_reg64
   dq rbx, ax, mov_reg16_indirect_reg64
+  dq rax, push_reg64
   dq pack_next, lit, 8, packalign, early_here_store
 
   ; This was "store32".
@@ -2411,6 +2413,7 @@ cold_start:
   dq rbx, pop_reg64
   dq rax, rax, xor_reg64_reg64
   dq rbx, eax, mov_reg32_indirect_reg64
+  dq rax, push_reg64
   dq pack_next, lit, 8, packalign, early_here_store
 
   ; This was "store_control_stack". Jonesforth calls it RSP!, which looks as
@@ -3025,6 +3028,55 @@ cold_start:
   dq swap, unroll3, pack_beforenext
   dq lit, 8, packalign, early_here_store
 
+  dq litstring, "unpack64", 0, early_create, early_docol_codeword
+  dq litstring, "dup", early_find, entry_to_execution_token, early_comma
+  dq litstring, "@", early_find, entry_to_execution_token, early_comma
+  dq litstring, "swap", early_find, entry_to_execution_token, early_comma
+  dq litstring, "lit", early_find, entry_to_execution_token, early_comma
+  dq lit, 8, early_comma
+  dq litstring, "+", early_find, entry_to_execution_token, early_comma
+  dq litstring, "swap", 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, "unpack32", 0, early_create, early_docol_codeword
+  dq litstring, "dup", early_find, entry_to_execution_token, early_comma
+  dq litstring, "32@", early_find, entry_to_execution_token, early_comma
+  dq litstring, "swap", early_find, entry_to_execution_token, early_comma
+  dq litstring, "lit", early_find, entry_to_execution_token, early_comma
+  dq lit, 4, early_comma
+  dq litstring, "+", early_find, entry_to_execution_token, early_comma
+  dq litstring, "swap", 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, "unpack16", 0, early_create, early_docol_codeword
+  dq litstring, "dup", early_find, entry_to_execution_token, early_comma
+  dq litstring, "16@", early_find, entry_to_execution_token, early_comma
+  dq litstring, "swap", early_find, entry_to_execution_token, early_comma
+  dq litstring, "lit", early_find, entry_to_execution_token, early_comma
+  dq lit, 2, early_comma
+  dq litstring, "+", early_find, entry_to_execution_token, early_comma
+  dq litstring, "swap", 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, "unpack8", early_create, early_docol_codeword
+  dq litstring, "dup", early_find, entry_to_execution_token, early_comma
+  dq litstring, "8@", early_find, entry_to_execution_token, early_comma
+  dq litstring, "swap", 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, "+", early_find, entry_to_execution_token, early_comma
+  dq litstring, "swap", 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, "unpackalign", early_create, early_docol_codeword
+  dq litstring, "packalign", 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
+
   ; The flatassembler names of all these were the same, but without the
   ; colons, and with underscores instead of hyphens.
   dq litstring, ":rax", early_keyword
@@ -6206,7 +6258,8 @@ cold_start:
   dq litstring, "exit", early_find, entry_to_execution_token, early_comma
   dq early_here, fetch, lit, 8, packalign, early_here_store
 
-  ;;; Initialize our runtime data structures.
+  ;;; Here we have some imperative code that runs immediately, to initialize
+  ;;; some runtime data structures.
   ; (heap pointer)
   dq litstring, "allocate-input-buffer-metadata", early_find
   dq entry_to_execution_token, execute
@@ -6229,10 +6282,134 @@ cold_start:
   dq litstring, "main-input-buffer", swap
   ; (heap pointer, metadata pointer, string pointer, execution token)
   dq execute
+
+  dq litstring, "key", early_create, early_docol_codeword
   dq litstring, "main-input-buffer", early_find, entry_to_execution_token
-  dq execute
+  dq early_comma
+  dq litstring, "dup", early_find, entry_to_execution_token, early_comma
+  dq litstring, "buffer-logical-start", early_find, entry_to_execution_token
+  dq early_comma
+  dq litstring, "@", early_find, entry_to_execution_token, early_comma
+  dq litstring, "swap", early_find, entry_to_execution_token, early_comma
+  dq litstring, "dup", early_find, entry_to_execution_token, early_comma
+  dq litstring, "buffer-logical-end", early_find, entry_to_execution_token
+  dq early_comma
+  dq litstring, "@", early_find, entry_to_execution_token, early_comma
+  dq litstring, "swap", early_find, entry_to_execution_token, early_comma
+  dq litstring, "3unroll", early_find, entry_to_execution_token, early_comma
+  dq litstring, "eq", 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
+
+  ; If the start and end pointers are equal, there is no input; return zero.
+  ; TODO This would also be the place to call the "refill" word.
+  ; (metadata pointer)
+  dq litstring, "drop", 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, "exit", early_find, entry_to_execution_token, early_comma
+
+  ; The buffer is non-empty, so read a byte from it.
+  ; (metadata pointer, input pointer)
+  dq litstring, "dup", early_find, entry_to_execution_token, early_comma
+  dq litstring, "buffer-logical-start", early_find, entry_to_execution_token
+  dq early_comma
+  dq litstring, "@", early_find, entry_to_execution_token, early_comma
+  dq litstring, "unpack8", early_find, entry_to_execution_token, early_comma
+  ; (metadata pointer, updated input pointer, result byte)
+  dq litstring, "swap", early_find, entry_to_execution_token, early_comma
+  dq litstring, "dup", early_find, entry_to_execution_token, early_comma
+  dq litstring, "lit", early_find, entry_to_execution_token, early_comma
+  dq lit, 4, early_comma
+  dq litstring, "roll", early_find, entry_to_execution_token, early_comma
+  ; (result byte, updated input pointer, updated input pointer,
+  ;  metadata pointer)
+  dq litstring, "dup", early_find, entry_to_execution_token, early_comma
+  dq litstring, "3unroll", early_find, entry_to_execution_token, early_comma
+  ; (result byte, updated input pointer, metadata pointer,
+  ;  updated input pointer, metadata pointer)
+  dq litstring, "buffer-physical-end", early_find, entry_to_execution_token
+  dq early_comma
+  dq litstring, "@", early_find, entry_to_execution_token, early_comma
+  dq litstring, "eq", early_find, entry_to_execution_token, early_comma
+  dq litstring, "0branch", early_find, entry_to_execution_token, early_comma
+  dq lit, 13*8, early_comma
+
+  ; If the logical start pointer is now equal to the physical end pointer,
+  ; we want to wrap to the physical start. That's what makes it a circular
+  ; buffer.
+  ;
+  ; However, we skip over this behavior if the logical start is also equal to
+  ; the logical end. Otherwise it would loop forever, re-reading the same
+  ; input.
+  ; (result byte, updated input pointer, metadata pointer)
+  dq litstring, "2dup", early_find, entry_to_execution_token, early_comma
+  dq litstring, "buffer-logical-end", early_find, entry_to_execution_token
+  dq early_comma
+  dq litstring, "@", early_find, entry_to_execution_token, early_comma
+  dq litstring, "ne", early_find, entry_to_execution_token, early_comma
+  dq litstring, "0branch", early_find, entry_to_execution_token, early_comma
+  dq lit, 7*8, early_comma
+
+  ; (result byte, updated input pointer, metadata pointer)
+  ; Here's the part where we swap in the physical 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, "dup", early_find, entry_to_execution_token, early_comma
+  dq litstring, "buffer-physical-start", early_find, entry_to_execution_token
+  dq early_comma
+  dq litstring, "@", early_find, entry_to_execution_token, early_comma
+  dq litstring, "swap", early_find, entry_to_execution_token, early_comma
+  ; Fall through to the other half of both branches.
+
+  ; However we got here, save the updated logical end pointer.
+  ; (result byte, updated input pointer, metadata pointer)
+  dq litstring, "buffer-logical-start", early_find, entry_to_execution_token
+  dq 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 lit, 0, sys_exit
 
+  ;;; TODO rethink this, it needs to not use space on the value stack
+  ;; Stack-allocate a buffer.
+  ;;
+  ;;   For brevity's sake, in notation below here when we give the contents of
+  ;; the stack we'll leave out the original copy of the heap pointer, and the
+  ;; four words used for the buffer.
+  ;dq lit, 0, lit, 0, lit, 0, lit, 0, fetch_value_stack
+  ;;   Make a copy of the heap pointer so we can have it a little closer. If we
+  ;; instead were to try to get to the copy on the other side of the buffer by
+  ;; rolling, it would move the buffer, invalidating the pointers.
+  ;dq lit, 6, roll, dup, lit, 7, unroll, swap
+  ;dq dup
+  ;dq lit, boot_source
+  ;; (heap pointer, buffer start pointer, buffer end pointer, input pointer)
+  ;
+  ;; Start of the loop
+  ;dq key                                                       ; 1 word
+  ;
+  ;; (heap pointer, buffer start pointer, buffer end pointer,
+  ;;  input pointer, input byte)
+  ;dq dup, lit, " ", ne, zbranch, 13*8                          ; 6 words
+  ;dq dup, lit, 0x0a, ne, zbranch, 7*8                          ; 6 words
+  ;
+  ;; If we got here, it's a body character.
+  ;dq roll3, swap, pack8, swap, branch, -18*8                   ; 6 words
+  ;
+  ;; If we got here, it's a space character.
+  ;dq drop, swap, lit, 0, pack8                                 ; 5 words
+  ;dq swap, roll3, dup, lit, 4, unroll                          ; 6 words
+  ;
+  ;; (heap pointer, buffer start pointer, buffer end pointer,
+  ;;  input pointer, word pointer)
+  ;dq lit, 5, roll, swap, early_find, swap, lit, 5, unroll      ; 8 words
+  ;dq entry_to_execution_token, execute                         ; 2 words
+  ;dq branch, -41*8
+
   ;;; For triage's sake, here's an inventory of everything else in the file.
   ;;;
   ;;; Macros:
@@ -6982,6 +7159,7 @@ defword fetch8, 0
   pop.qreg rbx
   xor.qreg.qreg rax, rax
   mov.breg.indirect.qreg al, rbx
+  push.qreg rax
   next
 
 defword store16, 0
@@ -6996,6 +7174,7 @@ defword fetch16, 0
   pop.qreg rbx
   xor.qreg.qreg rax, rax
   mov.wreg.indirect.qreg ax, rbx
+  push.qreg rax
   next
 
 defword store32, 0
@@ -7010,6 +7189,7 @@ defword fetch32, 0
   pop.qreg rbx
   xor.qreg.qreg rax, rax
   mov.dreg.indirect.qreg eax, rbx
+  push.qreg rax
   next
 
 ; Before we get too deep into it, we also define a few reflection routines
@@ -7685,6 +7865,47 @@ defword litpack8, 0
   beforenext pack8
 
 
+;;;;;;;;;;;;;;;;;;;;;
+;;; Input helpers ;;;
+;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;;   These routines are for examining data structures in-memory.
+;;;
+;;;   Similarly to the output routines, each routine takes an input address,
+;;; which it updates to point after the data item being read. Since this is
+;;; input, the routines return data items rather than accepting them.
+
+; In: base address
+; Out: new base address, value
+defword unpack64, 0
+  dq docol
+  dq dup, fetch, swap, lit, 8, add, swap
+  dq exit
+defword unpack32, 0
+  dq docol
+  dq dup, fetch32, swap, lit, 4, add, swap
+  dq exit
+defword unpack16, 0
+  dq docol
+  dq dup, fetch16, swap, lit, 2, add, swap
+  dq exit
+defword unpack8, 0
+  dq docol
+  dq dup, fetch8, swap, lit, 1, add, swap
+  dq exit
+
+;   Since there's no data, this is identical to its output version, but we
+; allow this name as an alias for clarity.
+;
+; Stack in:
+;   base address
+;   byte size
+; Stack out:
+;   new base address
+defword unpackalign, 0
+  dq docol, packalign, exit
+
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Assembly language, but in Forth ;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;