From d9338b05bef60de439ba2377a3237f790b7bf2f6 Mon Sep 17 00:00:00 2001 From: David Given Date: Sat, 25 Jul 2015 23:51:55 +0200 Subject: [PATCH] Lots more words. --- Applications/util/fforth.c | 80 ++++++++++++++++++++++++++++++-------- 1 file changed, 63 insertions(+), 17 deletions(-) diff --git a/Applications/util/fforth.c b/Applications/util/fforth.c index 42ee79b7..6543fe38 100644 --- a/Applications/util/fforth.c +++ b/Applications/util/fforth.c @@ -528,8 +528,8 @@ static cdefn_t less0_word ; static cdefn_t lit_word ; static cdefn_t lshift_word ; static cdefn_t lt_word ; -static cdefn_t m_star_word ; static cdefn_t m_one_word ; +static cdefn_t m_star_word ; static cdefn_t more0_word ; static cdefn_t mul_word ; static cdefn_t not_equals_word ; @@ -545,10 +545,10 @@ static cdefn_t r_arrow_word ; static cdefn_t rot_word ; static cdefn_t rpick_word ; static cdefn_t rshift_word ; -static cdefn_t rsshift_word ; static cdefn_t rsp0_word ; static cdefn_t rsp_at_word ; static cdefn_t rsp_pling_word ; +static cdefn_t rsshift_word ; static cdefn_t source_word ; static cdefn_t sp0_word ; static cdefn_t sp_at_word ; @@ -561,6 +561,7 @@ static cdefn_t t_drop_word ; static cdefn_t t_dup_word ; static cdefn_t t_over_word ; static cdefn_t t_swap_word ; +static cdefn_t tuck_word ; static cdefn_t two_word ; static cdefn_t u_lt_word ; static cdefn_t u_m_star_word ; @@ -828,6 +829,15 @@ static void dabs_cb(cdefn_t* w) dpushd(d); } +static void tuck_cb(cdefn_t* w) +{ + cell_t x2 = dpop(); + cell_t x1 = dpop(); + dpush(x2); + dpush(x1); + dpush(x2); +} + static void fm_mod_cb(cdefn_t* w) { cell_t den = dpop(); @@ -973,9 +983,9 @@ COM( less0_word, less0_cb, "0<", &le_word, ) //@W COM( lit_word, lit_cb, "LIT", &less0_word, ) //@W COM( lshift_word, lshift_cb, "LSHIFT", &lit_word, ) //@W COM( lt_word, lt_cb, "<", &lshift_word, ) //@W -COM( m_star_word, m_star_cb, "M*", <_word, ) //@W -COM( m_one_word, rvarword, "-1", &m_star_word, (void*)-1 ) //@W -COM( more0_word, more0_cb, "0>", &m_one_word, ) //@W +COM( m_one_word, rvarword, "-1", <_word, (void*)-1 ) //@W +COM( m_star_word, m_star_cb, "M*", &m_one_word, ) //@W +COM( more0_word, more0_cb, "0>", &m_star_word, ) //@W COM( mul_word, mul_cb, "*", &more0_word, ) //@W COM( not_equals_word, not_equals_cb, "<>", &mul_word, ) //@W COM( notequals0_word, notequals0_cb, "0<>", ¬_equals_word, ) //@W @@ -990,11 +1000,11 @@ COM( r_arrow_word, r_arrow_cb, "R>", &q_dup_word, ) //@W COM( rot_word, rot_cb, "ROT", &r_arrow_word, ) //@W COM( rpick_word, rpick_cb, "RPICK", &rot_word, ) //@W COM( rshift_word, rshift_cb, "RSHIFT", &rpick_word, ) //@W -COM( rsshift_word, rsshift_cb, "2/", &rshift_word, ) //@W -COM( rsp0_word, rvarword, "RSP0", &rsshift_word, rstack ) //@W +COM( rsp0_word, rvarword, "RSP0", &rshift_word, rstack ) //@W COM( rsp_at_word, rivarword, "RSP@", &rsp0_word, &rsp ) //@W COM( rsp_pling_word, wivarword, "RSP!", &rsp_at_word, &rsp ) //@W -COM( source_word, r2varword, "SOURCE", &rsp_pling_word, input_buffer, (void*)MAX_LINE_LENGTH ) //@W +COM( rsshift_word, rsshift_cb, "2/", &rsp_pling_word, ) //@W +COM( source_word, r2varword, "SOURCE", &rsshift_word, input_buffer, (void*)MAX_LINE_LENGTH ) //@W COM( sp0_word, rvarword, "SP0", &source_word, dstack ) //@W COM( sp_at_word, rivarword, "SP@", &sp0_word, &dsp ) //@W COM( sp_pling_word, wivarword, "SP!", &sp_at_word, &dsp ) //@W @@ -1006,7 +1016,8 @@ COM( t_drop_word, t_drop_cb, "2DROP", &swap_word, ) //@W COM( t_dup_word, peekcon2_cb, "2DUP", &t_drop_word, (void*)2 ) //@W COM( t_over_word, peekcon2_cb, "2OVER", &t_dup_word, (void*)4 ) //@W COM( t_swap_word, t_swap_cb, "2SWAP", &t_over_word, ) //@W -COM( two_word, rvarword, "2", &t_swap_word, (void*)2 ) //@W +COM( tuck_word, tuck_cb, "TUCK", &t_swap_word, ) //@W +COM( two_word, rvarword, "2", &tuck_word, (void*)2 ) //@W COM( u_lt_word, u_lt_cb, "U<", &two_word, ) //@W COM( u_m_star_word, u_m_star_cb, "UM*", &u_lt_word, ) //@W COM( um_mod, um_mod_cb, "UM/MOD", &u_m_star_word, ) //@W @@ -1032,10 +1043,34 @@ COM( cells_word, codeword, "CELLS", &_5c__word, (void*)&cell_word, (void*)&mul_w // CELL + COM( cell_2b__word, codeword, "CELL+", &cells_word, (void*)&cell_word, (void*)&add_word, (void*)&exit_word ) +//@C CHAR+ +// 1+ +COM( char_2b__word, codeword, "CHAR+", &cell_2b__word, (void*)&add_one_word, (void*)&exit_word ) + +//@C CHARS +// \ nop! +COM( chars_word, codeword, "CHARS", &char_2b__word, (void*)&exit_word ) + +//@C ALIGNED +// \ addr -- aligned-addr +// DUP \ -- end-r-addr end-r-addr +// CELL SWAP - +// CELL 1- AND \ -- end-r-addr offset +// + \ -- aligned-end-r-addr +COM( aligned_word, codeword, "ALIGNED", &chars_word, (void*)&dup_word, (void*)&cell_word, (void*)&swap_word, (void*)&sub_word, (void*)&cell_word, (void*)&sub_one_word, (void*)&and_word, (void*)&add_word, (void*)&exit_word ) + +//@C +! +// \ n addr -- +// DUP @ \ -- n addr val +// ROT \ -- addr val n +// + \ -- addr new-val +// SWAP ! +COM( _2b__21__word, codeword, "+!", &aligned_word, (void*)&dup_word, (void*)&at_word, (void*)&rot_word, (void*)&add_word, (void*)&swap_word, (void*)&pling_word, (void*)&exit_word ) + //@C , // HERE ! // CELL ALLOT -COM( _2c__word, codeword, ",", &cell_2b__word, (void*)&here_word, (void*)&pling_word, (void*)&cell_word, (void*)&allot_word, (void*)&exit_word ) +COM( _2c__word, codeword, ",", &_2b__21__word, (void*)&here_word, (void*)&pling_word, (void*)&cell_word, (void*)&allot_word, (void*)&exit_word ) //@C C, // HERE C! @@ -1508,17 +1543,14 @@ COM( depth_word, codeword, "DEPTH", &_2a__2f_mod_word, (void*)&sp_at_word, (void // DUP C@ + 1+ \ -- r-addr end-r-addr // // \ Align it! -// DUP \ -- r-addr end-r-addr end-r-addr -// CELL SWAP - -// CELL 1- AND \ -- r-addr end-r-addr offset -// + \ -- r-addr aligned-end-r-addr +// ALIGNED // // \ Store it back as the return address. // >R // // \ ...and decode the counted string. // COUNT -COM( s_22_helper_word, codeword, "", &depth_word, (void*)&r_arrow_word, (void*)&dup_word, (void*)&dup_word, (void*)&c_at_word, (void*)&add_word, (void*)&add_one_word, (void*)&dup_word, (void*)&cell_word, (void*)&swap_word, (void*)&sub_word, (void*)&cell_word, (void*)&sub_one_word, (void*)&and_word, (void*)&add_word, (void*)&arrow_r_word, (void*)&count_word, (void*)&exit_word ) +COM( s_22_helper_word, codeword, "", &depth_word, (void*)&r_arrow_word, (void*)&dup_word, (void*)&dup_word, (void*)&c_at_word, (void*)&add_word, (void*)&add_one_word, (void*)&aligned_word, (void*)&arrow_r_word, (void*)&count_word, (void*)&exit_word ) //@C S" IMMEDIATE // \ -- addr count @@ -1643,8 +1675,22 @@ COM( _2e_s_word, codeword, ".S", &u_2e__word, (void*)&sp_at_word, (void*)&sp0_wo // [&lit_word] [&lit_word] , , IMM( literal_word, codeword, "LITERAL", &_2e_s_word, (void*)(&lit_word), (void*)(&lit_word), (void*)&_2c__word, (void*)&_2c__word, (void*)&exit_word ) -static cdefn_t* last = (defn_t*) &literal_word; //@E -static defn_t* latest = (defn_t*) &literal_word; //@E +//@C 2@ +// \ addr -- lo hi +// DUP @ \ addr lo +// SWAP \ lo addr +// CELL+ @ \ lo hi +COM( _32__40__word, codeword, "2@", &literal_word, (void*)&dup_word, (void*)&at_word, (void*)&swap_word, (void*)&cell_2b__word, (void*)&at_word, (void*)&exit_word ) + +//@C 2! +// \ lo hi addr -- +// TUCK \ lo addr hi addr +// CELL+ \ lo addr hi addr+C +// ! ! +COM( _32__21__word, codeword, "2!", &_32__40__word, (void*)&tuck_word, (void*)&cell_2b__word, (void*)&pling_word, (void*)&pling_word, (void*)&exit_word ) + +static cdefn_t* last = (defn_t*) &_32__21__word; //@E +static defn_t* latest = (defn_t*) &_32__21__word; //@E int main(int argc, const char* argv[]) { -- 2.34.1