aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorClyne Sullivan <clyne@bitgloo.com>2023-02-23 08:29:11 -0500
committerClyne Sullivan <clyne@bitgloo.com>2023-02-23 08:29:11 -0500
commit1815716fc702a745cf37db84757ab56a0d923f45 (patch)
treed668bacd46504e7a78e0e5f5133912e6b7b13e62
parent9ccce3fd1831684a9074a3b4e243e80418265cd6 (diff)
.(, buffer:, c", erase
-rw-r--r--alee.cpp2
-rw-r--r--compat.txt8
-rw-r--r--core.fth15
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 ;