X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=blobdiff_plain;f=src%2Fforth.jl;h=fb7121c27d13851b98c445e2daf7db1000219e4c;hb=87b17b0ee12c90f028186761fbb2bd5f6b4008eb;hp=fba23756de47ac0abc25c9cc941798609c3c418b;hpb=990c32e23baef033051587cfdfe2aef3e18b888a;p=forth.jl.git diff --git a/src/forth.jl b/src/forth.jl index fba2375..fb7121c 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,16 +36,14 @@ primNames = Array{ASCIIString,1}() # Built-in variables nextVarAddr = 1 -RSP0 = nextVarAddr; nextVarAddr += 1 -PSP0 = nextVarAddr; nextVarAddr += 1 HERE = 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[HERE] = TIB + size_TIB # location of bottom of dictionary +mem[LATEST] = 0 # no previous definition DICT = mem[HERE] # Save bottom of dictionary as constant @@ -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_IMMED = 128 +F_HIDDEN = 256 +F_LENMASK = 127 function createHeader(name::AbstractString, flags::Int64) mem[mem[HERE]] = mem[LATEST] @@ -159,7 +169,7 @@ function defWord(name::AbstractString, wordAddrs::Array{Int64,1}; flags::Int64=0 return addr end -# Variable creation +# Variable creation functions function defExistingVar(name::AbstractString, varAddr::Int64; flags::Int64=0) @@ -175,24 +185,21 @@ function defNewVar(name::AbstractString, initial::Int64; flags::Int64=0) codeWordAddr = mem[HERE] varAddr = mem[HERE] + 1 - f = eval(:(() -> begin - pushPS($(varAddr)) - return NEXT - end)) - - mem[mem[HERE]] = defPrim(f, name=name); mem[HERE] += 1 + mem[mem[HERE]] = DOVAR; mem[HERE] += 1 mem[mem[HERE]] = initial; mem[HERE] += 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[HERE] + + mem[mem[HERE]] = DOCON; mem[HERE] += 1 + mem[mem[HERE]] = val; mem[HERE] += 1 + + return codeWordAddr end # Threading Primitives (inner interpreter) @@ -209,11 +216,40 @@ 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 + +HERE_CFA = defExistingVar("HERE", HERE) +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) + # Basic forth primitives DROP = defPrimWord("DROP", () -> begin @@ -284,8 +320,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) @@ -362,14 +407,14 @@ TWODIV = defPrimWord("2/", () -> begin return NEXT end) -EQU = defPrimWord("=", () -> begin +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) @@ -404,12 +449,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) @@ -498,24 +543,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 @@ -539,7 +566,7 @@ RSPFETCH = defPrimWord("RSP@", () -> begin end) RSPSTORE = defPrimWord("RSP!", () -> begin - RSP = popPS() + reg.RSP = popPS() return NEXT end) @@ -556,7 +583,7 @@ PSPFETCH = defPrimWord("PSP@", () -> begin end) PSPSTORE = defPrimWord("PSP!", () -> begin - PSP = popPS() + reg.PSP = popPS() return NEXT end) @@ -577,29 +604,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 + close(pop!(sources)) + if !isempty(sources) + return NEXT + else + return 0 end - - pushPS(mem[TIB + mem[TOIN]]) - mem[TOIN] += 1 - - return NEXT end) EMIT = defPrimWord("EMIT", () -> begin @@ -607,83 +618,31 @@ EMIT = defPrimWord("EMIT", () -> begin return NEXT end) -WORD = defPrimWord("WORD", () -> begin - - eof_char = Char(EOF) - c = eof_char - - skip_to_end = false - while true - - callPrim(mem[KEY]) - c = Char(popPS()) - - if c == '\\' - skip_to_end = true - continue - end - - if skip_to_end - if c == '\n' || c == eof_char - skip_to_end = false - end - continue - end - - if c == ' ' || c == '\t' - continue - end - - break - end - - wordAddr = mem[HERE] - offset = 0 - - if c == '\n' || c == eof_char - # Treat newline as a special word - - mem[wordAddr + offset] = Int64(c) - pushPS(wordAddr) - pushPS(1) - return NEXT - end - - while true - mem[wordAddr + offset] = Int64(c) - offset += 1 - - callPrim(mem[KEY]) - c = Char(popPS()) +SPAN, SPAN_CFA = defNewVar("SPAN", 0) +EXPECT = defPrimWord("EXPECT", () -> begin + maxLen = popPS() + addr = popPS() - if c == ' ' || c == '\t' || c == '\n' || c == eof_char - # Rewind KEY - mem[TOIN] -= 1 - break - end + if !eof(currentSource()) + line = chomp(readline(currentSource())) + mem[SPAN] = min(length(line), maxLen) + putString(line[1:mem[SPAN]], addr) + else + mem[SPAN] = 1 + mem[addr] = 4 # eof end - wordLen = offset - - pushPS(wordAddr) - pushPS(wordLen) - return NEXT end) +BASE, BASE_CFA = defNewVar("BASE", 10) NUMBER = defPrimWord("NUMBER", () -> begin - - wordLen = popPS() - wordAddr = popPS() + 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 NEXT end) @@ -692,8 +651,9 @@ end) FIND = defPrimWord("FIND", () -> begin - wordLen = popPS() - wordAddr = popPS() + countedAddr = popPS() + wordAddr = countedAddr + 1 + wordLen = mem[countedAddr] word = lowercase(getString(wordAddr, wordLen)) latest = LATEST @@ -732,7 +692,7 @@ TOCFA = defPrimWord(">CFA", () -> begin return NEXT end) -TODFA = defWord(">DFA", [TOCFA, INCR, EXIT]) +TOPFA = defWord(">PFA", [TOCFA, INCR, EXIT]) # Branching @@ -751,73 +711,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 @@ -830,7 +723,7 @@ LITSTRING = defPrimWord("LITSTRING", () -> begin return NEXT end) -TELL = defPrimWord("TELL", () -> begin +TYPE = defPrimWord("TYPE", () -> begin len = popPS() addr = popPS() str = getString(addr, len) @@ -840,97 +733,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[HERE]] = popPS() + mem[HERE] += 1 + + return NEXT +end) + +BTICK = defWord("[']", + [FROMR, DUP, INCR, TOR, FETCH, EXIT]) + EXECUTE = defPrimWord("EXECUTE", () -> begin reg.W = popPS() return mem[reg.W] end) -type ParseError <: Exception - wordName::ASCIIString -end -Base.showerror(io::IO, ex::ParseError) = print(io, "Parse error at word: '$(ex.wordName)'.") - -DEBUG, DEBUG_CFA = defNewVar("DEBUG", 0) +TIB_CFA = defConst("TIB", TIB) +NUMTIB, NUMTIB_CFA = defNewVar("#TIB", 0) +TOIN, TOIN_CFA = defNewVar(">IN", 0) -INTERPRET = defPrimWord("INTERPRET", () -> begin +QUERY = defWord("QUERY", + [TIB_CFA, LIT, 160, EXPECT, + SPAN_CFA, FETCH, NUMTIB_CFA, STORE, + LIT, 0, TOIN_CFA, STORE, + EXIT]) - callPrim(mem[WORD]) +WORD = defPrimWord("WORD", () -> begin + delim = popPS() - wordName = getString(mem[reg.PSP-1], mem[reg.PSP]) - if mem[DEBUG] != 0 - println("... ", replace(replace(wordName, "\004", "EOF"), "\n", "\\n"), " ...") + # Chew up initial occurrences of delim + while (mem[TOIN]0 - # Word in dictionary + if (mem[addr] == delim) + break + end - isImmediate = (mem[wordAddr+1] & F_IMMED) != 0 - callPrim(mem[TOCFA]) + count += 1 + addr += 1 + end - callPrim(mem[NROT]) # get rid of extra copy of word string details - popPS() - popPS() + # Record count + mem[countAddr] = count + pushPS(countAddr) - 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 + return NEXT +end) - popPS() +PARSE = defPrimWord("PARSE", () -> begin + delim = popPS() - callPrim(mem[NUMBER]) + # Chew up initial occurrences of delim + addr = mem[HERE] - if popPS() != 0 - throw(ParseError(wordName)) - end + # Start reading input stream + count = 0 + while (mem[TOIN] begin + println("Bye!") 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, 31, + # Compiling + DUP, FIND, QDUP, ZBRANCH, 19, + + # Found word. + SWAP, DROP, + DUP, TOCFA, SWAP, INCR, FETCH, LIT, F_IMMED, AND, ZBRANCH, 4, + # Immediate: Execute! + EXECUTE, BRANCH, -33, + + # Not immediate: Compile! + COMMA, BRANCH, -36, + + # No word found, parse number + NUMBER, BTICK, LIT, COMMA, COMMA, BRANCH, -43, + + # Interpreting + DUP, FIND, QDUP, ZBRANCH, 7, -NL = defPrimWord("\n", () -> begin - if mem[STATE] == 0 && currentSource() == STDIN - callPrim(mem[PROMPT]) + # Found word. Execute! + SWAP, DROP, TOCFA, EXECUTE, BRANCH, -54, + + # No word found, parse number and leave on stack + NUMBER, BRANCH, -57, + 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")) @@ -941,36 +900,63 @@ INCLUDE = defPrimWord("INCLUDE", () -> begin return NEXT end) -EOF_WORD = defPrimWord("\x04", () -> begin - if currentSource() != STDIN - close(currentSource()) - end +# Compilation - pop!(sources) +HEADER = defPrimWord("HEADER", () -> begin + wordAddr = popPS()+1 + wordLen = mem[wordAddr-1] + word = getString(wordAddr, wordLen) - if length(sources)>0 - if currentSource() == STDIN - callPrim(mem[PROMPT]) - end + createHeader(word, 0) - return NEXT - else - return 0 - end -end, flags=F_IMMED) + return NEXT +end) -# Odds and Ends +LBRAC = defPrimWord("[", () -> begin + mem[STATE] = 0 + return NEXT +end, flags=F_IMMED) -CHAR = defPrimWord("CHAR", () -> begin - callPrim(mem[WORD]) - wordLen = popPS() - wordAddr = popPS() - word = getString(wordAddr, wordLen) - pushPS(Int64(word[1])) +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", + [LIT, 32, WORD, + FIND, + HIDDEN, + EXIT]) + +COLON = defWord(":", + [LIT, 32, WORD, + HEADER, + 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) + + +#### VM loop #### + initialized = false initFileName = nothing if isfile("lib.4th") @@ -979,8 +965,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) @@ -1004,10 +988,7 @@ function run(;initialize=true) 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 @@ -1018,11 +999,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 + 1 jmp = NEXT end end @@ -1064,11 +1042,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() @@ -1078,11 +1056,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()