X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=blobdiff_plain;f=src%2Fforth.jl;h=4b625bc146eb19cbcc36a51f6ab414789726645d;hb=03de266dbc3975cfa2f3b07de2d58ff642f4bf76;hp=91eea4f228e63f0cee7fc8d3b77806b6a4fc7f5a;hpb=1060539f1cf03aa9225443762bad93d384fb4f0a;p=forth.jl.git

diff --git a/src/forth.jl b/src/forth.jl
index 91eea4f..4b625bc 100644
--- 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
 
@@ -142,6 +145,7 @@ end
 function defNewVar(name::AbstractString, initial::Int64; flags::Int64=0)
     createHeader(name, flags)
     
+    codeWordAddr = mem[HERE]
     varAddr = mem[HERE] + 1
     push!(primitives, eval(:(() -> begin
         pushPS($(varAddr))
@@ -151,7 +155,7 @@ function defNewVar(name::AbstractString, initial::Int64; flags::Int64=0)
 
     mem[mem[HERE]] = initial; mem[HERE] += 1
 
-    return varAddr
+    return varAddr, codeWordAddr
 end
 
 function defConst(name::AbstractString, val::Int64; flags::Int64=0)
@@ -471,12 +475,12 @@ end)
 
 # Built-in variables
 
-defExistingVar("HERE", HERE)
-defExistingVar("LATEST", LATEST)
-defExistingVar("PSP0", PSP0)
-defExistingVar("RSP0", RSP0)
-STATE = defNewVar("STATE", 0)
-BASE = defNewVar("BASE", 10)
+HERE_CFA = defExistingVar("HERE", HERE)
+LATEST_CFA = defExistingVar("LATEST", LATEST)
+PSP0_CFA = defExistingVar("PSP0", PSP0)
+RSP0_CFA = defExistingVar("RSP0", RSP0)
+STATE, STATE_CFA = defNewVar("STATE", 0)
+BASE, BASE_CFA = defNewVar("BASE", 10)
 
 # Constants
 
@@ -529,8 +533,8 @@ end)
 # I/O
 
 defConst("TIB", TIB)
-NUMTIB = defNewVar("#TIB", 0)
-TOIN = defNewVar(">IN", 0)
+NUMTIB, NUMTIB_CFA = defNewVar("#TIB", 0)
+TOIN, TOIN_CFA = defNewVar(">IN", 0)
 
 KEY = defPrim("KEY", () -> begin
     if mem[TOIN] >= mem[NUMTIB]
@@ -583,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
@@ -591,6 +604,8 @@ WORD = defPrim("WORD", () -> begin
         c = Char(popPS())
 
         if c == ' ' || c == '\t' || c == '\n'
+            # Rewind KEY
+            mem[TOIN] -= 1
             break
         end
     end
@@ -626,7 +641,7 @@ FIND = defPrim("FIND", () -> begin
 
     wordLen = popPS()
     wordAddr = popPS()
-    word = getString(wordAddr, wordLen)
+    word = lowercase(getString(wordAddr, wordLen))
 
     latest = LATEST
     
@@ -641,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
@@ -759,10 +774,115 @@ LITSTRING = defPrim("LITSTRING", () -> begin
     return mem[NEXT]
 end)
 
+TELL = defPrim("TELL", () -> begin
+    len = popPS()
+    addr = popPS()
+    str = getString(addr, len)
+    print(str)
+    return mem[NEXT]
+end)
+
+# Outer interpreter
+
+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
+
+        isImmediate = (mem[wordAddr+1] & F_IMMED) != 0
+        callPrim(mem[TOCFA])
+
+        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, 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]
+end)
+
+QUIT = defWord("QUIT",
+    [RSP0_CFA, RSPSTORE,
+    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