X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=blobdiff_plain;f=src%2Fforth.jl;h=e2292e1416edc747733971d88a3ef85fc7239108;hb=ece6e5acc36b0b01b5abf93dde3858b37abd4874;hp=19e5965d420ae70e11f7d933d09857db5eeb5422;hpb=19b36fc0c147c5d98fe346ad62771fd615d137bb;p=forth.jl.git

diff --git a/src/forth.jl b/src/forth.jl
index 19e5965..e2292e1 100644
--- a/src/forth.jl
+++ b/src/forth.jl
@@ -55,27 +55,29 @@ 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, STDIN)
+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
 
@@ -114,7 +116,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
@@ -228,6 +230,7 @@ SWAP = defPrimWord("SWAP", () -> begin
 end)
 
 DUP = defPrimWord("DUP", () -> begin
+    ensurePSDepth(1)
     pushPS(mem[reg.PSP])
     return NEXT
 end)
@@ -514,6 +517,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
@@ -555,21 +563,26 @@ end)
 
 # I/O
 
+sources = Array{Any,1}()
+currentSource() = sources[length(sources)]
+
 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
 
-        if reg.source != STDIN && eof(reg.source)
-            reg.source = STDIN
+        if !eof(currentSource())
+            line = readline(currentSource())
+            mem[NUMTIB] = length(line)
+            putString(line, TIB)
+        else
+            mem[NUMTIB] = 1
+            mem[TIB] = EOF
         end
-
-        line = readline(reg.source)
-        mem[NUMTIB] = length(line)
-        putString(line, TIB)
     end
 
     pushPS(mem[TIB + mem[TOIN]])
@@ -584,8 +597,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
@@ -599,7 +613,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
@@ -615,7 +629,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)
@@ -631,7 +645,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
@@ -709,6 +723,23 @@ end)
 
 TODFA = defWord(">DFA", [TOCFA, INCR, EXIT])
 
+# Branching
+
+BRANCH = defPrimWord("BRANCH", () -> begin
+    reg.IP += mem[reg.IP]
+    return NEXT
+end)
+
+ZBRANCH = defPrimWord("0BRANCH", () -> begin
+    if (popPS() == 0)
+        reg.IP += mem[reg.IP]
+    else
+        reg.IP += 1
+    end
+
+    return NEXT
+end)
+
 # Compilation
 
 CREATE = defPrimWord("CREATE", () -> begin
@@ -771,24 +802,10 @@ IMMEDIATE = defPrimWord("IMMEDIATE", () -> begin
     return NEXT
 end, flags=F_IMMED)
 
-TICK = defWord("'", [WORD, FIND, TOCFA, EXIT])
-
-# Branching
-
-BRANCH = defPrimWord("BRANCH", () -> begin
-    reg.IP += mem[reg.IP]
-    return NEXT
-end)
-
-ZBRANCH = defPrimWord("0BRANCH", () -> begin
-    if (popPS() == 0)
-        reg.IP += mem[reg.IP]
-    else
-        reg.IP += 1
-    end
-
-    return NEXT
-end)
+TICK = defWord("'",
+    [STATE_CFA, FETCH, ZBRANCH, 7,
+    FROMR, DUP, INCR, TOR, FETCH, EXIT,
+    WORD, FIND, TOCFA, EXIT])
 
 # Strings
 
@@ -822,7 +839,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])
@@ -841,7 +858,6 @@ INTERPRET = defPrimWord("INTERPRET", () -> begin
 
         if mem[STATE] == 0 || isImmediate
             # Execute!
-            #println("Executing CFA at $(mem[reg.PSP])")
             return callPrim(mem[EXECUTE])
         else
             # Append CFA to dictionary
@@ -881,52 +897,85 @@ BYE = defPrimWord("BYE", () -> begin
     return 0
 end)
 
+PROMPT = defPrimWord("PROMPT", () -> begin
+    println(" ok")
+end)
+
 NL = defPrimWord("\n", () -> begin
-    if mem[STATE] == 0 && reg.source == STDIN
-        println(" ok")
+    if mem[STATE] == 0 && currentSource() == STDIN
+        callPrim(mem[PROMPT])
     end
     return NEXT
 end, flags=F_IMMED)
 
-# Odds and Ends
-
-CHAR = defPrimWord("CHAR", () -> begin
+INCLUDE = defPrimWord("INCLUDE", () -> begin
     callPrim(mem[WORD])
     wordLen = popPS()
     wordAddr = popPS()
     word = getString(wordAddr, wordLen)
-    pushPS(Int64(word[1]))
+
+    push!(sources, open(word, "r"))
+
+    # Clear input buffer
+    mem[NUMTIB] = 0
 
     return NEXT
 end)
 
-INCLUDE = defPrimWord("INCLUDE", () -> begin
+EOF_WORD = defPrimWord("\x04", () -> begin
+    if currentSource() != STDIN
+        close(currentSource())
+    end
 
+    pop!(sources)
+
+    if length(sources)>0
+        if currentSource() == STDIN
+            callPrim(mem[PROMPT])
+        end
+
+        return NEXT
+    else
+        return 0
+    end
+end, flags=F_IMMED)
+
+# Odds and Ends
+
+CHAR = defPrimWord("CHAR", () -> begin
     callPrim(mem[WORD])
     wordLen = popPS()
     wordAddr = popPS()
     word = getString(wordAddr, wordLen)
-
-    println("Reading from $word...")
-
-    reg.source = open(word, "r")
-
-    # Clear input buffer
-    mem[NUMTIB] = 0
+    pushPS(Int64(word[1]))
 
     return NEXT
 end)
 
 #### VM loop ####
 function run()
+    # Begin with STDIN as source
+    push!(sources, STDIN)
+
     # 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
+            showerror(STDOUT, ex)
+            println()
+
+            mem[NUMTIB] = 0
+            reg.IP = QUIT + 1
+            jmp = NEXT
+        end
     end
 end
 
@@ -993,4 +1042,13 @@ function printRS()
     end
 end
 
+DUMP = defPrimWord("DUMP", () -> begin
+    count = popPS()
+    addr = popPS()
+
+    dump(addr, count=count)
+
+    return NEXT
+end)
+
 end