From d80736ab6e8e3cad2f1a30c6eaba2d6883dbe967 Mon Sep 17 00:00:00 2001 From: Dimitri Sokolyuk Date: Sat, 26 Aug 2017 20:31:40 +0200 Subject: Remove AmForth --- amforth-6.5/appl/eval-pollin/p328-16.lst | 10427 ----------------------------- 1 file changed, 10427 deletions(-) delete mode 100644 amforth-6.5/appl/eval-pollin/p328-16.lst (limited to 'amforth-6.5/appl/eval-pollin/p328-16.lst') diff --git a/amforth-6.5/appl/eval-pollin/p328-16.lst b/amforth-6.5/appl/eval-pollin/p328-16.lst deleted file mode 100644 index da486f0..0000000 --- a/amforth-6.5/appl/eval-pollin/p328-16.lst +++ /dev/null @@ -1,10427 +0,0 @@ - -AVRASM ver. 2.1.52 p328-16.asm Sun Apr 30 20:10:15 2017 - -p328-16.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/atmega328p\device.asm' -../../avr8/devices/atmega328p\device.asm(5): Including file '../../avr8/Atmel/Appnotes2\m328Pdef.inc' -p328-16.asm(14): Including file '../../avr8\drivers/usart_0.asm' -../../avr8\drivers/usart_0.asm(32): 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' -p328-16.asm(19): Including file '../../avr8\drivers/1wire.asm' -p328-16.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 = 256 - .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_USART0 = 0 - .set WANT_TWI = 0 - .set WANT_TIMER_COUNTER_1 = 0 - .set WANT_TIMER_COUNTER_2 = 0 - .set WANT_AD_CONVERTER = 0 - .set WANT_ANALOG_COMPARATOR = 0 - .set WANT_PORTB = 0 - .set WANT_PORTC = 0 - .set WANT_PORTD = 0 - .set WANT_TIMER_COUNTER_0 = 0 - .set WANT_EXTERNAL_INTERRUPT = 0 - .set WANT_SPI = 0 - .set WANT_WATCHDOG = 0 - .set WANT_CPU = 0 - .set WANT_EEPROM = 0 - .equ intvecsize = 2 ; please verify; flash size: 32768 bytes - .equ pclen = 2 ; please verify - .overlap - .org 2 -000002 d126 rcall isr ; External Interrupt Request 0 - .org 4 -000004 d124 rcall isr ; External Interrupt Request 1 - .org 6 -000006 d122 rcall isr ; Pin Change Interrupt Request 0 - .org 8 -000008 d120 rcall isr ; Pin Change Interrupt Request 0 - .org 10 -00000a d11e rcall isr ; Pin Change Interrupt Request 1 - .org 12 -00000c d11c rcall isr ; Watchdog Time-out Interrupt - .org 14 -00000e d11a rcall isr ; Timer/Counter2 Compare Match A - .org 16 -000010 d118 rcall isr ; Timer/Counter2 Compare Match A - .org 18 -000012 d116 rcall isr ; Timer/Counter2 Overflow - .org 20 -000014 d114 rcall isr ; Timer/Counter1 Capture Event - .org 22 -000016 d112 rcall isr ; Timer/Counter1 Compare Match A - .org 24 -000018 d110 rcall isr ; Timer/Counter1 Compare Match B - .org 26 -00001a d10e rcall isr ; Timer/Counter1 Overflow - .org 28 -00001c d10c rcall isr ; TimerCounter0 Compare Match A - .org 30 -00001e d10a rcall isr ; TimerCounter0 Compare Match B - .org 32 -000020 d108 rcall isr ; Timer/Couner0 Overflow - .org 34 -000022 d106 rcall isr ; SPI Serial Transfer Complete - .org 36 -000024 d104 rcall isr ; USART Rx Complete - .org 38 -000026 d102 rcall isr ; USART, Data Register Empty - .org 40 -000028 d100 rcall isr ; USART Tx Complete - .org 42 -00002a d0fe rcall isr ; ADC Conversion Complete - .org 44 -00002c d0fc rcall isr ; EEPROM Ready - .org 46 -00002e d0fa rcall isr ; Analog Comparator - .org 48 -000030 d0f8 rcall isr ; Two-wire Serial Interface - .org 50 -000032 d0f6 rcall isr ; Store Program Memory Read - .equ INTVECTORS = 26 - .nooverlap - - ; compatability layer (maybe empty) - .equ SPMEN = SELFPRGEN - - ; controller data area, environment query mcu-info - mcu_info: - mcu_ramsize: -000033 0800 .dw 2048 - mcu_eepromsize: -000034 0400 .dw 1024 - mcu_maxdp: -000035 7000 .dw 28672 - mcu_numints: -000036 001a .dw 26 - mcu_name: -000037 000a .dw 10 -000038 5441 -000039 656d -00003a 6167 -00003b 3233 -00003c 5038 .db "ATmega328P" - .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 = 16000000 - .set BAUD_MAXERROR = 30 - .equ TIMER_INT = OVF2addr - - .include "drivers/usart_0.asm" - - .equ BAUDRATE_HIGH = UBRR0H - .equ USART_C = UCSR0C - .equ USART_B = UCSR0B - .equ USART_A = UCSR0A - .equ USART_DATA = UDR0 - .ifndef URXCaddr - .endif - - .equ bm_USART_RXRD = 1 << RXC0 - .equ bm_USART_TXRD = 1 << UDRE0 - .equ bm_ENABLE_TX = 1 << TXEN0 - .equ bm_ENABLE_RX = 1 << RXEN0 - .equ bm_ENABLE_INT_RX = 1<rx-buf",0 -000042 0000 .dw VE_HEAD - .set VE_HEAD = VE_TO_RXBUF - XT_TO_RXBUF: -000043 0044 .dw PFA_rx_tobuf - PFA_rx_tobuf: -000044 2f08 mov temp0, tosl -000045 9110 0110 lds temp1, usart_rx_in -000047 e0e0 ldi zl, low(usart_rx_data) -000048 e0f1 ldi zh, high(usart_rx_data) -000049 0fe1 add zl, temp1 -00004a 1df3 adc zh, zeroh -00004b 8300 st Z, temp0 -00004c 9513 inc temp1 -00004d 701f andi temp1,usart_rx_mask -00004e 9310 0110 sts usart_rx_in, temp1 -000050 9189 -000051 9199 loadtos -000052 940c 3805 jmp_ DO_NEXT - - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ; setup with - ; ' isr-rx URXCaddr int! - VE_ISR_RX: -000054 ff06 .dw $ff06 -000055 7369 -000056 2d72 -000057 7872 .db "isr-rx" -000058 003d .dw VE_HEAD - .set VE_HEAD = VE_ISR_RX - XT_ISR_RX: -000059 3801 .dw DO_COLON - usart_rx_isr: -00005a 383d .dw XT_DOLITERAL -00005b 00c6 .dw usart_data -00005c 3898 .dw XT_CFETCH -00005d 38b1 .dw XT_DUP -00005e 383d .dw XT_DOLITERAL -00005f 0003 .dw 3 -000060 3fdf .dw XT_EQUAL -000061 3836 .dw XT_DOCONDBRANCH -000062 0064 .dw usart_rx_isr1 -000063 3d38 .dw XT_COLD - usart_rx_isr1: -000064 0043 .dw XT_TO_RXBUF -000065 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: -000066 3801 .dw DO_COLON - PFA_USART_INIT_RX_BUFFER: ; ( -- ) -000067 383d -000068 0059 .dw XT_DOLITERAL, XT_ISR_RX -000069 383d -00006a 0024 .dw XT_DOLITERAL, URXCaddr -00006b 3ca5 .dw XT_INTSTORE - -00006c 383d .dw XT_DOLITERAL -00006d 0100 .dw usart_rx_data -00006e 383d .dw XT_DOLITERAL -00006f 0016 .dw usart_rx_size + 6 -000070 3954 .dw XT_ZERO -000071 3e98 .dw XT_FILL -000072 3820 .dw XT_EXIT - - ; ( -- c) - ; MCU - ; get 1 character from input queue, wait if needed using interrupt driver - VE_RX_BUFFER: -000073 ff06 .dw $ff06 -000074 7872 -000075 622d -000076 6675 .db "rx-buf" -000077 0054 .dw VE_HEAD - .set VE_HEAD = VE_RX_BUFFER - XT_RX_BUFFER: -000078 3801 .dw DO_COLON - PFA_RX_BUFFER: -000079 0093 .dw XT_RXQ_BUFFER -00007a 3836 .dw XT_DOCONDBRANCH -00007b 0079 .dw PFA_RX_BUFFER -00007c 383d .dw XT_DOLITERAL -00007d 0111 .dw usart_rx_out -00007e 3898 .dw XT_CFETCH -00007f 38b1 .dw XT_DUP -000080 383d .dw XT_DOLITERAL -000081 0100 .dw usart_rx_data -000082 399d .dw XT_PLUS -000083 3898 .dw XT_CFETCH -000084 38c4 .dw XT_SWAP -000085 3a2f .dw XT_1PLUS -000086 383d .dw XT_DOLITERAL -000087 000f .dw usart_rx_mask -000088 3a13 .dw XT_AND -000089 383d .dw XT_DOLITERAL -00008a 0111 .dw usart_rx_out -00008b 388d .dw XT_CSTORE -00008c 3820 .dw XT_EXIT - - ; ( -- f) - ; MCU - ; check if unread characters are in the input queue - VE_RXQ_BUFFER: -00008d ff07 .dw $ff07 -00008e 7872 -00008f 2d3f -000090 7562 -000091 0066 .db "rx?-buf",0 -000092 0073 .dw VE_HEAD - .set VE_HEAD = VE_RXQ_BUFFER - XT_RXQ_BUFFER: -000093 3801 .dw DO_COLON - PFA_RXQ_BUFFER: -000094 3d30 .dw XT_PAUSE -000095 383d .dw XT_DOLITERAL -000096 0111 .dw usart_rx_out -000097 3898 .dw XT_CFETCH -000098 383d .dw XT_DOLITERAL -000099 0110 .dw usart_rx_in -00009a 3898 .dw XT_CFETCH -00009b 3913 .dw XT_NOTEQUAL -00009c 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: -00009d ff07 .dw $ff07 -00009e 7874 -00009f 702d -0000a0 6c6f -0000a1 006c .db "tx-poll",0 -0000a2 008d .dw VE_HEAD - .set VE_HEAD = VE_TX_POLL - XT_TX_POLL: -0000a3 3801 .dw DO_COLON - PFA_TX_POLL: - ; wait for data ready -0000a4 00b1 .dw XT_TXQ_POLL -0000a5 3836 .dw XT_DOCONDBRANCH -0000a6 00a4 .dw PFA_TX_POLL - ; send to usart -0000a7 383d .dw XT_DOLITERAL -0000a8 00c6 .dw USART_DATA -0000a9 388d .dw XT_CSTORE -0000aa 3820 .dw XT_EXIT - - ; ( -- f) MCU - ; MCU - ; check if a character can be send using register poll - VE_TXQ_POLL: -0000ab ff08 .dw $ff08 -0000ac 7874 -0000ad 2d3f -0000ae 6f70 -0000af 6c6c .db "tx?-poll" -0000b0 009d .dw VE_HEAD - .set VE_HEAD = VE_TXQ_POLL - XT_TXQ_POLL: -0000b1 3801 .dw DO_COLON - PFA_TXQ_POLL: -0000b2 3d30 .dw XT_PAUSE -0000b3 383d .dw XT_DOLITERAL -0000b4 00c0 .dw USART_A -0000b5 3898 .dw XT_CFETCH -0000b6 383d .dw XT_DOLITERAL -0000b7 0020 .dw bm_USART_TXRD -0000b8 3a13 .dw XT_AND -0000b9 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: -0000ba ff04 .dw $ff04 -0000bb 6275 -0000bc 7272 .db "ubrr" -0000bd 00ab .dw VE_HEAD - .set VE_HEAD = VE_UBRR - XT_UBRR: -0000be 386f .dw PFA_DOVALUE1 - PFA_UBRR: ; ( -- ) -0000bf 008c .dw EE_UBRRVAL -0000c0 3da0 .dw XT_EDEFERFETCH -0000c1 3daa .dw XT_EDEFERSTORE - .include "words/usart.asm" - - ; MCU - ; initialize usart - VE_USART: -0000c2 ff06 .dw $ff06 -0000c3 752b -0000c4 6173 -0000c5 7472 .db "+usart" -0000c6 00ba .dw VE_HEAD - .set VE_HEAD = VE_USART - XT_USART: -0000c7 3801 .dw DO_COLON - PFA_USART: ; ( -- ) - -0000c8 383d .dw XT_DOLITERAL -0000c9 0098 .dw USART_B_VALUE -0000ca 383d .dw XT_DOLITERAL -0000cb 00c1 .dw USART_B -0000cc 388d .dw XT_CSTORE - -0000cd 383d .dw XT_DOLITERAL -0000ce 0006 .dw USART_C_VALUE -0000cf 383d .dw XT_DOLITERAL -0000d0 00c2 .dw USART_C | bm_USARTC_en -0000d1 388d .dw XT_CSTORE - -0000d2 00be .dw XT_UBRR -0000d3 38b1 .dw XT_DUP -0000d4 3af9 .dw XT_BYTESWAP -0000d5 383d .dw XT_DOLITERAL -0000d6 00c5 .dw BAUDRATE_HIGH -0000d7 388d .dw XT_CSTORE -0000d8 383d .dw XT_DOLITERAL -0000d9 00c4 .dw BAUDRATE_LOW -0000da 388d .dw XT_CSTORE - .if XT_USART_INIT_RX!=0 -0000db 0066 .dw XT_USART_INIT_RX - .endif - .if XT_USART_INIT_TX!=0 - .endif - -0000dc 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: -0000dd ff08 .dw $ff08 -0000de 7731 -0000df 722e -0000e0 7365 -0000e1 7465 .db "1w.reset" -0000e2 00c2 .dw VE_HEAD - .set VE_HEAD = VE_OW_RESET - XT_OW_RESET: -0000e3 00e4 .dw PFA_OW_RESET - PFA_OW_RESET: -0000e4 939a -0000e5 938a savetos - ; setup to output -0000e6 9a24 sbi OW_DDR, OW_BIT - ; Pull output low -0000e7 982c cbi OW_PORT, OW_BIT - ; Delay >480 usec -0000e8 e8e0 -0000e9 e0f7 -0000ea 9731 -0000eb f7f1 DELAY 480 - ; Critical timing period, disable interrupts. -0000ec b71f in temp1, SREG -0000ed 94f8 cli - ; Pull output high -0000ee 9a2c sbi OW_PORT, OW_BIT - ; make pin input, sends "1" -0000ef 9824 cbi OW_DDR, OW_BIT -0000f0 e0e0 -0000f1 e0f1 -0000f2 9731 -0000f3 f7f1 DELAY 64 ; delayB - ; Sample input pin, set TOS if input is zero -0000f4 b183 in tosl, OW_PIN -0000f5 ff84 sbrs tosl, OW_BIT -0000f6 ef9f ser tosh - ; End critical timing period, enable interrupts -0000f7 bf1f out SREG, temp1 - ; release bus -0000f8 9824 cbi OW_DDR, OW_BIT -0000f9 982c cbi OW_PORT, OW_BIT - - ; Delay rest of 480 usec -0000fa e8e0 -0000fb e0f6 -0000fc 9731 -0000fd f7f1 DELAY 416 - ; we now have the result flag in TOS -0000fe 2f89 mov tosl, tosh -0000ff 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: -000101 ff07 .dw $ff07 -000102 7731 -000103 732e -000104 6f6c -000105 0074 .db "1w.slot",0 -000106 00dd .dw VE_HEAD - .set VE_HEAD = VE_OW_SLOT - XT_OW_SLOT: -000107 0108 .dw PFA_OW_SLOT - PFA_OW_SLOT: - ; pull low -000108 982c cbi OW_PORT, OW_BIT -000109 9a24 sbi OW_DDR, OW_BIT - ; disable interrupts -00010a b71f in temp1, SREG -00010b 94f8 cli -00010c e1e8 -00010d e0f0 -00010e 9731 -00010f f7f1 DELAY 6 ; DELAY A - ; check bit -000110 9488 clc -000111 9587 ror tosl -000112 f410 brcc PFA_OW_SLOT0 ; a 0 keeps the bus low - ; release bus, a 1 is written -000113 9a2c sbi OW_PORT, OW_BIT -000114 9824 cbi OW_DDR, OW_BIT - PFA_OW_SLOT0: - ; sample the input (no action required if zero) -000115 e2e4 -000116 e0f0 -000117 9731 -000118 f7f1 DELAY 9 ; wait DELAY E to sample -000119 b103 in temp0, OW_PIN -00011a fd04 sbrc temp0, OW_BIT -00011b 6880 ori tosl, $80 - -00011c ecec -00011d e0f0 -00011e 9731 -00011f f7f1 DELAY 51 ; DELAY B -000120 9a2c sbi OW_PORT, OW_BIT ; release bus -000121 9824 cbi OW_DDR, OW_BIT -000122 e0e8 -000123 e0f0 -000124 9731 -000125 f7f1 delay 2 - ; re-enable interrupts -000126 bf1f out SREG, temp1 -000127 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 -000112 intcnt: .byte INTVECTORS - .cseg - - ; interrupt routine gets called (again) by rcall! This gives the - ; address of the int-vector on the stack. - isr: -000129 920a st -Y, r0 -00012a b60f in r0, SREG -00012b 920a st -Y, r0 - .if (pclen==3) - .endif -00012c 900f pop r0 -00012d 900f pop r0 ; = intnum * intvectorsize + 1 (address following the rcall) -00012e 940a dec r0 - .if intvecsize == 1 ; - .endif -00012f 2cb0 mov isrflag, r0 -000130 93ff push zh -000131 93ef push zl -000132 e1e2 ldi zl, low(intcnt) -000133 e0f1 ldi zh, high(intcnt) -000134 9406 lsr r0 ; we use byte addresses in the counter array, not words -000135 0de0 add zl, r0 -000136 1df3 adc zh, zeroh -000137 8000 ld r0, Z -000138 9403 inc r0 -000139 8200 st Z, r0 -00013a 91ef pop zl -00013b 91ff pop zh - -00013c 9009 ld r0, Y+ -00013d be0f out SREG, r0 -00013e 9009 ld r0, Y+ -00013f 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: -000140 ff02 .dw $ff02 -000141 2b6d .db "m+" -000142 0101 .dw VE_HEAD - .set VE_HEAD = VE_MPLUS - XT_MPLUS: -000143 3801 .dw DO_COLON - PFA_MPLUS: -000144 3fc7 .dw XT_S2D -000145 3c15 .dw XT_DPLUS -000146 3820 .dw XT_EXIT - .include "words/ud-star.asm" - - .if cpu_msp430==1 - .endif - - .if cpu_avr8==1 - VE_UDSTAR: -000147 ff03 .dw $ff03 -000148 6475 -../../common\words/ud-star.asm(9): warning: .cseg .db misalignment - padding zero byte -000149 002a .db "ud*" -00014a 0140 .dw VE_HEAD - .set VE_HEAD = VE_UDSTAR - XT_UDSTAR: -00014b 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 + ; - -00014c 38b1 -00014d 38ff -00014e 39e0 -00014f 38d9 .DW XT_DUP,XT_TO_R,XT_UMSTAR,XT_DROP -000150 38c4 -000151 38f6 -000152 39e0 -000153 38e1 -000154 399d -000155 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: -000156 ff04 .dw $ff04 -000157 6d75 -000158 7861 .db "umax" -000159 0147 .dw VE_HEAD - .set VE_HEAD = VE_UMAX - XT_UMAX: -00015a 3801 .dw DO_COLON - PFA_UMAX: - .endif - -00015b 3ec9 -00015c 395c .DW XT_2DUP,XT_ULESS -00015d 3836 .dw XT_DOCONDBRANCH -00015e 0160 DEST(UMAX1) -00015f 38c4 .DW XT_SWAP -000160 38d9 UMAX1: .DW XT_DROP -000161 3820 .dw XT_EXIT - .include "words/umin.asm" - - .if cpu_msp430==1 - .endif - - .if cpu_avr8==1 - VE_UMIN: -000162 ff04 .dw $ff04 -000163 6d75 -000164 6e69 .db "umin" -000165 0156 .dw VE_HEAD - .set VE_HEAD = VE_UMIN - XT_UMIN: -000166 3801 .dw DO_COLON - PFA_UMIN: - .endif -000167 3ec9 -000168 3967 .DW XT_2DUP,XT_UGREATER -000169 3836 .dw XT_DOCONDBRANCH -00016a 016c DEST(UMIN1) -00016b 38c4 .DW XT_SWAP -00016c 38d9 UMIN1: .DW XT_DROP -00016d 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: -00016e 3801 .dw DO_COLON - PFA_IMMEDIATEQ: -00016f 383d .dw XT_DOLITERAL -000170 8000 .dw $8000 -000171 3a13 .dw XT_AND -000172 391a .dw XT_ZEROEQUAL -000173 3836 .dw XT_DOCONDBRANCH -000174 0177 DEST(IMMEDIATEQ1) -000175 3fe6 .dw XT_ONE -000176 3820 .dw XT_EXIT - IMMEDIATEQ1: - ; not immediate -000177 394b .dw XT_TRUE -000178 3820 .dw XT_EXIT - .include "words/name2flags.asm" - - ; Tools - ; get the flags from a name token - VE_NAME2FLAGS: -000179 ff0a .dw $ff0a -00017a 616e -00017b 656d -00017c 663e -00017d 616c -00017e 7367 .db "name>flags" -00017f 0162 .dw VE_HEAD - .set VE_HEAD = VE_NAME2FLAGS - XT_NAME2FLAGS: -000180 3801 .dw DO_COLON - PFA_NAME2FLAGS: -000181 3bcb .dw XT_FETCHI ; skip to link field -000182 383d .dw XT_DOLITERAL -000183 ff00 .dw $ff00 -000184 3a13 .dw XT_AND -000185 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: -000186 ff03 .dw $ff03 -000187 6576 -../../common\words/ver.asm(12): warning: .cseg .db misalignment - padding zero byte -000188 0072 .db "ver" -000189 0179 .dw VE_HEAD - .set VE_HEAD = VE_DOT_VER - XT_DOT_VER: -00018a 3801 .dw DO_COLON - PFA_DOT_VER: - .endif -00018b 02da .dw XT_ENV_FORTHNAME -00018c 0403 .dw XT_ITYPE -00018d 3fae .dw XT_SPACE -00018e 3ebd .dw XT_BASE -00018f 3879 .dw XT_FETCH - -000190 02e8 .dw XT_ENV_FORTHVERSION -000191 3f41 .dw XT_DECIMAL -000192 3fc7 .dw XT_S2D -000193 0321 .dw XT_L_SHARP -000194 0329 .dw XT_SHARP -000195 383d .dw XT_DOLITERAL -000196 002e .dw '.' -000197 0312 .dw XT_HOLD -000198 033f .dw XT_SHARP_S -000199 034a .dw XT_SHARP_G -00019a 0439 .dw XT_TYPE -00019b 3ebd .dw XT_BASE -00019c 3881 .dw XT_STORE -00019d 3fae .dw XT_SPACE -00019e 02f0 .dw XT_ENV_CPU -00019f 0403 .dw XT_ITYPE - -0001a0 3820 .dw XT_EXIT - - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - .include "words/noop.asm" - - ; Tools - ; do nothing - - .if cpu_msp430==1 - .endif - - .if cpu_avr8==1 - VE_NOOP: -0001a1 ff04 .dw $ff04 -0001a2 6f6e -0001a3 706f .db "noop" -0001a4 0186 .dw VE_HEAD - .set VE_HEAD = VE_NOOP - XT_NOOP: -0001a5 3801 .dw DO_COLON - PFA_NOOP: - .endif -0001a6 3820 .DW XT_EXIT - .include "words/unused.asm" - - ; Tools - ; Amount of available RAM (incl. PAD) - VE_UNUSED: -0001a7 ff06 .dw $ff06 -0001a8 6e75 -0001a9 7375 -0001aa 6465 .db "unused" -0001ab 01a1 .dw VE_HEAD - .set VE_HEAD = VE_UNUSED - XT_UNUSED: -0001ac 3801 .dw DO_COLON - PFA_UNUSED: -0001ad 3a8d .dw XT_SP_FETCH -0001ae 3f23 .dw XT_HERE -0001af 3993 .dw XT_MINUS -0001b0 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: -0001b1 0002 .dw $0002 -0001b2 6f74 .db "to" -0001b3 01a7 .dw VE_HEAD - .set VE_HEAD = VE_TO - XT_TO: -0001b4 3801 .dw DO_COLON - PFA_TO: - .endif -0001b5 0448 .dw XT_TICK -0001b6 3fd0 .dw XT_TO_BODY -0001b7 3eb7 .dw XT_STATE -0001b8 3879 .dw XT_FETCH -0001b9 3836 .dw XT_DOCONDBRANCH -0001ba 01c5 DEST(PFA_TO1) -0001bb 075c .dw XT_COMPILE -0001bc 01bf .dw XT_DOTO -0001bd 0767 .dw XT_COMMA -0001be 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: -0001bf 3801 .dw DO_COLON - PFA_DOTO: - .endif -0001c0 38f6 .dw XT_R_FROM -0001c1 38b1 .dw XT_DUP -0001c2 01d1 .dw XT_ICELLPLUS -0001c3 38ff .dw XT_TO_R -0001c4 3bcb .dw XT_FETCHI - PFA_TO1: -0001c5 38b1 .dw XT_DUP -0001c6 01d1 .dw XT_ICELLPLUS -0001c7 01d1 .dw XT_ICELLPLUS -0001c8 3bcb .dw XT_FETCHI -0001c9 382a .dw XT_EXECUTE -0001ca 3820 .dw XT_EXIT - .include "words/i-cellplus.asm" - - ; Compiler - ; skip to the next cell in flash - VE_ICELLPLUS: -0001cb ff07 .dw $FF07 -0001cc 2d69 -0001cd 6563 -0001ce 6c6c -0001cf 002b .db "i-cell+",0 -0001d0 01b1 .dw VE_HEAD - .set VE_HEAD = VE_ICELLPLUS - XT_ICELLPLUS: -0001d1 3801 .dw DO_COLON - PFA_ICELLPLUS: -0001d2 3a2f .dw XT_1PLUS -0001d3 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: -0001d4 ff08 .dw $ff08 -0001d5 6369 -0001d6 6d6f -0001d7 6170 -0001d8 6572 .db "icompare" -0001d9 01cb .dw VE_HEAD - .set VE_HEAD = VE_ICOMPARE - XT_ICOMPARE: -0001da 3801 .dw DO_COLON - PFA_ICOMPARE: -0001db 38ff .dw XT_TO_R ; ( -- r-addr r-len f-addr) -0001dc 38cf .dw XT_OVER ; ( -- r-addr r-len f-addr r-len) -0001dd 38f6 .dw XT_R_FROM ; ( -- r-addr r-len f-addr r-len f-len ) -0001de 3913 .dw XT_NOTEQUAL ; ( -- r-addr r-len f-addr flag ) -0001df 3836 .dw XT_DOCONDBRANCH -0001e0 01e5 .dw PFA_ICOMPARE_SAMELEN -0001e1 3ed2 .dw XT_2DROP -0001e2 38d9 .dw XT_DROP -0001e3 394b .dw XT_TRUE -0001e4 3820 .dw XT_EXIT - PFA_ICOMPARE_SAMELEN: -0001e5 38c4 .dw XT_SWAP ; ( -- r-addr f-addr len ) -0001e6 3954 .dw XT_ZERO -0001e7 0826 .dw XT_QDOCHECK -0001e8 3836 .dw XT_DOCONDBRANCH -0001e9 0208 .dw PFA_ICOMPARE_DONE -0001ea 3a9b .dw XT_DODO - PFA_ICOMPARE_LOOP: - ; ( r-addr f-addr --) -0001eb 38cf .dw XT_OVER -0001ec 3879 .dw XT_FETCH - .if WANT_IGNORECASE == 1 - .endif -0001ed 38cf .dw XT_OVER -0001ee 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 -0001ef 38b1 .dw XT_DUP - ;.dw XT_BYTESWAP -0001f0 383d .dw XT_DOLITERAL -0001f1 0100 .dw $100 -0001f2 395c .dw XT_ULESS -0001f3 3836 .dw XT_DOCONDBRANCH -0001f4 01f9 .dw PFA_ICOMPARE_LASTCELL -0001f5 38c4 .dw XT_SWAP -0001f6 383d .dw XT_DOLITERAL -0001f7 00ff .dw $00FF -0001f8 3a13 .dw XT_AND ; the final swap can be omitted - PFA_ICOMPARE_LASTCELL: -0001f9 3913 .dw XT_NOTEQUAL -0001fa 3836 .dw XT_DOCONDBRANCH -0001fb 0200 .dw PFA_ICOMPARE_NEXTLOOP -0001fc 3ed2 .dw XT_2DROP -0001fd 394b .dw XT_TRUE -0001fe 3ad4 .dw XT_UNLOOP -0001ff 3820 .dw XT_EXIT - PFA_ICOMPARE_NEXTLOOP: -000200 3a2f .dw XT_1PLUS -000201 38c4 .dw XT_SWAP -000202 3c90 .dw XT_CELLPLUS -000203 38c4 .dw XT_SWAP -000204 383d .dw XT_DOLITERAL -000205 0002 .dw 2 -000206 3aba .dw XT_DOPLUSLOOP -000207 01eb .dw PFA_ICOMPARE_LOOP - PFA_ICOMPARE_DONE: -000208 3ed2 .dw XT_2DROP -000209 3954 .dw XT_ZERO -00020a 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: -00020b ff01 .dw $ff01 -00020c 002a .db "*",0 -00020d 01d4 .dw VE_HEAD - .set VE_HEAD = VE_STAR - XT_STAR: -00020e 3801 .dw DO_COLON - PFA_STAR: - .endif - -00020f 39a6 .dw XT_MSTAR -000210 38d9 .dw XT_DROP -000211 3820 .dw XT_EXIT - .include "words/j.asm" - - ; Compiler - ; loop counter of outer loop - VE_J: -000212 ff01 .dw $FF01 -000213 006a .db "j",0 -000214 020b .dw VE_HEAD - .set VE_HEAD = VE_J - XT_J: -000215 3801 .dw DO_COLON - PFA_J: -000216 3a76 .dw XT_RP_FETCH -000217 383d .dw XT_DOLITERAL -000218 0007 .dw 7 -000219 399d .dw XT_PLUS -00021a 3879 .dw XT_FETCH -00021b 3a76 .dw XT_RP_FETCH -00021c 383d .dw XT_DOLITERAL -00021d 0009 .dw 9 -00021e 399d .dw XT_PLUS -00021f 3879 .dw XT_FETCH -000220 399d .dw XT_PLUS -000221 3820 .dw XT_EXIT - .include "words/dabs.asm" - - ; Arithmetics - ; double cell absolute value - VE_DABS: -000222 ff04 .dw $ff04 -000223 6164 -000224 7362 .db "dabs" -000225 0212 .dw VE_HEAD - .set VE_HEAD = VE_DABS - XT_DABS: -000226 3801 .dw DO_COLON - PFA_DABS: -000227 38b1 .dw XT_DUP -000228 3921 .dw XT_ZEROLESS -000229 3836 .dw XT_DOCONDBRANCH -00022a 022c .dw PFA_DABS1 -00022b 0233 .dw XT_DNEGATE - PFA_DABS1: -00022c 3820 .dw XT_EXIT - ; : dabs ( ud1 -- +d2 ) dup 0< if dnegate then ; - .include "words/dnegate.asm" - - ; Arithmetics - ; double cell negation - VE_DNEGATE: -00022d ff07 .dw $ff07 -00022e 6e64 -00022f 6765 -000230 7461 -000231 0065 .db "dnegate",0 -000232 0222 .dw VE_HEAD - .set VE_HEAD = VE_DNEGATE - XT_DNEGATE: -000233 3801 .dw DO_COLON - PFA_DNEGATE: -000234 3c3b .dw XT_DINVERT -000235 3fe6 .dw XT_ONE -000236 3954 .dw XT_ZERO -000237 3c15 .dw XT_DPLUS -000238 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: -000239 ff05 .dw $ff05 -00023a 6d63 -00023b 766f -00023c 0065 .db "cmove",0 -00023d 022d .dw VE_HEAD - .set VE_HEAD = VE_CMOVE - XT_CMOVE: -00023e 023f .dw PFA_CMOVE - PFA_CMOVE: -00023f 93bf push xh -000240 93af push xl -000241 91e9 ld zl, Y+ -000242 91f9 ld zh, Y+ ; addr-to -000243 91a9 ld xl, Y+ -000244 91b9 ld xh, Y+ ; addr-from -000245 2f09 mov temp0, tosh -000246 2b08 or temp0, tosl -000247 f021 brbs 1, PFA_CMOVE1 - PFA_CMOVE2: -000248 911d ld temp1, X+ -000249 9311 st Z+, temp1 -00024a 9701 sbiw tosl, 1 -00024b f7e1 brbc 1, PFA_CMOVE2 - PFA_CMOVE1: -00024c 91af pop xl -00024d 91bf pop xh -00024e 9189 -00024f 9199 loadtos -000250 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: -000252 ff05 .dw $ff05 -000253 7332 -000254 6177 -000255 0070 .db "2swap",0 -000256 0239 .dw VE_HEAD - .set VE_HEAD = VE_2SWAP - XT_2SWAP: -000257 3801 .dw DO_COLON - PFA_2SWAP: - - .endif -000258 38e1 .dw XT_ROT -000259 38ff .dw XT_TO_R -00025a 38e1 .dw XT_ROT -00025b 38f6 .dw XT_R_FROM -00025c 3820 .dw XT_EXIT - .include "words/tib.asm" - - ; System - ; refills the input buffer - .if cpu_msp430==1 - .endif - - .if cpu_avr8==1 - VE_REFILLTIB: -00025d ff0a .dw $ff0a -00025e 6572 -00025f 6966 -000260 6c6c -000261 742d -000262 6269 .db "refill-tib" -000263 0252 .dw VE_HEAD - .set VE_HEAD = VE_REFILLTIB - XT_REFILLTIB: -000264 3801 .dw DO_COLON - PFA_REFILLTIB: - .endif -000265 0280 .dw XT_TIB -000266 383d .dw XT_DOLITERAL -000267 005a .dw TIB_SIZE -000268 0498 .dw XT_ACCEPT -000269 0286 .dw XT_NUMBERTIB -00026a 3881 .dw XT_STORE -00026b 3954 .dw XT_ZERO -00026c 3ee2 .dw XT_TO_IN -00026d 3881 .dw XT_STORE -00026e 394b .dw XT_TRUE ; -1 -00026f 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: -000270 ff0a .dw $FF0A -000271 6f73 -000272 7275 -000273 6563 -000274 742d -000275 6269 .db "source-tib" -000276 025d .dw VE_HEAD - .set VE_HEAD = VE_SOURCETIB - XT_SOURCETIB: -000277 3801 .dw DO_COLON - PFA_SOURCETIB: - .endif -000278 0280 .dw XT_TIB -000279 0286 .dw XT_NUMBERTIB -00027a 3879 .dw XT_FETCH -00027b 3820 .dw XT_EXIT - - ; ( -- addr ) - ; System Variable - ; terminal input buffer address - .if cpu_msp430==1 - .endif - - .if cpu_avr8==1 - VE_TIB: -00027c ff03 .dw $ff03 -00027d 6974 -00027e 0062 .db "tib",0 -00027f 0270 .dw VE_HEAD - .set VE_HEAD = VE_TIB - XT_TIB: -000280 3848 .dw PFA_DOVARIABLE - PFA_TIB: -000281 012c .dw ram_tib - .dseg -00012c 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: -000282 ff04 .dw $ff04 -000283 7423 -000284 6269 .db "#tib" -000285 027c .dw VE_HEAD - .set VE_HEAD = VE_NUMBERTIB - XT_NUMBERTIB: -000286 3848 .dw PFA_DOVARIABLE - PFA_NUMBERTIB: -000287 0186 .dw ram_sharptib - .dseg -000186 ram_sharptib: .byte 2 - .cseg - .endif - .include "words/init-ram.asm" - - ; Tools - ; copy len cells from eeprom to ram - VE_EE2RAM: -000288 ff06 .dw $ff06 -000289 6565 -00028a 723e -00028b 6d61 .db "ee>ram" -00028c 0282 .dw VE_HEAD - .set VE_HEAD = VE_EE2RAM - XT_EE2RAM: -00028d 3801 .dw DO_COLON - PFA_EE2RAM: ; ( -- ) -00028e 3954 .dw XT_ZERO -00028f 3a9b .dw XT_DODO - PFA_EE2RAM_1: - ; ( -- e-addr r-addr ) -000290 38cf .dw XT_OVER -000291 3b5f .dw XT_FETCHE -000292 38cf .dw XT_OVER -000293 3881 .dw XT_STORE -000294 3c90 .dw XT_CELLPLUS -000295 38c4 .dw XT_SWAP -000296 3c90 .dw XT_CELLPLUS -000297 38c4 .dw XT_SWAP -000298 3ac9 .dw XT_DOLOOP -000299 0290 .dw PFA_EE2RAM_1 - PFA_EE2RAM_2: -00029a 3ed2 .dw XT_2DROP -00029b 3820 .dw XT_EXIT - - ; ( -- ) - ; Tools - ; setup the default user area from eeprom - VE_INIT_RAM: -00029c ff08 .dw $ff08 -00029d 6e69 -00029e 7469 -00029f 722d -0002a0 6d61 .db "init-ram" -0002a1 0288 .dw VE_HEAD - .set VE_HEAD = VE_INIT_RAM - XT_INIT_RAM: -0002a2 3801 .dw DO_COLON - PFA_INI_RAM: ; ( -- ) -0002a3 383d .dw XT_DOLITERAL -0002a4 006a .dw EE_INITUSER -0002a5 3b02 .dw XT_UP_FETCH -0002a6 383d .dw XT_DOLITERAL -0002a7 0022 .dw SYSUSERSIZE -0002a8 3a04 .dw XT_2SLASH -0002a9 028d .dw XT_EE2RAM -0002aa 3820 .dw XT_EXIT - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - - - .include "words/environment.asm" - - ; System Value - ; word list identifier of the environmental search list - VE_ENVIRONMENT: -0002ab ff0b .dw $ff0b -0002ac 6e65 -0002ad 6976 -0002ae 6f72 -0002af 6d6e -0002b0 6e65 -0002b1 0074 .db "environment",0 -0002b2 029c .dw VE_HEAD - .set VE_HEAD = VE_ENVIRONMENT - XT_ENVIRONMENT: -0002b3 3848 .dw PFA_DOVARIABLE - PFA_ENVIRONMENT: -0002b4 0044 .dw CFG_ENVIRONMENT - .include "words/env-wordlists.asm" - - ; Environment - ; maximum number of wordlists in the dictionary search order - VE_ENVWORDLISTS: -0002b5 ff09 .dw $ff09 -0002b6 6f77 -0002b7 6472 -0002b8 696c -0002b9 7473 -0002ba 0073 .db "wordlists",0 -0002bb 0000 .dw VE_ENVHEAD - .set VE_ENVHEAD = VE_ENVWORDLISTS - XT_ENVWORDLISTS: -0002bc 3801 .dw DO_COLON - PFA_ENVWORDLISTS: -0002bd 383d .dw XT_DOLITERAL -0002be 0008 .dw NUMWORDLISTS -0002bf 3820 .dw XT_EXIT - .include "words/env-slashpad.asm" - - ; Environment - ; Size of the PAD buffer in bytes - VE_ENVSLASHPAD: -0002c0 ff04 .dw $ff04 -0002c1 702f -0002c2 6461 .db "/pad" -0002c3 02b5 .dw VE_ENVHEAD - .set VE_ENVHEAD = VE_ENVSLASHPAD - XT_ENVSLASHPAD: -0002c4 3801 .dw DO_COLON - PFA_ENVSLASHPAD: -0002c5 3a8d .dw XT_SP_FETCH -0002c6 3ee8 .dw XT_PAD -0002c7 3993 .dw XT_MINUS -0002c8 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: -0002c9 ff05 .dw $ff05 -0002ca 682f -0002cb 6c6f -0002cc 0064 .db "/hold",0 -0002cd 02c0 .dw VE_ENVHEAD - .set VE_ENVHEAD = VE_ENVSLASHHOLD - XT_ENVSLASHHOLD: -0002ce 3801 .dw DO_COLON - PFA_ENVSLASHHOLD: - .endif -0002cf 3ee8 .dw XT_PAD -0002d0 3f23 .dw XT_HERE -0002d1 3993 .dw XT_MINUS -0002d2 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: -0002d3 ff0a .dw $ff0a -0002d4 6f66 -0002d5 7472 -0002d6 2d68 -0002d7 616e -0002d8 656d .db "forth-name" -0002d9 02c9 .dw VE_ENVHEAD - .set VE_ENVHEAD = VE_ENV_FORTHNAME - XT_ENV_FORTHNAME: -0002da 3801 .dw DO_COLON - PFA_EN_FORTHNAME: -0002db 03d0 .dw XT_DOSLITERAL -0002dc 0007 .dw 7 - .endif -0002dd 6d61 -0002de 6f66 -0002df 7472 -../../common\words/env-forthname.asm(22): warning: .cseg .db misalignment - padding zero byte -0002e0 0068 .db "amforth" - .if cpu_msp430==1 - .endif -0002e1 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: -0002e2 ff07 .dw $ff07 -0002e3 6576 -0002e4 7372 -0002e5 6f69 -0002e6 006e .db "version",0 -0002e7 02d3 .dw VE_ENVHEAD - .set VE_ENVHEAD = VE_ENV_FORTHVERSION - XT_ENV_FORTHVERSION: -0002e8 3801 .dw DO_COLON - PFA_EN_FORTHVERSION: - .endif -0002e9 383d .dw XT_DOLITERAL -0002ea 0041 .dw 65 -0002eb 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: -0002ec ff03 .dw $ff03 -0002ed 7063 -0002ee 0075 .db "cpu",0 -0002ef 02e2 .dw VE_ENVHEAD - .set VE_ENVHEAD = VE_ENV_CPU - XT_ENV_CPU: -0002f0 3801 .dw DO_COLON - PFA_EN_CPU: - .endif -0002f1 383d .dw XT_DOLITERAL -0002f2 0037 .dw mcu_name -0002f3 042f .dw XT_ICOUNT -0002f4 3820 .dw XT_EXIT - .include "words/env-mcuinfo.asm" - - ; Environment - ; flash address of some CPU specific parameters - VE_ENV_MCUINFO: -0002f5 ff08 .dw $ff08 -0002f6 636d -0002f7 2d75 -0002f8 6e69 -0002f9 6f66 .db "mcu-info" -0002fa 02ec .dw VE_ENVHEAD - .set VE_ENVHEAD = VE_ENV_MCUINFO - XT_ENV_MCUINFO: -0002fb 3801 .dw DO_COLON - PFA_EN_MCUINFO: -0002fc 383d .dw XT_DOLITERAL -0002fd 0033 .dw mcu_info -0002fe 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: -0002ff ff05 .dw $ff05 -000300 752f -000301 6573 -000302 0072 .db "/user",0 -000303 02f5 .dw VE_ENVHEAD - .set VE_ENVHEAD = VE_ENVUSERSIZE - XT_ENVUSERSIZE: -000304 3801 .dw DO_COLON - PFA_ENVUSERSIZE: - .endif -000305 383d .dw XT_DOLITERAL -000306 002c .dw SYSUSERSIZE + APPUSERSIZE -000307 3820 .dw XT_EXIT - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - .include "words/hld.asm" - - ; Numeric IO - ; pointer to current write position in the Pictured Numeric Output buffer - VE_HLD: -000308 ff03 .dw $ff03 -000309 6c68 -00030a 0064 .db "hld",0 -00030b 02ab .dw VE_HEAD - .set VE_HEAD = VE_HLD - XT_HLD: -00030c 3848 .dw PFA_DOVARIABLE - PFA_HLD: -00030d 0188 .dw ram_hld - - .dseg -000188 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: -00030e ff04 .dw $ff04 -00030f 6f68 -000310 646c .db "hold" -000311 0308 .dw VE_HEAD - .set VE_HEAD = VE_HOLD - XT_HOLD: -000312 3801 .dw DO_COLON - PFA_HOLD: - .endif -000313 030c .dw XT_HLD -000314 38b1 .dw XT_DUP -000315 3879 .dw XT_FETCH -000316 3a35 .dw XT_1MINUS -000317 38b1 .dw XT_DUP -000318 38ff .dw XT_TO_R -000319 38c4 .dw XT_SWAP -00031a 3881 .dw XT_STORE -00031b 38f6 .dw XT_R_FROM -00031c 388d .dw XT_CSTORE -00031d 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: -00031e ff02 .dw $ff02 -00031f 233c .db "<#" -000320 030e .dw VE_HEAD - .set VE_HEAD = VE_L_SHARP - XT_L_SHARP: -000321 3801 .dw DO_COLON - PFA_L_SHARP: - .endif -000322 3ee8 .dw XT_PAD -000323 030c .dw XT_HLD -000324 3881 .dw XT_STORE -000325 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: -000326 ff01 .dw $ff01 -000327 0023 .db "#",0 -000328 031e .dw VE_HEAD - .set VE_HEAD = VE_SHARP - XT_SHARP: -000329 3801 .dw DO_COLON - PFA_SHARP: - .endif -00032a 3ebd .dw XT_BASE -00032b 3879 .dw XT_FETCH -00032c 03a6 .dw XT_UDSLASHMOD -00032d 38e1 .dw XT_ROT -00032e 383d .dw XT_DOLITERAL -00032f 0009 .dw 9 -000330 38cf .dw XT_OVER -000331 396e .dw XT_LESS -000332 3836 .dw XT_DOCONDBRANCH -000333 0337 DEST(PFA_SHARP1) -000334 383d .dw XT_DOLITERAL -000335 0007 .dw 7 -000336 399d .dw XT_PLUS - PFA_SHARP1: -000337 383d .dw XT_DOLITERAL -000338 0030 .dw 48 ; ASCII 0 -000339 399d .dw XT_PLUS -00033a 0312 .dw XT_HOLD -00033b 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: -00033c ff02 .dw $ff02 -00033d 7323 .db "#s" -00033e 0326 .dw VE_HEAD - .set VE_HEAD = VE_SHARP_S - XT_SHARP_S: -00033f 3801 .dw DO_COLON - PFA_SHARP_S: - .endif - NUMS1: -000340 0329 .dw XT_SHARP -000341 3ec9 .dw XT_2DUP -000342 3a1c .dw XT_OR -000343 391a .dw XT_ZEROEQUAL -000344 3836 .dw XT_DOCONDBRANCH -000345 0340 DEST(NUMS1) ; PFA_SHARP_S -000346 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: -000347 ff02 .dw $ff02 -000348 3e23 .db "#>" -000349 033c .dw VE_HEAD - .set VE_HEAD = VE_SHARP_G - XT_SHARP_G: -00034a 3801 .dw DO_COLON - PFA_SHARP_G: - .endif -00034b 3ed2 .dw XT_2DROP -00034c 030c .dw XT_HLD -00034d 3879 .dw XT_FETCH -00034e 3ee8 .dw XT_PAD -00034f 38cf .dw XT_OVER -000350 3993 .dw XT_MINUS -000351 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: -000352 ff04 .dw $ff04 -000353 6973 -000354 6e67 .db "sign" -000355 0347 .dw VE_HEAD - .set VE_HEAD = VE_SIGN - XT_SIGN: -000356 3801 .dw DO_COLON - PFA_SIGN: - .endif -000357 3921 .dw XT_ZEROLESS -000358 3836 .dw XT_DOCONDBRANCH -000359 035d DEST(PFA_SIGN1) -00035a 383d .dw XT_DOLITERAL -00035b 002d .dw 45 ; ascii - -00035c 0312 .dw XT_HOLD - PFA_SIGN1: -00035d 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: -00035e ff03 .dw $ff03 -00035f 2e64 -000360 0072 .db "d.r",0 -000361 0352 .dw VE_HEAD - .set VE_HEAD = VE_DDOTR - XT_DDOTR: -000362 3801 .dw DO_COLON - PFA_DDOTR: - - .endif -000363 38ff .dw XT_TO_R -000364 3eda .dw XT_TUCK -000365 0226 .dw XT_DABS -000366 0321 .dw XT_L_SHARP -000367 033f .dw XT_SHARP_S -000368 38e1 .dw XT_ROT -000369 0356 .dw XT_SIGN -00036a 034a .dw XT_SHARP_G -00036b 38f6 .dw XT_R_FROM -00036c 38cf .dw XT_OVER -00036d 3993 .dw XT_MINUS -00036e 3fb7 .dw XT_SPACES -00036f 0439 .dw XT_TYPE -000370 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: -000371 ff02 .dw $ff02 -000372 722e .db ".r" -000373 035e .dw VE_HEAD - .set VE_HEAD = VE_DOTR - XT_DOTR: -000374 3801 .dw DO_COLON - PFA_DOTR: - - .endif -000375 38ff .dw XT_TO_R -000376 3fc7 .dw XT_S2D -000377 38f6 .dw XT_R_FROM -000378 0362 .dw XT_DDOTR -000379 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: -00037a ff02 .dw $ff02 -00037b 2e64 .db "d." -00037c 0371 .dw VE_HEAD - .set VE_HEAD = VE_DDOT - XT_DDOT: -00037d 3801 .dw DO_COLON - PFA_DDOT: - - .endif -00037e 3954 .dw XT_ZERO -00037f 0362 .dw XT_DDOTR -000380 3fae .dw XT_SPACE -000381 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: -000382 ff01 .dw $ff01 -000383 002e .db ".",0 -000384 037a .dw VE_HEAD - .set VE_HEAD = VE_DOT - XT_DOT: -000385 3801 .dw DO_COLON - PFA_DOT: - .endif -000386 3fc7 .dw XT_S2D -000387 037d .dw XT_DDOT -000388 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: -000389 ff03 .dw $ff03 -00038a 6475 -00038b 002e .db "ud.",0 -00038c 0382 .dw VE_HEAD - .set VE_HEAD = VE_UDDOT - XT_UDDOT: -00038d 3801 .dw DO_COLON - PFA_UDDOT: - .endif -00038e 3954 .dw XT_ZERO -00038f 0396 .dw XT_UDDOTR -000390 3fae .dw XT_SPACE -000391 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: -000392 ff04 .dw $ff04 -000393 6475 -000394 722e .db "ud.r" -000395 0389 .dw VE_HEAD - .set VE_HEAD = VE_UDDOTR - XT_UDDOTR: -000396 3801 .dw DO_COLON - PFA_UDDOTR: - .endif -000397 38ff .dw XT_TO_R -000398 0321 .dw XT_L_SHARP -000399 033f .dw XT_SHARP_S -00039a 034a .dw XT_SHARP_G -00039b 38f6 .dw XT_R_FROM -00039c 38cf .dw XT_OVER -00039d 3993 .dw XT_MINUS -00039e 3fb7 .dw XT_SPACES -00039f 0439 .dw XT_TYPE -0003a0 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: -0003a1 ff06 .dw $ff06 -0003a2 6475 -0003a3 6d2f -0003a4 646f .db "ud/mod" -0003a5 0392 .dw VE_HEAD - .set VE_HEAD = VE_UDSLASHMOD - XT_UDSLASHMOD: -0003a6 3801 .dw DO_COLON - PFA_UDSLASHMOD: - .endif -0003a7 38ff .dw XT_TO_R -0003a8 3954 .dw XT_ZERO -0003a9 3908 .dw XT_R_FETCH -0003aa 39c2 .dw XT_UMSLASHMOD -0003ab 38f6 .dw XT_R_FROM -0003ac 38c4 .dw XT_SWAP -0003ad 38ff .dw XT_TO_R -0003ae 39c2 .dw XT_UMSLASHMOD -0003af 38f6 .dw XT_R_FROM -0003b0 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: -0003b1 ff06 .dw $ff06 -0003b2 6964 -0003b3 6967 -0003b4 3f74 .db "digit?" -0003b5 03a1 .dw VE_HEAD - .set VE_HEAD = VE_DIGITQ - XT_DIGITQ: -0003b6 3801 .dw DO_COLON - PFA_DIGITQ: - .endif -0003b7 3f66 .dw XT_TOUPPER -0003b8 38b1 -0003b9 383d -0003ba 0039 -0003bb 3978 -0003bc 383d -0003bd 0100 .DW XT_DUP,XT_DOLITERAL,57,XT_GREATER,XT_DOLITERAL,256 -0003be 3a13 -0003bf 399d -0003c0 38b1 -0003c1 383d -0003c2 0140 -0003c3 3978 .DW XT_AND,XT_PLUS,XT_DUP,XT_DOLITERAL,320,XT_GREATER -0003c4 383d -0003c5 0107 -0003c6 3a13 -0003c7 3993 -0003c8 383d -0003c9 0030 .DW XT_DOLITERAL,263,XT_AND,XT_MINUS,XT_DOLITERAL,48 -0003ca 3993 -0003cb 38b1 -0003cc 3ebd -0003cd 3879 -0003ce 395c .DW XT_MINUS,XT_DUP,XT_BASE,XT_FETCH,XT_ULESS -0003cf 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: -0003d0 3801 .dw DO_COLON - PFA_DOSLITERAL: -0003d1 3908 .dw XT_R_FETCH ; ( -- addr ) -0003d2 042f .dw XT_ICOUNT -0003d3 38f6 .dw XT_R_FROM -0003d4 38cf .dw XT_OVER ; ( -- addr' n addr n) -0003d5 3a2f .dw XT_1PLUS -0003d6 3a04 .dw XT_2SLASH ; ( -- addr' n addr k ) -0003d7 399d .dw XT_PLUS ; ( -- addr' n addr'' ) -0003d8 3a2f .dw XT_1PLUS -0003d9 38ff .dw XT_TO_R ; ( -- ) -0003da 3820 .dw XT_EXIT - .include "words/scomma.asm" - - ; Compiler - ; compiles a string from RAM to Flash - VE_SCOMMA: -0003db ff02 .dw $ff02 -0003dc 2c73 .db "s",$2c -0003dd 03b1 .dw VE_HEAD - .set VE_HEAD = VE_SCOMMA - XT_SCOMMA: -0003de 3801 .dw DO_COLON - PFA_SCOMMA: -0003df 38b1 .dw XT_DUP -0003e0 03e2 .dw XT_DOSCOMMA -0003e1 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: -0003e2 3801 .dw DO_COLON - PFA_DOSCOMMA: -0003e3 0767 .dw XT_COMMA -0003e4 38b1 .dw XT_DUP ; ( --addr len len) -0003e5 3a04 .dw XT_2SLASH ; ( -- addr len len/2 -0003e6 3eda .dw XT_TUCK ; ( -- addr len/2 len len/2 -0003e7 3a0b .dw XT_2STAR ; ( -- addr len/2 len len' -0003e8 3993 .dw XT_MINUS ; ( -- addr len/2 rem -0003e9 38ff .dw XT_TO_R -0003ea 3954 .dw XT_ZERO -0003eb 0826 .dw XT_QDOCHECK -0003ec 3836 .dw XT_DOCONDBRANCH -0003ed 03f5 .dw PFA_SCOMMA2 -0003ee 3a9b .dw XT_DODO - PFA_SCOMMA1: -0003ef 38b1 .dw XT_DUP ; ( -- addr addr ) -0003f0 3879 .dw XT_FETCH ; ( -- addr c1c2 ) -0003f1 0767 .dw XT_COMMA ; ( -- addr ) -0003f2 3c90 .dw XT_CELLPLUS ; ( -- addr+cell ) -0003f3 3ac9 .dw XT_DOLOOP -0003f4 03ef .dw PFA_SCOMMA1 - PFA_SCOMMA2: -0003f5 38f6 .dw XT_R_FROM -0003f6 3928 .dw XT_GREATERZERO -0003f7 3836 .dw XT_DOCONDBRANCH -0003f8 03fc .dw PFA_SCOMMA3 -0003f9 38b1 .dw XT_DUP ; well, tricky -0003fa 3898 .dw XT_CFETCH -0003fb 0767 .dw XT_COMMA - PFA_SCOMMA3: -0003fc 38d9 .dw XT_DROP ; ( -- ) -0003fd 3820 .dw XT_EXIT - .include "words/itype.asm" - - ; Tools - ; reads string from flash and prints it - VE_ITYPE: -0003fe ff05 .dw $ff05 -0003ff 7469 -000400 7079 -000401 0065 .db "itype",0 -000402 03db .dw VE_HEAD - .set VE_HEAD = VE_ITYPE - XT_ITYPE: -000403 3801 .dw DO_COLON - PFA_ITYPE: -000404 38b1 .dw XT_DUP ; ( --addr len len) -000405 3a04 .dw XT_2SLASH ; ( -- addr len len/2 -000406 3eda .dw XT_TUCK ; ( -- addr len/2 len len/2 -000407 3a0b .dw XT_2STAR ; ( -- addr len/2 len len' -000408 3993 .dw XT_MINUS ; ( -- addr len/2 rem -000409 38ff .dw XT_TO_R -00040a 3954 .dw XT_ZERO -00040b 0826 .dw XT_QDOCHECK -00040c 3836 .dw XT_DOCONDBRANCH -00040d 0417 .dw PFA_ITYPE2 -00040e 3a9b .dw XT_DODO - PFA_ITYPE1: -00040f 38b1 .dw XT_DUP ; ( -- addr addr ) -000410 3bcb .dw XT_FETCHI ; ( -- addr c1c2 ) -000411 38b1 .dw XT_DUP -000412 0424 .dw XT_LOWEMIT -000413 0420 .dw XT_HIEMIT -000414 3a2f .dw XT_1PLUS ; ( -- addr+cell ) -000415 3ac9 .dw XT_DOLOOP -000416 040f .dw PFA_ITYPE1 - PFA_ITYPE2: -000417 38f6 .dw XT_R_FROM -000418 3928 .dw XT_GREATERZERO -000419 3836 .dw XT_DOCONDBRANCH -00041a 041e .dw PFA_ITYPE3 -00041b 38b1 .dw XT_DUP ; make sure the drop below has always something to do -00041c 3bcb .dw XT_FETCHI -00041d 0424 .dw XT_LOWEMIT - PFA_ITYPE3: -00041e 38d9 .dw XT_DROP -00041f 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: -000420 3801 .dw DO_COLON - PFA_HIEMIT: -000421 3af9 .dw XT_BYTESWAP -000422 0424 .dw XT_LOWEMIT -000423 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: -000424 3801 .dw DO_COLON - PFA_LOWEMIT: -000425 383d .dw XT_DOLITERAL -000426 00ff .dw $00ff -000427 3a13 .dw XT_AND -000428 3ef2 .dw XT_EMIT -000429 3820 .dw XT_EXIT - .include "words/icount.asm" - - ; Tools - ; get count information out of a counted string in flash - VE_ICOUNT: -00042a ff06 .dw $ff06 -00042b 6369 -00042c 756f -00042d 746e .db "icount" -00042e 03fe .dw VE_HEAD - .set VE_HEAD = VE_ICOUNT - XT_ICOUNT: -00042f 3801 .dw DO_COLON - PFA_ICOUNT: -000430 38b1 .dw XT_DUP -000431 3a2f .dw XT_1PLUS -000432 38c4 .dw XT_SWAP -000433 3bcb .dw XT_FETCHI -000434 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: -000435 ff04 .dw $ff04 -000436 7974 -000437 6570 .db "type" -000438 042a .dw VE_HEAD - .set VE_HEAD = VE_TYPE - XT_TYPE: -000439 3801 .dw DO_COLON - PFA_TYPE: - - .endif -00043a 3f99 .dw XT_BOUNDS -00043b 0826 .dw XT_QDOCHECK -00043c 3836 .dw XT_DOCONDBRANCH -00043d 0444 DEST(PFA_TYPE2) -00043e 3a9b .dw XT_DODO - PFA_TYPE1: -00043f 3aac .dw XT_I -000440 3898 .dw XT_CFETCH -000441 3ef2 .dw XT_EMIT -000442 3ac9 .dw XT_DOLOOP -000443 043f DEST(PFA_TYPE1) - PFA_TYPE2: -000444 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: -000445 ff01 .dw $ff01 -000446 0027 .db "'",0 -000447 0435 .dw VE_HEAD - .set VE_HEAD = VE_TICK - XT_TICK: -000448 3801 .dw DO_COLON - PFA_TICK: - .endif -000449 05bb .dw XT_PARSENAME -00044a 05fe .dw XT_FORTHRECOGNIZER -00044b 0609 .dw XT_RECOGNIZE - ; a word is tickable unless DT:TOKEN is DT:NULL or - ; the interpret action is a NOOP -00044c 38b1 .dw XT_DUP -00044d 0696 .dw XT_DT_NULL -00044e 3fdf .dw XT_EQUAL -00044f 38c4 .dw XT_SWAP -000450 3bcb .dw XT_FETCHI -000451 383d .dw XT_DOLITERAL -000452 01a5 .dw XT_NOOP -000453 3fdf .dw XT_EQUAL -000454 3a1c .dw XT_OR -000455 3836 .dw XT_DOCONDBRANCH -000456 045a DEST(PFA_TICK1) -000457 383d .dw XT_DOLITERAL -000458 fff3 .dw -13 -000459 3d86 .dw XT_THROW - PFA_TICK1: -00045a 38d9 .dw XT_DROP -00045b 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: -00045c ff05 .dw $ff05 -00045d 7363 -00045e 696b -00045f 0070 .db "cskip",0 -000460 0445 .dw VE_HEAD - .set VE_HEAD = VE_CSKIP - XT_CSKIP: -000461 3801 .dw DO_COLON - PFA_CSKIP: - .endif -000462 38ff .dw XT_TO_R ; ( -- addr1 n1 ) - PFA_CSKIP1: -000463 38b1 .dw XT_DUP ; ( -- addr' n' n' ) -000464 3836 .dw XT_DOCONDBRANCH ; ( -- addr' n') -000465 0470 DEST(PFA_CSKIP2) -000466 38cf .dw XT_OVER ; ( -- addr' n' addr' ) -000467 3898 .dw XT_CFETCH ; ( -- addr' n' c' ) -000468 3908 .dw XT_R_FETCH ; ( -- addr' n' c' c ) -000469 3fdf .dw XT_EQUAL ; ( -- addr' n' f ) -00046a 3836 .dw XT_DOCONDBRANCH ; ( -- addr' n') -00046b 0470 DEST(PFA_CSKIP2) -00046c 3fe6 .dw XT_ONE -00046d 05ac .dw XT_SLASHSTRING -00046e 382f .dw XT_DOBRANCH -00046f 0463 DEST(PFA_CSKIP1) - PFA_CSKIP2: -000470 38f6 .dw XT_R_FROM -000471 38d9 .dw XT_DROP ; ( -- addr2 n2) -000472 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: -000473 ff05 .dw $ff05 -000474 7363 -000475 6163 -../../common\words/cscan.asm(12): warning: .cseg .db misalignment - padding zero byte -000476 006e .db "cscan" -000477 045c .dw VE_HEAD - .set VE_HEAD = VE_CSCAN - XT_CSCAN: -000478 3801 .dw DO_COLON - PFA_CSCAN: - .endif -000479 38ff .dw XT_TO_R -00047a 38cf .dw XT_OVER - PFA_CSCAN1: -00047b 38b1 .dw XT_DUP -00047c 3898 .dw XT_CFETCH -00047d 3908 .dw XT_R_FETCH -00047e 3fdf .dw XT_EQUAL -00047f 391a .dw XT_ZEROEQUAL -000480 3836 .dw XT_DOCONDBRANCH -000481 048d DEST(PFA_CSCAN2) -000482 38c4 .dw XT_SWAP -000483 3a35 .dw XT_1MINUS -000484 38c4 .dw XT_SWAP -000485 38cf .dw XT_OVER -000486 3921 .dw XT_ZEROLESS ; not negative -000487 391a .dw XT_ZEROEQUAL -000488 3836 .dw XT_DOCONDBRANCH -000489 048d DEST(PFA_CSCAN2) -00048a 3a2f .dw XT_1PLUS -00048b 382f .dw XT_DOBRANCH -00048c 047b DEST(PFA_CSCAN1) - PFA_CSCAN2: -00048d 38f0 .dw XT_NIP -00048e 38cf .dw XT_OVER -00048f 3993 .dw XT_MINUS -000490 38f6 .dw XT_R_FROM -000491 38d9 .dw XT_DROP -000492 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: -000493 ff06 .dw $ff06 -000494 6361 -000495 6563 -000496 7470 .db "accept" -000497 0473 .dw VE_HEAD - .set VE_HEAD = VE_ACCEPT - XT_ACCEPT: -000498 3801 .dw DO_COLON - PFA_ACCEPT: - - .endif -000499 38cf -00049a 399d -00049b 3a35 -00049c 38cf .DW XT_OVER,XT_PLUS,XT_1MINUS,XT_OVER -00049d 3f03 -00049e 38b1 -00049f 04d9 -0004a0 391a -0004a1 3836 ACC1: .DW XT_KEY,XT_DUP,XT_CRLFQ,XT_ZEROEQUAL,XT_DOCONDBRANCH -0004a2 04cb DEST(ACC5) -0004a3 38b1 -0004a4 383d -0004a5 0008 -0004a6 3fdf -0004a7 3836 .DW XT_DUP,XT_DOLITERAL,8,XT_EQUAL,XT_DOCONDBRANCH -0004a8 04bb DEST(ACC3) -0004a9 38d9 -0004aa 38e1 -0004ab 3ec9 -0004ac 3978 -0004ad 38ff -0004ae 38e1 -0004af 38e1 -0004b0 38f6 -0004b1 3836 .DW XT_DROP,XT_ROT,XT_2DUP,XT_GREATER,XT_TO_R,XT_ROT,XT_ROT,XT_R_FROM,XT_DOCONDBRANCH -0004b2 04b9 DEST(ACC6) -0004b3 04d1 -0004b4 3a35 -0004b5 38ff -0004b6 38cf -0004b7 38f6 -0004b8 015a .DW XT_BS,XT_1MINUS,XT_TO_R,XT_OVER,XT_R_FROM,XT_UMAX -0004b9 382f ACC6: .DW XT_DOBRANCH -0004ba 04c9 DEST(ACC4) - - - ACC3: ; check for remaining control characters, replace them with blank -0004bb 38b1 .dw XT_DUP ; ( -- addr k k ) -0004bc 3f54 .dw XT_BL -0004bd 396e .dw XT_LESS -0004be 3836 .dw XT_DOCONDBRANCH -0004bf 04c2 DEST(PFA_ACCEPT6) -0004c0 38d9 .dw XT_DROP -0004c1 3f54 .dw XT_BL - PFA_ACCEPT6: -0004c2 38b1 -0004c3 3ef2 -0004c4 38cf -0004c5 388d -0004c6 3a2f -0004c7 38cf -0004c8 0166 .DW XT_DUP,XT_EMIT,XT_OVER,XT_CSTORE,XT_1PLUS,XT_OVER,XT_UMIN -0004c9 382f ACC4: .DW XT_DOBRANCH -0004ca 049d DEST(ACC1) -0004cb 38d9 -0004cc 38f0 -0004cd 38c4 -0004ce 3993 -0004cf 3fa1 -0004d0 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: -0004d1 3801 .dw DO_COLON - .endif -0004d2 383d .dw XT_DOLITERAL -0004d3 0008 .dw 8 -0004d4 38b1 .dw XT_DUP -0004d5 3ef2 .dw XT_EMIT -0004d6 3fae .dw XT_SPACE -0004d7 3ef2 .dw XT_EMIT -0004d8 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: -0004d9 3801 .dw DO_COLON - .endif -0004da 38b1 .dw XT_DUP -0004db 383d .dw XT_DOLITERAL -0004dc 000d .dw 13 -0004dd 3fdf .dw XT_EQUAL -0004de 38c4 .dw XT_SWAP -0004df 383d .dw XT_DOLITERAL -0004e0 000a .dw 10 -0004e1 3fdf .dw XT_EQUAL -0004e2 3a1c .dw XT_OR -0004e3 3820 .dw XT_EXIT - .include "words/refill.asm" - - ; System - ; refills the input buffer - - .if cpu_msp430==1 - .endif - - .if cpu_avr8==1 - VE_REFILL: -0004e4 ff06 .dw $ff06 -0004e5 6572 -0004e6 6966 -0004e7 6c6c .db "refill" -0004e8 0493 .dw VE_HEAD - .set VE_HEAD = VE_REFILL - XT_REFILL: -0004e9 3dff .dw PFA_DODEFER1 - PFA_REFILL: - .endif -0004ea 001a .dw USER_REFILL -0004eb 3dc8 .dw XT_UDEFERFETCH -0004ec 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: -0004ed ff04 .dw $ff04 -0004ee 6863 -0004ef 7261 .db "char" -0004f0 04e4 .dw VE_HEAD - .set VE_HEAD = VE_CHAR - XT_CHAR: -0004f1 3801 .dw DO_COLON - PFA_CHAR: - .endif -0004f2 05bb .dw XT_PARSENAME -0004f3 38d9 .dw XT_DROP -0004f4 3898 .dw XT_CFETCH -0004f5 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: -0004f6 ff06 .dw $ff06 -0004f7 756e -0004f8 626d -0004f9 7265 .db "number" -0004fa 04ed .dw VE_HEAD - .set VE_HEAD = VE_NUMBER - XT_NUMBER: -0004fb 3801 .dw DO_COLON - PFA_NUMBER: - .endif -0004fc 3ebd .dw XT_BASE -0004fd 3879 .dw XT_FETCH -0004fe 38ff .dw XT_TO_R -0004ff 053f .dw XT_QSIGN -000500 38ff .dw XT_TO_R -000501 0552 .dw XT_SET_BASE -000502 053f .dw XT_QSIGN -000503 38f6 .dw XT_R_FROM -000504 3a1c .dw XT_OR -000505 38ff .dw XT_TO_R - ; check whether something is left -000506 38b1 .dw XT_DUP -000507 391a .dw XT_ZEROEQUAL -000508 3836 .dw XT_DOCONDBRANCH -000509 0512 DEST(PFA_NUMBER0) - ; nothing is left. It cannot be a number at all -00050a 3ed2 .dw XT_2DROP -00050b 38f6 .dw XT_R_FROM -00050c 38d9 .dw XT_DROP -00050d 38f6 .dw XT_R_FROM -00050e 3ebd .dw XT_BASE -00050f 3881 .dw XT_STORE -000510 3954 .dw XT_ZERO -000511 3820 .dw XT_EXIT - PFA_NUMBER0: -000512 3b1e .dw XT_2TO_R -000513 3954 .dw XT_ZERO ; starting value -000514 3954 .dw XT_ZERO -000515 3b2d .dw XT_2R_FROM -000516 0570 .dw XT_TO_NUMBER ; ( 0. addr len -- d addr' len' - ; check length of the remaining string. - ; if zero: a single cell number is entered -000517 38b9 .dw XT_QDUP -000518 3836 .dw XT_DOCONDBRANCH -000519 0534 DEST(PFA_NUMBER1) - ; if equal 1: mayba a trailing dot? --> double cell number -00051a 3fe6 .dw XT_ONE -00051b 3fdf .dw XT_EQUAL -00051c 3836 .dw XT_DOCONDBRANCH -00051d 052b DEST(PFA_NUMBER2) - ; excatly one character is left -00051e 3898 .dw XT_CFETCH -00051f 383d .dw XT_DOLITERAL -000520 002e .dw 46 ; . -000521 3fdf .dw XT_EQUAL -000522 3836 .dw XT_DOCONDBRANCH -000523 052c DEST(PFA_NUMBER6) - ; its a double cell number - ; incorporate sign into number -000524 38f6 .dw XT_R_FROM -000525 3836 .dw XT_DOCONDBRANCH -000526 0528 DEST(PFA_NUMBER3) -000527 0233 .dw XT_DNEGATE - PFA_NUMBER3: -000528 3feb .dw XT_TWO -000529 382f .dw XT_DOBRANCH -00052a 053a DEST(PFA_NUMBER5) - PFA_NUMBER2: -00052b 38d9 .dw XT_DROP - PFA_NUMBER6: -00052c 3ed2 .dw XT_2DROP -00052d 38f6 .dw XT_R_FROM -00052e 38d9 .dw XT_DROP -00052f 38f6 .dw XT_R_FROM -000530 3ebd .dw XT_BASE -000531 3881 .dw XT_STORE -000532 3954 .dw XT_ZERO -000533 3820 .dw XT_EXIT - PFA_NUMBER1: -000534 3ed2 .dw XT_2DROP ; remove the address - ; incorporate sign into number -000535 38f6 .dw XT_R_FROM -000536 3836 .dw XT_DOCONDBRANCH -000537 0539 DEST(PFA_NUMBER4) -000538 3e27 .dw XT_NEGATE - PFA_NUMBER4: -000539 3fe6 .dw XT_ONE - PFA_NUMBER5: -00053a 38f6 .dw XT_R_FROM -00053b 3ebd .dw XT_BASE -00053c 3881 .dw XT_STORE -00053d 394b .dw XT_TRUE -00053e 3820 .dw XT_EXIT - .include "words/q-sign.asm" - - .if cpu_msp430==1 - .endif - - .if cpu_avr8==1 - XT_QSIGN: -00053f 3801 .dw DO_COLON - PFA_QSIGN: ; ( c -- ) - .endif -000540 38cf .dw XT_OVER ; ( -- addr len addr ) -000541 3898 .dw XT_CFETCH -000542 383d .dw XT_DOLITERAL -000543 002d .dw '-' -000544 3fdf .dw XT_EQUAL ; ( -- addr len flag ) -000545 38b1 .dw XT_DUP -000546 38ff .dw XT_TO_R -000547 3836 .dw XT_DOCONDBRANCH -000548 054b DEST(PFA_NUMBERSIGN_DONE) -000549 3fe6 .dw XT_ONE ; skip sign character -00054a 05ac .dw XT_SLASHSTRING - PFA_NUMBERSIGN_DONE: -00054b 38f6 .dw XT_R_FROM -00054c 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: -00054d 3852 .dw PFA_DOCONSTANT - .endif -00054e 000a -00054f 0010 -000550 0002 -000551 000a .dw 10,16,2,10 ; last one could a 8 instead. - - .if cpu_msp430==1 - .endif - - .if cpu_avr8==1 - XT_SET_BASE: -000552 3801 .dw DO_COLON - PFA_SET_BASE: ; ( adr1 len1 -- adr2 len2 ) - .endif -000553 38cf .dw XT_OVER -000554 3898 .dw XT_CFETCH -000555 383d .dw XT_DOLITERAL -000556 0023 .dw 35 -000557 3993 .dw XT_MINUS -000558 38b1 .dw XT_DUP -000559 3954 .dw XT_ZERO -00055a 383d .dw XT_DOLITERAL -00055b 0004 .dw 4 -00055c 3e57 .dw XT_WITHIN -00055d 3836 .dw XT_DOCONDBRANCH -00055e 0568 DEST(SET_BASE1) - .if cpu_msp430==1 - .endif -00055f 054d .dw XT_BASES -000560 399d .dw XT_PLUS -000561 3bcb .dw XT_FETCHI -000562 3ebd .dw XT_BASE -000563 3881 .dw XT_STORE -000564 3fe6 .dw XT_ONE -000565 05ac .dw XT_SLASHSTRING -000566 382f .dw XT_DOBRANCH -000567 0569 DEST(SET_BASE2) - SET_BASE1: -000568 38d9 .dw XT_DROP - SET_BASE2: -000569 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: -00056a ff07 .dw $ff07 -00056b 6e3e -00056c 6d75 -00056d 6562 -00056e 0072 .db ">number",0 -00056f 04f6 .dw VE_HEAD - .set VE_HEAD = VE_TO_NUMBER - XT_TO_NUMBER: -000570 3801 .dw DO_COLON - - .endif - -000571 38b1 -000572 3836 TONUM1: .DW XT_DUP,XT_DOCONDBRANCH -000573 0588 DEST(TONUM3) -000574 38cf -000575 3898 -000576 03b6 .DW XT_OVER,XT_CFETCH,XT_DIGITQ -000577 391a -000578 3836 .DW XT_ZEROEQUAL,XT_DOCONDBRANCH -000579 057c DEST(TONUM2) -00057a 38d9 -00057b 3820 .DW XT_DROP,XT_EXIT -00057c 38ff -00057d 0257 -00057e 3ebd -00057f 3879 -000580 014b TONUM2: .DW XT_TO_R,XT_2SWAP,XT_BASE,XT_FETCH,XT_UDSTAR -000581 38f6 -000582 0143 -000583 0257 .DW XT_R_FROM,XT_MPLUS,XT_2SWAP -000584 3fe6 -000585 05ac -000586 382f .DW XT_ONE,XT_SLASHSTRING,XT_DOBRANCH -000587 0571 DEST(TONUM1) -000588 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: -000589 ff05 .dw $ff05 -00058a 6170 -00058b 7372 -00058c 0065 .db "parse",0 -00058d 056a .dw VE_HEAD - .set VE_HEAD = VE_PARSE - XT_PARSE: -00058e 3801 .dw DO_COLON - PFA_PARSE: - .endif -00058f 38ff .dw XT_TO_R ; ( -- ) -000590 05a2 .dw XT_SOURCE ; ( -- addr len) -000591 3ee2 .dw XT_TO_IN ; ( -- addr len >in) -000592 3879 .dw XT_FETCH -000593 05ac .dw XT_SLASHSTRING ; ( -- addr' len' ) - -000594 38f6 .dw XT_R_FROM ; ( -- addr' len' c) -000595 0478 .dw XT_CSCAN ; ( -- addr' len'') -000596 38b1 .dw XT_DUP ; ( -- addr' len'' len'') -000597 3a2f .dw XT_1PLUS -000598 3ee2 .dw XT_TO_IN ; ( -- addr' len'' len'' >in) -000599 3a65 .dw XT_PLUSSTORE ; ( -- addr' len') -00059a 3fe6 .dw XT_ONE -00059b 05ac .dw XT_SLASHSTRING -00059c 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: -00059d ff06 .dw $FF06 -00059e 6f73 -00059f 7275 -0005a0 6563 .db "source" -0005a1 0589 .dw VE_HEAD - .set VE_HEAD = VE_SOURCE - XT_SOURCE: -0005a2 3dff .dw PFA_DODEFER1 - PFA_SOURCE: - .endif -0005a3 0016 .dw USER_SOURCE -0005a4 3dc8 .dw XT_UDEFERFETCH -0005a5 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: -0005a6 ff07 .dw $ff07 -0005a7 732f -0005a8 7274 -0005a9 6e69 -0005aa 0067 .db "/string",0 -0005ab 059d .dw VE_HEAD - .set VE_HEAD = VE_SLASHSTRING - XT_SLASHSTRING: -0005ac 3801 .dw DO_COLON - PFA_SLASHSTRING: - .endif -0005ad 38e1 .dw XT_ROT -0005ae 38cf .dw XT_OVER -0005af 399d .dw XT_PLUS -0005b0 38e1 .dw XT_ROT -0005b1 38e1 .dw XT_ROT -0005b2 3993 .dw XT_MINUS -0005b3 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: -0005b4 ff0a .dw $FF0A -0005b5 6170 -0005b6 7372 -0005b7 2d65 -0005b8 616e -0005b9 656d .db "parse-name" -0005ba 05a6 .dw VE_HEAD - .set VE_HEAD = VE_PARSENAME - XT_PARSENAME: -0005bb 3801 .dw DO_COLON - PFA_PARSENAME: - .endif -0005bc 3f54 .dw XT_BL -0005bd 05bf .dw XT_SKIPSCANCHAR -0005be 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: -0005bf 3801 .dw DO_COLON - PFA_SKIPSCANCHAR: - .endif -0005c0 38ff .dw XT_TO_R -0005c1 05a2 .dw XT_SOURCE -0005c2 3ee2 .dw XT_TO_IN -0005c3 3879 .dw XT_FETCH -0005c4 05ac .dw XT_SLASHSTRING - -0005c5 3908 .dw XT_R_FETCH -0005c6 0461 .dw XT_CSKIP -0005c7 38f6 .dw XT_R_FROM -0005c8 0478 .dw XT_CSCAN - - ; adjust >IN -0005c9 3ec9 .dw XT_2DUP -0005ca 399d .dw XT_PLUS -0005cb 05a2 .dw XT_SOURCE -0005cc 38d9 .dw XT_DROP -0005cd 3993 .dw XT_MINUS -0005ce 3ee2 .dw XT_TO_IN -0005cf 3881 .dw XT_STORE -0005d0 3820 .dw XT_EXIT - .include "words/sp0.asm" - - ; Stack - ; start address of the data stack - VE_SP0: -0005d1 ff03 .dw $ff03 -0005d2 7073 -0005d3 0030 .db "sp0",0 -0005d4 05b4 .dw VE_HEAD - .set VE_HEAD = VE_SP0 - XT_SP0: -0005d5 386f .dw PFA_DOVALUE1 - PFA_SP0: -0005d6 0006 .dw USER_SP0 -0005d7 3dc8 .dw XT_UDEFERFETCH -0005d8 3dd4 .dw XT_UDEFERSTORE - - ; ( -- addr) - ; Stack - ; address of user variable to store top-of-stack for inactive tasks - VE_SP: -0005d9 ff02 .dw $ff02 -0005da 7073 .db "sp" -0005db 05d1 .dw VE_HEAD - .set VE_HEAD = VE_SP - XT_SP: -0005dc 3858 .dw PFA_DOUSER - PFA_SP: -0005dd 0008 .dw USER_SP - .include "words/rp0.asm" - - ; Stack - ; start address of return stack - VE_RP0: -0005de ff03 .dw $ff03 -0005df 7072 -0005e0 0030 .db "rp0",0 -0005e1 05d9 .dw VE_HEAD - .set VE_HEAD = VE_RP0 - XT_RP0: -0005e2 3801 .dw DO_COLON - PFA_RP0: -0005e3 05e6 .dw XT_DORP0 -0005e4 3879 .dw XT_FETCH -0005e5 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: -0005e6 3858 .dw PFA_DOUSER - PFA_DORP0: -0005e7 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: -0005e8 ff05 .dw $ff05 -0005e9 6564 -0005ea 7470 -0005eb 0068 .db "depth",0 -0005ec 05de .dw VE_HEAD - .set VE_HEAD = VE_DEPTH - XT_DEPTH: -0005ed 3801 .dw DO_COLON - PFA_DEPTH: - .endif -0005ee 05d5 .dw XT_SP0 -0005ef 3a8d .dw XT_SP_FETCH -0005f0 3993 .dw XT_MINUS -0005f1 3a04 .dw XT_2SLASH -0005f2 3a35 .dw XT_1MINUS -0005f3 3820 .dw XT_EXIT - .include "words/forth-recognizer.asm" - - ; System Value - ; address of the next free data space (RAM) cell - VE_FORTHRECOGNIZER: -0005f4 ff10 .dw $ff10 -0005f5 6f66 -0005f6 7472 -0005f7 2d68 -0005f8 6572 -0005f9 6f63 -0005fa 6e67 -0005fb 7a69 -0005fc 7265 .db "forth-recognizer" -0005fd 05e8 .dw VE_HEAD - .set VE_HEAD = VE_FORTHRECOGNIZER - XT_FORTHRECOGNIZER: -0005fe 386f .dw PFA_DOVALUE1 - PFA_FORTHRECOGNIZER: -0005ff 003e .dw CFG_FORTHRECOGNIZER -000600 3da0 .dw XT_EDEFERFETCH -000601 3daa .dw XT_EDEFERSTORE - .include "words/recognize.asm" - - ; System - ; walk the recognizer stack - - .if cpu_msp430==1 - .endif - - .if cpu_avr8==1 - VE_RECOGNIZE: -000602 ff09 .dw $ff09 -000603 6572 -000604 6f63 -000605 6e67 -000606 7a69 -000607 0065 .db "recognize",0 -000608 05f4 .dw VE_HEAD - .set VE_HEAD = VE_RECOGNIZE - XT_RECOGNIZE: -000609 3801 .dw DO_COLON - PFA_RECOGNIZE: - .endif -00060a 383d .dw XT_DOLITERAL -00060b 0614 .dw XT_RECOGNIZE_A -00060c 38c4 .dw XT_SWAP -00060d 09a7 .dw XT_MAPSTACK -00060e 391a .dw XT_ZEROEQUAL -00060f 3836 .dw XT_DOCONDBRANCH -000610 0613 DEST(PFA_RECOGNIZE1) -000611 3ed2 .dw XT_2DROP -000612 0696 .dw XT_DT_NULL - PFA_RECOGNIZE1: -000613 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: -000614 3801 .dw DO_COLON - PFA_RECOGNIZE_A: - .endif -000615 38e1 .dw XT_ROT ; -- len xt addr -000616 38e1 .dw XT_ROT ; -- xt addr len -000617 3ec9 .dw XT_2DUP -000618 3b1e .dw XT_2TO_R -000619 38e1 .dw XT_ROT ; -- addr len xt -00061a 382a .dw XT_EXECUTE ; -- i*x dt:* | dt:null -00061b 3b2d .dw XT_2R_FROM -00061c 38e1 .dw XT_ROT -00061d 38b1 .dw XT_DUP -00061e 0696 .dw XT_DT_NULL -00061f 3fdf .dw XT_EQUAL -000620 3836 .dw XT_DOCONDBRANCH -000621 0625 DEST(PFA_RECOGNIZE_A1) -000622 38d9 .dw XT_DROP -000623 3954 .dw XT_ZERO -000624 3820 .dw XT_EXIT - PFA_RECOGNIZE_A1: -000625 38f0 .dw XT_NIP -000626 38f0 .dw XT_NIP -000627 394b .dw XT_TRUE -000628 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: -000629 ff09 .dw $ff09 -00062a 6e69 -00062b 6574 -00062c 7072 -00062d 6572 -00062e 0074 .db "interpret",0 -00062f 0602 .dw VE_HEAD - .set VE_HEAD = VE_INTERPRET - XT_INTERPRET: -000630 3801 .dw DO_COLON - .endif - PFA_INTERPRET: -000631 05bb .dw XT_PARSENAME ; ( -- addr len ) -000632 38b1 .dw XT_DUP ; ( -- addr len flag) -000633 3836 .dw XT_DOCONDBRANCH -000634 0641 DEST(PFA_INTERPRET2) -000635 05fe .dw XT_FORTHRECOGNIZER -000636 0609 .dw XT_RECOGNIZE -000637 3eb7 .dw XT_STATE -000638 3879 .dw XT_FETCH -000639 3836 .dw XT_DOCONDBRANCH -00063a 063c DEST(PFA_INTERPRET1) -00063b 01d1 .dw XT_ICELLPLUS ; we need the compile action - PFA_INTERPRET1: -00063c 3bcb .dw XT_FETCHI -00063d 382a .dw XT_EXECUTE -00063e 3f8b .dw XT_QSTACK -00063f 382f .dw XT_DOBRANCH -000640 0631 DEST(PFA_INTERPRET) - PFA_INTERPRET2: -000641 3ed2 .dw XT_2DROP -000642 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: -000643 ff06 .dw $ff06 -000644 7464 -000645 6e3a -000646 6d75 .db "dt:num" -000647 0629 .dw VE_HEAD - .set VE_HEAD = VE_DT_NUM - XT_DT_NUM: -000648 3852 .dw PFA_DOCONSTANT - PFA_DT_NUM: - .endif -000649 01a5 .dw XT_NOOP ; interpret -00064a 077d .dw XT_LITERAL ; compile -00064b 077d .dw XT_LITERAL ; postpone - - ; ( -- addr ) - ; Interpreter - ; Method table for double cell integers - .if cpu_msp430==1 - .endif - - .if cpu_avr8==1 - VE_DT_DNUM: -00064c ff07 .dw $ff07 -00064d 7464 -00064e 643a -00064f 756e -000650 006d .db "dt:dnum",0 -000651 0643 .dw VE_HEAD - .set VE_HEAD = VE_DT_DNUM - XT_DT_DNUM: -000652 3852 .dw PFA_DOCONSTANT - PFA_DT_DNUM: - .endif -000653 01a5 .dw XT_NOOP ; interpret -000654 3fd7 .dw XT_2LITERAL ; compile -000655 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: -000656 ff07 .dw $ff07 -000657 6572 -000658 3a63 -000659 756e -00065a 006d .db "rec:num",0 -00065b 064c .dw VE_HEAD - .set VE_HEAD = VE_REC_NUM - XT_REC_NUM: -00065c 3801 .dw DO_COLON - PFA_REC_NUM: - .endif - ; try converting to a number -00065d 04fb .dw XT_NUMBER -00065e 3836 .dw XT_DOCONDBRANCH -00065f 0668 DEST(PFA_REC_NONUMBER) -000660 3fe6 .dw XT_ONE -000661 3fdf .dw XT_EQUAL -000662 3836 .dw XT_DOCONDBRANCH -000663 0666 DEST(PFA_REC_INTNUM2) -000664 0648 .dw XT_DT_NUM -000665 3820 .dw XT_EXIT - PFA_REC_INTNUM2: -000666 0652 .dw XT_DT_DNUM -000667 3820 .dw XT_EXIT - PFA_REC_NONUMBER: -000668 0696 .dw XT_DT_NULL -000669 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: -00066a ff08 .dw $ff08 -00066b 6572 -00066c 3a63 -00066d 6966 -00066e 646e .db "rec:find" -00066f 0656 .dw VE_HEAD - .set VE_HEAD = VE_REC_FIND - XT_REC_FIND: -000670 3801 .dw DO_COLON - PFA_REC_FIND: - .endif -000671 070b .DW XT_FINDXT -000672 38b1 .dw XT_DUP -000673 391a .dw XT_ZEROEQUAL -000674 3836 .dw XT_DOCONDBRANCH -000675 0679 DEST(PFA_REC_WORD_FOUND) -000676 38d9 .dw XT_DROP -000677 0696 .dw XT_DT_NULL -000678 3820 .dw XT_EXIT - PFA_REC_WORD_FOUND: -000679 0680 .dw XT_DT_XT - -00067a 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: -00067b ff05 .dw $ff05 -00067c 7464 -00067d 783a -00067e 0074 .db "dt:xt",0 -00067f 066a .dw VE_HEAD - .set VE_HEAD = VE_DT_XT - XT_DT_XT: -000680 3852 .dw PFA_DOCONSTANT - PFA_DT_XT: - .endif -000681 0684 .dw XT_R_WORD_INTERPRET -000682 0688 .dw XT_R_WORD_COMPILE -000683 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: -000684 3801 .dw DO_COLON - PFA_R_WORD_INTERPRET: - .endif -000685 38d9 .dw XT_DROP ; the flags are in the way -000686 382a .dw XT_EXECUTE -000687 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: -000688 3801 .dw DO_COLON - PFA_R_WORD_COMPILE: - .endif -000689 3921 .dw XT_ZEROLESS -00068a 3836 .dw XT_DOCONDBRANCH -00068b 068e DEST(PFA_R_WORD_COMPILE1) -00068c 0767 .dw XT_COMMA -00068d 3820 .dw XT_EXIT - PFA_R_WORD_COMPILE1: -00068e 382a .dw XT_EXECUTE -00068f 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: -000690 ff07 .dw $ff07 -000691 7464 -000692 6e3a -000693 6c75 -../../common\words/dt-null.asm(12): warning: .cseg .db misalignment - padding zero byte -000694 006c .db "dt:null" -000695 067b .dw VE_HEAD - .set VE_HEAD = VE_DT_NULL - XT_DT_NULL: -000696 3852 .dw PFA_DOCONSTANT - PFA_DT_NULL: - .endif -000697 069a .dw XT_FAIL ; interpret -000698 069a .dw XT_FAIL ; compile -000699 069a .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: -00069a 3801 .dw DO_COLON - PFA_FAIL: - .endif -00069b 383d .dw XT_DOLITERAL -00069c fff3 .dw -13 -00069d 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: -00069e ff0f .dw $ff0f -00069f 6573 -0006a0 7261 -0006a1 6863 -0006a2 772d -0006a3 726f -0006a4 6c64 -0006a5 7369 -0006a6 0074 .db "search-wordlist",0 -0006a7 0690 .dw VE_HEAD - .set VE_HEAD = VE_SEARCH_WORDLIST - XT_SEARCH_WORDLIST: -0006a8 3801 .dw DO_COLON - PFA_SEARCH_WORDLIST: - .endif -0006a9 38ff .dw XT_TO_R -0006aa 3954 .dw XT_ZERO -0006ab 383d .dw XT_DOLITERAL -0006ac 06bd .dw XT_ISWORD -0006ad 38f6 .dw XT_R_FROM -0006ae 06da .dw XT_TRAVERSEWORDLIST -0006af 38b1 .dw XT_DUP -0006b0 391a .dw XT_ZEROEQUAL -0006b1 3836 .dw XT_DOCONDBRANCH -0006b2 06b7 DEST(PFA_SEARCH_WORDLIST1) -0006b3 3ed2 .dw XT_2DROP -0006b4 38d9 .dw XT_DROP -0006b5 3954 .dw XT_ZERO -0006b6 3820 .dw XT_EXIT - PFA_SEARCH_WORDLIST1: - ; ... get the XT ... -0006b7 38b1 .dw XT_DUP -0006b8 0701 .dw XT_NFA2CFA - ; .. and get the header flag -0006b9 38c4 .dw XT_SWAP -0006ba 0180 .dw XT_NAME2FLAGS -0006bb 016e .dw XT_IMMEDIATEQ -0006bc 3820 .dw XT_EXIT - - .if cpu_msp430==1 - .endif - - .if cpu_avr8==1 - XT_ISWORD: -0006bd 3801 .dw DO_COLON - PFA_ISWORD: - .endif - ; ( c-addr len 0 nt -- c-addr len 0 true| nt false ) -0006be 38ff .dw XT_TO_R -0006bf 38d9 .dw XT_DROP -0006c0 3ec9 .dw XT_2DUP -0006c1 3908 .dw XT_R_FETCH ; -- addr len addr len nt -0006c2 06f5 .dw XT_NAME2STRING -0006c3 01da .dw XT_ICOMPARE ; (-- addr len f ) -0006c4 3836 .dw XT_DOCONDBRANCH -0006c5 06cb DEST(PFA_ISWORD3) - ; not now -0006c6 38f6 .dw XT_R_FROM -0006c7 38d9 .dw XT_DROP -0006c8 3954 .dw XT_ZERO -0006c9 394b .dw XT_TRUE ; maybe next word -0006ca 3820 .dw XT_EXIT - PFA_ISWORD3: - ; we found the word, now clean up iteration data ... -0006cb 3ed2 .dw XT_2DROP -0006cc 38f6 .dw XT_R_FROM -0006cd 3954 .dw XT_ZERO ; finish traverse-wordlist -0006ce 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: -0006cf ff11 .dw $ff11 -0006d0 7274 -0006d1 7661 -0006d2 7265 -0006d3 6573 -0006d4 772d -0006d5 726f -0006d6 6c64 -0006d7 7369 -0006d8 0074 .db "traverse-wordlist",0 -0006d9 069e .dw VE_HEAD - .set VE_HEAD = VE_TRAVERSEWORDLIST - XT_TRAVERSEWORDLIST: -0006da 3801 .dw DO_COLON - PFA_TRAVERSEWORDLIST: - - .endif -0006db 3b5f .dw XT_FETCHE - PFA_TRAVERSEWORDLIST1: -0006dc 38b1 .dw XT_DUP ; ( -- xt nt nt ) -0006dd 3836 .dw XT_DOCONDBRANCH ; ( -- nt ) is nfa = counted string -0006de 06eb DEST(PFA_TRAVERSEWORDLIST2) -0006df 3ec9 .dw XT_2DUP -0006e0 3b1e .dw XT_2TO_R -0006e1 38c4 .dw XT_SWAP -0006e2 382a .dw XT_EXECUTE -0006e3 3b2d .dw XT_2R_FROM -0006e4 38e1 .dw XT_ROT -0006e5 3836 .dw XT_DOCONDBRANCH -0006e6 06eb DEST(PFA_TRAVERSEWORDLIST2) -0006e7 0a16 .dw XT_NFA2LFA -0006e8 3bcb .dw XT_FETCHI -0006e9 382f .dw XT_DOBRANCH ; ( -- addr ) -0006ea 06dc DEST(PFA_TRAVERSEWORDLIST1) ; ( -- addr ) - PFA_TRAVERSEWORDLIST2: -0006eb 3ed2 .dw XT_2DROP -0006ec 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: -0006ed ff0b .dw $ff0b -0006ee 616e -0006ef 656d -0006f0 733e -0006f1 7274 -0006f2 6e69 -0006f3 0067 .db "name>string",0 -0006f4 06cf .dw VE_HEAD - .set VE_HEAD = VE_NAME2STRING - XT_NAME2STRING: -0006f5 3801 .dw DO_COLON - PFA_NAME2STRING: - - .endif -0006f6 042f .dw XT_ICOUNT ; ( -- addr n ) -0006f7 383d .dw XT_DOLITERAL -0006f8 00ff .dw 255 -0006f9 3a13 .dw XT_AND ; mask immediate bit -0006fa 3820 .dw XT_EXIT - .include "words/nfa2cfa.asm" - - ; Tools - ; get the XT from a name token - VE_NFA2CFA: -0006fb ff07 .dw $ff07 -0006fc 666e -0006fd 3e61 -0006fe 6663 -../../avr8\words/nfa2cfa.asm(6): warning: .cseg .db misalignment - padding zero byte -0006ff 0061 .db "nfa>cfa" -000700 06ed .dw VE_HEAD - .set VE_HEAD = VE_NFA2CFA - XT_NFA2CFA: -000701 3801 .dw DO_COLON - PFA_NFA2CFA: -000702 0a16 .dw XT_NFA2LFA ; skip to link field -000703 3a2f .dw XT_1PLUS ; next is the execution token -000704 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: -000705 ff07 .dw $ff07 -000706 6966 -000707 646e -000708 782d -000709 0074 .db "find-xt",0 -00070a 06fb .dw VE_HEAD - .set VE_HEAD = VE_FINDXT - XT_FINDXT: -00070b 3801 .dw DO_COLON - PFA_FINDXT: - .endif -00070c 383d .dw XT_DOLITERAL -00070d 0717 .dw XT_FINDXTA -00070e 383d .dw XT_DOLITERAL -00070f 004a .dw CFG_ORDERLISTLEN -000710 09a7 .dw XT_MAPSTACK -000711 391a .dw XT_ZEROEQUAL -000712 3836 .dw XT_DOCONDBRANCH -000713 0716 DEST(PFA_FINDXT1) -000714 3ed2 .dw XT_2DROP -000715 3954 .dw XT_ZERO - PFA_FINDXT1: -000716 3820 .dw XT_EXIT - - .if cpu_msp430==1 - .endif - - .if cpu_avr8==1 - - XT_FINDXTA: -000717 3801 .dw DO_COLON - PFA_FINDXTA: - .endif -000718 38ff .dw XT_TO_R -000719 3ec9 .dw XT_2DUP -00071a 38f6 .dw XT_R_FROM -00071b 06a8 .dw XT_SEARCH_WORDLIST -00071c 38b1 .dw XT_DUP -00071d 3836 .dw XT_DOCONDBRANCH -00071e 0724 DEST(PFA_FINDXTA1) -00071f 38ff .dw XT_TO_R -000720 38f0 .dw XT_NIP -000721 38f0 .dw XT_NIP -000722 38f6 .dw XT_R_FROM -000723 394b .dw XT_TRUE - PFA_FINDXTA1: -000724 3820 .dw XT_EXIT - - .include "dict/compiler1.inc" - - .include "words/newest.asm" - - ; System Variable - ; system state - VE_NEWEST: -000725 ff06 .dw $ff06 -000726 656e -000727 6577 -000728 7473 .db "newest" -000729 0705 .dw VE_HEAD - .set VE_HEAD = VE_NEWEST - XT_NEWEST: -00072a 3848 .dw PFA_DOVARIABLE - PFA_NEWEST: -00072b 018a .dw ram_newest - - .dseg -00018a ram_newest: .byte 4 - .include "words/latest.asm" - - ; System Variable - ; system state - VE_LATEST: -00072c ff06 .dw $ff06 -00072d 616c -00072e 6574 -00072f 7473 .db "latest" -000730 0725 .dw VE_HEAD - .set VE_HEAD = VE_LATEST - XT_LATEST: -000731 3848 .dw PFA_DOVARIABLE - PFA_LATEST: -000732 018e .dw ram_latest - - .dseg -00018e 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: -000733 ff08 .dw $ff08 -000734 6328 -000735 6572 -000736 7461 -000737 2965 .db "(create)" -000738 072c .dw VE_HEAD - .set VE_HEAD = VE_DOCREATE - XT_DOCREATE: -000739 3801 .dw DO_COLON - PFA_DOCREATE: - .endif -00073a 05bb -00073b 0890 .DW XT_PARSENAME,XT_WLSCOPE ; ( -- addr len wid) -00073c 38b1 -00073d 072a -00073e 3c90 -00073f 3881 .DW XT_DUP,XT_NEWEST,XT_CELLPLUS,XT_STORE ; save the wid -000740 0875 -000741 072a -000742 3881 .DW XT_HEADER,XT_NEWEST,XT_STORE ; save the nt -000743 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: -000744 0001 .dw $0001 -000745 005c .db $5c,0 -000746 0733 .dw VE_HEAD - .set VE_HEAD = VE_BACKSLASH - XT_BACKSLASH: -000747 3801 .dw DO_COLON - PFA_BACKSLASH: - .endif -000748 05a2 .dw XT_SOURCE -000749 38f0 .dw XT_NIP -00074a 3ee2 .dw XT_TO_IN -00074b 3881 .dw XT_STORE -00074c 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: -00074d 0001 .dw $0001 -00074e 0028 .db "(" ,0 -00074f 0744 .dw VE_HEAD - .set VE_HEAD = VE_LPAREN - XT_LPAREN: -000750 3801 .dw DO_COLON - PFA_LPAREN: - .endif -000751 383d .dw XT_DOLITERAL -000752 0029 .dw ')' -000753 058e .dw XT_PARSE -000754 3ed2 .dw XT_2DROP -000755 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: -000756 ff07 .dw $ff07 -000757 6f63 -000758 706d -000759 6c69 -00075a 0065 .db "compile",0 -00075b 074d .dw VE_HEAD - .set VE_HEAD = VE_COMPILE - XT_COMPILE: -00075c 3801 .dw DO_COLON - PFA_COMPILE: - .endif -00075d 38f6 .dw XT_R_FROM -00075e 38b1 .dw XT_DUP -00075f 01d1 .dw XT_ICELLPLUS -000760 38ff .dw XT_TO_R -000761 3bcb .dw XT_FETCHI -000762 0767 .dw XT_COMMA -000763 3820 .dw XT_EXIT - .include "words/comma.asm" - - ; Dictionary - ; compile 16 bit into flash at DP - VE_COMMA: -000764 ff01 .dw $ff01 -000765 002c .db ',',0 ; , -000766 0756 .dw VE_HEAD - .set VE_HEAD = VE_COMMA - XT_COMMA: -000767 3801 .dw DO_COLON - PFA_COMMA: -000768 3f12 .dw XT_DP -000769 3b73 .dw XT_STOREI -00076a 3f12 .dw XT_DP -00076b 3a2f .dw XT_1PLUS -00076c 01bf .dw XT_DOTO -00076d 3f13 .dw PFA_DP -00076e 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: -00076f 0003 .dw $0003 -000770 275b -000771 005d .db "[']",0 -000772 0764 .dw VE_HEAD - .set VE_HEAD = VE_BRACKETTICK - XT_BRACKETTICK: -000773 3801 .dw DO_COLON - PFA_BRACKETTICK: - .endif -000774 0448 .dw XT_TICK -000775 077d .dw XT_LITERAL -000776 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: -000777 0007 .dw $0007 -000778 696c -000779 6574 -00077a 6172 -00077b 006c .db "literal",0 -00077c 076f .dw VE_HEAD - .set VE_HEAD = VE_LITERAL - XT_LITERAL: -00077d 3801 .dw DO_COLON - PFA_LITERAL: - .endif -00077e 075c .DW XT_COMPILE -00077f 383d .DW XT_DOLITERAL -000780 0767 .DW XT_COMMA -000781 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: -000782 0008 .dw $0008 -000783 6c73 -000784 7469 -000785 7265 -000786 6c61 .db "sliteral" -000787 0777 .dw VE_HEAD - .set VE_HEAD = VE_SLITERAL - XT_SLITERAL: -000788 3801 .dw DO_COLON - PFA_SLITERAL: - .endif -000789 075c .dw XT_COMPILE -00078a 03d0 .dw XT_DOSLITERAL ; ( -- addr n) -00078b 03de .dw XT_SCOMMA -00078c 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: -00078d 3801 .dw DO_COLON - PFA_GMARK: -00078e 3f12 .dw XT_DP -00078f 075c .dw XT_COMPILE -000790 ffff .dw -1 ; ffff does not erase flash -000791 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: -000792 3801 .dw DO_COLON - PFA_GRESOLVE: -000793 3f8b .dw XT_QSTACK -000794 3f12 .dw XT_DP -000795 38c4 .dw XT_SWAP -000796 3b73 .dw XT_STOREI -000797 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: -000826 3801 .dw DO_COLON - PFA_QDOCHECK: - .endif -000827 3ec9 .dw XT_2DUP -000828 3fdf .dw XT_EQUAL -000829 38b1 .dw XT_DUP -00082a 38ff .dw XT_TO_R -00082b 3836 .dw XT_DOCONDBRANCH -00082c 082e DEST(PFA_QDOCHECK1) -00082d 3ed2 .dw XT_2DROP - PFA_QDOCHECK1: -00082e 38f6 .dw XT_R_FROM -00082f 39fd .dw XT_INVERT -000830 3820 .dw XT_EXIT - .include "words/endloop.asm" - - .if cpu_msp430==1 - .endif - - .if cpu_avr8==1 - VE_ENDLOOP: -000831 ff07 .dw $ff07 -000832 6e65 -000833 6c64 -000834 6f6f -000835 0070 .db "endloop",0 -000836 081a .dw VE_HEAD - .set VE_HEAD = VE_ENDLOOP - XT_ENDLOOP: -000837 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. - -000838 079b .DW XT_LRESOLVE -000839 0844 -00083a 38b9 -00083b 3836 LOOP1: .DW XT_L_FROM,XT_QDUP,XT_DOCONDBRANCH -00083c 0840 DEST(LOOP2) -00083d 07c0 .DW XT_THEN -00083e 382f .dw XT_DOBRANCH -00083f 0839 DEST(LOOP1) -000840 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: -000841 ff02 .dw $ff02 -000842 3e6c .db "l>" -000843 0831 .dw VE_HEAD - .set VE_HEAD = VE_L_FROM - XT_L_FROM: -000844 3801 .dw DO_COLON - PFA_L_FROM: - - .endif - ;Z L> -- x L: x -- move from leave stack - ; LP @ @ -2 LP +! ; - -000845 0863 .dw XT_LP -000846 3879 .dw XT_FETCH -000847 3879 .dw XT_FETCH -000848 383d .dw XT_DOLITERAL -000849 fffe .dw -2 -00084a 0863 .dw XT_LP -00084b 3a65 .dw XT_PLUSSTORE -00084c 3820 .dw XT_EXIT - .include "words/to-l.asm" - - .if cpu_msp430==1 - .endif - - .if cpu_avr8==1 - VE_TO_L: -00084d ff02 .dw $ff02 -00084e 6c3e .db ">l" -00084f 0841 .dw VE_HEAD - .set VE_HEAD = VE_TO_L - XT_TO_L: -000850 3801 .dw DO_COLON - PFA_TO_L: - .endif - ;Z >L x -- L: -- x move to leave stack - ; CELL LP +! LP @ ! ; (L stack grows up) - -000851 3feb .dw XT_TWO -000852 0863 .dw XT_LP -000853 3a65 .dw XT_PLUSSTORE -000854 0863 .dw XT_LP -000855 3879 .dw XT_FETCH -000856 3881 .dw XT_STORE -000857 3820 .dw XT_EXIT - .include "words/lp0.asm" - - ; Stack - ; start address of leave stack - VE_LP0: -000858 ff03 .dw $ff03 -000859 706c -00085a 0030 .db "lp0",0 -00085b 084d .dw VE_HEAD - .set VE_HEAD = VE_LP0 - XT_LP0: -00085c 386f .dw PFA_DOVALUE1 - PFA_LP0: -00085d 0040 .dw CFG_LP0 -00085e 3da0 .dw XT_EDEFERFETCH -00085f 3daa .dw XT_EDEFERSTORE - .include "words/lp.asm" - - ; System Variable - ; leave stack pointer - VE_LP: -000860 ff02 .dw $ff02 -000861 706c .db "lp" -000862 0858 .dw VE_HEAD - .set VE_HEAD = VE_LP - XT_LP: -000863 3848 .dw PFA_DOVARIABLE - PFA_LP: -000864 0190 .dw ram_lp - - .dseg -000190 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: -000865 ff06 .dw $ff06 -000866 7263 -000867 6165 -000868 6574 .db "create" -000869 0860 .dw VE_HEAD - .set VE_HEAD = VE_CREATE - XT_CREATE: -00086a 3801 .dw DO_COLON - PFA_CREATE: - .endif -00086b 0739 .dw XT_DOCREATE -00086c 0899 .dw XT_REVEAL -00086d 075c .dw XT_COMPILE -00086e 3852 .dw PFA_DOCONSTANT -00086f 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: -000870 ff06 .dw $ff06 -000871 6568 -000872 6461 -000873 7265 .db "header" -000874 0865 .dw VE_HEAD - .set VE_HEAD = VE_HEADER - XT_HEADER: -000875 3801 .dw DO_COLON - PFA_HEADER: -000876 3f12 .dw XT_DP ; the new Name Field -000877 38ff .dw XT_TO_R -000878 38ff .dw XT_TO_R ; ( R: NFA WID ) -000879 38b1 .dw XT_DUP -00087a 3928 .dw XT_GREATERZERO -00087b 3836 .dw XT_DOCONDBRANCH -00087c 0887 .dw PFA_HEADER1 -00087d 38b1 .dw XT_DUP -00087e 383d .dw XT_DOLITERAL -00087f ff00 .dw $ff00 ; all flags are off (e.g. immediate) -000880 3a1c .dw XT_OR -000881 03e2 .dw XT_DOSCOMMA - ; make the link to the previous entry in this wordlist -000882 38f6 .dw XT_R_FROM -000883 3b5f .dw XT_FETCHE -000884 0767 .dw XT_COMMA -000885 38f6 .dw XT_R_FROM -000886 3820 .dw XT_EXIT - - PFA_HEADER1: - ; -16: attempt to use zero length string as a name -000887 383d .dw XT_DOLITERAL -000888 fff0 .dw -16 -000889 3d86 .dw XT_THROW - - .include "words/wlscope.asm" - - ; Compiler - ; dynamically place a word in a wordlist. The word name may be changed. - VE_WLSCOPE: -00088a ff07 .dw $ff07 -00088b 6c77 -00088c 6373 -00088d 706f -00088e 0065 .db "wlscope",0 -00088f 0870 .dw VE_HEAD - .set VE_HEAD = VE_WLSCOPE - XT_WLSCOPE: -000890 3dff .dw PFA_DODEFER1 - PFA_WLSCOPE: -000891 003c .dw CFG_WLSCOPE -000892 3da0 .dw XT_EDEFERFETCH -000893 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: -000894 ff06 .dw $ff06 -000895 6572 -000896 6576 -000897 6c61 .db "reveal" -000898 088a .dw VE_HEAD - .set VE_HEAD = VE_REVEAL - XT_REVEAL: -000899 3801 .dw DO_COLON - PFA_REVEAL: - .endif -00089a 072a -00089b 3c90 -00089c 3879 .DW XT_NEWEST,XT_CELLPLUS,XT_FETCH ; only if wordlist is in use -00089d 38b9 -00089e 3836 .DW XT_QDUP,XT_DOCONDBRANCH -00089f 08a4 DEST(REVEAL1) -0008a0 072a -0008a1 3879 -0008a2 38c4 -0008a3 3b3b .DW XT_NEWEST,XT_FETCH,XT_SWAP,XT_STOREE - ; .DW XT_ZERO,XT_NEWEST,XT_CELLPLUS,XT_STORE ; clean wordlist entry - REVEAL1: -0008a4 3820 .DW XT_EXIT - .include "words/does.asm" - - ; Compiler - ; organize the XT replacement to call other colon code - VE_DOES: -0008a5 0005 .dw $0005 -0008a6 6f64 -0008a7 7365 -0008a8 003e .db "does>",0 -0008a9 0894 .dw VE_HEAD - .set VE_HEAD = VE_DOES - XT_DOES: -0008aa 3801 .dw DO_COLON - PFA_DOES: -0008ab 075c .dw XT_COMPILE -0008ac 08bd .dw XT_DODOES -0008ad 075c .dw XT_COMPILE ; create a code snippet to be used in an embedded XT -0008ae 940e .dw $940e ; the address of this compiled -0008af 075c .dw XT_COMPILE ; code will replace the XT of the -0008b0 08b2 .dw DO_DODOES ; word that CREATE created -0008b1 3820 .dw XT_EXIT ; - - DO_DODOES: ; ( -- PFA ) -0008b2 939a -0008b3 938a savetos -0008b4 01cb movw tosl, wl -0008b5 9601 adiw tosl, 1 - ; the following takes the address from a real uC-call - .if (pclen==3) - .endif -0008b6 917f pop wh -0008b7 916f pop wl - -0008b8 93bf push XH -0008b9 93af push XL -0008ba 01db movw XL, wl -0008bb 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: -0008bd 3801 .dw DO_COLON - PFA_DODOES: -0008be 38f6 .dw XT_R_FROM -0008bf 072a .dw XT_NEWEST -0008c0 3c90 .dw XT_CELLPLUS -0008c1 3879 .dw XT_FETCH -0008c2 3b5f .dw XT_FETCHE -0008c3 0701 .dw XT_NFA2CFA -0008c4 3b73 .dw XT_STOREI -0008c5 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: -0008c6 ff01 .dw $ff01 -0008c7 003a .db ":",0 -0008c8 08a5 .dw VE_HEAD - .set VE_HEAD = VE_COLON - XT_COLON: -0008c9 3801 .dw DO_COLON - PFA_COLON: - .endif -0008ca 0739 .dw XT_DOCREATE -0008cb 08d4 .dw XT_COLONNONAME -0008cc 38d9 .dw XT_DROP -0008cd 3820 .dw XT_EXIT - .include "words/colon-noname.asm" - - ; Compiler - ; create an unnamed entry in the dictionary, XT is DO_COLON - VE_COLONNONAME: -0008ce ff07 .dw $ff07 -0008cf 6e3a -0008d0 6e6f -0008d1 6d61 -0008d2 0065 .db ":noname",0 -0008d3 08c6 .dw VE_HEAD - .set VE_HEAD = VE_COLONNONAME - XT_COLONNONAME: -0008d4 3801 .dw DO_COLON - PFA_COLONNONAME: -0008d5 3f12 .dw XT_DP -0008d6 38b1 .dw XT_DUP -0008d7 0731 .dw XT_LATEST -0008d8 3881 .dw XT_STORE - -0008d9 075c .dw XT_COMPILE -0008da 3801 .dw DO_COLON - -0008db 08e9 .dw XT_RBRACKET -0008dc 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: -0008dd 0001 .dw $0001 -0008de 003b .db $3b,0 -0008df 08ce .dw VE_HEAD - .set VE_HEAD = VE_SEMICOLON - XT_SEMICOLON: -0008e0 3801 .dw DO_COLON - PFA_SEMICOLON: - .endif -0008e1 075c .dw XT_COMPILE -0008e2 3820 .dw XT_EXIT -0008e3 08f1 .dw XT_LBRACKET -0008e4 0899 .dw XT_REVEAL -0008e5 3820 .dw XT_EXIT - .include "words/right-bracket.asm" - - ; Compiler - ; enter compiler mode - - .if cpu_msp430==1 - .endif - - .if cpu_avr8==1 - VE_RBRACKET: -0008e6 ff01 .dw $ff01 -0008e7 005d .db "]",0 -0008e8 08dd .dw VE_HEAD - .set VE_HEAD = VE_RBRACKET - XT_RBRACKET: -0008e9 3801 .dw DO_COLON - PFA_RBRACKET: - .endif -0008ea 3fe6 .dw XT_ONE -0008eb 3eb7 .dw XT_STATE -0008ec 3881 .dw XT_STORE -0008ed 3820 .dw XT_EXIT - .include "words/left-bracket.asm" - - ; Compiler - ; enter interpreter mode - - .if cpu_msp430==1 - .endif - - .if cpu_avr8==1 - VE_LBRACKET: -0008ee 0001 .dw $0001 -0008ef 005b .db "[",0 -0008f0 08e6 .dw VE_HEAD - .set VE_HEAD = VE_LBRACKET - XT_LBRACKET: -0008f1 3801 .dw DO_COLON - PFA_LBRACKET: - .endif -0008f2 3954 .dw XT_ZERO -0008f3 3eb7 .dw XT_STATE -0008f4 3881 .dw XT_STORE -0008f5 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: -0008f6 ff08 .dw $ff08 -0008f7 6176 -0008f8 6972 -0008f9 6261 -0008fa 656c .db "variable" -0008fb 08ee .dw VE_HEAD - .set VE_HEAD = VE_VARIABLE - XT_VARIABLE: -0008fc 3801 .dw DO_COLON - PFA_VARIABLE: - .endif -0008fd 3f23 .dw XT_HERE -0008fe 0908 .dw XT_CONSTANT -0008ff 3feb .dw XT_TWO -000900 3f2c .dw XT_ALLOT -000901 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: -000902 ff08 .dw $ff08 -000903 6f63 -000904 736e -000905 6174 -000906 746e .db "constant" -000907 08f6 .dw VE_HEAD - .set VE_HEAD = VE_CONSTANT - XT_CONSTANT: -000908 3801 .dw DO_COLON - PFA_CONSTANT: - .endif -000909 0739 .dw XT_DOCREATE -00090a 0899 .dw XT_REVEAL -00090b 075c .dw XT_COMPILE -00090c 3848 .dw PFA_DOVARIABLE -00090d 0767 .dw XT_COMMA -00090e 3820 .dw XT_EXIT - .include "words/user.asm" - - ; Compiler - ; create a dictionary entry for a user variable at offset n - VE_USER: -00090f ff04 .dw $ff04 -000910 7375 -000911 7265 .db "user" -000912 0902 .dw VE_HEAD - .set VE_HEAD = VE_USER - XT_USER: -000913 3801 .dw DO_COLON - PFA_USER: -000914 0739 .dw XT_DOCREATE -000915 0899 .dw XT_REVEAL - -000916 075c .dw XT_COMPILE -000917 3858 .dw PFA_DOUSER -000918 0767 .dw XT_COMMA -000919 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: -00091a 0007 .dw $0007 -00091b 6572 -00091c 7563 -00091d 7372 -00091e 0065 .db "recurse",0 -00091f 090f .dw VE_HEAD - .set VE_HEAD = VE_RECURSE - XT_RECURSE: -000920 3801 .dw DO_COLON - PFA_RECURSE: - .endif -000921 0731 .dw XT_LATEST -000922 3879 .dw XT_FETCH -000923 0767 .dw XT_COMMA -000924 3820 .dw XT_EXIT - .include "words/immediate.asm" - - ; Compiler - ; set immediate flag for the most recent word definition - VE_IMMEDIATE: -000925 ff09 .dw $ff09 -000926 6d69 -000927 656d -000928 6964 -000929 7461 -00092a 0065 .db "immediate",0 -00092b 091a .dw VE_HEAD - .set VE_HEAD = VE_IMMEDIATE - XT_IMMEDIATE: -00092c 3801 .dw DO_COLON - PFA_IMMEDIATE: -00092d 09ce .dw XT_GET_CURRENT -00092e 3b5f .dw XT_FETCHE -00092f 38b1 .dw XT_DUP -000930 3bcb .dw XT_FETCHI -000931 383d .dw XT_DOLITERAL -000932 7fff .dw $7fff -000933 3a13 .dw XT_AND -000934 38c4 .dw XT_SWAP -000935 3b73 .dw XT_STOREI -000936 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: -000937 0006 .dw $0006 -000938 635b -000939 6168 -00093a 5d72 .db "[char]" -00093b 0925 .dw VE_HEAD - .set VE_HEAD = VE_BRACKETCHAR - XT_BRACKETCHAR: -00093c 3801 .dw DO_COLON - PFA_BRACKETCHAR: - .endif -00093d 075c .dw XT_COMPILE -00093e 383d .dw XT_DOLITERAL -00093f 04f1 .dw XT_CHAR -000940 0767 .dw XT_COMMA -000941 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: -000942 0006 .dw $0006 -000943 6261 -000944 726f -000945 2274 .db "abort",'"' -000946 0937 .dw VE_HEAD - .set VE_HEAD = VE_ABORTQUOTE - XT_ABORTQUOTE: -000947 3801 .dw DO_COLON - PFA_ABORTQUOTE: - .endif -000948 3e8a .dw XT_SQUOTE -000949 075c .dw XT_COMPILE -00094a 0959 .dw XT_QABORT -00094b 3820 .DW XT_EXIT - .include "words/abort.asm" - - ; Exceptions - ; send an exception -1 - .if cpu_msp430==1 - .endif - - .if cpu_avr8==1 - VE_ABORT: -00094c ff05 .dw $ff05 -00094d 6261 -00094e 726f -00094f 0074 .db "abort",0 -000950 0942 .dw VE_HEAD - .set VE_HEAD = VE_ABORT - XT_ABORT: -000951 3801 .dw DO_COLON - PFA_ABORT: - .endif -000952 394b .dw XT_TRUE -000953 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: -000954 ff06 .dw $ff06 -000955 613f -000956 6f62 -000957 7472 .db "?abort" -000958 094c .dw VE_HEAD - .set VE_HEAD = VE_QABORT - XT_QABORT: -000959 3801 .dw DO_COLON - PFA_QABORT: - - .endif -00095a 38e1 -00095b 3836 .DW XT_ROT,XT_DOCONDBRANCH -00095c 095f DEST(QABO1) -00095d 0403 -00095e 0951 .DW XT_ITYPE,XT_ABORT -00095f 3ed2 -000960 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: -000961 ff09 .dw $ff09 -000962 6567 -000963 2d74 -000964 7473 -000965 6361 -000966 006b .db "get-stack",0 -000967 0954 .dw VE_HEAD - .set VE_HEAD = VE_GET_STACK - XT_GET_STACK: -000968 3801 .dw DO_COLON - .endif -000969 38b1 .dw XT_DUP -00096a 3c90 .dw XT_CELLPLUS -00096b 38c4 .dw XT_SWAP -00096c 3b5f .dw XT_FETCHE -00096d 38b1 .dw XT_DUP -00096e 38ff .dw XT_TO_R -00096f 3954 .dw XT_ZERO -000970 38c4 .dw XT_SWAP ; go from bigger to smaller addresses -000971 0826 .dw XT_QDOCHECK -000972 3836 .dw XT_DOCONDBRANCH -000973 097f DEST(PFA_N_FETCH_E2) -000974 3a9b .dw XT_DODO - PFA_N_FETCH_E1: - ; ( ee-addr ) -000975 3aac .dw XT_I -000976 3a35 .dw XT_1MINUS -000977 3ec4 .dw XT_CELLS ; ( -- ee-addr i*2 ) -000978 38cf .dw XT_OVER ; ( -- ee-addr i*2 ee-addr ) -000979 399d .dw XT_PLUS ; ( -- ee-addr ee-addr+i -00097a 3b5f .dw XT_FETCHE ;( -- ee-addr item_i ) -00097b 38c4 .dw XT_SWAP ;( -- item_i ee-addr ) -00097c 394b .dw XT_TRUE ; shortcut for -1 -00097d 3aba .dw XT_DOPLUSLOOP -00097e 0975 DEST(PFA_N_FETCH_E1) - PFA_N_FETCH_E2: -00097f 3ed2 .dw XT_2DROP -000980 38f6 .dw XT_R_FROM -000981 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: -000982 ff09 .dw $ff09 -000983 6573 -000984 2d74 -000985 7473 -000986 6361 -000987 006b .db "set-stack",0 -000988 0961 .dw VE_HEAD - .set VE_HEAD = VE_SET_STACK - XT_SET_STACK: -000989 3801 .dw DO_COLON - PFA_SET_STACK: - .endif -00098a 38cf .dw XT_OVER -00098b 3921 .dw XT_ZEROLESS -00098c 3836 .dw XT_DOCONDBRANCH -00098d 0991 DEST(PFA_SET_STACK0) -00098e 383d .dw XT_DOLITERAL -00098f fffc .dw -4 -000990 3d86 .dw XT_THROW - PFA_SET_STACK0: -000991 3ec9 .dw XT_2DUP -000992 3b3b .dw XT_STOREE ; ( -- i_n .. i_0 n e-addr ) -000993 38c4 .dw XT_SWAP -000994 3954 .dw XT_ZERO -000995 0826 .dw XT_QDOCHECK -000996 3836 .dw XT_DOCONDBRANCH -000997 099e DEST(PFA_SET_STACK2) -000998 3a9b .dw XT_DODO - PFA_SET_STACK1: -000999 3c90 .dw XT_CELLPLUS ; ( -- i_x e-addr ) -00099a 3eda .dw XT_TUCK ; ( -- e-addr i_x e-addr -00099b 3b3b .dw XT_STOREE -00099c 3ac9 .dw XT_DOLOOP -00099d 0999 DEST(PFA_SET_STACK1) - PFA_SET_STACK2: -00099e 38d9 .dw XT_DROP -00099f 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: -0009a0 ff09 .dw $ff09 -0009a1 616d -0009a2 2d70 -0009a3 7473 -0009a4 6361 -0009a5 006b .db "map-stack",0 -0009a6 0982 .dw VE_HEAD - .set VE_HEAD = VE_MAPSTACK - XT_MAPSTACK: -0009a7 3801 .dw DO_COLON - PFA_MAPSTACK: - .endif -0009a8 38b1 .dw XT_DUP -0009a9 3c90 .dw XT_CELLPLUS -0009aa 38c4 .dw XT_SWAP -0009ab 3b5f .dw XT_FETCHE -0009ac 3ec4 .dw XT_CELLS -0009ad 3f99 .dw XT_BOUNDS -0009ae 0826 .dw XT_QDOCHECK -0009af 3836 .dw XT_DOCONDBRANCH -0009b0 09c3 DEST(PFA_MAPSTACK3) -0009b1 3a9b .dw XT_DODO - PFA_MAPSTACK1: -0009b2 3aac .dw XT_I -0009b3 3b5f .dw XT_FETCHE ; -- i*x XT id -0009b4 38c4 .dw XT_SWAP -0009b5 38ff .dw XT_TO_R -0009b6 3908 .dw XT_R_FETCH -0009b7 382a .dw XT_EXECUTE ; i*x id -- j*y true | i*x false -0009b8 38b9 .dw XT_QDUP -0009b9 3836 .dw XT_DOCONDBRANCH -0009ba 09bf DEST(PFA_MAPSTACK2) -0009bb 38f6 .dw XT_R_FROM -0009bc 38d9 .dw XT_DROP -0009bd 3ad4 .dw XT_UNLOOP -0009be 3820 .dw XT_EXIT - PFA_MAPSTACK2: -0009bf 38f6 .dw XT_R_FROM -0009c0 3feb .dw XT_TWO -0009c1 3aba .dw XT_DOPLUSLOOP -0009c2 09b2 DEST(PFA_MAPSTACK1) - PFA_MAPSTACK3: -0009c3 38d9 .dw XT_DROP -0009c4 3954 .dw XT_ZERO -0009c5 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: -0009c6 ff0b .dw $ff0b -0009c7 6567 -0009c8 2d74 -0009c9 7563 -0009ca 7272 -0009cb 6e65 -0009cc 0074 .db "get-current",0 -0009cd 09a0 .dw VE_HEAD - .set VE_HEAD = VE_GET_CURRENT - XT_GET_CURRENT: -0009ce 3801 .dw DO_COLON - PFA_GET_CURRENT: -0009cf 383d .dw XT_DOLITERAL -0009d0 0046 .dw CFG_CURRENT -0009d1 3b5f .dw XT_FETCHE -0009d2 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: -0009d3 ff09 .dw $ff09 -0009d4 6567 -0009d5 2d74 -0009d6 726f -0009d7 6564 -0009d8 0072 .db "get-order",0 -0009d9 09c6 .dw VE_HEAD - .set VE_HEAD = VE_GET_ORDER - XT_GET_ORDER: -0009da 3801 .dw DO_COLON - PFA_GET_ORDER: - .endif -0009db 383d .dw XT_DOLITERAL -0009dc 004a .dw CFG_ORDERLISTLEN -0009dd 0968 .dw XT_GET_STACK -0009de 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: -0009df ff09 .dw $ff09 -0009e0 6663 -0009e1 2d67 -0009e2 726f -0009e3 6564 -0009e4 0072 .db "cfg-order",0 -0009e5 09d3 .dw VE_HEAD - .set VE_HEAD = VE_CFG_ORDER - XT_CFG_ORDER: -0009e6 3848 .dw PFA_DOVARIABLE - PFA_CFG_ORDER: - .endif -0009e7 004a .dw CFG_ORDERLISTLEN - .include "words/compare.asm" - - ; String - ; compares two strings in RAM - VE_COMPARE: -0009e8 ff07 .dw $ff07 -0009e9 6f63 -0009ea 706d -0009eb 7261 -0009ec 0065 .db "compare",0 -0009ed 09df .dw VE_HEAD - .set VE_HEAD = VE_COMPARE - XT_COMPARE: -0009ee 09ef .dw PFA_COMPARE - PFA_COMPARE: -0009ef 93bf push xh -0009f0 93af push xl -0009f1 018c movw temp0, tosl -0009f2 9189 -0009f3 9199 loadtos -0009f4 01dc movw xl, tosl -0009f5 9189 -0009f6 9199 loadtos -0009f7 019c movw temp2, tosl -0009f8 9189 -0009f9 9199 loadtos -0009fa 01fc movw zl, tosl - PFA_COMPARE_LOOP: -0009fb 90ed ld temp4, X+ -0009fc 90f1 ld temp5, Z+ -0009fd 14ef cp temp4, temp5 -0009fe f451 brne PFA_COMPARE_NOTEQUAL -0009ff 950a dec temp0 -000a00 f019 breq PFA_COMPARE_ENDREACHED2 -000a01 952a dec temp2 -000a02 f7c1 brne PFA_COMPARE_LOOP -000a03 c001 rjmp PFA_COMPARE_ENDREACHED - PFA_COMPARE_ENDREACHED2: -000a04 952a dec temp2 - PFA_COMPARE_ENDREACHED: -000a05 2b02 or temp0, temp2 -000a06 f411 brne PFA_COMPARE_CHECKLASTCHAR -000a07 2788 clr tosl -000a08 c002 rjmp PFA_COMPARE_DONE - PFA_COMPARE_CHECKLASTCHAR: - PFA_COMPARE_NOTEQUAL: -000a09 ef8f ser tosl -000a0a c000 rjmp PFA_COMPARE_DONE - - PFA_COMPARE_DONE: -000a0b 2f98 mov tosh, tosl -000a0c 91af pop xl -000a0d 91bf pop xh -000a0e 940c 3805 jmp_ DO_NEXT - .include "words/nfa2lfa.asm" - - ; System - ; get the link field address from the name field address - VE_NFA2LFA: -000a10 ff07 .dw $ff07 -000a11 666e -000a12 3e61 -000a13 666c -000a14 0061 .db "nfa>lfa",0 -000a15 09e8 .dw VE_HEAD - .set VE_HEAD = VE_NFA2LFA - XT_NFA2LFA: -000a16 3801 .dw DO_COLON - PFA_NFA2LFA: -000a17 06f5 .dw XT_NAME2STRING -000a18 3a2f .dw XT_1PLUS -000a19 3a04 .dw XT_2SLASH -000a1a 399d .dw XT_PLUS -000a1b 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: -000a1c ff02 .dw $ff02 -000a1d 732e .db ".s" -000a1e 0a10 .dw VE_HEAD - .set VE_HEAD = VE_DOTS - XT_DOTS: -000a1f 3801 .dw DO_COLON - PFA_DOTS: - .endif -000a20 05ed .dw XT_DEPTH -000a21 3e0a .dw XT_UDOT -000a22 3fae .dw XT_SPACE -000a23 05ed .dw XT_DEPTH -000a24 3954 .dw XT_ZERO -000a25 0826 .dw XT_QDOCHECK -000a26 3836 .dw XT_DOCONDBRANCH -000a27 0a2e DEST(PFA_DOTS2) -000a28 3a9b .dw XT_DODO - PFA_DOTS1: -000a29 3aac .dw XT_I -000a2a 3c84 .dw XT_PICK -000a2b 3e0a .dw XT_UDOT -000a2c 3ac9 .dw XT_DOLOOP -000a2d 0a29 DEST(PFA_DOTS1) - PFA_DOTS2: -000a2e 3820 .dw XT_EXIT - .include "words/spirw.asm" - - ; MCU - ; SPI exchange of 1 byte - VE_SPIRW: -000a2f ff06 .dw $ff06 -000a30 2163 -000a31 7340 -000a32 6970 .db "c!@spi" -000a33 0a1c .dw VE_HEAD - .set VE_HEAD = VE_SPIRW - XT_SPIRW: -000a34 0a35 .dw PFA_SPIRW - PFA_SPIRW: -000a35 d003 rcall do_spirw -000a36 2799 clr tosh -000a37 940c 3805 jmp_ DO_NEXT - - do_spirw: -000a39 bd8e out_ SPDR, tosl - do_spirw1: -000a3a b50d in_ temp0, SPSR -000a3b 7f08 cbr temp0,7 -000a3c bd0d out_ SPSR, temp0 -000a3d b50d in_ temp0, SPSR -000a3e ff07 sbrs temp0, 7 -000a3f cffa rjmp do_spirw1 ; wait until complete -000a40 b58e in_ tosl, SPDR -000a41 9508 ret - .include "words/n-spi.asm" - - ; MCU - ; read len bytes from SPI to addr - VE_N_SPIR: -000a42 ff05 .dw $ff05 -000a43 406e -000a44 7073 -000a45 0069 .db "n@spi",0 -000a46 0a2f .dw VE_HEAD - .set VE_HEAD = VE_N_SPIR - XT_N_SPIR: -000a47 0a48 .dw PFA_N_SPIR - PFA_N_SPIR: -000a48 018c movw temp0, tosl -000a49 9189 -000a4a 9199 loadtos -000a4b 01fc movw zl, tosl -000a4c 01c8 movw tosl, temp0 - PFA_N_SPIR_LOOP: -000a4d bc2e out_ SPDR, zerol - PFA_N_SPIR_LOOP1: -000a4e b52d in_ temp2, SPSR -000a4f ff27 sbrs temp2, SPIF -000a50 cffd rjmp PFA_N_SPIR_LOOP1 -000a51 b52e in_ temp2, SPDR -000a52 9321 st Z+, temp2 -000a53 9701 sbiw tosl, 1 -000a54 f7c1 brne PFA_N_SPIR_LOOP -000a55 9189 -000a56 9199 loadtos -000a57 940c 3805 jmp_ DO_NEXT - - ; ( addr len -- ) - ; MCU - ; write len bytes to SPI from addr - VE_N_SPIW: -000a59 ff05 .dw $ff05 -000a5a 216e -000a5b 7073 -000a5c 0069 .db "n!spi",0 -000a5d 0a42 .dw VE_HEAD - .set VE_HEAD = VE_N_SPIW - XT_N_SPIW: -000a5e 0a5f .dw PFA_N_SPIW - PFA_N_SPIW: -000a5f 018c movw temp0, tosl -000a60 9189 -000a61 9199 loadtos -000a62 01fc movw zl, tosl -000a63 01c8 movw tosl, temp0 - PFA_N_SPIW_LOOP: -000a64 9121 ld temp2, Z+ -000a65 bd2e out_ SPDR, temp2 - PFA_N_SPIW_LOOP1: -000a66 b52d in_ temp2, SPSR -000a67 ff27 sbrs temp2, SPIF -000a68 cffd rjmp PFA_N_SPIW_LOOP1 -000a69 b52e in_ temp2, SPDR ; ignore the data -000a6a 9701 sbiw tosl, 1 -000a6b f7c1 brne PFA_N_SPIW_LOOP -000a6c 9189 -000a6d 9199 loadtos -000a6e 940c 3805 jmp_ DO_NEXT - .include "words/applturnkey.asm" - - ; R( -- ) - ; application specific turnkey action - VE_APPLTURNKEY: -000a70 ff0b .dw $ff0b -000a71 7061 -000a72 6c70 -000a73 7574 -000a74 6e72 -000a75 656b -000a76 0079 .db "applturnkey",0 -000a77 0a59 .dw VE_HEAD - .set VE_HEAD = VE_APPLTURNKEY - XT_APPLTURNKEY: -000a78 3801 .dw DO_COLON - PFA_APPLTURNKEY: -000a79 00c7 .dw XT_USART - - .if WANT_INTERRUPTS == 1 -000a7a 3c97 .dw XT_INTON - .endif -000a7b 018a .dw XT_DOT_VER -000a7c 3fae .dw XT_SPACE -000a7d 3eac .dw XT_F_CPU -000a7e 383d .dw XT_DOLITERAL -000a7f 03e8 .dw 1000 -000a80 39c2 .dw XT_UMSLASHMOD -000a81 38f0 .dw XT_NIP -000a82 3f41 .dw XT_DECIMAL -000a83 0385 .dw XT_DOT -000a84 03d0 .dw XT_DOSLITERAL -000a85 0004 .dw 4 -000a86 486b -000a87 207a .db "kHz " -000a88 0403 .dw XT_ITYPE -000a89 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: -000a8a ff0b .dw $ff0b -000a8b 6573 -000a8c 2d74 -000a8d 7563 -000a8e 7272 -000a8f 6e65 -000a90 0074 .db "set-current",0 -000a91 0a70 .dw VE_HEAD - .set VE_HEAD = VE_SET_CURRENT - XT_SET_CURRENT: -000a92 3801 .dw DO_COLON - PFA_SET_CURRENT: -000a93 383d .dw XT_DOLITERAL -000a94 0046 .dw CFG_CURRENT -000a95 3b3b .dw XT_STOREE -000a96 3820 .dw XT_EXIT - .include "words/wordlist.asm" - - ; Search Order - ; create a new, empty wordlist - VE_WORDLIST: -000a97 ff08 .dw $ff08 -000a98 6f77 -000a99 6472 -000a9a 696c -000a9b 7473 .db "wordlist" -000a9c 0a8a .dw VE_HEAD - .set VE_HEAD = VE_WORDLIST - XT_WORDLIST: -000a9d 3801 .dw DO_COLON - PFA_WORDLIST: -000a9e 3f1b .dw XT_EHERE -000a9f 3954 .dw XT_ZERO -000aa0 38cf .dw XT_OVER -000aa1 3b3b .dw XT_STOREE -000aa2 38b1 .dw XT_DUP -000aa3 3c90 .dw XT_CELLPLUS -000aa4 01bf .dw XT_DOTO -000aa5 3f1c .dw PFA_EHERE -000aa6 3820 .dw XT_EXIT - - .include "words/forth-wordlist.asm" - - ; Search Order - ; get the system default word list - VE_FORTHWORDLIST: -000aa7 ff0e .dw $ff0e -000aa8 6f66 -000aa9 7472 -000aaa 2d68 -000aab 6f77 -000aac 6472 -000aad 696c -000aae 7473 .db "forth-wordlist" -000aaf 0a97 .dw VE_HEAD - .set VE_HEAD = VE_FORTHWORDLIST - XT_FORTHWORDLIST: -000ab0 3848 .dw PFA_DOVARIABLE - PFA_FORTHWORDLIST: -000ab1 0048 .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: -000ab2 ff09 .dw $ff09 -000ab3 6573 -000ab4 2d74 -000ab5 726f -000ab6 6564 -000ab7 0072 .db "set-order",0 -000ab8 0aa7 .dw VE_HEAD - .set VE_HEAD = VE_SET_ORDER - XT_SET_ORDER: -000ab9 3801 .dw DO_COLON - PFA_SET_ORDER: - .endif -000aba 383d .dw XT_DOLITERAL -000abb 004a .dw CFG_ORDERLISTLEN -000abc 0989 .dw XT_SET_STACK -000abd 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: -000abe ff0f .dw $ff0f -000abf 6573 -000ac0 2d74 -000ac1 6572 -000ac2 6f63 -000ac3 6e67 -000ac4 7a69 -000ac5 7265 -000ac6 0073 .db "set-recognizers",0 -000ac7 0ab2 .dw VE_HEAD - .set VE_HEAD = VE_SET_RECOGNIZERS - XT_SET_RECOGNIZERS: -000ac8 3801 .dw DO_COLON - PFA_SET_RECOGNIZERS: - .endif -000ac9 383d .dw XT_DOLITERAL -000aca 005c .dw CFG_RECOGNIZERLISTLEN -000acb 0989 .dw XT_SET_STACK -000acc 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: -000acd ff0f .dw $ff0f -000ace 6567 -000acf 2d74 -000ad0 6572 -000ad1 6f63 -000ad2 6e67 -000ad3 7a69 -000ad4 7265 -000ad5 0073 .db "get-recognizers",0 -000ad6 0abe .dw VE_HEAD - .set VE_HEAD = VE_GET_RECOGNIZERS - XT_GET_RECOGNIZERS: -000ad7 3801 .dw DO_COLON - PFA_GET_RECOGNIZERS: - .endif -000ad8 383d .dw XT_DOLITERAL -000ad9 005c .dw CFG_RECOGNIZERLISTLEN -000ada 0968 .dw XT_GET_STACK -000adb 3820 .dw XT_EXIT - .include "words/code.asm" - - ; Compiler - ; create named entry in the dictionary, XT is the data field - VE_CODE: -000adc ff04 .dw $ff04 -000add 6f63 -000ade 6564 .db "code" -000adf 0acd .dw VE_HEAD - .set VE_HEAD = VE_CODE - XT_CODE: -000ae0 3801 .dw DO_COLON - PFA_CODE: -000ae1 0739 .dw XT_DOCREATE -000ae2 0899 .dw XT_REVEAL -000ae3 3f12 .dw XT_DP -000ae4 01d1 .dw XT_ICELLPLUS -000ae5 0767 .dw XT_COMMA -000ae6 3820 .dw XT_EXIT - .include "words/end-code.asm" - - ; Compiler - ; finish a code definition - VE_ENDCODE: -000ae7 ff08 .dw $ff08 -000ae8 6e65 -000ae9 2d64 -000aea 6f63 -000aeb 6564 .db "end-code" -000aec 0adc .dw VE_HEAD - .set VE_HEAD = VE_ENDCODE - XT_ENDCODE: -000aed 3801 .dw DO_COLON - PFA_ENDCODE: -000aee 075c .dw XT_COMPILE -000aef 940c .dw $940c -000af0 075c .dw XT_COMPILE -000af1 3805 .dw DO_NEXT -000af2 3820 .dw XT_EXIT - .include "words/marker.asm" - - ; System Value - ; The eeprom address until which MARKER saves and restores the eeprom data. - VE_MARKER: -000af3 ff08 .dw $ff08 -000af4 6d28 -000af5 7261 -000af6 656b -000af7 2972 .db "(marker)" -000af8 0ae7 .dw VE_HEAD - .set VE_HEAD = VE_MARKER - XT_MARKER: -000af9 386f .dw PFA_DOVALUE1 - PFA_MARKER: -000afa 0068 .dw EE_MARKER -000afb 3da0 .dw XT_EDEFERFETCH -000afc 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: -000afd 0008 .dw $0008 -000afe 6f70 -000aff 7473 -000b00 6f70 -000b01 656e .db "postpone" -000b02 0af3 .dw VE_HEAD - .set VE_HEAD = VE_POSTPONE - XT_POSTPONE: -000b03 3801 .dw DO_COLON - PFA_POSTPONE: - .endif -000b04 05bb .dw XT_PARSENAME -000b05 05fe .dw XT_FORTHRECOGNIZER -000b06 0609 .dw XT_RECOGNIZE -000b07 38b1 .dw XT_DUP -000b08 38ff .dw XT_TO_R -000b09 01d1 .dw XT_ICELLPLUS -000b0a 01d1 .dw XT_ICELLPLUS -000b0b 3bcb .dw XT_FETCHI -000b0c 382a .dw XT_EXECUTE -000b0d 38f6 .dw XT_R_FROM -000b0e 01d1 .dw XT_ICELLPLUS -000b0f 3bcb .dw XT_FETCHI -000b10 0767 .dw XT_COMMA -000b11 3820 .dw XT_EXIT - .endif - .include "words/2r_fetch.asm" - - ; Stack - ; fetch content of TOR - VE_2R_FETCH: -000b12 ff03 .dw $ff03 -000b13 7232 -000b14 0040 .db "2r@",0 -000b15 0afd .dw VE_HEAD - .set VE_HEAD = VE_2R_FETCH - XT_2R_FETCH: -000b16 0b17 .dw PFA_2R_FETCH - PFA_2R_FETCH: -000b17 939a -000b18 938a savetos -000b19 91ef pop zl -000b1a 91ff pop zh -000b1b 918f pop tosl -000b1c 919f pop tosh -000b1d 939f push tosh -000b1e 938f push tosl -000b1f 93ff push zh -000b20 93ef push zl -000b21 939a -000b22 938a savetos -000b23 01cf movw tosl, zl -000b24 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 0b12 .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 0739 .dw XT_DOCREATE -00386b 0899 .dw XT_REVEAL -00386c 075c .dw XT_COMPILE -00386d 386f .dw PFA_DOVALUE1 -00386e 3820 .dw XT_EXIT - PFA_DOVALUE1: -00386f 940e 08b2 call_ DO_DODOES -003871 38b1 .dw XT_DUP -003872 01d1 .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 eae0 -003b16 e0ff -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 b500 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 b500 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 99f9 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 bdf2 out_ EEARH,zh -003b57 bde1 out_ EEARL,zl -003b58 bd80 out_ EEDR, tosl -003b59 9afa sbi EECR,EEMPE -003b5a 9af9 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 b580 in_ tosl, EEDR - -003b65 9631 adiw zl,1 - -003b66 d003 rcall PFA_FETCHE2 -003b67 b590 in_ tosh, EEDR -003b68 bf2f out_ SREG, temp2 -003b69 cc9b jmp_ DO_NEXT - - PFA_FETCHE2: -003b6a 99f9 sbic EECR, EEPE -003b6b cffe rjmp PFA_FETCHE2 - -003b6c bdf2 out_ EEARH,zh -003b6d bde1 out_ EEARL,zl - -003b6e 9af8 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 0066 .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 03d0 .dw XT_DOSLITERAL -003ccb 0003 .dw 3 -003ccc 6f20 -003ccd 006b .db " ok",0 - .endif -003cce 0403 .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 03d0 .dw XT_DOSLITERAL -003cda 0002 .dw 2 -003cdb 203e .db "> " - .endif -003cdc 3fa1 .dw XT_CR -003cdd 0403 .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 03d0 .dw XT_DOSLITERAL -003cea 0004 .dw 4 -003ceb 3f20 -003cec 203f .db " ?? " - .endif -003ced 0403 .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 0385 .dw XT_DOT -003cf3 3ee2 .dw XT_TO_IN -003cf4 3879 .dw XT_FETCH -003cf5 0385 .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 085c -003d09 0863 -003d0a 3881 .dw XT_LP0,XT_LP,XT_STORE -003d0b 05d5 .dw XT_SP0 -003d0c 3a96 .dw XT_SP_STORE -003d0d 05e2 .dw XT_RP0 -003d0e 3a80 .dw XT_RP_STORE -003d0f 08f1 .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 04e9 .dw XT_REFILL -003d17 3836 .dw XT_DOCONDBRANCH -003d18 3d28 DEST(PFA_QUIT3) -003d19 383d .dw XT_DOLITERAL -003d1a 0630 .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 0192 .dw ram_pause -003d32 3db4 .dw XT_RDEFERFETCH -003d33 3dbe .dw XT_RDEFERSTORE - - .dseg -000192 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 e0e0 ldi zl, low(ramstart) -003d3f e0f1 ldi zh, high(ramstart) - clearloop: -003d40 9221 st Z+, zerol -003d41 30e0 cpi zl, low(sram_size+ramstart) -003d42 f7e9 brne clearloop -003d43 30f9 cpi zh, high(sram_size+ramstart) -003d44 f7d9 brne clearloop - ; init first user data area - ; allocate space for User Area - .dseg -000194 ram_user1: .byte SYSUSERSIZE + APPUSERSIZE - .cseg -003d45 e9e4 ldi zl, low(ram_user1) -003d46 e0f1 ldi zh, high(ram_user1) -003d47 012f movw upl, zl - ; init return stack pointer -003d48 ef0f 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 eacf 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 02a2 .dw XT_INIT_RAM -003d5b 383d .dw XT_DOLITERAL -003d5c 01a5 .dw XT_NOOP -003d5d 383d .dw XT_DOLITERAL -003d5e 3d30 .dw XT_PAUSE -003d5f 3ddf .dw XT_DEFERSTORE -003d60 08f1 .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 01d1 .dw XT_ICELLPLUS -003de3 01d1 .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 01d1 .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 0739 .dw XT_DOCREATE -003dfb 0899 .dw XT_REVEAL -003dfc 075c .dw XT_COMPILE -003dfd 3dff .dw PFA_DODEFER1 -003dfe 3820 .dw XT_EXIT - PFA_DODEFER1: -003dff 940e 08b2 call_ DO_DODOES -003e01 38b1 .dw XT_DUP -003e02 01d1 .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 038d .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 0396 .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 06da .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 06f5 .dw XT_NAME2STRING -003e70 0403 .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 004c .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 075c .dw XT_COMPILE -003e85 0403 .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 058e .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 0788 .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 2400 .dw (F_CPU % 65536) -003eaf 383d .dw XT_DOLITERAL -003eb0 00f4 .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 01c0 .dw ram_state - - .dseg -0001c0 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 0036 .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 003a .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 0038 .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 01bf .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 0042 .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 05ed .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 077d .dw XT_LITERAL -003fda 077d .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" -000034 ff ff - ; some configs -000036 26 0b CFG_DP: .dw DPSTART ; Dictionary Pointer -000038 c2 01 EE_HERE: .dw HERESTART ; Memory Allocation -00003a 8e 00 EE_EHERE: .dw EHERESTART ; EEProm Memory Allocation -00003c ce 09 CFG_WLSCOPE: .dw XT_GET_CURRENT ; default wordlist scope -00003e 5c 00 CFG_FORTHRECOGNIZER: .dw CFG_RECOGNIZERLISTLEN ; Recognizer word set - ; LEAVE stack is between data stack and return stack. -000040 b0 08 CFG_LP0: .dw stackstart+1 -000042 78 0a CFG_TURNKEY: .dw XT_APPLTURNKEY ; TURNKEY -000044 ff 02 CFG_ENVIRONMENT:.dw VE_ENVHEAD ; environmental queries -000046 48 00 CFG_CURRENT: .dw CFG_FORTHWORDLIST ; forth-wordlist -000048 ed 3f CFG_FORTHWORDLIST:.dw VE_HEAD ; pre-defined (compiled in) wordlist - CFG_ORDERLISTLEN: -00004a 01 00 .dw 1 - CFG_ORDERLIST: ; list of wordlist id, exactly numwordlist entries -00004c 48 00 .dw CFG_FORTHWORDLIST ; get/set-order -00004e .byte (NUMWORDLISTS-1)*CELLSIZE ; one slot is already used - CFG_RECOGNIZERLISTLEN: -00005c 02 00 .dw 2 - CFG_RECOGNIZERLIST: -00005e 70 06 .dw XT_REC_FIND -000060 5c 06 .dw XT_REC_NUM -000062 .byte (NUMRECOGNIZERS-2)*CELLSIZE ; two slots are already used - - EE_STOREI: -000066 7e 3b .dw XT_DO_STOREI ; Store a cell into flash - - ; MARKER saves everything up to here. Nothing beyond gets saved - EE_MARKER: -000068 68 00 .dw EE_MARKER - - ; default user area - EE_INITUSER: -00006a 00 00 .dw 0 ; USER_STATE -00006c 00 00 .dw 0 ; USER_FOLLOWER -00006e ff 08 .dw rstackstart ; USER_RP -000070 af 08 .dw stackstart ; USER_SP0 -000072 af 08 .dw stackstart ; USER_SP - -000074 00 00 .dw 0 ; USER_HANDLER -000076 0a 00 .dw 10 ; USER_BASE - -000078 a3 00 .dw XT_TX ; USER_EMIT -00007a b1 00 .dw XT_TXQ ; USER_EMITQ -00007c 78 00 .dw XT_RX ; USER_KEY -00007e 93 00 .dw XT_RXQ ; USER_KEYQ -000080 77 02 .dw XT_SOURCETIB ; USER_SOURCE -000082 00 00 .dw 0 ; USER_G_IN -000084 64 02 .dw XT_REFILLTIB ; USER_REFILL -000086 c9 3c .dw XT_DEFAULT_PROMPTOK -000088 e8 3c .dw XT_DEFAULT_PROMPTERROR -00008a 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: -00008c 19 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 - -"ATmega328P" 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%) - -"ATmega328P" 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 : 39 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%) - -"ATmega328P" memory use summary [bytes]: -Segment Begin End Code Data Used Size Use% ---------------------------------------------------------------- -[.cseg] 0x000000 0x007fe4 2082 11710 13792 32768 42.1% -[.dseg] 0x000100 0x0001c2 0 194 194 2048 9.5% -[.eseg] 0x000000 0x00008e 0 142 142 1024 13.9% - -Assembly complete, 0 errors, 8 warnings -- cgit v1.2.3