3 import Base.REPLCompletions
6 size_mem = 1000000 # 1 mega-int
9 size_RS = 1000 # Return stack size
10 size_PS = 1000 # Parameter stack size
11 size_TIB = 1000 # Terminal input buffer size
14 mem = Array{Int64,1}(size_mem)
15 primitives = Array{Function,1}()
16 primNames = Array{AbstractString,1}()
18 # Memory geography and built-in variables
21 H = nextVarAddr; nextVarAddr += 1 # Next free memory address
22 FORTH_LATEST = nextVarAddr; nextVarAddr += 1 # FORTH dict latest
23 CURRENT = nextVarAddr; nextVarAddr += 1 # Current compilation dict
25 RSP0 = nextVarAddr # bottom of RS
26 PSP0 = RSP0 + size_RS # bottom of PS
27 TIB = PSP0 + size_PS # address of terminal input buffer
28 mem[H] = TIB + size_TIB # location of bottom of dictionary
29 mem[FORTH_LATEST] = 0 # zero FORTH dict latest (no previous def)
30 mem[CURRENT] = FORTH_LATEST-1 # Compile words to system dict initially
32 DICT = mem[H] # Save bottom of dictionary as constant
36 RSP::Int64 # Return stack pointer
37 PSP::Int64 # Parameter/data stack pointer
38 IP::Int64 # Instruction pointer
39 W::Int64 # Working register
41 reg = Reg(RSP0, PSP0, 0, 0)
43 # Stack manipulation functions
45 function ensurePSDepth(depth::Int64)
46 if reg.PSP - PSP0 < depth
47 error("Parameter stack underflow.")
51 function ensurePSCapacity(toAdd::Int64)
52 if reg.PSP + toAdd >= PSP0 + size_PS
53 error("Parameter stack overflow.")
57 function ensureRSDepth(depth::Int64)
58 if reg.RSP - RSP0 < depth
59 error("Return stack underflow.")
63 function ensureRSCapacity(toAdd::Int64)
64 if reg.RSP + toAdd >= RSP0 + size_RS
65 error("Return stack overflow.")
69 function pushRS(val::Int64)
82 function pushPS(val::Int64)
85 mem[reg.PSP += 1] = val
96 # Handy functions for adding/retrieving strings to/from memory.
98 getString(addr::Int64, len::Int64) = AbstractString([Char(c) for c in mem[addr:(addr+len-1)]])
100 function putString(str::AbstractString, addr::Int64, maxLen::Int64)
101 len = min(length(str), maxLen)
102 mem[addr:(addr+len-1)] = [Int64(c) for c in str]
105 stringAsInts(str::AbstractString) = [Int(c) for c in collect(str)]
107 # Primitive creation and calling functions
109 function defPrim(f::Function; name="nameless")
111 push!(primNames, replace(name, "\004", "EOF"))
113 return -length(primitives)
116 function callPrim(addr::Int64)
117 if addr >=0 || -addr>length(primitives)
118 error("Attempted to execute non-existent primitive at address $addr.")
123 getPrimName(addr::Int64) = primNames[-addr]
125 # Word creation functions
132 function dictWrite(ints::Array{Int64,1})
133 mem[mem[H]:(mem[H]+length(ints)-1)] = ints
134 mem[H] += length(ints)
136 dictWrite(int::Int64) = dictWrite([int])
137 dictWriteString(string::AbstractString) = dictWrite([Int64(c) for c in string])
139 function createHeader(name::AbstractString, flags::Int64)
140 mem[mem[H]] = mem[mem[CURRENT]+1]
141 mem[mem[CURRENT]+1] = mem[H]
144 dictWrite(length(name) | flags | NFA_MARK)
145 dictWriteString(name)
148 function defPrimWord(name::AbstractString, f::Function; flags::Int64=0)
149 createHeader(name, flags)
151 codeWordAddr = mem[H]
152 dictWrite(defPrim(f, name=name))
157 function defWord(name::AbstractString, wordAddrs::Array{Int64,1}; flags::Int64=0)
158 createHeader(name, flags)
168 # Variable creation functions
170 function defExistingVar(name::AbstractString, varAddr::Int64; flags::Int64=0)
172 defPrimWord(name, eval(:(() -> begin
178 function defNewVar(name::AbstractString, initial::Array{Int64,1}; flags::Int64=0)
179 createHeader(name, flags)
181 codeWordAddr = mem[H]
187 return varAddr, codeWordAddr
190 defNewVar(name::AbstractString, initial::Int64; flags::Int64=0) =
191 defNewVar(name, [initial]; flags=flags)
193 function defConst(name::AbstractString, val::Int64; flags::Int64=0)
194 createHeader(name, flags)
196 codeWordAddr = mem[H]
204 # Threading Primitives (inner interpreter)
206 NEXT = defPrim(() -> begin
212 DOCOL = defPrim(() -> begin
218 DOVAR = defPrim(() -> begin
223 DOCON = defPrim(() -> begin
224 pushPS(mem[reg.W + 1])
228 EXIT_CFA = defPrimWord("EXIT", () -> begin
233 # Dictionary entries for core built-in variables, constants
235 H_CFA = defExistingVar("H", H)
237 PSP0_CFA = defConst("PSP0", PSP0)
238 RSP0_CFA = defConst("RSP0", RSP0)
240 defConst("DOCOL", DOCOL)
241 defConst("DOCON", DOCON)
242 defConst("DOVAR", DOVAR)
244 defConst("DICT", DICT)
245 defConst("MEMSIZE", size_mem)
247 F_IMMED_CFA = defConst("F_IMMED", F_IMMED)
248 F_HIDDEN_CFA = defConst("F_HIDDEN", F_HIDDEN)
249 F_LENMASK_CFA = defConst("F_LENMASK", F_LENMASK)
250 NFA_MARK_CFA = defConst("NFA_MARK", NFA_MARK)
252 # Basic forth primitives
254 DROP_CFA = defPrimWord("DROP", () -> begin
259 SWAP_CFA = defPrimWord("SWAP", () -> begin
267 DUP_CFA = defPrimWord("DUP", () -> begin
273 OVER_CFA = defPrimWord("OVER", () -> begin
275 pushPS(mem[reg.PSP-1])
279 ROT_CFA = defPrimWord("ROT", () -> begin
289 NROT_CFA = defPrimWord("-ROT", () -> begin
300 TWODROP_CFA = defPrimWord("2DROP", () -> begin
306 TWODUP_CFA = defPrimWord("2DUP", () -> begin
315 TWOSWAP_CFA = defPrimWord("2SWAP", () -> begin
327 TWOOVER_CFA = defPrimWord("2OVER", () -> begin
336 QDUP_CFA = defPrimWord("?DUP", () -> begin
345 INCR_CFA = defPrimWord("1+", () -> begin
351 DECR_CFA = defPrimWord("1-", () -> begin
357 INCR2_CFA = defPrimWord("2+", () -> begin
363 DECR2_CFA = defPrimWord("2-", () -> begin
369 ADD_CFA = defPrimWord("+", () -> begin
376 SUB_CFA = defPrimWord("-", () -> begin
383 MUL_CFA = defPrimWord("*", () -> begin
390 DIVMOD_CFA = defPrimWord("/MOD", () -> begin
399 TWOMUL_CFA = defPrimWord("2*", () -> begin
404 TWODIV_CFA = defPrimWord("2/", () -> begin
409 EQ_CFA = defPrimWord("=", () -> begin
412 pushPS(a==b ? -1 : 0)
416 NE_CFA = defPrimWord("<>", () -> begin
419 pushPS(a!=b ? -1 : 0)
423 LT_CFA = defPrimWord("<", () -> begin
430 GT_CFA = defPrimWord(">", () -> begin
437 LE_CFA = defPrimWord("<=", () -> begin
440 pushPS(a<=b ? -1 : 0)
444 GE_CFA = defPrimWord(">=", () -> begin
447 pushPS(a>=b ? -1 : 0)
451 ZE_CFA = defPrimWord("0=", () -> begin
452 pushPS(popPS() == 0 ? -1 : 0)
456 ZNE_CFA = defPrimWord("0<>", () -> begin
457 pushPS(popPS() != 0 ? -1 : 0)
461 ZLT_CFA = defPrimWord("0<", () -> begin
462 pushPS(popPS() < 0 ? -1 : 0)
466 ZGT_CFA = defPrimWord("0>", () -> begin
467 pushPS(popPS() > 0 ? -1 : 0)
471 ZLE_CFA = defPrimWord("0<=", () -> begin
472 pushPS(popPS() <= 0 ? -1 : 0)
476 ZGE_CFA = defPrimWord("0>=", () -> begin
477 pushPS(popPS() >= 0 ? -1 : 0)
481 AND_CFA = defPrimWord("AND", () -> begin
488 OR_CFA = defPrimWord("OR", () -> begin
495 XOR_CFA = defPrimWord("XOR", () -> begin
502 INVERT_CFA = defPrimWord("INVERT", () -> begin
509 LIT_CFA = defPrimWord("LIT", () -> begin
517 STORE_CFA = defPrimWord("!", () -> begin
524 FETCH_CFA = defPrimWord("@", () -> begin
530 ADDSTORE_CFA = defPrimWord("+!", () -> begin
537 SUBSTORE_CFA = defPrimWord("-!", () -> begin
547 TOR_CFA = defPrimWord(">R", () -> begin
552 FROMR_CFA = defPrimWord("R>", () -> begin
557 RFETCH_CFA = defPrimWord("R@", () -> begin
562 RSPFETCH_CFA = defPrimWord("RSP@", () -> begin
567 RSPSTORE_CFA = defPrimWord("RSP!", () -> begin
572 RDROP_CFA = defPrimWord("RDROP", () -> begin
579 PSPFETCH_CFA = defPrimWord("PSP@", () -> begin
584 PSPSTORE_CFA = defPrimWord("PSP!", () -> begin
591 WFETCH_CFA = defPrimWord("W@", () -> begin
596 WSTORE_CFA = defPrimWord("W!", () -> begin
603 sources = Array{Any,1}()
604 currentSource() = sources[length(sources)]
606 CLOSEFILES_CFA = defPrimWord("CLOSEFILES", () -> begin
607 while currentSource() != STDIN
614 EOF_CFA = defPrimWord("\x04", () -> begin
615 if currentSource() != STDIN
623 EMIT_CFA = defPrimWord("EMIT", () -> begin
628 function raw_mode!(mode::Bool)
629 if ccall(:jl_tty_set_mode, Int32, (Ptr{Void}, Int32), STDIN.handle, mode) != 0
630 throw("FATAL: Terminal unable to enter raw mode.")
636 byte = readbytes(STDIN, 1)[1]
648 KEY_CFA = defPrimWord("KEY", () -> begin
649 pushPS(Int(getKey()))
653 function getLineFromSTDIN()
657 slashIdx = findlast(chars, '\\')
660 return join(chars[slashIdx:length(chars)])
666 function backspaceStr(s, bsCount)
668 newLen = max(0, oldLen - bsCount)
669 return join(collect(s)[1:newLen])
678 return AbstractString(line)
682 return string("\x04")
688 line = backspaceStr(line, 1)
692 # Strip ANSI escape sequence
693 nextKey = Char(getKey())
696 nextKey = Char(getKey())
697 if nextKey >= '@' || nextKey <= '~'
704 # Currently do nothing
708 if haskey(REPLCompletions.latex_symbols, frag)
709 print(repeat("\b", length(frag)))
711 comp = REPLCompletions.latex_symbols[frag]
712 line = string(backspaceStr(line, length(frag)), comp)
719 line = string(line, key)
724 SPAN, SPAN_CFA = defNewVar("SPAN", 0)
725 EXPECT_CFA = defPrimWord("EXPECT", () -> begin
729 if currentSource() == STDIN
730 line = getLineFromSTDIN()
732 if !eof(currentSource())
733 line = chomp(readline(currentSource()))
739 mem[SPAN] = min(length(line), maxLen)
740 putString(line, addr, maxLen)
745 BASE, BASE_CFA = defNewVar("BASE", 10)
746 NUMBER_CFA = defPrimWord("NUMBER", () -> begin
748 wordLen = mem[wordAddr-1]
750 s = getString(wordAddr, wordLen)
752 pushPS(parse(Int64, s, mem[BASE]))
757 # Dictionary searches
759 FROMLINK_CFA = defPrimWord("LINK>", () -> begin
762 lenAndFlags = mem[addr+1]
763 len = lenAndFlags & F_LENMASK
765 pushPS(addr + 2 + len)
770 NUMCONTEXT, NUMCONTEXT_CFA = defNewVar("#CONTEXT", 1)
772 createHeader("FORTH", 0)
774 dictWrite(defPrim(() -> begin
775 mem[CONTEXT + mem[NUMCONTEXT] - 1] = reg.W
778 dictWrite(0) # cell for latest
780 CURRENT_CFA = defExistingVar("CURRENT", CURRENT)
782 # Switch to new FORTH vocabulary cfa
783 mem[FORTH_CFA+1] = mem[mem[CURRENT]+1]
784 mem[CURRENT] = FORTH_CFA
786 CONTEXT, CONTEXT_CFA = defNewVar("CONTEXT", zeros(Int64, 10))
787 mem[CONTEXT] = FORTH_CFA
789 FINDVOCAB_CFA = defPrimWord("FINDVOCAB", () -> begin
791 countedAddr = popPS()
793 wordAddr = countedAddr + 1
794 wordLen = mem[countedAddr]
795 word = lowercase(getString(wordAddr, wordLen))
800 while (lfa = mem[lfa]) > 0
802 lenAndFlags = mem[lfa+1]
803 len = lenAndFlags & F_LENMASK
804 hidden = (lenAndFlags & F_HIDDEN) == F_HIDDEN
806 if hidden || len != wordLen
810 thisWord = lowercase(getString(lfa+2, len))
819 callPrim(mem[FROMLINK_CFA])
820 if (lenAndFlags & F_IMMED) == F_IMMED
833 FIND_CFA = defPrimWord("FIND", () -> begin
835 countedAddr = popPS()
836 context = mem[CONTEXT:(CONTEXT+mem[NUMCONTEXT]-1)]
838 for vocabCFA in reverse(context)
841 callPrim(mem[FINDVOCAB_CFA])
843 callPrim(mem[DUP_CFA])
861 BRANCH_CFA = defPrimWord("BRANCH", () -> begin
862 reg.IP += mem[reg.IP]
866 ZBRANCH_CFA = defPrimWord("0BRANCH", () -> begin
868 reg.IP += mem[reg.IP]
878 LITSTRING_CFA = defPrimWord("LITSTRING", () -> begin
888 TYPE_CFA = defPrimWord("TYPE", () -> begin
891 str = getString(addr, len)
896 # Interpreter/Compiler-specific I/O
898 TIB_CFA = defConst("TIB", TIB)
899 NUMTIB, NUMTIB_CFA = defNewVar("#TIB", 0)
900 TOIN, TOIN_CFA = defNewVar(">IN", 0)
902 QUERY_CFA = defWord("QUERY",
903 [TIB_CFA, LIT_CFA, 160, EXPECT_CFA,
904 SPAN_CFA, FETCH_CFA, NUMTIB_CFA, STORE_CFA,
905 LIT_CFA, 0, TOIN_CFA, STORE_CFA,
908 WORD_CFA = defPrimWord("WORD", () -> begin
911 # Chew up initial occurrences of delim
912 while (mem[TOIN]<mem[NUMTIB] && mem[TIB+mem[TOIN]] == delim)
919 # Start reading in word
921 while (mem[TOIN]<mem[NUMTIB])
922 mem[addr] = mem[TIB+mem[TOIN]]
925 if (mem[addr] == delim)
934 mem[countAddr] = count
942 STATE, STATE_CFA = defNewVar("STATE", 0)
944 COMMA_CFA = defPrimWord(",", () -> begin
945 mem[mem[H]] = popPS()
951 HERE_CFA = defWord("HERE",
952 [H_CFA, FETCH_CFA, EXIT_CFA])
954 HEADER_CFA = defPrimWord("HEADER", () -> begin
956 wordLen = mem[wordAddr-1]
957 word = getString(wordAddr, wordLen)
959 createHeader(word, 0)
964 CREATE_CFA = defWord("CREATE",
965 [LIT_CFA, 32, WORD_CFA, HEADER_CFA,
966 LIT_CFA, DOVAR, COMMA_CFA,
969 DODOES = defPrim(() -> begin
976 DOES_HELPER_CFA = defPrimWord("(DOES>)", () -> begin
978 pushPS(mem[mem[CURRENT]+1])
979 callPrim(mem[FROMLINK_CFA])
982 runtimeAddr = popPS()
984 mem[cfa] = defPrim(eval(:(() -> begin
985 pushPS($(runtimeAddr))
987 end)), name="doesPrim")
990 end, flags=F_IMMED | F_HIDDEN)
992 DOES_CFA = defWord("DOES>",
993 [LIT_CFA, LIT_CFA, COMMA_CFA, HERE_CFA, LIT_CFA, 3, ADD_CFA, COMMA_CFA,
994 LIT_CFA, DOES_HELPER_CFA, COMMA_CFA, LIT_CFA, EXIT_CFA, COMMA_CFA, EXIT_CFA],
997 LBRAC_CFA = defPrimWord("[", () -> begin
1002 RBRAC_CFA = defPrimWord("]", () -> begin
1007 HIDDEN_CFA = defPrimWord("HIDDEN", () -> begin
1008 lenAndFlagsAddr = mem[mem[CURRENT]+1] + 1
1009 mem[lenAndFlagsAddr] = mem[lenAndFlagsAddr] $ F_HIDDEN
1013 COLON_CFA = defWord(":",
1014 [LIT_CFA, 32, WORD_CFA,
1016 LIT_CFA, DOCOL, COMMA_CFA,
1021 SEMICOLON_CFA = defWord(";",
1022 [LIT_CFA, EXIT_CFA, COMMA_CFA,
1025 EXIT_CFA], flags=F_IMMED)
1027 IMMEDIATE_CFA = defPrimWord("IMMEDIATE", () -> begin
1028 lenAndFlagsAddr = mem[mem[CURRENT]+1] + 1
1029 mem[lenAndFlagsAddr] = mem[lenAndFlagsAddr] $ F_IMMED
1033 CODE_CFA = defPrimWord("CODE", () -> begin
1035 callPrim(mem[WORD_CFA])
1036 callPrim(mem[HEADER_CFA])
1038 exprString = "() -> begin\n"
1040 if mem[TOIN] >= mem[NUMTIB]
1041 exprString = string(exprString, "\n")
1042 if currentSource() == STDIN
1048 callPrim(mem[EXPECT_CFA])
1049 mem[NUMTIB] = mem[SPAN]
1054 callPrim(mem[WORD_CFA])
1056 thisWord = getString(cAddr+1, mem[cAddr])
1058 if uppercase(thisWord) == "END-CODE"
1062 exprString = string(exprString, " ", thisWord)
1064 exprString = string(exprString, "\nreturn NEXT\nend")
1066 func = eval(parse(exprString))
1067 dictWrite(defPrim(func))
1074 EXECUTE_CFA = defPrimWord("EXECUTE", () -> begin
1079 INTERPRET_CFA = defWord("INTERPRET",
1080 [LIT_CFA, 32, WORD_CFA, # Read next space-delimited word
1082 DUP_CFA, FETCH_CFA, ZE_CFA, ZBRANCH_CFA, 3,
1083 DROP_CFA, EXIT_CFA, # Exit if TIB is exhausted
1085 STATE_CFA, FETCH_CFA, ZBRANCH_CFA, 24,
1087 FIND_CFA, QDUP_CFA, ZBRANCH_CFA, 13,
1090 LIT_CFA, -1, EQ_CFA, INVERT_CFA, ZBRANCH_CFA, 4,
1092 # Immediate: Execute!
1093 EXECUTE_CFA, BRANCH_CFA, -26,
1095 # Not immediate: Compile!
1096 COMMA_CFA, BRANCH_CFA, -29,
1098 # No word found, parse number
1099 NUMBER_CFA, LIT_CFA, LIT_CFA, COMMA_CFA, COMMA_CFA, BRANCH_CFA, -36,
1102 FIND_CFA, QDUP_CFA, ZBRANCH_CFA, 5,
1104 # Found word. Execute!
1105 DROP_CFA, EXECUTE_CFA, BRANCH_CFA, -44,
1107 # No word found, parse number and leave on stack
1108 NUMBER_CFA, BRANCH_CFA, -47,
1111 PROMPT_CFA = defPrimWord("PROMPT", () -> begin
1112 if currentSource() == STDIN
1122 QUIT_CFA = defWord("QUIT",
1123 [LIT_CFA, 0, STATE_CFA, STORE_CFA,
1124 LIT_CFA, 0, NUMTIB_CFA, STORE_CFA,
1125 RSP0_CFA, RSPSTORE_CFA,
1127 INTERPRET_CFA, PROMPT_CFA,
1130 ABORT_CFA = defWord("ABORT",
1131 [CLOSEFILES_CFA, PSP0_CFA, PSPSTORE_CFA, QUIT_CFA])
1133 BYE_CFA = defPrimWord("BYE", () -> begin
1140 INCLUDE_CFA = defPrimWord("INCLUDE", () -> begin
1142 callPrim(mem[WORD_CFA])
1143 wordAddr = popPS()+1
1144 wordLen = mem[wordAddr-1]
1145 word = getString(wordAddr, wordLen)
1149 fname = Pkg.dir("forth","src",word)
1151 error("No file named $word found in current directory or package source directory.")
1154 push!(sources, open(fname, "r"))
1156 # Clear input buffer
1166 initFileName = nothing
1167 if isfile("lib.4th")
1168 initFileName = "lib.4th"
1169 elseif isfile(Pkg.dir("forth","src", "lib.4th"))
1170 initFileName = Pkg.dir("forth","src","lib.4th")
1173 function run(;initialize=true)
1174 # Begin with STDIN as source
1175 push!(sources, STDIN)
1177 global initialized, initFileName
1178 if !initialized && initialize
1179 if initFileName != nothing
1180 print("Including definitions from $initFileName...")
1181 push!(sources, open(initFileName, "r"))
1184 println("No library file found. Only primitive words available.")
1188 # Start with IP pointing to first instruction of outer interpreter
1189 reg.IP = QUIT_CFA + 1
1191 # Primitive processing loop.
1192 # Everyting else is simply a consequence of this loop!
1196 #println("Entering prim $(getPrimName(jmp))")
1200 showerror(STDOUT, ex)
1203 while !isempty(sources) && currentSource() != STDIN
1204 close(pop!(sources))
1208 reg.IP = ABORT_CFA + 1
1216 TRACE_CFA = defPrimWord("TRACE", () -> begin
1217 println("reg.W: $(reg.W) reg.IP: $(reg.IP)")
1218 print("PS: "); printPS()
1219 print("RS: "); printRS()
1226 function dump(startAddr::Int64; count::Int64 = 100, cellsPerLine::Int64 = 10)
1227 chars = Array{Char,1}(cellsPerLine)
1229 lineStartAddr = cellsPerLine*div((startAddr-1),cellsPerLine) + 1
1230 endAddr = startAddr + count - 1
1232 q, r = divrem((endAddr-lineStartAddr+1), cellsPerLine)
1233 numLines = q + (r > 0 ? 1 : 0)
1239 for c in 1:cellsPerLine
1240 if i >= startAddr && i <= endAddr
1242 if mem[i]>=32 && mem[i]<128
1243 chars[c] = Char(mem[i])
1255 println("\t", AbstractString(chars))
1260 count = reg.PSP - PSP0
1264 for i in (PSP0+1):reg.PSP
1269 println("Parameter stack empty")
1274 count = reg.RSP - RSP0
1278 for i in (RSP0+1):reg.RSP
1283 println("Return stack empty")
1287 DUMP = defPrimWord("DUMP", () -> begin
1292 dump(addr, count=count)