Reimplemented EXPECT. Closes #1.
[forth.jl.git] / src / forth.jl
index 0194736..4b71499 100644 (file)
@@ -131,16 +131,17 @@ getPrimName(addr::Int64) = primNames[-addr]
 
 # Word creation functions
 
-F_IMMED = 128
-F_HIDDEN = 256
-F_LENMASK = 127
+F_LENMASK = 31
+F_IMMED = 32
+F_HIDDEN = 64
+NFA_MARK = 128
 
 function createHeader(name::AbstractString, flags::Int64)
     mem[mem[H]] = mem[LATEST]
     mem[LATEST] = mem[H]
     mem[H] += 1
 
-    mem[mem[H]] = length(name) | flags; mem[H] += 1
+    mem[mem[H]] = length(name) | flags | NFA_MARK; mem[H] += 1
     putString(name, mem[H]); mem[H] += length(name)
 end
 
@@ -249,6 +250,7 @@ defConst("MEMSIZE", size_mem)
 F_IMMED_CFA = defConst("F_IMMED", F_IMMED)
 F_HIDDEN_CFA = defConst("F_HIDDEN", F_HIDDEN)
 F_LENMASK_CFA = defConst("F_LENMASK", F_LENMASK)
+NFA_MARK_CFA = defConst("NFA_MARK", NFA_MARK)
 
 # Basic forth primitives
 
@@ -605,8 +607,8 @@ sources = Array{Any,1}()
 currentSource() = sources[length(sources)]
 
 EOF = defPrimWord("\x04", () -> begin
-    close(pop!(sources))
-    if !isempty(sources)
+    if currentSource() != STDIN
+        close(pop!(sources))
         return NEXT
     else
         return 0
@@ -618,20 +620,88 @@ EMIT = defPrimWord("EMIT", () -> begin
     return NEXT
 end)
 
+function raw_mode!(mode::Bool)
+    if ccall(:jl_tty_set_mode, Int32, (Ptr{Void}, Int32), STDIN.handle, mode) != 0
+        throw("FATAL: Terminal unable to enter raw mode.")
+    end
+end
+
+function getKey()
+    raw_mode!(true)
+    byte = readbytes(STDIN, 1)[1]
+    raw_mode!(false)
+
+    if byte == 0x0d
+        return 0x0a
+    elseif byte == 127
+        return 0x08
+    else
+        return byte
+    end
+end
+
+KEY = defPrimWord("KEY", () -> begin
+    pushPS(Int(getKey()))
+    return NEXT
+end)
+
+function getLineFromSTDIN()
+    line = ""
+    while true
+        key = Char(getKey())
+
+        if key == '\n'
+            print(" ")
+            return ASCIIString(line)
+
+        elseif key == '\x04'
+            if isempty(line)
+                return string("\x04")
+            end
+
+        elseif key == '\b'
+            if !isempty(line)
+                line = line[1:length(line)-1]
+                print("\b \b")
+            end
+
+        elseif key == '\e'
+            # Strip ANSI escape sequence
+            nextKey = Char(getKey())
+            if nextKey == '['
+                while true
+                    nextKey = Char(getKey())
+                    if nextKey >= '@' || nextKey <= '~'
+                        break
+                    end
+                end
+            end
+
+        else
+            print(key)
+            line = string(line, key)
+        end
+    end
+end
+
 SPAN, SPAN_CFA = defNewVar("SPAN", 0)
 EXPECT = defPrimWord("EXPECT", () -> begin
     maxLen = popPS()
     addr = popPS()
 
-    if !eof(currentSource())
-        line = chomp(readline(currentSource()))
-        mem[SPAN] = min(length(line), maxLen)
-        putString(line[1:mem[SPAN]], addr)
+    if currentSource() == STDIN
+        line = getLineFromSTDIN()
     else
-        mem[SPAN] = 1
-        mem[addr] = 4 # eof
+        if !eof(currentSource())
+            line = chomp(readline(currentSource()))
+        else
+            line = "\x04" # eof
+        end
     end
 
+    mem[SPAN] = min(length(line), maxLen)
+    putString(line[1:mem[SPAN]], addr)
+
     return NEXT
 end)
 
@@ -649,6 +719,19 @@ end)
 
 # Dictionary searches
 
