Added MAX and MIN

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

diff --git a/src/forth.jl b/src/forth.jl
index 78d8a53..9c3f62e 100644 (file)
--- a/src/forth.jl
+++ b/src/forth.jl
@@ -60,20 +60,24 @@ reg = Reg(mem[RSP0], mem[PSP0], 0, 0)
 
 # Stack manipulation functions
 
-type StackUnderflow <: Exception end
+type ParamStackUnderflow <: Exception end
+type ReturnStackUnderflow <: Exception end
+
+Base.showerror(io::IO, ex::ParamStackUnderflow) = print(io, "Parameter stack underflow.")
+Base.showerror(io::IO, ex::ReturnStackUnderflow) = print(io, "Return stack underflow.")
 
 getRSDepth() = reg.RSP - mem[RSP0]
 getPSDepth() = reg.PSP - mem[PSP0]
 
 function ensurePSDepth(depth::Int64)
     if getPSDepth()<depth
-        throw(StackUnderflow())
+        throw(ParamStackUnderflow())
     end
 end
 
 function ensureRSDepth(depth::Int64)
     if getRSDepth()<depth
-        throw(StackUnderflow())
+        throw(ReturnStackUnderflow())
     end
 end
 
@@ -347,6 +351,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()
@@ -513,6 +527,11 @@ FROMR = defPrimWord("R>", () -> begin
     return NEXT
 end)
 
+RFETCH = defPrimWord("R@", () -> begin
+    pushPS(mem[reg.RSP])
+    return NEXT
+end)
+
 RSPFETCH = defPrimWord("RSP@", () -> begin
     pushPS(reg.RSP)
     return NEXT
@@ -825,6 +844,11 @@ 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)'.")
+
 INTERPRET = defPrimWord("INTERPRET", () -> begin
 
     callPrim(mem[WORD])
@@ -862,8 +886,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
@@ -888,9 +911,13 @@ BYE = defPrimWord("BYE", () -> begin
     return 0
 end)
 
+PROMPT = defPrimWord("PROMPT", () -> begin
+    println(" ok")
+end)
+
 NL = defPrimWord("\n", () -> begin
     if mem[STATE] == 0 && currentSource() == STDIN
-        println(" ok")
+        callPrim(mem[PROMPT])
     end
     return NEXT
 end, flags=F_IMMED)
@@ -917,6 +944,10 @@ EOF_WORD = defPrimWord("\x04", () -> begin
     pop!(sources)
 
     if length(sources)>0
+        if currentSource() == STDIN
+            callPrim(mem[PROMPT])
+        end
+
         return NEXT
     else
         return 0
@@ -935,11 +966,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
 
@@ -952,15 +1003,17 @@ function run()
             jmp = callPrim(jmp)
 
         catch ex
-            if isa(ex, StackUnderflow)
-                println("Stack underflow!")
+            showerror(STDOUT, ex)
+            println()
 
-                mem[NUMTIB] = 0
-                reg.IP = QUIT + 1
-                jmp = NEXT
-            else
-                rethrow(ex)
+            while !isempty(sources) && currentSource() != STDIN
+                close(pop!(sources))
             end
+
+            mem[STATE] = 0
+            mem[NUMTIB] = 0
+            reg.IP = QUIT + 1
+            jmp = NEXT
         end
     end
 end
@@ -1028,16 +1081,6 @@ function printRS()
     end
 end
 
-DOT = defPrimWord(".", () -> begin
-    print(popPS())
-    return NEXT
-end)
-
-#DOTS = defPrimWord(".s", () -> begin
-#    printPS()
-#    return NEXT
-#end)
-
 DUMP = defPrimWord("DUMP", () -> begin
     count = popPS()
     addr = popPS()