CODE now a library word.
authorTim Vaughan <tgvaughan@gmail.com>
Wed, 12 Oct 2016 09:12:05 +0000 (22:12 +1300)
committerTim Vaughan <tgvaughan@gmail.com>
Wed, 12 Oct 2016 09:12:05 +0000 (22:12 +1300)
src/forth.jl
src/lib.4th
src/lib_11_extensions.4th [new file with mode: 0644]

index 9939c9c..877c2d2 100644 (file)
@@ -1143,7 +1143,7 @@ CREATE_PRIM_CFA = defPrimWord("CREATE-PRIM", () -> begin
                         getString(addr, len), "\n",
                         "return NEXT\n",
                         "end")
                         getString(addr, len), "\n",
                         "return NEXT\n",
                         "end")
-    func = eval(parse(expString))
+    func = eval(parse(exprString))
 
     pushPS(defPrim(func))
     return NEXT
 
     pushPS(defPrim(func))
     return NEXT
index 86731cf..fef3b42 100644 (file)
@@ -15,5 +15,6 @@ include lib_7_variables.4th
 include lib_8_vocab.4th
 include lib_9_decompiler.4th
 include lib_10_misc.4th
 include lib_8_vocab.4th
 include lib_9_decompiler.4th
 include lib_10_misc.4th
+include lib_11_extensions.4th
 
 .(  done.) cr
 
 .(  done.) cr
diff --git a/src/lib_11_extensions.4th b/src/lib_11_extensions.4th
new file mode 100644 (file)
index 0000000..1e28933
--- /dev/null
@@ -0,0 +1,41 @@
+\ Non-core extension words
+
+CREATE CODEBUFFER 1000 CELLS ALLOT
+VARIABLE >CB
+0 >CB !
+
+: PARSE-CODE
+    0 >CB !
+
+    BEGIN
+        >IN @ #IB @ >= IF   \ End of IB?
+            '\n' CODEBUFFER >CB @ + !
+            1 >CB +!
+            SOURCE-ID 0= IF CR THEN
+            QUERY-INPUT     \ Get next line
+        ELSE
+            BL CODEBUFFER >CB @ + !
+            1 >CB +!
+        THEN
+
+        BL WORD COUNT
+        2DUP ( addr n addr n)
+        PAD SWAP CMOVE
+
+        PAD OVER TOLOWER
+        PAD OVER s" end-code" COMPARE
+        0= IF
+            2DROP EXIT
+        THEN
+
+        dup -rot ( n addr n )
+        CODEBUFFER >CB @ + SWAP CMOVE
+        >CB +!
+    AGAIN
+;
+
+: CODE
+    BL WORD HEADER
+    PARSE-CODE
+    CODEBUFFER >CB @ CREATE-PRIM ,
+;