Debugging DOCOL

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

diff --git a/src/forth.jl b/src/forth.jl
index abf6238..4b625bc 100644 (file)
--- a/src/forth.jl
+++ b/src/forth.jl
@@ -31,6 +31,7 @@ size_TIB = 1096  # Terminal input buffer size
 
 mem = Array{Int64,1}(size_mem)
 primitives = Array{Function,1}()
+primNames = Array{ASCIIString,1}()
 
 # Built-in variables
 
@@ -127,6 +128,8 @@ function defPrim(name::AbstractString, f::Function; flags::Int64=0)
     mem[codeWordAddr] = -length(primitives)
     mem[HERE] += 1
 
+    push!(primNames, name)
+
     return codeWordAddr
 end
 
@@ -584,6 +587,15 @@ WORD = defPrim("WORD", () -> begin
     wordAddr = mem[HERE]
     offset = 0
 
+    if c == '\n'
+        # Treat newline as a special word
+
+        mem[wordAddr + offset] = Int64(c)
+        pushPS(wordAddr)
+        pushPS(1)
+        return mem[NEXT]
+    end
+
     while true
         mem[wordAddr + offset] = Int64(c)
         offset += 1
@@ -592,6 +604,8 @@ WORD = defPrim("WORD", () -> begin
         c = Char(popPS())
 
         if c == ' ' || c == '\t' || c == '\n'
+            # Rewind KEY
+            mem[TOIN] -= 1
             break
         end
     end
@@ -627,7 +641,7 @@ FIND = defPrim("FIND", () -> begin
 
     wordLen = popPS()
     wordAddr = popPS()
-    word = getString(wordAddr, wordLen)
+    word = lowercase(getString(wordAddr, wordLen))
 
     latest = LATEST
     
@@ -642,9 +656,9 @@ FIND = defPrim("FIND", () -> begin
         end
         
         thisAddr = latest+2
-        thisWord = getString(thisAddr, len)
+        thisWord = lowercase(getString(thisAddr, len))
 
-        if thisWord == word
+        if lowercase(thisWord) == lowercase(word)
             break
         end
     end
@@ -773,19 +787,54 @@ end)
 INTERPRET = defPrim("INTERPRET", () -> begin
 
     callPrim(mem[WORD])
+
+    wordName = getString(mem[reg.PSP-1], mem[reg.PSP])
+    println("... ", replace(wordName, "\n", "\\n"), " ...")
+
+    callPrim(mem[TWODUP])
     callPrim(mem[FIND])
 
     wordAddr = mem[reg.PSP]
 
+
     if wordAddr>0
         # Word in dictionary
 
-        lenAndFlags = mem[wordAddr+1]
+        isImmediate = (mem[wordAddr+1] & F_IMMED) != 0
         callPrim(mem[TOCFA])
-        wordCFA = popPS()
 
+        callPrim(mem[ROT]) # get rid of extra copy of word string details
+        popPS()
+        popPS()
+
+        if mem[STATE] == 0 || isImmediate
+            # Execute!
+            return mem[popPS()]
+        else
+            # Append CFA to dictionary
+            callPrim(mem[COMMA])
+        end
     else
-        # Not in dictionary
+        # Not in dictionary, assume number
+
+        popPS()
+
+        callPrim(mem[NUMBER])
+
+        if popPS() != 0
+            println("Parse error at word: '$wordName'")
+            return mem[NEXT]
+        else
+        end
+
+        if mem[STATE] == 0
+            # Number already on stack!
+        else
+            # Append literal to dictionary
+            pushPS(LIT)
+            callPrim(mem[COMMA])
+            callPrim(mem[COMMA])
+        end
     end
 
     return mem[NEXT]
@@ -796,10 +845,44 @@ QUIT = defWord("QUIT",
     INTERPRET,
     BRANCH,-2])
 
+NL = defPrim("\n", () -> begin
+    if mem[STATE] == 0
+        println(" ok")
+    end
+    return mem[NEXT]
+end)
+
+# Odds and Ends
+
+CHAR = defPrim("CHAR", () -> begin
+    callPrim(mem[WORD])
+    wordLen = popPS()
+    wordAddr = popPS()
+    word = getString(wordAddr, wordLen)
+    pushPS(Int64(word[1]))
+
+    return mem[NEXT]
+end)
+
+EXECUTE = defPrim("EXECUTE", () -> begin
+    return mem[popPS()]
+end)
+
+BYE = defPrim("BYE", () -> begin
+    return 0
+end)
+
 #### VM loop ####
 function runVM()
+    # 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 = mem[NEXT]
-    while (jmp = callPrim(jmp)) != 0 end
+    while (jmp = callPrim(jmp)) != 0
+        println("Evaluating prim $jmp [$(primNames[-jmp])]")
+    end
 end
 
 # Debugging tools