From 4b2f52917ce00e4af92d2a3a86e199d21748da5b Mon Sep 17 00:00:00 2001
From: Tim Vaughan <tgvaughan@gmail.com>
Date: Sun, 8 May 2016 13:40:27 +1200
Subject: [PATCH] Pinning down insidious bug in interpreter.

Somehow mangles the parameter stack during LOOP.
---
 src/debug.4th | 41 +++++++++++++++++++++++++++++++++++++++++
 src/forth.jl  | 22 +++++++++++++++-------
 src/lib.4th   | 12 +++++++++++-
 3 files changed, 67 insertions(+), 8 deletions(-)
 create mode 100644 src/debug.4th

diff --git a/src/debug.4th b/src/debug.4th
new file mode 100644
index 0000000..91ea3dd
--- /dev/null
+++ b/src/debug.4th
@@ -0,0 +1,41 @@
+: CFA>
+        LATEST @
+        BEGIN
+                ?DUP
+        WHILE
+                2DUP SWAP
+                < IF           
+                        NIP  
+                        EXIT
+                THEN
+                @ 
+        REPEAT
+        DROP
+        0
+;
+
+: DECIMAL  10 BASE ! ;
+: HEX  16 BASE ! ;
+
+: ID.
+        1+
+        DUP @
+        F_LENMASK AND 
+
+        BEGIN
+                DUP 0>
+        WHILE
+                SWAP 1+
+                DUP @ EMIT
+                SWAP 1-
+        REPEAT
+        2DROP
+;
+
+: name cfa> id. ;
+
+: [trace] immediate
+    trace ;
+
+\ : test 20 0 [trace] do 42 emit [trace] loop ;
+
diff --git a/src/forth.jl b/src/forth.jl
index 0803b72..766bd4e 100644
--- a/src/forth.jl
+++ b/src/forth.jl
@@ -121,7 +121,13 @@ function defPrim(f::Function; name="nameless")
     return -length(primitives)
 end
 
-callPrim(addr::Int64) = primitives[-addr]()
+function callPrim(addr::Int64)
+    if addr >=0 || -addr>length(primitives)
+        error("Attempted to execute non-existent primitive at address $addr.")
+    else
+        primitives[-addr]()
+    end
+end
 getPrimName(addr::Int64) = primNames[-addr]
 
 # Word creation functions
@@ -721,9 +727,9 @@ end)
 # Outer interpreter
 
 TRACE = defPrimWord("TRACE", () -> begin
-    println("Val: $(popPS())")
-    print("RS: "); printRS()
+    println("reg.W: $(reg.W) reg.IP: $(reg.IP)")
     print("PS: "); printPS()
+    print("RS: "); printRS()
     print("[paused]")
     readline()
 
@@ -936,9 +942,6 @@ IMMEDIATE = defPrimWord("IMMEDIATE", () -> begin
     return NEXT
 end, flags=F_IMMED)
 
-TICK = defWord("'",
-    [LIT, 32, WORD, FIND, TOCFA, EXIT])
-
 
 #### VM loop ####
 
@@ -950,7 +953,7 @@ elseif isfile(Pkg.dir("forth/src/lib.4th"))
     initFileName = Pkg.dir("forth/src/lib.4th")
 end
 
-function run(;initialize=false)
+function run(;initialize=true)
     # Begin with STDIN as source
     push!(sources, STDIN)
 
@@ -984,6 +987,11 @@ function run(;initialize=false)
                 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]
diff --git a/src/lib.4th b/src/lib.4th
index 68bb77b..c145b61 100644
--- a/src/lib.4th
+++ b/src/lib.4th
@@ -32,8 +32,9 @@
 
 : LITERAL IMMEDIATE ['] LIT , , ;
 
-: CHAR BL WORD 1+ @ ;
+: ' BL WORD FIND >CFA ;
 
+: CHAR BL WORD 1+ @ ;
 : [CHAR] IMMEDIATE
     CHAR
     ['] LIT , ,
@@ -147,11 +148,16 @@
 ;
 
 : +LOOP IMMEDIATE
+
+        trace
+
         ['] DUP , \ Store copy of increment
 
         ['] R> , ['] SWAP , ['] R> , ['] SWAP , ['] R> , ['] SWAP , ['] + , ['] 2DUP , ['] - ,
         ['] SWAP , ['] >R , ['] SWAP , ['] >R , ['] SWAP , ['] >R ,
 
+        trace
+
         \ Condition differently depending on sign of increment
         ['] SWAP , ['] 0>= , [COMPILE] IF
             ['] 0<= ,
@@ -159,12 +165,16 @@
             ['] 0> ,
         [COMPILE] THEN
 
+        trace
+
         \ Branch back to begining of loop kernel
         ['] 0BRANCH , HERE @ - ,
 
         \ Clean up
         ['] RDROP , ['] RDROP , ['] RDROP ,
 
+        trace
+
         \ Record address of loop end for any LEAVEs to use
         HERE @ SWAP !
 
-- 
2.20.1