+TOCFA = defPrimWord(">CFA", () -> begin
+
+    addr = popPS()
+    lenAndFlags = mem[addr+1]
+    len = lenAndFlags & F_LENMASK
+
+    pushPS(addr + 2 + len)
+
+    return NEXT
+end)
+
+TOBODY = defWord(">BODY", [INCR, EXIT])
+
 FIND = defPrimWord("FIND", () -> begin
 
     countedAddr = popPS()
@@ -657,6 +740,7 @@ FIND = defPrimWord("FIND", () -> begin
     word = lowercase(getString(wordAddr, wordLen))
 
     latest = LATEST
+    lenAndFlags = 0
     
     i = 0
     while (latest = mem[latest]) > 0
@@ -676,23 +760,22 @@ FIND = defPrimWord("FIND", () -> begin
         end
     end
 
-    pushPS(latest)
-
-    return NEXT
-end)
-
-TOCFA = defPrimWord(">CFA", () -> begin
-
-    addr = popPS()
-    lenAndFlags = mem[addr+1]
-    len = lenAndFlags & F_LENMASK
-
-    pushPS(addr + 2 + len)
+    if latest > 0
+        pushPS(latest)
+        callPrim(mem[TOCFA])
+        if (lenAndFlags & F_IMMED) == F_IMMED
+            pushPS(1)
+        else
+            pushPS(-1)
+        end
+    else
+        pushPS(countedAddr)
+        pushPS(0)
+    end
 
     return NEXT
 end)
 
-TOPFA = defWord(">PFA", [TOCFA, INCR, EXIT])
 
 # Branching
 
@@ -827,7 +910,7 @@ PARSE = defPrimWord("PARSE", () -> begin
 end)
 
 BYE = defPrimWord("BYE", () -> begin
-    println("Bye!")
+    println("\nBye!")
     return 0
 end)
 
@@ -839,30 +922,30 @@ INTERPRET = defWord("INTERPRET",
     DUP, FETCH, ZE, ZBRANCH, 3,
         DROP, EXIT, # Exit if TIB is exhausted
 
-    STATE_CFA, FETCH, ZBRANCH, 31,
+    STATE_CFA, FETCH, ZBRANCH, 24,
         # Compiling
-        DUP, FIND, QDUP, ZBRANCH, 19,
+        FIND, QDUP, ZBRANCH, 13,
 
             # Found word. 
-            SWAP, DROP,
-            DUP, TOCFA, SWAP, INCR, FETCH, LIT, F_IMMED, AND, ZBRANCH, 4,
+            LIT, -1, EQ, INVERT, ZBRANCH, 4,
+
                 # Immediate: Execute!
-                EXECUTE, BRANCH, -33,
+                EXECUTE, BRANCH, -26,
 
                 # Not immediate: Compile!
-                COMMA, BRANCH, -36,
+                COMMA, BRANCH, -29,
 
             # No word found, parse number
-            NUMBER, BTICK, LIT, COMMA, COMMA, BRANCH, -43,
+            NUMBER, BTICK, LIT, COMMA, COMMA, BRANCH, -36,
         
        # Interpreting
-        DUP, FIND, QDUP, ZBRANCH, 7,
+        FIND, QDUP, ZBRANCH, 5,
 
             # Found word. Execute!
-            SWAP, DROP, TOCFA, EXECUTE, BRANCH, -54,
+            DROP, EXECUTE, BRANCH, -44,
 
             # No word found, parse number and leave on stack
-            NUMBER, BRANCH, -57,
+            NUMBER, BRANCH, -47,
     EXIT]
 )
 
@@ -902,6 +985,9 @@ end)
 
 # Compilation
 
+HERE = defWord("HERE",
+    [H_CFA, FETCH, EXIT])
+
 HEADER = defPrimWord("HEADER", () -> begin
     wordAddr = popPS()+1
     wordLen = mem[wordAddr-1]
@@ -912,6 +998,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
@@ -923,28 +1042,22 @@ RBRAC = defPrimWord("]", () -> begin
 end, flags=F_IMMED)
 
 HIDDEN = defPrimWord("HIDDEN", () -> begin
-    addr = popPS() + 1
-    mem[addr] = mem[addr] $ F_HIDDEN
+    lenAndFlagsAddr = mem[LATEST] + 1
+    mem[lenAndFlagsAddr] = mem[lenAndFlagsAddr] $ F_HIDDEN
     return NEXT
 end)
 
-HIDE = defWord("HIDE",
-    [LIT, 32, WORD,
-    FIND,
-    HIDDEN,
-    EXIT])
-
 COLON = defWord(":",
     [LIT, 32, WORD,
     HEADER,
     LIT, DOCOL, COMMA,
-    LATEST_CFA, FETCH, HIDDEN,
+    HIDDEN,
     RBRAC,
     EXIT])
 
 SEMICOLON = defWord(";",
     [LIT, EXIT, COMMA,
-    LATEST_CFA, FETCH, HIDDEN,
+    HIDDEN,
     LBRAC,
     EXIT], flags=F_IMMED)
 
@@ -1073,6 +1186,7 @@ DUMP = defPrimWord("DUMP", () -> begin
     count = popPS()
     addr = popPS()
 
+    println()
     dump(addr, count=count)
 
     return NEXT