X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=blobdiff_plain;f=src%2Fforth.jl;h=4b714992dbaf249c7fb6116dd6a67a339bc03ba2;hb=b18e42773e45b9d4819cf0e2d2c5965bd34dcb4f;hp=940e6f3fcd9c08faa72b6e9ddb40d178c04b583b;hpb=3546a8908320d9fafc9d3b054d573bd7bece8670;p=forth.jl.git diff --git a/src/forth.jl b/src/forth.jl index 940e6f3..4b71499 100644 --- a/src/forth.jl +++ b/src/forth.jl @@ -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 -F_IMMED = 128 -F_HIDDEN = 256 -F_LENMASK = 127 +F_LENMASK = 31 +F_IMMED = 32 +F_HIDDEN = 64 +NFA_MARK = 128 function createHeader(name::AbstractString, flags::Int64) - mem[mem[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 @@ -152,13 +158,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 @@ -177,11 +183,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 @@ -189,10 +195,10 @@ end function defConst(name::AbstractString, val::Int64; flags::Int64=0) createHeader(name, flags) - codeWordAddr = mem[HERE] + codeWordAddr = mem[H] - mem[mem[HERE]] = DOCON; mem[HERE] += 1 - mem[mem[HERE]] = val; mem[HERE] += 1 + mem[mem[H]] = DOCON; mem[H] += 1 + mem[mem[H]] = val; mem[H] += 1 return codeWordAddr end @@ -228,10 +234,11 @@ 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) @@ -243,6 +250,7 @@ defConst("MEMSIZE", size_mem) F_IMMED_CFA = defConst("F_IMMED", F_IMMED) F_HIDDEN_CFA = defConst("F_HIDDEN", F_HIDDEN) F_LENMASK_CFA = defConst("F_LENMASK", F_LENMASK) +NFA_MARK_CFA = defConst("NFA_MARK", NFA_MARK) # Basic forth primitives @@ -560,7 +568,7 @@ RSPFETCH = defPrimWord("RSP@", () -> begin end) RSPSTORE = defPrimWord("RSP!", () -> begin - RSP = popPS() + reg.RSP = popPS() return NEXT end) @@ -577,7 +585,7 @@ PSPFETCH = defPrimWord("PSP@", () -> begin end) PSPSTORE = defPrimWord("PSP!", () -> begin - PSP = popPS() + reg.PSP = popPS() return NEXT end) @@ -598,27 +606,102 @@ end) sources = Array{Any,1}() currentSource() = sources[length(sources)] -EOF_CFA = defConst("EOF", 4) +EOF = defPrimWord("\x04", () -> begin + if currentSource() != STDIN + close(pop!(sources)) + return NEXT + else + return 0 + end +end) EMIT = defPrimWord("EMIT", () -> begin print(Char(popPS())) return NEXT end) +function raw_mode!(mode::Bool) + if ccall(:jl_tty_set_mode, Int32, (Ptr{Void}, Int32), STDIN.handle, mode) != 0 + throw("FATAL: Terminal unable to enter raw mode.") + end +end + +function getKey() + raw_mode!(true) + byte = readbytes(STDIN, 1)[1] + raw_mode!(false) + + if byte == 0x0d + return 0x0a + elseif byte == 127 + return 0x08 + else + return byte + end +end + +KEY = defPrimWord("KEY", () -> begin + pushPS(Int(getKey())) + return NEXT +end) + +function getLineFromSTDIN() + line = "" + while true + key = Char(getKey()) + + if key == '\n' + print(" ") + return ASCIIString(line) + + elseif key == '\x04' + if isempty(line) + return string("\x04") + end + + elseif key == '\b' + if !isempty(line) + line = line[1:length(line)-1] + print("\b \b") + end + + elseif key == '\e' + # Strip ANSI escape sequence + nextKey = Char(getKey()) + if nextKey == '[' + while true + nextKey = Char(getKey()) + if nextKey >= '@' || nextKey <= '~' + break + end + end + end + + else + print(key) + line = string(line, key) + end + end +end + SPAN, SPAN_CFA = defNewVar("SPAN", 0) EXPECT = defPrimWord("EXPECT", () -> begin maxLen = popPS() addr = popPS() - if !eof(currentSource()) - line = chomp(readline(currentSource())) - mem[SPAN] = min(length(line), maxLen) - putString(line[1:mem[SPAN]], addr) + if currentSource() == STDIN + line = getLineFromSTDIN() else - mem[SPAN] = 1 - mem[addr] = EOF + if !eof(currentSource()) + line = chomp(readline(currentSource())) + else + line = "\x04" # eof + end end + mem[SPAN] = min(length(line), maxLen) + putString(line[1:mem[SPAN]], addr) + return NEXT end) @@ -636,6 +719,19 @@ end) # Dictionary searches +TOCFA = defPrimWord(">CFA", () -> begin + + addr = popPS() + lenAndFlags = mem[addr+1] + len = lenAndFlags & F_LENMASK + + pushPS(addr + 2 + len) + + return NEXT +end) + +TOBODY = defWord(">BODY", [INCR, EXIT]) + FIND = defPrimWord("FIND", () -> begin countedAddr = popPS() @@ -644,6 +740,7 @@ FIND = defPrimWord("FIND", () -> begin word = lowercase(getString(wordAddr, wordLen)) latest = LATEST + lenAndFlags = 0 i = 0 while (latest = mem[latest]) > 0 @@ -663,23 +760,22 @@ FIND = defPrimWord("FIND", () -> begin end end - pushPS(latest) - - return NEXT -end) - -TOCFA = defPrimWord(">CFA", () -> begin - - addr = popPS() - lenAndFlags = mem[addr+1] - len = lenAndFlags & F_LENMASK - - pushPS(addr + 2 + len) + if latest > 0 + pushPS(latest) + callPrim(mem[TOCFA]) + if (lenAndFlags & F_IMMED) == F_IMMED + pushPS(1) + else + pushPS(-1) + end + else + pushPS(countedAddr) + pushPS(0) + end return NEXT end) -TOPFA = defWord(">PFA", [TOCFA, INCR, EXIT]) # Branching @@ -721,8 +817,9 @@ end) # Outer interpreter TRACE = defPrimWord("TRACE", () -> begin - print("RS: "); printRS() + println("reg.W: $(reg.W) reg.IP: $(reg.IP)") print("PS: "); printPS() + print("RS: "); printRS() print("[paused]") readline() @@ -730,8 +827,8 @@ TRACE = defPrimWord("TRACE", () -> begin end) COMMA = defPrimWord(",", () -> begin - mem[mem[HERE]] = popPS() - mem[HERE] += 1 + mem[mem[H]] = popPS() + mem[H] += 1 return NEXT end) @@ -749,7 +846,7 @@ NUMTIB, NUMTIB_CFA = defNewVar("#TIB", 0) TOIN, TOIN_CFA = defNewVar(">IN", 0) QUERY = defWord("QUERY", - [TIB_CFA, LIT, 80, EXPECT, + [TIB_CFA, LIT, 160, EXPECT, SPAN_CFA, FETCH, NUMTIB_CFA, STORE, LIT, 0, TOIN_CFA, STORE, EXIT]) @@ -762,8 +859,8 @@ WORD = defPrimWord("WORD", () -> begin mem[TOIN] += 1 end - countAddr = mem[HERE] - addr = mem[HERE]+1 + countAddr = mem[H] + addr = mem[H]+1 # Start reading in word count = 0 @@ -790,7 +887,7 @@ PARSE = defPrimWord("PARSE", () -> begin delim = popPS() # Chew up initial occurrences of delim - addr = mem[HERE] + addr = mem[H] # Start reading input stream count = 0 @@ -812,6 +909,11 @@ PARSE = defPrimWord("PARSE", () -> begin return NEXT end) +BYE = defPrimWord("BYE", () -> begin + println("\nBye!") + return 0 +end) + STATE, STATE_CFA = defNewVar("STATE", 0) INTERPRET = defWord("INTERPRET", @@ -820,30 +922,30 @@ INTERPRET = defWord("INTERPRET", DUP, FETCH, ZE, ZBRANCH, 3, DROP, EXIT, # Exit if TIB is exhausted - STATE_CFA, FETCH, ZBRANCH, 32, + STATE_CFA, FETCH, ZBRANCH, 24, # Compiling - DUP, FIND, QDUP, ZBRANCH, 19, + FIND, QDUP, ZBRANCH, 13, # Found word. - SWAP, DROP, - DUP, TOCFA, SWAP, INCR, FETCH, LIT, F_IMMED, AND, ZBRANCH, 4, + LIT, -1, EQ, INVERT, ZBRANCH, 4, + # Immediate: Execute! - EXECUTE, BRANCH, -33, + EXECUTE, BRANCH, -26, # Not immediate: Compile! - COMMA, BRANCH, -36, + COMMA, BRANCH, -29, # No word found, parse number - BTICK, LIT, COMMA, TRACE, NUMBER, COMMA, BRANCH, -44, + NUMBER, BTICK, LIT, COMMA, COMMA, BRANCH, -36, # Interpreting - DUP, FIND, QDUP, ZBRANCH, 7, + FIND, QDUP, ZBRANCH, 5, # Found word. Execute! - SWAP, DROP, TOCFA, EXECUTE, BRANCH, -55, + DROP, EXECUTE, BRANCH, -44, # No word found, parse number and leave on stack - NUMBER, BRANCH, -58, + NUMBER, BRANCH, -47, EXIT] ) @@ -856,15 +958,15 @@ PROMPT = defPrimWord("PROMPT", () -> begin end) QUIT = defWord("QUIT", - [RSP0_CFA, RSPSTORE, + [LIT, 0, STATE_CFA, STORE, + LIT, 0, NUMTIB_CFA, STORE, + RSP0_CFA, RSPSTORE, QUERY, INTERPRET, PROMPT, BRANCH,-4]) -BYE = defPrimWord("BYE", () -> begin - println("Bye!") - return 0 -end) +ABORT = defWord("ABORT", + [PSP0_CFA, PSPSTORE, QUIT]) INCLUDE = defPrimWord("INCLUDE", () -> begin pushPS(32) @@ -883,6 +985,9 @@ end) # Compilation +HERE = defWord("HERE", + [H_CFA, FETCH, EXIT]) + HEADER = defPrimWord("HEADER", () -> begin wordAddr = popPS()+1 wordLen = mem[wordAddr-1] @@ -893,6 +998,39 @@ HEADER = defPrimWord("HEADER", () -> begin return NEXT end) +CREATE = defWord("CREATE", + [LIT, 32, WORD, HEADER, + LIT, DOVAR, COMMA, + EXIT]) + +DODOES = defPrim(() -> begin + pushRS(reg.IP) + reg.IP = popPS() + pushPS(reg.W + 1) + return NEXT +end, name="DODOES") + +DOES_HELPER = defPrimWord("(DOES>)", () -> begin + + pushPS(mem[LATEST]) + callPrim(mem[TOCFA]) + cfa = popPS() + + runtimeAddr = popPS() + + mem[cfa] = defPrim(eval(:(() -> begin + pushPS($(runtimeAddr)) + return DODOES + end)), name="doesPrim") + + return NEXT +end, flags=F_IMMED) + +DOES = defWord("DOES>", + [BTICK, LIT, COMMA, HERE, LIT, 3, ADD, COMMA, + BTICK, DOES_HELPER, COMMA, BTICK, EXIT, COMMA, EXIT], + flags=F_IMMED) + LBRAC = defPrimWord("[", () -> begin mem[STATE] = 0 return NEXT @@ -904,28 +1042,22 @@ RBRAC = defPrimWord("]", () -> begin end, flags=F_IMMED) HIDDEN = defPrimWord("HIDDEN", () -> begin - addr = popPS() + 1 - mem[addr] = mem[addr] $ F_HIDDEN + lenAndFlagsAddr = mem[LATEST] + 1 + mem[lenAndFlagsAddr] = mem[lenAndFlagsAddr] $ F_HIDDEN return NEXT end) -HIDE = defWord("HIDE", - [LIT, 32, WORD, - FIND, - HIDDEN, - EXIT]) - COLON = defWord(":", [LIT, 32, WORD, HEADER, LIT, DOCOL, COMMA, - LATEST_CFA, FETCH, HIDDEN, + HIDDEN, RBRAC, EXIT]) SEMICOLON = defWord(";", [LIT, EXIT, COMMA, - LATEST_CFA, FETCH, HIDDEN, + HIDDEN, LBRAC, EXIT], flags=F_IMMED) @@ -935,9 +1067,6 @@ IMMEDIATE = defPrimWord("IMMEDIATE", () -> begin return NEXT end, flags=F_IMMED) -TICK = defWord("'", - [LIT, 32, WORD, FIND, TOCFA, EXIT]) - #### VM loop #### @@ -949,7 +1078,7 @@ elseif isfile(Pkg.dir("forth/src/lib.4th")) initFileName = Pkg.dir("forth/src/lib.4th") end -function run(;initialize=false) +function run(;initialize=true) # Begin with STDIN as source push!(sources, STDIN) @@ -983,11 +1112,8 @@ function run(;initialize=false) 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 + 1 jmp = NEXT end end @@ -1029,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() @@ -1043,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() @@ -1060,6 +1186,7 @@ DUMP = defPrimWord("DUMP", () -> begin count = popPS() addr = popPS() + println() dump(addr, count=count) return NEXT