X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=blobdiff_plain;f=src%2Fforth.jl;h=80f6b76b9fc07eaa7e87f6591303e65b3842e68b;hb=d75b27e59e0ea50e52018239a74e1edc831219f7;hp=134b6516753e1dab85b687fdbe21ff56361fa1bf;hpb=dfc28eefbcea7eb34cf9c1e0df010322b291c40a;p=forth.jl.git

diff --git a/src/forth.jl b/src/forth.jl
index 134b651..80f6b76 100644
--- a/src/forth.jl
+++ b/src/forth.jl
@@ -36,18 +36,16 @@ primNames = Array{ASCIIString,1}()
 # Built-in variables
 
 nextVarAddr = 1
-RSP0 = nextVarAddr; nextVarAddr += 1
-PSP0 = nextVarAddr; nextVarAddr += 1
-HERE = nextVarAddr; nextVarAddr += 1
+H = nextVarAddr; nextVarAddr += 1
 LATEST = nextVarAddr; nextVarAddr += 1
 
-mem[RSP0] = nextVarAddr              # bottom of RS
-mem[PSP0] = mem[RSP0] + size_RS      # bottom of PS
-TIB = mem[PSP0] + size_PS            # address of terminal input buffer
-mem[HERE] = TIB + size_TIB           # location of bottom of dictionary
-mem[LATEST] = 0                      # no previous definition
+RSP0 = nextVarAddr                  # bottom of RS
+PSP0 = RSP0 + size_RS               # bottom of PS
+TIB = PSP0 + size_PS                # address of terminal input buffer
+mem[H] = TIB + size_TIB          # location of bottom of dictionary
+mem[LATEST] = 0                     # no previous definition
 
-DICT = mem[HERE] # Save bottom of dictionary as constant
+DICT = mem[H] # Save bottom of dictionary as constant
 
 # VM registers
 type Reg
@@ -56,7 +54,7 @@ type Reg
     IP::Int64   # Instruction pointer
     W::Int64    # Working register
 end
-reg = Reg(mem[RSP0], mem[PSP0], 0, 0)
+reg = Reg(RSP0, PSP0, 0, 0)
 
 # Stack manipulation functions
 
@@ -66,8 +64,8 @@ type ReturnStackUnderflow <: Exception end
 Base.showerror(io::IO, ex::ParamStackUnderflow) = print(io, "Parameter stack underflow.")
 Base.showerror(io::IO, ex::ReturnStackUnderflow) = print(io, "Return stack underflow.")
 
-getRSDepth() = reg.RSP - mem[RSP0]
-getPSDepth() = reg.PSP - mem[PSP0]
+getRSDepth() = reg.RSP - RSP0
+getPSDepth() = reg.PSP - PSP0
 
 function ensurePSDepth(depth::Int64)
     if getPSDepth()<depth
@@ -138,20 +136,20 @@ F_HIDDEN = 256
 F_LENMASK = 127
 
 function createHeader(name::AbstractString, flags::Int64)
-    mem[mem[HERE]] = mem[LATEST]
-    mem[LATEST] = mem[HERE]
-    mem[HERE] += 1
+    mem[mem[H]] = mem[LATEST]
+    mem[LATEST] = mem[H]
+    mem[H] += 1
 
-    mem[mem[HERE]] = length(name) | flags; mem[HERE] += 1
-    putString(name, mem[HERE]); mem[HERE] += length(name)
+    mem[mem[H]] = length(name) | flags; mem[H] += 1
+    putString(name, mem[H]); mem[H] += length(name)
 end
 
 function defPrimWord(name::AbstractString, f::Function; flags::Int64=0)
     createHeader(name, flags)
 
-    codeWordAddr = mem[HERE]
+    codeWordAddr = mem[H]
     mem[codeWordAddr] = defPrim(f, name=name)
-    mem[HERE] += 1
+    mem[H] += 1
 
     return codeWordAddr
 end
@@ -159,13 +157,13 @@ end
 function defWord(name::AbstractString, wordAddrs::Array{Int64,1}; flags::Int64=0)
     createHeader(name, flags)
 
