X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=blobdiff_plain;f=src%2Fforth.jl;h=4b714992dbaf249c7fb6116dd6a67a339bc03ba2;hb=b18e42773e45b9d4819cf0e2d2c5965bd34dcb4f;hp=3a2509bf367af2046c06304b7f4ef9220d0b3ae4;hpb=61231ed1d5237aa1271be30f458acb7e5c773bda;p=forth.jl.git diff --git a/src/forth.jl b/src/forth.jl index 3a2509b..4b71499 100644 --- a/src/forth.jl +++ b/src/forth.jl @@ -1,12 +1,12 @@ 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 +size_RS = 1000 # Return stack size +size_PS = 1000 # Parameter stack size +size_TIB = 1000 # Terminal input buffer size # The mem array constitutes the memory of the VM. It has the following geography: # @@ -36,18 +36,16 @@ primNames = Array{ASCIIString,1}() # Built-in variables nextVarAddr = 1 -RSP0 = nextVarAddr; nextVarAddr += 1 -PSP0 = nextVarAddr; nextVarAddr += 1 -HERE = nextVarAddr; nextVarAddr += 1 +H = nextVarAddr; nextVarAddr += 1 LATEST = nextVarAddr; nextVarAddr += 1 -mem[RSP0] = nextVarAddr # bottom of RS -mem[PSP0] = mem[RSP0] + size_RS # bottom of PS -TIB = mem[PSP0] + size_PS # address of terminal input buffer -mem[HERE] = TIB + size_TIB # location of bottom of dictionary -mem[LATEST] = 0 # no previous definition +RSP0 = nextVarAddr # bottom of RS +PSP0 = RSP0 + size_RS # bottom of PS +TIB = PSP0 + size_PS # address of terminal input buffer +mem[H] = TIB + size_TIB # location of bottom of dictionary +mem[LATEST] = 0 # no previous definition -DICT = mem[HERE] # Save bottom of dictionary as constant +DICT = mem[H] # Save bottom of dictionary as constant # VM registers type Reg @@ -56,7 +54,7 @@ type Reg IP::Int64 # Instruction pointer W::Int64 # Working register end -reg = Reg(mem[RSP0], mem[PSP0], 0, 0) +reg = Reg(RSP0, PSP0, 0, 0) # Stack manipulation functions @@ -66,8 +64,8 @@ type ReturnStackUnderflow <: Exception end Base.showerror(io::IO, ex::ParamStackUnderflow) = print(io, "Parameter stack underflow.") Base.showerror(io::IO, ex::ReturnStackUnderflow) = print(io, "Return stack underflow.") -getRSDepth() = reg.RSP - mem[RSP0] -getPSDepth() = reg.PSP - mem[PSP0] +getRSDepth() = reg.RSP - RSP0 +getPSDepth() = reg.PSP - PSP0 function ensurePSDepth(depth::Int64) if getPSDepth()=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 -# Word creation +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,19 +158,19 @@ 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 end -# Variable creation +# Variable creation functions function defExistingVar(name::AbstractString, varAddr::Int64; flags::Int64=0) @@ -172,27 +183,24 @@ 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 - f = eval(:(() -> begin - pushPS($(varAddr)) - return NEXT - end)) - - mem[mem[HERE]] = defPrim(f, name=name); 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 function defConst(name::AbstractString, val::Int64; flags::Int64=0) - defPrimWord(name, eval(:(() -> begin - pushPS($(val)) - return NEXT - end))) + createHeader(name, flags) - return val + codeWordAddr = mem[H] + + mem[mem[H]] = DOCON; mem[H] += 1 + mem[mem[H]] = val; mem[H] += 1 + + return codeWordAddr end # Threading Primitives (inner interpreter) @@ -209,11 +217,41 @@ DOCOL = defPrim(() -> begin return NEXT end, name="DOCOL") +DOVAR = defPrim(() -> begin + pushPS(reg.W + 1) + return NEXT +end, name="DOVAR") + +DOCON = defPrim(() -> begin + pushPS(mem[reg.W + 1]) + return NEXT +end, name="DOVAR") + EXIT = defPrimWord("EXIT", () -> begin reg.IP = popRS() return NEXT 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) + +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 = defPrimWord("DROP", () -> begin @@ -245,9 +283,9 @@ ROT = defPrimWord("ROT", () -> begin a = popPS() b = popPS() c = popPS() + pushPS(b) pushPS(a) pushPS(c) - pushPS(b) return NEXT end) @@ -255,12 +293,13 @@ NROT = defPrimWord("-ROT", () -> begin a = popPS() b = popPS() c = popPS() - pushPS(b) pushPS(a) pushPS(c) + pushPS(b) return NEXT end) + TWODROP = defPrimWord("2DROP", () -> begin popPS() popPS() @@ -283,8 +322,17 @@ TWOSWAP = defPrimWord("2SWAP", () -> begin d = popPS() pushPS(b) pushPS(a) - pushPS(c) pushPS(d) + pushPS(c) + return NEXT +end) + +TWOOVER = defPrimWord("2OVER", () -> begin + ensurePSDepth(4) + a = mem[reg.PSP-3] + b = mem[reg.PSP-2] + pushPS(a) + pushPS(b) return NEXT end) @@ -351,14 +399,24 @@ DIVMOD = defPrimWord("/MOD", () -> begin return NEXT end) -EQU = defPrimWord("=", () -> begin +TWOMUL = defPrimWord("2*", () -> begin + pushPS(popPS() << 1) + return NEXT +end) + +TWODIV = defPrimWord("2/", () -> begin + pushPS(popPS() >> 1) + return NEXT +end) + +EQ = defPrimWord("=", () -> begin b = popPS() a = popPS() pushPS(a==b ? -1 : 0) return NEXT end) -NEQU = defPrimWord("<>", () -> begin +NE = defPrimWord("<>", () -> begin b = popPS() a = popPS() pushPS(a!=b ? -1 : 0) @@ -393,12 +451,12 @@ GE = defPrimWord(">=", () -> begin return NEXT end) -ZEQU = defPrimWord("0=", () -> begin +ZE = defPrimWord("0=", () -> begin pushPS(popPS() == 0 ? -1 : 0) return NEXT end) -ZNEQU = defPrimWord("0<>", () -> begin +ZNE = defPrimWord("0<>", () -> begin pushPS(popPS() != 0 ? -1 : 0) return NEXT end) @@ -487,24 +545,6 @@ SUBSTORE = defPrimWord("-!", () -> begin 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 = defPrimWord(">R", () -> begin @@ -517,13 +557,18 @@ FROMR = defPrimWord("R>", () -> begin return NEXT end) +RFETCH = defPrimWord("R@", () -> begin + pushPS(mem[reg.RSP]) + return NEXT +end) + RSPFETCH = defPrimWord("RSP@", () -> begin pushPS(reg.RSP) return NEXT end) RSPSTORE = defPrimWord("RSP!", () -> begin - RSP = popPS() + reg.RSP = popPS() return NEXT end) @@ -540,7 +585,7 @@ PSPFETCH = defPrimWord("PSP@", () -> begin end) PSPSTORE = defPrimWord("PSP!", () -> begin - PSP = popPS() + reg.PSP = popPS() return NEXT end) @@ -561,29 +606,13 @@ 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 = 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 @@ -591,96 +620,127 @@ EMIT = defPrimWord("EMIT", () -> begin 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 - eof_char = Char(EOF) - c = eof_char +function getKey() + raw_mode!(true) + byte = readbytes(STDIN, 1)[1] + raw_mode!(false) - skip_to_end = false + if byte == 0x0d + return 0x0a + elseif byte == 127 + return 0x08 + else + return byte + end +end + +KEY = defPrimWord("KEY", () -> begin + pushPS(Int(getKey())) + return NEXT +end) + +function getLineFromSTDIN() + line = "" while true + key = Char(getKey()) - 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 = 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 = 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) -NUMBER = defPrimWord("NUMBER", () -> begin +# Dictionary searches - wordLen = popPS() - wordAddr = popPS() +TOCFA = 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 = defWord(">BODY", [INCR, EXIT]) FIND = 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 @@ -700,23 +760,22 @@ FIND = defPrimWord("FIND", () -> begin end end - pushPS(latest) - - return NEXT -end) - -TOCFA = defPrimWord(">CFA", () -> begin - - addr = popPS() - lenAndFlags = mem[addr+1] - len = lenAndFlags & F_LENMASK - - pushPS(addr + 2 + len) + if latest > 0 + pushPS(latest) + callPrim(mem[TOCFA]) + if (lenAndFlags & F_IMMED) == F_IMMED + pushPS(1) + else + pushPS(-1) + end + else + pushPS(countedAddr) + pushPS(0) + end return NEXT end) -TODFA = defWord(">DFA", [TOCFA, INCR, EXIT]) # Branching @@ -735,73 +794,6 @@ ZBRANCH = defPrimWord("0BRANCH", () -> begin return NEXT end) -# Compilation - -CREATE = defPrimWord("CREATE", () -> begin - - wordLen = popPS() - wordAddr = popPS() - word = getString(wordAddr, wordLen) - - createHeader(word, 0) - - return NEXT -end) - -COMMA = defPrimWord(",", () -> begin - mem[mem[HERE]] = popPS() - mem[HERE] += 1 - - return NEXT -end) - -LBRAC = defPrimWord("[", () -> begin - mem[STATE] = 0 - return NEXT -end, flags=F_IMMED) - -RBRAC = defPrimWord("]", () -> begin - mem[STATE] = 1 - return NEXT -end, flags=F_IMMED) - -HIDDEN = defPrimWord("HIDDEN", () -> begin - addr = popPS() + 1 - mem[addr] = mem[addr] $ F_HIDDEN - return NEXT -end) - -HIDE = defWord("HIDE", - [WORD, - FIND, - HIDDEN, - EXIT]) - -COLON = defWord(":", - [WORD, - CREATE, - LIT, DOCOL, COMMA, - LATEST_CFA, FETCH, HIDDEN, - RBRAC, - EXIT]) - -SEMICOLON = defWord(";", - [LIT, EXIT, COMMA, - LATEST_CFA, FETCH, HIDDEN, - LBRAC, - EXIT], flags=F_IMMED) - -IMMEDIATE = defPrimWord("IMMEDIATE", () -> begin - lenAndFlagsAddr = mem[LATEST] + 1 - mem[lenAndFlagsAddr] = mem[lenAndFlagsAddr] $ F_IMMED - return NEXT -end, flags=F_IMMED) - -TICK = defWord("'", - [STATE_CFA, FETCH, ZBRANCH, 7, - FROMR, DUP, INCR, TOR, FETCH, EXIT, - WORD, FIND, TOCFA, EXIT]) - # Strings LITSTRING = defPrimWord("LITSTRING", () -> begin @@ -814,7 +806,7 @@ LITSTRING = defPrimWord("LITSTRING", () -> begin return NEXT end) -TELL = defPrimWord("TELL", () -> begin +TYPE = defPrimWord("TYPE", () -> begin len = popPS() addr = popPS() str = getString(addr, len) @@ -824,89 +816,163 @@ end) # Outer interpreter +TRACE = defPrimWord("TRACE", () -> begin + println("reg.W: $(reg.W) reg.IP: $(reg.IP)") + print("PS: "); printPS() + print("RS: "); printRS() + print("[paused]") + readline() + + return NEXT +end) + +COMMA = defPrimWord(",", () -> begin + mem[mem[H]] = popPS() + mem[H] += 1 + + return NEXT +end) + +BTICK = defWord("[']", + [FROMR, DUP, INCR, TOR, FETCH, EXIT]) + EXECUTE = defPrimWord("EXECUTE", () -> begin reg.W = popPS() return mem[reg.W] end) -INTERPRET = defPrimWord("INTERPRET", () -> begin +TIB_CFA = defConst("TIB", TIB) +NUMTIB, NUMTIB_CFA = defNewVar("#TIB", 0) +TOIN, TOIN_CFA = defNewVar(">IN", 0) - callPrim(mem[WORD]) +QUERY = defWord("QUERY", + [TIB_CFA, LIT, 160, EXPECT, + SPAN_CFA, FETCH, NUMTIB_CFA, STORE, + LIT, 0, TOIN_CFA, STORE, + EXIT]) - wordName = getString(mem[reg.PSP-1], mem[reg.PSP]) - #println("... ", replace(replace(wordName, "\004", "EOF"), "\n", "\\n"), " ...") +WORD = defPrimWord("WORD", () -> begin + delim = popPS() - callPrim(mem[TWODUP]) - callPrim(mem[FIND]) + # Chew up initial occurrences of delim + while (mem[TOIN]0 - # Word in dictionary + # Start reading in word + count = 0 + while (mem[TOIN] begin + delim = popPS() - if popPS() != 0 - println("Parse error at word: '$wordName'") - return NEXT - end + # Chew up initial occurrences of delim + addr = mem[H] - if mem[STATE] == 0 - # Number already on stack! - else - # Append literal to dictionary - pushPS(LIT) - callPrim(mem[COMMA]) - callPrim(mem[COMMA]) + # Start reading input stream + count = 0 + while (mem[TOIN] begin + println("\nBye!") return 0 end) -PROMPT = defPrimWord("PROMPT", () -> begin - println(" ok") -end) +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, -NL = defPrimWord("\n", () -> begin - if mem[STATE] == 0 && currentSource() == STDIN - callPrim(mem[PROMPT]) + # 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, flags=F_IMMED) +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]) - wordLen = popPS() - wordAddr = popPS() + wordAddr = popPS()+1 + wordLen = mem[wordAddr-1] word = getString(wordAddr, wordLen) push!(sources, open(word, "r")) @@ -917,41 +983,116 @@ INCLUDE = defPrimWord("INCLUDE", () -> begin return NEXT end) -EOF_WORD = defPrimWord("\x04", () -> begin - if currentSource() != STDIN - close(currentSource()) - end +# Compilation - pop!(sources) +HERE = defWord("HERE", + [H_CFA, FETCH, EXIT]) - if length(sources)>0 - if currentSource() == STDIN - callPrim(mem[PROMPT]) - end +HEADER = defPrimWord("HEADER", () -> begin + wordAddr = popPS()+1 + wordLen = mem[wordAddr-1] + word = getString(wordAddr, wordLen) - return NEXT - else - return 0 - end + createHeader(word, 0) + + return NEXT +end) + +CREATE = defWord("CREATE", + [LIT, 32, WORD, HEADER, + LIT, DOVAR, COMMA, + EXIT]) + +DODOES = defPrim(() -> begin + pushRS(reg.IP) + reg.IP = popPS() + pushPS(reg.W + 1) + return NEXT +end, name="DODOES") + +DOES_HELPER = defPrimWord("(DOES>)", () -> begin + + pushPS(mem[LATEST]) + callPrim(mem[TOCFA]) + cfa = popPS() + + runtimeAddr = popPS() + + mem[cfa] = defPrim(eval(:(() -> begin + pushPS($(runtimeAddr)) + return DODOES + end)), name="doesPrim") + + return NEXT end, flags=F_IMMED) -# Odds and Ends +DOES = defWord("DOES>", + [BTICK, LIT, COMMA, HERE, LIT, 3, ADD, COMMA, + BTICK, DOES_HELPER, COMMA, BTICK, EXIT, COMMA, EXIT], + flags=F_IMMED) -CHAR = defPrimWord("CHAR", () -> begin - callPrim(mem[WORD]) - wordLen = popPS() - wordAddr = popPS() - word = getString(wordAddr, wordLen) - pushPS(Int64(word[1])) +LBRAC = defPrimWord("[", () -> begin + mem[STATE] = 0 + return NEXT +end, flags=F_IMMED) + +RBRAC = 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 return NEXT end) +COLON = defWord(":", + [LIT, 32, WORD, + HEADER, + LIT, DOCOL, COMMA, + HIDDEN, + RBRAC, + EXIT]) + +SEMICOLON = defWord(";", + [LIT, EXIT, COMMA, + HIDDEN, + LBRAC, + EXIT], flags=F_IMMED) + +IMMEDIATE = defPrimWord("IMMEDIATE", () -> begin + lenAndFlagsAddr = mem[LATEST] + 1 + mem[lenAndFlagsAddr] = mem[lenAndFlagsAddr] $ F_IMMED + return NEXT +end, flags=F_IMMED) + + #### VM loop #### -function run() + +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) # Begin with STDIN as source push!(sources, STDIN) + global initialized, initFileName + if !initialized && initialize + if initFileName != nothing + print("Including definitions from $initFileName...") + push!(sources, open(initFileName, "r")) + 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 @@ -960,15 +1101,19 @@ function run() jmp = NEXT while jmp != 0 try - #println("Evaluating prim ", jmp," ", primNames[-jmp]) + #println("Entering prim $(getPrimName(jmp))") jmp = callPrim(jmp) catch ex showerror(STDOUT, ex) println() - mem[NUMTIB] = 0 - reg.IP = QUIT + 1 + while !isempty(sources) && currentSource() != STDIN + close(pop!(sources)) + end + + # QUIT + reg.IP = ABORT + 1 jmp = NEXT end end @@ -1010,11 +1155,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() @@ -1024,11 +1169,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() @@ -1041,6 +1186,7 @@ DUMP = defPrimWord("DUMP", () -> begin count = popPS() addr = popPS() + println() dump(addr, count=count) return NEXT