refactor key into the separate parts peek and consume

Change-Id: I203ec08f02bff6f3fc7c82e359941449ca02a04c
Force-Push: yes

1 files changed, 111 insertions, 58 deletions

diff --git a/quine.asm b/quine.asm
index 5f13e13..53580e7 100644
--- a/quine.asm
+++ b/quine.asm
@@ -6352,7 +6352,93 @@ cold_start:
   ; (heap pointer, metadata pointer, string pointer, execution token)
   dq execute
 
-  dq litstring, "key-from", 0, early_create, early_docol_codeword
+
+  ; (metadata pointer)
+  dq litstring, "consume-from", early_create, early_docol_codeword
+
+  ; If the length is zero, exit without doing anything.
+  dq litstring, "dup", early_find, entry_to_execution_token, early_comma
+  dq litstring, "buffer-logical-length", early_find, entry_to_execution_token
+  dq 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, 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, 2*8, early_comma
+  dq litstring, "exit", early_find, entry_to_execution_token, early_comma
+
+  ; Decrement the logical length. We do this now to get it over with, since
+  ; adjusting the start pointer is more complex.
+  dq litstring, "dup", early_find, entry_to_execution_token, early_comma
+  dq litstring, "buffer-logical-length", early_find, entry_to_execution_token
+  dq early_comma
+  dq litstring, "dup", early_find, 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, 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, "!", early_find, entry_to_execution_token, early_comma
+  ; (metadata pointer)
+
+  ; We compute the physical end. We'll need it in adjusting the logical start,
+  ; and doing it now means less stack juggling later.
+  dq litstring, "dup", 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
+  dq litstring, "buffer-physical-length", early_find, entry_to_execution_token
+  dq early_comma
+  dq litstring, "@", 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
+  ; (physical end, metadata pointer)
+
+  ; Compute the incremented logical start.
+  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, "lit", early_find, entry_to_execution_token, early_comma
+  dq lit, 1, early_comma
+  dq litstring, "+", early_find, entry_to_execution_token, early_comma
+  ; (physical end, metadata pointer, updated start pointer)
+
+  ; Check whether the updated start is equal to the physical end.
+  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
+  ; (metadata pointer, updated start, updated start, physical end)
+  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
+
+  ; 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.
+  ; (metadata pointer, updated start)
+  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
+
+  ; However we got here, save the updated logical start pointer.
+  ; (metadata pointer, updated start)
+  dq litstring, "swap", 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, "exit", early_find, entry_to_execution_token, early_comma
+  dq early_here, fetch, lit, 8, packalign, early_here_store
+
+
+  ; (metadata pointer)
+  dq litstring, "peek-from", early_create, early_docol_codeword
   dq litstring, "dup", early_find, entry_to_execution_token, early_comma
   dq litstring, "buffer-logical-length", early_find, entry_to_execution_token
   dq early_comma
@@ -6411,71 +6497,30 @@ cold_start:
   ;   The buffer is non-empty, so read a byte from it. We might have reached
   ; this point either from the original check, or from the second check after
   ; calling the refill word.
+  ;
+  ;   While it might be more extensible to call an "unpack" word here, such as
+  ; unpack8, we actually just want to get the value, and delegate the pointer
+  ; adjustments to "consume".
+  ;
   ; (metadata 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)
-  ; Decrement the logical length.
-  dq litstring, "3roll", early_find, entry_to_execution_token, early_comma
-  dq litstring, "dup", early_find, entry_to_execution_token, early_comma
-  dq litstring, "buffer-logical-length", early_find, entry_to_execution_token
-  dq early_comma
-  dq litstring, "dup", early_find, 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, 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, "!", early_find, entry_to_execution_token, early_comma
-  dq litstring, "3unroll", 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, "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
-  dq litstring, "buffer-physical-length", early_find, entry_to_execution_token
-  dq early_comma
-  dq litstring, "@", early_find, entry_to_execution_token, early_comma
-  dq litstring, "+", early_find, entry_to_execution_token, early_comma
-  ; (result byte, updated input pointer, metadata pointer,
-  ;  updated input pointer, physical end pointer)
-  dq litstring, "=", 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
+  dq litstring, "8@", 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
 
-  ; 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.
-  ; (result byte, updated input pointer, metadata pointer)
-  dq litstring, "swap", early_find, entry_to_execution_token, early_comma
-  dq litstring, "drop", early_find, entry_to_execution_token, early_comma
+
+  ; (metadata pointer)
+  dq litstring, "key-from", 0, early_create, early_docol_codeword
   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, "peek-from", early_find, entry_to_execution_token, early_comma
+  ; (metadata pointer, result byte)
+  ; We unconditionally consume, because we have no way to distinguish between
+  ; reading a zero byte and having nothing left to read.
   dq litstring, "swap", early_find, entry_to_execution_token, early_comma
-
-  ; However we got here, save the updated logical start pointer.
-  ; (result byte, updated input pointer, metadata pointer)
-  dq litstring, "buffer-logical-start", early_find, entry_to_execution_token
+  dq litstring, "consume-from", 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
 
@@ -6563,6 +6608,14 @@ cold_start:
   dq litstring, "exit", early_find, entry_to_execution_token, early_comma
   dq early_here, fetch, lit, 8, packalign, early_here_store
 
+  dq litstring, "consume", early_create, early_docol_codeword
+  dq litstring, "main-input-buffer", early_find, entry_to_execution_token
+  dq early_comma
+  dq litstring, "consume-from", 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
+
 
   ;;;   As a convenience for "word", we have some facilities for working with
   ;;; stack-allocated strings. Yeah, trippy concept. Also, it would be a