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/appl/eval-pollin/p32-8.lst | 10420 +++++++++++++++++++++++++++++++ 1 file changed, 10420 insertions(+) create mode 100644 amforth-6.5/appl/eval-pollin/p32-8.lst (limited to 'amforth-6.5/appl/eval-pollin/p32-8.lst') diff --git a/amforth-6.5/appl/eval-pollin/p32-8.lst b/amforth-6.5/appl/eval-pollin/p32-8.lst new file mode 100644 index 0000000..0922f73 --- /dev/null +++ b/amforth-6.5/appl/eval-pollin/p32-8.lst @@ -0,0 +1,10420 @@ + +AVRASM ver. 2.1.52 p32-8.asm Sun Apr 30 20:10:14 2017 + +p32-8.asm(5): Including file '../../avr8\preamble.inc' +../../avr8\preamble.inc(2): Including file '../../avr8\macros.asm' +../../avr8\macros.asm(6): Including file '../../avr8\user.inc' +../../avr8\preamble.inc(6): Including file '../../avr8/devices/atmega32\device.asm' +../../avr8/devices/atmega32\device.asm(5): Including file '../../avr8/Atmel/Appnotes2\m32def.inc' +p32-8.asm(14): Including file '../../avr8\drivers/usart.asm' +../../avr8\drivers/usart.asm(30): Including file '../../avr8\drivers/usart_common.asm' +../../avr8\drivers/usart_common.asm(11): Including file '../../avr8\drivers/usart-rx-buffer.asm' +../../avr8\drivers/usart_common.asm(24): Including file '../../avr8\words/usart-tx-poll.asm' +../../avr8\drivers/usart_common.asm(29): Including file '../../avr8\words/ubrr.asm' +../../avr8\drivers/usart_common.asm(30): Including file '../../avr8\words/usart.asm' +p32-8.asm(19): Including file '../../avr8\drivers/1wire.asm' +p32-8.asm(21): Including file '../../avr8\amforth.asm' +../../avr8\amforth.asm(12): Including file '../../avr8\drivers/generic-isr.asm' +../../avr8\amforth.asm(14): Including file '../../avr8\dict/rww.inc' +../../avr8\dict/rww.inc(1): Including file '../../avr8\words/mplus.asm' +../../avr8\dict/rww.inc(2): Including file '../../common\words/ud-star.asm' +../../avr8\dict/rww.inc(3): Including file '../../common\words/umax.asm' +../../avr8\dict/rww.inc(4): Including file '../../common\words/umin.asm' +../../avr8\dict/rww.inc(5): Including file '../../avr8\words/immediate-q.asm' +../../avr8\dict/rww.inc(6): Including file '../../avr8\words/name2flags.asm' +../../avr8\dict/rww.inc(11): Including file '../../avr8\dict/appl_4k.inc' +../../avr8\dict/appl_4k.inc(1): Including file '../../common\words/ver.asm' +../../avr8\dict/appl_4k.inc(4): Including file '../../common\words/noop.asm' +../../avr8\dict/appl_4k.inc(5): Including file '../../avr8\words/unused.asm' +../../avr8\dict/appl_4k.inc(6): Including file '../../common\words/to.asm' +../../avr8\dict/appl_4k.inc(7): Including file '../../avr8\words/i-cellplus.asm' +../../avr8\dict/appl_4k.inc(8): Including file '../../avr8\words/icompare.asm' +../../avr8\dict/appl_4k.inc(9): Including file '../../common\words/star.asm' +../../avr8\dict/appl_4k.inc(10): Including file '../../avr8\words/j.asm' +../../avr8\dict/appl_4k.inc(11): Including file '../../avr8\words/dabs.asm' +../../avr8\dict/appl_4k.inc(12): Including file '../../avr8\words/dnegate.asm' +../../avr8\dict/appl_4k.inc(13): Including file '../../avr8\words/cmove.asm' +../../avr8\dict/appl_4k.inc(14): Including file '../../common\words/2swap.asm' +../../avr8\dict/appl_4k.inc(15): Including file '../../common\words/tib.asm' +../../avr8\dict/appl_4k.inc(16): Including file '../../avr8\words/init-ram.asm' +../../avr8\dict/appl_4k.inc(20): Including file '../../avr8\words/environment.asm' +../../avr8\dict/appl_4k.inc(21): Including file '../../avr8\words/env-wordlists.asm' +../../avr8\dict/appl_4k.inc(22): Including file '../../avr8\words/env-slashpad.asm' +../../avr8\dict/appl_4k.inc(23): Including file '../../common\words/env-slashhold.asm' +../../avr8\dict/appl_4k.inc(24): Including file '../../common\words/env-forthname.asm' +../../avr8\dict/appl_4k.inc(25): Including file '../../common\words/env-forthversion.asm' +../../avr8\dict/appl_4k.inc(26): Including file '../../common\words/env-cpu.asm' +../../avr8\dict/appl_4k.inc(27): Including file '../../avr8\words/env-mcuinfo.asm' +../../avr8\dict/appl_4k.inc(28): Including file '../../common\words/env-usersize.asm' +../../avr8\dict/appl_4k.inc(30): Including file '../../avr8\words/hld.asm' +../../avr8\dict/appl_4k.inc(31): Including file '../../common\words/hold.asm' +../../avr8\dict/appl_4k.inc(32): Including file '../../common\words/less-sharp.asm' +../../avr8\dict/appl_4k.inc(33): Including file '../../common\words/sharp.asm' +../../avr8\dict/appl_4k.inc(34): Including file '../../common\words/sharp-s.asm' +../../avr8\dict/appl_4k.inc(35): Including file '../../common\words/sharp-greater.asm' +../../avr8\dict/appl_4k.inc(36): Including file '../../common\words/sign.asm' +../../avr8\dict/appl_4k.inc(37): Including file '../../common\words/d-dot-r.asm' +../../avr8\dict/appl_4k.inc(38): Including file '../../common\words/dot-r.asm' +../../avr8\dict/appl_4k.inc(39): Including file '../../common\words/d-dot.asm' +../../avr8\dict/appl_4k.inc(40): Including file '../../common\words/dot.asm' +../../avr8\dict/appl_4k.inc(41): Including file '../../common\words/ud-dot.asm' +../../avr8\dict/appl_4k.inc(42): Including file '../../common\words/ud-dot-r.asm' +../../avr8\dict/appl_4k.inc(43): Including file '../../common\words/ud-slash-mod.asm' +../../avr8\dict/appl_4k.inc(44): Including file '../../common\words/digit-q.asm' +../../avr8\dict/appl_4k.inc(46): Including file '../../avr8\words/do-sliteral.asm' +../../avr8\dict/appl_4k.inc(47): Including file '../../avr8\words/scomma.asm' +../../avr8\dict/appl_4k.inc(48): Including file '../../avr8\words/itype.asm' +../../avr8\dict/appl_4k.inc(49): Including file '../../avr8\words/icount.asm' +../../avr8\dict/appl_4k.inc(50): Including file '../../common\words/type.asm' +../../avr8\dict/appl_4k.inc(51): Including file '../../common\words/tick.asm' +../../avr8\dict/appl_4k.inc(53): Including file '../../common\words/cskip.asm' +../../avr8\dict/appl_4k.inc(54): Including file '../../common\words/cscan.asm' +../../avr8\dict/appl_4k.inc(55): Including file '../../common\words/accept.asm' +../../avr8\dict/appl_4k.inc(56): Including file '../../common\words/refill.asm' +../../avr8\dict/appl_4k.inc(57): Including file '../../common\words/char.asm' +../../avr8\dict/appl_4k.inc(58): Including file '../../common\words/number.asm' +../../avr8\dict/appl_4k.inc(59): Including file '../../common\words/q-sign.asm' +../../avr8\dict/appl_4k.inc(60): Including file '../../common\words/set-base.asm' +../../avr8\dict/appl_4k.inc(61): Including file '../../common\words/to-number.asm' +../../avr8\dict/appl_4k.inc(62): Including file '../../common\words/parse.asm' +../../avr8\dict/appl_4k.inc(63): Including file '../../common\words/source.asm' +../../avr8\dict/appl_4k.inc(64): Including file '../../common\words/slash-string.asm' +../../avr8\dict/appl_4k.inc(65): Including file '../../common\words/parse-name.asm' +../../avr8\dict/appl_4k.inc(66): Including file '../../avr8\words/sp0.asm' +../../avr8\dict/appl_4k.inc(67): Including file '../../avr8\words/rp0.asm' +../../avr8\dict/appl_4k.inc(68): Including file '../../common\words/depth.asm' +../../avr8\dict/appl_4k.inc(69): Including file '../../avr8\words/forth-recognizer.asm' +../../avr8\dict/appl_4k.inc(70): Including file '../../common\words/recognize.asm' +../../avr8\dict/appl_4k.inc(71): Including file '../../common\words/interpret.asm' +../../avr8\dict/appl_4k.inc(72): Including file '../../common\words/rec-intnum.asm' +../../avr8\dict/appl_4k.inc(73): Including file '../../common\words/rec-find.asm' +../../avr8\dict/appl_4k.inc(74): Including file '../../common\words/dt-null.asm' +../../avr8\dict/appl_4k.inc(75): Including file '../../common\words/search-wordlist.asm' +../../avr8\dict/appl_4k.inc(76): Including file '../../common\words/traverse-wordlist.asm' +../../avr8\dict/appl_4k.inc(77): Including file '../../common\words/name2string.asm' +../../avr8\dict/appl_4k.inc(78): Including file '../../avr8\words/nfa2cfa.asm' +../../avr8\dict/appl_4k.inc(79): Including file '../../common\words/find-xt.asm' +../../avr8\dict/appl_4k.inc(81): Including file '../../avr8\dict/compiler1.inc' +../../avr8\dict/compiler1.inc(2): Including file '../../avr8\words/newest.asm' +../../avr8\dict/compiler1.inc(3): Including file '../../avr8\words/latest.asm' +../../avr8\dict/compiler1.inc(4): Including file '../../common\words/do-create.asm' +../../avr8\dict/compiler1.inc(5): Including file '../../common\words/backslash.asm' +../../avr8\dict/compiler1.inc(6): Including file '../../common\words/l-paren.asm' +../../avr8\dict/compiler1.inc(8): Including file '../../common\words/compile.asm' +../../avr8\dict/compiler1.inc(9): Including file '../../avr8\words/comma.asm' +../../avr8\dict/compiler1.inc(10): Including file '../../common\words/brackettick.asm' +../../avr8\dict/compiler1.inc(13): Including file '../../common\words/literal.asm' +../../avr8\dict/compiler1.inc(14): Including file '../../common\words/sliteral.asm' +../../avr8\dict/compiler1.inc(15): Including file '../../avr8\words/g-mark.asm' +../../avr8\dict/compiler1.inc(16): Including file '../../avr8\words/g-resolve.asm' +../../avr8\dict/compiler1.inc(17): Including file '../../avr8\words/l_mark.asm' +../../avr8\dict/compiler1.inc(18): Including file '../../avr8\words/l_resolve.asm' +../../avr8\dict/compiler1.inc(20): Including file '../../common\words/ahead.asm' +../../avr8\dict/compiler1.inc(21): Including file '../../common\words/if.asm' +../../avr8\dict/compiler1.inc(22): Including file '../../common\words/else.asm' +../../avr8\dict/compiler1.inc(23): Including file '../../common\words/then.asm' +../../avr8\dict/compiler1.inc(24): Including file '../../common\words/begin.asm' +../../avr8\dict/compiler1.inc(25): Including file '../../common\words/while.asm' +../../avr8\dict/compiler1.inc(26): Including file '../../common\words/repeat.asm' +../../avr8\dict/compiler1.inc(27): Including file '../../common\words/until.asm' +../../avr8\dict/compiler1.inc(28): Including file '../../common\words/again.asm' +../../avr8\dict/compiler1.inc(29): Including file '../../common\words/do.asm' +../../avr8\dict/compiler1.inc(30): Including file '../../common\words/loop.asm' +../../avr8\dict/compiler1.inc(31): Including file '../../common\words/plusloop.asm' +../../avr8\dict/compiler1.inc(32): Including file '../../common\words/leave.asm' +../../avr8\dict/compiler1.inc(33): Including file '../../common\words/qdo.asm' +../../avr8\dict/compiler1.inc(34): Including file '../../common\words/endloop.asm' +../../avr8\dict/compiler1.inc(36): Including file '../../common\words/l-from.asm' +../../avr8\dict/compiler1.inc(37): Including file '../../common\words/to-l.asm' +../../avr8\dict/compiler1.inc(38): Including file '../../avr8\words/lp0.asm' +../../avr8\dict/compiler1.inc(39): Including file '../../avr8\words/lp.asm' +../../avr8\dict/compiler1.inc(41): Including file '../../common\words/create.asm' +../../avr8\dict/compiler1.inc(42): Including file '../../avr8\words/header.asm' +../../avr8\dict/compiler1.inc(43): Including file '../../avr8\words/wlscope.asm' +../../avr8\dict/compiler1.inc(44): Including file '../../common\words/reveal.asm' +../../avr8\dict/compiler1.inc(45): Including file '../../avr8\words/does.asm' +../../avr8\dict/compiler1.inc(46): Including file '../../common\words/colon.asm' +../../avr8\dict/compiler1.inc(47): Including file '../../avr8\words/colon-noname.asm' +../../avr8\dict/compiler1.inc(48): Including file '../../common\words/semicolon.asm' +../../avr8\dict/compiler1.inc(49): Including file '../../common\words/right-bracket.asm' +../../avr8\dict/compiler1.inc(50): Including file '../../common\words/left-bracket.asm' +../../avr8\dict/compiler1.inc(51): Including file '../../common\words/variable.asm' +../../avr8\dict/compiler1.inc(52): Including file '../../common\words/constant.asm' +../../avr8\dict/compiler1.inc(53): Including file '../../avr8\words/user.asm' +../../avr8\dict/compiler1.inc(55): Including file '../../common\words/recurse.asm' +../../avr8\dict/compiler1.inc(56): Including file '../../avr8\words/immediate.asm' +../../avr8\dict/compiler1.inc(58): Including file '../../common\words/bracketchar.asm' +../../avr8\dict/compiler1.inc(59): Including file '../../common\words/abort-string.asm' +../../avr8\dict/compiler1.inc(60): Including file '../../common\words/abort.asm' +../../avr8\dict/compiler1.inc(61): Including file '../../common\words/q-abort.asm' +../../avr8\dict/compiler1.inc(63): Including file '../../common\words/get-stack.asm' +../../avr8\dict/compiler1.inc(64): Including file '../../common\words/set-stack.asm' +../../avr8\dict/compiler1.inc(65): Including file '../../common\words/map-stack.asm' +../../avr8\dict/compiler1.inc(66): Including file '../../avr8\words/get-current.asm' +../../avr8\dict/compiler1.inc(67): Including file '../../common\words/get-order.asm' +../../avr8\dict/compiler1.inc(68): Including file '../../common\words/cfg-order.asm' +../../avr8\dict/compiler1.inc(69): Including file '../../avr8\words/compare.asm' +../../avr8\dict/compiler1.inc(70): Including file '../../avr8\words/nfa2lfa.asm' +../../avr8\amforth.asm(15): Including file 'dict_appl.inc' +dict_appl.inc(3): Including file '../../common\words/dot-s.asm' +dict_appl.inc(4): Including file '../../avr8\words/spirw.asm' +dict_appl.inc(5): Including file '../../avr8\words/n-spi.asm' +dict_appl.inc(6): Including file 'words/applturnkey.asm' +dict_appl.inc(7): Including file '../../avr8\dict/compiler2.inc' +../../avr8\dict/compiler2.inc(8): Including file '../../avr8\words/set-current.asm' +../../avr8\dict/compiler2.inc(9): Including file '../../avr8\words/wordlist.asm' +../../avr8\dict/compiler2.inc(11): Including file '../../avr8\words/forth-wordlist.asm' +../../avr8\dict/compiler2.inc(12): Including file '../../common\words/set-order.asm' +../../avr8\dict/compiler2.inc(13): Including file '../../common\words/set-recognizer.asm' +../../avr8\dict/compiler2.inc(14): Including file '../../common\words/get-recognizer.asm' +../../avr8\dict/compiler2.inc(15): Including file '../../avr8\words/code.asm' +../../avr8\dict/compiler2.inc(16): Including file '../../avr8\words/end-code.asm' +../../avr8\dict/compiler2.inc(17): Including file '../../avr8\words/marker.asm' +../../avr8\dict/compiler2.inc(18): Including file '../../common\words/postpone.asm' +dict_appl.inc(8): Including file '../../avr8\words/2r_fetch.asm' +../../avr8\amforth.asm(23): Including file '../../avr8\amforth-interpreter.asm' +../../avr8\amforth.asm(24): Including file '../../avr8\dict/nrww.inc' +../../avr8\dict/nrww.inc(4): Including file '../../avr8\words/exit.asm' +../../avr8\dict/nrww.inc(5): Including file '../../avr8\words/execute.asm' +../../avr8\dict/nrww.inc(6): Including file '../../avr8\words/dobranch.asm' +../../avr8\dict/nrww.inc(7): Including file '../../avr8\words/docondbranch.asm' +../../avr8\dict/nrww.inc(10): Including file '../../avr8\words/doliteral.asm' +../../avr8\dict/nrww.inc(11): Including file '../../avr8\words/dovariable.asm' +../../avr8\dict/nrww.inc(12): Including file '../../avr8\words/doconstant.asm' +../../avr8\dict/nrww.inc(13): Including file '../../avr8\words/douser.asm' +../../avr8\dict/nrww.inc(14): Including file '../../avr8\words/do-value.asm' +../../avr8\dict/nrww.inc(15): Including file '../../avr8\words/fetch.asm' +../../avr8\dict/nrww.inc(16): Including file '../../avr8\words/store.asm' +../../avr8\dict/nrww.inc(17): Including file '../../avr8\words/cstore.asm' +../../avr8\dict/nrww.inc(18): Including file '../../avr8\words/cfetch.asm' +../../avr8\dict/nrww.inc(19): Including file '../../avr8\words/fetch-u.asm' +../../avr8\dict/nrww.inc(20): Including file '../../avr8\words/store-u.asm' +../../avr8\dict/nrww.inc(23): Including file '../../avr8\words/dup.asm' +../../avr8\dict/nrww.inc(24): Including file '../../avr8\words/qdup.asm' +../../avr8\dict/nrww.inc(25): Including file '../../avr8\words/swap.asm' +../../avr8\dict/nrww.inc(26): Including file '../../avr8\words/over.asm' +../../avr8\dict/nrww.inc(27): Including file '../../avr8\words/drop.asm' +../../avr8\dict/nrww.inc(28): Including file '../../avr8\words/rot.asm' +../../avr8\dict/nrww.inc(29): Including file '../../avr8\words/nip.asm' +../../avr8\dict/nrww.inc(31): Including file '../../avr8\words/r_from.asm' +../../avr8\dict/nrww.inc(32): Including file '../../avr8\words/to_r.asm' +../../avr8\dict/nrww.inc(33): Including file '../../avr8\words/r_fetch.asm' +../../avr8\dict/nrww.inc(36): Including file '../../common\words/not-equal.asm' +../../avr8\dict/nrww.inc(37): Including file '../../avr8\words/equalzero.asm' +../../avr8\dict/nrww.inc(38): Including file '../../avr8\words/lesszero.asm' +../../avr8\dict/nrww.inc(39): Including file '../../avr8\words/greaterzero.asm' +../../avr8\dict/nrww.inc(40): Including file '../../avr8\words/d-greaterzero.asm' +../../avr8\dict/nrww.inc(41): Including file '../../avr8\words/d-lesszero.asm' +../../avr8\dict/nrww.inc(43): Including file '../../avr8\words/true.asm' +../../avr8\dict/nrww.inc(44): Including file '../../avr8\words/zero.asm' +../../avr8\dict/nrww.inc(45): Including file '../../avr8\words/uless.asm' +../../avr8\dict/nrww.inc(46): Including file '../../common\words/u-greater.asm' +../../avr8\dict/nrww.inc(47): Including file '../../avr8\words/less.asm' +../../avr8\dict/nrww.inc(48): Including file '../../avr8\words/greater.asm' +../../avr8\dict/nrww.inc(50): Including file '../../avr8\words/log2.asm' +../../avr8\dict/nrww.inc(51): Including file '../../avr8\words/minus.asm' +../../avr8\dict/nrww.inc(52): Including file '../../avr8\words/plus.asm' +../../avr8\dict/nrww.inc(53): Including file '../../avr8\words/mstar.asm' +../../avr8\dict/nrww.inc(54): Including file '../../avr8\words/umslashmod.asm' +../../avr8\dict/nrww.inc(55): Including file '../../avr8\words/umstar.asm' +../../avr8\dict/nrww.inc(57): Including file '../../avr8\words/invert.asm' +../../avr8\dict/nrww.inc(58): Including file '../../avr8\words/2slash.asm' +../../avr8\dict/nrww.inc(59): Including file '../../avr8\words/2star.asm' +../../avr8\dict/nrww.inc(60): Including file '../../avr8\words/and.asm' +../../avr8\dict/nrww.inc(61): Including file '../../avr8\words/or.asm' +../../avr8\dict/nrww.inc(62): Including file '../../avr8\words/xor.asm' +../../avr8\dict/nrww.inc(64): Including file '../../avr8\words/1plus.asm' +../../avr8\dict/nrww.inc(65): Including file '../../avr8\words/1minus.asm' +../../avr8\dict/nrww.inc(66): Including file '../../common\words/q-negate.asm' +../../avr8\dict/nrww.inc(67): Including file '../../avr8\words/lshift.asm' +../../avr8\dict/nrww.inc(68): Including file '../../avr8\words/rshift.asm' +../../avr8\dict/nrww.inc(69): Including file '../../avr8\words/plusstore.asm' +../../avr8\dict/nrww.inc(71): Including file '../../avr8\words/rpfetch.asm' +../../avr8\dict/nrww.inc(72): Including file '../../avr8\words/rpstore.asm' +../../avr8\dict/nrww.inc(73): Including file '../../avr8\words/spfetch.asm' +../../avr8\dict/nrww.inc(74): Including file '../../avr8\words/spstore.asm' +../../avr8\dict/nrww.inc(76): Including file '../../avr8\words/dodo.asm' +../../avr8\dict/nrww.inc(77): Including file '../../avr8\words/i.asm' +../../avr8\dict/nrww.inc(78): Including file '../../avr8\words/doplusloop.asm' +../../avr8\dict/nrww.inc(79): Including file '../../avr8\words/doloop.asm' +../../avr8\dict/nrww.inc(80): Including file '../../avr8\words/unloop.asm' +../../avr8\dict/nrww.inc(84): Including file '../../avr8\words/cmove_g.asm' +../../avr8\dict/nrww.inc(85): Including file '../../avr8\words/byteswap.asm' +../../avr8\dict/nrww.inc(86): Including file '../../avr8\words/up.asm' +../../avr8\dict/nrww.inc(87): Including file '../../avr8\words/1ms.asm' +../../avr8\dict/nrww.inc(88): Including file '../../avr8\words/2to_r.asm' +../../avr8\dict/nrww.inc(89): Including file '../../avr8\words/2r_from.asm' +../../avr8\dict/nrww.inc(91): Including file '../../avr8\words/store-e.asm' +../../avr8\dict/nrww.inc(92): Including file '../../avr8\words/fetch-e.asm' +../../avr8\dict/nrww.inc(93): Including file '../../avr8\words/store-i.asm' +../../avr8\dict/nrww.inc(97): Including file '../../avr8\words/store-i_nrww.asm' +../../avr8\dict/nrww.inc(99): Including file '../../avr8\words/fetch-i.asm' +../../avr8\dict/nrww.inc(104): Including file '../../avr8\dict/core_4k.inc' +../../avr8\dict/core_4k.inc(3): Including file '../../avr8\words/n_to_r.asm' +../../avr8\dict/core_4k.inc(4): Including file '../../avr8\words/n_r_from.asm' +../../avr8\dict/core_4k.inc(5): Including file '../../avr8\words/d-2star.asm' +../../avr8\dict/core_4k.inc(6): Including file '../../avr8\words/d-2slash.asm' +../../avr8\dict/core_4k.inc(7): Including file '../../avr8\words/d-plus.asm' +../../avr8\dict/core_4k.inc(8): Including file '../../avr8\words/d-minus.asm' +../../avr8\dict/core_4k.inc(9): Including file '../../avr8\words/d-invert.asm' +../../avr8\dict/core_4k.inc(10): Including file '../../avr8\words/slashmod.asm' +../../avr8\dict/core_4k.inc(11): Including file '../../common\words/abs.asm' +../../avr8\dict/core_4k.inc(12): Including file '../../common\words/pick.asm' +../../avr8\dict/core_4k.inc(13): Including file '../../avr8\words/cellplus.asm' +../../avr8\dict/core_4k.inc(14): Including file '../../avr8\dict/interrupt.inc' +../../avr8\dict/interrupt.inc(8): Including file '../../avr8\words/int-on.asm' +../../avr8\dict/interrupt.inc(9): Including file '../../avr8\words/int-off.asm' +../../avr8\dict/interrupt.inc(10): Including file '../../avr8\words/int-store.asm' +../../avr8\dict/interrupt.inc(11): Including file '../../avr8\words/int-fetch.asm' +../../avr8\dict/interrupt.inc(12): Including file '../../avr8\words/int-trap.asm' +../../avr8\dict/interrupt.inc(14): Including file '../../avr8\words/isr-exec.asm' +../../avr8\dict/interrupt.inc(15): Including file '../../avr8\words/isr-end.asm' +../../avr8\dict/core_4k.inc(17): Including file '../../common\words/prompt-ok.asm' +../../avr8\dict/core_4k.inc(18): Including file '../../common\words/prompt-ready.asm' +../../avr8\dict/core_4k.inc(19): Including file '../../common\words/prompt-error.asm' +../../avr8\dict/core_4k.inc(21): Including file '../../common\words/quit.asm' +../../avr8\dict/core_4k.inc(22): Including file '../../avr8\words/pause.asm' +../../avr8\dict/core_4k.inc(23): Including file '../../avr8\words/cold.asm' +../../avr8\dict/core_4k.inc(24): Including file '../../common\words/warm.asm' +../../avr8\dict/core_4k.inc(26): Including file '../../common\words/handler.asm' +../../avr8\dict/core_4k.inc(27): Including file '../../common\words/catch.asm' +../../avr8\dict/core_4k.inc(28): Including file '../../common\words/throw.asm' +../../avr8\dict/core_4k.inc(31): Including file '../../avr8\words/edefer-fetch.asm' +../../avr8\dict/core_4k.inc(32): Including file '../../avr8\words/edefer-store.asm' +../../avr8\dict/core_4k.inc(33): Including file '../../common\words/rdefer-fetch.asm' +../../avr8\dict/core_4k.inc(34): Including file '../../common\words/rdefer-store.asm' +../../avr8\dict/core_4k.inc(35): Including file '../../common\words/udefer-fetch.asm' +../../avr8\dict/core_4k.inc(36): Including file '../../common\words/udefer-store.asm' +../../avr8\dict/core_4k.inc(37): Including file '../../common\words/defer-store.asm' +../../avr8\dict/core_4k.inc(38): Including file '../../common\words/defer-fetch.asm' +../../avr8\dict/core_4k.inc(39): Including file '../../avr8\words/do-defer.asm' +../../avr8\dict/core_4k.inc(41): Including file '../../common\words/u-dot.asm' +../../avr8\dict/core_4k.inc(42): Including file '../../common\words/u-dot-r.asm' +../../avr8\dict/core_4k.inc(45): Including file '../../avr8\words/uslashmod.asm' +../../avr8\dict/core_4k.inc(46): Including file '../../avr8\words/negate.asm' +../../avr8\dict/core_4k.inc(47): Including file '../../common\words/slash.asm' +../../avr8\dict/core_4k.inc(48): Including file '../../common\words/mod.asm' +../../avr8\dict/core_4k.inc(50): Including file '../../common\words/min.asm' +../../avr8\dict/core_4k.inc(51): Including file '../../common\words/max.asm' +../../avr8\dict/core_4k.inc(52): Including file '../../common\words/within.asm' +../../avr8\dict/core_4k.inc(54): Including file '../../common\words/show-wordlist.asm' +../../avr8\dict/core_4k.inc(55): Including file '../../common\words/words.asm' +../../avr8\dict/core_4k.inc(57): Including file '../../common\words/dot-quote.asm' +../../avr8\dict/core_4k.inc(58): Including file '../../common\words/squote.asm' +../../avr8\dict/core_4k.inc(59): Including file '../../avr8\words/fill.asm' +../../avr8\dict/core_4k.inc(61): Including file '../../common\words/f_cpu.asm' +../../avr8\dict/core_4k.inc(62): Including file '../../avr8\words/state.asm' +../../avr8\dict/core_4k.inc(63): Including file '../../common\words/base.asm' +../../avr8\dict/core_4k.inc(65): Including file '../../avr8\words/cells.asm' +../../avr8\dict/core_4k.inc(67): Including file '../../common\words/2dup.asm' +../../avr8\dict/core_4k.inc(68): Including file '../../common\words/2drop.asm' +../../avr8\dict/core_4k.inc(69): Including file '../../common\words/tuck.asm' +../../avr8\dict/core_4k.inc(71): Including file '../../common\words/to-in.asm' +../../avr8\dict/core_4k.inc(72): Including file '../../common\words/pad.asm' +../../avr8\dict/core_4k.inc(73): Including file '../../common\words/emit.asm' +../../avr8\dict/core_4k.inc(74): Including file '../../common\words/emitq.asm' +../../avr8\dict/core_4k.inc(75): Including file '../../common\words/key.asm' +../../avr8\dict/core_4k.inc(76): Including file '../../common\words/keyq.asm' +../../avr8\dict/core_4k.inc(78): Including file '../../avr8\words/dp.asm' +../../avr8\dict/core_4k.inc(79): Including file '../../avr8\words/ehere.asm' +../../avr8\dict/core_4k.inc(80): Including file '../../avr8\words/here.asm' +../../avr8\dict/core_4k.inc(81): Including file '../../avr8\words/allot.asm' +../../avr8\dict/core_4k.inc(83): Including file '../../common\words/bin.asm' +../../avr8\dict/core_4k.inc(84): Including file '../../common\words/decimal.asm' +../../avr8\dict/core_4k.inc(85): Including file '../../common\words/hex.asm' +../../avr8\dict/core_4k.inc(86): Including file '../../common\words/bl.asm' +../../avr8\dict/core_4k.inc(88): Including file '../../avr8\words/turnkey.asm' +../../avr8\dict/core_4k.inc(89): Including file '../../common\words/to-upper.asm' +../../avr8\dict/core_4k.inc(90): Including file '../../common\words/to-lower.asm' +../../avr8\dict/core_4k.inc(92): Including file '../../common\words/q-stack.asm' +../../avr8\dict/core_4k.inc(93): Including file '../../common\words/bounds.asm' +../../avr8\dict/core_4k.inc(94): Including file '../../common\words/cr.asm' +../../avr8\dict/core_4k.inc(95): Including file '../../common\words/space.asm' +../../avr8\dict/core_4k.inc(96): Including file '../../common\words/spaces.asm' +../../avr8\dict/core_4k.inc(97): Including file '../../common\words/s-to-d.asm' +../../avr8\dict/core_4k.inc(98): Including file '../../avr8\words/to-body.asm' +../../avr8\dict/nrww.inc(112): Including file '../../common\words/2literal.asm' +../../avr8\dict/nrww.inc(113): Including file '../../avr8\words/equal.asm' +../../avr8\dict/nrww.inc(114): Including file '../../common\words/num-constants.asm' +../../avr8\amforth.asm(25): Including file 'dict_appl_core.inc' +../../avr8\amforth.asm(36): Including file '../../avr8\amforth-eeprom.inc' + + + ; file see ../template/template.asm. You may want to + ; copy that file to this one and edit it afterwards. + + .include "preamble.inc" + + .include "macros.asm" + + .set DICT_COMPILER2 = 0 ; + .set cpu_msp430 = 0 + .set cpu_avr8 = 1 + + .include "user.inc" + + ; + + ; used by the multitasker + .set USER_STATE = 0 + .set USER_FOLLOWER = 2 + + ; stackpointer, used by mulitasker + .set USER_RP = 4 + .set USER_SP0 = 6 + .set USER_SP = 8 + + ; excpection handling + .set USER_HANDLER = 10 + + ; numeric IO + .set USER_BASE = 12 + + ; character IO + .set USER_EMIT = 14 + .set USER_EMITQ = 16 + .set USER_KEY = 18 + .set USER_KEYQ = 20 + + .set USER_SOURCE = 22 + .set USER_TO_IN = 24 + .set USER_REFILL = 26 + + .set USER_P_OK = 28 + .set USER_P_ERR = 30 + .set USER_P_RDY = 32 + + .set SYSUSERSIZE = 34 + ; + + .def zerol = r2 + .def zeroh = r3 + .def upl = r4 + .def uph = r5 + + .def al = r6 + .def ah = r7 + .def bl = r8 + .def bh = r9 + + ; internal + .def mcu_boot = r10 + .def isrflag = r11 + + .def temp4 = r14 + .def temp5 = r15 + + .def temp0 = r16 + .def temp1 = r17 + .def temp2 = r18 + .def temp3 = r19 + + .def temp6 = r20 + .def temp7 = r21 + + .def tosl = r24 + .def tosh = r25 + + .def wl = r22 + .def wh = r23 + + .macro loadtos + ld tosl, Y+ + ld tosh, Y+ + .endmacro + + .macro savetos + st -Y, tosh + st -Y, tosl + .endmacro + + .macro in_ + .if (@1 < $40) + in @0,@1 + .else + lds @0,@1 + .endif + .endmacro + + .macro out_ + .if (@0 < $40) + out @0,@1 + .else + sts @0,@1 + .endif + .endmacro + + .macro sbi_ + .if (@0 < $40) + sbi @0,@1 + .else + in_ @2,@0 + ori @2,exp2(@1) + out_ @0,@2 + .endif + .endmacro + + .macro cbi_ + .if (@0 < $40) + cbi @0,@1 + .else + in_ @2,@0 + andi @2,~(exp2(@1)) + out_ @0,@2 + .endif + .endmacro + + .macro jmp_ + ; a more flexible macro + .ifdef @0 + .if (@0-pc > 2040) || (pc-@0>2040) + jmp @0 + .else + rjmp @0 + .endif + .else + jmp @0 + .endif + .endmacro + .macro call_ + ; a more flexible macro + .ifdef @0 + .if (@0-pc > 2040) || (pc-@0>2040) + call @0 + .else + rcall @0 + .endif + .else + call @0 + .endif + .endmacro + + ; F_CPU + ; µsec 16000000 14745600 8000000 1000000 + ; 1 16 14,74 8 1 + ; 10 160 147,45 80 10 + ; 100 1600 1474,56 800 100 + ; 1000 16000 14745,6 8000 1000 + ; + ; cycles = µsec * f_cpu / 1e6 + ; n_loops=cycles/5 + ; + ; cycles already used will be subtracted from the delay + ; the waittime resolution is 1 cycle (delay from exact to +1 cycle) + ; the maximum delay at 20MHz (50ns/clock) is 38350ns + ; waitcount register must specify an immediate register + ; + ; busy waits a specfied amount of microseconds + .macro delay + .set cycles = ( ( @0 * F_CPU ) / 1000000 ) + .if (cycles > ( 256 * 255 * 4 + 2)) + .error "MACRO delay - too many cycles to burn" + .else + .if (cycles > 6) + .set loop_cycles = (cycles / 4) + ldi zl,low(loop_cycles) + ldi zh,high(loop_cycles) + sbiw Z, 1 + brne pc-1 + .set cycles = (cycles - (loop_cycles * 4)) + .endif + .if (cycles > 0) + .if (cycles & 4) + rjmp pc+1 + rjmp pc+1 + .endif + .if (cycles & 2) + rjmp pc+1 + .endif + .if (cycles & 1) + nop + .endif + .endif + .endif + .endmacro + + ; portability macros, they come from the msp430 branches + + .macro DEST + .dw @0 + .endm + + ; controller specific file selected via include + ; directory definition when calling the assembler (-I) + .include "device.asm" + + ; generated automatically, do not edit + + .list + + .equ ramstart = 96 + .equ CELLSIZE = 2 + .macro readflashcell + lsl zl + rol zh + lpm @0, Z+ + lpm @1, Z+ + .endmacro + .macro writeflashcell + lsl zl + rol zh + .endmacro + .set WANT_EEPROM = 0 + .set WANT_WATCHDOG = 0 + .set WANT_EXTERNAL_INTERRUPT = 0 + .set WANT_TIMER_COUNTER_0 = 0 + .set WANT_TIMER_COUNTER_2 = 0 + .set WANT_TIMER_COUNTER_1 = 0 + .set WANT_SPI = 0 + .set WANT_USART = 0 + .set WANT_ANALOG_COMPARATOR = 0 + .set WANT_AD_CONVERTER = 0 + .set WANT_PORTA = 0 + .set WANT_PORTB = 0 + .set WANT_PORTC = 0 + .set WANT_PORTD = 0 + .set WANT_CPU = 0 + .set WANT_BOOT_LOAD = 0 + .set WANT_TWI = 0 + .equ intvecsize = 2 ; please verify; flash size: 32768 bytes + .equ pclen = 2 ; please verify + .overlap + .org 2 +000002 d11b rcall isr ; External Interrupt Request 0 + .org 4 +000004 d119 rcall isr ; External Interrupt Request 1 + .org 6 +000006 d117 rcall isr ; External Interrupt Request 2 + .org 8 +000008 d115 rcall isr ; Timer/Counter2 Compare Match + .org 10 +00000a d113 rcall isr ; Timer/Counter2 Overflow + .org 12 +00000c d111 rcall isr ; Timer/Counter1 Capture Event + .org 14 +00000e d10f rcall isr ; Timer/Counter1 Compare Match A + .org 16 +000010 d10d rcall isr ; Timer/Counter1 Compare Match B + .org 18 +000012 d10b rcall isr ; Timer/Counter1 Overflow + .org 20 +000014 d109 rcall isr ; Timer/Counter0 Compare Match + .org 22 +000016 d107 rcall isr ; Timer/Counter0 Overflow + .org 24 +000018 d105 rcall isr ; Serial Transfer Complete + .org 26 +00001a d103 rcall isr ; USART, Rx Complete + .org 28 +00001c d101 rcall isr ; USART Data Register Empty + .org 30 +00001e d0ff rcall isr ; USART, Tx Complete + .org 32 +000020 d0fd rcall isr ; ADC Conversion Complete + .org 34 +000022 d0fb rcall isr ; EEPROM Ready + .org 36 +000024 d0f9 rcall isr ; Analog Comparator + .org 38 +000026 d0f7 rcall isr ; 2-wire Serial Interface + .org 40 +000028 d0f5 rcall isr ; Store Program Memory Ready + .equ INTVECTORS = 21 + .nooverlap + + ; compatability layer (maybe empty) + .equ SPMCSR = SPMCR + .equ EEPE = EEWE + .equ EEMPE = EEMWE + + ; controller data area, environment query mcu-info + mcu_info: + mcu_ramsize: +000029 0800 .dw 2048 + mcu_eepromsize: +00002a 0400 .dw 1024 + mcu_maxdp: +00002b 7000 .dw 28672 + mcu_numints: +00002c 0015 .dw 21 + mcu_name: +00002d 0008 .dw 8 +00002e 5441 +00002f 656d +000030 6167 +000031 3233 .db "ATmega32" + .set codestart=pc + + ; some defaults, change them in your application master file + ; see template.asm for an example + + ; enabling Interrupts, disabling them affects + ; other settings as well. + .set WANT_INTERRUPTS = 1 + + ; count the number of interrupts individually. + ; requires a lot of RAM (one byte per interrupt) + ; disabled by default. + .set WANT_INTERRUPT_COUNTERS = 0 + + ; receiving is asynchronously, so an interrupt queue is useful. + .set WANT_ISR_RX = 1 + + ; case insensitve dictionary lookup. + .set WANT_IGNORECASE = 0 + + ; map all memories to one address space. Details in the + ; technical guide + .set WANT_UNIFIED = 0 + + ; terminal input buffer + .set TIB_SIZE = 90 ; ANS94 needs at least 80 characters per line + + ; USER variables *in addition* to system ones + .set APPUSERSIZE = 10 ; size of application specific user area in bytes + + ; addresses of various data segments + .set rstackstart = RAMEND ; start address of return stack, grows downward + .set stackstart = RAMEND - 80 ; start address of data stack, grows downward + ; change only if you know what to you do + .set NUMWORDLISTS = 8 ; number of word lists in the searh order, at least 8 + .set NUMRECOGNIZERS = 4 ; total number of recognizers, two are always used. + + ; 10 per mille (1 per cent) is ok. + .set BAUD = 38400 + .set BAUD_MAXERROR = 10 + + ; Dictionary setup + .set VE_HEAD = $0000 + .set VE_ENVHEAD = $0000 + + .set AMFORTH_RO_SEG = NRWW_START_ADDR+1 + + ; cpu clock in hertz + .equ F_CPU = 8000000 + .set BAUD_MAXERROR = 30 + .equ TIMER_INT = OVF2addr + + .include "drivers/usart.asm" + + .equ BAUDRATE_LOW = UBRRL+$20 + .equ BAUDRATE_HIGH = UBRRH+$20 + .equ USART_C = UCSRC+$20 + .equ USART_B = UCSRB+$20 + .equ USART_A = UCSRA+$20 + .equ USART_DATA = UDR+$20 + .equ bm_USARTC_en = 1 << 7 + + ; some generic constants + .equ bm_USART_RXRD = 1 << RXC + .equ bm_USART_TXRD = 1 << UDRE + .equ bm_ENABLE_TX = 1 << TXEN + .equ bm_ENABLE_RX = 1 << RXEN + .equ bm_ENABLE_INT_RX = 1<rx-buf",0 +000037 0000 .dw VE_HEAD + .set VE_HEAD = VE_TO_RXBUF + XT_TO_RXBUF: +000038 0039 .dw PFA_rx_tobuf + PFA_rx_tobuf: +000039 2f08 mov temp0, tosl +00003a 9110 0070 lds temp1, usart_rx_in +00003c e6e0 ldi zl, low(usart_rx_data) +00003d e0f0 ldi zh, high(usart_rx_data) +00003e 0fe1 add zl, temp1 +00003f 1df3 adc zh, zeroh +000040 8300 st Z, temp0 +000041 9513 inc temp1 +000042 701f andi temp1,usart_rx_mask +000043 9310 0070 sts usart_rx_in, temp1 +000045 9189 +000046 9199 loadtos +000047 940c 3805 jmp_ DO_NEXT + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ; setup with + ; ' isr-rx URXCaddr int! + VE_ISR_RX: +000049 ff06 .dw $ff06 +00004a 7369 +00004b 2d72 +00004c 7872 .db "isr-rx" +00004d 0032 .dw VE_HEAD + .set VE_HEAD = VE_ISR_RX + XT_ISR_RX: +00004e 3801 .dw DO_COLON + usart_rx_isr: +00004f 383d .dw XT_DOLITERAL +000050 002c .dw usart_data +000051 3898 .dw XT_CFETCH +000052 38b1 .dw XT_DUP +000053 383d .dw XT_DOLITERAL +000054 0003 .dw 3 +000055 3fdf .dw XT_EQUAL +000056 3836 .dw XT_DOCONDBRANCH +000057 0059 .dw usart_rx_isr1 +000058 3d38 .dw XT_COLD + usart_rx_isr1: +000059 0038 .dw XT_TO_RXBUF +00005a 3820 .dw XT_EXIT + + ; ( -- ) Hardware Access + ; R( --) + ; initialize usart + ;VE_USART_INIT_RXBUFFER: + ; .dw $ff0x + ; .db "+usart-buffer" + ; .dw VE_HEAD + ; .set VE_HEAD = VE_USART_INIT_RXBUFFER + XT_USART_INIT_RX_BUFFER: +00005b 3801 .dw DO_COLON + PFA_USART_INIT_RX_BUFFER: ; ( -- ) +00005c 383d +00005d 004e .dw XT_DOLITERAL, XT_ISR_RX +00005e 383d +00005f 001a .dw XT_DOLITERAL, URXCaddr +000060 3ca5 .dw XT_INTSTORE + +000061 383d .dw XT_DOLITERAL +000062 0060 .dw usart_rx_data +000063 383d .dw XT_DOLITERAL +000064 0016 .dw usart_rx_size + 6 +000065 3954 .dw XT_ZERO +000066 3e98 .dw XT_FILL +000067 3820 .dw XT_EXIT + + ; ( -- c) + ; MCU + ; get 1 character from input queue, wait if needed using interrupt driver + VE_RX_BUFFER: +000068 ff06 .dw $ff06 +000069 7872 +00006a 622d +00006b 6675 .db "rx-buf" +00006c 0049 .dw VE_HEAD + .set VE_HEAD = VE_RX_BUFFER + XT_RX_BUFFER: +00006d 3801 .dw DO_COLON + PFA_RX_BUFFER: +00006e 0088 .dw XT_RXQ_BUFFER +00006f 3836 .dw XT_DOCONDBRANCH +000070 006e .dw PFA_RX_BUFFER +000071 383d .dw XT_DOLITERAL +000072 0071 .dw usart_rx_out +000073 3898 .dw XT_CFETCH +000074 38b1 .dw XT_DUP +000075 383d .dw XT_DOLITERAL +000076 0060 .dw usart_rx_data +000077 399d .dw XT_PLUS +000078 3898 .dw XT_CFETCH +000079 38c4 .dw XT_SWAP +00007a 3a2f .dw XT_1PLUS +00007b 383d .dw XT_DOLITERAL +00007c 000f .dw usart_rx_mask +00007d 3a13 .dw XT_AND +00007e 383d .dw XT_DOLITERAL +00007f 0071 .dw usart_rx_out +000080 388d .dw XT_CSTORE +000081 3820 .dw XT_EXIT + + ; ( -- f) + ; MCU + ; check if unread characters are in the input queue + VE_RXQ_BUFFER: +000082 ff07 .dw $ff07 +000083 7872 +000084 2d3f +000085 7562 +000086 0066 .db "rx?-buf",0 +000087 0068 .dw VE_HEAD + .set VE_HEAD = VE_RXQ_BUFFER + XT_RXQ_BUFFER: +000088 3801 .dw DO_COLON + PFA_RXQ_BUFFER: +000089 3d30 .dw XT_PAUSE +00008a 383d .dw XT_DOLITERAL +00008b 0071 .dw usart_rx_out +00008c 3898 .dw XT_CFETCH +00008d 383d .dw XT_DOLITERAL +00008e 0070 .dw usart_rx_in +00008f 3898 .dw XT_CFETCH +000090 3913 .dw XT_NOTEQUAL +000091 3820 .dw XT_EXIT + ; .include "drivers/timer-usart-isr.asm" + .set XT_RX = XT_RX_BUFFER + .set XT_RXQ = XT_RXQ_BUFFER + .set XT_USART_INIT_RX = XT_USART_INIT_RX_BUFFER + .else + .endif + + .include "words/usart-tx-poll.asm" + + ; MCU + ; check availability and send one character to the terminal using register poll + VE_TX_POLL: +000092 ff07 .dw $ff07 +000093 7874 +000094 702d +000095 6c6f +000096 006c .db "tx-poll",0 +000097 0082 .dw VE_HEAD + .set VE_HEAD = VE_TX_POLL + XT_TX_POLL: +000098 3801 .dw DO_COLON + PFA_TX_POLL: + ; wait for data ready +000099 00a6 .dw XT_TXQ_POLL +00009a 3836 .dw XT_DOCONDBRANCH +00009b 0099 .dw PFA_TX_POLL + ; send to usart +00009c 383d .dw XT_DOLITERAL +00009d 002c .dw USART_DATA +00009e 388d .dw XT_CSTORE +00009f 3820 .dw XT_EXIT + + ; ( -- f) MCU + ; MCU + ; check if a character can be send using register poll + VE_TXQ_POLL: +0000a0 ff08 .dw $ff08 +0000a1 7874 +0000a2 2d3f +0000a3 6f70 +0000a4 6c6c .db "tx?-poll" +0000a5 0092 .dw VE_HEAD + .set VE_HEAD = VE_TXQ_POLL + XT_TXQ_POLL: +0000a6 3801 .dw DO_COLON + PFA_TXQ_POLL: +0000a7 3d30 .dw XT_PAUSE +0000a8 383d .dw XT_DOLITERAL +0000a9 002b .dw USART_A +0000aa 3898 .dw XT_CFETCH +0000ab 383d .dw XT_DOLITERAL +0000ac 0020 .dw bm_USART_TXRD +0000ad 3a13 .dw XT_AND +0000ae 3820 .dw XT_EXIT + .set XT_TX = XT_TX_POLL + .set XT_TXQ = XT_TXQ_POLL + .set XT_USART_INIT_TX = 0 + + .include "words/ubrr.asm" + + ; MCU + ; returns usart UBRR settings + VE_UBRR: +0000af ff04 .dw $ff04 +0000b0 6275 +0000b1 7272 .db "ubrr" +0000b2 00a0 .dw VE_HEAD + .set VE_HEAD = VE_UBRR + XT_UBRR: +0000b3 386f .dw PFA_DOVALUE1 + PFA_UBRR: ; ( -- ) +0000b4 0082 .dw EE_UBRRVAL +0000b5 3da0 .dw XT_EDEFERFETCH +0000b6 3daa .dw XT_EDEFERSTORE + .include "words/usart.asm" + + ; MCU + ; initialize usart + VE_USART: +0000b7 ff06 .dw $ff06 +0000b8 752b +0000b9 6173 +0000ba 7472 .db "+usart" +0000bb 00af .dw VE_HEAD + .set VE_HEAD = VE_USART + XT_USART: +0000bc 3801 .dw DO_COLON + PFA_USART: ; ( -- ) + +0000bd 383d .dw XT_DOLITERAL +0000be 0098 .dw USART_B_VALUE +0000bf 383d .dw XT_DOLITERAL +0000c0 002a .dw USART_B +0000c1 388d .dw XT_CSTORE + +0000c2 383d .dw XT_DOLITERAL +0000c3 0006 .dw USART_C_VALUE +0000c4 383d .dw XT_DOLITERAL +0000c5 00c0 .dw USART_C | bm_USARTC_en +0000c6 388d .dw XT_CSTORE + +0000c7 00b3 .dw XT_UBRR +0000c8 38b1 .dw XT_DUP +0000c9 3af9 .dw XT_BYTESWAP +0000ca 383d .dw XT_DOLITERAL +0000cb 0040 .dw BAUDRATE_HIGH +0000cc 388d .dw XT_CSTORE +0000cd 383d .dw XT_DOLITERAL +0000ce 0029 .dw BAUDRATE_LOW +0000cf 388d .dw XT_CSTORE + .if XT_USART_INIT_RX!=0 +0000d0 005b .dw XT_USART_INIT_RX + .endif + .if XT_USART_INIT_TX!=0 + .endif + +0000d1 3820 .dw XT_EXIT + + ; settings for 1wire interface + .equ OW_PORT=PORTB + .EQU OW_BIT=4 + .include "drivers/1wire.asm" + + ; B. J. Rodriguez (MSP 430) + ; Matthias Trute (AVR Atmega) + ; COPYRIGHT + ; (c) 2012 Bradford J. Rodriguez for the 430 code and API + + ; adapted 430 assembly code to AVR + ; wishlist: + ; use a configurable pin at runtime, compatible with bitnames.frt + ; no external pull up, no external power supply for devices + ; ??? + ; + ;.EQU OW_BIT=4 + ;.equ OW_PORT=PORTE + .set OW_DDR=(OW_PORT-1) + .set OW_PIN=(OW_DDR-1) + + ;****f* 1W.RESET + ; NAME + ; 1W.RESET + ; SYNOPSIS + ; 1W.RESET ( -- f ) Initialize 1-wire devices; return true if present + ; DESCRIPTION + ; This configures the port pin used by the 1-wire interface, and then + ; sends an "initialize" sequence to the 1-wire devices. If any device + ; is present, it will be detected. + ; + ; Timing, per DS18B20 data sheet: + ; a) Output "0" (drive output low) for >480 usec. + ; b) Output "1" (let output float). + ; c) After 15 to 60 usec, device will drive pin low for 60 to 240 usec. + ; So, wait 75 usec and sample input. + ; d) Leave output high (floating) for at least 480 usec. + ;****** + ; ( -- f ) + ; Hardware + ; Initialize 1-wire devices; return true if present + VE_OW_RESET: +0000d2 ff08 .dw $ff08 +0000d3 7731 +0000d4 722e +0000d5 7365 +0000d6 7465 .db "1w.reset" +0000d7 00b7 .dw VE_HEAD + .set VE_HEAD = VE_OW_RESET + XT_OW_RESET: +0000d8 00d9 .dw PFA_OW_RESET + PFA_OW_RESET: +0000d9 939a +0000da 938a savetos + ; setup to output +0000db 9abc sbi OW_DDR, OW_BIT + ; Pull output low +0000dc 98c4 cbi OW_PORT, OW_BIT + ; Delay >480 usec +0000dd ece0 +0000de e0f3 +0000df 9731 +0000e0 f7f1 DELAY 480 + ; Critical timing period, disable interrupts. +0000e1 b71f in temp1, SREG +0000e2 94f8 cli + ; Pull output high +0000e3 9ac4 sbi OW_PORT, OW_BIT + ; make pin input, sends "1" +0000e4 98bc cbi OW_DDR, OW_BIT +0000e5 e8e0 +0000e6 e0f0 +0000e7 9731 +0000e8 f7f1 DELAY 64 ; delayB + ; Sample input pin, set TOS if input is zero +0000e9 b386 in tosl, OW_PIN +0000ea ff84 sbrs tosl, OW_BIT +0000eb ef9f ser tosh + ; End critical timing period, enable interrupts +0000ec bf1f out SREG, temp1 + ; release bus +0000ed 98bc cbi OW_DDR, OW_BIT +0000ee 98c4 cbi OW_PORT, OW_BIT + + ; Delay rest of 480 usec +0000ef e4e0 +0000f0 e0f3 +0000f1 9731 +0000f2 f7f1 DELAY 416 + ; we now have the result flag in TOS +0000f3 2f89 mov tosl, tosh +0000f4 940c 3805 jmp_ DO_NEXT + + ;****f* 1W.SLOT + ; NAME + ; 1W.SLOT + ; SYNOPSIS + ; 1W.SLOT ( c -- c' ) Write and read one bit to/from 1-wire. + ; DESCRIPTION + ; The "touch byte" function is described in Dallas App Note 74. + ; It outputs a byte to the 1-wire pin, LSB first, and reads back + ; the state of the 1-wire pin after a suitable delay. + ; To read a byte, output $FF and read the reply data. + ; To write a byte, output that byte and discard the reply. + ; + ; This function performs one bit of the "touch" operation -- + ; one read/write "slot" in Dallas jargon. Perform this eight + ; times in a row to get the "touch byte" function. + ; + ; PARAMETERS + ; The input parameter is xxxxxxxxbbbbbbbo where + ; 'xxxxxxxx' are don't cares, + ; 'bbbbbbb' are bits to be shifted down, and + ; 'o' is the bit to be output in the slot. This must be 1 + ; to create a read slot. + ; + ; The returned value is xxxxxxxxibbbbbbb where + ; 'xxxxxxxx' are not known (the input shifted down 1 position), + ; 'i' is the bit read during the slot. This has no meaning + ; if it was a write slot. + ; 'bbbbbbb' are the 7 input bits, shifted down one position. + ; + ; This peculiar parameter usage allows OWTOUCH to be written as + ; OWSLOT OWSLOT OWSLOT OWSLOT OWSLOT OWSLOT OWSLOT OWSLOT + ; + ; NOTES + ; Interrupts are disabled during each bit. + + ; Timing, per DS18B20 data sheet: + ; a) Output "0" for start period. (> 1 us, < 15 us, typ. 6 us*) + ; b) Output data bit (0 or 1), open drain + ; c) After MS from start of cycle, sample input (15 to 60 us, typ. 25 us*) + ; d) After write-0 period from start of cycle, output "1" (>60 us) + ; e) After recovery period, loop or return. (> 1 us) + ; For writes, DS18B20 samples input 15 to 60 usec from start of cycle. + ; * "Typical" values are per App Note 132 for a 300m cable length. + + ; --------- ------------------------------- + ; \ / / + ; ------------------------------- + ; a b c d e + ; | 6us | 19us | 35us | 2us | + ;****** + ; ( c -- c' ) + ; Hardware + ; Write and read one bit to/from 1-wire. + VE_OW_SLOT: +0000f6 ff07 .dw $ff07 +0000f7 7731 +0000f8 732e +0000f9 6f6c +0000fa 0074 .db "1w.slot",0 +0000fb 00d2 .dw VE_HEAD + .set VE_HEAD = VE_OW_SLOT + XT_OW_SLOT: +0000fc 00fd .dw PFA_OW_SLOT + PFA_OW_SLOT: + ; pull low +0000fd 98c4 cbi OW_PORT, OW_BIT +0000fe 9abc sbi OW_DDR, OW_BIT + ; disable interrupts +0000ff b71f in temp1, SREG +000100 94f8 cli +000101 e0ec +000102 e0f0 +000103 9731 +000104 f7f1 DELAY 6 ; DELAY A + ; check bit +000105 9488 clc +000106 9587 ror tosl +000107 f410 brcc PFA_OW_SLOT0 ; a 0 keeps the bus low + ; release bus, a 1 is written +000108 9ac4 sbi OW_PORT, OW_BIT +000109 98bc cbi OW_DDR, OW_BIT + PFA_OW_SLOT0: + ; sample the input (no action required if zero) +00010a e1e2 +00010b e0f0 +00010c 9731 +00010d f7f1 DELAY 9 ; wait DELAY E to sample +00010e b306 in temp0, OW_PIN +00010f fd04 sbrc temp0, OW_BIT +000110 6880 ori tosl, $80 + +000111 e6e6 +000112 e0f0 +000113 9731 +000114 f7f1 DELAY 51 ; DELAY B +000115 9ac4 sbi OW_PORT, OW_BIT ; release bus +000116 98bc cbi OW_DDR, OW_BIT +000117 e0e4 +000118 e0f0 +000119 9731 +00011a f7f1 delay 2 + ; re-enable interrupts +00011b bf1f out SREG, temp1 +00011c 940c 3805 jmp_ DO_NEXT + + .include "amforth.asm" + + ;;;; + ;;;; GPL V2 (only) + + .set AMFORTH_NRWW_SIZE=(FLASHEND-AMFORTH_RO_SEG)*2 + + .set corepc = pc + .org $0000 +000000 940c 3d39 jmp_ PFA_COLD + + .org corepc + .include "drivers/generic-isr.asm" + + .eseg +000000 intvec: .byte INTVECTORS * CELLSIZE + .dseg +000072 intcnt: .byte INTVECTORS + .cseg + + ; interrupt routine gets called (again) by rcall! This gives the + ; address of the int-vector on the stack. + isr: +00011e 920a st -Y, r0 +00011f b60f in r0, SREG +000120 920a st -Y, r0 + .if (pclen==3) + .endif +000121 900f pop r0 +000122 900f pop r0 ; = intnum * intvectorsize + 1 (address following the rcall) +000123 940a dec r0 + .if intvecsize == 1 ; + .endif +000124 2cb0 mov isrflag, r0 +000125 93ff push zh +000126 93ef push zl +000127 e7e2 ldi zl, low(intcnt) +000128 e0f0 ldi zh, high(intcnt) +000129 9406 lsr r0 ; we use byte addresses in the counter array, not words +00012a 0de0 add zl, r0 +00012b 1df3 adc zh, zeroh +00012c 8000 ld r0, Z +00012d 9403 inc r0 +00012e 8200 st Z, r0 +00012f 91ef pop zl +000130 91ff pop zh + +000131 9009 ld r0, Y+ +000132 be0f out SREG, r0 +000133 9009 ld r0, Y+ +000134 9508 ret ; returns the interrupt, the rcall stack frame is removed! + ; no reti here, see words/isr-end.asm + ; lower part of the dictionary + .include "dict/rww.inc" + + + ; Arithmetics + ; add a number to a double cell + VE_MPLUS: +000135 ff02 .dw $ff02 +000136 2b6d .db "m+" +000137 00f6 .dw VE_HEAD + .set VE_HEAD = VE_MPLUS + XT_MPLUS: +000138 3801 .dw DO_COLON + PFA_MPLUS: +000139 3fc7 .dw XT_S2D +00013a 3c15 .dw XT_DPLUS +00013b 3820 .dw XT_EXIT + .include "words/ud-star.asm" + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_UDSTAR: +00013c ff03 .dw $ff03 +00013d 6475 +../../common\words/ud-star.asm(9): warning: .cseg .db misalignment - padding zero byte +00013e 002a .db "ud*" +00013f 0135 .dw VE_HEAD + .set VE_HEAD = VE_UDSTAR + XT_UDSTAR: +000140 3801 .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 + ; + +000141 38b1 +000142 38ff +000143 39e0 +000144 38d9 .DW XT_DUP,XT_TO_R,XT_UMSTAR,XT_DROP +000145 38c4 +000146 38f6 +000147 39e0 +000148 38e1 +000149 399d +00014a 3820 .DW XT_SWAP,XT_R_FROM,XT_UMSTAR,XT_ROT,XT_PLUS,XT_EXIT + .include "words/umax.asm" + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_UMAX: +00014b ff04 .dw $ff04 +00014c 6d75 +00014d 7861 .db "umax" +00014e 013c .dw VE_HEAD + .set VE_HEAD = VE_UMAX + XT_UMAX: +00014f 3801 .dw DO_COLON + PFA_UMAX: + .endif + +000150 3ec9 +000151 395c .DW XT_2DUP,XT_ULESS +000152 3836 .dw XT_DOCONDBRANCH +000153 0155 DEST(UMAX1) +000154 38c4 .DW XT_SWAP +000155 38d9 UMAX1: .DW XT_DROP +000156 3820 .dw XT_EXIT + .include "words/umin.asm" + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_UMIN: +000157 ff04 .dw $ff04 +000158 6d75 +000159 6e69 .db "umin" +00015a 014b .dw VE_HEAD + .set VE_HEAD = VE_UMIN + XT_UMIN: +00015b 3801 .dw DO_COLON + PFA_UMIN: + .endif +00015c 3ec9 +00015d 3967 .DW XT_2DUP,XT_UGREATER +00015e 3836 .dw XT_DOCONDBRANCH +00015f 0161 DEST(UMIN1) +000160 38c4 .DW XT_SWAP +000161 38d9 UMIN1: .DW XT_DROP +000162 3820 .dw XT_EXIT + .include "words/immediate-q.asm" + + ; Tools + ; return +1 if immediate, -1 otherwise, flag from name>flags + ;VE_IMMEDIATEQ: + ; .dw $ff06 + ; .db "immediate?" + ; .dw VE_HEAD + ; .set VE_HEAD = VE_IMMEDIATEQ + XT_IMMEDIATEQ: +000163 3801 .dw DO_COLON + PFA_IMMEDIATEQ: +000164 383d .dw XT_DOLITERAL +000165 8000 .dw $8000 +000166 3a13 .dw XT_AND +000167 391a .dw XT_ZEROEQUAL +000168 3836 .dw XT_DOCONDBRANCH +000169 016c DEST(IMMEDIATEQ1) +00016a 3fe6 .dw XT_ONE +00016b 3820 .dw XT_EXIT + IMMEDIATEQ1: + ; not immediate +00016c 394b .dw XT_TRUE +00016d 3820 .dw XT_EXIT + .include "words/name2flags.asm" + + ; Tools + ; get the flags from a name token + VE_NAME2FLAGS: +00016e ff0a .dw $ff0a +00016f 616e +000170 656d +000171 663e +000172 616c +000173 7367 .db "name>flags" +000174 0157 .dw VE_HEAD + .set VE_HEAD = VE_NAME2FLAGS + XT_NAME2FLAGS: +000175 3801 .dw DO_COLON + PFA_NAME2FLAGS: +000176 3bcb .dw XT_FETCHI ; skip to link field +000177 383d .dw XT_DOLITERAL +000178 ff00 .dw $ff00 +000179 3a13 .dw XT_AND +00017a 3820 .dw XT_EXIT + + .if AMFORTH_NRWW_SIZE > 8000 + .elif AMFORTH_NRWW_SIZE > 4000 + .include "dict/appl_4k.inc" + + + ; Tools + ; print the version string + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_DOT_VER: +00017b ff03 .dw $ff03 +00017c 6576 +../../common\words/ver.asm(12): warning: .cseg .db misalignment - padding zero byte +00017d 0072 .db "ver" +00017e 016e .dw VE_HEAD + .set VE_HEAD = VE_DOT_VER + XT_DOT_VER: +00017f 3801 .dw DO_COLON + PFA_DOT_VER: + .endif +000180 02cf .dw XT_ENV_FORTHNAME +000181 03f8 .dw XT_ITYPE +000182 3fae .dw XT_SPACE +000183 3ebd .dw XT_BASE +000184 3879 .dw XT_FETCH + +000185 02dd .dw XT_ENV_FORTHVERSION +000186 3f41 .dw XT_DECIMAL +000187 3fc7 .dw XT_S2D +000188 0316 .dw XT_L_SHARP +000189 031e .dw XT_SHARP +00018a 383d .dw XT_DOLITERAL +00018b 002e .dw '.' +00018c 0307 .dw XT_HOLD +00018d 0334 .dw XT_SHARP_S +00018e 033f .dw XT_SHARP_G +00018f 042e .dw XT_TYPE +000190 3ebd .dw XT_BASE +000191 3881 .dw XT_STORE +000192 3fae .dw XT_SPACE +000193 02e5 .dw XT_ENV_CPU +000194 03f8 .dw XT_ITYPE + +000195 3820 .dw XT_EXIT + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + .include "words/noop.asm" + + ; Tools + ; do nothing + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_NOOP: +000196 ff04 .dw $ff04 +000197 6f6e +000198 706f .db "noop" +000199 017b .dw VE_HEAD + .set VE_HEAD = VE_NOOP + XT_NOOP: +00019a 3801 .dw DO_COLON + PFA_NOOP: + .endif +00019b 3820 .DW XT_EXIT + .include "words/unused.asm" + + ; Tools + ; Amount of available RAM (incl. PAD) + VE_UNUSED: +00019c ff06 .dw $ff06 +00019d 6e75 +00019e 7375 +00019f 6465 .db "unused" +0001a0 0196 .dw VE_HEAD + .set VE_HEAD = VE_UNUSED + XT_UNUSED: +0001a1 3801 .dw DO_COLON + PFA_UNUSED: +0001a2 3a8d .dw XT_SP_FETCH +0001a3 3f23 .dw XT_HERE +0001a4 3993 .dw XT_MINUS +0001a5 3820 .dw XT_EXIT + .include "words/to.asm" + + ; Tools + ; store the TOS to the named value (eeprom cell) + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_TO: +0001a6 0002 .dw $0002 +0001a7 6f74 .db "to" +0001a8 019c .dw VE_HEAD + .set VE_HEAD = VE_TO + XT_TO: +0001a9 3801 .dw DO_COLON + PFA_TO: + .endif +0001aa 043d .dw XT_TICK +0001ab 3fd0 .dw XT_TO_BODY +0001ac 3eb7 .dw XT_STATE +0001ad 3879 .dw XT_FETCH +0001ae 3836 .dw XT_DOCONDBRANCH +0001af 01ba DEST(PFA_TO1) +0001b0 0751 .dw XT_COMPILE +0001b1 01b4 .dw XT_DOTO +0001b2 075c .dw XT_COMMA +0001b3 3820 .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 + .endif + + .if cpu_avr8==1 + + XT_DOTO: +0001b4 3801 .dw DO_COLON + PFA_DOTO: + .endif +0001b5 38f6 .dw XT_R_FROM +0001b6 38b1 .dw XT_DUP +0001b7 01c6 .dw XT_ICELLPLUS +0001b8 38ff .dw XT_TO_R +0001b9 3bcb .dw XT_FETCHI + PFA_TO1: +0001ba 38b1 .dw XT_DUP +0001bb 01c6 .dw XT_ICELLPLUS +0001bc 01c6 .dw XT_ICELLPLUS +0001bd 3bcb .dw XT_FETCHI +0001be 382a .dw XT_EXECUTE +0001bf 3820 .dw XT_EXIT + .include "words/i-cellplus.asm" + + ; Compiler + ; skip to the next cell in flash + VE_ICELLPLUS: +0001c0 ff07 .dw $FF07 +0001c1 2d69 +0001c2 6563 +0001c3 6c6c +0001c4 002b .db "i-cell+",0 +0001c5 01a6 .dw VE_HEAD + .set VE_HEAD = VE_ICELLPLUS + XT_ICELLPLUS: +0001c6 3801 .dw DO_COLON + PFA_ICELLPLUS: +0001c7 3a2f .dw XT_1PLUS +0001c8 3820 .dw XT_EXIT + .include "words/icompare.asm" + + ; Tools + ; compares string in RAM with string in flash. f is zero if equal like COMPARE + VE_ICOMPARE: +0001c9 ff08 .dw $ff08 +0001ca 6369 +0001cb 6d6f +0001cc 6170 +0001cd 6572 .db "icompare" +0001ce 01c0 .dw VE_HEAD + .set VE_HEAD = VE_ICOMPARE + XT_ICOMPARE: +0001cf 3801 .dw DO_COLON + PFA_ICOMPARE: +0001d0 38ff .dw XT_TO_R ; ( -- r-addr r-len f-addr) +0001d1 38cf .dw XT_OVER ; ( -- r-addr r-len f-addr r-len) +0001d2 38f6 .dw XT_R_FROM ; ( -- r-addr r-len f-addr r-len f-len ) +0001d3 3913 .dw XT_NOTEQUAL ; ( -- r-addr r-len f-addr flag ) +0001d4 3836 .dw XT_DOCONDBRANCH +0001d5 01da .dw PFA_ICOMPARE_SAMELEN +0001d6 3ed2 .dw XT_2DROP +0001d7 38d9 .dw XT_DROP +0001d8 394b .dw XT_TRUE +0001d9 3820 .dw XT_EXIT + PFA_ICOMPARE_SAMELEN: +0001da 38c4 .dw XT_SWAP ; ( -- r-addr f-addr len ) +0001db 3954 .dw XT_ZERO +0001dc 081b .dw XT_QDOCHECK +0001dd 3836 .dw XT_DOCONDBRANCH +0001de 01fd .dw PFA_ICOMPARE_DONE +0001df 3a9b .dw XT_DODO + PFA_ICOMPARE_LOOP: + ; ( r-addr f-addr --) +0001e0 38cf .dw XT_OVER +0001e1 3879 .dw XT_FETCH + .if WANT_IGNORECASE == 1 + .endif +0001e2 38cf .dw XT_OVER +0001e3 3bcb .dw XT_FETCHI ; ( -- r-addr f-addr r-cc f- cc) + .if WANT_IGNORECASE == 1 + .endif + ; flash strings are zero-padded at the last cell + ; that means: if the flash cell is less $0100, than mask the + ; high byte in the ram cell +0001e4 38b1 .dw XT_DUP + ;.dw XT_BYTESWAP +0001e5 383d .dw XT_DOLITERAL +0001e6 0100 .dw $100 +0001e7 395c .dw XT_ULESS +0001e8 3836 .dw XT_DOCONDBRANCH +0001e9 01ee .dw PFA_ICOMPARE_LASTCELL +0001ea 38c4 .dw XT_SWAP +0001eb 383d .dw XT_DOLITERAL +0001ec 00ff .dw $00FF +0001ed 3a13 .dw XT_AND ; the final swap can be omitted + PFA_ICOMPARE_LASTCELL: +0001ee 3913 .dw XT_NOTEQUAL +0001ef 3836 .dw XT_DOCONDBRANCH +0001f0 01f5 .dw PFA_ICOMPARE_NEXTLOOP +0001f1 3ed2 .dw XT_2DROP +0001f2 394b .dw XT_TRUE +0001f3 3ad4 .dw XT_UNLOOP +0001f4 3820 .dw XT_EXIT + PFA_ICOMPARE_NEXTLOOP: +0001f5 3a2f .dw XT_1PLUS +0001f6 38c4 .dw XT_SWAP +0001f7 3c90 .dw XT_CELLPLUS +0001f8 38c4 .dw XT_SWAP +0001f9 383d .dw XT_DOLITERAL +0001fa 0002 .dw 2 +0001fb 3aba .dw XT_DOPLUSLOOP +0001fc 01e0 .dw PFA_ICOMPARE_LOOP + PFA_ICOMPARE_DONE: +0001fd 3ed2 .dw XT_2DROP +0001fe 3954 .dw XT_ZERO +0001ff 3820 .dw XT_EXIT + + .if WANT_IGNORECASE == 1 + .endif + .include "words/star.asm" + + ; Arithmetics + ; multiply routine + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_STAR: +000200 ff01 .dw $ff01 +000201 002a .db "*",0 +000202 01c9 .dw VE_HEAD + .set VE_HEAD = VE_STAR + XT_STAR: +000203 3801 .dw DO_COLON + PFA_STAR: + .endif + +000204 39a6 .dw XT_MSTAR +000205 38d9 .dw XT_DROP +000206 3820 .dw XT_EXIT + .include "words/j.asm" + + ; Compiler + ; loop counter of outer loop + VE_J: +000207 ff01 .dw $FF01 +000208 006a .db "j",0 +000209 0200 .dw VE_HEAD + .set VE_HEAD = VE_J + XT_J: +00020a 3801 .dw DO_COLON + PFA_J: +00020b 3a76 .dw XT_RP_FETCH +00020c 383d .dw XT_DOLITERAL +00020d 0007 .dw 7 +00020e 399d .dw XT_PLUS +00020f 3879 .dw XT_FETCH +000210 3a76 .dw XT_RP_FETCH +000211 383d .dw XT_DOLITERAL +000212 0009 .dw 9 +000213 399d .dw XT_PLUS +000214 3879 .dw XT_FETCH +000215 399d .dw XT_PLUS +000216 3820 .dw XT_EXIT + .include "words/dabs.asm" + + ; Arithmetics + ; double cell absolute value + VE_DABS: +000217 ff04 .dw $ff04 +000218 6164 +000219 7362 .db "dabs" +00021a 0207 .dw VE_HEAD + .set VE_HEAD = VE_DABS + XT_DABS: +00021b 3801 .dw DO_COLON + PFA_DABS: +00021c 38b1 .dw XT_DUP +00021d 3921 .dw XT_ZEROLESS +00021e 3836 .dw XT_DOCONDBRANCH +00021f 0221 .dw PFA_DABS1 +000220 0228 .dw XT_DNEGATE + PFA_DABS1: +000221 3820 .dw XT_EXIT + ; : dabs ( ud1 -- +d2 ) dup 0< if dnegate then ; + .include "words/dnegate.asm" + + ; Arithmetics + ; double cell negation + VE_DNEGATE: +000222 ff07 .dw $ff07 +000223 6e64 +000224 6765 +000225 7461 +000226 0065 .db "dnegate",0 +000227 0217 .dw VE_HEAD + .set VE_HEAD = VE_DNEGATE + XT_DNEGATE: +000228 3801 .dw DO_COLON + PFA_DNEGATE: +000229 3c3b .dw XT_DINVERT +00022a 3fe6 .dw XT_ONE +00022b 3954 .dw XT_ZERO +00022c 3c15 .dw XT_DPLUS +00022d 3820 .dw XT_EXIT + ; : dnegate ( ud1 -- ud2 ) dinvert 1. d+ ; + .include "words/cmove.asm" + + ; Memory + ; copy data in RAM, from lower to higher addresses + VE_CMOVE: +00022e ff05 .dw $ff05 +00022f 6d63 +000230 766f +000231 0065 .db "cmove",0 +000232 0222 .dw VE_HEAD + .set VE_HEAD = VE_CMOVE + XT_CMOVE: +000233 0234 .dw PFA_CMOVE + PFA_CMOVE: +000234 93bf push xh +000235 93af push xl +000236 91e9 ld zl, Y+ +000237 91f9 ld zh, Y+ ; addr-to +000238 91a9 ld xl, Y+ +000239 91b9 ld xh, Y+ ; addr-from +00023a 2f09 mov temp0, tosh +00023b 2b08 or temp0, tosl +00023c f021 brbs 1, PFA_CMOVE1 + PFA_CMOVE2: +00023d 911d ld temp1, X+ +00023e 9311 st Z+, temp1 +00023f 9701 sbiw tosl, 1 +000240 f7e1 brbc 1, PFA_CMOVE2 + PFA_CMOVE1: +000241 91af pop xl +000242 91bf pop xh +000243 9189 +000244 9199 loadtos +000245 940c 3805 jmp_ DO_NEXT + .include "words/2swap.asm" + + ; Stack + ; Exchange the two top cell pairs + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_2SWAP: +000247 ff05 .dw $ff05 +000248 7332 +000249 6177 +00024a 0070 .db "2swap",0 +00024b 022e .dw VE_HEAD + .set VE_HEAD = VE_2SWAP + XT_2SWAP: +00024c 3801 .dw DO_COLON + PFA_2SWAP: + + .endif +00024d 38e1 .dw XT_ROT +00024e 38ff .dw XT_TO_R +00024f 38e1 .dw XT_ROT +000250 38f6 .dw XT_R_FROM +000251 3820 .dw XT_EXIT + .include "words/tib.asm" + + ; System + ; refills the input buffer + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_REFILLTIB: +000252 ff0a .dw $ff0a +000253 6572 +000254 6966 +000255 6c6c +000256 742d +000257 6269 .db "refill-tib" +000258 0247 .dw VE_HEAD + .set VE_HEAD = VE_REFILLTIB + XT_REFILLTIB: +000259 3801 .dw DO_COLON + PFA_REFILLTIB: + .endif +00025a 0275 .dw XT_TIB +00025b 383d .dw XT_DOLITERAL +00025c 005a .dw TIB_SIZE +00025d 048d .dw XT_ACCEPT +00025e 027b .dw XT_NUMBERTIB +00025f 3881 .dw XT_STORE +000260 3954 .dw XT_ZERO +000261 3ee2 .dw XT_TO_IN +000262 3881 .dw XT_STORE +000263 394b .dw XT_TRUE ; -1 +000264 3820 .dw XT_EXIT + + ; ( -- addr n ) + ; System + ; address and current length of the input buffer + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_SOURCETIB: +000265 ff0a .dw $FF0A +000266 6f73 +000267 7275 +000268 6563 +000269 742d +00026a 6269 .db "source-tib" +00026b 0252 .dw VE_HEAD + .set VE_HEAD = VE_SOURCETIB + XT_SOURCETIB: +00026c 3801 .dw DO_COLON + PFA_SOURCETIB: + .endif +00026d 0275 .dw XT_TIB +00026e 027b .dw XT_NUMBERTIB +00026f 3879 .dw XT_FETCH +000270 3820 .dw XT_EXIT + + ; ( -- addr ) + ; System Variable + ; terminal input buffer address + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_TIB: +000271 ff03 .dw $ff03 +000272 6974 +000273 0062 .db "tib",0 +000274 0265 .dw VE_HEAD + .set VE_HEAD = VE_TIB + XT_TIB: +000275 3848 .dw PFA_DOVARIABLE + PFA_TIB: +000276 0087 .dw ram_tib + .dseg +000087 ram_tib: .byte TIB_SIZE + .cseg + .endif + + ; ( -- addr ) + ; System Variable + ; variable holding the number of characters in TIB + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_NUMBERTIB: +000277 ff04 .dw $ff04 +000278 7423 +000279 6269 .db "#tib" +00027a 0271 .dw VE_HEAD + .set VE_HEAD = VE_NUMBERTIB + XT_NUMBERTIB: +00027b 3848 .dw PFA_DOVARIABLE + PFA_NUMBERTIB: +00027c 00e1 .dw ram_sharptib + .dseg +0000e1 ram_sharptib: .byte 2 + .cseg + .endif + .include "words/init-ram.asm" + + ; Tools + ; copy len cells from eeprom to ram + VE_EE2RAM: +00027d ff06 .dw $ff06 +00027e 6565 +00027f 723e +000280 6d61 .db "ee>ram" +000281 0277 .dw VE_HEAD + .set VE_HEAD = VE_EE2RAM + XT_EE2RAM: +000282 3801 .dw DO_COLON + PFA_EE2RAM: ; ( -- ) +000283 3954 .dw XT_ZERO +000284 3a9b .dw XT_DODO + PFA_EE2RAM_1: + ; ( -- e-addr r-addr ) +000285 38cf .dw XT_OVER +000286 3b5f .dw XT_FETCHE +000287 38cf .dw XT_OVER +000288 3881 .dw XT_STORE +000289 3c90 .dw XT_CELLPLUS +00028a 38c4 .dw XT_SWAP +00028b 3c90 .dw XT_CELLPLUS +00028c 38c4 .dw XT_SWAP +00028d 3ac9 .dw XT_DOLOOP +00028e 0285 .dw PFA_EE2RAM_1 + PFA_EE2RAM_2: +00028f 3ed2 .dw XT_2DROP +000290 3820 .dw XT_EXIT + + ; ( -- ) + ; Tools + ; setup the default user area from eeprom + VE_INIT_RAM: +000291 ff08 .dw $ff08 +000292 6e69 +000293 7469 +000294 722d +000295 6d61 .db "init-ram" +000296 027d .dw VE_HEAD + .set VE_HEAD = VE_INIT_RAM + XT_INIT_RAM: +000297 3801 .dw DO_COLON + PFA_INI_RAM: ; ( -- ) +000298 383d .dw XT_DOLITERAL +000299 0060 .dw EE_INITUSER +00029a 3b02 .dw XT_UP_FETCH +00029b 383d .dw XT_DOLITERAL +00029c 0022 .dw SYSUSERSIZE +00029d 3a04 .dw XT_2SLASH +00029e 0282 .dw XT_EE2RAM +00029f 3820 .dw XT_EXIT + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + + .include "words/environment.asm" + + ; System Value + ; word list identifier of the environmental search list + VE_ENVIRONMENT: +0002a0 ff0b .dw $ff0b +0002a1 6e65 +0002a2 6976 +0002a3 6f72 +0002a4 6d6e +0002a5 6e65 +0002a6 0074 .db "environment",0 +0002a7 0291 .dw VE_HEAD + .set VE_HEAD = VE_ENVIRONMENT + XT_ENVIRONMENT: +0002a8 3848 .dw PFA_DOVARIABLE + PFA_ENVIRONMENT: +0002a9 003a .dw CFG_ENVIRONMENT + .include "words/env-wordlists.asm" + + ; Environment + ; maximum number of wordlists in the dictionary search order + VE_ENVWORDLISTS: +0002aa ff09 .dw $ff09 +0002ab 6f77 +0002ac 6472 +0002ad 696c +0002ae 7473 +0002af 0073 .db "wordlists",0 +0002b0 0000 .dw VE_ENVHEAD + .set VE_ENVHEAD = VE_ENVWORDLISTS + XT_ENVWORDLISTS: +0002b1 3801 .dw DO_COLON + PFA_ENVWORDLISTS: +0002b2 383d .dw XT_DOLITERAL +0002b3 0008 .dw NUMWORDLISTS +0002b4 3820 .dw XT_EXIT + .include "words/env-slashpad.asm" + + ; Environment + ; Size of the PAD buffer in bytes + VE_ENVSLASHPAD: +0002b5 ff04 .dw $ff04 +0002b6 702f +0002b7 6461 .db "/pad" +0002b8 02aa .dw VE_ENVHEAD + .set VE_ENVHEAD = VE_ENVSLASHPAD + XT_ENVSLASHPAD: +0002b9 3801 .dw DO_COLON + PFA_ENVSLASHPAD: +0002ba 3a8d .dw XT_SP_FETCH +0002bb 3ee8 .dw XT_PAD +0002bc 3993 .dw XT_MINUS +0002bd 3820 .dw XT_EXIT + .include "words/env-slashhold.asm" + + ; Environment + ; size of the pictured numeric output buffer in bytes + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_ENVSLASHHOLD: +0002be ff05 .dw $ff05 +0002bf 682f +0002c0 6c6f +0002c1 0064 .db "/hold",0 +0002c2 02b5 .dw VE_ENVHEAD + .set VE_ENVHEAD = VE_ENVSLASHHOLD + XT_ENVSLASHHOLD: +0002c3 3801 .dw DO_COLON + PFA_ENVSLASHHOLD: + .endif +0002c4 3ee8 .dw XT_PAD +0002c5 3f23 .dw XT_HERE +0002c6 3993 .dw XT_MINUS +0002c7 3820 .dw XT_EXIT + .include "words/env-forthname.asm" + + ; Environment + ; flash address of the amforth name string + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_ENV_FORTHNAME: +0002c8 ff0a .dw $ff0a +0002c9 6f66 +0002ca 7472 +0002cb 2d68 +0002cc 616e +0002cd 656d .db "forth-name" +0002ce 02be .dw VE_ENVHEAD + .set VE_ENVHEAD = VE_ENV_FORTHNAME + XT_ENV_FORTHNAME: +0002cf 3801 .dw DO_COLON + PFA_EN_FORTHNAME: +0002d0 03c5 .dw XT_DOSLITERAL +0002d1 0007 .dw 7 + .endif +0002d2 6d61 +0002d3 6f66 +0002d4 7472 +../../common\words/env-forthname.asm(22): warning: .cseg .db misalignment - padding zero byte +0002d5 0068 .db "amforth" + .if cpu_msp430==1 + .endif +0002d6 3820 .dw XT_EXIT + .include "words/env-forthversion.asm" + + ; Environment + ; version number of amforth + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_ENV_FORTHVERSION: +0002d7 ff07 .dw $ff07 +0002d8 6576 +0002d9 7372 +0002da 6f69 +0002db 006e .db "version",0 +0002dc 02c8 .dw VE_ENVHEAD + .set VE_ENVHEAD = VE_ENV_FORTHVERSION + XT_ENV_FORTHVERSION: +0002dd 3801 .dw DO_COLON + PFA_EN_FORTHVERSION: + .endif +0002de 383d .dw XT_DOLITERAL +0002df 0041 .dw 65 +0002e0 3820 .dw XT_EXIT + .include "words/env-cpu.asm" + + ; Environment + ; flash address of the CPU identification string + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_ENV_CPU: +0002e1 ff03 .dw $ff03 +0002e2 7063 +0002e3 0075 .db "cpu",0 +0002e4 02d7 .dw VE_ENVHEAD + .set VE_ENVHEAD = VE_ENV_CPU + XT_ENV_CPU: +0002e5 3801 .dw DO_COLON + PFA_EN_CPU: + .endif +0002e6 383d .dw XT_DOLITERAL +0002e7 002d .dw mcu_name +0002e8 0424 .dw XT_ICOUNT +0002e9 3820 .dw XT_EXIT + .include "words/env-mcuinfo.asm" + + ; Environment + ; flash address of some CPU specific parameters + VE_ENV_MCUINFO: +0002ea ff08 .dw $ff08 +0002eb 636d +0002ec 2d75 +0002ed 6e69 +0002ee 6f66 .db "mcu-info" +0002ef 02e1 .dw VE_ENVHEAD + .set VE_ENVHEAD = VE_ENV_MCUINFO + XT_ENV_MCUINFO: +0002f0 3801 .dw DO_COLON + PFA_EN_MCUINFO: +0002f1 383d .dw XT_DOLITERAL +0002f2 0029 .dw mcu_info +0002f3 3820 .dw XT_EXIT + .include "words/env-usersize.asm" + + ; Environment + ; size of the USER area in bytes + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + + VE_ENVUSERSIZE: +0002f4 ff05 .dw $ff05 +0002f5 752f +0002f6 6573 +0002f7 0072 .db "/user",0 +0002f8 02ea .dw VE_ENVHEAD + .set VE_ENVHEAD = VE_ENVUSERSIZE + XT_ENVUSERSIZE: +0002f9 3801 .dw DO_COLON + PFA_ENVUSERSIZE: + .endif +0002fa 383d .dw XT_DOLITERAL +0002fb 002c .dw SYSUSERSIZE + APPUSERSIZE +0002fc 3820 .dw XT_EXIT + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + .include "words/hld.asm" + + ; Numeric IO + ; pointer to current write position in the Pictured Numeric Output buffer + VE_HLD: +0002fd ff03 .dw $ff03 +0002fe 6c68 +0002ff 0064 .db "hld",0 +000300 02a0 .dw VE_HEAD + .set VE_HEAD = VE_HLD + XT_HLD: +000301 3848 .dw PFA_DOVARIABLE + PFA_HLD: +000302 00e3 .dw ram_hld + + .dseg +0000e3 ram_hld: .byte 2 + .cseg + .include "words/hold.asm" + + ; Numeric IO + ; prepend character to pictured numeric output buffer + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_HOLD: +000303 ff04 .dw $ff04 +000304 6f68 +000305 646c .db "hold" +000306 02fd .dw VE_HEAD + .set VE_HEAD = VE_HOLD + XT_HOLD: +000307 3801 .dw DO_COLON + PFA_HOLD: + .endif +000308 0301 .dw XT_HLD +000309 38b1 .dw XT_DUP +00030a 3879 .dw XT_FETCH +00030b 3a35 .dw XT_1MINUS +00030c 38b1 .dw XT_DUP +00030d 38ff .dw XT_TO_R +00030e 38c4 .dw XT_SWAP +00030f 3881 .dw XT_STORE +000310 38f6 .dw XT_R_FROM +000311 388d .dw XT_CSTORE +000312 3820 .dw XT_EXIT + .include "words/less-sharp.asm" ; <# + + ; Numeric IO + ; initialize the pictured numeric output conversion process + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_L_SHARP: +000313 ff02 .dw $ff02 +000314 233c .db "<#" +000315 0303 .dw VE_HEAD + .set VE_HEAD = VE_L_SHARP + XT_L_SHARP: +000316 3801 .dw DO_COLON + PFA_L_SHARP: + .endif +000317 3ee8 .dw XT_PAD +000318 0301 .dw XT_HLD +000319 3881 .dw XT_STORE +00031a 3820 .dw XT_EXIT + .include "words/sharp.asm" + + ; Numeric IO + ; pictured numeric output: convert one digit + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + + + VE_SHARP: +00031b ff01 .dw $ff01 +00031c 0023 .db "#",0 +00031d 0313 .dw VE_HEAD + .set VE_HEAD = VE_SHARP + XT_SHARP: +00031e 3801 .dw DO_COLON + PFA_SHARP: + .endif +00031f 3ebd .dw XT_BASE +000320 3879 .dw XT_FETCH +000321 039b .dw XT_UDSLASHMOD +000322 38e1 .dw XT_ROT +000323 383d .dw XT_DOLITERAL +000324 0009 .dw 9 +000325 38cf .dw XT_OVER +000326 396e .dw XT_LESS +000327 3836 .dw XT_DOCONDBRANCH +000328 032c DEST(PFA_SHARP1) +000329 383d .dw XT_DOLITERAL +00032a 0007 .dw 7 +00032b 399d .dw XT_PLUS + PFA_SHARP1: +00032c 383d .dw XT_DOLITERAL +00032d 0030 .dw 48 ; ASCII 0 +00032e 399d .dw XT_PLUS +00032f 0307 .dw XT_HOLD +000330 3820 .dw XT_EXIT + ; : # ( ud1 -- ud2 ) + ; base @ ud/mod rot 9 over < if 7 + then 30 + hold ; + .include "words/sharp-s.asm" + + ; Numeric IO + ; pictured numeric output: convert all digits until 0 (zero) is reached + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_SHARP_S: +000331 ff02 .dw $ff02 +000332 7323 .db "#s" +000333 031b .dw VE_HEAD + .set VE_HEAD = VE_SHARP_S + XT_SHARP_S: +000334 3801 .dw DO_COLON + PFA_SHARP_S: + .endif + NUMS1: +000335 031e .dw XT_SHARP +000336 3ec9 .dw XT_2DUP +000337 3a1c .dw XT_OR +000338 391a .dw XT_ZEROEQUAL +000339 3836 .dw XT_DOCONDBRANCH +00033a 0335 DEST(NUMS1) ; PFA_SHARP_S +00033b 3820 .dw XT_EXIT + .include "words/sharp-greater.asm" ; #> + + ; Numeric IO + ; Pictured Numeric Output: convert PNO buffer into an string + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_SHARP_G: +00033c ff02 .dw $ff02 +00033d 3e23 .db "#>" +00033e 0331 .dw VE_HEAD + .set VE_HEAD = VE_SHARP_G + XT_SHARP_G: +00033f 3801 .dw DO_COLON + PFA_SHARP_G: + .endif +000340 3ed2 .dw XT_2DROP +000341 0301 .dw XT_HLD +000342 3879 .dw XT_FETCH +000343 3ee8 .dw XT_PAD +000344 38cf .dw XT_OVER +000345 3993 .dw XT_MINUS +000346 3820 .dw XT_EXIT + .include "words/sign.asm" + + ; Numeric IO + ; place a - in HLD if n is negative + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_SIGN: +000347 ff04 .dw $ff04 +000348 6973 +000349 6e67 .db "sign" +00034a 033c .dw VE_HEAD + .set VE_HEAD = VE_SIGN + XT_SIGN: +00034b 3801 .dw DO_COLON + PFA_SIGN: + .endif +00034c 3921 .dw XT_ZEROLESS +00034d 3836 .dw XT_DOCONDBRANCH +00034e 0352 DEST(PFA_SIGN1) +00034f 383d .dw XT_DOLITERAL +000350 002d .dw 45 ; ascii - +000351 0307 .dw XT_HOLD + PFA_SIGN1: +000352 3820 .dw XT_EXIT + .include "words/d-dot-r.asm" + + ; Numeric IO + ; singed PNO with double cell numbers, right aligned in width w + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_DDOTR: +000353 ff03 .dw $ff03 +000354 2e64 +000355 0072 .db "d.r",0 +000356 0347 .dw VE_HEAD + .set VE_HEAD = VE_DDOTR + XT_DDOTR: +000357 3801 .dw DO_COLON + PFA_DDOTR: + + .endif +000358 38ff .dw XT_TO_R +000359 3eda .dw XT_TUCK +00035a 021b .dw XT_DABS +00035b 0316 .dw XT_L_SHARP +00035c 0334 .dw XT_SHARP_S +00035d 38e1 .dw XT_ROT +00035e 034b .dw XT_SIGN +00035f 033f .dw XT_SHARP_G +000360 38f6 .dw XT_R_FROM +000361 38cf .dw XT_OVER +000362 3993 .dw XT_MINUS +000363 3fb7 .dw XT_SPACES +000364 042e .dw XT_TYPE +000365 3820 .dw XT_EXIT + ; : d.r ( d n -- ) + ; >r swap over dabs <# #s rot sign #> r> over - spaces type ; + .include "words/dot-r.asm" + + ; Numeric IO + ; singed PNO with single cell numbers, right aligned in width w + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_DOTR: +000366 ff02 .dw $ff02 +000367 722e .db ".r" +000368 0353 .dw VE_HEAD + .set VE_HEAD = VE_DOTR + XT_DOTR: +000369 3801 .dw DO_COLON + PFA_DOTR: + + .endif +00036a 38ff .dw XT_TO_R +00036b 3fc7 .dw XT_S2D +00036c 38f6 .dw XT_R_FROM +00036d 0357 .dw XT_DDOTR +00036e 3820 .dw XT_EXIT + ; : .r ( s n -- ) >r s>d r> d.r ; + .include "words/d-dot.asm" + + ; Numeric IO + ; singed PNO with double cell numbers + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_DDOT: +00036f ff02 .dw $ff02 +000370 2e64 .db "d." +000371 0366 .dw VE_HEAD + .set VE_HEAD = VE_DDOT + XT_DDOT: +000372 3801 .dw DO_COLON + PFA_DDOT: + + .endif +000373 3954 .dw XT_ZERO +000374 0357 .dw XT_DDOTR +000375 3fae .dw XT_SPACE +000376 3820 .dw XT_EXIT + ; : d. ( d -- ) 0 d.r space ; + .include "words/dot.asm" + + ; Numeric IO + ; singed PNO with single cell numbers + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + + + VE_DOT: +000377 ff01 .dw $ff01 +000378 002e .db ".",0 +000379 036f .dw VE_HEAD + .set VE_HEAD = VE_DOT + XT_DOT: +00037a 3801 .dw DO_COLON + PFA_DOT: + .endif +00037b 3fc7 .dw XT_S2D +00037c 0372 .dw XT_DDOT +00037d 3820 .dw XT_EXIT + ; : . ( s -- ) s>d d. ; + .include "words/ud-dot.asm" + + ; Numeric IO + ; unsigned PNO with double cell numbers + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_UDDOT: +00037e ff03 .dw $ff03 +00037f 6475 +000380 002e .db "ud.",0 +000381 0377 .dw VE_HEAD + .set VE_HEAD = VE_UDDOT + XT_UDDOT: +000382 3801 .dw DO_COLON + PFA_UDDOT: + .endif +000383 3954 .dw XT_ZERO +000384 038b .dw XT_UDDOTR +000385 3fae .dw XT_SPACE +000386 3820 .dw XT_EXIT + .include "words/ud-dot-r.asm" + + ; Numeric IO + ; unsigned PNO with double cell numbers, right aligned in width w + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + + + VE_UDDOTR: +000387 ff04 .dw $ff04 +000388 6475 +000389 722e .db "ud.r" +00038a 037e .dw VE_HEAD + .set VE_HEAD = VE_UDDOTR + XT_UDDOTR: +00038b 3801 .dw DO_COLON + PFA_UDDOTR: + .endif +00038c 38ff .dw XT_TO_R +00038d 0316 .dw XT_L_SHARP +00038e 0334 .dw XT_SHARP_S +00038f 033f .dw XT_SHARP_G +000390 38f6 .dw XT_R_FROM +000391 38cf .dw XT_OVER +000392 3993 .dw XT_MINUS +000393 3fb7 .dw XT_SPACES +000394 042e .dw XT_TYPE +000395 3820 .dw XT_EXIT + .include "words/ud-slash-mod.asm" + + ; Arithmetics + ; unsigned double cell division with remainder + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_UDSLASHMOD: +000396 ff06 .dw $ff06 +000397 6475 +000398 6d2f +000399 646f .db "ud/mod" +00039a 0387 .dw VE_HEAD + .set VE_HEAD = VE_UDSLASHMOD + XT_UDSLASHMOD: +00039b 3801 .dw DO_COLON + PFA_UDSLASHMOD: + .endif +00039c 38ff .dw XT_TO_R +00039d 3954 .dw XT_ZERO +00039e 3908 .dw XT_R_FETCH +00039f 39c2 .dw XT_UMSLASHMOD +0003a0 38f6 .dw XT_R_FROM +0003a1 38c4 .dw XT_SWAP +0003a2 38ff .dw XT_TO_R +0003a3 39c2 .dw XT_UMSLASHMOD +0003a4 38f6 .dw XT_R_FROM +0003a5 3820 .dw XT_EXIT + .include "words/digit-q.asm" + + ; Numeric IO + ; tries to convert a character to a number, set flag accordingly + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_DIGITQ: +0003a6 ff06 .dw $ff06 +0003a7 6964 +0003a8 6967 +0003a9 3f74 .db "digit?" +0003aa 0396 .dw VE_HEAD + .set VE_HEAD = VE_DIGITQ + XT_DIGITQ: +0003ab 3801 .dw DO_COLON + PFA_DIGITQ: + .endif +0003ac 3f66 .dw XT_TOUPPER +0003ad 38b1 +0003ae 383d +0003af 0039 +0003b0 3978 +0003b1 383d +0003b2 0100 .DW XT_DUP,XT_DOLITERAL,57,XT_GREATER,XT_DOLITERAL,256 +0003b3 3a13 +0003b4 399d +0003b5 38b1 +0003b6 383d +0003b7 0140 +0003b8 3978 .DW XT_AND,XT_PLUS,XT_DUP,XT_DOLITERAL,320,XT_GREATER +0003b9 383d +0003ba 0107 +0003bb 3a13 +0003bc 3993 +0003bd 383d +0003be 0030 .DW XT_DOLITERAL,263,XT_AND,XT_MINUS,XT_DOLITERAL,48 +0003bf 3993 +0003c0 38b1 +0003c1 3ebd +0003c2 3879 +0003c3 395c .DW XT_MINUS,XT_DUP,XT_BASE,XT_FETCH,XT_ULESS +0003c4 3820 .DW XT_EXIT + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + .include "words/do-sliteral.asm" + + ; String + ; runtime portion of sliteral + ;VE_DOSLITERAL: + ; .dw $ff0a + ; .db "(sliteral)" + ; .dw VE_HEAD + ; .set VE_HEAD = VE_DOSLITERAL + XT_DOSLITERAL: +0003c5 3801 .dw DO_COLON + PFA_DOSLITERAL: +0003c6 3908 .dw XT_R_FETCH ; ( -- addr ) +0003c7 0424 .dw XT_ICOUNT +0003c8 38f6 .dw XT_R_FROM +0003c9 38cf .dw XT_OVER ; ( -- addr' n addr n) +0003ca 3a2f .dw XT_1PLUS +0003cb 3a04 .dw XT_2SLASH ; ( -- addr' n addr k ) +0003cc 399d .dw XT_PLUS ; ( -- addr' n addr'' ) +0003cd 3a2f .dw XT_1PLUS +0003ce 38ff .dw XT_TO_R ; ( -- ) +0003cf 3820 .dw XT_EXIT + .include "words/scomma.asm" + + ; Compiler + ; compiles a string from RAM to Flash + VE_SCOMMA: +0003d0 ff02 .dw $ff02 +0003d1 2c73 .db "s",$2c +0003d2 03a6 .dw VE_HEAD + .set VE_HEAD = VE_SCOMMA + XT_SCOMMA: +0003d3 3801 .dw DO_COLON + PFA_SCOMMA: +0003d4 38b1 .dw XT_DUP +0003d5 03d7 .dw XT_DOSCOMMA +0003d6 3820 .dw XT_EXIT + + ; ( addr len len' -- ) + ; Compiler + ; compiles a string from RAM to Flash + ;VE_DOSCOMMA: + ; .dw $ff04 + ; .db "(s",$2c,")" + ; .dw VE_HEAD + ; .set VE_HEAD = VE_DOSCOMMA + XT_DOSCOMMA: +0003d7 3801 .dw DO_COLON + PFA_DOSCOMMA: +0003d8 075c .dw XT_COMMA +0003d9 38b1 .dw XT_DUP ; ( --addr len len) +0003da 3a04 .dw XT_2SLASH ; ( -- addr len len/2 +0003db 3eda .dw XT_TUCK ; ( -- addr len/2 len len/2 +0003dc 3a0b .dw XT_2STAR ; ( -- addr len/2 len len' +0003dd 3993 .dw XT_MINUS ; ( -- addr len/2 rem +0003de 38ff .dw XT_TO_R +0003df 3954 .dw XT_ZERO +0003e0 081b .dw XT_QDOCHECK +0003e1 3836 .dw XT_DOCONDBRANCH +0003e2 03ea .dw PFA_SCOMMA2 +0003e3 3a9b .dw XT_DODO + PFA_SCOMMA1: +0003e4 38b1 .dw XT_DUP ; ( -- addr addr ) +0003e5 3879 .dw XT_FETCH ; ( -- addr c1c2 ) +0003e6 075c .dw XT_COMMA ; ( -- addr ) +0003e7 3c90 .dw XT_CELLPLUS ; ( -- addr+cell ) +0003e8 3ac9 .dw XT_DOLOOP +0003e9 03e4 .dw PFA_SCOMMA1 + PFA_SCOMMA2: +0003ea 38f6 .dw XT_R_FROM +0003eb 3928 .dw XT_GREATERZERO +0003ec 3836 .dw XT_DOCONDBRANCH +0003ed 03f1 .dw PFA_SCOMMA3 +0003ee 38b1 .dw XT_DUP ; well, tricky +0003ef 3898 .dw XT_CFETCH +0003f0 075c .dw XT_COMMA + PFA_SCOMMA3: +0003f1 38d9 .dw XT_DROP ; ( -- ) +0003f2 3820 .dw XT_EXIT + .include "words/itype.asm" + + ; Tools + ; reads string from flash and prints it + VE_ITYPE: +0003f3 ff05 .dw $ff05 +0003f4 7469 +0003f5 7079 +0003f6 0065 .db "itype",0 +0003f7 03d0 .dw VE_HEAD + .set VE_HEAD = VE_ITYPE + XT_ITYPE: +0003f8 3801 .dw DO_COLON + PFA_ITYPE: +0003f9 38b1 .dw XT_DUP ; ( --addr len len) +0003fa 3a04 .dw XT_2SLASH ; ( -- addr len len/2 +0003fb 3eda .dw XT_TUCK ; ( -- addr len/2 len len/2 +0003fc 3a0b .dw XT_2STAR ; ( -- addr len/2 len len' +0003fd 3993 .dw XT_MINUS ; ( -- addr len/2 rem +0003fe 38ff .dw XT_TO_R +0003ff 3954 .dw XT_ZERO +000400 081b .dw XT_QDOCHECK +000401 3836 .dw XT_DOCONDBRANCH +000402 040c .dw PFA_ITYPE2 +000403 3a9b .dw XT_DODO + PFA_ITYPE1: +000404 38b1 .dw XT_DUP ; ( -- addr addr ) +000405 3bcb .dw XT_FETCHI ; ( -- addr c1c2 ) +000406 38b1 .dw XT_DUP +000407 0419 .dw XT_LOWEMIT +000408 0415 .dw XT_HIEMIT +000409 3a2f .dw XT_1PLUS ; ( -- addr+cell ) +00040a 3ac9 .dw XT_DOLOOP +00040b 0404 .dw PFA_ITYPE1 + PFA_ITYPE2: +00040c 38f6 .dw XT_R_FROM +00040d 3928 .dw XT_GREATERZERO +00040e 3836 .dw XT_DOCONDBRANCH +00040f 0413 .dw PFA_ITYPE3 +000410 38b1 .dw XT_DUP ; make sure the drop below has always something to do +000411 3bcb .dw XT_FETCHI +000412 0419 .dw XT_LOWEMIT + PFA_ITYPE3: +000413 38d9 .dw XT_DROP +000414 3820 .dw XT_EXIT + + ; ( w -- ) + ; R( -- ) + ; content of cell fetched on stack. + ;VE_HIEMIT: + ; .dw $ff06 + ; .db "hiemit" + ; .dw VE_HEAD + ; .set VE_HEAD = VE_HIEMIT + XT_HIEMIT: +000415 3801 .dw DO_COLON + PFA_HIEMIT: +000416 3af9 .dw XT_BYTESWAP +000417 0419 .dw XT_LOWEMIT +000418 3820 .dw XT_EXIT + + ; ( w -- ) + ; R( -- ) + ; content of cell fetched on stack. + ;VE_LOWEMIT: + ; .dw $ff07 + ; .db "lowemit" + ; .dw VE_HEAD + ; .set VE_HEAD = VE_LOWEMIT + XT_LOWEMIT: +000419 3801 .dw DO_COLON + PFA_LOWEMIT: +00041a 383d .dw XT_DOLITERAL +00041b 00ff .dw $00ff +00041c 3a13 .dw XT_AND +00041d 3ef2 .dw XT_EMIT +00041e 3820 .dw XT_EXIT + .include "words/icount.asm" + + ; Tools + ; get count information out of a counted string in flash + VE_ICOUNT: +00041f ff06 .dw $ff06 +000420 6369 +000421 756f +000422 746e .db "icount" +000423 03f3 .dw VE_HEAD + .set VE_HEAD = VE_ICOUNT + XT_ICOUNT: +000424 3801 .dw DO_COLON + PFA_ICOUNT: +000425 38b1 .dw XT_DUP +000426 3a2f .dw XT_1PLUS +000427 38c4 .dw XT_SWAP +000428 3bcb .dw XT_FETCHI +000429 3820 .dw XT_EXIT + .include "words/type.asm" + + ; Character IO + ; print a RAM based string + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_TYPE: +00042a ff04 .dw $ff04 +00042b 7974 +00042c 6570 .db "type" +00042d 041f .dw VE_HEAD + .set VE_HEAD = VE_TYPE + XT_TYPE: +00042e 3801 .dw DO_COLON + PFA_TYPE: + + .endif +00042f 3f99 .dw XT_BOUNDS +000430 081b .dw XT_QDOCHECK +000431 3836 .dw XT_DOCONDBRANCH +000432 0439 DEST(PFA_TYPE2) +000433 3a9b .dw XT_DODO + PFA_TYPE1: +000434 3aac .dw XT_I +000435 3898 .dw XT_CFETCH +000436 3ef2 .dw XT_EMIT +000437 3ac9 .dw XT_DOLOOP +000438 0434 DEST(PFA_TYPE1) + PFA_TYPE2: +000439 3820 .dw XT_EXIT + .include "words/tick.asm" + + ; Dictionary + ; search dictionary for name, return XT or throw an exception -13 + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_TICK: +00043a ff01 .dw $ff01 +00043b 0027 .db "'",0 +00043c 042a .dw VE_HEAD + .set VE_HEAD = VE_TICK + XT_TICK: +00043d 3801 .dw DO_COLON + PFA_TICK: + .endif +00043e 05b0 .dw XT_PARSENAME +00043f 05f3 .dw XT_FORTHRECOGNIZER +000440 05fe .dw XT_RECOGNIZE + ; a word is tickable unless DT:TOKEN is DT:NULL or + ; the interpret action is a NOOP +000441 38b1 .dw XT_DUP +000442 068b .dw XT_DT_NULL +000443 3fdf .dw XT_EQUAL +000444 38c4 .dw XT_SWAP +000445 3bcb .dw XT_FETCHI +000446 383d .dw XT_DOLITERAL +000447 019a .dw XT_NOOP +000448 3fdf .dw XT_EQUAL +000449 3a1c .dw XT_OR +00044a 3836 .dw XT_DOCONDBRANCH +00044b 044f DEST(PFA_TICK1) +00044c 383d .dw XT_DOLITERAL +00044d fff3 .dw -13 +00044e 3d86 .dw XT_THROW + PFA_TICK1: +00044f 38d9 .dw XT_DROP +000450 3820 .dw XT_EXIT + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + .include "words/cskip.asm" + + ; String + ; skips leading occurancies in string at addr1/n1 leaving addr2/n2 pointing to the 1st non-c character + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_CSKIP: +000451 ff05 .dw $ff05 +000452 7363 +000453 696b +000454 0070 .db "cskip",0 +000455 043a .dw VE_HEAD + .set VE_HEAD = VE_CSKIP + XT_CSKIP: +000456 3801 .dw DO_COLON + PFA_CSKIP: + .endif +000457 38ff .dw XT_TO_R ; ( -- addr1 n1 ) + PFA_CSKIP1: +000458 38b1 .dw XT_DUP ; ( -- addr' n' n' ) +000459 3836 .dw XT_DOCONDBRANCH ; ( -- addr' n') +00045a 0465 DEST(PFA_CSKIP2) +00045b 38cf .dw XT_OVER ; ( -- addr' n' addr' ) +00045c 3898 .dw XT_CFETCH ; ( -- addr' n' c' ) +00045d 3908 .dw XT_R_FETCH ; ( -- addr' n' c' c ) +00045e 3fdf .dw XT_EQUAL ; ( -- addr' n' f ) +00045f 3836 .dw XT_DOCONDBRANCH ; ( -- addr' n') +000460 0465 DEST(PFA_CSKIP2) +000461 3fe6 .dw XT_ONE +000462 05a1 .dw XT_SLASHSTRING +000463 382f .dw XT_DOBRANCH +000464 0458 DEST(PFA_CSKIP1) + PFA_CSKIP2: +000465 38f6 .dw XT_R_FROM +000466 38d9 .dw XT_DROP ; ( -- addr2 n2) +000467 3820 .dw XT_EXIT + .include "words/cscan.asm" + + ; 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 + .endif + + .if cpu_avr8==1 + VE_CSCAN: +000468 ff05 .dw $ff05 +000469 7363 +00046a 6163 +../../common\words/cscan.asm(12): warning: .cseg .db misalignment - padding zero byte +00046b 006e .db "cscan" +00046c 0451 .dw VE_HEAD + .set VE_HEAD = VE_CSCAN + XT_CSCAN: +00046d 3801 .dw DO_COLON + PFA_CSCAN: + .endif +00046e 38ff .dw XT_TO_R +00046f 38cf .dw XT_OVER + PFA_CSCAN1: +000470 38b1 .dw XT_DUP +000471 3898 .dw XT_CFETCH +000472 3908 .dw XT_R_FETCH +000473 3fdf .dw XT_EQUAL +000474 391a .dw XT_ZEROEQUAL +000475 3836 .dw XT_DOCONDBRANCH +000476 0482 DEST(PFA_CSCAN2) +000477 38c4 .dw XT_SWAP +000478 3a35 .dw XT_1MINUS +000479 38c4 .dw XT_SWAP +00047a 38cf .dw XT_OVER +00047b 3921 .dw XT_ZEROLESS ; not negative +00047c 391a .dw XT_ZEROEQUAL +00047d 3836 .dw XT_DOCONDBRANCH +00047e 0482 DEST(PFA_CSCAN2) +00047f 3a2f .dw XT_1PLUS +000480 382f .dw XT_DOBRANCH +000481 0470 DEST(PFA_CSCAN1) + PFA_CSCAN2: +000482 38f0 .dw XT_NIP +000483 38cf .dw XT_OVER +000484 3993 .dw XT_MINUS +000485 38f6 .dw XT_R_FROM +000486 38d9 .dw XT_DROP +000487 3820 .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 + ; ; + .include "words/accept.asm" + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_ACCEPT: +000488 ff06 .dw $ff06 +000489 6361 +00048a 6563 +00048b 7470 .db "accept" +00048c 0468 .dw VE_HEAD + .set VE_HEAD = VE_ACCEPT + XT_ACCEPT: +00048d 3801 .dw DO_COLON + PFA_ACCEPT: + + .endif +00048e 38cf +00048f 399d +000490 3a35 +000491 38cf .DW XT_OVER,XT_PLUS,XT_1MINUS,XT_OVER +000492 3f03 +000493 38b1 +000494 04ce +000495 391a +000496 3836 ACC1: .DW XT_KEY,XT_DUP,XT_CRLFQ,XT_ZEROEQUAL,XT_DOCONDBRANCH +000497 04c0 DEST(ACC5) +000498 38b1 +000499 383d +00049a 0008 +00049b 3fdf +00049c 3836 .DW XT_DUP,XT_DOLITERAL,8,XT_EQUAL,XT_DOCONDBRANCH +00049d 04b0 DEST(ACC3) +00049e 38d9 +00049f 38e1 +0004a0 3ec9 +0004a1 3978 +0004a2 38ff +0004a3 38e1 +0004a4 38e1 +0004a5 38f6 +0004a6 3836 .DW XT_DROP,XT_ROT,XT_2DUP,XT_GREATER,XT_TO_R,XT_ROT,XT_ROT,XT_R_FROM,XT_DOCONDBRANCH +0004a7 04ae DEST(ACC6) +0004a8 04c6 +0004a9 3a35 +0004aa 38ff +0004ab 38cf +0004ac 38f6 +0004ad 014f .DW XT_BS,XT_1MINUS,XT_TO_R,XT_OVER,XT_R_FROM,XT_UMAX +0004ae 382f ACC6: .DW XT_DOBRANCH +0004af 04be DEST(ACC4) + + + ACC3: ; check for remaining control characters, replace them with blank +0004b0 38b1 .dw XT_DUP ; ( -- addr k k ) +0004b1 3f54 .dw XT_BL +0004b2 396e .dw XT_LESS +0004b3 3836 .dw XT_DOCONDBRANCH +0004b4 04b7 DEST(PFA_ACCEPT6) +0004b5 38d9 .dw XT_DROP +0004b6 3f54 .dw XT_BL + PFA_ACCEPT6: +0004b7 38b1 +0004b8 3ef2 +0004b9 38cf +0004ba 388d +0004bb 3a2f +0004bc 38cf +0004bd 015b .DW XT_DUP,XT_EMIT,XT_OVER,XT_CSTORE,XT_1PLUS,XT_OVER,XT_UMIN +0004be 382f ACC4: .DW XT_DOBRANCH +0004bf 0492 DEST(ACC1) +0004c0 38d9 +0004c1 38f0 +0004c2 38c4 +0004c3 3993 +0004c4 3fa1 +0004c5 3820 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 + .endif + + .if cpu_avr8==1 + + ;VE_BS: + ; .dw $ff02 + ; .db "bs" + ; .dw VE_HEAD + ; .set VE_HEAD = VE_BS + XT_BS: +0004c6 3801 .dw DO_COLON + .endif +0004c7 383d .dw XT_DOLITERAL +0004c8 0008 .dw 8 +0004c9 38b1 .dw XT_DUP +0004ca 3ef2 .dw XT_EMIT +0004cb 3fae .dw XT_SPACE +0004cc 3ef2 .dw XT_EMIT +0004cd 3820 .dw XT_EXIT + + + ; ( c -- f ) + ; System + ; is the character a line end character? + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + ;VE_CRLFQ: + ; .dw $ff02 + ; .db "crlf?" + ; .dw VE_HEAD + ; .set VE_HEAD = VE_CRLFQ + XT_CRLFQ: +0004ce 3801 .dw DO_COLON + .endif +0004cf 38b1 .dw XT_DUP +0004d0 383d .dw XT_DOLITERAL +0004d1 000d .dw 13 +0004d2 3fdf .dw XT_EQUAL +0004d3 38c4 .dw XT_SWAP +0004d4 383d .dw XT_DOLITERAL +0004d5 000a .dw 10 +0004d6 3fdf .dw XT_EQUAL +0004d7 3a1c .dw XT_OR +0004d8 3820 .dw XT_EXIT + .include "words/refill.asm" + + ; System + ; refills the input buffer + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_REFILL: +0004d9 ff06 .dw $ff06 +0004da 6572 +0004db 6966 +0004dc 6c6c .db "refill" +0004dd 0488 .dw VE_HEAD + .set VE_HEAD = VE_REFILL + XT_REFILL: +0004de 3dff .dw PFA_DODEFER1 + PFA_REFILL: + .endif +0004df 001a .dw USER_REFILL +0004e0 3dc8 .dw XT_UDEFERFETCH +0004e1 3dd4 .dw XT_UDEFERSTORE + .include "words/char.asm" + + ; Tools + ; copy the first character of the next word onto the stack + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_CHAR: +0004e2 ff04 .dw $ff04 +0004e3 6863 +0004e4 7261 .db "char" +0004e5 04d9 .dw VE_HEAD + .set VE_HEAD = VE_CHAR + XT_CHAR: +0004e6 3801 .dw DO_COLON + PFA_CHAR: + .endif +0004e7 05b0 .dw XT_PARSENAME +0004e8 38d9 .dw XT_DROP +0004e9 3898 .dw XT_CFETCH +0004ea 3820 .dw XT_EXIT + .include "words/number.asm" + + ; Numeric IO + ; convert a string at addr to a number + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_NUMBER: +0004eb ff06 .dw $ff06 +0004ec 756e +0004ed 626d +0004ee 7265 .db "number" +0004ef 04e2 .dw VE_HEAD + .set VE_HEAD = VE_NUMBER + XT_NUMBER: +0004f0 3801 .dw DO_COLON + PFA_NUMBER: + .endif +0004f1 3ebd .dw XT_BASE +0004f2 3879 .dw XT_FETCH +0004f3 38ff .dw XT_TO_R +0004f4 0534 .dw XT_QSIGN +0004f5 38ff .dw XT_TO_R +0004f6 0547 .dw XT_SET_BASE +0004f7 0534 .dw XT_QSIGN +0004f8 38f6 .dw XT_R_FROM +0004f9 3a1c .dw XT_OR +0004fa 38ff .dw XT_TO_R + ; check whether something is left +0004fb 38b1 .dw XT_DUP +0004fc 391a .dw XT_ZEROEQUAL +0004fd 3836 .dw XT_DOCONDBRANCH +0004fe 0507 DEST(PFA_NUMBER0) + ; nothing is left. It cannot be a number at all +0004ff 3ed2 .dw XT_2DROP +000500 38f6 .dw XT_R_FROM +000501 38d9 .dw XT_DROP +000502 38f6 .dw XT_R_FROM +000503 3ebd .dw XT_BASE +000504 3881 .dw XT_STORE +000505 3954 .dw XT_ZERO +000506 3820 .dw XT_EXIT + PFA_NUMBER0: +000507 3b1e .dw XT_2TO_R +000508 3954 .dw XT_ZERO ; starting value +000509 3954 .dw XT_ZERO +00050a 3b2d .dw XT_2R_FROM +00050b 0565 .dw XT_TO_NUMBER ; ( 0. addr len -- d addr' len' + ; check length of the remaining string. + ; if zero: a single cell number is entered +00050c 38b9 .dw XT_QDUP +00050d 3836 .dw XT_DOCONDBRANCH +00050e 0529 DEST(PFA_NUMBER1) + ; if equal 1: mayba a trailing dot? --> double cell number +00050f 3fe6 .dw XT_ONE +000510 3fdf .dw XT_EQUAL +000511 3836 .dw XT_DOCONDBRANCH +000512 0520 DEST(PFA_NUMBER2) + ; excatly one character is left +000513 3898 .dw XT_CFETCH +000514 383d .dw XT_DOLITERAL +000515 002e .dw 46 ; . +000516 3fdf .dw XT_EQUAL +000517 3836 .dw XT_DOCONDBRANCH +000518 0521 DEST(PFA_NUMBER6) + ; its a double cell number + ; incorporate sign into number +000519 38f6 .dw XT_R_FROM +00051a 3836 .dw XT_DOCONDBRANCH +00051b 051d DEST(PFA_NUMBER3) +00051c 0228 .dw XT_DNEGATE + PFA_NUMBER3: +00051d 3feb .dw XT_TWO +00051e 382f .dw XT_DOBRANCH +00051f 052f DEST(PFA_NUMBER5) + PFA_NUMBER2: +000520 38d9 .dw XT_DROP + PFA_NUMBER6: +000521 3ed2 .dw XT_2DROP +000522 38f6 .dw XT_R_FROM +000523 38d9 .dw XT_DROP +000524 38f6 .dw XT_R_FROM +000525 3ebd .dw XT_BASE +000526 3881 .dw XT_STORE +000527 3954 .dw XT_ZERO +000528 3820 .dw XT_EXIT + PFA_NUMBER1: +000529 3ed2 .dw XT_2DROP ; remove the address + ; incorporate sign into number +00052a 38f6 .dw XT_R_FROM +00052b 3836 .dw XT_DOCONDBRANCH +00052c 052e DEST(PFA_NUMBER4) +00052d 3e27 .dw XT_NEGATE + PFA_NUMBER4: +00052e 3fe6 .dw XT_ONE + PFA_NUMBER5: +00052f 38f6 .dw XT_R_FROM +000530 3ebd .dw XT_BASE +000531 3881 .dw XT_STORE +000532 394b .dw XT_TRUE +000533 3820 .dw XT_EXIT + .include "words/q-sign.asm" + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + XT_QSIGN: +000534 3801 .dw DO_COLON + PFA_QSIGN: ; ( c -- ) + .endif +000535 38cf .dw XT_OVER ; ( -- addr len addr ) +000536 3898 .dw XT_CFETCH +000537 383d .dw XT_DOLITERAL +000538 002d .dw '-' +000539 3fdf .dw XT_EQUAL ; ( -- addr len flag ) +00053a 38b1 .dw XT_DUP +00053b 38ff .dw XT_TO_R +00053c 3836 .dw XT_DOCONDBRANCH +00053d 0540 DEST(PFA_NUMBERSIGN_DONE) +00053e 3fe6 .dw XT_ONE ; skip sign character +00053f 05a1 .dw XT_SLASHSTRING + PFA_NUMBERSIGN_DONE: +000540 38f6 .dw XT_R_FROM +000541 3820 .dw XT_EXIT + .include "words/set-base.asm" + + ; Numeric IO + ; skip a numeric prefix character + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + XT_BASES: +000542 3852 .dw PFA_DOCONSTANT + .endif +000543 000a +000544 0010 +000545 0002 +000546 000a .dw 10,16,2,10 ; last one could a 8 instead. + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + XT_SET_BASE: +000547 3801 .dw DO_COLON + PFA_SET_BASE: ; ( adr1 len1 -- adr2 len2 ) + .endif +000548 38cf .dw XT_OVER +000549 3898 .dw XT_CFETCH +00054a 383d .dw XT_DOLITERAL +00054b 0023 .dw 35 +00054c 3993 .dw XT_MINUS +00054d 38b1 .dw XT_DUP +00054e 3954 .dw XT_ZERO +00054f 383d .dw XT_DOLITERAL +000550 0004 .dw 4 +000551 3e57 .dw XT_WITHIN +000552 3836 .dw XT_DOCONDBRANCH +000553 055d DEST(SET_BASE1) + .if cpu_msp430==1 + .endif +000554 0542 .dw XT_BASES +000555 399d .dw XT_PLUS +000556 3bcb .dw XT_FETCHI +000557 3ebd .dw XT_BASE +000558 3881 .dw XT_STORE +000559 3fe6 .dw XT_ONE +00055a 05a1 .dw XT_SLASHSTRING +00055b 382f .dw XT_DOBRANCH +00055c 055e DEST(SET_BASE2) + SET_BASE1: +00055d 38d9 .dw XT_DROP + SET_BASE2: +00055e 3820 .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 ; + .include "words/to-number.asm" + + ; Numeric IO + ; convert a string to a number c-addr2/u2 is the unconverted string + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_TO_NUMBER: +00055f ff07 .dw $ff07 +000560 6e3e +000561 6d75 +000562 6562 +000563 0072 .db ">number",0 +000564 04eb .dw VE_HEAD + .set VE_HEAD = VE_TO_NUMBER + XT_TO_NUMBER: +000565 3801 .dw DO_COLON + + .endif + +000566 38b1 +000567 3836 TONUM1: .DW XT_DUP,XT_DOCONDBRANCH +000568 057d DEST(TONUM3) +000569 38cf +00056a 3898 +00056b 03ab .DW XT_OVER,XT_CFETCH,XT_DIGITQ +00056c 391a +00056d 3836 .DW XT_ZEROEQUAL,XT_DOCONDBRANCH +00056e 0571 DEST(TONUM2) +00056f 38d9 +000570 3820 .DW XT_DROP,XT_EXIT +000571 38ff +000572 024c +000573 3ebd +000574 3879 +000575 0140 TONUM2: .DW XT_TO_R,XT_2SWAP,XT_BASE,XT_FETCH,XT_UDSTAR +000576 38f6 +000577 0138 +000578 024c .DW XT_R_FROM,XT_MPLUS,XT_2SWAP +000579 3fe6 +00057a 05a1 +00057b 382f .DW XT_ONE,XT_SLASHSTRING,XT_DOBRANCH +00057c 0566 DEST(TONUM1) +00057d 3820 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 ; + .include "words/parse.asm" + + ; String + ; in input buffer parse ccc delimited string by the delimiter char. + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_PARSE: +00057e ff05 .dw $ff05 +00057f 6170 +000580 7372 +000581 0065 .db "parse",0 +000582 055f .dw VE_HEAD + .set VE_HEAD = VE_PARSE + XT_PARSE: +000583 3801 .dw DO_COLON + PFA_PARSE: + .endif +000584 38ff .dw XT_TO_R ; ( -- ) +000585 0597 .dw XT_SOURCE ; ( -- addr len) +000586 3ee2 .dw XT_TO_IN ; ( -- addr len >in) +000587 3879 .dw XT_FETCH +000588 05a1 .dw XT_SLASHSTRING ; ( -- addr' len' ) + +000589 38f6 .dw XT_R_FROM ; ( -- addr' len' c) +00058a 046d .dw XT_CSCAN ; ( -- addr' len'') +00058b 38b1 .dw XT_DUP ; ( -- addr' len'' len'') +00058c 3a2f .dw XT_1PLUS +00058d 3ee2 .dw XT_TO_IN ; ( -- addr' len'' len'' >in) +00058e 3a65 .dw XT_PLUSSTORE ; ( -- addr' len') +00058f 3fe6 .dw XT_ONE +000590 05a1 .dw XT_SLASHSTRING +000591 3820 .dw XT_EXIT + .include "words/source.asm" + + ; System + ; address and current length of the input buffer + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_SOURCE: +000592 ff06 .dw $FF06 +000593 6f73 +000594 7275 +000595 6563 .db "source" +000596 057e .dw VE_HEAD + .set VE_HEAD = VE_SOURCE + XT_SOURCE: +000597 3dff .dw PFA_DODEFER1 + PFA_SOURCE: + .endif +000598 0016 .dw USER_SOURCE +000599 3dc8 .dw XT_UDEFERFETCH +00059a 3dd4 .dw XT_UDEFERSTORE + + + .include "words/slash-string.asm" + + ; String + ; adjust string from addr1 to addr1+n, reduce length from u1 to u2 by n + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_SLASHSTRING: +00059b ff07 .dw $ff07 +00059c 732f +00059d 7274 +00059e 6e69 +00059f 0067 .db "/string",0 +0005a0 0592 .dw VE_HEAD + .set VE_HEAD = VE_SLASHSTRING + XT_SLASHSTRING: +0005a1 3801 .dw DO_COLON + PFA_SLASHSTRING: + .endif +0005a2 38e1 .dw XT_ROT +0005a3 38cf .dw XT_OVER +0005a4 399d .dw XT_PLUS +0005a5 38e1 .dw XT_ROT +0005a6 38e1 .dw XT_ROT +0005a7 3993 .dw XT_MINUS +0005a8 3820 .dw XT_EXIT + + .include "words/parse-name.asm" + + ; String + ; In the SOURCE buffer parse whitespace delimited string. Returns string address within SOURCE. + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + + VE_PARSENAME: +0005a9 ff0a .dw $FF0A +0005aa 6170 +0005ab 7372 +0005ac 2d65 +0005ad 616e +0005ae 656d .db "parse-name" +0005af 059b .dw VE_HEAD + .set VE_HEAD = VE_PARSENAME + XT_PARSENAME: +0005b0 3801 .dw DO_COLON + PFA_PARSENAME: + .endif +0005b1 3f54 .dw XT_BL +0005b2 05b4 .dw XT_SKIPSCANCHAR +0005b3 3820 .dw XT_EXIT + + ; ( c -- addr2 len2 ) + ; String + ; skips char and scan what's left in source for char + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + ;VE_SKIPSCANCHAR: + ; .dw $FF0A + ; .db "skipscanchar" + ; .dw VE_HEAD + ; .set VE_HEAD = VE_SKIPSCANCHAR + XT_SKIPSCANCHAR: +0005b4 3801 .dw DO_COLON + PFA_SKIPSCANCHAR: + .endif +0005b5 38ff .dw XT_TO_R +0005b6 0597 .dw XT_SOURCE +0005b7 3ee2 .dw XT_TO_IN +0005b8 3879 .dw XT_FETCH +0005b9 05a1 .dw XT_SLASHSTRING + +0005ba 3908 .dw XT_R_FETCH +0005bb 0456 .dw XT_CSKIP +0005bc 38f6 .dw XT_R_FROM +0005bd 046d .dw XT_CSCAN + + ; adjust >IN +0005be 3ec9 .dw XT_2DUP +0005bf 399d .dw XT_PLUS +0005c0 0597 .dw XT_SOURCE +0005c1 38d9 .dw XT_DROP +0005c2 3993 .dw XT_MINUS +0005c3 3ee2 .dw XT_TO_IN +0005c4 3881 .dw XT_STORE +0005c5 3820 .dw XT_EXIT + .include "words/sp0.asm" + + ; Stack + ; start address of the data stack + VE_SP0: +0005c6 ff03 .dw $ff03 +0005c7 7073 +0005c8 0030 .db "sp0",0 +0005c9 05a9 .dw VE_HEAD + .set VE_HEAD = VE_SP0 + XT_SP0: +0005ca 386f .dw PFA_DOVALUE1 + PFA_SP0: +0005cb 0006 .dw USER_SP0 +0005cc 3dc8 .dw XT_UDEFERFETCH +0005cd 3dd4 .dw XT_UDEFERSTORE + + ; ( -- addr) + ; Stack + ; address of user variable to store top-of-stack for inactive tasks + VE_SP: +0005ce ff02 .dw $ff02 +0005cf 7073 .db "sp" +0005d0 05c6 .dw VE_HEAD + .set VE_HEAD = VE_SP + XT_SP: +0005d1 3858 .dw PFA_DOUSER + PFA_SP: +0005d2 0008 .dw USER_SP + .include "words/rp0.asm" + + ; Stack + ; start address of return stack + VE_RP0: +0005d3 ff03 .dw $ff03 +0005d4 7072 +0005d5 0030 .db "rp0",0 +0005d6 05ce .dw VE_HEAD + .set VE_HEAD = VE_RP0 + XT_RP0: +0005d7 3801 .dw DO_COLON + PFA_RP0: +0005d8 05db .dw XT_DORP0 +0005d9 3879 .dw XT_FETCH +0005da 3820 .dw XT_EXIT + + ; ( -- addr) + ; Stack + ; user variable of the address of the initial return stack + ;VE_DORP0: + ; .dw $ff05 + ; .db "(rp0)" + ; .dw VE_HEAD + ; .set VE_HEAD = VE_DORP0 + XT_DORP0: +0005db 3858 .dw PFA_DOUSER + PFA_DORP0: +0005dc 0004 .dw USER_RP + .include "words/depth.asm" + + ; Stack + ; number of single-cell values contained in the data stack before n was placed on the stack. + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_DEPTH: +0005dd ff05 .dw $ff05 +0005de 6564 +0005df 7470 +0005e0 0068 .db "depth",0 +0005e1 05d3 .dw VE_HEAD + .set VE_HEAD = VE_DEPTH + XT_DEPTH: +0005e2 3801 .dw DO_COLON + PFA_DEPTH: + .endif +0005e3 05ca .dw XT_SP0 +0005e4 3a8d .dw XT_SP_FETCH +0005e5 3993 .dw XT_MINUS +0005e6 3a04 .dw XT_2SLASH +0005e7 3a35 .dw XT_1MINUS +0005e8 3820 .dw XT_EXIT + .include "words/forth-recognizer.asm" + + ; System Value + ; address of the next free data space (RAM) cell + VE_FORTHRECOGNIZER: +0005e9 ff10 .dw $ff10 +0005ea 6f66 +0005eb 7472 +0005ec 2d68 +0005ed 6572 +0005ee 6f63 +0005ef 6e67 +0005f0 7a69 +0005f1 7265 .db "forth-recognizer" +0005f2 05dd .dw VE_HEAD + .set VE_HEAD = VE_FORTHRECOGNIZER + XT_FORTHRECOGNIZER: +0005f3 386f .dw PFA_DOVALUE1 + PFA_FORTHRECOGNIZER: +0005f4 0034 .dw CFG_FORTHRECOGNIZER +0005f5 3da0 .dw XT_EDEFERFETCH +0005f6 3daa .dw XT_EDEFERSTORE + .include "words/recognize.asm" + + ; System + ; walk the recognizer stack + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_RECOGNIZE: +0005f7 ff09 .dw $ff09 +0005f8 6572 +0005f9 6f63 +0005fa 6e67 +0005fb 7a69 +0005fc 0065 .db "recognize",0 +0005fd 05e9 .dw VE_HEAD + .set VE_HEAD = VE_RECOGNIZE + XT_RECOGNIZE: +0005fe 3801 .dw DO_COLON + PFA_RECOGNIZE: + .endif +0005ff 383d .dw XT_DOLITERAL +000600 0609 .dw XT_RECOGNIZE_A +000601 38c4 .dw XT_SWAP +000602 099c .dw XT_MAPSTACK +000603 391a .dw XT_ZEROEQUAL +000604 3836 .dw XT_DOCONDBRANCH +000605 0608 DEST(PFA_RECOGNIZE1) +000606 3ed2 .dw XT_2DROP +000607 068b .dw XT_DT_NULL + PFA_RECOGNIZE1: +000608 3820 .dw XT_EXIT + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + ; ( addr len XT -- addr len [ dt:xt -1 | 0 ] ) + XT_RECOGNIZE_A: +000609 3801 .dw DO_COLON + PFA_RECOGNIZE_A: + .endif +00060a 38e1 .dw XT_ROT ; -- len xt addr +00060b 38e1 .dw XT_ROT ; -- xt addr len +00060c 3ec9 .dw XT_2DUP +00060d 3b1e .dw XT_2TO_R +00060e 38e1 .dw XT_ROT ; -- addr len xt +00060f 382a .dw XT_EXECUTE ; -- i*x dt:* | dt:null +000610 3b2d .dw XT_2R_FROM +000611 38e1 .dw XT_ROT +000612 38b1 .dw XT_DUP +000613 068b .dw XT_DT_NULL +000614 3fdf .dw XT_EQUAL +000615 3836 .dw XT_DOCONDBRANCH +000616 061a DEST(PFA_RECOGNIZE_A1) +000617 38d9 .dw XT_DROP +000618 3954 .dw XT_ZERO +000619 3820 .dw XT_EXIT + PFA_RECOGNIZE_A1: +00061a 38f0 .dw XT_NIP +00061b 38f0 .dw XT_NIP +00061c 394b .dw XT_TRUE +00061d 3820 .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 ; + ; + .include "words/interpret.asm" + + ; System + ; Interpret SOURCE word by word. + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_INTERPRET: +00061e ff09 .dw $ff09 +00061f 6e69 +000620 6574 +000621 7072 +000622 6572 +000623 0074 .db "interpret",0 +000624 05f7 .dw VE_HEAD + .set VE_HEAD = VE_INTERPRET + XT_INTERPRET: +000625 3801 .dw DO_COLON + .endif + PFA_INTERPRET: +000626 05b0 .dw XT_PARSENAME ; ( -- addr len ) +000627 38b1 .dw XT_DUP ; ( -- addr len flag) +000628 3836 .dw XT_DOCONDBRANCH +000629 0636 DEST(PFA_INTERPRET2) +00062a 05f3 .dw XT_FORTHRECOGNIZER +00062b 05fe .dw XT_RECOGNIZE +00062c 3eb7 .dw XT_STATE +00062d 3879 .dw XT_FETCH +00062e 3836 .dw XT_DOCONDBRANCH +00062f 0631 DEST(PFA_INTERPRET1) +000630 01c6 .dw XT_ICELLPLUS ; we need the compile action + PFA_INTERPRET1: +000631 3bcb .dw XT_FETCHI +000632 382a .dw XT_EXECUTE +000633 3f8b .dw XT_QSTACK +000634 382f .dw XT_DOBRANCH +000635 0626 DEST(PFA_INTERPRET) + PFA_INTERPRET2: +000636 3ed2 .dw XT_2DROP +000637 3820 .dw XT_EXIT + .include "words/rec-intnum.asm" + + ; Interpreter + ; Method table for single cell integers + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_DT_NUM: +000638 ff06 .dw $ff06 +000639 7464 +00063a 6e3a +00063b 6d75 .db "dt:num" +00063c 061e .dw VE_HEAD + .set VE_HEAD = VE_DT_NUM + XT_DT_NUM: +00063d 3852 .dw PFA_DOCONSTANT + PFA_DT_NUM: + .endif +00063e 019a .dw XT_NOOP ; interpret +00063f 0772 .dw XT_LITERAL ; compile +000640 0772 .dw XT_LITERAL ; postpone + + ; ( -- addr ) + ; Interpreter + ; Method table for double cell integers + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_DT_DNUM: +000641 ff07 .dw $ff07 +000642 7464 +000643 643a +000644 756e +000645 006d .db "dt:dnum",0 +000646 0638 .dw VE_HEAD + .set VE_HEAD = VE_DT_DNUM + XT_DT_DNUM: +000647 3852 .dw PFA_DOCONSTANT + PFA_DT_DNUM: + .endif +000648 019a .dw XT_NOOP ; interpret +000649 3fd7 .dw XT_2LITERAL ; compile +00064a 3fd7 .dw XT_2LITERAL ; postpone + + ; ( addr len -- f ) + ; Interpreter + ; recognizer for integer numbers + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + + VE_REC_NUM: +00064b ff07 .dw $ff07 +00064c 6572 +00064d 3a63 +00064e 756e +00064f 006d .db "rec:num",0 +000650 0641 .dw VE_HEAD + .set VE_HEAD = VE_REC_NUM + XT_REC_NUM: +000651 3801 .dw DO_COLON + PFA_REC_NUM: + .endif + ; try converting to a number +000652 04f0 .dw XT_NUMBER +000653 3836 .dw XT_DOCONDBRANCH +000654 065d DEST(PFA_REC_NONUMBER) +000655 3fe6 .dw XT_ONE +000656 3fdf .dw XT_EQUAL +000657 3836 .dw XT_DOCONDBRANCH +000658 065b DEST(PFA_REC_INTNUM2) +000659 063d .dw XT_DT_NUM +00065a 3820 .dw XT_EXIT + PFA_REC_INTNUM2: +00065b 0647 .dw XT_DT_DNUM +00065c 3820 .dw XT_EXIT + PFA_REC_NONUMBER: +00065d 068b .dw XT_DT_NULL +00065e 3820 .dw XT_EXIT + .include "words/rec-find.asm" + + ; Interpreter + ; search for a word + .if cpu_msp430==1 + .endif + .if cpu_avr8==1 + VE_REC_FIND: +00065f ff08 .dw $ff08 +000660 6572 +000661 3a63 +000662 6966 +000663 646e .db "rec:find" +000664 064b .dw VE_HEAD + .set VE_HEAD = VE_REC_FIND + XT_REC_FIND: +000665 3801 .dw DO_COLON + PFA_REC_FIND: + .endif +000666 0700 .DW XT_FINDXT +000667 38b1 .dw XT_DUP +000668 391a .dw XT_ZEROEQUAL +000669 3836 .dw XT_DOCONDBRANCH +00066a 066e DEST(PFA_REC_WORD_FOUND) +00066b 38d9 .dw XT_DROP +00066c 068b .dw XT_DT_NULL +00066d 3820 .dw XT_EXIT + PFA_REC_WORD_FOUND: +00066e 0675 .dw XT_DT_XT + +00066f 3820 .dw XT_EXIT + + ; ( -- addr ) + ; Interpreter + ; actions to handle execution tokens and their flags + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_DT_XT: +000670 ff05 .dw $ff05 +000671 7464 +000672 783a +000673 0074 .db "dt:xt",0 +000674 065f .dw VE_HEAD + .set VE_HEAD = VE_DT_XT + XT_DT_XT: +000675 3852 .dw PFA_DOCONSTANT + PFA_DT_XT: + .endif +000676 0679 .dw XT_R_WORD_INTERPRET +000677 067d .dw XT_R_WORD_COMPILE +000678 3fd7 .dw XT_2LITERAL + + ; ( XT flags -- ) + ; Interpreter + ; interpret method for WORD recognizer + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + XT_R_WORD_INTERPRET: +000679 3801 .dw DO_COLON + PFA_R_WORD_INTERPRET: + .endif +00067a 38d9 .dw XT_DROP ; the flags are in the way +00067b 382a .dw XT_EXECUTE +00067c 3820 .dw XT_EXIT + + ; ( XT flags -- ) + ; Interpreter + ; Compile method for WORD recognizer + .if cpu_msp430==1 + .endif + .if cpu_avr8==1 + XT_R_WORD_COMPILE: +00067d 3801 .dw DO_COLON + PFA_R_WORD_COMPILE: + .endif +00067e 3921 .dw XT_ZEROLESS +00067f 3836 .dw XT_DOCONDBRANCH +000680 0683 DEST(PFA_R_WORD_COMPILE1) +000681 075c .dw XT_COMMA +000682 3820 .dw XT_EXIT + PFA_R_WORD_COMPILE1: +000683 382a .dw XT_EXECUTE +000684 3820 .dw XT_EXIT + .include "words/dt-null.asm" + + ; Interpreter + ; there is no parser for this recognizer, this is the default and failsafe part + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_DT_NULL: +000685 ff07 .dw $ff07 +000686 7464 +000687 6e3a +000688 6c75 +../../common\words/dt-null.asm(12): warning: .cseg .db misalignment - padding zero byte +000689 006c .db "dt:null" +00068a 0670 .dw VE_HEAD + .set VE_HEAD = VE_DT_NULL + XT_DT_NULL: +00068b 3852 .dw PFA_DOCONSTANT + PFA_DT_NULL: + .endif +00068c 068f .dw XT_FAIL ; interpret +00068d 068f .dw XT_FAIL ; compile +00068e 068f .dw XT_FAIL ; postpone + + ; ( addr len -- ) + ; Interpreter + ; default failure action: throw exception -13. + .if cpu_msp430==1 + .endif + .if cpu_avr8==1 + ;VE_FAIL: + ; .dw $ff04 + ; .db "fail" + ; .dw VE_HEAD + ; .set VE_HEAD = VE_FAIL + XT_FAIL: +00068f 3801 .dw DO_COLON + PFA_FAIL: + .endif +000690 383d .dw XT_DOLITERAL +000691 fff3 .dw -13 +000692 3d86 .dw XT_THROW + .include "words/search-wordlist.asm" + + ; Search Order + ; searches the word list wid for the word at c-addr/len + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_SEARCH_WORDLIST: +000693 ff0f .dw $ff0f +000694 6573 +000695 7261 +000696 6863 +000697 772d +000698 726f +000699 6c64 +00069a 7369 +00069b 0074 .db "search-wordlist",0 +00069c 0685 .dw VE_HEAD + .set VE_HEAD = VE_SEARCH_WORDLIST + XT_SEARCH_WORDLIST: +00069d 3801 .dw DO_COLON + PFA_SEARCH_WORDLIST: + .endif +00069e 38ff .dw XT_TO_R +00069f 3954 .dw XT_ZERO +0006a0 383d .dw XT_DOLITERAL +0006a1 06b2 .dw XT_ISWORD +0006a2 38f6 .dw XT_R_FROM +0006a3 06cf .dw XT_TRAVERSEWORDLIST +0006a4 38b1 .dw XT_DUP +0006a5 391a .dw XT_ZEROEQUAL +0006a6 3836 .dw XT_DOCONDBRANCH +0006a7 06ac DEST(PFA_SEARCH_WORDLIST1) +0006a8 3ed2 .dw XT_2DROP +0006a9 38d9 .dw XT_DROP +0006aa 3954 .dw XT_ZERO +0006ab 3820 .dw XT_EXIT + PFA_SEARCH_WORDLIST1: + ; ... get the XT ... +0006ac 38b1 .dw XT_DUP +0006ad 06f6 .dw XT_NFA2CFA + ; .. and get the header flag +0006ae 38c4 .dw XT_SWAP +0006af 0175 .dw XT_NAME2FLAGS +0006b0 0163 .dw XT_IMMEDIATEQ +0006b1 3820 .dw XT_EXIT + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + XT_ISWORD: +0006b2 3801 .dw DO_COLON + PFA_ISWORD: + .endif + ; ( c-addr len 0 nt -- c-addr len 0 true| nt false ) +0006b3 38ff .dw XT_TO_R +0006b4 38d9 .dw XT_DROP +0006b5 3ec9 .dw XT_2DUP +0006b6 3908 .dw XT_R_FETCH ; -- addr len addr len nt +0006b7 06ea .dw XT_NAME2STRING +0006b8 01cf .dw XT_ICOMPARE ; (-- addr len f ) +0006b9 3836 .dw XT_DOCONDBRANCH +0006ba 06c0 DEST(PFA_ISWORD3) + ; not now +0006bb 38f6 .dw XT_R_FROM +0006bc 38d9 .dw XT_DROP +0006bd 3954 .dw XT_ZERO +0006be 394b .dw XT_TRUE ; maybe next word +0006bf 3820 .dw XT_EXIT + PFA_ISWORD3: + ; we found the word, now clean up iteration data ... +0006c0 3ed2 .dw XT_2DROP +0006c1 38f6 .dw XT_R_FROM +0006c2 3954 .dw XT_ZERO ; finish traverse-wordlist +0006c3 3820 .dw XT_EXIT + .include "words/traverse-wordlist.asm" + + ; Tools Ext (2012) + ; call the xt for every member of the wordlist wid until xt returns false + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_TRAVERSEWORDLIST: +0006c4 ff11 .dw $ff11 +0006c5 7274 +0006c6 7661 +0006c7 7265 +0006c8 6573 +0006c9 772d +0006ca 726f +0006cb 6c64 +0006cc 7369 +0006cd 0074 .db "traverse-wordlist",0 +0006ce 0693 .dw VE_HEAD + .set VE_HEAD = VE_TRAVERSEWORDLIST + XT_TRAVERSEWORDLIST: +0006cf 3801 .dw DO_COLON + PFA_TRAVERSEWORDLIST: + + .endif +0006d0 3b5f .dw XT_FETCHE + PFA_TRAVERSEWORDLIST1: +0006d1 38b1 .dw XT_DUP ; ( -- xt nt nt ) +0006d2 3836 .dw XT_DOCONDBRANCH ; ( -- nt ) is nfa = counted string +0006d3 06e0 DEST(PFA_TRAVERSEWORDLIST2) +0006d4 3ec9 .dw XT_2DUP +0006d5 3b1e .dw XT_2TO_R +0006d6 38c4 .dw XT_SWAP +0006d7 382a .dw XT_EXECUTE +0006d8 3b2d .dw XT_2R_FROM +0006d9 38e1 .dw XT_ROT +0006da 3836 .dw XT_DOCONDBRANCH +0006db 06e0 DEST(PFA_TRAVERSEWORDLIST2) +0006dc 0a0b .dw XT_NFA2LFA +0006dd 3bcb .dw XT_FETCHI +0006de 382f .dw XT_DOBRANCH ; ( -- addr ) +0006df 06d1 DEST(PFA_TRAVERSEWORDLIST1) ; ( -- addr ) + PFA_TRAVERSEWORDLIST2: +0006e0 3ed2 .dw XT_2DROP +0006e1 3820 .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 ; + .include "words/name2string.asm" + + ; Tools Ext (2012) + ; get a (flash) string from a name token nt + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_NAME2STRING: +0006e2 ff0b .dw $ff0b +0006e3 616e +0006e4 656d +0006e5 733e +0006e6 7274 +0006e7 6e69 +0006e8 0067 .db "name>string",0 +0006e9 06c4 .dw VE_HEAD + .set VE_HEAD = VE_NAME2STRING + XT_NAME2STRING: +0006ea 3801 .dw DO_COLON + PFA_NAME2STRING: + + .endif +0006eb 0424 .dw XT_ICOUNT ; ( -- addr n ) +0006ec 383d .dw XT_DOLITERAL +0006ed 00ff .dw 255 +0006ee 3a13 .dw XT_AND ; mask immediate bit +0006ef 3820 .dw XT_EXIT + .include "words/nfa2cfa.asm" + + ; Tools + ; get the XT from a name token + VE_NFA2CFA: +0006f0 ff07 .dw $ff07 +0006f1 666e +0006f2 3e61 +0006f3 6663 +../../avr8\words/nfa2cfa.asm(6): warning: .cseg .db misalignment - padding zero byte +0006f4 0061 .db "nfa>cfa" +0006f5 06e2 .dw VE_HEAD + .set VE_HEAD = VE_NFA2CFA + XT_NFA2CFA: +0006f6 3801 .dw DO_COLON + PFA_NFA2CFA: +0006f7 0a0b .dw XT_NFA2LFA ; skip to link field +0006f8 3a2f .dw XT_1PLUS ; next is the execution token +0006f9 3820 .dw XT_EXIT + .include "words/find-xt.asm" + + ; Tools + ; search wordlists for an entry with the xt from c-addr/len + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_FINDXT: +0006fa ff07 .dw $ff07 +0006fb 6966 +0006fc 646e +0006fd 782d +0006fe 0074 .db "find-xt",0 +0006ff 06f0 .dw VE_HEAD + .set VE_HEAD = VE_FINDXT + XT_FINDXT: +000700 3801 .dw DO_COLON + PFA_FINDXT: + .endif +000701 383d .dw XT_DOLITERAL +000702 070c .dw XT_FINDXTA +000703 383d .dw XT_DOLITERAL +000704 0040 .dw CFG_ORDERLISTLEN +000705 099c .dw XT_MAPSTACK +000706 391a .dw XT_ZEROEQUAL +000707 3836 .dw XT_DOCONDBRANCH +000708 070b DEST(PFA_FINDXT1) +000709 3ed2 .dw XT_2DROP +00070a 3954 .dw XT_ZERO + PFA_FINDXT1: +00070b 3820 .dw XT_EXIT + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + + XT_FINDXTA: +00070c 3801 .dw DO_COLON + PFA_FINDXTA: + .endif +00070d 38ff .dw XT_TO_R +00070e 3ec9 .dw XT_2DUP +00070f 38f6 .dw XT_R_FROM +000710 069d .dw XT_SEARCH_WORDLIST +000711 38b1 .dw XT_DUP +000712 3836 .dw XT_DOCONDBRANCH +000713 0719 DEST(PFA_FINDXTA1) +000714 38ff .dw XT_TO_R +000715 38f0 .dw XT_NIP +000716 38f0 .dw XT_NIP +000717 38f6 .dw XT_R_FROM +000718 394b .dw XT_TRUE + PFA_FINDXTA1: +000719 3820 .dw XT_EXIT + + .include "dict/compiler1.inc" + + .include "words/newest.asm" + + ; System Variable + ; system state + VE_NEWEST: +00071a ff06 .dw $ff06 +00071b 656e +00071c 6577 +00071d 7473 .db "newest" +00071e 06fa .dw VE_HEAD + .set VE_HEAD = VE_NEWEST + XT_NEWEST: +00071f 3848 .dw PFA_DOVARIABLE + PFA_NEWEST: +000720 00e5 .dw ram_newest + + .dseg +0000e5 ram_newest: .byte 4 + .include "words/latest.asm" + + ; System Variable + ; system state + VE_LATEST: +000721 ff06 .dw $ff06 +000722 616c +000723 6574 +000724 7473 .db "latest" +000725 071a .dw VE_HEAD + .set VE_HEAD = VE_LATEST + XT_LATEST: +000726 3848 .dw PFA_DOVARIABLE + PFA_LATEST: +000727 00e9 .dw ram_latest + + .dseg +0000e9 ram_latest: .byte 2 + .include "words/do-create.asm" + + ; Compiler + ; parse the input and create an empty vocabulary entry without XT and data field (PF) + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_DOCREATE: +000728 ff08 .dw $ff08 +000729 6328 +00072a 6572 +00072b 7461 +00072c 2965 .db "(create)" +00072d 0721 .dw VE_HEAD + .set VE_HEAD = VE_DOCREATE + XT_DOCREATE: +00072e 3801 .dw DO_COLON + PFA_DOCREATE: + .endif +00072f 05b0 +000730 0885 .DW XT_PARSENAME,XT_WLSCOPE ; ( -- addr len wid) +000731 38b1 +000732 071f +000733 3c90 +000734 3881 .DW XT_DUP,XT_NEWEST,XT_CELLPLUS,XT_STORE ; save the wid +000735 086a +000736 071f +000737 3881 .DW XT_HEADER,XT_NEWEST,XT_STORE ; save the nt +000738 3820 .DW XT_EXIT + .include "words/backslash.asm" + + ; Compiler + ; everything up to the end of the current line is a comment + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_BACKSLASH: +000739 0001 .dw $0001 +00073a 005c .db $5c,0 +00073b 0728 .dw VE_HEAD + .set VE_HEAD = VE_BACKSLASH + XT_BACKSLASH: +00073c 3801 .dw DO_COLON + PFA_BACKSLASH: + .endif +00073d 0597 .dw XT_SOURCE +00073e 38f0 .dw XT_NIP +00073f 3ee2 .dw XT_TO_IN +000740 3881 .dw XT_STORE +000741 3820 .dw XT_EXIT + .include "words/l-paren.asm" + + ; Compiler + ; skip everything up to the closing bracket on the same line + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_LPAREN: +000742 0001 .dw $0001 +000743 0028 .db "(" ,0 +000744 0739 .dw VE_HEAD + .set VE_HEAD = VE_LPAREN + XT_LPAREN: +000745 3801 .dw DO_COLON + PFA_LPAREN: + .endif +000746 383d .dw XT_DOLITERAL +000747 0029 .dw ')' +000748 0583 .dw XT_PARSE +000749 3ed2 .dw XT_2DROP +00074a 3820 .dw XT_EXIT + + .include "words/compile.asm" + + ; Dictionary + ; read the following cell from the dictionary and append it to the current dictionary position. + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_COMPILE: +00074b ff07 .dw $ff07 +00074c 6f63 +00074d 706d +00074e 6c69 +00074f 0065 .db "compile",0 +000750 0742 .dw VE_HEAD + .set VE_HEAD = VE_COMPILE + XT_COMPILE: +000751 3801 .dw DO_COLON + PFA_COMPILE: + .endif +000752 38f6 .dw XT_R_FROM +000753 38b1 .dw XT_DUP +000754 01c6 .dw XT_ICELLPLUS +000755 38ff .dw XT_TO_R +000756 3bcb .dw XT_FETCHI +000757 075c .dw XT_COMMA +000758 3820 .dw XT_EXIT + .include "words/comma.asm" + + ; Dictionary + ; compile 16 bit into flash at DP + VE_COMMA: +000759 ff01 .dw $ff01 +00075a 002c .db ',',0 ; , +00075b 074b .dw VE_HEAD + .set VE_HEAD = VE_COMMA + XT_COMMA: +00075c 3801 .dw DO_COLON + PFA_COMMA: +00075d 3f12 .dw XT_DP +00075e 3b73 .dw XT_STOREI +00075f 3f12 .dw XT_DP +000760 3a2f .dw XT_1PLUS +000761 01b4 .dw XT_DOTO +000762 3f13 .dw PFA_DP +000763 3820 .dw XT_EXIT + .include "words/brackettick.asm" + + ; Compiler + ; what ' does in the interpreter mode, do in colon definitions + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_BRACKETTICK: +000764 0003 .dw $0003 +000765 275b +000766 005d .db "[']",0 +000767 0759 .dw VE_HEAD + .set VE_HEAD = VE_BRACKETTICK + XT_BRACKETTICK: +000768 3801 .dw DO_COLON + PFA_BRACKETTICK: + .endif +000769 043d .dw XT_TICK +00076a 0772 .dw XT_LITERAL +00076b 3820 .dw XT_EXIT + + + .include "words/literal.asm" + + ; Compiler + ; compile a literal in colon defintions + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_LITERAL: +00076c 0007 .dw $0007 +00076d 696c +00076e 6574 +00076f 6172 +000770 006c .db "literal",0 +000771 0764 .dw VE_HEAD + .set VE_HEAD = VE_LITERAL + XT_LITERAL: +000772 3801 .dw DO_COLON + PFA_LITERAL: + .endif +000773 0751 .DW XT_COMPILE +000774 383d .DW XT_DOLITERAL +000775 075c .DW XT_COMMA +000776 3820 .DW XT_EXIT + .include "words/sliteral.asm" + + ; String + ; compiles a string to flash, at runtime leaves ( -- flash-addr count) on stack + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_SLITERAL: +000777 0008 .dw $0008 +000778 6c73 +000779 7469 +00077a 7265 +00077b 6c61 .db "sliteral" +00077c 076c .dw VE_HEAD + .set VE_HEAD = VE_SLITERAL + XT_SLITERAL: +00077d 3801 .dw DO_COLON + PFA_SLITERAL: + .endif +00077e 0751 .dw XT_COMPILE +00077f 03c5 .dw XT_DOSLITERAL ; ( -- addr n) +000780 03d3 .dw XT_SCOMMA +000781 3820 .dw XT_EXIT + .include "words/g-mark.asm" + + ; Compiler + ; places current dictionary position for backward resolves + ;VE_GMARK: + ; .dw $ff05 + ; .db ">mark" + ; .dw VE_HEAD + ; .set VE_HEAD = VE_GMARK + XT_GMARK: +000782 3801 .dw DO_COLON + PFA_GMARK: +000783 3f12 .dw XT_DP +000784 0751 .dw XT_COMPILE +000785 ffff .dw -1 ; ffff does not erase flash +000786 3820 .dw XT_EXIT + .include "words/g-resolve.asm" + + ; Compiler + ; resolve backward jumps + ;VE_GRESOLVE: + ; .dw $ff08 + ; .db ">resolve" + ; .dw VE_HEAD + ; .set VE_HEAD = VE_GRESOLVE + XT_GRESOLVE: +000787 3801 .dw DO_COLON + PFA_GRESOLVE: +000788 3f8b .dw XT_QSTACK +000789 3f12 .dw XT_DP +00078a 38c4 .dw XT_SWAP +00078b 3b73 .dw XT_STOREI +00078c 3820 .dw XT_EXIT + .include "words/l_mark.asm" + + ; Compiler + ; place destination for backward branch + ;VE_LMARK: + ; .dw $ff05 + ; .db "r if 2drop then r> invert ; + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + XT_QDOCHECK: +00081b 3801 .dw DO_COLON + PFA_QDOCHECK: + .endif +00081c 3ec9 .dw XT_2DUP +00081d 3fdf .dw XT_EQUAL +00081e 38b1 .dw XT_DUP +00081f 38ff .dw XT_TO_R +000820 3836 .dw XT_DOCONDBRANCH +000821 0823 DEST(PFA_QDOCHECK1) +000822 3ed2 .dw XT_2DROP + PFA_QDOCHECK1: +000823 38f6 .dw XT_R_FROM +000824 39fd .dw XT_INVERT +000825 3820 .dw XT_EXIT + .include "words/endloop.asm" + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_ENDLOOP: +000826 ff07 .dw $ff07 +000827 6e65 +000828 6c64 +000829 6f6f +00082a 0070 .db "endloop",0 +00082b 080f .dw VE_HEAD + .set VE_HEAD = VE_ENDLOOP + XT_ENDLOOP: +00082c 3801 .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. + +00082d 0790 .DW XT_LRESOLVE +00082e 0839 +00082f 38b9 +000830 3836 LOOP1: .DW XT_L_FROM,XT_QDUP,XT_DOCONDBRANCH +000831 0835 DEST(LOOP2) +000832 07b5 .DW XT_THEN +000833 382f .dw XT_DOBRANCH +000834 082e DEST(LOOP1) +000835 3820 LOOP2: .DW XT_EXIT + ; leave address stack + .include "words/l-from.asm" + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_L_FROM: +000836 ff02 .dw $ff02 +000837 3e6c .db "l>" +000838 0826 .dw VE_HEAD + .set VE_HEAD = VE_L_FROM + XT_L_FROM: +000839 3801 .dw DO_COLON + PFA_L_FROM: + + .endif + ;Z L> -- x L: x -- move from leave stack + ; LP @ @ -2 LP +! ; + +00083a 0858 .dw XT_LP +00083b 3879 .dw XT_FETCH +00083c 3879 .dw XT_FETCH +00083d 383d .dw XT_DOLITERAL +00083e fffe .dw -2 +00083f 0858 .dw XT_LP +000840 3a65 .dw XT_PLUSSTORE +000841 3820 .dw XT_EXIT + .include "words/to-l.asm" + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_TO_L: +000842 ff02 .dw $ff02 +000843 6c3e .db ">l" +000844 0836 .dw VE_HEAD + .set VE_HEAD = VE_TO_L + XT_TO_L: +000845 3801 .dw DO_COLON + PFA_TO_L: + .endif + ;Z >L x -- L: -- x move to leave stack + ; CELL LP +! LP @ ! ; (L stack grows up) + +000846 3feb .dw XT_TWO +000847 0858 .dw XT_LP +000848 3a65 .dw XT_PLUSSTORE +000849 0858 .dw XT_LP +00084a 3879 .dw XT_FETCH +00084b 3881 .dw XT_STORE +00084c 3820 .dw XT_EXIT + .include "words/lp0.asm" + + ; Stack + ; start address of leave stack + VE_LP0: +00084d ff03 .dw $ff03 +00084e 706c +00084f 0030 .db "lp0",0 +000850 0842 .dw VE_HEAD + .set VE_HEAD = VE_LP0 + XT_LP0: +000851 386f .dw PFA_DOVALUE1 + PFA_LP0: +000852 0036 .dw CFG_LP0 +000853 3da0 .dw XT_EDEFERFETCH +000854 3daa .dw XT_EDEFERSTORE + .include "words/lp.asm" + + ; System Variable + ; leave stack pointer + VE_LP: +000855 ff02 .dw $ff02 +000856 706c .db "lp" +000857 084d .dw VE_HEAD + .set VE_HEAD = VE_LP + XT_LP: +000858 3848 .dw PFA_DOVARIABLE + PFA_LP: +000859 00eb .dw ram_lp + + .dseg +0000eb ram_lp: .byte 2 + .cseg + + + .include "words/create.asm" + + ; Dictionary + ; create a dictionary header. XT is (constant), with the address of the data field of name + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_CREATE: +00085a ff06 .dw $ff06 +00085b 7263 +00085c 6165 +00085d 6574 .db "create" +00085e 0855 .dw VE_HEAD + .set VE_HEAD = VE_CREATE + XT_CREATE: +00085f 3801 .dw DO_COLON + PFA_CREATE: + .endif +000860 072e .dw XT_DOCREATE +000861 088e .dw XT_REVEAL +000862 0751 .dw XT_COMPILE +000863 3852 .dw PFA_DOCONSTANT +000864 3820 .dw XT_EXIT + .include "words/header.asm" + + ; Compiler + ; creates the vocabulary header without XT and data field (PF) in the wordlist wid + VE_HEADER: +000865 ff06 .dw $ff06 +000866 6568 +000867 6461 +000868 7265 .db "header" +000869 085a .dw VE_HEAD + .set VE_HEAD = VE_HEADER + XT_HEADER: +00086a 3801 .dw DO_COLON + PFA_HEADER: +00086b 3f12 .dw XT_DP ; the new Name Field +00086c 38ff .dw XT_TO_R +00086d 38ff .dw XT_TO_R ; ( R: NFA WID ) +00086e 38b1 .dw XT_DUP +00086f 3928 .dw XT_GREATERZERO +000870 3836 .dw XT_DOCONDBRANCH +000871 087c .dw PFA_HEADER1 +000872 38b1 .dw XT_DUP +000873 383d .dw XT_DOLITERAL +000874 ff00 .dw $ff00 ; all flags are off (e.g. immediate) +000875 3a1c .dw XT_OR +000876 03d7 .dw XT_DOSCOMMA + ; make the link to the previous entry in this wordlist +000877 38f6 .dw XT_R_FROM +000878 3b5f .dw XT_FETCHE +000879 075c .dw XT_COMMA +00087a 38f6 .dw XT_R_FROM +00087b 3820 .dw XT_EXIT + + PFA_HEADER1: + ; -16: attempt to use zero length string as a name +00087c 383d .dw XT_DOLITERAL +00087d fff0 .dw -16 +00087e 3d86 .dw XT_THROW + + .include "words/wlscope.asm" + + ; Compiler + ; dynamically place a word in a wordlist. The word name may be changed. + VE_WLSCOPE: +00087f ff07 .dw $ff07 +000880 6c77 +000881 6373 +000882 706f +000883 0065 .db "wlscope",0 +000884 0865 .dw VE_HEAD + .set VE_HEAD = VE_WLSCOPE + XT_WLSCOPE: +000885 3dff .dw PFA_DODEFER1 + PFA_WLSCOPE: +000886 0032 .dw CFG_WLSCOPE +000887 3da0 .dw XT_EDEFERFETCH +000888 3daa .dw XT_EDEFERSTORE + + ; wlscope, "wordlist scope" ( addr len -- addr' len' wid ), is a deferred word + ; which enables the AmForth application to choose the wordlist ( wid ) for the + ; new voc entry based on the input ( addr len ) string. The name of the new voc + ; entry ( addr' len' ) may be different from the input string. Note that all + ; created voc entry types pass through the wlscope mechanism. The default + ; wlscope action passes the input string to the output without modification and + ; uses get-current to select the wid. + .include "words/reveal.asm" + + ; Dictionary + ; makes an entry in a wordlist visible, if not already done. + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_REVEAL: +000889 ff06 .dw $ff06 +00088a 6572 +00088b 6576 +00088c 6c61 .db "reveal" +00088d 087f .dw VE_HEAD + .set VE_HEAD = VE_REVEAL + XT_REVEAL: +00088e 3801 .dw DO_COLON + PFA_REVEAL: + .endif +00088f 071f +000890 3c90 +000891 3879 .DW XT_NEWEST,XT_CELLPLUS,XT_FETCH ; only if wordlist is in use +000892 38b9 +000893 3836 .DW XT_QDUP,XT_DOCONDBRANCH +000894 0899 DEST(REVEAL1) +000895 071f +000896 3879 +000897 38c4 +000898 3b3b .DW XT_NEWEST,XT_FETCH,XT_SWAP,XT_STOREE + ; .DW XT_ZERO,XT_NEWEST,XT_CELLPLUS,XT_STORE ; clean wordlist entry + REVEAL1: +000899 3820 .DW XT_EXIT + .include "words/does.asm" + + ; Compiler + ; organize the XT replacement to call other colon code + VE_DOES: +00089a 0005 .dw $0005 +00089b 6f64 +00089c 7365 +00089d 003e .db "does>",0 +00089e 0889 .dw VE_HEAD + .set VE_HEAD = VE_DOES + XT_DOES: +00089f 3801 .dw DO_COLON + PFA_DOES: +0008a0 0751 .dw XT_COMPILE +0008a1 08b2 .dw XT_DODOES +0008a2 0751 .dw XT_COMPILE ; create a code snippet to be used in an embedded XT +0008a3 940e .dw $940e ; the address of this compiled +0008a4 0751 .dw XT_COMPILE ; code will replace the XT of the +0008a5 08a7 .dw DO_DODOES ; word that CREATE created +0008a6 3820 .dw XT_EXIT ; + + DO_DODOES: ; ( -- PFA ) +0008a7 939a +0008a8 938a savetos +0008a9 01cb movw tosl, wl +0008aa 9601 adiw tosl, 1 + ; the following takes the address from a real uC-call + .if (pclen==3) + .endif +0008ab 917f pop wh +0008ac 916f pop wl + +0008ad 93bf push XH +0008ae 93af push XL +0008af 01db movw XL, wl +0008b0 940c 3805 jmp_ DO_NEXT + + ; ( -- ) + ; System + ; replace the XT written by CREATE to call the code that follows does> + ;VE_DODOES: + ; .dw $ff07 + ; .db "(does>)" + ; .set VE_HEAD = VE_DODOES + XT_DODOES: +0008b2 3801 .dw DO_COLON + PFA_DODOES: +0008b3 38f6 .dw XT_R_FROM +0008b4 071f .dw XT_NEWEST +0008b5 3c90 .dw XT_CELLPLUS +0008b6 3879 .dw XT_FETCH +0008b7 3b5f .dw XT_FETCHE +0008b8 06f6 .dw XT_NFA2CFA +0008b9 3b73 .dw XT_STOREI +0008ba 3820 .dw XT_EXIT + .include "words/colon.asm" + + ; Compiler + ; create a named entry in the dictionary, XT is DO_COLON + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_COLON: +0008bb ff01 .dw $ff01 +0008bc 003a .db ":",0 +0008bd 089a .dw VE_HEAD + .set VE_HEAD = VE_COLON + XT_COLON: +0008be 3801 .dw DO_COLON + PFA_COLON: + .endif +0008bf 072e .dw XT_DOCREATE +0008c0 08c9 .dw XT_COLONNONAME +0008c1 38d9 .dw XT_DROP +0008c2 3820 .dw XT_EXIT + .include "words/colon-noname.asm" + + ; Compiler + ; create an unnamed entry in the dictionary, XT is DO_COLON + VE_COLONNONAME: +0008c3 ff07 .dw $ff07 +0008c4 6e3a +0008c5 6e6f +0008c6 6d61 +0008c7 0065 .db ":noname",0 +0008c8 08bb .dw VE_HEAD + .set VE_HEAD = VE_COLONNONAME + XT_COLONNONAME: +0008c9 3801 .dw DO_COLON + PFA_COLONNONAME: +0008ca 3f12 .dw XT_DP +0008cb 38b1 .dw XT_DUP +0008cc 0726 .dw XT_LATEST +0008cd 3881 .dw XT_STORE + +0008ce 0751 .dw XT_COMPILE +0008cf 3801 .dw DO_COLON + +0008d0 08de .dw XT_RBRACKET +0008d1 3820 .dw XT_EXIT + .include "words/semicolon.asm" + + ; Compiler + ; finish colon defintion, compiles (exit) and returns to interpret state + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + + + VE_SEMICOLON: +0008d2 0001 .dw $0001 +0008d3 003b .db $3b,0 +0008d4 08c3 .dw VE_HEAD + .set VE_HEAD = VE_SEMICOLON + XT_SEMICOLON: +0008d5 3801 .dw DO_COLON + PFA_SEMICOLON: + .endif +0008d6 0751 .dw XT_COMPILE +0008d7 3820 .dw XT_EXIT +0008d8 08e6 .dw XT_LBRACKET +0008d9 088e .dw XT_REVEAL +0008da 3820 .dw XT_EXIT + .include "words/right-bracket.asm" + + ; Compiler + ; enter compiler mode + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_RBRACKET: +0008db ff01 .dw $ff01 +0008dc 005d .db "]",0 +0008dd 08d2 .dw VE_HEAD + .set VE_HEAD = VE_RBRACKET + XT_RBRACKET: +0008de 3801 .dw DO_COLON + PFA_RBRACKET: + .endif +0008df 3fe6 .dw XT_ONE +0008e0 3eb7 .dw XT_STATE +0008e1 3881 .dw XT_STORE +0008e2 3820 .dw XT_EXIT + .include "words/left-bracket.asm" + + ; Compiler + ; enter interpreter mode + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_LBRACKET: +0008e3 0001 .dw $0001 +0008e4 005b .db "[",0 +0008e5 08db .dw VE_HEAD + .set VE_HEAD = VE_LBRACKET + XT_LBRACKET: +0008e6 3801 .dw DO_COLON + PFA_LBRACKET: + .endif +0008e7 3954 .dw XT_ZERO +0008e8 3eb7 .dw XT_STATE +0008e9 3881 .dw XT_STORE +0008ea 3820 .dw XT_EXIT + .include "words/variable.asm" + + ; Compiler + ; create a dictionary entry for a variable and allocate 1 cell RAM + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + + VE_VARIABLE: +0008eb ff08 .dw $ff08 +0008ec 6176 +0008ed 6972 +0008ee 6261 +0008ef 656c .db "variable" +0008f0 08e3 .dw VE_HEAD + .set VE_HEAD = VE_VARIABLE + XT_VARIABLE: +0008f1 3801 .dw DO_COLON + PFA_VARIABLE: + .endif +0008f2 3f23 .dw XT_HERE +0008f3 08fd .dw XT_CONSTANT +0008f4 3feb .dw XT_TWO +0008f5 3f2c .dw XT_ALLOT +0008f6 3820 .dw XT_EXIT + .include "words/constant.asm" + + ; Compiler + ; create a constant in the dictionary + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + + VE_CONSTANT: +0008f7 ff08 .dw $ff08 +0008f8 6f63 +0008f9 736e +0008fa 6174 +0008fb 746e .db "constant" +0008fc 08eb .dw VE_HEAD + .set VE_HEAD = VE_CONSTANT + XT_CONSTANT: +0008fd 3801 .dw DO_COLON + PFA_CONSTANT: + .endif +0008fe 072e .dw XT_DOCREATE +0008ff 088e .dw XT_REVEAL +000900 0751 .dw XT_COMPILE +000901 3848 .dw PFA_DOVARIABLE +000902 075c .dw XT_COMMA +000903 3820 .dw XT_EXIT + .include "words/user.asm" + + ; Compiler + ; create a dictionary entry for a user variable at offset n + VE_USER: +000904 ff04 .dw $ff04 +000905 7375 +000906 7265 .db "user" +000907 08f7 .dw VE_HEAD + .set VE_HEAD = VE_USER + XT_USER: +000908 3801 .dw DO_COLON + PFA_USER: +000909 072e .dw XT_DOCREATE +00090a 088e .dw XT_REVEAL + +00090b 0751 .dw XT_COMPILE +00090c 3858 .dw PFA_DOUSER +00090d 075c .dw XT_COMMA +00090e 3820 .dw XT_EXIT + + .include "words/recurse.asm" + + ; Compiler + ; compile the XT of the word currently being defined into the dictionary + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_RECURSE: +00090f 0007 .dw $0007 +000910 6572 +000911 7563 +000912 7372 +000913 0065 .db "recurse",0 +000914 0904 .dw VE_HEAD + .set VE_HEAD = VE_RECURSE + XT_RECURSE: +000915 3801 .dw DO_COLON + PFA_RECURSE: + .endif +000916 0726 .dw XT_LATEST +000917 3879 .dw XT_FETCH +000918 075c .dw XT_COMMA +000919 3820 .dw XT_EXIT + .include "words/immediate.asm" + + ; Compiler + ; set immediate flag for the most recent word definition + VE_IMMEDIATE: +00091a ff09 .dw $ff09 +00091b 6d69 +00091c 656d +00091d 6964 +00091e 7461 +00091f 0065 .db "immediate",0 +000920 090f .dw VE_HEAD + .set VE_HEAD = VE_IMMEDIATE + XT_IMMEDIATE: +000921 3801 .dw DO_COLON + PFA_IMMEDIATE: +000922 09c3 .dw XT_GET_CURRENT +000923 3b5f .dw XT_FETCHE +000924 38b1 .dw XT_DUP +000925 3bcb .dw XT_FETCHI +000926 383d .dw XT_DOLITERAL +000927 7fff .dw $7fff +000928 3a13 .dw XT_AND +000929 38c4 .dw XT_SWAP +00092a 3b73 .dw XT_STOREI +00092b 3820 .dw XT_EXIT + + .include "words/bracketchar.asm" + + ; Tools + ; skip leading space delimites, place the first character of the word on the stack + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_BRACKETCHAR: +00092c 0006 .dw $0006 +00092d 635b +00092e 6168 +00092f 5d72 .db "[char]" +000930 091a .dw VE_HEAD + .set VE_HEAD = VE_BRACKETCHAR + XT_BRACKETCHAR: +000931 3801 .dw DO_COLON + PFA_BRACKETCHAR: + .endif +000932 0751 .dw XT_COMPILE +000933 383d .dw XT_DOLITERAL +000934 04e6 .dw XT_CHAR +000935 075c .dw XT_COMMA +000936 3820 .dw XT_EXIT + .include "words/abort-string.asm" + + ;C i*x x1 -- R: j*x -- x1<>0 + ; POSTPONE IS" POSTPONE ?ABORT ; IMMEDIATE + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_ABORTQUOTE: +000937 0006 .dw $0006 +000938 6261 +000939 726f +00093a 2274 .db "abort",'"' +00093b 092c .dw VE_HEAD + .set VE_HEAD = VE_ABORTQUOTE + XT_ABORTQUOTE: +00093c 3801 .dw DO_COLON + PFA_ABORTQUOTE: + .endif +00093d 3e8a .dw XT_SQUOTE +00093e 0751 .dw XT_COMPILE +00093f 094e .dw XT_QABORT +000940 3820 .DW XT_EXIT + .include "words/abort.asm" + + ; Exceptions + ; send an exception -1 + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_ABORT: +000941 ff05 .dw $ff05 +000942 6261 +000943 726f +000944 0074 .db "abort",0 +000945 0937 .dw VE_HEAD + .set VE_HEAD = VE_ABORT + XT_ABORT: +000946 3801 .dw DO_COLON + PFA_ABORT: + .endif +000947 394b .dw XT_TRUE +000948 3d86 .dw XT_THROW + .include "words/q-abort.asm" + + ; ROT IF ITYPE ABORT THEN 2DROP ; + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_QABORT: +000949 ff06 .dw $ff06 +00094a 613f +00094b 6f62 +00094c 7472 .db "?abort" +00094d 0941 .dw VE_HEAD + .set VE_HEAD = VE_QABORT + XT_QABORT: +00094e 3801 .dw DO_COLON + PFA_QABORT: + + .endif +00094f 38e1 +000950 3836 .DW XT_ROT,XT_DOCONDBRANCH +000951 0954 DEST(QABO1) +000952 03f8 +000953 0946 .DW XT_ITYPE,XT_ABORT +000954 3ed2 +000955 3820 QABO1: .DW XT_2DROP,XT_EXIT + + .include "words/get-stack.asm" + + ; Tools + ; Get a stack from EEPROM + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_GET_STACK: +000956 ff09 .dw $ff09 +000957 6567 +000958 2d74 +000959 7473 +00095a 6361 +00095b 006b .db "get-stack",0 +00095c 0949 .dw VE_HEAD + .set VE_HEAD = VE_GET_STACK + XT_GET_STACK: +00095d 3801 .dw DO_COLON + .endif +00095e 38b1 .dw XT_DUP +00095f 3c90 .dw XT_CELLPLUS +000960 38c4 .dw XT_SWAP +000961 3b5f .dw XT_FETCHE +000962 38b1 .dw XT_DUP +000963 38ff .dw XT_TO_R +000964 3954 .dw XT_ZERO +000965 38c4 .dw XT_SWAP ; go from bigger to smaller addresses +000966 081b .dw XT_QDOCHECK +000967 3836 .dw XT_DOCONDBRANCH +000968 0974 DEST(PFA_N_FETCH_E2) +000969 3a9b .dw XT_DODO + PFA_N_FETCH_E1: + ; ( ee-addr ) +00096a 3aac .dw XT_I +00096b 3a35 .dw XT_1MINUS +00096c 3ec4 .dw XT_CELLS ; ( -- ee-addr i*2 ) +00096d 38cf .dw XT_OVER ; ( -- ee-addr i*2 ee-addr ) +00096e 399d .dw XT_PLUS ; ( -- ee-addr ee-addr+i +00096f 3b5f .dw XT_FETCHE ;( -- ee-addr item_i ) +000970 38c4 .dw XT_SWAP ;( -- item_i ee-addr ) +000971 394b .dw XT_TRUE ; shortcut for -1 +000972 3aba .dw XT_DOPLUSLOOP +000973 096a DEST(PFA_N_FETCH_E1) + PFA_N_FETCH_E2: +000974 3ed2 .dw XT_2DROP +000975 38f6 .dw XT_R_FROM +000976 3820 .dw XT_EXIT + + .include "words/set-stack.asm" + + ; Tools + ; Write a stack to EEPROM + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_SET_STACK: +000977 ff09 .dw $ff09 +000978 6573 +000979 2d74 +00097a 7473 +00097b 6361 +00097c 006b .db "set-stack",0 +00097d 0956 .dw VE_HEAD + .set VE_HEAD = VE_SET_STACK + XT_SET_STACK: +00097e 3801 .dw DO_COLON + PFA_SET_STACK: + .endif +00097f 38cf .dw XT_OVER +000980 3921 .dw XT_ZEROLESS +000981 3836 .dw XT_DOCONDBRANCH +000982 0986 DEST(PFA_SET_STACK0) +000983 383d .dw XT_DOLITERAL +000984 fffc .dw -4 +000985 3d86 .dw XT_THROW + PFA_SET_STACK0: +000986 3ec9 .dw XT_2DUP +000987 3b3b .dw XT_STOREE ; ( -- i_n .. i_0 n e-addr ) +000988 38c4 .dw XT_SWAP +000989 3954 .dw XT_ZERO +00098a 081b .dw XT_QDOCHECK +00098b 3836 .dw XT_DOCONDBRANCH +00098c 0993 DEST(PFA_SET_STACK2) +00098d 3a9b .dw XT_DODO + PFA_SET_STACK1: +00098e 3c90 .dw XT_CELLPLUS ; ( -- i_x e-addr ) +00098f 3eda .dw XT_TUCK ; ( -- e-addr i_x e-addr +000990 3b3b .dw XT_STOREE +000991 3ac9 .dw XT_DOLOOP +000992 098e DEST(PFA_SET_STACK1) + PFA_SET_STACK2: +000993 38d9 .dw XT_DROP +000994 3820 .dw XT_EXIT + + .include "words/map-stack.asm" + + ; Tools + ; Iterate over a stack + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_MAPSTACK: +000995 ff09 .dw $ff09 +000996 616d +000997 2d70 +000998 7473 +000999 6361 +00099a 006b .db "map-stack",0 +00099b 0977 .dw VE_HEAD + .set VE_HEAD = VE_MAPSTACK + XT_MAPSTACK: +00099c 3801 .dw DO_COLON + PFA_MAPSTACK: + .endif +00099d 38b1 .dw XT_DUP +00099e 3c90 .dw XT_CELLPLUS +00099f 38c4 .dw XT_SWAP +0009a0 3b5f .dw XT_FETCHE +0009a1 3ec4 .dw XT_CELLS +0009a2 3f99 .dw XT_BOUNDS +0009a3 081b .dw XT_QDOCHECK +0009a4 3836 .dw XT_DOCONDBRANCH +0009a5 09b8 DEST(PFA_MAPSTACK3) +0009a6 3a9b .dw XT_DODO + PFA_MAPSTACK1: +0009a7 3aac .dw XT_I +0009a8 3b5f .dw XT_FETCHE ; -- i*x XT id +0009a9 38c4 .dw XT_SWAP +0009aa 38ff .dw XT_TO_R +0009ab 3908 .dw XT_R_FETCH +0009ac 382a .dw XT_EXECUTE ; i*x id -- j*y true | i*x false +0009ad 38b9 .dw XT_QDUP +0009ae 3836 .dw XT_DOCONDBRANCH +0009af 09b4 DEST(PFA_MAPSTACK2) +0009b0 38f6 .dw XT_R_FROM +0009b1 38d9 .dw XT_DROP +0009b2 3ad4 .dw XT_UNLOOP +0009b3 3820 .dw XT_EXIT + PFA_MAPSTACK2: +0009b4 38f6 .dw XT_R_FROM +0009b5 3feb .dw XT_TWO +0009b6 3aba .dw XT_DOPLUSLOOP +0009b7 09a7 DEST(PFA_MAPSTACK1) + PFA_MAPSTACK3: +0009b8 38d9 .dw XT_DROP +0009b9 3954 .dw XT_ZERO +0009ba 3820 .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 + ; ; + .include "words/get-current.asm" + + ; Search Order + ; get the wid of the current compilation word list + VE_GET_CURRENT: +0009bb ff0b .dw $ff0b +0009bc 6567 +0009bd 2d74 +0009be 7563 +0009bf 7272 +0009c0 6e65 +0009c1 0074 .db "get-current",0 +0009c2 0995 .dw VE_HEAD + .set VE_HEAD = VE_GET_CURRENT + XT_GET_CURRENT: +0009c3 3801 .dw DO_COLON + PFA_GET_CURRENT: +0009c4 383d .dw XT_DOLITERAL +0009c5 003c .dw CFG_CURRENT +0009c6 3b5f .dw XT_FETCHE +0009c7 3820 .dw XT_EXIT + .include "words/get-order.asm" + + ; Search Order + ; Get the current search order word list + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_GET_ORDER: +0009c8 ff09 .dw $ff09 +0009c9 6567 +0009ca 2d74 +0009cb 726f +0009cc 6564 +0009cd 0072 .db "get-order",0 +0009ce 09bb .dw VE_HEAD + .set VE_HEAD = VE_GET_ORDER + XT_GET_ORDER: +0009cf 3801 .dw DO_COLON + PFA_GET_ORDER: + .endif +0009d0 383d .dw XT_DOLITERAL +0009d1 0040 .dw CFG_ORDERLISTLEN +0009d2 095d .dw XT_GET_STACK +0009d3 3820 .dw XT_EXIT + .include "words/cfg-order.asm" + + ; Search Order + ; Get the current search order word list + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_CFG_ORDER: +0009d4 ff09 .dw $ff09 +0009d5 6663 +0009d6 2d67 +0009d7 726f +0009d8 6564 +0009d9 0072 .db "cfg-order",0 +0009da 09c8 .dw VE_HEAD + .set VE_HEAD = VE_CFG_ORDER + XT_CFG_ORDER: +0009db 3848 .dw PFA_DOVARIABLE + PFA_CFG_ORDER: + .endif +0009dc 0040 .dw CFG_ORDERLISTLEN + .include "words/compare.asm" + + ; String + ; compares two strings in RAM + VE_COMPARE: +0009dd ff07 .dw $ff07 +0009de 6f63 +0009df 706d +0009e0 7261 +0009e1 0065 .db "compare",0 +0009e2 09d4 .dw VE_HEAD + .set VE_HEAD = VE_COMPARE + XT_COMPARE: +0009e3 09e4 .dw PFA_COMPARE + PFA_COMPARE: +0009e4 93bf push xh +0009e5 93af push xl +0009e6 018c movw temp0, tosl +0009e7 9189 +0009e8 9199 loadtos +0009e9 01dc movw xl, tosl +0009ea 9189 +0009eb 9199 loadtos +0009ec 019c movw temp2, tosl +0009ed 9189 +0009ee 9199 loadtos +0009ef 01fc movw zl, tosl + PFA_COMPARE_LOOP: +0009f0 90ed ld temp4, X+ +0009f1 90f1 ld temp5, Z+ +0009f2 14ef cp temp4, temp5 +0009f3 f451 brne PFA_COMPARE_NOTEQUAL +0009f4 950a dec temp0 +0009f5 f019 breq PFA_COMPARE_ENDREACHED2 +0009f6 952a dec temp2 +0009f7 f7c1 brne PFA_COMPARE_LOOP +0009f8 c001 rjmp PFA_COMPARE_ENDREACHED + PFA_COMPARE_ENDREACHED2: +0009f9 952a dec temp2 + PFA_COMPARE_ENDREACHED: +0009fa 2b02 or temp0, temp2 +0009fb f411 brne PFA_COMPARE_CHECKLASTCHAR +0009fc 2788 clr tosl +0009fd c002 rjmp PFA_COMPARE_DONE + PFA_COMPARE_CHECKLASTCHAR: + PFA_COMPARE_NOTEQUAL: +0009fe ef8f ser tosl +0009ff c000 rjmp PFA_COMPARE_DONE + + PFA_COMPARE_DONE: +000a00 2f98 mov tosh, tosl +000a01 91af pop xl +000a02 91bf pop xh +000a03 940c 3805 jmp_ DO_NEXT + .include "words/nfa2lfa.asm" + + ; System + ; get the link field address from the name field address + VE_NFA2LFA: +000a05 ff07 .dw $ff07 +000a06 666e +000a07 3e61 +000a08 666c +000a09 0061 .db "nfa>lfa",0 +000a0a 09dd .dw VE_HEAD + .set VE_HEAD = VE_NFA2LFA + XT_NFA2LFA: +000a0b 3801 .dw DO_COLON + PFA_NFA2LFA: +000a0c 06ea .dw XT_NAME2STRING +000a0d 3a2f .dw XT_1PLUS +000a0e 3a04 .dw XT_2SLASH +000a0f 399d .dw XT_PLUS +000a10 3820 .dw XT_EXIT + .elif AMFORTH_NRWW_SIZE > 2000 + .else + .endif + .include "dict_appl.inc" + + ; they may be moved to the core dictionary if needed + .include "words/dot-s.asm" + + ; Tools + ; stack dump + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_DOTS: +000a11 ff02 .dw $ff02 +000a12 732e .db ".s" +000a13 0a05 .dw VE_HEAD + .set VE_HEAD = VE_DOTS + XT_DOTS: +000a14 3801 .dw DO_COLON + PFA_DOTS: + .endif +000a15 05e2 .dw XT_DEPTH +000a16 3e0a .dw XT_UDOT +000a17 3fae .dw XT_SPACE +000a18 05e2 .dw XT_DEPTH +000a19 3954 .dw XT_ZERO +000a1a 081b .dw XT_QDOCHECK +000a1b 3836 .dw XT_DOCONDBRANCH +000a1c 0a23 DEST(PFA_DOTS2) +000a1d 3a9b .dw XT_DODO + PFA_DOTS1: +000a1e 3aac .dw XT_I +000a1f 3c84 .dw XT_PICK +000a20 3e0a .dw XT_UDOT +000a21 3ac9 .dw XT_DOLOOP +000a22 0a1e DEST(PFA_DOTS1) + PFA_DOTS2: +000a23 3820 .dw XT_EXIT + .include "words/spirw.asm" + + ; MCU + ; SPI exchange of 1 byte + VE_SPIRW: +000a24 ff06 .dw $ff06 +000a25 2163 +000a26 7340 +000a27 6970 .db "c!@spi" +000a28 0a11 .dw VE_HEAD + .set VE_HEAD = VE_SPIRW + XT_SPIRW: +000a29 0a2a .dw PFA_SPIRW + PFA_SPIRW: +000a2a d003 rcall do_spirw +000a2b 2799 clr tosh +000a2c 940c 3805 jmp_ DO_NEXT + + do_spirw: +000a2e b98f out_ SPDR, tosl + do_spirw1: +000a2f b10e in_ temp0, SPSR +000a30 7f08 cbr temp0,7 +000a31 b90e out_ SPSR, temp0 +000a32 b10e in_ temp0, SPSR +000a33 ff07 sbrs temp0, 7 +000a34 cffa rjmp do_spirw1 ; wait until complete +000a35 b18f in_ tosl, SPDR +000a36 9508 ret + .include "words/n-spi.asm" + + ; MCU + ; read len bytes from SPI to addr + VE_N_SPIR: +000a37 ff05 .dw $ff05 +000a38 406e +000a39 7073 +000a3a 0069 .db "n@spi",0 +000a3b 0a24 .dw VE_HEAD + .set VE_HEAD = VE_N_SPIR + XT_N_SPIR: +000a3c 0a3d .dw PFA_N_SPIR + PFA_N_SPIR: +000a3d 018c movw temp0, tosl +000a3e 9189 +000a3f 9199 loadtos +000a40 01fc movw zl, tosl +000a41 01c8 movw tosl, temp0 + PFA_N_SPIR_LOOP: +000a42 b82f out_ SPDR, zerol + PFA_N_SPIR_LOOP1: +000a43 b12e in_ temp2, SPSR +000a44 ff27 sbrs temp2, SPIF +000a45 cffd rjmp PFA_N_SPIR_LOOP1 +000a46 b12f in_ temp2, SPDR +000a47 9321 st Z+, temp2 +000a48 9701 sbiw tosl, 1 +000a49 f7c1 brne PFA_N_SPIR_LOOP +000a4a 9189 +000a4b 9199 loadtos +000a4c 940c 3805 jmp_ DO_NEXT + + ; ( addr len -- ) + ; MCU + ; write len bytes to SPI from addr + VE_N_SPIW: +000a4e ff05 .dw $ff05 +000a4f 216e +000a50 7073 +000a51 0069 .db "n!spi",0 +000a52 0a37 .dw VE_HEAD + .set VE_HEAD = VE_N_SPIW + XT_N_SPIW: +000a53 0a54 .dw PFA_N_SPIW + PFA_N_SPIW: +000a54 018c movw temp0, tosl +000a55 9189 +000a56 9199 loadtos +000a57 01fc movw zl, tosl +000a58 01c8 movw tosl, temp0 + PFA_N_SPIW_LOOP: +000a59 9121 ld temp2, Z+ +000a5a b92f out_ SPDR, temp2 + PFA_N_SPIW_LOOP1: +000a5b b12e in_ temp2, SPSR +000a5c ff27 sbrs temp2, SPIF +000a5d cffd rjmp PFA_N_SPIW_LOOP1 +000a5e b12f in_ temp2, SPDR ; ignore the data +000a5f 9701 sbiw tosl, 1 +000a60 f7c1 brne PFA_N_SPIW_LOOP +000a61 9189 +000a62 9199 loadtos +000a63 940c 3805 jmp_ DO_NEXT + .include "words/applturnkey.asm" + + ; R( -- ) + ; application specific turnkey action + VE_APPLTURNKEY: +000a65 ff0b .dw $ff0b +000a66 7061 +000a67 6c70 +000a68 7574 +000a69 6e72 +000a6a 656b +000a6b 0079 .db "applturnkey",0 +000a6c 0a4e .dw VE_HEAD + .set VE_HEAD = VE_APPLTURNKEY + XT_APPLTURNKEY: +000a6d 3801 .dw DO_COLON + PFA_APPLTURNKEY: +000a6e 00bc .dw XT_USART + + .if WANT_INTERRUPTS == 1 +000a6f 3c97 .dw XT_INTON + .endif +000a70 017f .dw XT_DOT_VER +000a71 3fae .dw XT_SPACE +000a72 3eac .dw XT_F_CPU +000a73 383d .dw XT_DOLITERAL +000a74 03e8 .dw 1000 +000a75 39c2 .dw XT_UMSLASHMOD +000a76 38f0 .dw XT_NIP +000a77 3f41 .dw XT_DECIMAL +000a78 037a .dw XT_DOT +000a79 03c5 .dw XT_DOSLITERAL +000a7a 0004 .dw 4 +000a7b 486b +000a7c 207a .db "kHz " +000a7d 03f8 .dw XT_ITYPE +000a7e 3820 .dw XT_EXIT + .include "dict/compiler2.inc" + + ; included almost independently from each other + ; on a include-per-use basis + ; + .if DICT_COMPILER2 == 0 + .set DICT_COMPILER2 = 1 + + .include "words/set-current.asm" + + ; Search Order + ; set current word list to the given word list wid + VE_SET_CURRENT: +000a7f ff0b .dw $ff0b +000a80 6573 +000a81 2d74 +000a82 7563 +000a83 7272 +000a84 6e65 +000a85 0074 .db "set-current",0 +000a86 0a65 .dw VE_HEAD + .set VE_HEAD = VE_SET_CURRENT + XT_SET_CURRENT: +000a87 3801 .dw DO_COLON + PFA_SET_CURRENT: +000a88 383d .dw XT_DOLITERAL +000a89 003c .dw CFG_CURRENT +000a8a 3b3b .dw XT_STOREE +000a8b 3820 .dw XT_EXIT + .include "words/wordlist.asm" + + ; Search Order + ; create a new, empty wordlist + VE_WORDLIST: +000a8c ff08 .dw $ff08 +000a8d 6f77 +000a8e 6472 +000a8f 696c +000a90 7473 .db "wordlist" +000a91 0a7f .dw VE_HEAD + .set VE_HEAD = VE_WORDLIST + XT_WORDLIST: +000a92 3801 .dw DO_COLON + PFA_WORDLIST: +000a93 3f1b .dw XT_EHERE +000a94 3954 .dw XT_ZERO +000a95 38cf .dw XT_OVER +000a96 3b3b .dw XT_STOREE +000a97 38b1 .dw XT_DUP +000a98 3c90 .dw XT_CELLPLUS +000a99 01b4 .dw XT_DOTO +000a9a 3f1c .dw PFA_EHERE +000a9b 3820 .dw XT_EXIT + + .include "words/forth-wordlist.asm" + + ; Search Order + ; get the system default word list + VE_FORTHWORDLIST: +000a9c ff0e .dw $ff0e +000a9d 6f66 +000a9e 7472 +000a9f 2d68 +000aa0 6f77 +000aa1 6472 +000aa2 696c +000aa3 7473 .db "forth-wordlist" +000aa4 0a8c .dw VE_HEAD + .set VE_HEAD = VE_FORTHWORDLIST + XT_FORTHWORDLIST: +000aa5 3848 .dw PFA_DOVARIABLE + PFA_FORTHWORDLIST: +000aa6 003e .dw CFG_FORTHWORDLIST + .include "words/set-order.asm" + + ; Search Order + ; replace the search order list + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_SET_ORDER: +000aa7 ff09 .dw $ff09 +000aa8 6573 +000aa9 2d74 +000aaa 726f +000aab 6564 +000aac 0072 .db "set-order",0 +000aad 0a9c .dw VE_HEAD + .set VE_HEAD = VE_SET_ORDER + XT_SET_ORDER: +000aae 3801 .dw DO_COLON + PFA_SET_ORDER: + .endif +000aaf 383d .dw XT_DOLITERAL +000ab0 0040 .dw CFG_ORDERLISTLEN +000ab1 097e .dw XT_SET_STACK +000ab2 3820 .dw XT_EXIT + + .include "words/set-recognizer.asm" + + ; Interpreter + ; replace the recognizer list + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_SET_RECOGNIZERS: +000ab3 ff0f .dw $ff0f +000ab4 6573 +000ab5 2d74 +000ab6 6572 +000ab7 6f63 +000ab8 6e67 +000ab9 7a69 +000aba 7265 +000abb 0073 .db "set-recognizers",0 +000abc 0aa7 .dw VE_HEAD + .set VE_HEAD = VE_SET_RECOGNIZERS + XT_SET_RECOGNIZERS: +000abd 3801 .dw DO_COLON + PFA_SET_RECOGNIZERS: + .endif +000abe 383d .dw XT_DOLITERAL +000abf 0052 .dw CFG_RECOGNIZERLISTLEN +000ac0 097e .dw XT_SET_STACK +000ac1 3820 .dw XT_EXIT + + .include "words/get-recognizer.asm" + + ; Interpreter + ; Get the current recognizer list + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_GET_RECOGNIZERS: +000ac2 ff0f .dw $ff0f +000ac3 6567 +000ac4 2d74 +000ac5 6572 +000ac6 6f63 +000ac7 6e67 +000ac8 7a69 +000ac9 7265 +000aca 0073 .db "get-recognizers",0 +000acb 0ab3 .dw VE_HEAD + .set VE_HEAD = VE_GET_RECOGNIZERS + XT_GET_RECOGNIZERS: +000acc 3801 .dw DO_COLON + PFA_GET_RECOGNIZERS: + .endif +000acd 383d .dw XT_DOLITERAL +000ace 0052 .dw CFG_RECOGNIZERLISTLEN +000acf 095d .dw XT_GET_STACK +000ad0 3820 .dw XT_EXIT + .include "words/code.asm" + + ; Compiler + ; create named entry in the dictionary, XT is the data field + VE_CODE: +000ad1 ff04 .dw $ff04 +000ad2 6f63 +000ad3 6564 .db "code" +000ad4 0ac2 .dw VE_HEAD + .set VE_HEAD = VE_CODE + XT_CODE: +000ad5 3801 .dw DO_COLON + PFA_CODE: +000ad6 072e .dw XT_DOCREATE +000ad7 088e .dw XT_REVEAL +000ad8 3f12 .dw XT_DP +000ad9 01c6 .dw XT_ICELLPLUS +000ada 075c .dw XT_COMMA +000adb 3820 .dw XT_EXIT + .include "words/end-code.asm" + + ; Compiler + ; finish a code definition + VE_ENDCODE: +000adc ff08 .dw $ff08 +000add 6e65 +000ade 2d64 +000adf 6f63 +000ae0 6564 .db "end-code" +000ae1 0ad1 .dw VE_HEAD + .set VE_HEAD = VE_ENDCODE + XT_ENDCODE: +000ae2 3801 .dw DO_COLON + PFA_ENDCODE: +000ae3 0751 .dw XT_COMPILE +000ae4 940c .dw $940c +000ae5 0751 .dw XT_COMPILE +000ae6 3805 .dw DO_NEXT +000ae7 3820 .dw XT_EXIT + .include "words/marker.asm" + + ; System Value + ; The eeprom address until which MARKER saves and restores the eeprom data. + VE_MARKER: +000ae8 ff08 .dw $ff08 +000ae9 6d28 +000aea 7261 +000aeb 656b +000aec 2972 .db "(marker)" +000aed 0adc .dw VE_HEAD + .set VE_HEAD = VE_MARKER + XT_MARKER: +000aee 386f .dw PFA_DOVALUE1 + PFA_MARKER: +000aef 005e .dw EE_MARKER +000af0 3da0 .dw XT_EDEFERFETCH +000af1 3daa .dw XT_EDEFERSTORE + .include "words/postpone.asm" + + ; Compiler + ; Append the compilation semantics of "name" to the dictionary + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_POSTPONE: +000af2 0008 .dw $0008 +000af3 6f70 +000af4 7473 +000af5 6f70 +000af6 656e .db "postpone" +000af7 0ae8 .dw VE_HEAD + .set VE_HEAD = VE_POSTPONE + XT_POSTPONE: +000af8 3801 .dw DO_COLON + PFA_POSTPONE: + .endif +000af9 05b0 .dw XT_PARSENAME +000afa 05f3 .dw XT_FORTHRECOGNIZER +000afb 05fe .dw XT_RECOGNIZE +000afc 38b1 .dw XT_DUP +000afd 38ff .dw XT_TO_R +000afe 01c6 .dw XT_ICELLPLUS +000aff 01c6 .dw XT_ICELLPLUS +000b00 3bcb .dw XT_FETCHI +000b01 382a .dw XT_EXECUTE +000b02 38f6 .dw XT_R_FROM +000b03 01c6 .dw XT_ICELLPLUS +000b04 3bcb .dw XT_FETCHI +000b05 075c .dw XT_COMMA +000b06 3820 .dw XT_EXIT + .endif + .include "words/2r_fetch.asm" + + ; Stack + ; fetch content of TOR + VE_2R_FETCH: +000b07 ff03 .dw $ff03 +000b08 7232 +000b09 0040 .db "2r@",0 +000b0a 0af2 .dw VE_HEAD + .set VE_HEAD = VE_2R_FETCH + XT_2R_FETCH: +000b0b 0b0c .dw PFA_2R_FETCH + PFA_2R_FETCH: +000b0c 939a +000b0d 938a savetos +000b0e 91ef pop zl +000b0f 91ff pop zh +000b10 918f pop tosl +000b11 919f pop tosh +000b12 939f push tosh +000b13 938f push tosl +000b14 93ff push zh +000b15 93ef push zl +000b16 939a +000b17 938a savetos +000b18 01cf movw tosl, zl +000b19 940c 3805 jmp_ DO_NEXT + + .set DPSTART = pc + .if(pc>AMFORTH_RO_SEG) + .endif + + .org AMFORTH_RO_SEG + .include "amforth-interpreter.asm" + + + DO_COLON: +003801 93bf push XH +003802 93af push XL ; PUSH IP +003803 01db movw XL, wl +003804 9611 adiw xl, 1 + DO_NEXT: + .if WANT_INTERRUPTS == 1 +003805 14b2 cp isrflag, zerol +003806 f469 brne DO_INTERRUPT + .endif +003807 01fd movw zl, XL ; READ IP +003808 0fee +003809 1fff +00380a 9165 +00380b 9175 readflashcell wl, wh +00380c 9611 adiw XL, 1 ; INC IP + + DO_EXECUTE: +00380d 01fb movw zl, wl +00380e 0fee +00380f 1fff +003810 9105 +003811 9115 readflashcell temp0,temp1 +003812 01f8 movw zl, temp0 +003813 9409 ijmp + + .if WANT_INTERRUPTS == 1 + DO_INTERRUPT: + ; here we deal with interrupts the forth way +003814 939a +003815 938a savetos +003816 2d8b mov tosl, isrflag +003817 2799 clr tosh +003818 24bb clr isrflag +003819 ec60 ldi wl, LOW(XT_ISREXEC) +00381a e37c ldi wh, HIGH(XT_ISREXEC) +00381b cff1 rjmp DO_EXECUTE + .include "dict/nrww.inc" + + ; section together with the forth inner interpreter + + .include "words/exit.asm" + + ; Compiler + ; end of current colon word + VE_EXIT: +00381c ff04 .dw $ff04 +00381d 7865 +00381e 7469 .db "exit" +00381f 0b07 .dw VE_HEAD + .set VE_HEAD = VE_EXIT + XT_EXIT: +003820 3821 .dw PFA_EXIT + PFA_EXIT: +003821 91af pop XL +003822 91bf pop XH +003823 cfe1 jmp_ DO_NEXT + .include "words/execute.asm" + + ; System + ; execute XT + VE_EXECUTE: +003824 ff07 .dw $ff07 +003825 7865 +003826 6365 +003827 7475 +003828 0065 .db "execute",0 +003829 381c .dw VE_HEAD + .set VE_HEAD = VE_EXECUTE + XT_EXECUTE: +00382a 382b .dw PFA_EXECUTE + PFA_EXECUTE: +00382b 01bc movw wl, tosl +00382c 9189 +00382d 9199 loadtos +00382e cfde jmp_ DO_EXECUTE + .include "words/dobranch.asm" + + ; System + ; runtime of branch + ;VE_DOBRANCH: + ; .dw $ff08 + ; .db "(branch)" + ; .dw VE_HEAD + ; .set VE_HEAD = VE_DOBRANCH + XT_DOBRANCH: +00382f 3830 .dw PFA_DOBRANCH + PFA_DOBRANCH: +003830 01fd movw zl, XL +003831 0fee +003832 1fff +003833 91a5 +003834 91b5 readflashcell XL,XH +003835 cfcf jmp_ DO_NEXT + .include "words/docondbranch.asm" + + ; System + ; runtime of ?branch + ;VE_DOCONDBRANCH: + ; .dw $ff09 + ; .db "(?branch)" + ; .dw VE_HEAD + ; .set VE_HEAD = VE_DOCONDBRANCH + XT_DOCONDBRANCH: +003836 3837 .dw PFA_DOCONDBRANCH + PFA_DOCONDBRANCH: +003837 2b98 or tosh, tosl +003838 9189 +003839 9199 loadtos +00383a f3a9 brbs 1, PFA_DOBRANCH ; 1 is z flag; if tos is zero (false), do the branch +00383b 9611 adiw XL, 1 +00383c cfc8 jmp_ DO_NEXT + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + .include "words/doliteral.asm" + + ; System + ; runtime of literal + ;VE_DOLITERAL: + ; .dw $ff09 + ; .db "(literal)" + ; .dw VE_HEAD + ; .set VE_HEAD = VE_DOLITERAL + XT_DOLITERAL: +00383d 383e .dw PFA_DOLITERAL + PFA_DOLITERAL: +00383e 939a +00383f 938a savetos +003840 01fd movw zl, xl +003841 0fee +003842 1fff +003843 9185 +003844 9195 readflashcell tosl,tosh +003845 9611 adiw xl, 1 +003846 cfbe jmp_ DO_NEXT + + .include "words/dovariable.asm" + + ; System + ; puts content of parameter field (1 cell) to TOS + ;VE_DOVARIABLE: + ; .dw $ff0a + ; .db "(variable)" + ; .dw VE_HEAD + ; .set VE_HEAD = VE_DOVARIABLE + XT_DOVARIABLE: +003847 3848 .dw PFA_DOVARIABLE + PFA_DOVARIABLE: +003848 939a +003849 938a savetos +00384a 01fb movw zl, wl +00384b 9631 adiw zl,1 +00384c 0fee +00384d 1fff +00384e 9185 +00384f 9195 readflashcell tosl,tosh +003850 cfb4 jmp_ DO_NEXT + .include "words/doconstant.asm" + + ; System + ; place data field address on TOS + ;VE_DOCONSTANT: + ; .dw $ff0a + ; .db "(constant)" + ; .dw VE_HEAD + ; .set VE_HEAD = VE_DOCONSTANT + XT_DOCONSTANT: +003851 3852 .dw PFA_DOCONSTANT + PFA_DOCONSTANT: +003852 939a +003853 938a savetos +003854 01cb movw tosl, wl +003855 9601 adiw tosl, 1 +003856 cfae jmp_ DO_NEXT + .include "words/douser.asm" + + ; System + ; runtime part of user + ;VE_DOUSER: + ; .dw $ff06 + ; .db "(user)" + ; .dw VE_HEAD + ; .set VE_HEAD = VE_DOUSER + XT_DOUSER: +003857 3858 .dw PFA_DOUSER + PFA_DOUSER: +003858 939a +003859 938a savetos +00385a 01fb movw zl, wl +00385b 9631 adiw zl, 1 +00385c 0fee +00385d 1fff +00385e 9185 +00385f 9195 readflashcell tosl,tosh +003860 0d84 add tosl, upl +003861 1d95 adc tosh, uph +003862 cfa2 jmp_ DO_NEXT + .include "words/do-value.asm" + + ; System + ; runtime of value + VE_DOVALUE: +003863 ff07 .dw $ff07 +003864 7628 +003865 6c61 +003866 6575 +003867 0029 .db "(value)", 0 +003868 3824 .dw VE_HEAD + .set VE_HEAD = VE_DOVALUE + XT_DOVALUE: +003869 3801 .dw DO_COLON + PFA_DOVALUE: +00386a 072e .dw XT_DOCREATE +00386b 088e .dw XT_REVEAL +00386c 0751 .dw XT_COMPILE +00386d 386f .dw PFA_DOVALUE1 +00386e 3820 .dw XT_EXIT + PFA_DOVALUE1: +00386f 940e 08a7 call_ DO_DODOES +003871 38b1 .dw XT_DUP +003872 01c6 .dw XT_ICELLPLUS +003873 3bcb .dw XT_FETCHI +003874 382a .dw XT_EXECUTE +003875 3820 .dw XT_EXIT + + ; : (value) dup icell+ @i execute ; + .include "words/fetch.asm" + + ; Memory + ; read 1 cell from RAM address + VE_FETCH: +003876 ff01 .dw $ff01 +003877 0040 .db "@",0 +003878 3863 .dw VE_HEAD + .set VE_HEAD = VE_FETCH + XT_FETCH: +003879 387a .dw PFA_FETCH + PFA_FETCH: + .if WANT_UNIFIED == 1 + .endif + PFA_FETCHRAM: +00387a 01fc movw zl, tosl + ; low byte is read before the high byte +00387b 9181 ld tosl, z+ +00387c 9191 ld tosh, z+ +00387d cf87 jmp_ DO_NEXT + .if WANT_UNIFIED == 1 + .endif + .include "words/store.asm" + + ; Memory + ; write n to RAM memory at addr, low byte first + VE_STORE: +00387e ff01 .dw $ff01 +00387f 0021 .db "!",0 +003880 3876 .dw VE_HEAD + .set VE_HEAD = VE_STORE + XT_STORE: +003881 3882 .dw PFA_STORE + PFA_STORE: + .if WANT_UNIFIED == 1 + .endif + PFA_STORERAM: +003882 01fc movw zl, tosl +003883 9189 +003884 9199 loadtos + ; the high byte is written before the low byte +003885 8391 std Z+1, tosh +003886 8380 std Z+0, tosl +003887 9189 +003888 9199 loadtos +003889 cf7b jmp_ DO_NEXT + .if WANT_UNIFIED == 1 + .endif + .include "words/cstore.asm" + + ; Memory + ; store a single byte to RAM address + VE_CSTORE: +00388a ff02 .dw $ff02 +00388b 2163 .db "c!" +00388c 387e .dw VE_HEAD + .set VE_HEAD = VE_CSTORE + XT_CSTORE: +00388d 388e .dw PFA_CSTORE + PFA_CSTORE: +00388e 01fc movw zl, tosl +00388f 9189 +003890 9199 loadtos +003891 8380 st Z, tosl +003892 9189 +003893 9199 loadtos +003894 cf70 jmp_ DO_NEXT + .include "words/cfetch.asm" + + ; Memory + ; fetch a single byte from memory mapped locations + VE_CFETCH: +003895 ff02 .dw $ff02 +003896 4063 .db "c@" +003897 388a .dw VE_HEAD + .set VE_HEAD = VE_CFETCH + XT_CFETCH: +003898 3899 .dw PFA_CFETCH + PFA_CFETCH: +003899 01fc movw zl, tosl +00389a 2799 clr tosh +00389b 8180 ld tosl, Z +00389c cf68 jmp_ DO_NEXT + .include "words/fetch-u.asm" + + ; Memory + ; read 1 cell from USER area + VE_FETCHU: +00389d ff02 .dw $ff02 +00389e 7540 .db "@u" +00389f 3895 .dw VE_HEAD + .set VE_HEAD = VE_FETCHU + XT_FETCHU: +0038a0 3801 .dw DO_COLON + PFA_FETCHU: +0038a1 3b02 .dw XT_UP_FETCH +0038a2 399d .dw XT_PLUS +0038a3 3879 .dw XT_FETCH +0038a4 3820 .dw XT_EXIT + .include "words/store-u.asm" + + ; Memory + ; write n to USER area at offset + VE_STOREU: +0038a5 ff02 .dw $ff02 +0038a6 7521 .db "!u" +0038a7 389d .dw VE_HEAD + .set VE_HEAD = VE_STOREU + XT_STOREU: +0038a8 3801 .dw DO_COLON + PFA_STOREU: +0038a9 3b02 .dw XT_UP_FETCH +0038aa 399d .dw XT_PLUS +0038ab 3881 .dw XT_STORE +0038ac 3820 .dw XT_EXIT + + ;;;;;;;;;;;;;;;;;;;;;;;;; + .include "words/dup.asm" + + ; Stack + ; duplicate TOS + VE_DUP: +0038ad ff03 .dw $ff03 +0038ae 7564 +0038af 0070 .db "dup",0 +0038b0 38a5 .dw VE_HEAD + .set VE_HEAD = VE_DUP + XT_DUP: +0038b1 38b2 .dw PFA_DUP + PFA_DUP: +0038b2 939a +0038b3 938a savetos +0038b4 cf50 jmp_ DO_NEXT + .include "words/qdup.asm" + + ; Stack + ; duplicate TOS if non-zero + VE_QDUP: +0038b5 ff04 .dw $ff04 +0038b6 643f +0038b7 7075 .db "?dup" +0038b8 38ad .dw VE_HEAD + .set VE_HEAD = VE_QDUP + XT_QDUP: +0038b9 38ba .dw PFA_QDUP + PFA_QDUP: +0038ba 2f08 mov temp0, tosl +0038bb 2b09 or temp0, tosh +0038bc f011 breq PFA_QDUP1 +0038bd 939a +0038be 938a savetos + PFA_QDUP1: +0038bf cf45 jmp_ DO_NEXT + .include "words/swap.asm" + + ; Stack + ; swaps the two top level stack cells + VE_SWAP: +0038c0 ff04 .dw $ff04 +0038c1 7773 +0038c2 7061 .db "swap" +0038c3 38b5 .dw VE_HEAD + .set VE_HEAD = VE_SWAP + XT_SWAP: +0038c4 38c5 .dw PFA_SWAP + PFA_SWAP: +0038c5 018c movw temp0, tosl +0038c6 9189 +0038c7 9199 loadtos +0038c8 931a st -Y, temp1 +0038c9 930a st -Y, temp0 +0038ca cf3a jmp_ DO_NEXT + .include "words/over.asm" + + ; Stack + ; Place a copy of x1 on top of the stack + VE_OVER: +0038cb ff04 .dw $ff04 +0038cc 766f +0038cd 7265 .db "over" +0038ce 38c0 .dw VE_HEAD + .set VE_HEAD = VE_OVER + XT_OVER: +0038cf 38d0 .dw PFA_OVER + PFA_OVER: +0038d0 939a +0038d1 938a savetos +0038d2 818a ldd tosl, Y+2 +0038d3 819b ldd tosh, Y+3 + +0038d4 cf30 jmp_ DO_NEXT + .include "words/drop.asm" + + ; Stack + ; drop TOS + VE_DROP: +0038d5 ff04 .dw $ff04 +0038d6 7264 +0038d7 706f .db "drop" +0038d8 38cb .dw VE_HEAD + .set VE_HEAD = VE_DROP + XT_DROP: +0038d9 38da .dw PFA_DROP + PFA_DROP: +0038da 9189 +0038db 9199 loadtos +0038dc cf28 jmp_ DO_NEXT + .include "words/rot.asm" + + ; Stack + ; rotate the three top level cells + VE_ROT: +0038dd ff03 .dw $ff03 +0038de 6f72 +0038df 0074 .db "rot",0 +0038e0 38d5 .dw VE_HEAD + .set VE_HEAD = VE_ROT + XT_ROT: +0038e1 38e2 .dw PFA_ROT + PFA_ROT: +0038e2 018c movw temp0, tosl +0038e3 9129 ld temp2, Y+ +0038e4 9139 ld temp3, Y+ +0038e5 9189 +0038e6 9199 loadtos + +0038e7 933a st -Y, temp3 +0038e8 932a st -Y, temp2 +0038e9 931a st -Y, temp1 +0038ea 930a st -Y, temp0 + +0038eb cf19 jmp_ DO_NEXT + .include "words/nip.asm" + + ; Stack + ; Remove Second of Stack + VE_NIP: +0038ec ff03 .dw $ff03 +0038ed 696e +0038ee 0070 .db "nip",0 +0038ef 38dd .dw VE_HEAD + .set VE_HEAD = VE_NIP + XT_NIP: +0038f0 38f1 .dw PFA_NIP + PFA_NIP: +0038f1 9622 adiw yl, 2 +0038f2 cf12 jmp_ DO_NEXT + ;;;;;;;;;;;;;;;;;;;;;;;;; + .include "words/r_from.asm" + + ; Stack + ; move TOR to TOS + VE_R_FROM: +0038f3 ff02 .dw $ff02 +0038f4 3e72 .db "r>" +0038f5 38ec .dw VE_HEAD + .set VE_HEAD = VE_R_FROM + XT_R_FROM: +0038f6 38f7 .dw PFA_R_FROM + PFA_R_FROM: +0038f7 939a +0038f8 938a savetos +0038f9 918f pop tosl +0038fa 919f pop tosh +0038fb cf09 jmp_ DO_NEXT + .include "words/to_r.asm" + + ; Stack + ; move TOS to TOR + VE_TO_R: +0038fc ff02 .dw $ff02 +0038fd 723e .db ">r" +0038fe 38f3 .dw VE_HEAD + .set VE_HEAD = VE_TO_R + XT_TO_R: +0038ff 3900 .dw PFA_TO_R + PFA_TO_R: +003900 939f push tosh +003901 938f push tosl +003902 9189 +003903 9199 loadtos +003904 cf00 jmp_ DO_NEXT + .include "words/r_fetch.asm" + + ; Stack + ; fetch content of TOR + VE_R_FETCH: +003905 ff02 .dw $ff02 +003906 4072 .db "r@" +003907 38fc .dw VE_HEAD + .set VE_HEAD = VE_R_FETCH + XT_R_FETCH: +003908 3909 .dw PFA_R_FETCH + PFA_R_FETCH: +003909 939a +00390a 938a savetos +00390b 918f pop tosl +00390c 919f pop tosh +00390d 939f push tosh +00390e 938f push tosl +00390f cef5 jmp_ DO_NEXT + + + .include "words/not-equal.asm" + + ; Compare + ; true if n1 is not equal to n2 + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_NOTEQUAL: +003910 ff02 .dw $ff02 +003911 3e3c .db "<>" +003912 3905 .dw VE_HEAD + .set VE_HEAD = VE_NOTEQUAL + XT_NOTEQUAL: +003913 3801 .dw DO_COLON + PFA_NOTEQUAL: + .endif + +003914 3fdf +003915 391a +003916 3820 .DW XT_EQUAL,XT_ZEROEQUAL,XT_EXIT + .include "words/equalzero.asm" + + ; Compare + ; compare with 0 (zero) + VE_ZEROEQUAL: +003917 ff02 .dw $ff02 +003918 3d30 .db "0=" +003919 3910 .dw VE_HEAD + .set VE_HEAD = VE_ZEROEQUAL + XT_ZEROEQUAL: +00391a 391b .dw PFA_ZEROEQUAL + PFA_ZEROEQUAL: +00391b 2b98 or tosh, tosl +00391c f5d1 brne PFA_ZERO1 +00391d c030 rjmp PFA_TRUE1 + .include "words/lesszero.asm" + + ; Compare + ; compare with zero + VE_ZEROLESS: +00391e ff02 .dw $ff02 +00391f 3c30 .db "0<" +003920 3917 .dw VE_HEAD + .set VE_HEAD = VE_ZEROLESS + XT_ZEROLESS: +003921 3922 .dw PFA_ZEROLESS + PFA_ZEROLESS: +003922 fd97 sbrc tosh,7 +003923 c02a rjmp PFA_TRUE1 +003924 c032 rjmp PFA_ZERO1 + .include "words/greaterzero.asm" + + ; Compare + ; true if n1 is greater than 0 + VE_GREATERZERO: +003925 ff02 .dw $ff02 +003926 3e30 .db "0>" +003927 391e .dw VE_HEAD + .set VE_HEAD = VE_GREATERZERO + XT_GREATERZERO: +003928 3929 .dw PFA_GREATERZERO + PFA_GREATERZERO: +003929 1582 cp tosl, zerol +00392a 0593 cpc tosh, zeroh +00392b f15c brlt PFA_ZERO1 +00392c f151 brbs 1, PFA_ZERO1 +00392d c020 rjmp PFA_TRUE1 + .include "words/d-greaterzero.asm" + + ; Compare + ; compares if a double double cell number is greater 0 + VE_DGREATERZERO: +00392e ff03 .dw $ff03 +00392f 3064 +003930 003e .db "d0>",0 +003931 3925 .dw VE_HEAD + .set VE_HEAD = VE_DGREATERZERO + XT_DGREATERZERO: +003932 3933 .dw PFA_DGREATERZERO + PFA_DGREATERZERO: +003933 1582 cp tosl, zerol +003934 0593 cpc tosh, zeroh +003935 9189 +003936 9199 loadtos +003937 0582 cpc tosl, zerol +003938 0593 cpc tosh, zeroh +003939 f0ec brlt PFA_ZERO1 +00393a f0e1 brbs 1, PFA_ZERO1 +00393b c012 rjmp PFA_TRUE1 + .include "words/d-lesszero.asm" + + ; Compare + ; compares if a double double cell number is less than 0 + VE_DXT_ZEROLESS: +00393c ff03 .dw $ff03 +00393d 3064 +00393e 003c .db "d0<",0 +00393f 392e .dw VE_HEAD + .set VE_HEAD = VE_DXT_ZEROLESS + XT_DXT_ZEROLESS: +003940 3941 .dw PFA_DXT_ZEROLESS + PFA_DXT_ZEROLESS: +003941 9622 adiw Y,2 +003942 fd97 sbrc tosh,7 +003943 940c 394e jmp PFA_TRUE1 +003945 940c 3957 jmp PFA_ZERO1 + + .include "words/true.asm" + + ; Arithmetics + ; leaves the value -1 (true) on TOS + VE_TRUE: +003947 ff04 .dw $ff04 +003948 7274 +003949 6575 .db "true" +00394a 393c .dw VE_HEAD + .set VE_HEAD = VE_TRUE + XT_TRUE: +00394b 394c .dw PFA_TRUE + PFA_TRUE: +00394c 939a +00394d 938a savetos + PFA_TRUE1: +00394e ef8f ser tosl +00394f ef9f ser tosh +003950 ceb4 jmp_ DO_NEXT + .include "words/zero.asm" + + ; Arithmetics + ; place a value 0 on TOS + VE_ZERO: +003951 ff01 .dw $ff01 +003952 0030 .db "0",0 +003953 3947 .dw VE_HEAD + .set VE_HEAD = VE_ZERO + XT_ZERO: +003954 3955 .dw PFA_ZERO + PFA_ZERO: +003955 939a +003956 938a savetos + PFA_ZERO1: +003957 01c1 movw tosl, zerol +003958 ceac jmp_ DO_NEXT + .include "words/uless.asm" + + ; Compare + ; true if u1 < u2 (unsigned) + VE_ULESS: +003959 ff02 .dw $ff02 +00395a 3c75 .db "u<" +00395b 3951 .dw VE_HEAD + .set VE_HEAD = VE_ULESS + XT_ULESS: +00395c 395d .dw PFA_ULESS + PFA_ULESS: +00395d 9129 ld temp2, Y+ +00395e 9139 ld temp3, Y+ +00395f 1782 cp tosl, temp2 +003960 0793 cpc tosh, temp3 +003961 f3a8 brlo PFA_ZERO1 +003962 f3a1 brbs 1, PFA_ZERO1 +003963 cfea jmp_ PFA_TRUE1 + .include "words/u-greater.asm" + + ; Compare + ; true if u1 > u2 (unsigned) + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_UGREATER: +003964 ff02 .dw $ff02 +003965 3e75 .db "u>" +003966 3959 .dw VE_HEAD + .set VE_HEAD = VE_UGREATER + XT_UGREATER: +003967 3801 .dw DO_COLON + PFA_UGREATER: + .endif +003968 38c4 .DW XT_SWAP +003969 395c .dw XT_ULESS +00396a 3820 .dw XT_EXIT + .include "words/less.asm" + + ; Compare + ; true if n1 is less than n2 + VE_LESS: +00396b ff01 .dw $ff01 +00396c 003c .db "<",0 +00396d 3964 .dw VE_HEAD + .set VE_HEAD = VE_LESS + XT_LESS: +00396e 396f .dw PFA_LESS + PFA_LESS: +00396f 9129 ld temp2, Y+ +003970 9139 ld temp3, Y+ +003971 1728 cp temp2, tosl +003972 0739 cpc temp3, tosh + PFA_LESSDONE: +003973 f71c brge PFA_ZERO1 +003974 cfd9 rjmp PFA_TRUE1 + .include "words/greater.asm" + + ; Compare + ; flag is true if n1 is greater than n2 + VE_GREATER: +003975 ff01 .dw $ff01 +003976 003e .db ">",0 +003977 396b .dw VE_HEAD + .set VE_HEAD = VE_GREATER + XT_GREATER: +003978 3979 .dw PFA_GREATER + PFA_GREATER: +003979 9129 ld temp2, Y+ +00397a 9139 ld temp3, Y+ +00397b 1728 cp temp2, tosl +00397c 0739 cpc temp3, tosh + PFA_GREATERDONE: +00397d f2cc brlt PFA_ZERO1 +00397e f2c1 brbs 1, PFA_ZERO1 +00397f cfce rjmp PFA_TRUE1 + + .include "words/log2.asm" + + ; Arithmetics + ; logarithm to base 2 or highest set bitnumber + VE_LOG2: +003980 ff04 .dw $ff04 +003981 6f6c +003982 3267 .db "log2" +003983 3975 .dw VE_HEAD + .set VE_HEAD = VE_LOG2 + XT_LOG2: +003984 3985 .dw PFA_LOG2 + PFA_LOG2: +003985 01fc movw zl, tosl +003986 2799 clr tosh +003987 e180 ldi tosl, 16 + PFA_LOG2_1: +003988 958a dec tosl +003989 f022 brmi PFA_LOG2_2 ; wrong data +00398a 0fee lsl zl +00398b 1fff rol zh +00398c f7d8 brcc PFA_LOG2_1 +00398d ce77 jmp_ DO_NEXT + + PFA_LOG2_2: +00398e 959a dec tosh +00398f ce75 jmp_ DO_NEXT + .include "words/minus.asm" + + ; Arithmetics + ; subtract n2 from n1 + VE_MINUS: +003990 ff01 .dw $ff01 +003991 002d .db "-",0 +003992 3980 .dw VE_HEAD + .set VE_HEAD = VE_MINUS + XT_MINUS: +003993 3994 .dw PFA_MINUS + PFA_MINUS: +003994 9109 ld temp0, Y+ +003995 9119 ld temp1, Y+ +003996 1b08 sub temp0, tosl +003997 0b19 sbc temp1, tosh +003998 01c8 movw tosl, temp0 +003999 ce6b jmp_ DO_NEXT + .include "words/plus.asm" + + ; Arithmetics + ; add n1 and n2 + VE_PLUS: +00399a ff01 .dw $ff01 +00399b 002b .db "+",0 +00399c 3990 .dw VE_HEAD + .set VE_HEAD = VE_PLUS + XT_PLUS: +00399d 399e .dw PFA_PLUS + PFA_PLUS: +00399e 9109 ld temp0, Y+ +00399f 9119 ld temp1, Y+ +0039a0 0f80 add tosl, temp0 +0039a1 1f91 adc tosh, temp1 +0039a2 ce62 jmp_ DO_NEXT + .include "words/mstar.asm" + + ; Arithmetics + ; multiply 2 cells to a double cell + VE_MSTAR: +0039a3 ff02 .dw $ff02 +0039a4 2a6d .db "m*" +0039a5 399a .dw VE_HEAD + .set VE_HEAD = VE_MSTAR + XT_MSTAR: +0039a6 39a7 .dw PFA_MSTAR + PFA_MSTAR: +0039a7 018c movw temp0, tosl +0039a8 9189 +0039a9 9199 loadtos +0039aa 019c movw temp2, tosl + ; high cell ah*bh +0039ab 0231 muls temp3, temp1 +0039ac 0170 movw temp4, r0 + ; low cell al*bl +0039ad 9f20 mul temp2, temp0 +0039ae 01c0 movw tosl, r0 + ; signed ah*bl +0039af 0330 mulsu temp3, temp0 +0039b0 08f3 sbc temp5, zeroh +0039b1 0d90 add tosh, r0 +0039b2 1ce1 adc temp4, r1 +0039b3 1cf3 adc temp5, zeroh + + ; signed al*bh +0039b4 0312 mulsu temp1, temp2 +0039b5 08f3 sbc temp5, zeroh +0039b6 0d90 add tosh, r0 +0039b7 1ce1 adc temp4, r1 +0039b8 1cf3 adc temp5, zeroh + +0039b9 939a +0039ba 938a savetos +0039bb 01c7 movw tosl, temp4 +0039bc ce48 jmp_ DO_NEXT + .include "words/umslashmod.asm" + + ; Arithmetics + ; unsigned division ud / u2 with remainder + VE_UMSLASHMOD: +0039bd ff06 .dw $ff06 +0039be 6d75 +0039bf 6d2f +0039c0 646f .db "um/mod" +0039c1 39a3 .dw VE_HEAD + .set VE_HEAD = VE_UMSLASHMOD + XT_UMSLASHMOD: +0039c2 39c3 .dw PFA_UMSLASHMOD + PFA_UMSLASHMOD: +0039c3 017c movw temp4, tosl + +0039c4 9129 ld temp2, Y+ +0039c5 9139 ld temp3, Y+ + +0039c6 9109 ld temp0, Y+ +0039c7 9119 ld temp1, Y+ + + ;; unsigned 32/16 -> 16r16 divide + + PFA_UMSLASHMODmod: + + ; set loop counter +0039c8 e140 ldi temp6,$10 + + PFA_UMSLASHMODmod_loop: + ; shift left, saving high bit +0039c9 2755 clr temp7 +0039ca 0f00 lsl temp0 +0039cb 1f11 rol temp1 +0039cc 1f22 rol temp2 +0039cd 1f33 rol temp3 +0039ce 1f55 rol temp7 + + ; try subtracting divisor +0039cf 152e cp temp2, temp4 +0039d0 053f cpc temp3, temp5 +0039d1 0552 cpc temp7,zerol + +0039d2 f018 brcs PFA_UMSLASHMODmod_loop_control + + PFA_UMSLASHMODmod_subtract: + ; dividend is large enough + ; do the subtraction for real + ; and set lowest bit +0039d3 9503 inc temp0 +0039d4 192e sub temp2, temp4 +0039d5 093f sbc temp3, temp5 + + PFA_UMSLASHMODmod_loop_control: +0039d6 954a dec temp6 +0039d7 f789 brne PFA_UMSLASHMODmod_loop + + PFA_UMSLASHMODmod_done: + ; put remainder on stack +0039d8 933a st -Y,temp3 +0039d9 932a st -Y,temp2 + + ; put quotient on stack +0039da 01c8 movw tosl, temp0 +0039db ce29 jmp_ DO_NEXT + .include "words/umstar.asm" + + ; Arithmetics + ; multiply 2 unsigned cells to a double cell + VE_UMSTAR: +0039dc ff03 .dw $ff03 +0039dd 6d75 +0039de 002a .db "um*",0 +0039df 39bd .dw VE_HEAD + .set VE_HEAD = VE_UMSTAR + XT_UMSTAR: +0039e0 39e1 .dw PFA_UMSTAR + PFA_UMSTAR: +0039e1 018c movw temp0, tosl +0039e2 9189 +0039e3 9199 loadtos + ; result: (temp3*temp1)* 65536 + (temp3*temp0 + temp1*temp2) * 256 + (temp0 * temp2) + ; low bytes +0039e4 9f80 mul tosl,temp0 +0039e5 01f0 movw zl, r0 +0039e6 2722 clr temp2 +0039e7 2733 clr temp3 + ; middle bytes +0039e8 9f90 mul tosh, temp0 +0039e9 0df0 add zh, r0 +0039ea 1d21 adc temp2, r1 +0039eb 1d33 adc temp3, zeroh + +0039ec 9f81 mul tosl, temp1 +0039ed 0df0 add zh, r0 +0039ee 1d21 adc temp2, r1 +0039ef 1d33 adc temp3, zeroh + +0039f0 9f91 mul tosh, temp1 +0039f1 0d20 add temp2, r0 +0039f2 1d31 adc temp3, r1 +0039f3 01cf movw tosl, zl +0039f4 939a +0039f5 938a savetos +0039f6 01c9 movw tosl, temp2 +0039f7 ce0d jmp_ DO_NEXT + + .include "words/invert.asm" + + ; Arithmetics + ; 1-complement of TOS + VE_INVERT: +0039f8 ff06 .dw $ff06 +0039f9 6e69 +0039fa 6576 +0039fb 7472 .db "invert" +0039fc 39dc .dw VE_HEAD + .set VE_HEAD = VE_INVERT + XT_INVERT: +0039fd 39fe .dw PFA_INVERT + PFA_INVERT: +0039fe 9580 com tosl +0039ff 9590 com tosh +003a00 ce04 jmp_ DO_NEXT + .include "words/2slash.asm" + + ; Arithmetics + ; arithmetic shift right + VE_2SLASH: +003a01 ff02 .dw $ff02 +003a02 2f32 .db "2/" +003a03 39f8 .dw VE_HEAD + .set VE_HEAD = VE_2SLASH + XT_2SLASH: +003a04 3a05 .dw PFA_2SLASH + PFA_2SLASH: +003a05 9595 asr tosh +003a06 9587 ror tosl +003a07 cdfd jmp_ DO_NEXT + .include "words/2star.asm" + + ; Arithmetics + ; arithmetic shift left, filling with zero + VE_2STAR: +003a08 ff02 .dw $ff02 +003a09 2a32 .db "2*" +003a0a 3a01 .dw VE_HEAD + .set VE_HEAD = VE_2STAR + XT_2STAR: +003a0b 3a0c .dw PFA_2STAR + PFA_2STAR: +003a0c 0f88 lsl tosl +003a0d 1f99 rol tosh +003a0e cdf6 jmp_ DO_NEXT + .include "words/and.asm" + + ; Logic + ; bitwise and + VE_AND: +003a0f ff03 .dw $ff03 +003a10 6e61 +003a11 0064 .db "and",0 +003a12 3a08 .dw VE_HEAD + .set VE_HEAD = VE_AND + XT_AND: +003a13 3a14 .dw PFA_AND + PFA_AND: +003a14 9109 ld temp0, Y+ +003a15 9119 ld temp1, Y+ +003a16 2380 and tosl, temp0 +003a17 2391 and tosh, temp1 +003a18 cdec jmp_ DO_NEXT + .include "words/or.asm" + + ; Logic + ; logical or + VE_OR: +003a19 ff02 .dw $ff02 +003a1a 726f .db "or" +003a1b 3a0f .dw VE_HEAD + .set VE_HEAD = VE_OR + XT_OR: +003a1c 3a1d .dw PFA_OR + PFA_OR: +003a1d 9109 ld temp0, Y+ +003a1e 9119 ld temp1, Y+ +003a1f 2b80 or tosl, temp0 +003a20 2b91 or tosh, temp1 +003a21 cde3 jmp_ DO_NEXT + + .include "words/xor.asm" + + ; Logic + ; exclusive or + VE_XOR: +003a22 ff03 .dw $ff03 +003a23 6f78 +003a24 0072 .db "xor",0 +003a25 3a19 .dw VE_HEAD + .set VE_HEAD = VE_XOR + XT_XOR: +003a26 3a27 .dw PFA_XOR + PFA_XOR: +003a27 9109 ld temp0, Y+ +003a28 9119 ld temp1, Y+ +003a29 2780 eor tosl, temp0 +003a2a 2791 eor tosh, temp1 +003a2b cdd9 jmp_ DO_NEXT + + .include "words/1plus.asm" + + ; Arithmetics + ; optimized increment + VE_1PLUS: +003a2c ff02 .dw $ff02 +003a2d 2b31 .db "1+" +003a2e 3a22 .dw VE_HEAD + .set VE_HEAD = VE_1PLUS + XT_1PLUS: +003a2f 3a30 .dw PFA_1PLUS + PFA_1PLUS: +003a30 9601 adiw tosl,1 +003a31 cdd3 jmp_ DO_NEXT + .include "words/1minus.asm" + + ; Arithmetics + ; optimized decrement + VE_1MINUS: +003a32 ff02 .dw $ff02 +003a33 2d31 .db "1-" +003a34 3a2c .dw VE_HEAD + .set VE_HEAD = VE_1MINUS + XT_1MINUS: +003a35 3a36 .dw PFA_1MINUS + PFA_1MINUS: +003a36 9701 sbiw tosl, 1 +003a37 cdcd jmp_ DO_NEXT + .include "words/q-negate.asm" + + ; 0< IF NEGATE THEN ; ...a common factor + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_QNEGATE: +003a38 ff07 .dw $ff07 +003a39 6e3f +003a3a 6765 +003a3b 7461 +../../common\words/q-negate.asm(11): warning: .cseg .db misalignment - padding zero byte +003a3c 0065 .db "?negate" +003a3d 3a32 .dw VE_HEAD + .set VE_HEAD = VE_QNEGATE + XT_QNEGATE: +003a3e 3801 .dw DO_COLON + PFA_QNEGATE: + + .endif +003a3f 3921 +003a40 3836 .DW XT_ZEROLESS,XT_DOCONDBRANCH +003a41 3a43 DEST(QNEG1) +003a42 3e27 .DW XT_NEGATE +003a43 3820 QNEG1: .DW XT_EXIT + .include "words/lshift.asm" + + ; Arithmetics + ; logically shift n1 left n2 times + VE_LSHIFT: +003a44 ff06 .dw $ff06 +003a45 736c +003a46 6968 +003a47 7466 .db "lshift" +003a48 3a38 .dw VE_HEAD + .set VE_HEAD = VE_LSHIFT + XT_LSHIFT: +003a49 3a4a .dw PFA_LSHIFT + PFA_LSHIFT: +003a4a 01fc movw zl, tosl +003a4b 9189 +003a4c 9199 loadtos + PFA_LSHIFT1: +003a4d 9731 sbiw zl, 1 +003a4e f01a brmi PFA_LSHIFT2 +003a4f 0f88 lsl tosl +003a50 1f99 rol tosh +003a51 cffb rjmp PFA_LSHIFT1 + PFA_LSHIFT2: +003a52 cdb2 jmp_ DO_NEXT + + .include "words/rshift.asm" + + ; Arithmetics + ; shift n1 n2-times logically right + VE_RSHIFT: +003a53 ff06 .dw $ff06 +003a54 7372 +003a55 6968 +003a56 7466 .db "rshift" +003a57 3a44 .dw VE_HEAD + .set VE_HEAD = VE_RSHIFT + XT_RSHIFT: +003a58 3a59 .dw PFA_RSHIFT + PFA_RSHIFT: +003a59 01fc movw zl, tosl +003a5a 9189 +003a5b 9199 loadtos + PFA_RSHIFT1: +003a5c 9731 sbiw zl, 1 +003a5d f01a brmi PFA_RSHIFT2 +003a5e 9596 lsr tosh +003a5f 9587 ror tosl +003a60 cffb rjmp PFA_RSHIFT1 + PFA_RSHIFT2: +003a61 cda3 jmp_ DO_NEXT + + .include "words/plusstore.asm" + + ; Arithmetics + ; add n to content of RAM address a-addr + VE_PLUSSTORE: +003a62 ff02 .dw $ff02 +003a63 212b .db "+!" +003a64 3a53 .dw VE_HEAD + .set VE_HEAD = VE_PLUSSTORE + XT_PLUSSTORE: +003a65 3a66 .dw PFA_PLUSSTORE + PFA_PLUSSTORE: +003a66 01fc movw zl, tosl +003a67 9189 +003a68 9199 loadtos +003a69 8120 ldd temp2, Z+0 +003a6a 8131 ldd temp3, Z+1 +003a6b 0f82 add tosl, temp2 +003a6c 1f93 adc tosh, temp3 +003a6d 8380 std Z+0, tosl +003a6e 8391 std Z+1, tosh +003a6f 9189 +003a70 9199 loadtos +003a71 cd93 jmp_ DO_NEXT + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + .include "words/rpfetch.asm" + + ; Stack + ; current return stack pointer address + VE_RP_FETCH: +003a72 ff03 .dw $ff03 +003a73 7072 +003a74 0040 .db "rp@",0 +003a75 3a62 .dw VE_HEAD + .set VE_HEAD = VE_RP_FETCH + XT_RP_FETCH: +003a76 3a77 .dw PFA_RP_FETCH + PFA_RP_FETCH: +003a77 939a +003a78 938a savetos +003a79 b78d in tosl, SPL +003a7a b79e in tosh, SPH +003a7b cd89 jmp_ DO_NEXT + .include "words/rpstore.asm" + + ; Stack + ; set return stack pointer + VE_RP_STORE: +003a7c ff03 .dw $ff03 +003a7d 7072 +003a7e 0021 .db "rp!",0 +003a7f 3a72 .dw VE_HEAD + .set VE_HEAD = VE_RP_STORE + XT_RP_STORE: +003a80 3a81 .dw PFA_RP_STORE + PFA_RP_STORE: +003a81 b72f in temp2, SREG +003a82 94f8 cli +003a83 bf8d out SPL, tosl +003a84 bf9e out SPH, tosh +003a85 bf2f out SREG, temp2 +003a86 9189 +003a87 9199 loadtos +003a88 cd7c jmp_ DO_NEXT + .include "words/spfetch.asm" + + ; Stack + ; current data stack pointer + VE_SP_FETCH: +003a89 ff03 .dw $ff03 +003a8a 7073 +003a8b 0040 .db "sp@",0 +003a8c 3a7c .dw VE_HEAD + .set VE_HEAD = VE_SP_FETCH + XT_SP_FETCH: +003a8d 3a8e .dw PFA_SP_FETCH + PFA_SP_FETCH: +003a8e 939a +003a8f 938a savetos +003a90 01ce movw tosl, yl +003a91 cd73 jmp_ DO_NEXT + .include "words/spstore.asm" + + ; Stack + ; set data stack pointer to addr + VE_SP_STORE: +003a92 ff03 .dw $ff03 +003a93 7073 +003a94 0021 .db "sp!",0 +003a95 3a89 .dw VE_HEAD + .set VE_HEAD = VE_SP_STORE + XT_SP_STORE: +003a96 3a97 .dw PFA_SP_STORE + PFA_SP_STORE: +003a97 01ec movw yl, tosl +003a98 9189 +003a99 9199 loadtos +003a9a cd6a jmp_ DO_NEXT + + .include "words/dodo.asm" + + ; System + ; runtime of do + ;VE_DODO: + ; .dw $ff04 + ; .db "(do)" + ; .dw VE_HEAD + ; .set VE_HEAD = VE_DODO + XT_DODO: +003a9b 3a9c .dw PFA_DODO + PFA_DODO: +003a9c 9129 ld temp2, Y+ +003a9d 9139 ld temp3, Y+ ; limit + PFA_DODO1: +003a9e e8e0 ldi zl, $80 +003a9f 0f3e add temp3, zl +003aa0 1b82 sub tosl, temp2 +003aa1 0b93 sbc tosh, temp3 + +003aa2 933f push temp3 +003aa3 932f push temp2 ; limit ( --> limit + $8000) +003aa4 939f push tosh +003aa5 938f push tosl ; start -> index ( --> index - (limit - $8000) +003aa6 9189 +003aa7 9199 loadtos +003aa8 cd5c jmp_ DO_NEXT + .include "words/i.asm" + + ; Compiler + ; current loop counter + VE_I: +003aa9 ff01 .dw $FF01 +003aaa 0069 .db "i",0 +003aab 3a92 .dw VE_HEAD + .set VE_HEAD = VE_I + XT_I: +003aac 3aad .dw PFA_I + PFA_I: +003aad 939a +003aae 938a savetos +003aaf 918f pop tosl +003ab0 919f pop tosh ; index +003ab1 91ef pop zl +003ab2 91ff pop zh ; limit +003ab3 93ff push zh +003ab4 93ef push zl +003ab5 939f push tosh +003ab6 938f push tosl +003ab7 0f8e add tosl, zl +003ab8 1f9f adc tosh, zh +003ab9 cd4b jmp_ DO_NEXT + .include "words/doplusloop.asm" + + ; System + ; runtime of +loop + ;VE_DOPLUSLOOP: + ; .dw $ff07 + ; .db "(+loop)" + ; .dw VE_HEAD + ; .set VE_HEAD = VE_DOPLUSLOOP + XT_DOPLUSLOOP: +003aba 3abb .dw PFA_DOPLUSLOOP + PFA_DOPLUSLOOP: +003abb 91ef pop zl +003abc 91ff pop zh +003abd 0fe8 add zl, tosl +003abe 1ff9 adc zh, tosh +003abf 9189 +003ac0 9199 loadtos +003ac1 f01b brvs PFA_DOPLUSLOOP_LEAVE + ; next cycle + PFA_DOPLUSLOOP_NEXT: + ; next iteration +003ac2 93ff push zh +003ac3 93ef push zl +003ac4 cd6b rjmp PFA_DOBRANCH ; read next cell from dictionary and jump to its destination + PFA_DOPLUSLOOP_LEAVE: +003ac5 910f pop temp0 +003ac6 911f pop temp1 ; remove limit +003ac7 9611 adiw xl, 1 ; skip branch-back address +003ac8 cd3c jmp_ DO_NEXT + .include "words/doloop.asm" + + ; System + ; runtime of loop + ;VE_DOLOOP: + ; .dw $ff06 + ; .db "(loop)" + ; .dw VE_HEAD + ; .set VE_HEAD = VE_DOLOOP + XT_DOLOOP: +003ac9 3aca .dw PFA_DOLOOP + PFA_DOLOOP: +003aca 91ef pop zl +003acb 91ff pop zh +003acc 9631 adiw zl,1 +003acd f3bb brvs PFA_DOPLUSLOOP_LEAVE +003ace cff3 jmp_ PFA_DOPLUSLOOP_NEXT + .include "words/unloop.asm" + + ; Compiler + ; remove loop-sys, exit the loop and continue execution after it + VE_UNLOOP: +003acf ff06 .dw $ff06 +003ad0 6e75 +003ad1 6f6c +003ad2 706f .db "unloop" +003ad3 3aa9 .dw VE_HEAD + .set VE_HEAD = VE_UNLOOP + XT_UNLOOP: +003ad4 3ad5 .dw PFA_UNLOOP + PFA_UNLOOP: +003ad5 911f pop temp1 +003ad6 910f pop temp0 +003ad7 911f pop temp1 +003ad8 910f pop temp0 +003ad9 cd2b jmp_ DO_NEXT + + ;;;;;;;;;;;;;;;;;;;;;;;;;;; + + .include "words/cmove_g.asm" + + ; Memory + ; copy data in RAM from higher to lower addresses. + VE_CMOVE_G: +003ada ff06 .dw $ff06 +003adb 6d63 +003adc 766f +003add 3e65 .db "cmove>" +003ade 3acf .dw VE_HEAD + .set VE_HEAD = VE_CMOVE_G + XT_CMOVE_G: +003adf 3ae0 .dw PFA_CMOVE_G + PFA_CMOVE_G: +003ae0 93bf push xh +003ae1 93af push xl +003ae2 91e9 ld zl, Y+ +003ae3 91f9 ld zh, Y+ ; addr-to +003ae4 91a9 ld xl, Y+ +003ae5 91b9 ld xh, Y+ ; addr-from +003ae6 2f09 mov temp0, tosh +003ae7 2b08 or temp0, tosl +003ae8 f041 brbs 1, PFA_CMOVE_G1 +003ae9 0fe8 add zl, tosl +003aea 1ff9 adc zh, tosh +003aeb 0fa8 add xl, tosl +003aec 1fb9 adc xh, tosh + PFA_CMOVE_G2: +003aed 911e ld temp1, -X +003aee 9312 st -Z, temp1 +003aef 9701 sbiw tosl, 1 +003af0 f7e1 brbc 1, PFA_CMOVE_G2 + PFA_CMOVE_G1: +003af1 91af pop xl +003af2 91bf pop xh +003af3 9189 +003af4 9199 loadtos +003af5 cd0f jmp_ DO_NEXT + .include "words/byteswap.asm" + + ; Arithmetics + ; exchange the bytes of the TOS + VE_BYTESWAP: +003af6 ff02 .dw $ff02 +003af7 3c3e .db "><" +003af8 3ada .dw VE_HEAD + .set VE_HEAD = VE_BYTESWAP + XT_BYTESWAP: +003af9 3afa .dw PFA_BYTESWAP + PFA_BYTESWAP: +003afa 2f09 mov temp0, tosh +003afb 2f98 mov tosh, tosl +003afc 2f80 mov tosl, temp0 +003afd cd07 jmp_ DO_NEXT + .include "words/up.asm" + + ; System Variable + ; get user area pointer + VE_UP_FETCH: +003afe ff03 .dw $ff03 +003aff 7075 +003b00 0040 .db "up@",0 +003b01 3af6 .dw VE_HEAD + .set VE_HEAD = VE_UP_FETCH + XT_UP_FETCH: +003b02 3b03 .dw PFA_UP_FETCH + PFA_UP_FETCH: +003b03 939a +003b04 938a savetos +003b05 01c2 movw tosl, upl +003b06 ccfe jmp_ DO_NEXT + + ; ( addr -- ) + ; System Variable + ; set user area pointer + VE_UP_STORE: +003b07 ff03 .dw $ff03 +003b08 7075 +003b09 0021 .db "up!",0 +003b0a 3afe .dw VE_HEAD + .set VE_HEAD = VE_UP_STORE + XT_UP_STORE: +003b0b 3b0c .dw PFA_UP_STORE + PFA_UP_STORE: +003b0c 012c movw upl, tosl +003b0d 9189 +003b0e 9199 loadtos +003b0f ccf5 jmp_ DO_NEXT + .include "words/1ms.asm" + + ; Time + ; busy waits (almost) exactly 1 millisecond + VE_1MS: +003b10 ff03 .dw $ff03 +003b11 6d31 +003b12 0073 .db "1ms",0 +003b13 3b07 .dw VE_HEAD + .set VE_HEAD = VE_1MS + XT_1MS: +003b14 3b15 .dw PFA_1MS + PFA_1MS: +003b15 ede0 +003b16 e0f7 +003b17 9731 +003b18 f7f1 delay 1000 +003b19 cceb jmp_ DO_NEXT + .include "words/2to_r.asm" + + ; Stack + ; move DTOS to TOR + VE_2TO_R: +003b1a ff03 .dw $ff03 +003b1b 3e32 +003b1c 0072 .db "2>r",0 +003b1d 3b10 .dw VE_HEAD + .set VE_HEAD = VE_2TO_R + XT_2TO_R: +003b1e 3b1f .dw PFA_2TO_R + PFA_2TO_R: +003b1f 01fc movw zl, tosl +003b20 9189 +003b21 9199 loadtos +003b22 939f push tosh +003b23 938f push tosl +003b24 93ff push zh +003b25 93ef push zl +003b26 9189 +003b27 9199 loadtos +003b28 ccdc jmp_ DO_NEXT + .include "words/2r_from.asm" + + ; Stack + ; move DTOR to TOS + VE_2R_FROM: +003b29 ff03 .dw $ff03 +003b2a 7232 +003b2b 003e .db "2r>",0 +003b2c 3b1a .dw VE_HEAD + .set VE_HEAD = VE_2R_FROM + XT_2R_FROM: +003b2d 3b2e .dw PFA_2R_FROM + PFA_2R_FROM: +003b2e 939a +003b2f 938a savetos +003b30 91ef pop zl +003b31 91ff pop zh +003b32 918f pop tosl +003b33 919f pop tosh +003b34 939a +003b35 938a savetos +003b36 01cf movw tosl, zl +003b37 cccd jmp_ DO_NEXT + + .include "words/store-e.asm" + + ; Memory + ; write n (2bytes) to eeprom address + VE_STOREE: +003b38 ff02 .dw $ff02 +003b39 6521 .db "!e" +003b3a 3b29 .dw VE_HEAD + .set VE_HEAD = VE_STOREE + XT_STOREE: +003b3b 3b3c .dw PFA_STOREE + PFA_STOREE: + .if WANT_UNIFIED == 1 + .endif + PFA_STOREE0: +003b3c 01fc movw zl, tosl +003b3d 9189 +003b3e 9199 loadtos +003b3f b72f in_ temp2, SREG +003b40 94f8 cli +003b41 d028 rcall PFA_FETCHE2 +003b42 b30d in_ temp0, EEDR +003b43 1708 cp temp0,tosl +003b44 f009 breq PFA_STOREE3 +003b45 d00b rcall PFA_STOREE1 + PFA_STOREE3: +003b46 9631 adiw zl,1 +003b47 d022 rcall PFA_FETCHE2 +003b48 b30d in_ temp0, EEDR +003b49 1709 cp temp0,tosh +003b4a f011 breq PFA_STOREE4 +003b4b 2f89 mov tosl, tosh +003b4c d004 rcall PFA_STOREE1 + PFA_STOREE4: +003b4d bf2f out_ SREG, temp2 +003b4e 9189 +003b4f 9199 loadtos +003b50 ccb4 jmp_ DO_NEXT + + PFA_STOREE1: +003b51 99e1 sbic EECR, EEPE +003b52 cffe rjmp PFA_STOREE1 + + PFA_STOREE2: ; estore_wait_low_spm: +003b53 b707 in_ temp0, SPMCSR +003b54 fd00 sbrc temp0,SPMEN +003b55 cffd rjmp PFA_STOREE2 + +003b56 bbff out_ EEARH,zh +003b57 bbee out_ EEARL,zl +003b58 bb8d out_ EEDR, tosl +003b59 9ae2 sbi EECR,EEMPE +003b5a 9ae1 sbi EECR,EEPE + +003b5b 9508 ret + .if WANT_UNIFIED == 1 + .endif + .include "words/fetch-e.asm" + + ; Memory + ; read 1 cell from eeprom + VE_FETCHE: +003b5c ff02 .dw $ff02 +003b5d 6540 .db "@e" +003b5e 3b38 .dw VE_HEAD + .set VE_HEAD = VE_FETCHE + XT_FETCHE: +003b5f 3b60 .dw PFA_FETCHE + PFA_FETCHE: + .if WANT_UNIFIED == 1 + .endif + PFA_FETCHE1: +003b60 b72f in_ temp2, SREG +003b61 94f8 cli +003b62 01fc movw zl, tosl +003b63 d006 rcall PFA_FETCHE2 +003b64 b38d in_ tosl, EEDR + +003b65 9631 adiw zl,1 + +003b66 d003 rcall PFA_FETCHE2 +003b67 b39d in_ tosh, EEDR +003b68 bf2f out_ SREG, temp2 +003b69 cc9b jmp_ DO_NEXT + + PFA_FETCHE2: +003b6a 99e1 sbic EECR, EEPE +003b6b cffe rjmp PFA_FETCHE2 + +003b6c bbff out_ EEARH,zh +003b6d bbee out_ EEARL,zl + +003b6e 9ae0 sbi EECR,EERE +003b6f 9508 ret + + .if WANT_UNIFIED == 1 + .endif + .include "words/store-i.asm" + + ; System Value + ; Deferred action to write a single 16bit cell to flash + VE_STOREI: +003b70 ff02 .dw $ff02 +003b71 6921 .db "!i" +003b72 3b5c .dw VE_HEAD + .set VE_HEAD = VE_STOREI + XT_STOREI: +003b73 3dff .dw PFA_DODEFER1 + PFA_STOREI: +003b74 005c .dw EE_STOREI +003b75 3da0 .dw XT_EDEFERFETCH +003b76 3daa .dw XT_EDEFERSTORE + .if FLASHEND > $10000 + .else + .include "words/store-i_nrww.asm" + + ; Memory + ; writes n to flash memory using assembly code (code to be placed in boot loader section) + VE_DO_STOREI_NRWW: +003b77 ff09 .dw $ff09 +003b78 2128 +003b79 2d69 +003b7a 726e +003b7b 7777 +003b7c 0029 .db "(!i-nrww)",0 +003b7d 3b70 .dw VE_HEAD + .set VE_HEAD = VE_DO_STOREI_NRWW + XT_DO_STOREI: +003b7e 3b7f .dw PFA_DO_STOREI_NRWW + PFA_DO_STOREI_NRWW: + ; store status register +003b7f b71f in temp1,SREG +003b80 931f push temp1 +003b81 94f8 cli + +003b82 019c movw temp2, tosl ; save the (word) address +003b83 9189 +003b84 9199 loadtos ; get the new value for the flash cell +003b85 93af push xl +003b86 93bf push xh +003b87 93cf push yl +003b88 93df push yh +003b89 d009 rcall DO_STOREI_atmega +003b8a 91df pop yh +003b8b 91cf pop yl +003b8c 91bf pop xh +003b8d 91af pop xl + ; finally clear the stack +003b8e 9189 +003b8f 9199 loadtos +003b90 911f pop temp1 + ; restore status register (and interrupt enable flag) +003b91 bf1f out SREG,temp1 + +003b92 cc72 jmp_ DO_NEXT + + ; + DO_STOREI_atmega: + ; write data to temp page buffer + ; use the values in tosl/tosh at the + ; appropiate place +003b93 d010 rcall pageload + + ; erase page if needed + ; it is needed if a bit goes from 0 to 1 +003b94 94e0 com temp4 +003b95 94f0 com temp5 +003b96 218e and tosl, temp4 +003b97 219f and tosh, temp5 +003b98 2b98 or tosh, tosl +003b99 f019 breq DO_STOREI_writepage +003b9a 01f9 movw zl, temp2 +003b9b e002 ldi temp0,(1<8000 + .elif AMFORTH_NRWW_SIZE>4000 + .include "dict/core_4k.inc" + + ; in a short distance to DO_NEXT + .include "words/n_to_r.asm" + + ; Stack + ; move n items from data stack to return stack + VE_N_TO_R: +003bd2 ff03 .dw $ff03 +003bd3 3e6e +003bd4 0072 .db "n>r",0 +003bd5 3bc8 .dw VE_HEAD + .set VE_HEAD = VE_N_TO_R + XT_N_TO_R: +003bd6 3bd7 .dw PFA_N_TO_R + PFA_N_TO_R: +003bd7 01fc movw zl, tosl +003bd8 2f08 mov temp0, tosl + PFA_N_TO_R1: +003bd9 9189 +003bda 9199 loadtos +003bdb 939f push tosh +003bdc 938f push tosl +003bdd 950a dec temp0 +003bde f7d1 brne PFA_N_TO_R1 +003bdf 93ef push zl +003be0 93ff push zh +003be1 9189 +003be2 9199 loadtos +003be3 cc21 jmp_ DO_NEXT + .include "words/n_r_from.asm" + + ; Stack + ; move n items from return stack to data stack + VE_N_R_FROM: +003be4 ff03 .dw $ff03 +003be5 726e +003be6 003e .db "nr>",0 +003be7 3bd2 .dw VE_HEAD + .set VE_HEAD = VE_N_R_FROM + XT_N_R_FROM: +003be8 3be9 .dw PFA_N_R_FROM + PFA_N_R_FROM: +003be9 939a +003bea 938a savetos +003beb 91ff pop zh +003bec 91ef pop zl +003bed 2f0e mov temp0, zl + PFA_N_R_FROM1: +003bee 918f pop tosl +003bef 919f pop tosh +003bf0 939a +003bf1 938a savetos +003bf2 950a dec temp0 +003bf3 f7d1 brne PFA_N_R_FROM1 +003bf4 01cf movw tosl, zl +003bf5 cc0f jmp_ DO_NEXT + .include "words/d-2star.asm" + + ; Arithmetics + ; shift a double cell left + VE_D2STAR: +003bf6 ff03 .dw $ff03 +003bf7 3264 +003bf8 002a .db "d2*",0 +003bf9 3be4 .dw VE_HEAD + .set VE_HEAD = VE_D2STAR + XT_D2STAR: +003bfa 3bfb .dw PFA_D2STAR + PFA_D2STAR: +003bfb 9109 ld temp0, Y+ +003bfc 9119 ld temp1, Y+ +003bfd 0f00 lsl temp0 +003bfe 1f11 rol temp1 +003bff 1f88 rol tosl +003c00 1f99 rol tosh +003c01 931a st -Y, temp1 +003c02 930a st -Y, temp0 +003c03 cc01 jmp_ DO_NEXT + .include "words/d-2slash.asm" + + ; Arithmetics + ; shift a double cell value right + VE_D2SLASH: +003c04 ff03 .dw $ff03 +003c05 3264 +003c06 002f .db "d2/",0 +003c07 3bf6 .dw VE_HEAD + .set VE_HEAD = VE_D2SLASH + XT_D2SLASH: +003c08 3c09 .dw PFA_D2SLASH + PFA_D2SLASH: +003c09 9109 ld temp0, Y+ +003c0a 9119 ld temp1, Y+ +003c0b 9595 asr tosh +003c0c 9587 ror tosl +003c0d 9517 ror temp1 +003c0e 9507 ror temp0 +003c0f 931a st -Y, temp1 +003c10 930a st -Y, temp0 +003c11 cbf3 jmp_ DO_NEXT + .include "words/d-plus.asm" + + ; Arithmetics + ; add 2 double cell values + VE_DPLUS: +003c12 ff02 .dw $ff02 +003c13 2b64 .db "d+" +003c14 3c04 .dw VE_HEAD + .set VE_HEAD = VE_DPLUS + XT_DPLUS: +003c15 3c16 .dw PFA_DPLUS + PFA_DPLUS: +003c16 9129 ld temp2, Y+ +003c17 9139 ld temp3, Y+ + +003c18 90e9 ld temp4, Y+ +003c19 90f9 ld temp5, Y+ +003c1a 9149 ld temp6, Y+ +003c1b 9159 ld temp7, Y+ + +003c1c 0f24 add temp2, temp6 +003c1d 1f35 adc temp3, temp7 +003c1e 1d8e adc tosl, temp4 +003c1f 1d9f adc tosh, temp5 + +003c20 933a st -Y, temp3 +003c21 932a st -Y, temp2 +003c22 cbe2 jmp_ DO_NEXT + .include "words/d-minus.asm" + + ; Arithmetics + ; subtract d2 from d1 + VE_DMINUS: +003c23 ff02 .dw $ff02 +003c24 2d64 .db "d-" +003c25 3c12 .dw VE_HEAD + .set VE_HEAD = VE_DMINUS + XT_DMINUS: +003c26 3c27 .dw PFA_DMINUS + PFA_DMINUS: +003c27 9129 ld temp2, Y+ +003c28 9139 ld temp3, Y+ + +003c29 90e9 ld temp4, Y+ +003c2a 90f9 ld temp5, Y+ +003c2b 9149 ld temp6, Y+ +003c2c 9159 ld temp7, Y+ + +003c2d 1b42 sub temp6, temp2 +003c2e 0b53 sbc temp7, temp3 +003c2f 0ae8 sbc temp4, tosl +003c30 0af9 sbc temp5, tosh + +003c31 935a st -Y, temp7 +003c32 934a st -Y, temp6 +003c33 01c7 movw tosl, temp4 +003c34 cbd0 jmp_ DO_NEXT + .include "words/d-invert.asm" + + ; Arithmetics + ; invert all bits in the double cell value + VE_DINVERT: +003c35 ff07 .dw $ff07 +003c36 6964 +003c37 766e +003c38 7265 +003c39 0074 .db "dinvert",0 +003c3a 3c23 .dw VE_HEAD + .set VE_HEAD = VE_DINVERT + XT_DINVERT: +003c3b 3c3c .dw PFA_DINVERT + PFA_DINVERT: +003c3c 9109 ld temp0, Y+ +003c3d 9119 ld temp1, Y+ +003c3e 9580 com tosl +003c3f 9590 com tosh +003c40 9500 com temp0 +003c41 9510 com temp1 +003c42 931a st -Y, temp1 +003c43 930a st -Y, temp0 +003c44 cbc0 jmp_ DO_NEXT + .include "words/slashmod.asm" + + ; Arithmetics + ; signed division n1/n2 with remainder and quotient + VE_SLASHMOD: +003c45 ff04 .dw $ff04 +003c46 6d2f +003c47 646f .db "/mod" +003c48 3c35 .dw VE_HEAD + .set VE_HEAD = VE_SLASHMOD + XT_SLASHMOD: +003c49 3c4a .dw PFA_SLASHMOD + PFA_SLASHMOD: +003c4a 019c movw temp2, tosl + +003c4b 9109 ld temp0, Y+ +003c4c 9119 ld temp1, Y+ + +003c4d 2f41 mov temp6,temp1 ;move dividend High to sign register +003c4e 2743 eor temp6,temp3 ;xor divisor High with sign register +003c4f ff17 sbrs temp1,7 ;if MSB in dividend set +003c50 c004 rjmp PFA_SLASHMOD_1 +003c51 9510 com temp1 ; change sign of dividend +003c52 9500 com temp0 +003c53 5f0f subi temp0,low(-1) +003c54 4f1f sbci temp1,high(-1) + PFA_SLASHMOD_1: +003c55 ff37 sbrs temp3,7 ;if MSB in divisor set +003c56 c004 rjmp PFA_SLASHMOD_2 +003c57 9530 com temp3 ; change sign of divisor +003c58 9520 com temp2 +003c59 5f2f subi temp2,low(-1) +003c5a 4f3f sbci temp3,high(-1) +003c5b 24ee PFA_SLASHMOD_2: clr temp4 ;clear remainder Low byte +003c5c 18ff sub temp5,temp5;clear remainder High byte and carry +003c5d e151 ldi temp7,17 ;init loop counter + +003c5e 1f00 PFA_SLASHMOD_3: rol temp0 ;shift left dividend +003c5f 1f11 rol temp1 +003c60 955a dec temp7 ;decrement counter +003c61 f439 brne PFA_SLASHMOD_5 ;if done +003c62 ff47 sbrs temp6,7 ; if MSB in sign register set +003c63 c004 rjmp PFA_SLASHMOD_4 +003c64 9510 com temp1 ; change sign of result +003c65 9500 com temp0 +003c66 5f0f subi temp0,low(-1) +003c67 4f1f sbci temp1,high(-1) +003c68 c00b PFA_SLASHMOD_4: rjmp PFA_SLASHMODmod_done ; return +003c69 1cee PFA_SLASHMOD_5: rol temp4 ;shift dividend into remainder +003c6a 1cff rol temp5 +003c6b 1ae2 sub temp4,temp2 ;remainder = remainder - divisor +003c6c 0af3 sbc temp5,temp3 ; +003c6d f420 brcc PFA_SLASHMOD_6 ;if result negative +003c6e 0ee2 add temp4,temp2 ; restore remainder +003c6f 1ef3 adc temp5,temp3 +003c70 9488 clc ; clear carry to be shifted into result +003c71 cfec rjmp PFA_SLASHMOD_3 ;else +003c72 9408 PFA_SLASHMOD_6: sec ; set carry to be shifted into result +003c73 cfea rjmp PFA_SLASHMOD_3 + + PFA_SLASHMODmod_done: + ; put remainder on stack +003c74 92fa st -Y,temp5 +003c75 92ea st -Y,temp4 + + ; put quotient on stack +003c76 01c8 movw tosl, temp0 +003c77 cb8d jmp_ DO_NEXT + .include "words/abs.asm" + + ; DUP ?NEGATE ; + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_ABS: +003c78 ff03 .dw $ff03 +003c79 6261 +003c7a 0073 .db "abs",0 +003c7b 3c45 .dw VE_HEAD + .set VE_HEAD = VE_ABS + XT_ABS: +003c7c 3801 .dw DO_COLON + PFA_ABS: + + .endif + +003c7d 38b1 +003c7e 3a3e +003c7f 3820 .DW XT_DUP,XT_QNEGATE,XT_EXIT + .include "words/pick.asm" + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_PICK: +003c80 ff04 .dw $ff04 +003c81 6970 +003c82 6b63 .db "pick" +003c83 3c78 .dw VE_HEAD + .set VE_HEAD = VE_PICK + XT_PICK: +003c84 3801 .dw DO_COLON + PFA_PICK: + .endif +003c85 3a2f .dw XT_1PLUS +003c86 3ec4 .dw XT_CELLS +003c87 3a8d .dw XT_SP_FETCH +003c88 399d .dw XT_PLUS +003c89 3879 .dw XT_FETCH +003c8a 3820 .dw XT_EXIT + .include "words/cellplus.asm" + + ; Arithmetics + ; add the size of an address-unit to a-addr1 + VE_CELLPLUS: +003c8b ff05 .dw $ff05 +003c8c 6563 +003c8d 6c6c +003c8e 002b .db "cell+",0 +003c8f 3c80 .dw VE_HEAD + .set VE_HEAD = VE_CELLPLUS + XT_CELLPLUS: +003c90 3c91 .dw PFA_CELLPLUS + PFA_CELLPLUS: +003c91 9602 adiw tosl, CELLSIZE +003c92 cb72 jmp_ DO_NEXT + .include "dict/interrupt.inc" + + .if WANT_INTERRUPTS == 1 + + .if WANT_INTERRUPT_COUNTERS == 1 + .endif + + .include "words/int-on.asm" + + ; Interrupt + ; turns on all interrupts + VE_INTON: +003c93 ff04 .dw $ff04 +003c94 692b +003c95 746e .db "+int" +003c96 3c8b .dw VE_HEAD + .set VE_HEAD = VE_INTON + XT_INTON: +003c97 3c98 .dw PFA_INTON + PFA_INTON: +003c98 9478 sei +003c99 cb6b jmp_ DO_NEXT + .include "words/int-off.asm" + + ; Interrupt + ; turns off all interrupts + VE_INTOFF: +003c9a ff04 .dw $ff04 +003c9b 692d +003c9c 746e .db "-int" +003c9d 3c93 .dw VE_HEAD + .set VE_HEAD = VE_INTOFF + XT_INTOFF: +003c9e 3c9f .dw PFA_INTOFF + PFA_INTOFF: +003c9f 94f8 cli +003ca0 cb64 jmp_ DO_NEXT + .include "words/int-store.asm" + + ; Interrupt + ; stores XT as interrupt vector i + VE_INTSTORE: +003ca1 ff04 .dw $ff04 +003ca2 6e69 +003ca3 2174 .db "int!" +003ca4 3c9a .dw VE_HEAD + .set VE_HEAD = VE_INTSTORE + XT_INTSTORE: +003ca5 3801 .dw DO_COLON + PFA_INTSTORE: +003ca6 383d .dw XT_DOLITERAL +003ca7 0000 .dw intvec +003ca8 399d .dw XT_PLUS +003ca9 3b3b .dw XT_STOREE +003caa 3820 .dw XT_EXIT + .include "words/int-fetch.asm" + + ; Interrupt + ; fetches XT from interrupt vector i + VE_INTFETCH: +003cab ff04 .dw $ff04 +003cac 6e69 +003cad 4074 .db "int@" +003cae 3ca1 .dw VE_HEAD + .set VE_HEAD = VE_INTFETCH + XT_INTFETCH: +003caf 3801 .dw DO_COLON + PFA_INTFETCH: +003cb0 383d .dw XT_DOLITERAL +003cb1 0000 .dw intvec +003cb2 399d .dw XT_PLUS +003cb3 3b5f .dw XT_FETCHE +003cb4 3820 .dw XT_EXIT + .include "words/int-trap.asm" + + ; Interrupt + ; trigger an interrupt + VE_INTTRAP: +003cb5 ff08 .dw $ff08 +003cb6 6e69 +003cb7 2d74 +003cb8 7274 +003cb9 7061 .db "int-trap" +003cba 3cab .dw VE_HEAD + .set VE_HEAD = VE_INTTRAP + XT_INTTRAP: +003cbb 3cbc .dw PFA_INTTRAP + PFA_INTTRAP: +003cbc 2eb8 mov isrflag, tosl +003cbd 9189 +003cbe 9199 loadtos +003cbf cb45 jmp_ DO_NEXT + + .include "words/isr-exec.asm" + + ; Interrupt + ; executes an interrupt service routine + ;VE_ISREXEC: + ; .dw $ff08 + ; .db "isr-exec" + ; .dw VE_HEAD + ; .set VE_HEAD = VE_ISREXEC + XT_ISREXEC: +003cc0 3801 .dw DO_COLON + PFA_ISREXEC: +003cc1 3caf .dw XT_INTFETCH +003cc2 382a .dw XT_EXECUTE +003cc3 3cc5 .dw XT_ISREND +003cc4 3820 .dw XT_EXIT + .include "words/isr-end.asm" + + ; Interrupt + ; re-enables interrupts in an ISR + ;VE_ISREND: + ; .dw $ff07 + ; .db "isr-end",0 + ; .dw VE_HEAD + ; .set VE_HEAD = VE_ISREND + XT_ISREND: +003cc5 3cc6 .dw PFA_ISREND + PFA_ISREND: +003cc6 d001 rcall PFA_ISREND1 ; clear the interrupt flag for the controller +003cc7 cb3d jmp_ DO_NEXT + PFA_ISREND1: +003cc8 9518 reti + .endif + + ; now the relocatable colon words + .include "words/prompt-ok.asm" + + ; System + ; send the READY prompt to the command line + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + ;VE_PROMPTOK: + ; .dw $ff02 + ; .db "ok" + ; .dw VE_HEAD + ; .set VE_HEAD = VE_PROMPTOK + XT_DEFAULT_PROMPTOK: +003cc9 3801 .dw DO_COLON + PFA_DEFAULT_PROMPTOK: +003cca 03c5 .dw XT_DOSLITERAL +003ccb 0003 .dw 3 +003ccc 6f20 +003ccd 006b .db " ok",0 + .endif +003cce 03f8 .dw XT_ITYPE +003ccf 3820 .dw XT_EXIT + + ; ------------------------ + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_PROMPTOK: +003cd0 ff03 .dw $FF03 +003cd1 6f2e +../../common\words/prompt-ok.asm(43): warning: .cseg .db misalignment - padding zero byte +003cd2 006b .db ".ok" +003cd3 3cb5 .dw VE_HEAD + .set VE_HEAD = VE_PROMPTOK + XT_PROMPTOK: +003cd4 3dff .dw PFA_DODEFER1 + PFA_PROMPTOK: + .endif +003cd5 001c .dw USER_P_OK +003cd6 3dc8 .dw XT_UDEFERFETCH +003cd7 3dd4 .dw XT_UDEFERSTORE + .include "words/prompt-ready.asm" + + ; System + ; process the error prompt + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + ;VE_PROMPTRDY: + ; .dw $ff04 + ; .db "p_er" + ; .dw VE_HEAD + ; .set VE_HEAD = VE_PROMPTRDY + XT_DEFAULT_PROMPTREADY: +003cd8 3801 .dw DO_COLON + PFA_DEFAULT_PROMPTREADY: +003cd9 03c5 .dw XT_DOSLITERAL +003cda 0002 .dw 2 +003cdb 203e .db "> " + .endif +003cdc 3fa1 .dw XT_CR +003cdd 03f8 .dw XT_ITYPE +003cde 3820 .dw XT_EXIT + + ; ------------------------ + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_PROMPTREADY: +003cdf ff06 .dw $FF06 +003ce0 722e +003ce1 6165 +003ce2 7964 .db ".ready" +003ce3 3cd0 .dw VE_HEAD + .set VE_HEAD = VE_PROMPTREADY + XT_PROMPTREADY: +003ce4 3dff .dw PFA_DODEFER1 + PFA_PROMPTREADY: + .endif +003ce5 0020 .dw USER_P_RDY +003ce6 3dc8 .dw XT_UDEFERFETCH +003ce7 3dd4 .dw XT_UDEFERSTORE + .include "words/prompt-error.asm" + + ; System + ; process the error prompt + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + ;VE_PROMPTERROR: + ; .dw $ff04 + ; .db "p_er" + ; .dw VE_HEAD + ; .set VE_HEAD = VE_PROMPTERROR + XT_DEFAULT_PROMPTERROR: +003ce8 3801 .dw DO_COLON + PFA_DEFAULT_PROMPTERROR: +003ce9 03c5 .dw XT_DOSLITERAL +003cea 0004 .dw 4 +003ceb 3f20 +003cec 203f .db " ?? " + .endif +003ced 03f8 .dw XT_ITYPE +003cee 3ebd .dw XT_BASE +003cef 3879 .dw XT_FETCH +003cf0 38ff .dw XT_TO_R +003cf1 3f41 .dw XT_DECIMAL +003cf2 037a .dw XT_DOT +003cf3 3ee2 .dw XT_TO_IN +003cf4 3879 .dw XT_FETCH +003cf5 037a .dw XT_DOT +003cf6 38f6 .dw XT_R_FROM +003cf7 3ebd .dw XT_BASE +003cf8 3881 .dw XT_STORE +003cf9 3820 .dw XT_EXIT + + ; ------------------------ + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_PROMPTERROR: +003cfa ff06 .dw $FF06 +003cfb 652e +003cfc 7272 +003cfd 726f .db ".error" +003cfe 3cdf .dw VE_HEAD + .set VE_HEAD = VE_PROMPTERROR + XT_PROMPTERROR: +003cff 3dff .dw PFA_DODEFER1 + PFA_PROMPTERROR: + .endif +003d00 001e .dw USER_P_ERR +003d01 3dc8 .dw XT_UDEFERFETCH +003d02 3dd4 .dw XT_UDEFERSTORE + + .include "words/quit.asm" + + ; System + ; main loop of amforth. accept - interpret in an endless loop + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_QUIT: +003d03 ff04 .dw $ff04 +003d04 7571 +003d05 7469 .db "quit" +003d06 3cfa .dw VE_HEAD + .set VE_HEAD = VE_QUIT + XT_QUIT: +003d07 3801 .dw DO_COLON + .endif + PFA_QUIT: +003d08 0851 +003d09 0858 +003d0a 3881 .dw XT_LP0,XT_LP,XT_STORE +003d0b 05ca .dw XT_SP0 +003d0c 3a96 .dw XT_SP_STORE +003d0d 05d7 .dw XT_RP0 +003d0e 3a80 .dw XT_RP_STORE +003d0f 08e6 .dw XT_LBRACKET + + PFA_QUIT2: +003d10 3eb7 .dw XT_STATE +003d11 3879 .dw XT_FETCH +003d12 391a .dw XT_ZEROEQUAL +003d13 3836 .dw XT_DOCONDBRANCH +003d14 3d16 DEST(PFA_QUIT4) +003d15 3ce4 .dw XT_PROMPTREADY + PFA_QUIT4: +003d16 04de .dw XT_REFILL +003d17 3836 .dw XT_DOCONDBRANCH +003d18 3d28 DEST(PFA_QUIT3) +003d19 383d .dw XT_DOLITERAL +003d1a 0625 .dw XT_INTERPRET +003d1b 3d70 .dw XT_CATCH +003d1c 38b9 .dw XT_QDUP +003d1d 3836 .dw XT_DOCONDBRANCH +003d1e 3d28 DEST(PFA_QUIT3) +003d1f 38b1 .dw XT_DUP +003d20 383d .dw XT_DOLITERAL +003d21 fffe .dw -2 +003d22 396e .dw XT_LESS +003d23 3836 .dw XT_DOCONDBRANCH +003d24 3d26 DEST(PFA_QUIT5) +003d25 3cff .dw XT_PROMPTERROR + PFA_QUIT5: +003d26 382f .dw XT_DOBRANCH +003d27 3d08 DEST(PFA_QUIT) + PFA_QUIT3: +003d28 3cd4 .dw XT_PROMPTOK +003d29 382f .dw XT_DOBRANCH +003d2a 3d10 DEST(PFA_QUIT2) + ; .dw XT_EXIT ; never reached + + .include "words/pause.asm" + + ; Multitasking + ; Fetch pause vector and execute it. may make a context/task switch + VE_PAUSE: +003d2b ff05 .dw $ff05 +003d2c 6170 +003d2d 7375 +003d2e 0065 .db "pause",0 +003d2f 3d03 .dw VE_HEAD + .set VE_HEAD = VE_PAUSE + XT_PAUSE: +003d30 3dff .dw PFA_DODEFER1 + PFA_PAUSE: +003d31 00ed .dw ram_pause +003d32 3db4 .dw XT_RDEFERFETCH +003d33 3dbe .dw XT_RDEFERSTORE + + .dseg +0000ed ram_pause: .byte 2 + .cseg + .include "words/cold.asm" + + ; System + ; start up amforth. + VE_COLD: +003d34 ff04 .dw $ff04 +003d35 6f63 +003d36 646c .db "cold" +003d37 3d2b .dw VE_HEAD + .set VE_HEAD = VE_COLD + XT_COLD: +003d38 3d39 .dw PFA_COLD + PFA_COLD: +003d39 b6a4 in_ mcu_boot, MCUSR +003d3a 2422 clr zerol +003d3b 2433 clr zeroh +003d3c 24bb clr isrflag +003d3d be24 out_ MCUSR, zerol + ; clear RAM +003d3e e6e0 ldi zl, low(ramstart) +003d3f e0f0 ldi zh, high(ramstart) + clearloop: +003d40 9221 st Z+, zerol +003d41 36e0 cpi zl, low(sram_size+ramstart) +003d42 f7e9 brne clearloop +003d43 30f8 cpi zh, high(sram_size+ramstart) +003d44 f7d9 brne clearloop + ; init first user data area + ; allocate space for User Area + .dseg +0000ef ram_user1: .byte SYSUSERSIZE + APPUSERSIZE + .cseg +003d45 eeef ldi zl, low(ram_user1) +003d46 e0f0 ldi zh, high(ram_user1) +003d47 012f movw upl, zl + ; init return stack pointer +003d48 e50f ldi temp0,low(rstackstart) +003d49 bf0d out_ SPL,temp0 +003d4a 8304 std Z+4, temp0 +003d4b e018 ldi temp1,high(rstackstart) +003d4c bf1e out_ SPH,temp1 +003d4d 8315 std Z+5, temp1 + + ; init parameter stack pointer +003d4e e0cf ldi yl,low(stackstart) +003d4f 83c6 std Z+6, yl +003d50 e0d8 ldi yh,high(stackstart) +003d51 83d7 std Z+7, yh + + ; load Forth IP with starting word +003d52 e5aa ldi XL, low(PFA_WARM) +003d53 e3bd ldi XH, high(PFA_WARM) + ; its a far jump... +003d54 cab0 jmp_ DO_NEXT + .include "words/warm.asm" + + ; System + ; initialize amforth further. executes turnkey operation and go to quit + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_WARM: +003d55 ff04 .dw $ff04 +003d56 6177 +003d57 6d72 .db "warm" +003d58 3d34 .dw VE_HEAD + .set VE_HEAD = VE_WARM + XT_WARM: +003d59 3801 .dw DO_COLON + PFA_WARM: + .endif +003d5a 0297 .dw XT_INIT_RAM +003d5b 383d .dw XT_DOLITERAL +003d5c 019a .dw XT_NOOP +003d5d 383d .dw XT_DOLITERAL +003d5e 3d30 .dw XT_PAUSE +003d5f 3ddf .dw XT_DEFERSTORE +003d60 08e6 .dw XT_LBRACKET +003d61 3f5c .dw XT_TURNKEY +003d62 3d07 .dw XT_QUIT ; never returns + + .include "words/handler.asm" + + ; Exceptions + ; USER variable used by catch/throw + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_HANDLER: +003d63 ff07 .dw $ff07 +003d64 6168 +003d65 646e +003d66 656c +003d67 0072 .db "handler",0 +003d68 3d55 .dw VE_HEAD + .set VE_HEAD = VE_HANDLER + XT_HANDLER: +003d69 3858 .dw PFA_DOUSER + PFA_HANDLER: + .endif +003d6a 000a .dw USER_HANDLER + .include "words/catch.asm" + + ; Exceptions + ; execute XT and check for exceptions. + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_CATCH: +003d6b ff05 .dw $ff05 +003d6c 6163 +003d6d 6374 +003d6e 0068 .db "catch",0 +003d6f 3d63 .dw VE_HEAD + .set VE_HEAD = VE_CATCH + XT_CATCH: +003d70 3801 .dw DO_COLON + PFA_CATCH: + .endif + + ; sp@ >r +003d71 3a8d .dw XT_SP_FETCH +003d72 38ff .dw XT_TO_R + ; handler @ >r +003d73 3d69 .dw XT_HANDLER +003d74 3879 .dw XT_FETCH +003d75 38ff .dw XT_TO_R + ; rp@ handler ! +003d76 3a76 .dw XT_RP_FETCH +003d77 3d69 .dw XT_HANDLER +003d78 3881 .dw XT_STORE +003d79 382a .dw XT_EXECUTE + ; r> handler ! +003d7a 38f6 .dw XT_R_FROM +003d7b 3d69 .dw XT_HANDLER +003d7c 3881 .dw XT_STORE +003d7d 38f6 .dw XT_R_FROM +003d7e 38d9 .dw XT_DROP +003d7f 3954 .dw XT_ZERO +003d80 3820 .dw XT_EXIT + .include "words/throw.asm" + + ; Exceptions + ; throw an exception + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_THROW: +003d81 ff05 .dw $ff05 +003d82 6874 +003d83 6f72 +003d84 0077 .db "throw",0 +003d85 3d6b .dw VE_HEAD + .set VE_HEAD = VE_THROW + XT_THROW: +003d86 3801 .dw DO_COLON + PFA_THROW: + .endif +003d87 38b1 .dw XT_DUP +003d88 391a .dw XT_ZEROEQUAL +003d89 3836 .dw XT_DOCONDBRANCH +003d8a 3d8d DEST(PFA_THROW1) +003d8b 38d9 .dw XT_DROP +003d8c 3820 .dw XT_EXIT + PFA_THROW1: +003d8d 3d69 .dw XT_HANDLER +003d8e 3879 .dw XT_FETCH +003d8f 3a80 .dw XT_RP_STORE +003d90 38f6 .dw XT_R_FROM +003d91 3d69 .dw XT_HANDLER +003d92 3881 .dw XT_STORE +003d93 38f6 .dw XT_R_FROM +003d94 38c4 .dw XT_SWAP +003d95 38ff .dw XT_TO_R +003d96 3a96 .dw XT_SP_STORE +003d97 38d9 .dw XT_DROP +003d98 38f6 .dw XT_R_FROM +003d99 3820 .dw XT_EXIT + + + + .include "words/edefer-fetch.asm" + + ; System + ; does the real defer@ for eeprom defers + VE_EDEFERFETCH: +003d9a ff07 .dw $ff07 +003d9b 6445 +003d9c 6665 +003d9d 7265 +003d9e 0040 .db "Edefer@",0 +003d9f 3d81 .dw VE_HEAD + .set VE_HEAD = VE_EDEFERFETCH + XT_EDEFERFETCH: +003da0 3801 .dw DO_COLON + PFA_EDEFERFETCH: +003da1 3bcb .dw XT_FETCHI +003da2 3b5f .dw XT_FETCHE +003da3 3820 .dw XT_EXIT + .include "words/edefer-store.asm" + + ; System + ; does the real defer! for eeprom defers + VE_EDEFERSTORE: +003da4 ff07 .dw $ff07 +003da5 6445 +003da6 6665 +003da7 7265 +003da8 0021 .db "Edefer!",0 +003da9 3d9a .dw VE_HEAD + .set VE_HEAD = VE_EDEFERSTORE + XT_EDEFERSTORE: +003daa 3801 .dw DO_COLON + PFA_EDEFERSTORE: +003dab 3bcb .dw XT_FETCHI +003dac 3b3b .dw XT_STOREE +003dad 3820 .dw XT_EXIT + .include "words/rdefer-fetch.asm" + + ; System + ; The defer@ for ram defers + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_RDEFERFETCH: +003dae ff07 .dw $ff07 +003daf 6452 +003db0 6665 +003db1 7265 +003db2 0040 .db "Rdefer@",0 +003db3 3da4 .dw VE_HEAD + .set VE_HEAD = VE_RDEFERFETCH + XT_RDEFERFETCH: +003db4 3801 .dw DO_COLON + PFA_RDEFERFETCH: + .endif +003db5 3bcb .dw XT_FETCHI +003db6 3879 .dw XT_FETCH +003db7 3820 .dw XT_EXIT + .include "words/rdefer-store.asm" + + ; System + ; The defer! for ram defers + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_RDEFERSTORE: +003db8 ff07 .dw $ff07 +003db9 6452 +003dba 6665 +003dbb 7265 +003dbc 0021 .db "Rdefer!",0 +003dbd 3dae .dw VE_HEAD + .set VE_HEAD = VE_RDEFERSTORE + XT_RDEFERSTORE: +003dbe 3801 .dw DO_COLON + PFA_RDEFERSTORE: + .endif +003dbf 3bcb .dw XT_FETCHI +003dc0 3881 .dw XT_STORE +003dc1 3820 .dw XT_EXIT + + .include "words/udefer-fetch.asm" + + ; System + ; does the real defer@ for user based defers + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_UDEFERFETCH: +003dc2 ff07 .dw $ff07 +003dc3 6455 +003dc4 6665 +003dc5 7265 +003dc6 0040 .db "Udefer@",0 +003dc7 3db8 .dw VE_HEAD + .set VE_HEAD = VE_UDEFERFETCH + XT_UDEFERFETCH: +003dc8 3801 .dw DO_COLON + PFA_UDEFERFETCH: + .endif +003dc9 3bcb .dw XT_FETCHI +003dca 3b02 .dw XT_UP_FETCH +003dcb 399d .dw XT_PLUS +003dcc 3879 .dw XT_FETCH +003dcd 3820 .dw XT_EXIT + .include "words/udefer-store.asm" + + ; System + ; does the real defer! for user based defers + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_UDEFERSTORE: +003dce ff07 .dw $ff07 +003dcf 6455 +003dd0 6665 +003dd1 7265 +003dd2 0021 .db "Udefer!",0 +003dd3 3dc2 .dw VE_HEAD + .set VE_HEAD = VE_UDEFERSTORE + XT_UDEFERSTORE: +003dd4 3801 .dw DO_COLON + PFA_UDEFERSTORE: + .endif + +003dd5 3bcb .dw XT_FETCHI +003dd6 3b02 .dw XT_UP_FETCH +003dd7 399d .dw XT_PLUS +003dd8 3881 .dw XT_STORE +003dd9 3820 .dw XT_EXIT + + .include "words/defer-store.asm" + + ; System + ; stores xt1 as the xt to be executed when xt2 is called + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_DEFERSTORE: +003dda ff06 .dw $ff06 +003ddb 6564 +003ddc 6566 +003ddd 2172 .db "defer!" +003dde 3dce .dw VE_HEAD + .set VE_HEAD = VE_DEFERSTORE + XT_DEFERSTORE: +003ddf 3801 .dw DO_COLON + PFA_DEFERSTORE: + .endif +003de0 3fd0 .dw XT_TO_BODY +003de1 38b1 .dw XT_DUP +003de2 01c6 .dw XT_ICELLPLUS +003de3 01c6 .dw XT_ICELLPLUS +003de4 3bcb .dw XT_FETCHI +003de5 382a .dw XT_EXECUTE +003de6 3820 .dw XT_EXIT + + .include "words/defer-fetch.asm" + + ; System + ; returns the XT associated with the given XT + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_DEFERFETCH: +003de7 ff06 .dw $ff06 +003de8 6564 +003de9 6566 +003dea 4072 .db "defer@" +003deb 3dda .dw VE_HEAD + .set VE_HEAD = VE_DEFERFETCH + XT_DEFERFETCH: +003dec 3801 .dw DO_COLON + PFA_DEFERFETCH: + .endif +003ded 3fd0 .dw XT_TO_BODY +003dee 38b1 .dw XT_DUP +003def 01c6 .dw XT_ICELLPLUS +003df0 3bcb .dw XT_FETCHI +003df1 382a .dw XT_EXECUTE +003df2 3820 .dw XT_EXIT + .include "words/do-defer.asm" + + ; System + ; runtime of defer + VE_DODEFER: +003df3 ff07 .dw $ff07 +003df4 6428 +003df5 6665 +003df6 7265 +003df7 0029 .db "(defer)", 0 +003df8 3de7 .dw VE_HEAD + .set VE_HEAD = VE_DODEFER + XT_DODEFER: +003df9 3801 .dw DO_COLON + PFA_DODEFER: +003dfa 072e .dw XT_DOCREATE +003dfb 088e .dw XT_REVEAL +003dfc 0751 .dw XT_COMPILE +003dfd 3dff .dw PFA_DODEFER1 +003dfe 3820 .dw XT_EXIT + PFA_DODEFER1: +003dff 940e 08a7 call_ DO_DODOES +003e01 38b1 .dw XT_DUP +003e02 01c6 .dw XT_ICELLPLUS +003e03 3bcb .dw XT_FETCHI +003e04 382a .dw XT_EXECUTE +003e05 382a .dw XT_EXECUTE +003e06 3820 .dw XT_EXIT + + ; : (defer) dup i-cell+ @i execute execute ; + + + .include "words/u-dot.asm" + + ; Numeric IO + ; unsigned PNO with single cell numbers + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_UDOT: +003e07 ff02 .dw $ff02 +003e08 2e75 .db "u." +003e09 3df3 .dw VE_HEAD + .set VE_HEAD = VE_UDOT + XT_UDOT: +003e0a 3801 .dw DO_COLON + PFA_UDOT: + .endif +003e0b 3954 .dw XT_ZERO +003e0c 0382 .dw XT_UDDOT +003e0d 3820 .dw XT_EXIT + ; : u. ( us -- ) 0 ud. ; + .include "words/u-dot-r.asm" + + ; Numeric IO + ; unsigned PNO with single cells numbers, right aligned in width w + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + + + VE_UDOTR: +003e0e ff03 .dw $ff03 +003e0f 2e75 +003e10 0072 .db "u.r",0 +003e11 3e07 .dw VE_HEAD + .set VE_HEAD = VE_UDOTR + XT_UDOTR: +003e12 3801 .dw DO_COLON + PFA_UDOTR: + .endif +003e13 3954 .dw XT_ZERO +003e14 38c4 .dw XT_SWAP +003e15 038b .dw XT_UDDOTR +003e16 3820 .dw XT_EXIT + ; : u.r ( s n -- ) 0 swap ud.r ; + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;; + .include "words/uslashmod.asm" + + ; Arithmetics + ; unsigned division with remainder + VE_USLASHMOD: +003e17 ff05 .dw $ff05 +003e18 2f75 +003e19 6f6d +003e1a 0064 .db "u/mod",0 +003e1b 3e0e .dw VE_HEAD + .set VE_HEAD = VE_USLASHMOD + XT_USLASHMOD: +003e1c 3801 .dw DO_COLON + PFA_USLASHMOD: +003e1d 38ff .dw XT_TO_R +003e1e 3954 .dw XT_ZERO +003e1f 38f6 .dw XT_R_FROM +003e20 39c2 .dw XT_UMSLASHMOD +003e21 3820 .dw XT_EXIT + .include "words/negate.asm" + + ; Logic + ; 2-complement + VE_NEGATE: +003e22 ff06 .dw $ff06 +003e23 656e +003e24 6167 +003e25 6574 .db "negate" +003e26 3e17 .dw VE_HEAD + .set VE_HEAD = VE_NEGATE + XT_NEGATE: +003e27 3801 .dw DO_COLON + PFA_NEGATE: +003e28 39fd .dw XT_INVERT +003e29 3a2f .dw XT_1PLUS +003e2a 3820 .dw XT_EXIT + .include "words/slash.asm" + + ; Arithmetics + ; divide n1 by n2. giving the quotient + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + + + VE_SLASH: +003e2b ff01 .dw $ff01 +003e2c 002f .db "/",0 +003e2d 3e22 .dw VE_HEAD + .set VE_HEAD = VE_SLASH + XT_SLASH: +003e2e 3801 .dw DO_COLON + PFA_SLASH: + .endif +003e2f 3c49 .dw XT_SLASHMOD +003e30 38f0 .dw XT_NIP +003e31 3820 .dw XT_EXIT + + .include "words/mod.asm" + + ; Arithmetics + ; divide n1 by n2 giving the remainder n3 + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + + + VE_MOD: +003e32 ff03 .dw $ff03 +003e33 6f6d +003e34 0064 .db "mod",0 +003e35 3e2b .dw VE_HEAD + .set VE_HEAD = VE_MOD + XT_MOD: +003e36 3801 .dw DO_COLON + PFA_MOD: + .endif +003e37 3c49 .dw XT_SLASHMOD +003e38 38d9 .dw XT_DROP +003e39 3820 .dw XT_EXIT + + .include "words/min.asm" + + ; Compare + ; compare two values leave the smaller one + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + + + VE_MIN: +003e3a ff03 .dw $ff03 +003e3b 696d +003e3c 006e .db "min",0 +003e3d 3e32 .dw VE_HEAD + .set VE_HEAD = VE_MIN + XT_MIN: +003e3e 3801 .dw DO_COLON + PFA_MIN: + .endif +003e3f 3ec9 .dw XT_2DUP +003e40 3978 .dw XT_GREATER +003e41 3836 .dw XT_DOCONDBRANCH +003e42 3e44 DEST(PFA_MIN1) +003e43 38c4 .dw XT_SWAP + PFA_MIN1: +003e44 38d9 .dw XT_DROP +003e45 3820 .dw XT_EXIT + .include "words/max.asm" + + ; Compare + ; compare two values, leave the bigger one + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_MAX: +003e46 ff03 .dw $ff03 +003e47 616d +003e48 0078 .db "max",0 +003e49 3e3a .dw VE_HEAD + .set VE_HEAD = VE_MAX + XT_MAX: +003e4a 3801 .dw DO_COLON + PFA_MAX: + + .endif +003e4b 3ec9 .dw XT_2DUP +003e4c 396e .dw XT_LESS +003e4d 3836 .dw XT_DOCONDBRANCH +003e4e 3e50 DEST(PFA_MAX1) +003e4f 38c4 .dw XT_SWAP + PFA_MAX1: +003e50 38d9 .dw XT_DROP +003e51 3820 .dw XT_EXIT + .include "words/within.asm" + + ; Compare + ; check if n is within min..max + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_WITHIN: +003e52 ff06 .dw $ff06 +003e53 6977 +003e54 6874 +003e55 6e69 .db "within" +003e56 3e46 .dw VE_HEAD + .set VE_HEAD = VE_WITHIN + XT_WITHIN: +003e57 3801 .dw DO_COLON + PFA_WITHIN: + .endif +003e58 38cf .dw XT_OVER +003e59 3993 .dw XT_MINUS +003e5a 38ff .dw XT_TO_R +003e5b 3993 .dw XT_MINUS +003e5c 38f6 .dw XT_R_FROM +003e5d 395c .dw XT_ULESS +003e5e 3820 .dw XT_EXIT + + .include "words/show-wordlist.asm" + + ; Tools + ; prints the name of the words in a wordlist + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_SHOWWORDLIST: +003e5f ff0d .dw $ff0d +003e60 6873 +003e61 776f +003e62 772d +003e63 726f +003e64 6c64 +003e65 7369 +003e66 0074 .db "show-wordlist",0 +003e67 3e52 .dw VE_HEAD + .set VE_HEAD = VE_SHOWWORDLIST + XT_SHOWWORDLIST: +003e68 3801 .dw DO_COLON + PFA_SHOWWORDLIST: + .endif +003e69 383d .dw XT_DOLITERAL +003e6a 3e6e .dw XT_SHOWWORD +003e6b 38c4 .dw XT_SWAP +003e6c 06cf .dw XT_TRAVERSEWORDLIST +003e6d 3820 .dw XT_EXIT + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + XT_SHOWWORD: +003e6e 3801 .dw DO_COLON + PFA_SHOWWORD: + .endif +003e6f 06ea .dw XT_NAME2STRING +003e70 03f8 .dw XT_ITYPE +003e71 3fae .dw XT_SPACE ; ( -- addr n) +003e72 394b .dw XT_TRUE +003e73 3820 .dw XT_EXIT + .include "words/words.asm" + + ; Tools + ; prints a list of all (visible) words in the dictionary + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + + + VE_WORDS: +003e74 ff05 .dw $ff05 +003e75 6f77 +003e76 6472 +003e77 0073 .db "words",0 +003e78 3e5f .dw VE_HEAD + .set VE_HEAD = VE_WORDS + XT_WORDS: +003e79 3801 .dw DO_COLON + PFA_WORDS: + .endif +003e7a 383d .dw XT_DOLITERAL +003e7b 0042 .dw CFG_ORDERLISTLEN+2 +003e7c 3b5f .dw XT_FETCHE +003e7d 3e68 .dw XT_SHOWWORDLIST +003e7e 3820 .dw XT_EXIT + + .include "words/dot-quote.asm" + + ; Compiler + ; compiles string into dictionary to be printed at runtime + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + + + VE_DOTSTRING: +003e7f 0002 .dw $0002 +003e80 222e .db ".",$22 +003e81 3e74 .dw VE_HEAD + .set VE_HEAD = VE_DOTSTRING + XT_DOTSTRING: +003e82 3801 .dw DO_COLON + PFA_DOTSTRING: + .endif +003e83 3e8a .dw XT_SQUOTE +003e84 0751 .dw XT_COMPILE +003e85 03f8 .dw XT_ITYPE +003e86 3820 .dw XT_EXIT + .include "words/squote.asm" + + ; Compiler + ; compiles a string to flash, at runtime leaves ( -- flash-addr count) on stack + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_SQUOTE: +003e87 0002 .dw $0002 +003e88 2273 .db "s",$22 +003e89 3e7f .dw VE_HEAD + .set VE_HEAD = VE_SQUOTE + XT_SQUOTE: +003e8a 3801 .dw DO_COLON + PFA_SQUOTE: + .endif +003e8b 383d .dw XT_DOLITERAL +003e8c 0022 .dw 34 ; 0x22 +003e8d 0583 .dw XT_PARSE ; ( -- addr n) +003e8e 3eb7 .dw XT_STATE +003e8f 3879 .dw XT_FETCH +003e90 3836 .dw XT_DOCONDBRANCH +003e91 3e93 DEST(PFA_SQUOTE1) +003e92 077d .dw XT_SLITERAL + PFA_SQUOTE1: +003e93 3820 .dw XT_EXIT + .include "words/fill.asm" + + ; Memory + ; fill u bytes memory beginning at a-addr with character c + VE_FILL: +003e94 ff04 .dw $ff04 +003e95 6966 +003e96 6c6c .db "fill" +003e97 3e87 .dw VE_HEAD + .set VE_HEAD = VE_FILL + XT_FILL: +003e98 3801 .dw DO_COLON + PFA_FILL: +003e99 38e1 .dw XT_ROT +003e9a 38e1 .dw XT_ROT +003e9b 38b9 +003e9c 3836 .dw XT_QDUP,XT_DOCONDBRANCH +003e9d 3ea5 DEST(PFA_FILL2) +003e9e 3f99 .dw XT_BOUNDS +003e9f 3a9b .dw XT_DODO + PFA_FILL1: +003ea0 38b1 .dw XT_DUP +003ea1 3aac .dw XT_I +003ea2 388d .dw XT_CSTORE ; ( -- c c-addr) +003ea3 3ac9 .dw XT_DOLOOP +003ea4 3ea0 .dw PFA_FILL1 + PFA_FILL2: +003ea5 38d9 .dw XT_DROP +003ea6 3820 .dw XT_EXIT + + .include "words/f_cpu.asm" + + ; System + ; put the cpu frequency in Hz on stack + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_F_CPU: +003ea7 ff05 .dw $ff05 +003ea8 5f66 +003ea9 7063 +003eaa 0075 .db "f_cpu",0 +003eab 3e94 .dw VE_HEAD + .set VE_HEAD = VE_F_CPU + XT_F_CPU: +003eac 3801 .dw DO_COLON + PFA_F_CPU: + .endif +003ead 383d .dw XT_DOLITERAL +003eae 1200 .dw (F_CPU % 65536) +003eaf 383d .dw XT_DOLITERAL +003eb0 007a .dw (F_CPU / 65536) +003eb1 3820 .dw XT_EXIT + .include "words/state.asm" + + ; System Variable + ; system state + VE_STATE: +003eb2 ff05 .dw $ff05 +003eb3 7473 +003eb4 7461 +003eb5 0065 .db "state",0 +003eb6 3ea7 .dw VE_HEAD + .set VE_HEAD = VE_STATE + XT_STATE: +003eb7 3848 .dw PFA_DOVARIABLE + PFA_STATE: +003eb8 011b .dw ram_state + + .dseg +00011b ram_state: .byte 2 + .include "words/base.asm" + + ; Numeric IO + ; location of the cell containing the number conversion radix + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_BASE: +003eb9 ff04 .dw $ff04 +003eba 6162 +003ebb 6573 .db "base" +003ebc 3eb2 .dw VE_HEAD + .set VE_HEAD = VE_BASE + XT_BASE: +003ebd 3858 .dw PFA_DOUSER + PFA_BASE: + .endif +003ebe 000c .dw USER_BASE + + .include "words/cells.asm" + + ; Arithmetics + ; n2 is the size in address units of n1 cells + VE_CELLS: +003ebf ff05 .dw $ff05 +003ec0 6563 +003ec1 6c6c +003ec2 0073 .db "cells",0 +003ec3 3eb9 .dw VE_HEAD + .set VE_HEAD = VE_CELLS + XT_CELLS: +003ec4 3a0c .dw PFA_2STAR + + .include "words/2dup.asm" + + ; Stack + ; Duplicate the 2 top elements + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_2DUP: +003ec5 ff04 .dw $ff04 +003ec6 6432 +003ec7 7075 .db "2dup" +003ec8 3ebf .dw VE_HEAD + .set VE_HEAD = VE_2DUP + XT_2DUP: +003ec9 3801 .dw DO_COLON + PFA_2DUP: + .endif + +003eca 38cf .dw XT_OVER +003ecb 38cf .dw XT_OVER +003ecc 3820 .dw XT_EXIT + .include "words/2drop.asm" + + ; Stack + ; Remove the 2 top elements + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_2DROP: +003ecd ff05 .dw $ff05 +003ece 6432 +003ecf 6f72 +003ed0 0070 .db "2drop",0 +003ed1 3ec5 .dw VE_HEAD + .set VE_HEAD = VE_2DROP + XT_2DROP: +003ed2 3801 .dw DO_COLON + PFA_2DROP: + .endif +003ed3 38d9 .dw XT_DROP +003ed4 38d9 .dw XT_DROP +003ed5 3820 .dw XT_EXIT + .include "words/tuck.asm" + + ; Stack + ; Copy the first (top) stack item below the second stack item. + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_TUCK: +003ed6 ff04 .dw $ff04 +003ed7 7574 +003ed8 6b63 .db "tuck" +003ed9 3ecd .dw VE_HEAD + .set VE_HEAD = VE_TUCK + XT_TUCK: +003eda 3801 .dw DO_COLON + PFA_TUCK: + .endif +003edb 38c4 .dw XT_SWAP +003edc 38cf .dw XT_OVER +003edd 3820 .dw XT_EXIT + + .include "words/to-in.asm" + + ; System Variable + ; pointer to current read position in input buffer + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_TO_IN: +003ede ff03 .dw $ff03 +003edf 693e +003ee0 006e .db ">in",0 +003ee1 3ed6 .dw VE_HEAD + .set VE_HEAD = VE_TO_IN + XT_TO_IN: +003ee2 3858 .dw PFA_DOUSER + PFA_TO_IN: + .endif +003ee3 0018 .dw USER_TO_IN + .include "words/pad.asm" + + ; System Variable + ; Address of the temporary scratch buffer. + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_PAD: +003ee4 ff03 .dw $ff03 +003ee5 6170 +003ee6 0064 .db "pad",0 +003ee7 3ede .dw VE_HEAD + .set VE_HEAD = VE_PAD + XT_PAD: +003ee8 3801 .dw DO_COLON + PFA_PAD: + .endif +003ee9 3f23 .dw XT_HERE +003eea 383d .dw XT_DOLITERAL +003eeb 0028 .dw 40 +003eec 399d .dw XT_PLUS +003eed 3820 .dw XT_EXIT + .include "words/emit.asm" + + ; Character IO + ; fetch the emit vector and execute it. should emit a character from TOS + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_EMIT: +003eee ff04 .dw $ff04 +003eef 6d65 +003ef0 7469 .db "emit" +003ef1 3ee4 .dw VE_HEAD + .set VE_HEAD = VE_EMIT + XT_EMIT: +003ef2 3dff .dw PFA_DODEFER1 + PFA_EMIT: + .endif +003ef3 000e .dw USER_EMIT +003ef4 3dc8 .dw XT_UDEFERFETCH +003ef5 3dd4 .dw XT_UDEFERSTORE + .include "words/emitq.asm" + + ; Character IO + ; fetch emit? vector and execute it. should return the ready-to-send condition + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_EMITQ: +003ef6 ff05 .dw $ff05 +003ef7 6d65 +003ef8 7469 +003ef9 003f .db "emit?",0 +003efa 3eee .dw VE_HEAD + .set VE_HEAD = VE_EMITQ + XT_EMITQ: +003efb 3dff .dw PFA_DODEFER1 + PFA_EMITQ: + .endif +003efc 0010 .dw USER_EMITQ +003efd 3dc8 .dw XT_UDEFERFETCH +003efe 3dd4 .dw XT_UDEFERSTORE + .include "words/key.asm" + + ; Character IO + ; fetch key vector and execute it, should leave a single character on TOS + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_KEY: +003eff ff03 .dw $ff03 +003f00 656b +003f01 0079 .db "key",0 +003f02 3ef6 .dw VE_HEAD + .set VE_HEAD = VE_KEY + XT_KEY: +003f03 3dff .dw PFA_DODEFER1 + PFA_KEY: + .endif +003f04 0012 .dw USER_KEY +003f05 3dc8 .dw XT_UDEFERFETCH +003f06 3dd4 .dw XT_UDEFERSTORE + .include "words/keyq.asm" + + ; Character IO + ; fetch key? vector and execute it. should turn on key sender, if it is disabled/stopped + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_KEYQ: +003f07 ff04 .dw $ff04 +003f08 656b +003f09 3f79 .db "key?" +003f0a 3eff .dw VE_HEAD + .set VE_HEAD = VE_KEYQ + XT_KEYQ: +003f0b 3dff .dw PFA_DODEFER1 + PFA_KEYQ: + .endif +003f0c 0014 .dw USER_KEYQ +003f0d 3dc8 .dw XT_UDEFERFETCH +003f0e 3dd4 .dw XT_UDEFERSTORE + + .include "words/dp.asm" + + ; System Value + ; address of the next free dictionary cell + VE_DP: +003f0f ff02 .dw $ff02 +003f10 7064 .db "dp" +003f11 3f07 .dw VE_HEAD + .set VE_HEAD = VE_DP + XT_DP: +003f12 386f .dw PFA_DOVALUE1 + PFA_DP: +003f13 002c .dw CFG_DP +003f14 3da0 .dw XT_EDEFERFETCH +003f15 3daa .dw XT_EDEFERSTORE + .include "words/ehere.asm" + + ; System Value + ; address of the next free address in eeprom + VE_EHERE: +003f16 ff05 .dw $ff05 +003f17 6865 +003f18 7265 +003f19 0065 .db "ehere",0 +003f1a 3f0f .dw VE_HEAD + .set VE_HEAD = VE_EHERE + XT_EHERE: +003f1b 386f .dw PFA_DOVALUE1 + PFA_EHERE: +003f1c 0030 .dw EE_EHERE +003f1d 3da0 .dw XT_EDEFERFETCH +003f1e 3daa .dw XT_EDEFERSTORE + .include "words/here.asm" + + ; System Value + ; address of the next free data space (RAM) cell + VE_HERE: +003f1f ff04 .dw $ff04 +003f20 6568 +003f21 6572 .db "here" +003f22 3f16 .dw VE_HEAD + .set VE_HEAD = VE_HERE + XT_HERE: +003f23 386f .dw PFA_DOVALUE1 + PFA_HERE: +003f24 002e .dw EE_HERE +003f25 3da0 .dw XT_EDEFERFETCH +003f26 3daa .dw XT_EDEFERSTORE + .include "words/allot.asm" + + ; System + ; allocate or release memory in RAM + VE_ALLOT: +003f27 ff05 .dw $ff05 +003f28 6c61 +003f29 6f6c +003f2a 0074 .db "allot",0 +003f2b 3f1f .dw VE_HEAD + .set VE_HEAD = VE_ALLOT + XT_ALLOT: +003f2c 3801 .dw DO_COLON + PFA_ALLOT: +003f2d 3f23 .dw XT_HERE +003f2e 399d .dw XT_PLUS +003f2f 01b4 .dw XT_DOTO +003f30 3f24 .dw PFA_HERE +003f31 3820 .dw XT_EXIT + + .include "words/bin.asm" + + ; Numeric IO + ; set base for numeric conversion to 10 + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_BIN: +003f32 ff03 .dw $ff03 +003f33 6962 +003f34 006e .db "bin",0 +003f35 3f27 .dw VE_HEAD + .set VE_HEAD = VE_BIN + XT_BIN: +003f36 3801 .dw DO_COLON + PFA_BIN: + .endif +003f37 3feb .dw XT_TWO +003f38 3ebd .dw XT_BASE +003f39 3881 .dw XT_STORE +003f3a 3820 .dw XT_EXIT + .include "words/decimal.asm" + + ; Numeric IO + ; set base for numeric conversion to 10 + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_DECIMAL: +003f3b ff07 .dw $ff07 +003f3c 6564 +003f3d 6963 +003f3e 616d +003f3f 006c .db "decimal",0 +003f40 3f32 .dw VE_HEAD + .set VE_HEAD = VE_DECIMAL + XT_DECIMAL: +003f41 3801 .dw DO_COLON + PFA_DECIMAL: + .endif +003f42 383d .dw XT_DOLITERAL +003f43 000a .dw 10 +003f44 3ebd .dw XT_BASE +003f45 3881 .dw XT_STORE +003f46 3820 .dw XT_EXIT + .include "words/hex.asm" + + ; Numeric IO + ; set base for numeric conversion to 10 + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_HEX: +003f47 ff03 .dw $ff03 +003f48 6568 +003f49 0078 .db "hex",0 +003f4a 3f3b .dw VE_HEAD + .set VE_HEAD = VE_HEX + XT_HEX: +003f4b 3801 .dw DO_COLON + PFA_HEX: + .endif +003f4c 383d .dw XT_DOLITERAL +003f4d 0010 .dw 16 +003f4e 3ebd .dw XT_BASE +003f4f 3881 .dw XT_STORE +003f50 3820 .dw XT_EXIT + .include "words/bl.asm" + + ; Character IO + ; put ascii code of the blank to the stack + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_BL: +003f51 ff02 .dw $ff02 +003f52 6c62 .db "bl" +003f53 3f47 .dw VE_HEAD + .set VE_HEAD = VE_BL + XT_BL: +003f54 3848 .dw PFA_DOVARIABLE + PFA_BL: + .endif +003f55 0020 .dw 32 + + .include "words/turnkey.asm" + + ; System Value + ; Deferred action during startup/reset + VE_TURNKEY: +003f56 ff07 .dw $ff07 +003f57 7574 +003f58 6e72 +003f59 656b +003f5a 0079 .db "turnkey",0 +003f5b 3f51 .dw VE_HEAD + .set VE_HEAD = VE_TURNKEY + XT_TURNKEY: +003f5c 3dff .dw PFA_DODEFER1 + PFA_TURNKEY: +003f5d 0038 .dw CFG_TURNKEY +003f5e 3da0 .dw XT_EDEFERFETCH +003f5f 3daa .dw XT_EDEFERSTORE + .include "words/to-upper.asm" + + ; String + ; if c is a lowercase letter convert it to uppercase + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_TOUPPER: +003f60 ff07 .dw $ff07 +003f61 6f74 +003f62 7075 +003f63 6570 +003f64 0072 .db "toupper",0 +003f65 3f56 .dw VE_HEAD + .set VE_HEAD = VE_TOUPPER + XT_TOUPPER: +003f66 3801 .dw DO_COLON + PFA_TOUPPER: + .endif +003f67 38b1 .dw XT_DUP +003f68 383d .dw XT_DOLITERAL +003f69 0061 .dw 'a' +003f6a 383d .dw XT_DOLITERAL +003f6b 007b .dw 'z'+1 +003f6c 3e57 .dw XT_WITHIN +003f6d 3836 .dw XT_DOCONDBRANCH +003f6e 3f72 DEST(PFA_TOUPPER0) +003f6f 383d .dw XT_DOLITERAL +003f70 00df .dw 223 ; inverse of 0x20: 0xdf +003f71 3a13 .dw XT_AND + PFA_TOUPPER0: +003f72 3820 .dw XT_EXIT + .include "words/to-lower.asm" + + ; String + ; if C is an uppercase letter convert it to lowercase + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + + + VE_TOLOWER: +003f73 ff07 .dw $ff07 +003f74 6f74 +003f75 6f6c +003f76 6577 +003f77 0072 .db "tolower",0 +003f78 3f60 .dw VE_HEAD + .set VE_HEAD = VE_TOLOWER + XT_TOLOWER: +003f79 3801 .dw DO_COLON + PFA_TOLOWER: + .endif +003f7a 38b1 .dw XT_DUP +003f7b 383d .dw XT_DOLITERAL +003f7c 0041 .dw 'A' +003f7d 383d .dw XT_DOLITERAL +003f7e 005b .dw 'Z'+1 +003f7f 3e57 .dw XT_WITHIN +003f80 3836 .dw XT_DOCONDBRANCH +003f81 3f85 DEST(PFA_TOLOWER0) +003f82 383d .dw XT_DOLITERAL +003f83 0020 .dw 32 +003f84 3a1c .dw XT_OR + PFA_TOLOWER0: +003f85 3820 .dw XT_EXIT + + .include "words/q-stack.asm" + + ; Tools + ; check data stack depth and exit to quit if underrun + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_QSTACK: +003f86 ff06 .dw $ff06 +003f87 733f +003f88 6174 +003f89 6b63 .db "?stack" +003f8a 3f73 .dw VE_HEAD + .set VE_HEAD = VE_QSTACK + XT_QSTACK: +003f8b 3801 .dw DO_COLON + PFA_QSTACK: + .endif +003f8c 05e2 .dw XT_DEPTH +003f8d 3921 .dw XT_ZEROLESS +003f8e 3836 .dw XT_DOCONDBRANCH +003f8f 3f93 DEST(PFA_QSTACK1) +003f90 383d .dw XT_DOLITERAL +003f91 fffc .dw -4 +003f92 3d86 .dw XT_THROW + PFA_QSTACK1: +003f93 3820 .dw XT_EXIT + .include "words/bounds.asm" + + ; Tools + ; convert a string to an address range + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_BOUNDS: +003f94 ff06 .dw $ff06 +003f95 6f62 +003f96 6e75 +003f97 7364 .db "bounds" +003f98 3f86 .dw VE_HEAD + .set VE_HEAD = VE_BOUNDS + XT_BOUNDS: +003f99 3801 .dw DO_COLON + PFA_BOUNDS: + .endif +003f9a 38cf .dw XT_OVER +003f9b 399d .dw XT_PLUS +003f9c 38c4 .dw XT_SWAP +003f9d 3820 .dw XT_EXIT + .include "words/cr.asm" + + ; Character IO + ; cause subsequent output appear at the beginning of the next line + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_CR: +003f9e ff02 .dw 0xff02 +003f9f 7263 .db "cr" +003fa0 3f94 .dw VE_HEAD + .set VE_HEAD = VE_CR + XT_CR: +003fa1 3801 .dw DO_COLON + PFA_CR: + .endif + +003fa2 383d .dw XT_DOLITERAL +003fa3 000d .dw 13 +003fa4 3ef2 .dw XT_EMIT +003fa5 383d .dw XT_DOLITERAL +003fa6 000a .dw 10 +003fa7 3ef2 .dw XT_EMIT +003fa8 3820 .dw XT_EXIT + .include "words/space.asm" + + ; Character IO + ; emits a space (bl) + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_SPACE: +003fa9 ff05 .dw $ff05 +003faa 7073 +003fab 6361 +003fac 0065 .db "space",0 +003fad 3f9e .dw VE_HEAD + .set VE_HEAD = VE_SPACE + XT_SPACE: +003fae 3801 .dw DO_COLON + PFA_SPACE: + .endif +003faf 3f54 .dw XT_BL +003fb0 3ef2 .dw XT_EMIT +003fb1 3820 .dw XT_EXIT + .include "words/spaces.asm" + + ; Character IO + ; emits n space(s) (bl) + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_SPACES: +003fb2 ff06 .dw $ff06 +003fb3 7073 +003fb4 6361 +003fb5 7365 .db "spaces" +003fb6 3fa9 .dw VE_HEAD + .set VE_HEAD = VE_SPACES + XT_SPACES: +003fb7 3801 .dw DO_COLON + PFA_SPACES: + + .endif + ;C SPACES n -- output n spaces + ; BEGIN DUP 0> WHILE SPACE 1- REPEAT DROP ; +003fb8 3954 +003fb9 3e4a .DW XT_ZERO, XT_MAX +003fba 38b1 +003fbb 3836 SPCS1: .DW XT_DUP,XT_DOCONDBRANCH +003fbc 3fc1 DEST(SPCS2) +003fbd 3fae +003fbe 3a35 +003fbf 382f .DW XT_SPACE,XT_1MINUS,XT_DOBRANCH +003fc0 3fba DEST(SPCS1) +003fc1 38d9 +003fc2 3820 SPCS2: .DW XT_DROP,XT_EXIT + .include "words/s-to-d.asm" + + ; Conversion + ; extend (signed) single cell value to double cell + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_S2D: +003fc3 ff03 .dw $ff03 +003fc4 3e73 +003fc5 0064 .db "s>d",0 +003fc6 3fb2 .dw VE_HEAD + .set VE_HEAD = VE_S2D + XT_S2D: +003fc7 3801 .dw DO_COLON + PFA_S2D: + .endif +003fc8 38b1 .dw XT_DUP +003fc9 3921 .dw XT_ZEROLESS +003fca 3820 .dw XT_EXIT + .include "words/to-body.asm" + + ; Core + ; get body from XT + VE_TO_BODY: +003fcb ff05 .dw $ff05 +003fcc 623e +003fcd 646f +003fce 0079 .db ">body",0 +003fcf 3fc3 .dw VE_HEAD + .set VE_HEAD = VE_TO_BODY + XT_TO_BODY: +003fd0 3a30 .dw PFA_1PLUS + .elif AMFORTH_NRWW_SIZE>2000 + .else + .endif + ; now colon words + ;;;;;;;;;;;;;;;;;;;;;;;; + .include "words/2literal.asm" + + ; Compiler + ; compile a cell pair literal in colon definitions + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_2LITERAL: +003fd1 0008 .dw $0008 +003fd2 6c32 +003fd3 7469 +003fd4 7265 +003fd5 6c61 .db "2literal" +003fd6 3fcb .dw VE_HEAD + .set VE_HEAD = VE_2LITERAL + XT_2LITERAL: +003fd7 3801 .dw DO_COLON + PFA_2LITERAL: + .endif +003fd8 38c4 .dw XT_SWAP +003fd9 0772 .dw XT_LITERAL +003fda 0772 .dw XT_LITERAL +003fdb 3820 .dw XT_EXIT + .include "words/equal.asm" + + ; Compare + ; compares two values for equality + VE_EQUAL: +003fdc ff01 .dw $ff01 +003fdd 003d .db "=",0 +003fde 3fd1 .dw VE_HEAD + .set VE_HEAD = VE_EQUAL + XT_EQUAL: +003fdf 3801 .dw DO_COLON + PFA_EQUAL: +003fe0 3993 .dw XT_MINUS +003fe1 391a .dw XT_ZEROEQUAL +003fe2 3820 .dw XT_EXIT + .include "words/num-constants.asm" + + .endif + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_ONE: +003fe3 ff01 .dw $ff01 +003fe4 0031 .db "1",0 +003fe5 3fdc .dw VE_HEAD + .set VE_HEAD = VE_ONE + XT_ONE: +003fe6 3848 .dw PFA_DOVARIABLE + PFA_ONE: + .endif +003fe7 0001 .DW 1 + + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_TWO: +003fe8 ff01 .dw $ff01 +003fe9 0032 .db "2",0 +003fea 3fe3 .dw VE_HEAD + .set VE_HEAD = VE_TWO + XT_TWO: +003feb 3848 .dw PFA_DOVARIABLE + PFA_TWO: + .endif +003fec 0002 .DW 2 + .if cpu_msp430==1 + .endif + + .if cpu_avr8==1 + VE_MINUSONE: +003fed ff02 .dw $ff02 +003fee 312d .db "-1" +003fef 3fe8 .dw VE_HEAD + .set VE_HEAD = VE_MINUSONE + XT_MINUSONE: +003ff0 3848 .dw PFA_DOVARIABLE + PFA_MINUSONE: + .endif +003ff1 ffff .DW -1 + .include "dict_appl_core.inc" + + ; do not delete it! + + .set flashlast = pc + .if (pc>FLASHEND) + .endif + + .dseg + ; define a label for the 1st free ram address + HERESTART: + .eseg + .include "amforth-eeprom.inc" +00002a ff ff + ; some configs +00002c 1b 0b CFG_DP: .dw DPSTART ; Dictionary Pointer +00002e 1d 01 EE_HERE: .dw HERESTART ; Memory Allocation +000030 84 00 EE_EHERE: .dw EHERESTART ; EEProm Memory Allocation +000032 c3 09 CFG_WLSCOPE: .dw XT_GET_CURRENT ; default wordlist scope +000034 52 00 CFG_FORTHRECOGNIZER: .dw CFG_RECOGNIZERLISTLEN ; Recognizer word set + ; LEAVE stack is between data stack and return stack. +000036 10 08 CFG_LP0: .dw stackstart+1 +000038 6d 0a CFG_TURNKEY: .dw XT_APPLTURNKEY ; TURNKEY +00003a f4 02 CFG_ENVIRONMENT:.dw VE_ENVHEAD ; environmental queries +00003c 3e 00 CFG_CURRENT: .dw CFG_FORTHWORDLIST ; forth-wordlist +00003e ed 3f CFG_FORTHWORDLIST:.dw VE_HEAD ; pre-defined (compiled in) wordlist + CFG_ORDERLISTLEN: +000040 01 00 .dw 1 + CFG_ORDERLIST: ; list of wordlist id, exactly numwordlist entries +000042 3e 00 .dw CFG_FORTHWORDLIST ; get/set-order +000044 .byte (NUMWORDLISTS-1)*CELLSIZE ; one slot is already used + CFG_RECOGNIZERLISTLEN: +000052 02 00 .dw 2 + CFG_RECOGNIZERLIST: +000054 65 06 .dw XT_REC_FIND +000056 51 06 .dw XT_REC_NUM +000058 .byte (NUMRECOGNIZERS-2)*CELLSIZE ; two slots are already used + + EE_STOREI: +00005c 7e 3b .dw XT_DO_STOREI ; Store a cell into flash + + ; MARKER saves everything up to here. Nothing beyond gets saved + EE_MARKER: +00005e 5e 00 .dw EE_MARKER + + ; default user area + EE_INITUSER: +000060 00 00 .dw 0 ; USER_STATE +000062 00 00 .dw 0 ; USER_FOLLOWER +000064 5f 08 .dw rstackstart ; USER_RP +000066 0f 08 .dw stackstart ; USER_SP0 +000068 0f 08 .dw stackstart ; USER_SP + +00006a 00 00 .dw 0 ; USER_HANDLER +00006c 0a 00 .dw 10 ; USER_BASE + +00006e 98 00 .dw XT_TX ; USER_EMIT +000070 a6 00 .dw XT_TXQ ; USER_EMITQ +000072 6d 00 .dw XT_RX ; USER_KEY +000074 88 00 .dw XT_RXQ ; USER_KEYQ +000076 6c 02 .dw XT_SOURCETIB ; USER_SOURCE +000078 00 00 .dw 0 ; USER_G_IN +00007a 59 02 .dw XT_REFILLTIB ; USER_REFILL +00007c c9 3c .dw XT_DEFAULT_PROMPTOK +00007e e8 3c .dw XT_DEFAULT_PROMPTERROR +000080 d8 3c .dw XT_DEFAULT_PROMPTREADY + + ; calculate baud rate error + .equ UBRR_VAL = ((F_CPU+BAUD*8)/(BAUD*16)-1) ; smart round + .equ BAUD_REAL = (F_CPU/(16*(UBRR_VAL+1))) ; effective baud rate + .equ BAUD_ERROR = ((BAUD_REAL*1000)/BAUD-1000) ; error in pro mille + + .if ((BAUD_ERROR>BAUD_MAXERROR) || (BAUD_ERROR<-BAUD_MAXERROR)) + .endif + EE_UBRRVAL: +000082 0c 00 .dw UBRR_VAL ; BAUDRATE + ; 1st free address in EEPROM. + EHERESTART: + .cseg + + +RESOURCE USE INFORMATION +------------------------ + +Notice: +The register and instruction counts are symbol table hit counts, +and hence implicitly used resources are not counted, eg, the +'lpm' instruction without operands implicitly uses r0 and z, +none of which are counted. + +x,y,z are separate entities in the symbol table and are +counted separately from r26..r31 here. + +.dseg memory usage only counts static data declared with .byte + +"ATmega32" register use summary: +r0 : 25 r1 : 5 r2 : 10 r3 : 12 r4 : 4 r5 : 1 r6 : 0 r7 : 0 +r8 : 0 r9 : 0 r10: 1 r11: 6 r12: 0 r13: 0 r14: 22 r15: 20 +r16: 89 r17: 61 r18: 61 r19: 37 r20: 13 r21: 11 r22: 11 r23: 3 +r24: 212 r25: 145 r26: 28 r27: 17 r28: 7 r29: 4 r30: 90 r31: 49 +x : 4 y : 217 z : 50 +Registers used: 29 out of 35 (82.9%) + +"ATmega32" instruction use summary: +.lds : 0 .sts : 0 adc : 22 add : 17 adiw : 17 and : 4 +andi : 3 asr : 2 bclr : 0 bld : 0 brbc : 2 brbs : 7 +brcc : 3 brcs : 1 break : 0 breq : 6 brge : 1 brhc : 0 +brhs : 0 brid : 0 brie : 0 brlo : 1 brlt : 3 brmi : 3 +brne : 22 brpl : 0 brsh : 0 brtc : 0 brts : 0 brvc : 0 +brvs : 2 bset : 0 bst : 0 call : 2 cbi : 7 cbr : 1 +clc : 2 clh : 0 cli : 7 cln : 0 clr : 14 cls : 0 +clt : 0 clv : 0 clz : 0 com : 14 cp : 11 cpc : 10 +cpi : 2 cpse : 0 dec : 10 eor : 3 fmul : 0 fmuls : 0 +fmulsu: 0 icall : 0 ijmp : 1 in : 25 inc : 3 jmp : 13 +ld : 145 ldd : 4 ldi : 41 lds : 1 lpm : 16 lsl : 14 +lsr : 2 mov : 16 movw : 72 mul : 5 muls : 1 mulsu : 2 +neg : 0 nop : 0 or : 9 ori : 2 out : 22 pop : 49 +push : 43 rcall : 34 ret : 7 reti : 1 rjmp : 106 rol : 23 +ror : 6 sbc : 9 sbci : 3 sbi : 8 sbic : 3 sbis : 0 +sbiw : 16 sbr : 0 sbrc : 5 sbrs : 7 sec : 1 seh : 0 +sei : 1 sen : 0 ser : 4 ses : 0 set : 0 sev : 0 +sez : 0 sleep : 0 spm : 2 st : 81 std : 8 sts : 1 +sub : 6 subi : 3 swap : 0 tst : 0 wdr : 0 +Instructions used: 72 out of 113 (63.7%) + +"ATmega32" memory use summary [bytes]: +Segment Begin End Code Data Used Size Use% +--------------------------------------------------------------- +[.cseg] 0x000000 0x007fe4 2072 11708 13780 32768 42.1% +[.dseg] 0x000060 0x00011d 0 189 189 2048 9.2% +[.eseg] 0x000000 0x000084 0 132 132 1024 12.9% + +Assembly complete, 0 errors, 8 warnings -- cgit v1.2.3