4 size_mem = 1000000 # 1 mega-int
7 size_RS = 1000 # Return stack size
8 size_PS = 1000 # Parameter stack size
9 size_TIB = 1000 # Terminal input buffer size
12 mem = Array{Int64,1}(size_mem)
13 primitives = Array{Function,1}()
14 primNames = Array{ASCIIString,1}()
16 # Memory geography and built-in variables
19 H = nextVarAddr; nextVarAddr += 1 # Next free memory address
20 FORTH_LATEST = nextVarAddr; nextVarAddr += 1 # FORTH dict latest
21 CURRENT = nextVarAddr; nextVarAddr += 1 # Current compilation dict
23 RSP0 = nextVarAddr # bottom of RS
24 PSP0 = RSP0 + size_RS # bottom of PS
25 TIB = PSP0 + size_PS # address of terminal input buffer
26 mem[H] = TIB + size_TIB # location of bottom of dictionary
27 mem[FORTH_LATEST] = 0 # zero FORTH dict latest (no previous def)
28 mem[CURRENT] = FORTH_LATEST-1 # Compile words to system dict initially
30 DICT = mem[H] # Save bottom of dictionary as constant
34 RSP::Int64 # Return stack pointer
35 PSP::Int64 # Parameter/data stack pointer
36 IP::Int64 # Instruction pointer
37 W::Int64 # Working register
39 reg = Reg(RSP0, PSP0, 0, 0)
41 # Stack manipulation functions
43 function ensurePSDepth(depth::Int64)
44 if reg.PSP - PSP0 < depth
45 error("Parameter stack underflow.")
49 function ensureRSDepth(depth::Int64)
50 if reg.RSP - RSP0 < depth
51 error("Return stack underflow.")
55 function pushRS(val::Int64)
67 function pushPS(val::Int64)
68 mem[reg.PSP += 1] = val
79 # Handy functions for adding/retrieving strings to/from memory.
81 getString(addr::Int64, len::Int64) = ASCIIString([Char(c) for c in mem[addr:(addr+len-1)]])
83 function putString(str::ASCIIString, addr::Int64)
84 mem[addr:(addr+length(str)-1)] = [Int64(c) for c in str]
87 stringAsInts(str::ASCIIString) = [Int(c) for c in collect(str)]
89 # Primitive creation and calling functions
91 function defPrim(f::Function; name="nameless")
93 push!(primNames, replace(name, "\004", "EOF"))
95 return -length(primitives)
98 function callPrim(addr::Int64)
99 if addr >=0 || -addr>length(primitives)
100 error("Attempted to execute non-existent primitive at address $addr.")
105 getPrimName(addr::Int64) = primNames[-addr]
107 # Word creation functions
114 function dictWrite(ints::Array{Int64,1})
115 mem[mem[H]:(mem[H]+length(ints)-1)] = ints
116 mem[H] += length(ints)
118 dictWrite(int::Int64) = dictWrite([int])
119 dictWriteString(string::ASCIIString) = dictWrite([Int64(c) for c in string])
121 function createHeader(name::AbstractString, flags::Int64)
122 mem[mem[H]] = mem[mem[CURRENT]+1]
123 mem[mem[CURRENT]+1] = mem[H]
126 dictWrite(length(name) | flags | NFA_MARK)
127 dictWriteString(name)
130 function defPrimWord(name::AbstractString, f::Function; flags::Int64=0)
131 createHeader(name, flags)
133 codeWordAddr = mem[H]
134 dictWrite(defPrim(f, name=name))
139 function defWord(name::AbstractString, wordAddrs::Array{Int64,1}; flags::Int64=0)
140 createHeader(name, flags)
150 # Variable creation functions
152 function defExistingVar(name::AbstractString, varAddr::Int64; flags::Int64=0)
154 defPrimWord(name, eval(:(() -> begin
160 function defNewVar(name::AbstractString, initial::Array{Int64,1}; flags::Int64=0)
161 createHeader(name, flags)
163 codeWordAddr = mem[H]
169 return varAddr, codeWordAddr
172 defNewVar(name::AbstractString, initial::Int64; flags::Int64=0) =
173 defNewVar(name, [initial]; flags=flags)
175 function defConst(name::AbstractString, val::Int64; flags::Int64=0)
176 createHeader(name, flags)
178 codeWordAddr = mem[H]
186 # Threading Primitives (inner interpreter)
188 NEXT = defPrim(() -> begin
194 DOCOL = defPrim(() -> begin
200 DOVAR = defPrim(() -> begin
205 DOCON = defPrim(() -> begin
206 pushPS(mem[reg.W + 1])
210 EXIT_CFA = defPrimWord("EXIT", () -> begin
215 # Dictionary entries for core built-in variables, constants
217 H_CFA = defExistingVar("H", H)
219 PSP0_CFA = defConst("PSP0", PSP0)
220 RSP0_CFA = defConst("RSP0", RSP0)
222 defConst("DOCOL", DOCOL)
223 defConst("DOCON", DOCON)
224 defConst("DOVAR", DOVAR)
226 defConst("DICT", DICT)
227 defConst("MEMSIZE", size_mem)
229 F_IMMED_CFA = defConst("F_IMMED", F_IMMED)
230 F_HIDDEN_CFA = defConst("F_HIDDEN", F_HIDDEN)
231 F_LENMASK_CFA = defConst("F_LENMASK", F_LENMASK)
232 NFA_MARK_CFA = defConst("NFA_MARK", NFA_MARK)
234 # Basic forth primitives
236 DROP_CFA = defPrimWord("DROP", () -> begin
241 SWAP_CFA = defPrimWord("SWAP", () -> begin
249 DUP_CFA = defPrimWord("DUP", () -> begin
255 OVER_CFA = defPrimWord("OVER", () -> begin
257 pushPS(mem[reg.PSP-1])
261 ROT_CFA = defPrimWord("ROT", () -> begin
271 NROT_CFA = defPrimWord("-ROT", () -> begin
282 TWODROP_CFA = defPrimWord("2DROP", () -> begin
288 TWODUP_CFA = defPrimWord("2DUP", () -> begin
297 TWOSWAP_CFA = defPrimWord("2SWAP", () -> begin
309 TWOOVER_CFA = defPrimWord("2OVER", () -> begin
318 QDUP_CFA = defPrimWord("?DUP", () -> begin
327 INCR_CFA = defPrimWord("1+", () -> begin
333 DECR_CFA = defPrimWord("1-", () -> begin
339 INCR2_CFA = defPrimWord("2+", () -> begin
345 DECR2_CFA = defPrimWord("2-", () -> begin
351 ADD_CFA = defPrimWord("+", () -> begin
358 SUB_CFA = defPrimWord("-", () -> begin
365 MUL_CFA = defPrimWord("*", () -> begin
372 DIVMOD_CFA = defPrimWord("/MOD", () -> begin
381 TWOMUL_CFA = defPrimWord("2*", () -> begin
386 TWODIV_CFA = defPrimWord("2/", () -> begin
391 EQ_CFA = defPrimWord("=", () -> begin
394 pushPS(a==b ? -1 : 0)
398 NE_CFA = defPrimWord("<>", () -> begin
401 pushPS(a!=b ? -1 : 0)
405 LT_CFA = defPrimWord("<", () -> begin
412 GT_CFA = defPrimWord(">", () -> begin
419 LE_CFA = defPrimWord("<=", () -> begin
422 pushPS(a<=b ? -1 : 0)
426 GE_CFA = defPrimWord(">=", () -> begin
429 pushPS(a>=b ? -1 : 0)
433 ZE_CFA = defPrimWord("0=", () -> begin
434 pushPS(popPS() == 0 ? -1 : 0)
438 ZNE_CFA = defPrimWord("0<>", () -> begin
439 pushPS(popPS() != 0 ? -1 : 0)
443 ZLT_CFA = defPrimWord("0<", () -> begin
444 pushPS(popPS() < 0 ? -1 : 0)
448 ZGT_CFA = defPrimWord("0>", () -> begin
449 pushPS(popPS() > 0 ? -1 : 0)
453 ZLE_CFA = defPrimWord("0<=", () -> begin
454 pushPS(popPS() <= 0 ? -1 : 0)
458 ZGE_CFA = defPrimWord("0>=", () -> begin
459 pushPS(popPS() >= 0 ? -1 : 0)
463 AND_CFA = defPrimWord("AND", () -> begin
470 OR_CFA = defPrimWord("OR", () -> begin
477 XOR_CFA = defPrimWord("XOR", () -> begin
484 INVERT_CFA = defPrimWord("INVERT", () -> begin
491 LIT_CFA = defPrimWord("LIT", () -> begin
499 STORE_CFA = defPrimWord("!", () -> begin
506 FETCH_CFA = defPrimWord("@", () -> begin
512 ADDSTORE_CFA = defPrimWord("+!", () -> begin
519 SUBSTORE_CFA = defPrimWord("-!", () -> begin
529 TOR_CFA = defPrimWord(">R", () -> begin
534 FROMR_CFA = defPrimWord("R>", () -> begin
539 RFETCH_CFA = defPrimWord("R@", () -> begin
544 RSPFETCH_CFA = defPrimWord("RSP@", () -> begin
549 RSPSTORE_CFA = defPrimWord("RSP!", () -> begin
554 RDROP_CFA = defPrimWord("RDROP", () -> begin
561 PSPFETCH_CFA = defPrimWord("PSP@", () -> begin
566 PSPSTORE_CFA = defPrimWord("PSP!", () -> begin
573 WFETCH_CFA = defPrimWord("W@", () -> begin
578 WSTORE_CFA = defPrimWord("W!", () -> begin
585 sources = Array{Any,1}()
586 currentSource() = sources[length(sources)]
588 CLOSEFILES_CFA = defPrimWord("CLOSEFILES", () -> begin
589 while currentSource() != STDIN
596 EOF_CFA = defPrimWord("\x04", () -> begin
597 if currentSource() != STDIN
605 EMIT_CFA = defPrimWord("EMIT", () -> begin
610 function raw_mode!(mode::Bool)
611 if ccall(:jl_tty_set_mode, Int32, (Ptr{Void}, Int32), STDIN.handle, mode) != 0
612 throw("FATAL: Terminal unable to enter raw mode.")
618 byte = readbytes(STDIN, 1)[1]
630 KEY_CFA = defPrimWord("KEY", () -> begin
631 pushPS(Int(getKey()))
635 function getLineFromSTDIN()
642 return ASCIIString(line)
646 return string("\x04")
652 line = line[1:length(line)-1]
656 # Strip ANSI escape sequence
657 nextKey = Char(getKey())
660 nextKey = Char(getKey())
661 if nextKey >= '@' || nextKey <= '~'
668 # Currently do nothing
672 line = string(line, key)
677 SPAN, SPAN_CFA = defNewVar("SPAN", 0)
678 EXPECT_CFA = defPrimWord("EXPECT", () -> begin
682 if currentSource() == STDIN
683 line = getLineFromSTDIN()
685 if !eof(currentSource())
686 line = chomp(readline(currentSource()))
692 mem[SPAN] = min(length(line), maxLen)
693 putString(line[1:mem[SPAN]], addr)
698 BASE, BASE_CFA = defNewVar("BASE", 10)
699 NUMBER_CFA = defPrimWord("NUMBER", () -> begin
701 wordLen = mem[wordAddr-1]
703 s = getString(wordAddr, wordLen)
705 pushPS(parse(Int64, s, mem[BASE]))
710 # Dictionary searches
712 FROMLINK_CFA = defPrimWord("LINK>", () -> begin
715 lenAndFlags = mem[addr+1]
716 len = lenAndFlags & F_LENMASK
718 pushPS(addr + 2 + len)
723 NUMCONTEXT, NUMCONTEXT_CFA = defNewVar("#CONTEXT", 1)
725 createHeader("FORTH", 0)
727 dictWrite(defPrim(() -> begin
728 mem[CONTEXT + mem[NUMCONTEXT] - 1] = reg.W
731 dictWrite(0) # cell for latest
733 CURRENT_CFA = defExistingVar("CURRENT", CURRENT)
735 # Switch to new FORTH vocabulary cfa
736 mem[FORTH_CFA+1] = mem[mem[CURRENT]+1]
737 mem[CURRENT] = FORTH_CFA
739 CONTEXT, CONTEXT_CFA = defNewVar("CONTEXT", zeros(Int64, 10))
740 mem[CONTEXT] = FORTH_CFA
742 FINDVOCAB_CFA = defPrimWord("FINDVOCAB", () -> begin
744 countedAddr = popPS()
746 wordAddr = countedAddr + 1
747 wordLen = mem[countedAddr]
748 word = lowercase(getString(wordAddr, wordLen))
753 while (lfa = mem[lfa]) > 0
755 lenAndFlags = mem[lfa+1]
756 len = lenAndFlags & F_LENMASK
757 hidden = (lenAndFlags & F_HIDDEN) == F_HIDDEN
759 if hidden || len != wordLen
763 thisWord = lowercase(getString(lfa+2, len))
772 callPrim(mem[FROMLINK_CFA])
773 if (lenAndFlags & F_IMMED) == F_IMMED
786 FIND_CFA = defPrimWord("FIND", () -> begin
788 countedAddr = popPS()
789 context = mem[CONTEXT:(CONTEXT+mem[NUMCONTEXT]-1)]
791 for vocabCFA in reverse(context)
794 callPrim(mem[FINDVOCAB_CFA])
796 callPrim(mem[DUP_CFA])
814 BRANCH_CFA = defPrimWord("BRANCH", () -> begin
815 reg.IP += mem[reg.IP]
819 ZBRANCH_CFA = defPrimWord("0BRANCH", () -> begin
821 reg.IP += mem[reg.IP]
831 LITSTRING_CFA = defPrimWord("LITSTRING", () -> begin
841 TYPE_CFA = defPrimWord("TYPE", () -> begin
844 str = getString(addr, len)
849 # Interpreter/Compiler-specific I/O
851 TIB_CFA = defConst("TIB", TIB)
852 NUMTIB, NUMTIB_CFA = defNewVar("#TIB", 0)
853 TOIN, TOIN_CFA = defNewVar(">IN", 0)
855 QUERY_CFA = defWord("QUERY",
856 [TIB_CFA, LIT_CFA, 160, EXPECT_CFA,
857 SPAN_CFA, FETCH_CFA, NUMTIB_CFA, STORE_CFA,
858 LIT_CFA, 0, TOIN_CFA, STORE_CFA,
861 WORD_CFA = defPrimWord("WORD", () -> begin
864 # Chew up initial occurrences of delim
865 while (mem[TOIN]<mem[NUMTIB] && mem[TIB+mem[TOIN]] == delim)
872 # Start reading in word
874 while (mem[TOIN]<mem[NUMTIB])
875 mem[addr] = mem[TIB+mem[TOIN]]
878 if (mem[addr] == delim)
887 mem[countAddr] = count
895 STATE, STATE_CFA = defNewVar("STATE", 0)
897 COMMA_CFA = defPrimWord(",", () -> begin
898 mem[mem[H]] = popPS()
904 HERE_CFA = defWord("HERE",
905 [H_CFA, FETCH_CFA, EXIT_CFA])
907 HEADER_CFA = defPrimWord("HEADER", () -> begin
909 wordLen = mem[wordAddr-1]
910 word = getString(wordAddr, wordLen)
912 createHeader(word, 0)
917 CREATE_CFA = defWord("CREATE",
918 [LIT_CFA, 32, WORD_CFA, HEADER_CFA,
919 LIT_CFA, DOVAR, COMMA_CFA,
922 DODOES = defPrim(() -> begin
929 DOES_HELPER_CFA = defPrimWord("(DOES>)", () -> begin
931 pushPS(mem[mem[CURRENT]+1])
932 callPrim(mem[FROMLINK_CFA])
935 runtimeAddr = popPS()
937 mem[cfa] = defPrim(eval(:(() -> begin
938 pushPS($(runtimeAddr))
940 end)), name="doesPrim")
943 end, flags=F_IMMED | F_HIDDEN)
945 DOES_CFA = defWord("DOES>",
946 [LIT_CFA, LIT_CFA, COMMA_CFA, HERE_CFA, LIT_CFA, 3, ADD_CFA, COMMA_CFA,
947 LIT_CFA, DOES_HELPER_CFA, COMMA_CFA, LIT_CFA, EXIT_CFA, COMMA_CFA, EXIT_CFA],
950 LBRAC_CFA = defPrimWord("[", () -> begin
955 RBRAC_CFA = defPrimWord("]", () -> begin
960 HIDDEN_CFA = defPrimWord("HIDDEN", () -> begin
961 lenAndFlagsAddr = mem[mem[CURRENT]+1] + 1
962 mem[lenAndFlagsAddr] = mem[lenAndFlagsAddr] $ F_HIDDEN
966 COLON_CFA = defWord(":",
967 [LIT_CFA, 32, WORD_CFA,
969 LIT_CFA, DOCOL, COMMA_CFA,
974 SEMICOLON_CFA = defWord(";",
975 [LIT_CFA, EXIT_CFA, COMMA_CFA,
978 EXIT_CFA], flags=F_IMMED)
980 IMMEDIATE_CFA = defPrimWord("IMMEDIATE", () -> begin
981 lenAndFlagsAddr = mem[mem[CURRENT]+1] + 1
982 mem[lenAndFlagsAddr] = mem[lenAndFlagsAddr] $ F_IMMED
988 EXECUTE_CFA = defPrimWord("EXECUTE", () -> begin
993 INTERPRET_CFA = defWord("INTERPRET",
994 [LIT_CFA, 32, WORD_CFA, # Read next space-delimited word
996 DUP_CFA, FETCH_CFA, ZE_CFA, ZBRANCH_CFA, 3,
997 DROP_CFA, EXIT_CFA, # Exit if TIB is exhausted
999 STATE_CFA, FETCH_CFA, ZBRANCH_CFA, 24,
1001 FIND_CFA, QDUP_CFA, ZBRANCH_CFA, 13,
1004 LIT_CFA, -1, EQ_CFA, INVERT_CFA, ZBRANCH_CFA, 4,
1006 # Immediate: Execute!
1007 EXECUTE_CFA, BRANCH_CFA, -26,
1009 # Not immediate: Compile!
1010 COMMA_CFA, BRANCH_CFA, -29,
1012 # No word found, parse number
1013 NUMBER_CFA, LIT_CFA, LIT_CFA, COMMA_CFA, COMMA_CFA, BRANCH_CFA, -36,
1016 FIND_CFA, QDUP_CFA, ZBRANCH_CFA, 5,
1018 # Found word. Execute!
1019 DROP_CFA, EXECUTE_CFA, BRANCH_CFA, -44,
1021 # No word found, parse number and leave on stack
1022 NUMBER_CFA, BRANCH_CFA, -47,
1025 PROMPT_CFA = defPrimWord("PROMPT", () -> begin
1026 if currentSource() == STDIN
1036 QUIT_CFA = defWord("QUIT",
1037 [LIT_CFA, 0, STATE_CFA, STORE_CFA,
1038 LIT_CFA, 0, NUMTIB_CFA, STORE_CFA,
1039 RSP0_CFA, RSPSTORE_CFA,
1041 INTERPRET_CFA, PROMPT_CFA,
1044 ABORT_CFA = defWord("ABORT",
1045 [CLOSEFILES_CFA, PSP0_CFA, PSPSTORE_CFA, QUIT_CFA])
1047 BYE_CFA = defPrimWord("BYE", () -> begin
1054 INCLUDE_CFA = defPrimWord("INCLUDE", () -> begin
1056 callPrim(mem[WORD_CFA])
1057 wordAddr = popPS()+1
1058 wordLen = mem[wordAddr-1]
1059 word = getString(wordAddr, wordLen)
1063 fname = Pkg.dir("forth","src",word)
1065 error("No file named $word found in current directory or package source directory.")
1068 push!(sources, open(fname, "r"))
1070 # Clear input buffer
1080 initFileName = nothing
1081 if isfile("lib.4th")
1082 initFileName = "lib.4th"
1083 elseif isfile(Pkg.dir("forth","src", "lib.4th"))
1084 initFileName = Pkg.dir("forth","src","lib.4th")
1087 function run(;initialize=true)
1088 # Begin with STDIN as source
1089 push!(sources, STDIN)
1091 global initialized, initFileName
1092 if !initialized && initialize
1093 if initFileName != nothing
1094 print("Including definitions from $initFileName...")
1095 push!(sources, open(initFileName, "r"))
1098 println("No library file found. Only primitive words available.")
1102 # Start with IP pointing to first instruction of outer interpreter
1103 reg.IP = QUIT_CFA + 1
1105 # Primitive processing loop.
1106 # Everyting else is simply a consequence of this loop!
1110 #println("Entering prim $(getPrimName(jmp))")
1114 showerror(STDOUT, ex)
1117 while !isempty(sources) && currentSource() != STDIN
1118 close(pop!(sources))
1122 reg.IP = ABORT_CFA + 1
1130 TRACE_CFA = defPrimWord("TRACE", () -> begin
1131 println("reg.W: $(reg.W) reg.IP: $(reg.IP)")
1132 print("PS: "); printPS()
1133 print("RS: "); printRS()
1140 function dump(startAddr::Int64; count::Int64 = 100, cellsPerLine::Int64 = 10)
1141 chars = Array{Char,1}(cellsPerLine)
1143 lineStartAddr = cellsPerLine*div((startAddr-1),cellsPerLine) + 1
1144 endAddr = startAddr + count - 1
1146 q, r = divrem((endAddr-lineStartAddr+1), cellsPerLine)
1147 numLines = q + (r > 0 ? 1 : 0)
1153 for c in 1:cellsPerLine
1154 if i >= startAddr && i <= endAddr
1156 if mem[i]>=32 && mem[i]<128
1157 chars[c] = Char(mem[i])
1169 println("\t", ASCIIString(chars))
1174 count = reg.PSP - PSP0
1178 for i in (PSP0+1):reg.PSP
1183 println("Parameter stack empty")
1188 count = reg.RSP - RSP0
1192 for i in (RSP0+1):reg.RSP
1197 println("Return stack empty")
1201 DUMP = defPrimWord("DUMP", () -> begin
1206 dump(addr, count=count)