Doing my head in!

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

diff --git a/src/forth.jl b/src/forth.jl
index f35d212..aac4c2a 100644 (file)
--- a/src/forth.jl
+++ b/src/forth.jl
@@ -25,7 +25,7 @@ STATE = 0
 
 BASE = 10
 
-# Stack manipulation macros
+# Stack manipulation functions
 
 function pushRS(val::Int64)
     global RSP
@@ -51,7 +51,7 @@ function popPS()
     return val
 end
 
-# Primitive creation functions
+# Primitive creation and calling functions
 
 function defPrim(name::AbstractString, expr::Expr)
     global HERE, LATEST
@@ -65,80 +65,95 @@ function defPrim(name::AbstractString, expr::Expr)
 
     push!(primitives, expr)
     memory[HERE] = -length(primitives)
-    codeword = HERE
     HERE += 1
 
-    return codeword
+    return -length(primitives)
 end
 
-function defVar(name::AbstractString, var::Expr)
-    defPrim(name, Expr(:call, :pushPS, var))
-end
+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", :(begin
+NEXT = defPrim("NEXT", quote
     W = memory[IP]
     IP += 1
     X = memory[W]
     jmp = X
-end))
+end)
 
-DOCOL = defPrim("DOCOL", :(begin
+DOCOL = defPrim("DOCOL", quote
     pushRS(IP)
     IP = W + 1
     jmp = NEXT
-end))
+end)
 
-EXIT = defPrim("EXIT", :(begin
+EXIT = defPrim("EXIT", quote
     IP = popRS()
     jmp = NEXT
-end))
+end)
 
 
 # Basic forth primitives
 
-DROP = defPrim("DROP", :(begin
+DROP = defPrim("DROP", quote
     popPS()
-end))
+    jmp = NEXT
+end)
 
-SWAP = defPrim("SWAP", :(begin
+SWAP = defPrim("SWAP", quote
     PS[PSP], PS[PSP-1] = PS[PSP-1], PS[PS]
-end))
+    jmp = NEXT
+end)
 
-DUP = defPrim("DUP", :(begin
+DUP = defPrim("DUP", quote
     pushPS(PS[PSP])
-end))
+    jmp = NEXT
+end)
 
-LIT = defPrim("LIT", :(begin
+LIT = defPrim("LIT", quote
     pushPS(memory[IP])
     IP += 1
-end))
+    jmp = NEXT
+end)
 
 # Memory primitives
 
-STORE = defPrim("!", :(begin
+STORE = defPrim("!", quote
     addr = popPS()
     dat = popPS()
     memory[addr] = dat
-end))
+    jmp = NEXT
+end)
 
-FETCH = defPrim("@", :(begin
+FETCH = defPrim("@", quote
     addr = popPS()
     pushPS(memory[addr])
-end))
+    jmp = NEXT
+end)
 
-ADDSTORE = defPrim("+!", :(begin
+ADDSTORE = defPrim("+!", quote
     addr = popPS()
     toAdd = popPS()
     memory[addr] += toAdd
-end))
+    jmp = NEXT
+end)
 
-SUBSTORE = defPrim("-!", :(begin
+SUBSTORE = defPrim("-!", quote
     addr = popPS()
     toSub = popPS()
     memory[addr] -= toSub
-end))
+    jmp = NEXT
+end)
 
 
 # Built-in variables
@@ -146,18 +161,78 @@ end))
 defVar("STATE", :STATE)
 defVar("HERE", :HERE)
 defVar("LATEST", :LATEST)
-defVAR("PSP", :PSP)
 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
+#### VM loop ####
 jmp = NEXT
 function runVM()
     while true
-        eval(primitives[-memory[jmp]])
+        callPrim(jmp)
     end
 end