module forth
-currentLine = ""
-currentPos = 0
-
-function nextLine()
- if eof(STDIN)
- return false
- else
- currentLine = readLine()
- currentPos = 1
- return true
- end
+RS = Array{Int64, 1}(1024)
+RSP = 0
+
+PS = Array{Int64, 1}(1024)
+PSP =0
+
+IP = 0
+W = 0
+X = 0
+
+jmp = 0
+
+primitives = Array{Expr,1}()
+memory = Array{Int64,1}(64*1024)
+latest = 0
+here = 1
+
+# Intperpreter state
+
+state = 0
+
+# Current radix
+
+base = 10
+
+# Input buffer
+
+tib_size = 4096
+tib = length(memory) - tib_size
+numtib = 0
+toin = 0
+
+# Stack manipulation functions
+
+function pushRS(val::Int64)
+ global RSP
+ RS[RSP += 1] = val
end
-function readPattern(pattern::Regex)
- m = match(pattern, currentLine)
- pos += length(m.match)
- return m.match
+function popRS()
+ global RSP
+ val = RS[RSP]
+ RSP -= 1
+ return val
end
-modes = Dict{AbstractString,Function}()
-mode = ""
+function pushPS(val::Int64)
+ global PSP
+ PS[PSP += 1] = val
+end
-function interpretPrimitive()
- if haskey(dict, word)
- dict[word]()
- return true
- else
- return false
+function popPS()
+ global PSP
+ val = PS[PSP]
+ PSP -= 1
+ return val
end
-interpretNonPrimitive() = false
-interpretNumber() = false
-
-modes["interpret"] = () -> begin
- getWord()
-
- if ! (interpretPrimitive() ||
- interpretNonPrimitive() ||
- interpretNumber())
- println("Error: unknown word '$word'.")
- end
+
+# Primitive creation and calling functions
+
+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
-function repl()
+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)
+
+SUBSTORE = defPrim("-!", quote
+ addr = popPS()
+ toSub = popPS()
+ memory[addr] -= toSub
+ jmp = NEXT
+end)
+
+
+# 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
+
+defConst("TIB", tib)
+defVar("#TIB", :numtib)
+defVar(">IN", :toin)
+
+KEY = defPrim("KEY", quote
+ if toin >= numtib
+
+ end
+
+ jmp = NEXT
+end)
+
+EMIT = defPrim("EMIT", quote
+
+ jmp = NEXT
+end)
+
+WORD = defPrim("WORD", quote
+
+ jmp = NEXT
+end)
+
+NUMBER = defPrim("NUMBER", quote
+
+ jmp = NEXT
+end)
- mode = "interpret"
- while mode != "stop"
- modes[mode]()
+#### VM loop ####
+jmp = NEXT
+function runVM()
+ while true
+ callPrim(jmp)
end
end