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
12 size_FIB = 1000 # File input buffer size
15 mem = Array{Int64,1}(size_mem)
16 primitives = Array{Function,1}()
17 primNames = Array{AbstractString,1}()
19 # Memory geography and built-in variables
22 H = nextVarAddr; nextVarAddr += 1 # Next free memory address
23 FORTH_LATEST = nextVarAddr; nextVarAddr += 1 # FORTH dict latest
24 CURRENT = nextVarAddr; nextVarAddr += 1 # Current compilation dict
26 RSP0 = nextVarAddr # bottom of RS
27 PSP0 = RSP0 + size_RS # bottom of PS
28 TIB = PSP0 + size_PS # address of terminal input buffer
29 FIB = TIB + size_TIB # address of terminal input buffer
30 mem[H] = FIB + size_FIB # location of bottom of dictionary
31 mem[FORTH_LATEST] = 0 # zero FORTH dict latest (no previous def)
32 mem[CURRENT] = FORTH_LATEST-1 # Compile words to system dict initially
34 DICT = mem[H] # Save bottom of dictionary as constant
38 RSP::Int64 # Return stack pointer
39 PSP::Int64 # Parameter/data stack pointer
40 IP::Int64 # Instruction pointer
41 W::Int64 # Working register
43 reg = Reg(RSP0, PSP0, 0, 0)
45 # Stack manipulation functions
47 function ensurePSDepth(depth::Int64)
48 if reg.PSP - PSP0 < depth
49 error("Parameter stack underflow.")
53 function ensurePSCapacity(toAdd::Int64)
54 if reg.PSP + toAdd >= PSP0 + size_PS
55 error("Parameter stack overflow.")
59 function ensureRSDepth(depth::Int64)
60 if reg.RSP - RSP0 < depth
61 error("Return stack underflow.")
65 function ensureRSCapacity(toAdd::Int64)
66 if reg.RSP + toAdd >= RSP0 + size_RS
67 error("Return stack overflow.")
71 function pushRS(val::Int64)
84 function pushPS(val::Int64)
87 mem[reg.PSP += 1] = val
98 # Handy functions for adding/retrieving strings to/from memory.
100 getString(addr::Int64, len::Int64) = String([Char(c) for c in mem[addr:(addr+len-1)]])
102 function putString(str::AbstractString, addr::Int64)
103 mem[addr:(addr+length(str)-1)] = [Int64(c) for c in str]
106 function putString(str::AbstractString, addr::Int64, maxLen::Int64)
107 len = min(length(str), maxLen)
108 mem[addr:(addr+len-1)] = [Int64(c) for c in str]
111 stringAsInts(str::AbstractString) = [Int(c) for c in collect(str)]
113 # Primitive creation and calling functions
115 function defPrim(f::Function; name="nameless")
117 push!(primNames, replace(name, "\004", "EOF"))
119 return -length(primitives)
122 function callPrim(addr::Int64)
123 if addr >=0 || -addr>length(primitives)
124 error("Attempted to execute non-existent primitive at address $addr.")
129 getPrimName(addr::Int64) = primNames[-addr]
131 # Word creation functions
138 function dictWrite(ints::Array{Int64,1})
139 mem[mem[H]:(mem[H]+length(ints)-1)] = ints
140 mem[H] += length(ints)
142 dictWrite(int::Int64) = dictWrite([int])
143 dictWriteString(string::AbstractString) = dictWrite([Int64(c) for c in string])
145 function createHeader(name::AbstractString, flags::Int64)
146 mem[mem[H]] = mem[mem[CURRENT]+1]
147 mem[mem[CURRENT]+1] = mem[H]
150 dictWrite(length(name) | flags | NFA_MARK)
151 dictWriteString(name)
154 function defPrimWord(name::AbstractString, f::Function; flags::Int64=0)
155 createHeader(name, flags)
157 codeWordAddr = mem[H]
158 dictWrite(defPrim(f, name=name))
163 function defWord(name::AbstractString, wordAddrs::Array{Int64,1}; flags::Int64=0)
164 createHeader(name, flags)
174 # Variable creation functions
176 function defExistingVar(name::AbstractString, varAddr::Int64; flags::Int64=0)
178 defPrimWord(name, eval(:(() -> begin
184 function defNewVar(name::AbstractString, initial::Array{Int64,1}; flags::Int64=0)
185 createHeader(name, flags)
187 codeWordAddr = mem[H]
193 return varAddr, codeWordAddr
196 defNewVar(name::AbstractString, initial::Int64; flags::Int64=0) =
197 defNewVar(name, [initial]; flags=flags)
199 function defConst(name::AbstractString, val::Int64; flags::Int64=0)
200 createHeader(name, flags)
202 codeWordAddr = mem[H]
210 # Threading Primitives (inner interpreter)
212 NEXT = defPrim(() -> begin
218 DOCOL = defPrim(() -> begin
224 DOVAR = defPrim(() -> begin
229 DOCON = defPrim(() -> begin
230 pushPS(mem[reg.W + 1])
234 EXIT_CFA = defPrimWord("EXIT", () -> begin
239 # Dictionary entries for core built-in variables, constants
241 H_CFA = defExistingVar("H", H)
243 PSP0_CFA = defConst("PSP0", PSP0)
244 RSP0_CFA = defConst("RSP0", RSP0)
246 defConst("DOCOL", DOCOL)
247 defConst("DOCON", DOCON)
248 defConst("DOVAR", DOVAR)
250 defConst("DICT", DICT)
251 defConst("MEMSIZE", size_mem)
253 F_IMMED_CFA = defConst("F_IMMED", F_IMMED)
254 F_HIDDEN_CFA = defConst("F_HIDDEN", F_HIDDEN)
255 F_LENMASK_CFA = defConst("F_LENMASK", F_LENMASK)
256 NFA_MARK_CFA = defConst("NFA_MARK", NFA_MARK)
258 # Basic forth primitives
260 DROP_CFA = defPrimWord("DROP", () -> begin
265 SWAP_CFA = defPrimWord("SWAP", () -> begin
273 DUP_CFA = defPrimWord("DUP", () -> begin
279 OVER_CFA = defPrimWord("OVER", () -> begin
281 pushPS(mem[reg.PSP-1])
285 ROT_CFA = defPrimWord("ROT", () -> begin
295 NROT_CFA = defPrimWord("-ROT", () -> begin
306 TWODROP_CFA = defPrimWord("2DROP", () -> begin
312 TWODUP_CFA = defPrimWord("2DUP", () -> begin
321 TWOSWAP_CFA = defPrimWord("2SWAP", () -> begin
333 TWOOVER_CFA = defPrimWord("2OVER", () -> begin
342 QDUP_CFA = defPrimWord("?DUP", () -> begin
351 INCR_CFA = defPrimWord("1+", () -> begin
357 DECR_CFA = defPrimWord("1-", () -> begin
363 INCR2_CFA = defPrimWord("2+", () -> begin
369 DECR2_CFA = defPrimWord("2-", () -> begin
375 ADD_CFA = defPrimWord("+", () -> begin
382 SUB_CFA = defPrimWord("-", () -> begin
389 MUL_CFA = defPrimWord("*", () -> begin
396 DIVMOD_CFA = defPrimWord("/MOD", () -> begin
405 TWOMUL_CFA = defPrimWord("2*", () -> begin
410 TWODIV_CFA = defPrimWord("2/", () -> begin
415 EQ_CFA = defPrimWord("=", () -> begin
418 pushPS(a==b ? -1 : 0)
422 NE_CFA = defPrimWord("<>", () -> begin
425 pushPS(a!=b ? -1 : 0)
429 LT_CFA = defPrimWord("<", () -> begin
436 GT_CFA = defPrimWord(">", () -> begin
443 LE_CFA = defPrimWord("<=", () -> begin
446 pushPS(a<=b ? -1 : 0)
450 GE_CFA = defPrimWord(">=", () -> begin
453 pushPS(a>=b ? -1 : 0)
457 ZE_CFA = defPrimWord("0=", () -> begin
458 pushPS(popPS() == 0 ? -1 : 0)
462 ZNE_CFA = defPrimWord("0<>", () -> begin
463 pushPS(popPS() != 0 ? -1 : 0)
467 ZLT_CFA = defPrimWord("0<", () -> begin
468 pushPS(popPS() < 0 ? -1 : 0)
472 ZGT_CFA = defPrimWord("0>", () -> begin
473 pushPS(popPS() > 0 ? -1 : 0)
477 ZLE_CFA = defPrimWord("0<=", () -> begin
478 pushPS(popPS() <= 0 ? -1 : 0)
482 ZGE_CFA = defPrimWord("0>=", () -> begin
483 pushPS(popPS() >= 0 ? -1 : 0)
487 AND_CFA = defPrimWord("AND", () -> begin
494 OR_CFA = defPrimWord("OR", () -> begin
501 XOR_CFA = defPrimWord("XOR", () -> begin
508 INVERT_CFA = defPrimWord("INVERT", () -> begin
515 LIT_CFA = defPrimWord("LIT", () -> begin
523 STORE_CFA = defPrimWord("!", () -> begin
530 FETCH_CFA = defPrimWord("@", () -> begin
536 ADDSTORE_CFA = defPrimWord("+!", () -> begin
543 SUBSTORE_CFA = defPrimWord("-!", () -> begin
553 TOR_CFA = defPrimWord(">R", () -> begin
558 FROMR_CFA = defPrimWord("R>", () -> begin
563 RFETCH_CFA = defPrimWord("R@", () -> begin
568 RSPFETCH_CFA = defPrimWord("RSP@", () -> begin
573 RSPSTORE_CFA = defPrimWord("RSP!", () -> begin
578 RDROP_CFA = defPrimWord("RDROP", () -> begin
585 PSPFETCH_CFA = defPrimWord("PSP@", () -> begin
590 PSPSTORE_CFA = defPrimWord("PSP!", () -> begin
597 WFETCH_CFA = defPrimWord("W@", () -> begin
602 WSTORE_CFA = defPrimWord("W!", () -> begin
609 openFiles = Dict{Int64,IOStream}()
616 FAM_RO_CFA = defConst("R/O", FAM_RO)
617 FAM_WO_CFA = defConst("W/O", FAM_WO)
619 function fileOpener(create::Bool)
624 fname = getString(fnameAddr, fnameLen)
626 if create && !isfile(fname)
639 openFiles[nextFileID] = open(fname, mode)
646 OPEN_FILE_CFA = defPrimWord("OPEN-FILE", () -> begin
651 CREATE_FILE_CFA = defPrimWord("CREATE-FILE", () -> begin
656 CLOSE_FILE_CFA = defPrimWord("CLOSE-FILE", () -> begin
658 close(openFiles[fid])
659 delete!(openFiles, fid)
661 pushPS(0) # Result code 0
665 CLOSE_FILES_CFA = defPrimWord("CLOSE-FILES", () -> begin
666 for fh in values(openFiles)
671 pushPS(0) # Result code 0
675 READ_LINE_CFA = defPrimWord("READ-LINE", () -> begin
683 eofFlag = endswith(line, '\n') ? 0 : -1
686 putString(line, addr, maxSize)
695 READ_FILE_CFA = defPrimWord("READ-FILE", () -> begin
702 string = join(map(x -> Char(x), read(fh, size)), "")
704 eofFlag = length(string) == size ? 0 : -1 ;
706 putString(string, addr, length(string))
708 pushPS(length(string))
715 EMIT_CFA = defPrimWord("EMIT", () -> begin
720 function raw_mode!(mode::Bool)
721 if ccall(:jl_tty_set_mode, Int32, (Ptr{Void}, Int32), STDIN.handle, mode) != 0
722 throw("FATAL: Terminal unable to enter raw mode.")
728 byte = read(STDIN, 1)[1]
740 KEY_CFA = defPrimWord("KEY", () -> begin
741 pushPS(Int(getKey()))
745 function getLineFromSTDIN()
749 slashIdx = findlast(chars, '\\')
752 return join(chars[slashIdx:length(chars)])
758 function backspaceStr(s, bsCount)
760 newLen = max(0, oldLen - bsCount)
761 return join(collect(s)[1:newLen])
774 return string("\x04")
780 line = backspaceStr(line, 1)
784 # Strip ANSI escape sequence
785 nextKey = Char(getKey())
788 nextKey = Char(getKey())
789 if nextKey >= '@' || nextKey <= '~'
796 # Currently do nothing
800 if haskey(REPLCompletions.latex_symbols, frag)
801 print(repeat("\b", length(frag)))
803 comp = REPLCompletions.latex_symbols[frag]
804 line = string(backspaceStr(line, length(frag)), comp)
811 line = string(line, key)
816 SPAN, SPAN_CFA = defNewVar("SPAN", 0)
817 EXPECT_CFA = defPrimWord("EXPECT", () -> begin
821 line = getLineFromSTDIN()
823 mem[SPAN] = min(length(line), maxLen)
824 putString(line, addr, maxLen)
829 BASE, BASE_CFA = defNewVar("BASE", 10)
830 NUMBER_CFA = defPrimWord("NUMBER", () -> begin
832 wordLen = mem[wordAddr-1]
834 s = getString(wordAddr, wordLen)
836 pushPS(parse(Int64, s, mem[BASE]))
841 # Dictionary searches
843 FROMLINK_CFA = defPrimWord("LINK>", () -> begin
846 lenAndFlags = mem[addr+1]
847 len = lenAndFlags & F_LENMASK
849 pushPS(addr + 2 + len)
854 NUMCONTEXT, NUMCONTEXT_CFA = defNewVar("#CONTEXT", 1)
856 createHeader("FORTH", 0)
858 dictWrite(defPrim(() -> begin
859 mem[CONTEXT + mem[NUMCONTEXT] - 1] = reg.W
862 dictWrite(0) # cell for latest
864 CURRENT_CFA = defExistingVar("CURRENT", CURRENT)
866 # Switch to new FORTH vocabulary cfa
867 mem[FORTH_CFA+1] = mem[mem[CURRENT]+1]
868 mem[CURRENT] = FORTH_CFA
870 CONTEXT, CONTEXT_CFA = defNewVar("CONTEXT", zeros(Int64, 10))
871 mem[CONTEXT] = FORTH_CFA
873 FINDVOCAB_CFA = defPrimWord("FINDVOCAB", () -> begin
875 countedAddr = popPS()
877 wordAddr = countedAddr + 1
878 wordLen = mem[countedAddr]
879 word = lowercase(getString(wordAddr, wordLen))
884 while (lfa = mem[lfa]) > 0
886 lenAndFlags = mem[lfa+1]
887 len = lenAndFlags & F_LENMASK
888 hidden = (lenAndFlags & F_HIDDEN) == F_HIDDEN
890 if hidden || len != wordLen
894 thisWord = lowercase(getString(lfa+2, len))
903 callPrim(mem[FROMLINK_CFA])
904 if (lenAndFlags & F_IMMED) == F_IMMED
917 FIND_CFA = defPrimWord("FIND", () -> begin
919 countedAddr = popPS()
920 context = mem[CONTEXT:(CONTEXT+mem[NUMCONTEXT]-1)]
922 for vocabCFA in reverse(context)
925 callPrim(mem[FINDVOCAB_CFA])
927 callPrim(mem[DUP_CFA])
945 BRANCH_CFA = defPrimWord("BRANCH", () -> begin
946 reg.IP += mem[reg.IP]
950 ZBRANCH_CFA = defPrimWord("0BRANCH", () -> begin
952 reg.IP += mem[reg.IP]
962 LITSTRING_CFA = defPrimWord("LITSTRING", () -> begin
972 TYPE_CFA = defPrimWord("TYPE", () -> begin
975 str = getString(addr, len)
980 # Interpreter/Compiler-specific I/O
982 TIB_CFA = defConst("TIB", TIB)
983 NUMTIB, NUMTIB_CFA = defNewVar("#TIB", 0)
985 FIB_CFA = defConst("FIB", FIB)
986 NUMFIB, NUMFIB_CFA = defNewVar("#FIB", 0)
988 IB_CFA = defPrimWord("IB", () -> begin
989 pushPS(mem[SOURCE_ID_VAR] == 0 ? TIB : FIB)
993 NUMIB_CFA = defPrimWord("#IB", () -> begin
994 pushPS(mem[SOURCE_ID_VAR] == 0 ? NUMTIB : NUMFIB)
998 TOIN, TOIN_CFA = defNewVar(">IN", 0)
1000 SOURCE_ID_VAR, SOURCE_ID_VAR_CFA = defNewVar("SOURCE-ID-VAR", 0)
1002 QUERY_CFA = defWord("QUERY",
1003 [TIB_CFA, LIT_CFA, 160, EXPECT_CFA,
1004 SPAN_CFA, FETCH_CFA, NUMTIB_CFA, STORE_CFA,
1005 LIT_CFA, 0, TOIN_CFA, STORE_CFA,
1008 EOF_FLAG, EOF_FLAG_CFA = defNewVar("EOF-FLAG", 0)
1011 # EOF-FLAG set to true if EOF is reached
1012 QUERY_FILE_CFA = defWord("QUERY-FILE",
1013 [FIB_CFA, LIT_CFA, 160, ROT_CFA, READ_LINE_CFA,
1014 DROP_CFA, EOF_FLAG_CFA, STORE_CFA,
1015 NUMFIB_CFA, STORE_CFA,
1016 LIT_CFA, 0, TOIN_CFA, STORE_CFA,
1019 WORD_CFA = defPrimWord("WORD", () -> begin
1022 if mem[SOURCE_ID_VAR] == 0
1030 # Chew up initial occurrences of delim
1031 while (mem[TOIN]<mem[sizeAddr] && mem[bufferAddr+mem[TOIN]] == delim)
1038 # Start reading in word
1040 while (mem[TOIN]<mem[sizeAddr])
1041 mem[addr] = mem[bufferAddr+mem[TOIN]]
1044 if (mem[addr] == delim)
1053 mem[countAddr] = count
1056 #println("Processing word: '$(getString(countAddr+1,mem[countAddr]))' (state $(mem[STATE]))")
1063 STATE, STATE_CFA = defNewVar("STATE", 0)
1065 COMMA_CFA = defPrimWord(",", () -> begin
1066 mem[mem[H]] = popPS()
1072 HERE_CFA = defWord("HERE",
1073 [H_CFA, FETCH_CFA, EXIT_CFA])
1075 HEADER_CFA = defPrimWord("HEADER", () -> begin
1076 wordAddr = popPS()+1
1077 wordLen = mem[wordAddr-1]
1078 word = getString(wordAddr, wordLen)
1080 createHeader(word, 0)
1085 CREATE_CFA = defWord("CREATE",
1086 [LIT_CFA, 32, WORD_CFA, HEADER_CFA,
1087 LIT_CFA, DOVAR, COMMA_CFA,
1090 DODOES = defPrim(() -> begin
1097 DOES_HELPER_CFA = defPrimWord("(DOES>)", () -> begin
1099 pushPS(mem[mem[CURRENT]+1])
1100 callPrim(mem[FROMLINK_CFA])
1103 runtimeAddr = popPS()
1105 mem[cfa] = defPrim(eval(:(() -> begin
1106 pushPS($(runtimeAddr))
1108 end)), name="doesPrim")
1111 end, flags=F_IMMED | F_HIDDEN)
1113 DOES_CFA = defWord("DOES>",
1114 [LIT_CFA, LIT_CFA, COMMA_CFA, HERE_CFA, LIT_CFA, 3, ADD_CFA, COMMA_CFA,
1115 LIT_CFA, DOES_HELPER_CFA, COMMA_CFA, LIT_CFA, EXIT_CFA, COMMA_CFA, EXIT_CFA],
1118 LBRAC_CFA = defPrimWord("[", () -> begin
1123 RBRAC_CFA = defPrimWord("]", () -> begin
1128 HIDDEN_CFA = defPrimWord("HIDDEN", () -> begin
1129 lenAndFlagsAddr = mem[mem[CURRENT]+1] + 1
1130 mem[lenAndFlagsAddr] = mem[lenAndFlagsAddr] $ F_HIDDEN
1134 COLON_CFA = defWord(":",
1135 [LIT_CFA, 32, WORD_CFA,
1137 LIT_CFA, DOCOL, COMMA_CFA,
1142 SEMICOLON_CFA = defWord(";",
1143 [LIT_CFA, EXIT_CFA, COMMA_CFA,
1146 EXIT_CFA], flags=F_IMMED)
1148 IMMEDIATE_CFA = defPrimWord("IMMEDIATE", () -> begin
1149 lenAndFlagsAddr = mem[mem[CURRENT]+1] + 1
1150 mem[lenAndFlagsAddr] = mem[lenAndFlagsAddr] $ F_IMMED
1154 # ( addr n -- primAddr )
1155 CREATE_PRIM_CFA = defPrimWord("CREATE-PRIM", () -> begin
1159 exprString = string("() -> begin\n",
1160 getString(addr, len), "\n",
1163 func = eval(parse(exprString))
1165 pushPS(defPrim(func))
1171 EXECUTE_CFA = defPrimWord("EXECUTE", () -> begin
1176 INTERPRET_CFA = defWord("INTERPRET",
1177 [LIT_CFA, 32, WORD_CFA, # Read next space-delimited word
1179 DUP_CFA, FETCH_CFA, ZE_CFA, ZBRANCH_CFA, 3,
1180 DROP_CFA, EXIT_CFA, # Exit if input buffer is exhausted
1182 STATE_CFA, FETCH_CFA, ZBRANCH_CFA, 24,
1184 FIND_CFA, QDUP_CFA, ZBRANCH_CFA, 13,
1187 LIT_CFA, -1, EQ_CFA, INVERT_CFA, ZBRANCH_CFA, 4,
1189 # Immediate: Execute!
1190 EXECUTE_CFA, BRANCH_CFA, -26,
1192 # Not immediate: Compile!
1193 COMMA_CFA, BRANCH_CFA, -29,
1195 # No word found, parse number
1196 NUMBER_CFA, LIT_CFA, LIT_CFA, COMMA_CFA, COMMA_CFA, BRANCH_CFA, -36,
1199 FIND_CFA, QDUP_CFA, ZBRANCH_CFA, 5,
1201 # Found word. Execute!
1202 DROP_CFA, EXECUTE_CFA, BRANCH_CFA, -44,
1204 # No word found, parse number and leave on stack
1205 NUMBER_CFA, BRANCH_CFA, -47,
1208 PROMPT_CFA = defPrimWord("PROMPT", () -> begin
1217 QUIT_CFA = defWord("QUIT",
1218 [LIT_CFA, 0, STATE_CFA, STORE_CFA, # Set mode to interpret
1219 LIT_CFA, 0, SOURCE_ID_VAR_CFA, STORE_CFA, # Set terminal as input stream
1220 LIT_CFA, 0, NUMTIB_CFA, STORE_CFA, # Clear the input buffer
1221 RSP0_CFA, RSPSTORE_CFA, # Clear the return stack
1222 QUERY_CFA, # Read line of input
1223 INTERPRET_CFA, PROMPT_CFA, # Interpret line
1224 BRANCH_CFA,-4]) # Loop
1226 INCLUDED_CFA = defWord("INCLUDED",
1227 [LIT_CFA, 0, STATE_CFA, STORE_CFA, # Set mode to interpret
1228 FAM_RO_CFA, OPEN_FILE_CFA, DROP_CFA, # Open the file
1229 SOURCE_ID_VAR_CFA, FETCH_CFA, SWAP_CFA, # Store current source on stack
1230 SOURCE_ID_VAR_CFA, STORE_CFA, # Mark this as the current source
1231 SOURCE_ID_VAR_CFA, FETCH_CFA, QUERY_FILE_CFA, # Read line from file
1232 EOF_FLAG_CFA, FETCH_CFA,
1233 NUMFIB_CFA, FETCH_CFA, ZE_CFA, AND_CFA, # Test for EOF and empty line
1234 INVERT_CFA, ZBRANCH_CFA, 4, # Break out if EOF
1235 INTERPRET_CFA, # Interpret line
1236 BRANCH_CFA, -14, # Loop
1237 SOURCE_ID_VAR_CFA, FETCH_CFA,
1238 CLOSE_FILE_CFA, DROP_CFA, # Close file
1239 SOURCE_ID_VAR_CFA, STORE_CFA, # Restore input source
1240 LIT_CFA, 0, NUMIB_CFA, STORE_CFA, # Zero #IB
1241 LIT_CFA, 0, TOIN_CFA, STORE_CFA, # Zero >IN
1244 INCLUDE_CFA = defWord("INCLUDE", [LIT_CFA, 32, WORD_CFA,
1246 SWAP_CFA, FETCH_CFA,
1247 INCLUDED_CFA, EXIT_CFA]);
1249 ABORT_CFA = defWord("ABORT",
1250 [CLOSE_FILES_CFA, DROP_CFA, PSP0_CFA, PSPSTORE_CFA, QUIT_CFA])
1252 BYE_CFA = defPrimWord("BYE", () -> begin
1253 if mem[SOURCE_ID_VAR] == 0
1259 EOF_CFA = defPrimWord("\x04", () -> begin
1263 ### Library loading ###
1266 SETLIBCWD_CFA = defPrimWord("SETLIBCWD", () -> begin
1267 global oldCWD = pwd()
1268 if !isfile("lib.4th") # Exception for debugging.
1269 cd(Pkg.dir("forth","src"))
1274 RESTORECWD_CFA = defPrimWord("RESTORECWD", () -> begin
1279 INCLUDED_LIB_CFA = defWord("INCLUDED-LIB",
1280 [SETLIBCWD_CFA, INCLUDED_CFA, RESTORECWD_CFA, EXIT_CFA])
1282 INCLUDE_LIB_CFA = defWord("INCLUDE-LIB", [LIT_CFA, 32, WORD_CFA,
1284 SWAP_CFA, FETCH_CFA,
1285 INCLUDED_LIB_CFA, EXIT_CFA]);
1287 SKIP_WELCOME, SKIP_WELCOME_CFA = defNewVar("SKIP-WELCOME", 0)
1292 libFileName = "lib.4th"
1294 function run(fileName=nothing; initialize=true)
1296 # Start with IP pointing to first instruction of outer interpreter
1299 # Include optional file
1300 if fileName != nothing
1301 putString(fileName, mem[H])
1303 mem[H] += length(fileName)
1304 pushPS(length(fileName))
1305 pushRS(INCLUDED_CFA+1)
1307 mem[SKIP_WELCOME] = -1
1310 # Load library files
1311 global initialized, libFileName
1312 if !initialized && initialize
1313 if libFileName != nothing
1314 #print("Including definitions from $libFileName...")
1316 putString(libFileName, mem[H])
1318 pushPS(length(libFileName))
1319 pushRS(INCLUDED_LIB_CFA+1)
1323 println("No library file found. Only primitive words available.")
1328 # Primitive processing loop.
1329 # Everyting else is simply a consequence of this loop!
1333 #print("Entering prim $(getPrimName(jmp)), PS: ")
1339 showerror(STDOUT, ex)
1343 reg.IP = ABORT_CFA + 1
1351 TRACE_CFA = defPrimWord("TRACE", () -> begin
1352 println("reg.W: $(reg.W) reg.IP: $(reg.IP)")
1353 print("PS: "); printPS()
1354 print("RS: "); printRS()
1361 function dump(startAddr::Int64; count::Int64 = 100, cellsPerLine::Int64 = 10)
1362 chars = Array{Char,1}(cellsPerLine)
1364 lineStartAddr = cellsPerLine*div((startAddr-1),cellsPerLine) + 1
1365 endAddr = startAddr + count - 1
1367 q, r = divrem((endAddr-lineStartAddr+1), cellsPerLine)
1368 numLines = q + (r > 0 ? 1 : 0)
1374 for c in 1:cellsPerLine
1375 if i >= startAddr && i <= endAddr
1377 if mem[i]>=32 && mem[i]<128
1378 chars[c] = Char(mem[i])
1390 println("\t", String(chars))
1395 count = reg.PSP - PSP0
1399 for i in (PSP0+1):reg.PSP
1404 println("Parameter stack empty")
1409 count = reg.RSP - RSP0
1413 for i in (RSP0+1):reg.RSP
1418 println("Return stack empty")
1422 DUMP = defPrimWord("DUMP", () -> begin
1427 dump(addr, count=count)