AVRASM ver. 2.1.52 p644-16.asm Sun Apr 30 20:10:15 2017 p644-16.asm(5): Including file '../../avr8\preamble.inc' ../../avr8\preamble.inc(2): Including file '../../avr8\macros.asm' ../../avr8\macros.asm(6): Including file '../../avr8\user.inc' ../../avr8\preamble.inc(6): Including file '../../avr8/devices/atmega644\device.asm' ../../avr8/devices/atmega644\device.asm(5): Including file '../../avr8/Atmel/Appnotes2\m644def.inc' p644-16.asm(14): Including file '../../avr8\drivers/usart_0.asm' ../../avr8\drivers/usart_0.asm(32): Including file '../../avr8\drivers/usart_common.asm' ../../avr8\drivers/usart_common.asm(11): Including file '../../avr8\drivers/usart-rx-buffer.asm' ../../avr8\drivers/usart_common.asm(24): Including file '../../avr8\words/usart-tx-poll.asm' ../../avr8\drivers/usart_common.asm(29): Including file '../../avr8\words/ubrr.asm' ../../avr8\drivers/usart_common.asm(30): Including file '../../avr8\words/usart.asm' p644-16.asm(19): Including file '../../avr8\drivers/1wire.asm' p644-16.asm(21): Including file '../../avr8\amforth.asm' ../../avr8\amforth.asm(12): Including file '../../avr8\drivers/generic-isr.asm' ../../avr8\amforth.asm(14): Including file '../../avr8\dict/rww.inc' ../../avr8\dict/rww.inc(1): Including file '../../avr8\words/mplus.asm' ../../avr8\dict/rww.inc(2): Including file '../../common\words/ud-star.asm' ../../avr8\dict/rww.inc(3): Including file '../../common\words/umax.asm' ../../avr8\dict/rww.inc(4): Including file '../../common\words/umin.asm' ../../avr8\dict/rww.inc(5): Including file '../../avr8\words/immediate-q.asm' ../../avr8\dict/rww.inc(6): Including file '../../avr8\words/name2flags.asm' ../../avr8\dict/rww.inc(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.asm(15): Including file 'dict_appl.inc' dict_appl.inc(3): Including file '../../common\words/dot-s.asm' dict_appl.inc(4): Including file '../../avr8\words/spirw.asm' dict_appl.inc(5): Including file '../../avr8\words/n-spi.asm' dict_appl.inc(6): Including file 'words/applturnkey.asm' dict_appl.inc(7): Including file '../../avr8\dict/compiler2.inc' ../../avr8\dict/compiler2.inc(8): Including file '../../avr8\words/set-current.asm' ../../avr8\dict/compiler2.inc(9): Including file '../../avr8\words/wordlist.asm' ../../avr8\dict/compiler2.inc(11): Including file '../../avr8\words/forth-wordlist.asm' ../../avr8\dict/compiler2.inc(12): Including file '../../common\words/set-order.asm' ../../avr8\dict/compiler2.inc(13): Including file '../../common\words/set-recognizer.asm' ../../avr8\dict/compiler2.inc(14): Including file '../../common\words/get-recognizer.asm' ../../avr8\dict/compiler2.inc(15): Including file '../../avr8\words/code.asm' ../../avr8\dict/compiler2.inc(16): Including file '../../avr8\words/end-code.asm' ../../avr8\dict/compiler2.inc(17): Including file '../../avr8\words/marker.asm' ../../avr8\dict/compiler2.inc(18): Including file '../../common\words/postpone.asm' dict_appl.inc(8): Including file '../../avr8\words/2r_fetch.asm' ../../avr8\amforth.asm(23): Including file '../../avr8\amforth-interpreter.asm' ../../avr8\amforth.asm(24): Including file '../../avr8\dict/nrww.inc' ../../avr8\dict/nrww.inc(4): Including file '../../avr8\words/exit.asm' ../../avr8\dict/nrww.inc(5): Including file '../../avr8\words/execute.asm' ../../avr8\dict/nrww.inc(6): Including file '../../avr8\words/dobranch.asm' ../../avr8\dict/nrww.inc(7): Including file '../../avr8\words/docondbranch.asm' ../../avr8\dict/nrww.inc(10): Including file '../../avr8\words/doliteral.asm' ../../avr8\dict/nrww.inc(11): Including file '../../avr8\words/dovariable.asm' ../../avr8\dict/nrww.inc(12): Including file '../../avr8\words/doconstant.asm' ../../avr8\dict/nrww.inc(13): Including file '../../avr8\words/douser.asm' ../../avr8\dict/nrww.inc(14): Including file '../../avr8\words/do-value.asm' ../../avr8\dict/nrww.inc(15): Including file '../../avr8\words/fetch.asm' ../../avr8\dict/nrww.inc(16): Including file '../../avr8\words/store.asm' ../../avr8\dict/nrww.inc(17): Including file '../../avr8\words/cstore.asm' ../../avr8\dict/nrww.inc(18): Including file '../../avr8\words/cfetch.asm' ../../avr8\dict/nrww.inc(19): Including file '../../avr8\words/fetch-u.asm' ../../avr8\dict/nrww.inc(20): Including file '../../avr8\words/store-u.asm' ../../avr8\dict/nrww.inc(23): Including file '../../avr8\words/dup.asm' ../../avr8\dict/nrww.inc(24): Including file '../../avr8\words/qdup.asm' ../../avr8\dict/nrww.inc(25): Including file '../../avr8\words/swap.asm' ../../avr8\dict/nrww.inc(26): Including file '../../avr8\words/over.asm' ../../avr8\dict/nrww.inc(27): Including file '../../avr8\words/drop.asm' ../../avr8\dict/nrww.inc(28): Including file '../../avr8\words/rot.asm' ../../avr8\dict/nrww.inc(29): Including file '../../avr8\words/nip.asm' ../../avr8\dict/nrww.inc(31): Including file '../../avr8\words/r_from.asm' ../../avr8\dict/nrww.inc(32): Including file '../../avr8\words/to_r.asm' ../../avr8\dict/nrww.inc(33): Including file '../../avr8\words/r_fetch.asm' ../../avr8\dict/nrww.inc(36): Including file '../../common\words/not-equal.asm' ../../avr8\dict/nrww.inc(37): Including file '../../avr8\words/equalzero.asm' ../../avr8\dict/nrww.inc(38): Including file '../../avr8\words/lesszero.asm' ../../avr8\dict/nrww.inc(39): Including file '../../avr8\words/greaterzero.asm' ../../avr8\dict/nrww.inc(40): Including file '../../avr8\words/d-greaterzero.asm' ../../avr8\dict/nrww.inc(41): Including file '../../avr8\words/d-lesszero.asm' ../../avr8\dict/nrww.inc(43): Including file '../../avr8\words/true.asm' ../../avr8\dict/nrww.inc(44): Including file '../../avr8\words/zero.asm' ../../avr8\dict/nrww.inc(45): Including file '../../avr8\words/uless.asm' ../../avr8\dict/nrww.inc(46): Including file '../../common\words/u-greater.asm' ../../avr8\dict/nrww.inc(47): Including file '../../avr8\words/less.asm' ../../avr8\dict/nrww.inc(48): Including file '../../avr8\words/greater.asm' ../../avr8\dict/nrww.inc(50): Including file '../../avr8\words/log2.asm' ../../avr8\dict/nrww.inc(51): Including file '../../avr8\words/minus.asm' ../../avr8\dict/nrww.inc(52): Including file '../../avr8\words/plus.asm' ../../avr8\dict/nrww.inc(53): Including file '../../avr8\words/mstar.asm' ../../avr8\dict/nrww.inc(54): Including file '../../avr8\words/umslashmod.asm' ../../avr8\dict/nrww.inc(55): Including file '../../avr8\words/umstar.asm' ../../avr8\dict/nrww.inc(57): Including file '../../avr8\words/invert.asm' ../../avr8\dict/nrww.inc(58): Including file '../../avr8\words/2slash.asm' ../../avr8\dict/nrww.inc(59): Including file '../../avr8\words/2star.asm' ../../avr8\dict/nrww.inc(60): Including file '../../avr8\words/and.asm' ../../avr8\dict/nrww.inc(61): Including file '../../avr8\words/or.asm' ../../avr8\dict/nrww.inc(62): Including file '../../avr8\words/xor.asm' ../../avr8\dict/nrww.inc(64): Including file '../../avr8\words/1plus.asm' ../../avr8\dict/nrww.inc(65): Including file '../../avr8\words/1minus.asm' ../../avr8\dict/nrww.inc(66): Including file '../../common\words/q-negate.asm' ../../avr8\dict/nrww.inc(67): Including file '../../avr8\words/lshift.asm' ../../avr8\dict/nrww.inc(68): Including file '../../avr8\words/rshift.asm' ../../avr8\dict/nrww.inc(69): Including file '../../avr8\words/plusstore.asm' ../../avr8\dict/nrww.inc(71): Including file '../../avr8\words/rpfetch.asm' ../../avr8\dict/nrww.inc(72): Including file '../../avr8\words/rpstore.asm' ../../avr8\dict/nrww.inc(73): Including file '../../avr8\words/spfetch.asm' ../../avr8\dict/nrww.inc(74): Including file '../../avr8\words/spstore.asm' ../../avr8\dict/nrww.inc(76): Including file '../../avr8\words/dodo.asm' ../../avr8\dict/nrww.inc(77): Including file '../../avr8\words/i.asm' ../../avr8\dict/nrww.inc(78): Including file '../../avr8\words/doplusloop.asm' ../../avr8\dict/nrww.inc(79): Including file '../../avr8\words/doloop.asm' ../../avr8\dict/nrww.inc(80): Including file '../../avr8\words/unloop.asm' ../../avr8\dict/nrww.inc(84): Including file '../../avr8\words/cmove_g.asm' ../../avr8\dict/nrww.inc(85): Including file '../../avr8\words/byteswap.asm' ../../avr8\dict/nrww.inc(86): Including file '../../avr8\words/up.asm' ../../avr8\dict/nrww.inc(87): Including file '../../avr8\words/1ms.asm' ../../avr8\dict/nrww.inc(88): Including file '../../avr8\words/2to_r.asm' ../../avr8\dict/nrww.inc(89): Including file '../../avr8\words/2r_from.asm' ../../avr8\dict/nrww.inc(91): Including file '../../avr8\words/store-e.asm' ../../avr8\dict/nrww.inc(92): Including file '../../avr8\words/fetch-e.asm' ../../avr8\dict/nrww.inc(93): Including file '../../avr8\words/store-i.asm' ../../avr8\dict/nrww.inc(97): Including file '../../avr8\words/store-i_nrww.asm' ../../avr8\dict/nrww.inc(99): Including file '../../avr8\words/fetch-i.asm' ../../avr8\dict/nrww.inc(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/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.asm(25): Including file 'dict_appl_core.inc' ../../avr8\amforth.asm(36): Including file '../../avr8\amforth-eeprom.inc' ; file see ../template/template.asm. You may want to ; copy that file to this one and edit it afterwards. .include "preamble.inc" .include "macros.asm" .set DICT_COMPILER2 = 0 ; .set cpu_msp430 = 0 .set cpu_avr8 = 1 .include "user.inc" ; ; used by the multitasker .set USER_STATE = 0 .set USER_FOLLOWER = 2 ; stackpointer, used by mulitasker .set USER_RP = 4 .set USER_SP0 = 6 .set USER_SP = 8 ; excpection handling .set USER_HANDLER = 10 ; numeric IO .set USER_BASE = 12 ; character IO .set USER_EMIT = 14 .set USER_EMITQ = 16 .set USER_KEY = 18 .set USER_KEYQ = 20 .set USER_SOURCE = 22 .set USER_TO_IN = 24 .set USER_REFILL = 26 .set USER_P_OK = 28 .set USER_P_ERR = 30 .set USER_P_RDY = 32 .set SYSUSERSIZE = 34 ; .def zerol = r2 .def zeroh = r3 .def upl = r4 .def uph = r5 .def al = r6 .def ah = r7 .def bl = r8 .def bh = r9 ; internal .def mcu_boot = r10 .def isrflag = r11 .def temp4 = r14 .def temp5 = r15 .def temp0 = r16 .def temp1 = r17 .def temp2 = r18 .def temp3 = r19 .def temp6 = r20 .def temp7 = r21 .def tosl = r24 .def tosh = r25 .def wl = r22 .def wh = r23 .macro loadtos ld tosl, Y+ ld tosh, Y+ .endmacro .macro savetos st -Y, tosh st -Y, tosl .endmacro .macro in_ .if (@1 < $40) in @0,@1 .else lds @0,@1 .endif .endmacro .macro out_ .if (@0 < $40) out @0,@1 .else sts @0,@1 .endif .endmacro .macro sbi_ .if (@0 < $40) sbi @0,@1 .else in_ @2,@0 ori @2,exp2(@1) out_ @0,@2 .endif .endmacro .macro cbi_ .if (@0 < $40) cbi @0,@1 .else in_ @2,@0 andi @2,~(exp2(@1)) out_ @0,@2 .endif .endmacro .macro jmp_ ; a more flexible macro .ifdef @0 .if (@0-pc > 2040) || (pc-@0>2040) jmp @0 .else rjmp @0 .endif .else jmp @0 .endif .endmacro .macro call_ ; a more flexible macro .ifdef @0 .if (@0-pc > 2040) || (pc-@0>2040) call @0 .else rcall @0 .endif .else call @0 .endif .endmacro ; F_CPU ; µsec 16000000 14745600 8000000 1000000 ; 1 16 14,74 8 1 ; 10 160 147,45 80 10 ; 100 1600 1474,56 800 100 ; 1000 16000 14745,6 8000 1000 ; ; cycles = µsec * f_cpu / 1e6 ; n_loops=cycles/5 ; ; cycles already used will be subtracted from the delay ; the waittime resolution is 1 cycle (delay from exact to +1 cycle) ; the maximum delay at 20MHz (50ns/clock) is 38350ns ; waitcount register must specify an immediate register ; ; busy waits a specfied amount of microseconds .macro delay .set cycles = ( ( @0 * F_CPU ) / 1000000 ) .if (cycles > ( 256 * 255 * 4 + 2)) .error "MACRO delay - too many cycles to burn" .else .if (cycles > 6) .set loop_cycles = (cycles / 4) ldi zl,low(loop_cycles) ldi zh,high(loop_cycles) sbiw Z, 1 brne pc-1 .set cycles = (cycles - (loop_cycles * 4)) .endif .if (cycles > 0) .if (cycles & 4) rjmp pc+1 rjmp pc+1 .endif .if (cycles & 2) rjmp pc+1 .endif .if (cycles & 1) nop .endif .endif .endif .endmacro ; portability macros, they come from the msp430 branches .macro DEST .dw @0 .endm ; controller specific file selected via include ; directory definition when calling the assembler (-I) .include "device.asm" ; generated automatically, do not edit .list .equ ramstart = 256 .equ CELLSIZE = 2 .macro readflashcell lsl zl rol zh lpm @0, Z+ lpm @1, Z+ .endmacro .macro writeflashcell lsl zl rol zh .endmacro .set WANT_ANALOG_COMPARATOR = 0 .set WANT_USART0 = 0 .set WANT_PORTA = 0 .set WANT_PORTB = 0 .set WANT_PORTC = 0 .set WANT_PORTD = 0 .set WANT_TIMER_COUNTER_0 = 0 .set WANT_TIMER_COUNTER_2 = 0 .set WANT_WATCHDOG = 0 .set WANT_JTAG = 0 .set WANT_BOOT_LOAD = 0 .set WANT_EXTERNAL_INTERRUPT = 0 .set WANT_AD_CONVERTER = 0 .set WANT_TIMER_COUNTER_1 = 0 .set WANT_EEPROM = 0 .set WANT_TWI = 0 .set WANT_SPI = 0 .set WANT_CPU = 0 .equ intvecsize = 2 ; please verify; flash size: 65536 bytes .equ pclen = 2 ; please verify .overlap .org 2 000002 d12a rcall isr ; External Interrupt Request 0 .org 4 000004 d128 rcall isr ; External Interrupt Request 1 .org 6 000006 d126 rcall isr ; External Interrupt Request 2 .org 8 000008 d124 rcall isr ; Pin Change Interrupt Request 0 .org 10 00000a d122 rcall isr ; Pin Change Interrupt Request 1 .org 12 00000c d120 rcall isr ; Pin Change Interrupt Request 2 .org 14 00000e d11e rcall isr ; Pin Change Interrupt Request 3 .org 16 000010 d11c rcall isr ; Watchdog Time-out Interrupt .org 18 000012 d11a rcall isr ; Timer/Counter2 Compare Match A .org 20 000014 d118 rcall isr ; Timer/Counter2 Compare Match B .org 22 000016 d116 rcall isr ; Timer/Counter2 Overflow .org 24 000018 d114 rcall isr ; Timer/Counter1 Capture Event .org 26 00001a d112 rcall isr ; Timer/Counter1 Compare Match A .org 28 00001c d110 rcall isr ; Timer/Counter1 Compare Match B .org 30 00001e d10e rcall isr ; Timer/Counter1 Overflow .org 32 000020 d10c rcall isr ; Timer/Counter0 Compare Match A .org 34 000022 d10a rcall isr ; Timer/Counter0 Compare Match B .org 36 000024 d108 rcall isr ; Timer/Counter0 Overflow .org 38 000026 d106 rcall isr ; SPI Serial Transfer Complete .org 40 000028 d104 rcall isr ; USART0, Rx Complete .org 42 00002a d102 rcall isr ; USART0 Data register Empty .org 44 00002c d100 rcall isr ; USART0, Tx Complete .org 46 00002e d0fe rcall isr ; Analog Comparator .org 48 000030 d0fc rcall isr ; ADC Conversion Complete .org 50 000032 d0fa rcall isr ; EEPROM Ready .org 52 000034 d0f8 rcall isr ; 2-wire Serial Interface .org 54 000036 d0f6 rcall isr ; Store Program Memory Read .equ INTVECTORS = 28 .nooverlap ; compatability layer (maybe empty) ; controller data area, environment query mcu-info mcu_info: mcu_ramsize: 000037 1000 .dw 4096 mcu_eepromsize: 000038 0800 .dw 2048 mcu_maxdp: 000039 e000 .dw 57344 mcu_numints: 00003a 001c .dw 28 mcu_name: 00003b 0009 .dw 9 00003c 5441 00003d 656d 00003e 6167 00003f 3436 000040 0034 .db "ATmega644",0 .set codestart=pc ; some defaults, change them in your application master file ; see template.asm for an example ; enabling Interrupts, disabling them affects ; other settings as well. .set WANT_INTERRUPTS = 1 ; count the number of interrupts individually. ; requires a lot of RAM (one byte per interrupt) ; disabled by default. .set WANT_INTERRUPT_COUNTERS = 0 ; receiving is asynchronously, so an interrupt queue is useful. .set WANT_ISR_RX = 1 ; case insensitve dictionary lookup. .set WANT_IGNORECASE = 0 ; map all memories to one address space. Details in the ; technical guide .set WANT_UNIFIED = 0 ; terminal input buffer .set TIB_SIZE = 90 ; ANS94 needs at least 80 characters per line ; USER variables *in addition* to system ones .set APPUSERSIZE = 10 ; size of application specific user area in bytes ; addresses of various data segments .set rstackstart = RAMEND ; start address of return stack, grows downward .set stackstart = RAMEND - 80 ; start address of data stack, grows downward ; change only if you know what to you do .set NUMWORDLISTS = 8 ; number of word lists in the searh order, at least 8 .set NUMRECOGNIZERS = 4 ; total number of recognizers, two are always used. ; 10 per mille (1 per cent) is ok. .set BAUD = 38400 .set BAUD_MAXERROR = 10 ; Dictionary setup .set VE_HEAD = $0000 .set VE_ENVHEAD = $0000 .set AMFORTH_RO_SEG = NRWW_START_ADDR+1 ; cpu clock in hertz .equ F_CPU = 16000000 .set BAUD_MAXERROR = 30 .equ TIMER_INT = OVF2addr .include "drivers/usart_0.asm" .equ BAUDRATE_HIGH = UBRR0H .equ USART_C = UCSR0C .equ USART_B = UCSR0B .equ USART_A = UCSR0A .equ USART_DATA = UDR0 .ifndef URXCaddr .equ URXCaddr = URXC0addr .equ UDREaddr = UDRE0addr .endif .equ bm_USART_RXRD = 1 << RXC0 .equ bm_USART_TXRD = 1 << UDRE0 .equ bm_ENABLE_TX = 1 << TXEN0 .equ bm_ENABLE_RX = 1 << RXEN0 .equ bm_ENABLE_INT_RX = 1<rx-buf",0 000046 0000 .dw VE_HEAD .set VE_HEAD = VE_TO_RXBUF XT_TO_RXBUF: 000047 0048 .dw PFA_rx_tobuf PFA_rx_tobuf: 000048 2f08 mov temp0, tosl 000049 9110 0110 lds temp1, usart_rx_in 00004b e0e0 ldi zl, low(usart_rx_data) 00004c e0f1 ldi zh, high(usart_rx_data) 00004d 0fe1 add zl, temp1 00004e 1df3 adc zh, zeroh 00004f 8300 st Z, temp0 000050 9513 inc temp1 000051 701f andi temp1,usart_rx_mask 000052 9310 0110 sts usart_rx_in, temp1 000054 9189 000055 9199 loadtos 000056 940c 7005 jmp_ DO_NEXT ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; setup with ; ' isr-rx URXCaddr int! VE_ISR_RX: 000058 ff06 .dw $ff06 000059 7369 00005a 2d72 00005b 7872 .db "isr-rx" 00005c 0041 .dw VE_HEAD .set VE_HEAD = VE_ISR_RX XT_ISR_RX: 00005d 7001 .dw DO_COLON usart_rx_isr: 00005e 703d .dw XT_DOLITERAL 00005f 00c6 .dw usart_data 000060 7098 .dw XT_CFETCH 000061 70b1 .dw XT_DUP 000062 703d .dw XT_DOLITERAL 000063 0003 .dw 3 000064 7d7f .dw XT_EQUAL 000065 7036 .dw XT_DOCONDBRANCH 000066 0068 .dw usart_rx_isr1 000067 7a59 .dw XT_COLD usart_rx_isr1: 000068 0047 .dw XT_TO_RXBUF 000069 7020 .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: 00006a 7001 .dw DO_COLON PFA_USART_INIT_RX_BUFFER: ; ( -- ) 00006b 703d 00006c 005d .dw XT_DOLITERAL, XT_ISR_RX 00006d 703d 00006e 0028 .dw XT_DOLITERAL, URXCaddr 00006f 7487 .dw XT_INTSTORE 000070 703d .dw XT_DOLITERAL 000071 0100 .dw usart_rx_data 000072 703d .dw XT_DOLITERAL 000073 0016 .dw usart_rx_size + 6 000074 7154 .dw XT_ZERO 000075 74cf .dw XT_FILL 000076 7020 .dw XT_EXIT ; ( -- c) ; MCU ; get 1 character from input queue, wait if needed using interrupt driver VE_RX_BUFFER: 000077 ff06 .dw $ff06 000078 7872 000079 622d 00007a 6675 .db "rx-buf" 00007b 0058 .dw VE_HEAD .set VE_HEAD = VE_RX_BUFFER XT_RX_BUFFER: 00007c 7001 .dw DO_COLON PFA_RX_BUFFER: 00007d 0097 .dw XT_RXQ_BUFFER 00007e 7036 .dw XT_DOCONDBRANCH 00007f 007d .dw PFA_RX_BUFFER 000080 703d .dw XT_DOLITERAL 000081 0111 .dw usart_rx_out 000082 7098 .dw XT_CFETCH 000083 70b1 .dw XT_DUP 000084 703d .dw XT_DOLITERAL 000085 0100 .dw usart_rx_data 000086 719d .dw XT_PLUS 000087 7098 .dw XT_CFETCH 000088 70c4 .dw XT_SWAP 000089 722f .dw XT_1PLUS 00008a 703d .dw XT_DOLITERAL 00008b 000f .dw usart_rx_mask 00008c 7213 .dw XT_AND 00008d 703d .dw XT_DOLITERAL 00008e 0111 .dw usart_rx_out 00008f 708d .dw XT_CSTORE 000090 7020 .dw XT_EXIT ; ( -- f) ; MCU ; check if unread characters are in the input queue VE_RXQ_BUFFER: 000091 ff07 .dw $ff07 000092 7872 000093 2d3f 000094 7562 000095 0066 .db "rx?-buf",0 000096 0077 .dw VE_HEAD .set VE_HEAD = VE_RXQ_BUFFER XT_RXQ_BUFFER: 000097 7001 .dw DO_COLON PFA_RXQ_BUFFER: 000098 7a51 .dw XT_PAUSE 000099 703d .dw XT_DOLITERAL 00009a 0111 .dw usart_rx_out 00009b 7098 .dw XT_CFETCH 00009c 703d .dw XT_DOLITERAL 00009d 0110 .dw usart_rx_in 00009e 7098 .dw XT_CFETCH 00009f 7113 .dw XT_NOTEQUAL 0000a0 7020 .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: 0000a1 ff07 .dw $ff07 0000a2 7874 0000a3 702d 0000a4 6c6f 0000a5 006c .db "tx-poll",0 0000a6 0091 .dw VE_HEAD .set VE_HEAD = VE_TX_POLL XT_TX_POLL: 0000a7 7001 .dw DO_COLON PFA_TX_POLL: ; wait for data ready 0000a8 00b5 .dw XT_TXQ_POLL 0000a9 7036 .dw XT_DOCONDBRANCH 0000aa 00a8 .dw PFA_TX_POLL ; send to usart 0000ab 703d .dw XT_DOLITERAL 0000ac 00c6 .dw USART_DATA 0000ad 708d .dw XT_CSTORE 0000ae 7020 .dw XT_EXIT ; ( -- f) MCU ; MCU ; check if a character can be send using register poll VE_TXQ_POLL: 0000af ff08 .dw $ff08 0000b0 7874 0000b1 2d3f 0000b2 6f70 0000b3 6c6c .db "tx?-poll" 0000b4 00a1 .dw VE_HEAD .set VE_HEAD = VE_TXQ_POLL XT_TXQ_POLL: 0000b5 7001 .dw DO_COLON PFA_TXQ_POLL: 0000b6 7a51 .dw XT_PAUSE 0000b7 703d .dw XT_DOLITERAL 0000b8 00c0 .dw USART_A 0000b9 7098 .dw XT_CFETCH 0000ba 703d .dw XT_DOLITERAL 0000bb 0020 .dw bm_USART_TXRD 0000bc 7213 .dw XT_AND 0000bd 7020 .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: 0000be ff04 .dw $ff04 0000bf 6275 0000c0 7272 .db "ubrr" 0000c1 00af .dw VE_HEAD .set VE_HEAD = VE_UBRR XT_UBRR: 0000c2 706f .dw PFA_DOVALUE1 PFA_UBRR: ; ( -- ) 0000c3 0090 .dw EE_UBRRVAL 0000c4 7bb4 .dw XT_EDEFERFETCH 0000c5 7bbe .dw XT_EDEFERSTORE .include "words/usart.asm" ; MCU ; initialize usart VE_USART: 0000c6 ff06 .dw $ff06 0000c7 752b 0000c8 6173 0000c9 7472 .db "+usart" 0000ca 00be .dw VE_HEAD .set VE_HEAD = VE_USART XT_USART: 0000cb 7001 .dw DO_COLON PFA_USART: ; ( -- ) 0000cc 703d .dw XT_DOLITERAL 0000cd 0098 .dw USART_B_VALUE 0000ce 703d .dw XT_DOLITERAL 0000cf 00c1 .dw USART_B 0000d0 708d .dw XT_CSTORE 0000d1 703d .dw XT_DOLITERAL 0000d2 0006 .dw USART_C_VALUE 0000d3 703d .dw XT_DOLITERAL 0000d4 00c2 .dw USART_C | bm_USARTC_en 0000d5 708d .dw XT_CSTORE 0000d6 00c2 .dw XT_UBRR 0000d7 70b1 .dw XT_DUP 0000d8 72f9 .dw XT_BYTESWAP 0000d9 703d .dw XT_DOLITERAL 0000da 00c5 .dw BAUDRATE_HIGH 0000db 708d .dw XT_CSTORE 0000dc 703d .dw XT_DOLITERAL 0000dd 00c4 .dw BAUDRATE_LOW 0000de 708d .dw XT_CSTORE .if XT_USART_INIT_RX!=0 0000df 006a .dw XT_USART_INIT_RX .endif .if XT_USART_INIT_TX!=0 .endif 0000e0 7020 .dw XT_EXIT ; settings for 1wire interface .equ OW_PORT=PORTB .EQU OW_BIT=4 .include "drivers/1wire.asm" ; B. J. Rodriguez (MSP 430) ; Matthias Trute (AVR Atmega) ; COPYRIGHT ; (c) 2012 Bradford J. Rodriguez for the 430 code and API ; adapted 430 assembly code to AVR ; wishlist: ; use a configurable pin at runtime, compatible with bitnames.frt ; no external pull up, no external power supply for devices ; ??? ; ;.EQU OW_BIT=4 ;.equ OW_PORT=PORTE .set OW_DDR=(OW_PORT-1) .set OW_PIN=(OW_DDR-1) ;****f* 1W.RESET ; NAME ; 1W.RESET ; SYNOPSIS ; 1W.RESET ( -- f ) Initialize 1-wire devices; return true if present ; DESCRIPTION ; This configures the port pin used by the 1-wire interface, and then ; sends an "initialize" sequence to the 1-wire devices. If any device ; is present, it will be detected. ; ; Timing, per DS18B20 data sheet: ; a) Output "0" (drive output low) for >480 usec. ; b) Output "1" (let output float). ; c) After 15 to 60 usec, device will drive pin low for 60 to 240 usec. ; So, wait 75 usec and sample input. ; d) Leave output high (floating) for at least 480 usec. ;****** ; ( -- f ) ; Hardware ; Initialize 1-wire devices; return true if present VE_OW_RESET: 0000e1 ff08 .dw $ff08 0000e2 7731 0000e3 722e 0000e4 7365 0000e5 7465 .db "1w.reset" 0000e6 00c6 .dw VE_HEAD .set VE_HEAD = VE_OW_RESET XT_OW_RESET: 0000e7 00e8 .dw PFA_OW_RESET PFA_OW_RESET: 0000e8 939a 0000e9 938a savetos ; setup to output 0000ea 9a24 sbi OW_DDR, OW_BIT ; Pull output low 0000eb 982c cbi OW_PORT, OW_BIT ; Delay >480 usec 0000ec e8e0 0000ed e0f7 0000ee 9731 0000ef f7f1 DELAY 480 ; Critical timing period, disable interrupts. 0000f0 b71f in temp1, SREG 0000f1 94f8 cli ; Pull output high 0000f2 9a2c sbi OW_PORT, OW_BIT ; make pin input, sends "1" 0000f3 9824 cbi OW_DDR, OW_BIT 0000f4 e0e0 0000f5 e0f1 0000f6 9731 0000f7 f7f1 DELAY 64 ; delayB ; Sample input pin, set TOS if input is zero 0000f8 b183 in tosl, OW_PIN 0000f9 ff84 sbrs tosl, OW_BIT 0000fa ef9f ser tosh ; End critical timing period, enable interrupts 0000fb bf1f out SREG, temp1 ; release bus 0000fc 9824 cbi OW_DDR, OW_BIT 0000fd 982c cbi OW_PORT, OW_BIT ; Delay rest of 480 usec 0000fe e8e0 0000ff e0f6 000100 9731 000101 f7f1 DELAY 416 ; we now have the result flag in TOS 000102 2f89 mov tosl, tosh 000103 940c 7005 jmp_ DO_NEXT ;****f* 1W.SLOT ; NAME ; 1W.SLOT ; SYNOPSIS ; 1W.SLOT ( c -- c' ) Write and read one bit to/from 1-wire. ; DESCRIPTION ; The "touch byte" function is described in Dallas App Note 74. ; It outputs a byte to the 1-wire pin, LSB first, and reads back ; the state of the 1-wire pin after a suitable delay. ; To read a byte, output $FF and read the reply data. ; To write a byte, output that byte and discard the reply. ; ; This function performs one bit of the "touch" operation -- ; one read/write "slot" in Dallas jargon. Perform this eight ; times in a row to get the "touch byte" function. ; ; PARAMETERS ; The input parameter is xxxxxxxxbbbbbbbo where ; 'xxxxxxxx' are don't cares, ; 'bbbbbbb' are bits to be shifted down, and ; 'o' is the bit to be output in the slot. This must be 1 ; to create a read slot. ; ; The returned value is xxxxxxxxibbbbbbb where ; 'xxxxxxxx' are not known (the input shifted down 1 position), ; 'i' is the bit read during the slot. This has no meaning ; if it was a write slot. ; 'bbbbbbb' are the 7 input bits, shifted down one position. ; ; This peculiar parameter usage allows OWTOUCH to be written as ; OWSLOT OWSLOT OWSLOT OWSLOT OWSLOT OWSLOT OWSLOT OWSLOT ; ; NOTES ; Interrupts are disabled during each bit. ; Timing, per DS18B20 data sheet: ; a) Output "0" for start period. (> 1 us, < 15 us, typ. 6 us*) ; b) Output data bit (0 or 1), open drain ; c) After MS from start of cycle, sample input (15 to 60 us, typ. 25 us*) ; d) After write-0 period from start of cycle, output "1" (>60 us) ; e) After recovery period, loop or return. (> 1 us) ; For writes, DS18B20 samples input 15 to 60 usec from start of cycle. ; * "Typical" values are per App Note 132 for a 300m cable length. ; --------- ------------------------------- ; \ / / ; ------------------------------- ; a b c d e ; | 6us | 19us | 35us | 2us | ;****** ; ( c -- c' ) ; Hardware ; Write and read one bit to/from 1-wire. VE_OW_SLOT: 000105 ff07 .dw $ff07 000106 7731 000107 732e 000108 6f6c 000109 0074 .db "1w.slot",0 00010a 00e1 .dw VE_HEAD .set VE_HEAD = VE_OW_SLOT XT_OW_SLOT: 00010b 010c .dw PFA_OW_SLOT PFA_OW_SLOT: ; pull low 00010c 982c cbi OW_PORT, OW_BIT 00010d 9a24 sbi OW_DDR, OW_BIT ; disable interrupts 00010e b71f in temp1, SREG 00010f 94f8 cli 000110 e1e8 000111 e0f0 000112 9731 000113 f7f1 DELAY 6 ; DELAY A ; check bit 000114 9488 clc 000115 9587 ror tosl 000116 f410 brcc PFA_OW_SLOT0 ; a 0 keeps the bus low ; release bus, a 1 is written 000117 9a2c sbi OW_PORT, OW_BIT 000118 9824 cbi OW_DDR, OW_BIT PFA_OW_SLOT0: ; sample the input (no action required if zero) 000119 e2e4 00011a e0f0 00011b 9731 00011c f7f1 DELAY 9 ; wait DELAY E to sample 00011d b103 in temp0, OW_PIN 00011e fd04 sbrc temp0, OW_BIT 00011f 6880 ori tosl, $80 000120 ecec 000121 e0f0 000122 9731 000123 f7f1 DELAY 51 ; DELAY B 000124 9a2c sbi OW_PORT, OW_BIT ; release bus 000125 9824 cbi OW_DDR, OW_BIT 000126 e0e8 000127 e0f0 000128 9731 000129 f7f1 delay 2 ; re-enable interrupts 00012a bf1f out SREG, temp1 00012b 940c 7005 jmp_ DO_NEXT .include "amforth.asm" ;;;; ;;;; GPL V2 (only) .set AMFORTH_NRWW_SIZE=(FLASHEND-AMFORTH_RO_SEG)*2 .set corepc = pc .org $0000 000000 940c 7a5a jmp_ PFA_COLD .org corepc .include "drivers/generic-isr.asm" .eseg 000000 intvec: .byte INTVECTORS * CELLSIZE .dseg 000112 intcnt: .byte INTVECTORS .cseg ; interrupt routine gets called (again) by rcall! This gives the ; address of the int-vector on the stack. isr: 00012d 920a st -Y, r0 00012e b60f in r0, SREG 00012f 920a st -Y, r0 .if (pclen==3) .endif 000130 900f pop r0 000131 900f pop r0 ; = intnum * intvectorsize + 1 (address following the rcall) 000132 940a dec r0 .if intvecsize == 1 ; .endif 000133 2cb0 mov isrflag, r0 000134 93ff push zh 000135 93ef push zl 000136 e1e2 ldi zl, low(intcnt) 000137 e0f1 ldi zh, high(intcnt) 000138 9406 lsr r0 ; we use byte addresses in the counter array, not words 000139 0de0 add zl, r0 00013a 1df3 adc zh, zeroh 00013b 8000 ld r0, Z 00013c 9403 inc r0 00013d 8200 st Z, r0 00013e 91ef pop zl 00013f 91ff pop zh 000140 9009 ld r0, Y+ 000141 be0f out SREG, r0 000142 9009 ld r0, Y+ 000143 9508 ret ; returns the interrupt, the rcall stack frame is removed! ; no reti here, see words/isr-end.asm ; lower part of the dictionary .include "dict/rww.inc" ; Arithmetics ; add a number to a double cell VE_MPLUS: 000144 ff02 .dw $ff02 000145 2b6d .db "m+" 000146 0105 .dw VE_HEAD .set VE_HEAD = VE_MPLUS XT_MPLUS: 000147 7001 .dw DO_COLON PFA_MPLUS: 000148 7d67 .dw XT_S2D 000149 7415 .dw XT_DPLUS 00014a 7020 .dw XT_EXIT .include "words/ud-star.asm" .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_UDSTAR: 00014b ff03 .dw $ff03 00014c 6475 ../../common\words/ud-star.asm(9): warning: .cseg .db misalignment - padding zero byte 00014d 002a .db "ud*" 00014e 0144 .dw VE_HEAD .set VE_HEAD = VE_UDSTAR XT_UDSTAR: 00014f 7001 .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 + ; 000150 70b1 000151 70ff 000152 71e0 000153 70d9 .DW XT_DUP,XT_TO_R,XT_UMSTAR,XT_DROP 000154 70c4 000155 70f6 000156 71e0 000157 70e1 000158 719d 000159 7020 .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: 00015a ff04 .dw $ff04 00015b 6d75 00015c 7861 .db "umax" 00015d 014b .dw VE_HEAD .set VE_HEAD = VE_UMAX XT_UMAX: 00015e 7001 .dw DO_COLON PFA_UMAX: .endif 00015f 7565 000160 715c .DW XT_2DUP,XT_ULESS 000161 7036 .dw XT_DOCONDBRANCH 000162 0164 DEST(UMAX1) 000163 70c4 .DW XT_SWAP 000164 70d9 UMAX1: .DW XT_DROP 000165 7020 .dw XT_EXIT .include "words/umin.asm" .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_UMIN: 000166 ff04 .dw $ff04 000167 6d75 000168 6e69 .db "umin" 000169 015a .dw VE_HEAD .set VE_HEAD = VE_UMIN XT_UMIN: 00016a 7001 .dw DO_COLON PFA_UMIN: .endif 00016b 7565 00016c 7167 .DW XT_2DUP,XT_UGREATER 00016d 7036 .dw XT_DOCONDBRANCH 00016e 0170 DEST(UMIN1) 00016f 70c4 .DW XT_SWAP 000170 70d9 UMIN1: .DW XT_DROP 000171 7020 .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: 000172 7001 .dw DO_COLON PFA_IMMEDIATEQ: 000173 703d .dw XT_DOLITERAL 000174 8000 .dw $8000 000175 7213 .dw XT_AND 000176 711a .dw XT_ZEROEQUAL 000177 7036 .dw XT_DOCONDBRANCH 000178 017b DEST(IMMEDIATEQ1) 000179 7d86 .dw XT_ONE 00017a 7020 .dw XT_EXIT IMMEDIATEQ1: ; not immediate 00017b 714b .dw XT_TRUE 00017c 7020 .dw XT_EXIT .include "words/name2flags.asm" ; Tools ; get the flags from a name token VE_NAME2FLAGS: 00017d ff0a .dw $ff0a 00017e 616e 00017f 656d 000180 663e 000181 616c 000182 7367 .db "name>flags" 000183 0166 .dw VE_HEAD .set VE_HEAD = VE_NAME2FLAGS XT_NAME2FLAGS: 000184 7001 .dw DO_COLON PFA_NAME2FLAGS: 000185 73cb .dw XT_FETCHI ; skip to link field 000186 703d .dw XT_DOLITERAL 000187 ff00 .dw $ff00 000188 7213 .dw XT_AND 000189 7020 .dw XT_EXIT .if AMFORTH_NRWW_SIZE > 8000 .include "dict/appl_8k.inc" .include "words/newest.asm" ; System Variable ; system state VE_NEWEST: 00018a ff06 .dw $ff06 00018b 656e 00018c 6577 00018d 7473 .db "newest" 00018e 017d .dw VE_HEAD .set VE_HEAD = VE_NEWEST XT_NEWEST: 00018f 7048 .dw PFA_DOVARIABLE PFA_NEWEST: 000190 012e .dw ram_newest .dseg 00012e ram_newest: .byte 4 .include "words/latest.asm" ; System Variable ; system state VE_LATEST: 000191 ff06 .dw $ff06 000192 616c 000193 6574 000194 7473 .db "latest" 000195 018a .dw VE_HEAD .set VE_HEAD = VE_LATEST XT_LATEST: 000196 7048 .dw PFA_DOVARIABLE PFA_LATEST: 000197 0132 .dw ram_latest .dseg 000132 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: 000198 ff08 .dw $ff08 000199 6328 00019a 6572 00019b 7461 00019c 2965 .db "(create)" 00019d 0191 .dw VE_HEAD .set VE_HEAD = VE_DOCREATE XT_DOCREATE: 00019e 7001 .dw DO_COLON PFA_DOCREATE: .endif 00019f 79b4 0001a0 02f5 .DW XT_PARSENAME,XT_WLSCOPE ; ( -- addr len wid) 0001a1 70b1 0001a2 018f 0001a3 755e 0001a4 7081 .DW XT_DUP,XT_NEWEST,XT_CELLPLUS,XT_STORE ; save the wid 0001a5 02da 0001a6 018f 0001a7 7081 .DW XT_HEADER,XT_NEWEST,XT_STORE ; save the nt 0001a8 7020 .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: 0001a9 0001 .dw $0001 0001aa 005c .db $5c,0 0001ab 0198 .dw VE_HEAD .set VE_HEAD = VE_BACKSLASH XT_BACKSLASH: 0001ac 7001 .dw DO_COLON PFA_BACKSLASH: .endif 0001ad 799b .dw XT_SOURCE 0001ae 70f0 .dw XT_NIP 0001af 757e .dw XT_TO_IN 0001b0 7081 .dw XT_STORE 0001b1 7020 .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: 0001b2 0001 .dw $0001 0001b3 0028 .db "(" ,0 0001b4 01a9 .dw VE_HEAD .set VE_HEAD = VE_LPAREN XT_LPAREN: 0001b5 7001 .dw DO_COLON PFA_LPAREN: .endif 0001b6 703d .dw XT_DOLITERAL 0001b7 0029 .dw ')' 0001b8 7987 .dw XT_PARSE 0001b9 756e .dw XT_2DROP 0001ba 7020 .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: 0001bb ff07 .dw $ff07 0001bc 6f63 0001bd 706d 0001be 6c69 0001bf 0065 .db "compile",0 0001c0 01b2 .dw VE_HEAD .set VE_HEAD = VE_COMPILE XT_COMPILE: 0001c1 7001 .dw DO_COLON PFA_COMPILE: .endif 0001c2 70f6 .dw XT_R_FROM 0001c3 70b1 .dw XT_DUP 0001c4 7bab .dw XT_ICELLPLUS 0001c5 70ff .dw XT_TO_R 0001c6 73cb .dw XT_FETCHI 0001c7 01cc .dw XT_COMMA 0001c8 7020 .dw XT_EXIT .include "words/comma.asm" ; Dictionary ; compile 16 bit into flash at DP VE_COMMA: 0001c9 ff01 .dw $ff01 0001ca 002c .db ',',0 ; , 0001cb 01bb .dw VE_HEAD .set VE_HEAD = VE_COMMA XT_COMMA: 0001cc 7001 .dw DO_COLON PFA_COMMA: 0001cd 75ae .dw XT_DP 0001ce 7373 .dw XT_STOREI 0001cf 75ae .dw XT_DP 0001d0 722f .dw XT_1PLUS 0001d1 7b99 .dw XT_DOTO 0001d2 75af .dw PFA_DP 0001d3 7020 .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: 0001d4 0003 .dw $0003 0001d5 275b 0001d6 005d .db "[']",0 0001d7 01c9 .dw VE_HEAD .set VE_HEAD = VE_BRACKETTICK XT_BRACKETTICK: 0001d8 7001 .dw DO_COLON PFA_BRACKETTICK: .endif 0001d9 780a .dw XT_TICK 0001da 01e2 .dw XT_LITERAL 0001db 7020 .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: 0001dc 0007 .dw $0007 0001dd 696c 0001de 6574 0001df 6172 0001e0 006c .db "literal",0 0001e1 01d4 .dw VE_HEAD .set VE_HEAD = VE_LITERAL XT_LITERAL: 0001e2 7001 .dw DO_COLON PFA_LITERAL: .endif 0001e3 01c1 .DW XT_COMPILE 0001e4 703d .DW XT_DOLITERAL 0001e5 01cc .DW XT_COMMA 0001e6 7020 .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: 0001e7 0008 .dw $0008 0001e8 6c73 0001e9 7469 0001ea 7265 0001eb 6c61 .db "sliteral" 0001ec 01dc .dw VE_HEAD .set VE_HEAD = VE_SLITERAL XT_SLITERAL: 0001ed 7001 .dw DO_COLON PFA_SLITERAL: .endif 0001ee 01c1 .dw XT_COMPILE 0001ef 776d .dw XT_DOSLITERAL ; ( -- addr n) 0001f0 777b .dw XT_SCOMMA 0001f1 7020 .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: 0001f2 7001 .dw DO_COLON PFA_GMARK: 0001f3 75ae .dw XT_DP 0001f4 01c1 .dw XT_COMPILE 0001f5 ffff .dw -1 ; ffff does not erase flash 0001f6 7020 .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: 0001f7 7001 .dw DO_COLON PFA_GRESOLVE: 0001f8 7b57 .dw XT_QSTACK 0001f9 75ae .dw XT_DP 0001fa 70c4 .dw XT_SWAP 0001fb 7373 .dw XT_STOREI 0001fc 7020 .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: 00028b 7001 .dw DO_COLON PFA_QDOCHECK: .endif 00028c 7565 .dw XT_2DUP 00028d 7d7f .dw XT_EQUAL 00028e 70b1 .dw XT_DUP 00028f 70ff .dw XT_TO_R 000290 7036 .dw XT_DOCONDBRANCH 000291 0293 DEST(PFA_QDOCHECK1) 000292 756e .dw XT_2DROP PFA_QDOCHECK1: 000293 70f6 .dw XT_R_FROM 000294 71fd .dw XT_INVERT 000295 7020 .dw XT_EXIT .include "words/endloop.asm" .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_ENDLOOP: 000296 ff07 .dw $ff07 000297 6e65 000298 6c64 000299 6f6f 00029a 0070 .db "endloop",0 00029b 027f .dw VE_HEAD .set VE_HEAD = VE_ENDLOOP XT_ENDLOOP: 00029c 7001 .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. 00029d 0200 .DW XT_LRESOLVE 00029e 02a9 00029f 70b9 0002a0 7036 LOOP1: .DW XT_L_FROM,XT_QDUP,XT_DOCONDBRANCH 0002a1 02a5 DEST(LOOP2) 0002a2 0225 .DW XT_THEN 0002a3 702f .dw XT_DOBRANCH 0002a4 029e DEST(LOOP1) 0002a5 7020 LOOP2: .DW XT_EXIT ; leave address stack .include "words/l-from.asm" .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_L_FROM: 0002a6 ff02 .dw $ff02 0002a7 3e6c .db "l>" 0002a8 0296 .dw VE_HEAD .set VE_HEAD = VE_L_FROM XT_L_FROM: 0002a9 7001 .dw DO_COLON PFA_L_FROM: .endif ;Z L> -- x L: x -- move from leave stack ; LP @ @ -2 LP +! ; 0002aa 02c8 .dw XT_LP 0002ab 7079 .dw XT_FETCH 0002ac 7079 .dw XT_FETCH 0002ad 703d .dw XT_DOLITERAL 0002ae fffe .dw -2 0002af 02c8 .dw XT_LP 0002b0 7265 .dw XT_PLUSSTORE 0002b1 7020 .dw XT_EXIT .include "words/to-l.asm" .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_TO_L: 0002b2 ff02 .dw $ff02 0002b3 6c3e .db ">l" 0002b4 02a6 .dw VE_HEAD .set VE_HEAD = VE_TO_L XT_TO_L: 0002b5 7001 .dw DO_COLON PFA_TO_L: .endif ;Z >L x -- L: -- x move to leave stack ; CELL LP +! LP @ ! ; (L stack grows up) 0002b6 7d8b .dw XT_TWO 0002b7 02c8 .dw XT_LP 0002b8 7265 .dw XT_PLUSSTORE 0002b9 02c8 .dw XT_LP 0002ba 7079 .dw XT_FETCH 0002bb 7081 .dw XT_STORE 0002bc 7020 .dw XT_EXIT .include "words/lp0.asm" ; Stack ; start address of leave stack VE_LP0: 0002bd ff03 .dw $ff03 0002be 706c 0002bf 0030 .db "lp0",0 0002c0 02b2 .dw VE_HEAD .set VE_HEAD = VE_LP0 XT_LP0: 0002c1 706f .dw PFA_DOVALUE1 PFA_LP0: 0002c2 0044 .dw CFG_LP0 0002c3 7bb4 .dw XT_EDEFERFETCH 0002c4 7bbe .dw XT_EDEFERSTORE .include "words/lp.asm" ; System Variable ; leave stack pointer VE_LP: 0002c5 ff02 .dw $ff02 0002c6 706c .db "lp" 0002c7 02bd .dw VE_HEAD .set VE_HEAD = VE_LP XT_LP: 0002c8 7048 .dw PFA_DOVARIABLE PFA_LP: 0002c9 0134 .dw ram_lp .dseg 000134 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: 0002ca ff06 .dw $ff06 0002cb 7263 0002cc 6165 0002cd 6574 .db "create" 0002ce 02c5 .dw VE_HEAD .set VE_HEAD = VE_CREATE XT_CREATE: 0002cf 7001 .dw DO_COLON PFA_CREATE: .endif 0002d0 019e .dw XT_DOCREATE 0002d1 02fe .dw XT_REVEAL 0002d2 01c1 .dw XT_COMPILE 0002d3 7052 .dw PFA_DOCONSTANT 0002d4 7020 .dw XT_EXIT .include "words/header.asm" ; Compiler ; creates the vocabulary header without XT and data field (PF) in the wordlist wid VE_HEADER: 0002d5 ff06 .dw $ff06 0002d6 6568 0002d7 6461 0002d8 7265 .db "header" 0002d9 02ca .dw VE_HEAD .set VE_HEAD = VE_HEADER XT_HEADER: 0002da 7001 .dw DO_COLON PFA_HEADER: 0002db 75ae .dw XT_DP ; the new Name Field 0002dc 70ff .dw XT_TO_R 0002dd 70ff .dw XT_TO_R ; ( R: NFA WID ) 0002de 70b1 .dw XT_DUP 0002df 7128 .dw XT_GREATERZERO 0002e0 7036 .dw XT_DOCONDBRANCH 0002e1 02ec .dw PFA_HEADER1 0002e2 70b1 .dw XT_DUP 0002e3 703d .dw XT_DOLITERAL 0002e4 ff00 .dw $ff00 ; all flags are off (e.g. immediate) 0002e5 721c .dw XT_OR 0002e6 777f .dw XT_DOSCOMMA ; make the link to the previous entry in this wordlist 0002e7 70f6 .dw XT_R_FROM 0002e8 735f .dw XT_FETCHE 0002e9 01cc .dw XT_COMMA 0002ea 70f6 .dw XT_R_FROM 0002eb 7020 .dw XT_EXIT PFA_HEADER1: ; -16: attempt to use zero length string as a name 0002ec 703d .dw XT_DOLITERAL 0002ed fff0 .dw -16 0002ee 7841 .dw XT_THROW .include "words/wlscope.asm" ; Compiler ; dynamically place a word in a wordlist. The word name may be changed. VE_WLSCOPE: 0002ef ff07 .dw $ff07 0002f0 6c77 0002f1 6373 0002f2 706f 0002f3 0065 .db "wlscope",0 0002f4 02d5 .dw VE_HEAD .set VE_HEAD = VE_WLSCOPE XT_WLSCOPE: 0002f5 7c13 .dw PFA_DODEFER1 PFA_WLSCOPE: 0002f6 0040 .dw CFG_WLSCOPE 0002f7 7bb4 .dw XT_EDEFERFETCH 0002f8 7bbe .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: 0002f9 ff06 .dw $ff06 0002fa 6572 0002fb 6576 0002fc 6c61 .db "reveal" 0002fd 02ef .dw VE_HEAD .set VE_HEAD = VE_REVEAL XT_REVEAL: 0002fe 7001 .dw DO_COLON PFA_REVEAL: .endif 0002ff 018f 000300 755e 000301 7079 .DW XT_NEWEST,XT_CELLPLUS,XT_FETCH ; only if wordlist is in use 000302 70b9 000303 7036 .DW XT_QDUP,XT_DOCONDBRANCH 000304 0309 DEST(REVEAL1) 000305 018f 000306 7079 000307 70c4 000308 733b .DW XT_NEWEST,XT_FETCH,XT_SWAP,XT_STOREE ; .DW XT_ZERO,XT_NEWEST,XT_CELLPLUS,XT_STORE ; clean wordlist entry REVEAL1: 000309 7020 .DW XT_EXIT .include "words/does.asm" ; Compiler ; organize the XT replacement to call other colon code VE_DOES: 00030a 0005 .dw $0005 00030b 6f64 00030c 7365 00030d 003e .db "does>",0 00030e 02f9 .dw VE_HEAD .set VE_HEAD = VE_DOES XT_DOES: 00030f 7001 .dw DO_COLON PFA_DOES: 000310 01c1 .dw XT_COMPILE 000311 0322 .dw XT_DODOES 000312 01c1 .dw XT_COMPILE ; create a code snippet to be used in an embedded XT 000313 940e .dw $940e ; the address of this compiled 000314 01c1 .dw XT_COMPILE ; code will replace the XT of the 000315 0317 .dw DO_DODOES ; word that CREATE created 000316 7020 .dw XT_EXIT ; DO_DODOES: ; ( -- PFA ) 000317 939a 000318 938a savetos 000319 01cb movw tosl, wl 00031a 9601 adiw tosl, 1 ; the following takes the address from a real uC-call .if (pclen==3) .endif 00031b 917f pop wh 00031c 916f pop wl 00031d 93bf push XH 00031e 93af push XL 00031f 01db movw XL, wl 000320 940c 7005 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: 000322 7001 .dw DO_COLON PFA_DODOES: 000323 70f6 .dw XT_R_FROM 000324 018f .dw XT_NEWEST 000325 755e .dw XT_CELLPLUS 000326 7079 .dw XT_FETCH 000327 735f .dw XT_FETCHE 000328 7c7e .dw XT_NFA2CFA 000329 7373 .dw XT_STOREI 00032a 7020 .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: 00032b ff01 .dw $ff01 00032c 003a .db ":",0 00032d 030a .dw VE_HEAD .set VE_HEAD = VE_COLON XT_COLON: 00032e 7001 .dw DO_COLON PFA_COLON: .endif 00032f 019e .dw XT_DOCREATE 000330 0339 .dw XT_COLONNONAME 000331 70d9 .dw XT_DROP 000332 7020 .dw XT_EXIT .include "words/colon-noname.asm" ; Compiler ; create an unnamed entry in the dictionary, XT is DO_COLON VE_COLONNONAME: 000333 ff07 .dw $ff07 000334 6e3a 000335 6e6f 000336 6d61 000337 0065 .db ":noname",0 000338 032b .dw VE_HEAD .set VE_HEAD = VE_COLONNONAME XT_COLONNONAME: 000339 7001 .dw DO_COLON PFA_COLONNONAME: 00033a 75ae .dw XT_DP 00033b 70b1 .dw XT_DUP 00033c 0196 .dw XT_LATEST 00033d 7081 .dw XT_STORE 00033e 01c1 .dw XT_COMPILE 00033f 7001 .dw DO_COLON 000340 034e .dw XT_RBRACKET 000341 7020 .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: 000342 0001 .dw $0001 000343 003b .db $3b,0 000344 0333 .dw VE_HEAD .set VE_HEAD = VE_SEMICOLON XT_SEMICOLON: 000345 7001 .dw DO_COLON PFA_SEMICOLON: .endif 000346 01c1 .dw XT_COMPILE 000347 7020 .dw XT_EXIT 000348 0356 .dw XT_LBRACKET 000349 02fe .dw XT_REVEAL 00034a 7020 .dw XT_EXIT .include "words/right-bracket.asm" ; Compiler ; enter compiler mode .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_RBRACKET: 00034b ff01 .dw $ff01 00034c 005d .db "]",0 00034d 0342 .dw VE_HEAD .set VE_HEAD = VE_RBRACKET XT_RBRACKET: 00034e 7001 .dw DO_COLON PFA_RBRACKET: .endif 00034f 7d86 .dw XT_ONE 000350 754b .dw XT_STATE 000351 7081 .dw XT_STORE 000352 7020 .dw XT_EXIT .include "words/left-bracket.asm" ; Compiler ; enter interpreter mode .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_LBRACKET: 000353 0001 .dw $0001 000354 005b .db "[",0 000355 034b .dw VE_HEAD .set VE_HEAD = VE_LBRACKET XT_LBRACKET: 000356 7001 .dw DO_COLON PFA_LBRACKET: .endif 000357 7154 .dw XT_ZERO 000358 754b .dw XT_STATE 000359 7081 .dw XT_STORE 00035a 7020 .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: 00035b ff08 .dw $ff08 00035c 6176 00035d 6972 00035e 6261 00035f 656c .db "variable" 000360 0353 .dw VE_HEAD .set VE_HEAD = VE_VARIABLE XT_VARIABLE: 000361 7001 .dw DO_COLON PFA_VARIABLE: .endif 000362 75bf .dw XT_HERE 000363 036d .dw XT_CONSTANT 000364 7d8b .dw XT_TWO 000365 75c8 .dw XT_ALLOT 000366 7020 .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: 000367 ff08 .dw $ff08 000368 6f63 000369 736e 00036a 6174 00036b 746e .db "constant" 00036c 035b .dw VE_HEAD .set VE_HEAD = VE_CONSTANT XT_CONSTANT: 00036d 7001 .dw DO_COLON PFA_CONSTANT: .endif 00036e 019e .dw XT_DOCREATE 00036f 02fe .dw XT_REVEAL 000370 01c1 .dw XT_COMPILE 000371 7048 .dw PFA_DOVARIABLE 000372 01cc .dw XT_COMMA 000373 7020 .dw XT_EXIT .include "words/user.asm" ; Compiler ; create a dictionary entry for a user variable at offset n VE_USER: 000374 ff04 .dw $ff04 000375 7375 000376 7265 .db "user" 000377 0367 .dw VE_HEAD .set VE_HEAD = VE_USER XT_USER: 000378 7001 .dw DO_COLON PFA_USER: 000379 019e .dw XT_DOCREATE 00037a 02fe .dw XT_REVEAL 00037b 01c1 .dw XT_COMPILE 00037c 7058 .dw PFA_DOUSER 00037d 01cc .dw XT_COMMA 00037e 7020 .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: 00037f 0007 .dw $0007 000380 6572 000381 7563 000382 7372 000383 0065 .db "recurse",0 000384 0374 .dw VE_HEAD .set VE_HEAD = VE_RECURSE XT_RECURSE: 000385 7001 .dw DO_COLON PFA_RECURSE: .endif 000386 0196 .dw XT_LATEST 000387 7079 .dw XT_FETCH 000388 01cc .dw XT_COMMA 000389 7020 .dw XT_EXIT .include "words/immediate.asm" ; Compiler ; set immediate flag for the most recent word definition VE_IMMEDIATE: 00038a ff09 .dw $ff09 00038b 6d69 00038c 656d 00038d 6964 00038e 7461 00038f 0065 .db "immediate",0 000390 037f .dw VE_HEAD .set VE_HEAD = VE_IMMEDIATE XT_IMMEDIATE: 000391 7001 .dw DO_COLON PFA_IMMEDIATE: 000392 0433 .dw XT_GET_CURRENT 000393 735f .dw XT_FETCHE 000394 70b1 .dw XT_DUP 000395 73cb .dw XT_FETCHI 000396 703d .dw XT_DOLITERAL 000397 7fff .dw $7fff 000398 7213 .dw XT_AND 000399 70c4 .dw XT_SWAP 00039a 7373 .dw XT_STOREI 00039b 7020 .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: 00039c 0006 .dw $0006 00039d 635b 00039e 6168 00039f 5d72 .db "[char]" 0003a0 038a .dw VE_HEAD .set VE_HEAD = VE_BRACKETCHAR XT_BRACKETCHAR: 0003a1 7001 .dw DO_COLON PFA_BRACKETCHAR: .endif 0003a2 01c1 .dw XT_COMPILE 0003a3 703d .dw XT_DOLITERAL 0003a4 78ea .dw XT_CHAR 0003a5 01cc .dw XT_COMMA 0003a6 7020 .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: 0003a7 0006 .dw $0006 0003a8 6261 0003a9 726f 0003aa 2274 .db "abort",'"' 0003ab 039c .dw VE_HEAD .set VE_HEAD = VE_ABORTQUOTE XT_ABORTQUOTE: 0003ac 7001 .dw DO_COLON PFA_ABORTQUOTE: .endif 0003ad 74c1 .dw XT_SQUOTE 0003ae 01c1 .dw XT_COMPILE 0003af 03be .dw XT_QABORT 0003b0 7020 .DW XT_EXIT .include "words/abort.asm" ; Exceptions ; send an exception -1 .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_ABORT: 0003b1 ff05 .dw $ff05 0003b2 6261 0003b3 726f 0003b4 0074 .db "abort",0 0003b5 03a7 .dw VE_HEAD .set VE_HEAD = VE_ABORT XT_ABORT: 0003b6 7001 .dw DO_COLON PFA_ABORT: .endif 0003b7 714b .dw XT_TRUE 0003b8 7841 .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: 0003b9 ff06 .dw $ff06 0003ba 613f 0003bb 6f62 0003bc 7472 .db "?abort" 0003bd 03b1 .dw VE_HEAD .set VE_HEAD = VE_QABORT XT_QABORT: 0003be 7001 .dw DO_COLON PFA_QABORT: .endif 0003bf 70e1 0003c0 7036 .DW XT_ROT,XT_DOCONDBRANCH 0003c1 03c4 DEST(QABO1) 0003c2 77a0 0003c3 03b6 .DW XT_ITYPE,XT_ABORT 0003c4 756e 0003c5 7020 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: 0003c6 ff09 .dw $ff09 0003c7 6567 0003c8 2d74 0003c9 7473 0003ca 6361 0003cb 006b .db "get-stack",0 0003cc 03b9 .dw VE_HEAD .set VE_HEAD = VE_GET_STACK XT_GET_STACK: 0003cd 7001 .dw DO_COLON .endif 0003ce 70b1 .dw XT_DUP 0003cf 755e .dw XT_CELLPLUS 0003d0 70c4 .dw XT_SWAP 0003d1 735f .dw XT_FETCHE 0003d2 70b1 .dw XT_DUP 0003d3 70ff .dw XT_TO_R 0003d4 7154 .dw XT_ZERO 0003d5 70c4 .dw XT_SWAP ; go from bigger to smaller addresses 0003d6 028b .dw XT_QDOCHECK 0003d7 7036 .dw XT_DOCONDBRANCH 0003d8 03e4 DEST(PFA_N_FETCH_E2) 0003d9 729b .dw XT_DODO PFA_N_FETCH_E1: ; ( ee-addr ) 0003da 72ac .dw XT_I 0003db 7235 .dw XT_1MINUS 0003dc 7558 .dw XT_CELLS ; ( -- ee-addr i*2 ) 0003dd 70cf .dw XT_OVER ; ( -- ee-addr i*2 ee-addr ) 0003de 719d .dw XT_PLUS ; ( -- ee-addr ee-addr+i 0003df 735f .dw XT_FETCHE ;( -- ee-addr item_i ) 0003e0 70c4 .dw XT_SWAP ;( -- item_i ee-addr ) 0003e1 714b .dw XT_TRUE ; shortcut for -1 0003e2 72ba .dw XT_DOPLUSLOOP 0003e3 03da DEST(PFA_N_FETCH_E1) PFA_N_FETCH_E2: 0003e4 756e .dw XT_2DROP 0003e5 70f6 .dw XT_R_FROM 0003e6 7020 .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: 0003e7 ff09 .dw $ff09 0003e8 6573 0003e9 2d74 0003ea 7473 0003eb 6361 0003ec 006b .db "set-stack",0 0003ed 03c6 .dw VE_HEAD .set VE_HEAD = VE_SET_STACK XT_SET_STACK: 0003ee 7001 .dw DO_COLON PFA_SET_STACK: .endif 0003ef 70cf .dw XT_OVER 0003f0 7121 .dw XT_ZEROLESS 0003f1 7036 .dw XT_DOCONDBRANCH 0003f2 03f6 DEST(PFA_SET_STACK0) 0003f3 703d .dw XT_DOLITERAL 0003f4 fffc .dw -4 0003f5 7841 .dw XT_THROW PFA_SET_STACK0: 0003f6 7565 .dw XT_2DUP 0003f7 733b .dw XT_STOREE ; ( -- i_n .. i_0 n e-addr ) 0003f8 70c4 .dw XT_SWAP 0003f9 7154 .dw XT_ZERO 0003fa 028b .dw XT_QDOCHECK 0003fb 7036 .dw XT_DOCONDBRANCH 0003fc 0403 DEST(PFA_SET_STACK2) 0003fd 729b .dw XT_DODO PFA_SET_STACK1: 0003fe 755e .dw XT_CELLPLUS ; ( -- i_x e-addr ) 0003ff 7576 .dw XT_TUCK ; ( -- e-addr i_x e-addr 000400 733b .dw XT_STOREE 000401 72c9 .dw XT_DOLOOP 000402 03fe DEST(PFA_SET_STACK1) PFA_SET_STACK2: 000403 70d9 .dw XT_DROP 000404 7020 .dw XT_EXIT .include "words/map-stack.asm" ; Tools ; Iterate over a stack .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_MAPSTACK: 000405 ff09 .dw $ff09 000406 616d 000407 2d70 000408 7473 000409 6361 00040a 006b .db "map-stack",0 00040b 03e7 .dw VE_HEAD .set VE_HEAD = VE_MAPSTACK XT_MAPSTACK: 00040c 7001 .dw DO_COLON PFA_MAPSTACK: .endif 00040d 70b1 .dw XT_DUP 00040e 755e .dw XT_CELLPLUS 00040f 70c4 .dw XT_SWAP 000410 735f .dw XT_FETCHE 000411 7558 .dw XT_CELLS 000412 7d5e .dw XT_BOUNDS 000413 028b .dw XT_QDOCHECK 000414 7036 .dw XT_DOCONDBRANCH 000415 0428 DEST(PFA_MAPSTACK3) 000416 729b .dw XT_DODO PFA_MAPSTACK1: 000417 72ac .dw XT_I 000418 735f .dw XT_FETCHE ; -- i*x XT id 000419 70c4 .dw XT_SWAP 00041a 70ff .dw XT_TO_R 00041b 7108 .dw XT_R_FETCH 00041c 702a .dw XT_EXECUTE ; i*x id -- j*y true | i*x false 00041d 70b9 .dw XT_QDUP 00041e 7036 .dw XT_DOCONDBRANCH 00041f 0424 DEST(PFA_MAPSTACK2) 000420 70f6 .dw XT_R_FROM 000421 70d9 .dw XT_DROP 000422 72d4 .dw XT_UNLOOP 000423 7020 .dw XT_EXIT PFA_MAPSTACK2: 000424 70f6 .dw XT_R_FROM 000425 7d8b .dw XT_TWO 000426 72ba .dw XT_DOPLUSLOOP 000427 0417 DEST(PFA_MAPSTACK1) PFA_MAPSTACK3: 000428 70d9 .dw XT_DROP 000429 7154 .dw XT_ZERO 00042a 7020 .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: 00042b ff0b .dw $ff0b 00042c 6567 00042d 2d74 00042e 7563 00042f 7272 000430 6e65 000431 0074 .db "get-current",0 000432 0405 .dw VE_HEAD .set VE_HEAD = VE_GET_CURRENT XT_GET_CURRENT: 000433 7001 .dw DO_COLON PFA_GET_CURRENT: 000434 703d .dw XT_DOLITERAL 000435 004a .dw CFG_CURRENT 000436 735f .dw XT_FETCHE 000437 7020 .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: 000438 ff09 .dw $ff09 000439 6567 00043a 2d74 00043b 726f 00043c 6564 00043d 0072 .db "get-order",0 00043e 042b .dw VE_HEAD .set VE_HEAD = VE_GET_ORDER XT_GET_ORDER: 00043f 7001 .dw DO_COLON PFA_GET_ORDER: .endif 000440 703d .dw XT_DOLITERAL 000441 004e .dw CFG_ORDERLISTLEN 000442 03cd .dw XT_GET_STACK 000443 7020 .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: 000444 ff09 .dw $ff09 000445 6663 000446 2d67 000447 726f 000448 6564 000449 0072 .db "cfg-order",0 00044a 0438 .dw VE_HEAD .set VE_HEAD = VE_CFG_ORDER XT_CFG_ORDER: 00044b 7048 .dw PFA_DOVARIABLE PFA_CFG_ORDER: .endif 00044c 004e .dw CFG_ORDERLISTLEN .include "words/compare.asm" ; String ; compares two strings in RAM VE_COMPARE: 00044d ff07 .dw $ff07 00044e 6f63 00044f 706d 000450 7261 000451 0065 .db "compare",0 000452 0444 .dw VE_HEAD .set VE_HEAD = VE_COMPARE XT_COMPARE: 000453 0454 .dw PFA_COMPARE PFA_COMPARE: 000454 93bf push xh 000455 93af push xl 000456 018c movw temp0, tosl 000457 9189 000458 9199 loadtos 000459 01dc movw xl, tosl 00045a 9189 00045b 9199 loadtos 00045c 019c movw temp2, tosl 00045d 9189 00045e 9199 loadtos 00045f 01fc movw zl, tosl PFA_COMPARE_LOOP: 000460 90ed ld temp4, X+ 000461 90f1 ld temp5, Z+ 000462 14ef cp temp4, temp5 000463 f451 brne PFA_COMPARE_NOTEQUAL 000464 950a dec temp0 000465 f019 breq PFA_COMPARE_ENDREACHED2 000466 952a dec temp2 000467 f7c1 brne PFA_COMPARE_LOOP 000468 c001 rjmp PFA_COMPARE_ENDREACHED PFA_COMPARE_ENDREACHED2: 000469 952a dec temp2 PFA_COMPARE_ENDREACHED: 00046a 2b02 or temp0, temp2 00046b f411 brne PFA_COMPARE_CHECKLASTCHAR 00046c 2788 clr tosl 00046d c002 rjmp PFA_COMPARE_DONE PFA_COMPARE_CHECKLASTCHAR: PFA_COMPARE_NOTEQUAL: 00046e ef8f ser tosl 00046f c000 rjmp PFA_COMPARE_DONE PFA_COMPARE_DONE: 000470 2f98 mov tosh, tosl 000471 91af pop xl 000472 91bf pop xh 000473 940c 7005 jmp_ DO_NEXT .include "words/nfa2lfa.asm" ; System ; get the link field address from the name field address VE_NFA2LFA: 000475 ff07 .dw $ff07 000476 666e 000477 3e61 000478 666c 000479 0061 .db "nfa>lfa",0 00047a 044d .dw VE_HEAD .set VE_HEAD = VE_NFA2LFA XT_NFA2LFA: 00047b 7001 .dw DO_COLON PFA_NFA2LFA: 00047c 7c72 .dw XT_NAME2STRING 00047d 722f .dw XT_1PLUS 00047e 7204 .dw XT_2SLASH 00047f 719d .dw XT_PLUS 000480 7020 .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/dot-s.asm" ; Tools ; stack dump .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_DOTS: 000481 ff02 .dw $ff02 000482 732e .db ".s" 000483 0475 .dw VE_HEAD .set VE_HEAD = VE_DOTS XT_DOTS: 000484 7001 .dw DO_COLON PFA_DOTS: .endif 000485 7aa1 .dw XT_DEPTH 000486 7448 .dw XT_UDOT 000487 77e2 .dw XT_SPACE 000488 7aa1 .dw XT_DEPTH 000489 7154 .dw XT_ZERO 00048a 028b .dw XT_QDOCHECK 00048b 7036 .dw XT_DOCONDBRANCH 00048c 0493 DEST(PFA_DOTS2) 00048d 729b .dw XT_DODO PFA_DOTS1: 00048e 72ac .dw XT_I 00048f 74af .dw XT_PICK 000490 7448 .dw XT_UDOT 000491 72c9 .dw XT_DOLOOP 000492 048e DEST(PFA_DOTS1) PFA_DOTS2: 000493 7020 .dw XT_EXIT .include "words/spirw.asm" ; MCU ; SPI exchange of 1 byte VE_SPIRW: 000494 ff06 .dw $ff06 000495 2163 000496 7340 000497 6970 .db "c!@spi" 000498 0481 .dw VE_HEAD .set VE_HEAD = VE_SPIRW XT_SPIRW: 000499 049a .dw PFA_SPIRW PFA_SPIRW: 00049a d003 rcall do_spirw 00049b 2799 clr tosh 00049c 940c 7005 jmp_ DO_NEXT do_spirw: 00049e bd8e out_ SPDR, tosl do_spirw1: 00049f b50d in_ temp0, SPSR 0004a0 7f08 cbr temp0,7 0004a1 bd0d out_ SPSR, temp0 0004a2 b50d in_ temp0, SPSR 0004a3 ff07 sbrs temp0, 7 0004a4 cffa rjmp do_spirw1 ; wait until complete 0004a5 b58e in_ tosl, SPDR 0004a6 9508 ret .include "words/n-spi.asm" ; MCU ; read len bytes from SPI to addr VE_N_SPIR: 0004a7 ff05 .dw $ff05 0004a8 406e 0004a9 7073 0004aa 0069 .db "n@spi",0 0004ab 0494 .dw VE_HEAD .set VE_HEAD = VE_N_SPIR XT_N_SPIR: 0004ac 04ad .dw PFA_N_SPIR PFA_N_SPIR: 0004ad 018c movw temp0, tosl 0004ae 9189 0004af 9199 loadtos 0004b0 01fc movw zl, tosl 0004b1 01c8 movw tosl, temp0 PFA_N_SPIR_LOOP: 0004b2 bc2e out_ SPDR, zerol PFA_N_SPIR_LOOP1: 0004b3 b52d in_ temp2, SPSR 0004b4 ff27 sbrs temp2, SPIF 0004b5 cffd rjmp PFA_N_SPIR_LOOP1 0004b6 b52e in_ temp2, SPDR 0004b7 9321 st Z+, temp2 0004b8 9701 sbiw tosl, 1 0004b9 f7c1 brne PFA_N_SPIR_LOOP 0004ba 9189 0004bb 9199 loadtos 0004bc 940c 7005 jmp_ DO_NEXT ; ( addr len -- ) ; MCU ; write len bytes to SPI from addr VE_N_SPIW: 0004be ff05 .dw $ff05 0004bf 216e 0004c0 7073 0004c1 0069 .db "n!spi",0 0004c2 04a7 .dw VE_HEAD .set VE_HEAD = VE_N_SPIW XT_N_SPIW: 0004c3 04c4 .dw PFA_N_SPIW PFA_N_SPIW: 0004c4 018c movw temp0, tosl 0004c5 9189 0004c6 9199 loadtos 0004c7 01fc movw zl, tosl 0004c8 01c8 movw tosl, temp0 PFA_N_SPIW_LOOP: 0004c9 9121 ld temp2, Z+ 0004ca bd2e out_ SPDR, temp2 PFA_N_SPIW_LOOP1: 0004cb b52d in_ temp2, SPSR 0004cc ff27 sbrs temp2, SPIF 0004cd cffd rjmp PFA_N_SPIW_LOOP1 0004ce b52e in_ temp2, SPDR ; ignore the data 0004cf 9701 sbiw tosl, 1 0004d0 f7c1 brne PFA_N_SPIW_LOOP 0004d1 9189 0004d2 9199 loadtos 0004d3 940c 7005 jmp_ DO_NEXT .include "words/applturnkey.asm" ; R( -- ) ; application specific turnkey action VE_APPLTURNKEY: 0004d5 ff0b .dw $ff0b 0004d6 7061 0004d7 6c70 0004d8 7574 0004d9 6e72 0004da 656b 0004db 0079 .db "applturnkey",0 0004dc 04be .dw VE_HEAD .set VE_HEAD = VE_APPLTURNKEY XT_APPLTURNKEY: 0004dd 7001 .dw DO_COLON PFA_APPLTURNKEY: 0004de 00cb .dw XT_USART .if WANT_INTERRUPTS == 1 0004df 7479 .dw XT_INTON .endif 0004e0 7b64 .dw XT_DOT_VER 0004e1 77e2 .dw XT_SPACE 0004e2 7540 .dw XT_F_CPU 0004e3 703d .dw XT_DOLITERAL 0004e4 03e8 .dw 1000 0004e5 71c2 .dw XT_UMSLASHMOD 0004e6 70f0 .dw XT_NIP 0004e7 75dd .dw XT_DECIMAL 0004e8 7722 .dw XT_DOT 0004e9 776d .dw XT_DOSLITERAL 0004ea 0004 .dw 4 0004eb 486b 0004ec 207a .db "kHz " 0004ed 77a0 .dw XT_ITYPE 0004ee 7020 .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: 0004ef ff0b .dw $ff0b 0004f0 6573 0004f1 2d74 0004f2 7563 0004f3 7272 0004f4 6e65 0004f5 0074 .db "set-current",0 0004f6 04d5 .dw VE_HEAD .set VE_HEAD = VE_SET_CURRENT XT_SET_CURRENT: 0004f7 7001 .dw DO_COLON PFA_SET_CURRENT: 0004f8 703d .dw XT_DOLITERAL 0004f9 004a .dw CFG_CURRENT 0004fa 733b .dw XT_STOREE 0004fb 7020 .dw XT_EXIT .include "words/wordlist.asm" ; Search Order ; create a new, empty wordlist VE_WORDLIST: 0004fc ff08 .dw $ff08 0004fd 6f77 0004fe 6472 0004ff 696c 000500 7473 .db "wordlist" 000501 04ef .dw VE_HEAD .set VE_HEAD = VE_WORDLIST XT_WORDLIST: 000502 7001 .dw DO_COLON PFA_WORDLIST: 000503 75b7 .dw XT_EHERE 000504 7154 .dw XT_ZERO 000505 70cf .dw XT_OVER 000506 733b .dw XT_STOREE 000507 70b1 .dw XT_DUP 000508 755e .dw XT_CELLPLUS 000509 7b99 .dw XT_DOTO 00050a 75b8 .dw PFA_EHERE 00050b 7020 .dw XT_EXIT .include "words/forth-wordlist.asm" ; Search Order ; get the system default word list VE_FORTHWORDLIST: 00050c ff0e .dw $ff0e 00050d 6f66 00050e 7472 00050f 2d68 000510 6f77 000511 6472 000512 696c 000513 7473 .db "forth-wordlist" 000514 04fc .dw VE_HEAD .set VE_HEAD = VE_FORTHWORDLIST XT_FORTHWORDLIST: 000515 7048 .dw PFA_DOVARIABLE PFA_FORTHWORDLIST: 000516 004c .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: 000517 ff09 .dw $ff09 000518 6573 000519 2d74 00051a 726f 00051b 6564 00051c 0072 .db "set-order",0 00051d 050c .dw VE_HEAD .set VE_HEAD = VE_SET_ORDER XT_SET_ORDER: 00051e 7001 .dw DO_COLON PFA_SET_ORDER: .endif 00051f 703d .dw XT_DOLITERAL 000520 004e .dw CFG_ORDERLISTLEN 000521 03ee .dw XT_SET_STACK 000522 7020 .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: 000523 ff0f .dw $ff0f 000524 6573 000525 2d74 000526 6572 000527 6f63 000528 6e67 000529 7a69 00052a 7265 00052b 0073 .db "set-recognizers",0 00052c 0517 .dw VE_HEAD .set VE_HEAD = VE_SET_RECOGNIZERS XT_SET_RECOGNIZERS: 00052d 7001 .dw DO_COLON PFA_SET_RECOGNIZERS: .endif 00052e 703d .dw XT_DOLITERAL 00052f 0060 .dw CFG_RECOGNIZERLISTLEN 000530 03ee .dw XT_SET_STACK 000531 7020 .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: 000532 ff0f .dw $ff0f 000533 6567 000534 2d74 000535 6572 000536 6f63 000537 6e67 000538 7a69 000539 7265 00053a 0073 .db "get-recognizers",0 00053b 0523 .dw VE_HEAD .set VE_HEAD = VE_GET_RECOGNIZERS XT_GET_RECOGNIZERS: 00053c 7001 .dw DO_COLON PFA_GET_RECOGNIZERS: .endif 00053d 703d .dw XT_DOLITERAL 00053e 0060 .dw CFG_RECOGNIZERLISTLEN 00053f 03cd .dw XT_GET_STACK 000540 7020 .dw XT_EXIT .include "words/code.asm" ; Compiler ; create named entry in the dictionary, XT is the data field VE_CODE: 000541 ff04 .dw $ff04 000542 6f63 000543 6564 .db "code" 000544 0532 .dw VE_HEAD .set VE_HEAD = VE_CODE XT_CODE: 000545 7001 .dw DO_COLON PFA_CODE: 000546 019e .dw XT_DOCREATE 000547 02fe .dw XT_REVEAL 000548 75ae .dw XT_DP 000549 7bab .dw XT_ICELLPLUS 00054a 01cc .dw XT_COMMA 00054b 7020 .dw XT_EXIT .include "words/end-code.asm" ; Compiler ; finish a code definition VE_ENDCODE: 00054c ff08 .dw $ff08 00054d 6e65 00054e 2d64 00054f 6f63 000550 6564 .db "end-code" 000551 0541 .dw VE_HEAD .set VE_HEAD = VE_ENDCODE XT_ENDCODE: 000552 7001 .dw DO_COLON PFA_ENDCODE: 000553 01c1 .dw XT_COMPILE 000554 940c .dw $940c 000555 01c1 .dw XT_COMPILE 000556 7005 .dw DO_NEXT 000557 7020 .dw XT_EXIT .include "words/marker.asm" ; System Value ; The eeprom address until which MARKER saves and restores the eeprom data. VE_MARKER: 000558 ff08 .dw $ff08 000559 6d28 00055a 7261 00055b 656b 00055c 2972 .db "(marker)" 00055d 054c .dw VE_HEAD .set VE_HEAD = VE_MARKER XT_MARKER: 00055e 706f .dw PFA_DOVALUE1 PFA_MARKER: 00055f 006c .dw EE_MARKER 000560 7bb4 .dw XT_EDEFERFETCH 000561 7bbe .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: 000562 0008 .dw $0008 000563 6f70 000564 7473 000565 6f70 000566 656e .db "postpone" 000567 0558 .dw VE_HEAD .set VE_HEAD = VE_POSTPONE XT_POSTPONE: 000568 7001 .dw DO_COLON PFA_POSTPONE: .endif 000569 79b4 .dw XT_PARSENAME 00056a 7acc .dw XT_FORTHRECOGNIZER 00056b 7ad7 .dw XT_RECOGNIZE 00056c 70b1 .dw XT_DUP 00056d 70ff .dw XT_TO_R 00056e 7bab .dw XT_ICELLPLUS 00056f 7bab .dw XT_ICELLPLUS 000570 73cb .dw XT_FETCHI 000571 702a .dw XT_EXECUTE 000572 70f6 .dw XT_R_FROM 000573 7bab .dw XT_ICELLPLUS 000574 73cb .dw XT_FETCHI 000575 01cc .dw XT_COMMA 000576 7020 .dw XT_EXIT .endif .include "words/2r_fetch.asm" ; Stack ; fetch content of TOR VE_2R_FETCH: 000577 ff03 .dw $ff03 000578 7232 000579 0040 .db "2r@",0 00057a 0562 .dw VE_HEAD .set VE_HEAD = VE_2R_FETCH XT_2R_FETCH: 00057b 057c .dw PFA_2R_FETCH PFA_2R_FETCH: 00057c 939a 00057d 938a savetos 00057e 91ef pop zl 00057f 91ff pop zh 000580 918f pop tosl 000581 919f pop tosh 000582 939f push tosh 000583 938f push tosl 000584 93ff push zh 000585 93ef push zl 000586 939a 000587 938a savetos 000588 01cf movw tosl, zl 000589 940c 7005 jmp_ DO_NEXT .set DPSTART = pc .if(pc>AMFORTH_RO_SEG) .endif .org AMFORTH_RO_SEG .include "amforth-interpreter.asm" DO_COLON: 007001 93bf push XH 007002 93af push XL ; PUSH IP 007003 01db movw XL, wl 007004 9611 adiw xl, 1 DO_NEXT: .if WANT_INTERRUPTS == 1 007005 14b2 cp isrflag, zerol 007006 f469 brne DO_INTERRUPT .endif 007007 01fd movw zl, XL ; READ IP 007008 0fee 007009 1fff 00700a 9165 00700b 9175 readflashcell wl, wh 00700c 9611 adiw XL, 1 ; INC IP DO_EXECUTE: 00700d 01fb movw zl, wl 00700e 0fee 00700f 1fff 007010 9105 007011 9115 readflashcell temp0,temp1 007012 01f8 movw zl, temp0 007013 9409 ijmp .if WANT_INTERRUPTS == 1 DO_INTERRUPT: ; here we deal with interrupts the forth way 007014 939a 007015 938a savetos 007016 2d8b mov tosl, isrflag 007017 2799 clr tosh 007018 24bb clr isrflag 007019 ea62 ldi wl, LOW(XT_ISREXEC) 00701a e774 ldi wh, HIGH(XT_ISREXEC) 00701b cff1 rjmp DO_EXECUTE .include "dict/nrww.inc" ; section together with the forth inner interpreter .include "words/exit.asm" ; Compiler ; end of current colon word VE_EXIT: 00701c ff04 .dw $ff04 00701d 7865 00701e 7469 .db "exit" 00701f 0577 .dw VE_HEAD .set VE_HEAD = VE_EXIT XT_EXIT: 007020 7021 .dw PFA_EXIT PFA_EXIT: 007021 91af pop XL 007022 91bf pop XH 007023 cfe1 jmp_ DO_NEXT .include "words/execute.asm" ; System ; execute XT VE_EXECUTE: 007024 ff07 .dw $ff07 007025 7865 007026 6365 007027 7475 007028 0065 .db "execute",0 007029 701c .dw VE_HEAD .set VE_HEAD = VE_EXECUTE XT_EXECUTE: 00702a 702b .dw PFA_EXECUTE PFA_EXECUTE: 00702b 01bc movw wl, tosl 00702c 9189 00702d 9199 loadtos 00702e cfde jmp_ DO_EXECUTE .include "words/dobranch.asm" ; System ; runtime of branch ;VE_DOBRANCH: ; .dw $ff08 ; .db "(branch)" ; .dw VE_HEAD ; .set VE_HEAD = VE_DOBRANCH XT_DOBRANCH: 00702f 7030 .dw PFA_DOBRANCH PFA_DOBRANCH: 007030 01fd movw zl, XL 007031 0fee 007032 1fff 007033 91a5 007034 91b5 readflashcell XL,XH 007035 cfcf jmp_ DO_NEXT .include "words/docondbranch.asm" ; System ; runtime of ?branch ;VE_DOCONDBRANCH: ; .dw $ff09 ; .db "(?branch)" ; .dw VE_HEAD ; .set VE_HEAD = VE_DOCONDBRANCH XT_DOCONDBRANCH: 007036 7037 .dw PFA_DOCONDBRANCH PFA_DOCONDBRANCH: 007037 2b98 or tosh, tosl 007038 9189 007039 9199 loadtos 00703a f3a9 brbs 1, PFA_DOBRANCH ; 1 is z flag; if tos is zero (false), do the branch 00703b 9611 adiw XL, 1 00703c cfc8 jmp_ DO_NEXT ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; .include "words/doliteral.asm" ; System ; runtime of literal ;VE_DOLITERAL: ; .dw $ff09 ; .db "(literal)" ; .dw VE_HEAD ; .set VE_HEAD = VE_DOLITERAL XT_DOLITERAL: 00703d 703e .dw PFA_DOLITERAL PFA_DOLITERAL: 00703e 939a 00703f 938a savetos 007040 01fd movw zl, xl 007041 0fee 007042 1fff 007043 9185 007044 9195 readflashcell tosl,tosh 007045 9611 adiw xl, 1 007046 cfbe jmp_ DO_NEXT .include "words/dovariable.asm" ; System ; puts content of parameter field (1 cell) to TOS ;VE_DOVARIABLE: ; .dw $ff0a ; .db "(variable)" ; .dw VE_HEAD ; .set VE_HEAD = VE_DOVARIABLE XT_DOVARIABLE: 007047 7048 .dw PFA_DOVARIABLE PFA_DOVARIABLE: 007048 939a 007049 938a savetos 00704a 01fb movw zl, wl 00704b 9631 adiw zl,1 00704c 0fee 00704d 1fff 00704e 9185 00704f 9195 readflashcell tosl,tosh 007050 cfb4 jmp_ DO_NEXT .include "words/doconstant.asm" ; System ; place data field address on TOS ;VE_DOCONSTANT: ; .dw $ff0a ; .db "(constant)" ; .dw VE_HEAD ; .set VE_HEAD = VE_DOCONSTANT XT_DOCONSTANT: 007051 7052 .dw PFA_DOCONSTANT PFA_DOCONSTANT: 007052 939a 007053 938a savetos 007054 01cb movw tosl, wl 007055 9601 adiw tosl, 1 007056 cfae jmp_ DO_NEXT .include "words/douser.asm" ; System ; runtime part of user ;VE_DOUSER: ; .dw $ff06 ; .db "(user)" ; .dw VE_HEAD ; .set VE_HEAD = VE_DOUSER XT_DOUSER: 007057 7058 .dw PFA_DOUSER PFA_DOUSER: 007058 939a 007059 938a savetos 00705a 01fb movw zl, wl 00705b 9631 adiw zl, 1 00705c 0fee 00705d 1fff 00705e 9185 00705f 9195 readflashcell tosl,tosh 007060 0d84 add tosl, upl 007061 1d95 adc tosh, uph 007062 cfa2 jmp_ DO_NEXT .include "words/do-value.asm" ; System ; runtime of value VE_DOVALUE: 007063 ff07 .dw $ff07 007064 7628 007065 6c61 007066 6575 007067 0029 .db "(value)", 0 007068 7024 .dw VE_HEAD .set VE_HEAD = VE_DOVALUE XT_DOVALUE: 007069 7001 .dw DO_COLON PFA_DOVALUE: 00706a 019e .dw XT_DOCREATE 00706b 02fe .dw XT_REVEAL 00706c 01c1 .dw XT_COMPILE 00706d 706f .dw PFA_DOVALUE1 00706e 7020 .dw XT_EXIT PFA_DOVALUE1: 00706f 940e 0317 call_ DO_DODOES 007071 70b1 .dw XT_DUP 007072 7bab .dw XT_ICELLPLUS 007073 73cb .dw XT_FETCHI 007074 702a .dw XT_EXECUTE 007075 7020 .dw XT_EXIT ; : (value) dup icell+ @i execute ; .include "words/fetch.asm" ; Memory ; read 1 cell from RAM address VE_FETCH: 007076 ff01 .dw $ff01 007077 0040 .db "@",0 007078 7063 .dw VE_HEAD .set VE_HEAD = VE_FETCH XT_FETCH: 007079 707a .dw PFA_FETCH PFA_FETCH: .if WANT_UNIFIED == 1 .endif PFA_FETCHRAM: 00707a 01fc movw zl, tosl ; low byte is read before the high byte 00707b 9181 ld tosl, z+ 00707c 9191 ld tosh, z+ 00707d cf87 jmp_ DO_NEXT .if WANT_UNIFIED == 1 .endif .include "words/store.asm" ; Memory ; write n to RAM memory at addr, low byte first VE_STORE: 00707e ff01 .dw $ff01 00707f 0021 .db "!",0 007080 7076 .dw VE_HEAD .set VE_HEAD = VE_STORE XT_STORE: 007081 7082 .dw PFA_STORE PFA_STORE: .if WANT_UNIFIED == 1 .endif PFA_STORERAM: 007082 01fc movw zl, tosl 007083 9189 007084 9199 loadtos ; the high byte is written before the low byte 007085 8391 std Z+1, tosh 007086 8380 std Z+0, tosl 007087 9189 007088 9199 loadtos 007089 cf7b jmp_ DO_NEXT .if WANT_UNIFIED == 1 .endif .include "words/cstore.asm" ; Memory ; store a single byte to RAM address VE_CSTORE: 00708a ff02 .dw $ff02 00708b 2163 .db "c!" 00708c 707e .dw VE_HEAD .set VE_HEAD = VE_CSTORE XT_CSTORE: 00708d 708e .dw PFA_CSTORE PFA_CSTORE: 00708e 01fc movw zl, tosl 00708f 9189 007090 9199 loadtos 007091 8380 st Z, tosl 007092 9189 007093 9199 loadtos 007094 cf70 jmp_ DO_NEXT .include "words/cfetch.asm" ; Memory ; fetch a single byte from memory mapped locations VE_CFETCH: 007095 ff02 .dw $ff02 007096 4063 .db "c@" 007097 708a .dw VE_HEAD .set VE_HEAD = VE_CFETCH XT_CFETCH: 007098 7099 .dw PFA_CFETCH PFA_CFETCH: 007099 01fc movw zl, tosl 00709a 2799 clr tosh 00709b 8180 ld tosl, Z 00709c cf68 jmp_ DO_NEXT .include "words/fetch-u.asm" ; Memory ; read 1 cell from USER area VE_FETCHU: 00709d ff02 .dw $ff02 00709e 7540 .db "@u" 00709f 7095 .dw VE_HEAD .set VE_HEAD = VE_FETCHU XT_FETCHU: 0070a0 7001 .dw DO_COLON PFA_FETCHU: 0070a1 7302 .dw XT_UP_FETCH 0070a2 719d .dw XT_PLUS 0070a3 7079 .dw XT_FETCH 0070a4 7020 .dw XT_EXIT .include "words/store-u.asm" ; Memory ; write n to USER area at offset VE_STOREU: 0070a5 ff02 .dw $ff02 0070a6 7521 .db "!u" 0070a7 709d .dw VE_HEAD .set VE_HEAD = VE_STOREU XT_STOREU: 0070a8 7001 .dw DO_COLON PFA_STOREU: 0070a9 7302 .dw XT_UP_FETCH 0070aa 719d .dw XT_PLUS 0070ab 7081 .dw XT_STORE 0070ac 7020 .dw XT_EXIT ;;;;;;;;;;;;;;;;;;;;;;;;; .include "words/dup.asm" ; Stack ; duplicate TOS VE_DUP: 0070ad ff03 .dw $ff03 0070ae 7564 0070af 0070 .db "dup",0 0070b0 70a5 .dw VE_HEAD .set VE_HEAD = VE_DUP XT_DUP: 0070b1 70b2 .dw PFA_DUP PFA_DUP: 0070b2 939a 0070b3 938a savetos 0070b4 cf50 jmp_ DO_NEXT .include "words/qdup.asm" ; Stack ; duplicate TOS if non-zero VE_QDUP: 0070b5 ff04 .dw $ff04 0070b6 643f 0070b7 7075 .db "?dup" 0070b8 70ad .dw VE_HEAD .set VE_HEAD = VE_QDUP XT_QDUP: 0070b9 70ba .dw PFA_QDUP PFA_QDUP: 0070ba 2f08 mov temp0, tosl 0070bb 2b09 or temp0, tosh 0070bc f011 breq PFA_QDUP1 0070bd 939a 0070be 938a savetos PFA_QDUP1: 0070bf cf45 jmp_ DO_NEXT .include "words/swap.asm" ; Stack ; swaps the two top level stack cells VE_SWAP: 0070c0 ff04 .dw $ff04 0070c1 7773 0070c2 7061 .db "swap" 0070c3 70b5 .dw VE_HEAD .set VE_HEAD = VE_SWAP XT_SWAP: 0070c4 70c5 .dw PFA_SWAP PFA_SWAP: 0070c5 018c movw temp0, tosl 0070c6 9189 0070c7 9199 loadtos 0070c8 931a st -Y, temp1 0070c9 930a st -Y, temp0 0070ca cf3a jmp_ DO_NEXT .include "words/over.asm" ; Stack ; Place a copy of x1 on top of the stack VE_OVER: 0070cb ff04 .dw $ff04 0070cc 766f 0070cd 7265 .db "over" 0070ce 70c0 .dw VE_HEAD .set VE_HEAD = VE_OVER XT_OVER: 0070cf 70d0 .dw PFA_OVER PFA_OVER: 0070d0 939a 0070d1 938a savetos 0070d2 818a ldd tosl, Y+2 0070d3 819b ldd tosh, Y+3 0070d4 cf30 jmp_ DO_NEXT .include "words/drop.asm" ; Stack ; drop TOS VE_DROP: 0070d5 ff04 .dw $ff04 0070d6 7264 0070d7 706f .db "drop" 0070d8 70cb .dw VE_HEAD .set VE_HEAD = VE_DROP XT_DROP: 0070d9 70da .dw PFA_DROP PFA_DROP: 0070da 9189 0070db 9199 loadtos 0070dc cf28 jmp_ DO_NEXT .include "words/rot.asm" ; Stack ; rotate the three top level cells VE_ROT: 0070dd ff03 .dw $ff03 0070de 6f72 0070df 0074 .db "rot",0 0070e0 70d5 .dw VE_HEAD .set VE_HEAD = VE_ROT XT_ROT: 0070e1 70e2 .dw PFA_ROT PFA_ROT: 0070e2 018c movw temp0, tosl 0070e3 9129 ld temp2, Y+ 0070e4 9139 ld temp3, Y+ 0070e5 9189 0070e6 9199 loadtos 0070e7 933a st -Y, temp3 0070e8 932a st -Y, temp2 0070e9 931a st -Y, temp1 0070ea 930a st -Y, temp0 0070eb cf19 jmp_ DO_NEXT .include "words/nip.asm" ; Stack ; Remove Second of Stack VE_NIP: 0070ec ff03 .dw $ff03 0070ed 696e 0070ee 0070 .db "nip",0 0070ef 70dd .dw VE_HEAD .set VE_HEAD = VE_NIP XT_NIP: 0070f0 70f1 .dw PFA_NIP PFA_NIP: 0070f1 9622 adiw yl, 2 0070f2 cf12 jmp_ DO_NEXT ;;;;;;;;;;;;;;;;;;;;;;;;; .include "words/r_from.asm" ; Stack ; move TOR to TOS VE_R_FROM: 0070f3 ff02 .dw $ff02 0070f4 3e72 .db "r>" 0070f5 70ec .dw VE_HEAD .set VE_HEAD = VE_R_FROM XT_R_FROM: 0070f6 70f7 .dw PFA_R_FROM PFA_R_FROM: 0070f7 939a 0070f8 938a savetos 0070f9 918f pop tosl 0070fa 919f pop tosh 0070fb cf09 jmp_ DO_NEXT .include "words/to_r.asm" ; Stack ; move TOS to TOR VE_TO_R: 0070fc ff02 .dw $ff02 0070fd 723e .db ">r" 0070fe 70f3 .dw VE_HEAD .set VE_HEAD = VE_TO_R XT_TO_R: 0070ff 7100 .dw PFA_TO_R PFA_TO_R: 007100 939f push tosh 007101 938f push tosl 007102 9189 007103 9199 loadtos 007104 cf00 jmp_ DO_NEXT .include "words/r_fetch.asm" ; Stack ; fetch content of TOR VE_R_FETCH: 007105 ff02 .dw $ff02 007106 4072 .db "r@" 007107 70fc .dw VE_HEAD .set VE_HEAD = VE_R_FETCH XT_R_FETCH: 007108 7109 .dw PFA_R_FETCH PFA_R_FETCH: 007109 939a 00710a 938a savetos 00710b 918f pop tosl 00710c 919f pop tosh 00710d 939f push tosh 00710e 938f push tosl 00710f cef5 jmp_ DO_NEXT .include "words/not-equal.asm" ; Compare ; true if n1 is not equal to n2 .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_NOTEQUAL: 007110 ff02 .dw $ff02 007111 3e3c .db "<>" 007112 7105 .dw VE_HEAD .set VE_HEAD = VE_NOTEQUAL XT_NOTEQUAL: 007113 7001 .dw DO_COLON PFA_NOTEQUAL: .endif 007114 7d7f 007115 711a 007116 7020 .DW XT_EQUAL,XT_ZEROEQUAL,XT_EXIT .include "words/equalzero.asm" ; Compare ; compare with 0 (zero) VE_ZEROEQUAL: 007117 ff02 .dw $ff02 007118 3d30 .db "0=" 007119 7110 .dw VE_HEAD .set VE_HEAD = VE_ZEROEQUAL XT_ZEROEQUAL: 00711a 711b .dw PFA_ZEROEQUAL PFA_ZEROEQUAL: 00711b 2b98 or tosh, tosl 00711c f5d1 brne PFA_ZERO1 00711d c030 rjmp PFA_TRUE1 .include "words/lesszero.asm" ; Compare ; compare with zero VE_ZEROLESS: 00711e ff02 .dw $ff02 00711f 3c30 .db "0<" 007120 7117 .dw VE_HEAD .set VE_HEAD = VE_ZEROLESS XT_ZEROLESS: 007121 7122 .dw PFA_ZEROLESS PFA_ZEROLESS: 007122 fd97 sbrc tosh,7 007123 c02a rjmp PFA_TRUE1 007124 c032 rjmp PFA_ZERO1 .include "words/greaterzero.asm" ; Compare ; true if n1 is greater than 0 VE_GREATERZERO: 007125 ff02 .dw $ff02 007126 3e30 .db "0>" 007127 711e .dw VE_HEAD .set VE_HEAD = VE_GREATERZERO XT_GREATERZERO: 007128 7129 .dw PFA_GREATERZERO PFA_GREATERZERO: 007129 1582 cp tosl, zerol 00712a 0593 cpc tosh, zeroh 00712b f15c brlt PFA_ZERO1 00712c f151 brbs 1, PFA_ZERO1 00712d c020 rjmp PFA_TRUE1 .include "words/d-greaterzero.asm" ; Compare ; compares if a double double cell number is greater 0 VE_DGREATERZERO: 00712e ff03 .dw $ff03 00712f 3064 007130 003e .db "d0>",0 007131 7125 .dw VE_HEAD .set VE_HEAD = VE_DGREATERZERO XT_DGREATERZERO: 007132 7133 .dw PFA_DGREATERZERO PFA_DGREATERZERO: 007133 1582 cp tosl, zerol 007134 0593 cpc tosh, zeroh 007135 9189 007136 9199 loadtos 007137 0582 cpc tosl, zerol 007138 0593 cpc tosh, zeroh 007139 f0ec brlt PFA_ZERO1 00713a f0e1 brbs 1, PFA_ZERO1 00713b c012 rjmp PFA_TRUE1 .include "words/d-lesszero.asm" ; Compare ; compares if a double double cell number is less than 0 VE_DXT_ZEROLESS: 00713c ff03 .dw $ff03 00713d 3064 00713e 003c .db "d0<",0 00713f 712e .dw VE_HEAD .set VE_HEAD = VE_DXT_ZEROLESS XT_DXT_ZEROLESS: 007140 7141 .dw PFA_DXT_ZEROLESS PFA_DXT_ZEROLESS: 007141 9622 adiw Y,2 007142 fd97 sbrc tosh,7 007143 940c 714e jmp PFA_TRUE1 007145 940c 7157 jmp PFA_ZERO1 .include "words/true.asm" ; Arithmetics ; leaves the value -1 (true) on TOS VE_TRUE: 007147 ff04 .dw $ff04 007148 7274 007149 6575 .db "true" 00714a 713c .dw VE_HEAD .set VE_HEAD = VE_TRUE XT_TRUE: 00714b 714c .dw PFA_TRUE PFA_TRUE: 00714c 939a 00714d 938a savetos PFA_TRUE1: 00714e ef8f ser tosl 00714f ef9f ser tosh 007150 ceb4 jmp_ DO_NEXT .include "words/zero.asm" ; Arithmetics ; place a value 0 on TOS VE_ZERO: 007151 ff01 .dw $ff01 007152 0030 .db "0",0 007153 7147 .dw VE_HEAD .set VE_HEAD = VE_ZERO XT_ZERO: 007154 7155 .dw PFA_ZERO PFA_ZERO: 007155 939a 007156 938a savetos PFA_ZERO1: 007157 01c1 movw tosl, zerol 007158 ceac jmp_ DO_NEXT .include "words/uless.asm" ; Compare ; true if u1 < u2 (unsigned) VE_ULESS: 007159 ff02 .dw $ff02 00715a 3c75 .db "u<" 00715b 7151 .dw VE_HEAD .set VE_HEAD = VE_ULESS XT_ULESS: 00715c 715d .dw PFA_ULESS PFA_ULESS: 00715d 9129 ld temp2, Y+ 00715e 9139 ld temp3, Y+ 00715f 1782 cp tosl, temp2 007160 0793 cpc tosh, temp3 007161 f3a8 brlo PFA_ZERO1 007162 f3a1 brbs 1, PFA_ZERO1 007163 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: 007164 ff02 .dw $ff02 007165 3e75 .db "u>" 007166 7159 .dw VE_HEAD .set VE_HEAD = VE_UGREATER XT_UGREATER: 007167 7001 .dw DO_COLON PFA_UGREATER: .endif 007168 70c4 .DW XT_SWAP 007169 715c .dw XT_ULESS 00716a 7020 .dw XT_EXIT .include "words/less.asm" ; Compare ; true if n1 is less than n2 VE_LESS: 00716b ff01 .dw $ff01 00716c 003c .db "<",0 00716d 7164 .dw VE_HEAD .set VE_HEAD = VE_LESS XT_LESS: 00716e 716f .dw PFA_LESS PFA_LESS: 00716f 9129 ld temp2, Y+ 007170 9139 ld temp3, Y+ 007171 1728 cp temp2, tosl 007172 0739 cpc temp3, tosh PFA_LESSDONE: 007173 f71c brge PFA_ZERO1 007174 cfd9 rjmp PFA_TRUE1 .include "words/greater.asm" ; Compare ; flag is true if n1 is greater than n2 VE_GREATER: 007175 ff01 .dw $ff01 007176 003e .db ">",0 007177 716b .dw VE_HEAD .set VE_HEAD = VE_GREATER XT_GREATER: 007178 7179 .dw PFA_GREATER PFA_GREATER: 007179 9129 ld temp2, Y+ 00717a 9139 ld temp3, Y+ 00717b 1728 cp temp2, tosl 00717c 0739 cpc temp3, tosh PFA_GREATERDONE: 00717d f2cc brlt PFA_ZERO1 00717e f2c1 brbs 1, PFA_ZERO1 00717f cfce rjmp PFA_TRUE1 .include "words/log2.asm" ; Arithmetics ; logarithm to base 2 or highest set bitnumber VE_LOG2: 007180 ff04 .dw $ff04 007181 6f6c 007182 3267 .db "log2" 007183 7175 .dw VE_HEAD .set VE_HEAD = VE_LOG2 XT_LOG2: 007184 7185 .dw PFA_LOG2 PFA_LOG2: 007185 01fc movw zl, tosl 007186 2799 clr tosh 007187 e180 ldi tosl, 16 PFA_LOG2_1: 007188 958a dec tosl 007189 f022 brmi PFA_LOG2_2 ; wrong data 00718a 0fee lsl zl 00718b 1fff rol zh 00718c f7d8 brcc PFA_LOG2_1 00718d ce77 jmp_ DO_NEXT PFA_LOG2_2: 00718e 959a dec tosh 00718f ce75 jmp_ DO_NEXT .include "words/minus.asm" ; Arithmetics ; subtract n2 from n1 VE_MINUS: 007190 ff01 .dw $ff01 007191 002d .db "-",0 007192 7180 .dw VE_HEAD .set VE_HEAD = VE_MINUS XT_MINUS: 007193 7194 .dw PFA_MINUS PFA_MINUS: 007194 9109 ld temp0, Y+ 007195 9119 ld temp1, Y+ 007196 1b08 sub temp0, tosl 007197 0b19 sbc temp1, tosh 007198 01c8 movw tosl, temp0 007199 ce6b jmp_ DO_NEXT .include "words/plus.asm" ; Arithmetics ; add n1 and n2 VE_PLUS: 00719a ff01 .dw $ff01 00719b 002b .db "+",0 00719c 7190 .dw VE_HEAD .set VE_HEAD = VE_PLUS XT_PLUS: 00719d 719e .dw PFA_PLUS PFA_PLUS: 00719e 9109 ld temp0, Y+ 00719f 9119 ld temp1, Y+ 0071a0 0f80 add tosl, temp0 0071a1 1f91 adc tosh, temp1 0071a2 ce62 jmp_ DO_NEXT .include "words/mstar.asm" ; Arithmetics ; multiply 2 cells to a double cell VE_MSTAR: 0071a3 ff02 .dw $ff02 0071a4 2a6d .db "m*" 0071a5 719a .dw VE_HEAD .set VE_HEAD = VE_MSTAR XT_MSTAR: 0071a6 71a7 .dw PFA_MSTAR PFA_MSTAR: 0071a7 018c movw temp0, tosl 0071a8 9189 0071a9 9199 loadtos 0071aa 019c movw temp2, tosl ; high cell ah*bh 0071ab 0231 muls temp3, temp1 0071ac 0170 movw temp4, r0 ; low cell al*bl 0071ad 9f20 mul temp2, temp0 0071ae 01c0 movw tosl, r0 ; signed ah*bl 0071af 0330 mulsu temp3, temp0 0071b0 08f3 sbc temp5, zeroh 0071b1 0d90 add tosh, r0 0071b2 1ce1 adc temp4, r1 0071b3 1cf3 adc temp5, zeroh ; signed al*bh 0071b4 0312 mulsu temp1, temp2 0071b5 08f3 sbc temp5, zeroh 0071b6 0d90 add tosh, r0 0071b7 1ce1 adc temp4, r1 0071b8 1cf3 adc temp5, zeroh 0071b9 939a 0071ba 938a savetos 0071bb 01c7 movw tosl, temp4 0071bc ce48 jmp_ DO_NEXT .include "words/umslashmod.asm" ; Arithmetics ; unsigned division ud / u2 with remainder VE_UMSLASHMOD: 0071bd ff06 .dw $ff06 0071be 6d75 0071bf 6d2f 0071c0 646f .db "um/mod" 0071c1 71a3 .dw VE_HEAD .set VE_HEAD = VE_UMSLASHMOD XT_UMSLASHMOD: 0071c2 71c3 .dw PFA_UMSLASHMOD PFA_UMSLASHMOD: 0071c3 017c movw temp4, tosl 0071c4 9129 ld temp2, Y+ 0071c5 9139 ld temp3, Y+ 0071c6 9109 ld temp0, Y+ 0071c7 9119 ld temp1, Y+ ;; unsigned 32/16 -> 16r16 divide PFA_UMSLASHMODmod: ; set loop counter 0071c8 e140 ldi temp6,$10 PFA_UMSLASHMODmod_loop: ; shift left, saving high bit 0071c9 2755 clr temp7 0071ca 0f00 lsl temp0 0071cb 1f11 rol temp1 0071cc 1f22 rol temp2 0071cd 1f33 rol temp3 0071ce 1f55 rol temp7 ; try subtracting divisor 0071cf 152e cp temp2, temp4 0071d0 053f cpc temp3, temp5 0071d1 0552 cpc temp7,zerol 0071d2 f018 brcs PFA_UMSLASHMODmod_loop_control PFA_UMSLASHMODmod_subtract: ; dividend is large enough ; do the subtraction for real ; and set lowest bit 0071d3 9503 inc temp0 0071d4 192e sub temp2, temp4 0071d5 093f sbc temp3, temp5 PFA_UMSLASHMODmod_loop_control: 0071d6 954a dec temp6 0071d7 f789 brne PFA_UMSLASHMODmod_loop PFA_UMSLASHMODmod_done: ; put remainder on stack 0071d8 933a st -Y,temp3 0071d9 932a st -Y,temp2 ; put quotient on stack 0071da 01c8 movw tosl, temp0 0071db ce29 jmp_ DO_NEXT .include "words/umstar.asm" ; Arithmetics ; multiply 2 unsigned cells to a double cell VE_UMSTAR: 0071dc ff03 .dw $ff03 0071dd 6d75 0071de 002a .db "um*",0 0071df 71bd .dw VE_HEAD .set VE_HEAD = VE_UMSTAR XT_UMSTAR: 0071e0 71e1 .dw PFA_UMSTAR PFA_UMSTAR: 0071e1 018c movw temp0, tosl 0071e2 9189 0071e3 9199 loadtos ; result: (temp3*temp1)* 65536 + (temp3*temp0 + temp1*temp2) * 256 + (temp0 * temp2) ; low bytes 0071e4 9f80 mul tosl,temp0 0071e5 01f0 movw zl, r0 0071e6 2722 clr temp2 0071e7 2733 clr temp3 ; middle bytes 0071e8 9f90 mul tosh, temp0 0071e9 0df0 add zh, r0 0071ea 1d21 adc temp2, r1 0071eb 1d33 adc temp3, zeroh 0071ec 9f81 mul tosl, temp1 0071ed 0df0 add zh, r0 0071ee 1d21 adc temp2, r1 0071ef 1d33 adc temp3, zeroh 0071f0 9f91 mul tosh, temp1 0071f1 0d20 add temp2, r0 0071f2 1d31 adc temp3, r1 0071f3 01cf movw tosl, zl 0071f4 939a 0071f5 938a savetos 0071f6 01c9 movw tosl, temp2 0071f7 ce0d jmp_ DO_NEXT .include "words/invert.asm" ; Arithmetics ; 1-complement of TOS VE_INVERT: 0071f8 ff06 .dw $ff06 0071f9 6e69 0071fa 6576 0071fb 7472 .db "invert" 0071fc 71dc .dw VE_HEAD .set VE_HEAD = VE_INVERT XT_INVERT: 0071fd 71fe .dw PFA_INVERT PFA_INVERT: 0071fe 9580 com tosl 0071ff 9590 com tosh 007200 ce04 jmp_ DO_NEXT .include "words/2slash.asm" ; Arithmetics ; arithmetic shift right VE_2SLASH: 007201 ff02 .dw $ff02 007202 2f32 .db "2/" 007203 71f8 .dw VE_HEAD .set VE_HEAD = VE_2SLASH XT_2SLASH: 007204 7205 .dw PFA_2SLASH PFA_2SLASH: 007205 9595 asr tosh 007206 9587 ror tosl 007207 cdfd jmp_ DO_NEXT .include "words/2star.asm" ; Arithmetics ; arithmetic shift left, filling with zero VE_2STAR: 007208 ff02 .dw $ff02 007209 2a32 .db "2*" 00720a 7201 .dw VE_HEAD .set VE_HEAD = VE_2STAR XT_2STAR: 00720b 720c .dw PFA_2STAR PFA_2STAR: 00720c 0f88 lsl tosl 00720d 1f99 rol tosh 00720e cdf6 jmp_ DO_NEXT .include "words/and.asm" ; Logic ; bitwise and VE_AND: 00720f ff03 .dw $ff03 007210 6e61 007211 0064 .db "and",0 007212 7208 .dw VE_HEAD .set VE_HEAD = VE_AND XT_AND: 007213 7214 .dw PFA_AND PFA_AND: 007214 9109 ld temp0, Y+ 007215 9119 ld temp1, Y+ 007216 2380 and tosl, temp0 007217 2391 and tosh, temp1 007218 cdec jmp_ DO_NEXT .include "words/or.asm" ; Logic ; logical or VE_OR: 007219 ff02 .dw $ff02 00721a 726f .db "or" 00721b 720f .dw VE_HEAD .set VE_HEAD = VE_OR XT_OR: 00721c 721d .dw PFA_OR PFA_OR: 00721d 9109 ld temp0, Y+ 00721e 9119 ld temp1, Y+ 00721f 2b80 or tosl, temp0 007220 2b91 or tosh, temp1 007221 cde3 jmp_ DO_NEXT .include "words/xor.asm" ; Logic ; exclusive or VE_XOR: 007222 ff03 .dw $ff03 007223 6f78 007224 0072 .db "xor",0 007225 7219 .dw VE_HEAD .set VE_HEAD = VE_XOR XT_XOR: 007226 7227 .dw PFA_XOR PFA_XOR: 007227 9109 ld temp0, Y+ 007228 9119 ld temp1, Y+ 007229 2780 eor tosl, temp0 00722a 2791 eor tosh, temp1 00722b cdd9 jmp_ DO_NEXT .include "words/1plus.asm" ; Arithmetics ; optimized increment VE_1PLUS: 00722c ff02 .dw $ff02 00722d 2b31 .db "1+" 00722e 7222 .dw VE_HEAD .set VE_HEAD = VE_1PLUS XT_1PLUS: 00722f 7230 .dw PFA_1PLUS PFA_1PLUS: 007230 9601 adiw tosl,1 007231 cdd3 jmp_ DO_NEXT .include "words/1minus.asm" ; Arithmetics ; optimized decrement VE_1MINUS: 007232 ff02 .dw $ff02 007233 2d31 .db "1-" 007234 722c .dw VE_HEAD .set VE_HEAD = VE_1MINUS XT_1MINUS: 007235 7236 .dw PFA_1MINUS PFA_1MINUS: 007236 9701 sbiw tosl, 1 007237 cdcd jmp_ DO_NEXT .include "words/q-negate.asm" ; 0< IF NEGATE THEN ; ...a common factor .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_QNEGATE: 007238 ff07 .dw $ff07 007239 6e3f 00723a 6765 00723b 7461 ../../common\words/q-negate.asm(11): warning: .cseg .db misalignment - padding zero byte 00723c 0065 .db "?negate" 00723d 7232 .dw VE_HEAD .set VE_HEAD = VE_QNEGATE XT_QNEGATE: 00723e 7001 .dw DO_COLON PFA_QNEGATE: .endif 00723f 7121 007240 7036 .DW XT_ZEROLESS,XT_DOCONDBRANCH 007241 7243 DEST(QNEG1) 007242 763f .DW XT_NEGATE 007243 7020 QNEG1: .DW XT_EXIT .include "words/lshift.asm" ; Arithmetics ; logically shift n1 left n2 times VE_LSHIFT: 007244 ff06 .dw $ff06 007245 736c 007246 6968 007247 7466 .db "lshift" 007248 7238 .dw VE_HEAD .set VE_HEAD = VE_LSHIFT XT_LSHIFT: 007249 724a .dw PFA_LSHIFT PFA_LSHIFT: 00724a 01fc movw zl, tosl 00724b 9189 00724c 9199 loadtos PFA_LSHIFT1: 00724d 9731 sbiw zl, 1 00724e f01a brmi PFA_LSHIFT2 00724f 0f88 lsl tosl 007250 1f99 rol tosh 007251 cffb rjmp PFA_LSHIFT1 PFA_LSHIFT2: 007252 cdb2 jmp_ DO_NEXT .include "words/rshift.asm" ; Arithmetics ; shift n1 n2-times logically right VE_RSHIFT: 007253 ff06 .dw $ff06 007254 7372 007255 6968 007256 7466 .db "rshift" 007257 7244 .dw VE_HEAD .set VE_HEAD = VE_RSHIFT XT_RSHIFT: 007258 7259 .dw PFA_RSHIFT PFA_RSHIFT: 007259 01fc movw zl, tosl 00725a 9189 00725b 9199 loadtos PFA_RSHIFT1: 00725c 9731 sbiw zl, 1 00725d f01a brmi PFA_RSHIFT2 00725e 9596 lsr tosh 00725f 9587 ror tosl 007260 cffb rjmp PFA_RSHIFT1 PFA_RSHIFT2: 007261 cda3 jmp_ DO_NEXT .include "words/plusstore.asm" ; Arithmetics ; add n to content of RAM address a-addr VE_PLUSSTORE: 007262 ff02 .dw $ff02 007263 212b .db "+!" 007264 7253 .dw VE_HEAD .set VE_HEAD = VE_PLUSSTORE XT_PLUSSTORE: 007265 7266 .dw PFA_PLUSSTORE PFA_PLUSSTORE: 007266 01fc movw zl, tosl 007267 9189 007268 9199 loadtos 007269 8120 ldd temp2, Z+0 00726a 8131 ldd temp3, Z+1 00726b 0f82 add tosl, temp2 00726c 1f93 adc tosh, temp3 00726d 8380 std Z+0, tosl 00726e 8391 std Z+1, tosh 00726f 9189 007270 9199 loadtos 007271 cd93 jmp_ DO_NEXT ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; .include "words/rpfetch.asm" ; Stack ; current return stack pointer address VE_RP_FETCH: 007272 ff03 .dw $ff03 007273 7072 007274 0040 .db "rp@",0 007275 7262 .dw VE_HEAD .set VE_HEAD = VE_RP_FETCH XT_RP_FETCH: 007276 7277 .dw PFA_RP_FETCH PFA_RP_FETCH: 007277 939a 007278 938a savetos 007279 b78d in tosl, SPL 00727a b79e in tosh, SPH 00727b cd89 jmp_ DO_NEXT .include "words/rpstore.asm" ; Stack ; set return stack pointer VE_RP_STORE: 00727c ff03 .dw $ff03 00727d 7072 00727e 0021 .db "rp!",0 00727f 7272 .dw VE_HEAD .set VE_HEAD = VE_RP_STORE XT_RP_STORE: 007280 7281 .dw PFA_RP_STORE PFA_RP_STORE: 007281 b72f in temp2, SREG 007282 94f8 cli 007283 bf8d out SPL, tosl 007284 bf9e out SPH, tosh 007285 bf2f out SREG, temp2 007286 9189 007287 9199 loadtos 007288 cd7c jmp_ DO_NEXT .include "words/spfetch.asm" ; Stack ; current data stack pointer VE_SP_FETCH: 007289 ff03 .dw $ff03 00728a 7073 00728b 0040 .db "sp@",0 00728c 727c .dw VE_HEAD .set VE_HEAD = VE_SP_FETCH XT_SP_FETCH: 00728d 728e .dw PFA_SP_FETCH PFA_SP_FETCH: 00728e 939a 00728f 938a savetos 007290 01ce movw tosl, yl 007291 cd73 jmp_ DO_NEXT .include "words/spstore.asm" ; Stack ; set data stack pointer to addr VE_SP_STORE: 007292 ff03 .dw $ff03 007293 7073 007294 0021 .db "sp!",0 007295 7289 .dw VE_HEAD .set VE_HEAD = VE_SP_STORE XT_SP_STORE: 007296 7297 .dw PFA_SP_STORE PFA_SP_STORE: 007297 01ec movw yl, tosl 007298 9189 007299 9199 loadtos 00729a cd6a jmp_ DO_NEXT .include "words/dodo.asm" ; System ; runtime of do ;VE_DODO: ; .dw $ff04 ; .db "(do)" ; .dw VE_HEAD ; .set VE_HEAD = VE_DODO XT_DODO: 00729b 729c .dw PFA_DODO PFA_DODO: 00729c 9129 ld temp2, Y+ 00729d 9139 ld temp3, Y+ ; limit PFA_DODO1: 00729e e8e0 ldi zl, $80 00729f 0f3e add temp3, zl 0072a0 1b82 sub tosl, temp2 0072a1 0b93 sbc tosh, temp3 0072a2 933f push temp3 0072a3 932f push temp2 ; limit ( --> limit + $8000) 0072a4 939f push tosh 0072a5 938f push tosl ; start -> index ( --> index - (limit - $8000) 0072a6 9189 0072a7 9199 loadtos 0072a8 cd5c jmp_ DO_NEXT .include "words/i.asm" ; Compiler ; current loop counter VE_I: 0072a9 ff01 .dw $FF01 0072aa 0069 .db "i",0 0072ab 7292 .dw VE_HEAD .set VE_HEAD = VE_I XT_I: 0072ac 72ad .dw PFA_I PFA_I: 0072ad 939a 0072ae 938a savetos 0072af 918f pop tosl 0072b0 919f pop tosh ; index 0072b1 91ef pop zl 0072b2 91ff pop zh ; limit 0072b3 93ff push zh 0072b4 93ef push zl 0072b5 939f push tosh 0072b6 938f push tosl 0072b7 0f8e add tosl, zl 0072b8 1f9f adc tosh, zh 0072b9 cd4b jmp_ DO_NEXT .include "words/doplusloop.asm" ; System ; runtime of +loop ;VE_DOPLUSLOOP: ; .dw $ff07 ; .db "(+loop)" ; .dw VE_HEAD ; .set VE_HEAD = VE_DOPLUSLOOP XT_DOPLUSLOOP: 0072ba 72bb .dw PFA_DOPLUSLOOP PFA_DOPLUSLOOP: 0072bb 91ef pop zl 0072bc 91ff pop zh 0072bd 0fe8 add zl, tosl 0072be 1ff9 adc zh, tosh 0072bf 9189 0072c0 9199 loadtos 0072c1 f01b brvs PFA_DOPLUSLOOP_LEAVE ; next cycle PFA_DOPLUSLOOP_NEXT: ; next iteration 0072c2 93ff push zh 0072c3 93ef push zl 0072c4 cd6b rjmp PFA_DOBRANCH ; read next cell from dictionary and jump to its destination PFA_DOPLUSLOOP_LEAVE: 0072c5 910f pop temp0 0072c6 911f pop temp1 ; remove limit 0072c7 9611 adiw xl, 1 ; skip branch-back address 0072c8 cd3c jmp_ DO_NEXT .include "words/doloop.asm" ; System ; runtime of loop ;VE_DOLOOP: ; .dw $ff06 ; .db "(loop)" ; .dw VE_HEAD ; .set VE_HEAD = VE_DOLOOP XT_DOLOOP: 0072c9 72ca .dw PFA_DOLOOP PFA_DOLOOP: 0072ca 91ef pop zl 0072cb 91ff pop zh 0072cc 9631 adiw zl,1 0072cd f3bb brvs PFA_DOPLUSLOOP_LEAVE 0072ce cff3 jmp_ PFA_DOPLUSLOOP_NEXT .include "words/unloop.asm" ; Compiler ; remove loop-sys, exit the loop and continue execution after it VE_UNLOOP: 0072cf ff06 .dw $ff06 0072d0 6e75 0072d1 6f6c 0072d2 706f .db "unloop" 0072d3 72a9 .dw VE_HEAD .set VE_HEAD = VE_UNLOOP XT_UNLOOP: 0072d4 72d5 .dw PFA_UNLOOP PFA_UNLOOP: 0072d5 911f pop temp1 0072d6 910f pop temp0 0072d7 911f pop temp1 0072d8 910f pop temp0 0072d9 cd2b jmp_ DO_NEXT ;;;;;;;;;;;;;;;;;;;;;;;;;;; .include "words/cmove_g.asm" ; Memory ; copy data in RAM from higher to lower addresses. VE_CMOVE_G: 0072da ff06 .dw $ff06 0072db 6d63 0072dc 766f 0072dd 3e65 .db "cmove>" 0072de 72cf .dw VE_HEAD .set VE_HEAD = VE_CMOVE_G XT_CMOVE_G: 0072df 72e0 .dw PFA_CMOVE_G PFA_CMOVE_G: 0072e0 93bf push xh 0072e1 93af push xl 0072e2 91e9 ld zl, Y+ 0072e3 91f9 ld zh, Y+ ; addr-to 0072e4 91a9 ld xl, Y+ 0072e5 91b9 ld xh, Y+ ; addr-from 0072e6 2f09 mov temp0, tosh 0072e7 2b08 or temp0, tosl 0072e8 f041 brbs 1, PFA_CMOVE_G1 0072e9 0fe8 add zl, tosl 0072ea 1ff9 adc zh, tosh 0072eb 0fa8 add xl, tosl 0072ec 1fb9 adc xh, tosh PFA_CMOVE_G2: 0072ed 911e ld temp1, -X 0072ee 9312 st -Z, temp1 0072ef 9701 sbiw tosl, 1 0072f0 f7e1 brbc 1, PFA_CMOVE_G2 PFA_CMOVE_G1: 0072f1 91af pop xl 0072f2 91bf pop xh 0072f3 9189 0072f4 9199 loadtos 0072f5 cd0f jmp_ DO_NEXT .include "words/byteswap.asm" ; Arithmetics ; exchange the bytes of the TOS VE_BYTESWAP: 0072f6 ff02 .dw $ff02 0072f7 3c3e .db "><" 0072f8 72da .dw VE_HEAD .set VE_HEAD = VE_BYTESWAP XT_BYTESWAP: 0072f9 72fa .dw PFA_BYTESWAP PFA_BYTESWAP: 0072fa 2f09 mov temp0, tosh 0072fb 2f98 mov tosh, tosl 0072fc 2f80 mov tosl, temp0 0072fd cd07 jmp_ DO_NEXT .include "words/up.asm" ; System Variable ; get user area pointer VE_UP_FETCH: 0072fe ff03 .dw $ff03 0072ff 7075 007300 0040 .db "up@",0 007301 72f6 .dw VE_HEAD .set VE_HEAD = VE_UP_FETCH XT_UP_FETCH: 007302 7303 .dw PFA_UP_FETCH PFA_UP_FETCH: 007303 939a 007304 938a savetos 007305 01c2 movw tosl, upl 007306 ccfe jmp_ DO_NEXT ; ( addr -- ) ; System Variable ; set user area pointer VE_UP_STORE: 007307 ff03 .dw $ff03 007308 7075 007309 0021 .db "up!",0 00730a 72fe .dw VE_HEAD .set VE_HEAD = VE_UP_STORE XT_UP_STORE: 00730b 730c .dw PFA_UP_STORE PFA_UP_STORE: 00730c 012c movw upl, tosl 00730d 9189 00730e 9199 loadtos 00730f ccf5 jmp_ DO_NEXT .include "words/1ms.asm" ; Time ; busy waits (almost) exactly 1 millisecond VE_1MS: 007310 ff03 .dw $ff03 007311 6d31 007312 0073 .db "1ms",0 007313 7307 .dw VE_HEAD .set VE_HEAD = VE_1MS XT_1MS: 007314 7315 .dw PFA_1MS PFA_1MS: 007315 eae0 007316 e0ff 007317 9731 007318 f7f1 delay 1000 007319 cceb jmp_ DO_NEXT .include "words/2to_r.asm" ; Stack ; move DTOS to TOR VE_2TO_R: 00731a ff03 .dw $ff03 00731b 3e32 00731c 0072 .db "2>r",0 00731d 7310 .dw VE_HEAD .set VE_HEAD = VE_2TO_R XT_2TO_R: 00731e 731f .dw PFA_2TO_R PFA_2TO_R: 00731f 01fc movw zl, tosl 007320 9189 007321 9199 loadtos 007322 939f push tosh 007323 938f push tosl 007324 93ff push zh 007325 93ef push zl 007326 9189 007327 9199 loadtos 007328 ccdc jmp_ DO_NEXT .include "words/2r_from.asm" ; Stack ; move DTOR to TOS VE_2R_FROM: 007329 ff03 .dw $ff03 00732a 7232 00732b 003e .db "2r>",0 00732c 731a .dw VE_HEAD .set VE_HEAD = VE_2R_FROM XT_2R_FROM: 00732d 732e .dw PFA_2R_FROM PFA_2R_FROM: 00732e 939a 00732f 938a savetos 007330 91ef pop zl 007331 91ff pop zh 007332 918f pop tosl 007333 919f pop tosh 007334 939a 007335 938a savetos 007336 01cf movw tosl, zl 007337 cccd jmp_ DO_NEXT .include "words/store-e.asm" ; Memory ; write n (2bytes) to eeprom address VE_STOREE: 007338 ff02 .dw $ff02 007339 6521 .db "!e" 00733a 7329 .dw VE_HEAD .set VE_HEAD = VE_STOREE XT_STOREE: 00733b 733c .dw PFA_STOREE PFA_STOREE: .if WANT_UNIFIED == 1 .endif PFA_STOREE0: 00733c 01fc movw zl, tosl 00733d 9189 00733e 9199 loadtos 00733f b72f in_ temp2, SREG 007340 94f8 cli 007341 d028 rcall PFA_FETCHE2 007342 b500 in_ temp0, EEDR 007343 1708 cp temp0,tosl 007344 f009 breq PFA_STOREE3 007345 d00b rcall PFA_STOREE1 PFA_STOREE3: 007346 9631 adiw zl,1 007347 d022 rcall PFA_FETCHE2 007348 b500 in_ temp0, EEDR 007349 1709 cp temp0,tosh 00734a f011 breq PFA_STOREE4 00734b 2f89 mov tosl, tosh 00734c d004 rcall PFA_STOREE1 PFA_STOREE4: 00734d bf2f out_ SREG, temp2 00734e 9189 00734f 9199 loadtos 007350 ccb4 jmp_ DO_NEXT PFA_STOREE1: 007351 99f9 sbic EECR, EEPE 007352 cffe rjmp PFA_STOREE1 PFA_STOREE2: ; estore_wait_low_spm: 007353 b707 in_ temp0, SPMCSR 007354 fd00 sbrc temp0,SPMEN 007355 cffd rjmp PFA_STOREE2 007356 bdf2 out_ EEARH,zh 007357 bde1 out_ EEARL,zl 007358 bd80 out_ EEDR, tosl 007359 9afa sbi EECR,EEMPE 00735a 9af9 sbi EECR,EEPE 00735b 9508 ret .if WANT_UNIFIED == 1 .endif .include "words/fetch-e.asm" ; Memory ; read 1 cell from eeprom VE_FETCHE: 00735c ff02 .dw $ff02 00735d 6540 .db "@e" 00735e 7338 .dw VE_HEAD .set VE_HEAD = VE_FETCHE XT_FETCHE: 00735f 7360 .dw PFA_FETCHE PFA_FETCHE: .if WANT_UNIFIED == 1 .endif PFA_FETCHE1: 007360 b72f in_ temp2, SREG 007361 94f8 cli 007362 01fc movw zl, tosl 007363 d006 rcall PFA_FETCHE2 007364 b580 in_ tosl, EEDR 007365 9631 adiw zl,1 007366 d003 rcall PFA_FETCHE2 007367 b590 in_ tosh, EEDR 007368 bf2f out_ SREG, temp2 007369 cc9b jmp_ DO_NEXT PFA_FETCHE2: 00736a 99f9 sbic EECR, EEPE 00736b cffe rjmp PFA_FETCHE2 00736c bdf2 out_ EEARH,zh 00736d bde1 out_ EEARL,zl 00736e 9af8 sbi EECR,EERE 00736f 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: 007370 ff02 .dw $ff02 007371 6921 .db "!i" 007372 735c .dw VE_HEAD .set VE_HEAD = VE_STOREI XT_STOREI: 007373 7c13 .dw PFA_DODEFER1 PFA_STOREI: 007374 006a .dw EE_STOREI 007375 7bb4 .dw XT_EDEFERFETCH 007376 7bbe .dw XT_EDEFERSTORE .if FLASHEND > $10000 .else .include "words/store-i_nrww.asm" ; Memory ; writes n to flash memory using assembly code (code to be placed in boot loader section) VE_DO_STOREI_NRWW: 007377 ff09 .dw $ff09 007378 2128 007379 2d69 00737a 726e 00737b 7777 00737c 0029 .db "(!i-nrww)",0 00737d 7370 .dw VE_HEAD .set VE_HEAD = VE_DO_STOREI_NRWW XT_DO_STOREI: 00737e 737f .dw PFA_DO_STOREI_NRWW PFA_DO_STOREI_NRWW: ; store status register 00737f b71f in temp1,SREG 007380 931f push temp1 007381 94f8 cli 007382 019c movw temp2, tosl ; save the (word) address 007383 9189 007384 9199 loadtos ; get the new value for the flash cell 007385 93af push xl 007386 93bf push xh 007387 93cf push yl 007388 93df push yh 007389 d009 rcall DO_STOREI_atmega 00738a 91df pop yh 00738b 91cf pop yl 00738c 91bf pop xh 00738d 91af pop xl ; finally clear the stack 00738e 9189 00738f 9199 loadtos 007390 911f pop temp1 ; restore status register (and interrupt enable flag) 007391 bf1f out SREG,temp1 007392 cc72 jmp_ DO_NEXT ; DO_STOREI_atmega: ; write data to temp page buffer ; use the values in tosl/tosh at the ; appropiate place 007393 d010 rcall pageload ; erase page if needed ; it is needed if a bit goes from 0 to 1 007394 94e0 com temp4 007395 94f0 com temp5 007396 218e and tosl, temp4 007397 219f and tosh, temp5 007398 2b98 or tosh, tosl 007399 f019 breq DO_STOREI_writepage 00739a 01f9 movw zl, temp2 00739b e002 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: 0073d2 ff03 .dw $ff03 0073d3 3e6e 0073d4 0072 .db "n>r",0 0073d5 73c8 .dw VE_HEAD .set VE_HEAD = VE_N_TO_R XT_N_TO_R: 0073d6 73d7 .dw PFA_N_TO_R PFA_N_TO_R: 0073d7 01fc movw zl, tosl 0073d8 2f08 mov temp0, tosl PFA_N_TO_R1: 0073d9 9189 0073da 9199 loadtos 0073db 939f push tosh 0073dc 938f push tosl 0073dd 950a dec temp0 0073de f7d1 brne PFA_N_TO_R1 0073df 93ef push zl 0073e0 93ff push zh 0073e1 9189 0073e2 9199 loadtos 0073e3 cc21 jmp_ DO_NEXT .include "words/n_r_from.asm" ; Stack ; move n items from return stack to data stack VE_N_R_FROM: 0073e4 ff03 .dw $ff03 0073e5 726e 0073e6 003e .db "nr>",0 0073e7 73d2 .dw VE_HEAD .set VE_HEAD = VE_N_R_FROM XT_N_R_FROM: 0073e8 73e9 .dw PFA_N_R_FROM PFA_N_R_FROM: 0073e9 939a 0073ea 938a savetos 0073eb 91ff pop zh 0073ec 91ef pop zl 0073ed 2f0e mov temp0, zl PFA_N_R_FROM1: 0073ee 918f pop tosl 0073ef 919f pop tosh 0073f0 939a 0073f1 938a savetos 0073f2 950a dec temp0 0073f3 f7d1 brne PFA_N_R_FROM1 0073f4 01cf movw tosl, zl 0073f5 cc0f jmp_ DO_NEXT .include "words/d-2star.asm" ; Arithmetics ; shift a double cell left VE_D2STAR: 0073f6 ff03 .dw $ff03 0073f7 3264 0073f8 002a .db "d2*",0 0073f9 73e4 .dw VE_HEAD .set VE_HEAD = VE_D2STAR XT_D2STAR: 0073fa 73fb .dw PFA_D2STAR PFA_D2STAR: 0073fb 9109 ld temp0, Y+ 0073fc 9119 ld temp1, Y+ 0073fd 0f00 lsl temp0 0073fe 1f11 rol temp1 0073ff 1f88 rol tosl 007400 1f99 rol tosh 007401 931a st -Y, temp1 007402 930a st -Y, temp0 007403 cc01 jmp_ DO_NEXT .include "words/d-2slash.asm" ; Arithmetics ; shift a double cell value right VE_D2SLASH: 007404 ff03 .dw $ff03 007405 3264 007406 002f .db "d2/",0 007407 73f6 .dw VE_HEAD .set VE_HEAD = VE_D2SLASH XT_D2SLASH: 007408 7409 .dw PFA_D2SLASH PFA_D2SLASH: 007409 9109 ld temp0, Y+ 00740a 9119 ld temp1, Y+ 00740b 9595 asr tosh 00740c 9587 ror tosl 00740d 9517 ror temp1 00740e 9507 ror temp0 00740f 931a st -Y, temp1 007410 930a st -Y, temp0 007411 cbf3 jmp_ DO_NEXT .include "words/d-plus.asm" ; Arithmetics ; add 2 double cell values VE_DPLUS: 007412 ff02 .dw $ff02 007413 2b64 .db "d+" 007414 7404 .dw VE_HEAD .set VE_HEAD = VE_DPLUS XT_DPLUS: 007415 7416 .dw PFA_DPLUS PFA_DPLUS: 007416 9129 ld temp2, Y+ 007417 9139 ld temp3, Y+ 007418 90e9 ld temp4, Y+ 007419 90f9 ld temp5, Y+ 00741a 9149 ld temp6, Y+ 00741b 9159 ld temp7, Y+ 00741c 0f24 add temp2, temp6 00741d 1f35 adc temp3, temp7 00741e 1d8e adc tosl, temp4 00741f 1d9f adc tosh, temp5 007420 933a st -Y, temp3 007421 932a st -Y, temp2 007422 cbe2 jmp_ DO_NEXT .include "words/d-minus.asm" ; Arithmetics ; subtract d2 from d1 VE_DMINUS: 007423 ff02 .dw $ff02 007424 2d64 .db "d-" 007425 7412 .dw VE_HEAD .set VE_HEAD = VE_DMINUS XT_DMINUS: 007426 7427 .dw PFA_DMINUS PFA_DMINUS: 007427 9129 ld temp2, Y+ 007428 9139 ld temp3, Y+ 007429 90e9 ld temp4, Y+ 00742a 90f9 ld temp5, Y+ 00742b 9149 ld temp6, Y+ 00742c 9159 ld temp7, Y+ 00742d 1b42 sub temp6, temp2 00742e 0b53 sbc temp7, temp3 00742f 0ae8 sbc temp4, tosl 007430 0af9 sbc temp5, tosh 007431 935a st -Y, temp7 007432 934a st -Y, temp6 007433 01c7 movw tosl, temp4 007434 cbd0 jmp_ DO_NEXT .include "words/d-invert.asm" ; Arithmetics ; invert all bits in the double cell value VE_DINVERT: 007435 ff07 .dw $ff07 007436 6964 007437 766e 007438 7265 007439 0074 .db "dinvert",0 00743a 7423 .dw VE_HEAD .set VE_HEAD = VE_DINVERT XT_DINVERT: 00743b 743c .dw PFA_DINVERT PFA_DINVERT: 00743c 9109 ld temp0, Y+ 00743d 9119 ld temp1, Y+ 00743e 9580 com tosl 00743f 9590 com tosh 007440 9500 com temp0 007441 9510 com temp1 007442 931a st -Y, temp1 007443 930a st -Y, temp0 007444 cbc0 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: 007445 ff02 .dw $ff02 007446 2e75 .db "u." 007447 7435 .dw VE_HEAD .set VE_HEAD = VE_UDOT XT_UDOT: 007448 7001 .dw DO_COLON PFA_UDOT: .endif 007449 7154 .dw XT_ZERO 00744a 772a .dw XT_UDDOT 00744b 7020 .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: 00744c ff03 .dw $ff03 00744d 2e75 00744e 0072 .db "u.r",0 00744f 7445 .dw VE_HEAD .set VE_HEAD = VE_UDOTR XT_UDOTR: 007450 7001 .dw DO_COLON PFA_UDOTR: .endif 007451 7154 .dw XT_ZERO 007452 70c4 .dw XT_SWAP 007453 7733 .dw XT_UDDOTR 007454 7020 .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: 007455 ff0d .dw $ff0d 007456 6873 007457 776f 007458 772d 007459 726f 00745a 6c64 00745b 7369 00745c 0074 .db "show-wordlist",0 00745d 744c .dw VE_HEAD .set VE_HEAD = VE_SHOWWORDLIST XT_SHOWWORDLIST: 00745e 7001 .dw DO_COLON PFA_SHOWWORDLIST: .endif 00745f 703d .dw XT_DOLITERAL 007460 7464 .dw XT_SHOWWORD 007461 70c4 .dw XT_SWAP 007462 7c57 .dw XT_TRAVERSEWORDLIST 007463 7020 .dw XT_EXIT .if cpu_msp430==1 .endif .if cpu_avr8==1 XT_SHOWWORD: 007464 7001 .dw DO_COLON PFA_SHOWWORD: .endif 007465 7c72 .dw XT_NAME2STRING 007466 77a0 .dw XT_ITYPE 007467 77e2 .dw XT_SPACE ; ( -- addr n) 007468 714b .dw XT_TRUE 007469 7020 .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: 00746a ff05 .dw $ff05 00746b 6f77 00746c 6472 00746d 0073 .db "words",0 00746e 7455 .dw VE_HEAD .set VE_HEAD = VE_WORDS XT_WORDS: 00746f 7001 .dw DO_COLON PFA_WORDS: .endif 007470 703d .dw XT_DOLITERAL 007471 0050 .dw CFG_ORDERLISTLEN+2 007472 735f .dw XT_FETCHE 007473 745e .dw XT_SHOWWORDLIST 007474 7020 .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: 007475 ff04 .dw $ff04 007476 692b 007477 746e .db "+int" 007478 746a .dw VE_HEAD .set VE_HEAD = VE_INTON XT_INTON: 007479 747a .dw PFA_INTON PFA_INTON: 00747a 9478 sei 00747b cb89 jmp_ DO_NEXT .include "words/int-off.asm" ; Interrupt ; turns off all interrupts VE_INTOFF: 00747c ff04 .dw $ff04 00747d 692d 00747e 746e .db "-int" 00747f 7475 .dw VE_HEAD .set VE_HEAD = VE_INTOFF XT_INTOFF: 007480 7481 .dw PFA_INTOFF PFA_INTOFF: 007481 94f8 cli 007482 cb82 jmp_ DO_NEXT .include "words/int-store.asm" ; Interrupt ; stores XT as interrupt vector i VE_INTSTORE: 007483 ff04 .dw $ff04 007484 6e69 007485 2174 .db "int!" 007486 747c .dw VE_HEAD .set VE_HEAD = VE_INTSTORE XT_INTSTORE: 007487 7001 .dw DO_COLON PFA_INTSTORE: 007488 703d .dw XT_DOLITERAL 007489 0000 .dw intvec 00748a 719d .dw XT_PLUS 00748b 733b .dw XT_STOREE 00748c 7020 .dw XT_EXIT .include "words/int-fetch.asm" ; Interrupt ; fetches XT from interrupt vector i VE_INTFETCH: 00748d ff04 .dw $ff04 00748e 6e69 00748f 4074 .db "int@" 007490 7483 .dw VE_HEAD .set VE_HEAD = VE_INTFETCH XT_INTFETCH: 007491 7001 .dw DO_COLON PFA_INTFETCH: 007492 703d .dw XT_DOLITERAL 007493 0000 .dw intvec 007494 719d .dw XT_PLUS 007495 735f .dw XT_FETCHE 007496 7020 .dw XT_EXIT .include "words/int-trap.asm" ; Interrupt ; trigger an interrupt VE_INTTRAP: 007497 ff08 .dw $ff08 007498 6e69 007499 2d74 00749a 7274 00749b 7061 .db "int-trap" 00749c 748d .dw VE_HEAD .set VE_HEAD = VE_INTTRAP XT_INTTRAP: 00749d 749e .dw PFA_INTTRAP PFA_INTTRAP: 00749e 2eb8 mov isrflag, tosl 00749f 9189 0074a0 9199 loadtos 0074a1 cb63 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: 0074a2 7001 .dw DO_COLON PFA_ISREXEC: 0074a3 7491 .dw XT_INTFETCH 0074a4 702a .dw XT_EXECUTE 0074a5 74a7 .dw XT_ISREND 0074a6 7020 .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: 0074a7 74a8 .dw PFA_ISREND PFA_ISREND: 0074a8 d001 rcall PFA_ISREND1 ; clear the interrupt flag for the controller 0074a9 cb5b jmp_ DO_NEXT PFA_ISREND1: 0074aa 9518 reti .endif .include "words/pick.asm" .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_PICK: 0074ab ff04 .dw $ff04 0074ac 6970 0074ad 6b63 .db "pick" 0074ae 7497 .dw VE_HEAD .set VE_HEAD = VE_PICK XT_PICK: 0074af 7001 .dw DO_COLON PFA_PICK: .endif 0074b0 722f .dw XT_1PLUS 0074b1 7558 .dw XT_CELLS 0074b2 728d .dw XT_SP_FETCH 0074b3 719d .dw XT_PLUS 0074b4 7079 .dw XT_FETCH 0074b5 7020 .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: 0074b6 0002 .dw $0002 0074b7 222e .db ".",$22 0074b8 74ab .dw VE_HEAD .set VE_HEAD = VE_DOTSTRING XT_DOTSTRING: 0074b9 7001 .dw DO_COLON PFA_DOTSTRING: .endif 0074ba 74c1 .dw XT_SQUOTE 0074bb 01c1 .dw XT_COMPILE 0074bc 77a0 .dw XT_ITYPE 0074bd 7020 .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: 0074be 0002 .dw $0002 0074bf 2273 .db "s",$22 0074c0 74b6 .dw VE_HEAD .set VE_HEAD = VE_SQUOTE XT_SQUOTE: 0074c1 7001 .dw DO_COLON PFA_SQUOTE: .endif 0074c2 703d .dw XT_DOLITERAL 0074c3 0022 .dw 34 ; 0x22 0074c4 7987 .dw XT_PARSE ; ( -- addr n) 0074c5 754b .dw XT_STATE 0074c6 7079 .dw XT_FETCH 0074c7 7036 .dw XT_DOCONDBRANCH 0074c8 74ca DEST(PFA_SQUOTE1) 0074c9 01ed .dw XT_SLITERAL PFA_SQUOTE1: 0074ca 7020 .dw XT_EXIT .include "words/fill.asm" ; Memory ; fill u bytes memory beginning at a-addr with character c VE_FILL: 0074cb ff04 .dw $ff04 0074cc 6966 0074cd 6c6c .db "fill" 0074ce 74be .dw VE_HEAD .set VE_HEAD = VE_FILL XT_FILL: 0074cf 7001 .dw DO_COLON PFA_FILL: 0074d0 70e1 .dw XT_ROT 0074d1 70e1 .dw XT_ROT 0074d2 70b9 0074d3 7036 .dw XT_QDUP,XT_DOCONDBRANCH 0074d4 74dc DEST(PFA_FILL2) 0074d5 7d5e .dw XT_BOUNDS 0074d6 729b .dw XT_DODO PFA_FILL1: 0074d7 70b1 .dw XT_DUP 0074d8 72ac .dw XT_I 0074d9 708d .dw XT_CSTORE ; ( -- c c-addr) 0074da 72c9 .dw XT_DOLOOP 0074db 74d7 .dw PFA_FILL1 PFA_FILL2: 0074dc 70d9 .dw XT_DROP 0074dd 7020 .dw XT_EXIT .include "words/environment.asm" ; System Value ; word list identifier of the environmental search list VE_ENVIRONMENT: 0074de ff0b .dw $ff0b 0074df 6e65 0074e0 6976 0074e1 6f72 0074e2 6d6e 0074e3 6e65 0074e4 0074 .db "environment",0 0074e5 74cb .dw VE_HEAD .set VE_HEAD = VE_ENVIRONMENT XT_ENVIRONMENT: 0074e6 7048 .dw PFA_DOVARIABLE PFA_ENVIRONMENT: 0074e7 0048 .dw CFG_ENVIRONMENT .include "words/env-wordlists.asm" ; Environment ; maximum number of wordlists in the dictionary search order VE_ENVWORDLISTS: 0074e8 ff09 .dw $ff09 0074e9 6f77 0074ea 6472 0074eb 696c 0074ec 7473 0074ed 0073 .db "wordlists",0 0074ee 0000 .dw VE_ENVHEAD .set VE_ENVHEAD = VE_ENVWORDLISTS XT_ENVWORDLISTS: 0074ef 7001 .dw DO_COLON PFA_ENVWORDLISTS: 0074f0 703d .dw XT_DOLITERAL 0074f1 0008 .dw NUMWORDLISTS 0074f2 7020 .dw XT_EXIT .include "words/env-slashpad.asm" ; Environment ; Size of the PAD buffer in bytes VE_ENVSLASHPAD: 0074f3 ff04 .dw $ff04 0074f4 702f 0074f5 6461 .db "/pad" 0074f6 74e8 .dw VE_ENVHEAD .set VE_ENVHEAD = VE_ENVSLASHPAD XT_ENVSLASHPAD: 0074f7 7001 .dw DO_COLON PFA_ENVSLASHPAD: 0074f8 728d .dw XT_SP_FETCH 0074f9 7584 .dw XT_PAD 0074fa 7193 .dw XT_MINUS 0074fb 7020 .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: 0074fc ff05 .dw $ff05 0074fd 682f 0074fe 6c6f 0074ff 0064 .db "/hold",0 007500 74f3 .dw VE_ENVHEAD .set VE_ENVHEAD = VE_ENVSLASHHOLD XT_ENVSLASHHOLD: 007501 7001 .dw DO_COLON PFA_ENVSLASHHOLD: .endif 007502 7584 .dw XT_PAD 007503 75bf .dw XT_HERE 007504 7193 .dw XT_MINUS 007505 7020 .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: 007506 ff0a .dw $ff0a 007507 6f66 007508 7472 007509 2d68 00750a 616e 00750b 656d .db "forth-name" 00750c 74fc .dw VE_ENVHEAD .set VE_ENVHEAD = VE_ENV_FORTHNAME XT_ENV_FORTHNAME: 00750d 7001 .dw DO_COLON PFA_EN_FORTHNAME: 00750e 776d .dw XT_DOSLITERAL 00750f 0007 .dw 7 .endif 007510 6d61 007511 6f66 007512 7472 ../../common\words/env-forthname.asm(22): warning: .cseg .db misalignment - padding zero byte 007513 0068 .db "amforth" .if cpu_msp430==1 .endif 007514 7020 .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: 007515 ff07 .dw $ff07 007516 6576 007517 7372 007518 6f69 007519 006e .db "version",0 00751a 7506 .dw VE_ENVHEAD .set VE_ENVHEAD = VE_ENV_FORTHVERSION XT_ENV_FORTHVERSION: 00751b 7001 .dw DO_COLON PFA_EN_FORTHVERSION: .endif 00751c 703d .dw XT_DOLITERAL 00751d 0041 .dw 65 00751e 7020 .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: 00751f ff03 .dw $ff03 007520 7063 007521 0075 .db "cpu",0 007522 7515 .dw VE_ENVHEAD .set VE_ENVHEAD = VE_ENV_CPU XT_ENV_CPU: 007523 7001 .dw DO_COLON PFA_EN_CPU: .endif 007524 703d .dw XT_DOLITERAL 007525 003b .dw mcu_name 007526 77cc .dw XT_ICOUNT 007527 7020 .dw XT_EXIT .include "words/env-mcuinfo.asm" ; Environment ; flash address of some CPU specific parameters VE_ENV_MCUINFO: 007528 ff08 .dw $ff08 007529 636d 00752a 2d75 00752b 6e69 00752c 6f66 .db "mcu-info" 00752d 751f .dw VE_ENVHEAD .set VE_ENVHEAD = VE_ENV_MCUINFO XT_ENV_MCUINFO: 00752e 7001 .dw DO_COLON PFA_EN_MCUINFO: 00752f 703d .dw XT_DOLITERAL 007530 0037 .dw mcu_info 007531 7020 .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: 007532 ff05 .dw $ff05 007533 752f 007534 6573 007535 0072 .db "/user",0 007536 7528 .dw VE_ENVHEAD .set VE_ENVHEAD = VE_ENVUSERSIZE XT_ENVUSERSIZE: 007537 7001 .dw DO_COLON PFA_ENVUSERSIZE: .endif 007538 703d .dw XT_DOLITERAL 007539 002c .dw SYSUSERSIZE + APPUSERSIZE 00753a 7020 .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: 00753b ff05 .dw $ff05 00753c 5f66 00753d 7063 00753e 0075 .db "f_cpu",0 00753f 74de .dw VE_HEAD .set VE_HEAD = VE_F_CPU XT_F_CPU: 007540 7001 .dw DO_COLON PFA_F_CPU: .endif 007541 703d .dw XT_DOLITERAL 007542 2400 .dw (F_CPU % 65536) 007543 703d .dw XT_DOLITERAL 007544 00f4 .dw (F_CPU / 65536) 007545 7020 .dw XT_EXIT .include "words/state.asm" ; System Variable ; system state VE_STATE: 007546 ff05 .dw $ff05 007547 7473 007548 7461 007549 0065 .db "state",0 00754a 753b .dw VE_HEAD .set VE_HEAD = VE_STATE XT_STATE: 00754b 7048 .dw PFA_DOVARIABLE PFA_STATE: 00754c 0136 .dw ram_state .dseg 000136 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: 00754d ff04 .dw $ff04 00754e 6162 00754f 6573 .db "base" 007550 7546 .dw VE_HEAD .set VE_HEAD = VE_BASE XT_BASE: 007551 7058 .dw PFA_DOUSER PFA_BASE: .endif 007552 000c .dw USER_BASE .include "words/cells.asm" ; Arithmetics ; n2 is the size in address units of n1 cells VE_CELLS: 007553 ff05 .dw $ff05 007554 6563 007555 6c6c 007556 0073 .db "cells",0 007557 754d .dw VE_HEAD .set VE_HEAD = VE_CELLS XT_CELLS: 007558 720c .dw PFA_2STAR .include "words/cellplus.asm" ; Arithmetics ; add the size of an address-unit to a-addr1 VE_CELLPLUS: 007559 ff05 .dw $ff05 00755a 6563 00755b 6c6c 00755c 002b .db "cell+",0 00755d 7553 .dw VE_HEAD .set VE_HEAD = VE_CELLPLUS XT_CELLPLUS: 00755e 755f .dw PFA_CELLPLUS PFA_CELLPLUS: 00755f 9602 adiw tosl, CELLSIZE 007560 caa4 jmp_ DO_NEXT .include "words/2dup.asm" ; Stack ; Duplicate the 2 top elements .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_2DUP: 007561 ff04 .dw $ff04 007562 6432 007563 7075 .db "2dup" 007564 7559 .dw VE_HEAD .set VE_HEAD = VE_2DUP XT_2DUP: 007565 7001 .dw DO_COLON PFA_2DUP: .endif 007566 70cf .dw XT_OVER 007567 70cf .dw XT_OVER 007568 7020 .dw XT_EXIT .include "words/2drop.asm" ; Stack ; Remove the 2 top elements .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_2DROP: 007569 ff05 .dw $ff05 00756a 6432 00756b 6f72 00756c 0070 .db "2drop",0 00756d 7561 .dw VE_HEAD .set VE_HEAD = VE_2DROP XT_2DROP: 00756e 7001 .dw DO_COLON PFA_2DROP: .endif 00756f 70d9 .dw XT_DROP 007570 70d9 .dw XT_DROP 007571 7020 .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: 007572 ff04 .dw $ff04 007573 7574 007574 6b63 .db "tuck" 007575 7569 .dw VE_HEAD .set VE_HEAD = VE_TUCK XT_TUCK: 007576 7001 .dw DO_COLON PFA_TUCK: .endif 007577 70c4 .dw XT_SWAP 007578 70cf .dw XT_OVER 007579 7020 .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: 00757a ff03 .dw $ff03 00757b 693e 00757c 006e .db ">in",0 00757d 7572 .dw VE_HEAD .set VE_HEAD = VE_TO_IN XT_TO_IN: 00757e 7058 .dw PFA_DOUSER PFA_TO_IN: .endif 00757f 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: 007580 ff03 .dw $ff03 007581 6170 007582 0064 .db "pad",0 007583 757a .dw VE_HEAD .set VE_HEAD = VE_PAD XT_PAD: 007584 7001 .dw DO_COLON PFA_PAD: .endif 007585 75bf .dw XT_HERE 007586 703d .dw XT_DOLITERAL 007587 0028 .dw 40 007588 719d .dw XT_PLUS 007589 7020 .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: 00758a ff04 .dw $ff04 00758b 6d65 00758c 7469 .db "emit" 00758d 7580 .dw VE_HEAD .set VE_HEAD = VE_EMIT XT_EMIT: 00758e 7c13 .dw PFA_DODEFER1 PFA_EMIT: .endif 00758f 000e .dw USER_EMIT 007590 7bdc .dw XT_UDEFERFETCH 007591 7be8 .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: 007592 ff05 .dw $ff05 007593 6d65 007594 7469 007595 003f .db "emit?",0 007596 758a .dw VE_HEAD .set VE_HEAD = VE_EMITQ XT_EMITQ: 007597 7c13 .dw PFA_DODEFER1 PFA_EMITQ: .endif 007598 0010 .dw USER_EMITQ 007599 7bdc .dw XT_UDEFERFETCH 00759a 7be8 .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: 00759b ff03 .dw $ff03 00759c 656b 00759d 0079 .db "key",0 00759e 7592 .dw VE_HEAD .set VE_HEAD = VE_KEY XT_KEY: 00759f 7c13 .dw PFA_DODEFER1 PFA_KEY: .endif 0075a0 0012 .dw USER_KEY 0075a1 7bdc .dw XT_UDEFERFETCH 0075a2 7be8 .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: 0075a3 ff04 .dw $ff04 0075a4 656b 0075a5 3f79 .db "key?" 0075a6 759b .dw VE_HEAD .set VE_HEAD = VE_KEYQ XT_KEYQ: 0075a7 7c13 .dw PFA_DODEFER1 PFA_KEYQ: .endif 0075a8 0014 .dw USER_KEYQ 0075a9 7bdc .dw XT_UDEFERFETCH 0075aa 7be8 .dw XT_UDEFERSTORE .include "words/dp.asm" ; System Value ; address of the next free dictionary cell VE_DP: 0075ab ff02 .dw $ff02 0075ac 7064 .db "dp" 0075ad 75a3 .dw VE_HEAD .set VE_HEAD = VE_DP XT_DP: 0075ae 706f .dw PFA_DOVALUE1 PFA_DP: 0075af 003a .dw CFG_DP 0075b0 7bb4 .dw XT_EDEFERFETCH 0075b1 7bbe .dw XT_EDEFERSTORE .include "words/ehere.asm" ; System Value ; address of the next free address in eeprom VE_EHERE: 0075b2 ff05 .dw $ff05 0075b3 6865 0075b4 7265 0075b5 0065 .db "ehere",0 0075b6 75ab .dw VE_HEAD .set VE_HEAD = VE_EHERE XT_EHERE: 0075b7 706f .dw PFA_DOVALUE1 PFA_EHERE: 0075b8 003e .dw EE_EHERE 0075b9 7bb4 .dw XT_EDEFERFETCH 0075ba 7bbe .dw XT_EDEFERSTORE .include "words/here.asm" ; System Value ; address of the next free data space (RAM) cell VE_HERE: 0075bb ff04 .dw $ff04 0075bc 6568 0075bd 6572 .db "here" 0075be 75b2 .dw VE_HEAD .set VE_HEAD = VE_HERE XT_HERE: 0075bf 706f .dw PFA_DOVALUE1 PFA_HERE: 0075c0 003c .dw EE_HERE 0075c1 7bb4 .dw XT_EDEFERFETCH 0075c2 7bbe .dw XT_EDEFERSTORE .include "words/allot.asm" ; System ; allocate or release memory in RAM VE_ALLOT: 0075c3 ff05 .dw $ff05 0075c4 6c61 0075c5 6f6c 0075c6 0074 .db "allot",0 0075c7 75bb .dw VE_HEAD .set VE_HEAD = VE_ALLOT XT_ALLOT: 0075c8 7001 .dw DO_COLON PFA_ALLOT: 0075c9 75bf .dw XT_HERE 0075ca 719d .dw XT_PLUS 0075cb 7b99 .dw XT_DOTO 0075cc 75c0 .dw PFA_HERE 0075cd 7020 .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: 0075ce ff03 .dw $ff03 0075cf 6962 0075d0 006e .db "bin",0 0075d1 75c3 .dw VE_HEAD .set VE_HEAD = VE_BIN XT_BIN: 0075d2 7001 .dw DO_COLON PFA_BIN: .endif 0075d3 7d8b .dw XT_TWO 0075d4 7551 .dw XT_BASE 0075d5 7081 .dw XT_STORE 0075d6 7020 .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: 0075d7 ff07 .dw $ff07 0075d8 6564 0075d9 6963 0075da 616d 0075db 006c .db "decimal",0 0075dc 75ce .dw VE_HEAD .set VE_HEAD = VE_DECIMAL XT_DECIMAL: 0075dd 7001 .dw DO_COLON PFA_DECIMAL: .endif 0075de 703d .dw XT_DOLITERAL 0075df 000a .dw 10 0075e0 7551 .dw XT_BASE 0075e1 7081 .dw XT_STORE 0075e2 7020 .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: 0075e3 ff03 .dw $ff03 0075e4 6568 0075e5 0078 .db "hex",0 0075e6 75d7 .dw VE_HEAD .set VE_HEAD = VE_HEX XT_HEX: 0075e7 7001 .dw DO_COLON PFA_HEX: .endif 0075e8 703d .dw XT_DOLITERAL 0075e9 0010 .dw 16 0075ea 7551 .dw XT_BASE 0075eb 7081 .dw XT_STORE 0075ec 7020 .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: 0075ed ff02 .dw $ff02 0075ee 6c62 .db "bl" 0075ef 75e3 .dw VE_HEAD .set VE_HEAD = VE_BL XT_BL: 0075f0 7048 .dw PFA_DOVARIABLE PFA_BL: .endif 0075f1 0020 .dw 32 .include "words/turnkey.asm" ; System Value ; Deferred action during startup/reset VE_TURNKEY: 0075f2 ff07 .dw $ff07 0075f3 7574 0075f4 6e72 0075f5 656b 0075f6 0079 .db "turnkey",0 0075f7 75ed .dw VE_HEAD .set VE_HEAD = VE_TURNKEY XT_TURNKEY: 0075f8 7c13 .dw PFA_DODEFER1 PFA_TURNKEY: 0075f9 0046 .dw CFG_TURNKEY 0075fa 7bb4 .dw XT_EDEFERFETCH 0075fb 7bbe .dw XT_EDEFERSTORE ;;;;;;;;;;;;;;;;;;;;;;;;;;;; .include "words/slashmod.asm" ; Arithmetics ; signed division n1/n2 with remainder and quotient VE_SLASHMOD: 0075fc ff04 .dw $ff04 0075fd 6d2f 0075fe 646f .db "/mod" 0075ff 75f2 .dw VE_HEAD .set VE_HEAD = VE_SLASHMOD XT_SLASHMOD: 007600 7601 .dw PFA_SLASHMOD PFA_SLASHMOD: 007601 019c movw temp2, tosl 007602 9109 ld temp0, Y+ 007603 9119 ld temp1, Y+ 007604 2f41 mov temp6,temp1 ;move dividend High to sign register 007605 2743 eor temp6,temp3 ;xor divisor High with sign register 007606 ff17 sbrs temp1,7 ;if MSB in dividend set 007607 c004 rjmp PFA_SLASHMOD_1 007608 9510 com temp1 ; change sign of dividend 007609 9500 com temp0 00760a 5f0f subi temp0,low(-1) 00760b 4f1f sbci temp1,high(-1) PFA_SLASHMOD_1: 00760c ff37 sbrs temp3,7 ;if MSB in divisor set 00760d c004 rjmp PFA_SLASHMOD_2 00760e 9530 com temp3 ; change sign of divisor 00760f 9520 com temp2 007610 5f2f subi temp2,low(-1) 007611 4f3f sbci temp3,high(-1) 007612 24ee PFA_SLASHMOD_2: clr temp4 ;clear remainder Low byte 007613 18ff sub temp5,temp5;clear remainder High byte and carry 007614 e151 ldi temp7,17 ;init loop counter 007615 1f00 PFA_SLASHMOD_3: rol temp0 ;shift left dividend 007616 1f11 rol temp1 007617 955a dec temp7 ;decrement counter 007618 f439 brne PFA_SLASHMOD_5 ;if done 007619 ff47 sbrs temp6,7 ; if MSB in sign register set 00761a c004 rjmp PFA_SLASHMOD_4 00761b 9510 com temp1 ; change sign of result 00761c 9500 com temp0 00761d 5f0f subi temp0,low(-1) 00761e 4f1f sbci temp1,high(-1) 00761f c00b PFA_SLASHMOD_4: rjmp PFA_SLASHMODmod_done ; return 007620 1cee PFA_SLASHMOD_5: rol temp4 ;shift dividend into remainder 007621 1cff rol temp5 007622 1ae2 sub temp4,temp2 ;remainder = remainder - divisor 007623 0af3 sbc temp5,temp3 ; 007624 f420 brcc PFA_SLASHMOD_6 ;if result negative 007625 0ee2 add temp4,temp2 ; restore remainder 007626 1ef3 adc temp5,temp3 007627 9488 clc ; clear carry to be shifted into result 007628 cfec rjmp PFA_SLASHMOD_3 ;else 007629 9408 PFA_SLASHMOD_6: sec ; set carry to be shifted into result 00762a cfea rjmp PFA_SLASHMOD_3 PFA_SLASHMODmod_done: ; put remainder on stack 00762b 92fa st -Y,temp5 00762c 92ea st -Y,temp4 ; put quotient on stack 00762d 01c8 movw tosl, temp0 00762e c9d6 jmp_ DO_NEXT .include "words/uslashmod.asm" ; Arithmetics ; unsigned division with remainder VE_USLASHMOD: 00762f ff05 .dw $ff05 007630 2f75 007631 6f6d 007632 0064 .db "u/mod",0 007633 75fc .dw VE_HEAD .set VE_HEAD = VE_USLASHMOD XT_USLASHMOD: 007634 7001 .dw DO_COLON PFA_USLASHMOD: 007635 70ff .dw XT_TO_R 007636 7154 .dw XT_ZERO 007637 70f6 .dw XT_R_FROM 007638 71c2 .dw XT_UMSLASHMOD 007639 7020 .dw XT_EXIT .include "words/negate.asm" ; Logic ; 2-complement VE_NEGATE: 00763a ff06 .dw $ff06 00763b 656e 00763c 6167 00763d 6574 .db "negate" 00763e 762f .dw VE_HEAD .set VE_HEAD = VE_NEGATE XT_NEGATE: 00763f 7001 .dw DO_COLON PFA_NEGATE: 007640 71fd .dw XT_INVERT 007641 722f .dw XT_1PLUS 007642 7020 .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: 007643 ff01 .dw $ff01 007644 002f .db "/",0 007645 763a .dw VE_HEAD .set VE_HEAD = VE_SLASH XT_SLASH: 007646 7001 .dw DO_COLON PFA_SLASH: .endif 007647 7600 .dw XT_SLASHMOD 007648 70f0 .dw XT_NIP 007649 7020 .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: 00764a ff03 .dw $ff03 00764b 6f6d 00764c 0064 .db "mod",0 00764d 7643 .dw VE_HEAD .set VE_HEAD = VE_MOD XT_MOD: 00764e 7001 .dw DO_COLON PFA_MOD: .endif 00764f 7600 .dw XT_SLASHMOD 007650 70d9 .dw XT_DROP 007651 7020 .dw XT_EXIT .include "words/abs.asm" ; DUP ?NEGATE ; .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_ABS: 007652 ff03 .dw $ff03 007653 6261 007654 0073 .db "abs",0 007655 764a .dw VE_HEAD .set VE_HEAD = VE_ABS XT_ABS: 007656 7001 .dw DO_COLON PFA_ABS: .endif 007657 70b1 007658 723e 007659 7020 .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: 00765a ff03 .dw $ff03 00765b 696d 00765c 006e .db "min",0 00765d 7652 .dw VE_HEAD .set VE_HEAD = VE_MIN XT_MIN: 00765e 7001 .dw DO_COLON PFA_MIN: .endif 00765f 7565 .dw XT_2DUP 007660 7178 .dw XT_GREATER 007661 7036 .dw XT_DOCONDBRANCH 007662 7664 DEST(PFA_MIN1) 007663 70c4 .dw XT_SWAP PFA_MIN1: 007664 70d9 .dw XT_DROP 007665 7020 .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: 007666 ff03 .dw $ff03 007667 616d 007668 0078 .db "max",0 007669 765a .dw VE_HEAD .set VE_HEAD = VE_MAX XT_MAX: 00766a 7001 .dw DO_COLON PFA_MAX: .endif 00766b 7565 .dw XT_2DUP 00766c 716e .dw XT_LESS 00766d 7036 .dw XT_DOCONDBRANCH 00766e 7670 DEST(PFA_MAX1) 00766f 70c4 .dw XT_SWAP PFA_MAX1: 007670 70d9 .dw XT_DROP 007671 7020 .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: 007672 ff06 .dw $ff06 007673 6977 007674 6874 007675 6e69 .db "within" 007676 7666 .dw VE_HEAD .set VE_HEAD = VE_WITHIN XT_WITHIN: 007677 7001 .dw DO_COLON PFA_WITHIN: .endif 007678 70cf .dw XT_OVER 007679 7193 .dw XT_MINUS 00767a 70ff .dw XT_TO_R 00767b 7193 .dw XT_MINUS 00767c 70f6 .dw XT_R_FROM 00767d 715c .dw XT_ULESS 00767e 7020 .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: 00767f ff07 .dw $ff07 007680 6f74 007681 7075 007682 6570 007683 0072 .db "toupper",0 007684 7672 .dw VE_HEAD .set VE_HEAD = VE_TOUPPER XT_TOUPPER: 007685 7001 .dw DO_COLON PFA_TOUPPER: .endif 007686 70b1 .dw XT_DUP 007687 703d .dw XT_DOLITERAL 007688 0061 .dw 'a' 007689 703d .dw XT_DOLITERAL 00768a 007b .dw 'z'+1 00768b 7677 .dw XT_WITHIN 00768c 7036 .dw XT_DOCONDBRANCH 00768d 7691 DEST(PFA_TOUPPER0) 00768e 703d .dw XT_DOLITERAL 00768f 00df .dw 223 ; inverse of 0x20: 0xdf 007690 7213 .dw XT_AND PFA_TOUPPER0: 007691 7020 .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: 007692 ff07 .dw $ff07 007693 6f74 007694 6f6c 007695 6577 007696 0072 .db "tolower",0 007697 767f .dw VE_HEAD .set VE_HEAD = VE_TOLOWER XT_TOLOWER: 007698 7001 .dw DO_COLON PFA_TOLOWER: .endif 007699 70b1 .dw XT_DUP 00769a 703d .dw XT_DOLITERAL 00769b 0041 .dw 'A' 00769c 703d .dw XT_DOLITERAL 00769d 005b .dw 'Z'+1 00769e 7677 .dw XT_WITHIN 00769f 7036 .dw XT_DOCONDBRANCH 0076a0 76a4 DEST(PFA_TOLOWER0) 0076a1 703d .dw XT_DOLITERAL 0076a2 0020 .dw 32 0076a3 721c .dw XT_OR PFA_TOLOWER0: 0076a4 7020 .dw XT_EXIT ;;;;;;;;;;;;;;;;;;;;;; .include "words/hld.asm" ; Numeric IO ; pointer to current write position in the Pictured Numeric Output buffer VE_HLD: 0076a5 ff03 .dw $ff03 0076a6 6c68 0076a7 0064 .db "hld",0 0076a8 7692 .dw VE_HEAD .set VE_HEAD = VE_HLD XT_HLD: 0076a9 7048 .dw PFA_DOVARIABLE PFA_HLD: 0076aa 0138 .dw ram_hld .dseg 000138 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: 0076ab ff04 .dw $ff04 0076ac 6f68 0076ad 646c .db "hold" 0076ae 76a5 .dw VE_HEAD .set VE_HEAD = VE_HOLD XT_HOLD: 0076af 7001 .dw DO_COLON PFA_HOLD: .endif 0076b0 76a9 .dw XT_HLD 0076b1 70b1 .dw XT_DUP 0076b2 7079 .dw XT_FETCH 0076b3 7235 .dw XT_1MINUS 0076b4 70b1 .dw XT_DUP 0076b5 70ff .dw XT_TO_R 0076b6 70c4 .dw XT_SWAP 0076b7 7081 .dw XT_STORE 0076b8 70f6 .dw XT_R_FROM 0076b9 708d .dw XT_CSTORE 0076ba 7020 .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: 0076bb ff02 .dw $ff02 0076bc 233c .db "<#" 0076bd 76ab .dw VE_HEAD .set VE_HEAD = VE_L_SHARP XT_L_SHARP: 0076be 7001 .dw DO_COLON PFA_L_SHARP: .endif 0076bf 7584 .dw XT_PAD 0076c0 76a9 .dw XT_HLD 0076c1 7081 .dw XT_STORE 0076c2 7020 .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: 0076c3 ff01 .dw $ff01 0076c4 0023 .db "#",0 0076c5 76bb .dw VE_HEAD .set VE_HEAD = VE_SHARP XT_SHARP: 0076c6 7001 .dw DO_COLON PFA_SHARP: .endif 0076c7 7551 .dw XT_BASE 0076c8 7079 .dw XT_FETCH 0076c9 7743 .dw XT_UDSLASHMOD 0076ca 70e1 .dw XT_ROT 0076cb 703d .dw XT_DOLITERAL 0076cc 0009 .dw 9 0076cd 70cf .dw XT_OVER 0076ce 716e .dw XT_LESS 0076cf 7036 .dw XT_DOCONDBRANCH 0076d0 76d4 DEST(PFA_SHARP1) 0076d1 703d .dw XT_DOLITERAL 0076d2 0007 .dw 7 0076d3 719d .dw XT_PLUS PFA_SHARP1: 0076d4 703d .dw XT_DOLITERAL 0076d5 0030 .dw 48 ; ASCII 0 0076d6 719d .dw XT_PLUS 0076d7 76af .dw XT_HOLD 0076d8 7020 .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: 0076d9 ff02 .dw $ff02 0076da 7323 .db "#s" 0076db 76c3 .dw VE_HEAD .set VE_HEAD = VE_SHARP_S XT_SHARP_S: 0076dc 7001 .dw DO_COLON PFA_SHARP_S: .endif NUMS1: 0076dd 76c6 .dw XT_SHARP 0076de 7565 .dw XT_2DUP 0076df 721c .dw XT_OR 0076e0 711a .dw XT_ZEROEQUAL 0076e1 7036 .dw XT_DOCONDBRANCH 0076e2 76dd DEST(NUMS1) ; PFA_SHARP_S 0076e3 7020 .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: 0076e4 ff02 .dw $ff02 0076e5 3e23 .db "#>" 0076e6 76d9 .dw VE_HEAD .set VE_HEAD = VE_SHARP_G XT_SHARP_G: 0076e7 7001 .dw DO_COLON PFA_SHARP_G: .endif 0076e8 756e .dw XT_2DROP 0076e9 76a9 .dw XT_HLD 0076ea 7079 .dw XT_FETCH 0076eb 7584 .dw XT_PAD 0076ec 70cf .dw XT_OVER 0076ed 7193 .dw XT_MINUS 0076ee 7020 .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: 0076ef ff04 .dw $ff04 0076f0 6973 0076f1 6e67 .db "sign" 0076f2 76e4 .dw VE_HEAD .set VE_HEAD = VE_SIGN XT_SIGN: 0076f3 7001 .dw DO_COLON PFA_SIGN: .endif 0076f4 7121 .dw XT_ZEROLESS 0076f5 7036 .dw XT_DOCONDBRANCH 0076f6 76fa DEST(PFA_SIGN1) 0076f7 703d .dw XT_DOLITERAL 0076f8 002d .dw 45 ; ascii - 0076f9 76af .dw XT_HOLD PFA_SIGN1: 0076fa 7020 .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: 0076fb ff03 .dw $ff03 0076fc 2e64 0076fd 0072 .db "d.r",0 0076fe 76ef .dw VE_HEAD .set VE_HEAD = VE_DDOTR XT_DDOTR: 0076ff 7001 .dw DO_COLON PFA_DDOTR: .endif 007700 70ff .dw XT_TO_R 007701 7576 .dw XT_TUCK 007702 7cd4 .dw XT_DABS 007703 76be .dw XT_L_SHARP 007704 76dc .dw XT_SHARP_S 007705 70e1 .dw XT_ROT 007706 76f3 .dw XT_SIGN 007707 76e7 .dw XT_SHARP_G 007708 70f6 .dw XT_R_FROM 007709 70cf .dw XT_OVER 00770a 7193 .dw XT_MINUS 00770b 77eb .dw XT_SPACES 00770c 77fb .dw XT_TYPE 00770d 7020 .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: 00770e ff02 .dw $ff02 00770f 722e .db ".r" 007710 76fb .dw VE_HEAD .set VE_HEAD = VE_DOTR XT_DOTR: 007711 7001 .dw DO_COLON PFA_DOTR: .endif 007712 70ff .dw XT_TO_R 007713 7d67 .dw XT_S2D 007714 70f6 .dw XT_R_FROM 007715 76ff .dw XT_DDOTR 007716 7020 .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: 007717 ff02 .dw $ff02 007718 2e64 .db "d." 007719 770e .dw VE_HEAD .set VE_HEAD = VE_DDOT XT_DDOT: 00771a 7001 .dw DO_COLON PFA_DDOT: .endif 00771b 7154 .dw XT_ZERO 00771c 76ff .dw XT_DDOTR 00771d 77e2 .dw XT_SPACE 00771e 7020 .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: 00771f ff01 .dw $ff01 007720 002e .db ".",0 007721 7717 .dw VE_HEAD .set VE_HEAD = VE_DOT XT_DOT: 007722 7001 .dw DO_COLON PFA_DOT: .endif 007723 7d67 .dw XT_S2D 007724 771a .dw XT_DDOT 007725 7020 .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: 007726 ff03 .dw $ff03 007727 6475 007728 002e .db "ud.",0 007729 771f .dw VE_HEAD .set VE_HEAD = VE_UDDOT XT_UDDOT: 00772a 7001 .dw DO_COLON PFA_UDDOT: .endif 00772b 7154 .dw XT_ZERO 00772c 7733 .dw XT_UDDOTR 00772d 77e2 .dw XT_SPACE 00772e 7020 .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: 00772f ff04 .dw $ff04 007730 6475 007731 722e .db "ud.r" 007732 7726 .dw VE_HEAD .set VE_HEAD = VE_UDDOTR XT_UDDOTR: 007733 7001 .dw DO_COLON PFA_UDDOTR: .endif 007734 70ff .dw XT_TO_R 007735 76be .dw XT_L_SHARP 007736 76dc .dw XT_SHARP_S 007737 76e7 .dw XT_SHARP_G 007738 70f6 .dw XT_R_FROM 007739 70cf .dw XT_OVER 00773a 7193 .dw XT_MINUS 00773b 77eb .dw XT_SPACES 00773c 77fb .dw XT_TYPE 00773d 7020 .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: 00773e ff06 .dw $ff06 00773f 6475 007740 6d2f 007741 646f .db "ud/mod" 007742 772f .dw VE_HEAD .set VE_HEAD = VE_UDSLASHMOD XT_UDSLASHMOD: 007743 7001 .dw DO_COLON PFA_UDSLASHMOD: .endif 007744 70ff .dw XT_TO_R 007745 7154 .dw XT_ZERO 007746 7108 .dw XT_R_FETCH 007747 71c2 .dw XT_UMSLASHMOD 007748 70f6 .dw XT_R_FROM 007749 70c4 .dw XT_SWAP 00774a 70ff .dw XT_TO_R 00774b 71c2 .dw XT_UMSLASHMOD 00774c 70f6 .dw XT_R_FROM 00774d 7020 .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: 00774e ff06 .dw $ff06 00774f 6964 007750 6967 007751 3f74 .db "digit?" 007752 773e .dw VE_HEAD .set VE_HEAD = VE_DIGITQ XT_DIGITQ: 007753 7001 .dw DO_COLON PFA_DIGITQ: .endif 007754 7685 .dw XT_TOUPPER 007755 70b1 007756 703d 007757 0039 007758 7178 007759 703d 00775a 0100 .DW XT_DUP,XT_DOLITERAL,57,XT_GREATER,XT_DOLITERAL,256 00775b 7213 00775c 719d 00775d 70b1 00775e 703d 00775f 0140 007760 7178 .DW XT_AND,XT_PLUS,XT_DUP,XT_DOLITERAL,320,XT_GREATER 007761 703d 007762 0107 007763 7213 007764 7193 007765 703d 007766 0030 .DW XT_DOLITERAL,263,XT_AND,XT_MINUS,XT_DOLITERAL,48 007767 7193 007768 70b1 007769 7551 00776a 7079 00776b 715c .DW XT_MINUS,XT_DUP,XT_BASE,XT_FETCH,XT_ULESS 00776c 7020 .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: 00776d 7001 .dw DO_COLON PFA_DOSLITERAL: 00776e 7108 .dw XT_R_FETCH ; ( -- addr ) 00776f 77cc .dw XT_ICOUNT 007770 70f6 .dw XT_R_FROM 007771 70cf .dw XT_OVER ; ( -- addr' n addr n) 007772 722f .dw XT_1PLUS 007773 7204 .dw XT_2SLASH ; ( -- addr' n addr k ) 007774 719d .dw XT_PLUS ; ( -- addr' n addr'' ) 007775 722f .dw XT_1PLUS 007776 70ff .dw XT_TO_R ; ( -- ) 007777 7020 .dw XT_EXIT .include "words/scomma.asm" ; Compiler ; compiles a string from RAM to Flash VE_SCOMMA: 007778 ff02 .dw $ff02 007779 2c73 .db "s",$2c 00777a 774e .dw VE_HEAD .set VE_HEAD = VE_SCOMMA XT_SCOMMA: 00777b 7001 .dw DO_COLON PFA_SCOMMA: 00777c 70b1 .dw XT_DUP 00777d 777f .dw XT_DOSCOMMA 00777e 7020 .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: 00777f 7001 .dw DO_COLON PFA_DOSCOMMA: 007780 01cc .dw XT_COMMA 007781 70b1 .dw XT_DUP ; ( --addr len len) 007782 7204 .dw XT_2SLASH ; ( -- addr len len/2 007783 7576 .dw XT_TUCK ; ( -- addr len/2 len len/2 007784 720b .dw XT_2STAR ; ( -- addr len/2 len len' 007785 7193 .dw XT_MINUS ; ( -- addr len/2 rem 007786 70ff .dw XT_TO_R 007787 7154 .dw XT_ZERO 007788 028b .dw XT_QDOCHECK 007789 7036 .dw XT_DOCONDBRANCH 00778a 7792 .dw PFA_SCOMMA2 00778b 729b .dw XT_DODO PFA_SCOMMA1: 00778c 70b1 .dw XT_DUP ; ( -- addr addr ) 00778d 7079 .dw XT_FETCH ; ( -- addr c1c2 ) 00778e 01cc .dw XT_COMMA ; ( -- addr ) 00778f 755e .dw XT_CELLPLUS ; ( -- addr+cell ) 007790 72c9 .dw XT_DOLOOP 007791 778c .dw PFA_SCOMMA1 PFA_SCOMMA2: 007792 70f6 .dw XT_R_FROM 007793 7128 .dw XT_GREATERZERO 007794 7036 .dw XT_DOCONDBRANCH 007795 7799 .dw PFA_SCOMMA3 007796 70b1 .dw XT_DUP ; well, tricky 007797 7098 .dw XT_CFETCH 007798 01cc .dw XT_COMMA PFA_SCOMMA3: 007799 70d9 .dw XT_DROP ; ( -- ) 00779a 7020 .dw XT_EXIT .include "words/itype.asm" ; Tools ; reads string from flash and prints it VE_ITYPE: 00779b ff05 .dw $ff05 00779c 7469 00779d 7079 00779e 0065 .db "itype",0 00779f 7778 .dw VE_HEAD .set VE_HEAD = VE_ITYPE XT_ITYPE: 0077a0 7001 .dw DO_COLON PFA_ITYPE: 0077a1 70b1 .dw XT_DUP ; ( --addr len len) 0077a2 7204 .dw XT_2SLASH ; ( -- addr len len/2 0077a3 7576 .dw XT_TUCK ; ( -- addr len/2 len len/2 0077a4 720b .dw XT_2STAR ; ( -- addr len/2 len len' 0077a5 7193 .dw XT_MINUS ; ( -- addr len/2 rem 0077a6 70ff .dw XT_TO_R 0077a7 7154 .dw XT_ZERO 0077a8 028b .dw XT_QDOCHECK 0077a9 7036 .dw XT_DOCONDBRANCH 0077aa 77b4 .dw PFA_ITYPE2 0077ab 729b .dw XT_DODO PFA_ITYPE1: 0077ac 70b1 .dw XT_DUP ; ( -- addr addr ) 0077ad 73cb .dw XT_FETCHI ; ( -- addr c1c2 ) 0077ae 70b1 .dw XT_DUP 0077af 77c1 .dw XT_LOWEMIT 0077b0 77bd .dw XT_HIEMIT 0077b1 722f .dw XT_1PLUS ; ( -- addr+cell ) 0077b2 72c9 .dw XT_DOLOOP 0077b3 77ac .dw PFA_ITYPE1 PFA_ITYPE2: 0077b4 70f6 .dw XT_R_FROM 0077b5 7128 .dw XT_GREATERZERO 0077b6 7036 .dw XT_DOCONDBRANCH 0077b7 77bb .dw PFA_ITYPE3 0077b8 70b1 .dw XT_DUP ; make sure the drop below has always something to do 0077b9 73cb .dw XT_FETCHI 0077ba 77c1 .dw XT_LOWEMIT PFA_ITYPE3: 0077bb 70d9 .dw XT_DROP 0077bc 7020 .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: 0077bd 7001 .dw DO_COLON PFA_HIEMIT: 0077be 72f9 .dw XT_BYTESWAP 0077bf 77c1 .dw XT_LOWEMIT 0077c0 7020 .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: 0077c1 7001 .dw DO_COLON PFA_LOWEMIT: 0077c2 703d .dw XT_DOLITERAL 0077c3 00ff .dw $00ff 0077c4 7213 .dw XT_AND 0077c5 758e .dw XT_EMIT 0077c6 7020 .dw XT_EXIT .include "words/icount.asm" ; Tools ; get count information out of a counted string in flash VE_ICOUNT: 0077c7 ff06 .dw $ff06 0077c8 6369 0077c9 756f 0077ca 746e .db "icount" 0077cb 779b .dw VE_HEAD .set VE_HEAD = VE_ICOUNT XT_ICOUNT: 0077cc 7001 .dw DO_COLON PFA_ICOUNT: 0077cd 70b1 .dw XT_DUP 0077ce 722f .dw XT_1PLUS 0077cf 70c4 .dw XT_SWAP 0077d0 73cb .dw XT_FETCHI 0077d1 7020 .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: 0077d2 ff02 .dw 0xff02 0077d3 7263 .db "cr" 0077d4 77c7 .dw VE_HEAD .set VE_HEAD = VE_CR XT_CR: 0077d5 7001 .dw DO_COLON PFA_CR: .endif 0077d6 703d .dw XT_DOLITERAL 0077d7 000d .dw 13 0077d8 758e .dw XT_EMIT 0077d9 703d .dw XT_DOLITERAL 0077da 000a .dw 10 0077db 758e .dw XT_EMIT 0077dc 7020 .dw XT_EXIT .include "words/space.asm" ; Character IO ; emits a space (bl) .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_SPACE: 0077dd ff05 .dw $ff05 0077de 7073 0077df 6361 0077e0 0065 .db "space",0 0077e1 77d2 .dw VE_HEAD .set VE_HEAD = VE_SPACE XT_SPACE: 0077e2 7001 .dw DO_COLON PFA_SPACE: .endif 0077e3 75f0 .dw XT_BL 0077e4 758e .dw XT_EMIT 0077e5 7020 .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: 0077e6 ff06 .dw $ff06 0077e7 7073 0077e8 6361 0077e9 7365 .db "spaces" 0077ea 77dd .dw VE_HEAD .set VE_HEAD = VE_SPACES XT_SPACES: 0077eb 7001 .dw DO_COLON PFA_SPACES: .endif ;C SPACES n -- output n spaces ; BEGIN DUP 0> WHILE SPACE 1- REPEAT DROP ; 0077ec 7154 0077ed 766a .DW XT_ZERO, XT_MAX 0077ee 70b1 0077ef 7036 SPCS1: .DW XT_DUP,XT_DOCONDBRANCH 0077f0 77f5 DEST(SPCS2) 0077f1 77e2 0077f2 7235 0077f3 702f .DW XT_SPACE,XT_1MINUS,XT_DOBRANCH 0077f4 77ee DEST(SPCS1) 0077f5 70d9 0077f6 7020 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: 0077f7 ff04 .dw $ff04 0077f8 7974 0077f9 6570 .db "type" 0077fa 77e6 .dw VE_HEAD .set VE_HEAD = VE_TYPE XT_TYPE: 0077fb 7001 .dw DO_COLON PFA_TYPE: .endif 0077fc 7d5e .dw XT_BOUNDS 0077fd 028b .dw XT_QDOCHECK 0077fe 7036 .dw XT_DOCONDBRANCH 0077ff 7806 DEST(PFA_TYPE2) 007800 729b .dw XT_DODO PFA_TYPE1: 007801 72ac .dw XT_I 007802 7098 .dw XT_CFETCH 007803 758e .dw XT_EMIT 007804 72c9 .dw XT_DOLOOP 007805 7801 DEST(PFA_TYPE1) PFA_TYPE2: 007806 7020 .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: 007807 ff01 .dw $ff01 007808 0027 .db "'",0 007809 77f7 .dw VE_HEAD .set VE_HEAD = VE_TICK XT_TICK: 00780a 7001 .dw DO_COLON PFA_TICK: .endif 00780b 79b4 .dw XT_PARSENAME 00780c 7acc .dw XT_FORTHRECOGNIZER 00780d 7ad7 .dw XT_RECOGNIZE ; a word is tickable unless DT:TOKEN is DT:NULL or ; the interpret action is a NOOP 00780e 70b1 .dw XT_DUP 00780f 7b4a .dw XT_DT_NULL 007810 7d7f .dw XT_EQUAL 007811 70c4 .dw XT_SWAP 007812 73cb .dw XT_FETCHI 007813 703d .dw XT_DOLITERAL 007814 7b7f .dw XT_NOOP 007815 7d7f .dw XT_EQUAL 007816 721c .dw XT_OR 007817 7036 .dw XT_DOCONDBRANCH 007818 781c DEST(PFA_TICK1) 007819 703d .dw XT_DOLITERAL 00781a fff3 .dw -13 00781b 7841 .dw XT_THROW PFA_TICK1: 00781c 70d9 .dw XT_DROP 00781d 7020 .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: 00781e ff07 .dw $ff07 00781f 6168 007820 646e 007821 656c 007822 0072 .db "handler",0 007823 7807 .dw VE_HEAD .set VE_HEAD = VE_HANDLER XT_HANDLER: 007824 7058 .dw PFA_DOUSER PFA_HANDLER: .endif 007825 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: 007826 ff05 .dw $ff05 007827 6163 007828 6374 007829 0068 .db "catch",0 00782a 781e .dw VE_HEAD .set VE_HEAD = VE_CATCH XT_CATCH: 00782b 7001 .dw DO_COLON PFA_CATCH: .endif ; sp@ >r 00782c 728d .dw XT_SP_FETCH 00782d 70ff .dw XT_TO_R ; handler @ >r 00782e 7824 .dw XT_HANDLER 00782f 7079 .dw XT_FETCH 007830 70ff .dw XT_TO_R ; rp@ handler ! 007831 7276 .dw XT_RP_FETCH 007832 7824 .dw XT_HANDLER 007833 7081 .dw XT_STORE 007834 702a .dw XT_EXECUTE ; r> handler ! 007835 70f6 .dw XT_R_FROM 007836 7824 .dw XT_HANDLER 007837 7081 .dw XT_STORE 007838 70f6 .dw XT_R_FROM 007839 70d9 .dw XT_DROP 00783a 7154 .dw XT_ZERO 00783b 7020 .dw XT_EXIT .include "words/throw.asm" ; Exceptions ; throw an exception .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_THROW: 00783c ff05 .dw $ff05 00783d 6874 00783e 6f72 00783f 0077 .db "throw",0 007840 7826 .dw VE_HEAD .set VE_HEAD = VE_THROW XT_THROW: 007841 7001 .dw DO_COLON PFA_THROW: .endif 007842 70b1 .dw XT_DUP 007843 711a .dw XT_ZEROEQUAL 007844 7036 .dw XT_DOCONDBRANCH 007845 7848 DEST(PFA_THROW1) 007846 70d9 .dw XT_DROP 007847 7020 .dw XT_EXIT PFA_THROW1: 007848 7824 .dw XT_HANDLER 007849 7079 .dw XT_FETCH 00784a 7280 .dw XT_RP_STORE 00784b 70f6 .dw XT_R_FROM 00784c 7824 .dw XT_HANDLER 00784d 7081 .dw XT_STORE 00784e 70f6 .dw XT_R_FROM 00784f 70c4 .dw XT_SWAP 007850 70ff .dw XT_TO_R 007851 7296 .dw XT_SP_STORE 007852 70d9 .dw XT_DROP 007853 70f6 .dw XT_R_FROM 007854 7020 .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: 007855 ff05 .dw $ff05 007856 7363 007857 696b 007858 0070 .db "cskip",0 007859 783c .dw VE_HEAD .set VE_HEAD = VE_CSKIP XT_CSKIP: 00785a 7001 .dw DO_COLON PFA_CSKIP: .endif 00785b 70ff .dw XT_TO_R ; ( -- addr1 n1 ) PFA_CSKIP1: 00785c 70b1 .dw XT_DUP ; ( -- addr' n' n' ) 00785d 7036 .dw XT_DOCONDBRANCH ; ( -- addr' n') 00785e 7869 DEST(PFA_CSKIP2) 00785f 70cf .dw XT_OVER ; ( -- addr' n' addr' ) 007860 7098 .dw XT_CFETCH ; ( -- addr' n' c' ) 007861 7108 .dw XT_R_FETCH ; ( -- addr' n' c' c ) 007862 7d7f .dw XT_EQUAL ; ( -- addr' n' f ) 007863 7036 .dw XT_DOCONDBRANCH ; ( -- addr' n') 007864 7869 DEST(PFA_CSKIP2) 007865 7d86 .dw XT_ONE 007866 79a5 .dw XT_SLASHSTRING 007867 702f .dw XT_DOBRANCH 007868 785c DEST(PFA_CSKIP1) PFA_CSKIP2: 007869 70f6 .dw XT_R_FROM 00786a 70d9 .dw XT_DROP ; ( -- addr2 n2) 00786b 7020 .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: 00786c ff05 .dw $ff05 00786d 7363 00786e 6163 ../../common\words/cscan.asm(12): warning: .cseg .db misalignment - padding zero byte 00786f 006e .db "cscan" 007870 7855 .dw VE_HEAD .set VE_HEAD = VE_CSCAN XT_CSCAN: 007871 7001 .dw DO_COLON PFA_CSCAN: .endif 007872 70ff .dw XT_TO_R 007873 70cf .dw XT_OVER PFA_CSCAN1: 007874 70b1 .dw XT_DUP 007875 7098 .dw XT_CFETCH 007876 7108 .dw XT_R_FETCH 007877 7d7f .dw XT_EQUAL 007878 711a .dw XT_ZEROEQUAL 007879 7036 .dw XT_DOCONDBRANCH 00787a 7886 DEST(PFA_CSCAN2) 00787b 70c4 .dw XT_SWAP 00787c 7235 .dw XT_1MINUS 00787d 70c4 .dw XT_SWAP 00787e 70cf .dw XT_OVER 00787f 7121 .dw XT_ZEROLESS ; not negative 007880 711a .dw XT_ZEROEQUAL 007881 7036 .dw XT_DOCONDBRANCH 007882 7886 DEST(PFA_CSCAN2) 007883 722f .dw XT_1PLUS 007884 702f .dw XT_DOBRANCH 007885 7874 DEST(PFA_CSCAN1) PFA_CSCAN2: 007886 70f0 .dw XT_NIP 007887 70cf .dw XT_OVER 007888 7193 .dw XT_MINUS 007889 70f6 .dw XT_R_FROM 00788a 70d9 .dw XT_DROP 00788b 7020 .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: 00788c ff06 .dw $ff06 00788d 6361 00788e 6563 00788f 7470 .db "accept" 007890 786c .dw VE_HEAD .set VE_HEAD = VE_ACCEPT XT_ACCEPT: 007891 7001 .dw DO_COLON PFA_ACCEPT: .endif 007892 70cf 007893 719d 007894 7235 007895 70cf .DW XT_OVER,XT_PLUS,XT_1MINUS,XT_OVER 007896 759f 007897 70b1 007898 78d2 007899 711a 00789a 7036 ACC1: .DW XT_KEY,XT_DUP,XT_CRLFQ,XT_ZEROEQUAL,XT_DOCONDBRANCH 00789b 78c4 DEST(ACC5) 00789c 70b1 00789d 703d 00789e 0008 00789f 7d7f 0078a0 7036 .DW XT_DUP,XT_DOLITERAL,8,XT_EQUAL,XT_DOCONDBRANCH 0078a1 78b4 DEST(ACC3) 0078a2 70d9 0078a3 70e1 0078a4 7565 0078a5 7178 0078a6 70ff 0078a7 70e1 0078a8 70e1 0078a9 70f6 0078aa 7036 .DW XT_DROP,XT_ROT,XT_2DUP,XT_GREATER,XT_TO_R,XT_ROT,XT_ROT,XT_R_FROM,XT_DOCONDBRANCH 0078ab 78b2 DEST(ACC6) 0078ac 78ca 0078ad 7235 0078ae 70ff 0078af 70cf 0078b0 70f6 0078b1 015e .DW XT_BS,XT_1MINUS,XT_TO_R,XT_OVER,XT_R_FROM,XT_UMAX 0078b2 702f ACC6: .DW XT_DOBRANCH 0078b3 78c2 DEST(ACC4) ACC3: ; check for remaining control characters, replace them with blank 0078b4 70b1 .dw XT_DUP ; ( -- addr k k ) 0078b5 75f0 .dw XT_BL 0078b6 716e .dw XT_LESS 0078b7 7036 .dw XT_DOCONDBRANCH 0078b8 78bb DEST(PFA_ACCEPT6) 0078b9 70d9 .dw XT_DROP 0078ba 75f0 .dw XT_BL PFA_ACCEPT6: 0078bb 70b1 0078bc 758e 0078bd 70cf 0078be 708d 0078bf 722f 0078c0 70cf 0078c1 016a .DW XT_DUP,XT_EMIT,XT_OVER,XT_CSTORE,XT_1PLUS,XT_OVER,XT_UMIN 0078c2 702f ACC4: .DW XT_DOBRANCH 0078c3 7896 DEST(ACC1) 0078c4 70d9 0078c5 70f0 0078c6 70c4 0078c7 7193 0078c8 77d5 0078c9 7020 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: 0078ca 7001 .dw DO_COLON .endif 0078cb 703d .dw XT_DOLITERAL 0078cc 0008 .dw 8 0078cd 70b1 .dw XT_DUP 0078ce 758e .dw XT_EMIT 0078cf 77e2 .dw XT_SPACE 0078d0 758e .dw XT_EMIT 0078d1 7020 .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: 0078d2 7001 .dw DO_COLON .endif 0078d3 70b1 .dw XT_DUP 0078d4 703d .dw XT_DOLITERAL 0078d5 000d .dw 13 0078d6 7d7f .dw XT_EQUAL 0078d7 70c4 .dw XT_SWAP 0078d8 703d .dw XT_DOLITERAL 0078d9 000a .dw 10 0078da 7d7f .dw XT_EQUAL 0078db 721c .dw XT_OR 0078dc 7020 .dw XT_EXIT .include "words/refill.asm" ; System ; refills the input buffer .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_REFILL: 0078dd ff06 .dw $ff06 0078de 6572 0078df 6966 0078e0 6c6c .db "refill" 0078e1 788c .dw VE_HEAD .set VE_HEAD = VE_REFILL XT_REFILL: 0078e2 7c13 .dw PFA_DODEFER1 PFA_REFILL: .endif 0078e3 001a .dw USER_REFILL 0078e4 7bdc .dw XT_UDEFERFETCH 0078e5 7be8 .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: 0078e6 ff04 .dw $ff04 0078e7 6863 0078e8 7261 .db "char" 0078e9 78dd .dw VE_HEAD .set VE_HEAD = VE_CHAR XT_CHAR: 0078ea 7001 .dw DO_COLON PFA_CHAR: .endif 0078eb 79b4 .dw XT_PARSENAME 0078ec 70d9 .dw XT_DROP 0078ed 7098 .dw XT_CFETCH 0078ee 7020 .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: 0078ef ff06 .dw $ff06 0078f0 756e 0078f1 626d 0078f2 7265 .db "number" 0078f3 78e6 .dw VE_HEAD .set VE_HEAD = VE_NUMBER XT_NUMBER: 0078f4 7001 .dw DO_COLON PFA_NUMBER: .endif 0078f5 7551 .dw XT_BASE 0078f6 7079 .dw XT_FETCH 0078f7 70ff .dw XT_TO_R 0078f8 7938 .dw XT_QSIGN 0078f9 70ff .dw XT_TO_R 0078fa 794b .dw XT_SET_BASE 0078fb 7938 .dw XT_QSIGN 0078fc 70f6 .dw XT_R_FROM 0078fd 721c .dw XT_OR 0078fe 70ff .dw XT_TO_R ; check whether something is left 0078ff 70b1 .dw XT_DUP 007900 711a .dw XT_ZEROEQUAL 007901 7036 .dw XT_DOCONDBRANCH 007902 790b DEST(PFA_NUMBER0) ; nothing is left. It cannot be a number at all 007903 756e .dw XT_2DROP 007904 70f6 .dw XT_R_FROM 007905 70d9 .dw XT_DROP 007906 70f6 .dw XT_R_FROM 007907 7551 .dw XT_BASE 007908 7081 .dw XT_STORE 007909 7154 .dw XT_ZERO 00790a 7020 .dw XT_EXIT PFA_NUMBER0: 00790b 731e .dw XT_2TO_R 00790c 7154 .dw XT_ZERO ; starting value 00790d 7154 .dw XT_ZERO 00790e 732d .dw XT_2R_FROM 00790f 7969 .dw XT_TO_NUMBER ; ( 0. addr len -- d addr' len' ; check length of the remaining string. ; if zero: a single cell number is entered 007910 70b9 .dw XT_QDUP 007911 7036 .dw XT_DOCONDBRANCH 007912 792d DEST(PFA_NUMBER1) ; if equal 1: mayba a trailing dot? --> double cell number 007913 7d86 .dw XT_ONE 007914 7d7f .dw XT_EQUAL 007915 7036 .dw XT_DOCONDBRANCH 007916 7924 DEST(PFA_NUMBER2) ; excatly one character is left 007917 7098 .dw XT_CFETCH 007918 703d .dw XT_DOLITERAL 007919 002e .dw 46 ; . 00791a 7d7f .dw XT_EQUAL 00791b 7036 .dw XT_DOCONDBRANCH 00791c 7925 DEST(PFA_NUMBER6) ; its a double cell number ; incorporate sign into number 00791d 70f6 .dw XT_R_FROM 00791e 7036 .dw XT_DOCONDBRANCH 00791f 7921 DEST(PFA_NUMBER3) 007920 7ce1 .dw XT_DNEGATE PFA_NUMBER3: 007921 7d8b .dw XT_TWO 007922 702f .dw XT_DOBRANCH 007923 7933 DEST(PFA_NUMBER5) PFA_NUMBER2: 007924 70d9 .dw XT_DROP PFA_NUMBER6: 007925 756e .dw XT_2DROP 007926 70f6 .dw XT_R_FROM 007927 70d9 .dw XT_DROP 007928 70f6 .dw XT_R_FROM 007929 7551 .dw XT_BASE 00792a 7081 .dw XT_STORE 00792b 7154 .dw XT_ZERO 00792c 7020 .dw XT_EXIT PFA_NUMBER1: 00792d 756e .dw XT_2DROP ; remove the address ; incorporate sign into number 00792e 70f6 .dw XT_R_FROM 00792f 7036 .dw XT_DOCONDBRANCH 007930 7932 DEST(PFA_NUMBER4) 007931 763f .dw XT_NEGATE PFA_NUMBER4: 007932 7d86 .dw XT_ONE PFA_NUMBER5: 007933 70f6 .dw XT_R_FROM 007934 7551 .dw XT_BASE 007935 7081 .dw XT_STORE 007936 714b .dw XT_TRUE 007937 7020 .dw XT_EXIT .include "words/q-sign.asm" .if cpu_msp430==1 .endif .if cpu_avr8==1 XT_QSIGN: 007938 7001 .dw DO_COLON PFA_QSIGN: ; ( c -- ) .endif 007939 70cf .dw XT_OVER ; ( -- addr len addr ) 00793a 7098 .dw XT_CFETCH 00793b 703d .dw XT_DOLITERAL 00793c 002d .dw '-' 00793d 7d7f .dw XT_EQUAL ; ( -- addr len flag ) 00793e 70b1 .dw XT_DUP 00793f 70ff .dw XT_TO_R 007940 7036 .dw XT_DOCONDBRANCH 007941 7944 DEST(PFA_NUMBERSIGN_DONE) 007942 7d86 .dw XT_ONE ; skip sign character 007943 79a5 .dw XT_SLASHSTRING PFA_NUMBERSIGN_DONE: 007944 70f6 .dw XT_R_FROM 007945 7020 .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: 007946 7052 .dw PFA_DOCONSTANT .endif 007947 000a 007948 0010 007949 0002 00794a 000a .dw 10,16,2,10 ; last one could a 8 instead. .if cpu_msp430==1 .endif .if cpu_avr8==1 XT_SET_BASE: 00794b 7001 .dw DO_COLON PFA_SET_BASE: ; ( adr1 len1 -- adr2 len2 ) .endif 00794c 70cf .dw XT_OVER 00794d 7098 .dw XT_CFETCH 00794e 703d .dw XT_DOLITERAL 00794f 0023 .dw 35 007950 7193 .dw XT_MINUS 007951 70b1 .dw XT_DUP 007952 7154 .dw XT_ZERO 007953 703d .dw XT_DOLITERAL 007954 0004 .dw 4 007955 7677 .dw XT_WITHIN 007956 7036 .dw XT_DOCONDBRANCH 007957 7961 DEST(SET_BASE1) .if cpu_msp430==1 .endif 007958 7946 .dw XT_BASES 007959 719d .dw XT_PLUS 00795a 73cb .dw XT_FETCHI 00795b 7551 .dw XT_BASE 00795c 7081 .dw XT_STORE 00795d 7d86 .dw XT_ONE 00795e 79a5 .dw XT_SLASHSTRING 00795f 702f .dw XT_DOBRANCH 007960 7962 DEST(SET_BASE2) SET_BASE1: 007961 70d9 .dw XT_DROP SET_BASE2: 007962 7020 .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: 007963 ff07 .dw $ff07 007964 6e3e 007965 6d75 007966 6562 007967 0072 .db ">number",0 007968 78ef .dw VE_HEAD .set VE_HEAD = VE_TO_NUMBER XT_TO_NUMBER: 007969 7001 .dw DO_COLON .endif 00796a 70b1 00796b 7036 TONUM1: .DW XT_DUP,XT_DOCONDBRANCH 00796c 7981 DEST(TONUM3) 00796d 70cf 00796e 7098 00796f 7753 .DW XT_OVER,XT_CFETCH,XT_DIGITQ 007970 711a 007971 7036 .DW XT_ZEROEQUAL,XT_DOCONDBRANCH 007972 7975 DEST(TONUM2) 007973 70d9 007974 7020 .DW XT_DROP,XT_EXIT 007975 70ff 007976 7d05 007977 7551 007978 7079 007979 014f TONUM2: .DW XT_TO_R,XT_2SWAP,XT_BASE,XT_FETCH,XT_UDSTAR 00797a 70f6 00797b 0147 00797c 7d05 .DW XT_R_FROM,XT_MPLUS,XT_2SWAP 00797d 7d86 00797e 79a5 00797f 702f .DW XT_ONE,XT_SLASHSTRING,XT_DOBRANCH 007980 796a DEST(TONUM1) 007981 7020 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: 007982 ff05 .dw $ff05 007983 6170 007984 7372 007985 0065 .db "parse",0 007986 7963 .dw VE_HEAD .set VE_HEAD = VE_PARSE XT_PARSE: 007987 7001 .dw DO_COLON PFA_PARSE: .endif 007988 70ff .dw XT_TO_R ; ( -- ) 007989 799b .dw XT_SOURCE ; ( -- addr len) 00798a 757e .dw XT_TO_IN ; ( -- addr len >in) 00798b 7079 .dw XT_FETCH 00798c 79a5 .dw XT_SLASHSTRING ; ( -- addr' len' ) 00798d 70f6 .dw XT_R_FROM ; ( -- addr' len' c) 00798e 7871 .dw XT_CSCAN ; ( -- addr' len'') 00798f 70b1 .dw XT_DUP ; ( -- addr' len'' len'') 007990 722f .dw XT_1PLUS 007991 757e .dw XT_TO_IN ; ( -- addr' len'' len'' >in) 007992 7265 .dw XT_PLUSSTORE ; ( -- addr' len') 007993 7d86 .dw XT_ONE 007994 79a5 .dw XT_SLASHSTRING 007995 7020 .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: 007996 ff06 .dw $FF06 007997 6f73 007998 7275 007999 6563 .db "source" 00799a 7982 .dw VE_HEAD .set VE_HEAD = VE_SOURCE XT_SOURCE: 00799b 7c13 .dw PFA_DODEFER1 PFA_SOURCE: .endif 00799c 0016 .dw USER_SOURCE 00799d 7bdc .dw XT_UDEFERFETCH 00799e 7be8 .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: 00799f ff07 .dw $ff07 0079a0 732f 0079a1 7274 0079a2 6e69 0079a3 0067 .db "/string",0 0079a4 7996 .dw VE_HEAD .set VE_HEAD = VE_SLASHSTRING XT_SLASHSTRING: 0079a5 7001 .dw DO_COLON PFA_SLASHSTRING: .endif 0079a6 70e1 .dw XT_ROT 0079a7 70cf .dw XT_OVER 0079a8 719d .dw XT_PLUS 0079a9 70e1 .dw XT_ROT 0079aa 70e1 .dw XT_ROT 0079ab 7193 .dw XT_MINUS 0079ac 7020 .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: 0079ad ff0a .dw $FF0A 0079ae 6170 0079af 7372 0079b0 2d65 0079b1 616e 0079b2 656d .db "parse-name" 0079b3 799f .dw VE_HEAD .set VE_HEAD = VE_PARSENAME XT_PARSENAME: 0079b4 7001 .dw DO_COLON PFA_PARSENAME: .endif 0079b5 75f0 .dw XT_BL 0079b6 79b8 .dw XT_SKIPSCANCHAR 0079b7 7020 .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: 0079b8 7001 .dw DO_COLON PFA_SKIPSCANCHAR: .endif 0079b9 70ff .dw XT_TO_R 0079ba 799b .dw XT_SOURCE 0079bb 757e .dw XT_TO_IN 0079bc 7079 .dw XT_FETCH 0079bd 79a5 .dw XT_SLASHSTRING 0079be 7108 .dw XT_R_FETCH 0079bf 785a .dw XT_CSKIP 0079c0 70f6 .dw XT_R_FROM 0079c1 7871 .dw XT_CSCAN ; adjust >IN 0079c2 7565 .dw XT_2DUP 0079c3 719d .dw XT_PLUS 0079c4 799b .dw XT_SOURCE 0079c5 70d9 .dw XT_DROP 0079c6 7193 .dw XT_MINUS 0079c7 757e .dw XT_TO_IN 0079c8 7081 .dw XT_STORE 0079c9 7020 .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: 0079ca ff07 .dw $ff07 0079cb 6966 0079cc 646e 0079cd 782d 0079ce 0074 .db "find-xt",0 0079cf 79ad .dw VE_HEAD .set VE_HEAD = VE_FINDXT XT_FINDXT: 0079d0 7001 .dw DO_COLON PFA_FINDXT: .endif 0079d1 703d .dw XT_DOLITERAL 0079d2 79dc .dw XT_FINDXTA 0079d3 703d .dw XT_DOLITERAL 0079d4 004e .dw CFG_ORDERLISTLEN 0079d5 040c .dw XT_MAPSTACK 0079d6 711a .dw XT_ZEROEQUAL 0079d7 7036 .dw XT_DOCONDBRANCH 0079d8 79db DEST(PFA_FINDXT1) 0079d9 756e .dw XT_2DROP 0079da 7154 .dw XT_ZERO PFA_FINDXT1: 0079db 7020 .dw XT_EXIT .if cpu_msp430==1 .endif .if cpu_avr8==1 XT_FINDXTA: 0079dc 7001 .dw DO_COLON PFA_FINDXTA: .endif 0079dd 70ff .dw XT_TO_R 0079de 7565 .dw XT_2DUP 0079df 70f6 .dw XT_R_FROM 0079e0 7c25 .dw XT_SEARCH_WORDLIST 0079e1 70b1 .dw XT_DUP 0079e2 7036 .dw XT_DOCONDBRANCH 0079e3 79e9 DEST(PFA_FINDXTA1) 0079e4 70ff .dw XT_TO_R 0079e5 70f0 .dw XT_NIP 0079e6 70f0 .dw XT_NIP 0079e7 70f6 .dw XT_R_FROM 0079e8 714b .dw XT_TRUE PFA_FINDXTA1: 0079e9 7020 .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: 0079ea 7001 .dw DO_COLON PFA_DEFAULT_PROMPTOK: 0079eb 776d .dw XT_DOSLITERAL 0079ec 0003 .dw 3 0079ed 6f20 0079ee 006b .db " ok",0 .endif 0079ef 77a0 .dw XT_ITYPE 0079f0 7020 .dw XT_EXIT ; ------------------------ .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_PROMPTOK: 0079f1 ff03 .dw $FF03 0079f2 6f2e ../../common\words/prompt-ok.asm(43): warning: .cseg .db misalignment - padding zero byte 0079f3 006b .db ".ok" 0079f4 79ca .dw VE_HEAD .set VE_HEAD = VE_PROMPTOK XT_PROMPTOK: 0079f5 7c13 .dw PFA_DODEFER1 PFA_PROMPTOK: .endif 0079f6 001c .dw USER_P_OK 0079f7 7bdc .dw XT_UDEFERFETCH 0079f8 7be8 .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: 0079f9 7001 .dw DO_COLON PFA_DEFAULT_PROMPTREADY: 0079fa 776d .dw XT_DOSLITERAL 0079fb 0002 .dw 2 0079fc 203e .db "> " .endif 0079fd 77d5 .dw XT_CR 0079fe 77a0 .dw XT_ITYPE 0079ff 7020 .dw XT_EXIT ; ------------------------ .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_PROMPTREADY: 007a00 ff06 .dw $FF06 007a01 722e 007a02 6165 007a03 7964 .db ".ready" 007a04 79f1 .dw VE_HEAD .set VE_HEAD = VE_PROMPTREADY XT_PROMPTREADY: 007a05 7c13 .dw PFA_DODEFER1 PFA_PROMPTREADY: .endif 007a06 0020 .dw USER_P_RDY 007a07 7bdc .dw XT_UDEFERFETCH 007a08 7be8 .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: 007a09 7001 .dw DO_COLON PFA_DEFAULT_PROMPTERROR: 007a0a 776d .dw XT_DOSLITERAL 007a0b 0004 .dw 4 007a0c 3f20 007a0d 203f .db " ?? " .endif 007a0e 77a0 .dw XT_ITYPE 007a0f 7551 .dw XT_BASE 007a10 7079 .dw XT_FETCH 007a11 70ff .dw XT_TO_R 007a12 75dd .dw XT_DECIMAL 007a13 7722 .dw XT_DOT 007a14 757e .dw XT_TO_IN 007a15 7079 .dw XT_FETCH 007a16 7722 .dw XT_DOT 007a17 70f6 .dw XT_R_FROM 007a18 7551 .dw XT_BASE 007a19 7081 .dw XT_STORE 007a1a 7020 .dw XT_EXIT ; ------------------------ .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_PROMPTERROR: 007a1b ff06 .dw $FF06 007a1c 652e 007a1d 7272 007a1e 726f .db ".error" 007a1f 7a00 .dw VE_HEAD .set VE_HEAD = VE_PROMPTERROR XT_PROMPTERROR: 007a20 7c13 .dw PFA_DODEFER1 PFA_PROMPTERROR: .endif 007a21 001e .dw USER_P_ERR 007a22 7bdc .dw XT_UDEFERFETCH 007a23 7be8 .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: 007a24 ff04 .dw $ff04 007a25 7571 007a26 7469 .db "quit" 007a27 7a1b .dw VE_HEAD .set VE_HEAD = VE_QUIT XT_QUIT: 007a28 7001 .dw DO_COLON .endif PFA_QUIT: 007a29 02c1 007a2a 02c8 007a2b 7081 .dw XT_LP0,XT_LP,XT_STORE 007a2c 7a89 .dw XT_SP0 007a2d 7296 .dw XT_SP_STORE 007a2e 7a96 .dw XT_RP0 007a2f 7280 .dw XT_RP_STORE 007a30 0356 .dw XT_LBRACKET PFA_QUIT2: 007a31 754b .dw XT_STATE 007a32 7079 .dw XT_FETCH 007a33 711a .dw XT_ZEROEQUAL 007a34 7036 .dw XT_DOCONDBRANCH 007a35 7a37 DEST(PFA_QUIT4) 007a36 7a05 .dw XT_PROMPTREADY PFA_QUIT4: 007a37 78e2 .dw XT_REFILL 007a38 7036 .dw XT_DOCONDBRANCH 007a39 7a49 DEST(PFA_QUIT3) 007a3a 703d .dw XT_DOLITERAL 007a3b 7aaf .dw XT_INTERPRET 007a3c 782b .dw XT_CATCH 007a3d 70b9 .dw XT_QDUP 007a3e 7036 .dw XT_DOCONDBRANCH 007a3f 7a49 DEST(PFA_QUIT3) 007a40 70b1 .dw XT_DUP 007a41 703d .dw XT_DOLITERAL 007a42 fffe .dw -2 007a43 716e .dw XT_LESS 007a44 7036 .dw XT_DOCONDBRANCH 007a45 7a47 DEST(PFA_QUIT5) 007a46 7a20 .dw XT_PROMPTERROR PFA_QUIT5: 007a47 702f .dw XT_DOBRANCH 007a48 7a29 DEST(PFA_QUIT) PFA_QUIT3: 007a49 79f5 .dw XT_PROMPTOK 007a4a 702f .dw XT_DOBRANCH 007a4b 7a31 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: 007a4c ff05 .dw $ff05 007a4d 6170 007a4e 7375 007a4f 0065 .db "pause",0 007a50 7a24 .dw VE_HEAD .set VE_HEAD = VE_PAUSE XT_PAUSE: 007a51 7c13 .dw PFA_DODEFER1 PFA_PAUSE: 007a52 013a .dw ram_pause 007a53 7bc8 .dw XT_RDEFERFETCH 007a54 7bd2 .dw XT_RDEFERSTORE .dseg 00013a ram_pause: .byte 2 .cseg .include "words/cold.asm" ; System ; start up amforth. VE_COLD: 007a55 ff04 .dw $ff04 007a56 6f63 007a57 646c .db "cold" 007a58 7a4c .dw VE_HEAD .set VE_HEAD = VE_COLD XT_COLD: 007a59 7a5a .dw PFA_COLD PFA_COLD: 007a5a b6a4 in_ mcu_boot, MCUSR 007a5b 2422 clr zerol 007a5c 2433 clr zeroh 007a5d 24bb clr isrflag 007a5e be24 out_ MCUSR, zerol ; clear RAM 007a5f e0e0 ldi zl, low(ramstart) 007a60 e0f1 ldi zh, high(ramstart) clearloop: 007a61 9221 st Z+, zerol 007a62 30e0 cpi zl, low(sram_size+ramstart) 007a63 f7e9 brne clearloop 007a64 31f1 cpi zh, high(sram_size+ramstart) 007a65 f7d9 brne clearloop ; init first user data area ; allocate space for User Area .dseg 00013c ram_user1: .byte SYSUSERSIZE + APPUSERSIZE .cseg 007a66 e3ec ldi zl, low(ram_user1) 007a67 e0f1 ldi zh, high(ram_user1) 007a68 012f movw upl, zl ; init return stack pointer 007a69 ef0f ldi temp0,low(rstackstart) 007a6a bf0d out_ SPL,temp0 007a6b 8304 std Z+4, temp0 007a6c e110 ldi temp1,high(rstackstart) 007a6d bf1e out_ SPH,temp1 007a6e 8315 std Z+5, temp1 ; init parameter stack pointer 007a6f eacf ldi yl,low(stackstart) 007a70 83c6 std Z+6, yl 007a71 e1d0 ldi yh,high(stackstart) 007a72 83d7 std Z+7, yh ; load Forth IP with starting word 007a73 e7ac ldi XL, low(PFA_WARM) 007a74 e7ba ldi XH, high(PFA_WARM) ; its a far jump... 007a75 940c 7005 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: 007a77 ff04 .dw $ff04 007a78 6177 007a79 6d72 .db "warm" 007a7a 7a55 .dw VE_HEAD .set VE_HEAD = VE_WARM XT_WARM: 007a7b 7001 .dw DO_COLON PFA_WARM: .endif 007a7c 7d50 .dw XT_INIT_RAM 007a7d 703d .dw XT_DOLITERAL 007a7e 7b7f .dw XT_NOOP 007a7f 703d .dw XT_DOLITERAL 007a80 7a51 .dw XT_PAUSE 007a81 7bf3 .dw XT_DEFERSTORE 007a82 0356 .dw XT_LBRACKET 007a83 75f8 .dw XT_TURNKEY 007a84 7a28 .dw XT_QUIT ; never returns ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; .include "words/sp0.asm" ; Stack ; start address of the data stack VE_SP0: 007a85 ff03 .dw $ff03 007a86 7073 007a87 0030 .db "sp0",0 007a88 7a77 .dw VE_HEAD .set VE_HEAD = VE_SP0 XT_SP0: 007a89 706f .dw PFA_DOVALUE1 PFA_SP0: 007a8a 0006 .dw USER_SP0 007a8b 7bdc .dw XT_UDEFERFETCH 007a8c 7be8 .dw XT_UDEFERSTORE ; ( -- addr) ; Stack ; address of user variable to store top-of-stack for inactive tasks VE_SP: 007a8d ff02 .dw $ff02 007a8e 7073 .db "sp" 007a8f 7a85 .dw VE_HEAD .set VE_HEAD = VE_SP XT_SP: 007a90 7058 .dw PFA_DOUSER PFA_SP: 007a91 0008 .dw USER_SP .include "words/rp0.asm" ; Stack ; start address of return stack VE_RP0: 007a92 ff03 .dw $ff03 007a93 7072 007a94 0030 .db "rp0",0 007a95 7a8d .dw VE_HEAD .set VE_HEAD = VE_RP0 XT_RP0: 007a96 7001 .dw DO_COLON PFA_RP0: 007a97 7a9a .dw XT_DORP0 007a98 7079 .dw XT_FETCH 007a99 7020 .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: 007a9a 7058 .dw PFA_DOUSER PFA_DORP0: 007a9b 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: 007a9c ff05 .dw $ff05 007a9d 6564 007a9e 7470 007a9f 0068 .db "depth",0 007aa0 7a92 .dw VE_HEAD .set VE_HEAD = VE_DEPTH XT_DEPTH: 007aa1 7001 .dw DO_COLON PFA_DEPTH: .endif 007aa2 7a89 .dw XT_SP0 007aa3 728d .dw XT_SP_FETCH 007aa4 7193 .dw XT_MINUS 007aa5 7204 .dw XT_2SLASH 007aa6 7235 .dw XT_1MINUS 007aa7 7020 .dw XT_EXIT .include "words/interpret.asm" ; System ; Interpret SOURCE word by word. .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_INTERPRET: 007aa8 ff09 .dw $ff09 007aa9 6e69 007aaa 6574 007aab 7072 007aac 6572 007aad 0074 .db "interpret",0 007aae 7a9c .dw VE_HEAD .set VE_HEAD = VE_INTERPRET XT_INTERPRET: 007aaf 7001 .dw DO_COLON .endif PFA_INTERPRET: 007ab0 79b4 .dw XT_PARSENAME ; ( -- addr len ) 007ab1 70b1 .dw XT_DUP ; ( -- addr len flag) 007ab2 7036 .dw XT_DOCONDBRANCH 007ab3 7ac0 DEST(PFA_INTERPRET2) 007ab4 7acc .dw XT_FORTHRECOGNIZER 007ab5 7ad7 .dw XT_RECOGNIZE 007ab6 754b .dw XT_STATE 007ab7 7079 .dw XT_FETCH 007ab8 7036 .dw XT_DOCONDBRANCH 007ab9 7abb DEST(PFA_INTERPRET1) 007aba 7bab .dw XT_ICELLPLUS ; we need the compile action PFA_INTERPRET1: 007abb 73cb .dw XT_FETCHI 007abc 702a .dw XT_EXECUTE 007abd 7b57 .dw XT_QSTACK 007abe 702f .dw XT_DOBRANCH 007abf 7ab0 DEST(PFA_INTERPRET) PFA_INTERPRET2: 007ac0 756e .dw XT_2DROP 007ac1 7020 .dw XT_EXIT .include "words/forth-recognizer.asm" ; System Value ; address of the next free data space (RAM) cell VE_FORTHRECOGNIZER: 007ac2 ff10 .dw $ff10 007ac3 6f66 007ac4 7472 007ac5 2d68 007ac6 6572 007ac7 6f63 007ac8 6e67 007ac9 7a69 007aca 7265 .db "forth-recognizer" 007acb 7aa8 .dw VE_HEAD .set VE_HEAD = VE_FORTHRECOGNIZER XT_FORTHRECOGNIZER: 007acc 706f .dw PFA_DOVALUE1 PFA_FORTHRECOGNIZER: 007acd 0042 .dw CFG_FORTHRECOGNIZER 007ace 7bb4 .dw XT_EDEFERFETCH 007acf 7bbe .dw XT_EDEFERSTORE .include "words/recognize.asm" ; System ; walk the recognizer stack .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_RECOGNIZE: 007ad0 ff09 .dw $ff09 007ad1 6572 007ad2 6f63 007ad3 6e67 007ad4 7a69 007ad5 0065 .db "recognize",0 007ad6 7ac2 .dw VE_HEAD .set VE_HEAD = VE_RECOGNIZE XT_RECOGNIZE: 007ad7 7001 .dw DO_COLON PFA_RECOGNIZE: .endif 007ad8 703d .dw XT_DOLITERAL 007ad9 7ae2 .dw XT_RECOGNIZE_A 007ada 70c4 .dw XT_SWAP 007adb 040c .dw XT_MAPSTACK 007adc 711a .dw XT_ZEROEQUAL 007add 7036 .dw XT_DOCONDBRANCH 007ade 7ae1 DEST(PFA_RECOGNIZE1) 007adf 756e .dw XT_2DROP 007ae0 7b4a .dw XT_DT_NULL PFA_RECOGNIZE1: 007ae1 7020 .dw XT_EXIT .if cpu_msp430==1 .endif .if cpu_avr8==1 ; ( addr len XT -- addr len [ dt:xt -1 | 0 ] ) XT_RECOGNIZE_A: 007ae2 7001 .dw DO_COLON PFA_RECOGNIZE_A: .endif 007ae3 70e1 .dw XT_ROT ; -- len xt addr 007ae4 70e1 .dw XT_ROT ; -- xt addr len 007ae5 7565 .dw XT_2DUP 007ae6 731e .dw XT_2TO_R 007ae7 70e1 .dw XT_ROT ; -- addr len xt 007ae8 702a .dw XT_EXECUTE ; -- i*x dt:* | dt:null 007ae9 732d .dw XT_2R_FROM 007aea 70e1 .dw XT_ROT 007aeb 70b1 .dw XT_DUP 007aec 7b4a .dw XT_DT_NULL 007aed 7d7f .dw XT_EQUAL 007aee 7036 .dw XT_DOCONDBRANCH 007aef 7af3 DEST(PFA_RECOGNIZE_A1) 007af0 70d9 .dw XT_DROP 007af1 7154 .dw XT_ZERO 007af2 7020 .dw XT_EXIT PFA_RECOGNIZE_A1: 007af3 70f0 .dw XT_NIP 007af4 70f0 .dw XT_NIP 007af5 714b .dw XT_TRUE 007af6 7020 .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: 007af7 ff06 .dw $ff06 007af8 7464 007af9 6e3a 007afa 6d75 .db "dt:num" 007afb 7ad0 .dw VE_HEAD .set VE_HEAD = VE_DT_NUM XT_DT_NUM: 007afc 7052 .dw PFA_DOCONSTANT PFA_DT_NUM: .endif 007afd 7b7f .dw XT_NOOP ; interpret 007afe 01e2 .dw XT_LITERAL ; compile 007aff 01e2 .dw XT_LITERAL ; postpone ; ( -- addr ) ; Interpreter ; Method table for double cell integers .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_DT_DNUM: 007b00 ff07 .dw $ff07 007b01 7464 007b02 643a 007b03 756e 007b04 006d .db "dt:dnum",0 007b05 7af7 .dw VE_HEAD .set VE_HEAD = VE_DT_DNUM XT_DT_DNUM: 007b06 7052 .dw PFA_DOCONSTANT PFA_DT_DNUM: .endif 007b07 7b7f .dw XT_NOOP ; interpret 007b08 7d77 .dw XT_2LITERAL ; compile 007b09 7d77 .dw XT_2LITERAL ; postpone ; ( addr len -- f ) ; Interpreter ; recognizer for integer numbers .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_REC_NUM: 007b0a ff07 .dw $ff07 007b0b 6572 007b0c 3a63 007b0d 756e 007b0e 006d .db "rec:num",0 007b0f 7b00 .dw VE_HEAD .set VE_HEAD = VE_REC_NUM XT_REC_NUM: 007b10 7001 .dw DO_COLON PFA_REC_NUM: .endif ; try converting to a number 007b11 78f4 .dw XT_NUMBER 007b12 7036 .dw XT_DOCONDBRANCH 007b13 7b1c DEST(PFA_REC_NONUMBER) 007b14 7d86 .dw XT_ONE 007b15 7d7f .dw XT_EQUAL 007b16 7036 .dw XT_DOCONDBRANCH 007b17 7b1a DEST(PFA_REC_INTNUM2) 007b18 7afc .dw XT_DT_NUM 007b19 7020 .dw XT_EXIT PFA_REC_INTNUM2: 007b1a 7b06 .dw XT_DT_DNUM 007b1b 7020 .dw XT_EXIT PFA_REC_NONUMBER: 007b1c 7b4a .dw XT_DT_NULL 007b1d 7020 .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: 007b1e ff08 .dw $ff08 007b1f 6572 007b20 3a63 007b21 6966 007b22 646e .db "rec:find" 007b23 7b0a .dw VE_HEAD .set VE_HEAD = VE_REC_FIND XT_REC_FIND: 007b24 7001 .dw DO_COLON PFA_REC_FIND: .endif 007b25 79d0 .DW XT_FINDXT 007b26 70b1 .dw XT_DUP 007b27 711a .dw XT_ZEROEQUAL 007b28 7036 .dw XT_DOCONDBRANCH 007b29 7b2d DEST(PFA_REC_WORD_FOUND) 007b2a 70d9 .dw XT_DROP 007b2b 7b4a .dw XT_DT_NULL 007b2c 7020 .dw XT_EXIT PFA_REC_WORD_FOUND: 007b2d 7b34 .dw XT_DT_XT 007b2e 7020 .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: 007b2f ff05 .dw $ff05 007b30 7464 007b31 783a 007b32 0074 .db "dt:xt",0 007b33 7b1e .dw VE_HEAD .set VE_HEAD = VE_DT_XT XT_DT_XT: 007b34 7052 .dw PFA_DOCONSTANT PFA_DT_XT: .endif 007b35 7b38 .dw XT_R_WORD_INTERPRET 007b36 7b3c .dw XT_R_WORD_COMPILE 007b37 7d77 .dw XT_2LITERAL ; ( XT flags -- ) ; Interpreter ; interpret method for WORD recognizer .if cpu_msp430==1 .endif .if cpu_avr8==1 XT_R_WORD_INTERPRET: 007b38 7001 .dw DO_COLON PFA_R_WORD_INTERPRET: .endif 007b39 70d9 .dw XT_DROP ; the flags are in the way 007b3a 702a .dw XT_EXECUTE 007b3b 7020 .dw XT_EXIT ; ( XT flags -- ) ; Interpreter ; Compile method for WORD recognizer .if cpu_msp430==1 .endif .if cpu_avr8==1 XT_R_WORD_COMPILE: 007b3c 7001 .dw DO_COLON PFA_R_WORD_COMPILE: .endif 007b3d 7121 .dw XT_ZEROLESS 007b3e 7036 .dw XT_DOCONDBRANCH 007b3f 7b42 DEST(PFA_R_WORD_COMPILE1) 007b40 01cc .dw XT_COMMA 007b41 7020 .dw XT_EXIT PFA_R_WORD_COMPILE1: 007b42 702a .dw XT_EXECUTE 007b43 7020 .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: 007b44 ff07 .dw $ff07 007b45 7464 007b46 6e3a 007b47 6c75 ../../common\words/dt-null.asm(12): warning: .cseg .db misalignment - padding zero byte 007b48 006c .db "dt:null" 007b49 7b2f .dw VE_HEAD .set VE_HEAD = VE_DT_NULL XT_DT_NULL: 007b4a 7052 .dw PFA_DOCONSTANT PFA_DT_NULL: .endif 007b4b 7b4e .dw XT_FAIL ; interpret 007b4c 7b4e .dw XT_FAIL ; compile 007b4d 7b4e .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: 007b4e 7001 .dw DO_COLON PFA_FAIL: .endif 007b4f 703d .dw XT_DOLITERAL 007b50 fff3 .dw -13 007b51 7841 .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: 007b52 ff06 .dw $ff06 007b53 733f 007b54 6174 007b55 6b63 .db "?stack" 007b56 7b44 .dw VE_HEAD .set VE_HEAD = VE_QSTACK XT_QSTACK: 007b57 7001 .dw DO_COLON PFA_QSTACK: .endif 007b58 7aa1 .dw XT_DEPTH 007b59 7121 .dw XT_ZEROLESS 007b5a 7036 .dw XT_DOCONDBRANCH 007b5b 7b5f DEST(PFA_QSTACK1) 007b5c 703d .dw XT_DOLITERAL 007b5d fffc .dw -4 007b5e 7841 .dw XT_THROW PFA_QSTACK1: 007b5f 7020 .dw XT_EXIT .include "words/ver.asm" ; Tools ; print the version string .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_DOT_VER: 007b60 ff03 .dw $ff03 007b61 6576 ../../common\words/ver.asm(12): warning: .cseg .db misalignment - padding zero byte 007b62 0072 .db "ver" 007b63 7b52 .dw VE_HEAD .set VE_HEAD = VE_DOT_VER XT_DOT_VER: 007b64 7001 .dw DO_COLON PFA_DOT_VER: .endif 007b65 750d .dw XT_ENV_FORTHNAME 007b66 77a0 .dw XT_ITYPE 007b67 77e2 .dw XT_SPACE 007b68 7551 .dw XT_BASE 007b69 7079 .dw XT_FETCH 007b6a 751b .dw XT_ENV_FORTHVERSION 007b6b 75dd .dw XT_DECIMAL 007b6c 7d67 .dw XT_S2D 007b6d 76be .dw XT_L_SHARP 007b6e 76c6 .dw XT_SHARP 007b6f 703d .dw XT_DOLITERAL 007b70 002e .dw '.' 007b71 76af .dw XT_HOLD 007b72 76dc .dw XT_SHARP_S 007b73 76e7 .dw XT_SHARP_G 007b74 77fb .dw XT_TYPE 007b75 7551 .dw XT_BASE 007b76 7081 .dw XT_STORE 007b77 77e2 .dw XT_SPACE 007b78 7523 .dw XT_ENV_CPU 007b79 77a0 .dw XT_ITYPE 007b7a 7020 .dw XT_EXIT ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; .include "words/noop.asm" ; Tools ; do nothing .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_NOOP: 007b7b ff04 .dw $ff04 007b7c 6f6e 007b7d 706f .db "noop" 007b7e 7b60 .dw VE_HEAD .set VE_HEAD = VE_NOOP XT_NOOP: 007b7f 7001 .dw DO_COLON PFA_NOOP: .endif 007b80 7020 .DW XT_EXIT .include "words/unused.asm" ; Tools ; Amount of available RAM (incl. PAD) VE_UNUSED: 007b81 ff06 .dw $ff06 007b82 6e75 007b83 7375 007b84 6465 .db "unused" 007b85 7b7b .dw VE_HEAD .set VE_HEAD = VE_UNUSED XT_UNUSED: 007b86 7001 .dw DO_COLON PFA_UNUSED: 007b87 728d .dw XT_SP_FETCH 007b88 75bf .dw XT_HERE 007b89 7193 .dw XT_MINUS 007b8a 7020 .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: 007b8b 0002 .dw $0002 007b8c 6f74 .db "to" 007b8d 7b81 .dw VE_HEAD .set VE_HEAD = VE_TO XT_TO: 007b8e 7001 .dw DO_COLON PFA_TO: .endif 007b8f 780a .dw XT_TICK 007b90 7d70 .dw XT_TO_BODY 007b91 754b .dw XT_STATE 007b92 7079 .dw XT_FETCH 007b93 7036 .dw XT_DOCONDBRANCH 007b94 7b9f DEST(PFA_TO1) 007b95 01c1 .dw XT_COMPILE 007b96 7b99 .dw XT_DOTO 007b97 01cc .dw XT_COMMA 007b98 7020 .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: 007b99 7001 .dw DO_COLON PFA_DOTO: .endif 007b9a 70f6 .dw XT_R_FROM 007b9b 70b1 .dw XT_DUP 007b9c 7bab .dw XT_ICELLPLUS 007b9d 70ff .dw XT_TO_R 007b9e 73cb .dw XT_FETCHI PFA_TO1: 007b9f 70b1 .dw XT_DUP 007ba0 7bab .dw XT_ICELLPLUS 007ba1 7bab .dw XT_ICELLPLUS 007ba2 73cb .dw XT_FETCHI 007ba3 702a .dw XT_EXECUTE 007ba4 7020 .dw XT_EXIT .include "words/i-cellplus.asm" ; Compiler ; skip to the next cell in flash VE_ICELLPLUS: 007ba5 ff07 .dw $FF07 007ba6 2d69 007ba7 6563 007ba8 6c6c 007ba9 002b .db "i-cell+",0 007baa 7b8b .dw VE_HEAD .set VE_HEAD = VE_ICELLPLUS XT_ICELLPLUS: 007bab 7001 .dw DO_COLON PFA_ICELLPLUS: 007bac 722f .dw XT_1PLUS 007bad 7020 .dw XT_EXIT .include "words/edefer-fetch.asm" ; System ; does the real defer@ for eeprom defers VE_EDEFERFETCH: 007bae ff07 .dw $ff07 007baf 6445 007bb0 6665 007bb1 7265 007bb2 0040 .db "Edefer@",0 007bb3 7ba5 .dw VE_HEAD .set VE_HEAD = VE_EDEFERFETCH XT_EDEFERFETCH: 007bb4 7001 .dw DO_COLON PFA_EDEFERFETCH: 007bb5 73cb .dw XT_FETCHI 007bb6 735f .dw XT_FETCHE 007bb7 7020 .dw XT_EXIT .include "words/edefer-store.asm" ; System ; does the real defer! for eeprom defers VE_EDEFERSTORE: 007bb8 ff07 .dw $ff07 007bb9 6445 007bba 6665 007bbb 7265 007bbc 0021 .db "Edefer!",0 007bbd 7bae .dw VE_HEAD .set VE_HEAD = VE_EDEFERSTORE XT_EDEFERSTORE: 007bbe 7001 .dw DO_COLON PFA_EDEFERSTORE: 007bbf 73cb .dw XT_FETCHI 007bc0 733b .dw XT_STOREE 007bc1 7020 .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: 007bc2 ff07 .dw $ff07 007bc3 6452 007bc4 6665 007bc5 7265 007bc6 0040 .db "Rdefer@",0 007bc7 7bb8 .dw VE_HEAD .set VE_HEAD = VE_RDEFERFETCH XT_RDEFERFETCH: 007bc8 7001 .dw DO_COLON PFA_RDEFERFETCH: .endif 007bc9 73cb .dw XT_FETCHI 007bca 7079 .dw XT_FETCH 007bcb 7020 .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: 007bcc ff07 .dw $ff07 007bcd 6452 007bce 6665 007bcf 7265 007bd0 0021 .db "Rdefer!",0 007bd1 7bc2 .dw VE_HEAD .set VE_HEAD = VE_RDEFERSTORE XT_RDEFERSTORE: 007bd2 7001 .dw DO_COLON PFA_RDEFERSTORE: .endif 007bd3 73cb .dw XT_FETCHI 007bd4 7081 .dw XT_STORE 007bd5 7020 .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: 007bd6 ff07 .dw $ff07 007bd7 6455 007bd8 6665 007bd9 7265 007bda 0040 .db "Udefer@",0 007bdb 7bcc .dw VE_HEAD .set VE_HEAD = VE_UDEFERFETCH XT_UDEFERFETCH: 007bdc 7001 .dw DO_COLON PFA_UDEFERFETCH: .endif 007bdd 73cb .dw XT_FETCHI 007bde 7302 .dw XT_UP_FETCH 007bdf 719d .dw XT_PLUS 007be0 7079 .dw XT_FETCH 007be1 7020 .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: 007be2 ff07 .dw $ff07 007be3 6455 007be4 6665 007be5 7265 007be6 0021 .db "Udefer!",0 007be7 7bd6 .dw VE_HEAD .set VE_HEAD = VE_UDEFERSTORE XT_UDEFERSTORE: 007be8 7001 .dw DO_COLON PFA_UDEFERSTORE: .endif 007be9 73cb .dw XT_FETCHI 007bea 7302 .dw XT_UP_FETCH 007beb 719d .dw XT_PLUS 007bec 7081 .dw XT_STORE 007bed 7020 .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: 007bee ff06 .dw $ff06 007bef 6564 007bf0 6566 007bf1 2172 .db "defer!" 007bf2 7be2 .dw VE_HEAD .set VE_HEAD = VE_DEFERSTORE XT_DEFERSTORE: 007bf3 7001 .dw DO_COLON PFA_DEFERSTORE: .endif 007bf4 7d70 .dw XT_TO_BODY 007bf5 70b1 .dw XT_DUP 007bf6 7bab .dw XT_ICELLPLUS 007bf7 7bab .dw XT_ICELLPLUS 007bf8 73cb .dw XT_FETCHI 007bf9 702a .dw XT_EXECUTE 007bfa 7020 .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: 007bfb ff06 .dw $ff06 007bfc 6564 007bfd 6566 007bfe 4072 .db "defer@" 007bff 7bee .dw VE_HEAD .set VE_HEAD = VE_DEFERFETCH XT_DEFERFETCH: 007c00 7001 .dw DO_COLON PFA_DEFERFETCH: .endif 007c01 7d70 .dw XT_TO_BODY 007c02 70b1 .dw XT_DUP 007c03 7bab .dw XT_ICELLPLUS 007c04 73cb .dw XT_FETCHI 007c05 702a .dw XT_EXECUTE 007c06 7020 .dw XT_EXIT .include "words/do-defer.asm" ; System ; runtime of defer VE_DODEFER: 007c07 ff07 .dw $ff07 007c08 6428 007c09 6665 007c0a 7265 007c0b 0029 .db "(defer)", 0 007c0c 7bfb .dw VE_HEAD .set VE_HEAD = VE_DODEFER XT_DODEFER: 007c0d 7001 .dw DO_COLON PFA_DODEFER: 007c0e 019e .dw XT_DOCREATE 007c0f 02fe .dw XT_REVEAL 007c10 01c1 .dw XT_COMPILE 007c11 7c13 .dw PFA_DODEFER1 007c12 7020 .dw XT_EXIT PFA_DODEFER1: 007c13 940e 0317 call_ DO_DODOES 007c15 70b1 .dw XT_DUP 007c16 7bab .dw XT_ICELLPLUS 007c17 73cb .dw XT_FETCHI 007c18 702a .dw XT_EXECUTE 007c19 702a .dw XT_EXECUTE 007c1a 7020 .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: 007c1b ff0f .dw $ff0f 007c1c 6573 007c1d 7261 007c1e 6863 007c1f 772d 007c20 726f 007c21 6c64 007c22 7369 007c23 0074 .db "search-wordlist",0 007c24 7c07 .dw VE_HEAD .set VE_HEAD = VE_SEARCH_WORDLIST XT_SEARCH_WORDLIST: 007c25 7001 .dw DO_COLON PFA_SEARCH_WORDLIST: .endif 007c26 70ff .dw XT_TO_R 007c27 7154 .dw XT_ZERO 007c28 703d .dw XT_DOLITERAL 007c29 7c3a .dw XT_ISWORD 007c2a 70f6 .dw XT_R_FROM 007c2b 7c57 .dw XT_TRAVERSEWORDLIST 007c2c 70b1 .dw XT_DUP 007c2d 711a .dw XT_ZEROEQUAL 007c2e 7036 .dw XT_DOCONDBRANCH 007c2f 7c34 DEST(PFA_SEARCH_WORDLIST1) 007c30 756e .dw XT_2DROP 007c31 70d9 .dw XT_DROP 007c32 7154 .dw XT_ZERO 007c33 7020 .dw XT_EXIT PFA_SEARCH_WORDLIST1: ; ... get the XT ... 007c34 70b1 .dw XT_DUP 007c35 7c7e .dw XT_NFA2CFA ; .. and get the header flag 007c36 70c4 .dw XT_SWAP 007c37 0184 .dw XT_NAME2FLAGS 007c38 0172 .dw XT_IMMEDIATEQ 007c39 7020 .dw XT_EXIT .if cpu_msp430==1 .endif .if cpu_avr8==1 XT_ISWORD: 007c3a 7001 .dw DO_COLON PFA_ISWORD: .endif ; ( c-addr len 0 nt -- c-addr len 0 true| nt false ) 007c3b 70ff .dw XT_TO_R 007c3c 70d9 .dw XT_DROP 007c3d 7565 .dw XT_2DUP 007c3e 7108 .dw XT_R_FETCH ; -- addr len addr len nt 007c3f 7c72 .dw XT_NAME2STRING 007c40 7c88 .dw XT_ICOMPARE ; (-- addr len f ) 007c41 7036 .dw XT_DOCONDBRANCH 007c42 7c48 DEST(PFA_ISWORD3) ; not now 007c43 70f6 .dw XT_R_FROM 007c44 70d9 .dw XT_DROP 007c45 7154 .dw XT_ZERO 007c46 714b .dw XT_TRUE ; maybe next word 007c47 7020 .dw XT_EXIT PFA_ISWORD3: ; we found the word, now clean up iteration data ... 007c48 756e .dw XT_2DROP 007c49 70f6 .dw XT_R_FROM 007c4a 7154 .dw XT_ZERO ; finish traverse-wordlist 007c4b 7020 .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: 007c4c ff11 .dw $ff11 007c4d 7274 007c4e 7661 007c4f 7265 007c50 6573 007c51 772d 007c52 726f 007c53 6c64 007c54 7369 007c55 0074 .db "traverse-wordlist",0 007c56 7c1b .dw VE_HEAD .set VE_HEAD = VE_TRAVERSEWORDLIST XT_TRAVERSEWORDLIST: 007c57 7001 .dw DO_COLON PFA_TRAVERSEWORDLIST: .endif 007c58 735f .dw XT_FETCHE PFA_TRAVERSEWORDLIST1: 007c59 70b1 .dw XT_DUP ; ( -- xt nt nt ) 007c5a 7036 .dw XT_DOCONDBRANCH ; ( -- nt ) is nfa = counted string 007c5b 7c68 DEST(PFA_TRAVERSEWORDLIST2) 007c5c 7565 .dw XT_2DUP 007c5d 731e .dw XT_2TO_R 007c5e 70c4 .dw XT_SWAP 007c5f 702a .dw XT_EXECUTE 007c60 732d .dw XT_2R_FROM 007c61 70e1 .dw XT_ROT 007c62 7036 .dw XT_DOCONDBRANCH 007c63 7c68 DEST(PFA_TRAVERSEWORDLIST2) 007c64 047b .dw XT_NFA2LFA 007c65 73cb .dw XT_FETCHI 007c66 702f .dw XT_DOBRANCH ; ( -- addr ) 007c67 7c59 DEST(PFA_TRAVERSEWORDLIST1) ; ( -- addr ) PFA_TRAVERSEWORDLIST2: 007c68 756e .dw XT_2DROP 007c69 7020 .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: 007c6a ff0b .dw $ff0b 007c6b 616e 007c6c 656d 007c6d 733e 007c6e 7274 007c6f 6e69 007c70 0067 .db "name>string",0 007c71 7c4c .dw VE_HEAD .set VE_HEAD = VE_NAME2STRING XT_NAME2STRING: 007c72 7001 .dw DO_COLON PFA_NAME2STRING: .endif 007c73 77cc .dw XT_ICOUNT ; ( -- addr n ) 007c74 703d .dw XT_DOLITERAL 007c75 00ff .dw 255 007c76 7213 .dw XT_AND ; mask immediate bit 007c77 7020 .dw XT_EXIT .include "words/nfa2cfa.asm" ; Tools ; get the XT from a name token VE_NFA2CFA: 007c78 ff07 .dw $ff07 007c79 666e 007c7a 3e61 007c7b 6663 ../../avr8\words/nfa2cfa.asm(6): warning: .cseg .db misalignment - padding zero byte 007c7c 0061 .db "nfa>cfa" 007c7d 7c6a .dw VE_HEAD .set VE_HEAD = VE_NFA2CFA XT_NFA2CFA: 007c7e 7001 .dw DO_COLON PFA_NFA2CFA: 007c7f 047b .dw XT_NFA2LFA ; skip to link field 007c80 722f .dw XT_1PLUS ; next is the execution token 007c81 7020 .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: 007c82 ff08 .dw $ff08 007c83 6369 007c84 6d6f 007c85 6170 007c86 6572 .db "icompare" 007c87 7c78 .dw VE_HEAD .set VE_HEAD = VE_ICOMPARE XT_ICOMPARE: 007c88 7001 .dw DO_COLON PFA_ICOMPARE: 007c89 70ff .dw XT_TO_R ; ( -- r-addr r-len f-addr) 007c8a 70cf .dw XT_OVER ; ( -- r-addr r-len f-addr r-len) 007c8b 70f6 .dw XT_R_FROM ; ( -- r-addr r-len f-addr r-len f-len ) 007c8c 7113 .dw XT_NOTEQUAL ; ( -- r-addr r-len f-addr flag ) 007c8d 7036 .dw XT_DOCONDBRANCH 007c8e 7c93 .dw PFA_ICOMPARE_SAMELEN 007c8f 756e .dw XT_2DROP 007c90 70d9 .dw XT_DROP 007c91 714b .dw XT_TRUE 007c92 7020 .dw XT_EXIT PFA_ICOMPARE_SAMELEN: 007c93 70c4 .dw XT_SWAP ; ( -- r-addr f-addr len ) 007c94 7154 .dw XT_ZERO 007c95 028b .dw XT_QDOCHECK 007c96 7036 .dw XT_DOCONDBRANCH 007c97 7cb6 .dw PFA_ICOMPARE_DONE 007c98 729b .dw XT_DODO PFA_ICOMPARE_LOOP: ; ( r-addr f-addr --) 007c99 70cf .dw XT_OVER 007c9a 7079 .dw XT_FETCH .if WANT_IGNORECASE == 1 .endif 007c9b 70cf .dw XT_OVER 007c9c 73cb .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 007c9d 70b1 .dw XT_DUP ;.dw XT_BYTESWAP 007c9e 703d .dw XT_DOLITERAL 007c9f 0100 .dw $100 007ca0 715c .dw XT_ULESS 007ca1 7036 .dw XT_DOCONDBRANCH 007ca2 7ca7 .dw PFA_ICOMPARE_LASTCELL 007ca3 70c4 .dw XT_SWAP 007ca4 703d .dw XT_DOLITERAL 007ca5 00ff .dw $00FF 007ca6 7213 .dw XT_AND ; the final swap can be omitted PFA_ICOMPARE_LASTCELL: 007ca7 7113 .dw XT_NOTEQUAL 007ca8 7036 .dw XT_DOCONDBRANCH 007ca9 7cae .dw PFA_ICOMPARE_NEXTLOOP 007caa 756e .dw XT_2DROP 007cab 714b .dw XT_TRUE 007cac 72d4 .dw XT_UNLOOP 007cad 7020 .dw XT_EXIT PFA_ICOMPARE_NEXTLOOP: 007cae 722f .dw XT_1PLUS 007caf 70c4 .dw XT_SWAP 007cb0 755e .dw XT_CELLPLUS 007cb1 70c4 .dw XT_SWAP 007cb2 703d .dw XT_DOLITERAL 007cb3 0002 .dw 2 007cb4 72ba .dw XT_DOPLUSLOOP 007cb5 7c99 .dw PFA_ICOMPARE_LOOP PFA_ICOMPARE_DONE: 007cb6 756e .dw XT_2DROP 007cb7 7154 .dw XT_ZERO 007cb8 7020 .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: 007cb9 ff01 .dw $ff01 007cba 002a .db "*",0 007cbb 7c82 .dw VE_HEAD .set VE_HEAD = VE_STAR XT_STAR: 007cbc 7001 .dw DO_COLON PFA_STAR: .endif 007cbd 71a6 .dw XT_MSTAR 007cbe 70d9 .dw XT_DROP 007cbf 7020 .dw XT_EXIT .include "words/j.asm" ; Compiler ; loop counter of outer loop VE_J: 007cc0 ff01 .dw $FF01 007cc1 006a .db "j",0 007cc2 7cb9 .dw VE_HEAD .set VE_HEAD = VE_J XT_J: 007cc3 7001 .dw DO_COLON PFA_J: 007cc4 7276 .dw XT_RP_FETCH 007cc5 703d .dw XT_DOLITERAL 007cc6 0007 .dw 7 007cc7 719d .dw XT_PLUS 007cc8 7079 .dw XT_FETCH 007cc9 7276 .dw XT_RP_FETCH 007cca 703d .dw XT_DOLITERAL 007ccb 0009 .dw 9 007ccc 719d .dw XT_PLUS 007ccd 7079 .dw XT_FETCH 007cce 719d .dw XT_PLUS 007ccf 7020 .dw XT_EXIT .include "words/dabs.asm" ; Arithmetics ; double cell absolute value VE_DABS: 007cd0 ff04 .dw $ff04 007cd1 6164 007cd2 7362 .db "dabs" 007cd3 7cc0 .dw VE_HEAD .set VE_HEAD = VE_DABS XT_DABS: 007cd4 7001 .dw DO_COLON PFA_DABS: 007cd5 70b1 .dw XT_DUP 007cd6 7121 .dw XT_ZEROLESS 007cd7 7036 .dw XT_DOCONDBRANCH 007cd8 7cda .dw PFA_DABS1 007cd9 7ce1 .dw XT_DNEGATE PFA_DABS1: 007cda 7020 .dw XT_EXIT ; : dabs ( ud1 -- +d2 ) dup 0< if dnegate then ; .include "words/dnegate.asm" ; Arithmetics ; double cell negation VE_DNEGATE: 007cdb ff07 .dw $ff07 007cdc 6e64 007cdd 6765 007cde 7461 007cdf 0065 .db "dnegate",0 007ce0 7cd0 .dw VE_HEAD .set VE_HEAD = VE_DNEGATE XT_DNEGATE: 007ce1 7001 .dw DO_COLON PFA_DNEGATE: 007ce2 743b .dw XT_DINVERT 007ce3 7d86 .dw XT_ONE 007ce4 7154 .dw XT_ZERO 007ce5 7415 .dw XT_DPLUS 007ce6 7020 .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: 007ce7 ff05 .dw $ff05 007ce8 6d63 007ce9 766f 007cea 0065 .db "cmove",0 007ceb 7cdb .dw VE_HEAD .set VE_HEAD = VE_CMOVE XT_CMOVE: 007cec 7ced .dw PFA_CMOVE PFA_CMOVE: 007ced 93bf push xh 007cee 93af push xl 007cef 91e9 ld zl, Y+ 007cf0 91f9 ld zh, Y+ ; addr-to 007cf1 91a9 ld xl, Y+ 007cf2 91b9 ld xh, Y+ ; addr-from 007cf3 2f09 mov temp0, tosh 007cf4 2b08 or temp0, tosl 007cf5 f021 brbs 1, PFA_CMOVE1 PFA_CMOVE2: 007cf6 911d ld temp1, X+ 007cf7 9311 st Z+, temp1 007cf8 9701 sbiw tosl, 1 007cf9 f7e1 brbc 1, PFA_CMOVE2 PFA_CMOVE1: 007cfa 91af pop xl 007cfb 91bf pop xh 007cfc 9189 007cfd 9199 loadtos 007cfe 940c 7005 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: 007d00 ff05 .dw $ff05 007d01 7332 007d02 6177 007d03 0070 .db "2swap",0 007d04 7ce7 .dw VE_HEAD .set VE_HEAD = VE_2SWAP XT_2SWAP: 007d05 7001 .dw DO_COLON PFA_2SWAP: .endif 007d06 70e1 .dw XT_ROT 007d07 70ff .dw XT_TO_R 007d08 70e1 .dw XT_ROT 007d09 70f6 .dw XT_R_FROM 007d0a 7020 .dw XT_EXIT .include "words/tib.asm" ; System ; refills the input buffer .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_REFILLTIB: 007d0b ff0a .dw $ff0a 007d0c 6572 007d0d 6966 007d0e 6c6c 007d0f 742d 007d10 6269 .db "refill-tib" 007d11 7d00 .dw VE_HEAD .set VE_HEAD = VE_REFILLTIB XT_REFILLTIB: 007d12 7001 .dw DO_COLON PFA_REFILLTIB: .endif 007d13 7d2e .dw XT_TIB 007d14 703d .dw XT_DOLITERAL 007d15 005a .dw TIB_SIZE 007d16 7891 .dw XT_ACCEPT 007d17 7d34 .dw XT_NUMBERTIB 007d18 7081 .dw XT_STORE 007d19 7154 .dw XT_ZERO 007d1a 757e .dw XT_TO_IN 007d1b 7081 .dw XT_STORE 007d1c 714b .dw XT_TRUE ; -1 007d1d 7020 .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: 007d1e ff0a .dw $FF0A 007d1f 6f73 007d20 7275 007d21 6563 007d22 742d 007d23 6269 .db "source-tib" 007d24 7d0b .dw VE_HEAD .set VE_HEAD = VE_SOURCETIB XT_SOURCETIB: 007d25 7001 .dw DO_COLON PFA_SOURCETIB: .endif 007d26 7d2e .dw XT_TIB 007d27 7d34 .dw XT_NUMBERTIB 007d28 7079 .dw XT_FETCH 007d29 7020 .dw XT_EXIT ; ( -- addr ) ; System Variable ; terminal input buffer address .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_TIB: 007d2a ff03 .dw $ff03 007d2b 6974 007d2c 0062 .db "tib",0 007d2d 7d1e .dw VE_HEAD .set VE_HEAD = VE_TIB XT_TIB: 007d2e 7048 .dw PFA_DOVARIABLE PFA_TIB: 007d2f 0168 .dw ram_tib .dseg 000168 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: 007d30 ff04 .dw $ff04 007d31 7423 007d32 6269 .db "#tib" 007d33 7d2a .dw VE_HEAD .set VE_HEAD = VE_NUMBERTIB XT_NUMBERTIB: 007d34 7048 .dw PFA_DOVARIABLE PFA_NUMBERTIB: 007d35 01c2 .dw ram_sharptib .dseg 0001c2 ram_sharptib: .byte 2 .cseg .endif .include "words/init-ram.asm" ; Tools ; copy len cells from eeprom to ram VE_EE2RAM: 007d36 ff06 .dw $ff06 007d37 6565 007d38 723e 007d39 6d61 .db "ee>ram" 007d3a 7d30 .dw VE_HEAD .set VE_HEAD = VE_EE2RAM XT_EE2RAM: 007d3b 7001 .dw DO_COLON PFA_EE2RAM: ; ( -- ) 007d3c 7154 .dw XT_ZERO 007d3d 729b .dw XT_DODO PFA_EE2RAM_1: ; ( -- e-addr r-addr ) 007d3e 70cf .dw XT_OVER 007d3f 735f .dw XT_FETCHE 007d40 70cf .dw XT_OVER 007d41 7081 .dw XT_STORE 007d42 755e .dw XT_CELLPLUS 007d43 70c4 .dw XT_SWAP 007d44 755e .dw XT_CELLPLUS 007d45 70c4 .dw XT_SWAP 007d46 72c9 .dw XT_DOLOOP 007d47 7d3e .dw PFA_EE2RAM_1 PFA_EE2RAM_2: 007d48 756e .dw XT_2DROP 007d49 7020 .dw XT_EXIT ; ( -- ) ; Tools ; setup the default user area from eeprom VE_INIT_RAM: 007d4a ff08 .dw $ff08 007d4b 6e69 007d4c 7469 007d4d 722d 007d4e 6d61 .db "init-ram" 007d4f 7d36 .dw VE_HEAD .set VE_HEAD = VE_INIT_RAM XT_INIT_RAM: 007d50 7001 .dw DO_COLON PFA_INI_RAM: ; ( -- ) 007d51 703d .dw XT_DOLITERAL 007d52 006e .dw EE_INITUSER 007d53 7302 .dw XT_UP_FETCH 007d54 703d .dw XT_DOLITERAL 007d55 0022 .dw SYSUSERSIZE 007d56 7204 .dw XT_2SLASH 007d57 7d3b .dw XT_EE2RAM 007d58 7020 .dw XT_EXIT .include "dict/compiler2.inc" ; included almost independently from each other ; on a include-per-use basis ; .if DICT_COMPILER2 == 0 .endif .include "words/bounds.asm" ; Tools ; convert a string to an address range .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_BOUNDS: 007d59 ff06 .dw $ff06 007d5a 6f62 007d5b 6e75 007d5c 7364 .db "bounds" 007d5d 7d4a .dw VE_HEAD .set VE_HEAD = VE_BOUNDS XT_BOUNDS: 007d5e 7001 .dw DO_COLON PFA_BOUNDS: .endif 007d5f 70cf .dw XT_OVER 007d60 719d .dw XT_PLUS 007d61 70c4 .dw XT_SWAP 007d62 7020 .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: 007d63 ff03 .dw $ff03 007d64 3e73 007d65 0064 .db "s>d",0 007d66 7d59 .dw VE_HEAD .set VE_HEAD = VE_S2D XT_S2D: 007d67 7001 .dw DO_COLON PFA_S2D: .endif 007d68 70b1 .dw XT_DUP 007d69 7121 .dw XT_ZEROLESS 007d6a 7020 .dw XT_EXIT .include "words/to-body.asm" ; Core ; get body from XT VE_TO_BODY: 007d6b ff05 .dw $ff05 007d6c 623e 007d6d 646f 007d6e 0079 .db ">body",0 007d6f 7d63 .dw VE_HEAD .set VE_HEAD = VE_TO_BODY XT_TO_BODY: 007d70 7230 .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: 007d71 0008 .dw $0008 007d72 6c32 007d73 7469 007d74 7265 007d75 6c61 .db "2literal" 007d76 7d6b .dw VE_HEAD .set VE_HEAD = VE_2LITERAL XT_2LITERAL: 007d77 7001 .dw DO_COLON PFA_2LITERAL: .endif 007d78 70c4 .dw XT_SWAP 007d79 01e2 .dw XT_LITERAL 007d7a 01e2 .dw XT_LITERAL 007d7b 7020 .dw XT_EXIT .include "words/equal.asm" ; Compare ; compares two values for equality VE_EQUAL: 007d7c ff01 .dw $ff01 007d7d 003d .db "=",0 007d7e 7d71 .dw VE_HEAD .set VE_HEAD = VE_EQUAL XT_EQUAL: 007d7f 7001 .dw DO_COLON PFA_EQUAL: 007d80 7193 .dw XT_MINUS 007d81 711a .dw XT_ZEROEQUAL 007d82 7020 .dw XT_EXIT .include "words/num-constants.asm" .endif .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_ONE: 007d83 ff01 .dw $ff01 007d84 0031 .db "1",0 007d85 7d7c .dw VE_HEAD .set VE_HEAD = VE_ONE XT_ONE: 007d86 7048 .dw PFA_DOVARIABLE PFA_ONE: .endif 007d87 0001 .DW 1 .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_TWO: 007d88 ff01 .dw $ff01 007d89 0032 .db "2",0 007d8a 7d83 .dw VE_HEAD .set VE_HEAD = VE_TWO XT_TWO: 007d8b 7048 .dw PFA_DOVARIABLE PFA_TWO: .endif 007d8c 0002 .DW 2 .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_MINUSONE: 007d8d ff02 .dw $ff02 007d8e 312d .db "-1" 007d8f 7d88 .dw VE_HEAD .set VE_HEAD = VE_MINUSONE XT_MINUSONE: 007d90 7048 .dw PFA_DOVARIABLE PFA_MINUSONE: .endif 007d91 ffff .DW -1 .include "dict_appl_core.inc" ; do not delete it! .set flashlast = pc .if (pc>FLASHEND) .endif .dseg ; define a label for the 1st free ram address HERESTART: .eseg .include "amforth-eeprom.inc" 000038 ff ff ; some configs 00003a 8b 05 CFG_DP: .dw DPSTART ; Dictionary Pointer 00003c c4 01 EE_HERE: .dw HERESTART ; Memory Allocation 00003e 92 00 EE_EHERE: .dw EHERESTART ; EEProm Memory Allocation 000040 33 04 CFG_WLSCOPE: .dw XT_GET_CURRENT ; default wordlist scope 000042 60 00 CFG_FORTHRECOGNIZER: .dw CFG_RECOGNIZERLISTLEN ; Recognizer word set ; LEAVE stack is between data stack and return stack. 000044 b0 10 CFG_LP0: .dw stackstart+1 000046 dd 04 CFG_TURNKEY: .dw XT_APPLTURNKEY ; TURNKEY 000048 32 75 CFG_ENVIRONMENT:.dw VE_ENVHEAD ; environmental queries 00004a 4c 00 CFG_CURRENT: .dw CFG_FORTHWORDLIST ; forth-wordlist 00004c 8d 7d CFG_FORTHWORDLIST:.dw VE_HEAD ; pre-defined (compiled in) wordlist CFG_ORDERLISTLEN: 00004e 01 00 .dw 1 CFG_ORDERLIST: ; list of wordlist id, exactly numwordlist entries 000050 4c 00 .dw CFG_FORTHWORDLIST ; get/set-order 000052 .byte (NUMWORDLISTS-1)*CELLSIZE ; one slot is already used CFG_RECOGNIZERLISTLEN: 000060 02 00 .dw 2 CFG_RECOGNIZERLIST: 000062 24 7b .dw XT_REC_FIND 000064 10 7b .dw XT_REC_NUM 000066 .byte (NUMRECOGNIZERS-2)*CELLSIZE ; two slots are already used EE_STOREI: 00006a 7e 73 .dw XT_DO_STOREI ; Store a cell into flash ; MARKER saves everything up to here. Nothing beyond gets saved EE_MARKER: 00006c 6c 00 .dw EE_MARKER ; default user area EE_INITUSER: 00006e 00 00 .dw 0 ; USER_STATE 000070 00 00 .dw 0 ; USER_FOLLOWER 000072 ff 10 .dw rstackstart ; USER_RP 000074 af 10 .dw stackstart ; USER_SP0 000076 af 10 .dw stackstart ; USER_SP 000078 00 00 .dw 0 ; USER_HANDLER 00007a 0a 00 .dw 10 ; USER_BASE 00007c a7 00 .dw XT_TX ; USER_EMIT 00007e b5 00 .dw XT_TXQ ; USER_EMITQ 000080 7c 00 .dw XT_RX ; USER_KEY 000082 97 00 .dw XT_RXQ ; USER_KEYQ 000084 25 7d .dw XT_SOURCETIB ; USER_SOURCE 000086 00 00 .dw 0 ; USER_G_IN 000088 12 7d .dw XT_REFILLTIB ; USER_REFILL 00008a ea 79 .dw XT_DEFAULT_PROMPTOK 00008c 09 7a .dw XT_DEFAULT_PROMPTERROR 00008e f9 79 .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: 000090 19 00 .dw UBRR_VAL ; BAUDRATE ; 1st free address in EEPROM. EHERESTART: .cseg RESOURCE USE INFORMATION ------------------------ Notice: The register and instruction counts are symbol table hit counts, and hence implicitly used resources are not counted, eg, the 'lpm' instruction without operands implicitly uses r0 and z, none of which are counted. x,y,z are separate entities in the symbol table and are counted separately from r26..r31 here. .dseg memory usage only counts static data declared with .byte "ATmega644" register use summary: r0 : 25 r1 : 5 r2 : 10 r3 : 12 r4 : 4 r5 : 1 r6 : 0 r7 : 0 r8 : 0 r9 : 0 r10: 1 r11: 6 r12: 0 r13: 0 r14: 22 r15: 20 r16: 89 r17: 61 r18: 61 r19: 37 r20: 13 r21: 11 r22: 11 r23: 3 r24: 212 r25: 145 r26: 28 r27: 17 r28: 7 r29: 4 r30: 90 r31: 49 x : 4 y : 217 z : 50 Registers used: 29 out of 35 (82.9%) "ATmega644" instruction use summary: .lds : 0 .sts : 0 adc : 22 add : 17 adiw : 17 and : 4 andi : 3 asr : 2 bclr : 0 bld : 0 brbc : 2 brbs : 7 brcc : 3 brcs : 1 break : 0 breq : 6 brge : 1 brhc : 0 brhs : 0 brid : 0 brie : 0 brlo : 1 brlt : 3 brmi : 3 brne : 22 brpl : 0 brsh : 0 brtc : 0 brts : 0 brvc : 0 brvs : 2 bset : 0 bst : 0 call : 2 cbi : 7 cbr : 1 clc : 2 clh : 0 cli : 7 cln : 0 clr : 14 cls : 0 clt : 0 clv : 0 clz : 0 com : 14 cp : 11 cpc : 10 cpi : 2 cpse : 0 dec : 10 eor : 3 fmul : 0 fmuls : 0 fmulsu: 0 icall : 0 ijmp : 1 in : 25 inc : 3 jmp : 14 ld : 145 ldd : 4 ldi : 41 lds : 1 lpm : 16 lsl : 14 lsr : 2 mov : 16 movw : 72 mul : 5 muls : 1 mulsu : 2 neg : 0 nop : 0 or : 9 ori : 2 out : 22 pop : 49 push : 43 rcall : 41 ret : 7 reti : 1 rjmp : 105 rol : 23 ror : 6 sbc : 9 sbci : 3 sbi : 8 sbic : 3 sbis : 0 sbiw : 16 sbr : 0 sbrc : 5 sbrs : 7 sec : 1 seh : 0 sei : 1 sen : 0 ser : 4 ses : 0 set : 0 sev : 0 sez : 0 sleep : 0 spm : 2 st : 81 std : 8 sts : 1 sub : 6 subi : 3 swap : 0 tst : 0 wdr : 0 Instructions used: 72 out of 113 (63.7%) "ATmega644" memory use summary [bytes]: Segment Begin End Code Data Used Size Use% --------------------------------------------------------------- [.cseg] 0x000000 0x00fb24 2088 14590 16678 65536 25.4% [.dseg] 0x000100 0x0001c4 0 196 196 4096 4.8% [.eseg] 0x000000 0x000092 0 146 146 2048 7.1% Assembly complete, 0 errors, 8 warnings