exit, word, s"

main
Clyne 2 weeks ago
parent a92731ee99
commit 5de7639632
Signed by: clyne
GPG Key ID: 3267C8EBF3F9AFC7

@ -16,10 +16,6 @@
: min 2dup <= if drop else swap drop then ; : min 2dup <= if drop else swap drop then ;
: max 2dup <= if swap drop else 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 : begin 0 here ; immediate
: while swap 1+ swap postpone if -rot ; immediate : while swap 1+ swap postpone if -rot ; immediate
: repeat ['] _jmp , , if postpone then then ; immediate : repeat ['] _jmp , , if postpone then then ; immediate
@ -27,7 +23,7 @@
: do ['] _lit , here 0 , ['] >r , postpone 2>r here ; immediate : do ['] _lit , here 0 , ['] >r , postpone 2>r here ; immediate
: unloop postpone 2r> ['] 2drop , ['] r> , ['] drop , ; immediate : unloop postpone 2r> ['] 2drop , ['] r> , ['] drop , ; immediate
: leave postpone 2r> ['] 2drop , ['] exit , ; immediate : leave postpone 2r> ['] 2drop , postpone exit ; immediate
: +loop ['] r> , ['] 2dup , ['] + , : +loop ['] r> , ['] 2dup , ['] + ,
postpone r@ ['] swap , ['] >r , postpone r@ ['] swap , ['] >r ,
['] - , ['] 2dup , ['] + , ['] over , ['] xor , ['] - , ['] 2dup , ['] + , ['] over , ['] xor ,
@ -51,3 +47,26 @@
: variable create cell allot ; : variable create cell allot ;
: constant create , does> @ ; : 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

@ -153,6 +153,8 @@ struct forth : public word_list
else else
execute(body); 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(std::bit_cast<cell>(fthp->source));
fthp->push(len); }, 0 fthp->push(len); }, 0
, S{">in"}, [](auto) { fthp->push(std::bit_cast<cell>(&fthp->sourcei)); }, 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; >::word;
constexpr static auto& dict2 = comp_dict<prologue, &dict1 constexpr static auto& dict2 = comp_dict<prologue, &dict1
, S{"align" }, S{"here dup aligned swap - allot"}, 0 , 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{"swap over ! cell+ !"}, 0
, S{"2@" }, S{"dup cell+ @ swap @"}, 0 , S{"2@" }, S{"dup cell+ @ swap @"}, 0
, S{"c," }, S{"here c! 1 allot"}, 0 , S{"c," }, S{"here c! 1 allot"}, 0
, S{"exit" }, S{"0 ,"}, word_base::immediate
, S{"," }, S{"here ! cell allot"}, 0 , S{"," }, S{"here ! cell allot"}, 0
, S{"allot" }, S{"dp +!"}, 0 , S{"allot" }, S{"dp +!"}, 0
, S{"+!" }, S{"dup >r swap r> @ + swap !"}, 0 , S{"+!" }, S{"dup >r swap r> @ + swap !"}, 0
@ -304,6 +312,7 @@ constexpr auto initialize()
, S{"-rot" }, S{"rot rot"}, 0 , S{"-rot" }, S{"rot rot"}, 0
, S{"2drop" }, S{"drop drop"}, 0 , S{"2drop" }, S{"drop drop"}, 0
, S{"0<" }, S{"0 <"}, 0 , S{"0<" }, S{"0 <"}, 0
, S{"0<>" }, S{"0 <>"}, 0
, S{"<>" }, S{"= 0="}, 0 , S{"<>" }, S{"= 0="}, 0
, S{"0=" }, S{"0 ="}, 0 , S{"0=" }, S{"0 ="}, 0
, S{">" }, S{"swap <"}, 0 , S{">" }, S{"swap <"}, 0

Loading…
Cancel
Save