From 1815716fc702a745cf37db84757ab56a0d923f45 Mon Sep 17 00:00:00 2001
From: Clyne Sullivan <clyne@bitgloo.com>
Date: Thu, 23 Feb 2023 08:29:11 -0500
Subject: [PATCH] .(, buffer:, c", erase

---
 alee.cpp   |  2 ++
 compat.txt |  8 ++++----
 core.fth   | 15 ++++++++++++---
 3 files changed, 18 insertions(+), 7 deletions(-)

diff --git a/alee.cpp b/alee.cpp
index 38b16e4..d8a0cc8 100644
--- a/alee.cpp
+++ b/alee.cpp
@@ -94,6 +94,8 @@ void parseFile(Parser& parser, State& state, std::istream& file)
     while (file.good()) {
         std::string line;
         std::getline(file, line);
+        if (line == "bye")
+            exit(0);
         parseLine(parser, state, line);
     }
 }
diff --git a/compat.txt b/compat.txt
index 5c0cad6..6307bfc 100644
--- a/compat.txt
+++ b/compat.txt
@@ -136,7 +136,7 @@ yes 6.1.2540 ]
 
 6.2 Core extension words
 
-    6.2.0200 .(
+yes 6.2.0200 .(
     6.2.0210 .R
 yes 6.2.0260 0<>
 yes 6.2.0280 0>
@@ -148,8 +148,8 @@ yes 6.2.0500 <>
     6.2.0620 ?DO
 yes 6.2.0698 ACTION-OF
 yes 6.2.0700 AGAIN
-    6.2.0825 BUFFER:
-    6.2.0855 C"
+yes 6.2.0825 BUFFER:
+yes 6.2.0855 C"
     6.2.0873 CASE
 yes 6.2.0945 COMPILE,
 yes 6.2.1173 DEFER
@@ -157,7 +157,7 @@ yes 6.2.1175 DEFER!
 yes 6.2.1177 DEFER@
     6.2.1342 ENDCASE
     6.2.1343 ENDOF
-    6.2.1350 ERASE
+yes 6.2.1350 ERASE
 yes 6.2.1485 FALSE
 yes 6.2.1660 HEX
     6.2.1675 HOLDS
diff --git a/core.fth b/core.fth
index 863228f..901d9b9 100644
--- a/core.fth
+++ b/core.fth
@@ -90,7 +90,7 @@
 : 2*       2 * ;
 : 2/       2 / ;
 
-: cr       9 emit ;
+: cr       10 emit ;
 : bl       32 ;
 : space    bl emit ;
 : spaces   begin dup 0 > while space 1- repeat drop ;
@@ -119,7 +119,14 @@
            dup cell+ allot
            rot here swap !
            swap postpone literal postpone literal ; imm
+: c"       state @ if ['] _jmp , here 0 , then
+           [char] " word
+           state @ 0= if exit then
+           dup count nip allot
+           here rot !
+           postpone literal ; imm
 : ."       postpone s" state @ if ['] type , else type then ; imm
+: .(       [char] ) word count type ; imm
 
 : create   align here bl word count nip cell+ allot align
            ['] _lit , here 3 cells + , ['] exit dup , ,
@@ -134,6 +141,7 @@
 : >body    cell+ @ ;
 : compile, postpone literal postpone execute ;
 
+: buffer:  create allot ;
 : variable create 1 cells allot ;
 : constant create , does> @ ;
 : value    constant ;
@@ -156,12 +164,13 @@
 : recurse  _latword , ; imm
 
 : move     begin dup 0 > while
-           rot dup @ >r cell+
-           rot r> over ! cell+
+           rot dup @ >r 1+
+           rot r> over ! 1+
            rot 1- repeat drop 2drop ;
 : fill     -rot begin dup 0 > while
            >r 2dup c! char+ r> 1- repeat
            2drop drop ;
+: erase    begin dup 0 > while swap 0 over ! 1+ swap 1- repeat ;
 : roll     dup if swap >r 1- recurse r> swap exit then drop ;
 
 : environment? 2drop false ;