From: Tim Vaughan <tgvaughan@gmail.com>
Date: Mon, 23 May 2016 12:31:32 +0000 (+1200)
Subject: Fixed residual INTERPRET bugs. Closes #3.
X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=commitdiff_plain;h=f998451ad1e6486ab7f9db3204bf830e82cb0f94;p=forth.jl.git

Fixed residual INTERPRET bugs. Closes #3.
---

diff --git a/src/forth.jl b/src/forth.jl
index 134b651..cdb56d5 100644
--- a/src/forth.jl
+++ b/src/forth.jl
@@ -567,7 +567,7 @@ RSPFETCH = defPrimWord("RSP@", () -> begin
 end)
 
 RSPSTORE = defPrimWord("RSP!", () -> begin
-    RSP = popPS()
+    reg.RSP = popPS()
     return NEXT
 end)
 
@@ -584,7 +584,7 @@ PSPFETCH = defPrimWord("PSP@", () -> begin
 end)
 
 PSPSTORE = defPrimWord("PSP!", () -> begin
-    PSP = popPS()
+    reg.PSP = popPS()
     return NEXT
 end)
 
@@ -764,7 +764,7 @@ NUMTIB, NUMTIB_CFA = defNewVar("#TIB", 0)
 TOIN, TOIN_CFA = defNewVar(">IN", 0)
 
 QUERY = defWord("QUERY",
-    [TIB_CFA, LIT, 80, EXPECT,
+    [TIB_CFA, LIT, 160, EXPECT,
     SPAN_CFA, FETCH, NUMTIB_CFA, STORE,
     LIT, 0, TOIN_CFA, STORE,
     EXIT])
@@ -876,11 +876,16 @@ PROMPT = defPrimWord("PROMPT", () -> begin
 end)
 
 QUIT = defWord("QUIT",
-    [RSP0_CFA, RSPSTORE,
+    [LIT, 0, STATE_CFA, STORE,
+    LIT, 0, NUMTIB_CFA, STORE,
+    RSP0_CFA, FETCH, RSPSTORE,
     QUERY,
     INTERPRET, PROMPT,
     BRANCH,-4])
 
+ABORT = defWord("ABORT",
+    [PSP0_CFA, FETCH, PSPSTORE, QUIT])
+
 INCLUDE = defPrimWord("INCLUDE", () -> begin
     pushPS(32)
     callPrim(mem[WORD])
@@ -995,16 +1000,8 @@ function run(;initialize=true)
                 close(pop!(sources))
             end
 
-            # Want backtrace in here eventually
-            println("reg.W: $(reg.W) reg.IP: $(reg.IP)")
-            print("PS: "); printPS()
-            print("RS: "); printRS()
-
-            mem[STATE] = 0
-            mem[NUMTIB] = 0
-            reg.PSP = mem[PSP0]
-            reg.RSP = mem[RSP0]
-            reg.IP = QUIT + 1
+            # QUIT
+            reg.IP = ABORT + 1
             jmp = NEXT
         end
     end
diff --git a/src/lib.4th b/src/lib.4th
index 81b1e6f..301f9ac 100644
--- a/src/lib.4th
+++ b/src/lib.4th
@@ -427,9 +427,14 @@
                 ['] LITSTRING ,   ( compile LITSTRING )
                 HERE @          ( save the address of the length word on the stack )
                 0 ,             ( dummy length - we don't know what it is yet )
-                KEY DROP
+
                 BEGIN
-                        KEY             ( get next character of the string )
+                        >IN @ #TIB @ >= IF      \ End of TIB?
+                                QUERY           \ Get next line
+                        THEN
+
+                        TIB >IN @ + @ 1 >IN +!  \ Get char from TIB
+
                         DUP [CHAR] " <>
                 WHILE
                         C,              ( copy character )
@@ -441,9 +446,14 @@
                 SWAP !          ( and back-fill the length location )
         ELSE            ( immediate mode )
                 HERE @          ( get the start address of the temporary space )
-                KEY DROP
+                
                 BEGIN
-                        KEY
+                        >IN @ #TIB @ >= IF      \ End of TIB?
+                                QUERY           \ Get next line
+                        THEN
+
+                        TIB >IN @ + @ 1 >IN +!  \ Get char from TIB
+
                         DUP [CHAR] " <>
                 WHILE
                         OVER C!         ( save next character )
@@ -462,9 +472,13 @@
 ;
 
 : .( 
-        KEY DROP
         BEGIN
-                KEY
+                >IN @ #TIB @ >= IF      \ End of TIB?
+                        QUERY           \ Get next line
+                THEN
+
+                TIB >IN @ + @ 1 >IN +!  \ Get char from TIB
+
                 DUP [CHAR] ) = IF
                         DROP    ( drop the double quote character )
                         EXIT    ( return from this function )
@@ -494,11 +508,11 @@
 ;
 
 : VARIABLE
-        CREATE
+        BL WORD HEADER
+        DOVAR ,
         1 CELLS ALLOT   ( allocate 1 cell of memory, push the pointer to this memory )
 ;
 
-
 : VALUE         ( n -- )
         BL WORD HEADER  ( make the dictionary entry (the name follows VALUE) )
         DOCOL ,         ( append DOCOL )
@@ -630,14 +644,14 @@
 ;
 
 : SEE
-        BL WORD 2DUP FIND     ( find the dictionary entry to decompile )
+        BL WORD DUP FIND     ( find the dictionary entry to decompile )
 
         ?DUP 0= IF
-                ." Word '" TYPE ." ' not found in dictionary."
+                ." Word '" COUNT TYPE ." ' not found in dictionary."
                 EXIT
         THEN
 
-        -ROT 2DROP
+        SWAP DROP
 
         ( Now we search again, looking for the next word in the dictionary.  This gives us
           the length of the word that we will be decompiling.  (Well, mostly it does). )