exit, word, s"

diff --git a/core.fth b/core.fth
index a194aa1925116d23471cb5f31d5d73f8cda7bc99..24f6820cfea6d4ab9e0aea908c89b7a8c29dd304 100644 (file)
--- a/core.fth
+++ b/core.fth
@@ -16,10 +16,6 @@
 : min       2dup <= if drop else swap drop then ;
 : max       2dup <= if swap drop else drop then ;
 
-: cr        10 emit ;
-: space     bl emit ;
-\ : spaces    begin dup 0 > while space 1- repeat drop ;
-
 : begin     0 here ; immediate
 : while     swap 1+ swap postpone if -rot ; immediate
 : repeat    ['] _jmp , , if postpone then then ; immediate
@@ -27,7 +23,7 @@
 
 : do        ['] _lit , here 0 , ['] >r , postpone 2>r here ; immediate
 : unloop    postpone 2r> ['] 2drop , ['] r> , ['] drop , ; immediate
-: leave     postpone 2r> ['] 2drop , ['] exit , ; immediate
+: leave     postpone 2r> ['] 2drop , postpone exit ; immediate
 : +loop     ['] r> , ['] 2dup , ['] + ,
             postpone r@ ['] swap , ['] >r ,
             ['] - , ['] 2dup , ['] + , ['] over , ['] xor ,
@@ -49,5 +45,28 @@
 
 : does>     here 4 cells + postpone literal ['] _does> , 0 , ; immediate
 
-: variable create cell allot ;
-: constant create , does> @ ;
+: variable  create cell allot ;
+: constant  create , does> @ ;
+
+: cr        10 emit ;
+: space     bl emit ;
+: spaces    begin dup 0 > while space 1- repeat drop ;
+
+: word      0 here c! begin \ bl
+            key 2dup <>     \ bl key <>
+            over 0<> and while \ bl key
+            here c@ char+ \ bl key u
+            dup here c! \ bl key u
+            here + c! \ bl
+            repeat 2drop here ;
+: count    dup char+ swap c@ ;
+: char     0 here char+ c! bl word char+ c@ ;
+: [char]   char postpone literal ; immediate
+
+: s"       state @ if ['] _jmp , here 0 , then
+           [char] " word count
+           state @ 0= if exit then
+           dup cell+ allot
+           rot here swap !
+           swap postpone literal postpone literal ; immediate
+

diff --git a/sforth/forth.hpp b/sforth/forth.hpp
index 52d0585a0ebec7ccc0be7373565872bd7824edcd..be184c67dae074625f28bc44f30a1deda57caefb 100644 (file)
--- a/sforth/forth.hpp
+++ b/sforth/forth.hpp
@@ -153,6 +153,8 @@ struct forth : public word_list
                 else
                     execute(body);
             }
+
+            sourcei = sv.find_first_not_of(" \t\r\n", sourcei);
         }
     }
 
@@ -272,6 +274,11 @@ constexpr auto initialize()
             fthp->push(std::bit_cast<cell>(fthp->source));
             fthp->push(len); }, 0
         , S{">in"}, [](auto) { fthp->push(std::bit_cast<cell>(&fthp->sourcei)); }, 0
+        , S{"key"}, [](auto) {
+            if (fthp->sourcei != std::string_view::npos)
+                fthp->push(fthp->source[fthp->sourcei++]);
+            else
+                fthp->push(0); }, 0
     >::word;
     constexpr static auto& dict2 = comp_dict<prologue, &dict1
         , S{"align"  }, S{"here dup aligned swap - allot"}, 0
@@ -282,6 +289,7 @@ constexpr auto initialize()
         , S{"2!"    }, S{"swap over ! cell+ !"}, 0
         , S{"2@"    }, S{"dup cell+ @ swap @"}, 0
         , S{"c,"    }, S{"here c! 1 allot"}, 0
+        , S{"exit"  }, S{"0 ,"}, word_base::immediate
         , S{","     }, S{"here ! cell allot"}, 0
         , S{"allot" }, S{"dp +!"}, 0
         , S{"+!"    }, S{"dup >r swap r> @ + swap !"}, 0
@@ -304,6 +312,7 @@ constexpr auto initialize()
         , S{"-rot"  }, S{"rot rot"}, 0
         , S{"2drop" }, S{"drop drop"}, 0
         , S{"0<"    }, S{"0 <"}, 0
+        , S{"0<>"   }, S{"0 <>"}, 0
         , S{"<>"    }, S{"= 0="}, 0
         , S{"0="    }, S{"0 ="}, 0
         , S{">"     }, S{"swap <"}, 0