X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=blobdiff_plain;ds=sidebyside;f=src%2Fforth.jl;h=4b625bc146eb19cbcc36a51f6ab414789726645d;hb=03de266dbc3975cfa2f3b07de2d58ff642f4bf76;hp=cdfe88d901130ae6720aa9e0aa96c8324403d834;hpb=b6b53f943f1a2ceb89b03c2a2930c66d4972df07;p=forth.jl.git diff --git a/src/forth.jl b/src/forth.jl index cdfe88d..4b625bc 100644 --- a/src/forth.jl +++ b/src/forth.jl @@ -31,6 +31,7 @@ size_TIB = 1096 # Terminal input buffer size mem = Array{Int64,1}(size_mem) primitives = Array{Function,1}() +primNames = Array{ASCIIString,1}() # Built-in variables @@ -101,6 +102,13 @@ function popPS() return val end +# Handy functions for adding/retrieving strings to/from memory. + +getString(addr::Int64, len::Int64) = ASCIIString([Char(c) for c in mem[addr:(addr+len-1)]]) +function putString(str::ASCIIString, addr::Int64) + mem[addr:(addr+length(str)-1)] = [Int64(c) for c in str] +end + # Primitive creation and calling functions function createHeader(name::AbstractString, flags::Int64) @@ -109,7 +117,7 @@ function createHeader(name::AbstractString, flags::Int64) mem[HERE] += 1 mem[mem[HERE]] = length(name) | flags; mem[HERE] += 1 - mem[mem[HERE]:(mem[HERE]+length(name)-1)] = [Int(c) for c in name]; mem[HERE] += length(name) + putString(name, mem[HERE]); mem[HERE] += length(name) end function defPrim(name::AbstractString, f::Function; flags::Int64=0) @@ -120,6 +128,8 @@ function defPrim(name::AbstractString, f::Function; flags::Int64=0) mem[codeWordAddr] = -length(primitives) mem[HERE] += 1 + push!(primNames, name) + return codeWordAddr end @@ -135,6 +145,7 @@ end function defNewVar(name::AbstractString, initial::Int64; flags::Int64=0) createHeader(name, flags) + codeWordAddr = mem[HERE] varAddr = mem[HERE] + 1 push!(primitives, eval(:(() -> begin pushPS($(varAddr)) @@ -144,7 +155,7 @@ function defNewVar(name::AbstractString, initial::Int64; flags::Int64=0) mem[mem[HERE]] = initial; mem[HERE] += 1 - return varAddr + return varAddr, codeWordAddr end function defConst(name::AbstractString, val::Int64; flags::Int64=0) @@ -464,12 +475,12 @@ end) # Built-in variables -defExistingVar("HERE", HERE) -defExistingVar("LATEST", LATEST) -defExistingVar("PSP0", PSP0) -defExistingVar("RSP0", RSP0) -STATE = defNewVar("STATE", 0) -BASE = defNewVar("BASE", 10) +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 @@ -522,15 +533,15 @@ end) # I/O defConst("TIB", TIB) -NUMTIB = defNewVar("#TIB", 0) -TOIN = defNewVar(">IN", 0) +NUMTIB, NUMTIB_CFA = defNewVar("#TIB", 0) +TOIN, TOIN_CFA = defNewVar(">IN", 0) KEY = defPrim("KEY", () -> begin if mem[TOIN] >= mem[NUMTIB] mem[TOIN] = 0 line = readline() mem[NUMTIB] = length(line) - mem[TIB:(TIB+mem[NUMTIB]-1)] = [Int64(c) for c in collect(line)] + putString(line, TIB) end pushPS(mem[TIB + mem[TOIN]]) @@ -576,6 +587,15 @@ WORD = defPrim("WORD", () -> begin wordAddr = mem[HERE] offset = 0 + if c == '\n' + # Treat newline as a special word + + mem[wordAddr + offset] = Int64(c) + pushPS(wordAddr) + pushPS(1) + return mem[NEXT] + end + while true mem[wordAddr + offset] = Int64(c) offset += 1 @@ -584,6 +604,8 @@ WORD = defPrim("WORD", () -> begin c = Char(popPS()) if c == ' ' || c == '\t' || c == '\n' + # Rewind KEY + mem[TOIN] -= 1 break end end @@ -601,7 +623,7 @@ NUMBER = defPrim("NUMBER", () -> begin wordLen = popPS() wordAddr = popPS() - s = ASCIIString([Char(c) for c in mem[wordAddr:(wordAddr+wordLen-1)]]) + s = getString(wordAddr, wordLen) try pushPS(parse(Int64, s, mem[BASE])) @@ -619,24 +641,24 @@ FIND = defPrim("FIND", () -> begin wordLen = popPS() wordAddr = popPS() - word = ASCIIString([Char(c) for c in mem[wordAddr:(wordAddr+wordLen-1)]]) + word = lowercase(getString(wordAddr, wordLen)) - latest = mem[LATEST] + latest = LATEST - while latest>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 - latest = mem[latest] continue end thisAddr = latest+2 - thisWord = ASCIIString([Char(c) for c in mem[thisAddr:(thisAddr+len-1)]]) + thisWord = lowercase(getString(thisAddr, len)) - if thisWord == word + if lowercase(thisWord) == lowercase(word) break end end @@ -665,14 +687,9 @@ CREATE = defPrim("CREATE", () -> begin wordLen = popPS() wordAddr = popPS() - word = ASCIIString([Char(c) for c in mem[wordAddr:(wordAddr+wordLen-1)]]) - - mem[mem[HERE]] = mem[LATEST]; mem[HERE] += 1 - mem[LATEST] = mem[HERE] - mem[mem[HERE]] = wordLen; mem[HERE] += 1 + word = getString(wordAddr, wordLen) - mem[mem[HERE]:(mem[HERE]+wordLen-1)] = collect(Int64, word) - mem[HERE] += wordLen + createHeader(word, 0) return mem[NEXT] end) @@ -687,19 +704,25 @@ end) LBRAC = defPrim("[", () -> begin mem[STATE] = 0 return mem[NEXT] -end, flags=F_IMMEDIATE) +end, flags=F_IMMED) RBRAC = defPrim("]", () -> begin mem[STATE] = 1 return mem[NEXT] -end, flags=F_IMMEDIATE) +end, flags=F_IMMED) HIDDEN = defPrim("HIDDEN", () -> begin addr = popPS() + 1 mem[addr] = mem[addr] $ F_HIDDEN - reurn mem[NEXT] + return mem[NEXT] end) +HIDE = defWord("HIDE", + [WORD, + FIND, + HIDDEN, + EXIT]) + COLON = defWord(":", [WORD, CREATE, @@ -712,12 +735,154 @@ SEMICOLON = defWord(";", [LIT, EXIT, COMMA, LATEST, FETCH, HIDDEN, LBRAC, - EXIT], flags=F_IMMEDIATE) + EXIT], flags=F_IMMED) + +IMMEDIATE = defPrim("IMMEDIATE", () -> begin + lenAndFlagsAddr = mem[LATEST] + 1 + mem[lenAndFlagsAddr] = mem[lenAndFlagsAddr] $ F_IMMED + return mem[NEXT] +end, flags=F_IMMED) + +TICK = defWord("'", [WORD, FIND, TOCFA, EXIT]) + +# Branching + +BRANCH = defPrim("BRANCH", () -> begin + reg.IP += mem[reg.IP] + return mem[NEXT] +end) + +ZBRANCH = defPrim("0BRANCH", () -> begin + if (popPS() == 0) + reg.IP += mem[reg.IP] + else + reg.IP += 1 + end + + return mem[NEXT] +end) + +# Strings + +LITSTRING = defPrim("LITSTRING", () -> begin + len = mem[reg.IP] + reg.IP += 1 + pushPS(reg.IP) + pushPS(len) + reg.IP += len + + return mem[NEXT] +end) + +TELL = defPrim("TELL", () -> begin + len = popPS() + addr = popPS() + str = getString(addr, len) + print(str) + return mem[NEXT] +end) + +# Outer interpreter + +INTERPRET = defPrim("INTERPRET", () -> begin + + callPrim(mem[WORD]) + + wordName = getString(mem[reg.PSP-1], mem[reg.PSP]) + println("... ", replace(wordName, "\n", "\\n"), " ...") + + callPrim(mem[TWODUP]) + callPrim(mem[FIND]) + + wordAddr = mem[reg.PSP] + + + if wordAddr>0 + # Word in dictionary + + isImmediate = (mem[wordAddr+1] & F_IMMED) != 0 + callPrim(mem[TOCFA]) + + callPrim(mem[ROT]) # get rid of extra copy of word string details + popPS() + popPS() + + if mem[STATE] == 0 || isImmediate + # Execute! + return mem[popPS()] + else + # Append CFA to dictionary + callPrim(mem[COMMA]) + end + else + # Not in dictionary, assume number + + popPS() + + callPrim(mem[NUMBER]) + + if popPS() != 0 + println("Parse error at word: '$wordName'") + return mem[NEXT] + else + end + + if mem[STATE] == 0 + # Number already on stack! + else + # Append literal to dictionary + pushPS(LIT) + callPrim(mem[COMMA]) + callPrim(mem[COMMA]) + end + end + + return mem[NEXT] +end) + +QUIT = defWord("QUIT", + [RSP0_CFA, RSPSTORE, + INTERPRET, + BRANCH,-2]) + +NL = defPrim("\n", () -> begin + if mem[STATE] == 0 + println(" ok") + end + return mem[NEXT] +end) + +# Odds and Ends + +CHAR = defPrim("CHAR", () -> begin + callPrim(mem[WORD]) + wordLen = popPS() + wordAddr = popPS() + word = getString(wordAddr, wordLen) + pushPS(Int64(word[1])) + + return mem[NEXT] +end) + +EXECUTE = defPrim("EXECUTE", () -> begin + return mem[popPS()] +end) + +BYE = defPrim("BYE", () -> begin + return 0 +end) #### VM loop #### function runVM() - jmp = NEXT - while (jmp = callPrim(jmp)) != 0 end + # Start with IP pointing to first instruction of outer interpreter + reg.IP = QUIT + 1 + + # Primitive processing loop. + # Everyting else is simply a consequence of this loop! + jmp = mem[NEXT] + while (jmp = callPrim(jmp)) != 0 + println("Evaluating prim $jmp [$(primNames[-jmp])]") + end end # Debugging tools @@ -725,23 +890,33 @@ end function dump(startAddr::Int64; count::Int64 = 100, cellsPerLine::Int64 = 10) chars = Array{Char,1}(cellsPerLine) - for i in 0:(count-1) - addr = startAddr + i - if i%cellsPerLine == 0 - print("$addr:") - end - - print("\t$(mem[addr]) ") + lineStartAddr = cellsPerLine*div((startAddr-1),cellsPerLine) + 1 + endAddr = startAddr + count - 1 + + q, r = divrem((endAddr-lineStartAddr+1), cellsPerLine) + numLines = q + (r > 0 ? 1 : 0) + + i = lineStartAddr + for l in 1:numLines + print(i,":") + + for c in 1:cellsPerLine + if i >= startAddr && i <= endAddr + print("\t",mem[i]) + if mem[i]>=32 && mem[i]<128 + chars[c] = Char(mem[i]) + else + chars[c] = '.' + end + else + print("\t") + chars[c] = ' ' + end - if (mem[addr]>=32 && mem[addr]<176) - chars[i%cellsPerLine + 1] = Char(mem[addr]) - else - chars[i%cellsPerLine + 1] = '.' + i += 1 end - if i%cellsPerLine == cellsPerLine-1 - println(string("\t", ASCIIString(chars))) - end + println("\t", ASCIIString(chars)) end end