X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?p=forth.jl.git;a=blobdiff_plain;f=src%2Fforth.jl;h=63e7d576e70e3af8d8855ccb5f9cb932bb0fb81a;hp=01c8c0d4537fb393b73c4576e6650db49e7e3ce1;hb=19d08aee45587ac2b84f6c413fc53542d50c52cc;hpb=429b35ca5e2f4832cf904e08339a2b42d171da9d diff --git a/src/forth.jl b/src/forth.jl index 01c8c0d..63e7d57 100644 --- a/src/forth.jl +++ b/src/forth.jl @@ -16,14 +16,16 @@ primNames = Array{ASCIIString,1}() # Built-in variables nextVarAddr = 1 -H = nextVarAddr; nextVarAddr += 1 -LATEST = nextVarAddr; nextVarAddr += 1 +H = nextVarAddr; nextVarAddr += 1 # Next free memory address +FORTH_LATEST = nextVarAddr; nextVarAddr += 1 # LFA of latest word in system dict +CURRENT = nextVarAddr; nextVarAddr += 1 # Current compilation dict 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 +mem[H] = TIB + size_TIB # location of bottom of dictionary +mem[FORTH_LATEST] = 0 # no previous definition +mem[CURRENT] = FORTH_LATEST # Compile words to system dict initially DICT = mem[H] # Save bottom of dictionary as constant @@ -107,21 +109,27 @@ F_IMMED = 32 F_HIDDEN = 64 NFA_MARK = 128 +function dictWrite(ints::Array{Int64,1}) + mem[mem[H]:(mem[H]+length(ints)-1)] = ints + mem[H] += length(ints) +end +dictWrite(int::Int64) = dictWrite([int]) +dictWriteString(string::ASCIIString) = dictWrite([Int64(c) for c in string]) + function createHeader(name::AbstractString, flags::Int64) - mem[mem[H]] = mem[LATEST] - mem[LATEST] = mem[H] + mem[mem[H]] = mem[mem[CURRENT]] + mem[mem[CURRENT]] = mem[H] mem[H] += 1 - mem[mem[H]] = length(name) | flags | NFA_MARK; mem[H] += 1 - putString(name, mem[H]); mem[H] += length(name) + dictWrite(length(name) | flags | NFA_MARK) + dictWriteString(name) end function defPrimWord(name::AbstractString, f::Function; flags::Int64=0) createHeader(name, flags) codeWordAddr = mem[H] - mem[codeWordAddr] = defPrim(f, name=name) - mem[H] += 1 + dictWrite(defPrim(f, name=name)) return codeWordAddr end @@ -130,13 +138,9 @@ function defWord(name::AbstractString, wordAddrs::Array{Int64,1}; flags::Int64=0 createHeader(name, flags) addr = mem[H] - mem[mem[H]] = DOCOL - mem[H] += 1 + dictWrite(DOCOL) - for wordAddr in wordAddrs - mem[mem[H]] = wordAddr - mem[H] += 1 - end + dictWrite(wordAddrs) return addr end @@ -151,25 +155,28 @@ function defExistingVar(name::AbstractString, varAddr::Int64; flags::Int64=0) end))) end -function defNewVar(name::AbstractString, initial::Int64; flags::Int64=0) +function defNewVar(name::AbstractString, initial::Array{Int64,1}; flags::Int64=0) createHeader(name, flags) codeWordAddr = mem[H] varAddr = mem[H] + 1 - mem[mem[H]] = DOVAR; mem[H] += 1 - mem[mem[H]] = initial; mem[H] += 1 + dictWrite(DOVAR) + dictWrite(initial) return varAddr, codeWordAddr end +defNewVar(name::AbstractString, initial::Int64; flags::Int64=0) = + defNewVar(name, [initial]; flags=flags) + function defConst(name::AbstractString, val::Int64; flags::Int64=0) createHeader(name, flags) codeWordAddr = mem[H] - mem[mem[H]] = DOCON; mem[H] += 1 - mem[mem[H]] = val; mem[H] += 1 + dictWrite(DOCON) + dictWrite(val) return codeWordAddr end @@ -206,7 +213,7 @@ end) # Dictionary entries for core built-in variables, constants H_CFA = defExistingVar("H", H) -LATEST_CFA = defExistingVar("LATEST", LATEST) +CURRENT_CFA = defExistingVar("CURRENT", CURRENT) PSP0_CFA = defConst("PSP0", PSP0) RSP0_CFA = defConst("RSP0", RSP0) @@ -690,7 +697,7 @@ end) # Dictionary searches -TOCFA_CFA = defPrimWord(">CFA", () -> begin +FROMLINK_CFA = defPrimWord("LINK>", () -> begin addr = popPS() lenAndFlags = mem[addr+1] @@ -701,7 +708,17 @@ TOCFA_CFA = defPrimWord(">CFA", () -> begin return NEXT end) -TOBODY_CFA = defWord(">BODY", [INCR_CFA, EXIT_CFA]) +createHeader("FORTH", 0) +FORTH_CFA = mem[H] +dictWrite(defPrim(() -> begin + mem[CONTEXT] = reg.W + return NEXT +end, name="FORTH")) +dictWrite(FORTH_LATEST) + +CONTEXT, CONTEXT_CFA = defNewVar("CONTEXT", zeros(Int64, 100)) +mem[CONTEXT] = FORTH_CFA +NUMCONTEXT, NUMCONTEXT_CFA = defNewVar("#CONTEXT", 1) FIND_CFA = defPrimWord("FIND", () -> begin @@ -710,30 +727,39 @@ FIND_CFA = defPrimWord("FIND", () -> begin wordLen = mem[countedAddr] word = lowercase(getString(wordAddr, wordLen)) - latest = LATEST + context = mem[CONTEXT:(CONTEXT+mem[NUMCONTEXT]-1)] + lenAndFlags = 0 - - i = 0 - while (latest = mem[latest]) > 0 - lenAndFlags = mem[latest+1] - len = lenAndFlags & F_LENMASK - hidden = (lenAndFlags & F_HIDDEN) == F_HIDDEN - - if hidden || len != wordLen - continue + lfa = 0 + + for vocabCFA in reverse(context) + lfa = mem[vocabCFA+1] + + while (lfa = mem[lfa]) > 0 + + lenAndFlags = mem[lfa+1] + len = lenAndFlags & F_LENMASK + hidden = (lenAndFlags & F_HIDDEN) == F_HIDDEN + + if hidden || len != wordLen + continue + end + + thisWord = lowercase(getString(lfa+2, len)) + + if thisWord == word + break + end end - - thisAddr = latest+2 - thisWord = lowercase(getString(thisAddr, len)) - if lowercase(thisWord) == lowercase(word) + if lfa>0 break end end - if latest > 0 - pushPS(latest) - callPrim(mem[TOCFA_CFA]) + if lfa > 0 + pushPS(lfa) + callPrim(mem[FROMLINK_CFA]) if (lenAndFlags & F_IMMED) == F_IMMED pushPS(1) else @@ -785,22 +811,7 @@ TYPE_CFA = defPrimWord("TYPE", () -> begin return NEXT end) -# Outer interpreter - -COMMA_CFA = defPrimWord(",", () -> begin - mem[mem[H]] = popPS() - mem[H] += 1 - - return NEXT -end) - -BTICK_CFA = defWord("[']", - [FROMR_CFA, DUP_CFA, INCR_CFA, TOR_CFA, FETCH_CFA, EXIT_CFA]) - -EXECUTE_CFA = defPrimWord("EXECUTE", () -> begin - reg.W = popPS() - return mem[reg.W] -end) +# Interpreter/Compiler-specific I/O TIB_CFA = defConst("TIB", TIB) NUMTIB, NUMTIB_CFA = defNewVar("#TIB", 0) @@ -844,107 +855,17 @@ WORD_CFA = defPrimWord("WORD", () -> begin return NEXT end) -PARSE_CFA = defPrimWord("PARSE", () -> begin - delim = popPS() - - # Chew up initial occurrences of delim - addr = mem[H] - - # Start reading input stream - count = 0 - while (mem[TOIN] begin - println("\nBye!") - return 0 -end) +# Compilation STATE, STATE_CFA = defNewVar("STATE", 0) -INTERPRET_CFA = defWord("INTERPRET", - [LIT_CFA, 32, WORD_CFA, # Read next space-delimited word - - DUP_CFA, FETCH_CFA, ZE_CFA, ZBRANCH_CFA, 3, - DROP_CFA, EXIT_CFA, # Exit if TIB is exhausted - - STATE_CFA, FETCH_CFA, ZBRANCH_CFA, 24, - # Compiling - FIND_CFA, QDUP_CFA, ZBRANCH_CFA, 13, - - # Found word. - LIT_CFA, -1, EQ_CFA, INVERT_CFA, ZBRANCH_CFA, 4, - - # Immediate: Execute! - EXECUTE_CFA, BRANCH_CFA, -26, - - # Not immediate: Compile! - COMMA_CFA, BRANCH_CFA, -29, - - # No word found, parse number - NUMBER_CFA, BTICK_CFA, LIT_CFA, COMMA_CFA, COMMA_CFA, BRANCH_CFA, -36, - - # Interpreting - FIND_CFA, QDUP_CFA, ZBRANCH_CFA, 5, - - # Found word. Execute! - DROP_CFA, EXECUTE_CFA, BRANCH_CFA, -44, - - # No word found, parse number and leave on stack - NUMBER_CFA, BRANCH_CFA, -47, - EXIT_CFA]) - -PROMPT_CFA = defPrimWord("PROMPT", () -> begin - if (mem[STATE] == 0 && currentSource() == STDIN) - println(" ok") - end - - return NEXT -end) - -QUIT_CFA = defWord("QUIT", - [LIT_CFA, 0, STATE_CFA, STORE_CFA, - LIT_CFA, 0, NUMTIB_CFA, STORE_CFA, - RSP0_CFA, RSPSTORE_CFA, - QUERY_CFA, - INTERPRET_CFA, PROMPT_CFA, - BRANCH_CFA,-4]) - -ABORT_CFA = defWord("ABORT", - [PSP0_CFA, PSPSTORE_CFA, QUIT_CFA]) - -INCLUDE_CFA = defPrimWord("INCLUDE", () -> begin - pushPS(32) - callPrim(mem[WORD_CFA]) - wordAddr = popPS()+1 - wordLen = mem[wordAddr-1] - word = getString(wordAddr, wordLen) - - push!(sources, open(word, "r")) - - # Clear input buffer - mem[NUMTIB] = 0 +COMMA_CFA = defPrimWord(",", () -> begin + mem[mem[H]] = popPS() + mem[H] += 1 return NEXT end) -# Compilation - HERE_CFA = defWord("HERE", [H_CFA, FETCH_CFA, EXIT_CFA]) @@ -972,8 +893,8 @@ end, name="DODOES") DOES_HELPER_CFA = defPrimWord("(DOES>)", () -> begin - pushPS(mem[LATEST]) - callPrim(mem[TOCFA_CFA]) + pushPS(mem[mem[CURRENT]]) + callPrim(mem[FROMLINK_CFA]) cfa = popPS() runtimeAddr = popPS() @@ -984,11 +905,11 @@ DOES_HELPER_CFA = defPrimWord("(DOES>)", () -> begin end)), name="doesPrim") return NEXT -end, flags=F_IMMED) +end, flags=F_IMMED | F_HIDDEN) DOES_CFA = defWord("DOES>", - [BTICK_CFA, LIT_CFA, COMMA_CFA, HERE_CFA, LIT_CFA, 3, ADD_CFA, COMMA_CFA, - BTICK_CFA, DOES_HELPER_CFA, COMMA_CFA, BTICK_CFA, EXIT_CFA, COMMA_CFA, EXIT_CFA], + [LIT_CFA, LIT_CFA, COMMA_CFA, HERE_CFA, LIT_CFA, 3, ADD_CFA, COMMA_CFA, + LIT_CFA, DOES_HELPER_CFA, COMMA_CFA, LIT_CFA, EXIT_CFA, COMMA_CFA, EXIT_CFA], flags=F_IMMED) LBRAC_CFA = defPrimWord("[", () -> begin @@ -1002,7 +923,7 @@ RBRAC_CFA = defPrimWord("]", () -> begin end, flags=F_IMMED) HIDDEN_CFA = defPrimWord("HIDDEN", () -> begin - lenAndFlagsAddr = mem[LATEST] + 1 + lenAndFlagsAddr = mem[mem[CURRENT]] + 1 mem[lenAndFlagsAddr] = mem[lenAndFlagsAddr] $ F_HIDDEN return NEXT end) @@ -1022,11 +943,98 @@ SEMICOLON_CFA = defWord(";", EXIT_CFA], flags=F_IMMED) IMMEDIATE_CFA = defPrimWord("IMMEDIATE", () -> begin - lenAndFlagsAddr = mem[LATEST] + 1 + lenAndFlagsAddr = mem[mem[CURRENT]] + 1 mem[lenAndFlagsAddr] = mem[lenAndFlagsAddr] $ F_IMMED return NEXT end, flags=F_IMMED) +# Outer Interpreter + +EXECUTE_CFA = defPrimWord("EXECUTE", () -> begin + reg.W = popPS() + return mem[reg.W] +end) + +INTERPRET_CFA = defWord("INTERPRET", + [LIT_CFA, 32, WORD_CFA, # Read next space-delimited word + + DUP_CFA, FETCH_CFA, ZE_CFA, ZBRANCH_CFA, 3, + DROP_CFA, EXIT_CFA, # Exit if TIB is exhausted + + STATE_CFA, FETCH_CFA, ZBRANCH_CFA, 24, + # Compiling + FIND_CFA, QDUP_CFA, ZBRANCH_CFA, 13, + + # Found word. + LIT_CFA, -1, EQ_CFA, INVERT_CFA, ZBRANCH_CFA, 4, + + # Immediate: Execute! + EXECUTE_CFA, BRANCH_CFA, -26, + + # Not immediate: Compile! + COMMA_CFA, BRANCH_CFA, -29, + + # No word found, parse number + NUMBER_CFA, LIT_CFA, LIT_CFA, COMMA_CFA, COMMA_CFA, BRANCH_CFA, -36, + + # Interpreting + FIND_CFA, QDUP_CFA, ZBRANCH_CFA, 5, + + # Found word. Execute! + DROP_CFA, EXECUTE_CFA, BRANCH_CFA, -44, + + # No word found, parse number and leave on stack + NUMBER_CFA, BRANCH_CFA, -47, + EXIT_CFA]) + +PROMPT_CFA = defPrimWord("PROMPT", () -> begin + if (mem[STATE] == 0 && currentSource() == STDIN) + println(" ok") + end + + return NEXT +end) + +QUIT_CFA = defWord("QUIT", + [LIT_CFA, 0, STATE_CFA, STORE_CFA, + LIT_CFA, 0, NUMTIB_CFA, STORE_CFA, + RSP0_CFA, RSPSTORE_CFA, + QUERY_CFA, + INTERPRET_CFA, PROMPT_CFA, + BRANCH_CFA,-4]) + +ABORT_CFA = defWord("ABORT", + [PSP0_CFA, PSPSTORE_CFA, QUIT_CFA]) + +BYE_CFA = defPrimWord("BYE", () -> begin + println("\nBye!") + return 0 +end) + +# File I/O + +INCLUDE_CFA = defPrimWord("INCLUDE", () -> begin + pushPS(32) + callPrim(mem[WORD_CFA]) + wordAddr = popPS()+1 + wordLen = mem[wordAddr-1] + word = getString(wordAddr, wordLen) + + fname = word + if !isfile(fname) + fname = Pkg.dir("forth","src",word) + if !isfile(fname) + error("No file named $word found in current directory or package source directory.") + end + end + push!(sources, open(fname, "r")) + + # Clear input buffer + mem[NUMTIB] = 0 + + return NEXT +end) + #### VM loop #### @@ -1034,8 +1042,8 @@ 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") +elseif isfile(Pkg.dir("forth","src", "lib.4th")) + initFileName = Pkg.dir("forth","src","lib.4th") end function run(;initialize=true)