X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=blobdiff_plain;f=src%2Fforth.jl;h=02f74afed367a7a2d808f3226e28038ec7107351;hb=74030e7ce7cbe674ac71767cff6e9c3f3564c3b0;hp=a1a479970a797af829c01f1bc142bbccb3b63a04;hpb=492989e5e479cebefe9213a0c350534528d5f819;p=forth.jl.git

diff --git a/src/forth.jl b/src/forth.jl
index a1a4799..02f74af 100644
--- a/src/forth.jl
+++ b/src/forth.jl
@@ -1134,42 +1134,18 @@ IMMEDIATE_CFA = defPrimWord("IMMEDIATE", () -> begin
     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)
 
@@ -1253,7 +1229,6 @@ INCLUDE_CFA = defWord("INCLUDE", [LIT_CFA, 32, WORD_CFA,
     SWAP_CFA, FETCH_CFA,
     INCLUDED_CFA, EXIT_CFA]);
 
-
 ABORT_CFA = defWord("ABORT",
     [CLOSE_FILES_CFA, DROP_CFA, PSP0_CFA, PSPSTORE_CFA, QUIT_CFA])
 
@@ -1266,31 +1241,63 @@ EOF_CFA = defPrimWord("\x04", () -> begin
     return 0
 end)
 
+### Library loading ###
+
+oldCWD = ""
+SETLIBCWD_CFA = defPrimWord("SETLIBCWD", () -> begin
+    global oldCWD = pwd()
+    if !isfile("lib.4th") # Exception for debugging.
+        cd(Pkg.dir("forth","src"))
+    end
+    return NEXT
+end)
+
+RESTORECWD_CFA = defPrimWord("RESTORECWD", () -> begin
+    cd(oldCWD)
+    return NEXT
+end)
+
+INCLUDED_LIB_CFA = defWord("INCLUDED-LIB",
+    [SETLIBCWD_CFA, INCLUDED_CFA, RESTORECWD_CFA, EXIT_CFA])
+
+INCLUDE_LIB_CFA = defWord("INCLUDE-LIB", [LIT_CFA, 32, WORD_CFA,
+    DUP_CFA, INCR_CFA,
+    SWAP_CFA, FETCH_CFA,
+    INCLUDED_LIB_CFA, EXIT_CFA]);
+
+SKIP_WELCOME, SKIP_WELCOME_CFA = defNewVar("SKIP-WELCOME", 0)
+
 #### VM loop ####
 
 initialized = false
-initFileName = nothing
-if isfile("lib.4th")
-    initFileName = "lib.4th"
-elseif isfile(Pkg.dir("forth","src", "lib.4th"))
-    initFileName = Pkg.dir("forth","src","lib.4th")
-end
+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))
-            pushRS(INCLUDED_CFA+1)
+            pushPS(length(libFileName))
+            pushRS(INCLUDED_LIB_CFA+1)
 
             initialized = true
         else