return NEXT
end, flags=F_IMMED)
-CODE_CFA = defPrimWord("CODE", () -> begin
- pushPS(32)
- callPrim(mem[WORD_CFA])
- callPrim(mem[HEADER_CFA])
-
- exprString = "() -> begin\n"
- while true
- if mem[TOIN] >= mem[NUMTIB]
- exprString = string(exprString, "\n")
- if currentSource() == STDIN
- println()
- end
-
- pushPS(TIB)
- pushPS(160)
- callPrim(mem[EXPECT_CFA])
- mem[NUMTIB] = mem[SPAN]
- mem[TOIN] = 0
- end
-
- pushPS(32)
- callPrim(mem[WORD_CFA])
- cAddr = popPS()
- thisWord = getString(cAddr+1, mem[cAddr])
-
- if uppercase(thisWord) == "END-CODE"
- break
- end
-
- exprString = string(exprString, " ", thisWord)
- end
- exprString = string(exprString, "\nreturn NEXT\nend")
-
+# ( addr n -- primAddr )
+CREATE_PRIM_CFA = defPrimWord("CREATE-PRIM", () -> begin
+ len = popPS()
+ addr = popPS()
+
+ exprString = string("() -> begin\n",
+ getString(addr, len), "\n",
+ "return NEXT\n",
+ "end")
func = eval(parse(exprString))
- dictWrite(defPrim(func))
+ pushPS(defPrim(func))
return NEXT
end)
SWAP_CFA, FETCH_CFA,
INCLUDED_CFA, EXIT_CFA]);
+ABORT_CFA = defWord("ABORT",
+ [CLOSE_FILES_CFA, DROP_CFA, PSP0_CFA, PSPSTORE_CFA, QUIT_CFA])
+
+BYE_CFA = defPrimWord("BYE", () -> begin
+ if mem[SOURCE_ID_VAR] == 0
+ println("\nBye!")
+ end
+ return 0
+end)
+
+EOF_CFA = defPrimWord("\x04", () -> begin
+ return 0
+end)
+
+### Library loading ###
+
oldCWD = ""
SETLIBCWD_CFA = defPrimWord("SETLIBCWD", () -> begin
global oldCWD = pwd()
SWAP_CFA, FETCH_CFA,
INCLUDED_LIB_CFA, EXIT_CFA]);
-ABORT_CFA = defWord("ABORT",
- [CLOSE_FILES_CFA, DROP_CFA, PSP0_CFA, PSPSTORE_CFA, QUIT_CFA])
-
-BYE_CFA = defPrimWord("BYE", () -> begin
- println("\nBye!")
- return 0
-end)
-
-EOF_CFA = defPrimWord("\x04", () -> begin
- return 0
-end)
+SKIP_WELCOME, SKIP_WELCOME_CFA = defNewVar("SKIP-WELCOME", 0)
#### VM loop ####
initialized = false
-initFileName = "lib.4th"
+libFileName = "lib.4th"
-function run(;initialize=true)
+function run(fileName=nothing; initialize=true)
# Start with IP pointing to first instruction of outer interpreter
pushRS(QUIT_CFA+1)
+ # Include optional file
+ if fileName != nothing
+ putString(fileName, mem[H])
+ pushPS(mem[H])
+ mem[H] += length(fileName)
+ pushPS(length(fileName))
+ pushRS(INCLUDED_CFA+1)
+
+ mem[SKIP_WELCOME] = -1
+ end
+
# Load library files
- global initialized, initFileName
+ global initialized, libFileName
if !initialized && initialize
- if initFileName != nothing
- print("Including definitions from $initFileName...")
+ if libFileName != nothing
+ #print("Including definitions from $libFileName...")
- putString(initFileName, mem[H])
+ putString(libFileName, mem[H])
pushPS(mem[H])
- pushPS(length(initFileName))
+ pushPS(length(libFileName))
pushRS(INCLUDED_LIB_CFA+1)
initialized = true