Renamed CREATE to HEADER in prep for true CREATE/DOES>

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

diff --git a/src/forth.jl b/src/forth.jl
index bba6a98..64d2d23 100644 (file)
--- a/src/forth.jl
+++ b/src/forth.jl
@@ -123,7 +123,7 @@ end
 
 callPrim(addr::Int64) = primitives[-addr]()
 
-# Word creation
+# Word creation functions
 
 function createHeader(name::AbstractString, flags::Int64)
     mem[mem[HERE]] = mem[LATEST]
@@ -159,7 +159,7 @@ function defWord(name::AbstractString, wordAddrs::Array{Int64,1}; flags::Int64=0
     return addr
 end
 
-# Variable creation
+# Variable creation functions
 
 function defExistingVar(name::AbstractString, varAddr::Int64; flags::Int64=0)
 
@@ -175,22 +175,17 @@ function defNewVar(name::AbstractString, initial::Int64; flags::Int64=0)
     codeWordAddr = mem[HERE]
     varAddr = mem[HERE] + 1
 
-    f = eval(:(() -> begin
-        pushPS($(varAddr))
-        return NEXT
-    end))
-
-    mem[mem[HERE]] = defPrim(f, name=name); mem[HERE] += 1
+    mem[mem[HERE]] = DOVAR; mem[HERE] += 1
     mem[mem[HERE]] = initial; mem[HERE] += 1
 
     return varAddr, codeWordAddr
 end
 
 function defConst(name::AbstractString, val::Int64; flags::Int64=0)
-    defPrimWord(name, eval(:(() -> begin
-        pushPS($(val))
-        return NEXT
-    end)))
+    createHeader(name, flags)
+
+    mem[mem[HERE]] = DOCON; mem[HERE] += 1
+    mem[mem[HERE]] = val; mem[HERE] += 1
 
     return val
 end
@@ -209,6 +204,16 @@ DOCOL = defPrim(() -> begin
     return NEXT
 end, name="DOCOL")
 
+DOVAR = defPrim(() -> begin
+    pushPS(reg.W + 1)
+    return NEXT
+end, name="DOVAR")
+
+DOCON = defPrim(() -> begin
+    pushPS(mem[reg.W + 1])
+    return NEXT
+end, name="DOVAR")
+
 EXIT = defPrimWord("EXIT", () -> begin
     reg.IP = popRS()
     return NEXT
@@ -284,8 +289,17 @@ TWOSWAP = defPrimWord("2SWAP", () -> begin
     d = popPS()
     pushPS(b)
     pushPS(a)
-    pushPS(c)
     pushPS(d)
+    pushPS(c)
+    return NEXT
+end)
+
+TWOOVER = defPrimWord("2OVER", () -> begin
+    ensurePSDepth(4)
+    a = mem[reg.PSP-3]
+    b = mem[reg.PSP-2]
+    pushPS(a)
+    pushPS(b)
     return NEXT
 end)
 
@@ -509,9 +523,12 @@ BASE, BASE_CFA = defNewVar("BASE", 10)
 
 # Constants
 
-defConst("VERSION", 1)
 defConst("DOCOL", DOCOL)
+defConst("DOCON", DOCON)
+defConst("DOVAR", DOVAR)
+
 defConst("DICT", DICT)
+
 F_IMMED = defConst("F_IMMED", 128)
 F_HIDDEN = defConst("F_HIDDEN", 256)
 F_LENMASK = defConst("F_LENMASK", 127)
@@ -753,7 +770,7 @@ end)
 
 # Compilation
 
-CREATE = defPrimWord("CREATE", () -> begin
+HEADER = defPrimWord("HEADER", () -> begin
 
     wordLen = popPS()
     wordAddr = popPS()
@@ -795,7 +812,7 @@ HIDE = defWord("HIDE",
 
 COLON = defWord(":",
     [WORD,
-    CREATE,
+    HEADER,
     LIT, DOCOL, COMMA,
     LATEST_CFA, FETCH, HIDDEN,
     RBRAC,
@@ -814,9 +831,11 @@ IMMEDIATE = defPrimWord("IMMEDIATE", () -> begin
 end, flags=F_IMMED)
 
 TICK = defWord("'",
-    [STATE_CFA, FETCH, ZBRANCH, 7,
-    FROMR, DUP, INCR, TOR, FETCH, EXIT,
-    WORD, FIND, TOCFA, EXIT])
+    [WORD, FIND, TOCFA, EXIT])
+
+BTICK = defWord("[']",
+    [FROMR, DUP, INCR, TOR, FETCH, EXIT])
+
 
 # Strings
 
@@ -1020,6 +1039,8 @@ function run(;initialize=true)
 
             mem[STATE] = 0
             mem[NUMTIB] = 0
+            reg.PSP = mem[PSP0]
+            reg.RSP = mem[RSP0]
             reg.IP = QUIT + 1
             jmp = NEXT
         end