X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?p=forth.jl.git;a=blobdiff_plain;f=src%2Fforth.jl;h=9439dead46913871d9255834a9272713cad19433;hp=a52b67534031c76d2105cca5d38abb6b1160f8c6;hb=6cb12b03e2a154214fc60d7c437e650e79fb42e5;hpb=9131cbd1d39efc223c1c6307e7bcbdda500ffa8e diff --git a/src/forth.jl b/src/forth.jl index a52b675..9439dea 100644 --- a/src/forth.jl +++ b/src/forth.jl @@ -1,34 +1,14 @@ module forth # 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 as negative indicies -# into the primitives array which contains 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}() @@ -36,18 +16,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,28 +34,19 @@ 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 -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 - mem[RSP0] -getPSDepth() = reg.PSP - mem[PSP0] - function ensurePSDepth(depth::Int64) - if getPSDepth()=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 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 | NFA_MARK; 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 @@ -147,13 +129,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 @@ -172,11 +154,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 @@ -184,10 +166,12 @@ end function defConst(name::AbstractString, val::Int64; flags::Int64=0) createHeader(name, flags) - mem[mem[HERE]] = DOCON; mem[HERE] += 1 - mem[mem[HERE]] = val; mem[HERE] += 1 + codeWordAddr = mem[H] - return val + mem[mem[H]] = DOCON; mem[H] += 1 + mem[mem[H]] = val; mem[H] += 1 + + return codeWordAddr end # Threading Primitives (inner interpreter) @@ -214,38 +198,39 @@ DOCON = defPrim(() -> begin return NEXT end, name="DOVAR") -EXIT = defPrimWord("EXIT", () -> begin +EXIT_CFA = defPrimWord("EXIT", () -> begin reg.IP = popRS() return NEXT 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) defConst("DOVAR", DOVAR) defConst("DICT", DICT) +defConst("MEMSIZE", size_mem) -F_IMMED = defConst("F_IMMED", 128) -F_HIDDEN = defConst("F_HIDDEN", 256) -F_LENMASK = defConst("F_LENMASK", 127) - - +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 = 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) @@ -253,19 +238,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() @@ -275,7 +260,7 @@ ROT = defPrimWord("ROT", () -> begin return NEXT end) -NROT = defPrimWord("-ROT", () -> begin +NROT_CFA = defPrimWord("-ROT", () -> begin a = popPS() b = popPS() c = popPS() @@ -286,13 +271,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] @@ -301,7 +286,7 @@ TWODUP = defPrimWord("2DUP", () -> begin return NEXT end) -TWOSWAP = defPrimWord("2SWAP", () -> begin +TWOSWAP_CFA = defPrimWord("2SWAP", () -> begin a = popPS() b = popPS() c = popPS() @@ -313,7 +298,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] @@ -322,7 +307,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 @@ -331,52 +316,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) @@ -385,117 +370,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) -EQU = defPrimWord("=", () -> begin +EQ_CFA = defPrimWord("=", () -> begin b = popPS() a = popPS() pushPS(a==b ? -1 : 0) return NEXT end) -NEQU = 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) -ZEQU = defPrimWord("0=", () -> begin +ZE_CFA = defPrimWord("0=", () -> begin pushPS(popPS() == 0 ? -1 : 0) return NEXT end) -ZNEQU = 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) 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 @@ -503,27 +488,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 @@ -533,56 +518,56 @@ 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 - RSP = popPS() +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 - PSP = popPS() +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) @@ -592,127 +577,141 @@ end) sources = Array{Any,1}() currentSource() = sources[length(sources)] -defConst("TIB", TIB) -NUMTIB, NUMTIB_CFA = defNewVar("#TIB", 0) -TOIN, TOIN_CFA = defNewVar(">IN", 0) -EOF = defConst("EOF", 4) - -KEY = defPrimWord("KEY", () -> begin - if mem[TOIN] >= mem[NUMTIB] - mem[TOIN] = 0 - - if !eof(currentSource()) - line = readline(currentSource()) - mem[NUMTIB] = length(line) - putString(line, TIB) - else - mem[NUMTIB] = 1 - mem[TIB] = EOF - end +EOF_CFA = defPrimWord("\x04", () -> begin + if currentSource() != STDIN + close(pop!(sources)) + return NEXT + else + return 0 end - - pushPS(mem[TIB + mem[TOIN]]) - mem[TOIN] += 1 - - return NEXT end) -EMIT = defPrimWord("EMIT", () -> begin +EMIT_CFA = defPrimWord("EMIT", () -> begin print(Char(popPS())) return NEXT end) -WORD = defPrimWord("WORD", () -> begin +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) - eof_char = Char(EOF) - c = eof_char + if byte == 0x0d + return 0x0a + elseif byte == 127 + return 0x08 + else + return byte + end +end - skip_to_end = false +KEY_CFA = defPrimWord("KEY", () -> begin + pushPS(Int(getKey())) + return NEXT +end) + +function getLineFromSTDIN() + line = "" while true + key = Char(getKey()) - callPrim(mem[KEY]) - c = Char(popPS()) + if key == '\n' + print(" ") + return ASCIIString(line) - if c == '\\' - skip_to_end = true - continue - end + elseif key == '\x04' + if isempty(line) + return string("\x04") + end - if skip_to_end - if c == '\n' || c == eof_char - skip_to_end = false + elseif key == '\b' + if !isempty(line) + line = line[1:length(line)-1] + print("\b \b") end - continue - end - if c == ' ' || c == '\t' - continue - 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 - break + else + print(key) + line = string(line, key) + end end +end - wordAddr = mem[HERE] - offset = 0 - - if c == '\n' || c == eof_char - # Treat newline as a special word +SPAN, SPAN_CFA = defNewVar("SPAN", 0) +EXPECT_CFA = defPrimWord("EXPECT", () -> begin + maxLen = popPS() + addr = popPS() - mem[wordAddr + offset] = Int64(c) - pushPS(wordAddr) - pushPS(1) - return NEXT + if currentSource() == STDIN + line = getLineFromSTDIN() + else + if !eof(currentSource()) + line = chomp(readline(currentSource())) + else + line = "\x04" # eof + end end - while true - mem[wordAddr + offset] = Int64(c) - offset += 1 + mem[SPAN] = min(length(line), maxLen) + putString(line[1:mem[SPAN]], addr) - callPrim(mem[KEY]) - c = Char(popPS()) + return NEXT +end) - if c == ' ' || c == '\t' || c == '\n' || c == eof_char - # Rewind KEY - mem[TOIN] -= 1 - break - end - end +BASE, BASE_CFA = defNewVar("BASE", 10) +NUMBER_CFA = defPrimWord("NUMBER", () -> begin + wordAddr = popPS()+1 + wordLen = mem[wordAddr-1] - wordLen = offset + s = getString(wordAddr, wordLen) - pushPS(wordAddr) - pushPS(wordLen) + pushPS(parse(Int64, s, mem[BASE])) return NEXT end) -BASE, BASE_CFA = defNewVar("BASE", 10) -NUMBER = defPrimWord("NUMBER", () -> begin +# Dictionary searches - wordLen = popPS() - wordAddr = popPS() +TOCFA_CFA = defPrimWord(">CFA", () -> begin - s = getString(wordAddr, wordLen) + addr = popPS() + lenAndFlags = mem[addr+1] + len = lenAndFlags & F_LENMASK - try - pushPS(parse(Int64, s, mem[BASE])) - pushPS(0) - catch - pushPS(1) # Error indication - end + pushPS(addr + 2 + len) return NEXT end) -# Dictionary searches +TOBODY_CFA = defWord(">BODY", [INCR_CFA, EXIT_CFA]) -FIND = defPrimWord("FIND", () -> begin +FIND_CFA = defPrimWord("FIND", () -> begin - wordLen = popPS() - wordAddr = popPS() + countedAddr = popPS() + wordAddr = countedAddr + 1 + wordLen = mem[countedAddr] word = lowercase(getString(wordAddr, wordLen)) latest = LATEST + lenAndFlags = 0 i = 0 while (latest = mem[latest]) > 0 @@ -732,32 +731,31 @@ 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_CFA]) + if (lenAndFlags & F_IMMED) == F_IMMED + pushPS(1) + else + pushPS(-1) + end + else + pushPS(countedAddr) + pushPS(0) + end return NEXT end) -TODFA = defWord(">DFA", [TOCFA, INCR, EXIT]) # 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 @@ -767,190 +765,233 @@ ZBRANCH = defPrimWord("0BRANCH", () -> begin return NEXT end) -# Compilation - -HEADER = defPrimWord("HEADER", () -> begin +# Strings - wordLen = popPS() - wordAddr = popPS() - word = getString(wordAddr, wordLen) +LITSTRING_CFA = defPrimWord("LITSTRING", () -> begin + len = mem[reg.IP] + reg.IP += 1 + pushPS(reg.IP) + pushPS(len) + reg.IP += len - createHeader(word, 0) + return NEXT +end) +TYPE_CFA = defPrimWord("TYPE", () -> begin + len = popPS() + addr = popPS() + str = getString(addr, len) + print(str) return NEXT end) -COMMA = defPrimWord(",", () -> begin - mem[mem[HERE]] = popPS() - mem[HERE] += 1 +# 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]) + +WORD_CFA = defPrimWord("WORD", () -> begin + delim = popPS() + + # Chew up initial occurrences of delim + while (mem[TOIN] begin - mem[STATE] = 0 - return NEXT -end, flags=F_IMMED) +STATE, STATE_CFA = defNewVar("STATE", 0) -RBRAC = defPrimWord("]", () -> begin - mem[STATE] = 1 - return NEXT -end, flags=F_IMMED) +COMMA_CFA = defPrimWord(",", () -> begin + mem[mem[H]] = popPS() + mem[H] += 1 -HIDDEN = defPrimWord("HIDDEN", () -> begin - addr = popPS() + 1 - mem[addr] = mem[addr] $ F_HIDDEN return NEXT end) -HIDE = defWord("HIDE", - [WORD, - FIND, - HIDDEN, - EXIT]) +HERE_CFA = defWord("HERE", + [H_CFA, FETCH_CFA, EXIT_CFA]) -COLON = defWord(":", - [WORD, - HEADER, - LIT, DOCOL, COMMA, - LATEST_CFA, FETCH, HIDDEN, - RBRAC, - EXIT]) +HEADER_CFA = defPrimWord("HEADER", () -> begin + wordAddr = popPS()+1 + wordLen = mem[wordAddr-1] + word = getString(wordAddr, wordLen) -SEMICOLON = defWord(";", - [LIT, EXIT, COMMA, - LATEST_CFA, FETCH, HIDDEN, - LBRAC, - EXIT], flags=F_IMMED) + createHeader(word, 0) -IMMEDIATE = defPrimWord("IMMEDIATE", () -> begin - lenAndFlagsAddr = mem[LATEST] + 1 - mem[lenAndFlagsAddr] = mem[lenAndFlagsAddr] $ F_IMMED return NEXT -end, flags=F_IMMED) +end) -TICK = defWord("'", - [WORD, FIND, TOCFA, EXIT]) +CREATE_CFA = defWord("CREATE", + [LIT_CFA, 32, WORD_CFA, HEADER_CFA, + LIT_CFA, DOVAR, COMMA_CFA, + EXIT_CFA]) -BTICK = defWord("[']", - [FROMR, DUP, INCR, TOR, FETCH, EXIT]) +DODOES = defPrim(() -> begin + pushRS(reg.IP) + reg.IP = popPS() + pushPS(reg.W + 1) + return NEXT +end, name="DODOES") +DOES_HELPER_CFA = defPrimWord("(DOES>)", () -> begin -# Strings + pushPS(mem[LATEST]) + callPrim(mem[TOCFA_CFA]) + cfa = popPS() -LITSTRING = defPrimWord("LITSTRING", () -> begin - len = mem[reg.IP] - reg.IP += 1 - pushPS(reg.IP) - pushPS(len) - reg.IP += len + runtimeAddr = popPS() + + mem[cfa] = defPrim(eval(:(() -> begin + pushPS($(runtimeAddr)) + return DODOES + end)), name="doesPrim") return NEXT -end) +end, flags=F_IMMED) -TELL = defPrimWord("TELL", () -> begin - len = popPS() - addr = popPS() - str = getString(addr, len) - print(str) +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) +end, flags=F_IMMED) -# Outer interpreter +RBRAC_CFA = defPrimWord("]", () -> begin + mem[STATE] = 1 + return NEXT +end, flags=F_IMMED) -EXECUTE = defPrimWord("EXECUTE", () -> begin - reg.W = popPS() - return mem[reg.W] +HIDDEN_CFA = defPrimWord("HIDDEN", () -> begin + lenAndFlagsAddr = mem[LATEST] + 1 + mem[lenAndFlagsAddr] = mem[lenAndFlagsAddr] $ F_HIDDEN + return NEXT end) -type ParseError <: Exception - wordName::ASCIIString -end -Base.showerror(io::IO, ex::ParseError) = print(io, "Parse error at word: '$(ex.wordName)'.") +COLON_CFA = defWord(":", + [LIT_CFA, 32, WORD_CFA, + HEADER_CFA, + LIT_CFA, DOCOL, COMMA_CFA, + HIDDEN_CFA, + RBRAC_CFA, + EXIT_CFA]) -DEBUG, DEBUG_CFA = defNewVar("DEBUG", 0) +SEMICOLON_CFA = defWord(";", + [LIT_CFA, EXIT_CFA, COMMA_CFA, + HIDDEN_CFA, + LBRAC_CFA, + EXIT_CFA], flags=F_IMMED) -INTERPRET = defPrimWord("INTERPRET", () -> begin +IMMEDIATE_CFA = defPrimWord("IMMEDIATE", () -> begin + lenAndFlagsAddr = mem[LATEST] + 1 + mem[lenAndFlagsAddr] = mem[lenAndFlagsAddr] $ F_IMMED + return NEXT +end, flags=F_IMMED) - callPrim(mem[WORD]) +# Outer Interpreter - wordName = getString(mem[reg.PSP-1], mem[reg.PSP]) - if mem[DEBUG] != 0 - println("... ", replace(replace(wordName, "\004", "EOF"), "\n", "\\n"), " ...") - end +EXECUTE_CFA = defPrimWord("EXECUTE", () -> begin + reg.W = popPS() + return mem[reg.W] +end) - callPrim(mem[TWODUP]) - callPrim(mem[FIND]) +INTERPRET_CFA = defWord("INTERPRET", + [LIT_CFA, 32, WORD_CFA, # Read next space-delimited word - wordAddr = mem[reg.PSP] + DUP_CFA, FETCH_CFA, ZE_CFA, ZBRANCH_CFA, 3, + DROP_CFA, EXIT_CFA, # Exit if TIB is exhausted - if wordAddr>0 - # Word in dictionary + STATE_CFA, FETCH_CFA, ZBRANCH_CFA, 24, + # Compiling + FIND_CFA, QDUP_CFA, ZBRANCH_CFA, 13, - isImmediate = (mem[wordAddr+1] & F_IMMED) != 0 - callPrim(mem[TOCFA]) + # Found word. + LIT_CFA, -1, EQ_CFA, INVERT_CFA, ZBRANCH_CFA, 4, - callPrim(mem[NROT]) # get rid of extra copy of word string details - popPS() - popPS() + # Immediate: Execute! + EXECUTE_CFA, BRANCH_CFA, -26, - if mem[STATE] == 0 || isImmediate - # Execute! - return callPrim(mem[EXECUTE]) - else - # Append CFA to dictionary - callPrim(mem[COMMA]) - end - else - # Not in dictionary, assume number + # Not immediate: Compile! + COMMA_CFA, BRANCH_CFA, -29, - popPS() + # 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, - callPrim(mem[NUMBER]) + # Found word. Execute! + DROP_CFA, EXECUTE_CFA, BRANCH_CFA, -44, - if popPS() != 0 - throw(ParseError(wordName)) - end + # No word found, parse number and leave on stack + NUMBER_CFA, BRANCH_CFA, -47, + EXIT_CFA]) - if mem[STATE] == 0 - # Number already on stack! - else - # Append literal to dictionary - pushPS(LIT) - callPrim(mem[COMMA]) - callPrim(mem[COMMA]) - end +PROMPT_CFA = defPrimWord("PROMPT", () -> begin + if (mem[STATE] == 0 && currentSource() == STDIN) + println(" ok") end return NEXT end) -QUIT = defWord("QUIT", - [RSP0_CFA, RSPSTORE, - INTERPRET, - BRANCH,-2]) +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]) -BYE = defPrimWord("BYE", () -> begin - return 0 -end) +ABORT_CFA = defWord("ABORT", + [PSP0_CFA, PSPSTORE_CFA, QUIT_CFA]) -PROMPT = defPrimWord("PROMPT", () -> begin - println(" ok") +BYE_CFA = defPrimWord("BYE", () -> begin + println("\nBye!") + return 0 end) -NL = defPrimWord("\n", () -> begin - if mem[STATE] == 0 && currentSource() == STDIN - callPrim(mem[PROMPT]) - end - return NEXT -end, flags=F_IMMED) +# File I/O -INCLUDE = defPrimWord("INCLUDE", () -> begin - callPrim(mem[WORD]) - wordLen = popPS() - wordAddr = popPS() +INCLUDE_CFA = defPrimWord("INCLUDE", () -> begin + pushPS(32) + callPrim(mem[WORD_CFA]) + wordAddr = popPS()+1 + wordLen = mem[wordAddr-1] word = getString(wordAddr, wordLen) push!(sources, open(word, "r")) @@ -961,35 +1002,8 @@ INCLUDE = defPrimWord("INCLUDE", () -> begin return NEXT end) -EOF_WORD = defPrimWord("\x04", () -> begin - if currentSource() != STDIN - close(currentSource()) - end - - pop!(sources) - - if length(sources)>0 - if currentSource() == STDIN - callPrim(mem[PROMPT]) - end - - return NEXT - else - return 0 - end -end, flags=F_IMMED) - -# Odds and Ends -CHAR = defPrimWord("CHAR", () -> begin - callPrim(mem[WORD]) - wordLen = popPS() - wordAddr = popPS() - word = getString(wordAddr, wordLen) - pushPS(Int64(word[1])) - - return NEXT -end) +#### VM loop #### initialized = false initFileName = nothing @@ -999,8 +1013,6 @@ elseif isfile(Pkg.dir("forth/src/lib.4th")) initFileName = Pkg.dir("forth/src/lib.4th") end - -#### VM loop #### function run(;initialize=true) # Begin with STDIN as source push!(sources, STDIN) @@ -1017,17 +1029,14 @@ function run(;initialize=true) 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 = NEXT while jmp != 0 try - if mem[DEBUG] != 0 - println("Evaluating prim ", jmp," ", primNames[-jmp]) - end - + #println("Entering prim $(getPrimName(jmp))") jmp = callPrim(jmp) catch ex @@ -1038,11 +1047,8 @@ function run(;initialize=true) close(pop!(sources)) end - mem[STATE] = 0 - mem[NUMTIB] = 0 - reg.PSP = mem[PSP0] - reg.RSP = mem[RSP0] - reg.IP = QUIT + 1 + # QUIT + reg.IP = ABORT_CFA + 1 jmp = NEXT end end @@ -1050,6 +1056,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) @@ -1084,11 +1100,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() @@ -1098,11 +1114,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() @@ -1115,6 +1131,7 @@ DUMP = defPrimWord("DUMP", () -> begin count = popPS() addr = popPS() + println() dump(addr, count=count) return NEXT