Interpreter almost works!!!
[forth.jl.git] / src / forth.jl
index 01618f4..27f9dc3 100644 (file)
@@ -101,6 +101,13 @@ function popPS()
     return val
 end
 
+# Handy functions for adding/retrieving strings to/from memory.
+
+getString(addr::Int64, len::Int64) = ASCIIString([Char(c) for c in mem[addr:(addr+len-1)]])
+function putString(str::ASCIIString, addr::Int64)
+    mem[addr:(addr+length(str)-1)] = [Int64(c) for c in str]
+end
+
 # Primitive creation and calling functions
 
 function createHeader(name::AbstractString, flags::Int64)
@@ -109,7 +116,7 @@ function createHeader(name::AbstractString, flags::Int64)
     mem[HERE] += 1
 
     mem[mem[HERE]] = length(name) | flags; mem[HERE] += 1
-    mem[mem[HERE]:(mem[HERE]+length(name)-1)] = [Int(c) for c in name]; mem[HERE] += length(name)
+    putString(name, mem[HERE]); mem[HERE] += length(name)
 end
 
 function defPrim(name::AbstractString, f::Function; flags::Int64=0)
@@ -135,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))
@@ -144,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)
@@ -464,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
 
@@ -522,15 +530,15 @@ 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]
         mem[TOIN] = 0
         line = readline()
         mem[NUMTIB] = length(line)
-        mem[TIB:(TIB+mem[NUMTIB]-1)] = [Int64(c) for c in collect(line)]
+        putString(line, TIB)
     end
 
     pushPS(mem[TIB + mem[TOIN]])
@@ -601,7 +609,7 @@ NUMBER = defPrim("NUMBER", () -> begin
     wordLen = popPS()
     wordAddr = popPS()
 
-    s = ASCIIString([Char(c) for c in mem[wordAddr:(wordAddr+wordLen-1)]])
+    s = getString(wordAddr, wordLen)
 
     try
         pushPS(parse(Int64, s, mem[BASE]))
@@ -619,22 +627,22 @@ FIND = defPrim("FIND", () -> begin
 
     wordLen = popPS()
     wordAddr = popPS()
-    word = ASCIIString([Char(c) for c in mem[wordAddr:(wordAddr+wordLen-1)]])
+    word = getString(wordAddr, wordLen)
 
-    latest = mem[LATEST]
+    latest = LATEST
     
-    while latest>0
+    i = 0
+    while (latest = mem[latest]) > 0
         lenAndFlags = mem[latest+1]
         len = lenAndFlags & F_LENMASK
         hidden = (lenAndFlags & F_HIDDEN) == F_HIDDEN
 
         if hidden || len != wordLen
-            latest = mem[latest]
             continue
         end
         
         thisAddr = latest+2
-        thisWord = ASCIIString([Char(c) for c in mem[thisAddr:(thisAddr+len-1)]])
+        thisWord = getString(thisAddr, len)
 
         if thisWord == word
             break
@@ -659,9 +667,187 @@ end)
 
 TODFA = defWord(">DFA", [TOCFA, INCR, EXIT])
 
+# Compilation
+
+CREATE = defPrim("CREATE", () -> begin
+
+    wordLen = popPS()
+    wordAddr = popPS()
+    word = getString(wordAddr, wordLen)
+
+    createHeader(word, 0)
+
+    return mem[NEXT]
+end)
+
+COMMA = defPrim(",", () -> begin
+    mem[mem[HERE]] = popPS()
+    mem[HERE] += 1
+
+    return mem[NEXT]
+end)
+
+LBRAC = defPrim("[", () -> begin
+    mem[STATE] = 0
+    return mem[NEXT]
+end, flags=F_IMMED)
+
+RBRAC = defPrim("]", () -> begin
+    mem[STATE] = 1
+    return mem[NEXT]
+end, flags=F_IMMED)
+
+HIDDEN = defPrim("HIDDEN", () -> begin
+    addr = popPS() + 1
+    mem[addr] = mem[addr] $ F_HIDDEN
+    return mem[NEXT]
+end)
+
+HIDE = defWord("HIDE",
+    [WORD,
+    FIND,
+    HIDDEN,
+    EXIT])
+
+COLON = defWord(":",
+    [WORD,
+    CREATE,
+    LIT, DOCOL, COMMA,
+    LATEST, FETCH, HIDDEN,
+    RBRAC,
+    EXIT])
+
+SEMICOLON = defWord(";",
+    [LIT, EXIT, COMMA,
+    LATEST, FETCH, HIDDEN,
+    LBRAC,
+    EXIT], flags=F_IMMED)
+
+IMMEDIATE = defPrim("IMMEDIATE", () -> begin
+    lenAndFlagsAddr = mem[LATEST] + 1
+    mem[lenAndFlagsAddr] = mem[lenAndFlagsAddr] $ F_IMMED
+    return mem[NEXT]
+end, flags=F_IMMED)
+
+TICK = defWord("'", [WORD, FIND, TOCFA, EXIT])
+
+# Branching
+
+BRANCH = defPrim("BRANCH", () -> begin
+    reg.IP += mem[reg.IP]
+    return mem[NEXT]
+end)
+
+ZBRANCH = defPrim("0BRANCH", () -> begin
+    if (popPS() == 0)
+        reg.IP += mem[reg.IP]
+    else
+        reg.IP += 1
+    end
+
+    return mem[NEXT]
+end)
+
+# Strings
+
+LITSTRING = defPrim("LITSTRING", () -> begin
+    len = mem[reg.IP]
+    reg.IP += 1
+    pushPS(reg.IP)
+    pushPS(len)
+    reg.IP += len
+
+    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()
+        callPrim(mem[NUMBER])
+
+        if popPS() != 0
+            println("Parse error!")
+            return mem[NEXT]
+        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])
+
+# 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)
+
 #### VM loop ####
 function runVM()
-    jmp = NEXT
+    # 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
 
@@ -670,23 +856,33 @@ end
 function dump(startAddr::Int64; count::Int64 = 100, cellsPerLine::Int64 = 10)
     chars = Array{Char,1}(cellsPerLine)
 
-    for i in 0:(count-1)
-        addr = startAddr + i
-        if i%cellsPerLine == 0
-            print("$addr:")
-        end
-
-        print("\t$(mem[addr]) ")
+    lineStartAddr = cellsPerLine*div((startAddr-1),cellsPerLine) + 1
+    endAddr = startAddr + count - 1
+
+    q, r = divrem((endAddr-lineStartAddr+1), cellsPerLine)
+    numLines = q + (r > 0 ? 1 : 0)
+
+    i = lineStartAddr
+    for l in 1:numLines
+        print(i,":")
+
+        for c in 1:cellsPerLine
+            if i >= startAddr && i <= endAddr
+                print("\t",mem[i])
+                if mem[i]>=32 && mem[i]<128
+                    chars[c] = Char(mem[i])
+                else
+                    chars[c] = '.'
+                end
+            else
+                print("\t")
+                chars[c] = ' '
+            end
 
-        if (mem[addr]>=32 && mem[addr]<176)
-            chars[i%cellsPerLine + 1] = Char(mem[addr])
-        else
-            chars[i%cellsPerLine + 1] = '.'
+            i += 1
         end
 
-        if i%cellsPerLine == cellsPerLine-1
-            println(string("\t", ASCIIString(chars)))
-        end
+        println("\t", ASCIIString(chars))
     end
 end