the interpreter fully compiles now

doesn't work quite yet. close :)

Force-Push: yes
Change-Id: I71b6e788790fe2ca8e07dae95e9ad6e39d0664c0

3 files changed, 90 insertions, 24 deletions

diff --git a/input.e b/input.e
index 5cf2aeb..c7a1c02 100644
--- a/input.e
+++ b/input.e
@@ -166,7 +166,7 @@
   buffer-logical-start @ 8@ ;
 
 
-~ (metadata pointer)
+~ (metadata pointer -- byte or 0)
 : key-from
   dup peek-from
   ~ (metadata pointer, result byte)
@@ -175,6 +175,54 @@
   swap consume-from ;
 
 
+~   If the buffer is empty, make sure its logical position is at the
+~ physical start. Otherwise, leave it alone.
+~
+~ In:
+~   pointer to buffer metadata
+: normalize-buffer
+  dup buffer-logical-length @ 0 =
+  { dup buffer-physical-start @ swap
+    buffer-logical-start ! } { drop } if-else
+  ;
+
+
+~   Find the next contiguous area of a buffer to write incoming data to.
+~ This will begin at the logical end. Depending on the order things are in,
+~ the available space might run from there to the physical end, or to the
+~ logical start. Those are the only two possibilities.
+~
+~   If the buffer is full, this will return as normal but the length will
+~ be zero. The caller should make sure to respect that.
+~
+~ In:
+~   pointer to buffer metadata
+~ Out:
+~   destination start
+~   destination length
+: compute-next-buffer-free-block
+  dup buffer-physical-start @ swap dup buffer-physical-length @
+  swap 3unroll + swap
+~ (physical end, metadata pointer)
+  dup buffer-logical-start @ swap dup buffer-logical-length @
+  swap 3unroll + swap 3unroll
+~ (metadata pointer, physical end, logical end not yet wrapped)
+
+
+~ (metadata pointer --)
+: refill-input-buffer-from-stdin
+  dup normalize-buffer
+  dup compute-next-buffer-free-block
+  ~   Check whether the buffer is full. If not, do a read. If so, that's not
+  ~ an error, just clean up and take no action.
+  dup { swap sys-read
+        dup -2 =
+        { drop drop s" Read error." emitstring 0 sys-exit }
+        { swap dup buffer-logical-length @ 3roll +
+          swap buffer-logical-length ! } if-else }
+      { drop drop } if-else ;
+
+
 
 ~   Here we have some imperative code that runs immediately, to initialize
 ~ some runtime data structures.
diff --git a/interpret.e b/interpret.e
index ee0a52b..516c728 100644
--- a/interpret.e
+++ b/interpret.e
@@ -450,8 +450,28 @@ latest @
   ; make-immediate
 
 
+~   Though we only do it once, this is a bit involved so we provide it as a
+~ word. Notionally there are situations in which it could come up again, so
+~ it seems worth having around.
+~
+~   It actually needs to run as a compiled word no matter what; if it were
+~ run in interpret mode it would cut itself off from the rest of itself.
+~ However, if we didn't want to keep it around we could have it forget
+~ itself...
+~
+~   It depends on ', so it's here in interpret.e.
+: relink-main-input-buffer-to-stdin
+  1024 allocate dup main-input-buffer buffer-physical-start !
+  main-input-buffer buffer-logical-start !
+  1024 main-input-buffer buffer-physical-length !
+  0 main-input-buffer buffer-logical-length !
+  ' refill-input-buffer-from-stdin entry-to-execution-token
+  main-input-buffer input-buffer-refill !
+  ;
+
+
 
-~ ~ Now the single most important word...
+~ Now the single most important word...
 : interpret
   word
 
@@ -493,7 +513,7 @@ latest @
       ~ ourselves are compiled, hardcoded; doing a dynamic lookup would
       ~ require dealing with what happens if it's not found.
       dropstring-with-result
-      [ ' lit entry-to-execution-token literal ]
+      ' lit entry-to-execution-token
       , ,
       exit
     } if
@@ -507,24 +527,14 @@ latest @
   ~ If it's neither in the dictionary nor a number, just print an error.
   s" No such word: " emitstring value@ emitstring dropstring ;
 
-~ ~ TODO for ease of debugging, this isn't the full implementation, which lets
-~ ~ us exit it to the outer "quit"
-~ : quit { interpret } forever ;
-~ 
-~ ~   Now we switch into the new interpreter, enabling the three words we'd been
-~ ~ keeping hidden and then calling "quit".
-~ dup entry-flags@ 0x80 invert & entry-flags!
-~ dup entry-flags@ 0x80 invert & entry-flags!
-~ dup entry-flags@ 0x80 invert & entry-flags!
-~ quit
-~ 
-~ ~ -0x10 newline . newline
-~ compile ~ 4 5 + . : za 13 12 - . ; za
-~ ~ ~ : ' word value@ find dropstring-with-result
-~ ~ ~  interpreter-flags @ 1 & { literal } if ; make-immediate
-~ ~ ' za . newline
-~ ~ : piz ' za . newline ; piz
-~ ~ ~ ' interpret forget quit 2 3 * .
-~ ~ ' ' describe ' za describe ' piz describe
-~ ~ bye
-~ ~ 
+: quit r0 @ control! { interpret } forever ;
+
+~   Now we enable the three words we'd been keeping hidden. It would be a
+~ good idea to call "quit" as soon as possible after this, but we leave it to
+~ the user.
+dup entry-flags@ 0x80 invert & entry-flags!
+dup entry-flags@ 0x80 invert & entry-flags!
+dup entry-flags@ 0x80 invert & entry-flags!
+
+relink-main-input-buffer-to-stdin quit
+
diff --git a/transform.e b/transform.e
index 1502ee4..4d7c32c 100644
--- a/transform.e
+++ b/transform.e
@@ -740,6 +740,13 @@ allocate-transform-state s" transform-state" variable
   dup s" allocate-input-buffer-metadata" stringcmp 0 = { drop 1 exit } if
   dup s" allocate-input-buffer" stringcmp 0 = { drop 0 exit } if
   dup s" attach-string-to-input-buffer" stringcmp 0 = { drop -2 exit } if
+  dup s" consume-from" stringcmp 0 = { drop -1 exit } if
+  dup s" peek-from" stringcmp 0 = { drop 0 exit } if
+  dup s" key-from" stringcmp 0 = { drop 0 exit } if
+  dup s" normalize-buffer" stringcmp 0 = { drop -1 exit } if
+  dup s" compute-next-buffer-free-block" stringcmp 0 = { drop 1 exit } if
+  dup s" refill-input-buffer-from-stdin" stringcmp 0 = { drop -1 exit } if
+  dup s" main-input-buffer" stringcmp 0 = { drop 1 exit } if
 
   ~ From interpret.e.
   dup s" unroll-past-string" stringcmp 0 = { drop 0 exit } if
@@ -759,6 +766,7 @@ allocate-transform-state s" transform-state" variable
   dup s" ;" stringcmp 0 = { drop 0 exit } if
   dup s" ;asm" stringcmp 0 = { drop 0 exit } if
   dup s" '" stringcmp 0 = { drop 1 exit } if
+  dup s" relink-main-input-buffer-to-stdin" stringcmp 0 = { drop 0 exit } if
   ~   The following is a deliberate omission: interpret.
   dup s" quit" stringcmp 0 = { drop 0 exit } if