Implement INTERPRET-STRING

INTERPRET-STRING works, but the program crashes on startup, because sys.f uses
words that assume that they are being run with user input, for example S" and
READ-WORD.

diff --git a/bootstrap.asm b/bootstrap.asm
index dd72ed9e85e8f53ec96830962457f2f4cd6d8d04..4dd77de2152879f910f50efb7638369afe2c4382 100644 (file)
--- a/bootstrap.asm
+++ b/bootstrap.asm
@@ -100,3 +100,31 @@ forth INTERPRET, 'INTERPRET'
   dq READ_WORD
   dq INTERPRET_WORD
   dq EXIT
+
+;; INTERPRET_STRING is a variant of INTERPRET that reads from a string instead
+;; of from the user. It takes a string as a (buffer, length) pair on the stack
+;; and interprets the entire string, even if the string has more than one word.
+forth INTERPRET_STRING, 'INTERPRET-STRING'
+  dq INPUT_LENGTH, PUT
+  dq INPUT_BUFFER, PUT
+
+  ;; Check if the buffer is-non-empty
+  ;; [TODO] This probably won't work for strings with whitespace at the end.
+  dq INPUT_LENGTH, GET
+  dq ZBRANCH, 8 * 19 ; to EXIT
+
+  dq INPUT_BUFFER, GET
+  dq INPUT_LENGTH, GET
+  dq POP_WORD
+
+  ;; Stack is (buffer buffer-length word word-length)
+
+  dq ROT, ROT
+  dq INPUT_LENGTH, PUT
+  dq ROT, ROT
+  dq INPUT_BUFFER, PUT
+
+  dq INTERPRET_WORD
+  dq BRANCH, -8 * 19 ; to INPUT-LENGTH @
+
+  dq EXIT

diff --git a/main.asm b/main.asm
index c9a7fc42acc1d9deb022010648f9c36c1aab30ee..7443c48aac209a0d46f08d1cddeb710766655ee9 100644 (file)
--- a/main.asm
+++ b/main.asm
@@ -408,7 +408,10 @@ forth_asm TIMESMOD, '/MOD'
 
 ;; Read user input until next " character is found. Push a string containing the
 ;; input on the stack as (buffer length). Note that the buffer is only valid
-;; until the next call to S" and that no more than 255 character can be read.
+;; until the next call to S" and that no more than 255 characters can be read.
+;;
+;; [TODO] We want to be able to use this when reading from buffers (e.g. in
+;; INTERPRET-STRING) too!
 forth_asm READ_STRING, 'S"'
   push rsi
 
@@ -506,6 +509,8 @@ forth_asm EQL, '='
   next
 
 forth MAIN, 'MAIN'
+  dq SYSCODE
+  dq INTERPRET_STRING
   dq INTERPRET
   dq BRANCH, -8 * 2
   dq TERMINATE
@@ -529,6 +534,14 @@ forth SYSCODE, 'SYSCODE'
   dq LIT, sysf.len
   dq EXIT
 
+forth INPUT_BUFFER, 'INPUT-BUFFER'
+  dq LIT, input_buffer
+  dq EXIT
+
+forth INPUT_LENGTH, 'INPUT-LENGTH'
+  dq LIT, input_buffer_length
+  dq EXIT
+
 segment readable writable
 
 ;; The LATEST variable holds a pointer to the word that was last added to the
@@ -559,6 +572,12 @@ DOTU.printed_length dq ?
 here dq here_top
 here_top rq $4000
 
+;; Pointer to input buffer and its length. Used as local variable in
+;; INTERPRET-STRING (see bootstrap.asm). [TODO] The code organization is a bit
+;; awkward here.
+input_buffer dq ?
+input_buffer_length dq ?
+
 ;; Return stack
 rq $2000
 return_stack_top: