From: Tim Vaughan <tgvaughan@gmail.com>
Date: Tue, 26 Apr 2016 12:16:47 +0000 (+1200)
Subject: DO LOOP LEAVE working
X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=commitdiff_plain;h=5328ad90af9699b87b0beee70aa7a7ee6a98e8a9;p=forth.jl.git

DO LOOP LEAVE working

rot/-rot bug is present!! Too tired to fix now.
---

diff --git a/src/forth.jl b/src/forth.jl
index 9c3f62e..0b4871f 100644
--- a/src/forth.jl
+++ b/src/forth.jl
@@ -241,26 +241,27 @@ OVER = defPrimWord("OVER", () -> begin
     return NEXT
 end)
 
-ROT = defPrimWord("ROT", () -> begin
+NROT = defPrimWord("-ROT", () -> begin
     a = popPS()
     b = popPS()
     c = popPS()
+    pushPS(b)
     pushPS(a)
     pushPS(c)
-    pushPS(b)
     return NEXT
 end)
 
-NROT = defPrimWord("-ROT", () -> begin
+ROT = defPrimWord("ROT", () -> begin
     a = popPS()
     b = popPS()
     c = popPS()
-    pushPS(b)
     pushPS(a)
     pushPS(c)
+    pushPS(b)
     return NEXT
 end)
 
+
 TWODROP = defPrimWord("2DROP", () -> begin
     popPS()
     popPS()
@@ -849,12 +850,16 @@ type ParseError <: Exception
 end
 Base.showerror(io::IO, ex::ParseError) = print(io, "Parse error at word: '$(ex.wordName)'.")
 
+DEBUG, DEBUG_CFA = defNewVar("DEBUG", 0)
+
 INTERPRET = defPrimWord("INTERPRET", () -> begin
 
     callPrim(mem[WORD])
 
     wordName = getString(mem[reg.PSP-1], mem[reg.PSP])
-    #println("... ", replace(replace(wordName, "\004", "EOF"), "\n", "\\n"), " ...")
+    if mem[DEBUG] != 0
+        println("... ", replace(replace(wordName, "\004", "EOF"), "\n", "\\n"), " ...")
+    end
 
     callPrim(mem[TWODUP])
     callPrim(mem[FIND])
@@ -999,7 +1004,10 @@ function run(;initialize=true)
     jmp = NEXT
     while jmp != 0
         try
-            #println("Evaluating prim ", jmp," ", primNames[-jmp])
+            if mem[DEBUG] != 0
+                println("Evaluating prim ", jmp," ", primNames[-jmp])
+            end
+
             jmp = callPrim(jmp)
 
         catch ex
diff --git a/src/lib.4th b/src/lib.4th
index ae4e60e..ff46f5f 100644
--- a/src/lib.4th
+++ b/src/lib.4th
@@ -45,6 +45,9 @@
         ,               \ compile it
 ;
 
+: DEBUGON TRUE DEBUG ! ;
+: DEBUGOFF FALSE DEBUG ! ;
+
 \ CONTROL STRUCTURES ----------------------------------------------------------------------
 
 : IF IMMEDIATE
@@ -107,24 +110,30 @@
 
 : DO IMMEDIATE
         ' >R , ' >R ,
+        ' LIT , HERE @ 0 , ' >R ,
         HERE @
 ;
 
-: I RSP@ 2- @ ;
+: I RSP@ 3 - @ ;
 
-: LOOP+ IMMEDIATE
-        ' R> , ' R> , ' -ROT , ' + , ' 2DUP , ' - ,
-        ' SWAP , ' >R , ' SWAP , ' >R ,
-        ' 0<= , ' 0BRANCH ,
-        HERE @ - ,
-        ' RDROP , ' RDROP ,
+: LEAVE IMMEDIATE
+        ' R> , ' RDROP , ' RDROP ,
+        ' LIT ,  HERE @ 7 + , ' DUP , ' ROT , ' - , ' SWAP , ' ! ,
+        ' BRANCH ,
+        0 ,
 ;
 
 : LOOP IMMEDIATE
-    ' LIT , 1 ,
-    [COMPILE] LOOP+
+        ' R> , ' R> , ' R> , ' 1+ , ' 2DUP , ' - ,
+        ' SWAP , ' >R , ' SWAP , ' >R , ' SWAP , ' >R ,
+        ' 0<= , ' 0BRANCH ,
+        HERE @ - ,
+        ' RDROP , ' RDROP , ' RDROP ,
+        HERE @ SWAP !
 ;
 
+: lt 10 0 do leave loop ;
+
 
 \ COMMENTS ----------------------------------------------------------------------