X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=blobdiff_plain;f=src%2Fforth.jl;h=b1d782ce1d11a0e6d291083315532922ea43c51c;hb=d2b2b3e5b33f882c18c9e7cf8c6623f4e863c2dd;hp=11d0044fad4b8c2fe70b7fe5f096c6bb2cec290a;hpb=231d418c3abbf3c1cf08742e7634a6728714b30a;p=forth.jl.git diff --git a/src/forth.jl b/src/forth.jl index 11d0044..b1d782c 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: # @@ -123,7 +123,7 @@ end callPrim(addr::Int64) = primitives[-addr]() -# Word creation +# Word creation functions function createHeader(name::AbstractString, flags::Int64) mem[mem[HERE]] = mem[LATEST] @@ -159,7 +159,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,22 +175,17 @@ 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) + + mem[mem[HERE]] = DOCON; mem[HERE] += 1 + mem[mem[HERE]] = val; mem[HERE] += 1 return val end @@ -209,11 +204,39 @@ 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 = defExistingVar("PSP0", PSP0) +RSP0_CFA = defExistingVar("RSP0", RSP0) + +defConst("DOCOL", DOCOL) +defConst("DOCON", DOCON) +defConst("DOVAR", DOVAR) + +defConst("DICT", DICT) +defConst("MEMSIZE", size_mem) + +F_IMMED = defConst("F_IMMED", 128) +F_HIDDEN = defConst("F_HIDDEN", 256) +F_LENMASK = defConst("F_LENMASK", 127) + # Basic forth primitives DROP = defPrimWord("DROP", () -> begin @@ -245,9 +268,9 @@ ROT = defPrimWord("ROT", () -> begin a = popPS() b = popPS() c = popPS() + pushPS(b) pushPS(a) pushPS(c) - pushPS(b) return NEXT end) @@ -255,12 +278,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() @@ -283,8 +307,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) @@ -497,24 +530,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 @@ -611,24 +626,10 @@ 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 @@ -670,6 +671,7 @@ WORD = defPrimWord("WORD", () -> begin return NEXT end) +BASE, BASE_CFA = defNewVar("BASE", 10) NUMBER = defPrimWord("NUMBER", () -> begin wordLen = popPS() @@ -752,7 +754,9 @@ end) # Compilation -CREATE = defPrimWord("CREATE", () -> begin +STATE, STATE_CFA = defNewVar("STATE", 0) + +HEADER = defPrimWord("HEADER", () -> begin wordLen = popPS() wordAddr = popPS() @@ -794,7 +798,7 @@ HIDE = defWord("HIDE", COLON = defWord(":", [WORD, - CREATE, + HEADER, LIT, DOCOL, COMMA, LATEST_CFA, FETCH, HIDDEN, RBRAC, @@ -813,9 +817,33 @@ IMMEDIATE = defPrimWord("IMMEDIATE", () -> begin end, flags=F_IMMED) TICK = defWord("'", - [STATE_CFA, FETCH, ZBRANCH, 7, - FROMR, DUP, INCR, TOR, FETCH, EXIT, - WORD, FIND, TOCFA, EXIT]) + [WORD, FIND, TOCFA, EXIT]) + +BTICK = defWord("[']", + [FROMR, DUP, INCR, TOR, FETCH, EXIT]) + +# CREATE and DOES> + +CREATE = defWord("CREATE", + [WORD, + HEADER, + LIT, DOVAR, COMMA, EXIT]); + +DODOES = defPrim(() -> begin + pushRS(reg.IP) + reg.IP = reg.W + 1 + return NEXT +end, name="DOCOL") + +defConst("DODOES", DODOES) + +FROMDOES_PAREN = defWord("(DOES>)", + [DODOES, LATEST, FETCH, TOCFA, STORE, EXIT]) + +FROMDOES = defWord("DOES>", + [BTICK, FROMDOES_PAREN, COMMA, BTICK, EXIT, COMMA, + BTICK, LIT, COMMA, LATEST, FETCH, TODFA, COMMA], flags=F_IMMED) + # Strings @@ -844,12 +872,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]) @@ -862,7 +899,7 @@ 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() @@ -881,8 +918,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 @@ -979,7 +1015,7 @@ function run(;initialize=true) global initialized, initFileName if !initialized && initialize if initFileName != nothing - print("Including definitions from $initFileName.") + print("Including definitions from $initFileName...") push!(sources, open(initFileName, "r")) initialized = true else @@ -995,14 +1031,24 @@ function run(;initialize=true) 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 showerror(STDOUT, ex) println() + while !isempty(sources) && currentSource() != STDIN + close(pop!(sources)) + end + + mem[STATE] = 0 mem[NUMTIB] = 0 + reg.PSP = mem[PSP0] + reg.RSP = mem[RSP0] reg.IP = QUIT + 1 jmp = NEXT end