Doing my head in!

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

diff --git a/src/forth.jl b/src/forth.jl
index 7f5756e..aac4c2a 100644 (file)
--- a/src/forth.jl
+++ b/src/forth.jl
@@ -1,93 +1,239 @@
 module forth
 
-instream = STDIN
+RS = Array{Int64, 1}(1024)
+RSP = 0
 
-currentLine = ""
-currentPos = 0
+PS = Array{Int64, 1}(1024)
+PSP =0
 
-function readPattern(pattern::Regex)
+IP = 0
+W = 0
+X = 0
 
-    if currentPos<1 || currentPos>length(currentLine)
-        if eof(instream)
-            return ""
-        else
-            global currentLine = readline(instream)
-            global currentPos = 1
-        end
-    end
+jmp = 0
 
-    m = match(pattern, currentLine[currentPos:length(currentLine)])
-    if m != nothing
-        global currentPos += length(m.match)
-        return m.match
-    else
-        return ""
-    end
-end
+primitives = Array{Expr,1}()
+memory = Array{Int64,1}(64*1024)
+LATEST = 0
+HERE = 1
 
-readSpaces() = readPattern(r"^([ \t]*)")
-readWord() = readPattern(r"^([^\s]+)")
-readNewline() = readPattern(r"^(\n)")
-readRestOfLine() = readPattern(r"^([^\n]*)")
+# Intperpreter state
 
-word = ""
-function getWordOrNewline()
-    global word = readWord()
-    if word == ""
-        global word = readNewline()
-    end
-end
+STATE = 0
+
+# Current radix
+
+BASE = 10
 
-modes = Dict{AbstractString,Function}()
-mode = ""
+# Stack manipulation functions
 
-dict = Dict{AbstractString, Function}()
-dict["%J"] = () -> begin
-    rol = readRestOfLine()
-    println("Evaluating '$rol'")
-    eval(parse(rol))
+function pushRS(val::Int64)
+    global RSP
+    RS[RSP += 1] = val
 end
 
-function interpretPrimitive()
-    if haskey(dict, word)
-        dict[word]()
-        return true
-    else
-        return false
-    end
+function popRS()
+    global RSP
+    val = RS[RSP]
+    RSP -= 1
+    return val
 end
-interpretNonPrimitive() = false
-interpretNumber() = false
 
-modes["interpret"] = () -> begin
-    getWordOrNewline()
+function pushPS(val::Int64)
+    global PSP
+    PS[PSP += 1] = val
+end
 
-    if ! (interpretPrimitive() ||
-        interpretNonPrimitive() ||
-        interpretNumber())
-        println("Error: unknown word '$word'.")
-    end
+function popPS()
+    global PSP
+    val = PS[PSP]
+    PSP -= 1
+    return val
 end
 
-function repl()
+# Primitive creation and calling functions
 
-    global mode = "interpret"
-    idx = 1
-    while mode != "stop"
-        modes[mode]()
-    end
+function defPrim(name::AbstractString, expr::Expr)
+    global HERE, LATEST
+
+    memory[HERE] = LATEST
+    LATEST = HERE
+    HERE += 1
+
+    memory[HERE] = length(name); HERE += 1
+    memory[HERE:(HERE+length(name)-1)] = [Int(c) for c in name]; HERE += length(name)
+
+    push!(primitives, expr)
+    memory[HERE] = -length(primitives)
+    HERE += 1
+
+    return -length(primitives)
 end
 
-# Bootstrapping interpreter
+defVar(name::AbstractString, var::Symbol) = defPrim(name, quote
+    pushPS($var)
+    jmp = NEXT
+end)
+
+defConst(name::AbstractString, val::Int64) = defPrim(name, quote
+    pushPS($val)
+    jmp = Next
+end)
+
+callPrim(addr::Int64) = eval(primitives[-addr])
+
+# Threading Primitives
+
+NEXT = defPrim("NEXT", quote
+    W = memory[IP]
+    IP += 1
+    X = memory[W]
+    jmp = X
+end)
+
+DOCOL = defPrim("DOCOL", quote
+    pushRS(IP)
+    IP = W + 1
+    jmp = NEXT
+end)
+
+EXIT = defPrim("EXIT", quote
+    IP = popRS()
+    jmp = NEXT
+end)
+
+
+# Basic forth primitives
+
+DROP = defPrim("DROP", quote
+    popPS()
+    jmp = NEXT
+end)
+
+SWAP = defPrim("SWAP", quote
+    PS[PSP], PS[PSP-1] = PS[PSP-1], PS[PS]
+    jmp = NEXT
+end)
+
+DUP = defPrim("DUP", quote
+    pushPS(PS[PSP])
+    jmp = NEXT
+end)
+
+LIT = defPrim("LIT", quote
+    pushPS(memory[IP])
+    IP += 1
+    jmp = NEXT
+end)
+
+# Memory primitives
+
+STORE = defPrim("!", quote
+    addr = popPS()
+    dat = popPS()
+    memory[addr] = dat
+    jmp = NEXT
+end)
+
+FETCH = defPrim("@", quote
+    addr = popPS()
+    pushPS(memory[addr])
+    jmp = NEXT
+end)
+
+ADDSTORE = defPrim("+!", quote
+    addr = popPS()
+    toAdd = popPS()
+    memory[addr] += toAdd
+    jmp = NEXT
+end)
 
-firstProg = """%J dict["\\n"] = () -> nothing
-%J dict["\\n"] = () -> nothing
-%J dict[""] = () -> global mode = "stop"
-%J global DS = []
-%J global RS = []
-"""
+SUBSTORE = defPrim("-!", quote
+    addr = popPS()
+    toSub = popPS()
+    memory[addr] -= toSub
+    jmp = NEXT
+end)
 
-instream = IOBuffer(firstProg)
-repl()
+
+# Built-in variables
+
+defVar("STATE", :STATE)
+defVar("HERE", :HERE)
+defVar("LATEST", :LATEST)
+defVAR("BASE", :BASE)
+
+# Constants
+
+defConst("VERSION", 1)
+defConst("DOCOL", DOCOL)
+
+# Return Stack
+
+TOR = defPrim(">R", quote
+    pushRS(popPS())
+    jmp = NEXT
+end)
+
+FROMR = defPrim("R>", quote
+    pushPS(popRS())
+end)
+
+RSPFETCH = defPrim("RSP@", quote
+    pushPS(RSP)
+    jmp = NEXT
+end)
+
+RSPSTORE = defPrim("RSP!", quote
+    RSP = popPS()
+    jmp = NEXT
+end)
+
+RDROP = defPrim("RDROP", quote
+    popRS()
+    jmp = NEXT
+end)
+
+# Parameter Stack
+
+PSPFETCH = defPrim("PSP@", quote
+    pushPS(PSP)
+    jmp = NEXT
+end)
+
+PSPSTORE = defPrim("PSP!", quote
+    PSP = popPS()
+    jmp = NEXT
+end)
+
+# I/O
+
+KEY = defPrim("KEY", quote
+
+    jmp = NEXT
+end)
+
+EMIT = defPrim("EMIT", quote
+
+    jmp = NEXT
+end)
+
+WORD = defPrim("WORD", quote
+
+    jmp = NEXT
+end)
+
+NUMBER = defPrim("NUMBER", quote
+
+    jmp = NEXT
+end)
+
+#### VM loop ####
+jmp = NEXT
+function runVM()
+    while true
+        callPrim(jmp)
+    end
+end
 
 end