Implemented ABORT".

[forth.jl.git] / src / lib_5_strings.4th

diff --git a/src/lib_5_strings.4th b/src/lib_5_strings.4th
index 9fef145..d0619f0 100644 (file)
--- 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
+;