Fixed 2swap bug, added ?do, fixed +loop.

[forth.jl.git] / src / forth.jl

diff --git a/src/forth.jl b/src/forth.jl
index e2292e1..e7faf97 100644 (file)
--- a/src/forth.jl
+++ b/src/forth.jl
@@ -245,9 +245,9 @@ ROT = defPrimWord("ROT", () -> begin
     a = popPS()
     b = popPS()
     c = popPS()
+    pushPS(b)
     pushPS(a)
     pushPS(c)
-    pushPS(b)
     return NEXT
 end)
 
@@ -255,12 +255,13 @@ NROT = 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()
@@ -283,8 +284,17 @@ TWOSWAP = defPrimWord("2SWAP", () -> begin
     d = popPS()
     pushPS(b)
     pushPS(a)
-    pushPS(c)
     pushPS(d)
+    pushPS(c)
+    return NEXT
+end)
+
+TWOOVER = defPrimWord("2OVER", () -> begin
+    ensurePSDepth(4)
+    a = mem[reg.PSP-3]
+    b = mem[reg.PSP-2]
+    pushPS(a)
+    pushPS(b)
     return NEXT
 end)
 
@@ -351,6 +361,16 @@ DIVMOD = defPrimWord("/MOD", () -> begin
     return NEXT
 end)
 
+TWOMUL = defPrimWord("2*", () -> begin
+    pushPS(popPS() << 1)
+    return NEXT
+end)
+
+TWODIV = defPrimWord("2/", () -> begin
+    pushPS(popPS() >> 1)
+    return NEXT
+end)
+
 EQU = defPrimWord("=", () -> begin
     b = popPS()
     a = popPS()
@@ -834,12 +854,21 @@ EXECUTE = defPrimWord("EXECUTE", () -> begin
     return mem[reg.W]
 end)
 
+type ParseError <: Exception
+    wordName::ASCIIString
+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])
@@ -852,7 +881,7 @@ INTERPRET = defPrimWord("INTERPRET", () -> begin
         isImmediate = (mem[wordAddr+1] & F_IMMED) != 0
         callPrim(mem[TOCFA])
 
-        callPrim(mem[ROT]) # get rid of extra copy of word string details
+        callPrim(mem[NROT]) # get rid of extra copy of word string details
         popPS()
         popPS()
 
@@ -871,8 +900,7 @@ INTERPRET = defPrimWord("INTERPRET", () -> begin
         callPrim(mem[NUMBER])
 
         if popPS() != 0
-            println("Parse error at word: '$wordName'")
-            return NEXT
+            throw(ParseError(wordName))
         end
 
         if mem[STATE] == 0
@@ -952,11 +980,31 @@ CHAR = defPrimWord("CHAR", () -> begin
     return NEXT
 end)
 
+initialized = false
+initFileName = nothing
+if isfile("lib.4th")
+    initFileName = "lib.4th"
+elseif isfile(Pkg.dir("forth/src/lib.4th"))
+    initFileName = Pkg.dir("forth/src/lib.4th")
+end
+
+
 #### VM loop ####
-function run()
+function run(;initialize=true)
     # Begin with STDIN as source
     push!(sources, STDIN)
 
+    global initialized, initFileName
+    if !initialized && initialize
+        if initFileName != nothing
+            print("Including definitions from $initFileName...")
+            push!(sources, open(initFileName, "r"))
+            initialized = true
+        else
+            println("No library file found. Only primitive words available.")
+        end
+    end
+
     # Start with IP pointing to first instruction of outer interpreter
     reg.IP = QUIT + 1
 
@@ -965,14 +1013,24 @@ function run()
     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
             showerror(STDOUT, ex)
             println()
 
+            while !isempty(sources) && currentSource() != STDIN
+                close(pop!(sources))
+            end
+
+            mem[STATE] = 0
             mem[NUMTIB] = 0
+            reg.PSP = mem[PSP0]
+            reg.RSP = mem[RSP0]
             reg.IP = QUIT + 1
             jmp = NEXT
         end