-    addr = mem[HERE]
-    mem[mem[HERE]] = DOCOL
-    mem[HERE] += 1
+    addr = mem[H]
+    mem[mem[H]] = DOCOL
+    mem[H] += 1
 
     for wordAddr in wordAddrs
-        mem[mem[HERE]] = wordAddr
-        mem[HERE] += 1
+        mem[mem[H]] = wordAddr
+        mem[H] += 1
     end
 
     return addr
@@ -184,11 +182,11 @@ end
 function defNewVar(name::AbstractString, initial::Int64; flags::Int64=0)
     createHeader(name, flags)
     
-    codeWordAddr = mem[HERE]
-    varAddr = mem[HERE] + 1
+    codeWordAddr = mem[H]
+    varAddr = mem[H] + 1
 
-    mem[mem[HERE]] = DOVAR; mem[HERE] += 1
-    mem[mem[HERE]] = initial; mem[HERE] += 1
+    mem[mem[H]] = DOVAR; mem[H] += 1
+    mem[mem[H]] = initial; mem[H] += 1
 
     return varAddr, codeWordAddr
 end
@@ -196,10 +194,10 @@ end
 function defConst(name::AbstractString, val::Int64; flags::Int64=0)
     createHeader(name, flags)
 
-    codeWordAddr = mem[HERE]
+    codeWordAddr = mem[H]
 
-    mem[mem[HERE]] = DOCON; mem[HERE] += 1
-    mem[mem[HERE]] = val; mem[HERE] += 1
+    mem[mem[H]] = DOCON; mem[H] += 1
+    mem[mem[H]] = val; mem[H] += 1
 
     return codeWordAddr
 end
@@ -235,10 +233,11 @@ end)
 
 # Dictionary entries for core built-in variables, constants
 
-HERE_CFA = defExistingVar("HERE", HERE)
+H_CFA = defExistingVar("H", H)
 LATEST_CFA = defExistingVar("LATEST", LATEST)
-PSP0_CFA = defExistingVar("PSP0", PSP0)
-RSP0_CFA = defExistingVar("RSP0", RSP0)
+
+PSP0_CFA = defConst("PSP0", PSP0)
+RSP0_CFA = defConst("RSP0", RSP0)
 
 defConst("DOCOL", DOCOL)
 defConst("DOCON", DOCON)
@@ -567,7 +566,7 @@ RSPFETCH = defPrimWord("RSP@", () -> begin
 end)
 
 RSPSTORE = defPrimWord("RSP!", () -> begin
-    RSP = popPS()
+    reg.RSP = popPS()
     return NEXT
 end)
 
@@ -584,7 +583,7 @@ PSPFETCH = defPrimWord("PSP@", () -> begin
 end)
 
 PSPSTORE = defPrimWord("PSP!", () -> begin
-    PSP = popPS()
+    reg.PSP = popPS()
     return NEXT
 end)
 
@@ -745,8 +744,8 @@ TRACE = defPrimWord("TRACE", () -> begin
 end)
 
 COMMA = defPrimWord(",", () -> begin
-    mem[mem[HERE]] = popPS()
-    mem[HERE] += 1
+    mem[mem[H]] = popPS()
+    mem[H] += 1
 
     return NEXT
 end)
