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/common/words/2drop.asm | 21 +++++ amforth-6.5/common/words/2dup.asm | 22 ++++++ amforth-6.5/common/words/2literal.asm | 21 +++++ amforth-6.5/common/words/2swap.asm | 24 ++++++ amforth-6.5/common/words/_template.asm | 8 ++ amforth-6.5/common/words/abort-string.asm | 29 +++++++ amforth-6.5/common/words/abort.asm | 19 +++++ amforth-6.5/common/words/abs.asm | 20 +++++ amforth-6.5/common/words/accept.asm | 95 +++++++++++++++++++++++ amforth-6.5/common/words/again.asm | 22 ++++++ amforth-6.5/common/words/ahead.asm | 22 ++++++ amforth-6.5/common/words/backslash.asm | 30 ++++++++ amforth-6.5/common/words/base.asm | 19 +++++ amforth-6.5/common/words/begin.asm | 20 +++++ amforth-6.5/common/words/bin.asm | 22 ++++++ amforth-6.5/common/words/bl.asm | 19 +++++ amforth-6.5/common/words/bounds.asm | 22 ++++++ amforth-6.5/common/words/bracketchar.asm | 23 ++++++ amforth-6.5/common/words/bracketcompile.asm | 23 ++++++ amforth-6.5/common/words/brackettick.asm | 21 +++++ amforth-6.5/common/words/build-info.tmpl | 26 +++++++ amforth-6.5/common/words/catch.asm | 39 ++++++++++ amforth-6.5/common/words/cfg-order.asm | 19 +++++ amforth-6.5/common/words/cfg-recognizer.asm | 19 +++++ amforth-6.5/common/words/char.asm | 22 ++++++ amforth-6.5/common/words/colon.asm | 22 ++++++ amforth-6.5/common/words/compile.asm | 25 ++++++ amforth-6.5/common/words/constant.asm | 25 ++++++ amforth-6.5/common/words/cr.asm | 26 +++++++ amforth-6.5/common/words/create.asm | 23 ++++++ amforth-6.5/common/words/cscan.asm | 56 ++++++++++++++ amforth-6.5/common/words/cskip.asm | 37 +++++++++ amforth-6.5/common/words/d-dot-r.asm | 35 +++++++++ amforth-6.5/common/words/d-dot.asm | 24 ++++++ amforth-6.5/common/words/decimal.asm | 23 ++++++ amforth-6.5/common/words/defer-fetch.asm | 24 ++++++ amforth-6.5/common/words/defer-store.asm | 26 +++++++ amforth-6.5/common/words/depth.asm | 23 ++++++ amforth-6.5/common/words/digit-q.asm | 24 ++++++ amforth-6.5/common/words/do-create.asm | 22 ++++++ amforth-6.5/common/words/do.asm | 25 ++++++ amforth-6.5/common/words/dot-quote.asm | 31 ++++++++ amforth-6.5/common/words/dot-r.asm | 32 ++++++++ amforth-6.5/common/words/dot-s.asm | 42 ++++++++++ amforth-6.5/common/words/dot.asm | 24 ++++++ amforth-6.5/common/words/dt-null.asm | 41 ++++++++++ amforth-6.5/common/words/else.asm | 24 ++++++ amforth-6.5/common/words/emit.asm | 21 +++++ amforth-6.5/common/words/emitq.asm | 21 +++++ amforth-6.5/common/words/endloop.asm | 28 +++++++ amforth-6.5/common/words/env-cpu.asm | 22 ++++++ amforth-6.5/common/words/env-forthname.asm | 26 +++++++ amforth-6.5/common/words/env-forthversion.asm | 20 +++++ amforth-6.5/common/words/env-slashhold.asm | 22 ++++++ amforth-6.5/common/words/env-usersize.asm | 21 +++++ amforth-6.5/common/words/f_cpu.asm | 22 ++++++ amforth-6.5/common/words/find-xt.asm | 55 ++++++++++++++ amforth-6.5/common/words/get-order.asm | 22 ++++++ amforth-6.5/common/words/get-recognizer.asm | 22 ++++++ amforth-6.5/common/words/get-stack.asm | 46 +++++++++++ amforth-6.5/common/words/git-info.tmpl | 27 +++++++ amforth-6.5/common/words/handler.asm | 19 +++++ amforth-6.5/common/words/hex.asm | 23 ++++++ amforth-6.5/common/words/hold.asm | 29 +++++++ amforth-6.5/common/words/if.asm | 22 ++++++ amforth-6.5/common/words/interpret.asm | 38 ++++++++++ amforth-6.5/common/words/key.asm | 21 +++++ amforth-6.5/common/words/keyq.asm | 21 +++++ amforth-6.5/common/words/l-from.asm | 27 +++++++ amforth-6.5/common/words/l-paren.asm | 23 ++++++ amforth-6.5/common/words/leave.asm | 20 +++++ amforth-6.5/common/words/left-bracket.asm | 22 ++++++ amforth-6.5/common/words/less-sharp.asm | 22 ++++++ amforth-6.5/common/words/literal.asm | 22 ++++++ amforth-6.5/common/words/loop.asm | 22 ++++++ amforth-6.5/common/words/map-stack.asm | 61 +++++++++++++++ amforth-6.5/common/words/max.asm | 27 +++++++ amforth-6.5/common/words/min.asm | 28 +++++++ amforth-6.5/common/words/mod.asm | 23 ++++++ amforth-6.5/common/words/name2compile.asm | 31 ++++++++ amforth-6.5/common/words/name2interpret.asm | 19 +++++ amforth-6.5/common/words/name2string.asm | 24 ++++++ amforth-6.5/common/words/noop.asm | 19 +++++ amforth-6.5/common/words/not-equal.asm | 20 +++++ amforth-6.5/common/words/num-constants.asm | 51 +++++++++++++ amforth-6.5/common/words/number.asm | 101 +++++++++++++++++++++++++ amforth-6.5/common/words/pad.asm | 23 ++++++ amforth-6.5/common/words/parse-name.asm | 60 +++++++++++++++ amforth-6.5/common/words/parse.asm | 33 ++++++++ amforth-6.5/common/words/pick.asm | 21 +++++ amforth-6.5/common/words/place.asm | 24 ++++++ amforth-6.5/common/words/plusloop.asm | 22 ++++++ amforth-6.5/common/words/postpone.asm | 32 ++++++++ amforth-6.5/common/words/prompt-error.asm | 64 ++++++++++++++++ amforth-6.5/common/words/prompt-ok.asm | 52 +++++++++++++ amforth-6.5/common/words/prompt-ready.asm | 54 +++++++++++++ amforth-6.5/common/words/q-abort.asm | 22 ++++++ amforth-6.5/common/words/q-dnegate.asm | 21 +++++ amforth-6.5/common/words/q-negate.asm | 22 ++++++ amforth-6.5/common/words/q-sign.asm | 24 ++++++ amforth-6.5/common/words/q-stack.asm | 26 +++++++ amforth-6.5/common/words/qdo.asm | 54 +++++++++++++ amforth-6.5/common/words/quit.asm | 58 ++++++++++++++ amforth-6.5/common/words/rdefer-fetch.asm | 20 +++++ amforth-6.5/common/words/rdefer-store.asm | 21 +++++ amforth-6.5/common/words/rec-find.asm | 85 +++++++++++++++++++++ amforth-6.5/common/words/rec-intnum.asm | 76 +++++++++++++++++++ amforth-6.5/common/words/recognize.asm | 73 ++++++++++++++++++ amforth-6.5/common/words/recurse.asm | 22 ++++++ amforth-6.5/common/words/refill.asm | 21 +++++ amforth-6.5/common/words/repeat.asm | 21 +++++ amforth-6.5/common/words/reveal.asm | 25 ++++++ amforth-6.5/common/words/right-bracket.asm | 22 ++++++ amforth-6.5/common/words/s-to-d.asm | 20 +++++ amforth-6.5/common/words/search-wordlist.asm | 72 ++++++++++++++++++ amforth-6.5/common/words/semicolon.asm | 25 ++++++ amforth-6.5/common/words/set-base.asm | 58 ++++++++++++++ amforth-6.5/common/words/set-order.asm | 23 ++++++ amforth-6.5/common/words/set-recognizer.asm | 23 ++++++ amforth-6.5/common/words/set-stack.asm | 43 +++++++++++ amforth-6.5/common/words/sharp-greater.asm | 25 ++++++ amforth-6.5/common/words/sharp-s.asm | 26 +++++++ amforth-6.5/common/words/sharp.asm | 41 ++++++++++ amforth-6.5/common/words/show-wordlist.asm | 38 ++++++++++ amforth-6.5/common/words/sign.asm | 26 +++++++ amforth-6.5/common/words/slash-string.asm | 26 +++++++ amforth-6.5/common/words/slash.asm | 24 ++++++ amforth-6.5/common/words/sliteral.asm | 22 ++++++ amforth-6.5/common/words/source.asm | 23 ++++++ amforth-6.5/common/words/space.asm | 21 +++++ amforth-6.5/common/words/spaces.asm | 27 +++++++ amforth-6.5/common/words/squote.asm | 33 ++++++++ amforth-6.5/common/words/star.asm | 22 ++++++ amforth-6.5/common/words/then.asm | 20 +++++ amforth-6.5/common/words/throw.asm | 39 ++++++++++ amforth-6.5/common/words/tib.asm | 96 +++++++++++++++++++++++ amforth-6.5/common/words/tick.asm | 41 ++++++++++ amforth-6.5/common/words/to-in.asm | 19 +++++ amforth-6.5/common/words/to-l.asm | 25 ++++++ amforth-6.5/common/words/to-lower.asm | 33 ++++++++ amforth-6.5/common/words/to-number.asm | 41 ++++++++++ amforth-6.5/common/words/to-upper.asm | 31 ++++++++ amforth-6.5/common/words/to.asm | 59 +++++++++++++++ amforth-6.5/common/words/traverse-wordlist.asm | 49 ++++++++++++ amforth-6.5/common/words/tuck.asm | 21 +++++ amforth-6.5/common/words/type.asm | 32 ++++++++ amforth-6.5/common/words/u-dot-r.asm | 25 ++++++ amforth-6.5/common/words/u-dot.asm | 22 ++++++ amforth-6.5/common/words/u-greater.asm | 21 +++++ amforth-6.5/common/words/ud-dot-r.asm | 31 ++++++++ amforth-6.5/common/words/ud-dot.asm | 23 ++++++ amforth-6.5/common/words/ud-slash-mod.asm | 28 +++++++ amforth-6.5/common/words/ud-star.asm | 21 +++++ amforth-6.5/common/words/udefer-fetch.asm | 23 ++++++ amforth-6.5/common/words/udefer-store.asm | 25 ++++++ amforth-6.5/common/words/umax.asm | 22 ++++++ amforth-6.5/common/words/umin.asm | 21 +++++ amforth-6.5/common/words/until.asm | 24 ++++++ amforth-6.5/common/words/variable.asm | 24 ++++++ amforth-6.5/common/words/ver.asm | 42 ++++++++++ amforth-6.5/common/words/warm.asm | 27 +++++++ amforth-6.5/common/words/while.asm | 21 +++++ amforth-6.5/common/words/within.asm | 25 ++++++ amforth-6.5/common/words/word.asm | 25 ++++++ amforth-6.5/common/words/words.asm | 25 ++++++ 165 files changed, 4968 insertions(+) create mode 100644 amforth-6.5/common/words/2drop.asm create mode 100644 amforth-6.5/common/words/2dup.asm create mode 100644 amforth-6.5/common/words/2literal.asm create mode 100644 amforth-6.5/common/words/2swap.asm create mode 100644 amforth-6.5/common/words/_template.asm create mode 100644 amforth-6.5/common/words/abort-string.asm create mode 100644 amforth-6.5/common/words/abort.asm create mode 100644 amforth-6.5/common/words/abs.asm create mode 100644 amforth-6.5/common/words/accept.asm create mode 100644 amforth-6.5/common/words/again.asm create mode 100644 amforth-6.5/common/words/ahead.asm create mode 100644 amforth-6.5/common/words/backslash.asm create mode 100644 amforth-6.5/common/words/base.asm create mode 100644 amforth-6.5/common/words/begin.asm create mode 100644 amforth-6.5/common/words/bin.asm create mode 100644 amforth-6.5/common/words/bl.asm create mode 100644 amforth-6.5/common/words/bounds.asm create mode 100644 amforth-6.5/common/words/bracketchar.asm create mode 100644 amforth-6.5/common/words/bracketcompile.asm create mode 100644 amforth-6.5/common/words/brackettick.asm create mode 100644 amforth-6.5/common/words/build-info.tmpl create mode 100644 amforth-6.5/common/words/catch.asm create mode 100644 amforth-6.5/common/words/cfg-order.asm create mode 100644 amforth-6.5/common/words/cfg-recognizer.asm create mode 100644 amforth-6.5/common/words/char.asm create mode 100644 amforth-6.5/common/words/colon.asm create mode 100644 amforth-6.5/common/words/compile.asm create mode 100644 amforth-6.5/common/words/constant.asm create mode 100644 amforth-6.5/common/words/cr.asm create mode 100644 amforth-6.5/common/words/create.asm create mode 100644 amforth-6.5/common/words/cscan.asm create mode 100644 amforth-6.5/common/words/cskip.asm create mode 100644 amforth-6.5/common/words/d-dot-r.asm create mode 100644 amforth-6.5/common/words/d-dot.asm create mode 100644 amforth-6.5/common/words/decimal.asm create mode 100644 amforth-6.5/common/words/defer-fetch.asm create mode 100644 amforth-6.5/common/words/defer-store.asm create mode 100644 amforth-6.5/common/words/depth.asm create mode 100644 amforth-6.5/common/words/digit-q.asm create mode 100644 amforth-6.5/common/words/do-create.asm create mode 100644 amforth-6.5/common/words/do.asm create mode 100644 amforth-6.5/common/words/dot-quote.asm create mode 100644 amforth-6.5/common/words/dot-r.asm create mode 100644 amforth-6.5/common/words/dot-s.asm create mode 100644 amforth-6.5/common/words/dot.asm create mode 100644 amforth-6.5/common/words/dt-null.asm create mode 100644 amforth-6.5/common/words/else.asm create mode 100644 amforth-6.5/common/words/emit.asm create mode 100644 amforth-6.5/common/words/emitq.asm create mode 100644 amforth-6.5/common/words/endloop.asm create mode 100644 amforth-6.5/common/words/env-cpu.asm create mode 100644 amforth-6.5/common/words/env-forthname.asm create mode 100644 amforth-6.5/common/words/env-forthversion.asm create mode 100644 amforth-6.5/common/words/env-slashhold.asm create mode 100644 amforth-6.5/common/words/env-usersize.asm create mode 100644 amforth-6.5/common/words/f_cpu.asm create mode 100644 amforth-6.5/common/words/find-xt.asm create mode 100644 amforth-6.5/common/words/get-order.asm create mode 100644 amforth-6.5/common/words/get-recognizer.asm create mode 100644 amforth-6.5/common/words/get-stack.asm create mode 100644 amforth-6.5/common/words/git-info.tmpl create mode 100644 amforth-6.5/common/words/handler.asm create mode 100644 amforth-6.5/common/words/hex.asm create mode 100644 amforth-6.5/common/words/hold.asm create mode 100644 amforth-6.5/common/words/if.asm create mode 100644 amforth-6.5/common/words/interpret.asm create mode 100644 amforth-6.5/common/words/key.asm create mode 100644 amforth-6.5/common/words/keyq.asm create mode 100644 amforth-6.5/common/words/l-from.asm create mode 100644 amforth-6.5/common/words/l-paren.asm create mode 100644 amforth-6.5/common/words/leave.asm create mode 100644 amforth-6.5/common/words/left-bracket.asm create mode 100644 amforth-6.5/common/words/less-sharp.asm create mode 100644 amforth-6.5/common/words/literal.asm create mode 100644 amforth-6.5/common/words/loop.asm create mode 100644 amforth-6.5/common/words/map-stack.asm create mode 100644 amforth-6.5/common/words/max.asm create mode 100644 amforth-6.5/common/words/min.asm create mode 100644 amforth-6.5/common/words/mod.asm create mode 100644 amforth-6.5/common/words/name2compile.asm create mode 100644 amforth-6.5/common/words/name2interpret.asm create mode 100644 amforth-6.5/common/words/name2string.asm create mode 100644 amforth-6.5/common/words/noop.asm create mode 100644 amforth-6.5/common/words/not-equal.asm create mode 100644 amforth-6.5/common/words/num-constants.asm create mode 100644 amforth-6.5/common/words/number.asm create mode 100644 amforth-6.5/common/words/pad.asm create mode 100644 amforth-6.5/common/words/parse-name.asm create mode 100644 amforth-6.5/common/words/parse.asm create mode 100644 amforth-6.5/common/words/pick.asm create mode 100644 amforth-6.5/common/words/place.asm create mode 100644 amforth-6.5/common/words/plusloop.asm create mode 100644 amforth-6.5/common/words/postpone.asm create mode 100644 amforth-6.5/common/words/prompt-error.asm create mode 100644 amforth-6.5/common/words/prompt-ok.asm create mode 100644 amforth-6.5/common/words/prompt-ready.asm create mode 100644 amforth-6.5/common/words/q-abort.asm create mode 100644 amforth-6.5/common/words/q-dnegate.asm create mode 100644 amforth-6.5/common/words/q-negate.asm create mode 100644 amforth-6.5/common/words/q-sign.asm create mode 100644 amforth-6.5/common/words/q-stack.asm create mode 100644 amforth-6.5/common/words/qdo.asm create mode 100644 amforth-6.5/common/words/quit.asm create mode 100644 amforth-6.5/common/words/rdefer-fetch.asm create mode 100644 amforth-6.5/common/words/rdefer-store.asm create mode 100644 amforth-6.5/common/words/rec-find.asm create mode 100644 amforth-6.5/common/words/rec-intnum.asm create mode 100644 amforth-6.5/common/words/recognize.asm create mode 100644 amforth-6.5/common/words/recurse.asm create mode 100644 amforth-6.5/common/words/refill.asm create mode 100644 amforth-6.5/common/words/repeat.asm create mode 100644 amforth-6.5/common/words/reveal.asm create mode 100644 amforth-6.5/common/words/right-bracket.asm create mode 100644 amforth-6.5/common/words/s-to-d.asm create mode 100644 amforth-6.5/common/words/search-wordlist.asm create mode 100644 amforth-6.5/common/words/semicolon.asm create mode 100644 amforth-6.5/common/words/set-base.asm create mode 100644 amforth-6.5/common/words/set-order.asm create mode 100644 amforth-6.5/common/words/set-recognizer.asm create mode 100644 amforth-6.5/common/words/set-stack.asm create mode 100644 amforth-6.5/common/words/sharp-greater.asm create mode 100644 amforth-6.5/common/words/sharp-s.asm create mode 100644 amforth-6.5/common/words/sharp.asm create mode 100644 amforth-6.5/common/words/show-wordlist.asm create mode 100644 amforth-6.5/common/words/sign.asm create mode 100644 amforth-6.5/common/words/slash-string.asm create mode 100644 amforth-6.5/common/words/slash.asm create mode 100644 amforth-6.5/common/words/sliteral.asm create mode 100644 amforth-6.5/common/words/source.asm create mode 100644 amforth-6.5/common/words/space.asm create mode 100644 amforth-6.5/common/words/spaces.asm create mode 100644 amforth-6.5/common/words/squote.asm create mode 100644 amforth-6.5/common/words/star.asm create mode 100644 amforth-6.5/common/words/then.asm create mode 100644 amforth-6.5/common/words/throw.asm create mode 100644 amforth-6.5/common/words/tib.asm create mode 100644 amforth-6.5/common/words/tick.asm create mode 100644 amforth-6.5/common/words/to-in.asm create mode 100644 amforth-6.5/common/words/to-l.asm create mode 100644 amforth-6.5/common/words/to-lower.asm create mode 100644 amforth-6.5/common/words/to-number.asm create mode 100644 amforth-6.5/common/words/to-upper.asm create mode 100644 amforth-6.5/common/words/to.asm create mode 100644 amforth-6.5/common/words/traverse-wordlist.asm create mode 100644 amforth-6.5/common/words/tuck.asm create mode 100644 amforth-6.5/common/words/type.asm create mode 100644 amforth-6.5/common/words/u-dot-r.asm create mode 100644 amforth-6.5/common/words/u-dot.asm create mode 100644 amforth-6.5/common/words/u-greater.asm create mode 100644 amforth-6.5/common/words/ud-dot-r.asm create mode 100644 amforth-6.5/common/words/ud-dot.asm create mode 100644 amforth-6.5/common/words/ud-slash-mod.asm create mode 100644 amforth-6.5/common/words/ud-star.asm create mode 100644 amforth-6.5/common/words/udefer-fetch.asm create mode 100644 amforth-6.5/common/words/udefer-store.asm create mode 100644 amforth-6.5/common/words/umax.asm create mode 100644 amforth-6.5/common/words/umin.asm create mode 100644 amforth-6.5/common/words/until.asm create mode 100644 amforth-6.5/common/words/variable.asm create mode 100644 amforth-6.5/common/words/ver.asm create mode 100644 amforth-6.5/common/words/warm.asm create mode 100644 amforth-6.5/common/words/while.asm create mode 100644 amforth-6.5/common/words/within.asm create mode 100644 amforth-6.5/common/words/word.asm create mode 100644 amforth-6.5/common/words/words.asm (limited to 'amforth-6.5/common/words') diff --git a/amforth-6.5/common/words/2drop.asm b/amforth-6.5/common/words/2drop.asm new file mode 100644 index 0000000..8db2003 --- /dev/null +++ b/amforth-6.5/common/words/2drop.asm @@ -0,0 +1,21 @@ +; ( x1 x2 -- ) +; Stack +; Remove the 2 top elements + +.if cpu_msp430==1 + HEADER(XT_2DROP,5,"2drop",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_2DROP: + .dw $ff05 + .db "2drop",0 + .dw VE_HEAD + .set VE_HEAD = VE_2DROP +XT_2DROP: + .dw DO_COLON +PFA_2DROP: +.endif + .dw XT_DROP + .dw XT_DROP + .dw XT_EXIT diff --git a/amforth-6.5/common/words/2dup.asm b/amforth-6.5/common/words/2dup.asm new file mode 100644 index 0000000..258c4f9 --- /dev/null +++ b/amforth-6.5/common/words/2dup.asm @@ -0,0 +1,22 @@ +; ( x1 x2 -- x1 x2 x1 x2 ) +; Stack +; Duplicate the 2 top elements + +.if cpu_msp430==1 + HEADER(XT_2DUP,4,"2dup",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_2DUP: + .dw $ff04 + .db "2dup" + .dw VE_HEAD + .set VE_HEAD = VE_2DUP +XT_2DUP: + .dw DO_COLON +PFA_2DUP: +.endif + + .dw XT_OVER + .dw XT_OVER + .dw XT_EXIT diff --git a/amforth-6.5/common/words/2literal.asm b/amforth-6.5/common/words/2literal.asm new file mode 100644 index 0000000..31b03cf --- /dev/null +++ b/amforth-6.5/common/words/2literal.asm @@ -0,0 +1,21 @@ +; ( -- x1 x2 ) (C: x1 x2 -- ) +; Compiler +; compile a cell pair literal in colon definitions +.if cpu_msp430==1 + IMMED(XT_2LITERAL,8,"2literal",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_2LITERAL: + .dw $0008 + .db "2literal" + .dw VE_HEAD + .set VE_HEAD = VE_2LITERAL +XT_2LITERAL: + .dw DO_COLON +PFA_2LITERAL: +.endif + .dw XT_SWAP + .dw XT_LITERAL + .dw XT_LITERAL + .dw XT_EXIT diff --git a/amforth-6.5/common/words/2swap.asm b/amforth-6.5/common/words/2swap.asm new file mode 100644 index 0000000..1056c54 --- /dev/null +++ b/amforth-6.5/common/words/2swap.asm @@ -0,0 +1,24 @@ +; ( x1 x2 x3 x4 -- x3 x4 x1 x2 ) +; Stack +; Exchange the two top cell pairs + +.if cpu_msp430==1 + HEADER(XT_2SWAP,5,"2swap",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_2SWAP: + .dw $ff05 + .db "2swap",0 + .dw VE_HEAD + .set VE_HEAD = VE_2SWAP +XT_2SWAP: + .dw DO_COLON +PFA_2SWAP: + +.endif + .dw XT_ROT + .dw XT_TO_R + .dw XT_ROT + .dw XT_R_FROM + .dw XT_EXIT diff --git a/amforth-6.5/common/words/_template.asm b/amforth-6.5/common/words/_template.asm new file mode 100644 index 0000000..1b42fcf --- /dev/null +++ b/amforth-6.5/common/words/_template.asm @@ -0,0 +1,8 @@ + +.if cpu_msp430==1 +; HEADER(XT_2SWAP,5,"2swap",DOCOLON) +.endif + +.if cpu_avr8==1 + +.endif diff --git a/amforth-6.5/common/words/abort-string.asm b/amforth-6.5/common/words/abort-string.asm new file mode 100644 index 0000000..116b1dc --- /dev/null +++ b/amforth-6.5/common/words/abort-string.asm @@ -0,0 +1,29 @@ +;C ABORT" i*x 0 -- i*x R: j*x -- j*x x1=0 +;C i*x x1 -- R: j*x -- x1<>0 +; POSTPONE IS" POSTPONE ?ABORT ; IMMEDIATE + +.if cpu_msp430==1 + ; IMMED(ABORTQUOTE,6,"ABORT"",DOCOLON) + DW link + DB 0FEh ; immediate +.set link = $ + DB 6,"abort",'"' + .align 16 +XT_ABORTQUOTE: + .DW DOCOLON +.endif + +.if cpu_avr8==1 +VE_ABORTQUOTE: + .dw $0006 + .db "abort",'"' + .dw VE_HEAD + .set VE_HEAD = VE_ABORTQUOTE +XT_ABORTQUOTE: + .dw DO_COLON +PFA_ABORTQUOTE: +.endif + .dw XT_SQUOTE + .dw XT_COMPILE + .dw XT_QABORT + .DW XT_EXIT diff --git a/amforth-6.5/common/words/abort.asm b/amforth-6.5/common/words/abort.asm new file mode 100644 index 0000000..05fe858 --- /dev/null +++ b/amforth-6.5/common/words/abort.asm @@ -0,0 +1,19 @@ +; ( i*x -- ) (R: j*y -- ) +; Exceptions +; send an exception -1 +.if cpu_msp430==1 + HEADER(XT_ABORT,5,"abort",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_ABORT: + .dw $ff05 + .db "abort",0 + .dw VE_HEAD + .set VE_HEAD = VE_ABORT +XT_ABORT: + .dw DO_COLON +PFA_ABORT: +.endif + .dw XT_TRUE + .dw XT_THROW diff --git a/amforth-6.5/common/words/abs.asm b/amforth-6.5/common/words/abs.asm new file mode 100644 index 0000000..429a603 --- /dev/null +++ b/amforth-6.5/common/words/abs.asm @@ -0,0 +1,20 @@ +;C ABS n1 -- +n2 absolute value +; DUP ?NEGATE ; + +.if cpu_msp430==1 + HEADER(XT_ABS,3,"abs",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_ABS: + .dw $ff03 + .db "abs",0 + .dw VE_HEAD + .set VE_HEAD = VE_ABS +XT_ABS: + .dw DO_COLON +PFA_ABS: + +.endif + + .DW XT_DUP,XT_QNEGATE,XT_EXIT diff --git a/amforth-6.5/common/words/accept.asm b/amforth-6.5/common/words/accept.asm new file mode 100644 index 0000000..68afdb1 --- /dev/null +++ b/amforth-6.5/common/words/accept.asm @@ -0,0 +1,95 @@ + +.if cpu_msp430==1 + HEADER(XT_ACCEPT,6,"accept",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_ACCEPT: + .dw $ff06 + .db "accept" + .dw VE_HEAD + .set VE_HEAD = VE_ACCEPT +XT_ACCEPT: + .dw DO_COLON +PFA_ACCEPT: + +.endif + .DW XT_OVER,XT_PLUS,XT_1MINUS,XT_OVER +ACC1: .DW XT_KEY,XT_DUP,XT_CRLFQ,XT_ZEROEQUAL,XT_DOCONDBRANCH + DEST(ACC5) + .DW XT_DUP,XT_DOLITERAL,8,XT_EQUAL,XT_DOCONDBRANCH + DEST(ACC3) + .DW XT_DROP,XT_ROT,XT_2DUP,XT_GREATER,XT_TO_R,XT_ROT,XT_ROT,XT_R_FROM,XT_DOCONDBRANCH + DEST(ACC6) + .DW XT_BS,XT_1MINUS,XT_TO_R,XT_OVER,XT_R_FROM,XT_UMAX +ACC6: .DW XT_DOBRANCH + DEST(ACC4) + + +ACC3: ; check for remaining control characters, replace them with blank + .dw XT_DUP ; ( -- addr k k ) + .dw XT_BL + .dw XT_LESS + .dw XT_DOCONDBRANCH + DEST(PFA_ACCEPT6) + .dw XT_DROP + .dw XT_BL +PFA_ACCEPT6: + .DW XT_DUP,XT_EMIT,XT_OVER,XT_CSTORE,XT_1PLUS,XT_OVER,XT_UMIN +ACC4: .DW XT_DOBRANCH + DEST(ACC1) +ACC5: .DW XT_DROP,XT_NIP,XT_SWAP,XT_MINUS,XT_CR,XT_EXIT + + +; ( -- ) +; System +; send a backspace character to overwrite the current char +.if cpu_msp430==1 + HEADLESS(XT_BS,DOCOLON) +.endif + +.if cpu_avr8==1 + +;VE_BS: +; .dw $ff02 +; .db "bs" +; .dw VE_HEAD +; .set VE_HEAD = VE_BS +XT_BS: + .dw DO_COLON +.endif + .dw XT_DOLITERAL + .dw 8 + .dw XT_DUP + .dw XT_EMIT + .dw XT_SPACE + .dw XT_EMIT + .dw XT_EXIT + + +; ( c -- f ) +; System +; is the character a line end character? +.if cpu_msp430==1 + HEADLESS(XT_CRLFQ,DOCOLON) +.endif + +.if cpu_avr8==1 +;VE_CRLFQ: +; .dw $ff02 +; .db "crlf?" +; .dw VE_HEAD +; .set VE_HEAD = VE_CRLFQ +XT_CRLFQ: + .dw DO_COLON +.endif + .dw XT_DUP + .dw XT_DOLITERAL + .dw 13 + .dw XT_EQUAL + .dw XT_SWAP + .dw XT_DOLITERAL + .dw 10 + .dw XT_EQUAL + .dw XT_OR + .dw XT_EXIT diff --git a/amforth-6.5/common/words/again.asm b/amforth-6.5/common/words/again.asm new file mode 100644 index 0000000..507e1ed --- /dev/null +++ b/amforth-6.5/common/words/again.asm @@ -0,0 +1,22 @@ +; ( -- ) (C: dest -- ) +; Compiler +; compile a jump back to dest + +.if cpu_msp430==1 + IMMED(XT_AGAIN,5,"again",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_AGAIN: + .dw $0005 + .db "again",0 + .dw VE_HEAD + .set VE_HEAD = VE_AGAIN +XT_AGAIN: + .dw DO_COLON +PFA_AGAIN: +.endif + .dw XT_COMPILE + .dw XT_DOBRANCH + .dw XT_LRESOLVE + .dw XT_EXIT diff --git a/amforth-6.5/common/words/ahead.asm b/amforth-6.5/common/words/ahead.asm new file mode 100644 index 0000000..d883543 --- /dev/null +++ b/amforth-6.5/common/words/ahead.asm @@ -0,0 +1,22 @@ +; ( f -- ) (C: -- orig ) +; Compiler +; do a unconditional branch + +.if cpu_msp430==1 + IMMED(XT_AHEAD,5,"ahead",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_AHEAD: + .dw $0005 + .db "ahead",0 + .dw VE_HEAD + .set VE_HEAD = VE_AHEAD +XT_AHEAD: + .dw DO_COLON +PFA_AHEAD: +.endif + .dw XT_COMPILE + .dw XT_DOBRANCH + .dw XT_GMARK + .dw XT_EXIT diff --git a/amforth-6.5/common/words/backslash.asm b/amforth-6.5/common/words/backslash.asm new file mode 100644 index 0000000..5364b9f --- /dev/null +++ b/amforth-6.5/common/words/backslash.asm @@ -0,0 +1,30 @@ +; ( "ccc" -- ) +; Compiler +; everything up to the end of the current line is a comment + +.if cpu_msp430==1 +; HEADER(XT_BACKSLASH,1,'\',DOCOLON) + DW link + DB 0FEh ; immediate +.set link = $ + DB 1,5ch + .align 16 +XT_BACKSLASH: + .DW DOCOLON +.endif + +.if cpu_avr8==1 +VE_BACKSLASH: + .dw $0001 + .db $5c,0 + .dw VE_HEAD + .set VE_HEAD = VE_BACKSLASH +XT_BACKSLASH: + .dw DO_COLON +PFA_BACKSLASH: +.endif + .dw XT_SOURCE + .dw XT_NIP + .dw XT_TO_IN + .dw XT_STORE + .dw XT_EXIT diff --git a/amforth-6.5/common/words/base.asm b/amforth-6.5/common/words/base.asm new file mode 100644 index 0000000..5f686b6 --- /dev/null +++ b/amforth-6.5/common/words/base.asm @@ -0,0 +1,19 @@ +; ( -- a-addr ) +; Numeric IO +; location of the cell containing the number conversion radix + +.if cpu_msp430==1 + HEADER(XT_BASE,4,"base",DOUSER) +.endif + +.if cpu_avr8==1 +VE_BASE: + .dw $ff04 + .db "base" + .dw VE_HEAD + .set VE_HEAD = VE_BASE +XT_BASE: + .dw PFA_DOUSER +PFA_BASE: +.endif + .dw USER_BASE diff --git a/amforth-6.5/common/words/begin.asm b/amforth-6.5/common/words/begin.asm new file mode 100644 index 0000000..b2e3c22 --- /dev/null +++ b/amforth-6.5/common/words/begin.asm @@ -0,0 +1,20 @@ +; ( -- ) (C: -- dest ) +; Compiler +; put the next location for a transfer of control onto the control flow stack + +.if cpu_msp430==1 + IMMED(XT_BEGIN,5,"begin",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_BEGIN: + .dw $0005 + .db "begin",0 + .dw VE_HEAD + .set VE_HEAD = VE_BEGIN +XT_BEGIN: + .dw DO_COLON +PFA_BEGIN: +.endif + .dw XT_LMARK + .dw XT_EXIT diff --git a/amforth-6.5/common/words/bin.asm b/amforth-6.5/common/words/bin.asm new file mode 100644 index 0000000..573c2f6 --- /dev/null +++ b/amforth-6.5/common/words/bin.asm @@ -0,0 +1,22 @@ +; ( -- ) +; Numeric IO +; set base for numeric conversion to 10 + +.if cpu_msp430==1 + HEADER(XT_BIN,3,"bin",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_BIN: + .dw $ff03 + .db "bin",0 + .dw VE_HEAD + .set VE_HEAD = VE_BIN +XT_BIN: + .dw DO_COLON +PFA_BIN: +.endif + .dw XT_TWO + .dw XT_BASE + .dw XT_STORE + .dw XT_EXIT diff --git a/amforth-6.5/common/words/bl.asm b/amforth-6.5/common/words/bl.asm new file mode 100644 index 0000000..cf242da --- /dev/null +++ b/amforth-6.5/common/words/bl.asm @@ -0,0 +1,19 @@ +; ( -- 32 ) +; Character IO +; put ascii code of the blank to the stack + +.if cpu_msp430==1 + HEADER(XT_BL,2,"bl",DOCON) +.endif + +.if cpu_avr8==1 +VE_BL: + .dw $ff02 + .db "bl" + .dw VE_HEAD + .set VE_HEAD = VE_BL +XT_BL: + .dw PFA_DOVARIABLE +PFA_BL: +.endif + .dw 32 diff --git a/amforth-6.5/common/words/bounds.asm b/amforth-6.5/common/words/bounds.asm new file mode 100644 index 0000000..0dd0555 --- /dev/null +++ b/amforth-6.5/common/words/bounds.asm @@ -0,0 +1,22 @@ +; ( addr len -- addr+len addr ) +; Tools +; convert a string to an address range + +.if cpu_msp430==1 + HEADER(XT_BOUNDS,6,"bounds",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_BOUNDS: + .dw $ff06 + .db "bounds" + .dw VE_HEAD + .set VE_HEAD = VE_BOUNDS +XT_BOUNDS: + .dw DO_COLON +PFA_BOUNDS: +.endif + .dw XT_OVER + .dw XT_PLUS + .dw XT_SWAP + .dw XT_EXIT diff --git a/amforth-6.5/common/words/bracketchar.asm b/amforth-6.5/common/words/bracketchar.asm new file mode 100644 index 0000000..ee55be0 --- /dev/null +++ b/amforth-6.5/common/words/bracketchar.asm @@ -0,0 +1,23 @@ +; ( -- c ) (C: "name" -- ) +; Tools +; skip leading space delimites, place the first character of the word on the stack + +.if cpu_msp430==1 + IMMED(XT_BRACKETCHAR,6,"[char]",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_BRACKETCHAR: + .dw $0006 + .db "[char]" + .dw VE_HEAD + .set VE_HEAD = VE_BRACKETCHAR +XT_BRACKETCHAR: + .dw DO_COLON +PFA_BRACKETCHAR: +.endif + .dw XT_COMPILE + .dw XT_DOLITERAL + .dw XT_CHAR + .dw XT_COMMA + .dw XT_EXIT diff --git a/amforth-6.5/common/words/bracketcompile.asm b/amforth-6.5/common/words/bracketcompile.asm new file mode 100644 index 0000000..01a1512 --- /dev/null +++ b/amforth-6.5/common/words/bracketcompile.asm @@ -0,0 +1,23 @@ +; ( -- c ) (C: "name" -- ) +; Compiler +; Append the compilation semantics of "name" to the dictionary, if any + +.if cpu_msp430==1 + IMMED(XT_BRACKETCOMPILE,9,"[compile]",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_BRACKETCOMPILE: + .dw $0009 + .db "[compile]",0 + .dw VE_HEAD + .set VE_HEAD = VE_BRACKETCOMPILE +XT_BRACKETCOMPILE: + .dw DO_COLON +PFA_BRACKETCOMPILE: +.endif + .dw XT_COMPILE + .dw XT_COMPILE + .dw XT_TICK + .dw XT_COMMA + .dw XT_EXIT diff --git a/amforth-6.5/common/words/brackettick.asm b/amforth-6.5/common/words/brackettick.asm new file mode 100644 index 0000000..4905ae3 --- /dev/null +++ b/amforth-6.5/common/words/brackettick.asm @@ -0,0 +1,21 @@ +; ( -- xt ) (C: "name" -- ) +; Compiler +; what ' does in the interpreter mode, do in colon definitions + +.if cpu_msp430==1 + IMMED(XT_BRACKETTICK,3,"[']",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_BRACKETTICK: + .dw $0003 + .db "[']",0 + .dw VE_HEAD + .set VE_HEAD = VE_BRACKETTICK +XT_BRACKETTICK: + .dw DO_COLON +PFA_BRACKETTICK: +.endif + .dw XT_TICK + .dw XT_LITERAL + .dw XT_EXIT diff --git a/amforth-6.5/common/words/build-info.tmpl b/amforth-6.5/common/words/build-info.tmpl new file mode 100644 index 0000000..6df97b8 --- /dev/null +++ b/amforth-6.5/common/words/build-info.tmpl @@ -0,0 +1,26 @@ +; ( -- i-addr len ) System +; R( -- ) +; Build Info as flash string + +.if cpu_msp430==1 + HEADER(XT_BUILDINFO,10,"build-info",DOCOLON) + .dw XT_DOSLITERAL + .db @TSTAMPLEN@ + .db "@TSTAMP@" + .align 16 +.endif + +.if cpu_avr8==1 +VE_BUILDINFO: + .dw $ff0a + .db "build-info" + .dw VE_HEAD + .set VE_HEAD = VE_BUILDINFO +XT_BUILDINFO: + .dw DO_COLON +PFA_BUILDINFO: + .dw XT_DOSLITERAL + .dw @TSTAMPLEN@ + .db "@TSTAMP@" +.endif + .dw XT_EXIT diff --git a/amforth-6.5/common/words/catch.asm b/amforth-6.5/common/words/catch.asm new file mode 100644 index 0000000..c67be65 --- /dev/null +++ b/amforth-6.5/common/words/catch.asm @@ -0,0 +1,39 @@ +; ( i*x xt -- j*x 0 | i*x n ) +; Exceptions +; execute XT and check for exceptions. + +.if cpu_msp430==1 + HEADER(XT_CATCH,5,"catch",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_CATCH: + .dw $ff05 + .db "catch",0 + .dw VE_HEAD + .set VE_HEAD = VE_CATCH +XT_CATCH: + .dw DO_COLON +PFA_CATCH: +.endif + + ; sp@ >r + .dw XT_SP_FETCH + .dw XT_TO_R + ; handler @ >r + .dw XT_HANDLER + .dw XT_FETCH + .dw XT_TO_R + ; rp@ handler ! + .dw XT_RP_FETCH + .dw XT_HANDLER + .dw XT_STORE + .dw XT_EXECUTE + ; r> handler ! + .dw XT_R_FROM + .dw XT_HANDLER + .dw XT_STORE + .dw XT_R_FROM + .dw XT_DROP + .dw XT_ZERO + .dw XT_EXIT diff --git a/amforth-6.5/common/words/cfg-order.asm b/amforth-6.5/common/words/cfg-order.asm new file mode 100644 index 0000000..2fba330 --- /dev/null +++ b/amforth-6.5/common/words/cfg-order.asm @@ -0,0 +1,19 @@ +; ( -- wid-n .. wid-1 n) +; Search Order +; Get the current search order word list + +.if cpu_msp430==1 + HEADER(XT_CFG_ORDER,9,"cfg-order",DOCON) +.endif + +.if cpu_avr8==1 +VE_CFG_ORDER: + .dw $ff09 + .db "cfg-order",0 + .dw VE_HEAD + .set VE_HEAD = VE_CFG_ORDER +XT_CFG_ORDER: + .dw PFA_DOVARIABLE +PFA_CFG_ORDER: +.endif + .dw CFG_ORDERLISTLEN diff --git a/amforth-6.5/common/words/cfg-recognizer.asm b/amforth-6.5/common/words/cfg-recognizer.asm new file mode 100644 index 0000000..8e6322a --- /dev/null +++ b/amforth-6.5/common/words/cfg-recognizer.asm @@ -0,0 +1,19 @@ +; ( -- wid-n .. wid-1 n) +; Search Order +; Get the current search order word list + +.if cpu_msp430==1 + HEADER(XT_CFG_RECOGNIZER,8,"cfg-recs",DOCON) +.endif + +.if cpu_avr8==1 +VE_CFG_RECOGNIZER: + .dw $ff08 + .db "cfg-recs" + .dw VE_HEAD + .set VE_HEAD = VE_CFG_RECOGNIZER +XT_CFG_RECOGNIZER: + .dw PFA_DOVARIABLE +PFA_CFG_RECOGNIZER: +.endif + .dw CFG_RECOGNIZERLISTLEN diff --git a/amforth-6.5/common/words/char.asm b/amforth-6.5/common/words/char.asm new file mode 100644 index 0000000..0fde37b --- /dev/null +++ b/amforth-6.5/common/words/char.asm @@ -0,0 +1,22 @@ +; ( "name" -- c ) +; Tools +; copy the first character of the next word onto the stack + +.if cpu_msp430==1 + HEADER(XT_CHAR,4,"char",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_CHAR: + .dw $ff04 + .db "char" + .dw VE_HEAD + .set VE_HEAD = VE_CHAR +XT_CHAR: + .dw DO_COLON +PFA_CHAR: +.endif + .dw XT_PARSENAME + .dw XT_DROP + .dw XT_CFETCH + .dw XT_EXIT diff --git a/amforth-6.5/common/words/colon.asm b/amforth-6.5/common/words/colon.asm new file mode 100644 index 0000000..3ec45ae --- /dev/null +++ b/amforth-6.5/common/words/colon.asm @@ -0,0 +1,22 @@ +; ( -- ) (C: "name" -- ) +; Compiler +; create a named entry in the dictionary, XT is DO_COLON + +.if cpu_msp430==1 + HEADER(XT_COLON,1,":",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_COLON: + .dw $ff01 + .db ":",0 + .dw VE_HEAD + .set VE_HEAD = VE_COLON +XT_COLON: + .dw DO_COLON +PFA_COLON: +.endif + .dw XT_DOCREATE + .dw XT_COLONNONAME + .dw XT_DROP + .dw XT_EXIT diff --git a/amforth-6.5/common/words/compile.asm b/amforth-6.5/common/words/compile.asm new file mode 100644 index 0000000..524cee6 --- /dev/null +++ b/amforth-6.5/common/words/compile.asm @@ -0,0 +1,25 @@ +; ( -- ) +; Dictionary +; read the following cell from the dictionary and append it to the current dictionary position. + +.if cpu_msp430==1 + HEADER(XT_COMPILE,7,"compile",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_COMPILE: + .dw $ff07 + .db "compile",0 + .dw VE_HEAD + .set VE_HEAD = VE_COMPILE +XT_COMPILE: + .dw DO_COLON +PFA_COMPILE: +.endif + .dw XT_R_FROM + .dw XT_DUP + .dw XT_ICELLPLUS + .dw XT_TO_R + .dw XT_FETCHI + .dw XT_COMMA + .dw XT_EXIT diff --git a/amforth-6.5/common/words/constant.asm b/amforth-6.5/common/words/constant.asm new file mode 100644 index 0000000..2f79dc3 --- /dev/null +++ b/amforth-6.5/common/words/constant.asm @@ -0,0 +1,25 @@ +; ( -- x ) (C: x "name" -- ) +; Compiler +; create a constant in the dictionary + +.if cpu_msp430==1 + HEADER(XT_CONSTANT,8,"constant",DOCOLON) +.endif + +.if cpu_avr8==1 + +VE_CONSTANT: + .dw $ff08 + .db "constant" + .dw VE_HEAD + .set VE_HEAD = VE_CONSTANT +XT_CONSTANT: + .dw DO_COLON +PFA_CONSTANT: +.endif + .dw XT_DOCREATE + .dw XT_REVEAL + .dw XT_COMPILE + .dw PFA_DOVARIABLE + .dw XT_COMMA + .dw XT_EXIT diff --git a/amforth-6.5/common/words/cr.asm b/amforth-6.5/common/words/cr.asm new file mode 100644 index 0000000..ba704ba --- /dev/null +++ b/amforth-6.5/common/words/cr.asm @@ -0,0 +1,26 @@ +; ( -- ) +; Character IO +; cause subsequent output appear at the beginning of the next line + +.if cpu_msp430==1 + HEADER(XT_CR,2,"cr",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_CR: + .dw 0xff02 + .db "cr" + .dw VE_HEAD + .set VE_HEAD = VE_CR +XT_CR: + .dw DO_COLON +PFA_CR: +.endif + + .dw XT_DOLITERAL + .dw 13 + .dw XT_EMIT + .dw XT_DOLITERAL + .dw 10 + .dw XT_EMIT + .dw XT_EXIT diff --git a/amforth-6.5/common/words/create.asm b/amforth-6.5/common/words/create.asm new file mode 100644 index 0000000..b288474 --- /dev/null +++ b/amforth-6.5/common/words/create.asm @@ -0,0 +1,23 @@ +; ( -- a-addr ) (C: "name" -- ) +; Dictionary +; create a dictionary header. XT is (constant), with the address of the data field of name + +.if cpu_msp430==1 + HEADER(XT_CREATE,6,"create",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_CREATE: + .dw $ff06 + .db "create" + .dw VE_HEAD + .set VE_HEAD = VE_CREATE +XT_CREATE: + .dw DO_COLON +PFA_CREATE: +.endif + .dw XT_DOCREATE + .dw XT_REVEAL + .dw XT_COMPILE + .dw PFA_DOCONSTANT + .dw XT_EXIT diff --git a/amforth-6.5/common/words/cscan.asm b/amforth-6.5/common/words/cscan.asm new file mode 100644 index 0000000..e043f60 --- /dev/null +++ b/amforth-6.5/common/words/cscan.asm @@ -0,0 +1,56 @@ +; ( addr1 n1 c -- addr1 n2 ) +; String +; Scan string at addr1/n1 for the first occurance of c, leaving addr1/n2, char at n2 is first non-c character + +.if cpu_msp430==1 + HEADER(XT_CSCAN,5,"cscan",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_CSCAN: + .dw $ff05 + .db "cscan" + .dw VE_HEAD + .set VE_HEAD = VE_CSCAN +XT_CSCAN: + .dw DO_COLON +PFA_CSCAN: +.endif + .dw XT_TO_R + .dw XT_OVER +PFA_CSCAN1: + .dw XT_DUP + .dw XT_CFETCH + .dw XT_R_FETCH + .dw XT_EQUAL + .dw XT_ZEROEQUAL + .dw XT_DOCONDBRANCH + DEST(PFA_CSCAN2) + .dw XT_SWAP + .dw XT_1MINUS + .dw XT_SWAP + .dw XT_OVER + .dw XT_ZEROLESS ; not negative + .dw XT_ZEROEQUAL + .dw XT_DOCONDBRANCH + DEST(PFA_CSCAN2) + .dw XT_1PLUS + .dw XT_DOBRANCH + DEST(PFA_CSCAN1) +PFA_CSCAN2: + .dw XT_NIP + .dw XT_OVER + .dw XT_MINUS + .dw XT_R_FROM + .dw XT_DROP + .dw XT_EXIT + +; : my-cscan ( addr len c -- addr len' ) +; >r over ( -- addr len addr ) +; begin +; dup c@ r@ <> while +; swap 1- swap over 0 >= while +; 1+ +; repeat then +; nip over - r> drop +; ; diff --git a/amforth-6.5/common/words/cskip.asm b/amforth-6.5/common/words/cskip.asm new file mode 100644 index 0000000..d57ff9c --- /dev/null +++ b/amforth-6.5/common/words/cskip.asm @@ -0,0 +1,37 @@ +; ( addr1 n1 c -- addr2 n2 ) +; String +; skips leading occurancies in string at addr1/n1 leaving addr2/n2 pointing to the 1st non-c character + +.if cpu_msp430==1 + HEADER(XT_CSKIP,5,"cskip",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_CSKIP: + .dw $ff05 + .db "cskip",0 + .dw VE_HEAD + .set VE_HEAD = VE_CSKIP +XT_CSKIP: + .dw DO_COLON +PFA_CSKIP: +.endif + .dw XT_TO_R ; ( -- addr1 n1 ) +PFA_CSKIP1: + .dw XT_DUP ; ( -- addr' n' n' ) + .dw XT_DOCONDBRANCH ; ( -- addr' n') + DEST(PFA_CSKIP2) + .dw XT_OVER ; ( -- addr' n' addr' ) + .dw XT_CFETCH ; ( -- addr' n' c' ) + .dw XT_R_FETCH ; ( -- addr' n' c' c ) + .dw XT_EQUAL ; ( -- addr' n' f ) + .dw XT_DOCONDBRANCH ; ( -- addr' n') + DEST(PFA_CSKIP2) + .dw XT_ONE + .dw XT_SLASHSTRING + .dw XT_DOBRANCH + DEST(PFA_CSKIP1) +PFA_CSKIP2: + .dw XT_R_FROM + .dw XT_DROP ; ( -- addr2 n2) + .dw XT_EXIT diff --git a/amforth-6.5/common/words/d-dot-r.asm b/amforth-6.5/common/words/d-dot-r.asm new file mode 100644 index 0000000..cc556d7 --- /dev/null +++ b/amforth-6.5/common/words/d-dot-r.asm @@ -0,0 +1,35 @@ +; ( d w -- ) +; Numeric IO +; singed PNO with double cell numbers, right aligned in width w + +.if cpu_msp430==1 + HEADER(XT_DDOTR,3,"d.r",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_DDOTR: + .dw $ff03 + .db "d.r",0 + .dw VE_HEAD + .set VE_HEAD = VE_DDOTR +XT_DDOTR: + .dw DO_COLON +PFA_DDOTR: + +.endif + .dw XT_TO_R + .dw XT_TUCK + .dw XT_DABS + .dw XT_L_SHARP + .dw XT_SHARP_S + .dw XT_ROT + .dw XT_SIGN + .dw XT_SHARP_G + .dw XT_R_FROM + .dw XT_OVER + .dw XT_MINUS + .dw XT_SPACES + .dw XT_TYPE + .dw XT_EXIT +; : d.r ( d n -- ) +; >r swap over dabs <# #s rot sign #> r> over - spaces type ; diff --git a/amforth-6.5/common/words/d-dot.asm b/amforth-6.5/common/words/d-dot.asm new file mode 100644 index 0000000..8aa1169 --- /dev/null +++ b/amforth-6.5/common/words/d-dot.asm @@ -0,0 +1,24 @@ +; ( d -- ) +; Numeric IO +; singed PNO with double cell numbers + +.if cpu_msp430==1 + HEADER(XT_DDOT,2,"d.",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_DDOT: + .dw $ff02 + .db "d." + .dw VE_HEAD + .set VE_HEAD = VE_DDOT +XT_DDOT: + .dw DO_COLON +PFA_DDOT: + +.endif + .dw XT_ZERO + .dw XT_DDOTR + .dw XT_SPACE + .dw XT_EXIT +; : d. ( d -- ) 0 d.r space ; diff --git a/amforth-6.5/common/words/decimal.asm b/amforth-6.5/common/words/decimal.asm new file mode 100644 index 0000000..de65dd4 --- /dev/null +++ b/amforth-6.5/common/words/decimal.asm @@ -0,0 +1,23 @@ +; ( -- ) +; Numeric IO +; set base for numeric conversion to 10 + +.if cpu_msp430==1 + HEADER(XT_DECIMAL,7,"decimal",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_DECIMAL: + .dw $ff07 + .db "decimal",0 + .dw VE_HEAD + .set VE_HEAD = VE_DECIMAL +XT_DECIMAL: + .dw DO_COLON +PFA_DECIMAL: +.endif + .dw XT_DOLITERAL + .dw 10 + .dw XT_BASE + .dw XT_STORE + .dw XT_EXIT diff --git a/amforth-6.5/common/words/defer-fetch.asm b/amforth-6.5/common/words/defer-fetch.asm new file mode 100644 index 0000000..6044afc --- /dev/null +++ b/amforth-6.5/common/words/defer-fetch.asm @@ -0,0 +1,24 @@ +; ( xt1 -- xt2 ) +; System +; returns the XT associated with the given XT + +.if cpu_msp430==1 + HEADER(XT_DEFERFETCH,6,"defer@",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_DEFERFETCH: + .dw $ff06 + .db "defer@" + .dw VE_HEAD + .set VE_HEAD = VE_DEFERFETCH +XT_DEFERFETCH: + .dw DO_COLON +PFA_DEFERFETCH: +.endif + .dw XT_TO_BODY + .dw XT_DUP + .dw XT_ICELLPLUS + .dw XT_FETCHI + .dw XT_EXECUTE + .dw XT_EXIT diff --git a/amforth-6.5/common/words/defer-store.asm b/amforth-6.5/common/words/defer-store.asm new file mode 100644 index 0000000..4ca579c --- /dev/null +++ b/amforth-6.5/common/words/defer-store.asm @@ -0,0 +1,26 @@ +; ( xt1 xt2 -- ) +; System +; stores xt1 as the xt to be executed when xt2 is called + +.if cpu_msp430==1 + HEADER(XT_DEFERSTORE,6,"defer!",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_DEFERSTORE: + .dw $ff06 + .db "defer!" + .dw VE_HEAD + .set VE_HEAD = VE_DEFERSTORE +XT_DEFERSTORE: + .dw DO_COLON +PFA_DEFERSTORE: +.endif + .dw XT_TO_BODY + .dw XT_DUP + .dw XT_ICELLPLUS + .dw XT_ICELLPLUS + .dw XT_FETCHI + .dw XT_EXECUTE + .dw XT_EXIT + diff --git a/amforth-6.5/common/words/depth.asm b/amforth-6.5/common/words/depth.asm new file mode 100644 index 0000000..c17d84d --- /dev/null +++ b/amforth-6.5/common/words/depth.asm @@ -0,0 +1,23 @@ +; ( -- n ) +; Stack +; number of single-cell values contained in the data stack before n was placed on the stack. +.if cpu_msp430==1 + HEADER(XT_DEPTH,5,"depth",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_DEPTH: + .dw $ff05 + .db "depth",0 + .dw VE_HEAD + .set VE_HEAD = VE_DEPTH +XT_DEPTH: + .dw DO_COLON +PFA_DEPTH: +.endif + .dw XT_SP0 + .dw XT_SP_FETCH + .dw XT_MINUS + .dw XT_2SLASH + .dw XT_1MINUS + .dw XT_EXIT diff --git a/amforth-6.5/common/words/digit-q.asm b/amforth-6.5/common/words/digit-q.asm new file mode 100644 index 0000000..da19b55 --- /dev/null +++ b/amforth-6.5/common/words/digit-q.asm @@ -0,0 +1,24 @@ +; ( c -- (number|) flag ) +; Numeric IO +; tries to convert a character to a number, set flag accordingly + +.if cpu_msp430==1 + HEADER(XT_DIGITQ,6,"digit?",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_DIGITQ: + .dw $ff06 + .db "digit?" + .dw VE_HEAD + .set VE_HEAD = VE_DIGITQ +XT_DIGITQ: + .dw DO_COLON +PFA_DIGITQ: +.endif + .dw XT_TOUPPER + .DW XT_DUP,XT_DOLITERAL,57,XT_GREATER,XT_DOLITERAL,256 + .DW XT_AND,XT_PLUS,XT_DUP,XT_DOLITERAL,320,XT_GREATER + .DW XT_DOLITERAL,263,XT_AND,XT_MINUS,XT_DOLITERAL,48 + .DW XT_MINUS,XT_DUP,XT_BASE,XT_FETCH,XT_ULESS + .DW XT_EXIT diff --git a/amforth-6.5/common/words/do-create.asm b/amforth-6.5/common/words/do-create.asm new file mode 100644 index 0000000..3f78729 --- /dev/null +++ b/amforth-6.5/common/words/do-create.asm @@ -0,0 +1,22 @@ +; ( -- ) (C: "name" -- ) +; Compiler +; parse the input and create an empty vocabulary entry without XT and data field (PF) + +.if cpu_msp430==1 + HEADER(XT_DOCREATE,8,"(create)",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_DOCREATE: + .dw $ff08 + .db "(create)" + .dw VE_HEAD + .set VE_HEAD = VE_DOCREATE +XT_DOCREATE: + .dw DO_COLON +PFA_DOCREATE: +.endif + .DW XT_PARSENAME,XT_WLSCOPE ; ( -- addr len wid) + .DW XT_DUP,XT_NEWEST,XT_CELLPLUS,XT_STORE ; save the wid + .DW XT_HEADER,XT_NEWEST,XT_STORE ; save the nt + .DW XT_EXIT diff --git a/amforth-6.5/common/words/do.asm b/amforth-6.5/common/words/do.asm new file mode 100644 index 0000000..a289bf8 --- /dev/null +++ b/amforth-6.5/common/words/do.asm @@ -0,0 +1,25 @@ +; ( n1 n2 -- ) (R: -- loop-sys ) (C: -- do-sys ) +; Compiler +; start do .. [+]loop + +.if cpu_msp430==1 + IMMED(XT_DO,2,"do",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_DO: + .dw $0002 + .db "do" + .dw VE_HEAD + .set VE_HEAD = VE_DO +XT_DO: + .dw DO_COLON +PFA_DO: + +.endif + .dw XT_COMPILE + .dw XT_DODO + .dw XT_LMARK + .dw XT_ZERO + .dw XT_TO_L + .dw XT_EXIT diff --git a/amforth-6.5/common/words/dot-quote.asm b/amforth-6.5/common/words/dot-quote.asm new file mode 100644 index 0000000..46efce1 --- /dev/null +++ b/amforth-6.5/common/words/dot-quote.asm @@ -0,0 +1,31 @@ +; ( -- ) (C: "ccc" -- ) +; Compiler +; compiles string into dictionary to be printed at runtime + +.if cpu_msp430==1 + ; IMMED(DOTQUOTE,2,"."",DOCOLON) + DW link + DB 0FEh ; immediate +.set link = $ + DB 2,'.','"' + .align 16 +DOTQUOTE: DW DOCOLON + +.endif + +.if cpu_avr8==1 + + +VE_DOTSTRING: + .dw $0002 + .db ".",$22 + .dw VE_HEAD + .set VE_HEAD = VE_DOTSTRING +XT_DOTSTRING: + .dw DO_COLON +PFA_DOTSTRING: +.endif + .dw XT_SQUOTE + .dw XT_COMPILE + .dw XT_ITYPE + .dw XT_EXIT diff --git a/amforth-6.5/common/words/dot-r.asm b/amforth-6.5/common/words/dot-r.asm new file mode 100644 index 0000000..5a19168 --- /dev/null +++ b/amforth-6.5/common/words/dot-r.asm @@ -0,0 +1,32 @@ +; ( n w -- ) +; Numeric IO +; singed PNO with single cell numbers, right aligned in width w + +.if cpu_msp430==1 +; HEADER(XT_DOTR,2,"..",DOCOLON) + DW link + DB 0FFh +.set link = $ + DB 2,".",'r' + .align 16 +XT_DOTR: + .DW DOCOLON +.endif + +.if cpu_avr8==1 +VE_DOTR: + .dw $ff02 + .db ".r" + .dw VE_HEAD + .set VE_HEAD = VE_DOTR +XT_DOTR: + .dw DO_COLON +PFA_DOTR: + +.endif + .dw XT_TO_R + .dw XT_S2D + .dw XT_R_FROM + .dw XT_DDOTR + .dw XT_EXIT +; : .r ( s n -- ) >r s>d r> d.r ; diff --git a/amforth-6.5/common/words/dot-s.asm b/amforth-6.5/common/words/dot-s.asm new file mode 100644 index 0000000..b6736a5 --- /dev/null +++ b/amforth-6.5/common/words/dot-s.asm @@ -0,0 +1,42 @@ +; ( -- ) +; Tools +; stack dump + +.if cpu_msp430==1 +; HEADER(XT_DOTS,2,"..",DOCOLON) + DW link + DB 0FFh +.set link = $ + DB 2,".",'s' + .align 16 +XT_DOTS: + .DW DOCOLON +.endif + +.if cpu_avr8==1 +VE_DOTS: + .dw $ff02 + .db ".s" + .dw VE_HEAD + .set VE_HEAD = VE_DOTS +XT_DOTS: + .dw DO_COLON +PFA_DOTS: +.endif + .dw XT_DEPTH + .dw XT_UDOT + .dw XT_SPACE + .dw XT_DEPTH + .dw XT_ZERO + .dw XT_QDOCHECK + .dw XT_DOCONDBRANCH + DEST(PFA_DOTS2) + .dw XT_DODO +PFA_DOTS1: + .dw XT_I + .dw XT_PICK + .dw XT_UDOT + .dw XT_DOLOOP + DEST(PFA_DOTS1) +PFA_DOTS2: + .dw XT_EXIT diff --git a/amforth-6.5/common/words/dot.asm b/amforth-6.5/common/words/dot.asm new file mode 100644 index 0000000..32ad95f --- /dev/null +++ b/amforth-6.5/common/words/dot.asm @@ -0,0 +1,24 @@ +; ( n -- ) +; Numeric IO +; singed PNO with single cell numbers + +.if cpu_msp430==1 + HEADER(XT_DOT,1,".",DOCOLON) +.endif + +.if cpu_avr8==1 + + +VE_DOT: + .dw $ff01 + .db ".",0 + .dw VE_HEAD + .set VE_HEAD = VE_DOT +XT_DOT: + .dw DO_COLON +PFA_DOT: +.endif + .dw XT_S2D + .dw XT_DDOT + .dw XT_EXIT +; : . ( s -- ) s>d d. ; diff --git a/amforth-6.5/common/words/dt-null.asm b/amforth-6.5/common/words/dt-null.asm new file mode 100644 index 0000000..640562f --- /dev/null +++ b/amforth-6.5/common/words/dt-null.asm @@ -0,0 +1,41 @@ +; ( -- addr ) +; Interpreter +; there is no parser for this recognizer, this is the default and failsafe part + +.if cpu_msp430==1 + HEADER(XT_DT_NULL,7,"dt:null",DOROM) +.endif + +.if cpu_avr8==1 +VE_DT_NULL: + .dw $ff07 + .db "dt:null" + .dw VE_HEAD + .set VE_HEAD = VE_DT_NULL +XT_DT_NULL: + .dw PFA_DOCONSTANT +PFA_DT_NULL: +.endif + .dw XT_FAIL ; interpret + .dw XT_FAIL ; compile + .dw XT_FAIL ; postpone + +; ( addr len -- ) +; Interpreter +; default failure action: throw exception -13. +.if cpu_msp430==1 + HEADLESS(XT_FAIL,DOCOLON) +.endif +.if cpu_avr8==1 +;VE_FAIL: +; .dw $ff04 +; .db "fail" +; .dw VE_HEAD +; .set VE_HEAD = VE_FAIL +XT_FAIL: + .dw DO_COLON +PFA_FAIL: +.endif + .dw XT_DOLITERAL + .dw -13 + .dw XT_THROW diff --git a/amforth-6.5/common/words/else.asm b/amforth-6.5/common/words/else.asm new file mode 100644 index 0000000..e0e2ff3 --- /dev/null +++ b/amforth-6.5/common/words/else.asm @@ -0,0 +1,24 @@ +; (C: orig1 -- orig2 ) +; Compiler +; resolve the forward reference and place a new unresolved forward reference + +.if cpu_msp430==1 + IMMED(XT_ELSE,4,"else",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_ELSE: + .dw $0004 + .db "else" + .dw VE_HEAD + .set VE_HEAD = VE_ELSE +XT_ELSE: + .dw DO_COLON +PFA_ELSE: +.endif + .dw XT_COMPILE + .dw XT_DOBRANCH + .dw XT_GMARK + .dw XT_SWAP + .dw XT_GRESOLVE + .dw XT_EXIT diff --git a/amforth-6.5/common/words/emit.asm b/amforth-6.5/common/words/emit.asm new file mode 100644 index 0000000..de194c3 --- /dev/null +++ b/amforth-6.5/common/words/emit.asm @@ -0,0 +1,21 @@ +; ( c -- ) +; Character IO +; fetch the emit vector and execute it. should emit a character from TOS + +.if cpu_msp430==1 + DEFER(XT_EMIT,4,"emit") +.endif + +.if cpu_avr8==1 +VE_EMIT: + .dw $ff04 + .db "emit" + .dw VE_HEAD + .set VE_HEAD = VE_EMIT +XT_EMIT: + .dw PFA_DODEFER1 +PFA_EMIT: +.endif + .dw USER_EMIT + .dw XT_UDEFERFETCH + .dw XT_UDEFERSTORE diff --git a/amforth-6.5/common/words/emitq.asm b/amforth-6.5/common/words/emitq.asm new file mode 100644 index 0000000..b1c04f2 --- /dev/null +++ b/amforth-6.5/common/words/emitq.asm @@ -0,0 +1,21 @@ +; ( -- f ) +; Character IO +; fetch emit? vector and execute it. should return the ready-to-send condition + +.if cpu_msp430==1 + DEFER(XT_EMITQ,5,"emit?") +.endif + +.if cpu_avr8==1 +VE_EMITQ: + .dw $ff05 + .db "emit?",0 + .dw VE_HEAD + .set VE_HEAD = VE_EMITQ +XT_EMITQ: + .dw PFA_DODEFER1 +PFA_EMITQ: +.endif + .dw USER_EMITQ + .dw XT_UDEFERFETCH + .dw XT_UDEFERSTORE diff --git a/amforth-6.5/common/words/endloop.asm b/amforth-6.5/common/words/endloop.asm new file mode 100644 index 0000000..26c9847 --- /dev/null +++ b/amforth-6.5/common/words/endloop.asm @@ -0,0 +1,28 @@ + +.if cpu_msp430==1 + HEADER(XT_ENDLOOP,7,"endloop",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_ENDLOOP: + .dw $ff07 + .db "endloop",0 + .dw VE_HEAD + .set VE_HEAD = VE_ENDLOOP +XT_ENDLOOP: + .dw DO_COLON +PFA_ENDLOOP: +.endif +;Z ENDLOOP adrs xt -- L: 0 a1 a2 .. aN -- +; ?DUP WHILE POSTPONE THEN REPEAT ; +; resolve LEAVEs +; This is a common factor of LOOP and +LOOP. + + .DW XT_LRESOLVE +LOOP1: .DW XT_L_FROM,XT_QDUP,XT_DOCONDBRANCH + DEST(LOOP2) + .DW XT_THEN + .dw XT_DOBRANCH + DEST(LOOP1) +LOOP2: .DW XT_EXIT diff --git a/amforth-6.5/common/words/env-cpu.asm b/amforth-6.5/common/words/env-cpu.asm new file mode 100644 index 0000000..3266b03 --- /dev/null +++ b/amforth-6.5/common/words/env-cpu.asm @@ -0,0 +1,22 @@ +; ( -- faddr len ) +; Environment +; flash address of the CPU identification string + +.if cpu_msp430==1 + ENVIRONMENT(XT_ENV_CPU,3,"cpu") +.endif + +.if cpu_avr8==1 +VE_ENV_CPU: + .dw $ff03 + .db "cpu",0 + .dw VE_ENVHEAD + .set VE_ENVHEAD = VE_ENV_CPU +XT_ENV_CPU: + .dw DO_COLON +PFA_EN_CPU: +.endif + .dw XT_DOLITERAL + .dw mcu_name + .dw XT_ICOUNT + .dw XT_EXIT diff --git a/amforth-6.5/common/words/env-forthname.asm b/amforth-6.5/common/words/env-forthname.asm new file mode 100644 index 0000000..025f818 --- /dev/null +++ b/amforth-6.5/common/words/env-forthname.asm @@ -0,0 +1,26 @@ +; ( -- faddr len ) +; Environment +; flash address of the amforth name string +.if cpu_msp430==1 + ENVIRONMENT(XT_ENV_FORTHNAME,10,"forth-name") + .dw XT_DOSLITERAL + .db 7 +.endif + +.if cpu_avr8==1 +VE_ENV_FORTHNAME: + .dw $ff0a + .db "forth-name" + .dw VE_ENVHEAD + .set VE_ENVHEAD = VE_ENV_FORTHNAME +XT_ENV_FORTHNAME: + .dw DO_COLON +PFA_EN_FORTHNAME: + .dw XT_DOSLITERAL + .dw 7 +.endif + .db "amforth" +.if cpu_msp430==1 + .align 16 +.endif + .dw XT_EXIT diff --git a/amforth-6.5/common/words/env-forthversion.asm b/amforth-6.5/common/words/env-forthversion.asm new file mode 100644 index 0000000..202e82b --- /dev/null +++ b/amforth-6.5/common/words/env-forthversion.asm @@ -0,0 +1,20 @@ +; ( -- n ) +; Environment +; version number of amforth +.if cpu_msp430==1 + ENVIRONMENT(XT_ENV_FORTHVERSION,7,"version") +.endif + +.if cpu_avr8==1 +VE_ENV_FORTHVERSION: + .dw $ff07 + .db "version",0 + .dw VE_ENVHEAD + .set VE_ENVHEAD = VE_ENV_FORTHVERSION +XT_ENV_FORTHVERSION: + .dw DO_COLON +PFA_EN_FORTHVERSION: +.endif + .dw XT_DOLITERAL + .dw 65 + .dw XT_EXIT diff --git a/amforth-6.5/common/words/env-slashhold.asm b/amforth-6.5/common/words/env-slashhold.asm new file mode 100644 index 0000000..9fa9468 --- /dev/null +++ b/amforth-6.5/common/words/env-slashhold.asm @@ -0,0 +1,22 @@ +; ( -- hldsize ) +; Environment +; size of the pictured numeric output buffer in bytes + +.if cpu_msp430==1 + ENVIRONMENT(XT_ENVSLASHHOLD,5,"/hold",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_ENVSLASHHOLD: + .dw $ff05 + .db "/hold",0 + .dw VE_ENVHEAD + .set VE_ENVHEAD = VE_ENVSLASHHOLD +XT_ENVSLASHHOLD: + .dw DO_COLON +PFA_ENVSLASHHOLD: +.endif + .dw XT_PAD + .dw XT_HERE + .dw XT_MINUS + .dw XT_EXIT diff --git a/amforth-6.5/common/words/env-usersize.asm b/amforth-6.5/common/words/env-usersize.asm new file mode 100644 index 0000000..53bd58a --- /dev/null +++ b/amforth-6.5/common/words/env-usersize.asm @@ -0,0 +1,21 @@ +; ( -- usersize ) +; Environment +; size of the USER area in bytes +.if cpu_msp430==1 + ENVIRONMENT(XT_ENVUSERSIZE,5,"/user") +.endif + +.if cpu_avr8==1 + +VE_ENVUSERSIZE: + .dw $ff05 + .db "/user",0 + .dw VE_ENVHEAD + .set VE_ENVHEAD = VE_ENVUSERSIZE +XT_ENVUSERSIZE: + .dw DO_COLON +PFA_ENVUSERSIZE: +.endif + .dw XT_DOLITERAL + .dw SYSUSERSIZE + APPUSERSIZE + .dw XT_EXIT diff --git a/amforth-6.5/common/words/f_cpu.asm b/amforth-6.5/common/words/f_cpu.asm new file mode 100644 index 0000000..3632b0c --- /dev/null +++ b/amforth-6.5/common/words/f_cpu.asm @@ -0,0 +1,22 @@ +; ( -- d ) +; System +; put the cpu frequency in Hz on stack +.if cpu_msp430==1 + HEADER(XT_F_CPU,5,"f_cpu",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_F_CPU: + .dw $ff05 + .db "f_cpu",0 + .dw VE_HEAD + .set VE_HEAD = VE_F_CPU +XT_F_CPU: + .dw DO_COLON +PFA_F_CPU: +.endif + .dw XT_DOLITERAL + .dw (F_CPU % 65536) + .dw XT_DOLITERAL + .dw (F_CPU / 65536) + .dw XT_EXIT diff --git a/amforth-6.5/common/words/find-xt.asm b/amforth-6.5/common/words/find-xt.asm new file mode 100644 index 0000000..0ed50b8 --- /dev/null +++ b/amforth-6.5/common/words/find-xt.asm @@ -0,0 +1,55 @@ +; ( c-addr len -- 0 | xt -1 | xt 1 ) +; Tools +; search wordlists for an entry with the xt from c-addr/len + +.if cpu_msp430==1 + HEADER(XT_FINDXT,7,"find-xt",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_FINDXT: + .dw $ff07 + .db "find-xt",0 + .dw VE_HEAD + .set VE_HEAD = VE_FINDXT +XT_FINDXT: + .dw DO_COLON +PFA_FINDXT: +.endif + .dw XT_DOLITERAL + .dw XT_FINDXTA + .dw XT_DOLITERAL + .dw CFG_ORDERLISTLEN + .dw XT_MAPSTACK + .dw XT_ZEROEQUAL + .dw XT_DOCONDBRANCH + DEST(PFA_FINDXT1) + .dw XT_2DROP + .dw XT_ZERO +PFA_FINDXT1: + .dw XT_EXIT + +.if cpu_msp430==1 + HEADLESS(XT_FINDXTA,DOCOLON) +.endif + +.if cpu_avr8==1 + +XT_FINDXTA: + .dw DO_COLON +PFA_FINDXTA: +.endif + .dw XT_TO_R + .dw XT_2DUP + .dw XT_R_FROM + .dw XT_SEARCH_WORDLIST + .dw XT_DUP + .dw XT_DOCONDBRANCH + DEST(PFA_FINDXTA1) + .dw XT_TO_R + .dw XT_NIP + .dw XT_NIP + .dw XT_R_FROM + .dw XT_TRUE +PFA_FINDXTA1: + .dw XT_EXIT diff --git a/amforth-6.5/common/words/get-order.asm b/amforth-6.5/common/words/get-order.asm new file mode 100644 index 0000000..df9ee77 --- /dev/null +++ b/amforth-6.5/common/words/get-order.asm @@ -0,0 +1,22 @@ +; ( -- wid-n .. wid-1 n) +; Search Order +; Get the current search order word list + +.if cpu_msp430==1 + HEADER(XT_GET_ORDER,9,"get-order",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_GET_ORDER: + .dw $ff09 + .db "get-order",0 + .dw VE_HEAD + .set VE_HEAD = VE_GET_ORDER +XT_GET_ORDER: + .dw DO_COLON +PFA_GET_ORDER: +.endif + .dw XT_DOLITERAL + .dw CFG_ORDERLISTLEN + .dw XT_GET_STACK + .dw XT_EXIT diff --git a/amforth-6.5/common/words/get-recognizer.asm b/amforth-6.5/common/words/get-recognizer.asm new file mode 100644 index 0000000..abfbe07 --- /dev/null +++ b/amforth-6.5/common/words/get-recognizer.asm @@ -0,0 +1,22 @@ +; ( -- rec-n .. rec-1 n) +; Interpreter +; Get the current recognizer list + +.if cpu_msp430==1 + HEADER(XT_GET_RECOGNIZERS,15,"get-recognizers",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_GET_RECOGNIZERS: + .dw $ff0f + .db "get-recognizers",0 + .dw VE_HEAD + .set VE_HEAD = VE_GET_RECOGNIZERS +XT_GET_RECOGNIZERS: + .dw DO_COLON +PFA_GET_RECOGNIZERS: +.endif + .dw XT_DOLITERAL + .dw CFG_RECOGNIZERLISTLEN + .dw XT_GET_STACK + .dw XT_EXIT diff --git a/amforth-6.5/common/words/get-stack.asm b/amforth-6.5/common/words/get-stack.asm new file mode 100644 index 0000000..3127d76 --- /dev/null +++ b/amforth-6.5/common/words/get-stack.asm @@ -0,0 +1,46 @@ +; ( e-addr -- item-n .. item-1 n) +; Tools +; Get a stack from EEPROM + +.if cpu_msp430==1 + HEADER(XT_GET_STACK,9,"get-stack",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_GET_STACK: + .dw $ff09 + .db "get-stack",0 + .dw VE_HEAD + .set VE_HEAD = VE_GET_STACK +XT_GET_STACK: + .dw DO_COLON +.endif + .dw XT_DUP + .dw XT_CELLPLUS + .dw XT_SWAP + .dw XT_FETCHE + .dw XT_DUP + .dw XT_TO_R + .dw XT_ZERO + .dw XT_SWAP ; go from bigger to smaller addresses + .dw XT_QDOCHECK + .dw XT_DOCONDBRANCH + DEST(PFA_N_FETCH_E2) + .dw XT_DODO +PFA_N_FETCH_E1: + ; ( ee-addr ) + .dw XT_I + .dw XT_1MINUS + .dw XT_CELLS ; ( -- ee-addr i*2 ) + .dw XT_OVER ; ( -- ee-addr i*2 ee-addr ) + .dw XT_PLUS ; ( -- ee-addr ee-addr+i + .dw XT_FETCHE ;( -- ee-addr item_i ) + .dw XT_SWAP ;( -- item_i ee-addr ) + .dw XT_TRUE ; shortcut for -1 + .dw XT_DOPLUSLOOP + DEST(PFA_N_FETCH_E1) +PFA_N_FETCH_E2: + .dw XT_2DROP + .dw XT_R_FROM + .dw XT_EXIT + diff --git a/amforth-6.5/common/words/git-info.tmpl b/amforth-6.5/common/words/git-info.tmpl new file mode 100644 index 0000000..2486d16 --- /dev/null +++ b/amforth-6.5/common/words/git-info.tmpl @@ -0,0 +1,27 @@ +; ( -- ) System +; R( -- ) +; GIT Info + +.if cpu_msp430==1 + HEADER(XT_GITINFO,8,"git-info",DOCOLON) + .dw XT_DOSLITERAL + .db @BRLEN@ +.endif + +.if cpu_avr8==1 +VE_GITINFO: + .dw $ff08 + .db "git-info" + .dw VE_HEAD + .set VE_HEAD = VE_GITINFO +XT_GITINFO: + .dw DO_COLON +PFA_GITINFO: + .dw XT_DOSLITERAL + .dw @BRLEN@ +.endif + .db "@BRNAME@" +.if cpu_msp430==1 + .align 16 +.endif + .dw XT_EXIT diff --git a/amforth-6.5/common/words/handler.asm b/amforth-6.5/common/words/handler.asm new file mode 100644 index 0000000..61b1c58 --- /dev/null +++ b/amforth-6.5/common/words/handler.asm @@ -0,0 +1,19 @@ +; ( -- a-addr ) +; Exceptions +; USER variable used by catch/throw + +.if cpu_msp430==1 + HEADER(XT_HANDLER,7,"handler",DOUSER) +.endif + +.if cpu_avr8==1 +VE_HANDLER: + .dw $ff07 + .db "handler",0 + .dw VE_HEAD + .set VE_HEAD = VE_HANDLER +XT_HANDLER: + .dw PFA_DOUSER +PFA_HANDLER: +.endif + .dw USER_HANDLER diff --git a/amforth-6.5/common/words/hex.asm b/amforth-6.5/common/words/hex.asm new file mode 100644 index 0000000..c87fa69 --- /dev/null +++ b/amforth-6.5/common/words/hex.asm @@ -0,0 +1,23 @@ +; ( -- ) +; Numeric IO +; set base for numeric conversion to 10 + +.if cpu_msp430==1 + HEADER(XT_HEX,3,"hex",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_HEX: + .dw $ff03 + .db "hex",0 + .dw VE_HEAD + .set VE_HEAD = VE_HEX +XT_HEX: + .dw DO_COLON +PFA_HEX: +.endif + .dw XT_DOLITERAL + .dw 16 + .dw XT_BASE + .dw XT_STORE + .dw XT_EXIT diff --git a/amforth-6.5/common/words/hold.asm b/amforth-6.5/common/words/hold.asm new file mode 100644 index 0000000..dda538a --- /dev/null +++ b/amforth-6.5/common/words/hold.asm @@ -0,0 +1,29 @@ +; ( c -- ) +; Numeric IO +; prepend character to pictured numeric output buffer + +.if cpu_msp430==1 + HEADER(XT_HOLD,4,"hold",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_HOLD: + .dw $ff04 + .db "hold" + .dw VE_HEAD + .set VE_HEAD = VE_HOLD +XT_HOLD: + .dw DO_COLON +PFA_HOLD: +.endif + .dw XT_HLD + .dw XT_DUP + .dw XT_FETCH + .dw XT_1MINUS + .dw XT_DUP + .dw XT_TO_R + .dw XT_SWAP + .dw XT_STORE + .dw XT_R_FROM + .dw XT_CSTORE + .dw XT_EXIT diff --git a/amforth-6.5/common/words/if.asm b/amforth-6.5/common/words/if.asm new file mode 100644 index 0000000..a3a0cc8 --- /dev/null +++ b/amforth-6.5/common/words/if.asm @@ -0,0 +1,22 @@ +; ( f -- ) (C: -- orig ) +; Compiler +; start conditional branch + +.if cpu_msp430==1 + IMMED(XT_IF,2,"if",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_IF: + .dw $0002 + .db "if" + .dw VE_HEAD + .set VE_HEAD = VE_IF +XT_IF: + .dw DO_COLON +PFA_IF: +.endif + .dw XT_COMPILE + .dw XT_DOCONDBRANCH + .dw XT_GMARK + .dw XT_EXIT diff --git a/amforth-6.5/common/words/interpret.asm b/amforth-6.5/common/words/interpret.asm new file mode 100644 index 0000000..37489ae --- /dev/null +++ b/amforth-6.5/common/words/interpret.asm @@ -0,0 +1,38 @@ +; (i*x - j*x ) +; System +; Interpret SOURCE word by word. + +.if cpu_msp430==1 + HEADER(XT_INTERPRET,9,"interpret",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_INTERPRET: + .dw $ff09 + .db "interpret",0 + .dw VE_HEAD + .set VE_HEAD = VE_INTERPRET +XT_INTERPRET: + .dw DO_COLON +.endif +PFA_INTERPRET: + .dw XT_PARSENAME ; ( -- addr len ) + .dw XT_DUP ; ( -- addr len flag) + .dw XT_DOCONDBRANCH + DEST(PFA_INTERPRET2) + .dw XT_FORTHRECOGNIZER + .dw XT_RECOGNIZE + .dw XT_STATE + .dw XT_FETCH + .dw XT_DOCONDBRANCH + DEST(PFA_INTERPRET1) + .dw XT_ICELLPLUS ; we need the compile action +PFA_INTERPRET1: + .dw XT_FETCHI + .dw XT_EXECUTE + .dw XT_QSTACK + .dw XT_DOBRANCH + DEST(PFA_INTERPRET) +PFA_INTERPRET2: + .dw XT_2DROP + .dw XT_EXIT diff --git a/amforth-6.5/common/words/key.asm b/amforth-6.5/common/words/key.asm new file mode 100644 index 0000000..06a4b47 --- /dev/null +++ b/amforth-6.5/common/words/key.asm @@ -0,0 +1,21 @@ +; ( -- c ) +; Character IO +; fetch key vector and execute it, should leave a single character on TOS + +.if cpu_msp430==1 + DEFER(XT_KEY,3,"key") +.endif + +.if cpu_avr8==1 +VE_KEY: + .dw $ff03 + .db "key",0 + .dw VE_HEAD + .set VE_HEAD = VE_KEY +XT_KEY: + .dw PFA_DODEFER1 +PFA_KEY: +.endif + .dw USER_KEY + .dw XT_UDEFERFETCH + .dw XT_UDEFERSTORE diff --git a/amforth-6.5/common/words/keyq.asm b/amforth-6.5/common/words/keyq.asm new file mode 100644 index 0000000..70e8c73 --- /dev/null +++ b/amforth-6.5/common/words/keyq.asm @@ -0,0 +1,21 @@ +; ( -- f) +; Character IO +; fetch key? vector and execute it. should turn on key sender, if it is disabled/stopped + +.if cpu_msp430==1 + DEFER(XT_KEYQ,4,"key?") +.endif + +.if cpu_avr8==1 +VE_KEYQ: + .dw $ff04 + .db "key?" + .dw VE_HEAD + .set VE_HEAD = VE_KEYQ +XT_KEYQ: + .dw PFA_DODEFER1 +PFA_KEYQ: +.endif + .dw USER_KEYQ + .dw XT_UDEFERFETCH + .dw XT_UDEFERSTORE diff --git a/amforth-6.5/common/words/l-from.asm b/amforth-6.5/common/words/l-from.asm new file mode 100644 index 0000000..353fbeb --- /dev/null +++ b/amforth-6.5/common/words/l-from.asm @@ -0,0 +1,27 @@ + +.if cpu_msp430==1 + HEADER(XT_L_FROM,2,"l>",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_L_FROM: + .dw $ff02 + .db "l>" + .dw VE_HEAD + .set VE_HEAD = VE_L_FROM +XT_L_FROM: + .dw DO_COLON +PFA_L_FROM: + +.endif +;Z L> -- x L: x -- move from leave stack +; LP @ @ -2 LP +! ; + + .dw XT_LP + .dw XT_FETCH + .dw XT_FETCH + .dw XT_DOLITERAL + .dw -2 + .dw XT_LP + .dw XT_PLUSSTORE + .dw XT_EXIT diff --git a/amforth-6.5/common/words/l-paren.asm b/amforth-6.5/common/words/l-paren.asm new file mode 100644 index 0000000..b1d0ef1 --- /dev/null +++ b/amforth-6.5/common/words/l-paren.asm @@ -0,0 +1,23 @@ +; ( "ccc" -- ) +; Compiler +; skip everything up to the closing bracket on the same line + +.if cpu_msp430==1 + IMMED(XT_PAREN,1,"(",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_LPAREN: + .dw $0001 + .db "(" ,0 + .dw VE_HEAD + .set VE_HEAD = VE_LPAREN +XT_LPAREN: + .dw DO_COLON +PFA_LPAREN: +.endif + .dw XT_DOLITERAL + .dw ')' + .dw XT_PARSE + .dw XT_2DROP + .dw XT_EXIT diff --git a/amforth-6.5/common/words/leave.asm b/amforth-6.5/common/words/leave.asm new file mode 100644 index 0000000..a7e676c --- /dev/null +++ b/amforth-6.5/common/words/leave.asm @@ -0,0 +1,20 @@ +; ( -- ) (R: loop-sys -- ) +; Compiler +; immediatly leave the current DO..LOOP + +.if cpu_msp430==1 + IMMED(XT_LEAVE,5,"leave",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_LEAVE: + .dw $0005 + .db "leave",0 + .dw VE_HEAD + .set VE_HEAD = VE_LEAVE +XT_LEAVE: + .dw DO_COLON +PFA_LEAVE: +.endif + .DW XT_COMPILE,XT_UNLOOP + .DW XT_AHEAD,XT_TO_L,XT_EXIT diff --git a/amforth-6.5/common/words/left-bracket.asm b/amforth-6.5/common/words/left-bracket.asm new file mode 100644 index 0000000..1957d4f --- /dev/null +++ b/amforth-6.5/common/words/left-bracket.asm @@ -0,0 +1,22 @@ +; ( -- ) +; Compiler +; enter interpreter mode + +.if cpu_msp430==1 + IMMED(XT_LBRACKET,1,"[",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_LBRACKET: + .dw $0001 + .db "[",0 + .dw VE_HEAD + .set VE_HEAD = VE_LBRACKET +XT_LBRACKET: + .dw DO_COLON +PFA_LBRACKET: +.endif + .dw XT_ZERO + .dw XT_STATE + .dw XT_STORE + .dw XT_EXIT diff --git a/amforth-6.5/common/words/less-sharp.asm b/amforth-6.5/common/words/less-sharp.asm new file mode 100644 index 0000000..122c246 --- /dev/null +++ b/amforth-6.5/common/words/less-sharp.asm @@ -0,0 +1,22 @@ +; ( -- ) +; Numeric IO +; initialize the pictured numeric output conversion process + +.if cpu_msp430==1 + HEADER(XT_L_SHARP,2,"<#",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_L_SHARP: + .dw $ff02 + .db "<#" + .dw VE_HEAD + .set VE_HEAD = VE_L_SHARP +XT_L_SHARP: + .dw DO_COLON +PFA_L_SHARP: +.endif + .dw XT_PAD + .dw XT_HLD + .dw XT_STORE + .dw XT_EXIT diff --git a/amforth-6.5/common/words/literal.asm b/amforth-6.5/common/words/literal.asm new file mode 100644 index 0000000..7d69652 --- /dev/null +++ b/amforth-6.5/common/words/literal.asm @@ -0,0 +1,22 @@ +; ( -- n ) (C: n -- ) +; Compiler +; compile a literal in colon defintions + +.if cpu_msp430==1 + IMMED(XT_LITERAL,7,"literal",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_LITERAL: + .dw $0007 + .db "literal",0 + .dw VE_HEAD + .set VE_HEAD = VE_LITERAL +XT_LITERAL: + .dw DO_COLON +PFA_LITERAL: +.endif + .DW XT_COMPILE + .DW XT_DOLITERAL + .DW XT_COMMA + .DW XT_EXIT diff --git a/amforth-6.5/common/words/loop.asm b/amforth-6.5/common/words/loop.asm new file mode 100644 index 0000000..9ffbfac --- /dev/null +++ b/amforth-6.5/common/words/loop.asm @@ -0,0 +1,22 @@ +; (R: loop-sys -- ) (C: do-sys -- ) +; Compiler +; compile (loop) and resolve the backward branch + +.if cpu_msp430==1 + IMMED(XT_LOOP,4,"loop",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_LOOP: + .dw $0004 + .db "loop" + .dw VE_HEAD + .set VE_HEAD = VE_LOOP +XT_LOOP: + .dw DO_COLON +PFA_LOOP: +.endif + .dw XT_COMPILE + .dw XT_DOLOOP + .dw XT_ENDLOOP + .dw XT_EXIT diff --git a/amforth-6.5/common/words/map-stack.asm b/amforth-6.5/common/words/map-stack.asm new file mode 100644 index 0000000..48995a1 --- /dev/null +++ b/amforth-6.5/common/words/map-stack.asm @@ -0,0 +1,61 @@ +; ( i*x XT e-addr -- j*y true | i*x false ) +; Tools +; Iterate over a stack + +.if cpu_msp430==1 + HEADER(XT_MAPSTACK,9,"map-stack",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_MAPSTACK: + .dw $ff09 + .db "map-stack",0 + .dw VE_HEAD + .set VE_HEAD = VE_MAPSTACK +XT_MAPSTACK: + .dw DO_COLON +PFA_MAPSTACK: +.endif + .dw XT_DUP + .dw XT_CELLPLUS + .dw XT_SWAP + .dw XT_FETCHE + .dw XT_CELLS + .dw XT_BOUNDS + .dw XT_QDOCHECK + .dw XT_DOCONDBRANCH + DEST(PFA_MAPSTACK3) + .dw XT_DODO +PFA_MAPSTACK1: + .dw XT_I + .dw XT_FETCHE ; -- i*x XT id + .dw XT_SWAP + .dw XT_TO_R + .dw XT_R_FETCH + .dw XT_EXECUTE ; i*x id -- j*y true | i*x false + .dw XT_QDUP + .dw XT_DOCONDBRANCH + DEST(PFA_MAPSTACK2) + .dw XT_R_FROM + .dw XT_DROP + .dw XT_UNLOOP + .dw XT_EXIT +PFA_MAPSTACK2: + .dw XT_R_FROM + .dw XT_TWO + .dw XT_DOPLUSLOOP + DEST(PFA_MAPSTACK1) +PFA_MAPSTACK3: + .dw XT_DROP + .dw XT_ZERO + .dw XT_EXIT + +; +; : map-stack ( i*x XT e-addr -- j*y ) +; dup cell+ swap @e cells bounds ?do +; ( -- i*x XT ) +; i @e swap >r r@ execute +; ?dup if r> drop unloop exit then +; r> +; 2 +loop drop 0 +; ; diff --git a/amforth-6.5/common/words/max.asm b/amforth-6.5/common/words/max.asm new file mode 100644 index 0000000..44cbbad --- /dev/null +++ b/amforth-6.5/common/words/max.asm @@ -0,0 +1,27 @@ +; ( n1 n2 -- n1|n2 ) +; Compare +; compare two values, leave the bigger one + +.if cpu_msp430==1 + HEADER(XT_MAX,3,"max",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_MAX: + .dw $ff03 + .db "max",0 + .dw VE_HEAD + .set VE_HEAD = VE_MAX +XT_MAX: + .dw DO_COLON +PFA_MAX: + +.endif + .dw XT_2DUP + .dw XT_LESS + .dw XT_DOCONDBRANCH + DEST(PFA_MAX1) + .dw XT_SWAP +PFA_MAX1: + .dw XT_DROP + .dw XT_EXIT diff --git a/amforth-6.5/common/words/min.asm b/amforth-6.5/common/words/min.asm new file mode 100644 index 0000000..59e9965 --- /dev/null +++ b/amforth-6.5/common/words/min.asm @@ -0,0 +1,28 @@ +; ( n1 n2 -- n1|n2 ) +; Compare +; compare two values leave the smaller one + +.if cpu_msp430==1 + HEADER(XT_MIN,3,"min",DOCOLON) +.endif + +.if cpu_avr8==1 + + +VE_MIN: + .dw $ff03 + .db "min",0 + .dw VE_HEAD + .set VE_HEAD = VE_MIN +XT_MIN: + .dw DO_COLON +PFA_MIN: +.endif + .dw XT_2DUP + .dw XT_GREATER + .dw XT_DOCONDBRANCH + DEST(PFA_MIN1) + .dw XT_SWAP +PFA_MIN1: + .dw XT_DROP + .dw XT_EXIT diff --git a/amforth-6.5/common/words/mod.asm b/amforth-6.5/common/words/mod.asm new file mode 100644 index 0000000..1f6cdee --- /dev/null +++ b/amforth-6.5/common/words/mod.asm @@ -0,0 +1,23 @@ +; ( n1 n2 -- n3) +; Arithmetics +; divide n1 by n2 giving the remainder n3 + +.if cpu_msp430==1 + HEADER(XT_MOD,3,"mod",DOCOLON) +.endif + +.if cpu_avr8==1 + + +VE_MOD: + .dw $ff03 + .db "mod",0 + .dw VE_HEAD + .set VE_HEAD = VE_MOD +XT_MOD: + .dw DO_COLON +PFA_MOD: +.endif + .dw XT_SLASHMOD + .dw XT_DROP + .dw XT_EXIT diff --git a/amforth-6.5/common/words/name2compile.asm b/amforth-6.5/common/words/name2compile.asm new file mode 100644 index 0000000..129ea0f --- /dev/null +++ b/amforth-6.5/common/words/name2compile.asm @@ -0,0 +1,31 @@ +; ( nt -- xt1 xt2 ) +; Tools (ext) +; get the execution token from the name token in compile state +.if cpu_msp430==1 + HEADER(XT_NAME2COMPILE,12,"name>compile",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_NAME2COMPILE: + .dw $ff0c + .db "name>compile" + .dw VE_HEAD + .set VE_HEAD = VE_NAME2COMPILE +XT_NAME2COMPILE: + .dw DO_COLON +PFA_NAME2COMPILE: +.endif + .dw XT_DUP + .dw XT_NFA2CFA + .dw XT_SWAP + .dw XT_NAME2FLAGS + .dw XT_IMMEDIATEQ + .dw XT_DOCONDBRANCH + DEST(NAME2COMPILE1) + .dw XT_DOLITERAL + .dw XT_COMMA + .dw XT_EXIT +NAME2COMPILE1: + .dw XT_DOLITERAL + .dw XT_EXECUTE + .dw XT_EXIT diff --git a/amforth-6.5/common/words/name2interpret.asm b/amforth-6.5/common/words/name2interpret.asm new file mode 100644 index 0000000..5a43389 --- /dev/null +++ b/amforth-6.5/common/words/name2interpret.asm @@ -0,0 +1,19 @@ +; ( nt -- xt ) +; Tools (ext) +; get the execution token from the name token +.if cpu_msp430==1 + HEADER(XT_NAME2INTERPRET,14,"name>interpret",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_NAME2INTERPRET: + .dw $ff0e + .db "name>interpret" + .dw VE_HEAD + .set VE_HEAD = VE_NAME2INTERPRET +XT_NAME2INTERPRET: + .dw DO_COLON +PFA_NAME2INTERPRET: +.endif + .dw XT_NFA2CFA + .dw XT_EXIT diff --git a/amforth-6.5/common/words/name2string.asm b/amforth-6.5/common/words/name2string.asm new file mode 100644 index 0000000..733e143 --- /dev/null +++ b/amforth-6.5/common/words/name2string.asm @@ -0,0 +1,24 @@ +; ( nt -- addr len ) +; Tools Ext (2012) +; get a (flash) string from a name token nt + +.if cpu_msp430==1 + HEADER(XT_NAME2STRING,11,"name>string",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_NAME2STRING: + .dw $ff0b + .db "name>string",0 + .dw VE_HEAD + .set VE_HEAD = VE_NAME2STRING +XT_NAME2STRING: + .dw DO_COLON +PFA_NAME2STRING: + +.endif + .dw XT_ICOUNT ; ( -- addr n ) + .dw XT_DOLITERAL + .dw 255 + .dw XT_AND ; mask immediate bit + .dw XT_EXIT diff --git a/amforth-6.5/common/words/noop.asm b/amforth-6.5/common/words/noop.asm new file mode 100644 index 0000000..9a99c28 --- /dev/null +++ b/amforth-6.5/common/words/noop.asm @@ -0,0 +1,19 @@ +; ( -- ) +; Tools +; do nothing + +.if cpu_msp430==1 + HEADER(XT_NOOP,4,"noop",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_NOOP: + .dw $ff04 + .db "noop" + .dw VE_HEAD + .set VE_HEAD = VE_NOOP +XT_NOOP: + .dw DO_COLON +PFA_NOOP: +.endif + .DW XT_EXIT diff --git a/amforth-6.5/common/words/not-equal.asm b/amforth-6.5/common/words/not-equal.asm new file mode 100644 index 0000000..2d103ed --- /dev/null +++ b/amforth-6.5/common/words/not-equal.asm @@ -0,0 +1,20 @@ +; ( n1 n2 -- flag) +; Compare +; true if n1 is not equal to n2 + +.if cpu_msp430==1 + HEADER(XT_NOTEQUAL,2,"<>",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_NOTEQUAL: + .dw $ff02 + .db "<>" + .dw VE_HEAD + .set VE_HEAD = VE_NOTEQUAL +XT_NOTEQUAL: + .dw DO_COLON +PFA_NOTEQUAL: +.endif + + .DW XT_EQUAL,XT_ZEROEQUAL,XT_EXIT diff --git a/amforth-6.5/common/words/num-constants.asm b/amforth-6.5/common/words/num-constants.asm new file mode 100644 index 0000000..88d1449 --- /dev/null +++ b/amforth-6.5/common/words/num-constants.asm @@ -0,0 +1,51 @@ +.if cpu_msp430==1 + HEADER(XT_ZERO,1,"0",DOCON) + DW 0 +.endif + +.if cpu_msp430==1 + HEADER(XT_ONE,1,"1",DOCON) +.endif + +.if cpu_avr8==1 +VE_ONE: + .dw $ff01 + .db "1",0 + .dw VE_HEAD + .set VE_HEAD = VE_ONE +XT_ONE: + .dw PFA_DOVARIABLE +PFA_ONE: +.endif + .DW 1 + +.if cpu_msp430==1 + HEADER(XT_TWO,1,"2",DOCON) +.endif + +.if cpu_avr8==1 +VE_TWO: + .dw $ff01 + .db "2",0 + .dw VE_HEAD + .set VE_HEAD = VE_TWO +XT_TWO: + .dw PFA_DOVARIABLE +PFA_TWO: +.endif + .DW 2 +.if cpu_msp430==1 + HEADER(XT_MINUSONE,2,"-1",DOCON) +.endif + +.if cpu_avr8==1 +VE_MINUSONE: + .dw $ff02 + .db "-1" + .dw VE_HEAD + .set VE_HEAD = VE_MINUSONE +XT_MINUSONE: + .dw PFA_DOVARIABLE +PFA_MINUSONE: +.endif + .DW -1 diff --git a/amforth-6.5/common/words/number.asm b/amforth-6.5/common/words/number.asm new file mode 100644 index 0000000..0c22655 --- /dev/null +++ b/amforth-6.5/common/words/number.asm @@ -0,0 +1,101 @@ +; (addr len -- [n|d size] f) +; Numeric IO +; convert a string at addr to a number + +.if cpu_msp430==1 + HEADER(XT_NUMBER,6,"number",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_NUMBER: + .dw $ff06 + .db "number" + .dw VE_HEAD + .set VE_HEAD = VE_NUMBER +XT_NUMBER: + .dw DO_COLON +PFA_NUMBER: +.endif + .dw XT_BASE + .dw XT_FETCH + .dw XT_TO_R + .dw XT_QSIGN + .dw XT_TO_R + .dw XT_SET_BASE + .dw XT_QSIGN + .dw XT_R_FROM + .dw XT_OR + .dw XT_TO_R + ; check whether something is left + .dw XT_DUP + .dw XT_ZEROEQUAL + .dw XT_DOCONDBRANCH + DEST(PFA_NUMBER0) + ; nothing is left. It cannot be a number at all + .dw XT_2DROP + .dw XT_R_FROM + .dw XT_DROP + .dw XT_R_FROM + .dw XT_BASE + .dw XT_STORE + .dw XT_ZERO + .dw XT_EXIT +PFA_NUMBER0: + .dw XT_2TO_R + .dw XT_ZERO ; starting value + .dw XT_ZERO + .dw XT_2R_FROM + .dw XT_TO_NUMBER ; ( 0. addr len -- d addr' len' + ; check length of the remaining string. + ; if zero: a single cell number is entered + .dw XT_QDUP + .dw XT_DOCONDBRANCH + DEST(PFA_NUMBER1) + ; if equal 1: mayba a trailing dot? --> double cell number + .dw XT_ONE + .dw XT_EQUAL + .dw XT_DOCONDBRANCH + DEST(PFA_NUMBER2) + ; excatly one character is left + .dw XT_CFETCH + .dw XT_DOLITERAL + .dw 46 ; . + .dw XT_EQUAL + .dw XT_DOCONDBRANCH + DEST(PFA_NUMBER6) + ; its a double cell number + ; incorporate sign into number + .dw XT_R_FROM + .dw XT_DOCONDBRANCH + DEST(PFA_NUMBER3) + .dw XT_DNEGATE +PFA_NUMBER3: + .dw XT_TWO + .dw XT_DOBRANCH + DEST(PFA_NUMBER5) +PFA_NUMBER2: + .dw XT_DROP +PFA_NUMBER6: + .dw XT_2DROP + .dw XT_R_FROM + .dw XT_DROP + .dw XT_R_FROM + .dw XT_BASE + .dw XT_STORE + .dw XT_ZERO + .dw XT_EXIT +PFA_NUMBER1: + .dw XT_2DROP ; remove the address + ; incorporate sign into number + .dw XT_R_FROM + .dw XT_DOCONDBRANCH + DEST(PFA_NUMBER4) + .dw XT_NEGATE +PFA_NUMBER4: + .dw XT_ONE +PFA_NUMBER5: + .dw XT_R_FROM + .dw XT_BASE + .dw XT_STORE + .dw XT_TRUE + .dw XT_EXIT diff --git a/amforth-6.5/common/words/pad.asm b/amforth-6.5/common/words/pad.asm new file mode 100644 index 0000000..93a2863 --- /dev/null +++ b/amforth-6.5/common/words/pad.asm @@ -0,0 +1,23 @@ +; ( -- a-addr ) +; System Variable +; Address of the temporary scratch buffer. + +.if cpu_msp430==1 + HEADER(XT_PAD,3,"pad",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_PAD: + .dw $ff03 + .db "pad",0 + .dw VE_HEAD + .set VE_HEAD = VE_PAD +XT_PAD: + .dw DO_COLON +PFA_PAD: +.endif + .dw XT_HERE + .dw XT_DOLITERAL + .dw 40 + .dw XT_PLUS + .dw XT_EXIT diff --git a/amforth-6.5/common/words/parse-name.asm b/amforth-6.5/common/words/parse-name.asm new file mode 100644 index 0000000..3c26396 --- /dev/null +++ b/amforth-6.5/common/words/parse-name.asm @@ -0,0 +1,60 @@ +; ( "" -- c-addr u ) +; String +; In the SOURCE buffer parse whitespace delimited string. Returns string address within SOURCE. + +.if cpu_msp430==1 + HEADER(XT_PARSENAME,10,"parse-name",DOCOLON) +.endif + +.if cpu_avr8==1 + +VE_PARSENAME: + .dw $FF0A + .db "parse-name" + .dw VE_HEAD + .set VE_HEAD = VE_PARSENAME +XT_PARSENAME: + .dw DO_COLON +PFA_PARSENAME: +.endif + .dw XT_BL + .dw XT_SKIPSCANCHAR + .dw XT_EXIT + +; ( c -- addr2 len2 ) +; String +; skips char and scan what's left in source for char +.if cpu_msp430==1 + HEADLESS(XT_SKIPSCANCHAR,DOCOLON) +.endif + +.if cpu_avr8==1 +;VE_SKIPSCANCHAR: +; .dw $FF0A +; .db "skipscanchar" +; .dw VE_HEAD +; .set VE_HEAD = VE_SKIPSCANCHAR +XT_SKIPSCANCHAR: + .dw DO_COLON +PFA_SKIPSCANCHAR: +.endif + .dw XT_TO_R + .dw XT_SOURCE + .dw XT_TO_IN + .dw XT_FETCH + .dw XT_SLASHSTRING + + .dw XT_R_FETCH + .dw XT_CSKIP + .dw XT_R_FROM + .dw XT_CSCAN + + ; adjust >IN + .dw XT_2DUP + .dw XT_PLUS + .dw XT_SOURCE + .dw XT_DROP + .dw XT_MINUS + .dw XT_TO_IN + .dw XT_STORE + .dw XT_EXIT diff --git a/amforth-6.5/common/words/parse.asm b/amforth-6.5/common/words/parse.asm new file mode 100644 index 0000000..0e51c05 --- /dev/null +++ b/amforth-6.5/common/words/parse.asm @@ -0,0 +1,33 @@ +; ( char "ccc" -- c-addr u ) +; String +; in input buffer parse ccc delimited string by the delimiter char. + +.if cpu_msp430==1 + HEADER(XT_PARSE,5,"parse",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_PARSE: + .dw $ff05 + .db "parse",0 + .dw VE_HEAD + .set VE_HEAD = VE_PARSE +XT_PARSE: + .dw DO_COLON +PFA_PARSE: +.endif + .dw XT_TO_R ; ( -- ) + .dw XT_SOURCE ; ( -- addr len) + .dw XT_TO_IN ; ( -- addr len >in) + .dw XT_FETCH + .dw XT_SLASHSTRING ; ( -- addr' len' ) + + .dw XT_R_FROM ; ( -- addr' len' c) + .dw XT_CSCAN ; ( -- addr' len'') + .dw XT_DUP ; ( -- addr' len'' len'') + .dw XT_1PLUS + .dw XT_TO_IN ; ( -- addr' len'' len'' >in) + .dw XT_PLUSSTORE ; ( -- addr' len') + .dw XT_ONE + .dw XT_SLASHSTRING + .dw XT_EXIT diff --git a/amforth-6.5/common/words/pick.asm b/amforth-6.5/common/words/pick.asm new file mode 100644 index 0000000..4e246ea --- /dev/null +++ b/amforth-6.5/common/words/pick.asm @@ -0,0 +1,21 @@ + +.if cpu_msp430==1 + HEADER(XT_PICK,4,"pick",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_PICK: + .dw $ff04 + .db "pick" + .dw VE_HEAD + .set VE_HEAD = VE_PICK +XT_PICK: + .dw DO_COLON +PFA_PICK: +.endif + .dw XT_1PLUS + .dw XT_CELLS + .dw XT_SP_FETCH + .dw XT_PLUS + .dw XT_FETCH + .dw XT_EXIT diff --git a/amforth-6.5/common/words/place.asm b/amforth-6.5/common/words/place.asm new file mode 100644 index 0000000..916b0ae --- /dev/null +++ b/amforth-6.5/common/words/place.asm @@ -0,0 +1,24 @@ +; ( addr1 len1 addr2 -- ) +; String +; copy string as counted string + +.if cpu_msp430==1 + HEADER(XT_PLACE,5,"place",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_PLACE: + .dw $ff05 + .db "place",0 + .dw VE_HEAD + .set VE_HEAD = VE_PLACE +XT_PLACE: + .dw DO_COLON +PFA_PLACE: +.endif + .dw XT_2DUP ; ( -- addr1 len1 addr2 len1 addr2) + .dw XT_CSTORE ; ( -- addr1 len1 addr2) + .dw XT_1PLUS ; ( -- addr1 len1 addr2') + .dw XT_SWAP ; ( -- addr1 addr2' len1) + .dw XT_CMOVE ; ( --- ) + .dw XT_EXIT diff --git a/amforth-6.5/common/words/plusloop.asm b/amforth-6.5/common/words/plusloop.asm new file mode 100644 index 0000000..df7925c --- /dev/null +++ b/amforth-6.5/common/words/plusloop.asm @@ -0,0 +1,22 @@ +; ( n -- ) (R: loop-sys -- loop-sys| ) (C: do-sys -- ) +; Compiler +; compile (+loop) and resolve branches + +.if cpu_msp430==1 + IMMED(XT_PLUSLOOP,5,"+loop",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_PLUSLOOP: + .dw $0005 + .db "+loop",0 + .dw VE_HEAD + .set VE_HEAD = VE_PLUSLOOP +XT_PLUSLOOP: + .dw DO_COLON +PFA_PLUSLOOP: +.endif + .dw XT_COMPILE + .dw XT_DOPLUSLOOP + .dw XT_ENDLOOP + .dw XT_EXIT diff --git a/amforth-6.5/common/words/postpone.asm b/amforth-6.5/common/words/postpone.asm new file mode 100644 index 0000000..10f36df --- /dev/null +++ b/amforth-6.5/common/words/postpone.asm @@ -0,0 +1,32 @@ +; ( "name" -- ) +; Compiler +; Append the compilation semantics of "name" to the dictionary + +.if cpu_msp430==1 + IMMED(XT_POSTPONE,8,"postpone",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_POSTPONE: + .dw $0008 + .db "postpone" + .dw VE_HEAD + .set VE_HEAD = VE_POSTPONE +XT_POSTPONE: + .dw DO_COLON +PFA_POSTPONE: +.endif + .dw XT_PARSENAME + .dw XT_FORTHRECOGNIZER + .dw XT_RECOGNIZE + .dw XT_DUP + .dw XT_TO_R + .dw XT_ICELLPLUS + .dw XT_ICELLPLUS + .dw XT_FETCHI + .dw XT_EXECUTE + .dw XT_R_FROM + .dw XT_ICELLPLUS + .dw XT_FETCHI + .dw XT_COMMA + .dw XT_EXIT diff --git a/amforth-6.5/common/words/prompt-error.asm b/amforth-6.5/common/words/prompt-error.asm new file mode 100644 index 0000000..5d94faa --- /dev/null +++ b/amforth-6.5/common/words/prompt-error.asm @@ -0,0 +1,64 @@ +; ( n -- ) +; System +; process the error prompt + +.if cpu_msp430==1 + HEADLESS(XT_DEFAULT_PROMPTERROR,DOCOLON) + DW XT_DOSLITERAL + DB 4," ?? " + .align 16 +.endif + +.if cpu_avr8==1 +;VE_PROMPTERROR: +; .dw $ff04 +; .db "p_er" +; .dw VE_HEAD +; .set VE_HEAD = VE_PROMPTERROR +XT_DEFAULT_PROMPTERROR: + .dw DO_COLON +PFA_DEFAULT_PROMPTERROR: + .dw XT_DOSLITERAL + .dw 4 + .db " ?? " +.endif + .dw XT_ITYPE + .dw XT_BASE + .dw XT_FETCH + .dw XT_TO_R + .dw XT_DECIMAL + .dw XT_DOT + .dw XT_TO_IN + .dw XT_FETCH + .dw XT_DOT + .dw XT_R_FROM + .dw XT_BASE + .dw XT_STORE + .dw XT_EXIT + +; ------------------------ + +.if cpu_msp430==1 +; DEFER(XT_PROMPTERROR,6,".error") + DW link + DB 0FFh +.set link = $ + DB 6,".","error" + .align 16 +XT_PROMPTERROR: + DW DODEFER +.endif + +.if cpu_avr8==1 +VE_PROMPTERROR: + .dw $FF06 + .db ".error" + .dw VE_HEAD + .set VE_HEAD = VE_PROMPTERROR +XT_PROMPTERROR: + .dw PFA_DODEFER1 +PFA_PROMPTERROR: +.endif + .dw USER_P_ERR + .dw XT_UDEFERFETCH + .dw XT_UDEFERSTORE diff --git a/amforth-6.5/common/words/prompt-ok.asm b/amforth-6.5/common/words/prompt-ok.asm new file mode 100644 index 0000000..6a73974 --- /dev/null +++ b/amforth-6.5/common/words/prompt-ok.asm @@ -0,0 +1,52 @@ +; ( -- ) +; System +; send the READY prompt to the command line + +.if cpu_msp430==1 + HEADLESS(XT_DEFAULT_PROMPTOK,DOCOLON) + DW XT_DOSLITERAL + DB 3," ok" +.endif + +.if cpu_avr8==1 +;VE_PROMPTOK: +; .dw $ff02 +; .db "ok" +; .dw VE_HEAD +; .set VE_HEAD = VE_PROMPTOK +XT_DEFAULT_PROMPTOK: + .dw DO_COLON +PFA_DEFAULT_PROMPTOK: + .dw XT_DOSLITERAL + .dw 3 + .db " ok",0 +.endif + .dw XT_ITYPE + .dw XT_EXIT + +; ------------------------ + +.if cpu_msp430==1 +; DEFER(XT_PROMPTOK,2,"ok") + DW link + DB 0FFh +.set link = $ + DB 3,".","ok" + .align 16 +XT_PROMPTOK: + DW DODEFER +.endif + +.if cpu_avr8==1 +VE_PROMPTOK: + .dw $FF03 + .db ".ok" + .dw VE_HEAD + .set VE_HEAD = VE_PROMPTOK +XT_PROMPTOK: + .dw PFA_DODEFER1 +PFA_PROMPTOK: +.endif + .dw USER_P_OK + .dw XT_UDEFERFETCH + .dw XT_UDEFERSTORE diff --git a/amforth-6.5/common/words/prompt-ready.asm b/amforth-6.5/common/words/prompt-ready.asm new file mode 100644 index 0000000..ad5915c --- /dev/null +++ b/amforth-6.5/common/words/prompt-ready.asm @@ -0,0 +1,54 @@ +; ( n -- ) +; System +; process the error prompt + +.if cpu_msp430==1 + HEADLESS(XT_DEFAULT_PROMPTREADY,DOCOLON) + DW XT_DOSLITERAL + DB 2,"> " + .align 16 +.endif + +.if cpu_avr8==1 +;VE_PROMPTRDY: +; .dw $ff04 +; .db "p_er" +; .dw VE_HEAD +; .set VE_HEAD = VE_PROMPTRDY +XT_DEFAULT_PROMPTREADY: + .dw DO_COLON +PFA_DEFAULT_PROMPTREADY: + .dw XT_DOSLITERAL + .dw 2 + .db "> " +.endif + .dw XT_CR + .dw XT_ITYPE + .dw XT_EXIT + +; ------------------------ + +.if cpu_msp430==1 +; DEFER(XT_PROMPTREADY,6,".ready") + DW link + DB 0FFh +.set link = $ + DB 6,".","ready" + .align 16 +XT_PROMPTREADY: + DW DODEFER +.endif + +.if cpu_avr8==1 +VE_PROMPTREADY: + .dw $FF06 + .db ".ready" + .dw VE_HEAD + .set VE_HEAD = VE_PROMPTREADY +XT_PROMPTREADY: + .dw PFA_DODEFER1 +PFA_PROMPTREADY: +.endif + .dw USER_P_RDY + .dw XT_UDEFERFETCH + .dw XT_UDEFERSTORE diff --git a/amforth-6.5/common/words/q-abort.asm b/amforth-6.5/common/words/q-abort.asm new file mode 100644 index 0000000..89f25bf --- /dev/null +++ b/amforth-6.5/common/words/q-abort.asm @@ -0,0 +1,22 @@ +;Z ?ABORT f c-addr u -- abort & print msg +; ROT IF ITYPE ABORT THEN 2DROP ; + +.if cpu_msp430==1 + HEADER(XT_QABORT,6,"?abort",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_QABORT: + .dw $ff06 + .db "?abort" + .dw VE_HEAD + .set VE_HEAD = VE_QABORT +XT_QABORT: + .dw DO_COLON +PFA_QABORT: + +.endif + .DW XT_ROT,XT_DOCONDBRANCH + DEST(QABO1) + .DW XT_ITYPE,XT_ABORT +QABO1: .DW XT_2DROP,XT_EXIT diff --git a/amforth-6.5/common/words/q-dnegate.asm b/amforth-6.5/common/words/q-dnegate.asm new file mode 100644 index 0000000..a9938c6 --- /dev/null +++ b/amforth-6.5/common/words/q-dnegate.asm @@ -0,0 +1,21 @@ +;Z ?DNEGATE d1 n -- d2 negate d1 if n negative +; 0< IF DNEGATE THEN ; ...a common factor + +.if cpu_msp430==1 + HEADER(XT_QDNEGATE,8,"?dnegate",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_QDNEGATE: + .dw $ff08 + .db "?dnegate" + .dw VE_HEAD + .set VE_HEAD = VE_QDNEGATE +XT_QDNEGATE: + .dw DO_COLON +PFA_QDNEGATE: +.endif + .DW XT_ZEROLESS,XT_DOCONDBRANCH + DEST(DNEG1) + .DW XT_DNEGATE +DNEG1: .DW XT_EXIT diff --git a/amforth-6.5/common/words/q-negate.asm b/amforth-6.5/common/words/q-negate.asm new file mode 100644 index 0000000..b6fe534 --- /dev/null +++ b/amforth-6.5/common/words/q-negate.asm @@ -0,0 +1,22 @@ +;Z ?NEGATE n1 n2 -- n3 negate n1 if n2 negative +; 0< IF NEGATE THEN ; ...a common factor + +.if cpu_msp430==1 + HEADER(XT_QNEGATE,7,"?negate",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_QNEGATE: + .dw $ff07 + .db "?negate" + .dw VE_HEAD + .set VE_HEAD = VE_QNEGATE +XT_QNEGATE: + .dw DO_COLON +PFA_QNEGATE: + +.endif + .DW XT_ZEROLESS,XT_DOCONDBRANCH + DEST(QNEG1) + .DW XT_NEGATE +QNEG1: .DW XT_EXIT diff --git a/amforth-6.5/common/words/q-sign.asm b/amforth-6.5/common/words/q-sign.asm new file mode 100644 index 0000000..8f0422b --- /dev/null +++ b/amforth-6.5/common/words/q-sign.asm @@ -0,0 +1,24 @@ + +.if cpu_msp430==1 + HEADLESS(XT_QSIGN,DOCOLON) +.endif + +.if cpu_avr8==1 +XT_QSIGN: + .dw DO_COLON +PFA_QSIGN: ; ( c -- ) +.endif + .dw XT_OVER ; ( -- addr len addr ) + .dw XT_CFETCH + .dw XT_DOLITERAL + .dw '-' + .dw XT_EQUAL ; ( -- addr len flag ) + .dw XT_DUP + .dw XT_TO_R + .dw XT_DOCONDBRANCH + DEST(PFA_NUMBERSIGN_DONE) + .dw XT_ONE ; skip sign character + .dw XT_SLASHSTRING +PFA_NUMBERSIGN_DONE: + .dw XT_R_FROM + .dw XT_EXIT diff --git a/amforth-6.5/common/words/q-stack.asm b/amforth-6.5/common/words/q-stack.asm new file mode 100644 index 0000000..f652bb2 --- /dev/null +++ b/amforth-6.5/common/words/q-stack.asm @@ -0,0 +1,26 @@ +; ( -- ) +; Tools +; check data stack depth and exit to quit if underrun +.if cpu_msp430==1 + HEADER(XT_QSTACK,6,"?stack",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_QSTACK: + .dw $ff06 + .db "?stack" + .dw VE_HEAD + .set VE_HEAD = VE_QSTACK +XT_QSTACK: + .dw DO_COLON +PFA_QSTACK: +.endif + .dw XT_DEPTH + .dw XT_ZEROLESS + .dw XT_DOCONDBRANCH + DEST(PFA_QSTACK1) + .dw XT_DOLITERAL + .dw -4 + .dw XT_THROW +PFA_QSTACK1: + .dw XT_EXIT diff --git a/amforth-6.5/common/words/qdo.asm b/amforth-6.5/common/words/qdo.asm new file mode 100644 index 0000000..491d06c --- /dev/null +++ b/amforth-6.5/common/words/qdo.asm @@ -0,0 +1,54 @@ +; ( n1|u1 n2|u2 -- ) R( -- | loop-sys ) (C: -- do-sys) +; Compiler +; start a ?do .. [+]loop control structure + +.if cpu_msp430==1 + IMMED(XT_QDO,3,"?do",DOCOLON) +.endif + +.if cpu_avr8==1 + +VE_QDO: + .dw $0003 + .db "?do",0 + .dw VE_HEAD + .set VE_HEAD = VE_QDO +XT_QDO: + .dw DO_COLON +PFA_QDO: +.endif + .dw XT_COMPILE + .dw XT_QDOCHECK + .dw XT_IF + .dw XT_DO + .dw XT_SWAP ; DO sets a 0 marker on the leave stack + .dw XT_TO_L ; then follows at the end. + .dw XT_EXIT + +; there is no special runtime for ?do, the do runtime +; gets wrapped with the sequence +; ... ?do-check if do ..... loop then +; with +; : ?do-check ( n1 n2 -- n1 n2 true | false ) +; 2dup = dup >r if 2drop then r> invert ; + +.if cpu_msp430==1 + HEADLESS(XT_QDOCHECK,DOCOLON) +.endif + +.if cpu_avr8==1 +XT_QDOCHECK: + .dw DO_COLON +PFA_QDOCHECK: +.endif + .dw XT_2DUP + .dw XT_EQUAL + .dw XT_DUP + .dw XT_TO_R + .dw XT_DOCONDBRANCH + DEST(PFA_QDOCHECK1) + .dw XT_2DROP +PFA_QDOCHECK1: + .dw XT_R_FROM + .dw XT_INVERT + .dw XT_EXIT diff --git a/amforth-6.5/common/words/quit.asm b/amforth-6.5/common/words/quit.asm new file mode 100644 index 0000000..2a30e4c --- /dev/null +++ b/amforth-6.5/common/words/quit.asm @@ -0,0 +1,58 @@ +; ( -- ) +; System +; main loop of amforth. accept - interpret in an endless loop + +.if cpu_msp430==1 + HEADER(XT_QUIT,4,"quit",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_QUIT: + .dw $ff04 + .db "quit" + .dw VE_HEAD + .set VE_HEAD = VE_QUIT +XT_QUIT: + .dw DO_COLON +.endif +PFA_QUIT: + .dw XT_LP0,XT_LP,XT_STORE + .dw XT_SP0 + .dw XT_SP_STORE + .dw XT_RP0 + .dw XT_RP_STORE + .dw XT_LBRACKET + +PFA_QUIT2: + .dw XT_STATE + .dw XT_FETCH + .dw XT_ZEROEQUAL + .dw XT_DOCONDBRANCH + DEST(PFA_QUIT4) + .dw XT_PROMPTREADY +PFA_QUIT4: + .dw XT_REFILL + .dw XT_DOCONDBRANCH + DEST(PFA_QUIT3) + .dw XT_DOLITERAL + .dw XT_INTERPRET + .dw XT_CATCH + .dw XT_QDUP + .dw XT_DOCONDBRANCH + DEST(PFA_QUIT3) + .dw XT_DUP + .dw XT_DOLITERAL + .dw -2 + .dw XT_LESS + .dw XT_DOCONDBRANCH + DEST(PFA_QUIT5) + .dw XT_PROMPTERROR +PFA_QUIT5: + .dw XT_DOBRANCH + DEST(PFA_QUIT) +PFA_QUIT3: + .dw XT_PROMPTOK + .dw XT_DOBRANCH + DEST(PFA_QUIT2) +; .dw XT_EXIT ; never reached + diff --git a/amforth-6.5/common/words/rdefer-fetch.asm b/amforth-6.5/common/words/rdefer-fetch.asm new file mode 100644 index 0000000..0424bd8 --- /dev/null +++ b/amforth-6.5/common/words/rdefer-fetch.asm @@ -0,0 +1,20 @@ +; ( xt1 -- xt2 ) +; System +; The defer@ for ram defers +.if cpu_msp430==1 + HEADER(XT_RDEFERFETCH,7,"Rdefer@",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_RDEFERFETCH: + .dw $ff07 + .db "Rdefer@",0 + .dw VE_HEAD + .set VE_HEAD = VE_RDEFERFETCH +XT_RDEFERFETCH: + .dw DO_COLON +PFA_RDEFERFETCH: +.endif + .dw XT_FETCHI + .dw XT_FETCH + .dw XT_EXIT diff --git a/amforth-6.5/common/words/rdefer-store.asm b/amforth-6.5/common/words/rdefer-store.asm new file mode 100644 index 0000000..906ca15 --- /dev/null +++ b/amforth-6.5/common/words/rdefer-store.asm @@ -0,0 +1,21 @@ +; ( xt1 xt2 -- ) +; System +; The defer! for ram defers +.if cpu_msp430==1 + HEADER(XT_RDEFERSTORE,7,"Rdefer!",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_RDEFERSTORE: + .dw $ff07 + .db "Rdefer!",0 + .dw VE_HEAD + .set VE_HEAD = VE_RDEFERSTORE +XT_RDEFERSTORE: + .dw DO_COLON +PFA_RDEFERSTORE: +.endif + .dw XT_FETCHI + .dw XT_STORE + .dw XT_EXIT + diff --git a/amforth-6.5/common/words/rec-find.asm b/amforth-6.5/common/words/rec-find.asm new file mode 100644 index 0000000..01a2aa1 --- /dev/null +++ b/amforth-6.5/common/words/rec-find.asm @@ -0,0 +1,85 @@ +; ( addr len -- xt flags dt:xt | dt:null ) +; Interpreter +; search for a word +.if cpu_msp430==1 + HEADER(XT_REC_FIND,8,"rec:find",DOCOLON) +.endif +.if cpu_avr8==1 +VE_REC_FIND: + .dw $ff08 + .db "rec:find" + .dw VE_HEAD + .set VE_HEAD = VE_REC_FIND +XT_REC_FIND: + .dw DO_COLON +PFA_REC_FIND: +.endif + .DW XT_FINDXT + .dw XT_DUP + .dw XT_ZEROEQUAL + .dw XT_DOCONDBRANCH + DEST(PFA_REC_WORD_FOUND) + .dw XT_DROP + .dw XT_DT_NULL + .dw XT_EXIT +PFA_REC_WORD_FOUND: + .dw XT_DT_XT + + .dw XT_EXIT + +; ( -- addr ) +; Interpreter +; actions to handle execution tokens and their flags +.if cpu_msp430==1 + HEADER(XT_DT_XT,6,"dt:xt",DOROM) +.endif + +.if cpu_avr8==1 +VE_DT_XT: + .dw $ff05 + .db "dt:xt",0 + .dw VE_HEAD + .set VE_HEAD = VE_DT_XT +XT_DT_XT: + .dw PFA_DOCONSTANT +PFA_DT_XT: +.endif + .dw XT_R_WORD_INTERPRET + .dw XT_R_WORD_COMPILE + .dw XT_2LITERAL + +; ( XT flags -- ) +; Interpreter +; interpret method for WORD recognizer +.if cpu_msp430==1 + HEADLESS(XT_R_WORD_INTERPRET,DOCOLON) +.endif + +.if cpu_avr8==1 +XT_R_WORD_INTERPRET: + .dw DO_COLON +PFA_R_WORD_INTERPRET: +.endif + .dw XT_DROP ; the flags are in the way + .dw XT_EXECUTE + .dw XT_EXIT + +; ( XT flags -- ) +; Interpreter +; Compile method for WORD recognizer +.if cpu_msp430==1 + HEADLESS(XT_R_WORD_COMPILE,DOCOLON) +.endif +.if cpu_avr8==1 +XT_R_WORD_COMPILE: + .dw DO_COLON +PFA_R_WORD_COMPILE: +.endif + .dw XT_ZEROLESS + .dw XT_DOCONDBRANCH + DEST(PFA_R_WORD_COMPILE1) + .dw XT_COMMA + .dw XT_EXIT +PFA_R_WORD_COMPILE1: + .dw XT_EXECUTE + .dw XT_EXIT diff --git a/amforth-6.5/common/words/rec-intnum.asm b/amforth-6.5/common/words/rec-intnum.asm new file mode 100644 index 0000000..15400e1 --- /dev/null +++ b/amforth-6.5/common/words/rec-intnum.asm @@ -0,0 +1,76 @@ +; ( -- addr ) +; Interpreter +; Method table for single cell integers +.if cpu_msp430==1 + HEADER(XT_DT_NUM,6,"dt:num",DOROM) +.endif + +.if cpu_avr8==1 +VE_DT_NUM: + .dw $ff06 + .db "dt:num" + .dw VE_HEAD + .set VE_HEAD = VE_DT_NUM +XT_DT_NUM: + .dw PFA_DOCONSTANT +PFA_DT_NUM: +.endif + .dw XT_NOOP ; interpret + .dw XT_LITERAL ; compile + .dw XT_LITERAL ; postpone + +; ( -- addr ) +; Interpreter +; Method table for double cell integers +.if cpu_msp430==1 + HEADER(XT_DT_DNUM,7,"dt:dnum",DOROM) +.endif + +.if cpu_avr8==1 +VE_DT_DNUM: + .dw $ff07 + .db "dt:dnum",0 + .dw VE_HEAD + .set VE_HEAD = VE_DT_DNUM +XT_DT_DNUM: + .dw PFA_DOCONSTANT +PFA_DT_DNUM: +.endif + .dw XT_NOOP ; interpret + .dw XT_2LITERAL ; compile + .dw XT_2LITERAL ; postpone + +; ( addr len -- f ) +; Interpreter +; recognizer for integer numbers +.if cpu_msp430==1 + HEADER(XT_REC_NUM,7,"rec:num",DOCOLON) +.endif + +.if cpu_avr8==1 + +VE_REC_NUM: + .dw $ff07 + .db "rec:num",0 + .dw VE_HEAD + .set VE_HEAD = VE_REC_NUM +XT_REC_NUM: + .dw DO_COLON +PFA_REC_NUM: +.endif + ; try converting to a number + .dw XT_NUMBER + .dw XT_DOCONDBRANCH + DEST(PFA_REC_NONUMBER) + .dw XT_ONE + .dw XT_EQUAL + .dw XT_DOCONDBRANCH + DEST(PFA_REC_INTNUM2) + .dw XT_DT_NUM + .dw XT_EXIT +PFA_REC_INTNUM2: + .dw XT_DT_DNUM + .dw XT_EXIT +PFA_REC_NONUMBER: + .dw XT_DT_NULL + .dw XT_EXIT diff --git a/amforth-6.5/common/words/recognize.asm b/amforth-6.5/common/words/recognize.asm new file mode 100644 index 0000000..2dc9690 --- /dev/null +++ b/amforth-6.5/common/words/recognize.asm @@ -0,0 +1,73 @@ +; (addr len recstack -- i*x dt:token | dt:null ) +; System +; walk the recognizer stack + +.if cpu_msp430==1 + HEADER(XT_RECOGNIZE,9,"recognize",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_RECOGNIZE: + .dw $ff09 + .db "recognize",0 + .dw VE_HEAD + .set VE_HEAD = VE_RECOGNIZE +XT_RECOGNIZE: + .dw DO_COLON +PFA_RECOGNIZE: +.endif + .dw XT_DOLITERAL + .dw XT_RECOGNIZE_A + .dw XT_SWAP + .dw XT_MAPSTACK + .dw XT_ZEROEQUAL + .dw XT_DOCONDBRANCH + DEST(PFA_RECOGNIZE1) + .dw XT_2DROP + .dw XT_DT_NULL +PFA_RECOGNIZE1: + .dw XT_EXIT + +.if cpu_msp430==1 + HEADLESS(XT_RECOGNIZE_A,DOCOLON) +.endif + +.if cpu_avr8==1 +; ( addr len XT -- addr len [ dt:xt -1 | 0 ] ) +XT_RECOGNIZE_A: + .dw DO_COLON +PFA_RECOGNIZE_A: +.endif + .dw XT_ROT ; -- len xt addr + .dw XT_ROT ; -- xt addr len + .dw XT_2DUP + .dw XT_2TO_R + .dw XT_ROT ; -- addr len xt + .dw XT_EXECUTE ; -- i*x dt:* | dt:null + .dw XT_2R_FROM + .dw XT_ROT + .dw XT_DUP + .dw XT_DT_NULL + .dw XT_EQUAL + .dw XT_DOCONDBRANCH + DEST(PFA_RECOGNIZE_A1) + .dw XT_DROP + .dw XT_ZERO + .dw XT_EXIT +PFA_RECOGNIZE_A1: + .dw XT_NIP + .dw XT_NIP + .dw XT_TRUE + .dw XT_EXIT + +; : recognize ( addr len stack-id -- i*x dt:* | dt:null ) +; [: ( addr len -- addr len 0 | i*x dt:* -1 ) +; rot rot 2dup 2>r rot execute 2r> rot +; dup dt:null = ( -- addr len dt:* f ) +; if drop 0 else nip nip -1 then +; ;] +; map-stack ( -- i*x addr len dt:* f ) +; 0= if \ a recognizer did the job, remove addr/len +; 2drop dt:null +; then ; +; diff --git a/amforth-6.5/common/words/recurse.asm b/amforth-6.5/common/words/recurse.asm new file mode 100644 index 0000000..c1f0114 --- /dev/null +++ b/amforth-6.5/common/words/recurse.asm @@ -0,0 +1,22 @@ +; ( -- ) +; Compiler +; compile the XT of the word currently being defined into the dictionary + +.if cpu_msp430==1 + IMMED(RECURSE,7,"recurse",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_RECURSE: + .dw $0007 + .db "recurse",0 + .dw VE_HEAD + .set VE_HEAD = VE_RECURSE +XT_RECURSE: + .dw DO_COLON +PFA_RECURSE: +.endif + .dw XT_LATEST + .dw XT_FETCH + .dw XT_COMMA + .dw XT_EXIT diff --git a/amforth-6.5/common/words/refill.asm b/amforth-6.5/common/words/refill.asm new file mode 100644 index 0000000..a7c918d --- /dev/null +++ b/amforth-6.5/common/words/refill.asm @@ -0,0 +1,21 @@ +; ( -- f ) +; System +; refills the input buffer + +.if cpu_msp430==1 + DEFER(XT_REFILL,6,"refill") +.endif + +.if cpu_avr8==1 +VE_REFILL: + .dw $ff06 + .db "refill" + .dw VE_HEAD + .set VE_HEAD = VE_REFILL +XT_REFILL: + .dw PFA_DODEFER1 +PFA_REFILL: +.endif + .dw USER_REFILL + .dw XT_UDEFERFETCH + .dw XT_UDEFERSTORE diff --git a/amforth-6.5/common/words/repeat.asm b/amforth-6.5/common/words/repeat.asm new file mode 100644 index 0000000..9ee9b09 --- /dev/null +++ b/amforth-6.5/common/words/repeat.asm @@ -0,0 +1,21 @@ +; ( -- ) (C: orig dest -- ) +; Compiler +; continue execution at dest, resolve orig + +.if cpu_msp430==1 + IMMED(XT_REPEAT,6,"repeat",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_REPEAT: + .dw $0006 + .db "repeat" + .dw VE_HEAD + .set VE_HEAD = VE_REPEAT +XT_REPEAT: + .dw DO_COLON +PFA_REPEAT: +.endif + .dw XT_AGAIN + .dw XT_THEN + .dw XT_EXIT diff --git a/amforth-6.5/common/words/reveal.asm b/amforth-6.5/common/words/reveal.asm new file mode 100644 index 0000000..b0b4931 --- /dev/null +++ b/amforth-6.5/common/words/reveal.asm @@ -0,0 +1,25 @@ +; ( -- ) +; Dictionary +; makes an entry in a wordlist visible, if not already done. + +.if cpu_msp430==1 + HEADER(XT_REVEAL,6,"reveal",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_REVEAL: + .dw $ff06 + .db "reveal" + .dw VE_HEAD + .set VE_HEAD = VE_REVEAL +XT_REVEAL: + .dw DO_COLON +PFA_REVEAL: +.endif + .DW XT_NEWEST,XT_CELLPLUS,XT_FETCH ; only if wordlist is in use + .DW XT_QDUP,XT_DOCONDBRANCH + DEST(REVEAL1) + .DW XT_NEWEST,XT_FETCH,XT_SWAP,XT_STOREE +; .DW XT_ZERO,XT_NEWEST,XT_CELLPLUS,XT_STORE ; clean wordlist entry +REVEAL1: + .DW XT_EXIT diff --git a/amforth-6.5/common/words/right-bracket.asm b/amforth-6.5/common/words/right-bracket.asm new file mode 100644 index 0000000..85dbd6a --- /dev/null +++ b/amforth-6.5/common/words/right-bracket.asm @@ -0,0 +1,22 @@ +; ( -- ) +; Compiler +; enter compiler mode + +.if cpu_msp430==1 + HEADER(XT_RBRACKET,1,"]",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_RBRACKET: + .dw $ff01 + .db "]",0 + .dw VE_HEAD + .set VE_HEAD = VE_RBRACKET +XT_RBRACKET: + .dw DO_COLON +PFA_RBRACKET: +.endif + .dw XT_ONE + .dw XT_STATE + .dw XT_STORE + .dw XT_EXIT diff --git a/amforth-6.5/common/words/s-to-d.asm b/amforth-6.5/common/words/s-to-d.asm new file mode 100644 index 0000000..374cc6a --- /dev/null +++ b/amforth-6.5/common/words/s-to-d.asm @@ -0,0 +1,20 @@ +; ( n1 -- d1 ) +; Conversion +; extend (signed) single cell value to double cell +.if cpu_msp430==1 + HEADER(XT_S2D,3,"s>d",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_S2D: + .dw $ff03 + .db "s>d",0 + .dw VE_HEAD + .set VE_HEAD = VE_S2D +XT_S2D: + .dw DO_COLON +PFA_S2D: +.endif + .dw XT_DUP + .dw XT_ZEROLESS + .dw XT_EXIT diff --git a/amforth-6.5/common/words/search-wordlist.asm b/amforth-6.5/common/words/search-wordlist.asm new file mode 100644 index 0000000..3d82de4 --- /dev/null +++ b/amforth-6.5/common/words/search-wordlist.asm @@ -0,0 +1,72 @@ +; ( c-addr len wid -- [ 0 ] | [ xt [-1|1]] ) +; Search Order +; searches the word list wid for the word at c-addr/len + +.if cpu_msp430==1 + HEADER(XT_SEARCH_WORDLIST,15,"search-wordlist",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_SEARCH_WORDLIST: + .dw $ff0f + .db "search-wordlist",0 + .dw VE_HEAD + .set VE_HEAD = VE_SEARCH_WORDLIST +XT_SEARCH_WORDLIST: + .dw DO_COLON +PFA_SEARCH_WORDLIST: +.endif + .dw XT_TO_R + .dw XT_ZERO + .dw XT_DOLITERAL + .dw XT_ISWORD + .dw XT_R_FROM + .dw XT_TRAVERSEWORDLIST + .dw XT_DUP + .dw XT_ZEROEQUAL + .dw XT_DOCONDBRANCH + DEST(PFA_SEARCH_WORDLIST1) + .dw XT_2DROP + .dw XT_DROP + .dw XT_ZERO + .dw XT_EXIT +PFA_SEARCH_WORDLIST1: + ; ... get the XT ... + .dw XT_DUP + .dw XT_NFA2CFA + ; .. and get the header flag + .dw XT_SWAP + .dw XT_NAME2FLAGS + .dw XT_IMMEDIATEQ + .dw XT_EXIT + +.if cpu_msp430==1 + HEADLESS(XT_ISWORD,DOCOLON) +.endif + +.if cpu_avr8==1 +XT_ISWORD: + .dw DO_COLON +PFA_ISWORD: +.endif + ; ( c-addr len 0 nt -- c-addr len 0 true| nt false ) + .dw XT_TO_R + .dw XT_DROP + .dw XT_2DUP + .dw XT_R_FETCH ; -- addr len addr len nt + .dw XT_NAME2STRING + .dw XT_ICOMPARE ; (-- addr len f ) + .dw XT_DOCONDBRANCH + DEST(PFA_ISWORD3) + ; not now + .dw XT_R_FROM + .dw XT_DROP + .dw XT_ZERO + .dw XT_TRUE ; maybe next word + .dw XT_EXIT +PFA_ISWORD3: + ; we found the word, now clean up iteration data ... + .dw XT_2DROP + .dw XT_R_FROM + .dw XT_ZERO ; finish traverse-wordlist + .dw XT_EXIT diff --git a/amforth-6.5/common/words/semicolon.asm b/amforth-6.5/common/words/semicolon.asm new file mode 100644 index 0000000..35c3a17 --- /dev/null +++ b/amforth-6.5/common/words/semicolon.asm @@ -0,0 +1,25 @@ +; ( -- ) +; Compiler +; finish colon defintion, compiles (exit) and returns to interpret state + +.if cpu_msp430==1 + IMMED(XT_SEMICOLON,1,";",DOCOLON) +.endif + +.if cpu_avr8==1 + + +VE_SEMICOLON: + .dw $0001 + .db $3b,0 + .dw VE_HEAD + .set VE_HEAD = VE_SEMICOLON +XT_SEMICOLON: + .dw DO_COLON +PFA_SEMICOLON: +.endif + .dw XT_COMPILE + .dw XT_EXIT + .dw XT_LBRACKET + .dw XT_REVEAL + .dw XT_EXIT diff --git a/amforth-6.5/common/words/set-base.asm b/amforth-6.5/common/words/set-base.asm new file mode 100644 index 0000000..8e9c10b --- /dev/null +++ b/amforth-6.5/common/words/set-base.asm @@ -0,0 +1,58 @@ +; ( addr len -- addr' len' ) +; Numeric IO +; skip a numeric prefix character + +.if cpu_msp430==1 + HEADLESS(XT_BASES,DOROM) +.endif + +.if cpu_avr8==1 +XT_BASES: + .dw PFA_DOCONSTANT +.endif + .dw 10,16,2,10 ; last one could a 8 instead. + +.if cpu_msp430==1 + HEADLESS(XT_SET_BASE,DOCOLON) +.endif + +.if cpu_avr8==1 +XT_SET_BASE: + .dw DO_COLON +PFA_SET_BASE: ; ( adr1 len1 -- adr2 len2 ) +.endif + .dw XT_OVER + .dw XT_CFETCH + .dw XT_DOLITERAL + .dw 35 + .dw XT_MINUS + .dw XT_DUP + .dw XT_ZERO + .dw XT_DOLITERAL + .dw 4 + .dw XT_WITHIN + .dw XT_DOCONDBRANCH + DEST(SET_BASE1) + .if cpu_msp430==1 + .dw XT_CELLS + .endif + .dw XT_BASES + .dw XT_PLUS + .dw XT_FETCHI + .dw XT_BASE + .dw XT_STORE + .dw XT_ONE + .dw XT_SLASHSTRING + .dw XT_DOBRANCH + DEST(SET_BASE2) +SET_BASE1: + .dw XT_DROP +SET_BASE2: + .dw XT_EXIT + +; create bases 10 , 16 , 2 , 8 , +; : set-base 35 - dup 0 4 within if +; bases + @i base ! 1 /string +; else +; drop +; then ; diff --git a/amforth-6.5/common/words/set-order.asm b/amforth-6.5/common/words/set-order.asm new file mode 100644 index 0000000..f9b0439 --- /dev/null +++ b/amforth-6.5/common/words/set-order.asm @@ -0,0 +1,23 @@ +; ( widn .. wid-1 n -- ) +; Search Order +; replace the search order list + +.if cpu_msp430==1 + HEADER(XT_SET_ORDER,9,"set-order",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_SET_ORDER: + .dw $ff09 + .db "set-order",0 + .dw VE_HEAD + .set VE_HEAD = VE_SET_ORDER +XT_SET_ORDER: + .dw DO_COLON +PFA_SET_ORDER: +.endif + .dw XT_DOLITERAL + .dw CFG_ORDERLISTLEN + .dw XT_SET_STACK + .dw XT_EXIT + diff --git a/amforth-6.5/common/words/set-recognizer.asm b/amforth-6.5/common/words/set-recognizer.asm new file mode 100644 index 0000000..7d9dc1c --- /dev/null +++ b/amforth-6.5/common/words/set-recognizer.asm @@ -0,0 +1,23 @@ +; ( rec-n .. rec-1 n -- ) +; Interpreter +; replace the recognizer list + +.if cpu_msp430==1 + HEADER(XT_SET_RECOGNIZERS,15,"set-recognizers",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_SET_RECOGNIZERS: + .dw $ff0f + .db "set-recognizers",0 + .dw VE_HEAD + .set VE_HEAD = VE_SET_RECOGNIZERS +XT_SET_RECOGNIZERS: + .dw DO_COLON +PFA_SET_RECOGNIZERS: +.endif + .dw XT_DOLITERAL + .dw CFG_RECOGNIZERLISTLEN + .dw XT_SET_STACK + .dw XT_EXIT + diff --git a/amforth-6.5/common/words/set-stack.asm b/amforth-6.5/common/words/set-stack.asm new file mode 100644 index 0000000..9c95a0b --- /dev/null +++ b/amforth-6.5/common/words/set-stack.asm @@ -0,0 +1,43 @@ +; ( rec-n .. rec-1 n ee-addr -- ) +; Tools +; Write a stack to EEPROM +.if cpu_msp430==1 + HEADER(XT_SET_STACK,9,"set-stack",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_SET_STACK: + .dw $ff09 + .db "set-stack",0 + .dw VE_HEAD + .set VE_HEAD = VE_SET_STACK +XT_SET_STACK: + .dw DO_COLON +PFA_SET_STACK: +.endif + .dw XT_OVER + .dw XT_ZEROLESS + .dw XT_DOCONDBRANCH + DEST(PFA_SET_STACK0) + .dw XT_DOLITERAL + .dw -4 + .dw XT_THROW +PFA_SET_STACK0: + .dw XT_2DUP + .dw XT_STOREE ; ( -- i_n .. i_0 n e-addr ) + .dw XT_SWAP + .dw XT_ZERO + .dw XT_QDOCHECK + .dw XT_DOCONDBRANCH + DEST(PFA_SET_STACK2) + .dw XT_DODO +PFA_SET_STACK1: + .dw XT_CELLPLUS ; ( -- i_x e-addr ) + .dw XT_TUCK ; ( -- e-addr i_x e-addr + .dw XT_STOREE + .dw XT_DOLOOP + DEST(PFA_SET_STACK1) +PFA_SET_STACK2: + .dw XT_DROP + .dw XT_EXIT + diff --git a/amforth-6.5/common/words/sharp-greater.asm b/amforth-6.5/common/words/sharp-greater.asm new file mode 100644 index 0000000..914aba2 --- /dev/null +++ b/amforth-6.5/common/words/sharp-greater.asm @@ -0,0 +1,25 @@ +; ( d1 -- addr count ) +; Numeric IO +; Pictured Numeric Output: convert PNO buffer into an string + +.if cpu_msp430==1 + HEADER(XT_SHARP_G,2,"#>",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_SHARP_G: + .dw $ff02 + .db "#>" + .dw VE_HEAD + .set VE_HEAD = VE_SHARP_G +XT_SHARP_G: + .dw DO_COLON +PFA_SHARP_G: +.endif + .dw XT_2DROP + .dw XT_HLD + .dw XT_FETCH + .dw XT_PAD + .dw XT_OVER + .dw XT_MINUS + .dw XT_EXIT diff --git a/amforth-6.5/common/words/sharp-s.asm b/amforth-6.5/common/words/sharp-s.asm new file mode 100644 index 0000000..58fd508 --- /dev/null +++ b/amforth-6.5/common/words/sharp-s.asm @@ -0,0 +1,26 @@ +; ( d -- 0 ) +; Numeric IO +; pictured numeric output: convert all digits until 0 (zero) is reached + +.if cpu_msp430==1 + HEADER(XT_SHARP_S,2,"#s",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_SHARP_S: + .dw $ff02 + .db "#s" + .dw VE_HEAD + .set VE_HEAD = VE_SHARP_S +XT_SHARP_S: + .dw DO_COLON +PFA_SHARP_S: +.endif +NUMS1: + .dw XT_SHARP + .dw XT_2DUP + .dw XT_OR + .dw XT_ZEROEQUAL + .dw XT_DOCONDBRANCH + DEST(NUMS1) ; PFA_SHARP_S + .dw XT_EXIT diff --git a/amforth-6.5/common/words/sharp.asm b/amforth-6.5/common/words/sharp.asm new file mode 100644 index 0000000..7659a39 --- /dev/null +++ b/amforth-6.5/common/words/sharp.asm @@ -0,0 +1,41 @@ +; ( d1 -- d2 ) +; Numeric IO +; pictured numeric output: convert one digit + +.if cpu_msp430==1 + HEADER(XT_SHARP,1,"#",DOCOLON) +.endif + +.if cpu_avr8==1 + + +VE_SHARP: + .dw $ff01 + .db "#",0 + .dw VE_HEAD + .set VE_HEAD = VE_SHARP +XT_SHARP: + .dw DO_COLON +PFA_SHARP: +.endif + .dw XT_BASE + .dw XT_FETCH + .dw XT_UDSLASHMOD + .dw XT_ROT + .dw XT_DOLITERAL + .dw 9 + .dw XT_OVER + .dw XT_LESS + .dw XT_DOCONDBRANCH + DEST(PFA_SHARP1) + .dw XT_DOLITERAL + .dw 7 + .dw XT_PLUS +PFA_SHARP1: + .dw XT_DOLITERAL + .dw 48 ; ASCII 0 + .dw XT_PLUS + .dw XT_HOLD + .dw XT_EXIT +; : # ( ud1 -- ud2 ) +; base @ ud/mod rot 9 over < if 7 + then 30 + hold ; diff --git a/amforth-6.5/common/words/show-wordlist.asm b/amforth-6.5/common/words/show-wordlist.asm new file mode 100644 index 0000000..d150639 --- /dev/null +++ b/amforth-6.5/common/words/show-wordlist.asm @@ -0,0 +1,38 @@ +; ( wid -- ) +; Tools +; prints the name of the words in a wordlist + +.if cpu_msp430==1 + HEADER(XT_SHOWWORDLIST,13,"show-wordlist",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_SHOWWORDLIST: + .dw $ff0d + .db "show-wordlist",0 + .dw VE_HEAD + .set VE_HEAD = VE_SHOWWORDLIST +XT_SHOWWORDLIST: + .dw DO_COLON +PFA_SHOWWORDLIST: +.endif + .dw XT_DOLITERAL + .dw XT_SHOWWORD + .dw XT_SWAP + .dw XT_TRAVERSEWORDLIST + .dw XT_EXIT + +.if cpu_msp430==1 + HEADLESS(XT_SHOWWORD,DOCOLON) +.endif + +.if cpu_avr8==1 +XT_SHOWWORD: + .dw DO_COLON +PFA_SHOWWORD: +.endif + .dw XT_NAME2STRING + .dw XT_ITYPE + .dw XT_SPACE ; ( -- addr n) + .dw XT_TRUE + .dw XT_EXIT diff --git a/amforth-6.5/common/words/sign.asm b/amforth-6.5/common/words/sign.asm new file mode 100644 index 0000000..f532bbe --- /dev/null +++ b/amforth-6.5/common/words/sign.asm @@ -0,0 +1,26 @@ +; ( n -- ) +; Numeric IO +; place a - in HLD if n is negative + +.if cpu_msp430==1 + HEADER(XT_SIGN,4,"sign",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_SIGN: + .dw $ff04 + .db "sign" + .dw VE_HEAD + .set VE_HEAD = VE_SIGN +XT_SIGN: + .dw DO_COLON +PFA_SIGN: +.endif + .dw XT_ZEROLESS + .dw XT_DOCONDBRANCH + DEST(PFA_SIGN1) + .dw XT_DOLITERAL + .dw 45 ; ascii - + .dw XT_HOLD +PFA_SIGN1: + .dw XT_EXIT diff --git a/amforth-6.5/common/words/slash-string.asm b/amforth-6.5/common/words/slash-string.asm new file mode 100644 index 0000000..bded983 --- /dev/null +++ b/amforth-6.5/common/words/slash-string.asm @@ -0,0 +1,26 @@ +; ( addr1 u1 n -- addr2 u2 ) +; String +; adjust string from addr1 to addr1+n, reduce length from u1 to u2 by n + +.if cpu_msp430==1 + HEADER(XT_SLASHSTRING,7,"/string",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_SLASHSTRING: + .dw $ff07 + .db "/string",0 + .dw VE_HEAD + .set VE_HEAD = VE_SLASHSTRING +XT_SLASHSTRING: + .dw DO_COLON +PFA_SLASHSTRING: +.endif + .dw XT_ROT + .dw XT_OVER + .dw XT_PLUS + .dw XT_ROT + .dw XT_ROT + .dw XT_MINUS + .dw XT_EXIT + diff --git a/amforth-6.5/common/words/slash.asm b/amforth-6.5/common/words/slash.asm new file mode 100644 index 0000000..3f0e3af --- /dev/null +++ b/amforth-6.5/common/words/slash.asm @@ -0,0 +1,24 @@ +; ( n1 n2 -- n3) +; Arithmetics +; divide n1 by n2. giving the quotient + +.if cpu_msp430==1 + HEADER(SLASH,1,"/",DOCOLON) +.endif + +.if cpu_avr8==1 + + +VE_SLASH: + .dw $ff01 + .db "/",0 + .dw VE_HEAD + .set VE_HEAD = VE_SLASH +XT_SLASH: + .dw DO_COLON +PFA_SLASH: +.endif + .dw XT_SLASHMOD + .dw XT_NIP + .dw XT_EXIT + diff --git a/amforth-6.5/common/words/sliteral.asm b/amforth-6.5/common/words/sliteral.asm new file mode 100644 index 0000000..9233796 --- /dev/null +++ b/amforth-6.5/common/words/sliteral.asm @@ -0,0 +1,22 @@ +; (C: addr len -- ) +; String +; compiles a string to flash, at runtime leaves ( -- flash-addr count) on stack + +.if cpu_msp430==1 + IMMED(XT_SLITERAL,8,"sliteral",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_SLITERAL: + .dw $0008 + .db "sliteral" + .dw VE_HEAD + .set VE_HEAD = VE_SLITERAL +XT_SLITERAL: + .dw DO_COLON +PFA_SLITERAL: +.endif + .dw XT_COMPILE + .dw XT_DOSLITERAL ; ( -- addr n) + .dw XT_SCOMMA + .dw XT_EXIT diff --git a/amforth-6.5/common/words/source.asm b/amforth-6.5/common/words/source.asm new file mode 100644 index 0000000..a1ac867 --- /dev/null +++ b/amforth-6.5/common/words/source.asm @@ -0,0 +1,23 @@ +; ( -- addr n ) +; System +; address and current length of the input buffer + +.if cpu_msp430==1 + DEFER(XT_SOURCE,6,"source") +.endif + +.if cpu_avr8==1 +VE_SOURCE: + .dw $FF06 + .db "source" + .dw VE_HEAD + .set VE_HEAD = VE_SOURCE +XT_SOURCE: + .dw PFA_DODEFER1 +PFA_SOURCE: +.endif + .dw USER_SOURCE + .dw XT_UDEFERFETCH + .dw XT_UDEFERSTORE + + diff --git a/amforth-6.5/common/words/space.asm b/amforth-6.5/common/words/space.asm new file mode 100644 index 0000000..bf4175d --- /dev/null +++ b/amforth-6.5/common/words/space.asm @@ -0,0 +1,21 @@ +; ( -- ) +; Character IO +; emits a space (bl) + +.if cpu_msp430==1 + HEADER(XT_SPACE,5,"space",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_SPACE: + .dw $ff05 + .db "space",0 + .dw VE_HEAD + .set VE_HEAD = VE_SPACE +XT_SPACE: + .dw DO_COLON +PFA_SPACE: +.endif + .dw XT_BL + .dw XT_EMIT + .dw XT_EXIT diff --git a/amforth-6.5/common/words/spaces.asm b/amforth-6.5/common/words/spaces.asm new file mode 100644 index 0000000..7ecbcd8 --- /dev/null +++ b/amforth-6.5/common/words/spaces.asm @@ -0,0 +1,27 @@ +; ( n -- ) +; Character IO +; emits n space(s) (bl) + +.if cpu_msp430==1 + HEADER(XT_SPACES,6,"spaces",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_SPACES: + .dw $ff06 + .db "spaces" + .dw VE_HEAD + .set VE_HEAD = VE_SPACES +XT_SPACES: + .dw DO_COLON +PFA_SPACES: + +.endif +;C SPACES n -- output n spaces +; BEGIN DUP 0> WHILE SPACE 1- REPEAT DROP ; + .DW XT_ZERO, XT_MAX +SPCS1: .DW XT_DUP,XT_DOCONDBRANCH + DEST(SPCS2) + .DW XT_SPACE,XT_1MINUS,XT_DOBRANCH + DEST(SPCS1) +SPCS2: .DW XT_DROP,XT_EXIT diff --git a/amforth-6.5/common/words/squote.asm b/amforth-6.5/common/words/squote.asm new file mode 100644 index 0000000..98cfa33 --- /dev/null +++ b/amforth-6.5/common/words/squote.asm @@ -0,0 +1,33 @@ +; ( -- addr len) (C: -- ) +; Compiler +; compiles a string to flash, at runtime leaves ( -- flash-addr count) on stack + +.if cpu_msp430==1 + DW link + DB 0FEh ; immediate +.set link = $ + DB 2,"s",'"' + .align 16 +XT_SQUOTE: DW DOCOLON +.endif + +.if cpu_avr8==1 +VE_SQUOTE: + .dw $0002 + .db "s",$22 + .dw VE_HEAD + .set VE_HEAD = VE_SQUOTE +XT_SQUOTE: + .dw DO_COLON +PFA_SQUOTE: +.endif + .dw XT_DOLITERAL + .dw 34 ; 0x22 + .dw XT_PARSE ; ( -- addr n) + .dw XT_STATE + .dw XT_FETCH + .dw XT_DOCONDBRANCH + DEST(PFA_SQUOTE1) + .dw XT_SLITERAL +PFA_SQUOTE1: + .dw XT_EXIT diff --git a/amforth-6.5/common/words/star.asm b/amforth-6.5/common/words/star.asm new file mode 100644 index 0000000..a09e00c --- /dev/null +++ b/amforth-6.5/common/words/star.asm @@ -0,0 +1,22 @@ +; ( n1 n2 -- n3 ) +; Arithmetics +; multiply routine + +.if cpu_msp430==1 + HEADER(STAR,1,"*",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_STAR: + .dw $ff01 + .db "*",0 + .dw VE_HEAD + .set VE_HEAD = VE_STAR +XT_STAR: + .dw DO_COLON +PFA_STAR: +.endif + + .dw XT_MSTAR + .dw XT_DROP + .dw XT_EXIT diff --git a/amforth-6.5/common/words/then.asm b/amforth-6.5/common/words/then.asm new file mode 100644 index 0000000..edd0665 --- /dev/null +++ b/amforth-6.5/common/words/then.asm @@ -0,0 +1,20 @@ +; ( -- ) (C: orig -- ) +; Compiler +; finish if + +.if cpu_msp430==1 + IMMED(XT_THEN,4,"then",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_THEN: + .dw $0004 + .db "then" + .dw VE_HEAD + .set VE_HEAD = VE_THEN +XT_THEN: + .dw DO_COLON +PFA_THEN: +.endif + .dw XT_GRESOLVE + .dw XT_EXIT diff --git a/amforth-6.5/common/words/throw.asm b/amforth-6.5/common/words/throw.asm new file mode 100644 index 0000000..24877a3 --- /dev/null +++ b/amforth-6.5/common/words/throw.asm @@ -0,0 +1,39 @@ +; ( n -- ) +; Exceptions +; throw an exception + +.if cpu_msp430==1 + HEADER(XT_THROW,5,"throw",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_THROW: + .dw $ff05 + .db "throw",0 + .dw VE_HEAD + .set VE_HEAD = VE_THROW +XT_THROW: + .dw DO_COLON +PFA_THROW: +.endif + .dw XT_DUP + .dw XT_ZEROEQUAL + .dw XT_DOCONDBRANCH + DEST(PFA_THROW1) + .dw XT_DROP + .dw XT_EXIT +PFA_THROW1: + .dw XT_HANDLER + .dw XT_FETCH + .dw XT_RP_STORE + .dw XT_R_FROM + .dw XT_HANDLER + .dw XT_STORE + .dw XT_R_FROM + .dw XT_SWAP + .dw XT_TO_R + .dw XT_SP_STORE + .dw XT_DROP + .dw XT_R_FROM + .dw XT_EXIT + diff --git a/amforth-6.5/common/words/tib.asm b/amforth-6.5/common/words/tib.asm new file mode 100644 index 0000000..ca5601f --- /dev/null +++ b/amforth-6.5/common/words/tib.asm @@ -0,0 +1,96 @@ +; ( -- f ) +; System +; refills the input buffer +.if cpu_msp430==1 + HEADER(XT_REFILLTIB,10,"refill-tib",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_REFILLTIB: + .dw $ff0a + .db "refill-tib" + .dw VE_HEAD + .set VE_HEAD = VE_REFILLTIB +XT_REFILLTIB: + .dw DO_COLON +PFA_REFILLTIB: +.endif + .dw XT_TIB + .dw XT_DOLITERAL + .dw TIB_SIZE + .dw XT_ACCEPT + .dw XT_NUMBERTIB + .dw XT_STORE + .dw XT_ZERO + .dw XT_TO_IN + .dw XT_STORE + .dw XT_TRUE ; -1 + .dw XT_EXIT + +; ( -- addr n ) +; System +; address and current length of the input buffer +.if cpu_msp430==1 + HEADER(XT_SOURCETIB,10,"source-tib",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_SOURCETIB: + .dw $FF0A + .db "source-tib" + .dw VE_HEAD + .set VE_HEAD = VE_SOURCETIB +XT_SOURCETIB: + .dw DO_COLON +PFA_SOURCETIB: +.endif + .dw XT_TIB + .dw XT_NUMBERTIB + .dw XT_FETCH + .dw XT_EXIT + +; ( -- addr ) +; System Variable +; terminal input buffer address +.if cpu_msp430==1 + VARIABLE(XT_TIB,3,"tib") + .DW TIBAREA +.endif + +.if cpu_avr8==1 +VE_TIB: + .dw $ff03 + .db "tib",0 + .dw VE_HEAD + .set VE_HEAD = VE_TIB +XT_TIB: + .dw PFA_DOVARIABLE +PFA_TIB: + .dw ram_tib +.dseg +ram_tib: .byte TIB_SIZE +.cseg +.endif + +; ( -- addr ) +; System Variable +; variable holding the number of characters in TIB +.if cpu_msp430==1 + VARIABLE(XT_NUMBERTIB,4,"#tib") + .DW RAM_NUMBERTIB +.endif + +.if cpu_avr8==1 +VE_NUMBERTIB: + .dw $ff04 + .db "#tib" + .dw VE_HEAD + .set VE_HEAD = VE_NUMBERTIB +XT_NUMBERTIB: + .dw PFA_DOVARIABLE +PFA_NUMBERTIB: + .dw ram_sharptib +.dseg +ram_sharptib: .byte 2 +.cseg +.endif diff --git a/amforth-6.5/common/words/tick.asm b/amforth-6.5/common/words/tick.asm new file mode 100644 index 0000000..3d04411 --- /dev/null +++ b/amforth-6.5/common/words/tick.asm @@ -0,0 +1,41 @@ +; ( "name" -- XT ) +; Dictionary +; search dictionary for name, return XT or throw an exception -13 + +.if cpu_msp430==1 + HEADER(XT_TICK,1,27h,DOCOLON) +.endif + +.if cpu_avr8==1 +VE_TICK: + .dw $ff01 + .db "'",0 + .dw VE_HEAD + .set VE_HEAD = VE_TICK +XT_TICK: + .dw DO_COLON +PFA_TICK: +.endif + .dw XT_PARSENAME + .dw XT_FORTHRECOGNIZER + .dw XT_RECOGNIZE + ; a word is tickable unless DT:TOKEN is DT:NULL or + ; the interpret action is a NOOP + .dw XT_DUP + .dw XT_DT_NULL + .dw XT_EQUAL + .dw XT_SWAP + .dw XT_FETCHI + .dw XT_DOLITERAL + .dw XT_NOOP + .dw XT_EQUAL + .dw XT_OR + .dw XT_DOCONDBRANCH + DEST(PFA_TICK1) + .dw XT_DOLITERAL + .dw -13 + .dw XT_THROW +PFA_TICK1: + .dw XT_DROP + .dw XT_EXIT + diff --git a/amforth-6.5/common/words/to-in.asm b/amforth-6.5/common/words/to-in.asm new file mode 100644 index 0000000..29ca20c --- /dev/null +++ b/amforth-6.5/common/words/to-in.asm @@ -0,0 +1,19 @@ +; ( -- a-addr ) +; System Variable +; pointer to current read position in input buffer + +.if cpu_msp430==1 + HEADER(XT_TO_IN,3,">in",DOUSER) +.endif + +.if cpu_avr8==1 +VE_TO_IN: + .dw $ff03 + .db ">in",0 + .dw VE_HEAD + .set VE_HEAD = VE_TO_IN +XT_TO_IN: + .dw PFA_DOUSER +PFA_TO_IN: +.endif + .dw USER_TO_IN diff --git a/amforth-6.5/common/words/to-l.asm b/amforth-6.5/common/words/to-l.asm new file mode 100644 index 0000000..0312da9 --- /dev/null +++ b/amforth-6.5/common/words/to-l.asm @@ -0,0 +1,25 @@ + +.if cpu_msp430==1 + HEADER(XT_TO_L,2,">l",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_TO_L: + .dw $ff02 + .db ">l" + .dw VE_HEAD + .set VE_HEAD = VE_TO_L +XT_TO_L: + .dw DO_COLON +PFA_TO_L: +.endif +;Z >L x -- L: -- x move to leave stack +; CELL LP +! LP @ ! ; (L stack grows up) + + .dw XT_TWO + .dw XT_LP + .dw XT_PLUSSTORE + .dw XT_LP + .dw XT_FETCH + .dw XT_STORE + .dw XT_EXIT diff --git a/amforth-6.5/common/words/to-lower.asm b/amforth-6.5/common/words/to-lower.asm new file mode 100644 index 0000000..fe9328c --- /dev/null +++ b/amforth-6.5/common/words/to-lower.asm @@ -0,0 +1,33 @@ +; ( C -- c) +; String +; if C is an uppercase letter convert it to lowercase + +.if cpu_msp430==1 + HEADER(XT_TOLOWER,7,"tolower",DOCOLON) +.endif + +.if cpu_avr8==1 + + +VE_TOLOWER: + .dw $ff07 + .db "tolower",0 + .dw VE_HEAD + .set VE_HEAD = VE_TOLOWER +XT_TOLOWER: + .dw DO_COLON +PFA_TOLOWER: +.endif + .dw XT_DUP + .dw XT_DOLITERAL + .dw 'A' + .dw XT_DOLITERAL + .dw 'Z'+1 + .dw XT_WITHIN + .dw XT_DOCONDBRANCH + DEST(PFA_TOLOWER0) + .dw XT_DOLITERAL + .dw 32 + .dw XT_OR +PFA_TOLOWER0: + .dw XT_EXIT diff --git a/amforth-6.5/common/words/to-number.asm b/amforth-6.5/common/words/to-number.asm new file mode 100644 index 0000000..18ab6f4 --- /dev/null +++ b/amforth-6.5/common/words/to-number.asm @@ -0,0 +1,41 @@ +; ( ud1 c-addr1 u1 -- ud2 c-addr2 u2 ) +; Numeric IO +; convert a string to a number c-addr2/u2 is the unconverted string + +.if cpu_msp430==1 + HEADER(XT_TO_NUMBER,7,">number",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_TO_NUMBER: + .dw $ff07 + .db ">number",0 + .dw VE_HEAD + .set VE_HEAD = VE_TO_NUMBER +XT_TO_NUMBER: + .dw DO_COLON + +.endif + +TONUM1: .DW XT_DUP,XT_DOCONDBRANCH + DEST(TONUM3) + .DW XT_OVER,XT_CFETCH,XT_DIGITQ + .DW XT_ZEROEQUAL,XT_DOCONDBRANCH + DEST(TONUM2) + .DW XT_DROP,XT_EXIT +TONUM2: .DW XT_TO_R,XT_2SWAP,XT_BASE,XT_FETCH,XT_UDSTAR + .DW XT_R_FROM,XT_MPLUS,XT_2SWAP + .DW XT_ONE,XT_SLASHSTRING,XT_DOBRANCH + DEST(TONUM1) +TONUM3: .DW XT_EXIT + +;C >NUMBER ud adr u -- ud' adr' u' +;C convert string to number +; BEGIN +; DUP WHILE +; OVER C@ DIGIT? +; 0= IF DROP EXIT THEN +; >R 2SWAP BASE @ UD* +; R> M+ 2SWAP +; 1 /STRING +; REPEAT ; diff --git a/amforth-6.5/common/words/to-upper.asm b/amforth-6.5/common/words/to-upper.asm new file mode 100644 index 0000000..180cd5d --- /dev/null +++ b/amforth-6.5/common/words/to-upper.asm @@ -0,0 +1,31 @@ +; ( c -- C ) +; String +; if c is a lowercase letter convert it to uppercase + +.if cpu_msp430==1 + HEADER(XT_TOUPPER,7,"toupper",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_TOUPPER: + .dw $ff07 + .db "toupper",0 + .dw VE_HEAD + .set VE_HEAD = VE_TOUPPER +XT_TOUPPER: + .dw DO_COLON +PFA_TOUPPER: +.endif + .dw XT_DUP + .dw XT_DOLITERAL + .dw 'a' + .dw XT_DOLITERAL + .dw 'z'+1 + .dw XT_WITHIN + .dw XT_DOCONDBRANCH + DEST(PFA_TOUPPER0) + .dw XT_DOLITERAL + .dw 223 ; inverse of 0x20: 0xdf + .dw XT_AND +PFA_TOUPPER0: + .dw XT_EXIT diff --git a/amforth-6.5/common/words/to.asm b/amforth-6.5/common/words/to.asm new file mode 100644 index 0000000..0bb1aec --- /dev/null +++ b/amforth-6.5/common/words/to.asm @@ -0,0 +1,59 @@ +; ( n -- ) +; Tools +; store the TOS to the named value (eeprom cell) + +.if cpu_msp430==1 + IMMED(XT_TO,2,"to",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_TO: + .dw $0002 + .db "to" + .dw VE_HEAD + .set VE_HEAD = VE_TO +XT_TO: + .dw DO_COLON +PFA_TO: +.endif + .dw XT_TICK + .dw XT_TO_BODY + .dw XT_STATE + .dw XT_FETCH + .dw XT_DOCONDBRANCH + DEST(PFA_TO1) + .dw XT_COMPILE + .dw XT_DOTO + .dw XT_COMMA + .dw XT_EXIT + +; ( n -- ) (R: IP -- IP+1) +; Tools +; runtime portion of to +;VE_DOTO: +; .dw $ff04 +; .db "(to)" +; .dw VE_HEAD +; .set VE_HEAD = VE_DOTO +.if cpu_msp430==1 + HEADLESS(XT_DOTO,DOCOLON) +.endif + +.if cpu_avr8==1 + +XT_DOTO: + .dw DO_COLON +PFA_DOTO: +.endif + .dw XT_R_FROM + .dw XT_DUP + .dw XT_ICELLPLUS + .dw XT_TO_R + .dw XT_FETCHI +PFA_TO1: + .dw XT_DUP + .dw XT_ICELLPLUS + .dw XT_ICELLPLUS + .dw XT_FETCHI + .dw XT_EXECUTE + .dw XT_EXIT diff --git a/amforth-6.5/common/words/traverse-wordlist.asm b/amforth-6.5/common/words/traverse-wordlist.asm new file mode 100644 index 0000000..b6c00e0 --- /dev/null +++ b/amforth-6.5/common/words/traverse-wordlist.asm @@ -0,0 +1,49 @@ +; ( i*x xt wid -- j*x ) +; Tools Ext (2012) +; call the xt for every member of the wordlist wid until xt returns false + +.if cpu_msp430==1 + HEADER(XT_TRAVERSEWORDLIST,17,"traverse-wordlist",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_TRAVERSEWORDLIST: + .dw $ff11 + .db "traverse-wordlist",0 + .dw VE_HEAD + .set VE_HEAD = VE_TRAVERSEWORDLIST +XT_TRAVERSEWORDLIST: + .dw DO_COLON +PFA_TRAVERSEWORDLIST: + +.endif + .dw XT_FETCHE +PFA_TRAVERSEWORDLIST1: + .dw XT_DUP ; ( -- xt nt nt ) + .dw XT_DOCONDBRANCH ; ( -- nt ) is nfa = counted string + DEST(PFA_TRAVERSEWORDLIST2) + .dw XT_2DUP + .dw XT_2TO_R + .dw XT_SWAP + .dw XT_EXECUTE + .dw XT_2R_FROM + .dw XT_ROT + .dw XT_DOCONDBRANCH + DEST(PFA_TRAVERSEWORDLIST2) + .dw XT_NFA2LFA + .dw XT_FETCHI + .dw XT_DOBRANCH ; ( -- addr ) + DEST(PFA_TRAVERSEWORDLIST1) ; ( -- addr ) +PFA_TRAVERSEWORDLIST2: + .dw XT_2DROP + .dw XT_EXIT + +; : traverse-wordlist ( i*x xt wid -- i*x' ) +; begin @ dup +; while +; 2dup 2>r +; swap execute ( i*x nt -- i*x' f ) +; 2r> rot +; while +; nfa>lfa @i +; repeat then 2drop ; diff --git a/amforth-6.5/common/words/tuck.asm b/amforth-6.5/common/words/tuck.asm new file mode 100644 index 0000000..173dc8c --- /dev/null +++ b/amforth-6.5/common/words/tuck.asm @@ -0,0 +1,21 @@ +; ( n1 n2 -- n2 n1 n2 ) +; Stack +; Copy the first (top) stack item below the second stack item. + +.if cpu_msp430==1 + HEADER(XT_TUCK,4,"tuck",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_TUCK: + .dw $ff04 + .db "tuck" + .dw VE_HEAD + .set VE_HEAD = VE_TUCK +XT_TUCK: + .dw DO_COLON +PFA_TUCK: +.endif + .dw XT_SWAP + .dw XT_OVER + .dw XT_EXIT diff --git a/amforth-6.5/common/words/type.asm b/amforth-6.5/common/words/type.asm new file mode 100644 index 0000000..66929b0 --- /dev/null +++ b/amforth-6.5/common/words/type.asm @@ -0,0 +1,32 @@ +; ( addr n -- ) +; Character IO +; print a RAM based string + +.if cpu_msp430==1 + HEADER(XT_TYPE,4,"type",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_TYPE: + .dw $ff04 + .db "type" + .dw VE_HEAD + .set VE_HEAD = VE_TYPE +XT_TYPE: + .dw DO_COLON +PFA_TYPE: + +.endif + .dw XT_BOUNDS + .dw XT_QDOCHECK + .dw XT_DOCONDBRANCH + DEST(PFA_TYPE2) + .dw XT_DODO +PFA_TYPE1: + .dw XT_I + .dw XT_CFETCH + .dw XT_EMIT + .dw XT_DOLOOP + DEST(PFA_TYPE1) +PFA_TYPE2: + .dw XT_EXIT diff --git a/amforth-6.5/common/words/u-dot-r.asm b/amforth-6.5/common/words/u-dot-r.asm new file mode 100644 index 0000000..18cb089 --- /dev/null +++ b/amforth-6.5/common/words/u-dot-r.asm @@ -0,0 +1,25 @@ +; ( u w -- ) +; Numeric IO +; unsigned PNO with single cells numbers, right aligned in width w + +.if cpu_msp430==1 + HEADER(XT_UDOTR,3,"u.r",DOCOLON) +.endif + +.if cpu_avr8==1 + + +VE_UDOTR: + .dw $ff03 + .db "u.r",0 + .dw VE_HEAD + .set VE_HEAD = VE_UDOTR +XT_UDOTR: + .dw DO_COLON +PFA_UDOTR: +.endif + .dw XT_ZERO + .dw XT_SWAP + .dw XT_UDDOTR + .dw XT_EXIT +; : u.r ( s n -- ) 0 swap ud.r ; diff --git a/amforth-6.5/common/words/u-dot.asm b/amforth-6.5/common/words/u-dot.asm new file mode 100644 index 0000000..100a53d --- /dev/null +++ b/amforth-6.5/common/words/u-dot.asm @@ -0,0 +1,22 @@ +; ( u -- ) +; Numeric IO +; unsigned PNO with single cell numbers + +.if cpu_msp430==1 + HEADER(XT_UDOT,2,"u.",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_UDOT: + .dw $ff02 + .db "u." + .dw VE_HEAD + .set VE_HEAD = VE_UDOT +XT_UDOT: + .dw DO_COLON +PFA_UDOT: +.endif + .dw XT_ZERO + .dw XT_UDDOT + .dw XT_EXIT +; : u. ( us -- ) 0 ud. ; diff --git a/amforth-6.5/common/words/u-greater.asm b/amforth-6.5/common/words/u-greater.asm new file mode 100644 index 0000000..4de1b85 --- /dev/null +++ b/amforth-6.5/common/words/u-greater.asm @@ -0,0 +1,21 @@ +; ( u1 u2 -- flag ) +; Compare +; true if u1 > u2 (unsigned) + +.if cpu_msp430==1 + HEADER(XT_UGREATER,2,"u>",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_UGREATER: + .dw $ff02 + .db "u>" + .dw VE_HEAD + .set VE_HEAD = VE_UGREATER +XT_UGREATER: + .dw DO_COLON +PFA_UGREATER: +.endif + .DW XT_SWAP + .dw XT_ULESS + .dw XT_EXIT diff --git a/amforth-6.5/common/words/ud-dot-r.asm b/amforth-6.5/common/words/ud-dot-r.asm new file mode 100644 index 0000000..7db9c2e --- /dev/null +++ b/amforth-6.5/common/words/ud-dot-r.asm @@ -0,0 +1,31 @@ +; ( ud w -- ) +; Numeric IO +; unsigned PNO with double cell numbers, right aligned in width w + +.if cpu_msp430==1 + HEADER(XT_UDDOTR,4,"ud.r",DOCOLON) +.endif + +.if cpu_avr8==1 + + +VE_UDDOTR: + .dw $ff04 + .db "ud.r" + .dw VE_HEAD + .set VE_HEAD = VE_UDDOTR +XT_UDDOTR: + .dw DO_COLON +PFA_UDDOTR: +.endif + .dw XT_TO_R + .dw XT_L_SHARP + .dw XT_SHARP_S + .dw XT_SHARP_G + .dw XT_R_FROM + .dw XT_OVER + .dw XT_MINUS + .dw XT_SPACES + .dw XT_TYPE + .dw XT_EXIT +; : ud.r ( ud n -- ) >r <# #s #> r> over - spaces type ; \ No newline at end of file diff --git a/amforth-6.5/common/words/ud-dot.asm b/amforth-6.5/common/words/ud-dot.asm new file mode 100644 index 0000000..c45ed5e --- /dev/null +++ b/amforth-6.5/common/words/ud-dot.asm @@ -0,0 +1,23 @@ +; ( ud -- ) +; Numeric IO +; unsigned PNO with double cell numbers + +.if cpu_msp430==1 + HEADER(XT_UDDOT,3,"ud.",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_UDDOT: + .dw $ff03 + .db "ud.",0 + .dw VE_HEAD + .set VE_HEAD = VE_UDDOT +XT_UDDOT: + .dw DO_COLON +PFA_UDDOT: +.endif + .dw XT_ZERO + .dw XT_UDDOTR + .dw XT_SPACE + .dw XT_EXIT +; : ud. ( ud -- ) 0 ud.r space ; \ No newline at end of file diff --git a/amforth-6.5/common/words/ud-slash-mod.asm b/amforth-6.5/common/words/ud-slash-mod.asm new file mode 100644 index 0000000..ad50afa --- /dev/null +++ b/amforth-6.5/common/words/ud-slash-mod.asm @@ -0,0 +1,28 @@ +; ( d1 n -- rem ud2 ) +; Arithmetics +; unsigned double cell division with remainder + +.if cpu_msp430==1 + HEADER(XT_UDSLASHMOD,6,"ud/mod",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_UDSLASHMOD: + .dw $ff06 + .db "ud/mod" + .dw VE_HEAD + .set VE_HEAD = VE_UDSLASHMOD +XT_UDSLASHMOD: + .dw DO_COLON +PFA_UDSLASHMOD: +.endif + .dw XT_TO_R + .dw XT_ZERO + .dw XT_R_FETCH + .dw XT_UMSLASHMOD + .dw XT_R_FROM + .dw XT_SWAP + .dw XT_TO_R + .dw XT_UMSLASHMOD + .dw XT_R_FROM + .dw XT_EXIT diff --git a/amforth-6.5/common/words/ud-star.asm b/amforth-6.5/common/words/ud-star.asm new file mode 100644 index 0000000..64642da --- /dev/null +++ b/amforth-6.5/common/words/ud-star.asm @@ -0,0 +1,21 @@ + +.if cpu_msp430==1 + HEADER(XT_UDSTAR,3,"ud*",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_UDSTAR: + .dw $ff03 + .db "ud*" + .dw VE_HEAD + .set VE_HEAD = VE_UDSTAR +XT_UDSTAR: + .dw DO_COLON +PFA_UDSTAR: + +.endif +;Z UD* ud1 d2 -- ud3 32*16->32 multiply +; XT_DUP >R UM* DROP XT_SWAP R> UM* ROT + ; + + .DW XT_DUP,XT_TO_R,XT_UMSTAR,XT_DROP + .DW XT_SWAP,XT_R_FROM,XT_UMSTAR,XT_ROT,XT_PLUS,XT_EXIT diff --git a/amforth-6.5/common/words/udefer-fetch.asm b/amforth-6.5/common/words/udefer-fetch.asm new file mode 100644 index 0000000..81a1084 --- /dev/null +++ b/amforth-6.5/common/words/udefer-fetch.asm @@ -0,0 +1,23 @@ +; ( xt1 -- xt2 ) +; System +; does the real defer@ for user based defers + +.if cpu_msp430==1 + HEADER(XT_UDEFERFETCH,7,"Udefer@",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_UDEFERFETCH: + .dw $ff07 + .db "Udefer@",0 + .dw VE_HEAD + .set VE_HEAD = VE_UDEFERFETCH +XT_UDEFERFETCH: + .dw DO_COLON +PFA_UDEFERFETCH: +.endif + .dw XT_FETCHI + .dw XT_UP_FETCH + .dw XT_PLUS + .dw XT_FETCH + .dw XT_EXIT diff --git a/amforth-6.5/common/words/udefer-store.asm b/amforth-6.5/common/words/udefer-store.asm new file mode 100644 index 0000000..447f58e --- /dev/null +++ b/amforth-6.5/common/words/udefer-store.asm @@ -0,0 +1,25 @@ +; ( xt1 xt2 -- ) +; System +; does the real defer! for user based defers + +.if cpu_msp430==1 + HEADER(XT_UDEFERSTORE,7,"Udefer!",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_UDEFERSTORE: + .dw $ff07 + .db "Udefer!",0 + .dw VE_HEAD + .set VE_HEAD = VE_UDEFERSTORE +XT_UDEFERSTORE: + .dw DO_COLON +PFA_UDEFERSTORE: +.endif + + .dw XT_FETCHI + .dw XT_UP_FETCH + .dw XT_PLUS + .dw XT_STORE + .dw XT_EXIT + diff --git a/amforth-6.5/common/words/umax.asm b/amforth-6.5/common/words/umax.asm new file mode 100644 index 0000000..fb16de5 --- /dev/null +++ b/amforth-6.5/common/words/umax.asm @@ -0,0 +1,22 @@ + +.if cpu_msp430==1 + HEADER(XT_UMAX,4,"umax",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_UMAX: + .dw $ff04 + .db "umax" + .dw VE_HEAD + .set VE_HEAD = VE_UMAX +XT_UMAX: + .dw DO_COLON +PFA_UMAX: +.endif + + .DW XT_2DUP,XT_ULESS + .dw XT_DOCONDBRANCH + DEST(UMAX1) + .DW XT_SWAP +UMAX1: .DW XT_DROP + .dw XT_EXIT diff --git a/amforth-6.5/common/words/umin.asm b/amforth-6.5/common/words/umin.asm new file mode 100644 index 0000000..c789095 --- /dev/null +++ b/amforth-6.5/common/words/umin.asm @@ -0,0 +1,21 @@ + +.if cpu_msp430==1 + HEADER(XT_UMIN,4,"umin",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_UMIN: + .dw $ff04 + .db "umin" + .dw VE_HEAD + .set VE_HEAD = VE_UMIN +XT_UMIN: + .dw DO_COLON +PFA_UMIN: +.endif + .DW XT_2DUP,XT_UGREATER + .dw XT_DOCONDBRANCH + DEST(UMIN1) + .DW XT_SWAP +UMIN1: .DW XT_DROP + .dw XT_EXIT diff --git a/amforth-6.5/common/words/until.asm b/amforth-6.5/common/words/until.asm new file mode 100644 index 0000000..74ec04b --- /dev/null +++ b/amforth-6.5/common/words/until.asm @@ -0,0 +1,24 @@ +; ( f -- ) (C: dest -- ) +; Compiler +; finish begin with conditional branch, leaves the loop if true flag at runtime + +.if cpu_msp430==1 + IMMED(XT_UNTIL,5,"until",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_UNTIL: + .dw $0005 + .db "until",0 + .dw VE_HEAD + .set VE_HEAD = VE_UNTIL +XT_UNTIL: + .dw DO_COLON +PFA_UNTIL: +.endif + .dw XT_DOLITERAL + .dw XT_DOCONDBRANCH + .dw XT_COMMA + + .dw XT_LRESOLVE + .dw XT_EXIT diff --git a/amforth-6.5/common/words/variable.asm b/amforth-6.5/common/words/variable.asm new file mode 100644 index 0000000..fe3e245 --- /dev/null +++ b/amforth-6.5/common/words/variable.asm @@ -0,0 +1,24 @@ +; ( cchar -- ) +; Compiler +; create a dictionary entry for a variable and allocate 1 cell RAM + +.if cpu_msp430==1 + HEADER(XT_VARIABLE,8,"variable",DOCOLON) +.endif + +.if cpu_avr8==1 + +VE_VARIABLE: + .dw $ff08 + .db "variable" + .dw VE_HEAD + .set VE_HEAD = VE_VARIABLE +XT_VARIABLE: + .dw DO_COLON +PFA_VARIABLE: +.endif + .dw XT_HERE + .dw XT_CONSTANT + .dw XT_TWO + .dw XT_ALLOT + .dw XT_EXIT diff --git a/amforth-6.5/common/words/ver.asm b/amforth-6.5/common/words/ver.asm new file mode 100644 index 0000000..3e0105a --- /dev/null +++ b/amforth-6.5/common/words/ver.asm @@ -0,0 +1,42 @@ +; ( -- ) +; Tools +; print the version string + +.if cpu_msp430==1 + HEADER(XT_DOT_VER,3,"ver",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_DOT_VER: + .dw $ff03 + .db "ver" + .dw VE_HEAD + .set VE_HEAD = VE_DOT_VER +XT_DOT_VER: + .dw DO_COLON +PFA_DOT_VER: +.endif + .dw XT_ENV_FORTHNAME + .dw XT_ITYPE + .dw XT_SPACE + .dw XT_BASE + .dw XT_FETCH + + .dw XT_ENV_FORTHVERSION + .dw XT_DECIMAL + .dw XT_S2D + .dw XT_L_SHARP + .dw XT_SHARP + .dw XT_DOLITERAL + .dw '.' + .dw XT_HOLD + .dw XT_SHARP_S + .dw XT_SHARP_G + .dw XT_TYPE + .dw XT_BASE + .dw XT_STORE + .dw XT_SPACE + .dw XT_ENV_CPU + .dw XT_ITYPE + + .dw XT_EXIT diff --git a/amforth-6.5/common/words/warm.asm b/amforth-6.5/common/words/warm.asm new file mode 100644 index 0000000..5634fa0 --- /dev/null +++ b/amforth-6.5/common/words/warm.asm @@ -0,0 +1,27 @@ +; ( nx* -- ) (R: ny* -- ) +; System +; initialize amforth further. executes turnkey operation and go to quit + +.if cpu_msp430==1 + HEADER(XT_WARM,4,"warm",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_WARM: + .dw $ff04 + .db "warm" + .dw VE_HEAD + .set VE_HEAD = VE_WARM +XT_WARM: + .dw DO_COLON +PFA_WARM: +.endif + .dw XT_INIT_RAM + .dw XT_DOLITERAL + .dw XT_NOOP + .dw XT_DOLITERAL + .dw XT_PAUSE + .dw XT_DEFERSTORE + .dw XT_LBRACKET + .dw XT_TURNKEY + .dw XT_QUIT ; never returns diff --git a/amforth-6.5/common/words/while.asm b/amforth-6.5/common/words/while.asm new file mode 100644 index 0000000..c21a6c1 --- /dev/null +++ b/amforth-6.5/common/words/while.asm @@ -0,0 +1,21 @@ +; ( f -- ) (C: dest -- orig dest ) +; Compiler +; at runtime skip until repeat if non-true + +.if cpu_msp430==1 + IMMED(XT_WHILE,5,"while",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_WHILE: + .dw $0005 + .db "while",0 + .dw VE_HEAD + .set VE_HEAD = VE_WHILE +XT_WHILE: + .dw DO_COLON +PFA_WHILE: +.endif + .dw XT_IF + .dw XT_SWAP + .dw XT_EXIT diff --git a/amforth-6.5/common/words/within.asm b/amforth-6.5/common/words/within.asm new file mode 100644 index 0000000..9aaa77a --- /dev/null +++ b/amforth-6.5/common/words/within.asm @@ -0,0 +1,25 @@ +; ( n min max -- f) +; Compare +; check if n is within min..max + +.if cpu_msp430==1 + HEADER(XT_WITHIN,6,"within",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_WITHIN: + .dw $ff06 + .db "within" + .dw VE_HEAD + .set VE_HEAD = VE_WITHIN +XT_WITHIN: + .dw DO_COLON +PFA_WITHIN: +.endif + .dw XT_OVER + .dw XT_MINUS + .dw XT_TO_R + .dw XT_MINUS + .dw XT_R_FROM + .dw XT_ULESS + .dw XT_EXIT diff --git a/amforth-6.5/common/words/word.asm b/amforth-6.5/common/words/word.asm new file mode 100644 index 0000000..9f24f85 --- /dev/null +++ b/amforth-6.5/common/words/word.asm @@ -0,0 +1,25 @@ +; ( c -- addr ) +; Tools +; skip leading delimiter character and parse SOURCE until the next delimiter. copy the word to HERE + +.if cpu_msp430==1 + HEADER(XT_WORD,4,"word",DOCOLON) +.endif + +.if cpu_avr8==1 +VE_WORD: + .dw $ff04 + .db "word" + .dw VE_HEAD + .set VE_HEAD = VE_WORD +XT_WORD: + .dw DO_COLON +PFA_WORD: +.endif + .dw XT_SKIPSCANCHAR ; factor for both parse/word + ; move to HERE + .dw XT_HERE + .dw XT_PLACE + ; leave result + .dw XT_HERE + .dw XT_EXIT diff --git a/amforth-6.5/common/words/words.asm b/amforth-6.5/common/words/words.asm new file mode 100644 index 0000000..a6f345e --- /dev/null +++ b/amforth-6.5/common/words/words.asm @@ -0,0 +1,25 @@ +; ( -- ) +; Tools +; prints a list of all (visible) words in the dictionary + +.if cpu_msp430==1 + HEADER(XT_WORDS,5,"words",DOCOLON) +.endif + +.if cpu_avr8==1 + + +VE_WORDS: + .dw $ff05 + .db "words",0 + .dw VE_HEAD + .set VE_HEAD = VE_WORDS +XT_WORDS: + .dw DO_COLON +PFA_WORDS: +.endif + .dw XT_DOLITERAL + .dw CFG_ORDERLISTLEN+2 + .dw XT_FETCHE + .dw XT_SHOWWORDLIST + .dw XT_EXIT -- cgit v1.2.3