X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?p=forth.jl.git;a=blobdiff_plain;f=src%2Fforth.jl;h=2bd68b9ab1475d5901645ba1fe67bedae223a1d0;hp=4b625bc146eb19cbcc36a51f6ab414789726645d;hb=40ee2b7687b038db08a7337fc1ca36cc70633167;hpb=03de266dbc3975cfa2f3b07de2d58ff642f4bf76 diff --git a/src/forth.jl b/src/forth.jl index 4b625bc..2bd68b9 100644 --- a/src/forth.jl +++ b/src/forth.jl @@ -1,53 +1,35 @@ module forth +import Base.REPLCompletions + # VM mem size -size_mem = 640*1024 +size_mem = 1000000 # 1 mega-int # Buffer sizes -size_RS = 1024 # Return stack size -size_PS = 1024 # Parameter stack size -size_TIB = 1096 # Terminal 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 the negative index -# into the primitives array which contains only these functions. +size_RS = 1000 # Return stack size +size_PS = 1000 # Parameter stack size +size_TIB = 1000 # Terminal input buffer size +# 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 -RSP0 = nextVarAddr; nextVarAddr += 1 -PSP0 = nextVarAddr; nextVarAddr += 1 -HERE = 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 -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[FORTH_LATEST] = 0 # zero FORTH dict latest (no previous def) +mem[CURRENT] = FORTH_LATEST-1 # Compile words to system dict initially -DICT = mem[HERE] # Save bottom of dictionary as constant +DICT = mem[H] # Save bottom of dictionary as constant # VM registers type Reg @@ -55,30 +37,37 @@ type Reg PSP::Int64 # Parameter/data stack pointer IP::Int64 # Instruction pointer W::Int64 # Working register - X::Int64 # Extra register end -reg = Reg(mem[RSP0], mem[PSP0], 0, 0, 0) - -# Stack manipulation - -type StackUnderflow <: Exception end +reg = Reg(RSP0, PSP0, 0, 0) -getRSDepth() = reg.RSP - mem[RSP0] -getPSDepth() = reg.PSP - mem[PSP0] +# Stack manipulation functions 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 @@ -91,6 +80,8 @@ function popRS() end function pushPS(val::Int64) + ensurePSCapacity(1) + mem[reg.PSP += 1] = val end @@ -104,789 +95,1139 @@ 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)]]) -function putString(str::ASCIIString, addr::Int64) - mem[addr:(addr+length(str)-1)] = [Int64(c) for c in str] +getString(addr::Int64, len::Int64) = AbstractString([Char(c) for c in mem[addr:(addr+len-1)]]) + +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") + push!(primitives, f) + push!(primNames, replace(name, "\004", "EOF")) + + return -length(primitives) +end + +function callPrim(addr::Int64) + if addr >=0 || -addr>length(primitives) + error("Attempted to execute non-existent primitive at address $addr.") + else + primitives[-addr]() + end +end +getPrimName(addr::Int64) = primNames[-addr] + +# Word creation functions + +F_LENMASK = 31 +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[HERE]] = mem[LATEST] - mem[LATEST] = mem[HERE] - mem[HERE] += 1 + mem[mem[H]] = mem[mem[CURRENT]+1] + mem[mem[CURRENT]+1] = mem[H] + mem[H] += 1 - mem[mem[HERE]] = length(name) | flags; mem[HERE] += 1 - putString(name, mem[HERE]); mem[HERE] += length(name) + dictWrite(length(name) | flags | NFA_MARK) + dictWriteString(name) end -function defPrim(name::AbstractString, f::Function; flags::Int64=0) +function defPrimWord(name::AbstractString, f::Function; flags::Int64=0) createHeader(name, flags) - codeWordAddr = mem[HERE] - push!(primitives, f) - mem[codeWordAddr] = -length(primitives) - mem[HERE] += 1 - - push!(primNames, name) + codeWordAddr = mem[H] + dictWrite(defPrim(f, name=name)) return codeWordAddr end -callPrim(addr::Int64) = primitives[-addr]() +function defWord(name::AbstractString, wordAddrs::Array{Int64,1}; flags::Int64=0) + createHeader(name, flags) + + addr = mem[H] + dictWrite(DOCOL) + + dictWrite(wordAddrs) + + return addr +end + +# Variable creation functions function defExistingVar(name::AbstractString, varAddr::Int64; flags::Int64=0) - defPrim(name, eval(:(() -> begin + + defPrimWord(name, eval(:(() -> begin pushPS($(varAddr)) - return mem[NEXT] + return NEXT 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[HERE] - varAddr = mem[HERE] + 1 - push!(primitives, eval(:(() -> begin - pushPS($(varAddr)) - return mem[NEXT] - end))) - mem[mem[HERE]] = -length(primitives); mem[HERE] += 1 + codeWordAddr = mem[H] + varAddr = mem[H] + 1 - mem[mem[HERE]] = initial; mem[HERE] += 1 + dictWrite(DOVAR) + dictWrite(initial) return varAddr, codeWordAddr end -function defConst(name::AbstractString, val::Int64; flags::Int64=0) - defPrim(name, eval(:(() -> begin - pushPS($(val)) - return mem[NEXT] - end))) +defNewVar(name::AbstractString, initial::Int64; flags::Int64=0) = + defNewVar(name, [initial]; flags=flags) - return val -end - -function defWord(name::AbstractString, wordAddrs::Array{Int64,1}; flags::Int64=0) +function defConst(name::AbstractString, val::Int64; flags::Int64=0) createHeader(name, flags) - addr = mem[HERE] - mem[mem[HERE]] = mem[DOCOL] - mem[HERE] += 1 + codeWordAddr = mem[H] - for wordAddr in wordAddrs - mem[mem[HERE]] = wordAddr - mem[HERE] += 1 - end + dictWrite(DOCON) + dictWrite(val) - return addr + return codeWordAddr end # Threading Primitives (inner interpreter) -NEXT = defPrim("NEXT", () -> begin +NEXT = defPrim(() -> begin reg.W = mem[reg.IP] reg.IP += 1 return mem[reg.W] -end) +end, name="NEXT") -DOCOL = defPrim("DOCOL", () -> begin +DOCOL = defPrim(() -> begin pushRS(reg.IP) reg.IP = reg.W + 1 - return mem[NEXT] -end) + return NEXT +end, name="DOCOL") + +DOVAR = defPrim(() -> begin + pushPS(reg.W + 1) + return NEXT +end, name="DOVAR") -EXIT = defPrim("EXIT", () -> begin +DOCON = defPrim(() -> begin + pushPS(mem[reg.W + 1]) + return NEXT +end, name="DOVAR") + +EXIT_CFA = defPrimWord("EXIT", () -> begin reg.IP = popRS() - return mem[NEXT] + return NEXT end) +# Dictionary entries for core built-in variables, constants + +H_CFA = defExistingVar("H", H) + +PSP0_CFA = defConst("PSP0", PSP0) +RSP0_CFA = defConst("RSP0", RSP0) + +defConst("DOCOL", DOCOL) +defConst("DOCON", DOCON) +defConst("DOVAR", DOVAR) + +defConst("DICT", DICT) +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 -DROP = defPrim("DROP", () -> begin +DROP_CFA = defPrimWord("DROP", () -> begin popPS() - return mem[NEXT] + return NEXT end) -SWAP = defPrim("SWAP", () -> begin +SWAP_CFA = defPrimWord("SWAP", () -> begin a = popPS() b = popPS() pushPS(a) pushPS(b) - return mem[NEXT] + return NEXT end) -DUP = defPrim("DUP", () -> begin +DUP_CFA = defPrimWord("DUP", () -> begin + ensurePSDepth(1) pushPS(mem[reg.PSP]) - return mem[NEXT] + return NEXT end) -OVER = defPrim("OVER", () -> begin +OVER_CFA = defPrimWord("OVER", () -> begin ensurePSDepth(2) pushPS(mem[reg.PSP-1]) - return mem[NEXT] + return NEXT end) -ROT = defPrim("ROT", () -> begin +ROT_CFA = defPrimWord("ROT", () -> begin a = popPS() b = popPS() c = popPS() + pushPS(b) pushPS(a) pushPS(c) - pushPS(b) - return mem[NEXT] + return NEXT end) -NROT = defPrim("-ROT", () -> begin +NROT_CFA = defPrimWord("-ROT", () -> begin a = popPS() b = popPS() c = popPS() - pushPS(b) pushPS(a) pushPS(c) - return mem[NEXT] + pushPS(b) + return NEXT end) -TWODROP = defPrim("2DROP", () -> begin + +TWODROP_CFA = defPrimWord("2DROP", () -> begin popPS() popPS() - return mem[NEXT] + return NEXT end) -TWODUP = defPrim("2DUP", () -> begin +TWODUP_CFA = defPrimWord("2DUP", () -> begin ensurePSDepth(2) a = mem[reg.PSP-1] b = mem[reg.PSP] pushPS(a) pushPS(b) - return mem[NEXT] + return NEXT end) -TWOSWAP = defPrim("2SWAP", () -> begin +TWOSWAP_CFA = defPrimWord("2SWAP", () -> begin a = popPS() b = popPS() c = popPS() d = popPS() pushPS(b) pushPS(a) - pushPS(c) pushPS(d) - return mem[NEXT] + pushPS(c) + return NEXT end) -QDUP = defPrim("?DUP", () -> begin +TWOOVER_CFA = defPrimWord("2OVER", () -> begin + ensurePSDepth(4) + a = mem[reg.PSP-3] + b = mem[reg.PSP-2] + pushPS(a) + pushPS(b) + return NEXT +end) + +QDUP_CFA = defPrimWord("?DUP", () -> begin ensurePSDepth(1) val = mem[reg.PSP] if val != 0 pushPS(val) end - return mem[NEXT] + return NEXT end) -INCR = defPrim("1+", () -> begin +INCR_CFA = defPrimWord("1+", () -> begin ensurePSDepth(1) mem[reg.PSP] += 1 - return mem[NEXT] + return NEXT end) -DECR = defPrim("1-", () -> begin +DECR_CFA = defPrimWord("1-", () -> begin ensurePSDepth(1) mem[reg.PSP] -= 1 - return mem[NEXT] + return NEXT end) -INCR2 = defPrim("2+", () -> begin +INCR2_CFA = defPrimWord("2+", () -> begin ensurePSDepth(1) mem[reg.PSP] += 2 - return mem[NEXT] + return NEXT end) -DECR2 = defPrim("2-", () -> begin +DECR2_CFA = defPrimWord("2-", () -> begin ensurePSDepth(1) mem[reg.PSP] -= 2 - return mem[NEXT] + return NEXT end) -ADD = defPrim("+", () -> begin +ADD_CFA = defPrimWord("+", () -> begin b = popPS() a = popPS() pushPS(a+b) - return mem[NEXT] + return NEXT end) -SUB = defPrim("-", () -> begin +SUB_CFA = defPrimWord("-", () -> begin b = popPS() a = popPS() pushPS(a-b) - return mem[NEXT] + return NEXT end) -MUL = defPrim("*", () -> begin +MUL_CFA = defPrimWord("*", () -> begin b = popPS() a = popPS() pushPS(a*b) - return mem[NEXT] + return NEXT end) -DIVMOD = defPrim("/MOD", () -> begin +DIVMOD_CFA = defPrimWord("/MOD", () -> begin b = popPS() a = popPS() q,r = divrem(a,b) pushPS(r) pushPS(q) - return mem[NEXT] + return NEXT +end) + +TWOMUL_CFA = defPrimWord("2*", () -> begin + pushPS(popPS() << 1) + return NEXT +end) + +TWODIV_CFA = defPrimWord("2/", () -> begin + pushPS(popPS() >> 1) + return NEXT end) -EQU = defPrim("=", () -> begin +EQ_CFA = defPrimWord("=", () -> begin b = popPS() a = popPS() pushPS(a==b ? -1 : 0) - return mem[NEXT] + return NEXT end) -NEQU = defPrim("<>", () -> begin +NE_CFA = defPrimWord("<>", () -> begin b = popPS() a = popPS() pushPS(a!=b ? -1 : 0) - return mem[NEXT] + return NEXT end) -LT = defPrim("<", () -> 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 mem[NEXT] + return NEXT end) -LE = defPrim("<=", () -> begin +LE_CFA = defPrimWord("<=", () -> begin b = popPS() a = popPS() pushPS(a<=b ? -1 : 0) - return mem[NEXT] + return NEXT end) -GE = defPrim(">=", () -> begin +GE_CFA = defPrimWord(">=", () -> begin b = popPS() a = popPS() pushPS(a>=b ? -1 : 0) - return mem[NEXT] + return NEXT end) -ZEQU = defPrim("0=", () -> begin +ZE_CFA = defPrimWord("0=", () -> begin pushPS(popPS() == 0 ? -1 : 0) - return mem[NEXT] + return NEXT end) -ZNEQU = defPrim("0<>", () -> begin +ZNE_CFA = defPrimWord("0<>", () -> begin pushPS(popPS() != 0 ? -1 : 0) - return mem[NEXT] + return NEXT end) -ZLT = defPrim("0<", () -> begin +ZLT_CFA = defPrimWord("0<", () -> begin pushPS(popPS() < 0 ? -1 : 0) - return mem[NEXT] + return NEXT end) -ZGT = defPrim("0>", () -> begin +ZGT_CFA = defPrimWord("0>", () -> begin pushPS(popPS() > 0 ? -1 : 0) - return mem[NEXT] + return NEXT end) -ZLE = defPrim("0<=", () -> begin +ZLE_CFA = defPrimWord("0<=", () -> begin pushPS(popPS() <= 0 ? -1 : 0) - return mem[NEXT] + return NEXT end) -ZGE = defPrim("0>=", () -> begin +ZGE_CFA = defPrimWord("0>=", () -> begin pushPS(popPS() >= 0 ? -1 : 0) - return mem[NEXT] + return NEXT end) -AND = defPrim("AND", () -> begin +AND_CFA = defPrimWord("AND", () -> begin b = popPS() a = popPS() pushPS(a & b) - return mem[NEXT] + return NEXT end) -OR = defPrim("OR", () -> begin +OR_CFA = defPrimWord("OR", () -> begin b = popPS() a = popPS() pushPS(a | b) - return mem[NEXT] + return NEXT end) -XOR = defPrim("XOR", () -> begin +XOR_CFA = defPrimWord("XOR", () -> begin b = popPS() a = popPS() pushPS(a $ b) - return mem[NEXT] + return NEXT end) -INVERT = defPrim("INVERT", () -> begin +INVERT_CFA = defPrimWord("INVERT", () -> begin pushPS(~popPS()) - return mem[NEXT] + return NEXT end) # Literals -LIT = defPrim("LIT", () -> begin +LIT_CFA = defPrimWord("LIT", () -> begin pushPS(mem[reg.IP]) reg.IP += 1 - return mem[NEXT] + return NEXT end) # Memory primitives -STORE = defPrim("!", () -> begin +STORE_CFA = defPrimWord("!", () -> begin addr = popPS() dat = popPS() mem[addr] = dat - return mem[NEXT] + return NEXT end) -FETCH = defPrim("@", () -> begin +FETCH_CFA = defPrimWord("@", () -> begin addr = popPS() pushPS(mem[addr]) - return mem[NEXT] + return NEXT end) -ADDSTORE = defPrim("+!", () -> begin +ADDSTORE_CFA = defPrimWord("+!", () -> begin addr = popPS() toAdd = popPS() mem[addr] += toAdd - return mem[NEXT] + return NEXT end) -SUBSTORE = defPrim("-!", () -> begin +SUBSTORE_CFA = defPrimWord("-!", () -> begin addr = popPS() toSub = popPS() mem[addr] -= toSub - return mem[NEXT] + return NEXT end) -# Built-in variables - -HERE_CFA = defExistingVar("HERE", HERE) -LATEST_CFA = defExistingVar("LATEST", LATEST) -PSP0_CFA = defExistingVar("PSP0", PSP0) -RSP0_CFA = defExistingVar("RSP0", RSP0) -STATE, STATE_CFA = defNewVar("STATE", 0) -BASE, BASE_CFA = defNewVar("BASE", 10) - -# Constants - -defConst("VERSION", 1) -defConst("DOCOL", DOCOL) -defConst("DICT", DICT) -F_IMMED = defConst("F_IMMED", 128) -F_HIDDEN = defConst("F_HIDDEN", 256) -F_LENMASK = defConst("F_LENMASK", 127) - # Return Stack -TOR = defPrim(">R", () -> begin +TOR_CFA = defPrimWord(">R", () -> begin pushRS(popPS()) - return mem[NEXT] + return NEXT end) -FROMR = defPrim("R>", () -> begin +FROMR_CFA = defPrimWord("R>", () -> begin pushPS(popRS()) - return mem[NEXT] + return NEXT end) -RSPFETCH = defPrim("RSP@", () -> begin +RFETCH_CFA = defPrimWord("R@", () -> begin + pushPS(mem[reg.RSP]) + return NEXT +end) + +RSPFETCH_CFA = defPrimWord("RSP@", () -> begin pushPS(reg.RSP) - return mem[NEXT] + return NEXT end) -RSPSTORE = defPrim("RSP!", () -> begin - RSP = popPS() - return mem[NEXT] +RSPSTORE_CFA = defPrimWord("RSP!", () -> begin + reg.RSP = popPS() + return NEXT end) -RDROP = defPrim("RDROP", () -> begin +RDROP_CFA = defPrimWord("RDROP", () -> begin popRS() - return mem[NEXT] + return NEXT end) # Parameter Stack -PSPFETCH = defPrim("PSP@", () -> begin +PSPFETCH_CFA = defPrimWord("PSP@", () -> begin pushPS(reg.PSP) - return mem[NEXT] + return NEXT +end) + +PSPSTORE_CFA = defPrimWord("PSP!", () -> begin + reg.PSP = popPS() + return NEXT +end) + +# Working Register + +WFETCH_CFA = defPrimWord("W@", () -> begin + pushPS(reg.W) + return NEXT end) -PSPSTORE = defPrim("PSP!", () -> begin - PSP = popPS() - return mem[NEXT] +WSTORE_CFA = defPrimWord("W!", () -> begin + reg.W = popPS() + return NEXT end) # I/O -defConst("TIB", TIB) -NUMTIB, NUMTIB_CFA = defNewVar("#TIB", 0) -TOIN, TOIN_CFA = defNewVar(">IN", 0) +openFiles = Dict{Int64,IOStream}() +nextFileID = 1 +SOURCE_ID, SOURCE_ID_CFA = defNewVar("SOURCE-ID", 0) + + +## 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) + fnameLen = popPS() + fnameAddr = popPS() + fam = popPS() + + fname = getString(fnameAddr, fnameLen) + + if create && !isfile(fname) + pushPS(0) + pushPS(-1) # error + return NEXT + end -KEY = defPrim("KEY", () -> begin - if mem[TOIN] >= mem[NUMTIB] - mem[TOIN] = 0 - line = readline() - mem[NUMTIB] = length(line) - putString(line, TIB) + if (fam == FAM_RO) + mode = "r" + else + mode = "w" end - pushPS(mem[TIB + mem[TOIN]]) - mem[TOIN] += 1 + 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) + return NEXT +end) + +CLOSE_FILES_CFA = defPrimWord("CLOSE-FILES", () -> begin + for fh in values(openFiles) + close(fh) + end + empty!(openFiles) - return mem[NEXT] + return NEXT end) + -EMIT = defPrim("EMIT", () -> begin +EMIT_CFA = defPrimWord("EMIT", () -> begin print(Char(popPS())) - return mem[NEXT] + return NEXT end) -WORD = defPrim("WORD", () -> begin - - c = -1 +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 - skip_to_end = false - while true +function getKey() + raw_mode!(true) + byte = readbytes(STDIN, 1)[1] + raw_mode!(false) - callPrim(mem[KEY]) - c = Char(popPS()) + if byte == 0x0d + return 0x0a + elseif byte == 127 + return 0x08 + else + return byte + end +end - if c == '\\' - skip_to_end = true - continue - end +KEY_CFA = defPrimWord("KEY", () -> begin + pushPS(Int(getKey())) + return NEXT +end) - if skip_to_end - if c == '\n' - skip_to_end = false - end - continue - end +function getLineFromSTDIN() - if c == ' ' || c == '\t' - continue + function getFrag(s) + chars = collect(s) + slashIdx = findlast(chars, '\\') + + if slashIdx > 0 + return join(chars[slashIdx:length(chars)]) + else + return nothing end + end - break + function backspaceStr(s, bsCount) + oldLen = length(s) + newLen = max(0, oldLen - bsCount) + return join(collect(s)[1:newLen]) end - wordAddr = mem[HERE] - offset = 0 + line = "" + while true + key = Char(getKey()) + + if key == '\n' + print(" ") + return AbstractString(line) - if c == '\n' - # Treat newline as a special word + elseif key == '\x04' + if isempty(line) + return string("\x04") + end - mem[wordAddr + offset] = Int64(c) - pushPS(wordAddr) - pushPS(1) - return mem[NEXT] - end + elseif key == '\b' + if !isempty(line) + print("\b\033[K") + line = backspaceStr(line, 1) + end - while true - mem[wordAddr + offset] = Int64(c) - offset += 1 + elseif key == '\e' + # Strip ANSI escape sequence + nextKey = Char(getKey()) + if nextKey == '[' + while true + nextKey = Char(getKey()) + if nextKey >= '@' || nextKey <= '~' + break + end + end + end - callPrim(mem[KEY]) - c = Char(popPS()) + 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 - if c == ' ' || c == '\t' || c == '\n' - # Rewind KEY - mem[TOIN] -= 1 - break + else + print(key) + line = string(line, key) end end +end - wordLen = offset +SPAN, SPAN_CFA = defNewVar("SPAN", 0) +EXPECT_CFA = defPrimWord("EXPECT", () -> begin + maxLen = popPS() + addr = popPS() - pushPS(wordAddr) - pushPS(wordLen) + line = getLineFromSTDIN() - return mem[NEXT] -end) + mem[SPAN] = min(length(line), maxLen) + putString(line, addr, maxLen) -NUMBER = defPrim("NUMBER", () -> begin + return NEXT +end) - wordLen = popPS() - wordAddr = popPS() +BASE, BASE_CFA = defNewVar("BASE", 10) +NUMBER_CFA = defPrimWord("NUMBER", () -> begin + wordAddr = popPS()+1 + wordLen = mem[wordAddr-1] s = getString(wordAddr, wordLen) - try - pushPS(parse(Int64, s, mem[BASE])) - pushPS(0) - catch - pushPS(1) # Error indication - end + pushPS(parse(Int64, s, mem[BASE])) - return mem[NEXT] + return NEXT end) # Dictionary searches -FIND = defPrim("FIND", () -> begin +FROMLINK_CFA = defPrimWord("LINK>", () -> begin - wordLen = popPS() - wordAddr = popPS() + addr = popPS() + lenAndFlags = mem[addr+1] + len = lenAndFlags & F_LENMASK + + pushPS(addr + 2 + len) + + return NEXT +end) + +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 + +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 - - i = 0 - while (latest = mem[latest]) > 0 - lenAndFlags = mem[latest+1] + lfa = vocabCFA+1 + lenAndFlags = 0 + + 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 - pushPS(latest) - - return mem[NEXT] -end) - -TOCFA = defPrim(">CFA", () -> begin - - addr = popPS() - lenAndFlags = mem[addr+1] - len = lenAndFlags & F_LENMASK - - pushPS(addr + 2 + len) + if lfa > 0 + pushPS(lfa) + callPrim(mem[FROMLINK_CFA]) + if (lenAndFlags & F_IMMED) == F_IMMED + pushPS(1) + else + pushPS(-1) + end + else + pushPS(countedAddr) + pushPS(0) + end - return mem[NEXT] + return NEXT end) -TODFA = defWord(">DFA", [TOCFA, INCR, EXIT]) - -# Compilation - -CREATE = defPrim("CREATE", () -> begin +FIND_CFA = defPrimWord("FIND", () -> begin - wordLen = popPS() - wordAddr = popPS() - word = getString(wordAddr, wordLen) + countedAddr = popPS() + context = mem[CONTEXT:(CONTEXT+mem[NUMCONTEXT]-1)] - createHeader(word, 0) + for vocabCFA in reverse(context) + pushPS(countedAddr) + pushPS(vocabCFA) + callPrim(mem[FINDVOCAB_CFA]) - return mem[NEXT] -end) + callPrim(mem[DUP_CFA]) + if popPS() != 0 + return NEXT + else + popPS() + popPS() + end + end -COMMA = defPrim(",", () -> begin - mem[mem[HERE]] = popPS() - mem[HERE] += 1 + pushPS(countedAddr) + pushPS(0) - return mem[NEXT] + return NEXT end) -LBRAC = defPrim("[", () -> begin - mem[STATE] = 0 - return mem[NEXT] -end, flags=F_IMMED) - -RBRAC = defPrim("]", () -> begin - mem[STATE] = 1 - return mem[NEXT] -end, flags=F_IMMED) - -HIDDEN = defPrim("HIDDEN", () -> begin - addr = popPS() + 1 - mem[addr] = mem[addr] $ F_HIDDEN - return mem[NEXT] -end) - -HIDE = defWord("HIDE", - [WORD, - FIND, - HIDDEN, - EXIT]) - -COLON = defWord(":", - [WORD, - CREATE, - LIT, DOCOL, COMMA, - LATEST, FETCH, HIDDEN, - RBRAC, - EXIT]) - -SEMICOLON = defWord(";", - [LIT, EXIT, COMMA, - LATEST, FETCH, HIDDEN, - LBRAC, - EXIT], flags=F_IMMED) - -IMMEDIATE = defPrim("IMMEDIATE", () -> begin - lenAndFlagsAddr = mem[LATEST] + 1 - mem[lenAndFlagsAddr] = mem[lenAndFlagsAddr] $ F_IMMED - return mem[NEXT] -end, flags=F_IMMED) - -TICK = defWord("'", [WORD, FIND, TOCFA, EXIT]) # Branching -BRANCH = defPrim("BRANCH", () -> begin +BRANCH_CFA = defPrimWord("BRANCH", () -> begin reg.IP += mem[reg.IP] - return mem[NEXT] + return NEXT end) -ZBRANCH = defPrim("0BRANCH", () -> begin +ZBRANCH_CFA = defPrimWord("0BRANCH", () -> begin if (popPS() == 0) reg.IP += mem[reg.IP] else reg.IP += 1 end - return mem[NEXT] + return NEXT end) # Strings -LITSTRING = defPrim("LITSTRING", () -> begin +LITSTRING_CFA = defPrimWord("LITSTRING", () -> begin len = mem[reg.IP] reg.IP += 1 pushPS(reg.IP) pushPS(len) reg.IP += len - return mem[NEXT] + return NEXT end) -TELL = defPrim("TELL", () -> begin +TYPE_CFA = defPrimWord("TYPE", () -> begin len = popPS() addr = popPS() str = getString(addr, len) print(str) - return mem[NEXT] + return NEXT end) -# Outer interpreter +# Interpreter/Compiler-specific I/O + +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]) -INTERPRET = defPrim("INTERPRET", () -> begin +WORD_CFA = defPrimWord("WORD", () -> begin + delim = popPS() - callPrim(mem[WORD]) + # Chew up initial occurrences of delim + while (mem[TOIN]0 - # Word in dictionary + # Record count + mem[countAddr] = count + pushPS(countAddr) - isImmediate = (mem[wordAddr+1] & F_IMMED) != 0 - callPrim(mem[TOCFA]) + return NEXT +end) - callPrim(mem[ROT]) # get rid of extra copy of word string details - popPS() - popPS() +# Compilation - if mem[STATE] == 0 || isImmediate - # Execute! - return mem[popPS()] - else - # Append CFA to dictionary - callPrim(mem[COMMA]) - end - else - # Not in dictionary, assume number +STATE, STATE_CFA = defNewVar("STATE", 0) - popPS() +COMMA_CFA = defPrimWord(",", () -> begin + mem[mem[H]] = popPS() + mem[H] += 1 - callPrim(mem[NUMBER]) + return NEXT +end) - if popPS() != 0 - println("Parse error at word: '$wordName'") - return mem[NEXT] - else +HERE_CFA = defWord("HERE", + [H_CFA, FETCH_CFA, EXIT_CFA]) + +HEADER_CFA = defPrimWord("HEADER", () -> begin + wordAddr = popPS()+1 + wordLen = mem[wordAddr-1] + word = getString(wordAddr, wordLen) + + createHeader(word, 0) + + return NEXT +end) + +CREATE_CFA = defWord("CREATE", + [LIT_CFA, 32, WORD_CFA, HEADER_CFA, + LIT_CFA, DOVAR, COMMA_CFA, + EXIT_CFA]) + +DODOES = defPrim(() -> begin + pushRS(reg.IP) + reg.IP = popPS() + pushPS(reg.W + 1) + return NEXT +end, name="DODOES") + +DOES_HELPER_CFA = defPrimWord("(DOES>)", () -> begin + + pushPS(mem[mem[CURRENT]+1]) + callPrim(mem[FROMLINK_CFA]) + cfa = popPS() + + runtimeAddr = popPS() + + mem[cfa] = defPrim(eval(:(() -> begin + pushPS($(runtimeAddr)) + return DODOES + end)), name="doesPrim") + + return NEXT +end, flags=F_IMMED | F_HIDDEN) + +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_CFA = defPrimWord("[", () -> begin + mem[STATE] = 0 + return NEXT +end, flags=F_IMMED) + +RBRAC_CFA = defPrimWord("]", () -> begin + mem[STATE] = 1 + return NEXT +end, flags=F_IMMED) + +HIDDEN_CFA = defPrimWord("HIDDEN", () -> begin + lenAndFlagsAddr = mem[mem[CURRENT]+1] + 1 + mem[lenAndFlagsAddr] = mem[lenAndFlagsAddr] $ F_HIDDEN + return NEXT +end) + +COLON_CFA = defWord(":", + [LIT_CFA, 32, WORD_CFA, + HEADER_CFA, + LIT_CFA, DOCOL, COMMA_CFA, + HIDDEN_CFA, + RBRAC_CFA, + EXIT_CFA]) + +SEMICOLON_CFA = defWord(";", + [LIT_CFA, EXIT_CFA, COMMA_CFA, + HIDDEN_CFA, + LBRAC_CFA, + EXIT_CFA], flags=F_IMMED) + +IMMEDIATE_CFA = defPrimWord("IMMEDIATE", () -> begin + lenAndFlagsAddr = mem[mem[CURRENT]+1] + 1 + mem[lenAndFlagsAddr] = mem[lenAndFlagsAddr] $ F_IMMED + return NEXT +end, flags=F_IMMED) + +CODE_CFA = defPrimWord("CODE", () -> begin + pushPS(32) + callPrim(mem[WORD_CFA]) + callPrim(mem[HEADER_CFA]) + + exprString = "() -> begin\n" + while true + if mem[TOIN] >= mem[NUMTIB] + exprString = string(exprString, "\n") + if currentSource() == STDIN + println() + end + + pushPS(TIB) + pushPS(160) + callPrim(mem[EXPECT_CFA]) + mem[NUMTIB] = mem[SPAN] + mem[TOIN] = 0 end - if mem[STATE] == 0 - # Number already on stack! - else - # Append literal to dictionary - pushPS(LIT) - callPrim(mem[COMMA]) - callPrim(mem[COMMA]) + pushPS(32) + callPrim(mem[WORD_CFA]) + cAddr = popPS() + thisWord = getString(cAddr+1, mem[cAddr]) + + if uppercase(thisWord) == "END-CODE" + break end + + exprString = string(exprString, " ", thisWord) end + exprString = string(exprString, "\nreturn NEXT\nend") - return mem[NEXT] + func = eval(parse(exprString)) + dictWrite(defPrim(func)) + + return NEXT end) -QUIT = defWord("QUIT", - [RSP0_CFA, RSPSTORE, - INTERPRET, - BRANCH,-2]) +# Outer Interpreter -NL = defPrim("\n", () -> begin - if mem[STATE] == 0 - println(" ok") - end - return mem[NEXT] +EXECUTE_CFA = defPrimWord("EXECUTE", () -> begin + reg.W = popPS() + return mem[reg.W] end) -# Odds and Ends +INTERPRET_CFA = defWord("INTERPRET", + [LIT_CFA, 32, WORD_CFA, # Read next space-delimited word -CHAR = defPrim("CHAR", () -> begin - callPrim(mem[WORD]) - wordLen = popPS() - wordAddr = popPS() - word = getString(wordAddr, wordLen) - pushPS(Int64(word[1])) + DUP_CFA, FETCH_CFA, ZE_CFA, ZBRANCH_CFA, 3, + DROP_CFA, EXIT_CFA, # Exit if TIB is exhausted - return mem[NEXT] -end) + 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, -EXECUTE = defPrim("EXECUTE", () -> begin - return mem[popPS()] + # 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) -BYE = defPrim("BYE", () -> begin +QUIT_CFA = defWord("QUIT", + [LIT_CFA, 0, STATE_CFA, STORE_CFA, + LIT_CFA, 0, NUMTIB_CFA, STORE_CFA, + RSP0_CFA, RSPSTORE_CFA, + QUERY_CFA, + INTERPRET_CFA, PROMPT_CFA, + BRANCH_CFA,-4]) + +ABORT_CFA = defWord("ABORT", + [CLOSE_FILES_CFA, PSP0_CFA, PSPSTORE_CFA, QUIT_CFA]) + +BYE_CFA = defPrimWord("BYE", () -> begin + println("\nBye!") return 0 end) #### VM loop #### -function runVM() + +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 + +function run(;initialize=true) + + global initialized, initFileName + if !initialized && initialize + if initFileName != nothing + print("Including definitions from $initFileName...") + + # TODO + + 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 + reg.IP = QUIT_CFA + 1 # Primitive processing loop. # Everyting else is simply a consequence of this loop! - jmp = mem[NEXT] - while (jmp = callPrim(jmp)) != 0 - println("Evaluating prim $jmp [$(primNames[-jmp])]") + jmp = NEXT + while jmp != 0 + try + #println("Entering prim $(getPrimName(jmp))") + jmp = callPrim(jmp) + + catch ex + showerror(STDOUT, ex) + println() + + # QUIT + reg.IP = ABORT_CFA + 1 + jmp = NEXT + end end 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) @@ -916,16 +1257,16 @@ function dump(startAddr::Int64; count::Int64 = 100, cellsPerLine::Int64 = 10) i += 1 end - println("\t", ASCIIString(chars)) + println("\t", AbstractString(chars)) end 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() @@ -935,11 +1276,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() @@ -948,4 +1289,14 @@ function printRS() end end +DUMP = defPrimWord("DUMP", () -> begin + count = popPS() + addr = popPS() + + println() + dump(addr, count=count) + + return NEXT +end) + end