AVRASM ver. 2.1.52 atmega256.asm Sun Apr 30 20:10:15 2017 atmega256.asm(11): 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/atmega2561\device.asm' ../../avr8/devices/atmega2561\device.asm(5): Including file '../../avr8/Atmel/Appnotes2\m2561def.inc' atmega256.asm(15): Including file '../../avr8\drivers/usart_1.asm' ../../avr8\drivers/usart_1.asm(31): 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' atmega256.asm(18): Including file '../../avr8\amforth-low.asm' ../../avr8\amforth-low.asm(11): Including file '../../avr8\amforth-interpreter.asm' ../../avr8\amforth-low.asm(12): Including file '../../avr8\drivers/generic-isr.asm' ../../avr8\amforth-low.asm(15): 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(9): Including file '../../avr8\dict/appl_8k.inc' ../../avr8\dict/appl_8k.inc(1): 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-low.asm(16): Including file 'dict_appl.inc' dict_appl.inc(4): Including file 'words/applturnkey.asm' ../../avr8\amforth-low.asm(17): 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(95): Including file '../../avr8\words/store-i_big.asm' ../../avr8\dict/nrww.inc(99): Including file '../../avr8\words/fetch-i.asm' ../../avr8\dict/nrww.inc(102): Including file '../../avr8\dict/core_8k.inc' ../../avr8\dict/core_8k.inc(2): Including file '../../avr8\words/n_to_r.asm' ../../avr8\dict/core_8k.inc(3): Including file '../../avr8\words/n_r_from.asm' ../../avr8\dict/core_8k.inc(5): Including file '../../avr8\words/d-2star.asm' ../../avr8\dict/core_8k.inc(6): Including file '../../avr8\words/d-2slash.asm' ../../avr8\dict/core_8k.inc(7): Including file '../../avr8\words/d-plus.asm' ../../avr8\dict/core_8k.inc(8): Including file '../../avr8\words/d-minus.asm' ../../avr8\dict/core_8k.inc(9): Including file '../../avr8\words/d-invert.asm' ../../avr8\dict/core_8k.inc(10): Including file '../../common\words/u-dot.asm' ../../avr8\dict/core_8k.inc(11): Including file '../../common\words/u-dot-r.asm' ../../avr8\dict/core_8k.inc(13): Including file '../../common\words/show-wordlist.asm' ../../avr8\dict/core_8k.inc(14): Including file '../../common\words/words.asm' ../../avr8\dict/core_8k.inc(15): 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_8k.inc(17): Including file '../../common\words/pick.asm' ../../avr8\dict/core_8k.inc(18): Including file '../../common\words/dot-quote.asm' ../../avr8\dict/core_8k.inc(19): Including file '../../common\words/squote.asm' ../../avr8\dict/core_8k.inc(21): Including file '../../avr8\words/fill.asm' ../../avr8\dict/core_8k.inc(23): Including file '../../avr8\words/environment.asm' ../../avr8\dict/core_8k.inc(24): Including file '../../avr8\words/env-wordlists.asm' ../../avr8\dict/core_8k.inc(25): Including file '../../avr8\words/env-slashpad.asm' ../../avr8\dict/core_8k.inc(26): Including file '../../common\words/env-slashhold.asm' ../../avr8\dict/core_8k.inc(27): Including file '../../common\words/env-forthname.asm' ../../avr8\dict/core_8k.inc(28): Including file '../../common\words/env-forthversion.asm' ../../avr8\dict/core_8k.inc(29): Including file '../../common\words/env-cpu.asm' ../../avr8\dict/core_8k.inc(30): Including file '../../avr8\words/env-mcuinfo.asm' ../../avr8\dict/core_8k.inc(31): Including file '../../common\words/env-usersize.asm' ../../avr8\dict/core_8k.inc(33): Including file '../../common\words/f_cpu.asm' ../../avr8\dict/core_8k.inc(34): Including file '../../avr8\words/state.asm' ../../avr8\dict/core_8k.inc(35): Including file '../../common\words/base.asm' ../../avr8\dict/core_8k.inc(37): Including file '../../avr8\words/cells.asm' ../../avr8\dict/core_8k.inc(38): Including file '../../avr8\words/cellplus.asm' ../../avr8\dict/core_8k.inc(40): Including file '../../common\words/2dup.asm' ../../avr8\dict/core_8k.inc(41): Including file '../../common\words/2drop.asm' ../../avr8\dict/core_8k.inc(43): Including file '../../common\words/tuck.asm' ../../avr8\dict/core_8k.inc(45): Including file '../../common\words/to-in.asm' ../../avr8\dict/core_8k.inc(46): Including file '../../common\words/pad.asm' ../../avr8\dict/core_8k.inc(47): Including file '../../common\words/emit.asm' ../../avr8\dict/core_8k.inc(48): Including file '../../common\words/emitq.asm' ../../avr8\dict/core_8k.inc(49): Including file '../../common\words/key.asm' ../../avr8\dict/core_8k.inc(50): Including file '../../common\words/keyq.asm' ../../avr8\dict/core_8k.inc(52): Including file '../../avr8\words/dp.asm' ../../avr8\dict/core_8k.inc(53): Including file '../../avr8\words/ehere.asm' ../../avr8\dict/core_8k.inc(54): Including file '../../avr8\words/here.asm' ../../avr8\dict/core_8k.inc(55): Including file '../../avr8\words/allot.asm' ../../avr8\dict/core_8k.inc(57): Including file '../../common\words/bin.asm' ../../avr8\dict/core_8k.inc(58): Including file '../../common\words/decimal.asm' ../../avr8\dict/core_8k.inc(59): Including file '../../common\words/hex.asm' ../../avr8\dict/core_8k.inc(60): Including file '../../common\words/bl.asm' ../../avr8\dict/core_8k.inc(62): Including file '../../avr8\words/turnkey.asm' ../../avr8\dict/core_8k.inc(64): Including file '../../avr8\words/slashmod.asm' ../../avr8\dict/core_8k.inc(65): Including file '../../avr8\words/uslashmod.asm' ../../avr8\dict/core_8k.inc(66): Including file '../../avr8\words/negate.asm' ../../avr8\dict/core_8k.inc(67): Including file '../../common\words/slash.asm' ../../avr8\dict/core_8k.inc(68): Including file '../../common\words/mod.asm' ../../avr8\dict/core_8k.inc(69): Including file '../../common\words/abs.asm' ../../avr8\dict/core_8k.inc(70): Including file '../../common\words/min.asm' ../../avr8\dict/core_8k.inc(71): Including file '../../common\words/max.asm' ../../avr8\dict/core_8k.inc(72): Including file '../../common\words/within.asm' ../../avr8\dict/core_8k.inc(74): Including file '../../common\words/to-upper.asm' ../../avr8\dict/core_8k.inc(75): Including file '../../common\words/to-lower.asm' ../../avr8\dict/core_8k.inc(77): Including file '../../avr8\words/hld.asm' ../../avr8\dict/core_8k.inc(78): Including file '../../common\words/hold.asm' ../../avr8\dict/core_8k.inc(79): Including file '../../common\words/less-sharp.asm' ../../avr8\dict/core_8k.inc(80): Including file '../../common\words/sharp.asm' ../../avr8\dict/core_8k.inc(81): Including file '../../common\words/sharp-s.asm' ../../avr8\dict/core_8k.inc(82): Including file '../../common\words/sharp-greater.asm' ../../avr8\dict/core_8k.inc(83): Including file '../../common\words/sign.asm' ../../avr8\dict/core_8k.inc(84): Including file '../../common\words/d-dot-r.asm' ../../avr8\dict/core_8k.inc(85): Including file '../../common\words/dot-r.asm' ../../avr8\dict/core_8k.inc(86): Including file '../../common\words/d-dot.asm' ../../avr8\dict/core_8k.inc(87): Including file '../../common\words/dot.asm' ../../avr8\dict/core_8k.inc(88): Including file '../../common\words/ud-dot.asm' ../../avr8\dict/core_8k.inc(89): Including file '../../common\words/ud-dot-r.asm' ../../avr8\dict/core_8k.inc(90): Including file '../../common\words/ud-slash-mod.asm' ../../avr8\dict/core_8k.inc(91): Including file '../../common\words/digit-q.asm' ../../avr8\dict/core_8k.inc(93): Including file '../../avr8\words/do-sliteral.asm' ../../avr8\dict/core_8k.inc(94): Including file '../../avr8\words/scomma.asm' ../../avr8\dict/core_8k.inc(95): Including file '../../avr8\words/itype.asm' ../../avr8\dict/core_8k.inc(96): Including file '../../avr8\words/icount.asm' ../../avr8\dict/core_8k.inc(97): Including file '../../common\words/cr.asm' ../../avr8\dict/core_8k.inc(98): Including file '../../common\words/space.asm' ../../avr8\dict/core_8k.inc(99): Including file '../../common\words/spaces.asm' ../../avr8\dict/core_8k.inc(100): Including file '../../common\words/type.asm' ../../avr8\dict/core_8k.inc(101): Including file '../../common\words/tick.asm' ../../avr8\dict/core_8k.inc(103): Including file '../../common\words/handler.asm' ../../avr8\dict/core_8k.inc(104): Including file '../../common\words/catch.asm' ../../avr8\dict/core_8k.inc(105): Including file '../../common\words/throw.asm' ../../avr8\dict/core_8k.inc(107): Including file '../../common\words/cskip.asm' ../../avr8\dict/core_8k.inc(108): Including file '../../common\words/cscan.asm' ../../avr8\dict/core_8k.inc(109): Including file '../../common\words/accept.asm' ../../avr8\dict/core_8k.inc(110): Including file '../../common\words/refill.asm' ../../avr8\dict/core_8k.inc(111): Including file '../../common\words/char.asm' ../../avr8\dict/core_8k.inc(112): Including file '../../common\words/number.asm' ../../avr8\dict/core_8k.inc(113): Including file '../../common\words/q-sign.asm' ../../avr8\dict/core_8k.inc(114): Including file '../../common\words/set-base.asm' ../../avr8\dict/core_8k.inc(115): Including file '../../common\words/to-number.asm' ../../avr8\dict/core_8k.inc(116): Including file '../../common\words/parse.asm' ../../avr8\dict/core_8k.inc(117): Including file '../../common\words/source.asm' ../../avr8\dict/core_8k.inc(118): Including file '../../common\words/slash-string.asm' ../../avr8\dict/core_8k.inc(119): Including file '../../common\words/parse-name.asm' ../../avr8\dict/core_8k.inc(120): Including file '../../common\words/find-xt.asm' ../../avr8\dict/core_8k.inc(122): Including file '../../common\words/prompt-ok.asm' ../../avr8\dict/core_8k.inc(123): Including file '../../common\words/prompt-ready.asm' ../../avr8\dict/core_8k.inc(124): Including file '../../common\words/prompt-error.asm' ../../avr8\dict/core_8k.inc(126): Including file '../../common\words/quit.asm' ../../avr8\dict/core_8k.inc(127): Including file '../../avr8\words/pause.asm' ../../avr8\dict/core_8k.inc(128): Including file '../../avr8\words/cold.asm' ../../avr8\dict/core_8k.inc(129): Including file '../../common\words/warm.asm' ../../avr8\dict/core_8k.inc(131): Including file '../../avr8\words/sp0.asm' ../../avr8\dict/core_8k.inc(132): Including file '../../avr8\words/rp0.asm' ../../avr8\dict/core_8k.inc(133): Including file '../../common\words/depth.asm' ../../avr8\dict/core_8k.inc(134): Including file '../../common\words/interpret.asm' ../../avr8\dict/core_8k.inc(135): Including file '../../avr8\words/forth-recognizer.asm' ../../avr8\dict/core_8k.inc(136): Including file '../../common\words/recognize.asm' ../../avr8\dict/core_8k.inc(137): Including file '../../common\words/rec-intnum.asm' ../../avr8\dict/core_8k.inc(138): Including file '../../common\words/rec-find.asm' ../../avr8\dict/core_8k.inc(139): Including file '../../common\words/dt-null.asm' ../../avr8\dict/core_8k.inc(141): Including file '../../common\words/q-stack.asm' ../../avr8\dict/core_8k.inc(142): Including file '../../common\words/ver.asm' ../../avr8\dict/core_8k.inc(144): Including file '../../common\words/noop.asm' ../../avr8\dict/core_8k.inc(145): Including file '../../avr8\words/unused.asm' ../../avr8\dict/core_8k.inc(147): Including file '../../common\words/to.asm' ../../avr8\dict/core_8k.inc(148): Including file '../../avr8\words/i-cellplus.asm' ../../avr8\dict/core_8k.inc(150): Including file '../../avr8\words/edefer-fetch.asm' ../../avr8\dict/core_8k.inc(151): Including file '../../avr8\words/edefer-store.asm' ../../avr8\dict/core_8k.inc(152): Including file '../../common\words/rdefer-fetch.asm' ../../avr8\dict/core_8k.inc(153): Including file '../../common\words/rdefer-store.asm' ../../avr8\dict/core_8k.inc(154): Including file '../../common\words/udefer-fetch.asm' ../../avr8\dict/core_8k.inc(155): Including file '../../common\words/udefer-store.asm' ../../avr8\dict/core_8k.inc(156): Including file '../../common\words/defer-store.asm' ../../avr8\dict/core_8k.inc(157): Including file '../../common\words/defer-fetch.asm' ../../avr8\dict/core_8k.inc(158): Including file '../../avr8\words/do-defer.asm' ../../avr8\dict/core_8k.inc(160): Including file '../../common\words/search-wordlist.asm' ../../avr8\dict/core_8k.inc(161): Including file '../../common\words/traverse-wordlist.asm' ../../avr8\dict/core_8k.inc(162): Including file '../../common\words/name2string.asm' ../../avr8\dict/core_8k.inc(163): Including file '../../avr8\words/nfa2cfa.asm' ../../avr8\dict/core_8k.inc(164): Including file '../../avr8\words/icompare.asm' ../../avr8\dict/core_8k.inc(166): Including file '../../common\words/star.asm' ../../avr8\dict/core_8k.inc(167): Including file '../../avr8\words/j.asm' ../../avr8\dict/core_8k.inc(169): Including file '../../avr8\words/dabs.asm' ../../avr8\dict/core_8k.inc(170): Including file '../../avr8\words/dnegate.asm' ../../avr8\dict/core_8k.inc(171): Including file '../../avr8\words/cmove.asm' ../../avr8\dict/core_8k.inc(172): Including file '../../common\words/2swap.asm' ../../avr8\dict/core_8k.inc(174): Including file '../../common\words/tib.asm' ../../avr8\dict/core_8k.inc(176): Including file '../../avr8\words/init-ram.asm' ../../avr8\dict/core_8k.inc(177): 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' ../../avr8\dict/core_8k.inc(178): Including file '../../common\words/bounds.asm' ../../avr8\dict/core_8k.inc(179): Including file '../../common\words/s-to-d.asm' ../../avr8\dict/core_8k.inc(180): 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-low.asm(18): Including file 'dict_appl_core.inc' ../../avr8\amforth-low.asm(27): Including file '../../avr8\amforth-eeprom.inc' ; both a 24bit address space and they need a special ; flash store placement in the NRWW section, way outside ; of the standard 16bit jump distance. ; note that dict_appl_core includes a store-i_big.asm ; instead if the normal store-i.asm file. This file ; has all the magic needed for the large address space. ; *everything else* is identical to other controllers. .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 = 512 .equ CELLSIZE = 2 .macro readflashcell clr temp7 lsl zl rol zh rol temp7 out_ RAMPZ, temp7 elpm @0, Z+ elpm @1, Z+ .endmacro .macro writeflashcell clr temp7 lsl zl rol zh rol temp7 out_ RAMPZ, temp7 .endmacro .set WANT_ANALOG_COMPARATOR = 0 .set WANT_USART0 = 0 .set WANT_TWI = 0 .set WANT_SPI = 0 .set WANT_PORTA = 0 .set WANT_PORTB = 0 .set WANT_PORTC = 0 .set WANT_PORTD = 0 .set WANT_PORTE = 0 .set WANT_PORTF = 0 .set WANT_PORTG = 0 .set WANT_TIMER_COUNTER_0 = 0 .set WANT_TIMER_COUNTER_2 = 0 .set WANT_WATCHDOG = 0 .set WANT_USART1 = 0 .set WANT_EEPROM = 0 .set WANT_TIMER_COUNTER_5 = 0 .set WANT_TIMER_COUNTER_4 = 0 .set WANT_TIMER_COUNTER_3 = 0 .set WANT_TIMER_COUNTER_1 = 0 .set WANT_JTAG = 0 .set WANT_EXTERNAL_INTERRUPT = 0 .set WANT_CPU = 0 .set WANT_AD_CONVERTER = 0 .set WANT_BOOT_LOAD = 0 .equ intvecsize = 2 ; please verify; flash size: 262144 bytes .equ pclen = 3 ; please verify .overlap .org 2 000002 d139 rcall isr ; External Interrupt Request 0 .org 4 000004 d137 rcall isr ; External Interrupt Request 1 .org 6 000006 d135 rcall isr ; External Interrupt Request 2 .org 8 000008 d133 rcall isr ; External Interrupt Request 3 .org 10 00000a d131 rcall isr ; External Interrupt Request 4 .org 12 00000c d12f rcall isr ; External Interrupt Request 5 .org 14 00000e d12d rcall isr ; External Interrupt Request 6 .org 16 000010 d12b rcall isr ; External Interrupt Request 7 .org 18 000012 d129 rcall isr ; Pin Change Interrupt Request 0 .org 20 000014 d127 rcall isr ; Pin Change Interrupt Request 1 .org 22 000016 d125 rcall isr ; Pin Change Interrupt Request 2 .org 24 000018 d123 rcall isr ; Watchdog Time-out Interrupt .org 26 00001a d121 rcall isr ; Timer/Counter2 Compare Match A .org 28 00001c d11f rcall isr ; Timer/Counter2 Compare Match B .org 30 00001e d11d rcall isr ; Timer/Counter2 Overflow .org 32 000020 d11b rcall isr ; Timer/Counter1 Capture Event .org 34 000022 d119 rcall isr ; Timer/Counter1 Compare Match A .org 36 000024 d117 rcall isr ; Timer/Counter1 Compare Match B .org 38 000026 d115 rcall isr ; Timer/Counter1 Compare Match C .org 40 000028 d113 rcall isr ; Timer/Counter1 Overflow .org 42 00002a d111 rcall isr ; Timer/Counter0 Compare Match A .org 44 00002c d10f rcall isr ; Timer/Counter0 Compare Match B .org 46 00002e d10d rcall isr ; Timer/Counter0 Overflow .org 48 000030 d10b rcall isr ; SPI Serial Transfer Complete .org 50 000032 d109 rcall isr ; USART0, Rx Complete .org 52 000034 d107 rcall isr ; USART0 Data register Empty .org 54 000036 d105 rcall isr ; USART0, Tx Complete .org 56 000038 d103 rcall isr ; Analog Comparator .org 58 00003a d101 rcall isr ; ADC Conversion Complete .org 60 00003c d0ff rcall isr ; EEPROM Ready .org 62 00003e d0fd rcall isr ; Timer/Counter3 Capture Event .org 64 000040 d0fb rcall isr ; Timer/Counter3 Compare Match A .org 66 000042 d0f9 rcall isr ; Timer/Counter3 Compare Match B .org 68 000044 d0f7 rcall isr ; Timer/Counter3 Compare Match C .org 70 000046 d0f5 rcall isr ; Timer/Counter3 Overflow .org 72 000048 d0f3 rcall isr ; USART1, Rx Complete .org 74 00004a d0f1 rcall isr ; USART1 Data register Empty .org 76 00004c d0ef rcall isr ; USART1, Tx Complete .org 78 00004e d0ed rcall isr ; 2-wire Serial Interface .org 80 000050 d0eb rcall isr ; Store Program Memory Read .org 82 000052 d0e9 rcall isr ; Timer/Counter4 Capture Event .org 84 000054 d0e7 rcall isr ; Timer/Counter4 Compare Match A .org 86 000056 d0e5 rcall isr ; Timer/Counter4 Compare Match B .org 88 000058 d0e3 rcall isr ; Timer/Counter4 Compare Match C .org 90 00005a d0e1 rcall isr ; Timer/Counter4 Overflow .org 92 00005c d0df rcall isr ; Timer/Counter5 Capture Event .org 94 00005e d0dd rcall isr ; Timer/Counter5 Compare Match A .org 96 000060 d0db rcall isr ; Timer/Counter5 Compare Match B .org 98 000062 d0d9 rcall isr ; Timer/Counter5 Compare Match C .org 100 000064 d0d7 rcall isr ; Timer/Counter5 Overflow .org 102 000066 d0d5 rcall isr ; USART2, Rx Complete .org 104 000068 d0d3 rcall isr ; USART2 Data register Empty .org 106 00006a d0d1 rcall isr ; USART2, Tx Complete .org 108 00006c d0cf rcall isr ; USART3, Rx Complete .org 110 00006e d0cd rcall isr ; USART3 Data register Empty .org 112 000070 d0cb rcall isr ; USART3, Tx Complete .equ INTVECTORS = 57 .nooverlap ; compatability layer (maybe empty) ; controller data area, environment query mcu-info mcu_info: mcu_ramsize: 000071 2000 .dw 8192 mcu_eepromsize: 000072 1000 .dw 4096 mcu_maxdp: 000073 ffff .dw 65535 mcu_numints: 000074 0039 .dw 57 mcu_name: 000075 000a .dw 10 000076 5441 000077 656d 000078 6167 000079 3532 00007a 3136 .db "ATmega2561" .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 ; cpu clock in hertz .equ F_CPU = 14745600 .include "drivers/usart_1.asm" .equ BAUDRATE_HIGH = UBRR1H .equ USART_C = UCSR1C .equ USART_B = UCSR1B .equ USART_A = UCSR1A .equ USART_DATA = UDR1 .equ URXCaddr = URXC1addr .equ UDREaddr = UDRE1addr .equ bm_USART_RXRD = 1 << RXC1 .equ bm_USART_TXRD = 1 << UDRE1 .equ bm_ENABLE_TX = 1 << TXEN1 .equ bm_ENABLE_RX = 1 << RXEN1 .equ bm_ENABLE_INT_RX = 1<rx-buf",0 000080 0000 .dw VE_HEAD .set VE_HEAD = VE_TO_RXBUF XT_TO_RXBUF: 000081 0082 .dw PFA_rx_tobuf PFA_rx_tobuf: 000082 2f08 mov temp0, tosl 000083 9110 0210 lds temp1, usart_rx_in 000085 e0e0 ldi zl, low(usart_rx_data) 000086 e0f2 ldi zh, high(usart_rx_data) 000087 0fe1 add zl, temp1 000088 1df3 adc zh, zeroh 000089 8300 st Z, temp0 00008a 9513 inc temp1 00008b 701f andi temp1,usart_rx_mask 00008c 9310 0210 sts usart_rx_in, temp1 00008e 9189 00008f 9199 loadtos 000090 940c 011f jmp_ DO_NEXT ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; setup with ; ' isr-rx URXCaddr int! VE_ISR_RX: 000092 ff06 .dw $ff06 000093 7369 000094 2d72 000095 7872 .db "isr-rx" 000096 007b .dw VE_HEAD .set VE_HEAD = VE_ISR_RX XT_ISR_RX: 000097 011b .dw DO_COLON usart_rx_isr: 000098 04ce .dw XT_DOLITERAL 000099 00ce .dw usart_data 00009a 0531 .dw XT_CFETCH 00009b 054a .dw XT_DUP 00009c 04ce .dw XT_DOLITERAL 00009d 0003 .dw 3 00009e 126d .dw XT_EQUAL 00009f 04c7 .dw XT_DOCONDBRANCH 0000a0 00a2 .dw usart_rx_isr1 0000a1 0ebf .dw XT_COLD usart_rx_isr1: 0000a2 0081 .dw XT_TO_RXBUF 0000a3 04ae .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: 0000a4 011b .dw DO_COLON PFA_USART_INIT_RX_BUFFER: ; ( -- ) 0000a5 04ce 0000a6 0097 .dw XT_DOLITERAL, XT_ISR_RX 0000a7 04ce 0000a8 0048 .dw XT_DOLITERAL, URXCaddr 0000a9 08eb .dw XT_INTSTORE 0000aa 04ce .dw XT_DOLITERAL 0000ab 0200 .dw usart_rx_data 0000ac 04ce .dw XT_DOLITERAL 0000ad 0016 .dw usart_rx_size + 6 0000ae 05ed .dw XT_ZERO 0000af 0933 .dw XT_FILL 0000b0 04ae .dw XT_EXIT ; ( -- c) ; MCU ; get 1 character from input queue, wait if needed using interrupt driver VE_RX_BUFFER: 0000b1 ff06 .dw $ff06 0000b2 7872 0000b3 622d 0000b4 6675 .db "rx-buf" 0000b5 0092 .dw VE_HEAD .set VE_HEAD = VE_RX_BUFFER XT_RX_BUFFER: 0000b6 011b .dw DO_COLON PFA_RX_BUFFER: 0000b7 00d1 .dw XT_RXQ_BUFFER 0000b8 04c7 .dw XT_DOCONDBRANCH 0000b9 00b7 .dw PFA_RX_BUFFER 0000ba 04ce .dw XT_DOLITERAL 0000bb 0211 .dw usart_rx_out 0000bc 0531 .dw XT_CFETCH 0000bd 054a .dw XT_DUP 0000be 04ce .dw XT_DOLITERAL 0000bf 0200 .dw usart_rx_data 0000c0 0636 .dw XT_PLUS 0000c1 0531 .dw XT_CFETCH 0000c2 055d .dw XT_SWAP 0000c3 06c8 .dw XT_1PLUS 0000c4 04ce .dw XT_DOLITERAL 0000c5 000f .dw usart_rx_mask 0000c6 06ac .dw XT_AND 0000c7 04ce .dw XT_DOLITERAL 0000c8 0211 .dw usart_rx_out 0000c9 0526 .dw XT_CSTORE 0000ca 04ae .dw XT_EXIT ; ( -- f) ; MCU ; check if unread characters are in the input queue VE_RXQ_BUFFER: 0000cb ff07 .dw $ff07 0000cc 7872 0000cd 2d3f 0000ce 7562 0000cf 0066 .db "rx?-buf",0 0000d0 00b1 .dw VE_HEAD .set VE_HEAD = VE_RXQ_BUFFER XT_RXQ_BUFFER: 0000d1 011b .dw DO_COLON PFA_RXQ_BUFFER: 0000d2 0eb7 .dw XT_PAUSE 0000d3 04ce .dw XT_DOLITERAL 0000d4 0211 .dw usart_rx_out 0000d5 0531 .dw XT_CFETCH 0000d6 04ce .dw XT_DOLITERAL 0000d7 0210 .dw usart_rx_in 0000d8 0531 .dw XT_CFETCH 0000d9 05ac .dw XT_NOTEQUAL 0000da 04ae .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: 0000db ff07 .dw $ff07 0000dc 7874 0000dd 702d 0000de 6c6f 0000df 006c .db "tx-poll",0 0000e0 00cb .dw VE_HEAD .set VE_HEAD = VE_TX_POLL XT_TX_POLL: 0000e1 011b .dw DO_COLON PFA_TX_POLL: ; wait for data ready 0000e2 00ef .dw XT_TXQ_POLL 0000e3 04c7 .dw XT_DOCONDBRANCH 0000e4 00e2 .dw PFA_TX_POLL ; send to usart 0000e5 04ce .dw XT_DOLITERAL 0000e6 00ce .dw USART_DATA 0000e7 0526 .dw XT_CSTORE 0000e8 04ae .dw XT_EXIT ; ( -- f) MCU ; MCU ; check if a character can be send using register poll VE_TXQ_POLL: 0000e9 ff08 .dw $ff08 0000ea 7874 0000eb 2d3f 0000ec 6f70 0000ed 6c6c .db "tx?-poll" 0000ee 00db .dw VE_HEAD .set VE_HEAD = VE_TXQ_POLL XT_TXQ_POLL: 0000ef 011b .dw DO_COLON PFA_TXQ_POLL: 0000f0 0eb7 .dw XT_PAUSE 0000f1 04ce .dw XT_DOLITERAL 0000f2 00c8 .dw USART_A 0000f3 0531 .dw XT_CFETCH 0000f4 04ce .dw XT_DOLITERAL 0000f5 0020 .dw bm_USART_TXRD 0000f6 06ac .dw XT_AND 0000f7 04ae .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: 0000f8 ff04 .dw $ff04 0000f9 6275 0000fa 7272 .db "ubrr" 0000fb 00e9 .dw VE_HEAD .set VE_HEAD = VE_UBRR XT_UBRR: 0000fc 0509 .dw PFA_DOVALUE1 PFA_UBRR: ; ( -- ) 0000fd 00ca .dw EE_UBRRVAL 0000fe 101a .dw XT_EDEFERFETCH 0000ff 1024 .dw XT_EDEFERSTORE .include "words/usart.asm" ; MCU ; initialize usart VE_USART: 000100 ff06 .dw $ff06 000101 752b 000102 6173 000103 7472 .db "+usart" 000104 00f8 .dw VE_HEAD .set VE_HEAD = VE_USART XT_USART: 000105 011b .dw DO_COLON PFA_USART: ; ( -- ) 000106 04ce .dw XT_DOLITERAL 000107 0098 .dw USART_B_VALUE 000108 04ce .dw XT_DOLITERAL 000109 00c9 .dw USART_B 00010a 0526 .dw XT_CSTORE 00010b 04ce .dw XT_DOLITERAL 00010c 0006 .dw USART_C_VALUE 00010d 04ce .dw XT_DOLITERAL 00010e 00ca .dw USART_C | bm_USARTC_en 00010f 0526 .dw XT_CSTORE 000110 00fc .dw XT_UBRR 000111 054a .dw XT_DUP 000112 0792 .dw XT_BYTESWAP 000113 04ce .dw XT_DOLITERAL 000114 00cd .dw BAUDRATE_HIGH 000115 0526 .dw XT_CSTORE 000116 04ce .dw XT_DOLITERAL 000117 00cc .dw BAUDRATE_LOW 000118 0526 .dw XT_CSTORE .if XT_USART_INIT_RX!=0 000119 00a4 .dw XT_USART_INIT_RX .endif .if XT_USART_INIT_TX!=0 .endif 00011a 04ae .dw XT_EXIT ; all of amforth is in one segment .include "amforth-low.asm" ;;;; ;;;; GPL V2 (only) .set pc_ = pc .org $0000 000000 940c 0ec0 jmp_ PFA_COLD .org pc_ .include "amforth-interpreter.asm" DO_COLON: 00011b 93bf push XH 00011c 93af push XL ; PUSH IP 00011d 01db movw XL, wl 00011e 9611 adiw xl, 1 DO_NEXT: .if WANT_INTERRUPTS == 1 00011f 14b2 cp isrflag, zerol 000120 f499 brne DO_INTERRUPT .endif 000121 01fd movw zl, XL ; READ IP 000122 2755 000123 0fee 000124 1fff 000125 1f55 000126 bf5b 000127 9167 000128 9177 readflashcell wl, wh 000129 9611 adiw XL, 1 ; INC IP DO_EXECUTE: 00012a 01fb movw zl, wl 00012b 2755 00012c 0fee 00012d 1fff 00012e 1f55 00012f bf5b 000130 9107 000131 9117 readflashcell temp0,temp1 000132 01f8 movw zl, temp0 000133 9409 ijmp .if WANT_INTERRUPTS == 1 DO_INTERRUPT: ; here we deal with interrupts the forth way 000134 939a 000135 938a savetos 000136 2d8b mov tosl, isrflag 000137 2799 clr tosh 000138 24bb clr isrflag 000139 e066 ldi wl, LOW(XT_ISREXEC) 00013a e079 ldi wh, HIGH(XT_ISREXEC) 00013b cfee rjmp DO_EXECUTE .include "drivers/generic-isr.asm" .eseg 000000 intvec: .byte INTVECTORS * CELLSIZE .dseg 000212 intcnt: .byte INTVECTORS .cseg ; interrupt routine gets called (again) by rcall! This gives the ; address of the int-vector on the stack. isr: 00013c 920a st -Y, r0 00013d b60f in r0, SREG 00013e 920a st -Y, r0 .if (pclen==3) 00013f 900f pop r0 ; some 128+K Flash devices use 3 cells for call/ret .endif 000140 900f pop r0 000141 900f pop r0 ; = intnum * intvectorsize + 1 (address following the rcall) 000142 940a dec r0 .if intvecsize == 1 ; .endif 000143 2cb0 mov isrflag, r0 000144 93ff push zh 000145 93ef push zl 000146 e1e2 ldi zl, low(intcnt) 000147 e0f2 ldi zh, high(intcnt) 000148 9406 lsr r0 ; we use byte addresses in the counter array, not words 000149 0de0 add zl, r0 00014a 1df3 adc zh, zeroh 00014b 8000 ld r0, Z 00014c 9403 inc r0 00014d 8200 st Z, r0 00014e 91ef pop zl 00014f 91ff pop zh 000150 9009 ld r0, Y+ 000151 be0f out SREG, r0 000152 9009 ld r0, Y+ 000153 9508 ret ; returns the interrupt, the rcall stack frame is removed! ; no reti here, see words/isr-end.asm .set AMFORTH_NRWW_SIZE=(FLASHEND-AMFORTH_RO_SEG)*2 ; lower part of the dictionary .include "dict/rww.inc" ; Arithmetics ; add a number to a double cell VE_MPLUS: 000154 ff02 .dw $ff02 000155 2b6d .db "m+" 000156 0100 .dw VE_HEAD .set VE_HEAD = VE_MPLUS XT_MPLUS: 000157 011b .dw DO_COLON PFA_MPLUS: 000158 1255 .dw XT_S2D 000159 0879 .dw XT_DPLUS 00015a 04ae .dw XT_EXIT .include "words/ud-star.asm" .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_UDSTAR: 00015b ff03 .dw $ff03 00015c 6475 ../../common\words/ud-star.asm(9): warning: .cseg .db misalignment - padding zero byte 00015d 002a .db "ud*" 00015e 0154 .dw VE_HEAD .set VE_HEAD = VE_UDSTAR XT_UDSTAR: 00015f 011b .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 + ; 000160 054a 000161 0598 000162 0679 000163 0572 .DW XT_DUP,XT_TO_R,XT_UMSTAR,XT_DROP 000164 055d 000165 058f 000166 0679 000167 057a 000168 0636 000169 04ae .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: 00016a ff04 .dw $ff04 00016b 6d75 00016c 7861 .db "umax" 00016d 015b .dw VE_HEAD .set VE_HEAD = VE_UMAX XT_UMAX: 00016e 011b .dw DO_COLON PFA_UMAX: .endif 00016f 09ca 000170 05f5 .DW XT_2DUP,XT_ULESS 000171 04c7 .dw XT_DOCONDBRANCH 000172 0174 DEST(UMAX1) 000173 055d .DW XT_SWAP 000174 0572 UMAX1: .DW XT_DROP 000175 04ae .dw XT_EXIT .include "words/umin.asm" .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_UMIN: 000176 ff04 .dw $ff04 000177 6d75 000178 6e69 .db "umin" 000179 016a .dw VE_HEAD .set VE_HEAD = VE_UMIN XT_UMIN: 00017a 011b .dw DO_COLON PFA_UMIN: .endif 00017b 09ca 00017c 0600 .DW XT_2DUP,XT_UGREATER 00017d 04c7 .dw XT_DOCONDBRANCH 00017e 0180 DEST(UMIN1) 00017f 055d .DW XT_SWAP 000180 0572 UMIN1: .DW XT_DROP 000181 04ae .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: 000182 011b .dw DO_COLON PFA_IMMEDIATEQ: 000183 04ce .dw XT_DOLITERAL 000184 8000 .dw $8000 000185 06ac .dw XT_AND 000186 05b3 .dw XT_ZEROEQUAL 000187 04c7 .dw XT_DOCONDBRANCH 000188 018b DEST(IMMEDIATEQ1) 000189 1274 .dw XT_ONE 00018a 04ae .dw XT_EXIT IMMEDIATEQ1: ; not immediate 00018b 05e4 .dw XT_TRUE 00018c 04ae .dw XT_EXIT .include "words/name2flags.asm" ; Tools ; get the flags from a name token VE_NAME2FLAGS: 00018d ff0a .dw $ff0a 00018e 616e 00018f 656d 000190 663e 000191 616c 000192 7367 .db "name>flags" 000193 0176 .dw VE_HEAD .set VE_HEAD = VE_NAME2FLAGS XT_NAME2FLAGS: 000194 011b .dw DO_COLON PFA_NAME2FLAGS: 000195 082c .dw XT_FETCHI ; skip to link field 000196 04ce .dw XT_DOLITERAL 000197 ff00 .dw $ff00 000198 06ac .dw XT_AND 000199 04ae .dw XT_EXIT .if AMFORTH_NRWW_SIZE > 8000 .include "dict/appl_8k.inc" .include "words/newest.asm" ; System Variable ; system state VE_NEWEST: 00019a ff06 .dw $ff06 00019b 656e 00019c 6577 00019d 7473 .db "newest" 00019e 018d .dw VE_HEAD .set VE_HEAD = VE_NEWEST XT_NEWEST: 00019f 04dc .dw PFA_DOVARIABLE PFA_NEWEST: 0001a0 024b .dw ram_newest .dseg 00024b ram_newest: .byte 4 .include "words/latest.asm" ; System Variable ; system state VE_LATEST: 0001a1 ff06 .dw $ff06 0001a2 616c 0001a3 6574 0001a4 7473 .db "latest" 0001a5 019a .dw VE_HEAD .set VE_HEAD = VE_LATEST XT_LATEST: 0001a6 04dc .dw PFA_DOVARIABLE PFA_LATEST: 0001a7 024f .dw ram_latest .dseg 00024f 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: 0001a8 ff08 .dw $ff08 0001a9 6328 0001aa 6572 0001ab 7461 0001ac 2965 .db "(create)" 0001ad 01a1 .dw VE_HEAD .set VE_HEAD = VE_DOCREATE XT_DOCREATE: 0001ae 011b .dw DO_COLON PFA_DOCREATE: .endif 0001af 0e1a 0001b0 0305 .DW XT_PARSENAME,XT_WLSCOPE ; ( -- addr len wid) 0001b1 054a 0001b2 019f 0001b3 09c2 0001b4 051a .DW XT_DUP,XT_NEWEST,XT_CELLPLUS,XT_STORE ; save the wid 0001b5 02ea 0001b6 019f 0001b7 051a .DW XT_HEADER,XT_NEWEST,XT_STORE ; save the nt 0001b8 04ae .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: 0001b9 0001 .dw $0001 0001ba 005c .db $5c,0 0001bb 01a8 .dw VE_HEAD .set VE_HEAD = VE_BACKSLASH XT_BACKSLASH: 0001bc 011b .dw DO_COLON PFA_BACKSLASH: .endif 0001bd 0e01 .dw XT_SOURCE 0001be 0589 .dw XT_NIP 0001bf 09e3 .dw XT_TO_IN 0001c0 051a .dw XT_STORE 0001c1 04ae .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: 0001c2 0001 .dw $0001 0001c3 0028 .db "(" ,0 0001c4 01b9 .dw VE_HEAD .set VE_HEAD = VE_LPAREN XT_LPAREN: 0001c5 011b .dw DO_COLON PFA_LPAREN: .endif 0001c6 04ce .dw XT_DOLITERAL 0001c7 0029 .dw ')' 0001c8 0ded .dw XT_PARSE 0001c9 09d3 .dw XT_2DROP 0001ca 04ae .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: 0001cb ff07 .dw $ff07 0001cc 6f63 0001cd 706d 0001ce 6c69 0001cf 0065 .db "compile",0 0001d0 01c2 .dw VE_HEAD .set VE_HEAD = VE_COMPILE XT_COMPILE: 0001d1 011b .dw DO_COLON PFA_COMPILE: .endif 0001d2 058f .dw XT_R_FROM 0001d3 054a .dw XT_DUP 0001d4 1011 .dw XT_ICELLPLUS 0001d5 0598 .dw XT_TO_R 0001d6 082c .dw XT_FETCHI 0001d7 01dc .dw XT_COMMA 0001d8 04ae .dw XT_EXIT .include "words/comma.asm" ; Dictionary ; compile 16 bit into flash at DP VE_COMMA: 0001d9 ff01 .dw $ff01 0001da 002c .db ',',0 ; , 0001db 01cb .dw VE_HEAD .set VE_HEAD = VE_COMMA XT_COMMA: 0001dc 011b .dw DO_COLON PFA_COMMA: 0001dd 0a13 .dw XT_DP 0001de 080d .dw XT_STOREI 0001df 0a13 .dw XT_DP 0001e0 06c8 .dw XT_1PLUS 0001e1 0fff .dw XT_DOTO 0001e2 0a14 .dw PFA_DP 0001e3 04ae .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: 0001e4 0003 .dw $0003 0001e5 275b 0001e6 005d .db "[']",0 0001e7 01d9 .dw VE_HEAD .set VE_HEAD = VE_BRACKETTICK XT_BRACKETTICK: 0001e8 011b .dw DO_COLON PFA_BRACKETTICK: .endif 0001e9 0c70 .dw XT_TICK 0001ea 01f2 .dw XT_LITERAL 0001eb 04ae .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: 0001ec 0007 .dw $0007 0001ed 696c 0001ee 6574 0001ef 6172 0001f0 006c .db "literal",0 0001f1 01e4 .dw VE_HEAD .set VE_HEAD = VE_LITERAL XT_LITERAL: 0001f2 011b .dw DO_COLON PFA_LITERAL: .endif 0001f3 01d1 .DW XT_COMPILE 0001f4 04ce .DW XT_DOLITERAL 0001f5 01dc .DW XT_COMMA 0001f6 04ae .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: 0001f7 0008 .dw $0008 0001f8 6c73 0001f9 7469 0001fa 7265 0001fb 6c61 .db "sliteral" 0001fc 01ec .dw VE_HEAD .set VE_HEAD = VE_SLITERAL XT_SLITERAL: 0001fd 011b .dw DO_COLON PFA_SLITERAL: .endif 0001fe 01d1 .dw XT_COMPILE 0001ff 0bd3 .dw XT_DOSLITERAL ; ( -- addr n) 000200 0be1 .dw XT_SCOMMA 000201 04ae .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: 000202 011b .dw DO_COLON PFA_GMARK: 000203 0a13 .dw XT_DP 000204 01d1 .dw XT_COMPILE 000205 ffff .dw -1 ; ffff does not erase flash 000206 04ae .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: 000207 011b .dw DO_COLON PFA_GRESOLVE: 000208 0fbd .dw XT_QSTACK 000209 0a13 .dw XT_DP 00020a 055d .dw XT_SWAP 00020b 080d .dw XT_STOREI 00020c 04ae .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: 00029b 011b .dw DO_COLON PFA_QDOCHECK: .endif 00029c 09ca .dw XT_2DUP 00029d 126d .dw XT_EQUAL 00029e 054a .dw XT_DUP 00029f 0598 .dw XT_TO_R 0002a0 04c7 .dw XT_DOCONDBRANCH 0002a1 02a3 DEST(PFA_QDOCHECK1) 0002a2 09d3 .dw XT_2DROP PFA_QDOCHECK1: 0002a3 058f .dw XT_R_FROM 0002a4 0696 .dw XT_INVERT 0002a5 04ae .dw XT_EXIT .include "words/endloop.asm" .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_ENDLOOP: 0002a6 ff07 .dw $ff07 0002a7 6e65 0002a8 6c64 0002a9 6f6f 0002aa 0070 .db "endloop",0 0002ab 028f .dw VE_HEAD .set VE_HEAD = VE_ENDLOOP XT_ENDLOOP: 0002ac 011b .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. 0002ad 0210 .DW XT_LRESOLVE 0002ae 02b9 0002af 0552 0002b0 04c7 LOOP1: .DW XT_L_FROM,XT_QDUP,XT_DOCONDBRANCH 0002b1 02b5 DEST(LOOP2) 0002b2 0235 .DW XT_THEN 0002b3 04bd .dw XT_DOBRANCH 0002b4 02ae DEST(LOOP1) 0002b5 04ae LOOP2: .DW XT_EXIT ; leave address stack .include "words/l-from.asm" .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_L_FROM: 0002b6 ff02 .dw $ff02 0002b7 3e6c .db "l>" 0002b8 02a6 .dw VE_HEAD .set VE_HEAD = VE_L_FROM XT_L_FROM: 0002b9 011b .dw DO_COLON PFA_L_FROM: .endif ;Z L> -- x L: x -- move from leave stack ; LP @ @ -2 LP +! ; 0002ba 02d8 .dw XT_LP 0002bb 0512 .dw XT_FETCH 0002bc 0512 .dw XT_FETCH 0002bd 04ce .dw XT_DOLITERAL 0002be fffe .dw -2 0002bf 02d8 .dw XT_LP 0002c0 06fe .dw XT_PLUSSTORE 0002c1 04ae .dw XT_EXIT .include "words/to-l.asm" .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_TO_L: 0002c2 ff02 .dw $ff02 0002c3 6c3e .db ">l" 0002c4 02b6 .dw VE_HEAD .set VE_HEAD = VE_TO_L XT_TO_L: 0002c5 011b .dw DO_COLON PFA_TO_L: .endif ;Z >L x -- L: -- x move to leave stack ; CELL LP +! LP @ ! ; (L stack grows up) 0002c6 1279 .dw XT_TWO 0002c7 02d8 .dw XT_LP 0002c8 06fe .dw XT_PLUSSTORE 0002c9 02d8 .dw XT_LP 0002ca 0512 .dw XT_FETCH 0002cb 051a .dw XT_STORE 0002cc 04ae .dw XT_EXIT .include "words/lp0.asm" ; Stack ; start address of leave stack VE_LP0: 0002cd ff03 .dw $ff03 0002ce 706c 0002cf 0030 .db "lp0",0 0002d0 02c2 .dw VE_HEAD .set VE_HEAD = VE_LP0 XT_LP0: 0002d1 0509 .dw PFA_DOVALUE1 PFA_LP0: 0002d2 007e .dw CFG_LP0 0002d3 101a .dw XT_EDEFERFETCH 0002d4 1024 .dw XT_EDEFERSTORE .include "words/lp.asm" ; System Variable ; leave stack pointer VE_LP: 0002d5 ff02 .dw $ff02 0002d6 706c .db "lp" 0002d7 02cd .dw VE_HEAD .set VE_HEAD = VE_LP XT_LP: 0002d8 04dc .dw PFA_DOVARIABLE PFA_LP: 0002d9 0251 .dw ram_lp .dseg 000251 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: 0002da ff06 .dw $ff06 0002db 7263 0002dc 6165 0002dd 6574 .db "create" 0002de 02d5 .dw VE_HEAD .set VE_HEAD = VE_CREATE XT_CREATE: 0002df 011b .dw DO_COLON PFA_CREATE: .endif 0002e0 01ae .dw XT_DOCREATE 0002e1 030e .dw XT_REVEAL 0002e2 01d1 .dw XT_COMPILE 0002e3 04e9 .dw PFA_DOCONSTANT 0002e4 04ae .dw XT_EXIT .include "words/header.asm" ; Compiler ; creates the vocabulary header without XT and data field (PF) in the wordlist wid VE_HEADER: 0002e5 ff06 .dw $ff06 0002e6 6568 0002e7 6461 0002e8 7265 .db "header" 0002e9 02da .dw VE_HEAD .set VE_HEAD = VE_HEADER XT_HEADER: 0002ea 011b .dw DO_COLON PFA_HEADER: 0002eb 0a13 .dw XT_DP ; the new Name Field 0002ec 0598 .dw XT_TO_R 0002ed 0598 .dw XT_TO_R ; ( R: NFA WID ) 0002ee 054a .dw XT_DUP 0002ef 05c1 .dw XT_GREATERZERO 0002f0 04c7 .dw XT_DOCONDBRANCH 0002f1 02fc .dw PFA_HEADER1 0002f2 054a .dw XT_DUP 0002f3 04ce .dw XT_DOLITERAL 0002f4 ff00 .dw $ff00 ; all flags are off (e.g. immediate) 0002f5 06b5 .dw XT_OR 0002f6 0be5 .dw XT_DOSCOMMA ; make the link to the previous entry in this wordlist 0002f7 058f .dw XT_R_FROM 0002f8 07f9 .dw XT_FETCHE 0002f9 01dc .dw XT_COMMA 0002fa 058f .dw XT_R_FROM 0002fb 04ae .dw XT_EXIT PFA_HEADER1: ; -16: attempt to use zero length string as a name 0002fc 04ce .dw XT_DOLITERAL 0002fd fff0 .dw -16 0002fe 0ca7 .dw XT_THROW .include "words/wlscope.asm" ; Compiler ; dynamically place a word in a wordlist. The word name may be changed. VE_WLSCOPE: 0002ff ff07 .dw $ff07 000300 6c77 000301 6373 000302 706f 000303 0065 .db "wlscope",0 000304 02e5 .dw VE_HEAD .set VE_HEAD = VE_WLSCOPE XT_WLSCOPE: 000305 1079 .dw PFA_DODEFER1 PFA_WLSCOPE: 000306 007a .dw CFG_WLSCOPE 000307 101a .dw XT_EDEFERFETCH 000308 1024 .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: 000309 ff06 .dw $ff06 00030a 6572 00030b 6576 00030c 6c61 .db "reveal" 00030d 02ff .dw VE_HEAD .set VE_HEAD = VE_REVEAL XT_REVEAL: 00030e 011b .dw DO_COLON PFA_REVEAL: .endif 00030f 019f 000310 09c2 000311 0512 .DW XT_NEWEST,XT_CELLPLUS,XT_FETCH ; only if wordlist is in use 000312 0552 000313 04c7 .DW XT_QDUP,XT_DOCONDBRANCH 000314 0319 DEST(REVEAL1) 000315 019f 000316 0512 000317 055d 000318 07d5 .DW XT_NEWEST,XT_FETCH,XT_SWAP,XT_STOREE ; .DW XT_ZERO,XT_NEWEST,XT_CELLPLUS,XT_STORE ; clean wordlist entry REVEAL1: 000319 04ae .DW XT_EXIT .include "words/does.asm" ; Compiler ; organize the XT replacement to call other colon code VE_DOES: 00031a 0005 .dw $0005 00031b 6f64 00031c 7365 00031d 003e .db "does>",0 00031e 0309 .dw VE_HEAD .set VE_HEAD = VE_DOES XT_DOES: 00031f 011b .dw DO_COLON PFA_DOES: 000320 01d1 .dw XT_COMPILE 000321 0332 .dw XT_DODOES 000322 01d1 .dw XT_COMPILE ; create a code snippet to be used in an embedded XT 000323 940e .dw $940e ; the address of this compiled 000324 01d1 .dw XT_COMPILE ; code will replace the XT of the 000325 0327 .dw DO_DODOES ; word that CREATE created 000326 04ae .dw XT_EXIT ; DO_DODOES: ; ( -- PFA ) 000327 939a 000328 938a savetos 000329 01cb movw tosl, wl 00032a 9601 adiw tosl, 1 ; the following takes the address from a real uC-call .if (pclen==3) 00032b 917f pop wh ; some 128K Flash devices use 3 cells for call/ret .endif 00032c 917f pop wh 00032d 916f pop wl 00032e 93bf push XH 00032f 93af push XL 000330 01db movw XL, wl 000331 cded 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: 000332 011b .dw DO_COLON PFA_DODOES: 000333 058f .dw XT_R_FROM 000334 019f .dw XT_NEWEST 000335 09c2 .dw XT_CELLPLUS 000336 0512 .dw XT_FETCH 000337 07f9 .dw XT_FETCHE 000338 10e4 .dw XT_NFA2CFA 000339 080d .dw XT_STOREI 00033a 04ae .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: 00033b ff01 .dw $ff01 00033c 003a .db ":",0 00033d 031a .dw VE_HEAD .set VE_HEAD = VE_COLON XT_COLON: 00033e 011b .dw DO_COLON PFA_COLON: .endif 00033f 01ae .dw XT_DOCREATE 000340 0349 .dw XT_COLONNONAME 000341 0572 .dw XT_DROP 000342 04ae .dw XT_EXIT .include "words/colon-noname.asm" ; Compiler ; create an unnamed entry in the dictionary, XT is DO_COLON VE_COLONNONAME: 000343 ff07 .dw $ff07 000344 6e3a 000345 6e6f 000346 6d61 000347 0065 .db ":noname",0 000348 033b .dw VE_HEAD .set VE_HEAD = VE_COLONNONAME XT_COLONNONAME: 000349 011b .dw DO_COLON PFA_COLONNONAME: 00034a 0a13 .dw XT_DP 00034b 054a .dw XT_DUP 00034c 01a6 .dw XT_LATEST 00034d 051a .dw XT_STORE 00034e 01d1 .dw XT_COMPILE 00034f 011b .dw DO_COLON 000350 035e .dw XT_RBRACKET 000351 04ae .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: 000352 0001 .dw $0001 000353 003b .db $3b,0 000354 0343 .dw VE_HEAD .set VE_HEAD = VE_SEMICOLON XT_SEMICOLON: 000355 011b .dw DO_COLON PFA_SEMICOLON: .endif 000356 01d1 .dw XT_COMPILE 000357 04ae .dw XT_EXIT 000358 0366 .dw XT_LBRACKET 000359 030e .dw XT_REVEAL 00035a 04ae .dw XT_EXIT .include "words/right-bracket.asm" ; Compiler ; enter compiler mode .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_RBRACKET: 00035b ff01 .dw $ff01 00035c 005d .db "]",0 00035d 0352 .dw VE_HEAD .set VE_HEAD = VE_RBRACKET XT_RBRACKET: 00035e 011b .dw DO_COLON PFA_RBRACKET: .endif 00035f 1274 .dw XT_ONE 000360 09af .dw XT_STATE 000361 051a .dw XT_STORE 000362 04ae .dw XT_EXIT .include "words/left-bracket.asm" ; Compiler ; enter interpreter mode .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_LBRACKET: 000363 0001 .dw $0001 000364 005b .db "[",0 000365 035b .dw VE_HEAD .set VE_HEAD = VE_LBRACKET XT_LBRACKET: 000366 011b .dw DO_COLON PFA_LBRACKET: .endif 000367 05ed .dw XT_ZERO 000368 09af .dw XT_STATE 000369 051a .dw XT_STORE 00036a 04ae .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: 00036b ff08 .dw $ff08 00036c 6176 00036d 6972 00036e 6261 00036f 656c .db "variable" 000370 0363 .dw VE_HEAD .set VE_HEAD = VE_VARIABLE XT_VARIABLE: 000371 011b .dw DO_COLON PFA_VARIABLE: .endif 000372 0a24 .dw XT_HERE 000373 037d .dw XT_CONSTANT 000374 1279 .dw XT_TWO 000375 0a2d .dw XT_ALLOT 000376 04ae .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: 000377 ff08 .dw $ff08 000378 6f63 000379 736e 00037a 6174 00037b 746e .db "constant" 00037c 036b .dw VE_HEAD .set VE_HEAD = VE_CONSTANT XT_CONSTANT: 00037d 011b .dw DO_COLON PFA_CONSTANT: .endif 00037e 01ae .dw XT_DOCREATE 00037f 030e .dw XT_REVEAL 000380 01d1 .dw XT_COMPILE 000381 04dc .dw PFA_DOVARIABLE 000382 01dc .dw XT_COMMA 000383 04ae .dw XT_EXIT .include "words/user.asm" ; Compiler ; create a dictionary entry for a user variable at offset n VE_USER: 000384 ff04 .dw $ff04 000385 7375 000386 7265 .db "user" 000387 0377 .dw VE_HEAD .set VE_HEAD = VE_USER XT_USER: 000388 011b .dw DO_COLON PFA_USER: 000389 01ae .dw XT_DOCREATE 00038a 030e .dw XT_REVEAL 00038b 01d1 .dw XT_COMPILE 00038c 04ef .dw PFA_DOUSER 00038d 01dc .dw XT_COMMA 00038e 04ae .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: 00038f 0007 .dw $0007 000390 6572 000391 7563 000392 7372 000393 0065 .db "recurse",0 000394 0384 .dw VE_HEAD .set VE_HEAD = VE_RECURSE XT_RECURSE: 000395 011b .dw DO_COLON PFA_RECURSE: .endif 000396 01a6 .dw XT_LATEST 000397 0512 .dw XT_FETCH 000398 01dc .dw XT_COMMA 000399 04ae .dw XT_EXIT .include "words/immediate.asm" ; Compiler ; set immediate flag for the most recent word definition VE_IMMEDIATE: 00039a ff09 .dw $ff09 00039b 6d69 00039c 656d 00039d 6964 00039e 7461 00039f 0065 .db "immediate",0 0003a0 038f .dw VE_HEAD .set VE_HEAD = VE_IMMEDIATE XT_IMMEDIATE: 0003a1 011b .dw DO_COLON PFA_IMMEDIATE: 0003a2 0443 .dw XT_GET_CURRENT 0003a3 07f9 .dw XT_FETCHE 0003a4 054a .dw XT_DUP 0003a5 082c .dw XT_FETCHI 0003a6 04ce .dw XT_DOLITERAL 0003a7 7fff .dw $7fff 0003a8 06ac .dw XT_AND 0003a9 055d .dw XT_SWAP 0003aa 080d .dw XT_STOREI 0003ab 04ae .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: 0003ac 0006 .dw $0006 0003ad 635b 0003ae 6168 0003af 5d72 .db "[char]" 0003b0 039a .dw VE_HEAD .set VE_HEAD = VE_BRACKETCHAR XT_BRACKETCHAR: 0003b1 011b .dw DO_COLON PFA_BRACKETCHAR: .endif 0003b2 01d1 .dw XT_COMPILE 0003b3 04ce .dw XT_DOLITERAL 0003b4 0d50 .dw XT_CHAR 0003b5 01dc .dw XT_COMMA 0003b6 04ae .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: 0003b7 0006 .dw $0006 0003b8 6261 0003b9 726f 0003ba 2274 .db "abort",'"' 0003bb 03ac .dw VE_HEAD .set VE_HEAD = VE_ABORTQUOTE XT_ABORTQUOTE: 0003bc 011b .dw DO_COLON PFA_ABORTQUOTE: .endif 0003bd 0925 .dw XT_SQUOTE 0003be 01d1 .dw XT_COMPILE 0003bf 03ce .dw XT_QABORT 0003c0 04ae .DW XT_EXIT .include "words/abort.asm" ; Exceptions ; send an exception -1 .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_ABORT: 0003c1 ff05 .dw $ff05 0003c2 6261 0003c3 726f 0003c4 0074 .db "abort",0 0003c5 03b7 .dw VE_HEAD .set VE_HEAD = VE_ABORT XT_ABORT: 0003c6 011b .dw DO_COLON PFA_ABORT: .endif 0003c7 05e4 .dw XT_TRUE 0003c8 0ca7 .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: 0003c9 ff06 .dw $ff06 0003ca 613f 0003cb 6f62 0003cc 7472 .db "?abort" 0003cd 03c1 .dw VE_HEAD .set VE_HEAD = VE_QABORT XT_QABORT: 0003ce 011b .dw DO_COLON PFA_QABORT: .endif 0003cf 057a 0003d0 04c7 .DW XT_ROT,XT_DOCONDBRANCH 0003d1 03d4 DEST(QABO1) 0003d2 0c06 0003d3 03c6 .DW XT_ITYPE,XT_ABORT 0003d4 09d3 0003d5 04ae 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: 0003d6 ff09 .dw $ff09 0003d7 6567 0003d8 2d74 0003d9 7473 0003da 6361 0003db 006b .db "get-stack",0 0003dc 03c9 .dw VE_HEAD .set VE_HEAD = VE_GET_STACK XT_GET_STACK: 0003dd 011b .dw DO_COLON .endif 0003de 054a .dw XT_DUP 0003df 09c2 .dw XT_CELLPLUS 0003e0 055d .dw XT_SWAP 0003e1 07f9 .dw XT_FETCHE 0003e2 054a .dw XT_DUP 0003e3 0598 .dw XT_TO_R 0003e4 05ed .dw XT_ZERO 0003e5 055d .dw XT_SWAP ; go from bigger to smaller addresses 0003e6 029b .dw XT_QDOCHECK 0003e7 04c7 .dw XT_DOCONDBRANCH 0003e8 03f4 DEST(PFA_N_FETCH_E2) 0003e9 0734 .dw XT_DODO PFA_N_FETCH_E1: ; ( ee-addr ) 0003ea 0745 .dw XT_I 0003eb 06ce .dw XT_1MINUS 0003ec 09bc .dw XT_CELLS ; ( -- ee-addr i*2 ) 0003ed 0568 .dw XT_OVER ; ( -- ee-addr i*2 ee-addr ) 0003ee 0636 .dw XT_PLUS ; ( -- ee-addr ee-addr+i 0003ef 07f9 .dw XT_FETCHE ;( -- ee-addr item_i ) 0003f0 055d .dw XT_SWAP ;( -- item_i ee-addr ) 0003f1 05e4 .dw XT_TRUE ; shortcut for -1 0003f2 0753 .dw XT_DOPLUSLOOP 0003f3 03ea DEST(PFA_N_FETCH_E1) PFA_N_FETCH_E2: 0003f4 09d3 .dw XT_2DROP 0003f5 058f .dw XT_R_FROM 0003f6 04ae .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: 0003f7 ff09 .dw $ff09 0003f8 6573 0003f9 2d74 0003fa 7473 0003fb 6361 0003fc 006b .db "set-stack",0 0003fd 03d6 .dw VE_HEAD .set VE_HEAD = VE_SET_STACK XT_SET_STACK: 0003fe 011b .dw DO_COLON PFA_SET_STACK: .endif 0003ff 0568 .dw XT_OVER 000400 05ba .dw XT_ZEROLESS 000401 04c7 .dw XT_DOCONDBRANCH 000402 0406 DEST(PFA_SET_STACK0) 000403 04ce .dw XT_DOLITERAL 000404 fffc .dw -4 000405 0ca7 .dw XT_THROW PFA_SET_STACK0: 000406 09ca .dw XT_2DUP 000407 07d5 .dw XT_STOREE ; ( -- i_n .. i_0 n e-addr ) 000408 055d .dw XT_SWAP 000409 05ed .dw XT_ZERO 00040a 029b .dw XT_QDOCHECK 00040b 04c7 .dw XT_DOCONDBRANCH 00040c 0413 DEST(PFA_SET_STACK2) 00040d 0734 .dw XT_DODO PFA_SET_STACK1: 00040e 09c2 .dw XT_CELLPLUS ; ( -- i_x e-addr ) 00040f 09db .dw XT_TUCK ; ( -- e-addr i_x e-addr 000410 07d5 .dw XT_STOREE 000411 0762 .dw XT_DOLOOP 000412 040e DEST(PFA_SET_STACK1) PFA_SET_STACK2: 000413 0572 .dw XT_DROP 000414 04ae .dw XT_EXIT .include "words/map-stack.asm" ; Tools ; Iterate over a stack .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_MAPSTACK: 000415 ff09 .dw $ff09 000416 616d 000417 2d70 000418 7473 000419 6361 00041a 006b .db "map-stack",0 00041b 03f7 .dw VE_HEAD .set VE_HEAD = VE_MAPSTACK XT_MAPSTACK: 00041c 011b .dw DO_COLON PFA_MAPSTACK: .endif 00041d 054a .dw XT_DUP 00041e 09c2 .dw XT_CELLPLUS 00041f 055d .dw XT_SWAP 000420 07f9 .dw XT_FETCHE 000421 09bc .dw XT_CELLS 000422 124c .dw XT_BOUNDS 000423 029b .dw XT_QDOCHECK 000424 04c7 .dw XT_DOCONDBRANCH 000425 0438 DEST(PFA_MAPSTACK3) 000426 0734 .dw XT_DODO PFA_MAPSTACK1: 000427 0745 .dw XT_I 000428 07f9 .dw XT_FETCHE ; -- i*x XT id 000429 055d .dw XT_SWAP 00042a 0598 .dw XT_TO_R 00042b 05a1 .dw XT_R_FETCH 00042c 04b8 .dw XT_EXECUTE ; i*x id -- j*y true | i*x false 00042d 0552 .dw XT_QDUP 00042e 04c7 .dw XT_DOCONDBRANCH 00042f 0434 DEST(PFA_MAPSTACK2) 000430 058f .dw XT_R_FROM 000431 0572 .dw XT_DROP 000432 076d .dw XT_UNLOOP 000433 04ae .dw XT_EXIT PFA_MAPSTACK2: 000434 058f .dw XT_R_FROM 000435 1279 .dw XT_TWO 000436 0753 .dw XT_DOPLUSLOOP 000437 0427 DEST(PFA_MAPSTACK1) PFA_MAPSTACK3: 000438 0572 .dw XT_DROP 000439 05ed .dw XT_ZERO 00043a 04ae .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: 00043b ff0b .dw $ff0b 00043c 6567 00043d 2d74 00043e 7563 00043f 7272 000440 6e65 000441 0074 .db "get-current",0 000442 0415 .dw VE_HEAD .set VE_HEAD = VE_GET_CURRENT XT_GET_CURRENT: 000443 011b .dw DO_COLON PFA_GET_CURRENT: 000444 04ce .dw XT_DOLITERAL 000445 0084 .dw CFG_CURRENT 000446 07f9 .dw XT_FETCHE 000447 04ae .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: 000448 ff09 .dw $ff09 000449 6567 00044a 2d74 00044b 726f 00044c 6564 00044d 0072 .db "get-order",0 00044e 043b .dw VE_HEAD .set VE_HEAD = VE_GET_ORDER XT_GET_ORDER: 00044f 011b .dw DO_COLON PFA_GET_ORDER: .endif 000450 04ce .dw XT_DOLITERAL 000451 0088 .dw CFG_ORDERLISTLEN 000452 03dd .dw XT_GET_STACK 000453 04ae .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: 000454 ff09 .dw $ff09 000455 6663 000456 2d67 000457 726f 000458 6564 000459 0072 .db "cfg-order",0 00045a 0448 .dw VE_HEAD .set VE_HEAD = VE_CFG_ORDER XT_CFG_ORDER: 00045b 04dc .dw PFA_DOVARIABLE PFA_CFG_ORDER: .endif 00045c 0088 .dw CFG_ORDERLISTLEN .include "words/compare.asm" ; String ; compares two strings in RAM VE_COMPARE: 00045d ff07 .dw $ff07 00045e 6f63 00045f 706d 000460 7261 000461 0065 .db "compare",0 000462 0454 .dw VE_HEAD .set VE_HEAD = VE_COMPARE XT_COMPARE: 000463 0464 .dw PFA_COMPARE PFA_COMPARE: 000464 93bf push xh 000465 93af push xl 000466 018c movw temp0, tosl 000467 9189 000468 9199 loadtos 000469 01dc movw xl, tosl 00046a 9189 00046b 9199 loadtos 00046c 019c movw temp2, tosl 00046d 9189 00046e 9199 loadtos 00046f 01fc movw zl, tosl PFA_COMPARE_LOOP: 000470 90ed ld temp4, X+ 000471 90f1 ld temp5, Z+ 000472 14ef cp temp4, temp5 000473 f451 brne PFA_COMPARE_NOTEQUAL 000474 950a dec temp0 000475 f019 breq PFA_COMPARE_ENDREACHED2 000476 952a dec temp2 000477 f7c1 brne PFA_COMPARE_LOOP 000478 c001 rjmp PFA_COMPARE_ENDREACHED PFA_COMPARE_ENDREACHED2: 000479 952a dec temp2 PFA_COMPARE_ENDREACHED: 00047a 2b02 or temp0, temp2 00047b f411 brne PFA_COMPARE_CHECKLASTCHAR 00047c 2788 clr tosl 00047d c002 rjmp PFA_COMPARE_DONE PFA_COMPARE_CHECKLASTCHAR: PFA_COMPARE_NOTEQUAL: 00047e ef8f ser tosl 00047f c000 rjmp PFA_COMPARE_DONE PFA_COMPARE_DONE: 000480 2f98 mov tosh, tosl 000481 91af pop xl 000482 91bf pop xh 000483 cc9b jmp_ DO_NEXT .include "words/nfa2lfa.asm" ; System ; get the link field address from the name field address VE_NFA2LFA: 000484 ff07 .dw $ff07 000485 666e 000486 3e61 000487 666c 000488 0061 .db "nfa>lfa",0 000489 045d .dw VE_HEAD .set VE_HEAD = VE_NFA2LFA XT_NFA2LFA: 00048a 011b .dw DO_COLON PFA_NFA2LFA: 00048b 10d8 .dw XT_NAME2STRING 00048c 06c8 .dw XT_1PLUS 00048d 069d .dw XT_2SLASH 00048e 0636 .dw XT_PLUS 00048f 04ae .dw XT_EXIT .elif AMFORTH_NRWW_SIZE > 4000 .elif AMFORTH_NRWW_SIZE > 2000 .else .endif .include "dict_appl.inc" ; they may be moved to the core dictionary if needed .include "words/applturnkey.asm" ; R( -- ) ; application specific turnkey action VE_APPLTURNKEY: 000490 ff0b .dw $ff0b 000491 7061 000492 6c70 000493 7574 000494 6e72 000495 656b 000496 0079 .db "applturnkey",0 000497 0484 .dw VE_HEAD .set VE_HEAD = VE_APPLTURNKEY XT_APPLTURNKEY: 000498 011b .dw DO_COLON PFA_APPLTURNKEY: 000499 0105 .dw XT_USART .if WANT_INTERRUPTS == 1 00049a 08dd .dw XT_INTON .endif 00049b 0fca .dw XT_DOT_VER 00049c 0c48 .dw XT_SPACE 00049d 09a4 .dw XT_F_CPU 00049e 04ce .dw XT_DOLITERAL 00049f 03e8 .dw 1000 0004a0 065b .dw XT_UMSLASHMOD 0004a1 0589 .dw XT_NIP 0004a2 0a42 .dw XT_DECIMAL 0004a3 0b88 .dw XT_DOT 0004a4 0bd3 .dw XT_DOSLITERAL 0004a5 0004 .dw 4 0004a6 486b 0004a7 207a .db "kHz " 0004a8 0c06 .dw XT_ITYPE 0004a9 04ae .dw XT_EXIT .include "dict/nrww.inc" ; well, not really nrww, but simplifies things alot ; section together with the forth inner interpreter .include "words/exit.asm" ; Compiler ; end of current colon word VE_EXIT: 0004aa ff04 .dw $ff04 0004ab 7865 0004ac 7469 .db "exit" 0004ad 0490 .dw VE_HEAD .set VE_HEAD = VE_EXIT XT_EXIT: 0004ae 04af .dw PFA_EXIT PFA_EXIT: 0004af 91af pop XL 0004b0 91bf pop XH 0004b1 cc6d jmp_ DO_NEXT .include "words/execute.asm" ; System ; execute XT VE_EXECUTE: 0004b2 ff07 .dw $ff07 0004b3 7865 0004b4 6365 0004b5 7475 0004b6 0065 .db "execute",0 0004b7 04aa .dw VE_HEAD .set VE_HEAD = VE_EXECUTE XT_EXECUTE: 0004b8 04b9 .dw PFA_EXECUTE PFA_EXECUTE: 0004b9 01bc movw wl, tosl 0004ba 9189 0004bb 9199 loadtos 0004bc cc6d 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: 0004bd 04be .dw PFA_DOBRANCH PFA_DOBRANCH: 0004be 01fd movw zl, XL 0004bf 2755 0004c0 0fee 0004c1 1fff 0004c2 1f55 0004c3 bf5b 0004c4 91a7 0004c5 91b7 readflashcell XL,XH 0004c6 cc58 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: 0004c7 04c8 .dw PFA_DOCONDBRANCH PFA_DOCONDBRANCH: 0004c8 2b98 or tosh, tosl 0004c9 9189 0004ca 9199 loadtos 0004cb f391 brbs 1, PFA_DOBRANCH ; 1 is z flag; if tos is zero (false), do the branch 0004cc 9611 adiw XL, 1 0004cd cc51 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: 0004ce 04cf .dw PFA_DOLITERAL PFA_DOLITERAL: 0004cf 939a 0004d0 938a savetos 0004d1 01fd movw zl, xl 0004d2 2755 0004d3 0fee 0004d4 1fff 0004d5 1f55 0004d6 bf5b 0004d7 9187 0004d8 9197 readflashcell tosl,tosh 0004d9 9611 adiw xl, 1 0004da cc44 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: 0004db 04dc .dw PFA_DOVARIABLE PFA_DOVARIABLE: 0004dc 939a 0004dd 938a savetos 0004de 01fb movw zl, wl 0004df 9631 adiw zl,1 0004e0 2755 0004e1 0fee 0004e2 1fff 0004e3 1f55 0004e4 bf5b 0004e5 9187 0004e6 9197 readflashcell tosl,tosh 0004e7 cc37 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: 0004e8 04e9 .dw PFA_DOCONSTANT PFA_DOCONSTANT: 0004e9 939a 0004ea 938a savetos 0004eb 01cb movw tosl, wl 0004ec 9601 adiw tosl, 1 0004ed cc31 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: 0004ee 04ef .dw PFA_DOUSER PFA_DOUSER: 0004ef 939a 0004f0 938a savetos 0004f1 01fb movw zl, wl 0004f2 9631 adiw zl, 1 0004f3 2755 0004f4 0fee 0004f5 1fff 0004f6 1f55 0004f7 bf5b 0004f8 9187 0004f9 9197 readflashcell tosl,tosh 0004fa 0d84 add tosl, upl 0004fb 1d95 adc tosh, uph 0004fc cc22 jmp_ DO_NEXT .include "words/do-value.asm" ; System ; runtime of value VE_DOVALUE: 0004fd ff07 .dw $ff07 0004fe 7628 0004ff 6c61 000500 6575 000501 0029 .db "(value)", 0 000502 04b2 .dw VE_HEAD .set VE_HEAD = VE_DOVALUE XT_DOVALUE: 000503 011b .dw DO_COLON PFA_DOVALUE: 000504 01ae .dw XT_DOCREATE 000505 030e .dw XT_REVEAL 000506 01d1 .dw XT_COMPILE 000507 0509 .dw PFA_DOVALUE1 000508 04ae .dw XT_EXIT PFA_DOVALUE1: 000509 de1d call_ DO_DODOES 00050a 054a .dw XT_DUP 00050b 1011 .dw XT_ICELLPLUS 00050c 082c .dw XT_FETCHI 00050d 04b8 .dw XT_EXECUTE 00050e 04ae .dw XT_EXIT ; : (value) dup icell+ @i execute ; .include "words/fetch.asm" ; Memory ; read 1 cell from RAM address VE_FETCH: 00050f ff01 .dw $ff01 000510 0040 .db "@",0 000511 04fd .dw VE_HEAD .set VE_HEAD = VE_FETCH XT_FETCH: 000512 0513 .dw PFA_FETCH PFA_FETCH: .if WANT_UNIFIED == 1 .endif PFA_FETCHRAM: 000513 01fc movw zl, tosl ; low byte is read before the high byte 000514 9181 ld tosl, z+ 000515 9191 ld tosh, z+ 000516 cc08 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: 000517 ff01 .dw $ff01 000518 0021 .db "!",0 000519 050f .dw VE_HEAD .set VE_HEAD = VE_STORE XT_STORE: 00051a 051b .dw PFA_STORE PFA_STORE: .if WANT_UNIFIED == 1 .endif PFA_STORERAM: 00051b 01fc movw zl, tosl 00051c 9189 00051d 9199 loadtos ; the high byte is written before the low byte 00051e 8391 std Z+1, tosh 00051f 8380 std Z+0, tosl 000520 9189 000521 9199 loadtos 000522 cbfc jmp_ DO_NEXT .if WANT_UNIFIED == 1 .endif .include "words/cstore.asm" ; Memory ; store a single byte to RAM address VE_CSTORE: 000523 ff02 .dw $ff02 000524 2163 .db "c!" 000525 0517 .dw VE_HEAD .set VE_HEAD = VE_CSTORE XT_CSTORE: 000526 0527 .dw PFA_CSTORE PFA_CSTORE: 000527 01fc movw zl, tosl 000528 9189 000529 9199 loadtos 00052a 8380 st Z, tosl 00052b 9189 00052c 9199 loadtos 00052d cbf1 jmp_ DO_NEXT .include "words/cfetch.asm" ; Memory ; fetch a single byte from memory mapped locations VE_CFETCH: 00052e ff02 .dw $ff02 00052f 4063 .db "c@" 000530 0523 .dw VE_HEAD .set VE_HEAD = VE_CFETCH XT_CFETCH: 000531 0532 .dw PFA_CFETCH PFA_CFETCH: 000532 01fc movw zl, tosl 000533 2799 clr tosh 000534 8180 ld tosl, Z 000535 cbe9 jmp_ DO_NEXT .include "words/fetch-u.asm" ; Memory ; read 1 cell from USER area VE_FETCHU: 000536 ff02 .dw $ff02 000537 7540 .db "@u" 000538 052e .dw VE_HEAD .set VE_HEAD = VE_FETCHU XT_FETCHU: 000539 011b .dw DO_COLON PFA_FETCHU: 00053a 079b .dw XT_UP_FETCH 00053b 0636 .dw XT_PLUS 00053c 0512 .dw XT_FETCH 00053d 04ae .dw XT_EXIT .include "words/store-u.asm" ; Memory ; write n to USER area at offset VE_STOREU: 00053e ff02 .dw $ff02 00053f 7521 .db "!u" 000540 0536 .dw VE_HEAD .set VE_HEAD = VE_STOREU XT_STOREU: 000541 011b .dw DO_COLON PFA_STOREU: 000542 079b .dw XT_UP_FETCH 000543 0636 .dw XT_PLUS 000544 051a .dw XT_STORE 000545 04ae .dw XT_EXIT ;;;;;;;;;;;;;;;;;;;;;;;;; .include "words/dup.asm" ; Stack ; duplicate TOS VE_DUP: 000546 ff03 .dw $ff03 000547 7564 000548 0070 .db "dup",0 000549 053e .dw VE_HEAD .set VE_HEAD = VE_DUP XT_DUP: 00054a 054b .dw PFA_DUP PFA_DUP: 00054b 939a 00054c 938a savetos 00054d cbd1 jmp_ DO_NEXT .include "words/qdup.asm" ; Stack ; duplicate TOS if non-zero VE_QDUP: 00054e ff04 .dw $ff04 00054f 643f 000550 7075 .db "?dup" 000551 0546 .dw VE_HEAD .set VE_HEAD = VE_QDUP XT_QDUP: 000552 0553 .dw PFA_QDUP PFA_QDUP: 000553 2f08 mov temp0, tosl 000554 2b09 or temp0, tosh 000555 f011 breq PFA_QDUP1 000556 939a 000557 938a savetos PFA_QDUP1: 000558 cbc6 jmp_ DO_NEXT .include "words/swap.asm" ; Stack ; swaps the two top level stack cells VE_SWAP: 000559 ff04 .dw $ff04 00055a 7773 00055b 7061 .db "swap" 00055c 054e .dw VE_HEAD .set VE_HEAD = VE_SWAP XT_SWAP: 00055d 055e .dw PFA_SWAP PFA_SWAP: 00055e 018c movw temp0, tosl 00055f 9189 000560 9199 loadtos 000561 931a st -Y, temp1 000562 930a st -Y, temp0 000563 cbbb jmp_ DO_NEXT .include "words/over.asm" ; Stack ; Place a copy of x1 on top of the stack VE_OVER: 000564 ff04 .dw $ff04 000565 766f 000566 7265 .db "over" 000567 0559 .dw VE_HEAD .set VE_HEAD = VE_OVER XT_OVER: 000568 0569 .dw PFA_OVER PFA_OVER: 000569 939a 00056a 938a savetos 00056b 818a ldd tosl, Y+2 00056c 819b ldd tosh, Y+3 00056d cbb1 jmp_ DO_NEXT .include "words/drop.asm" ; Stack ; drop TOS VE_DROP: 00056e ff04 .dw $ff04 00056f 7264 000570 706f .db "drop" 000571 0564 .dw VE_HEAD .set VE_HEAD = VE_DROP XT_DROP: 000572 0573 .dw PFA_DROP PFA_DROP: 000573 9189 000574 9199 loadtos 000575 cba9 jmp_ DO_NEXT .include "words/rot.asm" ; Stack ; rotate the three top level cells VE_ROT: 000576 ff03 .dw $ff03 000577 6f72 000578 0074 .db "rot",0 000579 056e .dw VE_HEAD .set VE_HEAD = VE_ROT XT_ROT: 00057a 057b .dw PFA_ROT PFA_ROT: 00057b 018c movw temp0, tosl 00057c 9129 ld temp2, Y+ 00057d 9139 ld temp3, Y+ 00057e 9189 00057f 9199 loadtos 000580 933a st -Y, temp3 000581 932a st -Y, temp2 000582 931a st -Y, temp1 000583 930a st -Y, temp0 000584 cb9a jmp_ DO_NEXT .include "words/nip.asm" ; Stack ; Remove Second of Stack VE_NIP: 000585 ff03 .dw $ff03 000586 696e 000587 0070 .db "nip",0 000588 0576 .dw VE_HEAD .set VE_HEAD = VE_NIP XT_NIP: 000589 058a .dw PFA_NIP PFA_NIP: 00058a 9622 adiw yl, 2 00058b cb93 jmp_ DO_NEXT ;;;;;;;;;;;;;;;;;;;;;;;;; .include "words/r_from.asm" ; Stack ; move TOR to TOS VE_R_FROM: 00058c ff02 .dw $ff02 00058d 3e72 .db "r>" 00058e 0585 .dw VE_HEAD .set VE_HEAD = VE_R_FROM XT_R_FROM: 00058f 0590 .dw PFA_R_FROM PFA_R_FROM: 000590 939a 000591 938a savetos 000592 918f pop tosl 000593 919f pop tosh 000594 cb8a jmp_ DO_NEXT .include "words/to_r.asm" ; Stack ; move TOS to TOR VE_TO_R: 000595 ff02 .dw $ff02 000596 723e .db ">r" 000597 058c .dw VE_HEAD .set VE_HEAD = VE_TO_R XT_TO_R: 000598 0599 .dw PFA_TO_R PFA_TO_R: 000599 939f push tosh 00059a 938f push tosl 00059b 9189 00059c 9199 loadtos 00059d cb81 jmp_ DO_NEXT .include "words/r_fetch.asm" ; Stack ; fetch content of TOR VE_R_FETCH: 00059e ff02 .dw $ff02 00059f 4072 .db "r@" 0005a0 0595 .dw VE_HEAD .set VE_HEAD = VE_R_FETCH XT_R_FETCH: 0005a1 05a2 .dw PFA_R_FETCH PFA_R_FETCH: 0005a2 939a 0005a3 938a savetos 0005a4 918f pop tosl 0005a5 919f pop tosh 0005a6 939f push tosh 0005a7 938f push tosl 0005a8 cb76 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: 0005a9 ff02 .dw $ff02 0005aa 3e3c .db "<>" 0005ab 059e .dw VE_HEAD .set VE_HEAD = VE_NOTEQUAL XT_NOTEQUAL: 0005ac 011b .dw DO_COLON PFA_NOTEQUAL: .endif 0005ad 126d 0005ae 05b3 0005af 04ae .DW XT_EQUAL,XT_ZEROEQUAL,XT_EXIT .include "words/equalzero.asm" ; Compare ; compare with 0 (zero) VE_ZEROEQUAL: 0005b0 ff02 .dw $ff02 0005b1 3d30 .db "0=" 0005b2 05a9 .dw VE_HEAD .set VE_HEAD = VE_ZEROEQUAL XT_ZEROEQUAL: 0005b3 05b4 .dw PFA_ZEROEQUAL PFA_ZEROEQUAL: 0005b4 2b98 or tosh, tosl 0005b5 f5d1 brne PFA_ZERO1 0005b6 c030 rjmp PFA_TRUE1 .include "words/lesszero.asm" ; Compare ; compare with zero VE_ZEROLESS: 0005b7 ff02 .dw $ff02 0005b8 3c30 .db "0<" 0005b9 05b0 .dw VE_HEAD .set VE_HEAD = VE_ZEROLESS XT_ZEROLESS: 0005ba 05bb .dw PFA_ZEROLESS PFA_ZEROLESS: 0005bb fd97 sbrc tosh,7 0005bc c02a rjmp PFA_TRUE1 0005bd c032 rjmp PFA_ZERO1 .include "words/greaterzero.asm" ; Compare ; true if n1 is greater than 0 VE_GREATERZERO: 0005be ff02 .dw $ff02 0005bf 3e30 .db "0>" 0005c0 05b7 .dw VE_HEAD .set VE_HEAD = VE_GREATERZERO XT_GREATERZERO: 0005c1 05c2 .dw PFA_GREATERZERO PFA_GREATERZERO: 0005c2 1582 cp tosl, zerol 0005c3 0593 cpc tosh, zeroh 0005c4 f15c brlt PFA_ZERO1 0005c5 f151 brbs 1, PFA_ZERO1 0005c6 c020 rjmp PFA_TRUE1 .include "words/d-greaterzero.asm" ; Compare ; compares if a double double cell number is greater 0 VE_DGREATERZERO: 0005c7 ff03 .dw $ff03 0005c8 3064 0005c9 003e .db "d0>",0 0005ca 05be .dw VE_HEAD .set VE_HEAD = VE_DGREATERZERO XT_DGREATERZERO: 0005cb 05cc .dw PFA_DGREATERZERO PFA_DGREATERZERO: 0005cc 1582 cp tosl, zerol 0005cd 0593 cpc tosh, zeroh 0005ce 9189 0005cf 9199 loadtos 0005d0 0582 cpc tosl, zerol 0005d1 0593 cpc tosh, zeroh 0005d2 f0ec brlt PFA_ZERO1 0005d3 f0e1 brbs 1, PFA_ZERO1 0005d4 c012 rjmp PFA_TRUE1 .include "words/d-lesszero.asm" ; Compare ; compares if a double double cell number is less than 0 VE_DXT_ZEROLESS: 0005d5 ff03 .dw $ff03 0005d6 3064 0005d7 003c .db "d0<",0 0005d8 05c7 .dw VE_HEAD .set VE_HEAD = VE_DXT_ZEROLESS XT_DXT_ZEROLESS: 0005d9 05da .dw PFA_DXT_ZEROLESS PFA_DXT_ZEROLESS: 0005da 9622 adiw Y,2 0005db fd97 sbrc tosh,7 0005dc 940c 05e7 jmp PFA_TRUE1 0005de 940c 05f0 jmp PFA_ZERO1 .include "words/true.asm" ; Arithmetics ; leaves the value -1 (true) on TOS VE_TRUE: 0005e0 ff04 .dw $ff04 0005e1 7274 0005e2 6575 .db "true" 0005e3 05d5 .dw VE_HEAD .set VE_HEAD = VE_TRUE XT_TRUE: 0005e4 05e5 .dw PFA_TRUE PFA_TRUE: 0005e5 939a 0005e6 938a savetos PFA_TRUE1: 0005e7 ef8f ser tosl 0005e8 ef9f ser tosh 0005e9 cb35 jmp_ DO_NEXT .include "words/zero.asm" ; Arithmetics ; place a value 0 on TOS VE_ZERO: 0005ea ff01 .dw $ff01 0005eb 0030 .db "0",0 0005ec 05e0 .dw VE_HEAD .set VE_HEAD = VE_ZERO XT_ZERO: 0005ed 05ee .dw PFA_ZERO PFA_ZERO: 0005ee 939a 0005ef 938a savetos PFA_ZERO1: 0005f0 01c1 movw tosl, zerol 0005f1 cb2d jmp_ DO_NEXT .include "words/uless.asm" ; Compare ; true if u1 < u2 (unsigned) VE_ULESS: 0005f2 ff02 .dw $ff02 0005f3 3c75 .db "u<" 0005f4 05ea .dw VE_HEAD .set VE_HEAD = VE_ULESS XT_ULESS: 0005f5 05f6 .dw PFA_ULESS PFA_ULESS: 0005f6 9129 ld temp2, Y+ 0005f7 9139 ld temp3, Y+ 0005f8 1782 cp tosl, temp2 0005f9 0793 cpc tosh, temp3 0005fa f3a8 brlo PFA_ZERO1 0005fb f3a1 brbs 1, PFA_ZERO1 0005fc 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: 0005fd ff02 .dw $ff02 0005fe 3e75 .db "u>" 0005ff 05f2 .dw VE_HEAD .set VE_HEAD = VE_UGREATER XT_UGREATER: 000600 011b .dw DO_COLON PFA_UGREATER: .endif 000601 055d .DW XT_SWAP 000602 05f5 .dw XT_ULESS 000603 04ae .dw XT_EXIT .include "words/less.asm" ; Compare ; true if n1 is less than n2 VE_LESS: 000604 ff01 .dw $ff01 000605 003c .db "<",0 000606 05fd .dw VE_HEAD .set VE_HEAD = VE_LESS XT_LESS: 000607 0608 .dw PFA_LESS PFA_LESS: 000608 9129 ld temp2, Y+ 000609 9139 ld temp3, Y+ 00060a 1728 cp temp2, tosl 00060b 0739 cpc temp3, tosh PFA_LESSDONE: 00060c f71c brge PFA_ZERO1 00060d cfd9 rjmp PFA_TRUE1 .include "words/greater.asm" ; Compare ; flag is true if n1 is greater than n2 VE_GREATER: 00060e ff01 .dw $ff01 00060f 003e .db ">",0 000610 0604 .dw VE_HEAD .set VE_HEAD = VE_GREATER XT_GREATER: 000611 0612 .dw PFA_GREATER PFA_GREATER: 000612 9129 ld temp2, Y+ 000613 9139 ld temp3, Y+ 000614 1728 cp temp2, tosl 000615 0739 cpc temp3, tosh PFA_GREATERDONE: 000616 f2cc brlt PFA_ZERO1 000617 f2c1 brbs 1, PFA_ZERO1 000618 cfce rjmp PFA_TRUE1 .include "words/log2.asm" ; Arithmetics ; logarithm to base 2 or highest set bitnumber VE_LOG2: 000619 ff04 .dw $ff04 00061a 6f6c 00061b 3267 .db "log2" 00061c 060e .dw VE_HEAD .set VE_HEAD = VE_LOG2 XT_LOG2: 00061d 061e .dw PFA_LOG2 PFA_LOG2: 00061e 01fc movw zl, tosl 00061f 2799 clr tosh 000620 e180 ldi tosl, 16 PFA_LOG2_1: 000621 958a dec tosl 000622 f022 brmi PFA_LOG2_2 ; wrong data 000623 0fee lsl zl 000624 1fff rol zh 000625 f7d8 brcc PFA_LOG2_1 000626 caf8 jmp_ DO_NEXT PFA_LOG2_2: 000627 959a dec tosh 000628 caf6 jmp_ DO_NEXT .include "words/minus.asm" ; Arithmetics ; subtract n2 from n1 VE_MINUS: 000629 ff01 .dw $ff01 00062a 002d .db "-",0 00062b 0619 .dw VE_HEAD .set VE_HEAD = VE_MINUS XT_MINUS: 00062c 062d .dw PFA_MINUS PFA_MINUS: 00062d 9109 ld temp0, Y+ 00062e 9119 ld temp1, Y+ 00062f 1b08 sub temp0, tosl 000630 0b19 sbc temp1, tosh 000631 01c8 movw tosl, temp0 000632 caec jmp_ DO_NEXT .include "words/plus.asm" ; Arithmetics ; add n1 and n2 VE_PLUS: 000633 ff01 .dw $ff01 000634 002b .db "+",0 000635 0629 .dw VE_HEAD .set VE_HEAD = VE_PLUS XT_PLUS: 000636 0637 .dw PFA_PLUS PFA_PLUS: 000637 9109 ld temp0, Y+ 000638 9119 ld temp1, Y+ 000639 0f80 add tosl, temp0 00063a 1f91 adc tosh, temp1 00063b cae3 jmp_ DO_NEXT .include "words/mstar.asm" ; Arithmetics ; multiply 2 cells to a double cell VE_MSTAR: 00063c ff02 .dw $ff02 00063d 2a6d .db "m*" 00063e 0633 .dw VE_HEAD .set VE_HEAD = VE_MSTAR XT_MSTAR: 00063f 0640 .dw PFA_MSTAR PFA_MSTAR: 000640 018c movw temp0, tosl 000641 9189 000642 9199 loadtos 000643 019c movw temp2, tosl ; high cell ah*bh 000644 0231 muls temp3, temp1 000645 0170 movw temp4, r0 ; low cell al*bl 000646 9f20 mul temp2, temp0 000647 01c0 movw tosl, r0 ; signed ah*bl 000648 0330 mulsu temp3, temp0 000649 08f3 sbc temp5, zeroh 00064a 0d90 add tosh, r0 00064b 1ce1 adc temp4, r1 00064c 1cf3 adc temp5, zeroh ; signed al*bh 00064d 0312 mulsu temp1, temp2 00064e 08f3 sbc temp5, zeroh 00064f 0d90 add tosh, r0 000650 1ce1 adc temp4, r1 000651 1cf3 adc temp5, zeroh 000652 939a 000653 938a savetos 000654 01c7 movw tosl, temp4 000655 cac9 jmp_ DO_NEXT .include "words/umslashmod.asm" ; Arithmetics ; unsigned division ud / u2 with remainder VE_UMSLASHMOD: 000656 ff06 .dw $ff06 000657 6d75 000658 6d2f 000659 646f .db "um/mod" 00065a 063c .dw VE_HEAD .set VE_HEAD = VE_UMSLASHMOD XT_UMSLASHMOD: 00065b 065c .dw PFA_UMSLASHMOD PFA_UMSLASHMOD: 00065c 017c movw temp4, tosl 00065d 9129 ld temp2, Y+ 00065e 9139 ld temp3, Y+ 00065f 9109 ld temp0, Y+ 000660 9119 ld temp1, Y+ ;; unsigned 32/16 -> 16r16 divide PFA_UMSLASHMODmod: ; set loop counter 000661 e140 ldi temp6,$10 PFA_UMSLASHMODmod_loop: ; shift left, saving high bit 000662 2755 clr temp7 000663 0f00 lsl temp0 000664 1f11 rol temp1 000665 1f22 rol temp2 000666 1f33 rol temp3 000667 1f55 rol temp7 ; try subtracting divisor 000668 152e cp temp2, temp4 000669 053f cpc temp3, temp5 00066a 0552 cpc temp7,zerol 00066b f018 brcs PFA_UMSLASHMODmod_loop_control PFA_UMSLASHMODmod_subtract: ; dividend is large enough ; do the subtraction for real ; and set lowest bit 00066c 9503 inc temp0 00066d 192e sub temp2, temp4 00066e 093f sbc temp3, temp5 PFA_UMSLASHMODmod_loop_control: 00066f 954a dec temp6 000670 f789 brne PFA_UMSLASHMODmod_loop PFA_UMSLASHMODmod_done: ; put remainder on stack 000671 933a st -Y,temp3 000672 932a st -Y,temp2 ; put quotient on stack 000673 01c8 movw tosl, temp0 000674 caaa jmp_ DO_NEXT .include "words/umstar.asm" ; Arithmetics ; multiply 2 unsigned cells to a double cell VE_UMSTAR: 000675 ff03 .dw $ff03 000676 6d75 000677 002a .db "um*",0 000678 0656 .dw VE_HEAD .set VE_HEAD = VE_UMSTAR XT_UMSTAR: 000679 067a .dw PFA_UMSTAR PFA_UMSTAR: 00067a 018c movw temp0, tosl 00067b 9189 00067c 9199 loadtos ; result: (temp3*temp1)* 65536 + (temp3*temp0 + temp1*temp2) * 256 + (temp0 * temp2) ; low bytes 00067d 9f80 mul tosl,temp0 00067e 01f0 movw zl, r0 00067f 2722 clr temp2 000680 2733 clr temp3 ; middle bytes 000681 9f90 mul tosh, temp0 000682 0df0 add zh, r0 000683 1d21 adc temp2, r1 000684 1d33 adc temp3, zeroh 000685 9f81 mul tosl, temp1 000686 0df0 add zh, r0 000687 1d21 adc temp2, r1 000688 1d33 adc temp3, zeroh 000689 9f91 mul tosh, temp1 00068a 0d20 add temp2, r0 00068b 1d31 adc temp3, r1 00068c 01cf movw tosl, zl 00068d 939a 00068e 938a savetos 00068f 01c9 movw tosl, temp2 000690 ca8e jmp_ DO_NEXT .include "words/invert.asm" ; Arithmetics ; 1-complement of TOS VE_INVERT: 000691 ff06 .dw $ff06 000692 6e69 000693 6576 000694 7472 .db "invert" 000695 0675 .dw VE_HEAD .set VE_HEAD = VE_INVERT XT_INVERT: 000696 0697 .dw PFA_INVERT PFA_INVERT: 000697 9580 com tosl 000698 9590 com tosh 000699 ca85 jmp_ DO_NEXT .include "words/2slash.asm" ; Arithmetics ; arithmetic shift right VE_2SLASH: 00069a ff02 .dw $ff02 00069b 2f32 .db "2/" 00069c 0691 .dw VE_HEAD .set VE_HEAD = VE_2SLASH XT_2SLASH: 00069d 069e .dw PFA_2SLASH PFA_2SLASH: 00069e 9595 asr tosh 00069f 9587 ror tosl 0006a0 ca7e jmp_ DO_NEXT .include "words/2star.asm" ; Arithmetics ; arithmetic shift left, filling with zero VE_2STAR: 0006a1 ff02 .dw $ff02 0006a2 2a32 .db "2*" 0006a3 069a .dw VE_HEAD .set VE_HEAD = VE_2STAR XT_2STAR: 0006a4 06a5 .dw PFA_2STAR PFA_2STAR: 0006a5 0f88 lsl tosl 0006a6 1f99 rol tosh 0006a7 ca77 jmp_ DO_NEXT .include "words/and.asm" ; Logic ; bitwise and VE_AND: 0006a8 ff03 .dw $ff03 0006a9 6e61 0006aa 0064 .db "and",0 0006ab 06a1 .dw VE_HEAD .set VE_HEAD = VE_AND XT_AND: 0006ac 06ad .dw PFA_AND PFA_AND: 0006ad 9109 ld temp0, Y+ 0006ae 9119 ld temp1, Y+ 0006af 2380 and tosl, temp0 0006b0 2391 and tosh, temp1 0006b1 ca6d jmp_ DO_NEXT .include "words/or.asm" ; Logic ; logical or VE_OR: 0006b2 ff02 .dw $ff02 0006b3 726f .db "or" 0006b4 06a8 .dw VE_HEAD .set VE_HEAD = VE_OR XT_OR: 0006b5 06b6 .dw PFA_OR PFA_OR: 0006b6 9109 ld temp0, Y+ 0006b7 9119 ld temp1, Y+ 0006b8 2b80 or tosl, temp0 0006b9 2b91 or tosh, temp1 0006ba ca64 jmp_ DO_NEXT .include "words/xor.asm" ; Logic ; exclusive or VE_XOR: 0006bb ff03 .dw $ff03 0006bc 6f78 0006bd 0072 .db "xor",0 0006be 06b2 .dw VE_HEAD .set VE_HEAD = VE_XOR XT_XOR: 0006bf 06c0 .dw PFA_XOR PFA_XOR: 0006c0 9109 ld temp0, Y+ 0006c1 9119 ld temp1, Y+ 0006c2 2780 eor tosl, temp0 0006c3 2791 eor tosh, temp1 0006c4 ca5a jmp_ DO_NEXT .include "words/1plus.asm" ; Arithmetics ; optimized increment VE_1PLUS: 0006c5 ff02 .dw $ff02 0006c6 2b31 .db "1+" 0006c7 06bb .dw VE_HEAD .set VE_HEAD = VE_1PLUS XT_1PLUS: 0006c8 06c9 .dw PFA_1PLUS PFA_1PLUS: 0006c9 9601 adiw tosl,1 0006ca ca54 jmp_ DO_NEXT .include "words/1minus.asm" ; Arithmetics ; optimized decrement VE_1MINUS: 0006cb ff02 .dw $ff02 0006cc 2d31 .db "1-" 0006cd 06c5 .dw VE_HEAD .set VE_HEAD = VE_1MINUS XT_1MINUS: 0006ce 06cf .dw PFA_1MINUS PFA_1MINUS: 0006cf 9701 sbiw tosl, 1 0006d0 ca4e 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: 0006d1 ff07 .dw $ff07 0006d2 6e3f 0006d3 6765 0006d4 7461 ../../common\words/q-negate.asm(11): warning: .cseg .db misalignment - padding zero byte 0006d5 0065 .db "?negate" 0006d6 06cb .dw VE_HEAD .set VE_HEAD = VE_QNEGATE XT_QNEGATE: 0006d7 011b .dw DO_COLON PFA_QNEGATE: .endif 0006d8 05ba 0006d9 04c7 .DW XT_ZEROLESS,XT_DOCONDBRANCH 0006da 06dc DEST(QNEG1) 0006db 0aa5 .DW XT_NEGATE 0006dc 04ae QNEG1: .DW XT_EXIT .include "words/lshift.asm" ; Arithmetics ; logically shift n1 left n2 times VE_LSHIFT: 0006dd ff06 .dw $ff06 0006de 736c 0006df 6968 0006e0 7466 .db "lshift" 0006e1 06d1 .dw VE_HEAD .set VE_HEAD = VE_LSHIFT XT_LSHIFT: 0006e2 06e3 .dw PFA_LSHIFT PFA_LSHIFT: 0006e3 01fc movw zl, tosl 0006e4 9189 0006e5 9199 loadtos PFA_LSHIFT1: 0006e6 9731 sbiw zl, 1 0006e7 f01a brmi PFA_LSHIFT2 0006e8 0f88 lsl tosl 0006e9 1f99 rol tosh 0006ea cffb rjmp PFA_LSHIFT1 PFA_LSHIFT2: 0006eb ca33 jmp_ DO_NEXT .include "words/rshift.asm" ; Arithmetics ; shift n1 n2-times logically right VE_RSHIFT: 0006ec ff06 .dw $ff06 0006ed 7372 0006ee 6968 0006ef 7466 .db "rshift" 0006f0 06dd .dw VE_HEAD .set VE_HEAD = VE_RSHIFT XT_RSHIFT: 0006f1 06f2 .dw PFA_RSHIFT PFA_RSHIFT: 0006f2 01fc movw zl, tosl 0006f3 9189 0006f4 9199 loadtos PFA_RSHIFT1: 0006f5 9731 sbiw zl, 1 0006f6 f01a brmi PFA_RSHIFT2 0006f7 9596 lsr tosh 0006f8 9587 ror tosl 0006f9 cffb rjmp PFA_RSHIFT1 PFA_RSHIFT2: 0006fa ca24 jmp_ DO_NEXT .include "words/plusstore.asm" ; Arithmetics ; add n to content of RAM address a-addr VE_PLUSSTORE: 0006fb ff02 .dw $ff02 0006fc 212b .db "+!" 0006fd 06ec .dw VE_HEAD .set VE_HEAD = VE_PLUSSTORE XT_PLUSSTORE: 0006fe 06ff .dw PFA_PLUSSTORE PFA_PLUSSTORE: 0006ff 01fc movw zl, tosl 000700 9189 000701 9199 loadtos 000702 8120 ldd temp2, Z+0 000703 8131 ldd temp3, Z+1 000704 0f82 add tosl, temp2 000705 1f93 adc tosh, temp3 000706 8380 std Z+0, tosl 000707 8391 std Z+1, tosh 000708 9189 000709 9199 loadtos 00070a ca14 jmp_ DO_NEXT ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; .include "words/rpfetch.asm" ; Stack ; current return stack pointer address VE_RP_FETCH: 00070b ff03 .dw $ff03 00070c 7072 00070d 0040 .db "rp@",0 00070e 06fb .dw VE_HEAD .set VE_HEAD = VE_RP_FETCH XT_RP_FETCH: 00070f 0710 .dw PFA_RP_FETCH PFA_RP_FETCH: 000710 939a 000711 938a savetos 000712 b78d in tosl, SPL 000713 b79e in tosh, SPH 000714 ca0a jmp_ DO_NEXT .include "words/rpstore.asm" ; Stack ; set return stack pointer VE_RP_STORE: 000715 ff03 .dw $ff03 000716 7072 000717 0021 .db "rp!",0 000718 070b .dw VE_HEAD .set VE_HEAD = VE_RP_STORE XT_RP_STORE: 000719 071a .dw PFA_RP_STORE PFA_RP_STORE: 00071a b72f in temp2, SREG 00071b 94f8 cli 00071c bf8d out SPL, tosl 00071d bf9e out SPH, tosh 00071e bf2f out SREG, temp2 00071f 9189 000720 9199 loadtos 000721 c9fd jmp_ DO_NEXT .include "words/spfetch.asm" ; Stack ; current data stack pointer VE_SP_FETCH: 000722 ff03 .dw $ff03 000723 7073 000724 0040 .db "sp@",0 000725 0715 .dw VE_HEAD .set VE_HEAD = VE_SP_FETCH XT_SP_FETCH: 000726 0727 .dw PFA_SP_FETCH PFA_SP_FETCH: 000727 939a 000728 938a savetos 000729 01ce movw tosl, yl 00072a c9f4 jmp_ DO_NEXT .include "words/spstore.asm" ; Stack ; set data stack pointer to addr VE_SP_STORE: 00072b ff03 .dw $ff03 00072c 7073 00072d 0021 .db "sp!",0 00072e 0722 .dw VE_HEAD .set VE_HEAD = VE_SP_STORE XT_SP_STORE: 00072f 0730 .dw PFA_SP_STORE PFA_SP_STORE: 000730 01ec movw yl, tosl 000731 9189 000732 9199 loadtos 000733 c9eb 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: 000734 0735 .dw PFA_DODO PFA_DODO: 000735 9129 ld temp2, Y+ 000736 9139 ld temp3, Y+ ; limit PFA_DODO1: 000737 e8e0 ldi zl, $80 000738 0f3e add temp3, zl 000739 1b82 sub tosl, temp2 00073a 0b93 sbc tosh, temp3 00073b 933f push temp3 00073c 932f push temp2 ; limit ( --> limit + $8000) 00073d 939f push tosh 00073e 938f push tosl ; start -> index ( --> index - (limit - $8000) 00073f 9189 000740 9199 loadtos 000741 c9dd jmp_ DO_NEXT .include "words/i.asm" ; Compiler ; current loop counter VE_I: 000742 ff01 .dw $FF01 000743 0069 .db "i",0 000744 072b .dw VE_HEAD .set VE_HEAD = VE_I XT_I: 000745 0746 .dw PFA_I PFA_I: 000746 939a 000747 938a savetos 000748 918f pop tosl 000749 919f pop tosh ; index 00074a 91ef pop zl 00074b 91ff pop zh ; limit 00074c 93ff push zh 00074d 93ef push zl 00074e 939f push tosh 00074f 938f push tosl 000750 0f8e add tosl, zl 000751 1f9f adc tosh, zh 000752 c9cc 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: 000753 0754 .dw PFA_DOPLUSLOOP PFA_DOPLUSLOOP: 000754 91ef pop zl 000755 91ff pop zh 000756 0fe8 add zl, tosl 000757 1ff9 adc zh, tosh 000758 9189 000759 9199 loadtos 00075a f01b brvs PFA_DOPLUSLOOP_LEAVE ; next cycle PFA_DOPLUSLOOP_NEXT: ; next iteration 00075b 93ff push zh 00075c 93ef push zl 00075d cd60 rjmp PFA_DOBRANCH ; read next cell from dictionary and jump to its destination PFA_DOPLUSLOOP_LEAVE: 00075e 910f pop temp0 00075f 911f pop temp1 ; remove limit 000760 9611 adiw xl, 1 ; skip branch-back address 000761 c9bd 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: 000762 0763 .dw PFA_DOLOOP PFA_DOLOOP: 000763 91ef pop zl 000764 91ff pop zh 000765 9631 adiw zl,1 000766 f3bb brvs PFA_DOPLUSLOOP_LEAVE 000767 cff3 jmp_ PFA_DOPLUSLOOP_NEXT .include "words/unloop.asm" ; Compiler ; remove loop-sys, exit the loop and continue execution after it VE_UNLOOP: 000768 ff06 .dw $ff06 000769 6e75 00076a 6f6c 00076b 706f .db "unloop" 00076c 0742 .dw VE_HEAD .set VE_HEAD = VE_UNLOOP XT_UNLOOP: 00076d 076e .dw PFA_UNLOOP PFA_UNLOOP: 00076e 911f pop temp1 00076f 910f pop temp0 000770 911f pop temp1 000771 910f pop temp0 000772 c9ac jmp_ DO_NEXT ;;;;;;;;;;;;;;;;;;;;;;;;;;; .include "words/cmove_g.asm" ; Memory ; copy data in RAM from higher to lower addresses. VE_CMOVE_G: 000773 ff06 .dw $ff06 000774 6d63 000775 766f 000776 3e65 .db "cmove>" 000777 0768 .dw VE_HEAD .set VE_HEAD = VE_CMOVE_G XT_CMOVE_G: 000778 0779 .dw PFA_CMOVE_G PFA_CMOVE_G: 000779 93bf push xh 00077a 93af push xl 00077b 91e9 ld zl, Y+ 00077c 91f9 ld zh, Y+ ; addr-to 00077d 91a9 ld xl, Y+ 00077e 91b9 ld xh, Y+ ; addr-from 00077f 2f09 mov temp0, tosh 000780 2b08 or temp0, tosl 000781 f041 brbs 1, PFA_CMOVE_G1 000782 0fe8 add zl, tosl 000783 1ff9 adc zh, tosh 000784 0fa8 add xl, tosl 000785 1fb9 adc xh, tosh PFA_CMOVE_G2: 000786 911e ld temp1, -X 000787 9312 st -Z, temp1 000788 9701 sbiw tosl, 1 000789 f7e1 brbc 1, PFA_CMOVE_G2 PFA_CMOVE_G1: 00078a 91af pop xl 00078b 91bf pop xh 00078c 9189 00078d 9199 loadtos 00078e c990 jmp_ DO_NEXT .include "words/byteswap.asm" ; Arithmetics ; exchange the bytes of the TOS VE_BYTESWAP: 00078f ff02 .dw $ff02 000790 3c3e .db "><" 000791 0773 .dw VE_HEAD .set VE_HEAD = VE_BYTESWAP XT_BYTESWAP: 000792 0793 .dw PFA_BYTESWAP PFA_BYTESWAP: 000793 2f09 mov temp0, tosh 000794 2f98 mov tosh, tosl 000795 2f80 mov tosl, temp0 000796 c988 jmp_ DO_NEXT .include "words/up.asm" ; System Variable ; get user area pointer VE_UP_FETCH: 000797 ff03 .dw $ff03 000798 7075 000799 0040 .db "up@",0 00079a 078f .dw VE_HEAD .set VE_HEAD = VE_UP_FETCH XT_UP_FETCH: 00079b 079c .dw PFA_UP_FETCH PFA_UP_FETCH: 00079c 939a 00079d 938a savetos 00079e 01c2 movw tosl, upl 00079f c97f jmp_ DO_NEXT ; ( addr -- ) ; System Variable ; set user area pointer VE_UP_STORE: 0007a0 ff03 .dw $ff03 0007a1 7075 0007a2 0021 .db "up!",0 0007a3 0797 .dw VE_HEAD .set VE_HEAD = VE_UP_STORE XT_UP_STORE: 0007a4 07a5 .dw PFA_UP_STORE PFA_UP_STORE: 0007a5 012c movw upl, tosl 0007a6 9189 0007a7 9199 loadtos 0007a8 c976 jmp_ DO_NEXT .include "words/1ms.asm" ; Time ; busy waits (almost) exactly 1 millisecond VE_1MS: 0007a9 ff03 .dw $ff03 0007aa 6d31 0007ab 0073 .db "1ms",0 0007ac 07a0 .dw VE_HEAD .set VE_HEAD = VE_1MS XT_1MS: 0007ad 07ae .dw PFA_1MS PFA_1MS: 0007ae e6e6 0007af e0fe 0007b0 9731 0007b1 f7f1 0007b2 0000 delay 1000 0007b3 c96b jmp_ DO_NEXT .include "words/2to_r.asm" ; Stack ; move DTOS to TOR VE_2TO_R: 0007b4 ff03 .dw $ff03 0007b5 3e32 0007b6 0072 .db "2>r",0 0007b7 07a9 .dw VE_HEAD .set VE_HEAD = VE_2TO_R XT_2TO_R: 0007b8 07b9 .dw PFA_2TO_R PFA_2TO_R: 0007b9 01fc movw zl, tosl 0007ba 9189 0007bb 9199 loadtos 0007bc 939f push tosh 0007bd 938f push tosl 0007be 93ff push zh 0007bf 93ef push zl 0007c0 9189 0007c1 9199 loadtos 0007c2 c95c jmp_ DO_NEXT .include "words/2r_from.asm" ; Stack ; move DTOR to TOS VE_2R_FROM: 0007c3 ff03 .dw $ff03 0007c4 7232 0007c5 003e .db "2r>",0 0007c6 07b4 .dw VE_HEAD .set VE_HEAD = VE_2R_FROM XT_2R_FROM: 0007c7 07c8 .dw PFA_2R_FROM PFA_2R_FROM: 0007c8 939a 0007c9 938a savetos 0007ca 91ef pop zl 0007cb 91ff pop zh 0007cc 918f pop tosl 0007cd 919f pop tosh 0007ce 939a 0007cf 938a savetos 0007d0 01cf movw tosl, zl 0007d1 c94d jmp_ DO_NEXT .include "words/store-e.asm" ; Memory ; write n (2bytes) to eeprom address VE_STOREE: 0007d2 ff02 .dw $ff02 0007d3 6521 .db "!e" 0007d4 07c3 .dw VE_HEAD .set VE_HEAD = VE_STOREE XT_STOREE: 0007d5 07d6 .dw PFA_STOREE PFA_STOREE: .if WANT_UNIFIED == 1 .endif PFA_STOREE0: 0007d6 01fc movw zl, tosl 0007d7 9189 0007d8 9199 loadtos 0007d9 b72f in_ temp2, SREG 0007da 94f8 cli 0007db d028 rcall PFA_FETCHE2 0007dc b500 in_ temp0, EEDR 0007dd 1708 cp temp0,tosl 0007de f009 breq PFA_STOREE3 0007df d00b rcall PFA_STOREE1 PFA_STOREE3: 0007e0 9631 adiw zl,1 0007e1 d022 rcall PFA_FETCHE2 0007e2 b500 in_ temp0, EEDR 0007e3 1709 cp temp0,tosh 0007e4 f011 breq PFA_STOREE4 0007e5 2f89 mov tosl, tosh 0007e6 d004 rcall PFA_STOREE1 PFA_STOREE4: 0007e7 bf2f out_ SREG, temp2 0007e8 9189 0007e9 9199 loadtos 0007ea c934 jmp_ DO_NEXT PFA_STOREE1: 0007eb 99f9 sbic EECR, EEPE 0007ec cffe rjmp PFA_STOREE1 PFA_STOREE2: ; estore_wait_low_spm: 0007ed b707 in_ temp0, SPMCSR 0007ee fd00 sbrc temp0,SPMEN 0007ef cffd rjmp PFA_STOREE2 0007f0 bdf2 out_ EEARH,zh 0007f1 bde1 out_ EEARL,zl 0007f2 bd80 out_ EEDR, tosl 0007f3 9afa sbi EECR,EEMPE 0007f4 9af9 sbi EECR,EEPE 0007f5 9508 ret .if WANT_UNIFIED == 1 .endif .include "words/fetch-e.asm" ; Memory ; read 1 cell from eeprom VE_FETCHE: 0007f6 ff02 .dw $ff02 0007f7 6540 .db "@e" 0007f8 07d2 .dw VE_HEAD .set VE_HEAD = VE_FETCHE XT_FETCHE: 0007f9 07fa .dw PFA_FETCHE PFA_FETCHE: .if WANT_UNIFIED == 1 .endif PFA_FETCHE1: 0007fa b72f in_ temp2, SREG 0007fb 94f8 cli 0007fc 01fc movw zl, tosl 0007fd d006 rcall PFA_FETCHE2 0007fe b580 in_ tosl, EEDR 0007ff 9631 adiw zl,1 000800 d003 rcall PFA_FETCHE2 000801 b590 in_ tosh, EEDR 000802 bf2f out_ SREG, temp2 000803 c91b jmp_ DO_NEXT PFA_FETCHE2: 000804 99f9 sbic EECR, EEPE 000805 cffe rjmp PFA_FETCHE2 000806 bdf2 out_ EEARH,zh 000807 bde1 out_ EEARL,zl 000808 9af8 sbi EECR,EERE 000809 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: 00080a ff02 .dw $ff02 00080b 6921 .db "!i" 00080c 07f6 .dw VE_HEAD .set VE_HEAD = VE_STOREI XT_STOREI: 00080d 1079 .dw PFA_DODEFER1 PFA_STOREI: 00080e 00a4 .dw EE_STOREI 00080f 101a .dw XT_EDEFERFETCH 000810 1024 .dw XT_EDEFERSTORE .if FLASHEND > $10000 .include "words/store-i_big.asm" ; R( -- ) ; writes a cell in flash VE_DO_STOREI_BIG: 000811 ff04 .dw $ff04 000812 6928 000813 2921 .db "(i!)" 000814 080a .dw VE_HEAD .set VE_HEAD = VE_DO_STOREI_BIG XT_DO_STOREI: 000815 0816 .dw PFA_DO_STOREI_BIG PFA_DO_STOREI_BIG: 000816 019c movw temp2, tosl ; save the (word) address 000817 9189 000818 9199 loadtos ; get the new value for the flash cell 000819 93af push xl 00081a 93bf push xh 00081b 93cf push yl 00081c 93df push yh 00081d e0e1 ldi zl, byte3(DO_STOREI_atmega) 00081e bfeb out_ rampz, zl 00081f eff0 ldi zh, byte2(DO_STOREI_atmega) 000820 e0e0 ldi zl, byte1(DO_STOREI_atmega) 000821 9519 eicall 000822 91df pop yh 000823 91cf pop yl 000824 91bf pop xh 000825 91af pop xl ; finally clear the stack 000826 9189 000827 9199 loadtos 000828 c8f6 jmp_ DO_NEXT ; .set _pc = pc .org NRWW_START_ADDR DO_STOREI_atmega: ; write data to temp page buffer ; use the values in tosl/tosh at the ; appropiate place 01f000 d010 rcall pageload ; erase page if needed ; it is needed if a bit goes from 0 to 1 01f001 94e0 com temp4 01f002 94f0 com temp5 01f003 218e and tosl, temp4 01f004 219f and tosh, temp5 01f005 2b98 or tosh, tosl 01f006 f019 breq DO_STOREI_writepage 01f007 01f9 movw zl, temp2 01f008 e003 ldi temp0,(1<8000 .include "dict/core_8k.inc" .include "words/n_to_r.asm" ; Stack ; move n items from data stack to return stack VE_N_TO_R: 000836 ff03 .dw $ff03 000837 3e6e 000838 0072 .db "n>r",0 000839 0829 .dw VE_HEAD .set VE_HEAD = VE_N_TO_R XT_N_TO_R: 00083a 083b .dw PFA_N_TO_R PFA_N_TO_R: 00083b 01fc movw zl, tosl 00083c 2f08 mov temp0, tosl PFA_N_TO_R1: 00083d 9189 00083e 9199 loadtos 00083f 939f push tosh 000840 938f push tosl 000841 950a dec temp0 000842 f7d1 brne PFA_N_TO_R1 000843 93ef push zl 000844 93ff push zh 000845 9189 000846 9199 loadtos 000847 c8d7 jmp_ DO_NEXT .include "words/n_r_from.asm" ; Stack ; move n items from return stack to data stack VE_N_R_FROM: 000848 ff03 .dw $ff03 000849 726e 00084a 003e .db "nr>",0 00084b 0836 .dw VE_HEAD .set VE_HEAD = VE_N_R_FROM XT_N_R_FROM: 00084c 084d .dw PFA_N_R_FROM PFA_N_R_FROM: 00084d 939a 00084e 938a savetos 00084f 91ff pop zh 000850 91ef pop zl 000851 2f0e mov temp0, zl PFA_N_R_FROM1: 000852 918f pop tosl 000853 919f pop tosh 000854 939a 000855 938a savetos 000856 950a dec temp0 000857 f7d1 brne PFA_N_R_FROM1 000858 01cf movw tosl, zl 000859 c8c5 jmp_ DO_NEXT .include "words/d-2star.asm" ; Arithmetics ; shift a double cell left VE_D2STAR: 00085a ff03 .dw $ff03 00085b 3264 00085c 002a .db "d2*",0 00085d 0848 .dw VE_HEAD .set VE_HEAD = VE_D2STAR XT_D2STAR: 00085e 085f .dw PFA_D2STAR PFA_D2STAR: 00085f 9109 ld temp0, Y+ 000860 9119 ld temp1, Y+ 000861 0f00 lsl temp0 000862 1f11 rol temp1 000863 1f88 rol tosl 000864 1f99 rol tosh 000865 931a st -Y, temp1 000866 930a st -Y, temp0 000867 c8b7 jmp_ DO_NEXT .include "words/d-2slash.asm" ; Arithmetics ; shift a double cell value right VE_D2SLASH: 000868 ff03 .dw $ff03 000869 3264 00086a 002f .db "d2/",0 00086b 085a .dw VE_HEAD .set VE_HEAD = VE_D2SLASH XT_D2SLASH: 00086c 086d .dw PFA_D2SLASH PFA_D2SLASH: 00086d 9109 ld temp0, Y+ 00086e 9119 ld temp1, Y+ 00086f 9595 asr tosh 000870 9587 ror tosl 000871 9517 ror temp1 000872 9507 ror temp0 000873 931a st -Y, temp1 000874 930a st -Y, temp0 000875 c8a9 jmp_ DO_NEXT .include "words/d-plus.asm" ; Arithmetics ; add 2 double cell values VE_DPLUS: 000876 ff02 .dw $ff02 000877 2b64 .db "d+" 000878 0868 .dw VE_HEAD .set VE_HEAD = VE_DPLUS XT_DPLUS: 000879 087a .dw PFA_DPLUS PFA_DPLUS: 00087a 9129 ld temp2, Y+ 00087b 9139 ld temp3, Y+ 00087c 90e9 ld temp4, Y+ 00087d 90f9 ld temp5, Y+ 00087e 9149 ld temp6, Y+ 00087f 9159 ld temp7, Y+ 000880 0f24 add temp2, temp6 000881 1f35 adc temp3, temp7 000882 1d8e adc tosl, temp4 000883 1d9f adc tosh, temp5 000884 933a st -Y, temp3 000885 932a st -Y, temp2 000886 c898 jmp_ DO_NEXT .include "words/d-minus.asm" ; Arithmetics ; subtract d2 from d1 VE_DMINUS: 000887 ff02 .dw $ff02 000888 2d64 .db "d-" 000889 0876 .dw VE_HEAD .set VE_HEAD = VE_DMINUS XT_DMINUS: 00088a 088b .dw PFA_DMINUS PFA_DMINUS: 00088b 9129 ld temp2, Y+ 00088c 9139 ld temp3, Y+ 00088d 90e9 ld temp4, Y+ 00088e 90f9 ld temp5, Y+ 00088f 9149 ld temp6, Y+ 000890 9159 ld temp7, Y+ 000891 1b42 sub temp6, temp2 000892 0b53 sbc temp7, temp3 000893 0ae8 sbc temp4, tosl 000894 0af9 sbc temp5, tosh 000895 935a st -Y, temp7 000896 934a st -Y, temp6 000897 01c7 movw tosl, temp4 000898 c886 jmp_ DO_NEXT .include "words/d-invert.asm" ; Arithmetics ; invert all bits in the double cell value VE_DINVERT: 000899 ff07 .dw $ff07 00089a 6964 00089b 766e 00089c 7265 00089d 0074 .db "dinvert",0 00089e 0887 .dw VE_HEAD .set VE_HEAD = VE_DINVERT XT_DINVERT: 00089f 08a0 .dw PFA_DINVERT PFA_DINVERT: 0008a0 9109 ld temp0, Y+ 0008a1 9119 ld temp1, Y+ 0008a2 9580 com tosl 0008a3 9590 com tosh 0008a4 9500 com temp0 0008a5 9510 com temp1 0008a6 931a st -Y, temp1 0008a7 930a st -Y, temp0 0008a8 c876 jmp_ DO_NEXT .include "words/u-dot.asm" ; Numeric IO ; unsigned PNO with single cell numbers .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_UDOT: 0008a9 ff02 .dw $ff02 0008aa 2e75 .db "u." 0008ab 0899 .dw VE_HEAD .set VE_HEAD = VE_UDOT XT_UDOT: 0008ac 011b .dw DO_COLON PFA_UDOT: .endif 0008ad 05ed .dw XT_ZERO 0008ae 0b90 .dw XT_UDDOT 0008af 04ae .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: 0008b0 ff03 .dw $ff03 0008b1 2e75 0008b2 0072 .db "u.r",0 0008b3 08a9 .dw VE_HEAD .set VE_HEAD = VE_UDOTR XT_UDOTR: 0008b4 011b .dw DO_COLON PFA_UDOTR: .endif 0008b5 05ed .dw XT_ZERO 0008b6 055d .dw XT_SWAP 0008b7 0b99 .dw XT_UDDOTR 0008b8 04ae .dw XT_EXIT ; : u.r ( s n -- ) 0 swap ud.r ; .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: 0008b9 ff0d .dw $ff0d 0008ba 6873 0008bb 776f 0008bc 772d 0008bd 726f 0008be 6c64 0008bf 7369 0008c0 0074 .db "show-wordlist",0 0008c1 08b0 .dw VE_HEAD .set VE_HEAD = VE_SHOWWORDLIST XT_SHOWWORDLIST: 0008c2 011b .dw DO_COLON PFA_SHOWWORDLIST: .endif 0008c3 04ce .dw XT_DOLITERAL 0008c4 08c8 .dw XT_SHOWWORD 0008c5 055d .dw XT_SWAP 0008c6 10bd .dw XT_TRAVERSEWORDLIST 0008c7 04ae .dw XT_EXIT .if cpu_msp430==1 .endif .if cpu_avr8==1 XT_SHOWWORD: 0008c8 011b .dw DO_COLON PFA_SHOWWORD: .endif 0008c9 10d8 .dw XT_NAME2STRING 0008ca 0c06 .dw XT_ITYPE 0008cb 0c48 .dw XT_SPACE ; ( -- addr n) 0008cc 05e4 .dw XT_TRUE 0008cd 04ae .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: 0008ce ff05 .dw $ff05 0008cf 6f77 0008d0 6472 0008d1 0073 .db "words",0 0008d2 08b9 .dw VE_HEAD .set VE_HEAD = VE_WORDS XT_WORDS: 0008d3 011b .dw DO_COLON PFA_WORDS: .endif 0008d4 04ce .dw XT_DOLITERAL 0008d5 008a .dw CFG_ORDERLISTLEN+2 0008d6 07f9 .dw XT_FETCHE 0008d7 08c2 .dw XT_SHOWWORDLIST 0008d8 04ae .dw XT_EXIT .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: 0008d9 ff04 .dw $ff04 0008da 692b 0008db 746e .db "+int" 0008dc 08ce .dw VE_HEAD .set VE_HEAD = VE_INTON XT_INTON: 0008dd 08de .dw PFA_INTON PFA_INTON: 0008de 9478 sei 0008df c83f jmp_ DO_NEXT .include "words/int-off.asm" ; Interrupt ; turns off all interrupts VE_INTOFF: 0008e0 ff04 .dw $ff04 0008e1 692d 0008e2 746e .db "-int" 0008e3 08d9 .dw VE_HEAD .set VE_HEAD = VE_INTOFF XT_INTOFF: 0008e4 08e5 .dw PFA_INTOFF PFA_INTOFF: 0008e5 94f8 cli 0008e6 c838 jmp_ DO_NEXT .include "words/int-store.asm" ; Interrupt ; stores XT as interrupt vector i VE_INTSTORE: 0008e7 ff04 .dw $ff04 0008e8 6e69 0008e9 2174 .db "int!" 0008ea 08e0 .dw VE_HEAD .set VE_HEAD = VE_INTSTORE XT_INTSTORE: 0008eb 011b .dw DO_COLON PFA_INTSTORE: 0008ec 04ce .dw XT_DOLITERAL 0008ed 0000 .dw intvec 0008ee 0636 .dw XT_PLUS 0008ef 07d5 .dw XT_STOREE 0008f0 04ae .dw XT_EXIT .include "words/int-fetch.asm" ; Interrupt ; fetches XT from interrupt vector i VE_INTFETCH: 0008f1 ff04 .dw $ff04 0008f2 6e69 0008f3 4074 .db "int@" 0008f4 08e7 .dw VE_HEAD .set VE_HEAD = VE_INTFETCH XT_INTFETCH: 0008f5 011b .dw DO_COLON PFA_INTFETCH: 0008f6 04ce .dw XT_DOLITERAL 0008f7 0000 .dw intvec 0008f8 0636 .dw XT_PLUS 0008f9 07f9 .dw XT_FETCHE 0008fa 04ae .dw XT_EXIT .include "words/int-trap.asm" ; Interrupt ; trigger an interrupt VE_INTTRAP: 0008fb ff08 .dw $ff08 0008fc 6e69 0008fd 2d74 0008fe 7274 0008ff 7061 .db "int-trap" 000900 08f1 .dw VE_HEAD .set VE_HEAD = VE_INTTRAP XT_INTTRAP: 000901 0902 .dw PFA_INTTRAP PFA_INTTRAP: 000902 2eb8 mov isrflag, tosl 000903 9189 000904 9199 loadtos 000905 c819 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: 000906 011b .dw DO_COLON PFA_ISREXEC: 000907 08f5 .dw XT_INTFETCH 000908 04b8 .dw XT_EXECUTE 000909 090b .dw XT_ISREND 00090a 04ae .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: 00090b 090c .dw PFA_ISREND PFA_ISREND: 00090c d001 rcall PFA_ISREND1 ; clear the interrupt flag for the controller 00090d c811 jmp_ DO_NEXT PFA_ISREND1: 00090e 9518 reti .endif .include "words/pick.asm" .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_PICK: 00090f ff04 .dw $ff04 000910 6970 000911 6b63 .db "pick" 000912 08fb .dw VE_HEAD .set VE_HEAD = VE_PICK XT_PICK: 000913 011b .dw DO_COLON PFA_PICK: .endif 000914 06c8 .dw XT_1PLUS 000915 09bc .dw XT_CELLS 000916 0726 .dw XT_SP_FETCH 000917 0636 .dw XT_PLUS 000918 0512 .dw XT_FETCH 000919 04ae .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: 00091a 0002 .dw $0002 00091b 222e .db ".",$22 00091c 090f .dw VE_HEAD .set VE_HEAD = VE_DOTSTRING XT_DOTSTRING: 00091d 011b .dw DO_COLON PFA_DOTSTRING: .endif 00091e 0925 .dw XT_SQUOTE 00091f 01d1 .dw XT_COMPILE 000920 0c06 .dw XT_ITYPE 000921 04ae .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: 000922 0002 .dw $0002 000923 2273 .db "s",$22 000924 091a .dw VE_HEAD .set VE_HEAD = VE_SQUOTE XT_SQUOTE: 000925 011b .dw DO_COLON PFA_SQUOTE: .endif 000926 04ce .dw XT_DOLITERAL 000927 0022 .dw 34 ; 0x22 000928 0ded .dw XT_PARSE ; ( -- addr n) 000929 09af .dw XT_STATE 00092a 0512 .dw XT_FETCH 00092b 04c7 .dw XT_DOCONDBRANCH 00092c 092e DEST(PFA_SQUOTE1) 00092d 01fd .dw XT_SLITERAL PFA_SQUOTE1: 00092e 04ae .dw XT_EXIT .include "words/fill.asm" ; Memory ; fill u bytes memory beginning at a-addr with character c VE_FILL: 00092f ff04 .dw $ff04 000930 6966 000931 6c6c .db "fill" 000932 0922 .dw VE_HEAD .set VE_HEAD = VE_FILL XT_FILL: 000933 011b .dw DO_COLON PFA_FILL: 000934 057a .dw XT_ROT 000935 057a .dw XT_ROT 000936 0552 000937 04c7 .dw XT_QDUP,XT_DOCONDBRANCH 000938 0940 DEST(PFA_FILL2) 000939 124c .dw XT_BOUNDS 00093a 0734 .dw XT_DODO PFA_FILL1: 00093b 054a .dw XT_DUP 00093c 0745 .dw XT_I 00093d 0526 .dw XT_CSTORE ; ( -- c c-addr) 00093e 0762 .dw XT_DOLOOP 00093f 093b .dw PFA_FILL1 PFA_FILL2: 000940 0572 .dw XT_DROP 000941 04ae .dw XT_EXIT .include "words/environment.asm" ; System Value ; word list identifier of the environmental search list VE_ENVIRONMENT: 000942 ff0b .dw $ff0b 000943 6e65 000944 6976 000945 6f72 000946 6d6e 000947 6e65 000948 0074 .db "environment",0 000949 092f .dw VE_HEAD .set VE_HEAD = VE_ENVIRONMENT XT_ENVIRONMENT: 00094a 04dc .dw PFA_DOVARIABLE PFA_ENVIRONMENT: 00094b 0082 .dw CFG_ENVIRONMENT .include "words/env-wordlists.asm" ; Environment ; maximum number of wordlists in the dictionary search order VE_ENVWORDLISTS: 00094c ff09 .dw $ff09 00094d 6f77 00094e 6472 00094f 696c 000950 7473 000951 0073 .db "wordlists",0 000952 0000 .dw VE_ENVHEAD .set VE_ENVHEAD = VE_ENVWORDLISTS XT_ENVWORDLISTS: 000953 011b .dw DO_COLON PFA_ENVWORDLISTS: 000954 04ce .dw XT_DOLITERAL 000955 0008 .dw NUMWORDLISTS 000956 04ae .dw XT_EXIT .include "words/env-slashpad.asm" ; Environment ; Size of the PAD buffer in bytes VE_ENVSLASHPAD: 000957 ff04 .dw $ff04 000958 702f 000959 6461 .db "/pad" 00095a 094c .dw VE_ENVHEAD .set VE_ENVHEAD = VE_ENVSLASHPAD XT_ENVSLASHPAD: 00095b 011b .dw DO_COLON PFA_ENVSLASHPAD: 00095c 0726 .dw XT_SP_FETCH 00095d 09e9 .dw XT_PAD 00095e 062c .dw XT_MINUS 00095f 04ae .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: 000960 ff05 .dw $ff05 000961 682f 000962 6c6f 000963 0064 .db "/hold",0 000964 0957 .dw VE_ENVHEAD .set VE_ENVHEAD = VE_ENVSLASHHOLD XT_ENVSLASHHOLD: 000965 011b .dw DO_COLON PFA_ENVSLASHHOLD: .endif 000966 09e9 .dw XT_PAD 000967 0a24 .dw XT_HERE 000968 062c .dw XT_MINUS 000969 04ae .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: 00096a ff0a .dw $ff0a 00096b 6f66 00096c 7472 00096d 2d68 00096e 616e 00096f 656d .db "forth-name" 000970 0960 .dw VE_ENVHEAD .set VE_ENVHEAD = VE_ENV_FORTHNAME XT_ENV_FORTHNAME: 000971 011b .dw DO_COLON PFA_EN_FORTHNAME: 000972 0bd3 .dw XT_DOSLITERAL 000973 0007 .dw 7 .endif 000974 6d61 000975 6f66 000976 7472 ../../common\words/env-forthname.asm(22): warning: .cseg .db misalignment - padding zero byte 000977 0068 .db "amforth" .if cpu_msp430==1 .endif 000978 04ae .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: 000979 ff07 .dw $ff07 00097a 6576 00097b 7372 00097c 6f69 00097d 006e .db "version",0 00097e 096a .dw VE_ENVHEAD .set VE_ENVHEAD = VE_ENV_FORTHVERSION XT_ENV_FORTHVERSION: 00097f 011b .dw DO_COLON PFA_EN_FORTHVERSION: .endif 000980 04ce .dw XT_DOLITERAL 000981 0041 .dw 65 000982 04ae .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: 000983 ff03 .dw $ff03 000984 7063 000985 0075 .db "cpu",0 000986 0979 .dw VE_ENVHEAD .set VE_ENVHEAD = VE_ENV_CPU XT_ENV_CPU: 000987 011b .dw DO_COLON PFA_EN_CPU: .endif 000988 04ce .dw XT_DOLITERAL 000989 0075 .dw mcu_name 00098a 0c32 .dw XT_ICOUNT 00098b 04ae .dw XT_EXIT .include "words/env-mcuinfo.asm" ; Environment ; flash address of some CPU specific parameters VE_ENV_MCUINFO: 00098c ff08 .dw $ff08 00098d 636d 00098e 2d75 00098f 6e69 000990 6f66 .db "mcu-info" 000991 0983 .dw VE_ENVHEAD .set VE_ENVHEAD = VE_ENV_MCUINFO XT_ENV_MCUINFO: 000992 011b .dw DO_COLON PFA_EN_MCUINFO: 000993 04ce .dw XT_DOLITERAL 000994 0071 .dw mcu_info 000995 04ae .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: 000996 ff05 .dw $ff05 000997 752f 000998 6573 000999 0072 .db "/user",0 00099a 098c .dw VE_ENVHEAD .set VE_ENVHEAD = VE_ENVUSERSIZE XT_ENVUSERSIZE: 00099b 011b .dw DO_COLON PFA_ENVUSERSIZE: .endif 00099c 04ce .dw XT_DOLITERAL 00099d 002c .dw SYSUSERSIZE + APPUSERSIZE 00099e 04ae .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: 00099f ff05 .dw $ff05 0009a0 5f66 0009a1 7063 0009a2 0075 .db "f_cpu",0 0009a3 0942 .dw VE_HEAD .set VE_HEAD = VE_F_CPU XT_F_CPU: 0009a4 011b .dw DO_COLON PFA_F_CPU: .endif 0009a5 04ce .dw XT_DOLITERAL 0009a6 0000 .dw (F_CPU % 65536) 0009a7 04ce .dw XT_DOLITERAL 0009a8 00e1 .dw (F_CPU / 65536) 0009a9 04ae .dw XT_EXIT .include "words/state.asm" ; System Variable ; system state VE_STATE: 0009aa ff05 .dw $ff05 0009ab 7473 0009ac 7461 0009ad 0065 .db "state",0 0009ae 099f .dw VE_HEAD .set VE_HEAD = VE_STATE XT_STATE: 0009af 04dc .dw PFA_DOVARIABLE PFA_STATE: 0009b0 0253 .dw ram_state .dseg 000253 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: 0009b1 ff04 .dw $ff04 0009b2 6162 0009b3 6573 .db "base" 0009b4 09aa .dw VE_HEAD .set VE_HEAD = VE_BASE XT_BASE: 0009b5 04ef .dw PFA_DOUSER PFA_BASE: .endif 0009b6 000c .dw USER_BASE .include "words/cells.asm" ; Arithmetics ; n2 is the size in address units of n1 cells VE_CELLS: 0009b7 ff05 .dw $ff05 0009b8 6563 0009b9 6c6c 0009ba 0073 .db "cells",0 0009bb 09b1 .dw VE_HEAD .set VE_HEAD = VE_CELLS XT_CELLS: 0009bc 06a5 .dw PFA_2STAR .include "words/cellplus.asm" ; Arithmetics ; add the size of an address-unit to a-addr1 VE_CELLPLUS: 0009bd ff05 .dw $ff05 0009be 6563 0009bf 6c6c 0009c0 002b .db "cell+",0 0009c1 09b7 .dw VE_HEAD .set VE_HEAD = VE_CELLPLUS XT_CELLPLUS: 0009c2 09c3 .dw PFA_CELLPLUS PFA_CELLPLUS: 0009c3 9602 adiw tosl, CELLSIZE 0009c4 940c 011f jmp_ DO_NEXT .include "words/2dup.asm" ; Stack ; Duplicate the 2 top elements .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_2DUP: 0009c6 ff04 .dw $ff04 0009c7 6432 0009c8 7075 .db "2dup" 0009c9 09bd .dw VE_HEAD .set VE_HEAD = VE_2DUP XT_2DUP: 0009ca 011b .dw DO_COLON PFA_2DUP: .endif 0009cb 0568 .dw XT_OVER 0009cc 0568 .dw XT_OVER 0009cd 04ae .dw XT_EXIT .include "words/2drop.asm" ; Stack ; Remove the 2 top elements .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_2DROP: 0009ce ff05 .dw $ff05 0009cf 6432 0009d0 6f72 0009d1 0070 .db "2drop",0 0009d2 09c6 .dw VE_HEAD .set VE_HEAD = VE_2DROP XT_2DROP: 0009d3 011b .dw DO_COLON PFA_2DROP: .endif 0009d4 0572 .dw XT_DROP 0009d5 0572 .dw XT_DROP 0009d6 04ae .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: 0009d7 ff04 .dw $ff04 0009d8 7574 0009d9 6b63 .db "tuck" 0009da 09ce .dw VE_HEAD .set VE_HEAD = VE_TUCK XT_TUCK: 0009db 011b .dw DO_COLON PFA_TUCK: .endif 0009dc 055d .dw XT_SWAP 0009dd 0568 .dw XT_OVER 0009de 04ae .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: 0009df ff03 .dw $ff03 0009e0 693e 0009e1 006e .db ">in",0 0009e2 09d7 .dw VE_HEAD .set VE_HEAD = VE_TO_IN XT_TO_IN: 0009e3 04ef .dw PFA_DOUSER PFA_TO_IN: .endif 0009e4 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: 0009e5 ff03 .dw $ff03 0009e6 6170 0009e7 0064 .db "pad",0 0009e8 09df .dw VE_HEAD .set VE_HEAD = VE_PAD XT_PAD: 0009e9 011b .dw DO_COLON PFA_PAD: .endif 0009ea 0a24 .dw XT_HERE 0009eb 04ce .dw XT_DOLITERAL 0009ec 0028 .dw 40 0009ed 0636 .dw XT_PLUS 0009ee 04ae .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: 0009ef ff04 .dw $ff04 0009f0 6d65 0009f1 7469 .db "emit" 0009f2 09e5 .dw VE_HEAD .set VE_HEAD = VE_EMIT XT_EMIT: 0009f3 1079 .dw PFA_DODEFER1 PFA_EMIT: .endif 0009f4 000e .dw USER_EMIT 0009f5 1042 .dw XT_UDEFERFETCH 0009f6 104e .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: 0009f7 ff05 .dw $ff05 0009f8 6d65 0009f9 7469 0009fa 003f .db "emit?",0 0009fb 09ef .dw VE_HEAD .set VE_HEAD = VE_EMITQ XT_EMITQ: 0009fc 1079 .dw PFA_DODEFER1 PFA_EMITQ: .endif 0009fd 0010 .dw USER_EMITQ 0009fe 1042 .dw XT_UDEFERFETCH 0009ff 104e .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: 000a00 ff03 .dw $ff03 000a01 656b 000a02 0079 .db "key",0 000a03 09f7 .dw VE_HEAD .set VE_HEAD = VE_KEY XT_KEY: 000a04 1079 .dw PFA_DODEFER1 PFA_KEY: .endif 000a05 0012 .dw USER_KEY 000a06 1042 .dw XT_UDEFERFETCH 000a07 104e .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: 000a08 ff04 .dw $ff04 000a09 656b 000a0a 3f79 .db "key?" 000a0b 0a00 .dw VE_HEAD .set VE_HEAD = VE_KEYQ XT_KEYQ: 000a0c 1079 .dw PFA_DODEFER1 PFA_KEYQ: .endif 000a0d 0014 .dw USER_KEYQ 000a0e 1042 .dw XT_UDEFERFETCH 000a0f 104e .dw XT_UDEFERSTORE .include "words/dp.asm" ; System Value ; address of the next free dictionary cell VE_DP: 000a10 ff02 .dw $ff02 000a11 7064 .db "dp" 000a12 0a08 .dw VE_HEAD .set VE_HEAD = VE_DP XT_DP: 000a13 0509 .dw PFA_DOVALUE1 PFA_DP: 000a14 0074 .dw CFG_DP 000a15 101a .dw XT_EDEFERFETCH 000a16 1024 .dw XT_EDEFERSTORE .include "words/ehere.asm" ; System Value ; address of the next free address in eeprom VE_EHERE: 000a17 ff05 .dw $ff05 000a18 6865 000a19 7265 000a1a 0065 .db "ehere",0 000a1b 0a10 .dw VE_HEAD .set VE_HEAD = VE_EHERE XT_EHERE: 000a1c 0509 .dw PFA_DOVALUE1 PFA_EHERE: 000a1d 0078 .dw EE_EHERE 000a1e 101a .dw XT_EDEFERFETCH 000a1f 1024 .dw XT_EDEFERSTORE .include "words/here.asm" ; System Value ; address of the next free data space (RAM) cell VE_HERE: 000a20 ff04 .dw $ff04 000a21 6568 000a22 6572 .db "here" 000a23 0a17 .dw VE_HEAD .set VE_HEAD = VE_HERE XT_HERE: 000a24 0509 .dw PFA_DOVALUE1 PFA_HERE: 000a25 0076 .dw EE_HERE 000a26 101a .dw XT_EDEFERFETCH 000a27 1024 .dw XT_EDEFERSTORE .include "words/allot.asm" ; System ; allocate or release memory in RAM VE_ALLOT: 000a28 ff05 .dw $ff05 000a29 6c61 000a2a 6f6c 000a2b 0074 .db "allot",0 000a2c 0a20 .dw VE_HEAD .set VE_HEAD = VE_ALLOT XT_ALLOT: 000a2d 011b .dw DO_COLON PFA_ALLOT: 000a2e 0a24 .dw XT_HERE 000a2f 0636 .dw XT_PLUS 000a30 0fff .dw XT_DOTO 000a31 0a25 .dw PFA_HERE 000a32 04ae .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: 000a33 ff03 .dw $ff03 000a34 6962 000a35 006e .db "bin",0 000a36 0a28 .dw VE_HEAD .set VE_HEAD = VE_BIN XT_BIN: 000a37 011b .dw DO_COLON PFA_BIN: .endif 000a38 1279 .dw XT_TWO 000a39 09b5 .dw XT_BASE 000a3a 051a .dw XT_STORE 000a3b 04ae .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: 000a3c ff07 .dw $ff07 000a3d 6564 000a3e 6963 000a3f 616d 000a40 006c .db "decimal",0 000a41 0a33 .dw VE_HEAD .set VE_HEAD = VE_DECIMAL XT_DECIMAL: 000a42 011b .dw DO_COLON PFA_DECIMAL: .endif 000a43 04ce .dw XT_DOLITERAL 000a44 000a .dw 10 000a45 09b5 .dw XT_BASE 000a46 051a .dw XT_STORE 000a47 04ae .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: 000a48 ff03 .dw $ff03 000a49 6568 000a4a 0078 .db "hex",0 000a4b 0a3c .dw VE_HEAD .set VE_HEAD = VE_HEX XT_HEX: 000a4c 011b .dw DO_COLON PFA_HEX: .endif 000a4d 04ce .dw XT_DOLITERAL 000a4e 0010 .dw 16 000a4f 09b5 .dw XT_BASE 000a50 051a .dw XT_STORE 000a51 04ae .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: 000a52 ff02 .dw $ff02 000a53 6c62 .db "bl" 000a54 0a48 .dw VE_HEAD .set VE_HEAD = VE_BL XT_BL: 000a55 04dc .dw PFA_DOVARIABLE PFA_BL: .endif 000a56 0020 .dw 32 .include "words/turnkey.asm" ; System Value ; Deferred action during startup/reset VE_TURNKEY: 000a57 ff07 .dw $ff07 000a58 7574 000a59 6e72 000a5a 656b 000a5b 0079 .db "turnkey",0 000a5c 0a52 .dw VE_HEAD .set VE_HEAD = VE_TURNKEY XT_TURNKEY: 000a5d 1079 .dw PFA_DODEFER1 PFA_TURNKEY: 000a5e 0080 .dw CFG_TURNKEY 000a5f 101a .dw XT_EDEFERFETCH 000a60 1024 .dw XT_EDEFERSTORE ;;;;;;;;;;;;;;;;;;;;;;;;;;;; .include "words/slashmod.asm" ; Arithmetics ; signed division n1/n2 with remainder and quotient VE_SLASHMOD: 000a61 ff04 .dw $ff04 000a62 6d2f 000a63 646f .db "/mod" 000a64 0a57 .dw VE_HEAD .set VE_HEAD = VE_SLASHMOD XT_SLASHMOD: 000a65 0a66 .dw PFA_SLASHMOD PFA_SLASHMOD: 000a66 019c movw temp2, tosl 000a67 9109 ld temp0, Y+ 000a68 9119 ld temp1, Y+ 000a69 2f41 mov temp6,temp1 ;move dividend High to sign register 000a6a 2743 eor temp6,temp3 ;xor divisor High with sign register 000a6b ff17 sbrs temp1,7 ;if MSB in dividend set 000a6c c004 rjmp PFA_SLASHMOD_1 000a6d 9510 com temp1 ; change sign of dividend 000a6e 9500 com temp0 000a6f 5f0f subi temp0,low(-1) 000a70 4f1f sbci temp1,high(-1) PFA_SLASHMOD_1: 000a71 ff37 sbrs temp3,7 ;if MSB in divisor set 000a72 c004 rjmp PFA_SLASHMOD_2 000a73 9530 com temp3 ; change sign of divisor 000a74 9520 com temp2 000a75 5f2f subi temp2,low(-1) 000a76 4f3f sbci temp3,high(-1) 000a77 24ee PFA_SLASHMOD_2: clr temp4 ;clear remainder Low byte 000a78 18ff sub temp5,temp5;clear remainder High byte and carry 000a79 e151 ldi temp7,17 ;init loop counter 000a7a 1f00 PFA_SLASHMOD_3: rol temp0 ;shift left dividend 000a7b 1f11 rol temp1 000a7c 955a dec temp7 ;decrement counter 000a7d f439 brne PFA_SLASHMOD_5 ;if done 000a7e ff47 sbrs temp6,7 ; if MSB in sign register set 000a7f c004 rjmp PFA_SLASHMOD_4 000a80 9510 com temp1 ; change sign of result 000a81 9500 com temp0 000a82 5f0f subi temp0,low(-1) 000a83 4f1f sbci temp1,high(-1) 000a84 c00b PFA_SLASHMOD_4: rjmp PFA_SLASHMODmod_done ; return 000a85 1cee PFA_SLASHMOD_5: rol temp4 ;shift dividend into remainder 000a86 1cff rol temp5 000a87 1ae2 sub temp4,temp2 ;remainder = remainder - divisor 000a88 0af3 sbc temp5,temp3 ; 000a89 f420 brcc PFA_SLASHMOD_6 ;if result negative 000a8a 0ee2 add temp4,temp2 ; restore remainder 000a8b 1ef3 adc temp5,temp3 000a8c 9488 clc ; clear carry to be shifted into result 000a8d cfec rjmp PFA_SLASHMOD_3 ;else 000a8e 9408 PFA_SLASHMOD_6: sec ; set carry to be shifted into result 000a8f cfea rjmp PFA_SLASHMOD_3 PFA_SLASHMODmod_done: ; put remainder on stack 000a90 92fa st -Y,temp5 000a91 92ea st -Y,temp4 ; put quotient on stack 000a92 01c8 movw tosl, temp0 000a93 940c 011f jmp_ DO_NEXT .include "words/uslashmod.asm" ; Arithmetics ; unsigned division with remainder VE_USLASHMOD: 000a95 ff05 .dw $ff05 000a96 2f75 000a97 6f6d 000a98 0064 .db "u/mod",0 000a99 0a61 .dw VE_HEAD .set VE_HEAD = VE_USLASHMOD XT_USLASHMOD: 000a9a 011b .dw DO_COLON PFA_USLASHMOD: 000a9b 0598 .dw XT_TO_R 000a9c 05ed .dw XT_ZERO 000a9d 058f .dw XT_R_FROM 000a9e 065b .dw XT_UMSLASHMOD 000a9f 04ae .dw XT_EXIT .include "words/negate.asm" ; Logic ; 2-complement VE_NEGATE: 000aa0 ff06 .dw $ff06 000aa1 656e 000aa2 6167 000aa3 6574 .db "negate" 000aa4 0a95 .dw VE_HEAD .set VE_HEAD = VE_NEGATE XT_NEGATE: 000aa5 011b .dw DO_COLON PFA_NEGATE: 000aa6 0696 .dw XT_INVERT 000aa7 06c8 .dw XT_1PLUS 000aa8 04ae .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: 000aa9 ff01 .dw $ff01 000aaa 002f .db "/",0 000aab 0aa0 .dw VE_HEAD .set VE_HEAD = VE_SLASH XT_SLASH: 000aac 011b .dw DO_COLON PFA_SLASH: .endif 000aad 0a65 .dw XT_SLASHMOD 000aae 0589 .dw XT_NIP 000aaf 04ae .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: 000ab0 ff03 .dw $ff03 000ab1 6f6d 000ab2 0064 .db "mod",0 000ab3 0aa9 .dw VE_HEAD .set VE_HEAD = VE_MOD XT_MOD: 000ab4 011b .dw DO_COLON PFA_MOD: .endif 000ab5 0a65 .dw XT_SLASHMOD 000ab6 0572 .dw XT_DROP 000ab7 04ae .dw XT_EXIT .include "words/abs.asm" ; DUP ?NEGATE ; .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_ABS: 000ab8 ff03 .dw $ff03 000ab9 6261 000aba 0073 .db "abs",0 000abb 0ab0 .dw VE_HEAD .set VE_HEAD = VE_ABS XT_ABS: 000abc 011b .dw DO_COLON PFA_ABS: .endif 000abd 054a 000abe 06d7 000abf 04ae .DW XT_DUP,XT_QNEGATE,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: 000ac0 ff03 .dw $ff03 000ac1 696d 000ac2 006e .db "min",0 000ac3 0ab8 .dw VE_HEAD .set VE_HEAD = VE_MIN XT_MIN: 000ac4 011b .dw DO_COLON PFA_MIN: .endif 000ac5 09ca .dw XT_2DUP 000ac6 0611 .dw XT_GREATER 000ac7 04c7 .dw XT_DOCONDBRANCH 000ac8 0aca DEST(PFA_MIN1) 000ac9 055d .dw XT_SWAP PFA_MIN1: 000aca 0572 .dw XT_DROP 000acb 04ae .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: 000acc ff03 .dw $ff03 000acd 616d 000ace 0078 .db "max",0 000acf 0ac0 .dw VE_HEAD .set VE_HEAD = VE_MAX XT_MAX: 000ad0 011b .dw DO_COLON PFA_MAX: .endif 000ad1 09ca .dw XT_2DUP 000ad2 0607 .dw XT_LESS 000ad3 04c7 .dw XT_DOCONDBRANCH 000ad4 0ad6 DEST(PFA_MAX1) 000ad5 055d .dw XT_SWAP PFA_MAX1: 000ad6 0572 .dw XT_DROP 000ad7 04ae .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: 000ad8 ff06 .dw $ff06 000ad9 6977 000ada 6874 000adb 6e69 .db "within" 000adc 0acc .dw VE_HEAD .set VE_HEAD = VE_WITHIN XT_WITHIN: 000add 011b .dw DO_COLON PFA_WITHIN: .endif 000ade 0568 .dw XT_OVER 000adf 062c .dw XT_MINUS 000ae0 0598 .dw XT_TO_R 000ae1 062c .dw XT_MINUS 000ae2 058f .dw XT_R_FROM 000ae3 05f5 .dw XT_ULESS 000ae4 04ae .dw XT_EXIT .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: 000ae5 ff07 .dw $ff07 000ae6 6f74 000ae7 7075 000ae8 6570 000ae9 0072 .db "toupper",0 000aea 0ad8 .dw VE_HEAD .set VE_HEAD = VE_TOUPPER XT_TOUPPER: 000aeb 011b .dw DO_COLON PFA_TOUPPER: .endif 000aec 054a .dw XT_DUP 000aed 04ce .dw XT_DOLITERAL 000aee 0061 .dw 'a' 000aef 04ce .dw XT_DOLITERAL 000af0 007b .dw 'z'+1 000af1 0add .dw XT_WITHIN 000af2 04c7 .dw XT_DOCONDBRANCH 000af3 0af7 DEST(PFA_TOUPPER0) 000af4 04ce .dw XT_DOLITERAL 000af5 00df .dw 223 ; inverse of 0x20: 0xdf 000af6 06ac .dw XT_AND PFA_TOUPPER0: 000af7 04ae .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: 000af8 ff07 .dw $ff07 000af9 6f74 000afa 6f6c 000afb 6577 000afc 0072 .db "tolower",0 000afd 0ae5 .dw VE_HEAD .set VE_HEAD = VE_TOLOWER XT_TOLOWER: 000afe 011b .dw DO_COLON PFA_TOLOWER: .endif 000aff 054a .dw XT_DUP 000b00 04ce .dw XT_DOLITERAL 000b01 0041 .dw 'A' 000b02 04ce .dw XT_DOLITERAL 000b03 005b .dw 'Z'+1 000b04 0add .dw XT_WITHIN 000b05 04c7 .dw XT_DOCONDBRANCH 000b06 0b0a DEST(PFA_TOLOWER0) 000b07 04ce .dw XT_DOLITERAL 000b08 0020 .dw 32 000b09 06b5 .dw XT_OR PFA_TOLOWER0: 000b0a 04ae .dw XT_EXIT ;;;;;;;;;;;;;;;;;;;;;; .include "words/hld.asm" ; Numeric IO ; pointer to current write position in the Pictured Numeric Output buffer VE_HLD: 000b0b ff03 .dw $ff03 000b0c 6c68 000b0d 0064 .db "hld",0 000b0e 0af8 .dw VE_HEAD .set VE_HEAD = VE_HLD XT_HLD: 000b0f 04dc .dw PFA_DOVARIABLE PFA_HLD: 000b10 0255 .dw ram_hld .dseg 000255 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: 000b11 ff04 .dw $ff04 000b12 6f68 000b13 646c .db "hold" 000b14 0b0b .dw VE_HEAD .set VE_HEAD = VE_HOLD XT_HOLD: 000b15 011b .dw DO_COLON PFA_HOLD: .endif 000b16 0b0f .dw XT_HLD 000b17 054a .dw XT_DUP 000b18 0512 .dw XT_FETCH 000b19 06ce .dw XT_1MINUS 000b1a 054a .dw XT_DUP 000b1b 0598 .dw XT_TO_R 000b1c 055d .dw XT_SWAP 000b1d 051a .dw XT_STORE 000b1e 058f .dw XT_R_FROM 000b1f 0526 .dw XT_CSTORE 000b20 04ae .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: 000b21 ff02 .dw $ff02 000b22 233c .db "<#" 000b23 0b11 .dw VE_HEAD .set VE_HEAD = VE_L_SHARP XT_L_SHARP: 000b24 011b .dw DO_COLON PFA_L_SHARP: .endif 000b25 09e9 .dw XT_PAD 000b26 0b0f .dw XT_HLD 000b27 051a .dw XT_STORE 000b28 04ae .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: 000b29 ff01 .dw $ff01 000b2a 0023 .db "#",0 000b2b 0b21 .dw VE_HEAD .set VE_HEAD = VE_SHARP XT_SHARP: 000b2c 011b .dw DO_COLON PFA_SHARP: .endif 000b2d 09b5 .dw XT_BASE 000b2e 0512 .dw XT_FETCH 000b2f 0ba9 .dw XT_UDSLASHMOD 000b30 057a .dw XT_ROT 000b31 04ce .dw XT_DOLITERAL 000b32 0009 .dw 9 000b33 0568 .dw XT_OVER 000b34 0607 .dw XT_LESS 000b35 04c7 .dw XT_DOCONDBRANCH 000b36 0b3a DEST(PFA_SHARP1) 000b37 04ce .dw XT_DOLITERAL 000b38 0007 .dw 7 000b39 0636 .dw XT_PLUS PFA_SHARP1: 000b3a 04ce .dw XT_DOLITERAL 000b3b 0030 .dw 48 ; ASCII 0 000b3c 0636 .dw XT_PLUS 000b3d 0b15 .dw XT_HOLD 000b3e 04ae .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: 000b3f ff02 .dw $ff02 000b40 7323 .db "#s" 000b41 0b29 .dw VE_HEAD .set VE_HEAD = VE_SHARP_S XT_SHARP_S: 000b42 011b .dw DO_COLON PFA_SHARP_S: .endif NUMS1: 000b43 0b2c .dw XT_SHARP 000b44 09ca .dw XT_2DUP 000b45 06b5 .dw XT_OR 000b46 05b3 .dw XT_ZEROEQUAL 000b47 04c7 .dw XT_DOCONDBRANCH 000b48 0b43 DEST(NUMS1) ; PFA_SHARP_S 000b49 04ae .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: 000b4a ff02 .dw $ff02 000b4b 3e23 .db "#>" 000b4c 0b3f .dw VE_HEAD .set VE_HEAD = VE_SHARP_G XT_SHARP_G: 000b4d 011b .dw DO_COLON PFA_SHARP_G: .endif 000b4e 09d3 .dw XT_2DROP 000b4f 0b0f .dw XT_HLD 000b50 0512 .dw XT_FETCH 000b51 09e9 .dw XT_PAD 000b52 0568 .dw XT_OVER 000b53 062c .dw XT_MINUS 000b54 04ae .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: 000b55 ff04 .dw $ff04 000b56 6973 000b57 6e67 .db "sign" 000b58 0b4a .dw VE_HEAD .set VE_HEAD = VE_SIGN XT_SIGN: 000b59 011b .dw DO_COLON PFA_SIGN: .endif 000b5a 05ba .dw XT_ZEROLESS 000b5b 04c7 .dw XT_DOCONDBRANCH 000b5c 0b60 DEST(PFA_SIGN1) 000b5d 04ce .dw XT_DOLITERAL 000b5e 002d .dw 45 ; ascii - 000b5f 0b15 .dw XT_HOLD PFA_SIGN1: 000b60 04ae .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: 000b61 ff03 .dw $ff03 000b62 2e64 000b63 0072 .db "d.r",0 000b64 0b55 .dw VE_HEAD .set VE_HEAD = VE_DDOTR XT_DDOTR: 000b65 011b .dw DO_COLON PFA_DDOTR: .endif 000b66 0598 .dw XT_TO_R 000b67 09db .dw XT_TUCK 000b68 113a .dw XT_DABS 000b69 0b24 .dw XT_L_SHARP 000b6a 0b42 .dw XT_SHARP_S 000b6b 057a .dw XT_ROT 000b6c 0b59 .dw XT_SIGN 000b6d 0b4d .dw XT_SHARP_G 000b6e 058f .dw XT_R_FROM 000b6f 0568 .dw XT_OVER 000b70 062c .dw XT_MINUS 000b71 0c51 .dw XT_SPACES 000b72 0c61 .dw XT_TYPE 000b73 04ae .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: 000b74 ff02 .dw $ff02 000b75 722e .db ".r" 000b76 0b61 .dw VE_HEAD .set VE_HEAD = VE_DOTR XT_DOTR: 000b77 011b .dw DO_COLON PFA_DOTR: .endif 000b78 0598 .dw XT_TO_R 000b79 1255 .dw XT_S2D 000b7a 058f .dw XT_R_FROM 000b7b 0b65 .dw XT_DDOTR 000b7c 04ae .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: 000b7d ff02 .dw $ff02 000b7e 2e64 .db "d." 000b7f 0b74 .dw VE_HEAD .set VE_HEAD = VE_DDOT XT_DDOT: 000b80 011b .dw DO_COLON PFA_DDOT: .endif 000b81 05ed .dw XT_ZERO 000b82 0b65 .dw XT_DDOTR 000b83 0c48 .dw XT_SPACE 000b84 04ae .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: 000b85 ff01 .dw $ff01 000b86 002e .db ".",0 000b87 0b7d .dw VE_HEAD .set VE_HEAD = VE_DOT XT_DOT: 000b88 011b .dw DO_COLON PFA_DOT: .endif 000b89 1255 .dw XT_S2D 000b8a 0b80 .dw XT_DDOT 000b8b 04ae .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: 000b8c ff03 .dw $ff03 000b8d 6475 000b8e 002e .db "ud.",0 000b8f 0b85 .dw VE_HEAD .set VE_HEAD = VE_UDDOT XT_UDDOT: 000b90 011b .dw DO_COLON PFA_UDDOT: .endif 000b91 05ed .dw XT_ZERO 000b92 0b99 .dw XT_UDDOTR 000b93 0c48 .dw XT_SPACE 000b94 04ae .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: 000b95 ff04 .dw $ff04 000b96 6475 000b97 722e .db "ud.r" 000b98 0b8c .dw VE_HEAD .set VE_HEAD = VE_UDDOTR XT_UDDOTR: 000b99 011b .dw DO_COLON PFA_UDDOTR: .endif 000b9a 0598 .dw XT_TO_R 000b9b 0b24 .dw XT_L_SHARP 000b9c 0b42 .dw XT_SHARP_S 000b9d 0b4d .dw XT_SHARP_G 000b9e 058f .dw XT_R_FROM 000b9f 0568 .dw XT_OVER 000ba0 062c .dw XT_MINUS 000ba1 0c51 .dw XT_SPACES 000ba2 0c61 .dw XT_TYPE 000ba3 04ae .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: 000ba4 ff06 .dw $ff06 000ba5 6475 000ba6 6d2f 000ba7 646f .db "ud/mod" 000ba8 0b95 .dw VE_HEAD .set VE_HEAD = VE_UDSLASHMOD XT_UDSLASHMOD: 000ba9 011b .dw DO_COLON PFA_UDSLASHMOD: .endif 000baa 0598 .dw XT_TO_R 000bab 05ed .dw XT_ZERO 000bac 05a1 .dw XT_R_FETCH 000bad 065b .dw XT_UMSLASHMOD 000bae 058f .dw XT_R_FROM 000baf 055d .dw XT_SWAP 000bb0 0598 .dw XT_TO_R 000bb1 065b .dw XT_UMSLASHMOD 000bb2 058f .dw XT_R_FROM 000bb3 04ae .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: 000bb4 ff06 .dw $ff06 000bb5 6964 000bb6 6967 000bb7 3f74 .db "digit?" 000bb8 0ba4 .dw VE_HEAD .set VE_HEAD = VE_DIGITQ XT_DIGITQ: 000bb9 011b .dw DO_COLON PFA_DIGITQ: .endif 000bba 0aeb .dw XT_TOUPPER 000bbb 054a 000bbc 04ce 000bbd 0039 000bbe 0611 000bbf 04ce 000bc0 0100 .DW XT_DUP,XT_DOLITERAL,57,XT_GREATER,XT_DOLITERAL,256 000bc1 06ac 000bc2 0636 000bc3 054a 000bc4 04ce 000bc5 0140 000bc6 0611 .DW XT_AND,XT_PLUS,XT_DUP,XT_DOLITERAL,320,XT_GREATER 000bc7 04ce 000bc8 0107 000bc9 06ac 000bca 062c 000bcb 04ce 000bcc 0030 .DW XT_DOLITERAL,263,XT_AND,XT_MINUS,XT_DOLITERAL,48 000bcd 062c 000bce 054a 000bcf 09b5 000bd0 0512 000bd1 05f5 .DW XT_MINUS,XT_DUP,XT_BASE,XT_FETCH,XT_ULESS 000bd2 04ae .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: 000bd3 011b .dw DO_COLON PFA_DOSLITERAL: 000bd4 05a1 .dw XT_R_FETCH ; ( -- addr ) 000bd5 0c32 .dw XT_ICOUNT 000bd6 058f .dw XT_R_FROM 000bd7 0568 .dw XT_OVER ; ( -- addr' n addr n) 000bd8 06c8 .dw XT_1PLUS 000bd9 069d .dw XT_2SLASH ; ( -- addr' n addr k ) 000bda 0636 .dw XT_PLUS ; ( -- addr' n addr'' ) 000bdb 06c8 .dw XT_1PLUS 000bdc 0598 .dw XT_TO_R ; ( -- ) 000bdd 04ae .dw XT_EXIT .include "words/scomma.asm" ; Compiler ; compiles a string from RAM to Flash VE_SCOMMA: 000bde ff02 .dw $ff02 000bdf 2c73 .db "s",$2c 000be0 0bb4 .dw VE_HEAD .set VE_HEAD = VE_SCOMMA XT_SCOMMA: 000be1 011b .dw DO_COLON PFA_SCOMMA: 000be2 054a .dw XT_DUP 000be3 0be5 .dw XT_DOSCOMMA 000be4 04ae .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: 000be5 011b .dw DO_COLON PFA_DOSCOMMA: 000be6 01dc .dw XT_COMMA 000be7 054a .dw XT_DUP ; ( --addr len len) 000be8 069d .dw XT_2SLASH ; ( -- addr len len/2 000be9 09db .dw XT_TUCK ; ( -- addr len/2 len len/2 000bea 06a4 .dw XT_2STAR ; ( -- addr len/2 len len' 000beb 062c .dw XT_MINUS ; ( -- addr len/2 rem 000bec 0598 .dw XT_TO_R 000bed 05ed .dw XT_ZERO 000bee 029b .dw XT_QDOCHECK 000bef 04c7 .dw XT_DOCONDBRANCH 000bf0 0bf8 .dw PFA_SCOMMA2 000bf1 0734 .dw XT_DODO PFA_SCOMMA1: 000bf2 054a .dw XT_DUP ; ( -- addr addr ) 000bf3 0512 .dw XT_FETCH ; ( -- addr c1c2 ) 000bf4 01dc .dw XT_COMMA ; ( -- addr ) 000bf5 09c2 .dw XT_CELLPLUS ; ( -- addr+cell ) 000bf6 0762 .dw XT_DOLOOP 000bf7 0bf2 .dw PFA_SCOMMA1 PFA_SCOMMA2: 000bf8 058f .dw XT_R_FROM 000bf9 05c1 .dw XT_GREATERZERO 000bfa 04c7 .dw XT_DOCONDBRANCH 000bfb 0bff .dw PFA_SCOMMA3 000bfc 054a .dw XT_DUP ; well, tricky 000bfd 0531 .dw XT_CFETCH 000bfe 01dc .dw XT_COMMA PFA_SCOMMA3: 000bff 0572 .dw XT_DROP ; ( -- ) 000c00 04ae .dw XT_EXIT .include "words/itype.asm" ; Tools ; reads string from flash and prints it VE_ITYPE: 000c01 ff05 .dw $ff05 000c02 7469 000c03 7079 000c04 0065 .db "itype",0 000c05 0bde .dw VE_HEAD .set VE_HEAD = VE_ITYPE XT_ITYPE: 000c06 011b .dw DO_COLON PFA_ITYPE: 000c07 054a .dw XT_DUP ; ( --addr len len) 000c08 069d .dw XT_2SLASH ; ( -- addr len len/2 000c09 09db .dw XT_TUCK ; ( -- addr len/2 len len/2 000c0a 06a4 .dw XT_2STAR ; ( -- addr len/2 len len' 000c0b 062c .dw XT_MINUS ; ( -- addr len/2 rem 000c0c 0598 .dw XT_TO_R 000c0d 05ed .dw XT_ZERO 000c0e 029b .dw XT_QDOCHECK 000c0f 04c7 .dw XT_DOCONDBRANCH 000c10 0c1a .dw PFA_ITYPE2 000c11 0734 .dw XT_DODO PFA_ITYPE1: 000c12 054a .dw XT_DUP ; ( -- addr addr ) 000c13 082c .dw XT_FETCHI ; ( -- addr c1c2 ) 000c14 054a .dw XT_DUP 000c15 0c27 .dw XT_LOWEMIT 000c16 0c23 .dw XT_HIEMIT 000c17 06c8 .dw XT_1PLUS ; ( -- addr+cell ) 000c18 0762 .dw XT_DOLOOP 000c19 0c12 .dw PFA_ITYPE1 PFA_ITYPE2: 000c1a 058f .dw XT_R_FROM 000c1b 05c1 .dw XT_GREATERZERO 000c1c 04c7 .dw XT_DOCONDBRANCH 000c1d 0c21 .dw PFA_ITYPE3 000c1e 054a .dw XT_DUP ; make sure the drop below has always something to do 000c1f 082c .dw XT_FETCHI 000c20 0c27 .dw XT_LOWEMIT PFA_ITYPE3: 000c21 0572 .dw XT_DROP 000c22 04ae .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: 000c23 011b .dw DO_COLON PFA_HIEMIT: 000c24 0792 .dw XT_BYTESWAP 000c25 0c27 .dw XT_LOWEMIT 000c26 04ae .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: 000c27 011b .dw DO_COLON PFA_LOWEMIT: 000c28 04ce .dw XT_DOLITERAL 000c29 00ff .dw $00ff 000c2a 06ac .dw XT_AND 000c2b 09f3 .dw XT_EMIT 000c2c 04ae .dw XT_EXIT .include "words/icount.asm" ; Tools ; get count information out of a counted string in flash VE_ICOUNT: 000c2d ff06 .dw $ff06 000c2e 6369 000c2f 756f 000c30 746e .db "icount" 000c31 0c01 .dw VE_HEAD .set VE_HEAD = VE_ICOUNT XT_ICOUNT: 000c32 011b .dw DO_COLON PFA_ICOUNT: 000c33 054a .dw XT_DUP 000c34 06c8 .dw XT_1PLUS 000c35 055d .dw XT_SWAP 000c36 082c .dw XT_FETCHI 000c37 04ae .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: 000c38 ff02 .dw 0xff02 000c39 7263 .db "cr" 000c3a 0c2d .dw VE_HEAD .set VE_HEAD = VE_CR XT_CR: 000c3b 011b .dw DO_COLON PFA_CR: .endif 000c3c 04ce .dw XT_DOLITERAL 000c3d 000d .dw 13 000c3e 09f3 .dw XT_EMIT 000c3f 04ce .dw XT_DOLITERAL 000c40 000a .dw 10 000c41 09f3 .dw XT_EMIT 000c42 04ae .dw XT_EXIT .include "words/space.asm" ; Character IO ; emits a space (bl) .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_SPACE: 000c43 ff05 .dw $ff05 000c44 7073 000c45 6361 000c46 0065 .db "space",0 000c47 0c38 .dw VE_HEAD .set VE_HEAD = VE_SPACE XT_SPACE: 000c48 011b .dw DO_COLON PFA_SPACE: .endif 000c49 0a55 .dw XT_BL 000c4a 09f3 .dw XT_EMIT 000c4b 04ae .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: 000c4c ff06 .dw $ff06 000c4d 7073 000c4e 6361 000c4f 7365 .db "spaces" 000c50 0c43 .dw VE_HEAD .set VE_HEAD = VE_SPACES XT_SPACES: 000c51 011b .dw DO_COLON PFA_SPACES: .endif ;C SPACES n -- output n spaces ; BEGIN DUP 0> WHILE SPACE 1- REPEAT DROP ; 000c52 05ed 000c53 0ad0 .DW XT_ZERO, XT_MAX 000c54 054a 000c55 04c7 SPCS1: .DW XT_DUP,XT_DOCONDBRANCH 000c56 0c5b DEST(SPCS2) 000c57 0c48 000c58 06ce 000c59 04bd .DW XT_SPACE,XT_1MINUS,XT_DOBRANCH 000c5a 0c54 DEST(SPCS1) 000c5b 0572 000c5c 04ae SPCS2: .DW XT_DROP,XT_EXIT .include "words/type.asm" ; Character IO ; print a RAM based string .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_TYPE: 000c5d ff04 .dw $ff04 000c5e 7974 000c5f 6570 .db "type" 000c60 0c4c .dw VE_HEAD .set VE_HEAD = VE_TYPE XT_TYPE: 000c61 011b .dw DO_COLON PFA_TYPE: .endif 000c62 124c .dw XT_BOUNDS 000c63 029b .dw XT_QDOCHECK 000c64 04c7 .dw XT_DOCONDBRANCH 000c65 0c6c DEST(PFA_TYPE2) 000c66 0734 .dw XT_DODO PFA_TYPE1: 000c67 0745 .dw XT_I 000c68 0531 .dw XT_CFETCH 000c69 09f3 .dw XT_EMIT 000c6a 0762 .dw XT_DOLOOP 000c6b 0c67 DEST(PFA_TYPE1) PFA_TYPE2: 000c6c 04ae .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: 000c6d ff01 .dw $ff01 000c6e 0027 .db "'",0 000c6f 0c5d .dw VE_HEAD .set VE_HEAD = VE_TICK XT_TICK: 000c70 011b .dw DO_COLON PFA_TICK: .endif 000c71 0e1a .dw XT_PARSENAME 000c72 0f32 .dw XT_FORTHRECOGNIZER 000c73 0f3d .dw XT_RECOGNIZE ; a word is tickable unless DT:TOKEN is DT:NULL or ; the interpret action is a NOOP 000c74 054a .dw XT_DUP 000c75 0fb0 .dw XT_DT_NULL 000c76 126d .dw XT_EQUAL 000c77 055d .dw XT_SWAP 000c78 082c .dw XT_FETCHI 000c79 04ce .dw XT_DOLITERAL 000c7a 0fe5 .dw XT_NOOP 000c7b 126d .dw XT_EQUAL 000c7c 06b5 .dw XT_OR 000c7d 04c7 .dw XT_DOCONDBRANCH 000c7e 0c82 DEST(PFA_TICK1) 000c7f 04ce .dw XT_DOLITERAL 000c80 fff3 .dw -13 000c81 0ca7 .dw XT_THROW PFA_TICK1: 000c82 0572 .dw XT_DROP 000c83 04ae .dw XT_EXIT ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; .include "words/handler.asm" ; Exceptions ; USER variable used by catch/throw .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_HANDLER: 000c84 ff07 .dw $ff07 000c85 6168 000c86 646e 000c87 656c 000c88 0072 .db "handler",0 000c89 0c6d .dw VE_HEAD .set VE_HEAD = VE_HANDLER XT_HANDLER: 000c8a 04ef .dw PFA_DOUSER PFA_HANDLER: .endif 000c8b 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: 000c8c ff05 .dw $ff05 000c8d 6163 000c8e 6374 000c8f 0068 .db "catch",0 000c90 0c84 .dw VE_HEAD .set VE_HEAD = VE_CATCH XT_CATCH: 000c91 011b .dw DO_COLON PFA_CATCH: .endif ; sp@ >r 000c92 0726 .dw XT_SP_FETCH 000c93 0598 .dw XT_TO_R ; handler @ >r 000c94 0c8a .dw XT_HANDLER 000c95 0512 .dw XT_FETCH 000c96 0598 .dw XT_TO_R ; rp@ handler ! 000c97 070f .dw XT_RP_FETCH 000c98 0c8a .dw XT_HANDLER 000c99 051a .dw XT_STORE 000c9a 04b8 .dw XT_EXECUTE ; r> handler ! 000c9b 058f .dw XT_R_FROM 000c9c 0c8a .dw XT_HANDLER 000c9d 051a .dw XT_STORE 000c9e 058f .dw XT_R_FROM 000c9f 0572 .dw XT_DROP 000ca0 05ed .dw XT_ZERO 000ca1 04ae .dw XT_EXIT .include "words/throw.asm" ; Exceptions ; throw an exception .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_THROW: 000ca2 ff05 .dw $ff05 000ca3 6874 000ca4 6f72 000ca5 0077 .db "throw",0 000ca6 0c8c .dw VE_HEAD .set VE_HEAD = VE_THROW XT_THROW: 000ca7 011b .dw DO_COLON PFA_THROW: .endif 000ca8 054a .dw XT_DUP 000ca9 05b3 .dw XT_ZEROEQUAL 000caa 04c7 .dw XT_DOCONDBRANCH 000cab 0cae DEST(PFA_THROW1) 000cac 0572 .dw XT_DROP 000cad 04ae .dw XT_EXIT PFA_THROW1: 000cae 0c8a .dw XT_HANDLER 000caf 0512 .dw XT_FETCH 000cb0 0719 .dw XT_RP_STORE 000cb1 058f .dw XT_R_FROM 000cb2 0c8a .dw XT_HANDLER 000cb3 051a .dw XT_STORE 000cb4 058f .dw XT_R_FROM 000cb5 055d .dw XT_SWAP 000cb6 0598 .dw XT_TO_R 000cb7 072f .dw XT_SP_STORE 000cb8 0572 .dw XT_DROP 000cb9 058f .dw XT_R_FROM 000cba 04ae .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: 000cbb ff05 .dw $ff05 000cbc 7363 000cbd 696b 000cbe 0070 .db "cskip",0 000cbf 0ca2 .dw VE_HEAD .set VE_HEAD = VE_CSKIP XT_CSKIP: 000cc0 011b .dw DO_COLON PFA_CSKIP: .endif 000cc1 0598 .dw XT_TO_R ; ( -- addr1 n1 ) PFA_CSKIP1: 000cc2 054a .dw XT_DUP ; ( -- addr' n' n' ) 000cc3 04c7 .dw XT_DOCONDBRANCH ; ( -- addr' n') 000cc4 0ccf DEST(PFA_CSKIP2) 000cc5 0568 .dw XT_OVER ; ( -- addr' n' addr' ) 000cc6 0531 .dw XT_CFETCH ; ( -- addr' n' c' ) 000cc7 05a1 .dw XT_R_FETCH ; ( -- addr' n' c' c ) 000cc8 126d .dw XT_EQUAL ; ( -- addr' n' f ) 000cc9 04c7 .dw XT_DOCONDBRANCH ; ( -- addr' n') 000cca 0ccf DEST(PFA_CSKIP2) 000ccb 1274 .dw XT_ONE 000ccc 0e0b .dw XT_SLASHSTRING 000ccd 04bd .dw XT_DOBRANCH 000cce 0cc2 DEST(PFA_CSKIP1) PFA_CSKIP2: 000ccf 058f .dw XT_R_FROM 000cd0 0572 .dw XT_DROP ; ( -- addr2 n2) 000cd1 04ae .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: 000cd2 ff05 .dw $ff05 000cd3 7363 000cd4 6163 ../../common\words/cscan.asm(12): warning: .cseg .db misalignment - padding zero byte 000cd5 006e .db "cscan" 000cd6 0cbb .dw VE_HEAD .set VE_HEAD = VE_CSCAN XT_CSCAN: 000cd7 011b .dw DO_COLON PFA_CSCAN: .endif 000cd8 0598 .dw XT_TO_R 000cd9 0568 .dw XT_OVER PFA_CSCAN1: 000cda 054a .dw XT_DUP 000cdb 0531 .dw XT_CFETCH 000cdc 05a1 .dw XT_R_FETCH 000cdd 126d .dw XT_EQUAL 000cde 05b3 .dw XT_ZEROEQUAL 000cdf 04c7 .dw XT_DOCONDBRANCH 000ce0 0cec DEST(PFA_CSCAN2) 000ce1 055d .dw XT_SWAP 000ce2 06ce .dw XT_1MINUS 000ce3 055d .dw XT_SWAP 000ce4 0568 .dw XT_OVER 000ce5 05ba .dw XT_ZEROLESS ; not negative 000ce6 05b3 .dw XT_ZEROEQUAL 000ce7 04c7 .dw XT_DOCONDBRANCH 000ce8 0cec DEST(PFA_CSCAN2) 000ce9 06c8 .dw XT_1PLUS 000cea 04bd .dw XT_DOBRANCH 000ceb 0cda DEST(PFA_CSCAN1) PFA_CSCAN2: 000cec 0589 .dw XT_NIP 000ced 0568 .dw XT_OVER 000cee 062c .dw XT_MINUS 000cef 058f .dw XT_R_FROM 000cf0 0572 .dw XT_DROP 000cf1 04ae .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: 000cf2 ff06 .dw $ff06 000cf3 6361 000cf4 6563 000cf5 7470 .db "accept" 000cf6 0cd2 .dw VE_HEAD .set VE_HEAD = VE_ACCEPT XT_ACCEPT: 000cf7 011b .dw DO_COLON PFA_ACCEPT: .endif 000cf8 0568 000cf9 0636 000cfa 06ce 000cfb 0568 .DW XT_OVER,XT_PLUS,XT_1MINUS,XT_OVER 000cfc 0a04 000cfd 054a 000cfe 0d38 000cff 05b3 000d00 04c7 ACC1: .DW XT_KEY,XT_DUP,XT_CRLFQ,XT_ZEROEQUAL,XT_DOCONDBRANCH 000d01 0d2a DEST(ACC5) 000d02 054a 000d03 04ce 000d04 0008 000d05 126d 000d06 04c7 .DW XT_DUP,XT_DOLITERAL,8,XT_EQUAL,XT_DOCONDBRANCH 000d07 0d1a DEST(ACC3) 000d08 0572 000d09 057a 000d0a 09ca 000d0b 0611 000d0c 0598 000d0d 057a 000d0e 057a 000d0f 058f 000d10 04c7 .DW XT_DROP,XT_ROT,XT_2DUP,XT_GREATER,XT_TO_R,XT_ROT,XT_ROT,XT_R_FROM,XT_DOCONDBRANCH 000d11 0d18 DEST(ACC6) 000d12 0d30 000d13 06ce 000d14 0598 000d15 0568 000d16 058f 000d17 016e .DW XT_BS,XT_1MINUS,XT_TO_R,XT_OVER,XT_R_FROM,XT_UMAX 000d18 04bd ACC6: .DW XT_DOBRANCH 000d19 0d28 DEST(ACC4) ACC3: ; check for remaining control characters, replace them with blank 000d1a 054a .dw XT_DUP ; ( -- addr k k ) 000d1b 0a55 .dw XT_BL 000d1c 0607 .dw XT_LESS 000d1d 04c7 .dw XT_DOCONDBRANCH 000d1e 0d21 DEST(PFA_ACCEPT6) 000d1f 0572 .dw XT_DROP 000d20 0a55 .dw XT_BL PFA_ACCEPT6: 000d21 054a 000d22 09f3 000d23 0568 000d24 0526 000d25 06c8 000d26 0568 000d27 017a .DW XT_DUP,XT_EMIT,XT_OVER,XT_CSTORE,XT_1PLUS,XT_OVER,XT_UMIN 000d28 04bd ACC4: .DW XT_DOBRANCH 000d29 0cfc DEST(ACC1) 000d2a 0572 000d2b 0589 000d2c 055d 000d2d 062c 000d2e 0c3b 000d2f 04ae 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: 000d30 011b .dw DO_COLON .endif 000d31 04ce .dw XT_DOLITERAL 000d32 0008 .dw 8 000d33 054a .dw XT_DUP 000d34 09f3 .dw XT_EMIT 000d35 0c48 .dw XT_SPACE 000d36 09f3 .dw XT_EMIT 000d37 04ae .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: 000d38 011b .dw DO_COLON .endif 000d39 054a .dw XT_DUP 000d3a 04ce .dw XT_DOLITERAL 000d3b 000d .dw 13 000d3c 126d .dw XT_EQUAL 000d3d 055d .dw XT_SWAP 000d3e 04ce .dw XT_DOLITERAL 000d3f 000a .dw 10 000d40 126d .dw XT_EQUAL 000d41 06b5 .dw XT_OR 000d42 04ae .dw XT_EXIT .include "words/refill.asm" ; System ; refills the input buffer .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_REFILL: 000d43 ff06 .dw $ff06 000d44 6572 000d45 6966 000d46 6c6c .db "refill" 000d47 0cf2 .dw VE_HEAD .set VE_HEAD = VE_REFILL XT_REFILL: 000d48 1079 .dw PFA_DODEFER1 PFA_REFILL: .endif 000d49 001a .dw USER_REFILL 000d4a 1042 .dw XT_UDEFERFETCH 000d4b 104e .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: 000d4c ff04 .dw $ff04 000d4d 6863 000d4e 7261 .db "char" 000d4f 0d43 .dw VE_HEAD .set VE_HEAD = VE_CHAR XT_CHAR: 000d50 011b .dw DO_COLON PFA_CHAR: .endif 000d51 0e1a .dw XT_PARSENAME 000d52 0572 .dw XT_DROP 000d53 0531 .dw XT_CFETCH 000d54 04ae .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: 000d55 ff06 .dw $ff06 000d56 756e 000d57 626d 000d58 7265 .db "number" 000d59 0d4c .dw VE_HEAD .set VE_HEAD = VE_NUMBER XT_NUMBER: 000d5a 011b .dw DO_COLON PFA_NUMBER: .endif 000d5b 09b5 .dw XT_BASE 000d5c 0512 .dw XT_FETCH 000d5d 0598 .dw XT_TO_R 000d5e 0d9e .dw XT_QSIGN 000d5f 0598 .dw XT_TO_R 000d60 0db1 .dw XT_SET_BASE 000d61 0d9e .dw XT_QSIGN 000d62 058f .dw XT_R_FROM 000d63 06b5 .dw XT_OR 000d64 0598 .dw XT_TO_R ; check whether something is left 000d65 054a .dw XT_DUP 000d66 05b3 .dw XT_ZEROEQUAL 000d67 04c7 .dw XT_DOCONDBRANCH 000d68 0d71 DEST(PFA_NUMBER0) ; nothing is left. It cannot be a number at all 000d69 09d3 .dw XT_2DROP 000d6a 058f .dw XT_R_FROM 000d6b 0572 .dw XT_DROP 000d6c 058f .dw XT_R_FROM 000d6d 09b5 .dw XT_BASE 000d6e 051a .dw XT_STORE 000d6f 05ed .dw XT_ZERO 000d70 04ae .dw XT_EXIT PFA_NUMBER0: 000d71 07b8 .dw XT_2TO_R 000d72 05ed .dw XT_ZERO ; starting value 000d73 05ed .dw XT_ZERO 000d74 07c7 .dw XT_2R_FROM 000d75 0dcf .dw XT_TO_NUMBER ; ( 0. addr len -- d addr' len' ; check length of the remaining string. ; if zero: a single cell number is entered 000d76 0552 .dw XT_QDUP 000d77 04c7 .dw XT_DOCONDBRANCH 000d78 0d93 DEST(PFA_NUMBER1) ; if equal 1: mayba a trailing dot? --> double cell number 000d79 1274 .dw XT_ONE 000d7a 126d .dw XT_EQUAL 000d7b 04c7 .dw XT_DOCONDBRANCH 000d7c 0d8a DEST(PFA_NUMBER2) ; excatly one character is left 000d7d 0531 .dw XT_CFETCH 000d7e 04ce .dw XT_DOLITERAL 000d7f 002e .dw 46 ; . 000d80 126d .dw XT_EQUAL 000d81 04c7 .dw XT_DOCONDBRANCH 000d82 0d8b DEST(PFA_NUMBER6) ; its a double cell number ; incorporate sign into number 000d83 058f .dw XT_R_FROM 000d84 04c7 .dw XT_DOCONDBRANCH 000d85 0d87 DEST(PFA_NUMBER3) 000d86 1147 .dw XT_DNEGATE PFA_NUMBER3: 000d87 1279 .dw XT_TWO 000d88 04bd .dw XT_DOBRANCH 000d89 0d99 DEST(PFA_NUMBER5) PFA_NUMBER2: 000d8a 0572 .dw XT_DROP PFA_NUMBER6: 000d8b 09d3 .dw XT_2DROP 000d8c 058f .dw XT_R_FROM 000d8d 0572 .dw XT_DROP 000d8e 058f .dw XT_R_FROM 000d8f 09b5 .dw XT_BASE 000d90 051a .dw XT_STORE 000d91 05ed .dw XT_ZERO 000d92 04ae .dw XT_EXIT PFA_NUMBER1: 000d93 09d3 .dw XT_2DROP ; remove the address ; incorporate sign into number 000d94 058f .dw XT_R_FROM 000d95 04c7 .dw XT_DOCONDBRANCH 000d96 0d98 DEST(PFA_NUMBER4) 000d97 0aa5 .dw XT_NEGATE PFA_NUMBER4: 000d98 1274 .dw XT_ONE PFA_NUMBER5: 000d99 058f .dw XT_R_FROM 000d9a 09b5 .dw XT_BASE 000d9b 051a .dw XT_STORE 000d9c 05e4 .dw XT_TRUE 000d9d 04ae .dw XT_EXIT .include "words/q-sign.asm" .if cpu_msp430==1 .endif .if cpu_avr8==1 XT_QSIGN: 000d9e 011b .dw DO_COLON PFA_QSIGN: ; ( c -- ) .endif 000d9f 0568 .dw XT_OVER ; ( -- addr len addr ) 000da0 0531 .dw XT_CFETCH 000da1 04ce .dw XT_DOLITERAL 000da2 002d .dw '-' 000da3 126d .dw XT_EQUAL ; ( -- addr len flag ) 000da4 054a .dw XT_DUP 000da5 0598 .dw XT_TO_R 000da6 04c7 .dw XT_DOCONDBRANCH 000da7 0daa DEST(PFA_NUMBERSIGN_DONE) 000da8 1274 .dw XT_ONE ; skip sign character 000da9 0e0b .dw XT_SLASHSTRING PFA_NUMBERSIGN_DONE: 000daa 058f .dw XT_R_FROM 000dab 04ae .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: 000dac 04e9 .dw PFA_DOCONSTANT .endif 000dad 000a 000dae 0010 000daf 0002 000db0 000a .dw 10,16,2,10 ; last one could a 8 instead. .if cpu_msp430==1 .endif .if cpu_avr8==1 XT_SET_BASE: 000db1 011b .dw DO_COLON PFA_SET_BASE: ; ( adr1 len1 -- adr2 len2 ) .endif 000db2 0568 .dw XT_OVER 000db3 0531 .dw XT_CFETCH 000db4 04ce .dw XT_DOLITERAL 000db5 0023 .dw 35 000db6 062c .dw XT_MINUS 000db7 054a .dw XT_DUP 000db8 05ed .dw XT_ZERO 000db9 04ce .dw XT_DOLITERAL 000dba 0004 .dw 4 000dbb 0add .dw XT_WITHIN 000dbc 04c7 .dw XT_DOCONDBRANCH 000dbd 0dc7 DEST(SET_BASE1) .if cpu_msp430==1 .endif 000dbe 0dac .dw XT_BASES 000dbf 0636 .dw XT_PLUS 000dc0 082c .dw XT_FETCHI 000dc1 09b5 .dw XT_BASE 000dc2 051a .dw XT_STORE 000dc3 1274 .dw XT_ONE 000dc4 0e0b .dw XT_SLASHSTRING 000dc5 04bd .dw XT_DOBRANCH 000dc6 0dc8 DEST(SET_BASE2) SET_BASE1: 000dc7 0572 .dw XT_DROP SET_BASE2: 000dc8 04ae .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: 000dc9 ff07 .dw $ff07 000dca 6e3e 000dcb 6d75 000dcc 6562 000dcd 0072 .db ">number",0 000dce 0d55 .dw VE_HEAD .set VE_HEAD = VE_TO_NUMBER XT_TO_NUMBER: 000dcf 011b .dw DO_COLON .endif 000dd0 054a 000dd1 04c7 TONUM1: .DW XT_DUP,XT_DOCONDBRANCH 000dd2 0de7 DEST(TONUM3) 000dd3 0568 000dd4 0531 000dd5 0bb9 .DW XT_OVER,XT_CFETCH,XT_DIGITQ 000dd6 05b3 000dd7 04c7 .DW XT_ZEROEQUAL,XT_DOCONDBRANCH 000dd8 0ddb DEST(TONUM2) 000dd9 0572 000dda 04ae .DW XT_DROP,XT_EXIT 000ddb 0598 000ddc 116b 000ddd 09b5 000dde 0512 000ddf 015f TONUM2: .DW XT_TO_R,XT_2SWAP,XT_BASE,XT_FETCH,XT_UDSTAR 000de0 058f 000de1 0157 000de2 116b .DW XT_R_FROM,XT_MPLUS,XT_2SWAP 000de3 1274 000de4 0e0b 000de5 04bd .DW XT_ONE,XT_SLASHSTRING,XT_DOBRANCH 000de6 0dd0 DEST(TONUM1) 000de7 04ae 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: 000de8 ff05 .dw $ff05 000de9 6170 000dea 7372 000deb 0065 .db "parse",0 000dec 0dc9 .dw VE_HEAD .set VE_HEAD = VE_PARSE XT_PARSE: 000ded 011b .dw DO_COLON PFA_PARSE: .endif 000dee 0598 .dw XT_TO_R ; ( -- ) 000def 0e01 .dw XT_SOURCE ; ( -- addr len) 000df0 09e3 .dw XT_TO_IN ; ( -- addr len >in) 000df1 0512 .dw XT_FETCH 000df2 0e0b .dw XT_SLASHSTRING ; ( -- addr' len' ) 000df3 058f .dw XT_R_FROM ; ( -- addr' len' c) 000df4 0cd7 .dw XT_CSCAN ; ( -- addr' len'') 000df5 054a .dw XT_DUP ; ( -- addr' len'' len'') 000df6 06c8 .dw XT_1PLUS 000df7 09e3 .dw XT_TO_IN ; ( -- addr' len'' len'' >in) 000df8 06fe .dw XT_PLUSSTORE ; ( -- addr' len') 000df9 1274 .dw XT_ONE 000dfa 0e0b .dw XT_SLASHSTRING 000dfb 04ae .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: 000dfc ff06 .dw $FF06 000dfd 6f73 000dfe 7275 000dff 6563 .db "source" 000e00 0de8 .dw VE_HEAD .set VE_HEAD = VE_SOURCE XT_SOURCE: 000e01 1079 .dw PFA_DODEFER1 PFA_SOURCE: .endif 000e02 0016 .dw USER_SOURCE 000e03 1042 .dw XT_UDEFERFETCH 000e04 104e .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: 000e05 ff07 .dw $ff07 000e06 732f 000e07 7274 000e08 6e69 000e09 0067 .db "/string",0 000e0a 0dfc .dw VE_HEAD .set VE_HEAD = VE_SLASHSTRING XT_SLASHSTRING: 000e0b 011b .dw DO_COLON PFA_SLASHSTRING: .endif 000e0c 057a .dw XT_ROT 000e0d 0568 .dw XT_OVER 000e0e 0636 .dw XT_PLUS 000e0f 057a .dw XT_ROT 000e10 057a .dw XT_ROT 000e11 062c .dw XT_MINUS 000e12 04ae .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: 000e13 ff0a .dw $FF0A 000e14 6170 000e15 7372 000e16 2d65 000e17 616e 000e18 656d .db "parse-name" 000e19 0e05 .dw VE_HEAD .set VE_HEAD = VE_PARSENAME XT_PARSENAME: 000e1a 011b .dw DO_COLON PFA_PARSENAME: .endif 000e1b 0a55 .dw XT_BL 000e1c 0e1e .dw XT_SKIPSCANCHAR 000e1d 04ae .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: 000e1e 011b .dw DO_COLON PFA_SKIPSCANCHAR: .endif 000e1f 0598 .dw XT_TO_R 000e20 0e01 .dw XT_SOURCE 000e21 09e3 .dw XT_TO_IN 000e22 0512 .dw XT_FETCH 000e23 0e0b .dw XT_SLASHSTRING 000e24 05a1 .dw XT_R_FETCH 000e25 0cc0 .dw XT_CSKIP 000e26 058f .dw XT_R_FROM 000e27 0cd7 .dw XT_CSCAN ; adjust >IN 000e28 09ca .dw XT_2DUP 000e29 0636 .dw XT_PLUS 000e2a 0e01 .dw XT_SOURCE 000e2b 0572 .dw XT_DROP 000e2c 062c .dw XT_MINUS 000e2d 09e3 .dw XT_TO_IN 000e2e 051a .dw XT_STORE 000e2f 04ae .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: 000e30 ff07 .dw $ff07 000e31 6966 000e32 646e 000e33 782d 000e34 0074 .db "find-xt",0 000e35 0e13 .dw VE_HEAD .set VE_HEAD = VE_FINDXT XT_FINDXT: 000e36 011b .dw DO_COLON PFA_FINDXT: .endif 000e37 04ce .dw XT_DOLITERAL 000e38 0e42 .dw XT_FINDXTA 000e39 04ce .dw XT_DOLITERAL 000e3a 0088 .dw CFG_ORDERLISTLEN 000e3b 041c .dw XT_MAPSTACK 000e3c 05b3 .dw XT_ZEROEQUAL 000e3d 04c7 .dw XT_DOCONDBRANCH 000e3e 0e41 DEST(PFA_FINDXT1) 000e3f 09d3 .dw XT_2DROP 000e40 05ed .dw XT_ZERO PFA_FINDXT1: 000e41 04ae .dw XT_EXIT .if cpu_msp430==1 .endif .if cpu_avr8==1 XT_FINDXTA: 000e42 011b .dw DO_COLON PFA_FINDXTA: .endif 000e43 0598 .dw XT_TO_R 000e44 09ca .dw XT_2DUP 000e45 058f .dw XT_R_FROM 000e46 108b .dw XT_SEARCH_WORDLIST 000e47 054a .dw XT_DUP 000e48 04c7 .dw XT_DOCONDBRANCH 000e49 0e4f DEST(PFA_FINDXTA1) 000e4a 0598 .dw XT_TO_R 000e4b 0589 .dw XT_NIP 000e4c 0589 .dw XT_NIP 000e4d 058f .dw XT_R_FROM 000e4e 05e4 .dw XT_TRUE PFA_FINDXTA1: 000e4f 04ae .dw XT_EXIT .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: 000e50 011b .dw DO_COLON PFA_DEFAULT_PROMPTOK: 000e51 0bd3 .dw XT_DOSLITERAL 000e52 0003 .dw 3 000e53 6f20 000e54 006b .db " ok",0 .endif 000e55 0c06 .dw XT_ITYPE 000e56 04ae .dw XT_EXIT ; ------------------------ .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_PROMPTOK: 000e57 ff03 .dw $FF03 000e58 6f2e ../../common\words/prompt-ok.asm(43): warning: .cseg .db misalignment - padding zero byte 000e59 006b .db ".ok" 000e5a 0e30 .dw VE_HEAD .set VE_HEAD = VE_PROMPTOK XT_PROMPTOK: 000e5b 1079 .dw PFA_DODEFER1 PFA_PROMPTOK: .endif 000e5c 001c .dw USER_P_OK 000e5d 1042 .dw XT_UDEFERFETCH 000e5e 104e .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: 000e5f 011b .dw DO_COLON PFA_DEFAULT_PROMPTREADY: 000e60 0bd3 .dw XT_DOSLITERAL 000e61 0002 .dw 2 000e62 203e .db "> " .endif 000e63 0c3b .dw XT_CR 000e64 0c06 .dw XT_ITYPE 000e65 04ae .dw XT_EXIT ; ------------------------ .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_PROMPTREADY: 000e66 ff06 .dw $FF06 000e67 722e 000e68 6165 000e69 7964 .db ".ready" 000e6a 0e57 .dw VE_HEAD .set VE_HEAD = VE_PROMPTREADY XT_PROMPTREADY: 000e6b 1079 .dw PFA_DODEFER1 PFA_PROMPTREADY: .endif 000e6c 0020 .dw USER_P_RDY 000e6d 1042 .dw XT_UDEFERFETCH 000e6e 104e .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: 000e6f 011b .dw DO_COLON PFA_DEFAULT_PROMPTERROR: 000e70 0bd3 .dw XT_DOSLITERAL 000e71 0004 .dw 4 000e72 3f20 000e73 203f .db " ?? " .endif 000e74 0c06 .dw XT_ITYPE 000e75 09b5 .dw XT_BASE 000e76 0512 .dw XT_FETCH 000e77 0598 .dw XT_TO_R 000e78 0a42 .dw XT_DECIMAL 000e79 0b88 .dw XT_DOT 000e7a 09e3 .dw XT_TO_IN 000e7b 0512 .dw XT_FETCH 000e7c 0b88 .dw XT_DOT 000e7d 058f .dw XT_R_FROM 000e7e 09b5 .dw XT_BASE 000e7f 051a .dw XT_STORE 000e80 04ae .dw XT_EXIT ; ------------------------ .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_PROMPTERROR: 000e81 ff06 .dw $FF06 000e82 652e 000e83 7272 000e84 726f .db ".error" 000e85 0e66 .dw VE_HEAD .set VE_HEAD = VE_PROMPTERROR XT_PROMPTERROR: 000e86 1079 .dw PFA_DODEFER1 PFA_PROMPTERROR: .endif 000e87 001e .dw USER_P_ERR 000e88 1042 .dw XT_UDEFERFETCH 000e89 104e .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: 000e8a ff04 .dw $ff04 000e8b 7571 000e8c 7469 .db "quit" 000e8d 0e81 .dw VE_HEAD .set VE_HEAD = VE_QUIT XT_QUIT: 000e8e 011b .dw DO_COLON .endif PFA_QUIT: 000e8f 02d1 000e90 02d8 000e91 051a .dw XT_LP0,XT_LP,XT_STORE 000e92 0eef .dw XT_SP0 000e93 072f .dw XT_SP_STORE 000e94 0efc .dw XT_RP0 000e95 0719 .dw XT_RP_STORE 000e96 0366 .dw XT_LBRACKET PFA_QUIT2: 000e97 09af .dw XT_STATE 000e98 0512 .dw XT_FETCH 000e99 05b3 .dw XT_ZEROEQUAL 000e9a 04c7 .dw XT_DOCONDBRANCH 000e9b 0e9d DEST(PFA_QUIT4) 000e9c 0e6b .dw XT_PROMPTREADY PFA_QUIT4: 000e9d 0d48 .dw XT_REFILL 000e9e 04c7 .dw XT_DOCONDBRANCH 000e9f 0eaf DEST(PFA_QUIT3) 000ea0 04ce .dw XT_DOLITERAL 000ea1 0f15 .dw XT_INTERPRET 000ea2 0c91 .dw XT_CATCH 000ea3 0552 .dw XT_QDUP 000ea4 04c7 .dw XT_DOCONDBRANCH 000ea5 0eaf DEST(PFA_QUIT3) 000ea6 054a .dw XT_DUP 000ea7 04ce .dw XT_DOLITERAL 000ea8 fffe .dw -2 000ea9 0607 .dw XT_LESS 000eaa 04c7 .dw XT_DOCONDBRANCH 000eab 0ead DEST(PFA_QUIT5) 000eac 0e86 .dw XT_PROMPTERROR PFA_QUIT5: 000ead 04bd .dw XT_DOBRANCH 000eae 0e8f DEST(PFA_QUIT) PFA_QUIT3: 000eaf 0e5b .dw XT_PROMPTOK 000eb0 04bd .dw XT_DOBRANCH 000eb1 0e97 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: 000eb2 ff05 .dw $ff05 000eb3 6170 000eb4 7375 000eb5 0065 .db "pause",0 000eb6 0e8a .dw VE_HEAD .set VE_HEAD = VE_PAUSE XT_PAUSE: 000eb7 1079 .dw PFA_DODEFER1 PFA_PAUSE: 000eb8 0257 .dw ram_pause 000eb9 102e .dw XT_RDEFERFETCH 000eba 1038 .dw XT_RDEFERSTORE .dseg 000257 ram_pause: .byte 2 .cseg .include "words/cold.asm" ; System ; start up amforth. VE_COLD: 000ebb ff04 .dw $ff04 000ebc 6f63 000ebd 646c .db "cold" 000ebe 0eb2 .dw VE_HEAD .set VE_HEAD = VE_COLD XT_COLD: 000ebf 0ec0 .dw PFA_COLD PFA_COLD: 000ec0 b6a4 in_ mcu_boot, MCUSR 000ec1 2422 clr zerol 000ec2 2433 clr zeroh 000ec3 24bb clr isrflag 000ec4 be24 out_ MCUSR, zerol ; clear RAM 000ec5 e0e0 ldi zl, low(ramstart) 000ec6 e0f2 ldi zh, high(ramstart) clearloop: 000ec7 9221 st Z+, zerol 000ec8 30e0 cpi zl, low(sram_size+ramstart) 000ec9 f7e9 brne clearloop 000eca 32f2 cpi zh, high(sram_size+ramstart) 000ecb f7d9 brne clearloop ; init first user data area ; allocate space for User Area .dseg 000259 ram_user1: .byte SYSUSERSIZE + APPUSERSIZE .cseg 000ecc e5e9 ldi zl, low(ram_user1) 000ecd e0f2 ldi zh, high(ram_user1) 000ece 012f movw upl, zl ; init return stack pointer 000ecf ef0f ldi temp0,low(rstackstart) 000ed0 bf0d out_ SPL,temp0 000ed1 8304 std Z+4, temp0 000ed2 e211 ldi temp1,high(rstackstart) 000ed3 bf1e out_ SPH,temp1 000ed4 8315 std Z+5, temp1 ; init parameter stack pointer 000ed5 eacf ldi yl,low(stackstart) 000ed6 83c6 std Z+6, yl 000ed7 e2d1 ldi yh,high(stackstart) 000ed8 83d7 std Z+7, yh ; load Forth IP with starting word 000ed9 eea2 ldi XL, low(PFA_WARM) 000eda e0be ldi XH, high(PFA_WARM) ; its a far jump... 000edb 940c 011f 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: 000edd ff04 .dw $ff04 000ede 6177 000edf 6d72 .db "warm" 000ee0 0ebb .dw VE_HEAD .set VE_HEAD = VE_WARM XT_WARM: 000ee1 011b .dw DO_COLON PFA_WARM: .endif 000ee2 11b6 .dw XT_INIT_RAM 000ee3 04ce .dw XT_DOLITERAL 000ee4 0fe5 .dw XT_NOOP 000ee5 04ce .dw XT_DOLITERAL 000ee6 0eb7 .dw XT_PAUSE 000ee7 1059 .dw XT_DEFERSTORE 000ee8 0366 .dw XT_LBRACKET 000ee9 0a5d .dw XT_TURNKEY 000eea 0e8e .dw XT_QUIT ; never returns ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; .include "words/sp0.asm" ; Stack ; start address of the data stack VE_SP0: 000eeb ff03 .dw $ff03 000eec 7073 000eed 0030 .db "sp0",0 000eee 0edd .dw VE_HEAD .set VE_HEAD = VE_SP0 XT_SP0: 000eef 0509 .dw PFA_DOVALUE1 PFA_SP0: 000ef0 0006 .dw USER_SP0 000ef1 1042 .dw XT_UDEFERFETCH 000ef2 104e .dw XT_UDEFERSTORE ; ( -- addr) ; Stack ; address of user variable to store top-of-stack for inactive tasks VE_SP: 000ef3 ff02 .dw $ff02 000ef4 7073 .db "sp" 000ef5 0eeb .dw VE_HEAD .set VE_HEAD = VE_SP XT_SP: 000ef6 04ef .dw PFA_DOUSER PFA_SP: 000ef7 0008 .dw USER_SP .include "words/rp0.asm" ; Stack ; start address of return stack VE_RP0: 000ef8 ff03 .dw $ff03 000ef9 7072 000efa 0030 .db "rp0",0 000efb 0ef3 .dw VE_HEAD .set VE_HEAD = VE_RP0 XT_RP0: 000efc 011b .dw DO_COLON PFA_RP0: 000efd 0f00 .dw XT_DORP0 000efe 0512 .dw XT_FETCH 000eff 04ae .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: 000f00 04ef .dw PFA_DOUSER PFA_DORP0: 000f01 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: 000f02 ff05 .dw $ff05 000f03 6564 000f04 7470 000f05 0068 .db "depth",0 000f06 0ef8 .dw VE_HEAD .set VE_HEAD = VE_DEPTH XT_DEPTH: 000f07 011b .dw DO_COLON PFA_DEPTH: .endif 000f08 0eef .dw XT_SP0 000f09 0726 .dw XT_SP_FETCH 000f0a 062c .dw XT_MINUS 000f0b 069d .dw XT_2SLASH 000f0c 06ce .dw XT_1MINUS 000f0d 04ae .dw XT_EXIT .include "words/interpret.asm" ; System ; Interpret SOURCE word by word. .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_INTERPRET: 000f0e ff09 .dw $ff09 000f0f 6e69 000f10 6574 000f11 7072 000f12 6572 000f13 0074 .db "interpret",0 000f14 0f02 .dw VE_HEAD .set VE_HEAD = VE_INTERPRET XT_INTERPRET: 000f15 011b .dw DO_COLON .endif PFA_INTERPRET: 000f16 0e1a .dw XT_PARSENAME ; ( -- addr len ) 000f17 054a .dw XT_DUP ; ( -- addr len flag) 000f18 04c7 .dw XT_DOCONDBRANCH 000f19 0f26 DEST(PFA_INTERPRET2) 000f1a 0f32 .dw XT_FORTHRECOGNIZER 000f1b 0f3d .dw XT_RECOGNIZE 000f1c 09af .dw XT_STATE 000f1d 0512 .dw XT_FETCH 000f1e 04c7 .dw XT_DOCONDBRANCH 000f1f 0f21 DEST(PFA_INTERPRET1) 000f20 1011 .dw XT_ICELLPLUS ; we need the compile action PFA_INTERPRET1: 000f21 082c .dw XT_FETCHI 000f22 04b8 .dw XT_EXECUTE 000f23 0fbd .dw XT_QSTACK 000f24 04bd .dw XT_DOBRANCH 000f25 0f16 DEST(PFA_INTERPRET) PFA_INTERPRET2: 000f26 09d3 .dw XT_2DROP 000f27 04ae .dw XT_EXIT .include "words/forth-recognizer.asm" ; System Value ; address of the next free data space (RAM) cell VE_FORTHRECOGNIZER: 000f28 ff10 .dw $ff10 000f29 6f66 000f2a 7472 000f2b 2d68 000f2c 6572 000f2d 6f63 000f2e 6e67 000f2f 7a69 000f30 7265 .db "forth-recognizer" 000f31 0f0e .dw VE_HEAD .set VE_HEAD = VE_FORTHRECOGNIZER XT_FORTHRECOGNIZER: 000f32 0509 .dw PFA_DOVALUE1 PFA_FORTHRECOGNIZER: 000f33 007c .dw CFG_FORTHRECOGNIZER 000f34 101a .dw XT_EDEFERFETCH 000f35 1024 .dw XT_EDEFERSTORE .include "words/recognize.asm" ; System ; walk the recognizer stack .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_RECOGNIZE: 000f36 ff09 .dw $ff09 000f37 6572 000f38 6f63 000f39 6e67 000f3a 7a69 000f3b 0065 .db "recognize",0 000f3c 0f28 .dw VE_HEAD .set VE_HEAD = VE_RECOGNIZE XT_RECOGNIZE: 000f3d 011b .dw DO_COLON PFA_RECOGNIZE: .endif 000f3e 04ce .dw XT_DOLITERAL 000f3f 0f48 .dw XT_RECOGNIZE_A 000f40 055d .dw XT_SWAP 000f41 041c .dw XT_MAPSTACK 000f42 05b3 .dw XT_ZEROEQUAL 000f43 04c7 .dw XT_DOCONDBRANCH 000f44 0f47 DEST(PFA_RECOGNIZE1) 000f45 09d3 .dw XT_2DROP 000f46 0fb0 .dw XT_DT_NULL PFA_RECOGNIZE1: 000f47 04ae .dw XT_EXIT .if cpu_msp430==1 .endif .if cpu_avr8==1 ; ( addr len XT -- addr len [ dt:xt -1 | 0 ] ) XT_RECOGNIZE_A: 000f48 011b .dw DO_COLON PFA_RECOGNIZE_A: .endif 000f49 057a .dw XT_ROT ; -- len xt addr 000f4a 057a .dw XT_ROT ; -- xt addr len 000f4b 09ca .dw XT_2DUP 000f4c 07b8 .dw XT_2TO_R 000f4d 057a .dw XT_ROT ; -- addr len xt 000f4e 04b8 .dw XT_EXECUTE ; -- i*x dt:* | dt:null 000f4f 07c7 .dw XT_2R_FROM 000f50 057a .dw XT_ROT 000f51 054a .dw XT_DUP 000f52 0fb0 .dw XT_DT_NULL 000f53 126d .dw XT_EQUAL 000f54 04c7 .dw XT_DOCONDBRANCH 000f55 0f59 DEST(PFA_RECOGNIZE_A1) 000f56 0572 .dw XT_DROP 000f57 05ed .dw XT_ZERO 000f58 04ae .dw XT_EXIT PFA_RECOGNIZE_A1: 000f59 0589 .dw XT_NIP 000f5a 0589 .dw XT_NIP 000f5b 05e4 .dw XT_TRUE 000f5c 04ae .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/rec-intnum.asm" ; Interpreter ; Method table for single cell integers .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_DT_NUM: 000f5d ff06 .dw $ff06 000f5e 7464 000f5f 6e3a 000f60 6d75 .db "dt:num" 000f61 0f36 .dw VE_HEAD .set VE_HEAD = VE_DT_NUM XT_DT_NUM: 000f62 04e9 .dw PFA_DOCONSTANT PFA_DT_NUM: .endif 000f63 0fe5 .dw XT_NOOP ; interpret 000f64 01f2 .dw XT_LITERAL ; compile 000f65 01f2 .dw XT_LITERAL ; postpone ; ( -- addr ) ; Interpreter ; Method table for double cell integers .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_DT_DNUM: 000f66 ff07 .dw $ff07 000f67 7464 000f68 643a 000f69 756e 000f6a 006d .db "dt:dnum",0 000f6b 0f5d .dw VE_HEAD .set VE_HEAD = VE_DT_DNUM XT_DT_DNUM: 000f6c 04e9 .dw PFA_DOCONSTANT PFA_DT_DNUM: .endif 000f6d 0fe5 .dw XT_NOOP ; interpret 000f6e 1265 .dw XT_2LITERAL ; compile 000f6f 1265 .dw XT_2LITERAL ; postpone ; ( addr len -- f ) ; Interpreter ; recognizer for integer numbers .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_REC_NUM: 000f70 ff07 .dw $ff07 000f71 6572 000f72 3a63 000f73 756e 000f74 006d .db "rec:num",0 000f75 0f66 .dw VE_HEAD .set VE_HEAD = VE_REC_NUM XT_REC_NUM: 000f76 011b .dw DO_COLON PFA_REC_NUM: .endif ; try converting to a number 000f77 0d5a .dw XT_NUMBER 000f78 04c7 .dw XT_DOCONDBRANCH 000f79 0f82 DEST(PFA_REC_NONUMBER) 000f7a 1274 .dw XT_ONE 000f7b 126d .dw XT_EQUAL 000f7c 04c7 .dw XT_DOCONDBRANCH 000f7d 0f80 DEST(PFA_REC_INTNUM2) 000f7e 0f62 .dw XT_DT_NUM 000f7f 04ae .dw XT_EXIT PFA_REC_INTNUM2: 000f80 0f6c .dw XT_DT_DNUM 000f81 04ae .dw XT_EXIT PFA_REC_NONUMBER: 000f82 0fb0 .dw XT_DT_NULL 000f83 04ae .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: 000f84 ff08 .dw $ff08 000f85 6572 000f86 3a63 000f87 6966 000f88 646e .db "rec:find" 000f89 0f70 .dw VE_HEAD .set VE_HEAD = VE_REC_FIND XT_REC_FIND: 000f8a 011b .dw DO_COLON PFA_REC_FIND: .endif 000f8b 0e36 .DW XT_FINDXT 000f8c 054a .dw XT_DUP 000f8d 05b3 .dw XT_ZEROEQUAL 000f8e 04c7 .dw XT_DOCONDBRANCH 000f8f 0f93 DEST(PFA_REC_WORD_FOUND) 000f90 0572 .dw XT_DROP 000f91 0fb0 .dw XT_DT_NULL 000f92 04ae .dw XT_EXIT PFA_REC_WORD_FOUND: 000f93 0f9a .dw XT_DT_XT 000f94 04ae .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: 000f95 ff05 .dw $ff05 000f96 7464 000f97 783a 000f98 0074 .db "dt:xt",0 000f99 0f84 .dw VE_HEAD .set VE_HEAD = VE_DT_XT XT_DT_XT: 000f9a 04e9 .dw PFA_DOCONSTANT PFA_DT_XT: .endif 000f9b 0f9e .dw XT_R_WORD_INTERPRET 000f9c 0fa2 .dw XT_R_WORD_COMPILE 000f9d 1265 .dw XT_2LITERAL ; ( XT flags -- ) ; Interpreter ; interpret method for WORD recognizer .if cpu_msp430==1 .endif .if cpu_avr8==1 XT_R_WORD_INTERPRET: 000f9e 011b .dw DO_COLON PFA_R_WORD_INTERPRET: .endif 000f9f 0572 .dw XT_DROP ; the flags are in the way 000fa0 04b8 .dw XT_EXECUTE 000fa1 04ae .dw XT_EXIT ; ( XT flags -- ) ; Interpreter ; Compile method for WORD recognizer .if cpu_msp430==1 .endif .if cpu_avr8==1 XT_R_WORD_COMPILE: 000fa2 011b .dw DO_COLON PFA_R_WORD_COMPILE: .endif 000fa3 05ba .dw XT_ZEROLESS 000fa4 04c7 .dw XT_DOCONDBRANCH 000fa5 0fa8 DEST(PFA_R_WORD_COMPILE1) 000fa6 01dc .dw XT_COMMA 000fa7 04ae .dw XT_EXIT PFA_R_WORD_COMPILE1: 000fa8 04b8 .dw XT_EXECUTE 000fa9 04ae .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: 000faa ff07 .dw $ff07 000fab 7464 000fac 6e3a 000fad 6c75 ../../common\words/dt-null.asm(12): warning: .cseg .db misalignment - padding zero byte 000fae 006c .db "dt:null" 000faf 0f95 .dw VE_HEAD .set VE_HEAD = VE_DT_NULL XT_DT_NULL: 000fb0 04e9 .dw PFA_DOCONSTANT PFA_DT_NULL: .endif 000fb1 0fb4 .dw XT_FAIL ; interpret 000fb2 0fb4 .dw XT_FAIL ; compile 000fb3 0fb4 .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: 000fb4 011b .dw DO_COLON PFA_FAIL: .endif 000fb5 04ce .dw XT_DOLITERAL 000fb6 fff3 .dw -13 000fb7 0ca7 .dw XT_THROW .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: 000fb8 ff06 .dw $ff06 000fb9 733f 000fba 6174 000fbb 6b63 .db "?stack" 000fbc 0faa .dw VE_HEAD .set VE_HEAD = VE_QSTACK XT_QSTACK: 000fbd 011b .dw DO_COLON PFA_QSTACK: .endif 000fbe 0f07 .dw XT_DEPTH 000fbf 05ba .dw XT_ZEROLESS 000fc0 04c7 .dw XT_DOCONDBRANCH 000fc1 0fc5 DEST(PFA_QSTACK1) 000fc2 04ce .dw XT_DOLITERAL 000fc3 fffc .dw -4 000fc4 0ca7 .dw XT_THROW PFA_QSTACK1: 000fc5 04ae .dw XT_EXIT .include "words/ver.asm" ; Tools ; print the version string .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_DOT_VER: 000fc6 ff03 .dw $ff03 000fc7 6576 ../../common\words/ver.asm(12): warning: .cseg .db misalignment - padding zero byte 000fc8 0072 .db "ver" 000fc9 0fb8 .dw VE_HEAD .set VE_HEAD = VE_DOT_VER XT_DOT_VER: 000fca 011b .dw DO_COLON PFA_DOT_VER: .endif 000fcb 0971 .dw XT_ENV_FORTHNAME 000fcc 0c06 .dw XT_ITYPE 000fcd 0c48 .dw XT_SPACE 000fce 09b5 .dw XT_BASE 000fcf 0512 .dw XT_FETCH 000fd0 097f .dw XT_ENV_FORTHVERSION 000fd1 0a42 .dw XT_DECIMAL 000fd2 1255 .dw XT_S2D 000fd3 0b24 .dw XT_L_SHARP 000fd4 0b2c .dw XT_SHARP 000fd5 04ce .dw XT_DOLITERAL 000fd6 002e .dw '.' 000fd7 0b15 .dw XT_HOLD 000fd8 0b42 .dw XT_SHARP_S 000fd9 0b4d .dw XT_SHARP_G 000fda 0c61 .dw XT_TYPE 000fdb 09b5 .dw XT_BASE 000fdc 051a .dw XT_STORE 000fdd 0c48 .dw XT_SPACE 000fde 0987 .dw XT_ENV_CPU 000fdf 0c06 .dw XT_ITYPE 000fe0 04ae .dw XT_EXIT ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; .include "words/noop.asm" ; Tools ; do nothing .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_NOOP: 000fe1 ff04 .dw $ff04 000fe2 6f6e 000fe3 706f .db "noop" 000fe4 0fc6 .dw VE_HEAD .set VE_HEAD = VE_NOOP XT_NOOP: 000fe5 011b .dw DO_COLON PFA_NOOP: .endif 000fe6 04ae .DW XT_EXIT .include "words/unused.asm" ; Tools ; Amount of available RAM (incl. PAD) VE_UNUSED: 000fe7 ff06 .dw $ff06 000fe8 6e75 000fe9 7375 000fea 6465 .db "unused" 000feb 0fe1 .dw VE_HEAD .set VE_HEAD = VE_UNUSED XT_UNUSED: 000fec 011b .dw DO_COLON PFA_UNUSED: 000fed 0726 .dw XT_SP_FETCH 000fee 0a24 .dw XT_HERE 000fef 062c .dw XT_MINUS 000ff0 04ae .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: 000ff1 0002 .dw $0002 000ff2 6f74 .db "to" 000ff3 0fe7 .dw VE_HEAD .set VE_HEAD = VE_TO XT_TO: 000ff4 011b .dw DO_COLON PFA_TO: .endif 000ff5 0c70 .dw XT_TICK 000ff6 125e .dw XT_TO_BODY 000ff7 09af .dw XT_STATE 000ff8 0512 .dw XT_FETCH 000ff9 04c7 .dw XT_DOCONDBRANCH 000ffa 1005 DEST(PFA_TO1) 000ffb 01d1 .dw XT_COMPILE 000ffc 0fff .dw XT_DOTO 000ffd 01dc .dw XT_COMMA 000ffe 04ae .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: 000fff 011b .dw DO_COLON PFA_DOTO: .endif 001000 058f .dw XT_R_FROM 001001 054a .dw XT_DUP 001002 1011 .dw XT_ICELLPLUS 001003 0598 .dw XT_TO_R 001004 082c .dw XT_FETCHI PFA_TO1: 001005 054a .dw XT_DUP 001006 1011 .dw XT_ICELLPLUS 001007 1011 .dw XT_ICELLPLUS 001008 082c .dw XT_FETCHI 001009 04b8 .dw XT_EXECUTE 00100a 04ae .dw XT_EXIT .include "words/i-cellplus.asm" ; Compiler ; skip to the next cell in flash VE_ICELLPLUS: 00100b ff07 .dw $FF07 00100c 2d69 00100d 6563 00100e 6c6c 00100f 002b .db "i-cell+",0 001010 0ff1 .dw VE_HEAD .set VE_HEAD = VE_ICELLPLUS XT_ICELLPLUS: 001011 011b .dw DO_COLON PFA_ICELLPLUS: 001012 06c8 .dw XT_1PLUS 001013 04ae .dw XT_EXIT .include "words/edefer-fetch.asm" ; System ; does the real defer@ for eeprom defers VE_EDEFERFETCH: 001014 ff07 .dw $ff07 001015 6445 001016 6665 001017 7265 001018 0040 .db "Edefer@",0 001019 100b .dw VE_HEAD .set VE_HEAD = VE_EDEFERFETCH XT_EDEFERFETCH: 00101a 011b .dw DO_COLON PFA_EDEFERFETCH: 00101b 082c .dw XT_FETCHI 00101c 07f9 .dw XT_FETCHE 00101d 04ae .dw XT_EXIT .include "words/edefer-store.asm" ; System ; does the real defer! for eeprom defers VE_EDEFERSTORE: 00101e ff07 .dw $ff07 00101f 6445 001020 6665 001021 7265 001022 0021 .db "Edefer!",0 001023 1014 .dw VE_HEAD .set VE_HEAD = VE_EDEFERSTORE XT_EDEFERSTORE: 001024 011b .dw DO_COLON PFA_EDEFERSTORE: 001025 082c .dw XT_FETCHI 001026 07d5 .dw XT_STOREE 001027 04ae .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: 001028 ff07 .dw $ff07 001029 6452 00102a 6665 00102b 7265 00102c 0040 .db "Rdefer@",0 00102d 101e .dw VE_HEAD .set VE_HEAD = VE_RDEFERFETCH XT_RDEFERFETCH: 00102e 011b .dw DO_COLON PFA_RDEFERFETCH: .endif 00102f 082c .dw XT_FETCHI 001030 0512 .dw XT_FETCH 001031 04ae .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: 001032 ff07 .dw $ff07 001033 6452 001034 6665 001035 7265 001036 0021 .db "Rdefer!",0 001037 1028 .dw VE_HEAD .set VE_HEAD = VE_RDEFERSTORE XT_RDEFERSTORE: 001038 011b .dw DO_COLON PFA_RDEFERSTORE: .endif 001039 082c .dw XT_FETCHI 00103a 051a .dw XT_STORE 00103b 04ae .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: 00103c ff07 .dw $ff07 00103d 6455 00103e 6665 00103f 7265 001040 0040 .db "Udefer@",0 001041 1032 .dw VE_HEAD .set VE_HEAD = VE_UDEFERFETCH XT_UDEFERFETCH: 001042 011b .dw DO_COLON PFA_UDEFERFETCH: .endif 001043 082c .dw XT_FETCHI 001044 079b .dw XT_UP_FETCH 001045 0636 .dw XT_PLUS 001046 0512 .dw XT_FETCH 001047 04ae .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: 001048 ff07 .dw $ff07 001049 6455 00104a 6665 00104b 7265 00104c 0021 .db "Udefer!",0 00104d 103c .dw VE_HEAD .set VE_HEAD = VE_UDEFERSTORE XT_UDEFERSTORE: 00104e 011b .dw DO_COLON PFA_UDEFERSTORE: .endif 00104f 082c .dw XT_FETCHI 001050 079b .dw XT_UP_FETCH 001051 0636 .dw XT_PLUS 001052 051a .dw XT_STORE 001053 04ae .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: 001054 ff06 .dw $ff06 001055 6564 001056 6566 001057 2172 .db "defer!" 001058 1048 .dw VE_HEAD .set VE_HEAD = VE_DEFERSTORE XT_DEFERSTORE: 001059 011b .dw DO_COLON PFA_DEFERSTORE: .endif 00105a 125e .dw XT_TO_BODY 00105b 054a .dw XT_DUP 00105c 1011 .dw XT_ICELLPLUS 00105d 1011 .dw XT_ICELLPLUS 00105e 082c .dw XT_FETCHI 00105f 04b8 .dw XT_EXECUTE 001060 04ae .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: 001061 ff06 .dw $ff06 001062 6564 001063 6566 001064 4072 .db "defer@" 001065 1054 .dw VE_HEAD .set VE_HEAD = VE_DEFERFETCH XT_DEFERFETCH: 001066 011b .dw DO_COLON PFA_DEFERFETCH: .endif 001067 125e .dw XT_TO_BODY 001068 054a .dw XT_DUP 001069 1011 .dw XT_ICELLPLUS 00106a 082c .dw XT_FETCHI 00106b 04b8 .dw XT_EXECUTE 00106c 04ae .dw XT_EXIT .include "words/do-defer.asm" ; System ; runtime of defer VE_DODEFER: 00106d ff07 .dw $ff07 00106e 6428 00106f 6665 001070 7265 001071 0029 .db "(defer)", 0 001072 1061 .dw VE_HEAD .set VE_HEAD = VE_DODEFER XT_DODEFER: 001073 011b .dw DO_COLON PFA_DODEFER: 001074 01ae .dw XT_DOCREATE 001075 030e .dw XT_REVEAL 001076 01d1 .dw XT_COMPILE 001077 1079 .dw PFA_DODEFER1 001078 04ae .dw XT_EXIT PFA_DODEFER1: 001079 940e 0327 call_ DO_DODOES 00107b 054a .dw XT_DUP 00107c 1011 .dw XT_ICELLPLUS 00107d 082c .dw XT_FETCHI 00107e 04b8 .dw XT_EXECUTE 00107f 04b8 .dw XT_EXECUTE 001080 04ae .dw XT_EXIT ; : (defer) dup i-cell+ @i execute execute ; .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: 001081 ff0f .dw $ff0f 001082 6573 001083 7261 001084 6863 001085 772d 001086 726f 001087 6c64 001088 7369 001089 0074 .db "search-wordlist",0 00108a 106d .dw VE_HEAD .set VE_HEAD = VE_SEARCH_WORDLIST XT_SEARCH_WORDLIST: 00108b 011b .dw DO_COLON PFA_SEARCH_WORDLIST: .endif 00108c 0598 .dw XT_TO_R 00108d 05ed .dw XT_ZERO 00108e 04ce .dw XT_DOLITERAL 00108f 10a0 .dw XT_ISWORD 001090 058f .dw XT_R_FROM 001091 10bd .dw XT_TRAVERSEWORDLIST 001092 054a .dw XT_DUP 001093 05b3 .dw XT_ZEROEQUAL 001094 04c7 .dw XT_DOCONDBRANCH 001095 109a DEST(PFA_SEARCH_WORDLIST1) 001096 09d3 .dw XT_2DROP 001097 0572 .dw XT_DROP 001098 05ed .dw XT_ZERO 001099 04ae .dw XT_EXIT PFA_SEARCH_WORDLIST1: ; ... get the XT ... 00109a 054a .dw XT_DUP 00109b 10e4 .dw XT_NFA2CFA ; .. and get the header flag 00109c 055d .dw XT_SWAP 00109d 0194 .dw XT_NAME2FLAGS 00109e 0182 .dw XT_IMMEDIATEQ 00109f 04ae .dw XT_EXIT .if cpu_msp430==1 .endif .if cpu_avr8==1 XT_ISWORD: 0010a0 011b .dw DO_COLON PFA_ISWORD: .endif ; ( c-addr len 0 nt -- c-addr len 0 true| nt false ) 0010a1 0598 .dw XT_TO_R 0010a2 0572 .dw XT_DROP 0010a3 09ca .dw XT_2DUP 0010a4 05a1 .dw XT_R_FETCH ; -- addr len addr len nt 0010a5 10d8 .dw XT_NAME2STRING 0010a6 10ee .dw XT_ICOMPARE ; (-- addr len f ) 0010a7 04c7 .dw XT_DOCONDBRANCH 0010a8 10ae DEST(PFA_ISWORD3) ; not now 0010a9 058f .dw XT_R_FROM 0010aa 0572 .dw XT_DROP 0010ab 05ed .dw XT_ZERO 0010ac 05e4 .dw XT_TRUE ; maybe next word 0010ad 04ae .dw XT_EXIT PFA_ISWORD3: ; we found the word, now clean up iteration data ... 0010ae 09d3 .dw XT_2DROP 0010af 058f .dw XT_R_FROM 0010b0 05ed .dw XT_ZERO ; finish traverse-wordlist 0010b1 04ae .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: 0010b2 ff11 .dw $ff11 0010b3 7274 0010b4 7661 0010b5 7265 0010b6 6573 0010b7 772d 0010b8 726f 0010b9 6c64 0010ba 7369 0010bb 0074 .db "traverse-wordlist",0 0010bc 1081 .dw VE_HEAD .set VE_HEAD = VE_TRAVERSEWORDLIST XT_TRAVERSEWORDLIST: 0010bd 011b .dw DO_COLON PFA_TRAVERSEWORDLIST: .endif 0010be 07f9 .dw XT_FETCHE PFA_TRAVERSEWORDLIST1: 0010bf 054a .dw XT_DUP ; ( -- xt nt nt ) 0010c0 04c7 .dw XT_DOCONDBRANCH ; ( -- nt ) is nfa = counted string 0010c1 10ce DEST(PFA_TRAVERSEWORDLIST2) 0010c2 09ca .dw XT_2DUP 0010c3 07b8 .dw XT_2TO_R 0010c4 055d .dw XT_SWAP 0010c5 04b8 .dw XT_EXECUTE 0010c6 07c7 .dw XT_2R_FROM 0010c7 057a .dw XT_ROT 0010c8 04c7 .dw XT_DOCONDBRANCH 0010c9 10ce DEST(PFA_TRAVERSEWORDLIST2) 0010ca 048a .dw XT_NFA2LFA 0010cb 082c .dw XT_FETCHI 0010cc 04bd .dw XT_DOBRANCH ; ( -- addr ) 0010cd 10bf DEST(PFA_TRAVERSEWORDLIST1) ; ( -- addr ) PFA_TRAVERSEWORDLIST2: 0010ce 09d3 .dw XT_2DROP 0010cf 04ae .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: 0010d0 ff0b .dw $ff0b 0010d1 616e 0010d2 656d 0010d3 733e 0010d4 7274 0010d5 6e69 0010d6 0067 .db "name>string",0 0010d7 10b2 .dw VE_HEAD .set VE_HEAD = VE_NAME2STRING XT_NAME2STRING: 0010d8 011b .dw DO_COLON PFA_NAME2STRING: .endif 0010d9 0c32 .dw XT_ICOUNT ; ( -- addr n ) 0010da 04ce .dw XT_DOLITERAL 0010db 00ff .dw 255 0010dc 06ac .dw XT_AND ; mask immediate bit 0010dd 04ae .dw XT_EXIT .include "words/nfa2cfa.asm" ; Tools ; get the XT from a name token VE_NFA2CFA: 0010de ff07 .dw $ff07 0010df 666e 0010e0 3e61 0010e1 6663 ../../avr8\words/nfa2cfa.asm(6): warning: .cseg .db misalignment - padding zero byte 0010e2 0061 .db "nfa>cfa" 0010e3 10d0 .dw VE_HEAD .set VE_HEAD = VE_NFA2CFA XT_NFA2CFA: 0010e4 011b .dw DO_COLON PFA_NFA2CFA: 0010e5 048a .dw XT_NFA2LFA ; skip to link field 0010e6 06c8 .dw XT_1PLUS ; next is the execution token 0010e7 04ae .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: 0010e8 ff08 .dw $ff08 0010e9 6369 0010ea 6d6f 0010eb 6170 0010ec 6572 .db "icompare" 0010ed 10de .dw VE_HEAD .set VE_HEAD = VE_ICOMPARE XT_ICOMPARE: 0010ee 011b .dw DO_COLON PFA_ICOMPARE: 0010ef 0598 .dw XT_TO_R ; ( -- r-addr r-len f-addr) 0010f0 0568 .dw XT_OVER ; ( -- r-addr r-len f-addr r-len) 0010f1 058f .dw XT_R_FROM ; ( -- r-addr r-len f-addr r-len f-len ) 0010f2 05ac .dw XT_NOTEQUAL ; ( -- r-addr r-len f-addr flag ) 0010f3 04c7 .dw XT_DOCONDBRANCH 0010f4 10f9 .dw PFA_ICOMPARE_SAMELEN 0010f5 09d3 .dw XT_2DROP 0010f6 0572 .dw XT_DROP 0010f7 05e4 .dw XT_TRUE 0010f8 04ae .dw XT_EXIT PFA_ICOMPARE_SAMELEN: 0010f9 055d .dw XT_SWAP ; ( -- r-addr f-addr len ) 0010fa 05ed .dw XT_ZERO 0010fb 029b .dw XT_QDOCHECK 0010fc 04c7 .dw XT_DOCONDBRANCH 0010fd 111c .dw PFA_ICOMPARE_DONE 0010fe 0734 .dw XT_DODO PFA_ICOMPARE_LOOP: ; ( r-addr f-addr --) 0010ff 0568 .dw XT_OVER 001100 0512 .dw XT_FETCH .if WANT_IGNORECASE == 1 .endif 001101 0568 .dw XT_OVER 001102 082c .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 001103 054a .dw XT_DUP ;.dw XT_BYTESWAP 001104 04ce .dw XT_DOLITERAL 001105 0100 .dw $100 001106 05f5 .dw XT_ULESS 001107 04c7 .dw XT_DOCONDBRANCH 001108 110d .dw PFA_ICOMPARE_LASTCELL 001109 055d .dw XT_SWAP 00110a 04ce .dw XT_DOLITERAL 00110b 00ff .dw $00FF 00110c 06ac .dw XT_AND ; the final swap can be omitted PFA_ICOMPARE_LASTCELL: 00110d 05ac .dw XT_NOTEQUAL 00110e 04c7 .dw XT_DOCONDBRANCH 00110f 1114 .dw PFA_ICOMPARE_NEXTLOOP 001110 09d3 .dw XT_2DROP 001111 05e4 .dw XT_TRUE 001112 076d .dw XT_UNLOOP 001113 04ae .dw XT_EXIT PFA_ICOMPARE_NEXTLOOP: 001114 06c8 .dw XT_1PLUS 001115 055d .dw XT_SWAP 001116 09c2 .dw XT_CELLPLUS 001117 055d .dw XT_SWAP 001118 04ce .dw XT_DOLITERAL 001119 0002 .dw 2 00111a 0753 .dw XT_DOPLUSLOOP 00111b 10ff .dw PFA_ICOMPARE_LOOP PFA_ICOMPARE_DONE: 00111c 09d3 .dw XT_2DROP 00111d 05ed .dw XT_ZERO 00111e 04ae .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: 00111f ff01 .dw $ff01 001120 002a .db "*",0 001121 10e8 .dw VE_HEAD .set VE_HEAD = VE_STAR XT_STAR: 001122 011b .dw DO_COLON PFA_STAR: .endif 001123 063f .dw XT_MSTAR 001124 0572 .dw XT_DROP 001125 04ae .dw XT_EXIT .include "words/j.asm" ; Compiler ; loop counter of outer loop VE_J: 001126 ff01 .dw $FF01 001127 006a .db "j",0 001128 111f .dw VE_HEAD .set VE_HEAD = VE_J XT_J: 001129 011b .dw DO_COLON PFA_J: 00112a 070f .dw XT_RP_FETCH 00112b 04ce .dw XT_DOLITERAL 00112c 0007 .dw 7 00112d 0636 .dw XT_PLUS 00112e 0512 .dw XT_FETCH 00112f 070f .dw XT_RP_FETCH 001130 04ce .dw XT_DOLITERAL 001131 0009 .dw 9 001132 0636 .dw XT_PLUS 001133 0512 .dw XT_FETCH 001134 0636 .dw XT_PLUS 001135 04ae .dw XT_EXIT .include "words/dabs.asm" ; Arithmetics ; double cell absolute value VE_DABS: 001136 ff04 .dw $ff04 001137 6164 001138 7362 .db "dabs" 001139 1126 .dw VE_HEAD .set VE_HEAD = VE_DABS XT_DABS: 00113a 011b .dw DO_COLON PFA_DABS: 00113b 054a .dw XT_DUP 00113c 05ba .dw XT_ZEROLESS 00113d 04c7 .dw XT_DOCONDBRANCH 00113e 1140 .dw PFA_DABS1 00113f 1147 .dw XT_DNEGATE PFA_DABS1: 001140 04ae .dw XT_EXIT ; : dabs ( ud1 -- +d2 ) dup 0< if dnegate then ; .include "words/dnegate.asm" ; Arithmetics ; double cell negation VE_DNEGATE: 001141 ff07 .dw $ff07 001142 6e64 001143 6765 001144 7461 001145 0065 .db "dnegate",0 001146 1136 .dw VE_HEAD .set VE_HEAD = VE_DNEGATE XT_DNEGATE: 001147 011b .dw DO_COLON PFA_DNEGATE: 001148 089f .dw XT_DINVERT 001149 1274 .dw XT_ONE 00114a 05ed .dw XT_ZERO 00114b 0879 .dw XT_DPLUS 00114c 04ae .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: 00114d ff05 .dw $ff05 00114e 6d63 00114f 766f 001150 0065 .db "cmove",0 001151 1141 .dw VE_HEAD .set VE_HEAD = VE_CMOVE XT_CMOVE: 001152 1153 .dw PFA_CMOVE PFA_CMOVE: 001153 93bf push xh 001154 93af push xl 001155 91e9 ld zl, Y+ 001156 91f9 ld zh, Y+ ; addr-to 001157 91a9 ld xl, Y+ 001158 91b9 ld xh, Y+ ; addr-from 001159 2f09 mov temp0, tosh 00115a 2b08 or temp0, tosl 00115b f021 brbs 1, PFA_CMOVE1 PFA_CMOVE2: 00115c 911d ld temp1, X+ 00115d 9311 st Z+, temp1 00115e 9701 sbiw tosl, 1 00115f f7e1 brbc 1, PFA_CMOVE2 PFA_CMOVE1: 001160 91af pop xl 001161 91bf pop xh 001162 9189 001163 9199 loadtos 001164 940c 011f 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: 001166 ff05 .dw $ff05 001167 7332 001168 6177 001169 0070 .db "2swap",0 00116a 114d .dw VE_HEAD .set VE_HEAD = VE_2SWAP XT_2SWAP: 00116b 011b .dw DO_COLON PFA_2SWAP: .endif 00116c 057a .dw XT_ROT 00116d 0598 .dw XT_TO_R 00116e 057a .dw XT_ROT 00116f 058f .dw XT_R_FROM 001170 04ae .dw XT_EXIT .include "words/tib.asm" ; System ; refills the input buffer .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_REFILLTIB: 001171 ff0a .dw $ff0a 001172 6572 001173 6966 001174 6c6c 001175 742d 001176 6269 .db "refill-tib" 001177 1166 .dw VE_HEAD .set VE_HEAD = VE_REFILLTIB XT_REFILLTIB: 001178 011b .dw DO_COLON PFA_REFILLTIB: .endif 001179 1194 .dw XT_TIB 00117a 04ce .dw XT_DOLITERAL 00117b 005a .dw TIB_SIZE 00117c 0cf7 .dw XT_ACCEPT 00117d 119a .dw XT_NUMBERTIB 00117e 051a .dw XT_STORE 00117f 05ed .dw XT_ZERO 001180 09e3 .dw XT_TO_IN 001181 051a .dw XT_STORE 001182 05e4 .dw XT_TRUE ; -1 001183 04ae .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: 001184 ff0a .dw $FF0A 001185 6f73 001186 7275 001187 6563 001188 742d 001189 6269 .db "source-tib" 00118a 1171 .dw VE_HEAD .set VE_HEAD = VE_SOURCETIB XT_SOURCETIB: 00118b 011b .dw DO_COLON PFA_SOURCETIB: .endif 00118c 1194 .dw XT_TIB 00118d 119a .dw XT_NUMBERTIB 00118e 0512 .dw XT_FETCH 00118f 04ae .dw XT_EXIT ; ( -- addr ) ; System Variable ; terminal input buffer address .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_TIB: 001190 ff03 .dw $ff03 001191 6974 001192 0062 .db "tib",0 001193 1184 .dw VE_HEAD .set VE_HEAD = VE_TIB XT_TIB: 001194 04dc .dw PFA_DOVARIABLE PFA_TIB: 001195 0285 .dw ram_tib .dseg 000285 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: 001196 ff04 .dw $ff04 001197 7423 001198 6269 .db "#tib" 001199 1190 .dw VE_HEAD .set VE_HEAD = VE_NUMBERTIB XT_NUMBERTIB: 00119a 04dc .dw PFA_DOVARIABLE PFA_NUMBERTIB: 00119b 02df .dw ram_sharptib .dseg 0002df ram_sharptib: .byte 2 .cseg .endif .include "words/init-ram.asm" ; Tools ; copy len cells from eeprom to ram VE_EE2RAM: 00119c ff06 .dw $ff06 00119d 6565 00119e 723e 00119f 6d61 .db "ee>ram" 0011a0 1196 .dw VE_HEAD .set VE_HEAD = VE_EE2RAM XT_EE2RAM: 0011a1 011b .dw DO_COLON PFA_EE2RAM: ; ( -- ) 0011a2 05ed .dw XT_ZERO 0011a3 0734 .dw XT_DODO PFA_EE2RAM_1: ; ( -- e-addr r-addr ) 0011a4 0568 .dw XT_OVER 0011a5 07f9 .dw XT_FETCHE 0011a6 0568 .dw XT_OVER 0011a7 051a .dw XT_STORE 0011a8 09c2 .dw XT_CELLPLUS 0011a9 055d .dw XT_SWAP 0011aa 09c2 .dw XT_CELLPLUS 0011ab 055d .dw XT_SWAP 0011ac 0762 .dw XT_DOLOOP 0011ad 11a4 .dw PFA_EE2RAM_1 PFA_EE2RAM_2: 0011ae 09d3 .dw XT_2DROP 0011af 04ae .dw XT_EXIT ; ( -- ) ; Tools ; setup the default user area from eeprom VE_INIT_RAM: 0011b0 ff08 .dw $ff08 0011b1 6e69 0011b2 7469 0011b3 722d 0011b4 6d61 .db "init-ram" 0011b5 119c .dw VE_HEAD .set VE_HEAD = VE_INIT_RAM XT_INIT_RAM: 0011b6 011b .dw DO_COLON PFA_INI_RAM: ; ( -- ) 0011b7 04ce .dw XT_DOLITERAL 0011b8 00a8 .dw EE_INITUSER 0011b9 079b .dw XT_UP_FETCH 0011ba 04ce .dw XT_DOLITERAL 0011bb 0022 .dw SYSUSERSIZE 0011bc 069d .dw XT_2SLASH 0011bd 11a1 .dw XT_EE2RAM 0011be 04ae .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: 0011bf ff0b .dw $ff0b 0011c0 6573 0011c1 2d74 0011c2 7563 0011c3 7272 0011c4 6e65 0011c5 0074 .db "set-current",0 0011c6 11b0 .dw VE_HEAD .set VE_HEAD = VE_SET_CURRENT XT_SET_CURRENT: 0011c7 011b .dw DO_COLON PFA_SET_CURRENT: 0011c8 04ce .dw XT_DOLITERAL 0011c9 0084 .dw CFG_CURRENT 0011ca 07d5 .dw XT_STOREE 0011cb 04ae .dw XT_EXIT .include "words/wordlist.asm" ; Search Order ; create a new, empty wordlist VE_WORDLIST: 0011cc ff08 .dw $ff08 0011cd 6f77 0011ce 6472 0011cf 696c 0011d0 7473 .db "wordlist" 0011d1 11bf .dw VE_HEAD .set VE_HEAD = VE_WORDLIST XT_WORDLIST: 0011d2 011b .dw DO_COLON PFA_WORDLIST: 0011d3 0a1c .dw XT_EHERE 0011d4 05ed .dw XT_ZERO 0011d5 0568 .dw XT_OVER 0011d6 07d5 .dw XT_STOREE 0011d7 054a .dw XT_DUP 0011d8 09c2 .dw XT_CELLPLUS 0011d9 0fff .dw XT_DOTO 0011da 0a1d .dw PFA_EHERE 0011db 04ae .dw XT_EXIT .include "words/forth-wordlist.asm" ; Search Order ; get the system default word list VE_FORTHWORDLIST: 0011dc ff0e .dw $ff0e 0011dd 6f66 0011de 7472 0011df 2d68 0011e0 6f77 0011e1 6472 0011e2 696c 0011e3 7473 .db "forth-wordlist" 0011e4 11cc .dw VE_HEAD .set VE_HEAD = VE_FORTHWORDLIST XT_FORTHWORDLIST: 0011e5 04dc .dw PFA_DOVARIABLE PFA_FORTHWORDLIST: 0011e6 0086 .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: 0011e7 ff09 .dw $ff09 0011e8 6573 0011e9 2d74 0011ea 726f 0011eb 6564 0011ec 0072 .db "set-order",0 0011ed 11dc .dw VE_HEAD .set VE_HEAD = VE_SET_ORDER XT_SET_ORDER: 0011ee 011b .dw DO_COLON PFA_SET_ORDER: .endif 0011ef 04ce .dw XT_DOLITERAL 0011f0 0088 .dw CFG_ORDERLISTLEN 0011f1 03fe .dw XT_SET_STACK 0011f2 04ae .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: 0011f3 ff0f .dw $ff0f 0011f4 6573 0011f5 2d74 0011f6 6572 0011f7 6f63 0011f8 6e67 0011f9 7a69 0011fa 7265 0011fb 0073 .db "set-recognizers",0 0011fc 11e7 .dw VE_HEAD .set VE_HEAD = VE_SET_RECOGNIZERS XT_SET_RECOGNIZERS: 0011fd 011b .dw DO_COLON PFA_SET_RECOGNIZERS: .endif 0011fe 04ce .dw XT_DOLITERAL 0011ff 009a .dw CFG_RECOGNIZERLISTLEN 001200 03fe .dw XT_SET_STACK 001201 04ae .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: 001202 ff0f .dw $ff0f 001203 6567 001204 2d74 001205 6572 001206 6f63 001207 6e67 001208 7a69 001209 7265 00120a 0073 .db "get-recognizers",0 00120b 11f3 .dw VE_HEAD .set VE_HEAD = VE_GET_RECOGNIZERS XT_GET_RECOGNIZERS: 00120c 011b .dw DO_COLON PFA_GET_RECOGNIZERS: .endif 00120d 04ce .dw XT_DOLITERAL 00120e 009a .dw CFG_RECOGNIZERLISTLEN 00120f 03dd .dw XT_GET_STACK 001210 04ae .dw XT_EXIT .include "words/code.asm" ; Compiler ; create named entry in the dictionary, XT is the data field VE_CODE: 001211 ff04 .dw $ff04 001212 6f63 001213 6564 .db "code" 001214 1202 .dw VE_HEAD .set VE_HEAD = VE_CODE XT_CODE: 001215 011b .dw DO_COLON PFA_CODE: 001216 01ae .dw XT_DOCREATE 001217 030e .dw XT_REVEAL 001218 0a13 .dw XT_DP 001219 1011 .dw XT_ICELLPLUS 00121a 01dc .dw XT_COMMA 00121b 04ae .dw XT_EXIT .include "words/end-code.asm" ; Compiler ; finish a code definition VE_ENDCODE: 00121c ff08 .dw $ff08 00121d 6e65 00121e 2d64 00121f 6f63 001220 6564 .db "end-code" 001221 1211 .dw VE_HEAD .set VE_HEAD = VE_ENDCODE XT_ENDCODE: 001222 011b .dw DO_COLON PFA_ENDCODE: 001223 01d1 .dw XT_COMPILE 001224 940c .dw $940c 001225 01d1 .dw XT_COMPILE 001226 011f .dw DO_NEXT 001227 04ae .dw XT_EXIT .include "words/marker.asm" ; System Value ; The eeprom address until which MARKER saves and restores the eeprom data. VE_MARKER: 001228 ff08 .dw $ff08 001229 6d28 00122a 7261 00122b 656b 00122c 2972 .db "(marker)" 00122d 121c .dw VE_HEAD .set VE_HEAD = VE_MARKER XT_MARKER: 00122e 0509 .dw PFA_DOVALUE1 PFA_MARKER: 00122f 00a6 .dw EE_MARKER 001230 101a .dw XT_EDEFERFETCH 001231 1024 .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: 001232 0008 .dw $0008 001233 6f70 001234 7473 001235 6f70 001236 656e .db "postpone" 001237 1228 .dw VE_HEAD .set VE_HEAD = VE_POSTPONE XT_POSTPONE: 001238 011b .dw DO_COLON PFA_POSTPONE: .endif 001239 0e1a .dw XT_PARSENAME 00123a 0f32 .dw XT_FORTHRECOGNIZER 00123b 0f3d .dw XT_RECOGNIZE 00123c 054a .dw XT_DUP 00123d 0598 .dw XT_TO_R 00123e 1011 .dw XT_ICELLPLUS 00123f 1011 .dw XT_ICELLPLUS 001240 082c .dw XT_FETCHI 001241 04b8 .dw XT_EXECUTE 001242 058f .dw XT_R_FROM 001243 1011 .dw XT_ICELLPLUS 001244 082c .dw XT_FETCHI 001245 01dc .dw XT_COMMA 001246 04ae .dw XT_EXIT .endif .include "words/bounds.asm" ; Tools ; convert a string to an address range .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_BOUNDS: 001247 ff06 .dw $ff06 001248 6f62 001249 6e75 00124a 7364 .db "bounds" 00124b 1232 .dw VE_HEAD .set VE_HEAD = VE_BOUNDS XT_BOUNDS: 00124c 011b .dw DO_COLON PFA_BOUNDS: .endif 00124d 0568 .dw XT_OVER 00124e 0636 .dw XT_PLUS 00124f 055d .dw XT_SWAP 001250 04ae .dw 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: 001251 ff03 .dw $ff03 001252 3e73 001253 0064 .db "s>d",0 001254 1247 .dw VE_HEAD .set VE_HEAD = VE_S2D XT_S2D: 001255 011b .dw DO_COLON PFA_S2D: .endif 001256 054a .dw XT_DUP 001257 05ba .dw XT_ZEROLESS 001258 04ae .dw XT_EXIT .include "words/to-body.asm" ; Core ; get body from XT VE_TO_BODY: 001259 ff05 .dw $ff05 00125a 623e 00125b 646f 00125c 0079 .db ">body",0 00125d 1251 .dw VE_HEAD .set VE_HEAD = VE_TO_BODY XT_TO_BODY: 00125e 06c9 .dw PFA_1PLUS .elif AMFORTH_NRWW_SIZE>4000 .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: 00125f 0008 .dw $0008 001260 6c32 001261 7469 001262 7265 001263 6c61 .db "2literal" 001264 1259 .dw VE_HEAD .set VE_HEAD = VE_2LITERAL XT_2LITERAL: 001265 011b .dw DO_COLON PFA_2LITERAL: .endif 001266 055d .dw XT_SWAP 001267 01f2 .dw XT_LITERAL 001268 01f2 .dw XT_LITERAL 001269 04ae .dw XT_EXIT .include "words/equal.asm" ; Compare ; compares two values for equality VE_EQUAL: 00126a ff01 .dw $ff01 00126b 003d .db "=",0 00126c 125f .dw VE_HEAD .set VE_HEAD = VE_EQUAL XT_EQUAL: 00126d 011b .dw DO_COLON PFA_EQUAL: 00126e 062c .dw XT_MINUS 00126f 05b3 .dw XT_ZEROEQUAL 001270 04ae .dw XT_EXIT .include "words/num-constants.asm" .endif .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_ONE: 001271 ff01 .dw $ff01 001272 0031 .db "1",0 001273 126a .dw VE_HEAD .set VE_HEAD = VE_ONE XT_ONE: 001274 04dc .dw PFA_DOVARIABLE PFA_ONE: .endif 001275 0001 .DW 1 .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_TWO: 001276 ff01 .dw $ff01 001277 0032 .db "2",0 001278 1271 .dw VE_HEAD .set VE_HEAD = VE_TWO XT_TWO: 001279 04dc .dw PFA_DOVARIABLE PFA_TWO: .endif 00127a 0002 .DW 2 .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_MINUSONE: 00127b ff02 .dw $ff02 00127c 312d .db "-1" 00127d 1276 .dw VE_HEAD .set VE_HEAD = VE_MINUSONE XT_MINUSONE: 00127e 04dc .dw PFA_DOVARIABLE PFA_MINUSONE: .endif 00127f ffff .DW -1 .include "dict_appl_core.inc" ; do not delete it! .set DPSTART = pc .set flashlast = pc .dseg HERESTART: .eseg .include "amforth-eeprom.inc" 000072 ff ff ; some configs 000074 80 12 CFG_DP: .dw DPSTART ; Dictionary Pointer 000076 e1 02 EE_HERE: .dw HERESTART ; Memory Allocation 000078 cc 00 EE_EHERE: .dw EHERESTART ; EEProm Memory Allocation 00007a 43 04 CFG_WLSCOPE: .dw XT_GET_CURRENT ; default wordlist scope 00007c 9a 00 CFG_FORTHRECOGNIZER: .dw CFG_RECOGNIZERLISTLEN ; Recognizer word set ; LEAVE stack is between data stack and return stack. 00007e b0 21 CFG_LP0: .dw stackstart+1 000080 98 04 CFG_TURNKEY: .dw XT_APPLTURNKEY ; TURNKEY 000082 96 09 CFG_ENVIRONMENT:.dw VE_ENVHEAD ; environmental queries 000084 86 00 CFG_CURRENT: .dw CFG_FORTHWORDLIST ; forth-wordlist 000086 7b 12 CFG_FORTHWORDLIST:.dw VE_HEAD ; pre-defined (compiled in) wordlist CFG_ORDERLISTLEN: 000088 01 00 .dw 1 CFG_ORDERLIST: ; list of wordlist id, exactly numwordlist entries 00008a 86 00 .dw CFG_FORTHWORDLIST ; get/set-order 00008c .byte (NUMWORDLISTS-1)*CELLSIZE ; one slot is already used CFG_RECOGNIZERLISTLEN: 00009a 02 00 .dw 2 CFG_RECOGNIZERLIST: 00009c 8a 0f .dw XT_REC_FIND 00009e 76 0f .dw XT_REC_NUM 0000a0 .byte (NUMRECOGNIZERS-2)*CELLSIZE ; two slots are already used EE_STOREI: 0000a4 15 08 .dw XT_DO_STOREI ; Store a cell into flash ; MARKER saves everything up to here. Nothing beyond gets saved EE_MARKER: 0000a6 a6 00 .dw EE_MARKER ; default user area EE_INITUSER: 0000a8 00 00 .dw 0 ; USER_STATE 0000aa 00 00 .dw 0 ; USER_FOLLOWER 0000ac ff 21 .dw rstackstart ; USER_RP 0000ae af 21 .dw stackstart ; USER_SP0 0000b0 af 21 .dw stackstart ; USER_SP 0000b2 00 00 .dw 0 ; USER_HANDLER 0000b4 0a 00 .dw 10 ; USER_BASE 0000b6 e1 00 .dw XT_TX ; USER_EMIT 0000b8 ef 00 .dw XT_TXQ ; USER_EMITQ 0000ba b6 00 .dw XT_RX ; USER_KEY 0000bc d1 00 .dw XT_RXQ ; USER_KEYQ 0000be 8b 11 .dw XT_SOURCETIB ; USER_SOURCE 0000c0 00 00 .dw 0 ; USER_G_IN 0000c2 78 11 .dw XT_REFILLTIB ; USER_REFILL 0000c4 50 0e .dw XT_DEFAULT_PROMPTOK 0000c6 6f 0e .dw XT_DEFAULT_PROMPTERROR 0000c8 5f 0e .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: 0000ca 17 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 "ATmega2561" register use summary: r0 : 26 r1 : 5 r2 : 9 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: 77 r17: 57 r18: 52 r19: 37 r20: 13 r21: 38 r22: 11 r23: 4 r24: 187 r25: 133 r26: 28 r27: 17 r28: 7 r29: 4 r30: 81 r31: 41 x : 4 y : 203 z : 41 Registers used: 29 out of 35 (82.9%) "ATmega2561" 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 : 2 brcs : 1 break : 0 breq : 6 brge : 1 brhc : 0 brhs : 0 brid : 0 brie : 0 brlo : 1 brlt : 3 brmi : 3 brne : 13 brpl : 0 brsh : 0 brtc : 0 brts : 0 brvc : 0 brvs : 2 bset : 0 bst : 0 call : 1 cbi : 0 cbr : 0 clc : 1 clh : 0 cli : 5 cln : 0 clr : 21 cls : 0 clt : 0 clv : 0 clz : 0 com : 14 cp : 11 cpc : 10 cpi : 2 cpse : 0 dec : 10 eicall: 1 eijmp : 0 elpm : 16 eor : 3 fmul : 0 fmuls : 0 fmulsu: 0 icall : 0 ijmp : 1 in : 14 inc : 3 jmp : 8 ld : 136 ldd : 4 ldi : 31 lds : 1 lpm : 0 lsl : 14 lsr : 2 mov : 15 movw : 65 mul : 5 muls : 1 mulsu : 2 neg : 0 nop : 1 or : 9 ori : 0 out : 26 pop : 47 push : 39 rcall : 69 ret : 6 reti : 1 rjmp : 102 rol : 32 ror : 5 sbc : 9 sbci : 3 sbi : 3 sbic : 3 sbis : 0 sbiw : 7 sbr : 0 sbrc : 4 sbrs : 3 sec : 1 seh : 0 sei : 1 sen : 0 ser : 3 ses : 0 set : 0 sev : 0 sez : 0 sleep : 0 spm : 2 st : 74 std : 8 sts : 1 sub : 6 subi : 3 swap : 0 tst : 0 wdr : 0 Instructions used: 71 out of 116 (61.2%) "ATmega2561" memory use summary [bytes]: Segment Begin End Code Data Used Size Use% --------------------------------------------------------------- [.cseg] 0x000000 0x03e07e 1962 12820 14782 262144 5.6% [.dseg] 0x000200 0x0002e1 0 225 225 8192 2.7% [.eseg] 0x000000 0x0000cc 0 204 204 4096 5.0% Assembly complete, 0 errors, 8 warnings