X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=blobdiff_plain;f=src%2Fforth.jl;h=6436f79173a7e936b46d42176e679f9e8e14247e;hb=ef461e2e2bd3226ba279ff37e17ffecfd1c916d1;hp=0803b72bef75e92014f84a5533f1f873094cde61;hpb=d0d02a9174dd0a8e4e0c37dc2d990d692ee9a73d;p=forth.jl.git diff --git a/src/forth.jl b/src/forth.jl index 0803b72..6436f79 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,7 +606,14 @@ end) sources = Array{Any,1}() currentSource() = sources[length(sources)] -EOF_CFA = defConst("EOF", 4) +EOF = defPrimWord("\x04", () -> begin + close(pop!(sources)) + if !isempty(sources) + return NEXT + else + return 0 + end +end) EMIT = defPrimWord("EMIT", () -> begin print(Char(popPS())) @@ -616,7 +631,7 @@ EXPECT = defPrimWord("EXPECT", () -> begin putString(line[1:mem[SPAN]], addr) else mem[SPAN] = 1 - mem[addr] = EOF + mem[addr] = 4 # eof end return NEXT @@ -636,6 +651,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 +672,7 @@ FIND = defPrimWord("FIND", () -> begin word = lowercase(getString(wordAddr, wordLen)) latest = LATEST + lenAndFlags = 0 i = 0 while (latest = mem[latest]) > 0 @@ -663,23 +692,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,9 +749,9 @@ end) # Outer interpreter TRACE = defPrimWord("TRACE", () -> begin - println("Val: $(popPS())") - print("RS: "); printRS() + println("reg.W: $(reg.W) reg.IP: $(reg.IP)") print("PS: "); printPS() + print("RS: "); printRS() print("[paused]") readline() @@ -731,8 +759,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) @@ -750,7 +778,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]) @@ -763,8 +791,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 @@ -791,7 +819,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 @@ -826,30 +854,30 @@ INTERPRET = defWord("INTERPRET", DUP, FETCH, ZE, ZBRANCH, 3, DROP, EXIT, # Exit if TIB is exhausted - STATE_CFA, FETCH, ZBRANCH, 31, + 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 - NUMBER, BTICK, LIT, COMMA, COMMA, BRANCH, -43, + 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, -54, + DROP, EXECUTE, BRANCH, -44, # No word found, parse number and leave on stack - NUMBER, BRANCH, -57, + NUMBER, BRANCH, -47, EXIT] ) @@ -862,11 +890,16 @@ 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]) +ABORT = defWord("ABORT", + [PSP0_CFA, PSPSTORE, QUIT]) + INCLUDE = defPrimWord("INCLUDE", () -> begin pushPS(32) callPrim(mem[WORD]) @@ -884,6 +917,9 @@ end) # Compilation +HERE = defWord("HERE", + [H_CFA, FETCH, EXIT]) + HEADER = defPrimWord("HEADER", () -> begin wordAddr = popPS()+1 wordLen = mem[wordAddr-1] @@ -894,6 +930,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 @@ -905,28 +974,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) @@ -936,9 +999,6 @@ IMMEDIATE = defPrimWord("IMMEDIATE", () -> begin return NEXT end, flags=F_IMMED) -TICK = defWord("'", - [LIT, 32, WORD, FIND, TOCFA, EXIT]) - #### VM loop #### @@ -950,7 +1010,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) @@ -984,11 +1044,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 @@ -1030,11 +1087,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() @@ -1044,11 +1101,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()