From: Tim Vaughan <tgvaughan@gmail.com>
Date: Mon, 6 Jun 2016 01:47:23 +0000 (+1200)
Subject: Implemented ABORT".
X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=commitdiff_plain;h=e57561fe2d6e29350b0bfb580d7129910ece9689;p=forth.jl.git

Implemented ABORT".
---

diff --git a/src/forth.jl b/src/forth.jl
index 37ce5d1..f10ea04 100644
--- a/src/forth.jl
+++ b/src/forth.jl
@@ -13,7 +13,7 @@ mem = Array{Int64,1}(size_mem)
 primitives = Array{Function,1}()
 primNames = Array{ASCIIString,1}()
 
-# Built-in variables
+# Memory geography and built-in variables
 
 nextVarAddr = 1
 H = nextVarAddr; nextVarAddr += 1              # Next free memory address
@@ -84,6 +84,8 @@ function putString(str::ASCIIString, addr::Int64)
     mem[addr:(addr+length(str)-1)] = [Int64(c) for c in str]
 end
 
+stringAsInts(str::ASCIIString) = [Int(c) for c in collect(str)]
+
 # Primitive creation and calling functions
 
 function defPrim(f::Function; name="nameless")
@@ -1010,8 +1012,11 @@ INTERPRET_CFA = defWord("INTERPRET",
     EXIT_CFA])
 
 PROMPT_CFA = defPrimWord("PROMPT", () -> begin
-    if (mem[STATE] == 0 && currentSource() == STDIN)
-        println(" ok")
+    if currentSource() == STDIN
+        if mem[STATE] == 0
+            print(" ok")
+        end
+        println()
     end
 
     return NEXT
diff --git a/src/lib_5_strings.4th b/src/lib_5_strings.4th
index 9fef145..d0619f0 100644
--- a/src/lib_5_strings.4th
+++ b/src/lib_5_strings.4th
@@ -37,55 +37,40 @@
         DROP
 ;
 
+( Compile-mode word which compiles everything until the next
+  double quote as a litstring. )
 : S" IMMEDIATE          ( -- addr len )
-        STATE @ IF      ( compiling? )
-                ['] LITSTRING ,   ( compile LITSTRING )
-                HERE          ( save the address of the length word on the stack )
-                0 ,             ( dummy length - we don't know what it is yet )
-
-                BEGIN
-                        >IN @ #TIB @ >= IF      \ End of TIB?
-                                QUERY           \ Get next line
-                        THEN
-
-                        TIB >IN @ + @ 1 >IN +!  \ Get char from TIB
-
-                        DUP [CHAR] " <>
-                WHILE
-                        C,              ( copy character )
-                REPEAT
-                DROP            ( drop the double quote character at the end )
-                DUP             ( get the saved address of the length word )
-                HERE SWAP -   ( calculate the length )
-                1-              ( subtract 1 (because we measured from the start of the length word) )
-                SWAP !          ( and back-fill the length location )
-        ELSE            ( immediate mode )
-                HERE          ( get the start address of the temporary space )
-                
-                BEGIN
-                        >IN @ #TIB @ >= IF      \ End of TIB?
-                                QUERY           \ Get next line
-                        THEN
-
-                        TIB >IN @ + @ 1 >IN +!  \ Get char from TIB
-
-                        DUP [CHAR] " <>
-                WHILE
-                        OVER C!         ( save next character )
-                        1+              ( increment address )
-                REPEAT
-                DROP            ( drop the final " character )
-                HERE -        ( calculate the length )
-                HERE          ( push the start address )
-                SWAP            ( addr len )
-        THEN
+        ['] LITSTRING ,   ( compile LITSTRING )
+        HERE          ( save the address of the length word on the stack )
+        0 ,             ( dummy length - we don't know what it is yet )
+
+        BEGIN
+                >IN @ #TIB @ >= IF      \ End of TIB?
+                        QUERY           \ Get next line
+                THEN
+
+                TIB >IN @ + @ 1 >IN +!  \ Get char from TIB
+
+                DUP [CHAR] " <>
+        WHILE
+                C,              ( copy character )
+        REPEAT
+        DROP            ( drop the double quote character at the end )
+        DUP             ( get the saved address of the length word )
+        HERE SWAP -   ( calculate the length )
+        1-              ( subtract 1 (because we measured from the start of the length word) )
+        SWAP !          ( and back-fill the length location )
 ;
 
-: ." IMMEDIATE          ( -- )
-        [COMPILE] S"    ( read the string, and compile LITSTRING, etc. )
-        ['] TYPE ,      ( compile the final TYPE )
+( Compile-mode word which compiles everything until the
+  next double quote as a litstring and appends a TYPE. )
+: ." IMMEDIATE
+        [COMPILE] S"
+        ['] TYPE ,
 ;
 
+( Interpret-mode word which prints everything until the next
+  right-paren to the terminal. )
 : .( 
         BEGIN
                 >IN @ #TIB @ >= IF      \ End of TIB?
@@ -107,4 +92,17 @@
 : COUNT ( addr1 -- addr2 n )
         DUP 1+ SWAP @ ;
 
-
+: ABORT" IMMEDIATE
+        [COMPILE] S"
+
+        ['] rot ,
+        [COMPILE] if
+                s" Aborted: " ['] lit , , ['] lit , , ['] swap ,
+                ['] type ,
+                ['] type ,
+                ['] cr ,
+                ['] abort ,
+        [COMPILE] else
+                ['] 2drop ,
+        [COMPILE] then
+;