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}()
19 H = nextVarAddr; nextVarAddr += 1
20 LATEST = nextVarAddr; nextVarAddr += 1
22 RSP0 = nextVarAddr # bottom of RS
23 PSP0 = RSP0 + size_RS # bottom of PS
24 TIB = PSP0 + size_PS # address of terminal input buffer
25 mem[H] = TIB + size_TIB # location of bottom of dictionary
26 mem[LATEST] = 0 # no previous definition
28 DICT = mem[H] # Save bottom of dictionary as constant
32 RSP::Int64 # Return stack pointer
33 PSP::Int64 # Parameter/data stack pointer
34 IP::Int64 # Instruction pointer
35 W::Int64 # Working register
37 reg = Reg(RSP0, PSP0, 0, 0)
39 # Stack manipulation functions
41 function ensurePSDepth(depth::Int64)
42 if reg.PSP - PSP0 < depth
43 error("Parameter stack underflow.")
47 function ensureRSDepth(depth::Int64)
48 if reg.RSP - RSP0 < depth
49 error("Return stack underflow.")
53 function pushRS(val::Int64)
65 function pushPS(val::Int64)
66 mem[reg.PSP += 1] = val
77 # Handy functions for adding/retrieving strings to/from memory.
79 getString(addr::Int64, len::Int64) = ASCIIString([Char(c) for c in mem[addr:(addr+len-1)]])
81 function putString(str::ASCIIString, addr::Int64)
82 mem[addr:(addr+length(str)-1)] = [Int64(c) for c in str]
85 # Primitive creation and calling functions
87 function defPrim(f::Function; name="nameless")
89 push!(primNames, replace(name, "\004", "EOF"))
91 return -length(primitives)
94 function callPrim(addr::Int64)
95 if addr >=0 || -addr>length(primitives)
96 error("Attempted to execute non-existent primitive at address $addr.")
101 getPrimName(addr::Int64) = primNames[-addr]
103 # Word creation functions
110 function createHeader(name::AbstractString, flags::Int64)
111 mem[mem[H]] = mem[LATEST]
115 mem[mem[H]] = length(name) | flags | NFA_MARK; mem[H] += 1
116 putString(name, mem[H]); mem[H] += length(name)
119 function defPrimWord(name::AbstractString, f::Function; flags::Int64=0)
120 createHeader(name, flags)
122 codeWordAddr = mem[H]
123 mem[codeWordAddr] = defPrim(f, name=name)
129 function defWord(name::AbstractString, wordAddrs::Array{Int64,1}; flags::Int64=0)
130 createHeader(name, flags)
136 for wordAddr in wordAddrs
137 mem[mem[H]] = wordAddr
144 # Variable creation functions
146 function defExistingVar(name::AbstractString, varAddr::Int64; flags::Int64=0)
148 defPrimWord(name, eval(:(() -> begin
154 function defNewVar(name::AbstractString, initial::Int64; flags::Int64=0)
155 createHeader(name, flags)
157 codeWordAddr = mem[H]
160 mem[mem[H]] = DOVAR; mem[H] += 1
161 mem[mem[H]] = initial; mem[H] += 1
163 return varAddr, codeWordAddr
166 function defConst(name::AbstractString, val::Int64; flags::Int64=0)
167 createHeader(name, flags)
169 codeWordAddr = mem[H]
171 mem[mem[H]] = DOCON; mem[H] += 1
172 mem[mem[H]] = val; mem[H] += 1
177 # Threading Primitives (inner interpreter)
179 NEXT = defPrim(() -> begin
185 DOCOL = defPrim(() -> begin
191 DOVAR = defPrim(() -> begin
196 DOCON = defPrim(() -> begin
197 pushPS(mem[reg.W + 1])
201 EXIT_CFA = defPrimWord("EXIT", () -> begin
206 # Dictionary entries for core built-in variables, constants
208 H_CFA = defExistingVar("H", H)
209 LATEST_CFA = defExistingVar("LATEST", LATEST)
211 PSP0_CFA = defConst("PSP0", PSP0)
212 RSP0_CFA = defConst("RSP0", RSP0)
214 defConst("DOCOL", DOCOL)
215 defConst("DOCON", DOCON)
216 defConst("DOVAR", DOVAR)
218 defConst("DICT", DICT)
219 defConst("MEMSIZE", size_mem)
221 F_IMMED_CFA = defConst("F_IMMED", F_IMMED)
222 F_HIDDEN_CFA = defConst("F_HIDDEN", F_HIDDEN)
223 F_LENMASK_CFA = defConst("F_LENMASK", F_LENMASK)
224 NFA_MARK_CFA = defConst("NFA_MARK", NFA_MARK)
226 # Basic forth primitives
228 DROP_CFA = defPrimWord("DROP", () -> begin
233 SWAP_CFA = defPrimWord("SWAP", () -> begin
241 DUP_CFA = defPrimWord("DUP", () -> begin
247 OVER_CFA = defPrimWord("OVER", () -> begin
249 pushPS(mem[reg.PSP-1])
253 ROT_CFA = defPrimWord("ROT", () -> begin
263 NROT_CFA = defPrimWord("-ROT", () -> begin
274 TWODROP_CFA = defPrimWord("2DROP", () -> begin
280 TWODUP_CFA = defPrimWord("2DUP", () -> begin
289 TWOSWAP_CFA = defPrimWord("2SWAP", () -> begin
301 TWOOVER_CFA = defPrimWord("2OVER", () -> begin
310 QDUP_CFA = defPrimWord("?DUP", () -> begin
319 INCR_CFA = defPrimWord("1+", () -> begin
325 DECR_CFA = defPrimWord("1-", () -> begin
331 INCR2_CFA = defPrimWord("2+", () -> begin
337 DECR2_CFA = defPrimWord("2-", () -> begin
343 ADD_CFA = defPrimWord("+", () -> begin
350 SUB_CFA = defPrimWord("-", () -> begin
357 MUL_CFA = defPrimWord("*", () -> begin
364 DIVMOD_CFA = defPrimWord("/MOD", () -> begin
373 TWOMUL_CFA = defPrimWord("2*", () -> begin
378 TWODIV_CFA = defPrimWord("2/", () -> begin
383 EQ_CFA = defPrimWord("=", () -> begin
386 pushPS(a==b ? -1 : 0)
390 NE_CFA = defPrimWord("<>", () -> begin
393 pushPS(a!=b ? -1 : 0)
397 LT_CFA = defPrimWord("<", () -> begin
404 GT_CFA = defPrimWord(">", () -> begin
411 LE_CFA = defPrimWord("<=", () -> begin
414 pushPS(a<=b ? -1 : 0)
418 GE_CFA = defPrimWord(">=", () -> begin
421 pushPS(a>=b ? -1 : 0)
425 ZE_CFA = defPrimWord("0=", () -> begin
426 pushPS(popPS() == 0 ? -1 : 0)
430 ZNE_CFA = defPrimWord("0<>", () -> begin
431 pushPS(popPS() != 0 ? -1 : 0)
435 ZLT_CFA = defPrimWord("0<", () -> begin
436 pushPS(popPS() < 0 ? -1 : 0)
440 ZGT_CFA = defPrimWord("0>", () -> begin
441 pushPS(popPS() > 0 ? -1 : 0)
445 ZLE_CFA = defPrimWord("0<=", () -> begin
446 pushPS(popPS() <= 0 ? -1 : 0)
450 ZGE_CFA = defPrimWord("0>=", () -> begin
451 pushPS(popPS() >= 0 ? -1 : 0)
455 AND_CFA = defPrimWord("AND", () -> begin
462 OR_CFA = defPrimWord("OR", () -> begin
469 XOR_CFA = defPrimWord("XOR", () -> begin
476 INVERT_CFA = defPrimWord("INVERT", () -> begin
483 LIT_CFA = defPrimWord("LIT", () -> begin
491 STORE_CFA = defPrimWord("!", () -> begin
498 FETCH_CFA = defPrimWord("@", () -> begin
504 ADDSTORE_CFA = defPrimWord("+!", () -> begin
511 SUBSTORE_CFA = defPrimWord("-!", () -> begin
521 TOR_CFA = defPrimWord(">R", () -> begin
526 FROMR_CFA = defPrimWord("R>", () -> begin
531 RFETCH_CFA = defPrimWord("R@", () -> begin
536 RSPFETCH_CFA = defPrimWord("RSP@", () -> begin
541 RSPSTORE_CFA = defPrimWord("RSP!", () -> begin
546 RDROP_CFA = defPrimWord("RDROP", () -> begin
553 PSPFETCH_CFA = defPrimWord("PSP@", () -> begin
558 PSPSTORE_CFA = defPrimWord("PSP!", () -> begin
565 WFETCH_CFA = defPrimWord("W@", () -> begin
570 WSTORE_CFA = defPrimWord("W!", () -> begin
577 sources = Array{Any,1}()
578 currentSource() = sources[length(sources)]
580 EOF_CFA = defPrimWord("\x04", () -> begin
581 if currentSource() != STDIN
589 EMIT_CFA = defPrimWord("EMIT", () -> begin
594 function raw_mode!(mode::Bool)
595 if ccall(:jl_tty_set_mode, Int32, (Ptr{Void}, Int32), STDIN.handle, mode) != 0
596 throw("FATAL: Terminal unable to enter raw mode.")
602 byte = readbytes(STDIN, 1)[1]
614 KEY_CFA = defPrimWord("KEY", () -> begin
615 pushPS(Int(getKey()))
619 function getLineFromSTDIN()
626 return ASCIIString(line)
630 return string("\x04")
635 line = line[1:length(line)-1]
640 # Strip ANSI escape sequence
641 nextKey = Char(getKey())
644 nextKey = Char(getKey())
645 if nextKey >= '@' || nextKey <= '~'
653 line = string(line, key)
658 SPAN, SPAN_CFA = defNewVar("SPAN", 0)
659 EXPECT_CFA = defPrimWord("EXPECT", () -> begin
663 if currentSource() == STDIN
664 line = getLineFromSTDIN()
666 if !eof(currentSource())
667 line = chomp(readline(currentSource()))
673 mem[SPAN] = min(length(line), maxLen)
674 putString(line[1:mem[SPAN]], addr)
679 BASE, BASE_CFA = defNewVar("BASE", 10)
680 NUMBER_CFA = defPrimWord("NUMBER", () -> begin
682 wordLen = mem[wordAddr-1]
684 s = getString(wordAddr, wordLen)
686 pushPS(parse(Int64, s, mem[BASE]))
691 # Dictionary searches
693 TOCFA_CFA = defPrimWord(">CFA", () -> begin
696 lenAndFlags = mem[addr+1]
697 len = lenAndFlags & F_LENMASK
699 pushPS(addr + 2 + len)
704 TOBODY_CFA = defWord(">BODY", [INCR_CFA, EXIT_CFA])
706 FIND_CFA = defPrimWord("FIND", () -> begin
708 countedAddr = popPS()
709 wordAddr = countedAddr + 1
710 wordLen = mem[countedAddr]
711 word = lowercase(getString(wordAddr, wordLen))
717 while (latest = mem[latest]) > 0
718 lenAndFlags = mem[latest+1]
719 len = lenAndFlags & F_LENMASK
720 hidden = (lenAndFlags & F_HIDDEN) == F_HIDDEN
722 if hidden || len != wordLen
727 thisWord = lowercase(getString(thisAddr, len))
729 if lowercase(thisWord) == lowercase(word)
736 callPrim(mem[TOCFA_CFA])
737 if (lenAndFlags & F_IMMED) == F_IMMED
753 BRANCH_CFA = defPrimWord("BRANCH", () -> begin
754 reg.IP += mem[reg.IP]
758 ZBRANCH_CFA = defPrimWord("0BRANCH", () -> begin
760 reg.IP += mem[reg.IP]
770 LITSTRING_CFA = defPrimWord("LITSTRING", () -> begin
780 TYPE_CFA = defPrimWord("TYPE", () -> begin
783 str = getString(addr, len)
790 COMMA_CFA = defPrimWord(",", () -> begin
791 mem[mem[H]] = popPS()
797 BTICK_CFA = defWord("[']",
798 [FROMR_CFA, DUP_CFA, INCR_CFA, TOR_CFA, FETCH_CFA, EXIT_CFA])
800 EXECUTE_CFA = defPrimWord("EXECUTE", () -> begin
805 TIB_CFA = defConst("TIB", TIB)
806 NUMTIB, NUMTIB_CFA = defNewVar("#TIB", 0)
807 TOIN, TOIN_CFA = defNewVar(">IN", 0)
809 QUERY_CFA = defWord("QUERY",
810 [TIB_CFA, LIT_CFA, 160, EXPECT_CFA,
811 SPAN_CFA, FETCH_CFA, NUMTIB_CFA, STORE_CFA,
812 LIT_CFA, 0, TOIN_CFA, STORE_CFA,
815 WORD_CFA = defPrimWord("WORD", () -> begin
818 # Chew up initial occurrences of delim
819 while (mem[TOIN]<mem[NUMTIB] && mem[TIB+mem[TOIN]] == delim)
826 # Start reading in word
828 while (mem[TOIN]<mem[NUMTIB])
829 mem[addr] = mem[TIB+mem[TOIN]]
832 if (mem[addr] == delim)
841 mem[countAddr] = count
847 PARSE_CFA = defPrimWord("PARSE", () -> begin
850 # Chew up initial occurrences of delim
853 # Start reading input stream
855 while (mem[TOIN]<mem[NUMTIB])
856 mem[addr] = mem[TIB+mem[TOIN]]
859 if (mem[addr] == delim)
873 BYE_CFA = defPrimWord("BYE", () -> begin
878 STATE, STATE_CFA = defNewVar("STATE", 0)
880 INTERPRET_CFA = defWord("INTERPRET",
881 [LIT_CFA, 32, WORD_CFA, # Read next space-delimited word
883 DUP_CFA, FETCH_CFA, ZE_CFA, ZBRANCH_CFA, 3,
884 DROP_CFA, EXIT_CFA, # Exit if TIB is exhausted
886 STATE_CFA, FETCH_CFA, ZBRANCH_CFA, 24,
888 FIND_CFA, QDUP_CFA, ZBRANCH_CFA, 13,
891 LIT_CFA, -1, EQ_CFA, INVERT_CFA, ZBRANCH_CFA, 4,
893 # Immediate: Execute!
894 EXECUTE_CFA, BRANCH_CFA, -26,
896 # Not immediate: Compile!
897 COMMA_CFA, BRANCH_CFA, -29,
899 # No word found, parse number
900 NUMBER_CFA, BTICK_CFA, LIT_CFA, COMMA_CFA, COMMA_CFA, BRANCH_CFA, -36,
903 FIND_CFA, QDUP_CFA, ZBRANCH_CFA, 5,
905 # Found word. Execute!
906 DROP_CFA, EXECUTE_CFA, BRANCH_CFA, -44,
908 # No word found, parse number and leave on stack
909 NUMBER_CFA, BRANCH_CFA, -47,
912 PROMPT_CFA = defPrimWord("PROMPT", () -> begin
913 if (mem[STATE] == 0 && currentSource() == STDIN)
920 QUIT_CFA = defWord("QUIT",
921 [LIT_CFA, 0, STATE_CFA, STORE_CFA,
922 LIT_CFA, 0, NUMTIB_CFA, STORE_CFA,
923 RSP0_CFA, RSPSTORE_CFA,
925 INTERPRET_CFA, PROMPT_CFA,
928 ABORT_CFA = defWord("ABORT",
929 [PSP0_CFA, PSPSTORE_CFA, QUIT_CFA])
931 INCLUDE_CFA = defPrimWord("INCLUDE", () -> begin
933 callPrim(mem[WORD_CFA])
935 wordLen = mem[wordAddr-1]
936 word = getString(wordAddr, wordLen)
938 push!(sources, open(word, "r"))
948 HERE_CFA = defWord("HERE",
949 [H_CFA, FETCH_CFA, EXIT_CFA])
951 HEADER_CFA = defPrimWord("HEADER", () -> begin
953 wordLen = mem[wordAddr-1]
954 word = getString(wordAddr, wordLen)
956 createHeader(word, 0)
961 CREATE_CFA = defWord("CREATE",
962 [LIT_CFA, 32, WORD_CFA, HEADER_CFA,
963 LIT_CFA, DOVAR, COMMA_CFA,
966 DODOES = defPrim(() -> begin
973 DOES_HELPER_CFA = defPrimWord("(DOES>)", () -> begin
976 callPrim(mem[TOCFA_CFA])
979 runtimeAddr = popPS()
981 mem[cfa] = defPrim(eval(:(() -> begin
982 pushPS($(runtimeAddr))
984 end)), name="doesPrim")
989 DOES_CFA = defWord("DOES>",
990 [BTICK_CFA, LIT_CFA, COMMA_CFA, HERE_CFA, LIT_CFA, 3, ADD_CFA, COMMA_CFA,
991 BTICK_CFA, DOES_HELPER_CFA, COMMA_CFA, BTICK_CFA, EXIT_CFA, COMMA_CFA, EXIT_CFA],
994 LBRAC_CFA = defPrimWord("[", () -> begin
999 RBRAC_CFA = defPrimWord("]", () -> begin
1004 HIDDEN_CFA = defPrimWord("HIDDEN", () -> begin
1005 lenAndFlagsAddr = mem[LATEST] + 1
1006 mem[lenAndFlagsAddr] = mem[lenAndFlagsAddr] $ F_HIDDEN
1010 COLON_CFA = defWord(":",
1011 [LIT_CFA, 32, WORD_CFA,
1013 LIT_CFA, DOCOL, COMMA_CFA,
1018 SEMICOLON_CFA = defWord(";",
1019 [LIT_CFA, EXIT_CFA, COMMA_CFA,
1022 EXIT_CFA], flags=F_IMMED)
1024 IMMEDIATE_CFA = defPrimWord("IMMEDIATE", () -> begin
1025 lenAndFlagsAddr = mem[LATEST] + 1
1026 mem[lenAndFlagsAddr] = mem[lenAndFlagsAddr] $ F_IMMED
1034 initFileName = nothing
1035 if isfile("lib.4th")
1036 initFileName = "lib.4th"
1037 elseif isfile(Pkg.dir("forth/src/lib.4th"))
1038 initFileName = Pkg.dir("forth/src/lib.4th")
1041 function run(;initialize=true)
1042 # Begin with STDIN as source
1043 push!(sources, STDIN)
1045 global initialized, initFileName
1046 if !initialized && initialize
1047 if initFileName != nothing
1048 print("Including definitions from $initFileName...")
1049 push!(sources, open(initFileName, "r"))
1052 println("No library file found. Only primitive words available.")
1056 # Start with IP pointing to first instruction of outer interpreter
1057 reg.IP = QUIT_CFA + 1
1059 # Primitive processing loop.
1060 # Everyting else is simply a consequence of this loop!
1064 #println("Entering prim $(getPrimName(jmp))")
1068 showerror(STDOUT, ex)
1071 while !isempty(sources) && currentSource() != STDIN
1072 close(pop!(sources))
1076 reg.IP = ABORT_CFA + 1
1084 TRACE_CFA = defPrimWord("TRACE", () -> begin
1085 println("reg.W: $(reg.W) reg.IP: $(reg.IP)")
1086 print("PS: "); printPS()
1087 print("RS: "); printRS()
1094 function dump(startAddr::Int64; count::Int64 = 100, cellsPerLine::Int64 = 10)
1095 chars = Array{Char,1}(cellsPerLine)
1097 lineStartAddr = cellsPerLine*div((startAddr-1),cellsPerLine) + 1
1098 endAddr = startAddr + count - 1
1100 q, r = divrem((endAddr-lineStartAddr+1), cellsPerLine)
1101 numLines = q + (r > 0 ? 1 : 0)
1107 for c in 1:cellsPerLine
1108 if i >= startAddr && i <= endAddr
1110 if mem[i]>=32 && mem[i]<128
1111 chars[c] = Char(mem[i])
1123 println("\t", ASCIIString(chars))
1128 count = reg.PSP - PSP0
1132 for i in (PSP0+1):reg.PSP
1137 println("Parameter stack empty")
1142 count = reg.RSP - RSP0
1146 for i in (RSP0+1):reg.RSP
1151 println("Return stack empty")
1155 DUMP = defPrimWord("DUMP", () -> begin
1160 dump(addr, count=count)