diff --git a/forth/core-ext.fth b/forth/core-ext.fth index 9dab169..83dd666 100644 --- a/forth/core-ext.fth +++ b/forth/core-ext.fth @@ -21,21 +21,23 @@ : \ _source @ >in @ + begin dup c@ while 0 over c! char+ repeat drop ; imm : again postpone repeat ; imm -: ?do ['] 2dup , ['] _lit , here 0 , ['] >r , ['] = , postpone if - ['] 2drop , postpone 2r> ['] drop , ['] >r , ['] leave , - postpone then postpone 2>r here ; imm + +: ?do ['] _lit , here 0 , ['] >r , ['] 2dup , postpone 2>r + ['] = , postpone if postpone leave postpone then + here ; imm : .( [char] ) word count type ; imm : c" state @ if ['] _jmp , here 0 , then [char] " word state @ 0= if exit then - dup count nip allot + dup count nip 1+ allot here rot ! postpone literal ; imm : buffer: create allot ; : value constant ; : to ' 4 cells + state @ if postpone literal ['] ! , else ! then ; imm + : defer create does> @ execute ; : defer@ >body @ ; : defer! >body ! ; @@ -48,11 +50,10 @@ : marker here _latest @ create , , does> dup @ _latest ! cell+ @ here - allot ; -: case ['] _lit , 1 here 0 , ['] drop , ; imm -: of ['] over , ['] = , postpone if ; imm -: endof ['] _jmp , here >r 0 , postpone then - swap 1+ swap r> tuck ! ; imm -: endcase swap 0 do dup @ swap here swap ! loop drop ['] drop , ; imm +: case 0 ; imm +: of ['] over , ['] = , postpone if ['] drop , ; imm +: endof postpone else ; imm +: endcase ['] drop , begin ?dup while postpone then repeat ; imm : holds begin dup while 1- 2dup + c@ hold repeat 2drop ; diff --git a/forth/core.fth b/forth/core.fth index 90a8577..c5cd8f4 100644 --- a/forth/core.fth +++ b/forth/core.fth @@ -21,13 +21,22 @@ : base 0 ; : here 1 cells @ ; : allot 1 cells +! ; + +: c! 0 _! ; +: c@ 0 _@ ; +: c, here c! 1 allot ; +: char+ 1+ ; +: chars ; + : _latest 2 cells ; : imm _latest @ dup @ 1 5 << | swap ! ; : immediate imm ; : state 3 cells ; -: _source 4 cells ; -: _sourceu 5 cells ; -: >in 6 cells ; +: _compxt 4 cells ; +: _source 5 cells ; +: _sourceu 6 cells ; +: >in 7 cells ; +: _begin 8 cells 80 chars + ; : , here ! 1 cells allot ; @@ -54,12 +63,6 @@ : 2over 3 pick 3 pick ; : 2swap rot >r rot r> ; -: c! 0 _! ; -: c@ 0 _@ ; -: c, here c! 1 allot ; -: char+ 1+ ; -: chars ; - : decimal 10 base ! ; : 2r> ['] r> , ['] r> , ['] swap , ; imm @@ -82,23 +85,22 @@ : do ['] _lit , here 0 , ['] >r , postpone 2>r here ; imm : unloop postpone 2r> ['] 2drop , ['] r> , ['] drop , ; imm -: leave postpone 2r> ['] 2drop , postpone 2r> - ['] drop , ['] >r , ['] exit , ; imm +: leave postpone 2r> ['] 2drop , ['] exit , ; imm : +loop ['] r> , ['] 2dup , ['] + , postpone r@ ['] swap , ['] >r , ['] - , ['] 2dup , ['] + , ['] over , ['] ^ , ['] rot , ['] rot , ['] ^ , ['] & , ['] _lit , 0 , ['] < , ['] _jmp0 , , - postpone unloop here swap ! ; imm + postpone unloop here 1 cells - swap ! ; imm : loop postpone 2r> ['] 1+ , ['] 2dup , postpone 2>r ['] = , ['] _jmp0 , , - postpone unloop here swap ! ; imm + postpone unloop here 1 cells - swap ! ; imm : i postpone r@ ; imm : j postpone 2r> ['] r> , postpone r@ ['] swap , ['] >r , ['] -rot , postpone 2>r ; imm -: align here 1 cells 1- swap over & if 1 cells swap - allot else drop then ; : aligned dup 1 cells 1- swap over & if 1 cells swap - + else drop then ; +: align here dup aligned swap - allot ; : and & ; : or | ; @@ -155,21 +157,18 @@ swap postpone literal postpone literal ; imm : ." postpone s" state @ if ['] type , else type then ; imm -: create align here dup _latest @ - 1 1 cells 8 * 6 - << 1- swap <= - dup if -1 6 << , then 0 , >r - begin key? if key else bl then dup bl <> while - c, 1 over +! repeat drop align - ['] _lit , here 3 cells + , ['] exit dup , , - dup _latest @ - r> if - over cell+ else 6 << over then +! _latest ! ; - -: _does> _latest @ dup @ 31 & + cell+ aligned 2 cells + - ['] _jmp over ! cell+ - r@ 1 cells - @ swap ! ; -: does> ['] _jmp , here 2 cells + dup , 2 cells + , - ['] _does> , ['] exit , ; imm +: :noname here dup _compxt ! 0 , here swap ] ; + +: create : here 4 cells + postpone literal postpone ; 0 , ; : >body cell+ @ ; +: _does> >r _latest @ dup @ 31 & + cell+ aligned 2 cells + + ['] _jmp over ! cell+ r> cell+ swap ! ; + +: does> state @ if + here 3 cells + postpone literal ['] _does> , ['] exit , else + here dup _does> dup _compxt ! 0 , ] then ; imm + : variable create 1 cells allot ; : constant create , does> @ ; @@ -179,7 +178,7 @@ postpone if ['] type , ['] abort , postpone else ['] 2drop , postpone then ; imm -: recurse depth 1- pick dup @ 31 & + cell+ aligned , ; imm +: recurse _compxt @ dup @ 31 & + cell+ aligned , ; imm : move dup 0 <= if drop 2drop exit then >r 2dup < r> swap if @@ -198,8 +197,6 @@ else dup emit rot 2dup c! char+ swap drop swap 1- then repeat drop r> - 1 chars / ; -: :noname here 0 , here swap ] ; - : evaluate _source @ >r _sourceu @ >r >in @ >r 0 >in ! _sourceu ! _source ! _ev r> >in ! r> _sourceu ! r> _source ! ; diff --git a/forth/tools.fth b/forth/tools.fth index 3453ae3..8992d48 100644 --- a/forth/tools.fth +++ b/forth/tools.fth @@ -3,7 +3,6 @@ : dump hex 0 do i cells over + @ s>d <# # # # # bl hold #> type loop drop decimal ; -7 cells 80 chars + constant _begin : words _latest @ begin dup @ dup 31 & 2 pick cell+ \ lt l len ws diff --git a/libalee/corewords.cpp b/libalee/corewords.cpp index 1a39b7e..6900b45 100644 --- a/libalee/corewords.cpp +++ b/libalee/corewords.cpp @@ -155,6 +155,7 @@ execute: break; case 22: // colon state.push(state.dict.alignhere()); + state.dict.write(Dictionary::CompToken, state.top()); while (!state.dict.hasInput()) state.input(); state.dict.addDefinition(state.dict.input()); diff --git a/libalee/dictionary.hpp b/libalee/dictionary.hpp index b43ea2e..2b7afdf 100644 --- a/libalee/dictionary.hpp +++ b/libalee/dictionary.hpp @@ -47,11 +47,12 @@ public: constexpr static Addr Here = sizeof(Cell); constexpr static Addr Latest = sizeof(Cell) * 2; constexpr static Addr Compiling = sizeof(Cell) * 3; - constexpr static Addr Source = sizeof(Cell) * 4; - constexpr static Addr SourceLen = sizeof(Cell) * 5; - constexpr static Addr Input = sizeof(Cell) * 6; // len data... + constexpr static Addr CompToken = sizeof(Cell) * 4; + constexpr static Addr Source = sizeof(Cell) * 5; + constexpr static Addr SourceLen = sizeof(Cell) * 6; + constexpr static Addr Input = sizeof(Cell) * 7; // len data... constexpr static Addr InputCells = 80; // bytes! - constexpr static Addr Begin = sizeof(Cell) * 7 + InputCells; + constexpr static Addr Begin = sizeof(Cell) * 8 + InputCells; constexpr static Cell Immediate = (1 << 5);