X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?p=forth.jl.git;a=blobdiff_plain;f=src%2Fforth.jl;h=4c81dc35b59f305078a7a2a08f4e95927b640b8b;hp=4b714992dbaf249c7fb6116dd6a67a339bc03ba2;hb=2de79279a0f7157a41c0f32674ba96f56cb1b02f;hpb=b18e42773e45b9d4819cf0e2d2c5965bd34dcb4f diff --git a/src/forth.jl b/src/forth.jl index 4b71499..4c81dc3 100644 --- a/src/forth.jl +++ b/src/forth.jl @@ -1,5 +1,7 @@ module forth +import Base.REPLCompletions, Base.invokelatest + # VM mem size size_mem = 1000000 # 1 mega-int @@ -7,43 +9,27 @@ size_mem = 1000000 # 1 mega-int size_RS = 1000 # Return stack size size_PS = 1000 # Parameter stack size size_TIB = 1000 # Terminal input buffer size +size_FIB = 1000 # File input buffer size -# The mem array constitutes the memory of the VM. It has the following geography: -# -# mem = +-----------------------+ -# | Built-in Variables | -# +-----------------------+ -# | Return Stack | -# +-----------------------+ -# | Parameter Stack | -# +-----------------------+ -# | Terminal Input Buffer | -# +-----------------------+ -# | Dictionary | -# +-----------------------+ -# -# Note that all words (user-defined, primitive, variables, etc) are included in -# the dictionary. -# -# Simple linear addressing is used with one exception: references to primitive code -# blocks, which are represented as anonymous functions, appear as negative indicies -# into the primitives array which contains these functions. - +# Memory arrays mem = Array{Int64,1}(size_mem) primitives = Array{Function,1}() -primNames = Array{ASCIIString,1}() +primNames = Array{AbstractString,1}() -# Built-in variables +# Memory geography and built-in variables nextVarAddr = 1 -H = nextVarAddr; nextVarAddr += 1 -LATEST = nextVarAddr; nextVarAddr += 1 +H = nextVarAddr; nextVarAddr += 1 # Next free memory address +FORTH_LATEST = nextVarAddr; nextVarAddr += 1 # FORTH dict latest +CURRENT = nextVarAddr; nextVarAddr += 1 # Current compilation dict 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 +FIB = TIB + size_TIB # address of terminal input buffer +mem[H] = FIB + size_FIB # location of bottom of dictionary +mem[FORTH_LATEST] = 0 # zero FORTH dict latest (no previous def) +mem[CURRENT] = FORTH_LATEST-1 # Compile words to system dict initially DICT = mem[H] # Save bottom of dictionary as constant @@ -58,28 +44,32 @@ reg = Reg(RSP0, PSP0, 0, 0) # Stack manipulation functions -type ParamStackUnderflow <: Exception end -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 - RSP0 -getPSDepth() = reg.PSP - PSP0 - function ensurePSDepth(depth::Int64) - if getPSDepth()= PSP0 + size_PS + error("Parameter stack overflow.") end end function ensureRSDepth(depth::Int64) - if getRSDepth()= RSP0 + size_RS + error("Return stack overflow.") end end function pushRS(val::Int64) + ensureRSCapacity(1) mem[reg.RSP+=1] = val end @@ -92,6 +82,8 @@ function popRS() end function pushPS(val::Int64) + ensurePSCapacity(1) + mem[reg.PSP += 1] = val end @@ -105,12 +97,19 @@ end # Handy functions for adding/retrieving strings to/from memory. -getString(addr::Int64, len::Int64) = ASCIIString([Char(c) for c in mem[addr:(addr+len-1)]]) +getString(addr::Int64, len::Int64) = String([Char(c) for c in mem[addr:(addr+len-1)]]) -function putString(str::ASCIIString, addr::Int64) +function putString(str::AbstractString, addr::Int64) mem[addr:(addr+length(str)-1)] = [Int64(c) for c in str] end +function putString(str::AbstractString, addr::Int64, maxLen::Int64) + len = min(length(str), maxLen) + mem[addr:(addr+len-1)] = [Int64(c) for c in str] +end + +stringAsInts(str::AbstractString) = [Int(c) for c in collect(str)] + # Primitive creation and calling functions function defPrim(f::Function; name="nameless") @@ -124,7 +123,7 @@ function callPrim(addr::Int64) if addr >=0 || -addr>length(primitives) error("Attempted to execute non-existent primitive at address $addr.") else - primitives[-addr]() + invokelatest(primitives[-addr]) end end getPrimName(addr::Int64) = primNames[-addr] @@ -136,21 +135,27 @@ F_IMMED = 32 F_HIDDEN = 64 NFA_MARK = 128 +function dictWrite(ints::Array{Int64,1}) + mem[mem[H]:(mem[H]+length(ints)-1)] = ints + mem[H] += length(ints) +end +dictWrite(int::Int64) = dictWrite([int]) +dictWriteString(string::AbstractString) = dictWrite([Int64(c) for c in string]) + function createHeader(name::AbstractString, flags::Int64) - mem[mem[H]] = mem[LATEST] - mem[LATEST] = mem[H] + mem[mem[H]] = mem[mem[CURRENT]+1] + mem[mem[CURRENT]+1] = mem[H] mem[H] += 1 - mem[mem[H]] = length(name) | flags | NFA_MARK; mem[H] += 1 - putString(name, mem[H]); mem[H] += length(name) + dictWrite(length(name) | flags | NFA_MARK) + dictWriteString(name) end function defPrimWord(name::AbstractString, f::Function; flags::Int64=0) createHeader(name, flags) codeWordAddr = mem[H] - mem[codeWordAddr] = defPrim(f, name=name) - mem[H] += 1 + dictWrite(defPrim(f, name=name)) return codeWordAddr end @@ -159,13 +164,9 @@ function defWord(name::AbstractString, wordAddrs::Array{Int64,1}; flags::Int64=0 createHeader(name, flags) addr = mem[H] - mem[mem[H]] = DOCOL - mem[H] += 1 + dictWrite(DOCOL) - for wordAddr in wordAddrs - mem[mem[H]] = wordAddr - mem[H] += 1 - end + dictWrite(wordAddrs) return addr end @@ -180,25 +181,28 @@ function defExistingVar(name::AbstractString, varAddr::Int64; flags::Int64=0) end))) end -function defNewVar(name::AbstractString, initial::Int64; flags::Int64=0) +function defNewVar(name::AbstractString, initial::Array{Int64,1}; flags::Int64=0) createHeader(name, flags) codeWordAddr = mem[H] varAddr = mem[H] + 1 - mem[mem[H]] = DOVAR; mem[H] += 1 - mem[mem[H]] = initial; mem[H] += 1 + dictWrite(DOVAR) + dictWrite(initial) return varAddr, codeWordAddr end +defNewVar(name::AbstractString, initial::Int64; flags::Int64=0) = + defNewVar(name, [initial]; flags=flags) + function defConst(name::AbstractString, val::Int64; flags::Int64=0) createHeader(name, flags) codeWordAddr = mem[H] - mem[mem[H]] = DOCON; mem[H] += 1 - mem[mem[H]] = val; mem[H] += 1 + dictWrite(DOCON) + dictWrite(val) return codeWordAddr end @@ -227,7 +231,7 @@ DOCON = defPrim(() -> begin return NEXT end, name="DOVAR") -EXIT = defPrimWord("EXIT", () -> begin +EXIT_CFA = defPrimWord("EXIT", () -> begin reg.IP = popRS() return NEXT end) @@ -235,7 +239,6 @@ end) # Dictionary entries for core built-in variables, constants H_CFA = defExistingVar("H", H) -LATEST_CFA = defExistingVar("LATEST", LATEST) PSP0_CFA = defConst("PSP0", PSP0) RSP0_CFA = defConst("RSP0", RSP0) @@ -254,12 +257,12 @@ NFA_MARK_CFA = defConst("NFA_MARK", NFA_MARK) # Basic forth primitives -DROP = defPrimWord("DROP", () -> begin +DROP_CFA = defPrimWord("DROP", () -> begin popPS() return NEXT end) -SWAP = defPrimWord("SWAP", () -> begin +SWAP_CFA = defPrimWord("SWAP", () -> begin a = popPS() b = popPS() pushPS(a) @@ -267,19 +270,19 @@ SWAP = defPrimWord("SWAP", () -> begin return NEXT end) -DUP = defPrimWord("DUP", () -> begin +DUP_CFA = defPrimWord("DUP", () -> begin ensurePSDepth(1) pushPS(mem[reg.PSP]) return NEXT end) -OVER = defPrimWord("OVER", () -> begin +OVER_CFA = defPrimWord("OVER", () -> begin ensurePSDepth(2) pushPS(mem[reg.PSP-1]) return NEXT end) -ROT = defPrimWord("ROT", () -> begin +ROT_CFA = defPrimWord("ROT", () -> begin a = popPS() b = popPS() c = popPS() @@ -289,7 +292,7 @@ ROT = defPrimWord("ROT", () -> begin return NEXT end) -NROT = defPrimWord("-ROT", () -> begin +NROT_CFA = defPrimWord("-ROT", () -> begin a = popPS() b = popPS() c = popPS() @@ -300,13 +303,13 @@ NROT = defPrimWord("-ROT", () -> begin end) -TWODROP = defPrimWord("2DROP", () -> begin +TWODROP_CFA = defPrimWord("2DROP", () -> begin popPS() popPS() return NEXT end) -TWODUP = defPrimWord("2DUP", () -> begin +TWODUP_CFA = defPrimWord("2DUP", () -> begin ensurePSDepth(2) a = mem[reg.PSP-1] b = mem[reg.PSP] @@ -315,7 +318,7 @@ TWODUP = defPrimWord("2DUP", () -> begin return NEXT end) -TWOSWAP = defPrimWord("2SWAP", () -> begin +TWOSWAP_CFA = defPrimWord("2SWAP", () -> begin a = popPS() b = popPS() c = popPS() @@ -327,7 +330,7 @@ TWOSWAP = defPrimWord("2SWAP", () -> begin return NEXT end) -TWOOVER = defPrimWord("2OVER", () -> begin +TWOOVER_CFA = defPrimWord("2OVER", () -> begin ensurePSDepth(4) a = mem[reg.PSP-3] b = mem[reg.PSP-2] @@ -336,7 +339,7 @@ TWOOVER = defPrimWord("2OVER", () -> begin return NEXT end) -QDUP = defPrimWord("?DUP", () -> begin +QDUP_CFA = defPrimWord("?DUP", () -> begin ensurePSDepth(1) val = mem[reg.PSP] if val != 0 @@ -345,52 +348,52 @@ QDUP = defPrimWord("?DUP", () -> begin return NEXT end) -INCR = defPrimWord("1+", () -> begin +INCR_CFA = defPrimWord("1+", () -> begin ensurePSDepth(1) mem[reg.PSP] += 1 return NEXT end) -DECR = defPrimWord("1-", () -> begin +DECR_CFA = defPrimWord("1-", () -> begin ensurePSDepth(1) mem[reg.PSP] -= 1 return NEXT end) -INCR2 = defPrimWord("2+", () -> begin +INCR2_CFA = defPrimWord("2+", () -> begin ensurePSDepth(1) mem[reg.PSP] += 2 return NEXT end) -DECR2 = defPrimWord("2-", () -> begin +DECR2_CFA = defPrimWord("2-", () -> begin ensurePSDepth(1) mem[reg.PSP] -= 2 return NEXT end) -ADD = defPrimWord("+", () -> begin +ADD_CFA = defPrimWord("+", () -> begin b = popPS() a = popPS() pushPS(a+b) return NEXT end) -SUB = defPrimWord("-", () -> begin +SUB_CFA = defPrimWord("-", () -> begin b = popPS() a = popPS() pushPS(a-b) return NEXT end) -MUL = defPrimWord("*", () -> begin +MUL_CFA = defPrimWord("*", () -> begin b = popPS() a = popPS() pushPS(a*b) return NEXT end) -DIVMOD = defPrimWord("/MOD", () -> begin +DIVMOD_CFA = defPrimWord("/MOD", () -> begin b = popPS() a = popPS() q,r = divrem(a,b) @@ -399,117 +402,117 @@ DIVMOD = defPrimWord("/MOD", () -> begin return NEXT end) -TWOMUL = defPrimWord("2*", () -> begin +TWOMUL_CFA = defPrimWord("2*", () -> begin pushPS(popPS() << 1) return NEXT end) -TWODIV = defPrimWord("2/", () -> begin +TWODIV_CFA = defPrimWord("2/", () -> begin pushPS(popPS() >> 1) return NEXT end) -EQ = defPrimWord("=", () -> begin +EQ_CFA = defPrimWord("=", () -> begin b = popPS() a = popPS() pushPS(a==b ? -1 : 0) return NEXT end) -NE = defPrimWord("<>", () -> begin +NE_CFA = defPrimWord("<>", () -> begin b = popPS() a = popPS() pushPS(a!=b ? -1 : 0) return NEXT end) -LT = defPrimWord("<", () -> begin +LT_CFA = defPrimWord("<", () -> begin b = popPS() a = popPS() pushPS(a", () -> begin +GT_CFA = defPrimWord(">", () -> begin b = popPS() a = popPS() pushPS(a>b ? -1 : 0) return NEXT end) -LE = defPrimWord("<=", () -> begin +LE_CFA = defPrimWord("<=", () -> begin b = popPS() a = popPS() pushPS(a<=b ? -1 : 0) return NEXT end) -GE = defPrimWord(">=", () -> begin +GE_CFA = defPrimWord(">=", () -> begin b = popPS() a = popPS() pushPS(a>=b ? -1 : 0) return NEXT end) -ZE = defPrimWord("0=", () -> begin +ZE_CFA = defPrimWord("0=", () -> begin pushPS(popPS() == 0 ? -1 : 0) return NEXT end) -ZNE = defPrimWord("0<>", () -> begin +ZNE_CFA = defPrimWord("0<>", () -> begin pushPS(popPS() != 0 ? -1 : 0) return NEXT end) -ZLT = defPrimWord("0<", () -> begin +ZLT_CFA = defPrimWord("0<", () -> begin pushPS(popPS() < 0 ? -1 : 0) return NEXT end) -ZGT = defPrimWord("0>", () -> begin +ZGT_CFA = defPrimWord("0>", () -> begin pushPS(popPS() > 0 ? -1 : 0) return NEXT end) -ZLE = defPrimWord("0<=", () -> begin +ZLE_CFA = defPrimWord("0<=", () -> begin pushPS(popPS() <= 0 ? -1 : 0) return NEXT end) -ZGE = defPrimWord("0>=", () -> begin +ZGE_CFA = defPrimWord("0>=", () -> begin pushPS(popPS() >= 0 ? -1 : 0) return NEXT end) -AND = defPrimWord("AND", () -> begin +AND_CFA = defPrimWord("AND", () -> begin b = popPS() a = popPS() pushPS(a & b) return NEXT end) -OR = defPrimWord("OR", () -> begin +OR_CFA = defPrimWord("OR", () -> begin b = popPS() a = popPS() pushPS(a | b) return NEXT end) -XOR = defPrimWord("XOR", () -> begin +XOR_CFA = defPrimWord("XOR", () -> begin b = popPS() a = popPS() - pushPS(a $ b) + pushPS(xor(a, b)) return NEXT end) -INVERT = defPrimWord("INVERT", () -> begin +INVERT_CFA = defPrimWord("INVERT", () -> begin pushPS(~popPS()) return NEXT end) # Literals -LIT = defPrimWord("LIT", () -> begin +LIT_CFA = defPrimWord("LIT", () -> begin pushPS(mem[reg.IP]) reg.IP += 1 return NEXT @@ -517,27 +520,27 @@ end) # Memory primitives -STORE = defPrimWord("!", () -> begin +STORE_CFA = defPrimWord("!", () -> begin addr = popPS() dat = popPS() mem[addr] = dat return NEXT end) -FETCH = defPrimWord("@", () -> begin +FETCH_CFA = defPrimWord("@", () -> begin addr = popPS() pushPS(mem[addr]) return NEXT end) -ADDSTORE = defPrimWord("+!", () -> begin +ADDSTORE_CFA = defPrimWord("+!", () -> begin addr = popPS() toAdd = popPS() mem[addr] += toAdd return NEXT end) -SUBSTORE = defPrimWord("-!", () -> begin +SUBSTORE_CFA = defPrimWord("-!", () -> begin addr = popPS() toSub = popPS() mem[addr] -= toSub @@ -547,75 +550,169 @@ end) # Return Stack -TOR = defPrimWord(">R", () -> begin +TOR_CFA = defPrimWord(">R", () -> begin pushRS(popPS()) return NEXT end) -FROMR = defPrimWord("R>", () -> begin +FROMR_CFA = defPrimWord("R>", () -> begin pushPS(popRS()) return NEXT end) -RFETCH = defPrimWord("R@", () -> begin +RFETCH_CFA = defPrimWord("R@", () -> begin pushPS(mem[reg.RSP]) return NEXT end) -RSPFETCH = defPrimWord("RSP@", () -> begin +RSPFETCH_CFA = defPrimWord("RSP@", () -> begin pushPS(reg.RSP) return NEXT end) -RSPSTORE = defPrimWord("RSP!", () -> begin +RSPSTORE_CFA = defPrimWord("RSP!", () -> begin reg.RSP = popPS() return NEXT end) -RDROP = defPrimWord("RDROP", () -> begin +RDROP_CFA = defPrimWord("RDROP", () -> begin popRS() return NEXT end) # Parameter Stack -PSPFETCH = defPrimWord("PSP@", () -> begin +PSPFETCH_CFA = defPrimWord("PSP@", () -> begin pushPS(reg.PSP) return NEXT end) -PSPSTORE = defPrimWord("PSP!", () -> begin +PSPSTORE_CFA = defPrimWord("PSP!", () -> begin reg.PSP = popPS() return NEXT end) # Working Register -WFETCH = defPrimWord("W@", () -> begin +WFETCH_CFA = defPrimWord("W@", () -> begin pushPS(reg.W) return NEXT end) -WSTORE = defPrimWord("W!", () -> begin +WSTORE_CFA = defPrimWord("W!", () -> begin reg.W = popPS() return NEXT end) # I/O -sources = Array{Any,1}() -currentSource() = sources[length(sources)] +openFiles = Dict{Int64,IOStream}() +nextFileID = 1 + + +## File access modes +FAM_RO = 0 +FAM_WO = 1 +FAM_RO_CFA = defConst("R/O", FAM_RO) +FAM_WO_CFA = defConst("W/O", FAM_WO) + +function fileOpener(create::Bool) + fam = popPS() + fnameLen = popPS() + fnameAddr = popPS() -EOF = defPrimWord("\x04", () -> begin - if currentSource() != STDIN - close(pop!(sources)) + fname = getString(fnameAddr, fnameLen) + + if create && !isfile(fname) + pushPS(0) + pushPS(-1) # error return NEXT + end + + if (fam == FAM_RO) + mode = "r" else - return 0 + mode = "w" + end + + global nextFileID + openFiles[nextFileID] = open(fname, mode) + pushPS(nextFileID) + pushPS(0) + + nextFileID += 1 +end + +OPEN_FILE_CFA = defPrimWord("OPEN-FILE", () -> begin + fileOpener(false) + return NEXT +end); + +CREATE_FILE_CFA = defPrimWord("CREATE-FILE", () -> begin + fileOpener(true) + return NEXT +end); + +CLOSE_FILE_CFA = defPrimWord("CLOSE-FILE", () -> begin + fid = popPS() + close(openFiles[fid]) + delete!(openFiles, fid) + + pushPS(0) # Result code 0 + return NEXT +end) + +CLOSE_FILES_CFA = defPrimWord("CLOSE-FILES", () -> begin + for fh in values(openFiles) + close(fh) end + empty!(openFiles) + + pushPS(0) # Result code 0 + return NEXT +end) + +READ_LINE_CFA = defPrimWord("READ-LINE", () -> begin + fid = popPS() + maxSize = popPS() + addr = popPS() + + fh = openFiles[fid] + line = readline(fh, chomp=false) + + eofFlag = endswith(line, '\n') ? 0 : -1 + line = chomp(line) + + putString(line, addr, maxSize) + + pushPS(length(line)) + pushPS(eofFlag) + pushPS(0) + + return NEXT +end) + +READ_FILE_CFA = defPrimWord("READ-FILE", () -> begin + fid = popPS() + size = popPS() + addr = popPS() + + fh = openFiles[fid] + + string = join(map(x -> Char(x), read(fh, size)), "") + + eofFlag = length(string) == size ? 0 : -1 ; + + putString(string, addr, length(string)) + + pushPS(length(string)) + pushPS(eofFlag) + + return NEXT end) -EMIT = defPrimWord("EMIT", () -> begin + +EMIT_CFA = defPrimWord("EMIT", () -> begin print(Char(popPS())) return NEXT end) @@ -628,7 +725,7 @@ end function getKey() raw_mode!(true) - byte = readbytes(STDIN, 1)[1] + byte = read(STDIN, 1)[1] raw_mode!(false) if byte == 0x0d @@ -640,19 +737,37 @@ function getKey() end end -KEY = defPrimWord("KEY", () -> begin +KEY_CFA = defPrimWord("KEY", () -> begin pushPS(Int(getKey())) return NEXT end) function getLineFromSTDIN() + + function getFrag(s) + chars = collect(s) + slashIdx = findlast(chars, '\\') + + if slashIdx > 0 + return join(chars[slashIdx:length(chars)]) + else + return nothing + end + end + + function backspaceStr(s, bsCount) + oldLen = length(s) + newLen = max(0, oldLen - bsCount) + return join(collect(s)[1:newLen]) + end + line = "" while true key = Char(getKey()) if key == '\n' print(" ") - return ASCIIString(line) + return String(line) elseif key == '\x04' if isempty(line) @@ -661,8 +776,8 @@ function getLineFromSTDIN() elseif key == '\b' if !isempty(line) - line = line[1:length(line)-1] - print("\b \b") + print("\b\033[K") + line = backspaceStr(line, 1) end elseif key == '\e' @@ -677,6 +792,20 @@ function getLineFromSTDIN() end end + elseif key == '\t' + # Currently do nothing + + frag = getFrag(line) + if frag != nothing + if haskey(REPLCompletions.latex_symbols, frag) + print(repeat("\b", length(frag))) + print("\033[K") + comp = REPLCompletions.latex_symbols[frag] + line = string(backspaceStr(line, length(frag)), comp) + print(comp) + end + end + else print(key) line = string(line, key) @@ -685,28 +814,20 @@ function getLineFromSTDIN() end SPAN, SPAN_CFA = defNewVar("SPAN", 0) -EXPECT = defPrimWord("EXPECT", () -> begin +EXPECT_CFA = defPrimWord("EXPECT", () -> begin maxLen = popPS() addr = popPS() - if currentSource() == STDIN - line = getLineFromSTDIN() - else - if !eof(currentSource()) - line = chomp(readline(currentSource())) - else - line = "\x04" # eof - end - end + line = getLineFromSTDIN() mem[SPAN] = min(length(line), maxLen) - putString(line[1:mem[SPAN]], addr) + putString(line, addr, maxLen) return NEXT end) BASE, BASE_CFA = defNewVar("BASE", 10) -NUMBER = defPrimWord("NUMBER", () -> begin +NUMBER_CFA = defPrimWord("NUMBER", () -> begin wordAddr = popPS()+1 wordLen = mem[wordAddr-1] @@ -719,7 +840,7 @@ end) # Dictionary searches -TOCFA = defPrimWord(">CFA", () -> begin +FROMLINK_CFA = defPrimWord("LINK>", () -> begin addr = popPS() lenAndFlags = mem[addr+1] @@ -730,39 +851,56 @@ TOCFA = defPrimWord(">CFA", () -> begin return NEXT end) -TOBODY = defWord(">BODY", [INCR, EXIT]) +NUMCONTEXT, NUMCONTEXT_CFA = defNewVar("#CONTEXT", 1) + +createHeader("FORTH", 0) +FORTH_CFA = mem[H] +dictWrite(defPrim(() -> begin + mem[CONTEXT + mem[NUMCONTEXT] - 1] = reg.W + return NEXT +end, name="FORTH")) +dictWrite(0) # cell for latest + +CURRENT_CFA = defExistingVar("CURRENT", CURRENT) + +# Switch to new FORTH vocabulary cfa +mem[FORTH_CFA+1] = mem[mem[CURRENT]+1] +mem[CURRENT] = FORTH_CFA -FIND = defPrimWord("FIND", () -> begin +CONTEXT, CONTEXT_CFA = defNewVar("CONTEXT", zeros(Int64, 10)) +mem[CONTEXT] = FORTH_CFA +FINDVOCAB_CFA = defPrimWord("FINDVOCAB", () -> begin + vocabCFA = popPS() countedAddr = popPS() + wordAddr = countedAddr + 1 wordLen = mem[countedAddr] word = lowercase(getString(wordAddr, wordLen)) - latest = LATEST + lfa = vocabCFA+1 lenAndFlags = 0 - - i = 0 - while (latest = mem[latest]) > 0 - lenAndFlags = mem[latest+1] + + while (lfa = mem[lfa]) > 0 + + lenAndFlags = mem[lfa+1] len = lenAndFlags & F_LENMASK hidden = (lenAndFlags & F_HIDDEN) == F_HIDDEN if hidden || len != wordLen continue end - - thisAddr = latest+2 - thisWord = lowercase(getString(thisAddr, len)) - if lowercase(thisWord) == lowercase(word) + thisWord = lowercase(getString(lfa+2, len)) + + if thisWord == word break end end - if latest > 0 - pushPS(latest) - callPrim(mem[TOCFA]) + if lfa > 0 + pushPS(lfa) + callPrim(mem[FROMLINK_CFA]) if (lenAndFlags & F_IMMED) == F_IMMED pushPS(1) else @@ -776,15 +914,40 @@ FIND = defPrimWord("FIND", () -> begin return NEXT end) +FIND_CFA = defPrimWord("FIND", () -> begin + + countedAddr = popPS() + context = mem[CONTEXT:(CONTEXT+mem[NUMCONTEXT]-1)] + + for vocabCFA in reverse(context) + pushPS(countedAddr) + pushPS(vocabCFA) + callPrim(mem[FINDVOCAB_CFA]) + + callPrim(mem[DUP_CFA]) + if popPS() != 0 + return NEXT + else + popPS() + popPS() + end + end + + pushPS(countedAddr) + pushPS(0) + + return NEXT +end) + # Branching -BRANCH = defPrimWord("BRANCH", () -> begin +BRANCH_CFA = defPrimWord("BRANCH", () -> begin reg.IP += mem[reg.IP] return NEXT end) -ZBRANCH = defPrimWord("0BRANCH", () -> begin +ZBRANCH_CFA = defPrimWord("0BRANCH", () -> begin if (popPS() == 0) reg.IP += mem[reg.IP] else @@ -796,7 +959,7 @@ end) # Strings -LITSTRING = defPrimWord("LITSTRING", () -> begin +LITSTRING_CFA = defPrimWord("LITSTRING", () -> begin len = mem[reg.IP] reg.IP += 1 pushPS(reg.IP) @@ -806,7 +969,7 @@ LITSTRING = defPrimWord("LITSTRING", () -> begin return NEXT end) -TYPE = defPrimWord("TYPE", () -> begin +TYPE_CFA = defPrimWord("TYPE", () -> begin len = popPS() addr = popPS() str = getString(addr, len) @@ -814,48 +977,58 @@ TYPE = defPrimWord("TYPE", () -> begin return NEXT end) -# Outer interpreter +# Interpreter/Compiler-specific I/O -TRACE = defPrimWord("TRACE", () -> begin - println("reg.W: $(reg.W) reg.IP: $(reg.IP)") - print("PS: "); printPS() - print("RS: "); printRS() - print("[paused]") - readline() +TIB_CFA = defConst("TIB", TIB) +NUMTIB, NUMTIB_CFA = defNewVar("#TIB", 0) +FIB_CFA = defConst("FIB", FIB) +NUMFIB, NUMFIB_CFA = defNewVar("#FIB", 0) + +IB_CFA = defPrimWord("IB", () -> begin + pushPS(mem[SOURCE_ID_VAR] == 0 ? TIB : FIB) return NEXT end) -COMMA = defPrimWord(",", () -> begin - mem[mem[H]] = popPS() - mem[H] += 1 - +NUMIB_CFA = defPrimWord("#IB", () -> begin + pushPS(mem[SOURCE_ID_VAR] == 0 ? NUMTIB : NUMFIB) return NEXT end) -BTICK = defWord("[']", - [FROMR, DUP, INCR, TOR, FETCH, EXIT]) +TOIN, TOIN_CFA = defNewVar(">IN", 0) -EXECUTE = defPrimWord("EXECUTE", () -> begin - reg.W = popPS() - return mem[reg.W] -end) +SOURCE_ID_VAR, SOURCE_ID_VAR_CFA = defNewVar("SOURCE-ID-VAR", 0) -TIB_CFA = defConst("TIB", TIB) -NUMTIB, NUMTIB_CFA = defNewVar("#TIB", 0) -TOIN, TOIN_CFA = defNewVar(">IN", 0) +QUERY_CFA = defWord("QUERY", + [TIB_CFA, LIT_CFA, 160, EXPECT_CFA, + SPAN_CFA, FETCH_CFA, NUMTIB_CFA, STORE_CFA, + LIT_CFA, 0, TOIN_CFA, STORE_CFA, + EXIT_CFA]) + +EOF_FLAG, EOF_FLAG_CFA = defNewVar("EOF-FLAG", 0) -QUERY = defWord("QUERY", - [TIB_CFA, LIT, 160, EXPECT, - SPAN_CFA, FETCH, NUMTIB_CFA, STORE, - LIT, 0, TOIN_CFA, STORE, - EXIT]) +# ( fid -- ) +# EOF-FLAG set to true if EOF is reached +QUERY_FILE_CFA = defWord("QUERY-FILE", + [FIB_CFA, LIT_CFA, 160, ROT_CFA, READ_LINE_CFA, + DROP_CFA, EOF_FLAG_CFA, STORE_CFA, + NUMFIB_CFA, STORE_CFA, + LIT_CFA, 0, TOIN_CFA, STORE_CFA, + EXIT_CFA]) -WORD = defPrimWord("WORD", () -> begin +WORD_CFA = defPrimWord("WORD", () -> begin delim = popPS() + if mem[SOURCE_ID_VAR] == 0 + bufferAddr = TIB + sizeAddr = NUMTIB + else + bufferAddr = FIB + sizeAddr = NUMFIB + end + # Chew up initial occurrences of delim - while (mem[TOIN] begin # Start reading in word count = 0 - while (mem[TOIN] begin mem[countAddr] = count pushPS(countAddr) - return NEXT -end) - -PARSE = defPrimWord("PARSE", () -> begin - delim = popPS() - - # Chew up initial occurrences of delim - addr = mem[H] - - # Start reading input stream - count = 0 - while (mem[TOIN] begin - println("\nBye!") - return 0 -end) +# Compilation STATE, STATE_CFA = defNewVar("STATE", 0) -INTERPRET = defWord("INTERPRET", - [LIT, 32, WORD, # Read next space-delimited word - - DUP, FETCH, ZE, ZBRANCH, 3, - DROP, EXIT, # Exit if TIB is exhausted - - STATE_CFA, FETCH, ZBRANCH, 24, - # Compiling - FIND, QDUP, ZBRANCH, 13, - - # Found word. - LIT, -1, EQ, INVERT, ZBRANCH, 4, - - # Immediate: Execute! - EXECUTE, BRANCH, -26, - - # Not immediate: Compile! - COMMA, BRANCH, -29, - - # No word found, parse number - NUMBER, BTICK, LIT, COMMA, COMMA, BRANCH, -36, - - # Interpreting - FIND, QDUP, ZBRANCH, 5, - - # Found word. Execute! - DROP, EXECUTE, BRANCH, -44, - - # No word found, parse number and leave on stack - NUMBER, BRANCH, -47, - EXIT] -) - -PROMPT = defPrimWord("PROMPT", () -> begin - if (mem[STATE] == 0 && currentSource() == STDIN) - println(" ok") - end - - return NEXT -end) - -QUIT = defWord("QUIT", - [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]) - wordAddr = popPS()+1 - wordLen = mem[wordAddr-1] - word = getString(wordAddr, wordLen) - - push!(sources, open(word, "r")) - - # Clear input buffer - mem[NUMTIB] = 0 +COMMA_CFA = defPrimWord(",", () -> begin + mem[mem[H]] = popPS() + mem[H] += 1 return NEXT end) -# Compilation - -HERE = defWord("HERE", - [H_CFA, FETCH, EXIT]) +HERE_CFA = defWord("HERE", + [H_CFA, FETCH_CFA, EXIT_CFA]) -HEADER = defPrimWord("HEADER", () -> begin +HEADER_CFA = defPrimWord("HEADER", () -> begin wordAddr = popPS()+1 wordLen = mem[wordAddr-1] word = getString(wordAddr, wordLen) @@ -998,10 +1082,10 @@ HEADER = defPrimWord("HEADER", () -> begin return NEXT end) -CREATE = defWord("CREATE", - [LIT, 32, WORD, HEADER, - LIT, DOVAR, COMMA, - EXIT]) +CREATE_CFA = defWord("CREATE", + [LIT_CFA, 32, WORD_CFA, HEADER_CFA, + LIT_CFA, DOVAR, COMMA_CFA, + EXIT_CFA]) DODOES = defPrim(() -> begin pushRS(reg.IP) @@ -1010,10 +1094,10 @@ DODOES = defPrim(() -> begin return NEXT end, name="DODOES") -DOES_HELPER = defPrimWord("(DOES>)", () -> begin +DOES_HELPER_CFA = defPrimWord("(DOES>)", () -> begin - pushPS(mem[LATEST]) - callPrim(mem[TOCFA]) + pushPS(mem[mem[CURRENT]+1]) + callPrim(mem[FROMLINK_CFA]) cfa = popPS() runtimeAddr = popPS() @@ -1024,96 +1108,239 @@ DOES_HELPER = defPrimWord("(DOES>)", () -> begin end)), name="doesPrim") return NEXT -end, flags=F_IMMED) +end, flags=F_IMMED | F_HIDDEN) -DOES = defWord("DOES>", - [BTICK, LIT, COMMA, HERE, LIT, 3, ADD, COMMA, - BTICK, DOES_HELPER, COMMA, BTICK, EXIT, COMMA, EXIT], +DOES_CFA = defWord("DOES>", + [LIT_CFA, LIT_CFA, COMMA_CFA, HERE_CFA, LIT_CFA, 3, ADD_CFA, COMMA_CFA, + LIT_CFA, DOES_HELPER_CFA, COMMA_CFA, LIT_CFA, EXIT_CFA, COMMA_CFA, EXIT_CFA], flags=F_IMMED) -LBRAC = defPrimWord("[", () -> begin +LBRAC_CFA = defPrimWord("[", () -> begin mem[STATE] = 0 return NEXT end, flags=F_IMMED) -RBRAC = defPrimWord("]", () -> begin +RBRAC_CFA = defPrimWord("]", () -> begin mem[STATE] = 1 return NEXT end, flags=F_IMMED) -HIDDEN = defPrimWord("HIDDEN", () -> begin - lenAndFlagsAddr = mem[LATEST] + 1 - mem[lenAndFlagsAddr] = mem[lenAndFlagsAddr] $ F_HIDDEN +HIDDEN_CFA = defPrimWord("HIDDEN", () -> begin + lenAndFlagsAddr = mem[mem[CURRENT]+1] + 1 + mem[lenAndFlagsAddr] = xor(mem[lenAndFlagsAddr], F_HIDDEN) return NEXT end) -COLON = defWord(":", - [LIT, 32, WORD, - HEADER, - LIT, DOCOL, COMMA, - HIDDEN, - RBRAC, - EXIT]) +COLON_CFA = defWord(":", + [LIT_CFA, 32, WORD_CFA, + HEADER_CFA, + LIT_CFA, DOCOL, COMMA_CFA, + HIDDEN_CFA, + RBRAC_CFA, + EXIT_CFA]) -SEMICOLON = defWord(";", - [LIT, EXIT, COMMA, - HIDDEN, - LBRAC, - EXIT], flags=F_IMMED) +SEMICOLON_CFA = defWord(";", + [LIT_CFA, EXIT_CFA, COMMA_CFA, + HIDDEN_CFA, + LBRAC_CFA, + EXIT_CFA], flags=F_IMMED) -IMMEDIATE = defPrimWord("IMMEDIATE", () -> begin - lenAndFlagsAddr = mem[LATEST] + 1 - mem[lenAndFlagsAddr] = mem[lenAndFlagsAddr] $ F_IMMED +IMMEDIATE_CFA = defPrimWord("IMMEDIATE", () -> begin + lenAndFlagsAddr = mem[mem[CURRENT]+1] + 1 + mem[lenAndFlagsAddr] = xor(mem[lenAndFlagsAddr], F_IMMED) return NEXT end, flags=F_IMMED) +# ( addr n -- primAddr ) +CREATE_PRIM_CFA = defPrimWord("CREATE-PRIM", () -> begin + len = popPS() + addr = popPS() + + exprString = string("() -> begin\n", + getString(addr, len), "\n", + "return NEXT\n", + "end") + func = eval(parse(exprString)) + + pushPS(defPrim(func)) + return NEXT +end) + +# Outer Interpreter + +EXECUTE_CFA = defPrimWord("EXECUTE", () -> begin + reg.W = popPS() + return mem[reg.W] +end) + +INTERPRET_CFA = defWord("INTERPRET", + [LIT_CFA, 32, WORD_CFA, # Read next space-delimited word + + DUP_CFA, FETCH_CFA, ZE_CFA, ZBRANCH_CFA, 3, + DROP_CFA, EXIT_CFA, # Exit if input buffer is exhausted + + STATE_CFA, FETCH_CFA, ZBRANCH_CFA, 24, + # Compiling + FIND_CFA, QDUP_CFA, ZBRANCH_CFA, 13, + + # Found word. + LIT_CFA, -1, EQ_CFA, INVERT_CFA, ZBRANCH_CFA, 4, + + # Immediate: Execute! + EXECUTE_CFA, BRANCH_CFA, -26, + + # Not immediate: Compile! + COMMA_CFA, BRANCH_CFA, -29, + + # No word found, parse number + NUMBER_CFA, LIT_CFA, LIT_CFA, COMMA_CFA, COMMA_CFA, BRANCH_CFA, -36, + + # Interpreting + FIND_CFA, QDUP_CFA, ZBRANCH_CFA, 5, + + # Found word. Execute! + DROP_CFA, EXECUTE_CFA, BRANCH_CFA, -44, + + # No word found, parse number and leave on stack + NUMBER_CFA, BRANCH_CFA, -47, + EXIT_CFA]) + +PROMPT_CFA = defPrimWord("PROMPT", () -> begin + if mem[STATE] == 0 + print(" ok") + end + println() + + return NEXT +end) + +QUIT_CFA = defWord("QUIT", + [LIT_CFA, 0, STATE_CFA, STORE_CFA, # Set mode to interpret + LIT_CFA, 0, SOURCE_ID_VAR_CFA, STORE_CFA, # Set terminal as input stream + LIT_CFA, 0, NUMTIB_CFA, STORE_CFA, # Clear the input buffer + RSP0_CFA, RSPSTORE_CFA, # Clear the return stack + QUERY_CFA, # Read line of input + INTERPRET_CFA, PROMPT_CFA, # Interpret line + BRANCH_CFA,-4]) # Loop + +INCLUDED_CFA = defWord("INCLUDED", + [LIT_CFA, 0, STATE_CFA, STORE_CFA, # Set mode to interpret + FAM_RO_CFA, OPEN_FILE_CFA, DROP_CFA, # Open the file + SOURCE_ID_VAR_CFA, FETCH_CFA, SWAP_CFA, # Store current source on stack + SOURCE_ID_VAR_CFA, STORE_CFA, # Mark this as the current source + SOURCE_ID_VAR_CFA, FETCH_CFA, QUERY_FILE_CFA, # Read line from file + EOF_FLAG_CFA, FETCH_CFA, + NUMFIB_CFA, FETCH_CFA, ZE_CFA, AND_CFA, # Test for EOF and empty line + INVERT_CFA, ZBRANCH_CFA, 4, # Break out if EOF + INTERPRET_CFA, # Interpret line + BRANCH_CFA, -14, # Loop + SOURCE_ID_VAR_CFA, FETCH_CFA, + CLOSE_FILE_CFA, DROP_CFA, # Close file + SOURCE_ID_VAR_CFA, STORE_CFA, # Restore input source + LIT_CFA, 0, NUMIB_CFA, STORE_CFA, # Zero #IB + LIT_CFA, 0, TOIN_CFA, STORE_CFA, # Zero >IN + EXIT_CFA]) + +INCLUDE_CFA = defWord("INCLUDE", [LIT_CFA, 32, WORD_CFA, + DUP_CFA, INCR_CFA, + SWAP_CFA, FETCH_CFA, + INCLUDED_CFA, EXIT_CFA]); + +ABORT_CFA = defWord("ABORT", + [CLOSE_FILES_CFA, DROP_CFA, PSP0_CFA, PSPSTORE_CFA, QUIT_CFA]) + +BYE_CFA = defPrimWord("BYE", () -> begin + if mem[SOURCE_ID_VAR] == 0 + println("\nBye!") + end + return 0 +end) + +EOF_CFA = defPrimWord("\x04", () -> begin + return 0 +end) + +### Library loading ### + +oldCWD = "" +SETLIBCWD_CFA = defPrimWord("SETLIBCWD", () -> begin + global oldCWD = pwd() + if !isfile("lib.4th") # Exception for debugging. + cd(Pkg.dir("forth","src")) + end + return NEXT +end) + +RESTORECWD_CFA = defPrimWord("RESTORECWD", () -> begin + cd(oldCWD) + return NEXT +end) + +INCLUDED_LIB_CFA = defWord("INCLUDED-LIB", + [SETLIBCWD_CFA, INCLUDED_CFA, RESTORECWD_CFA, EXIT_CFA]) + +INCLUDE_LIB_CFA = defWord("INCLUDE-LIB", [LIT_CFA, 32, WORD_CFA, + DUP_CFA, INCR_CFA, + SWAP_CFA, FETCH_CFA, + INCLUDED_LIB_CFA, EXIT_CFA]); + +SKIP_WELCOME, SKIP_WELCOME_CFA = defNewVar("SKIP-WELCOME", 0) #### VM loop #### initialized = false -initFileName = nothing -if isfile("lib.4th") - initFileName = "lib.4th" -elseif isfile(Pkg.dir("forth/src/lib.4th")) - initFileName = Pkg.dir("forth/src/lib.4th") -end +libFileName = "lib.4th" + +function run(fileName=nothing; initialize=true) -function run(;initialize=true) - # Begin with STDIN as source - push!(sources, STDIN) + # Start with IP pointing to first instruction of outer interpreter + pushRS(QUIT_CFA+1) + + # Include optional file + if fileName != nothing + putString(fileName, mem[H]) + pushPS(mem[H]) + mem[H] += length(fileName) + pushPS(length(fileName)) + pushRS(INCLUDED_CFA+1) + + mem[SKIP_WELCOME] = -1 + end - global initialized, initFileName + # Load library files + global initialized, libFileName if !initialized && initialize - if initFileName != nothing - print("Including definitions from $initFileName...") - push!(sources, open(initFileName, "r")) + if libFileName != nothing + #print("Including definitions from $libFileName...") + + putString(libFileName, mem[H]) + pushPS(mem[H]) + pushPS(length(libFileName)) + pushRS(INCLUDED_LIB_CFA+1) + initialized = true else println("No library file found. Only primitive words available.") end end - # Start with IP pointing to first instruction of outer interpreter - reg.IP = QUIT + 1 # Primitive processing loop. # Everyting else is simply a consequence of this loop! - jmp = NEXT + jmp = mem[EXIT_CFA] while jmp != 0 try - #println("Entering prim $(getPrimName(jmp))") + #print("Entering prim $(getPrimName(jmp)), PS: ") + #printPS() + jmp = callPrim(jmp) catch ex showerror(STDOUT, ex) println() - while !isempty(sources) && currentSource() != STDIN - close(pop!(sources)) - end - # QUIT - reg.IP = ABORT + 1 + reg.IP = ABORT_CFA + 1 jmp = NEXT end end @@ -1121,6 +1348,16 @@ end # Debugging tools +TRACE_CFA = defPrimWord("TRACE", () -> begin + println("reg.W: $(reg.W) reg.IP: $(reg.IP)") + print("PS: "); printPS() + print("RS: "); printRS() + print("[paused]") + readline() + + return NEXT +end) + function dump(startAddr::Int64; count::Int64 = 100, cellsPerLine::Int64 = 10) chars = Array{Char,1}(cellsPerLine) @@ -1150,7 +1387,7 @@ function dump(startAddr::Int64; count::Int64 = 100, cellsPerLine::Int64 = 10) i += 1 end - println("\t", ASCIIString(chars)) + println("\t", String(chars)) end end