X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=blobdiff_plain;f=src%2Fforth.jl;h=bba6a988a57190f53428b852ca930888d5ed2bb1;hb=eaec011bac29e0101b20a9e87593d0bc621d9bf7;hp=b1a78f32b90a9197a3ac2465665157bb2b987076;hpb=6e2ccc15f2ba17285a61b33ad8d2f23da6c66be7;p=forth.jl.git diff --git a/src/forth.jl b/src/forth.jl index b1a78f3..bba6a98 100644 --- a/src/forth.jl +++ b/src/forth.jl @@ -55,27 +55,29 @@ type Reg PSP::Int64 # Parameter/data stack pointer IP::Int64 # Instruction pointer W::Int64 # Working register - - source::Any # Input stream in use end -reg = Reg(mem[RSP0], mem[PSP0], 0, 0, STDIN) +reg = Reg(mem[RSP0], mem[PSP0], 0, 0) # Stack manipulation functions -type StackUnderflow <: Exception end +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() begin a = popPS() b = popPS() c = popPS() + pushPS(b) pushPS(a) pushPS(c) - pushPS(b) return NEXT end) @@ -253,12 +255,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() @@ -349,6 +352,16 @@ DIVMOD = defPrimWord("/MOD", () -> begin return NEXT end) +TWOMUL = defPrimWord("2*", () -> begin + pushPS(popPS() << 1) + return NEXT +end) + +TWODIV = defPrimWord("2/", () -> begin + pushPS(popPS() >> 1) + return NEXT +end) + EQU = defPrimWord("=", () -> begin b = popPS() a = popPS() @@ -515,6 +528,11 @@ 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 @@ -556,6 +574,9 @@ end) # I/O +sources = Array{Any,1}() +currentSource() = sources[length(sources)] + defConst("TIB", TIB) NUMTIB, NUMTIB_CFA = defNewVar("#TIB", 0) TOIN, TOIN_CFA = defNewVar(">IN", 0) @@ -565,8 +586,8 @@ KEY = defPrimWord("KEY", () -> begin if mem[TOIN] >= mem[NUMTIB] mem[TOIN] = 0 - if !eof(reg.source) - line = readline(reg.source) + if !eof(currentSource()) + line = readline(currentSource()) mem[NUMTIB] = length(line) putString(line, TIB) else @@ -713,6 +734,23 @@ end) TODFA = defWord(">DFA", [TOCFA, INCR, EXIT]) +# Branching + +BRANCH = defPrimWord("BRANCH", () -> begin + reg.IP += mem[reg.IP] + return NEXT +end) + +ZBRANCH = defPrimWord("0BRANCH", () -> begin + if (popPS() == 0) + reg.IP += mem[reg.IP] + else + reg.IP += 1 + end + + return NEXT +end) + # Compilation CREATE = defPrimWord("CREATE", () -> begin @@ -775,24 +813,10 @@ IMMEDIATE = defPrimWord("IMMEDIATE", () -> begin return NEXT end, flags=F_IMMED) -TICK = defWord("'", [WORD, FIND, TOCFA, EXIT]) - -# Branching - -BRANCH = defPrimWord("BRANCH", () -> begin - reg.IP += mem[reg.IP] - return NEXT -end) - -ZBRANCH = defPrimWord("0BRANCH", () -> begin - if (popPS() == 0) - reg.IP += mem[reg.IP] - else - reg.IP += 1 - end - - return NEXT -end) +TICK = defWord("'", + [STATE_CFA, FETCH, ZBRANCH, 7, + FROMR, DUP, INCR, TOR, FETCH, EXIT, + WORD, FIND, TOCFA, EXIT]) # Strings @@ -821,12 +845,21 @@ EXECUTE = defPrimWord("EXECUTE", () -> begin 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) + INTERPRET = defPrimWord("INTERPRET", () -> begin callPrim(mem[WORD]) wordName = getString(mem[reg.PSP-1], mem[reg.PSP]) - #println("... ", replace(replace(wordName, "\004", "EOF"), "\n", "\\n"), " ...") + if mem[DEBUG] != 0 + println("... ", replace(replace(wordName, "\004", "EOF"), "\n", "\\n"), " ...") + end callPrim(mem[TWODUP]) callPrim(mem[FIND]) @@ -839,13 +872,12 @@ INTERPRET = defPrimWord("INTERPRET", () -> begin isImmediate = (mem[wordAddr+1] & F_IMMED) != 0 callPrim(mem[TOCFA]) - callPrim(mem[ROT]) # get rid of extra copy of word string details + callPrim(mem[NROT]) # get rid of extra copy of word string details popPS() popPS() if mem[STATE] == 0 || isImmediate # Execute! - #println("Executing CFA at $(mem[reg.PSP])") return callPrim(mem[EXECUTE]) else # Append CFA to dictionary @@ -859,8 +891,7 @@ INTERPRET = defPrimWord("INTERPRET", () -> begin callPrim(mem[NUMBER]) if popPS() != 0 - println("Parse error at word: '$wordName'") - return NEXT + throw(ParseError(wordName)) end if mem[STATE] == 0 @@ -885,21 +916,24 @@ BYE = defPrimWord("BYE", () -> begin return 0 end) +PROMPT = defPrimWord("PROMPT", () -> begin + println(" ok") +end) + NL = defPrimWord("\n", () -> begin - if mem[STATE] == 0 && reg.source == STDIN - println(" ok") + if mem[STATE] == 0 && currentSource() == STDIN + callPrim(mem[PROMPT]) end return NEXT end, flags=F_IMMED) INCLUDE = defPrimWord("INCLUDE", () -> begin - callPrim(mem[WORD]) wordLen = popPS() wordAddr = popPS() word = getString(wordAddr, wordLen) - reg.source = open(word, "r") + push!(sources, open(word, "r")) # Clear input buffer mem[NUMTIB] = 0 @@ -908,12 +942,20 @@ INCLUDE = defPrimWord("INCLUDE", () -> begin end) EOF_WORD = defPrimWord("\x04", () -> begin - if reg.source == STDIN - return 0 - else - close(reg.source) - reg.source = STDIN + 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) @@ -929,8 +971,31 @@ CHAR = defPrimWord("CHAR", () -> begin return NEXT end) +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 + + #### VM loop #### -function run() +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 @@ -939,17 +1004,24 @@ function run() jmp = NEXT while jmp != 0 try - #println("Evaluating prim $jmp $(primNames[-jmp])") + if mem[DEBUG] != 0 + println("Evaluating prim ", jmp," ", primNames[-jmp]) + end + jmp = callPrim(jmp) catch ex - if isa(ex, StackUnderflow) - println("Stack underflow!") + showerror(STDOUT, ex) + println() - mem[NUMTIB] = 0 - reg.IP = QUIT + 1 - jmp = NEXT + while !isempty(sources) && currentSource() != STDIN + close(pop!(sources)) end + + mem[STATE] = 0 + mem[NUMTIB] = 0 + reg.IP = QUIT + 1 + jmp = NEXT end end end @@ -1017,4 +1089,13 @@ function printRS() end end +DUMP = defPrimWord("DUMP", () -> begin + count = popPS() + addr = popPS() + + dump(addr, count=count) + + return NEXT +end) + end