From 5de7639632e91ba73a956bcba2a4dc3ea389c0d2 Mon Sep 17 00:00:00 2001
From: Clyne Sullivan <clyne@bitgloo.com>
Date: Sun, 1 Dec 2024 16:13:45 -0500
Subject: exit, word, s"
---
core.fth | 33 ++++++++++++++++++++++++++-------
sforth/forth.hpp | 9 +++++++++
2 files changed, 35 insertions(+), 7 deletions(-)
diff --git a/core.fth b/core.fth
index a194aa1..24f6820 100644
--- 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 52d0585..be184c6 100644
--- 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
--
cgit v1.2.3