diff options
author | Clyne Sullivan <clyne@bitgloo.com> | 2023-02-23 08:29:11 -0500 |
---|---|---|
committer | Clyne Sullivan <clyne@bitgloo.com> | 2023-02-23 08:29:11 -0500 |
commit | 1815716fc702a745cf37db84757ab56a0d923f45 (patch) | |
tree | d668bacd46504e7a78e0e5f5133912e6b7b13e62 | |
parent | 9ccce3fd1831684a9074a3b4e243e80418265cd6 (diff) |
.(, buffer:, c", erase
-rw-r--r-- | alee.cpp | 2 | ||||
-rw-r--r-- | compat.txt | 8 | ||||
-rw-r--r-- | core.fth | 15 |
3 files changed, 18 insertions, 7 deletions
@@ -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); } } @@ -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 @@ -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 ; |