Sensible recovery from stack underflows.

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

diff --git a/src/forth.jl b/src/forth.jl
index 5ced825..b1a78f3 100644 (file)
--- a/src/forth.jl
+++ b/src/forth.jl
@@ -26,8 +26,8 @@ size_TIB = 1096  # Terminal input buffer size
 # the dictionary.
 #
 # Simple linear addressing is used with one exception: references to primitive code
-# blocks, which are represented as anonymous functions, appear the negative index
-# into the primitives array which contains only these functions.
+# blocks, which are represented as anonymous functions, appear as negative indicies
+# into the primitives array which contains these functions.
 
 mem = Array{Int64,1}(size_mem)
 primitives = Array{Function,1}()
@@ -55,10 +55,12 @@ type Reg
     PSP::Int64  # Parameter/data stack pointer
     IP::Int64   # Instruction pointer
     W::Int64    # Working register
+
+    source::Any # Input stream in use
 end
-reg = Reg(mem[RSP0], mem[PSP0], 0, 0)
+reg = Reg(mem[RSP0], mem[PSP0], 0, 0, STDIN)
 
-# Stack manipulation
+# Stack manipulation functions
 
 type StackUnderflow <: Exception end
 
@@ -112,7 +114,7 @@ end
 
 function defPrim(f::Function; name="nameless")
     push!(primitives, f)
-    push!(primNames, name)
+    push!(primNames, replace(replace(name, "\004", "EOF"), "\n", "\\n"))
 
     return -length(primitives)
 end
@@ -226,6 +228,7 @@ SWAP = defPrimWord("SWAP", () -> begin
 end)
 
 DUP = defPrimWord("DUP", () -> begin
+    ensurePSDepth(1)
     pushPS(mem[reg.PSP])
     return NEXT
 end)
@@ -556,13 +559,20 @@ end)
 defConst("TIB", TIB)
 NUMTIB, NUMTIB_CFA = defNewVar("#TIB", 0)
 TOIN, TOIN_CFA = defNewVar(">IN", 0)
+EOF = defConst("EOF", 4)
 
 KEY = defPrimWord("KEY", () -> begin
     if mem[TOIN] >= mem[NUMTIB]
         mem[TOIN] = 0
-        line = readline()
-        mem[NUMTIB] = length(line)
-        putString(line, TIB)
+
+        if !eof(reg.source)
+            line = readline(reg.source)
+            mem[NUMTIB] = length(line)
+            putString(line, TIB)
+        else
+            mem[NUMTIB] = 1
+            mem[TIB] = EOF
+        end
     end
 
     pushPS(mem[TIB + mem[TOIN]])
@@ -577,8 +587,9 @@ EMIT = defPrimWord("EMIT", () -> begin
 end)
 
 WORD = defPrimWord("WORD", () -> begin
-    
-    c = -1
+
+    eof_char = Char(EOF)
+    c = eof_char
 
     skip_to_end = false
     while true
@@ -592,7 +603,7 @@ WORD = defPrimWord("WORD", () -> begin
         end
 
         if skip_to_end
-            if c == '\n'
+            if c == '\n' || c == eof_char
                 skip_to_end = false
             end
             continue
@@ -608,7 +619,7 @@ WORD = defPrimWord("WORD", () -> begin
     wordAddr = mem[HERE]
     offset = 0
 
-    if c == '\n'
+    if c == '\n' || c == eof_char
         # Treat newline as a special word
 
         mem[wordAddr + offset] = Int64(c)
@@ -624,7 +635,7 @@ WORD = defPrimWord("WORD", () -> begin
         callPrim(mem[KEY])
         c = Char(popPS())
 
-        if c == ' ' || c == '\t' || c == '\n'
+        if c == ' ' || c == '\t' || c == '\n' || c == eof_char
             # Rewind KEY
             mem[TOIN] -= 1
             break
@@ -815,7 +826,7 @@ INTERPRET = defPrimWord("INTERPRET", () -> begin
     callPrim(mem[WORD])
 
     wordName = getString(mem[reg.PSP-1], mem[reg.PSP])
-    #println("... ", replace(wordName, "\n", "\\n"), " ...")
+    #println("... ", replace(replace(wordName, "\004", "EOF"), "\n", "\\n"), " ...")
 
     callPrim(mem[TWODUP])
     callPrim(mem[FIND])
@@ -870,13 +881,42 @@ QUIT = defWord("QUIT",
     INTERPRET,
     BRANCH,-2])
 
+BYE = defPrimWord("BYE", () -> begin
+    return 0
+end)
+
 NL = defPrimWord("\n", () -> begin
-    if mem[STATE] == 0
+    if mem[STATE] == 0 && reg.source == STDIN
         println(" ok")
     end
     return NEXT
 end, flags=F_IMMED)
 
+INCLUDE = defPrimWord("INCLUDE", () -> begin
+
+    callPrim(mem[WORD])
+    wordLen = popPS()
+    wordAddr = popPS()
+    word = getString(wordAddr, wordLen)
+
+    reg.source = open(word, "r")
+
+    # Clear input buffer
+    mem[NUMTIB] = 0
+
+    return NEXT
+end)
+
+EOF_WORD = defPrimWord("\x04", () -> begin
+    if reg.source == STDIN
+        return 0
+    else
+        close(reg.source)
+        reg.source = STDIN
+        return NEXT
+    end
+end, flags=F_IMMED)
+
 # Odds and Ends
 
 CHAR = defPrimWord("CHAR", () -> begin
@@ -889,20 +929,28 @@ CHAR = defPrimWord("CHAR", () -> begin
     return NEXT
 end)
 
-BYE = defPrimWord("BYE", () -> begin
-    return 0
-end)
-
 #### VM loop ####
-function runVM()
+function run()
     # Start with IP pointing to first instruction of outer interpreter
     reg.IP = QUIT + 1
 
     # Primitive processing loop.
     # Everyting else is simply a consequence of this loop!
     jmp = NEXT
-    while (jmp = callPrim(jmp)) != 0
-        #println("Evaluating prim $jmp [$(primNames[-jmp])]")
+    while jmp != 0
+        try
+            #println("Evaluating prim $jmp $(primNames[-jmp])")
+            jmp = callPrim(jmp)
+
+        catch ex
+            if isa(ex, StackUnderflow)
+                println("Stack underflow!")
+
+                mem[NUMTIB] = 0
+                reg.IP = QUIT + 1
+                jmp = NEXT
+            end
+        end
     end
 end