added BYE and NL
[forth.jl.git] / src / forth.jl
index 91eea4f..3363ea7 100644 (file)
@@ -142,6 +142,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 +152,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 +472,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 +530,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 +584,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 +601,8 @@ WORD = defPrim("WORD", () -> begin
         c = Char(popPS())
 
         if c == ' ' || c == '\t' || c == '\n'
+            # Rewind KEY
+            mem[TOIN] -= 1
             break
         end
     end
@@ -626,7 +638,7 @@ FIND = defPrim("FIND", () -> begin
 
     wordLen = popPS()
     wordAddr = popPS()
-    word = getString(wordAddr, wordLen)
+    word = lowercase(getString(wordAddr, wordLen))
 
     latest = LATEST
     
@@ -641,9 +653,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,8 +771,106 @@ 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])
+    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()
+
+        wordName = getString(mem[reg.PSP-1], mem[reg.PSP])
+
+        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
+    println(" ok")
+    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
 end