]> code.bitgloo.com Git - bitgloo/alee-forth.git/commitdiff
.(, buffer:, c", erase
authorClyne Sullivan <clyne@bitgloo.com>
Thu, 23 Feb 2023 13:29:11 +0000 (08:29 -0500)
committerClyne Sullivan <clyne@bitgloo.com>
Thu, 23 Feb 2023 13:29:11 +0000 (08:29 -0500)
alee.cpp
compat.txt
core.fth

index 38b16e42c9166df8b45c5179ef738c4c46c3f8bd..d8a0cc89c87fb47a8265372e016a651f7b3d92da 100644 (file)
--- 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);
     }
 }
index 5c0cad6c24254c1be05cd3bb06010960f188e615..6307bfc990e83438d2f06247973e1a47c4ac6ad0 100644 (file)
@@ -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
index 863228f411195d4934ae1033231973041af98659..901d9b967171281305c5a09fe7b0e6cf910988e3 100644 (file)
--- 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 ;
            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 , ,
 : >body    cell+ @ ;
 : compile, postpone literal postpone execute ;
 
+: buffer:  create allot ;
 : variable create 1 cells allot ;
 : constant create , does> @ ;
 : value    constant ;
 : 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 ;