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