From 67d25d837ac55f28a366c0a3b262e439a6e75fc3 Mon Sep 17 00:00:00 2001 From: Dimitri Sokolyuk Date: Sat, 19 Aug 2017 12:15:28 +0200 Subject: Add AmForth --- amforth-6.5/avr8/words/1minus.asm | 13 ++ amforth-6.5/avr8/words/1ms.asm | 13 ++ amforth-6.5/avr8/words/1plus.asm | 13 ++ amforth-6.5/avr8/words/2r_fetch.asm | 23 ++++ amforth-6.5/avr8/words/2r_from.asm | 19 +++ amforth-6.5/avr8/words/2slash.asm | 14 +++ amforth-6.5/avr8/words/2spirw.asm | 19 +++ amforth-6.5/avr8/words/2star.asm | 14 +++ amforth-6.5/avr8/words/2to_r.asm | 19 +++ amforth-6.5/avr8/words/allot.asm | 16 +++ amforth-6.5/avr8/words/and.asm | 16 +++ amforth-6.5/avr8/words/bm-clear.asm | 19 +++ amforth-6.5/avr8/words/bm-set.asm | 18 +++ amforth-6.5/avr8/words/bm-toggle.asm | 18 +++ amforth-6.5/avr8/words/byteswap.asm | 15 +++ amforth-6.5/avr8/words/cas.asm | 28 +++++ amforth-6.5/avr8/words/cellplus.asm | 13 ++ amforth-6.5/avr8/words/cells.asm | 10 ++ amforth-6.5/avr8/words/cfetch.asm | 15 +++ amforth-6.5/avr8/words/cmove.asm | 30 +++++ amforth-6.5/avr8/words/cmove_g.asm | 34 ++++++ amforth-6.5/avr8/words/code.asm | 17 +++ amforth-6.5/avr8/words/cold.asm | 52 ++++++++ amforth-6.5/avr8/words/colon-noname.asm | 21 ++++ amforth-6.5/avr8/words/comma.asm | 18 +++ amforth-6.5/avr8/words/compare.asm | 47 ++++++++ amforth-6.5/avr8/words/const-fold-depth.asm | 18 +++ amforth-6.5/avr8/words/cstore.asm | 16 +++ amforth-6.5/avr8/words/d-2slash.asm | 20 ++++ amforth-6.5/avr8/words/d-2star.asm | 20 ++++ amforth-6.5/avr8/words/d-greaterzero.asm | 19 +++ amforth-6.5/avr8/words/d-invert.asm | 20 ++++ amforth-6.5/avr8/words/d-lesszero.asm | 15 +++ amforth-6.5/avr8/words/d-minus.asm | 28 +++++ amforth-6.5/avr8/words/d-plus.asm | 27 +++++ amforth-6.5/avr8/words/dabs.asm | 19 +++ amforth-6.5/avr8/words/dnegate.asm | 17 +++ amforth-6.5/avr8/words/do-defer.asm | 27 +++++ amforth-6.5/avr8/words/do-sliteral.asm | 21 ++++ amforth-6.5/avr8/words/do-value.asm | 25 ++++ amforth-6.5/avr8/words/dobranch.asm | 14 +++ amforth-6.5/avr8/words/docondbranch.asm | 16 +++ amforth-6.5/avr8/words/doconstant.asm | 15 +++ amforth-6.5/avr8/words/dodo.asm | 25 ++++ amforth-6.5/avr8/words/does.asm | 53 ++++++++ amforth-6.5/avr8/words/doliteral.asm | 17 +++ amforth-6.5/avr8/words/doloop.asm | 16 +++ amforth-6.5/avr8/words/doplusloop.asm | 28 +++++ amforth-6.5/avr8/words/douser.asm | 18 +++ amforth-6.5/avr8/words/dovariable.asm | 16 +++ amforth-6.5/avr8/words/dp.asm | 14 +++ amforth-6.5/avr8/words/drop.asm | 13 ++ amforth-6.5/avr8/words/dup.asm | 13 ++ amforth-6.5/avr8/words/edefer-fetch.asm | 14 +++ amforth-6.5/avr8/words/edefer-store.asm | 14 +++ amforth-6.5/avr8/words/ehere.asm | 14 +++ amforth-6.5/avr8/words/end-code.asm | 16 +++ amforth-6.5/avr8/words/env-mcuinfo.asm | 14 +++ amforth-6.5/avr8/words/env-slashpad.asm | 15 +++ amforth-6.5/avr8/words/env-wordlists.asm | 14 +++ amforth-6.5/avr8/words/environment.asm | 12 ++ amforth-6.5/avr8/words/equal.asm | 14 +++ amforth-6.5/avr8/words/equalzero.asm | 14 +++ amforth-6.5/avr8/words/execute.asm | 14 +++ amforth-6.5/avr8/words/exit.asm | 14 +++ amforth-6.5/avr8/words/fetch-e.asm | 51 ++++++++ amforth-6.5/avr8/words/fetch-i.asm | 14 +++ amforth-6.5/avr8/words/fetch-u.asm | 15 +++ amforth-6.5/avr8/words/fetch.asm | 33 +++++ amforth-6.5/avr8/words/fill.asm | 26 ++++ amforth-6.5/avr8/words/forth-recognizer.asm | 14 +++ amforth-6.5/avr8/words/forth-wordlist.asm | 12 ++ amforth-6.5/avr8/words/g-mark.asm | 16 +++ amforth-6.5/avr8/words/g-resolve.asm | 16 +++ amforth-6.5/avr8/words/get-current.asm | 15 +++ amforth-6.5/avr8/words/greater.asm | 19 +++ amforth-6.5/avr8/words/greaterzero.asm | 16 +++ amforth-6.5/avr8/words/header.asm | 36 ++++++ amforth-6.5/avr8/words/here.asm | 14 +++ amforth-6.5/avr8/words/hld.asm | 16 +++ amforth-6.5/avr8/words/i-cellplus.asm | 13 ++ amforth-6.5/avr8/words/i.asm | 23 ++++ amforth-6.5/avr8/words/icompare.asm | 103 ++++++++++++++++ amforth-6.5/avr8/words/icount.asm | 16 +++ amforth-6.5/avr8/words/immediate-q.asm | 23 ++++ amforth-6.5/avr8/words/immediate.asm | 21 ++++ amforth-6.5/avr8/words/init-ram.asm | 48 ++++++++ amforth-6.5/avr8/words/int-fetch.asm | 16 +++ amforth-6.5/avr8/words/int-num.asm | 12 ++ amforth-6.5/avr8/words/int-off.asm | 13 ++ amforth-6.5/avr8/words/int-on.asm | 13 ++ amforth-6.5/avr8/words/int-store.asm | 16 +++ amforth-6.5/avr8/words/int-trap.asm | 14 +++ amforth-6.5/avr8/words/invert.asm | 14 +++ amforth-6.5/avr8/words/irqcnt.asm | 15 +++ amforth-6.5/avr8/words/isr-end.asm | 15 +++ amforth-6.5/avr8/words/isr-exec.asm | 15 +++ amforth-6.5/avr8/words/itype.asm | 74 ++++++++++++ amforth-6.5/avr8/words/j.asm | 23 ++++ amforth-6.5/avr8/words/l_mark.asm | 13 ++ amforth-6.5/avr8/words/l_resolve.asm | 14 +++ amforth-6.5/avr8/words/latest.asm | 16 +++ amforth-6.5/avr8/words/less.asm | 18 +++ amforth-6.5/avr8/words/lesszero.asm | 14 +++ amforth-6.5/avr8/words/log2.asm | 26 ++++ amforth-6.5/avr8/words/lp.asm | 17 +++ amforth-6.5/avr8/words/lp0.asm | 14 +++ amforth-6.5/avr8/words/lshift.asm | 22 ++++ amforth-6.5/avr8/words/marker.asm | 14 +++ amforth-6.5/avr8/words/minus.asm | 17 +++ amforth-6.5/avr8/words/mplus.asm | 14 +++ amforth-6.5/avr8/words/mstar.asm | 37 ++++++ amforth-6.5/avr8/words/n-spi.asm | 55 +++++++++ amforth-6.5/avr8/words/n_r_from.asm | 23 ++++ amforth-6.5/avr8/words/n_to_r.asm | 23 ++++ amforth-6.5/avr8/words/name2flags.asm | 16 +++ amforth-6.5/avr8/words/negate.asm | 14 +++ amforth-6.5/avr8/words/newest.asm | 16 +++ amforth-6.5/avr8/words/nfa2cfa.asm | 14 +++ amforth-6.5/avr8/words/nfa2lfa.asm | 16 +++ amforth-6.5/avr8/words/nip.asm | 13 ++ amforth-6.5/avr8/words/not.asm | 13 ++ amforth-6.5/avr8/words/notequalzero.asm | 14 +++ amforth-6.5/avr8/words/or.asm | 17 +++ amforth-6.5/avr8/words/over.asm | 16 +++ amforth-6.5/avr8/words/pause.asm | 18 +++ amforth-6.5/avr8/words/plus.asm | 16 +++ amforth-6.5/avr8/words/plusstore.asm | 21 ++++ amforth-6.5/avr8/words/popcnt.asm | 29 +++++ amforth-6.5/avr8/words/qdup.asm | 17 +++ amforth-6.5/avr8/words/r_fetch.asm | 17 +++ amforth-6.5/avr8/words/r_from.asm | 15 +++ amforth-6.5/avr8/words/reg-a.asm | 180 ++++++++++++++++++++++++++++ amforth-6.5/avr8/words/reg-b.asm | 180 ++++++++++++++++++++++++++++ amforth-6.5/avr8/words/rot.asm | 22 ++++ amforth-6.5/avr8/words/rp0.asm | 27 +++++ amforth-6.5/avr8/words/rpfetch.asm | 15 +++ amforth-6.5/avr8/words/rpstore.asm | 18 +++ amforth-6.5/avr8/words/rshift.asm | 22 ++++ amforth-6.5/avr8/words/scomma.asm | 56 +++++++++ amforth-6.5/avr8/words/set-current.asm | 15 +++ amforth-6.5/avr8/words/slashmod.asm | 66 ++++++++++ amforth-6.5/avr8/words/sp0.asm | 27 +++++ amforth-6.5/avr8/words/spfetch.asm | 14 +++ amforth-6.5/avr8/words/spirw.asm | 26 ++++ amforth-6.5/avr8/words/spstore.asm | 14 +++ amforth-6.5/avr8/words/state.asm | 16 +++ amforth-6.5/avr8/words/store-e.asm | 66 ++++++++++ amforth-6.5/avr8/words/store-i.asm | 14 +++ amforth-6.5/avr8/words/store-i_big.asm | 129 ++++++++++++++++++++ amforth-6.5/avr8/words/store-i_nrww.asm | 123 +++++++++++++++++++ amforth-6.5/avr8/words/store-u.asm | 15 +++ amforth-6.5/avr8/words/store.asm | 35 ++++++ amforth-6.5/avr8/words/swap.asm | 16 +++ amforth-6.5/avr8/words/to-body.asm | 10 ++ amforth-6.5/avr8/words/to_r.asm | 15 +++ amforth-6.5/avr8/words/true.asm | 16 +++ amforth-6.5/avr8/words/turnkey.asm | 14 +++ amforth-6.5/avr8/words/ubrr.asm | 14 +++ amforth-6.5/avr8/words/uless.asm | 18 +++ amforth-6.5/avr8/words/umslashmod.asm | 62 ++++++++++ amforth-6.5/avr8/words/umstar.asm | 37 ++++++ amforth-6.5/avr8/words/unloop.asm | 16 +++ amforth-6.5/avr8/words/unused.asm | 15 +++ amforth-6.5/avr8/words/up.asm | 29 +++++ amforth-6.5/avr8/words/usart-rx-poll.asm | 42 +++++++ amforth-6.5/avr8/words/usart-tx-poll.asm | 40 +++++++ amforth-6.5/avr8/words/usart.asm | 41 +++++++ amforth-6.5/avr8/words/user.asm | 18 +++ amforth-6.5/avr8/words/uslashmod.asm | 16 +++ amforth-6.5/avr8/words/wdr.asm | 13 ++ amforth-6.5/avr8/words/wlscope.asm | 22 ++++ amforth-6.5/avr8/words/wordlist.asm | 20 ++++ amforth-6.5/avr8/words/xor.asm | 16 +++ amforth-6.5/avr8/words/zero.asm | 15 +++ 175 files changed, 4257 insertions(+) create mode 100644 amforth-6.5/avr8/words/1minus.asm create mode 100644 amforth-6.5/avr8/words/1ms.asm create mode 100644 amforth-6.5/avr8/words/1plus.asm create mode 100644 amforth-6.5/avr8/words/2r_fetch.asm create mode 100644 amforth-6.5/avr8/words/2r_from.asm create mode 100644 amforth-6.5/avr8/words/2slash.asm create mode 100644 amforth-6.5/avr8/words/2spirw.asm create mode 100644 amforth-6.5/avr8/words/2star.asm create mode 100644 amforth-6.5/avr8/words/2to_r.asm create mode 100644 amforth-6.5/avr8/words/allot.asm create mode 100644 amforth-6.5/avr8/words/and.asm create mode 100644 amforth-6.5/avr8/words/bm-clear.asm create mode 100644 amforth-6.5/avr8/words/bm-set.asm create mode 100644 amforth-6.5/avr8/words/bm-toggle.asm create mode 100644 amforth-6.5/avr8/words/byteswap.asm create mode 100644 amforth-6.5/avr8/words/cas.asm create mode 100644 amforth-6.5/avr8/words/cellplus.asm create mode 100644 amforth-6.5/avr8/words/cells.asm create mode 100644 amforth-6.5/avr8/words/cfetch.asm create mode 100644 amforth-6.5/avr8/words/cmove.asm create mode 100644 amforth-6.5/avr8/words/cmove_g.asm create mode 100644 amforth-6.5/avr8/words/code.asm create mode 100644 amforth-6.5/avr8/words/cold.asm create mode 100644 amforth-6.5/avr8/words/colon-noname.asm create mode 100644 amforth-6.5/avr8/words/comma.asm create mode 100644 amforth-6.5/avr8/words/compare.asm create mode 100644 amforth-6.5/avr8/words/const-fold-depth.asm create mode 100644 amforth-6.5/avr8/words/cstore.asm create mode 100644 amforth-6.5/avr8/words/d-2slash.asm create mode 100644 amforth-6.5/avr8/words/d-2star.asm create mode 100644 amforth-6.5/avr8/words/d-greaterzero.asm create mode 100644 amforth-6.5/avr8/words/d-invert.asm create mode 100644 amforth-6.5/avr8/words/d-lesszero.asm create mode 100644 amforth-6.5/avr8/words/d-minus.asm create mode 100644 amforth-6.5/avr8/words/d-plus.asm create mode 100644 amforth-6.5/avr8/words/dabs.asm create mode 100644 amforth-6.5/avr8/words/dnegate.asm create mode 100644 amforth-6.5/avr8/words/do-defer.asm create mode 100644 amforth-6.5/avr8/words/do-sliteral.asm create mode 100644 amforth-6.5/avr8/words/do-value.asm create mode 100644 amforth-6.5/avr8/words/dobranch.asm create mode 100644 amforth-6.5/avr8/words/docondbranch.asm create mode 100644 amforth-6.5/avr8/words/doconstant.asm create mode 100644 amforth-6.5/avr8/words/dodo.asm create mode 100644 amforth-6.5/avr8/words/does.asm create mode 100644 amforth-6.5/avr8/words/doliteral.asm create mode 100644 amforth-6.5/avr8/words/doloop.asm create mode 100644 amforth-6.5/avr8/words/doplusloop.asm create mode 100644 amforth-6.5/avr8/words/douser.asm create mode 100644 amforth-6.5/avr8/words/dovariable.asm create mode 100644 amforth-6.5/avr8/words/dp.asm create mode 100644 amforth-6.5/avr8/words/drop.asm create mode 100644 amforth-6.5/avr8/words/dup.asm create mode 100644 amforth-6.5/avr8/words/edefer-fetch.asm create mode 100644 amforth-6.5/avr8/words/edefer-store.asm create mode 100644 amforth-6.5/avr8/words/ehere.asm create mode 100644 amforth-6.5/avr8/words/end-code.asm create mode 100644 amforth-6.5/avr8/words/env-mcuinfo.asm create mode 100644 amforth-6.5/avr8/words/env-slashpad.asm create mode 100644 amforth-6.5/avr8/words/env-wordlists.asm create mode 100644 amforth-6.5/avr8/words/environment.asm create mode 100644 amforth-6.5/avr8/words/equal.asm create mode 100644 amforth-6.5/avr8/words/equalzero.asm create mode 100644 amforth-6.5/avr8/words/execute.asm create mode 100644 amforth-6.5/avr8/words/exit.asm create mode 100644 amforth-6.5/avr8/words/fetch-e.asm create mode 100644 amforth-6.5/avr8/words/fetch-i.asm create mode 100644 amforth-6.5/avr8/words/fetch-u.asm create mode 100644 amforth-6.5/avr8/words/fetch.asm create mode 100644 amforth-6.5/avr8/words/fill.asm create mode 100644 amforth-6.5/avr8/words/forth-recognizer.asm create mode 100644 amforth-6.5/avr8/words/forth-wordlist.asm create mode 100644 amforth-6.5/avr8/words/g-mark.asm create mode 100644 amforth-6.5/avr8/words/g-resolve.asm create mode 100644 amforth-6.5/avr8/words/get-current.asm create mode 100644 amforth-6.5/avr8/words/greater.asm create mode 100644 amforth-6.5/avr8/words/greaterzero.asm create mode 100644 amforth-6.5/avr8/words/header.asm create mode 100644 amforth-6.5/avr8/words/here.asm create mode 100644 amforth-6.5/avr8/words/hld.asm create mode 100644 amforth-6.5/avr8/words/i-cellplus.asm create mode 100644 amforth-6.5/avr8/words/i.asm create mode 100644 amforth-6.5/avr8/words/icompare.asm create mode 100644 amforth-6.5/avr8/words/icount.asm create mode 100644 amforth-6.5/avr8/words/immediate-q.asm create mode 100644 amforth-6.5/avr8/words/immediate.asm create mode 100644 amforth-6.5/avr8/words/init-ram.asm create mode 100644 amforth-6.5/avr8/words/int-fetch.asm create mode 100644 amforth-6.5/avr8/words/int-num.asm create mode 100644 amforth-6.5/avr8/words/int-off.asm create mode 100644 amforth-6.5/avr8/words/int-on.asm create mode 100644 amforth-6.5/avr8/words/int-store.asm create mode 100644 amforth-6.5/avr8/words/int-trap.asm create mode 100644 amforth-6.5/avr8/words/invert.asm create mode 100644 amforth-6.5/avr8/words/irqcnt.asm create mode 100644 amforth-6.5/avr8/words/isr-end.asm create mode 100644 amforth-6.5/avr8/words/isr-exec.asm create mode 100644 amforth-6.5/avr8/words/itype.asm create mode 100644 amforth-6.5/avr8/words/j.asm create mode 100644 amforth-6.5/avr8/words/l_mark.asm create mode 100644 amforth-6.5/avr8/words/l_resolve.asm create mode 100644 amforth-6.5/avr8/words/latest.asm create mode 100644 amforth-6.5/avr8/words/less.asm create mode 100644 amforth-6.5/avr8/words/lesszero.asm create mode 100644 amforth-6.5/avr8/words/log2.asm create mode 100644 amforth-6.5/avr8/words/lp.asm create mode 100644 amforth-6.5/avr8/words/lp0.asm create mode 100644 amforth-6.5/avr8/words/lshift.asm create mode 100644 amforth-6.5/avr8/words/marker.asm create mode 100644 amforth-6.5/avr8/words/minus.asm create mode 100644 amforth-6.5/avr8/words/mplus.asm create mode 100644 amforth-6.5/avr8/words/mstar.asm create mode 100644 amforth-6.5/avr8/words/n-spi.asm create mode 100644 amforth-6.5/avr8/words/n_r_from.asm create mode 100644 amforth-6.5/avr8/words/n_to_r.asm create mode 100644 amforth-6.5/avr8/words/name2flags.asm create mode 100644 amforth-6.5/avr8/words/negate.asm create mode 100644 amforth-6.5/avr8/words/newest.asm create mode 100644 amforth-6.5/avr8/words/nfa2cfa.asm create mode 100644 amforth-6.5/avr8/words/nfa2lfa.asm create mode 100644 amforth-6.5/avr8/words/nip.asm create mode 100644 amforth-6.5/avr8/words/not.asm create mode 100644 amforth-6.5/avr8/words/notequalzero.asm create mode 100644 amforth-6.5/avr8/words/or.asm create mode 100644 amforth-6.5/avr8/words/over.asm create mode 100644 amforth-6.5/avr8/words/pause.asm create mode 100644 amforth-6.5/avr8/words/plus.asm create mode 100644 amforth-6.5/avr8/words/plusstore.asm create mode 100644 amforth-6.5/avr8/words/popcnt.asm create mode 100644 amforth-6.5/avr8/words/qdup.asm create mode 100644 amforth-6.5/avr8/words/r_fetch.asm create mode 100644 amforth-6.5/avr8/words/r_from.asm create mode 100644 amforth-6.5/avr8/words/reg-a.asm create mode 100644 amforth-6.5/avr8/words/reg-b.asm create mode 100644 amforth-6.5/avr8/words/rot.asm create mode 100644 amforth-6.5/avr8/words/rp0.asm create mode 100644 amforth-6.5/avr8/words/rpfetch.asm create mode 100644 amforth-6.5/avr8/words/rpstore.asm create mode 100644 amforth-6.5/avr8/words/rshift.asm create mode 100644 amforth-6.5/avr8/words/scomma.asm create mode 100644 amforth-6.5/avr8/words/set-current.asm create mode 100644 amforth-6.5/avr8/words/slashmod.asm create mode 100644 amforth-6.5/avr8/words/sp0.asm create mode 100644 amforth-6.5/avr8/words/spfetch.asm create mode 100644 amforth-6.5/avr8/words/spirw.asm create mode 100644 amforth-6.5/avr8/words/spstore.asm create mode 100644 amforth-6.5/avr8/words/state.asm create mode 100644 amforth-6.5/avr8/words/store-e.asm create mode 100644 amforth-6.5/avr8/words/store-i.asm create mode 100644 amforth-6.5/avr8/words/store-i_big.asm create mode 100644 amforth-6.5/avr8/words/store-i_nrww.asm create mode 100644 amforth-6.5/avr8/words/store-u.asm create mode 100644 amforth-6.5/avr8/words/store.asm create mode 100644 amforth-6.5/avr8/words/swap.asm create mode 100644 amforth-6.5/avr8/words/to-body.asm create mode 100644 amforth-6.5/avr8/words/to_r.asm create mode 100644 amforth-6.5/avr8/words/true.asm create mode 100644 amforth-6.5/avr8/words/turnkey.asm create mode 100644 amforth-6.5/avr8/words/ubrr.asm create mode 100644 amforth-6.5/avr8/words/uless.asm create mode 100644 amforth-6.5/avr8/words/umslashmod.asm create mode 100644 amforth-6.5/avr8/words/umstar.asm create mode 100644 amforth-6.5/avr8/words/unloop.asm create mode 100644 amforth-6.5/avr8/words/unused.asm create mode 100644 amforth-6.5/avr8/words/up.asm create mode 100644 amforth-6.5/avr8/words/usart-rx-poll.asm create mode 100644 amforth-6.5/avr8/words/usart-tx-poll.asm create mode 100644 amforth-6.5/avr8/words/usart.asm create mode 100644 amforth-6.5/avr8/words/user.asm create mode 100644 amforth-6.5/avr8/words/uslashmod.asm create mode 100644 amforth-6.5/avr8/words/wdr.asm create mode 100644 amforth-6.5/avr8/words/wlscope.asm create mode 100644 amforth-6.5/avr8/words/wordlist.asm create mode 100644 amforth-6.5/avr8/words/xor.asm create mode 100644 amforth-6.5/avr8/words/zero.asm (limited to 'amforth-6.5/avr8/words') diff --git a/amforth-6.5/avr8/words/1minus.asm b/amforth-6.5/avr8/words/1minus.asm new file mode 100644 index 0000000..ca70fed --- /dev/null +++ b/amforth-6.5/avr8/words/1minus.asm @@ -0,0 +1,13 @@ +; (S: n1 -- n2 ) +; Arithmetics +; optimized decrement +VE_1MINUS: + .dw $ff02 + .db "1-" + .dw VE_HEAD + .set VE_HEAD = VE_1MINUS +XT_1MINUS: + .dw PFA_1MINUS +PFA_1MINUS: + sbiw tosl, 1 + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/1ms.asm b/amforth-6.5/avr8/words/1ms.asm new file mode 100644 index 0000000..f23951d --- /dev/null +++ b/amforth-6.5/avr8/words/1ms.asm @@ -0,0 +1,13 @@ +; ( -- ) +; Time +; busy waits (almost) exactly 1 millisecond +VE_1MS: + .dw $ff03 + .db "1ms",0 + .dw VE_HEAD + .set VE_HEAD = VE_1MS +XT_1MS: + .dw PFA_1MS +PFA_1MS: + delay 1000 + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/1plus.asm b/amforth-6.5/avr8/words/1plus.asm new file mode 100644 index 0000000..ffaaec2 --- /dev/null +++ b/amforth-6.5/avr8/words/1plus.asm @@ -0,0 +1,13 @@ +; ( n1|u1 -- n2|u2 ) +; Arithmetics +; optimized increment +VE_1PLUS: + .dw $ff02 + .db "1+" + .dw VE_HEAD + .set VE_HEAD = VE_1PLUS +XT_1PLUS: + .dw PFA_1PLUS +PFA_1PLUS: + adiw tosl,1 + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/2r_fetch.asm b/amforth-6.5/avr8/words/2r_fetch.asm new file mode 100644 index 0000000..8d0060b --- /dev/null +++ b/amforth-6.5/avr8/words/2r_fetch.asm @@ -0,0 +1,23 @@ +; ( -- d) (R: d -- d ) +; Stack +; fetch content of TOR +VE_2R_FETCH: + .dw $ff03 + .db "2r@",0 + .dw VE_HEAD + .set VE_HEAD = VE_2R_FETCH +XT_2R_FETCH: + .dw PFA_2R_FETCH +PFA_2R_FETCH: + savetos + pop zl + pop zh + pop tosl + pop tosh + push tosh + push tosl + push zh + push zl + savetos + movw tosl, zl + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/2r_from.asm b/amforth-6.5/avr8/words/2r_from.asm new file mode 100644 index 0000000..ffb5a34 --- /dev/null +++ b/amforth-6.5/avr8/words/2r_from.asm @@ -0,0 +1,19 @@ +; ( -- x1 x2 ) (R: x1 x2 --) +; Stack +; move DTOR to TOS +VE_2R_FROM: + .dw $ff03 + .db "2r>",0 + .dw VE_HEAD + .set VE_HEAD = VE_2R_FROM +XT_2R_FROM: + .dw PFA_2R_FROM +PFA_2R_FROM: + savetos + pop zl + pop zh + pop tosl + pop tosh + savetos + movw tosl, zl + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/2slash.asm b/amforth-6.5/avr8/words/2slash.asm new file mode 100644 index 0000000..5d4ada2 --- /dev/null +++ b/amforth-6.5/avr8/words/2slash.asm @@ -0,0 +1,14 @@ +; ( n1 -- n2 ) +; Arithmetics +; arithmetic shift right +VE_2SLASH: + .dw $ff02 + .db "2/" + .dw VE_HEAD + .set VE_HEAD = VE_2SLASH +XT_2SLASH: + .dw PFA_2SLASH +PFA_2SLASH: + asr tosh + ror tosl + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/2spirw.asm b/amforth-6.5/avr8/words/2spirw.asm new file mode 100644 index 0000000..a7064da --- /dev/null +++ b/amforth-6.5/avr8/words/2spirw.asm @@ -0,0 +1,19 @@ +; ( n1 -- n2 ) +; MCU +; SPI exchange of 2 bytes, high byte first +VE_2SPIRW: + .dw $ff05 + .db "!@spi",0 + .dw VE_HEAD + .set VE_HEAD = VE_2SPIRW +XT_2SPIRW: + .dw PFA_2SPIRW +PFA_2SPIRW: + push tosl + mov tosl, tosh + call_ do_spirw + mov tosh, tosl + pop tosl + call_ do_spirw + jmp_ DO_NEXT + diff --git a/amforth-6.5/avr8/words/2star.asm b/amforth-6.5/avr8/words/2star.asm new file mode 100644 index 0000000..ef307e3 --- /dev/null +++ b/amforth-6.5/avr8/words/2star.asm @@ -0,0 +1,14 @@ +; ( n1 -- n2 ) +; Arithmetics +; arithmetic shift left, filling with zero +VE_2STAR: + .dw $ff02 + .db "2*" + .dw VE_HEAD + .set VE_HEAD = VE_2STAR +XT_2STAR: + .dw PFA_2STAR +PFA_2STAR: + lsl tosl + rol tosh + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/2to_r.asm b/amforth-6.5/avr8/words/2to_r.asm new file mode 100644 index 0000000..0e70f18 --- /dev/null +++ b/amforth-6.5/avr8/words/2to_r.asm @@ -0,0 +1,19 @@ +; ( x1 x2 -- ) (R: -- x1 x2) +; Stack +; move DTOS to TOR +VE_2TO_R: + .dw $ff03 + .db "2>r",0 + .dw VE_HEAD + .set VE_HEAD = VE_2TO_R +XT_2TO_R: + .dw PFA_2TO_R +PFA_2TO_R: + movw zl, tosl + loadtos + push tosh + push tosl + push zh + push zl + loadtos + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/allot.asm b/amforth-6.5/avr8/words/allot.asm new file mode 100644 index 0000000..0356fa4 --- /dev/null +++ b/amforth-6.5/avr8/words/allot.asm @@ -0,0 +1,16 @@ +; ( n -- ) +; System +; allocate or release memory in RAM +VE_ALLOT: + .dw $ff05 + .db "allot",0 + .dw VE_HEAD + .set VE_HEAD = VE_ALLOT +XT_ALLOT: + .dw DO_COLON +PFA_ALLOT: + .dw XT_HERE + .dw XT_PLUS + .dw XT_DOTO + .dw PFA_HERE + .dw XT_EXIT diff --git a/amforth-6.5/avr8/words/and.asm b/amforth-6.5/avr8/words/and.asm new file mode 100644 index 0000000..ed31668 --- /dev/null +++ b/amforth-6.5/avr8/words/and.asm @@ -0,0 +1,16 @@ +; ( n1 n2 -- n3 ) +; Logic +; bitwise and +VE_AND: + .dw $ff03 + .db "and",0 + .dw VE_HEAD + .set VE_HEAD = VE_AND +XT_AND: + .dw PFA_AND +PFA_AND: + ld temp0, Y+ + ld temp1, Y+ + and tosl, temp0 + and tosh, temp1 + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/bm-clear.asm b/amforth-6.5/avr8/words/bm-clear.asm new file mode 100644 index 0000000..6c47517 --- /dev/null +++ b/amforth-6.5/avr8/words/bm-clear.asm @@ -0,0 +1,19 @@ +; ( bitmask byte-addr -- ) +; MCU +; clear bits set in bitmask on byte at addr +VE_BM_CLEAR: + .dw $ff08 + .db "bm-clear" + .dw VE_HEAD + .set VE_HEAD = VE_BM_CLEAR +XT_BM_CLEAR: + .dw PFA_BM_CLEAR +PFA_BM_CLEAR: + movw zl, tosl + loadtos + com tosl + ld temp0, Z + and temp0, tosl + st Z, temp0 + loadtos + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/bm-set.asm b/amforth-6.5/avr8/words/bm-set.asm new file mode 100644 index 0000000..1ba5faa --- /dev/null +++ b/amforth-6.5/avr8/words/bm-set.asm @@ -0,0 +1,18 @@ +; ( bitmask byte-addr -- ) +; MCU +; set bits from bitmask on byte at addr +VE_BM_SET: + .dw $ff06 + .db "bm-set" + .dw VE_HEAD + .set VE_HEAD = VE_BM_SET +XT_BM_SET: + .dw PFA_BM_SET +PFA_BM_SET: + movw zl, tosl + loadtos + ld temp0, Z + or temp0, tosl + st Z, temp0 + loadtos + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/bm-toggle.asm b/amforth-6.5/avr8/words/bm-toggle.asm new file mode 100644 index 0000000..fbbdc21 --- /dev/null +++ b/amforth-6.5/avr8/words/bm-toggle.asm @@ -0,0 +1,18 @@ +; ( bitmask byte-addr -- ) +; MCU +; toggle bits set in bitmask on byte at addr +VE_BM_TOGGLE: + .dw $ff09 + .db "bm-toggle",0 + .dw VE_HEAD + .set VE_HEAD = VE_BM_TOGGLE +XT_BM_TOGGLE: + .dw PFA_BM_TOGGLE +PFA_BM_TOGGLE: + movw zl, tosl + loadtos + ld temp0, Z + eor temp0, tosl + st Z, temp0 + loadtos + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/byteswap.asm b/amforth-6.5/avr8/words/byteswap.asm new file mode 100644 index 0000000..b49cd2f --- /dev/null +++ b/amforth-6.5/avr8/words/byteswap.asm @@ -0,0 +1,15 @@ +; ( n1 -- n2 ) +; Arithmetics +; exchange the bytes of the TOS +VE_BYTESWAP: + .dw $ff02 + .db "><" + .dw VE_HEAD + .set VE_HEAD = VE_BYTESWAP +XT_BYTESWAP: + .dw PFA_BYTESWAP +PFA_BYTESWAP: + mov temp0, tosh + mov tosh, tosl + mov tosl, temp0 + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/cas.asm b/amforth-6.5/avr8/words/cas.asm new file mode 100644 index 0000000..f59ae26 --- /dev/null +++ b/amforth-6.5/avr8/words/cas.asm @@ -0,0 +1,28 @@ +; ( new old addr -- f ) +; Multitasking +; Atomic Compare and Swap: store new at addr and set f to true if contents of addr is equal to old. +VE_CAS: + .dw $ff03 + .db "cas",0 + .dw VE_HEAD + .set VE_HEAD = VE_CAS +XT_CAS: + .dw PFA_CAS +PFA_CAS: + movw zl, tosl + loadtos + ldd temp0, Z+0 + ldd temp1, Z+1 + cp tosl, temp0 + cpc tosh, temp1 + loadtos + brne PFA_CAS1 + std Z+0, tosl + std Z+1, tosh + ser tosl + rjmp PFA_CAS2 +PFA_CAS1: + clr tosl +PFA_CAS2: + mov tosh, tosl + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/cellplus.asm b/amforth-6.5/avr8/words/cellplus.asm new file mode 100644 index 0000000..e75de15 --- /dev/null +++ b/amforth-6.5/avr8/words/cellplus.asm @@ -0,0 +1,13 @@ +; ( a-addr1 -- a-addr2 ) +; Arithmetics +; add the size of an address-unit to a-addr1 +VE_CELLPLUS: + .dw $ff05 + .db "cell+",0 + .dw VE_HEAD + .set VE_HEAD = VE_CELLPLUS +XT_CELLPLUS: + .dw PFA_CELLPLUS +PFA_CELLPLUS: + adiw tosl, CELLSIZE + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/cells.asm b/amforth-6.5/avr8/words/cells.asm new file mode 100644 index 0000000..2876c2d --- /dev/null +++ b/amforth-6.5/avr8/words/cells.asm @@ -0,0 +1,10 @@ +; ( n1 -- n2 ) +; Arithmetics +; n2 is the size in address units of n1 cells +VE_CELLS: + .dw $ff05 + .db "cells",0 + .dw VE_HEAD + .set VE_HEAD = VE_CELLS +XT_CELLS: + .dw PFA_2STAR diff --git a/amforth-6.5/avr8/words/cfetch.asm b/amforth-6.5/avr8/words/cfetch.asm new file mode 100644 index 0000000..97ff7dc --- /dev/null +++ b/amforth-6.5/avr8/words/cfetch.asm @@ -0,0 +1,15 @@ +; ( a-addr - c1 ) +; Memory +; fetch a single byte from memory mapped locations +VE_CFETCH: + .dw $ff02 + .db "c@" + .dw VE_HEAD + .set VE_HEAD = VE_CFETCH +XT_CFETCH: + .dw PFA_CFETCH +PFA_CFETCH: + movw zl, tosl + clr tosh + ld tosl, Z + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/cmove.asm b/amforth-6.5/avr8/words/cmove.asm new file mode 100644 index 0000000..f7a1134 --- /dev/null +++ b/amforth-6.5/avr8/words/cmove.asm @@ -0,0 +1,30 @@ +; (addr-from addr-to n -- ) +; Memory +; copy data in RAM, from lower to higher addresses +VE_CMOVE: + .dw $ff05 + .db "cmove",0 + .dw VE_HEAD + .set VE_HEAD = VE_CMOVE +XT_CMOVE: + .dw PFA_CMOVE +PFA_CMOVE: + push xh + push xl + ld zl, Y+ + ld zh, Y+ ; addr-to + ld xl, Y+ + ld xh, Y+ ; addr-from + mov temp0, tosh + or temp0, tosl + brbs 1, PFA_CMOVE1 +PFA_CMOVE2: + ld temp1, X+ + st Z+, temp1 + sbiw tosl, 1 + brbc 1, PFA_CMOVE2 +PFA_CMOVE1: + pop xl + pop xh + loadtos + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/cmove_g.asm b/amforth-6.5/avr8/words/cmove_g.asm new file mode 100644 index 0000000..3bcbb4e --- /dev/null +++ b/amforth-6.5/avr8/words/cmove_g.asm @@ -0,0 +1,34 @@ +; (addr-from addr-to n -- ) +; Memory +; copy data in RAM from higher to lower addresses. +VE_CMOVE_G: + .dw $ff06 + .db "cmove>" + .dw VE_HEAD + .set VE_HEAD = VE_CMOVE_G +XT_CMOVE_G: + .dw PFA_CMOVE_G +PFA_CMOVE_G: + push xh + push xl + ld zl, Y+ + ld zh, Y+ ; addr-to + ld xl, Y+ + ld xh, Y+ ; addr-from + mov temp0, tosh + or temp0, tosl + brbs 1, PFA_CMOVE_G1 + add zl, tosl + adc zh, tosh + add xl, tosl + adc xh, tosh +PFA_CMOVE_G2: + ld temp1, -X + st -Z, temp1 + sbiw tosl, 1 + brbc 1, PFA_CMOVE_G2 +PFA_CMOVE_G1: + pop xl + pop xh + loadtos + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/code.asm b/amforth-6.5/avr8/words/code.asm new file mode 100644 index 0000000..ecbb6d5 --- /dev/null +++ b/amforth-6.5/avr8/words/code.asm @@ -0,0 +1,17 @@ +; ( -- ) (C: cchar -- ) +; Compiler +; create named entry in the dictionary, XT is the data field +VE_CODE: + .dw $ff04 + .db "code" + .dw VE_HEAD + .set VE_HEAD = VE_CODE +XT_CODE: + .dw DO_COLON +PFA_CODE: + .dw XT_DOCREATE + .dw XT_REVEAL + .dw XT_DP + .dw XT_ICELLPLUS + .dw XT_COMMA + .dw XT_EXIT diff --git a/amforth-6.5/avr8/words/cold.asm b/amforth-6.5/avr8/words/cold.asm new file mode 100644 index 0000000..4547f55 --- /dev/null +++ b/amforth-6.5/avr8/words/cold.asm @@ -0,0 +1,52 @@ +; ( i*x -- ) (R: j*y -- ) +; System +; start up amforth. +VE_COLD: + .dw $ff04 + .db "cold" + .dw VE_HEAD + .set VE_HEAD = VE_COLD +XT_COLD: + .dw PFA_COLD +PFA_COLD: + in_ mcu_boot, MCUSR + clr zerol + clr zeroh + clr isrflag + out_ MCUSR, zerol + ; clear RAM + ldi zl, low(ramstart) + ldi zh, high(ramstart) +clearloop: + st Z+, zerol + cpi zl, low(sram_size+ramstart) + brne clearloop + cpi zh, high(sram_size+ramstart) + brne clearloop + ; init first user data area + ; allocate space for User Area +.dseg +ram_user1: .byte SYSUSERSIZE + APPUSERSIZE +.cseg + ldi zl, low(ram_user1) + ldi zh, high(ram_user1) + movw upl, zl + ; init return stack pointer + ldi temp0,low(rstackstart) + out_ SPL,temp0 + std Z+4, temp0 + ldi temp1,high(rstackstart) + out_ SPH,temp1 + std Z+5, temp1 + + ; init parameter stack pointer + ldi yl,low(stackstart) + std Z+6, yl + ldi yh,high(stackstart) + std Z+7, yh + + ; load Forth IP with starting word + ldi XL, low(PFA_WARM) + ldi XH, high(PFA_WARM) + ; its a far jump... + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/colon-noname.asm b/amforth-6.5/avr8/words/colon-noname.asm new file mode 100644 index 0000000..8c47fb3 --- /dev/null +++ b/amforth-6.5/avr8/words/colon-noname.asm @@ -0,0 +1,21 @@ +; ( -- xt ) +; Compiler +; create an unnamed entry in the dictionary, XT is DO_COLON +VE_COLONNONAME: + .dw $ff07 + .db ":noname",0 + .dw VE_HEAD + .set VE_HEAD = VE_COLONNONAME +XT_COLONNONAME: + .dw DO_COLON +PFA_COLONNONAME: + .dw XT_DP + .dw XT_DUP + .dw XT_LATEST + .dw XT_STORE + + .dw XT_COMPILE + .dw DO_COLON + + .dw XT_RBRACKET + .dw XT_EXIT diff --git a/amforth-6.5/avr8/words/comma.asm b/amforth-6.5/avr8/words/comma.asm new file mode 100644 index 0000000..a9a903b --- /dev/null +++ b/amforth-6.5/avr8/words/comma.asm @@ -0,0 +1,18 @@ +; ( n -- ) +; Dictionary +; compile 16 bit into flash at DP +VE_COMMA: + .dw $ff01 + .db ',',0 ; , + .dw VE_HEAD + .set VE_HEAD = VE_COMMA +XT_COMMA: + .dw DO_COLON +PFA_COMMA: + .dw XT_DP + .dw XT_STOREI + .dw XT_DP + .dw XT_1PLUS + .dw XT_DOTO + .dw PFA_DP + .dw XT_EXIT diff --git a/amforth-6.5/avr8/words/compare.asm b/amforth-6.5/avr8/words/compare.asm new file mode 100644 index 0000000..0a33f47 --- /dev/null +++ b/amforth-6.5/avr8/words/compare.asm @@ -0,0 +1,47 @@ +; ( r-addr r-len f-addr f-len -- f) +; String +; compares two strings in RAM +VE_COMPARE: + .dw $ff07 + .db "compare",0 + .dw VE_HEAD + .set VE_HEAD = VE_COMPARE +XT_COMPARE: + .dw PFA_COMPARE +PFA_COMPARE: + push xh + push xl + movw temp0, tosl + loadtos + movw xl, tosl + loadtos + movw temp2, tosl + loadtos + movw zl, tosl +PFA_COMPARE_LOOP: + ld temp4, X+ + ld temp5, Z+ + cp temp4, temp5 + brne PFA_COMPARE_NOTEQUAL + dec temp0 + breq PFA_COMPARE_ENDREACHED2 + dec temp2 + brne PFA_COMPARE_LOOP + rjmp PFA_COMPARE_ENDREACHED +PFA_COMPARE_ENDREACHED2: + dec temp2 +PFA_COMPARE_ENDREACHED: + or temp0, temp2 + brne PFA_COMPARE_CHECKLASTCHAR + clr tosl + rjmp PFA_COMPARE_DONE +PFA_COMPARE_CHECKLASTCHAR: +PFA_COMPARE_NOTEQUAL: + ser tosl + rjmp PFA_COMPARE_DONE + +PFA_COMPARE_DONE: + mov tosh, tosl + pop xl + pop xh + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/const-fold-depth.asm b/amforth-6.5/avr8/words/const-fold-depth.asm new file mode 100644 index 0000000..40b80eb --- /dev/null +++ b/amforth-6.5/avr8/words/const-fold-depth.asm @@ -0,0 +1,18 @@ +; ( flagset -- n ) +; Tools +; constant fold depth +VE_CONSTFOLDDEPTH: + .dw $ff0a + .db "cfolddepth" + .dw VE_HEAD + .set VE_HEAD = VE_CONSTFOLDDEPTH +XT_CONSTFOLDDEPTH: + .dw DO_COLON +PFA_CONSTFOLDDEPTH: + .dw XT_DOLITERAL + .dw $7000 + .dw XT_AND + .dw XT_DOLITERAL + .dw 12 + .dw XT_RSHIFT + .dw XT_EXIT diff --git a/amforth-6.5/avr8/words/cstore.asm b/amforth-6.5/avr8/words/cstore.asm new file mode 100644 index 0000000..f953f8f --- /dev/null +++ b/amforth-6.5/avr8/words/cstore.asm @@ -0,0 +1,16 @@ +; ( c a-addr -- ) +; Memory +; store a single byte to RAM address +VE_CSTORE: + .dw $ff02 + .db "c!" + .dw VE_HEAD + .set VE_HEAD = VE_CSTORE +XT_CSTORE: + .dw PFA_CSTORE +PFA_CSTORE: + movw zl, tosl + loadtos + st Z, tosl + loadtos + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/d-2slash.asm b/amforth-6.5/avr8/words/d-2slash.asm new file mode 100644 index 0000000..e9a67ea --- /dev/null +++ b/amforth-6.5/avr8/words/d-2slash.asm @@ -0,0 +1,20 @@ +; ( d1 -- d2 ) +; Arithmetics +; shift a double cell value right +VE_D2SLASH: + .dw $ff03 + .db "d2/",0 + .dw VE_HEAD + .set VE_HEAD = VE_D2SLASH +XT_D2SLASH: + .dw PFA_D2SLASH +PFA_D2SLASH: + ld temp0, Y+ + ld temp1, Y+ + asr tosh + ror tosl + ror temp1 + ror temp0 + st -Y, temp1 + st -Y, temp0 + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/d-2star.asm b/amforth-6.5/avr8/words/d-2star.asm new file mode 100644 index 0000000..f0ca099 --- /dev/null +++ b/amforth-6.5/avr8/words/d-2star.asm @@ -0,0 +1,20 @@ +; ( d1 -- d2 ) +; Arithmetics +; shift a double cell left +VE_D2STAR: + .dw $ff03 + .db "d2*",0 + .dw VE_HEAD + .set VE_HEAD = VE_D2STAR +XT_D2STAR: + .dw PFA_D2STAR +PFA_D2STAR: + ld temp0, Y+ + ld temp1, Y+ + lsl temp0 + rol temp1 + rol tosl + rol tosh + st -Y, temp1 + st -Y, temp0 + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/d-greaterzero.asm b/amforth-6.5/avr8/words/d-greaterzero.asm new file mode 100644 index 0000000..30fad34 --- /dev/null +++ b/amforth-6.5/avr8/words/d-greaterzero.asm @@ -0,0 +1,19 @@ +; ( d -- flag ) +; Compare +; compares if a double double cell number is greater 0 +VE_DGREATERZERO: + .dw $ff03 + .db "d0>",0 + .dw VE_HEAD + .set VE_HEAD = VE_DGREATERZERO +XT_DGREATERZERO: + .dw PFA_DGREATERZERO +PFA_DGREATERZERO: + cp tosl, zerol + cpc tosh, zeroh + loadtos + cpc tosl, zerol + cpc tosh, zeroh + brlt PFA_ZERO1 + brbs 1, PFA_ZERO1 + rjmp PFA_TRUE1 diff --git a/amforth-6.5/avr8/words/d-invert.asm b/amforth-6.5/avr8/words/d-invert.asm new file mode 100644 index 0000000..c87ae05 --- /dev/null +++ b/amforth-6.5/avr8/words/d-invert.asm @@ -0,0 +1,20 @@ +; ( d1 -- d2) +; Arithmetics +; invert all bits in the double cell value +VE_DINVERT: + .dw $ff07 + .db "dinvert",0 + .dw VE_HEAD + .set VE_HEAD = VE_DINVERT +XT_DINVERT: + .dw PFA_DINVERT +PFA_DINVERT: + ld temp0, Y+ + ld temp1, Y+ + com tosl + com tosh + com temp0 + com temp1 + st -Y, temp1 + st -Y, temp0 + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/d-lesszero.asm b/amforth-6.5/avr8/words/d-lesszero.asm new file mode 100644 index 0000000..afa70c7 --- /dev/null +++ b/amforth-6.5/avr8/words/d-lesszero.asm @@ -0,0 +1,15 @@ +; ( d -- flag ) +; Compare +; compares if a double double cell number is less than 0 +VE_DXT_ZEROLESS: + .dw $ff03 + .db "d0<",0 + .dw VE_HEAD + .set VE_HEAD = VE_DXT_ZEROLESS +XT_DXT_ZEROLESS: + .dw PFA_DXT_ZEROLESS +PFA_DXT_ZEROLESS: + adiw Y,2 + sbrc tosh,7 + jmp PFA_TRUE1 + jmp PFA_ZERO1 diff --git a/amforth-6.5/avr8/words/d-minus.asm b/amforth-6.5/avr8/words/d-minus.asm new file mode 100644 index 0000000..a458851 --- /dev/null +++ b/amforth-6.5/avr8/words/d-minus.asm @@ -0,0 +1,28 @@ +; ( d1 d2 -- d3 ) +; Arithmetics +; subtract d2 from d1 +VE_DMINUS: + .dw $ff02 + .db "d-" + .dw VE_HEAD + .set VE_HEAD = VE_DMINUS +XT_DMINUS: + .dw PFA_DMINUS +PFA_DMINUS: + ld temp2, Y+ + ld temp3, Y+ + + ld temp4, Y+ + ld temp5, Y+ + ld temp6, Y+ + ld temp7, Y+ + + sub temp6, temp2 + sbc temp7, temp3 + sbc temp4, tosl + sbc temp5, tosh + + st -Y, temp7 + st -Y, temp6 + movw tosl, temp4 + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/d-plus.asm b/amforth-6.5/avr8/words/d-plus.asm new file mode 100644 index 0000000..60286dd --- /dev/null +++ b/amforth-6.5/avr8/words/d-plus.asm @@ -0,0 +1,27 @@ +; ( d1 d2 -- d3) +; Arithmetics +; add 2 double cell values +VE_DPLUS: + .dw $ff02 + .db "d+" + .dw VE_HEAD + .set VE_HEAD = VE_DPLUS +XT_DPLUS: + .dw PFA_DPLUS +PFA_DPLUS: + ld temp2, Y+ + ld temp3, Y+ + + ld temp4, Y+ + ld temp5, Y+ + ld temp6, Y+ + ld temp7, Y+ + + add temp2, temp6 + adc temp3, temp7 + adc tosl, temp4 + adc tosh, temp5 + + st -Y, temp3 + st -Y, temp2 + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/dabs.asm b/amforth-6.5/avr8/words/dabs.asm new file mode 100644 index 0000000..43b372d --- /dev/null +++ b/amforth-6.5/avr8/words/dabs.asm @@ -0,0 +1,19 @@ +; ( d -- ud ) +; Arithmetics +; double cell absolute value +VE_DABS: + .dw $ff04 + .db "dabs" + .dw VE_HEAD + .set VE_HEAD = VE_DABS +XT_DABS: + .dw DO_COLON +PFA_DABS: + .dw XT_DUP + .dw XT_ZEROLESS + .dw XT_DOCONDBRANCH + .dw PFA_DABS1 + .dw XT_DNEGATE +PFA_DABS1: + .dw XT_EXIT +; : dabs ( ud1 -- +d2 ) dup 0< if dnegate then ; diff --git a/amforth-6.5/avr8/words/dnegate.asm b/amforth-6.5/avr8/words/dnegate.asm new file mode 100644 index 0000000..cfa45ca --- /dev/null +++ b/amforth-6.5/avr8/words/dnegate.asm @@ -0,0 +1,17 @@ +; ( d1 -- d2 ) +; Arithmetics +; double cell negation +VE_DNEGATE: + .dw $ff07 + .db "dnegate",0 + .dw VE_HEAD + .set VE_HEAD = VE_DNEGATE +XT_DNEGATE: + .dw DO_COLON +PFA_DNEGATE: + .dw XT_DINVERT + .dw XT_ONE + .dw XT_ZERO + .dw XT_DPLUS + .dw XT_EXIT +; : dnegate ( ud1 -- ud2 ) dinvert 1. d+ ; diff --git a/amforth-6.5/avr8/words/do-defer.asm b/amforth-6.5/avr8/words/do-defer.asm new file mode 100644 index 0000000..dbd190e --- /dev/null +++ b/amforth-6.5/avr8/words/do-defer.asm @@ -0,0 +1,27 @@ +; ( i*x -- j*x ) +; System +; runtime of defer +VE_DODEFER: + .dw $ff07 + .db "(defer)", 0 + .dw VE_HEAD + .set VE_HEAD = VE_DODEFER +XT_DODEFER: + .dw DO_COLON +PFA_DODEFER: + .dw XT_DOCREATE + .dw XT_REVEAL + .dw XT_COMPILE + .dw PFA_DODEFER1 + .dw XT_EXIT +PFA_DODEFER1: + call_ DO_DODOES + .dw XT_DUP + .dw XT_ICELLPLUS + .dw XT_FETCHI + .dw XT_EXECUTE + .dw XT_EXECUTE + .dw XT_EXIT + +; : (defer) dup i-cell+ @i execute execute ; + diff --git a/amforth-6.5/avr8/words/do-sliteral.asm b/amforth-6.5/avr8/words/do-sliteral.asm new file mode 100644 index 0000000..41ddb15 --- /dev/null +++ b/amforth-6.5/avr8/words/do-sliteral.asm @@ -0,0 +1,21 @@ +; ( -- addr len ) +; String +; runtime portion of sliteral +;VE_DOSLITERAL: +; .dw $ff0a +; .db "(sliteral)" +; .dw VE_HEAD +; .set VE_HEAD = VE_DOSLITERAL +XT_DOSLITERAL: + .dw DO_COLON +PFA_DOSLITERAL: + .dw XT_R_FETCH ; ( -- addr ) + .dw XT_ICOUNT + .dw XT_R_FROM + .dw XT_OVER ; ( -- addr' n addr n) + .dw XT_1PLUS + .dw XT_2SLASH ; ( -- addr' n addr k ) + .dw XT_PLUS ; ( -- addr' n addr'' ) + .dw XT_1PLUS + .dw XT_TO_R ; ( -- ) + .dw XT_EXIT diff --git a/amforth-6.5/avr8/words/do-value.asm b/amforth-6.5/avr8/words/do-value.asm new file mode 100644 index 0000000..65182f5 --- /dev/null +++ b/amforth-6.5/avr8/words/do-value.asm @@ -0,0 +1,25 @@ +; ( -- n ) +; System +; runtime of value +VE_DOVALUE: + .dw $ff07 + .db "(value)", 0 + .dw VE_HEAD + .set VE_HEAD = VE_DOVALUE +XT_DOVALUE: + .dw DO_COLON +PFA_DOVALUE: + .dw XT_DOCREATE + .dw XT_REVEAL + .dw XT_COMPILE + .dw PFA_DOVALUE1 + .dw XT_EXIT +PFA_DOVALUE1: + call_ DO_DODOES + .dw XT_DUP + .dw XT_ICELLPLUS + .dw XT_FETCHI + .dw XT_EXECUTE + .dw XT_EXIT + +; : (value) dup icell+ @i execute ; diff --git a/amforth-6.5/avr8/words/dobranch.asm b/amforth-6.5/avr8/words/dobranch.asm new file mode 100644 index 0000000..7ff018f --- /dev/null +++ b/amforth-6.5/avr8/words/dobranch.asm @@ -0,0 +1,14 @@ +; ( -- ) +; System +; runtime of branch +;VE_DOBRANCH: +; .dw $ff08 +; .db "(branch)" +; .dw VE_HEAD +; .set VE_HEAD = VE_DOBRANCH +XT_DOBRANCH: + .dw PFA_DOBRANCH +PFA_DOBRANCH: + movw zl, XL + readflashcell XL,XH + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/docondbranch.asm b/amforth-6.5/avr8/words/docondbranch.asm new file mode 100644 index 0000000..64b2e5e --- /dev/null +++ b/amforth-6.5/avr8/words/docondbranch.asm @@ -0,0 +1,16 @@ +; ( f -- ) +; System +; runtime of ?branch +;VE_DOCONDBRANCH: +; .dw $ff09 +; .db "(?branch)" +; .dw VE_HEAD +; .set VE_HEAD = VE_DOCONDBRANCH +XT_DOCONDBRANCH: + .dw PFA_DOCONDBRANCH +PFA_DOCONDBRANCH: + or tosh, tosl + loadtos + brbs 1, PFA_DOBRANCH ; 1 is z flag; if tos is zero (false), do the branch + adiw XL, 1 + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/doconstant.asm b/amforth-6.5/avr8/words/doconstant.asm new file mode 100644 index 0000000..0ecdf27 --- /dev/null +++ b/amforth-6.5/avr8/words/doconstant.asm @@ -0,0 +1,15 @@ +; ( -- addr ) +; System +; place data field address on TOS +;VE_DOCONSTANT: +; .dw $ff0a +; .db "(constant)" +; .dw VE_HEAD +; .set VE_HEAD = VE_DOCONSTANT +XT_DOCONSTANT: + .dw PFA_DOCONSTANT +PFA_DOCONSTANT: + savetos + movw tosl, wl + adiw tosl, 1 + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/dodo.asm b/amforth-6.5/avr8/words/dodo.asm new file mode 100644 index 0000000..3b88694 --- /dev/null +++ b/amforth-6.5/avr8/words/dodo.asm @@ -0,0 +1,25 @@ +; ( limit start -- ) (R: -- loop-sys ) +; System +; runtime of do +;VE_DODO: +; .dw $ff04 +; .db "(do)" +; .dw VE_HEAD +; .set VE_HEAD = VE_DODO +XT_DODO: + .dw PFA_DODO +PFA_DODO: + ld temp2, Y+ + ld temp3, Y+ ; limit +PFA_DODO1: + ldi zl, $80 + add temp3, zl + sub tosl, temp2 + sbc tosh, temp3 + + push temp3 + push temp2 ; limit ( --> limit + $8000) + push tosh + push tosl ; start -> index ( --> index - (limit - $8000) + loadtos + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/does.asm b/amforth-6.5/avr8/words/does.asm new file mode 100644 index 0000000..6e3e71b --- /dev/null +++ b/amforth-6.5/avr8/words/does.asm @@ -0,0 +1,53 @@ +; ( i*x -- j*y ) (R: nest-sys1 -- ) (C: colon-sys1 -- colon-sys2 ) +; Compiler +; organize the XT replacement to call other colon code +VE_DOES: + .dw $0005 + .db "does>",0 + .dw VE_HEAD + .set VE_HEAD = VE_DOES +XT_DOES: + .dw DO_COLON +PFA_DOES: + .dw XT_COMPILE + .dw XT_DODOES + .dw XT_COMPILE ; create a code snippet to be used in an embedded XT + .dw $940e ; the address of this compiled + .dw XT_COMPILE ; code will replace the XT of the + .dw DO_DODOES ; word that CREATE created + .dw XT_EXIT ; + +DO_DODOES: ; ( -- PFA ) + savetos + movw tosl, wl + adiw tosl, 1 + ; the following takes the address from a real uC-call +.if (pclen==3) + pop wh ; some 128K Flash devices use 3 cells for call/ret +.endif + pop wh + pop wl + + push XH + push XL + movw XL, wl + jmp_ DO_NEXT + +; ( -- ) +; System +; replace the XT written by CREATE to call the code that follows does> +;VE_DODOES: +; .dw $ff07 +; .db "(does>)" +; .set VE_HEAD = VE_DODOES +XT_DODOES: + .dw DO_COLON +PFA_DODOES: + .dw XT_R_FROM + .dw XT_NEWEST + .dw XT_CELLPLUS + .dw XT_FETCH + .dw XT_FETCHE + .dw XT_NFA2CFA + .dw XT_STOREI + .dw XT_EXIT diff --git a/amforth-6.5/avr8/words/doliteral.asm b/amforth-6.5/avr8/words/doliteral.asm new file mode 100644 index 0000000..31da4b3 --- /dev/null +++ b/amforth-6.5/avr8/words/doliteral.asm @@ -0,0 +1,17 @@ +; ( -- n1 ) +; System +; runtime of literal +;VE_DOLITERAL: +; .dw $ff09 +; .db "(literal)" +; .dw VE_HEAD +; .set VE_HEAD = VE_DOLITERAL +XT_DOLITERAL: + .dw PFA_DOLITERAL +PFA_DOLITERAL: + savetos + movw zl, xl + readflashcell tosl,tosh + adiw xl, 1 + jmp_ DO_NEXT + diff --git a/amforth-6.5/avr8/words/doloop.asm b/amforth-6.5/avr8/words/doloop.asm new file mode 100644 index 0000000..b5e0a26 --- /dev/null +++ b/amforth-6.5/avr8/words/doloop.asm @@ -0,0 +1,16 @@ +; ( -- ) (R: loop-sys1 -- loop-sys2| ) +; System +; runtime of loop +;VE_DOLOOP: +; .dw $ff06 +; .db "(loop)" +; .dw VE_HEAD +; .set VE_HEAD = VE_DOLOOP +XT_DOLOOP: + .dw PFA_DOLOOP +PFA_DOLOOP: + pop zl + pop zh + adiw zl,1 + brvs PFA_DOPLUSLOOP_LEAVE + jmp_ PFA_DOPLUSLOOP_NEXT diff --git a/amforth-6.5/avr8/words/doplusloop.asm b/amforth-6.5/avr8/words/doplusloop.asm new file mode 100644 index 0000000..c34cae5 --- /dev/null +++ b/amforth-6.5/avr8/words/doplusloop.asm @@ -0,0 +1,28 @@ +; ( n1 -- ) (R: loop-sys1 -- loop-sys2| ) +; System +; runtime of +loop +;VE_DOPLUSLOOP: +; .dw $ff07 +; .db "(+loop)" +; .dw VE_HEAD +; .set VE_HEAD = VE_DOPLUSLOOP +XT_DOPLUSLOOP: + .dw PFA_DOPLUSLOOP +PFA_DOPLUSLOOP: + pop zl + pop zh + add zl, tosl + adc zh, tosh + loadtos + brvs PFA_DOPLUSLOOP_LEAVE + ; next cycle +PFA_DOPLUSLOOP_NEXT: + ; next iteration + push zh + push zl + rjmp PFA_DOBRANCH ; read next cell from dictionary and jump to its destination +PFA_DOPLUSLOOP_LEAVE: + pop temp0 + pop temp1 ; remove limit + adiw xl, 1 ; skip branch-back address + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/douser.asm b/amforth-6.5/avr8/words/douser.asm new file mode 100644 index 0000000..1347651 --- /dev/null +++ b/amforth-6.5/avr8/words/douser.asm @@ -0,0 +1,18 @@ +; ( -- addr ) +; System +; runtime part of user +;VE_DOUSER: +; .dw $ff06 +; .db "(user)" +; .dw VE_HEAD +; .set VE_HEAD = VE_DOUSER +XT_DOUSER: + .dw PFA_DOUSER +PFA_DOUSER: + savetos + movw zl, wl + adiw zl, 1 + readflashcell tosl,tosh + add tosl, upl + adc tosh, uph + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/dovariable.asm b/amforth-6.5/avr8/words/dovariable.asm new file mode 100644 index 0000000..6866ef4 --- /dev/null +++ b/amforth-6.5/avr8/words/dovariable.asm @@ -0,0 +1,16 @@ +; ( -- addr ) +; System +; puts content of parameter field (1 cell) to TOS +;VE_DOVARIABLE: +; .dw $ff0a +; .db "(variable)" +; .dw VE_HEAD +; .set VE_HEAD = VE_DOVARIABLE +XT_DOVARIABLE: + .dw PFA_DOVARIABLE +PFA_DOVARIABLE: + savetos + movw zl, wl + adiw zl,1 + readflashcell tosl,tosh + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/dp.asm b/amforth-6.5/avr8/words/dp.asm new file mode 100644 index 0000000..c9507f7 --- /dev/null +++ b/amforth-6.5/avr8/words/dp.asm @@ -0,0 +1,14 @@ +; ( -- f-addr ) +; System Value +; address of the next free dictionary cell +VE_DP: + .dw $ff02 + .db "dp" + .dw VE_HEAD + .set VE_HEAD = VE_DP +XT_DP: + .dw PFA_DOVALUE1 +PFA_DP: + .dw CFG_DP + .dw XT_EDEFERFETCH + .dw XT_EDEFERSTORE diff --git a/amforth-6.5/avr8/words/drop.asm b/amforth-6.5/avr8/words/drop.asm new file mode 100644 index 0000000..baee84b --- /dev/null +++ b/amforth-6.5/avr8/words/drop.asm @@ -0,0 +1,13 @@ +; ( n -- ) +; Stack +; drop TOS +VE_DROP: + .dw $ff04 + .db "drop" + .dw VE_HEAD + .set VE_HEAD = VE_DROP +XT_DROP: + .dw PFA_DROP +PFA_DROP: + loadtos + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/dup.asm b/amforth-6.5/avr8/words/dup.asm new file mode 100644 index 0000000..0b5fa27 --- /dev/null +++ b/amforth-6.5/avr8/words/dup.asm @@ -0,0 +1,13 @@ +; ( n -- n n ) +; Stack +; duplicate TOS +VE_DUP: + .dw $ff03 + .db "dup",0 + .dw VE_HEAD + .set VE_HEAD = VE_DUP +XT_DUP: + .dw PFA_DUP +PFA_DUP: + savetos + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/edefer-fetch.asm b/amforth-6.5/avr8/words/edefer-fetch.asm new file mode 100644 index 0000000..651bb53 --- /dev/null +++ b/amforth-6.5/avr8/words/edefer-fetch.asm @@ -0,0 +1,14 @@ +; ( xt1 -- xt2 ) +; System +; does the real defer@ for eeprom defers +VE_EDEFERFETCH: + .dw $ff07 + .db "Edefer@",0 + .dw VE_HEAD + .set VE_HEAD = VE_EDEFERFETCH +XT_EDEFERFETCH: + .dw DO_COLON +PFA_EDEFERFETCH: + .dw XT_FETCHI + .dw XT_FETCHE + .dw XT_EXIT diff --git a/amforth-6.5/avr8/words/edefer-store.asm b/amforth-6.5/avr8/words/edefer-store.asm new file mode 100644 index 0000000..1c0011b --- /dev/null +++ b/amforth-6.5/avr8/words/edefer-store.asm @@ -0,0 +1,14 @@ +; ( xt1 xt2 -- ) +; System +; does the real defer! for eeprom defers +VE_EDEFERSTORE: + .dw $ff07 + .db "Edefer!",0 + .dw VE_HEAD + .set VE_HEAD = VE_EDEFERSTORE +XT_EDEFERSTORE: + .dw DO_COLON +PFA_EDEFERSTORE: + .dw XT_FETCHI + .dw XT_STOREE + .dw XT_EXIT diff --git a/amforth-6.5/avr8/words/ehere.asm b/amforth-6.5/avr8/words/ehere.asm new file mode 100644 index 0000000..e416c0e --- /dev/null +++ b/amforth-6.5/avr8/words/ehere.asm @@ -0,0 +1,14 @@ +; ( -- e-addr ) +; System Value +; address of the next free address in eeprom +VE_EHERE: + .dw $ff05 + .db "ehere",0 + .dw VE_HEAD + .set VE_HEAD = VE_EHERE +XT_EHERE: + .dw PFA_DOVALUE1 +PFA_EHERE: + .dw EE_EHERE + .dw XT_EDEFERFETCH + .dw XT_EDEFERSTORE diff --git a/amforth-6.5/avr8/words/end-code.asm b/amforth-6.5/avr8/words/end-code.asm new file mode 100644 index 0000000..bf161eb --- /dev/null +++ b/amforth-6.5/avr8/words/end-code.asm @@ -0,0 +1,16 @@ +; ( -- ) +; Compiler +; finish a code definition +VE_ENDCODE: + .dw $ff08 + .db "end-code" + .dw VE_HEAD + .set VE_HEAD = VE_ENDCODE +XT_ENDCODE: + .dw DO_COLON +PFA_ENDCODE: + .dw XT_COMPILE + .dw $940c + .dw XT_COMPILE + .dw DO_NEXT + .dw XT_EXIT diff --git a/amforth-6.5/avr8/words/env-mcuinfo.asm b/amforth-6.5/avr8/words/env-mcuinfo.asm new file mode 100644 index 0000000..ef7240a --- /dev/null +++ b/amforth-6.5/avr8/words/env-mcuinfo.asm @@ -0,0 +1,14 @@ +; ( -- faddr len ) +; Environment +; flash address of some CPU specific parameters +VE_ENV_MCUINFO: + .dw $ff08 + .db "mcu-info" + .dw VE_ENVHEAD + .set VE_ENVHEAD = VE_ENV_MCUINFO +XT_ENV_MCUINFO: + .dw DO_COLON +PFA_EN_MCUINFO: + .dw XT_DOLITERAL + .dw mcu_info + .dw XT_EXIT diff --git a/amforth-6.5/avr8/words/env-slashpad.asm b/amforth-6.5/avr8/words/env-slashpad.asm new file mode 100644 index 0000000..1cb7dbb --- /dev/null +++ b/amforth-6.5/avr8/words/env-slashpad.asm @@ -0,0 +1,15 @@ +; ( -- padsize ) +; Environment +; Size of the PAD buffer in bytes +VE_ENVSLASHPAD: + .dw $ff04 + .db "/pad" + .dw VE_ENVHEAD + .set VE_ENVHEAD = VE_ENVSLASHPAD +XT_ENVSLASHPAD: + .dw DO_COLON +PFA_ENVSLASHPAD: + .dw XT_SP_FETCH + .dw XT_PAD + .dw XT_MINUS + .dw XT_EXIT diff --git a/amforth-6.5/avr8/words/env-wordlists.asm b/amforth-6.5/avr8/words/env-wordlists.asm new file mode 100644 index 0000000..643cfb7 --- /dev/null +++ b/amforth-6.5/avr8/words/env-wordlists.asm @@ -0,0 +1,14 @@ +; ( -- n ) +; Environment +; maximum number of wordlists in the dictionary search order +VE_ENVWORDLISTS: + .dw $ff09 + .db "wordlists",0 + .dw VE_ENVHEAD + .set VE_ENVHEAD = VE_ENVWORDLISTS +XT_ENVWORDLISTS: + .dw DO_COLON +PFA_ENVWORDLISTS: + .dw XT_DOLITERAL + .dw NUMWORDLISTS + .dw XT_EXIT diff --git a/amforth-6.5/avr8/words/environment.asm b/amforth-6.5/avr8/words/environment.asm new file mode 100644 index 0000000..8e39c08 --- /dev/null +++ b/amforth-6.5/avr8/words/environment.asm @@ -0,0 +1,12 @@ +; ( -- wid) +; System Value +; word list identifier of the environmental search list +VE_ENVIRONMENT: + .dw $ff0b + .db "environment",0 + .dw VE_HEAD + .set VE_HEAD = VE_ENVIRONMENT +XT_ENVIRONMENT: + .dw PFA_DOVARIABLE +PFA_ENVIRONMENT: + .dw CFG_ENVIRONMENT diff --git a/amforth-6.5/avr8/words/equal.asm b/amforth-6.5/avr8/words/equal.asm new file mode 100644 index 0000000..1cd3e57 --- /dev/null +++ b/amforth-6.5/avr8/words/equal.asm @@ -0,0 +1,14 @@ +; ( n1 n2 -- flag ) +; Compare +; compares two values for equality +VE_EQUAL: + .dw $ff01 + .db "=",0 + .dw VE_HEAD + .set VE_HEAD = VE_EQUAL +XT_EQUAL: + .dw DO_COLON +PFA_EQUAL: + .dw XT_MINUS + .dw XT_ZEROEQUAL + .dw XT_EXIT diff --git a/amforth-6.5/avr8/words/equalzero.asm b/amforth-6.5/avr8/words/equalzero.asm new file mode 100644 index 0000000..d33cedd --- /dev/null +++ b/amforth-6.5/avr8/words/equalzero.asm @@ -0,0 +1,14 @@ +; ( n -- flag ) +; Compare +; compare with 0 (zero) +VE_ZEROEQUAL: + .dw $ff02 + .db "0=" + .dw VE_HEAD + .set VE_HEAD = VE_ZEROEQUAL +XT_ZEROEQUAL: + .dw PFA_ZEROEQUAL +PFA_ZEROEQUAL: + or tosh, tosl + brne PFA_ZERO1 + rjmp PFA_TRUE1 diff --git a/amforth-6.5/avr8/words/execute.asm b/amforth-6.5/avr8/words/execute.asm new file mode 100644 index 0000000..4a2308d --- /dev/null +++ b/amforth-6.5/avr8/words/execute.asm @@ -0,0 +1,14 @@ +; ( xt -- ) +; System +; execute XT +VE_EXECUTE: + .dw $ff07 + .db "execute",0 + .dw VE_HEAD + .set VE_HEAD = VE_EXECUTE +XT_EXECUTE: + .dw PFA_EXECUTE +PFA_EXECUTE: + movw wl, tosl + loadtos + jmp_ DO_EXECUTE diff --git a/amforth-6.5/avr8/words/exit.asm b/amforth-6.5/avr8/words/exit.asm new file mode 100644 index 0000000..89e19b9 --- /dev/null +++ b/amforth-6.5/avr8/words/exit.asm @@ -0,0 +1,14 @@ +; ( -- ) (R: nest-sys -- ) +; Compiler +; end of current colon word +VE_EXIT: + .dw $ff04 + .db "exit" + .dw VE_HEAD + .set VE_HEAD = VE_EXIT +XT_EXIT: + .dw PFA_EXIT +PFA_EXIT: + pop XL + pop XH + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/fetch-e.asm b/amforth-6.5/avr8/words/fetch-e.asm new file mode 100644 index 0000000..fb0dee5 --- /dev/null +++ b/amforth-6.5/avr8/words/fetch-e.asm @@ -0,0 +1,51 @@ +; ( e-addr - n) +; Memory +; read 1 cell from eeprom +VE_FETCHE: + .dw $ff02 + .db "@e" + .dw VE_HEAD + .set VE_HEAD = VE_FETCHE +XT_FETCHE: + .dw PFA_FETCHE +PFA_FETCHE: +.if WANT_UNIFIED == 1 + ldi zh, high(EEPROMEND) + ldi zl, low(EEPROMEND) + cp tosl, zl + cpc tosh, zh + brlt PFA_FETCHE1 + brbs 1, PFA_FETCHE1 + rjmp PFA_FETCHE_OTHER +.endif +PFA_FETCHE1: + in_ temp2, SREG + cli + movw zl, tosl + rcall PFA_FETCHE2 + in_ tosl, EEDR + + adiw zl,1 + + rcall PFA_FETCHE2 + in_ tosh, EEDR + out_ SREG, temp2 + jmp_ DO_NEXT + +PFA_FETCHE2: + sbic EECR, EEPE + rjmp PFA_FETCHE2 + + out_ EEARH,zh + out_ EEARL,zl + + sbi EECR,EERE + ret + +.if WANT_UNIFIED == 1 +PFA_FETCHE_OTHER: + adiw zl, 1 + sub tosl, zl + sbc tosh, zh + jmp_ PFA_FETCHI +.endif diff --git a/amforth-6.5/avr8/words/fetch-i.asm b/amforth-6.5/avr8/words/fetch-i.asm new file mode 100644 index 0000000..5cdcc37 --- /dev/null +++ b/amforth-6.5/avr8/words/fetch-i.asm @@ -0,0 +1,14 @@ +; ( f-addr -- n1 ) +; Memory +; read 1 cell from flash +VE_FETCHI: + .dw $ff02 + .db "@i" + .dw VE_HEAD + .set VE_HEAD = VE_FETCHI +XT_FETCHI: + .dw PFA_FETCHI +PFA_FETCHI: + movw zl, tosl + readflashcell tosl,tosh + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/fetch-u.asm b/amforth-6.5/avr8/words/fetch-u.asm new file mode 100644 index 0000000..6e94616 --- /dev/null +++ b/amforth-6.5/avr8/words/fetch-u.asm @@ -0,0 +1,15 @@ +; ( offset -- n ) +; Memory +; read 1 cell from USER area +VE_FETCHU: + .dw $ff02 + .db "@u" + .dw VE_HEAD + .set VE_HEAD = VE_FETCHU +XT_FETCHU: + .dw DO_COLON +PFA_FETCHU: + .dw XT_UP_FETCH + .dw XT_PLUS + .dw XT_FETCH + .dw XT_EXIT diff --git a/amforth-6.5/avr8/words/fetch.asm b/amforth-6.5/avr8/words/fetch.asm new file mode 100644 index 0000000..6cd2f2b --- /dev/null +++ b/amforth-6.5/avr8/words/fetch.asm @@ -0,0 +1,33 @@ +; ( a-addr -- n ) +; Memory +; read 1 cell from RAM address +VE_FETCH: + .dw $ff01 + .db "@",0 + .dw VE_HEAD + .set VE_HEAD = VE_FETCH +XT_FETCH: + .dw PFA_FETCH +PFA_FETCH: +.if WANT_UNIFIED == 1 + ldi zh, high(RAMEND) + ldi zl, low(RAMEND) + cp tosl, zl + cpc tosh, zh + brlt PFA_FETCHRAM + brbs 1, PFA_FETCHRAM + rjmp PFA_FETCHOTHER +.endif +PFA_FETCHRAM: + movw zl, tosl + ; low byte is read before the high byte + ld tosl, z+ + ld tosh, z+ + jmp_ DO_NEXT +.if WANT_UNIFIED == 1 +PFA_FETCHOTHER: + adiw zl, 1 + sub tosl, zl + sbc tosh, zh + jmp_ PFA_FETCHE +.endif diff --git a/amforth-6.5/avr8/words/fill.asm b/amforth-6.5/avr8/words/fill.asm new file mode 100644 index 0000000..e8bcacc --- /dev/null +++ b/amforth-6.5/avr8/words/fill.asm @@ -0,0 +1,26 @@ +; ( a-addr u c -- ) +; Memory +; fill u bytes memory beginning at a-addr with character c +VE_FILL: + .dw $ff04 + .db "fill" + .dw VE_HEAD + .set VE_HEAD = VE_FILL +XT_FILL: + .dw DO_COLON +PFA_FILL: + .dw XT_ROT + .dw XT_ROT + .dw XT_QDUP,XT_DOCONDBRANCH + DEST(PFA_FILL2) + .dw XT_BOUNDS + .dw XT_DODO +PFA_FILL1: + .dw XT_DUP + .dw XT_I + .dw XT_CSTORE ; ( -- c c-addr) + .dw XT_DOLOOP + .dw PFA_FILL1 +PFA_FILL2: + .dw XT_DROP + .dw XT_EXIT diff --git a/amforth-6.5/avr8/words/forth-recognizer.asm b/amforth-6.5/avr8/words/forth-recognizer.asm new file mode 100644 index 0000000..5b50820 --- /dev/null +++ b/amforth-6.5/avr8/words/forth-recognizer.asm @@ -0,0 +1,14 @@ +; ( -- addr ) +; System Value +; address of the next free data space (RAM) cell +VE_FORTHRECOGNIZER: + .dw $ff10 + .db "forth-recognizer" + .dw VE_HEAD + .set VE_HEAD = VE_FORTHRECOGNIZER +XT_FORTHRECOGNIZER: + .dw PFA_DOVALUE1 +PFA_FORTHRECOGNIZER: + .dw CFG_FORTHRECOGNIZER + .dw XT_EDEFERFETCH + .dw XT_EDEFERSTORE diff --git a/amforth-6.5/avr8/words/forth-wordlist.asm b/amforth-6.5/avr8/words/forth-wordlist.asm new file mode 100644 index 0000000..4147aea --- /dev/null +++ b/amforth-6.5/avr8/words/forth-wordlist.asm @@ -0,0 +1,12 @@ +; ( -- wid ) +; Search Order +; get the system default word list +VE_FORTHWORDLIST: + .dw $ff0e + .db "forth-wordlist" + .dw VE_HEAD + .set VE_HEAD = VE_FORTHWORDLIST +XT_FORTHWORDLIST: + .dw PFA_DOVARIABLE +PFA_FORTHWORDLIST: + .dw CFG_FORTHWORDLIST diff --git a/amforth-6.5/avr8/words/g-mark.asm b/amforth-6.5/avr8/words/g-mark.asm new file mode 100644 index 0000000..7f7fa36 --- /dev/null +++ b/amforth-6.5/avr8/words/g-mark.asm @@ -0,0 +1,16 @@ +; ( -- dest ) +; Compiler +; places current dictionary position for backward resolves +;VE_GMARK: +; .dw $ff05 +; .db ">mark" +; .dw VE_HEAD +; .set VE_HEAD = VE_GMARK +XT_GMARK: + .dw DO_COLON +PFA_GMARK: + .dw XT_DP + .dw XT_COMPILE + .dw -1 ; ffff does not erase flash + .dw XT_EXIT + \ No newline at end of file diff --git a/amforth-6.5/avr8/words/g-resolve.asm b/amforth-6.5/avr8/words/g-resolve.asm new file mode 100644 index 0000000..0566b37 --- /dev/null +++ b/amforth-6.5/avr8/words/g-resolve.asm @@ -0,0 +1,16 @@ +; ( dest -- ) +; Compiler +; resolve backward jumps +;VE_GRESOLVE: +; .dw $ff08 +; .db ">resolve" +; .dw VE_HEAD +; .set VE_HEAD = VE_GRESOLVE +XT_GRESOLVE: + .dw DO_COLON +PFA_GRESOLVE: + .dw XT_QSTACK + .dw XT_DP + .dw XT_SWAP + .dw XT_STOREI + .dw XT_EXIT diff --git a/amforth-6.5/avr8/words/get-current.asm b/amforth-6.5/avr8/words/get-current.asm new file mode 100644 index 0000000..a016a95 --- /dev/null +++ b/amforth-6.5/avr8/words/get-current.asm @@ -0,0 +1,15 @@ +; ( -- wid) +; Search Order +; get the wid of the current compilation word list +VE_GET_CURRENT: + .dw $ff0b + .db "get-current",0 + .dw VE_HEAD + .set VE_HEAD = VE_GET_CURRENT +XT_GET_CURRENT: + .dw DO_COLON +PFA_GET_CURRENT: + .dw XT_DOLITERAL + .dw CFG_CURRENT + .dw XT_FETCHE + .dw XT_EXIT diff --git a/amforth-6.5/avr8/words/greater.asm b/amforth-6.5/avr8/words/greater.asm new file mode 100644 index 0000000..b4a9731 --- /dev/null +++ b/amforth-6.5/avr8/words/greater.asm @@ -0,0 +1,19 @@ +; ( n1 n2 -- flag ) +; Compare +; flag is true if n1 is greater than n2 +VE_GREATER: + .dw $ff01 + .db ">",0 + .dw VE_HEAD + .set VE_HEAD = VE_GREATER +XT_GREATER: + .dw PFA_GREATER +PFA_GREATER: + ld temp2, Y+ + ld temp3, Y+ + cp temp2, tosl + cpc temp3, tosh +PFA_GREATERDONE: + brlt PFA_ZERO1 + brbs 1, PFA_ZERO1 + rjmp PFA_TRUE1 diff --git a/amforth-6.5/avr8/words/greaterzero.asm b/amforth-6.5/avr8/words/greaterzero.asm new file mode 100644 index 0000000..61cca0e --- /dev/null +++ b/amforth-6.5/avr8/words/greaterzero.asm @@ -0,0 +1,16 @@ +; ( n1 -- flag ) +; Compare +; true if n1 is greater than 0 +VE_GREATERZERO: + .dw $ff02 + .db "0>" + .dw VE_HEAD + .set VE_HEAD = VE_GREATERZERO +XT_GREATERZERO: + .dw PFA_GREATERZERO +PFA_GREATERZERO: + cp tosl, zerol + cpc tosh, zeroh + brlt PFA_ZERO1 + brbs 1, PFA_ZERO1 + rjmp PFA_TRUE1 diff --git a/amforth-6.5/avr8/words/header.asm b/amforth-6.5/avr8/words/header.asm new file mode 100644 index 0000000..4a1e6e9 --- /dev/null +++ b/amforth-6.5/avr8/words/header.asm @@ -0,0 +1,36 @@ +; ( addr len wid -- nfa ) +; Compiler +; creates the vocabulary header without XT and data field (PF) in the wordlist wid +VE_HEADER: + .dw $ff06 + .db "header" + .dw VE_HEAD + .set VE_HEAD = VE_HEADER +XT_HEADER: + .dw DO_COLON +PFA_HEADER: + .dw XT_DP ; the new Name Field + .dw XT_TO_R + .dw XT_TO_R ; ( R: NFA WID ) + .dw XT_DUP + .dw XT_GREATERZERO + .dw XT_DOCONDBRANCH + .dw PFA_HEADER1 + .dw XT_DUP + .dw XT_DOLITERAL + .dw $ff00 ; all flags are off (e.g. immediate) + .dw XT_OR + .dw XT_DOSCOMMA + ; make the link to the previous entry in this wordlist + .dw XT_R_FROM + .dw XT_FETCHE + .dw XT_COMMA + .dw XT_R_FROM + .dw XT_EXIT + +PFA_HEADER1: + ; -16: attempt to use zero length string as a name + .dw XT_DOLITERAL + .dw -16 + .dw XT_THROW + diff --git a/amforth-6.5/avr8/words/here.asm b/amforth-6.5/avr8/words/here.asm new file mode 100644 index 0000000..c3fc5cb --- /dev/null +++ b/amforth-6.5/avr8/words/here.asm @@ -0,0 +1,14 @@ +; ( -- addr ) +; System Value +; address of the next free data space (RAM) cell +VE_HERE: + .dw $ff04 + .db "here" + .dw VE_HEAD + .set VE_HEAD = VE_HERE +XT_HERE: + .dw PFA_DOVALUE1 +PFA_HERE: + .dw EE_HERE + .dw XT_EDEFERFETCH + .dw XT_EDEFERSTORE diff --git a/amforth-6.5/avr8/words/hld.asm b/amforth-6.5/avr8/words/hld.asm new file mode 100644 index 0000000..d31590c --- /dev/null +++ b/amforth-6.5/avr8/words/hld.asm @@ -0,0 +1,16 @@ +; ( -- addr ) +; Numeric IO +; pointer to current write position in the Pictured Numeric Output buffer +VE_HLD: + .dw $ff03 + .db "hld",0 + .dw VE_HEAD + .set VE_HEAD = VE_HLD +XT_HLD: + .dw PFA_DOVARIABLE +PFA_HLD: + .dw ram_hld + +.dseg +ram_hld: .byte 2 +.cseg diff --git a/amforth-6.5/avr8/words/i-cellplus.asm b/amforth-6.5/avr8/words/i-cellplus.asm new file mode 100644 index 0000000..08cbb14 --- /dev/null +++ b/amforth-6.5/avr8/words/i-cellplus.asm @@ -0,0 +1,13 @@ +; ( addr -- addr' ) +; Compiler +; skip to the next cell in flash +VE_ICELLPLUS: + .dw $FF07 + .db "i-cell+",0 + .dw VE_HEAD + .set VE_HEAD = VE_ICELLPLUS +XT_ICELLPLUS: + .dw DO_COLON +PFA_ICELLPLUS: + .dw XT_1PLUS + .dw XT_EXIT diff --git a/amforth-6.5/avr8/words/i.asm b/amforth-6.5/avr8/words/i.asm new file mode 100644 index 0000000..4943073 --- /dev/null +++ b/amforth-6.5/avr8/words/i.asm @@ -0,0 +1,23 @@ +; ( -- n ) (R: loop-sys -- loop-sys) +; Compiler +; current loop counter +VE_I: + .dw $FF01 + .db "i",0 + .dw VE_HEAD + .set VE_HEAD = VE_I +XT_I: + .dw PFA_I +PFA_I: + savetos + pop tosl + pop tosh ; index + pop zl + pop zh ; limit + push zh + push zl + push tosh + push tosl + add tosl, zl + adc tosh, zh + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/icompare.asm b/amforth-6.5/avr8/words/icompare.asm new file mode 100644 index 0000000..f0fbab5 --- /dev/null +++ b/amforth-6.5/avr8/words/icompare.asm @@ -0,0 +1,103 @@ +; ( r-addr r-len f-addr f-len -- f) +; Tools +; compares string in RAM with string in flash. f is zero if equal like COMPARE +VE_ICOMPARE: + .dw $ff08 + .db "icompare" + .dw VE_HEAD + .set VE_HEAD = VE_ICOMPARE +XT_ICOMPARE: + .dw DO_COLON +PFA_ICOMPARE: + .dw XT_TO_R ; ( -- r-addr r-len f-addr) + .dw XT_OVER ; ( -- r-addr r-len f-addr r-len) + .dw XT_R_FROM ; ( -- r-addr r-len f-addr r-len f-len ) + .dw XT_NOTEQUAL ; ( -- r-addr r-len f-addr flag ) + .dw XT_DOCONDBRANCH + .dw PFA_ICOMPARE_SAMELEN + .dw XT_2DROP + .dw XT_DROP + .dw XT_TRUE + .dw XT_EXIT +PFA_ICOMPARE_SAMELEN: + .dw XT_SWAP ; ( -- r-addr f-addr len ) + .dw XT_ZERO + .dw XT_QDOCHECK + .dw XT_DOCONDBRANCH + .dw PFA_ICOMPARE_DONE + .dw XT_DODO +PFA_ICOMPARE_LOOP: + ; ( r-addr f-addr --) + .dw XT_OVER + .dw XT_FETCH +.if WANT_IGNORECASE == 1 + .dw XT_ICOMPARE_LC +.endif + .dw XT_OVER + .dw XT_FETCHI ; ( -- r-addr f-addr r-cc f- cc) +.if WANT_IGNORECASE == 1 + .dw XT_ICOMPARE_LC +.endif + ; flash strings are zero-padded at the last cell + ; that means: if the flash cell is less $0100, than mask the + ; high byte in the ram cell + .dw XT_DUP + ;.dw XT_BYTESWAP + .dw XT_DOLITERAL + .dw $100 + .dw XT_ULESS + .dw XT_DOCONDBRANCH + .dw PFA_ICOMPARE_LASTCELL + .dw XT_SWAP + .dw XT_DOLITERAL + .dw $00FF + .dw XT_AND ; the final swap can be omitted +PFA_ICOMPARE_LASTCELL: + .dw XT_NOTEQUAL + .dw XT_DOCONDBRANCH + .dw PFA_ICOMPARE_NEXTLOOP + .dw XT_2DROP + .dw XT_TRUE + .dw XT_UNLOOP + .dw XT_EXIT +PFA_ICOMPARE_NEXTLOOP: + .dw XT_1PLUS + .dw XT_SWAP + .dw XT_CELLPLUS + .dw XT_SWAP + .dw XT_DOLITERAL + .dw 2 + .dw XT_DOPLUSLOOP + .dw PFA_ICOMPARE_LOOP +PFA_ICOMPARE_DONE: + .dw XT_2DROP + .dw XT_ZERO + .dw XT_EXIT + +.if WANT_IGNORECASE == 1 +; ( cc1 cc2 -- f) +; Tools +; compares two packed characters +;VE_ICOMPARELC: +; .dw $ff08 +; .db "icompare-lower" +; .dw VE_HEAD +; .set VE_HEAD = VE_ICOMPARELC +XT_ICOMPARE_LC: + .dw DO_COLON +PFA_ICOMPARE_LC: + .dw XT_DUP + .dw XT_DOLITERAL + .dw $00ff + .dw XT_AND + .dw XT_TOLOWER + .dw XT_SWAP + .dw XT_BYTESWAP + .dw XT_DOLITERAL + .dw $00ff + .dw XT_AND + .dw XT_TOLOWER + .dw XT_BYTESWAP + .dw XT_OR + .dw XT_EXIT +.endif diff --git a/amforth-6.5/avr8/words/icount.asm b/amforth-6.5/avr8/words/icount.asm new file mode 100644 index 0000000..d71ef13 --- /dev/null +++ b/amforth-6.5/avr8/words/icount.asm @@ -0,0 +1,16 @@ +; ( addr -- addr+1 n ) +; Tools +; get count information out of a counted string in flash +VE_ICOUNT: + .dw $ff06 + .db "icount" + .dw VE_HEAD + .set VE_HEAD = VE_ICOUNT +XT_ICOUNT: + .dw DO_COLON +PFA_ICOUNT: + .dw XT_DUP + .dw XT_1PLUS + .dw XT_SWAP + .dw XT_FETCHI + .dw XT_EXIT diff --git a/amforth-6.5/avr8/words/immediate-q.asm b/amforth-6.5/avr8/words/immediate-q.asm new file mode 100644 index 0000000..36fb29a --- /dev/null +++ b/amforth-6.5/avr8/words/immediate-q.asm @@ -0,0 +1,23 @@ +; ( flagset -- +/-1 ) +; Tools +; return +1 if immediate, -1 otherwise, flag from name>flags +;VE_IMMEDIATEQ: +; .dw $ff06 +; .db "immediate?" +; .dw VE_HEAD +; .set VE_HEAD = VE_IMMEDIATEQ +XT_IMMEDIATEQ: + .dw DO_COLON +PFA_IMMEDIATEQ: + .dw XT_DOLITERAL + .dw $8000 + .dw XT_AND + .dw XT_ZEROEQUAL + .dw XT_DOCONDBRANCH + DEST(IMMEDIATEQ1) + .dw XT_ONE + .dw XT_EXIT +IMMEDIATEQ1: + ; not immediate + .dw XT_TRUE + .dw XT_EXIT diff --git a/amforth-6.5/avr8/words/immediate.asm b/amforth-6.5/avr8/words/immediate.asm new file mode 100644 index 0000000..6a2370d --- /dev/null +++ b/amforth-6.5/avr8/words/immediate.asm @@ -0,0 +1,21 @@ +; ( -- ) +; Compiler +; set immediate flag for the most recent word definition +VE_IMMEDIATE: + .dw $ff09 + .db "immediate",0 + .dw VE_HEAD + .set VE_HEAD = VE_IMMEDIATE +XT_IMMEDIATE: + .dw DO_COLON +PFA_IMMEDIATE: + .dw XT_GET_CURRENT + .dw XT_FETCHE + .dw XT_DUP + .dw XT_FETCHI + .dw XT_DOLITERAL + .dw $7fff + .dw XT_AND + .dw XT_SWAP + .dw XT_STOREI + .dw XT_EXIT diff --git a/amforth-6.5/avr8/words/init-ram.asm b/amforth-6.5/avr8/words/init-ram.asm new file mode 100644 index 0000000..cd672bd --- /dev/null +++ b/amforth-6.5/avr8/words/init-ram.asm @@ -0,0 +1,48 @@ +; ( e-addr r-addr len -- ) +; Tools +; copy len cells from eeprom to ram +VE_EE2RAM: + .dw $ff06 + .db "ee>ram" + .dw VE_HEAD + .set VE_HEAD = VE_EE2RAM +XT_EE2RAM: + .dw DO_COLON +PFA_EE2RAM: ; ( -- ) + .dw XT_ZERO + .dw XT_DODO +PFA_EE2RAM_1: + ; ( -- e-addr r-addr ) + .dw XT_OVER + .dw XT_FETCHE + .dw XT_OVER + .dw XT_STORE + .dw XT_CELLPLUS + .dw XT_SWAP + .dw XT_CELLPLUS + .dw XT_SWAP + .dw XT_DOLOOP + .dw PFA_EE2RAM_1 +PFA_EE2RAM_2: + .dw XT_2DROP + .dw XT_EXIT + +; ( -- ) +; Tools +; setup the default user area from eeprom +VE_INIT_RAM: + .dw $ff08 + .db "init-ram" + .dw VE_HEAD + .set VE_HEAD = VE_INIT_RAM +XT_INIT_RAM: + .dw DO_COLON +PFA_INI_RAM: ; ( -- ) + .dw XT_DOLITERAL + .dw EE_INITUSER + .dw XT_UP_FETCH + .dw XT_DOLITERAL + .dw SYSUSERSIZE + .dw XT_2SLASH + .dw XT_EE2RAM + .dw XT_EXIT diff --git a/amforth-6.5/avr8/words/int-fetch.asm b/amforth-6.5/avr8/words/int-fetch.asm new file mode 100644 index 0000000..f0c713a --- /dev/null +++ b/amforth-6.5/avr8/words/int-fetch.asm @@ -0,0 +1,16 @@ +; ( i -- xt ) +; Interrupt +; fetches XT from interrupt vector i +VE_INTFETCH: + .dw $ff04 + .db "int@" + .dw VE_HEAD + .set VE_HEAD = VE_INTFETCH +XT_INTFETCH: + .dw DO_COLON +PFA_INTFETCH: + .dw XT_DOLITERAL + .dw intvec + .dw XT_PLUS + .dw XT_FETCHE + .dw XT_EXIT diff --git a/amforth-6.5/avr8/words/int-num.asm b/amforth-6.5/avr8/words/int-num.asm new file mode 100644 index 0000000..31f51df --- /dev/null +++ b/amforth-6.5/avr8/words/int-num.asm @@ -0,0 +1,12 @@ +; ( -- n ) +; Interrupt +; number of interrupt vectors (0 based) +VE_NUMINT: + .dw $ff04 + .db "#int" + .dw VE_HEAD + .set VE_HEAD = VE_NUMINT +XT_NUMINT: + .dw PFA_DOVARIABLE +PFA_NUMINT: + .dw INTVECTORS diff --git a/amforth-6.5/avr8/words/int-off.asm b/amforth-6.5/avr8/words/int-off.asm new file mode 100644 index 0000000..4301404 --- /dev/null +++ b/amforth-6.5/avr8/words/int-off.asm @@ -0,0 +1,13 @@ +; ( -- ) +; Interrupt +; turns off all interrupts +VE_INTOFF: + .dw $ff04 + .db "-int" + .dw VE_HEAD + .set VE_HEAD = VE_INTOFF +XT_INTOFF: + .dw PFA_INTOFF +PFA_INTOFF: + cli + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/int-on.asm b/amforth-6.5/avr8/words/int-on.asm new file mode 100644 index 0000000..8b909da --- /dev/null +++ b/amforth-6.5/avr8/words/int-on.asm @@ -0,0 +1,13 @@ +; ( -- ) +; Interrupt +; turns on all interrupts +VE_INTON: + .dw $ff04 + .db "+int" + .dw VE_HEAD + .set VE_HEAD = VE_INTON +XT_INTON: + .dw PFA_INTON +PFA_INTON: + sei + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/int-store.asm b/amforth-6.5/avr8/words/int-store.asm new file mode 100644 index 0000000..9189ba0 --- /dev/null +++ b/amforth-6.5/avr8/words/int-store.asm @@ -0,0 +1,16 @@ +; ( xt i -- ) +; Interrupt +; stores XT as interrupt vector i +VE_INTSTORE: + .dw $ff04 + .db "int!" + .dw VE_HEAD + .set VE_HEAD = VE_INTSTORE +XT_INTSTORE: + .dw DO_COLON +PFA_INTSTORE: + .dw XT_DOLITERAL + .dw intvec + .dw XT_PLUS + .dw XT_STOREE + .dw XT_EXIT diff --git a/amforth-6.5/avr8/words/int-trap.asm b/amforth-6.5/avr8/words/int-trap.asm new file mode 100644 index 0000000..dd3170f --- /dev/null +++ b/amforth-6.5/avr8/words/int-trap.asm @@ -0,0 +1,14 @@ +; ( i -- ) +; Interrupt +; trigger an interrupt +VE_INTTRAP: + .dw $ff08 + .db "int-trap" + .dw VE_HEAD + .set VE_HEAD = VE_INTTRAP +XT_INTTRAP: + .dw PFA_INTTRAP +PFA_INTTRAP: + mov isrflag, tosl + loadtos + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/invert.asm b/amforth-6.5/avr8/words/invert.asm new file mode 100644 index 0000000..84d7a1d --- /dev/null +++ b/amforth-6.5/avr8/words/invert.asm @@ -0,0 +1,14 @@ +; ( n1 -- n2) +; Arithmetics +; 1-complement of TOS +VE_INVERT: + .dw $ff06 + .db "invert" + .dw VE_HEAD + .set VE_HEAD = VE_INVERT +XT_INVERT: + .dw PFA_INVERT +PFA_INVERT: + com tosl + com tosh + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/irqcnt.asm b/amforth-6.5/avr8/words/irqcnt.asm new file mode 100644 index 0000000..edb8a39 --- /dev/null +++ b/amforth-6.5/avr8/words/irqcnt.asm @@ -0,0 +1,15 @@ +; ( i -- xt ) +; Interrupt +; fetches XT from interrupt vector i +VE_IRQCNTADDR: + .dw $ff06 + .db "irq[]#" + .dw VE_HEAD + .set VE_HEAD = VE_IRQCNTADDR +XT_IRQCNTADDR: + .dw DO_COLON +PFA_IRQCNTADDR: + .dw XT_DOLITERAL + .dw intcnt + .dw XT_PLUS + .dw XT_EXIT diff --git a/amforth-6.5/avr8/words/isr-end.asm b/amforth-6.5/avr8/words/isr-end.asm new file mode 100644 index 0000000..7fe6132 --- /dev/null +++ b/amforth-6.5/avr8/words/isr-end.asm @@ -0,0 +1,15 @@ +; ( -- ) +; Interrupt +; re-enables interrupts in an ISR +;VE_ISREND: +; .dw $ff07 +; .db "isr-end",0 +; .dw VE_HEAD +; .set VE_HEAD = VE_ISREND +XT_ISREND: + .dw PFA_ISREND +PFA_ISREND: + rcall PFA_ISREND1 ; clear the interrupt flag for the controller + jmp_ DO_NEXT +PFA_ISREND1: + reti diff --git a/amforth-6.5/avr8/words/isr-exec.asm b/amforth-6.5/avr8/words/isr-exec.asm new file mode 100644 index 0000000..6c1a379 --- /dev/null +++ b/amforth-6.5/avr8/words/isr-exec.asm @@ -0,0 +1,15 @@ +; ( n -- ) +; Interrupt +; executes an interrupt service routine +;VE_ISREXEC: +; .dw $ff08 +; .db "isr-exec" +; .dw VE_HEAD +; .set VE_HEAD = VE_ISREXEC +XT_ISREXEC: + .dw DO_COLON +PFA_ISREXEC: + .dw XT_INTFETCH + .dw XT_EXECUTE + .dw XT_ISREND + .dw XT_EXIT diff --git a/amforth-6.5/avr8/words/itype.asm b/amforth-6.5/avr8/words/itype.asm new file mode 100644 index 0000000..7831344 --- /dev/null +++ b/amforth-6.5/avr8/words/itype.asm @@ -0,0 +1,74 @@ +; ( addr n -- ) +; Tools +; reads string from flash and prints it +VE_ITYPE: + .dw $ff05 + .db "itype",0 + .dw VE_HEAD + .set VE_HEAD = VE_ITYPE +XT_ITYPE: + .dw DO_COLON +PFA_ITYPE: + .dw XT_DUP ; ( --addr len len) + .dw XT_2SLASH ; ( -- addr len len/2 + .dw XT_TUCK ; ( -- addr len/2 len len/2 + .dw XT_2STAR ; ( -- addr len/2 len len' + .dw XT_MINUS ; ( -- addr len/2 rem + .dw XT_TO_R + .dw XT_ZERO + .dw XT_QDOCHECK + .dw XT_DOCONDBRANCH + .dw PFA_ITYPE2 + .dw XT_DODO +PFA_ITYPE1: + .dw XT_DUP ; ( -- addr addr ) + .dw XT_FETCHI ; ( -- addr c1c2 ) + .dw XT_DUP + .dw XT_LOWEMIT + .dw XT_HIEMIT + .dw XT_1PLUS ; ( -- addr+cell ) + .dw XT_DOLOOP + .dw PFA_ITYPE1 +PFA_ITYPE2: + .dw XT_R_FROM + .dw XT_GREATERZERO + .dw XT_DOCONDBRANCH + .dw PFA_ITYPE3 + .dw XT_DUP ; make sure the drop below has always something to do + .dw XT_FETCHI + .dw XT_LOWEMIT +PFA_ITYPE3: + .dw XT_DROP + .dw XT_EXIT + +; ( w -- ) +; R( -- ) +; content of cell fetched on stack. +;VE_HIEMIT: +; .dw $ff06 +; .db "hiemit" +; .dw VE_HEAD +; .set VE_HEAD = VE_HIEMIT +XT_HIEMIT: + .dw DO_COLON +PFA_HIEMIT: + .dw XT_BYTESWAP + .dw XT_LOWEMIT + .dw XT_EXIT + +; ( w -- ) +; R( -- ) +; content of cell fetched on stack. +;VE_LOWEMIT: +; .dw $ff07 +; .db "lowemit" +; .dw VE_HEAD +; .set VE_HEAD = VE_LOWEMIT +XT_LOWEMIT: + .dw DO_COLON +PFA_LOWEMIT: + .dw XT_DOLITERAL + .dw $00ff + .dw XT_AND + .dw XT_EMIT + .dw XT_EXIT diff --git a/amforth-6.5/avr8/words/j.asm b/amforth-6.5/avr8/words/j.asm new file mode 100644 index 0000000..30ba24b --- /dev/null +++ b/amforth-6.5/avr8/words/j.asm @@ -0,0 +1,23 @@ +; ( -- n ) (R: loop-sys1 loop-sys2 -- loop-sys1 loop-sys2) +; Compiler +; loop counter of outer loop +VE_J: + .dw $FF01 + .db "j",0 + .dw VE_HEAD + .set VE_HEAD = VE_J +XT_J: + .dw DO_COLON +PFA_J: + .dw XT_RP_FETCH + .dw XT_DOLITERAL + .dw 7 + .dw XT_PLUS + .dw XT_FETCH + .dw XT_RP_FETCH + .dw XT_DOLITERAL + .dw 9 + .dw XT_PLUS + .dw XT_FETCH + .dw XT_PLUS + .dw XT_EXIT diff --git a/amforth-6.5/avr8/words/l_mark.asm b/amforth-6.5/avr8/words/l_mark.asm new file mode 100644 index 0000000..9d5c5ae --- /dev/null +++ b/amforth-6.5/avr8/words/l_mark.asm @@ -0,0 +1,13 @@ +; ( -- dest ) +; Compiler +; place destination for backward branch +;VE_LMARK: +; .dw $ff05 +; .db "",0 + .dw VE_HEAD + .set VE_HEAD = VE_N_R_FROM +XT_N_R_FROM: + .dw PFA_N_R_FROM +PFA_N_R_FROM: + savetos + pop zh + pop zl + mov temp0, zl +PFA_N_R_FROM1: + pop tosl + pop tosh + savetos + dec temp0 + brne PFA_N_R_FROM1 + movw tosl, zl + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/n_to_r.asm b/amforth-6.5/avr8/words/n_to_r.asm new file mode 100644 index 0000000..9efdaa6 --- /dev/null +++ b/amforth-6.5/avr8/words/n_to_r.asm @@ -0,0 +1,23 @@ +; ( x-n .. x-1 n -- ) (R: -- x-n .. x-1 n) +; Stack +; move n items from data stack to return stack +VE_N_TO_R: + .dw $ff03 + .db "n>r",0 + .dw VE_HEAD + .set VE_HEAD = VE_N_TO_R +XT_N_TO_R: + .dw PFA_N_TO_R +PFA_N_TO_R: + movw zl, tosl + mov temp0, tosl +PFA_N_TO_R1: + loadtos + push tosh + push tosl + dec temp0 + brne PFA_N_TO_R1 + push zl + push zh + loadtos + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/name2flags.asm b/amforth-6.5/avr8/words/name2flags.asm new file mode 100644 index 0000000..12f618e --- /dev/null +++ b/amforth-6.5/avr8/words/name2flags.asm @@ -0,0 +1,16 @@ +; ( nt -- f ) +; Tools +; get the flags from a name token +VE_NAME2FLAGS: + .dw $ff0a + .db "name>flags" + .dw VE_HEAD + .set VE_HEAD = VE_NAME2FLAGS +XT_NAME2FLAGS: + .dw DO_COLON +PFA_NAME2FLAGS: + .dw XT_FETCHI ; skip to link field + .dw XT_DOLITERAL + .dw $ff00 + .dw XT_AND + .dw XT_EXIT diff --git a/amforth-6.5/avr8/words/negate.asm b/amforth-6.5/avr8/words/negate.asm new file mode 100644 index 0000000..6a88d58 --- /dev/null +++ b/amforth-6.5/avr8/words/negate.asm @@ -0,0 +1,14 @@ +; ( n1 -- n2 ) +; Logic +; 2-complement +VE_NEGATE: + .dw $ff06 + .db "negate" + .dw VE_HEAD + .set VE_HEAD = VE_NEGATE +XT_NEGATE: + .dw DO_COLON +PFA_NEGATE: + .dw XT_INVERT + .dw XT_1PLUS + .dw XT_EXIT diff --git a/amforth-6.5/avr8/words/newest.asm b/amforth-6.5/avr8/words/newest.asm new file mode 100644 index 0000000..62839fc --- /dev/null +++ b/amforth-6.5/avr8/words/newest.asm @@ -0,0 +1,16 @@ +; ( -- addr ) +; System Variable +; system state +VE_NEWEST: + .dw $ff06 + .db "newest" + .dw VE_HEAD + .set VE_HEAD = VE_NEWEST +XT_NEWEST: + .dw PFA_DOVARIABLE +PFA_NEWEST: + .dw ram_newest + +.dseg +ram_newest: .byte 4 +.cseg \ No newline at end of file diff --git a/amforth-6.5/avr8/words/nfa2cfa.asm b/amforth-6.5/avr8/words/nfa2cfa.asm new file mode 100644 index 0000000..ab1b230 --- /dev/null +++ b/amforth-6.5/avr8/words/nfa2cfa.asm @@ -0,0 +1,14 @@ +; ( nt -- xt ) +; Tools +; get the XT from a name token +VE_NFA2CFA: + .dw $ff07 + .db "nfa>cfa" + .dw VE_HEAD + .set VE_HEAD = VE_NFA2CFA +XT_NFA2CFA: + .dw DO_COLON +PFA_NFA2CFA: + .dw XT_NFA2LFA ; skip to link field + .dw XT_1PLUS ; next is the execution token + .dw XT_EXIT diff --git a/amforth-6.5/avr8/words/nfa2lfa.asm b/amforth-6.5/avr8/words/nfa2lfa.asm new file mode 100644 index 0000000..945fb64 --- /dev/null +++ b/amforth-6.5/avr8/words/nfa2lfa.asm @@ -0,0 +1,16 @@ +; ( nfa -- lfa ) +; System +; get the link field address from the name field address +VE_NFA2LFA: + .dw $ff07 + .db "nfa>lfa",0 + .dw VE_HEAD + .set VE_HEAD = VE_NFA2LFA +XT_NFA2LFA: + .dw DO_COLON +PFA_NFA2LFA: + .dw XT_NAME2STRING + .dw XT_1PLUS + .dw XT_2SLASH + .dw XT_PLUS + .dw XT_EXIT diff --git a/amforth-6.5/avr8/words/nip.asm b/amforth-6.5/avr8/words/nip.asm new file mode 100644 index 0000000..cfa1d1a --- /dev/null +++ b/amforth-6.5/avr8/words/nip.asm @@ -0,0 +1,13 @@ +; ( n1 n2 -- n2 ) +; Stack +; Remove Second of Stack +VE_NIP: + .dw $ff03 + .db "nip",0 + .dw VE_HEAD + .set VE_HEAD = VE_NIP +XT_NIP: + .dw PFA_NIP +PFA_NIP: + adiw yl, 2 + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/not.asm b/amforth-6.5/avr8/words/not.asm new file mode 100644 index 0000000..26aa5c4 --- /dev/null +++ b/amforth-6.5/avr8/words/not.asm @@ -0,0 +1,13 @@ +; ( flag -- flag' ) +; Logic +; identical to 0= +VE_NOT: + .dw $ff03 + .db "not",0 + .dw VE_HEAD + .set VE_HEAD = VE_NOT +XT_NOT: + .dw DO_COLON +PFA_NOT: + .dw XT_ZEROEQUAL + .dw XT_EXIT diff --git a/amforth-6.5/avr8/words/notequalzero.asm b/amforth-6.5/avr8/words/notequalzero.asm new file mode 100644 index 0000000..5088bf3 --- /dev/null +++ b/amforth-6.5/avr8/words/notequalzero.asm @@ -0,0 +1,14 @@ +; ( n -- flag ) +; Compare +; true if n is not zero +VE_NOTZEROEQUAL: + .dw $ff03 + .db "0<>",0 + .dw VE_HEAD + .set VE_HEAD = VE_NOTZEROEQUAL +XT_NOTZEROEQUAL: + .dw DO_COLON +PFA_NOTZEROEQUAL: + .dw XT_ZEROEQUAL + .dw XT_ZEROEQUAL + .dw XT_EXIT diff --git a/amforth-6.5/avr8/words/or.asm b/amforth-6.5/avr8/words/or.asm new file mode 100644 index 0000000..24bc268 --- /dev/null +++ b/amforth-6.5/avr8/words/or.asm @@ -0,0 +1,17 @@ +; ( n1 n2 -- n3 ) +; Logic +; logical or +VE_OR: + .dw $ff02 + .db "or" + .dw VE_HEAD + .set VE_HEAD = VE_OR +XT_OR: + .dw PFA_OR +PFA_OR: + ld temp0, Y+ + ld temp1, Y+ + or tosl, temp0 + or tosh, temp1 + jmp_ DO_NEXT + diff --git a/amforth-6.5/avr8/words/over.asm b/amforth-6.5/avr8/words/over.asm new file mode 100644 index 0000000..97ca242 --- /dev/null +++ b/amforth-6.5/avr8/words/over.asm @@ -0,0 +1,16 @@ +; ( x1 x2 -- x1 x2 x1 ) +; Stack +; Place a copy of x1 on top of the stack +VE_OVER: + .dw $ff04 + .db "over" + .dw VE_HEAD + .set VE_HEAD = VE_OVER +XT_OVER: + .dw PFA_OVER +PFA_OVER: + savetos + ldd tosl, Y+2 + ldd tosh, Y+3 + + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/pause.asm b/amforth-6.5/avr8/words/pause.asm new file mode 100644 index 0000000..747fde4 --- /dev/null +++ b/amforth-6.5/avr8/words/pause.asm @@ -0,0 +1,18 @@ +; ( -- ) +; Multitasking +; Fetch pause vector and execute it. may make a context/task switch +VE_PAUSE: + .dw $ff05 + .db "pause",0 + .dw VE_HEAD + .set VE_HEAD = VE_PAUSE +XT_PAUSE: + .dw PFA_DODEFER1 +PFA_PAUSE: + .dw ram_pause + .dw XT_RDEFERFETCH + .dw XT_RDEFERSTORE + +.dseg +ram_pause: .byte 2 +.cseg diff --git a/amforth-6.5/avr8/words/plus.asm b/amforth-6.5/avr8/words/plus.asm new file mode 100644 index 0000000..1b2a6c4 --- /dev/null +++ b/amforth-6.5/avr8/words/plus.asm @@ -0,0 +1,16 @@ +; ( n1 n2 -- n3) +; Arithmetics +; add n1 and n2 +VE_PLUS: + .dw $ff01 + .db "+",0 + .dw VE_HEAD + .set VE_HEAD = VE_PLUS +XT_PLUS: + .dw PFA_PLUS +PFA_PLUS: + ld temp0, Y+ + ld temp1, Y+ + add tosl, temp0 + adc tosh, temp1 + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/plusstore.asm b/amforth-6.5/avr8/words/plusstore.asm new file mode 100644 index 0000000..344670b --- /dev/null +++ b/amforth-6.5/avr8/words/plusstore.asm @@ -0,0 +1,21 @@ +; ( n a-addr -- ) +; Arithmetics +; add n to content of RAM address a-addr +VE_PLUSSTORE: + .dw $ff02 + .db "+!" + .dw VE_HEAD + .set VE_HEAD = VE_PLUSSTORE +XT_PLUSSTORE: + .dw PFA_PLUSSTORE +PFA_PLUSSTORE: + movw zl, tosl + loadtos + ldd temp2, Z+0 + ldd temp3, Z+1 + add tosl, temp2 + adc tosh, temp3 + std Z+0, tosl + std Z+1, tosh + loadtos + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/popcnt.asm b/amforth-6.5/avr8/words/popcnt.asm new file mode 100644 index 0000000..66f8f47 --- /dev/null +++ b/amforth-6.5/avr8/words/popcnt.asm @@ -0,0 +1,29 @@ +; ( n1 -- n2 ) +; Arithmetics +; count the Number of 1 bits (population count) +VE_POPCNT: + .dw $ff06 + .db "popcnt" + .dw VE_HEAD + .set VE_HEAD = VE_POPCNT +XT_POPCNT: + .dw PFA_POPCNT +PFA_POPCNT: + movw zl, tosl + clr tosl + rcall PFA_POPCNT1 + mov zl, zh + rcall PFA_POPCNT1 + clr tosh + jmp_ DO_NEXT + +PFA_POPCNT1: + ldi tosh, 8 +PFA_POPCNT2: + ror zl + ;breq PFA_POPCNT3 + adc tosl, zeroh + dec tosh + brne PFA_POPCNT2 +POPCNT3: + ret \ No newline at end of file diff --git a/amforth-6.5/avr8/words/qdup.asm b/amforth-6.5/avr8/words/qdup.asm new file mode 100644 index 0000000..e65640b --- /dev/null +++ b/amforth-6.5/avr8/words/qdup.asm @@ -0,0 +1,17 @@ +; ( n1 -- [ n1 n1 ] | 0) +; Stack +; duplicate TOS if non-zero +VE_QDUP: + .dw $ff04 + .db "?dup" + .dw VE_HEAD + .set VE_HEAD = VE_QDUP +XT_QDUP: + .dw PFA_QDUP +PFA_QDUP: + mov temp0, tosl + or temp0, tosh + breq PFA_QDUP1 + savetos +PFA_QDUP1: + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/r_fetch.asm b/amforth-6.5/avr8/words/r_fetch.asm new file mode 100644 index 0000000..06d8ab0 --- /dev/null +++ b/amforth-6.5/avr8/words/r_fetch.asm @@ -0,0 +1,17 @@ +; ( -- n) (R: n -- n ) +; Stack +; fetch content of TOR +VE_R_FETCH: + .dw $ff02 + .db "r@" + .dw VE_HEAD + .set VE_HEAD = VE_R_FETCH +XT_R_FETCH: + .dw PFA_R_FETCH +PFA_R_FETCH: + savetos + pop tosl + pop tosh + push tosh + push tosl + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/r_from.asm b/amforth-6.5/avr8/words/r_from.asm new file mode 100644 index 0000000..66c1ebc --- /dev/null +++ b/amforth-6.5/avr8/words/r_from.asm @@ -0,0 +1,15 @@ +; ( -- n ) (R: n --) +; Stack +; move TOR to TOS +VE_R_FROM: + .dw $ff02 + .db "r>" + .dw VE_HEAD + .set VE_HEAD = VE_R_FROM +XT_R_FROM: + .dw PFA_R_FROM +PFA_R_FROM: + savetos + pop tosl + pop tosh + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/reg-a.asm b/amforth-6.5/avr8/words/reg-a.asm new file mode 100644 index 0000000..196ca3c --- /dev/null +++ b/amforth-6.5/avr8/words/reg-a.asm @@ -0,0 +1,180 @@ +; ( -- n2 ) +; Extended VM +; Read memory pointed to by register A (Extended VM) +VE_AFETCH: + .dw $ff02 + .db "a@" + .dw VE_HEAD + .set VE_HEAD = VE_AFETCH +XT_AFETCH: + .dw PFA_AFETCH +PFA_AFETCH: + savetos + movw zl, al + ld tosl, Z+ + ld tosh, Z+ + jmp_ DO_NEXT + +; ( n1 -- n2 ) +; Extended VM +; Read memory pointed to by register A plus offset (Extended VM) +VE_NAFETCH: + .dw $ff03 + .db "na@",0 + .dw VE_HEAD + .set VE_HEAD = VE_NAFETCH +XT_NAFETCH: + .dw PFA_NAFETCH +PFA_NAFETCH: + movw zl, al + add zl, tosl + adc zh, tosh + ld tosl, Z+ + ld tosh, Z+ + jmp_ DO_NEXT + +; ( -- n ) +; Extended VM +; Read memory pointed to by register A, increment A by 1 cell (Extended VM) +VE_AFETCHPLUS: + .dw $ff03 + .db "a@+",0 + .dw VE_HEAD + .set VE_HEAD = VE_AFETCHPLUS +XT_AFETCHPLUS: + .dw PFA_AFETCHPLUS +PFA_AFETCHPLUS: + savetos + movw zl, al + ld tosl, Z+ + ld tosh, Z+ + movw al, zl + jmp_ DO_NEXT + +; ( -- n ) +; Extended VM +; Read memory pointed to by register A, decrement A by 1 cell (Extended VM) +VE_AFETCHMINUS: + .dw $ff03 + .db "a@-",0 + .dw VE_HEAD + .set VE_HEAD = VE_AFETCHMINUS +XT_AFETCHMINUS: + .dw PFA_AFETCHMINUS +PFA_AFETCHMINUS: + savetos + movw zl, al + ld tosh, -Z ; TODO: check byte order!! + ld tosl, -Z + movw al, zl + jmp_ DO_NEXT + +; ( n -- ) +; Extended VM +; Write memory pointed to by register A (Extended VM) +VE_ASTORE: + .dw $ff02 + .db "a!" + .dw VE_HEAD + .set VE_HEAD = VE_ASTORE +XT_ASTORE: + .dw PFA_ASTORE +PFA_ASTORE: + movw zl, al + st Z+, tosl + st Z+, tosh + loadtos + jmp_ DO_NEXT + +; ( n offs -- ) +; Extended VM +; Write memory pointed to by register A plus offset (Extended VM) +VE_NASTORE: + .dw $ff03 + .db "na!",0 + .dw VE_HEAD + .set VE_HEAD = VE_NASTORE +XT_NASTORE: + .dw PFA_NASTORE +PFA_NASTORE: + movw zl, al + add zl, tosl + adc zh, tosh + loadtos + st Z+, tosl + st Z+, tosh + loadtos + jmp_ DO_NEXT + +; ( -- n2 ) +; Extended VM +; Write memory pointed to by register A, increment A by 1 cell (Extended VM) +VE_ASTOREPLUS: + .dw $ff03 + .db "a!+",0 + .dw VE_HEAD + .set VE_HEAD = VE_ASTOREPLUS +XT_ASTOREPLUS: + .dw PFA_ASTOREPLUS +PFA_ASTOREPLUS: + movw zl, al + st Z+, tosl + st Z+, tosh + loadtos + movw al, zl + jmp_ DO_NEXT + +; ( -- n2 ) +; Extended VM +; Write memory pointed to by register A, decrement A by 1 cell (Extended VM) +VE_ASTOREMINUS: + .dw $ff03 + .db "a!-",0 + .dw VE_HEAD + .set VE_HEAD = VE_ASTOREMINUS +XT_ASTOREMINUS: + .dw PFA_ASTOREMINUS +PFA_ASTOREMINUS: + movw zl, al + st -Z, tosh + st -Z, tosl + loadtos + movw al, zl + jmp_ DO_NEXT + + + +; ( n -- ) +; Extended VM +; Write to A register (Extended VM) +VE_TO_A: + .dw $ff02 + .db ">a" + .dw VE_HEAD + .set VE_HEAD = VE_TO_A +XT_TO_A: + .dw PFA_TO_A +PFA_TO_A: + movw al, tosl + loadtos + jmp_ DO_NEXT + +; ( n1 -- n2 ) +; Extended VM +; read the A register (Extended VM) +VE_A_FROM: + .dw $ff02 + .db "a>" + .dw VE_HEAD + .set VE_HEAD = VE_A_FROM +XT_A_FROM: + .dw PFA_A_FROM +PFA_A_FROM: + savetos + movw tosl, al + jmp_ DO_NEXT + +; for more information read +; http://www.complang.tuwien.ac.at/anton/euroforth/ef08/papers/pelc.pdf +; adapted index based access from X/Y registers +; note: offset is byte address, not cell! diff --git a/amforth-6.5/avr8/words/reg-b.asm b/amforth-6.5/avr8/words/reg-b.asm new file mode 100644 index 0000000..4b77e99 --- /dev/null +++ b/amforth-6.5/avr8/words/reg-b.asm @@ -0,0 +1,180 @@ +; ( -- n2 ) +; Extended VM +; Read memory pointed to by register B (Extended VM) +VE_BFETCH: + .dw $ff02 + .db "b@" + .dw VE_HEAD + .set VE_HEAD = VE_BFETCH +XT_BFETCH: + .dw PFA_BFETCH +PFA_BFETCH: + savetos + movw zl, bl + ld tosl, Z+ + ld tosh, Z+ + jmp_ DO_NEXT + +; ( n1 -- n2 ) +; Extended VM +; Read memory pointed to by register B plus offset (Extended VM) +VE_NBFETCH: + .dw $ff03 + .db "nb@",0 + .dw VE_HEAD + .set VE_HEAD = VE_NBFETCH +XT_NBFETCH: + .dw PFA_NBFETCH +PFA_NBFETCH: + movw zl, bl + add zl, tosl + adc zh, tosh + ld tosl, Z+ + ld tosh, Z+ + jmp_ DO_NEXT + +; ( -- n ) +; Extended VM +; Read memory pointed to by register B, increment B by 1 cell (Extended VM) +VE_BFETCHPLUS: + .dw $ff03 + .db "b@+",0 + .dw VE_HEAD + .set VE_HEAD = VE_BFETCHPLUS +XT_BFETCHPLUS: + .dw PFA_BFETCHPLUS +PFA_BFETCHPLUS: + savetos + movw zl, bl + ld tosl, Z+ + ld tosh, Z+ + movw bl, zl + jmp_ DO_NEXT + +; ( -- n ) +; Extended VM +; Read memory pointed to by register B, decrement B by 1 cell (Extended VM) +VE_BFETCHMINUS: + .dw $ff03 + .db "b@-",0 + .dw VE_HEAD + .set VE_HEAD = VE_BFETCHMINUS +XT_BFETCHMINUS: + .dw PFA_BFETCHMINUS +PFA_BFETCHMINUS: + savetos + movw zl, bl + ld tosh, -Z + ld tosl, -Z + movw bl, zl + jmp_ DO_NEXT + +; ( n -- ) +; Extended VM +; Write memory pointed to by register B (Extended VM) +VE_BSTORE: + .dw $ff02 + .db "b!" + .dw VE_HEAD + .set VE_HEAD = VE_BSTORE +XT_BSTORE: + .dw PFA_BSTORE +PFA_BSTORE: + movw zl, bl + st Z+, tosl + st Z+, tosh + loadtos + jmp_ DO_NEXT + +; ( n offs -- ) +; Extended VM +; Write memory pointed to by register B plus offset (Extended VM) +VE_NBSTORE: + .dw $ff03 + .db "nb!",0 + .dw VE_HEAD + .set VE_HEAD = VE_NBSTORE +XT_NBSTORE: + .dw PFA_NBSTORE +PFA_NBSTORE: + movw zl, bl + add zl, tosl + adc zh, tosh + loadtos + st Z+, tosl + st Z+, tosh + loadtos + jmp_ DO_NEXT + +; ( -- n2 ) +; Extended VM +; Write memory pointed to by register B, increment B by 1 cell (Extended VM) +VE_BSTOREPLUS: + .dw $ff03 + .db "b!+",0 + .dw VE_HEAD + .set VE_HEAD = VE_BSTOREPLUS +XT_BSTOREPLUS: + .dw PFA_BSTOREPLUS +PFA_BSTOREPLUS: + movw zl, bl + st Z+, tosl + st Z+, tosh + loadtos + movw bl, zl + jmp_ DO_NEXT + +; ( -- n2 ) +; Extended VM +; Write memory pointed to by register B, decrement B by 1 cell (Extended VM) +VE_BSTOREMINUS: + .dw $ff03 + .db "b!-",0 + .dw VE_HEAD + .set VE_HEAD = VE_BSTOREMINUS +XT_BSTOREMINUS: + .dw PFA_BSTOREMINUS +PFA_BSTOREMINUS: + movw zl, bl + st -Z, tosh + st -Z, tosl + loadtos + movw bl, zl + jmp_ DO_NEXT + + + +; ( n -- ) +; Extended VM +; Write to B register (Extended VM) +VE_TO_B: + .dw $ff02 + .db ">b" + .dw VE_HEAD + .set VE_HEAD = VE_TO_B +XT_TO_B: + .dw PFA_TO_B +PFA_TO_B: + movw bl, tosl + loadtos + jmp_ DO_NEXT + +; ( n1 -- n2 ) +; Extended VM +; read the B register (Extended VM) +VE_B_FROM: + .dw $ff02 + .db "b>" + .dw VE_HEAD + .set VE_HEAD = VE_B_FROM +XT_B_FROM: + .dw PFA_B_FROM +PFA_B_FROM: + savetos + movw tosl, bl + jmp_ DO_NEXT + +; for more information read +; http://www.complang.tuwien.ac.at/anton/euroforth/ef08/papers/pelc.pdf +; adapted index based access from X/Y registers +; note: offset is byte address, not cell! diff --git a/amforth-6.5/avr8/words/rot.asm b/amforth-6.5/avr8/words/rot.asm new file mode 100644 index 0000000..298b79c --- /dev/null +++ b/amforth-6.5/avr8/words/rot.asm @@ -0,0 +1,22 @@ +; ( n1 n2 n3 -- n2 n3 n1) +; Stack +; rotate the three top level cells +VE_ROT: + .dw $ff03 + .db "rot",0 + .dw VE_HEAD + .set VE_HEAD = VE_ROT +XT_ROT: + .dw PFA_ROT +PFA_ROT: + movw temp0, tosl + ld temp2, Y+ + ld temp3, Y+ + loadtos + + st -Y, temp3 + st -Y, temp2 + st -Y, temp1 + st -Y, temp0 + + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/rp0.asm b/amforth-6.5/avr8/words/rp0.asm new file mode 100644 index 0000000..1909f1c --- /dev/null +++ b/amforth-6.5/avr8/words/rp0.asm @@ -0,0 +1,27 @@ +; ( -- addr) +; Stack +; start address of return stack +VE_RP0: + .dw $ff03 + .db "rp0",0 + .dw VE_HEAD + .set VE_HEAD = VE_RP0 +XT_RP0: + .dw DO_COLON +PFA_RP0: + .dw XT_DORP0 + .dw XT_FETCH + .dw XT_EXIT + +; ( -- addr) +; Stack +; user variable of the address of the initial return stack +;VE_DORP0: +; .dw $ff05 +; .db "(rp0)" +; .dw VE_HEAD +; .set VE_HEAD = VE_DORP0 +XT_DORP0: + .dw PFA_DOUSER +PFA_DORP0: + .dw USER_RP diff --git a/amforth-6.5/avr8/words/rpfetch.asm b/amforth-6.5/avr8/words/rpfetch.asm new file mode 100644 index 0000000..8d1cdb6 --- /dev/null +++ b/amforth-6.5/avr8/words/rpfetch.asm @@ -0,0 +1,15 @@ +; ( -- n) +; Stack +; current return stack pointer address +VE_RP_FETCH: + .dw $ff03 + .db "rp@",0 + .dw VE_HEAD + .set VE_HEAD = VE_RP_FETCH +XT_RP_FETCH: + .dw PFA_RP_FETCH +PFA_RP_FETCH: + savetos + in tosl, SPL + in tosh, SPH + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/rpstore.asm b/amforth-6.5/avr8/words/rpstore.asm new file mode 100644 index 0000000..2a3d778 --- /dev/null +++ b/amforth-6.5/avr8/words/rpstore.asm @@ -0,0 +1,18 @@ +; ( addr -- ) (R: -- x*y) +; Stack +; set return stack pointer +VE_RP_STORE: + .dw $ff03 + .db "rp!",0 + .dw VE_HEAD + .set VE_HEAD = VE_RP_STORE +XT_RP_STORE: + .dw PFA_RP_STORE +PFA_RP_STORE: + in temp2, SREG + cli + out SPL, tosl + out SPH, tosh + out SREG, temp2 + loadtos + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/rshift.asm b/amforth-6.5/avr8/words/rshift.asm new file mode 100644 index 0000000..e0e2231 --- /dev/null +++ b/amforth-6.5/avr8/words/rshift.asm @@ -0,0 +1,22 @@ +; ( n1 n2 -- n3 ) +; Arithmetics +; shift n1 n2-times logically right +VE_RSHIFT: + .dw $ff06 + .db "rshift" + .dw VE_HEAD + .set VE_HEAD = VE_RSHIFT +XT_RSHIFT: + .dw PFA_RSHIFT +PFA_RSHIFT: + movw zl, tosl + loadtos +PFA_RSHIFT1: + sbiw zl, 1 + brmi PFA_RSHIFT2 + lsr tosh + ror tosl + rjmp PFA_RSHIFT1 +PFA_RSHIFT2: + jmp_ DO_NEXT + diff --git a/amforth-6.5/avr8/words/scomma.asm b/amforth-6.5/avr8/words/scomma.asm new file mode 100644 index 0000000..a5be0ca --- /dev/null +++ b/amforth-6.5/avr8/words/scomma.asm @@ -0,0 +1,56 @@ +; ( addr len -- ) +; Compiler +; compiles a string from RAM to Flash +VE_SCOMMA: + .dw $ff02 + .db "s",$2c + .dw VE_HEAD + .set VE_HEAD = VE_SCOMMA +XT_SCOMMA: + .dw DO_COLON +PFA_SCOMMA: + .dw XT_DUP + .dw XT_DOSCOMMA + .dw XT_EXIT + +; ( addr len len' -- ) +; Compiler +; compiles a string from RAM to Flash +;VE_DOSCOMMA: +; .dw $ff04 +; .db "(s",$2c,")" +; .dw VE_HEAD +; .set VE_HEAD = VE_DOSCOMMA +XT_DOSCOMMA: + .dw DO_COLON +PFA_DOSCOMMA: + .dw XT_COMMA + .dw XT_DUP ; ( --addr len len) + .dw XT_2SLASH ; ( -- addr len len/2 + .dw XT_TUCK ; ( -- addr len/2 len len/2 + .dw XT_2STAR ; ( -- addr len/2 len len' + .dw XT_MINUS ; ( -- addr len/2 rem + .dw XT_TO_R + .dw XT_ZERO + .dw XT_QDOCHECK + .dw XT_DOCONDBRANCH + .dw PFA_SCOMMA2 + .dw XT_DODO +PFA_SCOMMA1: + .dw XT_DUP ; ( -- addr addr ) + .dw XT_FETCH ; ( -- addr c1c2 ) + .dw XT_COMMA ; ( -- addr ) + .dw XT_CELLPLUS ; ( -- addr+cell ) + .dw XT_DOLOOP + .dw PFA_SCOMMA1 +PFA_SCOMMA2: + .dw XT_R_FROM + .dw XT_GREATERZERO + .dw XT_DOCONDBRANCH + .dw PFA_SCOMMA3 + .dw XT_DUP ; well, tricky + .dw XT_CFETCH + .dw XT_COMMA +PFA_SCOMMA3: + .dw XT_DROP ; ( -- ) + .dw XT_EXIT diff --git a/amforth-6.5/avr8/words/set-current.asm b/amforth-6.5/avr8/words/set-current.asm new file mode 100644 index 0000000..334e167 --- /dev/null +++ b/amforth-6.5/avr8/words/set-current.asm @@ -0,0 +1,15 @@ +; ( wid -- ) +; Search Order +; set current word list to the given word list wid +VE_SET_CURRENT: + .dw $ff0b + .db "set-current",0 + .dw VE_HEAD + .set VE_HEAD = VE_SET_CURRENT +XT_SET_CURRENT: + .dw DO_COLON +PFA_SET_CURRENT: + .dw XT_DOLITERAL + .dw CFG_CURRENT + .dw XT_STOREE + .dw XT_EXIT diff --git a/amforth-6.5/avr8/words/slashmod.asm b/amforth-6.5/avr8/words/slashmod.asm new file mode 100644 index 0000000..2772651 --- /dev/null +++ b/amforth-6.5/avr8/words/slashmod.asm @@ -0,0 +1,66 @@ +; ( n1 n2 -- rem quot) +; Arithmetics +; signed division n1/n2 with remainder and quotient +VE_SLASHMOD: + .dw $ff04 + .db "/mod" + .dw VE_HEAD + .set VE_HEAD = VE_SLASHMOD +XT_SLASHMOD: + .dw PFA_SLASHMOD +PFA_SLASHMOD: + movw temp2, tosl + + ld temp0, Y+ + ld temp1, Y+ + + mov temp6,temp1 ;move dividend High to sign register + eor temp6,temp3 ;xor divisor High with sign register + sbrs temp1,7 ;if MSB in dividend set + rjmp PFA_SLASHMOD_1 + com temp1 ; change sign of dividend + com temp0 + subi temp0,low(-1) + sbci temp1,high(-1) +PFA_SLASHMOD_1: + sbrs temp3,7 ;if MSB in divisor set + rjmp PFA_SLASHMOD_2 + com temp3 ; change sign of divisor + com temp2 + subi temp2,low(-1) + sbci temp3,high(-1) +PFA_SLASHMOD_2: clr temp4 ;clear remainder Low byte + sub temp5,temp5;clear remainder High byte and carry + ldi temp7,17 ;init loop counter + +PFA_SLASHMOD_3: rol temp0 ;shift left dividend + rol temp1 + dec temp7 ;decrement counter + brne PFA_SLASHMOD_5 ;if done + sbrs temp6,7 ; if MSB in sign register set + rjmp PFA_SLASHMOD_4 + com temp1 ; change sign of result + com temp0 + subi temp0,low(-1) + sbci temp1,high(-1) +PFA_SLASHMOD_4: rjmp PFA_SLASHMODmod_done ; return +PFA_SLASHMOD_5: rol temp4 ;shift dividend into remainder + rol temp5 + sub temp4,temp2 ;remainder = remainder - divisor + sbc temp5,temp3 ; + brcc PFA_SLASHMOD_6 ;if result negative + add temp4,temp2 ; restore remainder + adc temp5,temp3 + clc ; clear carry to be shifted into result + rjmp PFA_SLASHMOD_3 ;else +PFA_SLASHMOD_6: sec ; set carry to be shifted into result + rjmp PFA_SLASHMOD_3 + +PFA_SLASHMODmod_done: + ; put remainder on stack + st -Y,temp5 + st -Y,temp4 + + ; put quotient on stack + movw tosl, temp0 + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/sp0.asm b/amforth-6.5/avr8/words/sp0.asm new file mode 100644 index 0000000..324c1cf --- /dev/null +++ b/amforth-6.5/avr8/words/sp0.asm @@ -0,0 +1,27 @@ +; ( -- addr) +; Stack +; start address of the data stack +VE_SP0: + .dw $ff03 + .db "sp0",0 + .dw VE_HEAD + .set VE_HEAD = VE_SP0 +XT_SP0: + .dw PFA_DOVALUE1 +PFA_SP0: + .dw USER_SP0 + .dw XT_UDEFERFETCH + .dw XT_UDEFERSTORE + +; ( -- addr) +; Stack +; address of user variable to store top-of-stack for inactive tasks +VE_SP: + .dw $ff02 + .db "sp" + .dw VE_HEAD + .set VE_HEAD = VE_SP +XT_SP: + .dw PFA_DOUSER +PFA_SP: + .dw USER_SP diff --git a/amforth-6.5/avr8/words/spfetch.asm b/amforth-6.5/avr8/words/spfetch.asm new file mode 100644 index 0000000..69a0709 --- /dev/null +++ b/amforth-6.5/avr8/words/spfetch.asm @@ -0,0 +1,14 @@ +; ( -- addr ) +; Stack +; current data stack pointer +VE_SP_FETCH: + .dw $ff03 + .db "sp@",0 + .dw VE_HEAD + .set VE_HEAD = VE_SP_FETCH +XT_SP_FETCH: + .dw PFA_SP_FETCH +PFA_SP_FETCH: + savetos + movw tosl, yl + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/spirw.asm b/amforth-6.5/avr8/words/spirw.asm new file mode 100644 index 0000000..bd6616a --- /dev/null +++ b/amforth-6.5/avr8/words/spirw.asm @@ -0,0 +1,26 @@ +; ( txbyte -- rxbyte) +; MCU +; SPI exchange of 1 byte +VE_SPIRW: + .dw $ff06 + .db "c!@spi" + .dw VE_HEAD + .set VE_HEAD = VE_SPIRW +XT_SPIRW: + .dw PFA_SPIRW +PFA_SPIRW: + rcall do_spirw + clr tosh + jmp_ DO_NEXT + +do_spirw: + out_ SPDR, tosl +do_spirw1: + in_ temp0, SPSR + cbr temp0,7 + out_ SPSR, temp0 + in_ temp0, SPSR + sbrs temp0, 7 + rjmp do_spirw1 ; wait until complete + in_ tosl, SPDR + ret diff --git a/amforth-6.5/avr8/words/spstore.asm b/amforth-6.5/avr8/words/spstore.asm new file mode 100644 index 0000000..004d348 --- /dev/null +++ b/amforth-6.5/avr8/words/spstore.asm @@ -0,0 +1,14 @@ +; ( addr -- i*x) +; Stack +; set data stack pointer to addr +VE_SP_STORE: + .dw $ff03 + .db "sp!",0 + .dw VE_HEAD + .set VE_HEAD = VE_SP_STORE +XT_SP_STORE: + .dw PFA_SP_STORE +PFA_SP_STORE: + movw yl, tosl + loadtos + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/state.asm b/amforth-6.5/avr8/words/state.asm new file mode 100644 index 0000000..31895fd --- /dev/null +++ b/amforth-6.5/avr8/words/state.asm @@ -0,0 +1,16 @@ +; ( -- addr ) +; System Variable +; system state +VE_STATE: + .dw $ff05 + .db "state",0 + .dw VE_HEAD + .set VE_HEAD = VE_STATE +XT_STATE: + .dw PFA_DOVARIABLE +PFA_STATE: + .dw ram_state + +.dseg +ram_state: .byte 2 +.cseg \ No newline at end of file diff --git a/amforth-6.5/avr8/words/store-e.asm b/amforth-6.5/avr8/words/store-e.asm new file mode 100644 index 0000000..45fff2a --- /dev/null +++ b/amforth-6.5/avr8/words/store-e.asm @@ -0,0 +1,66 @@ +; ( n e-addr -- ) +; Memory +; write n (2bytes) to eeprom address +VE_STOREE: + .dw $ff02 + .db "!e" + .dw VE_HEAD + .set VE_HEAD = VE_STOREE +XT_STOREE: + .dw PFA_STOREE +PFA_STOREE: +.if WANT_UNIFIED == 1 + ldi zh, high(EEPROMEND) + ldi zl, low(EEPROMEND) + cp tosl, zl + cpc tosh, zh + brlt PFA_STOREE0 + brbs 1, PFA_STOREE0 + rjmp PFA_STOREE_OTHER +.endif +PFA_STOREE0: + movw zl, tosl + loadtos + in_ temp2, SREG + cli + rcall PFA_FETCHE2 + in_ temp0, EEDR + cp temp0,tosl + breq PFA_STOREE3 + rcall PFA_STOREE1 +PFA_STOREE3: + adiw zl,1 + rcall PFA_FETCHE2 + in_ temp0, EEDR + cp temp0,tosh + breq PFA_STOREE4 + mov tosl, tosh + rcall PFA_STOREE1 +PFA_STOREE4: + out_ SREG, temp2 + loadtos + jmp_ DO_NEXT + +PFA_STOREE1: + sbic EECR, EEPE + rjmp PFA_STOREE1 + +PFA_STOREE2: ; estore_wait_low_spm: + in_ temp0, SPMCSR + sbrc temp0,SPMEN + rjmp PFA_STOREE2 + + out_ EEARH,zh + out_ EEARL,zl + out_ EEDR, tosl + sbi EECR,EEMPE + sbi EECR,EEPE + + ret +.if WANT_UNIFIED == 1 +PFA_STOREE_OTHER: + adiw zl, 1 + sub tosl, zl + sbc tosh, zh + jmp_ PFA_STOREI +.endif diff --git a/amforth-6.5/avr8/words/store-i.asm b/amforth-6.5/avr8/words/store-i.asm new file mode 100644 index 0000000..a56fce2 --- /dev/null +++ b/amforth-6.5/avr8/words/store-i.asm @@ -0,0 +1,14 @@ +; ( n addr -- ) +; System Value +; Deferred action to write a single 16bit cell to flash +VE_STOREI: + .dw $ff02 + .db "!i" + .dw VE_HEAD + .set VE_HEAD = VE_STOREI +XT_STOREI: + .dw PFA_DODEFER1 +PFA_STOREI: + .dw EE_STOREI + .dw XT_EDEFERFETCH + .dw XT_EDEFERSTORE diff --git a/amforth-6.5/avr8/words/store-i_big.asm b/amforth-6.5/avr8/words/store-i_big.asm new file mode 100644 index 0000000..422da39 --- /dev/null +++ b/amforth-6.5/avr8/words/store-i_big.asm @@ -0,0 +1,129 @@ +; ( n addr -- ) Memory +; R( -- ) +; writes a cell in flash +VE_DO_STOREI_BIG: + .dw $ff04 + .db "(i!)" + .dw VE_HEAD + .set VE_HEAD = VE_DO_STOREI_BIG +XT_DO_STOREI: + .dw PFA_DO_STOREI_BIG +PFA_DO_STOREI_BIG: + movw temp2, tosl ; save the (word) address + loadtos ; get the new value for the flash cell + push xl + push xh + push yl + push yh + ldi zl, byte3(DO_STOREI_atmega) + out_ rampz, zl + ldi zh, byte2(DO_STOREI_atmega) + ldi zl, byte1(DO_STOREI_atmega) + eicall + pop yh + pop yl + pop xh + pop xl + ; finally clear the stack + loadtos + jmp_ DO_NEXT + +; +.set _pc = pc +.org NRWW_START_ADDR +DO_STOREI_atmega: + ; write data to temp page buffer + ; use the values in tosl/tosh at the + ; appropiate place + rcall pageload + + ; erase page if needed + ; it is needed if a bit goes from 0 to 1 + com temp4 + com temp5 + and tosl, temp4 + and tosh, temp5 + or tosh, tosl + breq DO_STOREI_writepage + + movw zl, temp2 + ldi temp0,(1<body",0 + .dw VE_HEAD + .set VE_HEAD = VE_TO_BODY +XT_TO_BODY: + .dw PFA_1PLUS diff --git a/amforth-6.5/avr8/words/to_r.asm b/amforth-6.5/avr8/words/to_r.asm new file mode 100644 index 0000000..3e038de --- /dev/null +++ b/amforth-6.5/avr8/words/to_r.asm @@ -0,0 +1,15 @@ +; ( n -- ) (R: -- n) +; Stack +; move TOS to TOR +VE_TO_R: + .dw $ff02 + .db ">r" + .dw VE_HEAD + .set VE_HEAD = VE_TO_R +XT_TO_R: + .dw PFA_TO_R +PFA_TO_R: + push tosh + push tosl + loadtos + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/true.asm b/amforth-6.5/avr8/words/true.asm new file mode 100644 index 0000000..9b64014 --- /dev/null +++ b/amforth-6.5/avr8/words/true.asm @@ -0,0 +1,16 @@ +; ( -- -1 ) +; Arithmetics +; leaves the value -1 (true) on TOS +VE_TRUE: + .dw $ff04 + .db "true" + .dw VE_HEAD + .set VE_HEAD = VE_TRUE +XT_TRUE: + .dw PFA_TRUE +PFA_TRUE: + savetos +PFA_TRUE1: + ser tosl + ser tosh + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/turnkey.asm b/amforth-6.5/avr8/words/turnkey.asm new file mode 100644 index 0000000..6f8e0c4 --- /dev/null +++ b/amforth-6.5/avr8/words/turnkey.asm @@ -0,0 +1,14 @@ +; ( -- n*y ) +; System Value +; Deferred action during startup/reset +VE_TURNKEY: + .dw $ff07 + .db "turnkey",0 + .dw VE_HEAD + .set VE_HEAD = VE_TURNKEY +XT_TURNKEY: + .dw PFA_DODEFER1 +PFA_TURNKEY: + .dw CFG_TURNKEY + .dw XT_EDEFERFETCH + .dw XT_EDEFERSTORE diff --git a/amforth-6.5/avr8/words/ubrr.asm b/amforth-6.5/avr8/words/ubrr.asm new file mode 100644 index 0000000..40f4304 --- /dev/null +++ b/amforth-6.5/avr8/words/ubrr.asm @@ -0,0 +1,14 @@ +; ( -- v) +; MCU +; returns usart UBRR settings +VE_UBRR: + .dw $ff04 + .db "ubrr" + .dw VE_HEAD + .set VE_HEAD = VE_UBRR +XT_UBRR: + .dw PFA_DOVALUE1 +PFA_UBRR: ; ( -- ) + .dw EE_UBRRVAL + .dw XT_EDEFERFETCH + .dw XT_EDEFERSTORE diff --git a/amforth-6.5/avr8/words/uless.asm b/amforth-6.5/avr8/words/uless.asm new file mode 100644 index 0000000..69d5a6b --- /dev/null +++ b/amforth-6.5/avr8/words/uless.asm @@ -0,0 +1,18 @@ +; ( u1 u2 -- flasg) +; Compare +; true if u1 < u2 (unsigned) +VE_ULESS: + .dw $ff02 + .db "u<" + .dw VE_HEAD + .set VE_HEAD = VE_ULESS +XT_ULESS: + .dw PFA_ULESS +PFA_ULESS: + ld temp2, Y+ + ld temp3, Y+ + cp tosl, temp2 + cpc tosh, temp3 + brlo PFA_ZERO1 + brbs 1, PFA_ZERO1 + jmp_ PFA_TRUE1 diff --git a/amforth-6.5/avr8/words/umslashmod.asm b/amforth-6.5/avr8/words/umslashmod.asm new file mode 100644 index 0000000..6adfbb1 --- /dev/null +++ b/amforth-6.5/avr8/words/umslashmod.asm @@ -0,0 +1,62 @@ +; ( ud u2 -- rem quot) +; Arithmetics +; unsigned division ud / u2 with remainder +VE_UMSLASHMOD: + .dw $ff06 + .db "um/mod" + .dw VE_HEAD + .set VE_HEAD = VE_UMSLASHMOD +XT_UMSLASHMOD: + .dw PFA_UMSLASHMOD +PFA_UMSLASHMOD: + movw temp4, tosl + + ld temp2, Y+ + ld temp3, Y+ + + ld temp0, Y+ + ld temp1, Y+ + +;; unsigned 32/16 -> 16r16 divide + +PFA_UMSLASHMODmod: + + ; set loop counter + ldi temp6,$10 + +PFA_UMSLASHMODmod_loop: + ; shift left, saving high bit + clr temp7 + lsl temp0 + rol temp1 + rol temp2 + rol temp3 + rol temp7 + + ; try subtracting divisor + cp temp2, temp4 + cpc temp3, temp5 + cpc temp7,zerol + + brcs PFA_UMSLASHMODmod_loop_control + +PFA_UMSLASHMODmod_subtract: + ; dividend is large enough + ; do the subtraction for real + ; and set lowest bit + inc temp0 + sub temp2, temp4 + sbc temp3, temp5 + +PFA_UMSLASHMODmod_loop_control: + dec temp6 + brne PFA_UMSLASHMODmod_loop + +PFA_UMSLASHMODmod_done: + ; put remainder on stack + st -Y,temp3 + st -Y,temp2 + + ; put quotient on stack + movw tosl, temp0 + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/umstar.asm b/amforth-6.5/avr8/words/umstar.asm new file mode 100644 index 0000000..ee53c87 --- /dev/null +++ b/amforth-6.5/avr8/words/umstar.asm @@ -0,0 +1,37 @@ +; ( u1 u2 -- d) +; Arithmetics +; multiply 2 unsigned cells to a double cell +VE_UMSTAR: + .dw $ff03 + .db "um*",0 + .dw VE_HEAD + .set VE_HEAD = VE_UMSTAR +XT_UMSTAR: + .dw PFA_UMSTAR +PFA_UMSTAR: + movw temp0, tosl + loadtos + ; result: (temp3*temp1)* 65536 + (temp3*temp0 + temp1*temp2) * 256 + (temp0 * temp2) + ; low bytes + mul tosl,temp0 + movw zl, r0 + clr temp2 + clr temp3 + ; middle bytes + mul tosh, temp0 + add zh, r0 + adc temp2, r1 + adc temp3, zeroh + + mul tosl, temp1 + add zh, r0 + adc temp2, r1 + adc temp3, zeroh + + mul tosh, temp1 + add temp2, r0 + adc temp3, r1 + movw tosl, zl + savetos + movw tosl, temp2 + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/unloop.asm b/amforth-6.5/avr8/words/unloop.asm new file mode 100644 index 0000000..f4fb4bc --- /dev/null +++ b/amforth-6.5/avr8/words/unloop.asm @@ -0,0 +1,16 @@ +; ( -- ) (R: loop-sys -- ) +; Compiler +; remove loop-sys, exit the loop and continue execution after it +VE_UNLOOP: + .dw $ff06 + .db "unloop" + .dw VE_HEAD + .set VE_HEAD = VE_UNLOOP +XT_UNLOOP: + .dw PFA_UNLOOP +PFA_UNLOOP: + pop temp1 + pop temp0 + pop temp1 + pop temp0 + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/unused.asm b/amforth-6.5/avr8/words/unused.asm new file mode 100644 index 0000000..16566d4 --- /dev/null +++ b/amforth-6.5/avr8/words/unused.asm @@ -0,0 +1,15 @@ +; ( -- n ) +; Tools +; Amount of available RAM (incl. PAD) +VE_UNUSED: + .dw $ff06 + .db "unused" + .dw VE_HEAD + .set VE_HEAD = VE_UNUSED +XT_UNUSED: + .dw DO_COLON +PFA_UNUSED: + .dw XT_SP_FETCH + .dw XT_HERE + .dw XT_MINUS + .dw XT_EXIT diff --git a/amforth-6.5/avr8/words/up.asm b/amforth-6.5/avr8/words/up.asm new file mode 100644 index 0000000..0edfc01 --- /dev/null +++ b/amforth-6.5/avr8/words/up.asm @@ -0,0 +1,29 @@ +; ( -- addr ) +; System Variable +; get user area pointer +VE_UP_FETCH: + .dw $ff03 + .db "up@",0 + .dw VE_HEAD + .set VE_HEAD = VE_UP_FETCH +XT_UP_FETCH: + .dw PFA_UP_FETCH +PFA_UP_FETCH: + savetos + movw tosl, upl + jmp_ DO_NEXT + +; ( addr -- ) +; System Variable +; set user area pointer +VE_UP_STORE: + .dw $ff03 + .db "up!",0 + .dw VE_HEAD + .set VE_HEAD = VE_UP_STORE +XT_UP_STORE: + .dw PFA_UP_STORE +PFA_UP_STORE: + movw upl, tosl + loadtos + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/usart-rx-poll.asm b/amforth-6.5/avr8/words/usart-rx-poll.asm new file mode 100644 index 0000000..9896175 --- /dev/null +++ b/amforth-6.5/avr8/words/usart-rx-poll.asm @@ -0,0 +1,42 @@ +; (c -- ) +; MCU +; wait for one character and read it from the terminal connection using register poll +VE_RX_POLL: + .dw $ff07 + .db "rx-poll",0 + .dw VE_HEAD + .set VE_HEAD = VE_RX_POLL +XT_RX_POLL: + .dw DO_COLON +PFA_RX_POLL: + ; wait for data ready + .dw XT_RXQ_POLL + .dw XT_DOCONDBRANCH + .dw PFA_RX_POLL + ; send to usart + .dw XT_DOLITERAL + .dw USART_DATA + .dw XT_CFETCH + .dw XT_EXIT + +; ( -- f) +; MCU +; check if a unread character in the input device is available +VE_RXQ_POLL: + .dw $ff08 + .db "rx?-poll" + .dw VE_HEAD + .set VE_HEAD = VE_RXQ_POLL +XT_RXQ_POLL: + .dw DO_COLON +PFA_RXQ_POLL: + .dw XT_PAUSE + .dw XT_DOLITERAL + .dw bm_USART_RXRD + .dw XT_DUP + .dw XT_DOLITERAL + .dw USART_A + .dw XT_CFETCH + .dw XT_AND + .dw XT_EQUAL + .dw XT_EXIT diff --git a/amforth-6.5/avr8/words/usart-tx-poll.asm b/amforth-6.5/avr8/words/usart-tx-poll.asm new file mode 100644 index 0000000..a33e8fb --- /dev/null +++ b/amforth-6.5/avr8/words/usart-tx-poll.asm @@ -0,0 +1,40 @@ +; (c -- ) +; MCU +; check availability and send one character to the terminal using register poll +VE_TX_POLL: + .dw $ff07 + .db "tx-poll",0 + .dw VE_HEAD + .set VE_HEAD = VE_TX_POLL +XT_TX_POLL: + .dw DO_COLON +PFA_TX_POLL: + ; wait for data ready + .dw XT_TXQ_POLL + .dw XT_DOCONDBRANCH + .dw PFA_TX_POLL + ; send to usart + .dw XT_DOLITERAL + .dw USART_DATA + .dw XT_CSTORE + .dw XT_EXIT + +; ( -- f) MCU +; MCU +; check if a character can be send using register poll +VE_TXQ_POLL: + .dw $ff08 + .db "tx?-poll" + .dw VE_HEAD + .set VE_HEAD = VE_TXQ_POLL +XT_TXQ_POLL: + .dw DO_COLON +PFA_TXQ_POLL: + .dw XT_PAUSE + .dw XT_DOLITERAL + .dw USART_A + .dw XT_CFETCH + .dw XT_DOLITERAL + .dw bm_USART_TXRD + .dw XT_AND + .dw XT_EXIT diff --git a/amforth-6.5/avr8/words/usart.asm b/amforth-6.5/avr8/words/usart.asm new file mode 100644 index 0000000..f14e62f --- /dev/null +++ b/amforth-6.5/avr8/words/usart.asm @@ -0,0 +1,41 @@ +; ( -- ) +; MCU +; initialize usart +VE_USART: + .dw $ff06 + .db "+usart" + .dw VE_HEAD + .set VE_HEAD = VE_USART +XT_USART: + .dw DO_COLON +PFA_USART: ; ( -- ) + + .dw XT_DOLITERAL + .dw USART_B_VALUE + .dw XT_DOLITERAL + .dw USART_B + .dw XT_CSTORE + + .dw XT_DOLITERAL + .dw USART_C_VALUE + .dw XT_DOLITERAL + .dw USART_C | bm_USARTC_en + .dw XT_CSTORE + + .dw XT_UBRR + .dw XT_DUP + .dw XT_BYTESWAP + .dw XT_DOLITERAL + .dw BAUDRATE_HIGH + .dw XT_CSTORE + .dw XT_DOLITERAL + .dw BAUDRATE_LOW + .dw XT_CSTORE +.if XT_USART_INIT_RX!=0 + .dw XT_USART_INIT_RX +.endif +.if XT_USART_INIT_TX!=0 + .dw XT_USART_INIT_TX +.endif + + .dw XT_EXIT diff --git a/amforth-6.5/avr8/words/user.asm b/amforth-6.5/avr8/words/user.asm new file mode 100644 index 0000000..c11f600 --- /dev/null +++ b/amforth-6.5/avr8/words/user.asm @@ -0,0 +1,18 @@ +; ( n cchar -- ) +; Compiler +; create a dictionary entry for a user variable at offset n +VE_USER: + .dw $ff04 + .db "user" + .dw VE_HEAD + .set VE_HEAD = VE_USER +XT_USER: + .dw DO_COLON +PFA_USER: + .dw XT_DOCREATE + .dw XT_REVEAL + + .dw XT_COMPILE + .dw PFA_DOUSER + .dw XT_COMMA + .dw XT_EXIT diff --git a/amforth-6.5/avr8/words/uslashmod.asm b/amforth-6.5/avr8/words/uslashmod.asm new file mode 100644 index 0000000..0d9b5aa --- /dev/null +++ b/amforth-6.5/avr8/words/uslashmod.asm @@ -0,0 +1,16 @@ +; (u1 u2 -- rem quot) +; Arithmetics +; unsigned division with remainder +VE_USLASHMOD: + .dw $ff05 + .db "u/mod",0 + .dw VE_HEAD + .set VE_HEAD = VE_USLASHMOD +XT_USLASHMOD: + .dw DO_COLON +PFA_USLASHMOD: + .dw XT_TO_R + .dw XT_ZERO + .dw XT_R_FROM + .dw XT_UMSLASHMOD + .dw XT_EXIT diff --git a/amforth-6.5/avr8/words/wdr.asm b/amforth-6.5/avr8/words/wdr.asm new file mode 100644 index 0000000..b2c78f6 --- /dev/null +++ b/amforth-6.5/avr8/words/wdr.asm @@ -0,0 +1,13 @@ +; ( -- ) +; MCU +; calls the MCU watch dog reset instruction +VE_WDR: + .dw $ff03 + .db "wdr",0 + .dw VE_HEAD + .set VE_HEAD = VE_WDR +XT_WDR: + .dw PFA_WDR +PFA_WDR: + wdr + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/wlscope.asm b/amforth-6.5/avr8/words/wlscope.asm new file mode 100644 index 0000000..cbef8c2 --- /dev/null +++ b/amforth-6.5/avr8/words/wlscope.asm @@ -0,0 +1,22 @@ +; ( addr len -- addr' len' wid ) +; Compiler +; dynamically place a word in a wordlist. The word name may be changed. +VE_WLSCOPE: + .dw $ff07 + .db "wlscope",0 + .dw VE_HEAD + .set VE_HEAD = VE_WLSCOPE +XT_WLSCOPE: + .dw PFA_DODEFER1 +PFA_WLSCOPE: + .dw CFG_WLSCOPE + .dw XT_EDEFERFETCH + .dw XT_EDEFERSTORE + +; wlscope, "wordlist scope" ( addr len -- addr' len' wid ), is a deferred word +; which enables the AmForth application to choose the wordlist ( wid ) for the +; new voc entry based on the input ( addr len ) string. The name of the new voc +; entry ( addr' len' ) may be different from the input string. Note that all +; created voc entry types pass through the wlscope mechanism. The default +; wlscope action passes the input string to the output without modification and +; uses get-current to select the wid. diff --git a/amforth-6.5/avr8/words/wordlist.asm b/amforth-6.5/avr8/words/wordlist.asm new file mode 100644 index 0000000..d5d2980 --- /dev/null +++ b/amforth-6.5/avr8/words/wordlist.asm @@ -0,0 +1,20 @@ +; ( -- wid ) +; Search Order +; create a new, empty wordlist +VE_WORDLIST: + .dw $ff08 + .db "wordlist" + .dw VE_HEAD + .set VE_HEAD = VE_WORDLIST +XT_WORDLIST: + .dw DO_COLON +PFA_WORDLIST: + .dw XT_EHERE + .dw XT_ZERO + .dw XT_OVER + .dw XT_STOREE + .dw XT_DUP + .dw XT_CELLPLUS + .dw XT_DOTO + .dw PFA_EHERE + .dw XT_EXIT diff --git a/amforth-6.5/avr8/words/xor.asm b/amforth-6.5/avr8/words/xor.asm new file mode 100644 index 0000000..337259c --- /dev/null +++ b/amforth-6.5/avr8/words/xor.asm @@ -0,0 +1,16 @@ +; ( n1 n2 -- n3) +; Logic +; exclusive or +VE_XOR: + .dw $ff03 + .db "xor",0 + .dw VE_HEAD + .set VE_HEAD = VE_XOR +XT_XOR: + .dw PFA_XOR +PFA_XOR: + ld temp0, Y+ + ld temp1, Y+ + eor tosl, temp0 + eor tosh, temp1 + jmp_ DO_NEXT diff --git a/amforth-6.5/avr8/words/zero.asm b/amforth-6.5/avr8/words/zero.asm new file mode 100644 index 0000000..a03942c --- /dev/null +++ b/amforth-6.5/avr8/words/zero.asm @@ -0,0 +1,15 @@ +; ( -- 0 ) +; Arithmetics +; place a value 0 on TOS +VE_ZERO: + .dw $ff01 + .db "0",0 + .dw VE_HEAD + .set VE_HEAD = VE_ZERO +XT_ZERO: + .dw PFA_ZERO +PFA_ZERO: + savetos +PFA_ZERO1: + movw tosl, zerol + jmp_ DO_NEXT -- cgit v1.2.3