@@ -764,7 +763,7 @@ NUMTIB, NUMTIB_CFA = defNewVar("#TIB", 0)
 TOIN, TOIN_CFA = defNewVar(">IN", 0)
 
 QUERY = defWord("QUERY",
-    [TIB_CFA, LIT, 80, EXPECT,
+    [TIB_CFA, LIT, 160, EXPECT,
     SPAN_CFA, FETCH, NUMTIB_CFA, STORE,
     LIT, 0, TOIN_CFA, STORE,
     EXIT])
@@ -777,8 +776,8 @@ WORD = defPrimWord("WORD", () -> begin
         mem[TOIN] += 1
     end
 
-    countAddr = mem[HERE]
-    addr = mem[HERE]+1
+    countAddr = mem[H]
+    addr = mem[H]+1
 
     # Start reading in word
     count = 0
@@ -805,7 +804,7 @@ PARSE = defPrimWord("PARSE", () -> begin
     delim = popPS()
 
     # Chew up initial occurrences of delim
-    addr = mem[HERE]
+    addr = mem[H]
 
     # Start reading input stream
     count = 0
@@ -876,11 +875,16 @@ PROMPT = defPrimWord("PROMPT", () -> begin
 end)
 
 QUIT = defWord("QUIT",
-    [RSP0_CFA, RSPSTORE,
+    [LIT, 0, STATE_CFA, STORE,
+    LIT, 0, NUMTIB_CFA, STORE,
+    RSP0_CFA, RSPSTORE,
     QUERY,
     INTERPRET, PROMPT,
     BRANCH,-4])
 
+ABORT = defWord("ABORT",
+    [PSP0_CFA, PSPSTORE, QUIT])
+
 INCLUDE = defPrimWord("INCLUDE", () -> begin
     pushPS(32)
     callPrim(mem[WORD])
@@ -898,6 +902,9 @@ end)
 
 # Compilation
 
+HERE = defWord("HERE",
+    [H_CFA, FETCH, EXIT])
+
 HEADER = defPrimWord("HEADER", () -> begin
     wordAddr = popPS()+1
     wordLen = mem[wordAddr-1]
@@ -908,6 +915,39 @@ HEADER = defPrimWord("HEADER", () -> begin
     return NEXT
 end)
 
+CREATE = defWord("CREATE",
+    [LIT, 32, WORD, HEADER,
+    LIT, DOVAR, COMMA,
+    EXIT])
+
+DODOES = defPrim(() -> begin
+    pushRS(reg.IP)
+    reg.IP = popPS()
+    pushPS(reg.W + 1)
+    return NEXT
+end, name="DODOES")
+
+DOES_HELPER = defPrimWord("(DOES>)", () -> begin
+
+    pushPS(mem[LATEST])
+    callPrim(mem[TOCFA])
+    cfa = popPS()
+
+    runtimeAddr = popPS()
+
+    mem[cfa] = defPrim(eval(:(() -> begin
+        pushPS($(runtimeAddr))
+        return DODOES
+    end)), name="doesPrim")
+
+    return NEXT
+end, flags=F_IMMED)
+
+DOES = defWord("DOES>",
+    [BTICK, LIT, COMMA, HERE, LIT, 3, ADD, COMMA,
+    BTICK, DOES_HELPER, COMMA, BTICK, EXIT, COMMA, EXIT],
+    flags=F_IMMED)
+
 LBRAC = defPrimWord("[", () -> begin
     mem[STATE] = 0
     return NEXT
@@ -995,16 +1035,8 @@ function run(;initialize=true)
                 close(pop!(sources))
             end
 
-            # Want backtrace in here eventually
-            println("reg.W: $(reg.W) reg.IP: $(reg.IP)")
-            print("PS: "); printPS()
-            print("RS: "); printRS()
-
-            mem[STATE] = 0
-            mem[NUMTIB] = 0
-            reg.PSP = mem[PSP0]
-            reg.RSP = mem[RSP0]
-            reg.IP = QUIT + 1
+            # QUIT
+            reg.IP = ABORT + 1
             jmp = NEXT
         end
     end
@@ -1046,11 +1078,11 @@ function dump(startAddr::Int64; count::Int64 = 100, cellsPerLine::Int64 = 10)
 end
 
 function printPS()
-    count = reg.PSP - mem[PSP0]
+    count = reg.PSP - PSP0
 
     if count > 0
         print("<$count>")
-        for i in (mem[PSP0]+1):reg.PSP
+        for i in (PSP0+1):reg.PSP
             print(" $(mem[i])")
         end
         println()
@@ -1060,11 +1092,11 @@ function printPS()
 end
 
 function printRS()
-    count = reg.RSP - mem[RSP0]
+    count = reg.RSP - RSP0
 
     if count > 0
         print("<$count>")
-        for i in (mem[RSP0]+1):reg.RSP
+        for i in (RSP0+1):reg.RSP
             print(" $(mem[i])")
         end
         println()