AVRASM ver. 2.1.52 p1284-16.asm Sun Apr 30 20:10:15 2017 p1284-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/atmega1284p\device.asm' ../../avr8/devices/atmega1284p\device.asm(5): Including file '../../avr8/Atmel/Appnotes2\m1284Pdef.inc' p1284-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' p1284-16.asm(19): Including file '../../avr8\drivers/1wire.asm' p1284-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 clr temp7 lsl zl rol zh rol temp7 out_ RAMPZ, temp7 elpm @0, Z+ elpm @1, Z+ .endmacro .macro writeflashcell clr temp7 lsl zl rol zh rol temp7 out_ RAMPZ, temp7 .endmacro .set WANT_ANALOG_COMPARATOR = 0 .set WANT_USART0 = 0 .set WANT_PORTA = 0 .set WANT_PORTB = 0 .set WANT_PORTC = 0 .set WANT_PORTD = 0 .set WANT_TIMER_COUNTER_0 = 0 .set WANT_TIMER_COUNTER_1 = 0 .set WANT_TIMER_COUNTER_2 = 0 .set WANT_TIMER_COUNTER_3 = 0 .set WANT_BOOT_LOAD = 0 .set WANT_EXTERNAL_INTERRUPT = 0 .set WANT_AD_CONVERTER = 0 .set WANT_JTAG = 0 .set WANT_EEPROM = 0 .set WANT_TWI = 0 .set WANT_USART1 = 0 .set WANT_SPI = 0 .set WANT_WATCHDOG = 0 .set WANT_CPU = 0 .equ intvecsize = 2 ; please verify; flash size: 131072 bytes .equ pclen = 2 ; please verify .overlap .org 2 000002 d139 rcall isr ; External Interrupt Request 0 .org 4 000004 d137 rcall isr ; External Interrupt Request 1 .org 6 000006 d135 rcall isr ; External Interrupt Request 2 .org 8 000008 d133 rcall isr ; Pin Change Interrupt Request 0 .org 10 00000a d131 rcall isr ; Pin Change Interrupt Request 1 .org 12 00000c d12f rcall isr ; Pin Change Interrupt Request 2 .org 14 00000e d12d rcall isr ; Pin Change Interrupt Request 3 .org 16 000010 d12b rcall isr ; Watchdog Time-out Interrupt .org 18 000012 d129 rcall isr ; Timer/Counter2 Compare Match A .org 20 000014 d127 rcall isr ; Timer/Counter2 Compare Match B .org 22 000016 d125 rcall isr ; Timer/Counter2 Overflow .org 24 000018 d123 rcall isr ; Timer/Counter1 Capture Event .org 26 00001a d121 rcall isr ; Timer/Counter1 Compare Match A .org 28 00001c d11f rcall isr ; Timer/Counter1 Compare Match B .org 30 00001e d11d rcall isr ; Timer/Counter1 Overflow .org 32 000020 d11b rcall isr ; Timer/Counter0 Compare Match A .org 34 000022 d119 rcall isr ; Timer/Counter0 Compare Match B .org 36 000024 d117 rcall isr ; Timer/Counter0 Overflow .org 38 000026 d115 rcall isr ; SPI Serial Transfer Complete .org 40 000028 d113 rcall isr ; USART0, Rx Complete .org 42 00002a d111 rcall isr ; USART0 Data register Empty .org 44 00002c d10f rcall isr ; USART0, Tx Complete .org 46 00002e d10d rcall isr ; Analog Comparator .org 48 000030 d10b rcall isr ; ADC Conversion Complete .org 50 000032 d109 rcall isr ; EEPROM Ready .org 52 000034 d107 rcall isr ; 2-wire Serial Interface .org 54 000036 d105 rcall isr ; Store Program Memory Read .org 56 000038 d103 rcall isr ; USART1 RX complete .org 58 00003a d101 rcall isr ; USART1 Data Register Empty .org 60 00003c d0ff rcall isr ; USART1 TX complete .org 62 00003e d0fd rcall isr ; Timer/Counter3 Capture Event .org 64 000040 d0fb rcall isr ; Timer/Counter3 Compare Match A .org 66 000042 d0f9 rcall isr ; Timer/Counter3 Compare Match B .org 68 000044 d0f7 rcall isr ; Timer/Counter3 Overflow .equ INTVECTORS = 35 .nooverlap ; compatability layer (maybe empty) ; controller data area, environment query mcu-info mcu_info: mcu_ramsize: 000045 4000 .dw 16384 mcu_eepromsize: 000046 1000 .dw 4096 mcu_maxdp: 000047 ffff .dw 65535 mcu_numints: 000048 0023 .dw 35 mcu_name: 000049 000b .dw 11 00004a 5441 00004b 656d 00004c 6167 00004d 3231 00004e 3438 00004f 0050 .db "ATmega1284P",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 000055 0000 .dw VE_HEAD .set VE_HEAD = VE_TO_RXBUF XT_TO_RXBUF: 000056 0057 .dw PFA_rx_tobuf PFA_rx_tobuf: 000057 2f08 mov temp0, tosl 000058 9110 0110 lds temp1, usart_rx_in 00005a e0e0 ldi zl, low(usart_rx_data) 00005b e0f1 ldi zh, high(usart_rx_data) 00005c 0fe1 add zl, temp1 00005d 1df3 adc zh, zeroh 00005e 8300 st Z, temp0 00005f 9513 inc temp1 000060 701f andi temp1,usart_rx_mask 000061 9310 0110 sts usart_rx_in, temp1 000063 9189 000064 9199 loadtos 000065 940c f005 jmp_ DO_NEXT ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; setup with ; ' isr-rx URXCaddr int! VE_ISR_RX: 000067 ff06 .dw $ff06 000068 7369 000069 2d72 00006a 7872 .db "isr-rx" 00006b 0050 .dw VE_HEAD .set VE_HEAD = VE_ISR_RX XT_ISR_RX: 00006c f001 .dw DO_COLON usart_rx_isr: 00006d f046 .dw XT_DOLITERAL 00006e 00c6 .dw usart_data 00006f f0aa .dw XT_CFETCH 000070 f0c3 .dw XT_DUP 000071 f046 .dw XT_DOLITERAL 000072 0003 .dw 3 000073 fd9a .dw XT_EQUAL 000074 f03f .dw XT_DOCONDBRANCH 000075 0077 .dw usart_rx_isr1 000076 fa74 .dw XT_COLD usart_rx_isr1: 000077 0056 .dw XT_TO_RXBUF 000078 f026 .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: 000079 f001 .dw DO_COLON PFA_USART_INIT_RX_BUFFER: ; ( -- ) 00007a f046 00007b 006c .dw XT_DOLITERAL, XT_ISR_RX 00007c f046 00007d 0028 .dw XT_DOLITERAL, URXCaddr 00007e f4a2 .dw XT_INTSTORE 00007f f046 .dw XT_DOLITERAL 000080 0100 .dw usart_rx_data 000081 f046 .dw XT_DOLITERAL 000082 0016 .dw usart_rx_size + 6 000083 f166 .dw XT_ZERO 000084 f4ea .dw XT_FILL 000085 f026 .dw XT_EXIT ; ( -- c) ; MCU ; get 1 character from input queue, wait if needed using interrupt driver VE_RX_BUFFER: 000086 ff06 .dw $ff06 000087 7872 000088 622d 000089 6675 .db "rx-buf" 00008a 0067 .dw VE_HEAD .set VE_HEAD = VE_RX_BUFFER XT_RX_BUFFER: 00008b f001 .dw DO_COLON PFA_RX_BUFFER: 00008c 00a6 .dw XT_RXQ_BUFFER 00008d f03f .dw XT_DOCONDBRANCH 00008e 008c .dw PFA_RX_BUFFER 00008f f046 .dw XT_DOLITERAL 000090 0111 .dw usart_rx_out 000091 f0aa .dw XT_CFETCH 000092 f0c3 .dw XT_DUP 000093 f046 .dw XT_DOLITERAL 000094 0100 .dw usart_rx_data 000095 f1af .dw XT_PLUS 000096 f0aa .dw XT_CFETCH 000097 f0d6 .dw XT_SWAP 000098 f241 .dw XT_1PLUS 000099 f046 .dw XT_DOLITERAL 00009a 000f .dw usart_rx_mask 00009b f225 .dw XT_AND 00009c f046 .dw XT_DOLITERAL 00009d 0111 .dw usart_rx_out 00009e f09f .dw XT_CSTORE 00009f f026 .dw XT_EXIT ; ( -- f) ; MCU ; check if unread characters are in the input queue VE_RXQ_BUFFER: 0000a0 ff07 .dw $ff07 0000a1 7872 0000a2 2d3f 0000a3 7562 0000a4 0066 .db "rx?-buf",0 0000a5 0086 .dw VE_HEAD .set VE_HEAD = VE_RXQ_BUFFER XT_RXQ_BUFFER: 0000a6 f001 .dw DO_COLON PFA_RXQ_BUFFER: 0000a7 fa6c .dw XT_PAUSE 0000a8 f046 .dw XT_DOLITERAL 0000a9 0111 .dw usart_rx_out 0000aa f0aa .dw XT_CFETCH 0000ab f046 .dw XT_DOLITERAL 0000ac 0110 .dw usart_rx_in 0000ad f0aa .dw XT_CFETCH 0000ae f125 .dw XT_NOTEQUAL 0000af f026 .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: 0000b0 ff07 .dw $ff07 0000b1 7874 0000b2 702d 0000b3 6c6f 0000b4 006c .db "tx-poll",0 0000b5 00a0 .dw VE_HEAD .set VE_HEAD = VE_TX_POLL XT_TX_POLL: 0000b6 f001 .dw DO_COLON PFA_TX_POLL: ; wait for data ready 0000b7 00c4 .dw XT_TXQ_POLL 0000b8 f03f .dw XT_DOCONDBRANCH 0000b9 00b7 .dw PFA_TX_POLL ; send to usart 0000ba f046 .dw XT_DOLITERAL 0000bb 00c6 .dw USART_DATA 0000bc f09f .dw XT_CSTORE 0000bd f026 .dw XT_EXIT ; ( -- f) MCU ; MCU ; check if a character can be send using register poll VE_TXQ_POLL: 0000be ff08 .dw $ff08 0000bf 7874 0000c0 2d3f 0000c1 6f70 0000c2 6c6c .db "tx?-poll" 0000c3 00b0 .dw VE_HEAD .set VE_HEAD = VE_TXQ_POLL XT_TXQ_POLL: 0000c4 f001 .dw DO_COLON PFA_TXQ_POLL: 0000c5 fa6c .dw XT_PAUSE 0000c6 f046 .dw XT_DOLITERAL 0000c7 00c0 .dw USART_A 0000c8 f0aa .dw XT_CFETCH 0000c9 f046 .dw XT_DOLITERAL 0000ca 0020 .dw bm_USART_TXRD 0000cb f225 .dw XT_AND 0000cc f026 .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: 0000cd ff04 .dw $ff04 0000ce 6275 0000cf 7272 .db "ubrr" 0000d0 00be .dw VE_HEAD .set VE_HEAD = VE_UBRR XT_UBRR: 0000d1 f081 .dw PFA_DOVALUE1 PFA_UBRR: ; ( -- ) 0000d2 009e .dw EE_UBRRVAL 0000d3 fbcf .dw XT_EDEFERFETCH 0000d4 fbd9 .dw XT_EDEFERSTORE .include "words/usart.asm" ; MCU ; initialize usart VE_USART: 0000d5 ff06 .dw $ff06 0000d6 752b 0000d7 6173 0000d8 7472 .db "+usart" 0000d9 00cd .dw VE_HEAD .set VE_HEAD = VE_USART XT_USART: 0000da f001 .dw DO_COLON PFA_USART: ; ( -- ) 0000db f046 .dw XT_DOLITERAL 0000dc 0098 .dw USART_B_VALUE 0000dd f046 .dw XT_DOLITERAL 0000de 00c1 .dw USART_B 0000df f09f .dw XT_CSTORE 0000e0 f046 .dw XT_DOLITERAL 0000e1 0006 .dw USART_C_VALUE 0000e2 f046 .dw XT_DOLITERAL 0000e3 00c2 .dw USART_C | bm_USARTC_en 0000e4 f09f .dw XT_CSTORE 0000e5 00d1 .dw XT_UBRR 0000e6 f0c3 .dw XT_DUP 0000e7 f30b .dw XT_BYTESWAP 0000e8 f046 .dw XT_DOLITERAL 0000e9 00c5 .dw BAUDRATE_HIGH 0000ea f09f .dw XT_CSTORE 0000eb f046 .dw XT_DOLITERAL 0000ec 00c4 .dw BAUDRATE_LOW 0000ed f09f .dw XT_CSTORE .if XT_USART_INIT_RX!=0 0000ee 0079 .dw XT_USART_INIT_RX .endif .if XT_USART_INIT_TX!=0 .endif 0000ef f026 .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: 0000f0 ff08 .dw $ff08 0000f1 7731 0000f2 722e 0000f3 7365 0000f4 7465 .db "1w.reset" 0000f5 00d5 .dw VE_HEAD .set VE_HEAD = VE_OW_RESET XT_OW_RESET: 0000f6 00f7 .dw PFA_OW_RESET PFA_OW_RESET: 0000f7 939a 0000f8 938a savetos ; setup to output 0000f9 9a24 sbi OW_DDR, OW_BIT ; Pull output low 0000fa 982c cbi OW_PORT, OW_BIT ; Delay >480 usec 0000fb e8e0 0000fc e0f7 0000fd 9731 0000fe f7f1 DELAY 480 ; Critical timing period, disable interrupts. 0000ff b71f in temp1, SREG 000100 94f8 cli ; Pull output high 000101 9a2c sbi OW_PORT, OW_BIT ; make pin input, sends "1" 000102 9824 cbi OW_DDR, OW_BIT 000103 e0e0 000104 e0f1 000105 9731 000106 f7f1 DELAY 64 ; delayB ; Sample input pin, set TOS if input is zero 000107 b183 in tosl, OW_PIN 000108 ff84 sbrs tosl, OW_BIT 000109 ef9f ser tosh ; End critical timing period, enable interrupts 00010a bf1f out SREG, temp1 ; release bus 00010b 9824 cbi OW_DDR, OW_BIT 00010c 982c cbi OW_PORT, OW_BIT ; Delay rest of 480 usec 00010d e8e0 00010e e0f6 00010f 9731 000110 f7f1 DELAY 416 ; we now have the result flag in TOS 000111 2f89 mov tosl, tosh 000112 940c f005 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: 000114 ff07 .dw $ff07 000115 7731 000116 732e 000117 6f6c 000118 0074 .db "1w.slot",0 000119 00f0 .dw VE_HEAD .set VE_HEAD = VE_OW_SLOT XT_OW_SLOT: 00011a 011b .dw PFA_OW_SLOT PFA_OW_SLOT: ; pull low 00011b 982c cbi OW_PORT, OW_BIT 00011c 9a24 sbi OW_DDR, OW_BIT ; disable interrupts 00011d b71f in temp1, SREG 00011e 94f8 cli 00011f e1e8 000120 e0f0 000121 9731 000122 f7f1 DELAY 6 ; DELAY A ; check bit 000123 9488 clc 000124 9587 ror tosl 000125 f410 brcc PFA_OW_SLOT0 ; a 0 keeps the bus low ; release bus, a 1 is written 000126 9a2c sbi OW_PORT, OW_BIT 000127 9824 cbi OW_DDR, OW_BIT PFA_OW_SLOT0: ; sample the input (no action required if zero) 000128 e2e4 000129 e0f0 00012a 9731 00012b f7f1 DELAY 9 ; wait DELAY E to sample 00012c b103 in temp0, OW_PIN 00012d fd04 sbrc temp0, OW_BIT 00012e 6880 ori tosl, $80 00012f ecec 000130 e0f0 000131 9731 000132 f7f1 DELAY 51 ; DELAY B 000133 9a2c sbi OW_PORT, OW_BIT ; release bus 000134 9824 cbi OW_DDR, OW_BIT 000135 e0e8 000136 e0f0 000137 9731 000138 f7f1 delay 2 ; re-enable interrupts 000139 bf1f out SREG, temp1 00013a 940c f005 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 fa75 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: 00013c 920a st -Y, r0 00013d b60f in r0, SREG 00013e 920a st -Y, r0 .if (pclen==3) .endif 00013f 900f pop r0 000140 900f pop r0 ; = intnum * intvectorsize + 1 (address following the rcall) 000141 940a dec r0 .if intvecsize == 1 ; .endif 000142 2cb0 mov isrflag, r0 000143 93ff push zh 000144 93ef push zl 000145 e1e2 ldi zl, low(intcnt) 000146 e0f1 ldi zh, high(intcnt) 000147 9406 lsr r0 ; we use byte addresses in the counter array, not words 000148 0de0 add zl, r0 000149 1df3 adc zh, zeroh 00014a 8000 ld r0, Z 00014b 9403 inc r0 00014c 8200 st Z, r0 00014d 91ef pop zl 00014e 91ff pop zh 00014f 9009 ld r0, Y+ 000150 be0f out SREG, r0 000151 9009 ld r0, Y+ 000152 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: 000153 ff02 .dw $ff02 000154 2b6d .db "m+" 000155 0114 .dw VE_HEAD .set VE_HEAD = VE_MPLUS XT_MPLUS: 000156 f001 .dw DO_COLON PFA_MPLUS: 000157 fd82 .dw XT_S2D 000158 f430 .dw XT_DPLUS 000159 f026 .dw XT_EXIT .include "words/ud-star.asm" .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_UDSTAR: 00015a ff03 .dw $ff03 00015b 6475 ../../common\words/ud-star.asm(9): warning: .cseg .db misalignment - padding zero byte 00015c 002a .db "ud*" 00015d 0153 .dw VE_HEAD .set VE_HEAD = VE_UDSTAR XT_UDSTAR: 00015e f001 .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 + ; 00015f f0c3 000160 f111 000161 f1f2 000162 f0eb .DW XT_DUP,XT_TO_R,XT_UMSTAR,XT_DROP 000163 f0d6 000164 f108 000165 f1f2 000166 f0f3 000167 f1af 000168 f026 .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: 000169 ff04 .dw $ff04 00016a 6d75 00016b 7861 .db "umax" 00016c 015a .dw VE_HEAD .set VE_HEAD = VE_UMAX XT_UMAX: 00016d f001 .dw DO_COLON PFA_UMAX: .endif 00016e f580 00016f f16e .DW XT_2DUP,XT_ULESS 000170 f03f .dw XT_DOCONDBRANCH 000171 0173 DEST(UMAX1) 000172 f0d6 .DW XT_SWAP 000173 f0eb UMAX1: .DW XT_DROP 000174 f026 .dw XT_EXIT .include "words/umin.asm" .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_UMIN: 000175 ff04 .dw $ff04 000176 6d75 000177 6e69 .db "umin" 000178 0169 .dw VE_HEAD .set VE_HEAD = VE_UMIN XT_UMIN: 000179 f001 .dw DO_COLON PFA_UMIN: .endif 00017a f580 00017b f179 .DW XT_2DUP,XT_UGREATER 00017c f03f .dw XT_DOCONDBRANCH 00017d 017f DEST(UMIN1) 00017e f0d6 .DW XT_SWAP 00017f f0eb UMIN1: .DW XT_DROP 000180 f026 .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: 000181 f001 .dw DO_COLON PFA_IMMEDIATEQ: 000182 f046 .dw XT_DOLITERAL 000183 8000 .dw $8000 000184 f225 .dw XT_AND 000185 f12c .dw XT_ZEROEQUAL 000186 f03f .dw XT_DOCONDBRANCH 000187 018a DEST(IMMEDIATEQ1) 000188 fda1 .dw XT_ONE 000189 f026 .dw XT_EXIT IMMEDIATEQ1: ; not immediate 00018a f15d .dw XT_TRUE 00018b f026 .dw XT_EXIT .include "words/name2flags.asm" ; Tools ; get the flags from a name token VE_NAME2FLAGS: 00018c ff0a .dw $ff0a 00018d 616e 00018e 656d 00018f 663e 000190 616c 000191 7367 .db "name>flags" 000192 0175 .dw VE_HEAD .set VE_HEAD = VE_NAME2FLAGS XT_NAME2FLAGS: 000193 f001 .dw DO_COLON PFA_NAME2FLAGS: 000194 f3e3 .dw XT_FETCHI ; skip to link field 000195 f046 .dw XT_DOLITERAL 000196 ff00 .dw $ff00 000197 f225 .dw XT_AND 000198 f026 .dw XT_EXIT .if AMFORTH_NRWW_SIZE > 8000 .include "dict/appl_8k.inc" .include "words/newest.asm" ; System Variable ; system state VE_NEWEST: 000199 ff06 .dw $ff06 00019a 656e 00019b 6577 00019c 7473 .db "newest" 00019d 018c .dw VE_HEAD .set VE_HEAD = VE_NEWEST XT_NEWEST: 00019e f054 .dw PFA_DOVARIABLE PFA_NEWEST: 00019f 0135 .dw ram_newest .dseg 000135 ram_newest: .byte 4 .include "words/latest.asm" ; System Variable ; system state VE_LATEST: 0001a0 ff06 .dw $ff06 0001a1 616c 0001a2 6574 0001a3 7473 .db "latest" 0001a4 0199 .dw VE_HEAD .set VE_HEAD = VE_LATEST XT_LATEST: 0001a5 f054 .dw PFA_DOVARIABLE PFA_LATEST: 0001a6 0139 .dw ram_latest .dseg 000139 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: 0001a7 ff08 .dw $ff08 0001a8 6328 0001a9 6572 0001aa 7461 0001ab 2965 .db "(create)" 0001ac 01a0 .dw VE_HEAD .set VE_HEAD = VE_DOCREATE XT_DOCREATE: 0001ad f001 .dw DO_COLON PFA_DOCREATE: .endif 0001ae f9cf 0001af 0304 .DW XT_PARSENAME,XT_WLSCOPE ; ( -- addr len wid) 0001b0 f0c3 0001b1 019e 0001b2 f579 0001b3 f093 .DW XT_DUP,XT_NEWEST,XT_CELLPLUS,XT_STORE ; save the wid 0001b4 02e9 0001b5 019e 0001b6 f093 .DW XT_HEADER,XT_NEWEST,XT_STORE ; save the nt 0001b7 f026 .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: 0001b8 0001 .dw $0001 0001b9 005c .db $5c,0 0001ba 01a7 .dw VE_HEAD .set VE_HEAD = VE_BACKSLASH XT_BACKSLASH: 0001bb f001 .dw DO_COLON PFA_BACKSLASH: .endif 0001bc f9b6 .dw XT_SOURCE 0001bd f102 .dw XT_NIP 0001be f599 .dw XT_TO_IN 0001bf f093 .dw XT_STORE 0001c0 f026 .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: 0001c1 0001 .dw $0001 0001c2 0028 .db "(" ,0 0001c3 01b8 .dw VE_HEAD .set VE_HEAD = VE_LPAREN XT_LPAREN: 0001c4 f001 .dw DO_COLON PFA_LPAREN: .endif 0001c5 f046 .dw XT_DOLITERAL 0001c6 0029 .dw ')' 0001c7 f9a2 .dw XT_PARSE 0001c8 f589 .dw XT_2DROP 0001c9 f026 .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: 0001ca ff07 .dw $ff07 0001cb 6f63 0001cc 706d 0001cd 6c69 0001ce 0065 .db "compile",0 0001cf 01c1 .dw VE_HEAD .set VE_HEAD = VE_COMPILE XT_COMPILE: 0001d0 f001 .dw DO_COLON PFA_COMPILE: .endif 0001d1 f108 .dw XT_R_FROM 0001d2 f0c3 .dw XT_DUP 0001d3 fbc6 .dw XT_ICELLPLUS 0001d4 f111 .dw XT_TO_R 0001d5 f3e3 .dw XT_FETCHI 0001d6 01db .dw XT_COMMA 0001d7 f026 .dw XT_EXIT .include "words/comma.asm" ; Dictionary ; compile 16 bit into flash at DP VE_COMMA: 0001d8 ff01 .dw $ff01 0001d9 002c .db ',',0 ; , 0001da 01ca .dw VE_HEAD .set VE_HEAD = VE_COMMA XT_COMMA: 0001db f001 .dw DO_COLON PFA_COMMA: 0001dc f5c9 .dw XT_DP 0001dd f385 .dw XT_STOREI 0001de f5c9 .dw XT_DP 0001df f241 .dw XT_1PLUS 0001e0 fbb4 .dw XT_DOTO 0001e1 f5ca .dw PFA_DP 0001e2 f026 .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: 0001e3 0003 .dw $0003 0001e4 275b 0001e5 005d .db "[']",0 0001e6 01d8 .dw VE_HEAD .set VE_HEAD = VE_BRACKETTICK XT_BRACKETTICK: 0001e7 f001 .dw DO_COLON PFA_BRACKETTICK: .endif 0001e8 f825 .dw XT_TICK 0001e9 01f1 .dw XT_LITERAL 0001ea f026 .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: 0001eb 0007 .dw $0007 0001ec 696c 0001ed 6574 0001ee 6172 0001ef 006c .db "literal",0 0001f0 01e3 .dw VE_HEAD .set VE_HEAD = VE_LITERAL XT_LITERAL: 0001f1 f001 .dw DO_COLON PFA_LITERAL: .endif 0001f2 01d0 .DW XT_COMPILE 0001f3 f046 .DW XT_DOLITERAL 0001f4 01db .DW XT_COMMA 0001f5 f026 .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: 0001f6 0008 .dw $0008 0001f7 6c73 0001f8 7469 0001f9 7265 0001fa 6c61 .db "sliteral" 0001fb 01eb .dw VE_HEAD .set VE_HEAD = VE_SLITERAL XT_SLITERAL: 0001fc f001 .dw DO_COLON PFA_SLITERAL: .endif 0001fd 01d0 .dw XT_COMPILE 0001fe f788 .dw XT_DOSLITERAL ; ( -- addr n) 0001ff f796 .dw XT_SCOMMA 000200 f026 .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: 000201 f001 .dw DO_COLON PFA_GMARK: 000202 f5c9 .dw XT_DP 000203 01d0 .dw XT_COMPILE 000204 ffff .dw -1 ; ffff does not erase flash 000205 f026 .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: 000206 f001 .dw DO_COLON PFA_GRESOLVE: 000207 fb72 .dw XT_QSTACK 000208 f5c9 .dw XT_DP 000209 f0d6 .dw XT_SWAP 00020a f385 .dw XT_STOREI 00020b f026 .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: 00029a f001 .dw DO_COLON PFA_QDOCHECK: .endif 00029b f580 .dw XT_2DUP 00029c fd9a .dw XT_EQUAL 00029d f0c3 .dw XT_DUP 00029e f111 .dw XT_TO_R 00029f f03f .dw XT_DOCONDBRANCH 0002a0 02a2 DEST(PFA_QDOCHECK1) 0002a1 f589 .dw XT_2DROP PFA_QDOCHECK1: 0002a2 f108 .dw XT_R_FROM 0002a3 f20f .dw XT_INVERT 0002a4 f026 .dw XT_EXIT .include "words/endloop.asm" .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_ENDLOOP: 0002a5 ff07 .dw $ff07 0002a6 6e65 0002a7 6c64 0002a8 6f6f 0002a9 0070 .db "endloop",0 0002aa 028e .dw VE_HEAD .set VE_HEAD = VE_ENDLOOP XT_ENDLOOP: 0002ab f001 .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. 0002ac 020f .DW XT_LRESOLVE 0002ad 02b8 0002ae f0cb 0002af f03f LOOP1: .DW XT_L_FROM,XT_QDUP,XT_DOCONDBRANCH 0002b0 02b4 DEST(LOOP2) 0002b1 0234 .DW XT_THEN 0002b2 f035 .dw XT_DOBRANCH 0002b3 02ad DEST(LOOP1) 0002b4 f026 LOOP2: .DW XT_EXIT ; leave address stack .include "words/l-from.asm" .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_L_FROM: 0002b5 ff02 .dw $ff02 0002b6 3e6c .db "l>" 0002b7 02a5 .dw VE_HEAD .set VE_HEAD = VE_L_FROM XT_L_FROM: 0002b8 f001 .dw DO_COLON PFA_L_FROM: .endif ;Z L> -- x L: x -- move from leave stack ; LP @ @ -2 LP +! ; 0002b9 02d7 .dw XT_LP 0002ba f08b .dw XT_FETCH 0002bb f08b .dw XT_FETCH 0002bc f046 .dw XT_DOLITERAL 0002bd fffe .dw -2 0002be 02d7 .dw XT_LP 0002bf f277 .dw XT_PLUSSTORE 0002c0 f026 .dw XT_EXIT .include "words/to-l.asm" .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_TO_L: 0002c1 ff02 .dw $ff02 0002c2 6c3e .db ">l" 0002c3 02b5 .dw VE_HEAD .set VE_HEAD = VE_TO_L XT_TO_L: 0002c4 f001 .dw DO_COLON PFA_TO_L: .endif ;Z >L x -- L: -- x move to leave stack ; CELL LP +! LP @ ! ; (L stack grows up) 0002c5 fda6 .dw XT_TWO 0002c6 02d7 .dw XT_LP 0002c7 f277 .dw XT_PLUSSTORE 0002c8 02d7 .dw XT_LP 0002c9 f08b .dw XT_FETCH 0002ca f093 .dw XT_STORE 0002cb f026 .dw XT_EXIT .include "words/lp0.asm" ; Stack ; start address of leave stack VE_LP0: 0002cc ff03 .dw $ff03 0002cd 706c 0002ce 0030 .db "lp0",0 0002cf 02c1 .dw VE_HEAD .set VE_HEAD = VE_LP0 XT_LP0: 0002d0 f081 .dw PFA_DOVALUE1 PFA_LP0: 0002d1 0052 .dw CFG_LP0 0002d2 fbcf .dw XT_EDEFERFETCH 0002d3 fbd9 .dw XT_EDEFERSTORE .include "words/lp.asm" ; System Variable ; leave stack pointer VE_LP: 0002d4 ff02 .dw $ff02 0002d5 706c .db "lp" 0002d6 02cc .dw VE_HEAD .set VE_HEAD = VE_LP XT_LP: 0002d7 f054 .dw PFA_DOVARIABLE PFA_LP: 0002d8 013b .dw ram_lp .dseg 00013b 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: 0002d9 ff06 .dw $ff06 0002da 7263 0002db 6165 0002dc 6574 .db "create" 0002dd 02d4 .dw VE_HEAD .set VE_HEAD = VE_CREATE XT_CREATE: 0002de f001 .dw DO_COLON PFA_CREATE: .endif 0002df 01ad .dw XT_DOCREATE 0002e0 030d .dw XT_REVEAL 0002e1 01d0 .dw XT_COMPILE 0002e2 f061 .dw PFA_DOCONSTANT 0002e3 f026 .dw XT_EXIT .include "words/header.asm" ; Compiler ; creates the vocabulary header without XT and data field (PF) in the wordlist wid VE_HEADER: 0002e4 ff06 .dw $ff06 0002e5 6568 0002e6 6461 0002e7 7265 .db "header" 0002e8 02d9 .dw VE_HEAD .set VE_HEAD = VE_HEADER XT_HEADER: 0002e9 f001 .dw DO_COLON PFA_HEADER: 0002ea f5c9 .dw XT_DP ; the new Name Field 0002eb f111 .dw XT_TO_R 0002ec f111 .dw XT_TO_R ; ( R: NFA WID ) 0002ed f0c3 .dw XT_DUP 0002ee f13a .dw XT_GREATERZERO 0002ef f03f .dw XT_DOCONDBRANCH 0002f0 02fb .dw PFA_HEADER1 0002f1 f0c3 .dw XT_DUP 0002f2 f046 .dw XT_DOLITERAL 0002f3 ff00 .dw $ff00 ; all flags are off (e.g. immediate) 0002f4 f22e .dw XT_OR 0002f5 f79a .dw XT_DOSCOMMA ; make the link to the previous entry in this wordlist 0002f6 f108 .dw XT_R_FROM 0002f7 f371 .dw XT_FETCHE 0002f8 01db .dw XT_COMMA 0002f9 f108 .dw XT_R_FROM 0002fa f026 .dw XT_EXIT PFA_HEADER1: ; -16: attempt to use zero length string as a name 0002fb f046 .dw XT_DOLITERAL 0002fc fff0 .dw -16 0002fd f85c .dw XT_THROW .include "words/wlscope.asm" ; Compiler ; dynamically place a word in a wordlist. The word name may be changed. VE_WLSCOPE: 0002fe ff07 .dw $ff07 0002ff 6c77 000300 6373 000301 706f 000302 0065 .db "wlscope",0 000303 02e4 .dw VE_HEAD .set VE_HEAD = VE_WLSCOPE XT_WLSCOPE: 000304 fc2e .dw PFA_DODEFER1 PFA_WLSCOPE: 000305 004e .dw CFG_WLSCOPE 000306 fbcf .dw XT_EDEFERFETCH 000307 fbd9 .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: 000308 ff06 .dw $ff06 000309 6572 00030a 6576 00030b 6c61 .db "reveal" 00030c 02fe .dw VE_HEAD .set VE_HEAD = VE_REVEAL XT_REVEAL: 00030d f001 .dw DO_COLON PFA_REVEAL: .endif 00030e 019e 00030f f579 000310 f08b .DW XT_NEWEST,XT_CELLPLUS,XT_FETCH ; only if wordlist is in use 000311 f0cb 000312 f03f .DW XT_QDUP,XT_DOCONDBRANCH 000313 0318 DEST(REVEAL1) 000314 019e 000315 f08b 000316 f0d6 000317 f34d .DW XT_NEWEST,XT_FETCH,XT_SWAP,XT_STOREE ; .DW XT_ZERO,XT_NEWEST,XT_CELLPLUS,XT_STORE ; clean wordlist entry REVEAL1: 000318 f026 .DW XT_EXIT .include "words/does.asm" ; Compiler ; organize the XT replacement to call other colon code VE_DOES: 000319 0005 .dw $0005 00031a 6f64 00031b 7365 00031c 003e .db "does>",0 00031d 0308 .dw VE_HEAD .set VE_HEAD = VE_DOES XT_DOES: 00031e f001 .dw DO_COLON PFA_DOES: 00031f 01d0 .dw XT_COMPILE 000320 0331 .dw XT_DODOES 000321 01d0 .dw XT_COMPILE ; create a code snippet to be used in an embedded XT 000322 940e .dw $940e ; the address of this compiled 000323 01d0 .dw XT_COMPILE ; code will replace the XT of the 000324 0326 .dw DO_DODOES ; word that CREATE created 000325 f026 .dw XT_EXIT ; DO_DODOES: ; ( -- PFA ) 000326 939a 000327 938a savetos 000328 01cb movw tosl, wl 000329 9601 adiw tosl, 1 ; the following takes the address from a real uC-call .if (pclen==3) .endif 00032a 917f pop wh 00032b 916f pop wl 00032c 93bf push XH 00032d 93af push XL 00032e 01db movw XL, wl 00032f 940c f005 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: 000331 f001 .dw DO_COLON PFA_DODOES: 000332 f108 .dw XT_R_FROM 000333 019e .dw XT_NEWEST 000334 f579 .dw XT_CELLPLUS 000335 f08b .dw XT_FETCH 000336 f371 .dw XT_FETCHE 000337 fc99 .dw XT_NFA2CFA 000338 f385 .dw XT_STOREI 000339 f026 .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: 00033a ff01 .dw $ff01 00033b 003a .db ":",0 00033c 0319 .dw VE_HEAD .set VE_HEAD = VE_COLON XT_COLON: 00033d f001 .dw DO_COLON PFA_COLON: .endif 00033e 01ad .dw XT_DOCREATE 00033f 0348 .dw XT_COLONNONAME 000340 f0eb .dw XT_DROP 000341 f026 .dw XT_EXIT .include "words/colon-noname.asm" ; Compiler ; create an unnamed entry in the dictionary, XT is DO_COLON VE_COLONNONAME: 000342 ff07 .dw $ff07 000343 6e3a 000344 6e6f 000345 6d61 000346 0065 .db ":noname",0 000347 033a .dw VE_HEAD .set VE_HEAD = VE_COLONNONAME XT_COLONNONAME: 000348 f001 .dw DO_COLON PFA_COLONNONAME: 000349 f5c9 .dw XT_DP 00034a f0c3 .dw XT_DUP 00034b 01a5 .dw XT_LATEST 00034c f093 .dw XT_STORE 00034d 01d0 .dw XT_COMPILE 00034e f001 .dw DO_COLON 00034f 035d .dw XT_RBRACKET 000350 f026 .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: 000351 0001 .dw $0001 000352 003b .db $3b,0 000353 0342 .dw VE_HEAD .set VE_HEAD = VE_SEMICOLON XT_SEMICOLON: 000354 f001 .dw DO_COLON PFA_SEMICOLON: .endif 000355 01d0 .dw XT_COMPILE 000356 f026 .dw XT_EXIT 000357 0365 .dw XT_LBRACKET 000358 030d .dw XT_REVEAL 000359 f026 .dw XT_EXIT .include "words/right-bracket.asm" ; Compiler ; enter compiler mode .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_RBRACKET: 00035a ff01 .dw $ff01 00035b 005d .db "]",0 00035c 0351 .dw VE_HEAD .set VE_HEAD = VE_RBRACKET XT_RBRACKET: 00035d f001 .dw DO_COLON PFA_RBRACKET: .endif 00035e fda1 .dw XT_ONE 00035f f566 .dw XT_STATE 000360 f093 .dw XT_STORE 000361 f026 .dw XT_EXIT .include "words/left-bracket.asm" ; Compiler ; enter interpreter mode .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_LBRACKET: 000362 0001 .dw $0001 000363 005b .db "[",0 000364 035a .dw VE_HEAD .set VE_HEAD = VE_LBRACKET XT_LBRACKET: 000365 f001 .dw DO_COLON PFA_LBRACKET: .endif 000366 f166 .dw XT_ZERO 000367 f566 .dw XT_STATE 000368 f093 .dw XT_STORE 000369 f026 .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: 00036a ff08 .dw $ff08 00036b 6176 00036c 6972 00036d 6261 00036e 656c .db "variable" 00036f 0362 .dw VE_HEAD .set VE_HEAD = VE_VARIABLE XT_VARIABLE: 000370 f001 .dw DO_COLON PFA_VARIABLE: .endif 000371 f5da .dw XT_HERE 000372 037c .dw XT_CONSTANT 000373 fda6 .dw XT_TWO 000374 f5e3 .dw XT_ALLOT 000375 f026 .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: 000376 ff08 .dw $ff08 000377 6f63 000378 736e 000379 6174 00037a 746e .db "constant" 00037b 036a .dw VE_HEAD .set VE_HEAD = VE_CONSTANT XT_CONSTANT: 00037c f001 .dw DO_COLON PFA_CONSTANT: .endif 00037d 01ad .dw XT_DOCREATE 00037e 030d .dw XT_REVEAL 00037f 01d0 .dw XT_COMPILE 000380 f054 .dw PFA_DOVARIABLE 000381 01db .dw XT_COMMA 000382 f026 .dw XT_EXIT .include "words/user.asm" ; Compiler ; create a dictionary entry for a user variable at offset n VE_USER: 000383 ff04 .dw $ff04 000384 7375 000385 7265 .db "user" 000386 0376 .dw VE_HEAD .set VE_HEAD = VE_USER XT_USER: 000387 f001 .dw DO_COLON PFA_USER: 000388 01ad .dw XT_DOCREATE 000389 030d .dw XT_REVEAL 00038a 01d0 .dw XT_COMPILE 00038b f067 .dw PFA_DOUSER 00038c 01db .dw XT_COMMA 00038d f026 .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: 00038e 0007 .dw $0007 00038f 6572 000390 7563 000391 7372 000392 0065 .db "recurse",0 000393 0383 .dw VE_HEAD .set VE_HEAD = VE_RECURSE XT_RECURSE: 000394 f001 .dw DO_COLON PFA_RECURSE: .endif 000395 01a5 .dw XT_LATEST 000396 f08b .dw XT_FETCH 000397 01db .dw XT_COMMA 000398 f026 .dw XT_EXIT .include "words/immediate.asm" ; Compiler ; set immediate flag for the most recent word definition VE_IMMEDIATE: 000399 ff09 .dw $ff09 00039a 6d69 00039b 656d 00039c 6964 00039d 7461 00039e 0065 .db "immediate",0 00039f 038e .dw VE_HEAD .set VE_HEAD = VE_IMMEDIATE XT_IMMEDIATE: 0003a0 f001 .dw DO_COLON PFA_IMMEDIATE: 0003a1 0442 .dw XT_GET_CURRENT 0003a2 f371 .dw XT_FETCHE 0003a3 f0c3 .dw XT_DUP 0003a4 f3e3 .dw XT_FETCHI 0003a5 f046 .dw XT_DOLITERAL 0003a6 7fff .dw $7fff 0003a7 f225 .dw XT_AND 0003a8 f0d6 .dw XT_SWAP 0003a9 f385 .dw XT_STOREI 0003aa f026 .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: 0003ab 0006 .dw $0006 0003ac 635b 0003ad 6168 0003ae 5d72 .db "[char]" 0003af 0399 .dw VE_HEAD .set VE_HEAD = VE_BRACKETCHAR XT_BRACKETCHAR: 0003b0 f001 .dw DO_COLON PFA_BRACKETCHAR: .endif 0003b1 01d0 .dw XT_COMPILE 0003b2 f046 .dw XT_DOLITERAL 0003b3 f905 .dw XT_CHAR 0003b4 01db .dw XT_COMMA 0003b5 f026 .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: 0003b6 0006 .dw $0006 0003b7 6261 0003b8 726f 0003b9 2274 .db "abort",'"' 0003ba 03ab .dw VE_HEAD .set VE_HEAD = VE_ABORTQUOTE XT_ABORTQUOTE: 0003bb f001 .dw DO_COLON PFA_ABORTQUOTE: .endif 0003bc f4dc .dw XT_SQUOTE 0003bd 01d0 .dw XT_COMPILE 0003be 03cd .dw XT_QABORT 0003bf f026 .DW XT_EXIT .include "words/abort.asm" ; Exceptions ; send an exception -1 .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_ABORT: 0003c0 ff05 .dw $ff05 0003c1 6261 0003c2 726f 0003c3 0074 .db "abort",0 0003c4 03b6 .dw VE_HEAD .set VE_HEAD = VE_ABORT XT_ABORT: 0003c5 f001 .dw DO_COLON PFA_ABORT: .endif 0003c6 f15d .dw XT_TRUE 0003c7 f85c .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: 0003c8 ff06 .dw $ff06 0003c9 613f 0003ca 6f62 0003cb 7472 .db "?abort" 0003cc 03c0 .dw VE_HEAD .set VE_HEAD = VE_QABORT XT_QABORT: 0003cd f001 .dw DO_COLON PFA_QABORT: .endif 0003ce f0f3 0003cf f03f .DW XT_ROT,XT_DOCONDBRANCH 0003d0 03d3 DEST(QABO1) 0003d1 f7bb 0003d2 03c5 .DW XT_ITYPE,XT_ABORT 0003d3 f589 0003d4 f026 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: 0003d5 ff09 .dw $ff09 0003d6 6567 0003d7 2d74 0003d8 7473 0003d9 6361 0003da 006b .db "get-stack",0 0003db 03c8 .dw VE_HEAD .set VE_HEAD = VE_GET_STACK XT_GET_STACK: 0003dc f001 .dw DO_COLON .endif 0003dd f0c3 .dw XT_DUP 0003de f579 .dw XT_CELLPLUS 0003df f0d6 .dw XT_SWAP 0003e0 f371 .dw XT_FETCHE 0003e1 f0c3 .dw XT_DUP 0003e2 f111 .dw XT_TO_R 0003e3 f166 .dw XT_ZERO 0003e4 f0d6 .dw XT_SWAP ; go from bigger to smaller addresses 0003e5 029a .dw XT_QDOCHECK 0003e6 f03f .dw XT_DOCONDBRANCH 0003e7 03f3 DEST(PFA_N_FETCH_E2) 0003e8 f2ad .dw XT_DODO PFA_N_FETCH_E1: ; ( ee-addr ) 0003e9 f2be .dw XT_I 0003ea f247 .dw XT_1MINUS 0003eb f573 .dw XT_CELLS ; ( -- ee-addr i*2 ) 0003ec f0e1 .dw XT_OVER ; ( -- ee-addr i*2 ee-addr ) 0003ed f1af .dw XT_PLUS ; ( -- ee-addr ee-addr+i 0003ee f371 .dw XT_FETCHE ;( -- ee-addr item_i ) 0003ef f0d6 .dw XT_SWAP ;( -- item_i ee-addr ) 0003f0 f15d .dw XT_TRUE ; shortcut for -1 0003f1 f2cc .dw XT_DOPLUSLOOP 0003f2 03e9 DEST(PFA_N_FETCH_E1) PFA_N_FETCH_E2: 0003f3 f589 .dw XT_2DROP 0003f4 f108 .dw XT_R_FROM 0003f5 f026 .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: 0003f6 ff09 .dw $ff09 0003f7 6573 0003f8 2d74 0003f9 7473 0003fa 6361 0003fb 006b .db "set-stack",0 0003fc 03d5 .dw VE_HEAD .set VE_HEAD = VE_SET_STACK XT_SET_STACK: 0003fd f001 .dw DO_COLON PFA_SET_STACK: .endif 0003fe f0e1 .dw XT_OVER 0003ff f133 .dw XT_ZEROLESS 000400 f03f .dw XT_DOCONDBRANCH 000401 0405 DEST(PFA_SET_STACK0) 000402 f046 .dw XT_DOLITERAL 000403 fffc .dw -4 000404 f85c .dw XT_THROW PFA_SET_STACK0: 000405 f580 .dw XT_2DUP 000406 f34d .dw XT_STOREE ; ( -- i_n .. i_0 n e-addr ) 000407 f0d6 .dw XT_SWAP 000408 f166 .dw XT_ZERO 000409 029a .dw XT_QDOCHECK 00040a f03f .dw XT_DOCONDBRANCH 00040b 0412 DEST(PFA_SET_STACK2) 00040c f2ad .dw XT_DODO PFA_SET_STACK1: 00040d f579 .dw XT_CELLPLUS ; ( -- i_x e-addr ) 00040e f591 .dw XT_TUCK ; ( -- e-addr i_x e-addr 00040f f34d .dw XT_STOREE 000410 f2db .dw XT_DOLOOP 000411 040d DEST(PFA_SET_STACK1) PFA_SET_STACK2: 000412 f0eb .dw XT_DROP 000413 f026 .dw XT_EXIT .include "words/map-stack.asm" ; Tools ; Iterate over a stack .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_MAPSTACK: 000414 ff09 .dw $ff09 000415 616d 000416 2d70 000417 7473 000418 6361 000419 006b .db "map-stack",0 00041a 03f6 .dw VE_HEAD .set VE_HEAD = VE_MAPSTACK XT_MAPSTACK: 00041b f001 .dw DO_COLON PFA_MAPSTACK: .endif 00041c f0c3 .dw XT_DUP 00041d f579 .dw XT_CELLPLUS 00041e f0d6 .dw XT_SWAP 00041f f371 .dw XT_FETCHE 000420 f573 .dw XT_CELLS 000421 fd79 .dw XT_BOUNDS 000422 029a .dw XT_QDOCHECK 000423 f03f .dw XT_DOCONDBRANCH 000424 0437 DEST(PFA_MAPSTACK3) 000425 f2ad .dw XT_DODO PFA_MAPSTACK1: 000426 f2be .dw XT_I 000427 f371 .dw XT_FETCHE ; -- i*x XT id 000428 f0d6 .dw XT_SWAP 000429 f111 .dw XT_TO_R 00042a f11a .dw XT_R_FETCH 00042b f030 .dw XT_EXECUTE ; i*x id -- j*y true | i*x false 00042c f0cb .dw XT_QDUP 00042d f03f .dw XT_DOCONDBRANCH 00042e 0433 DEST(PFA_MAPSTACK2) 00042f f108 .dw XT_R_FROM 000430 f0eb .dw XT_DROP 000431 f2e6 .dw XT_UNLOOP 000432 f026 .dw XT_EXIT PFA_MAPSTACK2: 000433 f108 .dw XT_R_FROM 000434 fda6 .dw XT_TWO 000435 f2cc .dw XT_DOPLUSLOOP 000436 0426 DEST(PFA_MAPSTACK1) PFA_MAPSTACK3: 000437 f0eb .dw XT_DROP 000438 f166 .dw XT_ZERO 000439 f026 .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: 00043a ff0b .dw $ff0b 00043b 6567 00043c 2d74 00043d 7563 00043e 7272 00043f 6e65 000440 0074 .db "get-current",0 000441 0414 .dw VE_HEAD .set VE_HEAD = VE_GET_CURRENT XT_GET_CURRENT: 000442 f001 .dw DO_COLON PFA_GET_CURRENT: 000443 f046 .dw XT_DOLITERAL 000444 0058 .dw CFG_CURRENT 000445 f371 .dw XT_FETCHE 000446 f026 .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: 000447 ff09 .dw $ff09 000448 6567 000449 2d74 00044a 726f 00044b 6564 00044c 0072 .db "get-order",0 00044d 043a .dw VE_HEAD .set VE_HEAD = VE_GET_ORDER XT_GET_ORDER: 00044e f001 .dw DO_COLON PFA_GET_ORDER: .endif 00044f f046 .dw XT_DOLITERAL 000450 005c .dw CFG_ORDERLISTLEN 000451 03dc .dw XT_GET_STACK 000452 f026 .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: 000453 ff09 .dw $ff09 000454 6663 000455 2d67 000456 726f 000457 6564 000458 0072 .db "cfg-order",0 000459 0447 .dw VE_HEAD .set VE_HEAD = VE_CFG_ORDER XT_CFG_ORDER: 00045a f054 .dw PFA_DOVARIABLE PFA_CFG_ORDER: .endif 00045b 005c .dw CFG_ORDERLISTLEN .include "words/compare.asm" ; String ; compares two strings in RAM VE_COMPARE: 00045c ff07 .dw $ff07 00045d 6f63 00045e 706d 00045f 7261 000460 0065 .db "compare",0 000461 0453 .dw VE_HEAD .set VE_HEAD = VE_COMPARE XT_COMPARE: 000462 0463 .dw PFA_COMPARE PFA_COMPARE: 000463 93bf push xh 000464 93af push xl 000465 018c movw temp0, tosl 000466 9189 000467 9199 loadtos 000468 01dc movw xl, tosl 000469 9189 00046a 9199 loadtos 00046b 019c movw temp2, tosl 00046c 9189 00046d 9199 loadtos 00046e 01fc movw zl, tosl PFA_COMPARE_LOOP: 00046f 90ed ld temp4, X+ 000470 90f1 ld temp5, Z+ 000471 14ef cp temp4, temp5 000472 f451 brne PFA_COMPARE_NOTEQUAL 000473 950a dec temp0 000474 f019 breq PFA_COMPARE_ENDREACHED2 000475 952a dec temp2 000476 f7c1 brne PFA_COMPARE_LOOP 000477 c001 rjmp PFA_COMPARE_ENDREACHED PFA_COMPARE_ENDREACHED2: 000478 952a dec temp2 PFA_COMPARE_ENDREACHED: 000479 2b02 or temp0, temp2 00047a f411 brne PFA_COMPARE_CHECKLASTCHAR 00047b 2788 clr tosl 00047c c002 rjmp PFA_COMPARE_DONE PFA_COMPARE_CHECKLASTCHAR: PFA_COMPARE_NOTEQUAL: 00047d ef8f ser tosl 00047e c000 rjmp PFA_COMPARE_DONE PFA_COMPARE_DONE: 00047f 2f98 mov tosh, tosl 000480 91af pop xl 000481 91bf pop xh 000482 940c f005 jmp_ DO_NEXT .include "words/nfa2lfa.asm" ; System ; get the link field address from the name field address VE_NFA2LFA: 000484 ff07 .dw $ff07 000485 666e 000486 3e61 000487 666c 000488 0061 .db "nfa>lfa",0 000489 045c .dw VE_HEAD .set VE_HEAD = VE_NFA2LFA XT_NFA2LFA: 00048a f001 .dw DO_COLON PFA_NFA2LFA: 00048b fc8d .dw XT_NAME2STRING 00048c f241 .dw XT_1PLUS 00048d f216 .dw XT_2SLASH 00048e f1af .dw XT_PLUS 00048f f026 .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: 000490 ff02 .dw $ff02 000491 732e .db ".s" 000492 0484 .dw VE_HEAD .set VE_HEAD = VE_DOTS XT_DOTS: 000493 f001 .dw DO_COLON PFA_DOTS: .endif 000494 fabc .dw XT_DEPTH 000495 f463 .dw XT_UDOT 000496 f7fd .dw XT_SPACE 000497 fabc .dw XT_DEPTH 000498 f166 .dw XT_ZERO 000499 029a .dw XT_QDOCHECK 00049a f03f .dw XT_DOCONDBRANCH 00049b 04a2 DEST(PFA_DOTS2) 00049c f2ad .dw XT_DODO PFA_DOTS1: 00049d f2be .dw XT_I 00049e f4ca .dw XT_PICK 00049f f463 .dw XT_UDOT 0004a0 f2db .dw XT_DOLOOP 0004a1 049d DEST(PFA_DOTS1) PFA_DOTS2: 0004a2 f026 .dw XT_EXIT .include "words/spirw.asm" ; MCU ; SPI exchange of 1 byte VE_SPIRW: 0004a3 ff06 .dw $ff06 0004a4 2163 0004a5 7340 0004a6 6970 .db "c!@spi" 0004a7 0490 .dw VE_HEAD .set VE_HEAD = VE_SPIRW XT_SPIRW: 0004a8 04a9 .dw PFA_SPIRW PFA_SPIRW: 0004a9 d003 rcall do_spirw 0004aa 2799 clr tosh 0004ab 940c f005 jmp_ DO_NEXT do_spirw: 0004ad bd8e out_ SPDR, tosl do_spirw1: 0004ae b50d in_ temp0, SPSR 0004af 7f08 cbr temp0,7 0004b0 bd0d out_ SPSR, temp0 0004b1 b50d in_ temp0, SPSR 0004b2 ff07 sbrs temp0, 7 0004b3 cffa rjmp do_spirw1 ; wait until complete 0004b4 b58e in_ tosl, SPDR 0004b5 9508 ret .include "words/n-spi.asm" ; MCU ; read len bytes from SPI to addr VE_N_SPIR: 0004b6 ff05 .dw $ff05 0004b7 406e 0004b8 7073 0004b9 0069 .db "n@spi",0 0004ba 04a3 .dw VE_HEAD .set VE_HEAD = VE_N_SPIR XT_N_SPIR: 0004bb 04bc .dw PFA_N_SPIR PFA_N_SPIR: 0004bc 018c movw temp0, tosl 0004bd 9189 0004be 9199 loadtos 0004bf 01fc movw zl, tosl 0004c0 01c8 movw tosl, temp0 PFA_N_SPIR_LOOP: 0004c1 bc2e out_ SPDR, zerol PFA_N_SPIR_LOOP1: 0004c2 b52d in_ temp2, SPSR 0004c3 ff27 sbrs temp2, SPIF 0004c4 cffd rjmp PFA_N_SPIR_LOOP1 0004c5 b52e in_ temp2, SPDR 0004c6 9321 st Z+, temp2 0004c7 9701 sbiw tosl, 1 0004c8 f7c1 brne PFA_N_SPIR_LOOP 0004c9 9189 0004ca 9199 loadtos 0004cb 940c f005 jmp_ DO_NEXT ; ( addr len -- ) ; MCU ; write len bytes to SPI from addr VE_N_SPIW: 0004cd ff05 .dw $ff05 0004ce 216e 0004cf 7073 0004d0 0069 .db "n!spi",0 0004d1 04b6 .dw VE_HEAD .set VE_HEAD = VE_N_SPIW XT_N_SPIW: 0004d2 04d3 .dw PFA_N_SPIW PFA_N_SPIW: 0004d3 018c movw temp0, tosl 0004d4 9189 0004d5 9199 loadtos 0004d6 01fc movw zl, tosl 0004d7 01c8 movw tosl, temp0 PFA_N_SPIW_LOOP: 0004d8 9121 ld temp2, Z+ 0004d9 bd2e out_ SPDR, temp2 PFA_N_SPIW_LOOP1: 0004da b52d in_ temp2, SPSR 0004db ff27 sbrs temp2, SPIF 0004dc cffd rjmp PFA_N_SPIW_LOOP1 0004dd b52e in_ temp2, SPDR ; ignore the data 0004de 9701 sbiw tosl, 1 0004df f7c1 brne PFA_N_SPIW_LOOP 0004e0 9189 0004e1 9199 loadtos 0004e2 940c f005 jmp_ DO_NEXT .include "words/applturnkey.asm" ; R( -- ) ; application specific turnkey action VE_APPLTURNKEY: 0004e4 ff0b .dw $ff0b 0004e5 7061 0004e6 6c70 0004e7 7574 0004e8 6e72 0004e9 656b 0004ea 0079 .db "applturnkey",0 0004eb 04cd .dw VE_HEAD .set VE_HEAD = VE_APPLTURNKEY XT_APPLTURNKEY: 0004ec f001 .dw DO_COLON PFA_APPLTURNKEY: 0004ed 00da .dw XT_USART .if WANT_INTERRUPTS == 1 0004ee f494 .dw XT_INTON .endif 0004ef fb7f .dw XT_DOT_VER 0004f0 f7fd .dw XT_SPACE 0004f1 f55b .dw XT_F_CPU 0004f2 f046 .dw XT_DOLITERAL 0004f3 03e8 .dw 1000 0004f4 f1d4 .dw XT_UMSLASHMOD 0004f5 f102 .dw XT_NIP 0004f6 f5f8 .dw XT_DECIMAL 0004f7 f73d .dw XT_DOT 0004f8 f788 .dw XT_DOSLITERAL 0004f9 0004 .dw 4 0004fa 486b 0004fb 207a .db "kHz " 0004fc f7bb .dw XT_ITYPE 0004fd f026 .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: 0004fe ff0b .dw $ff0b 0004ff 6573 000500 2d74 000501 7563 000502 7272 000503 6e65 000504 0074 .db "set-current",0 000505 04e4 .dw VE_HEAD .set VE_HEAD = VE_SET_CURRENT XT_SET_CURRENT: 000506 f001 .dw DO_COLON PFA_SET_CURRENT: 000507 f046 .dw XT_DOLITERAL 000508 0058 .dw CFG_CURRENT 000509 f34d .dw XT_STOREE 00050a f026 .dw XT_EXIT .include "words/wordlist.asm" ; Search Order ; create a new, empty wordlist VE_WORDLIST: 00050b ff08 .dw $ff08 00050c 6f77 00050d 6472 00050e 696c 00050f 7473 .db "wordlist" 000510 04fe .dw VE_HEAD .set VE_HEAD = VE_WORDLIST XT_WORDLIST: 000511 f001 .dw DO_COLON PFA_WORDLIST: 000512 f5d2 .dw XT_EHERE 000513 f166 .dw XT_ZERO 000514 f0e1 .dw XT_OVER 000515 f34d .dw XT_STOREE 000516 f0c3 .dw XT_DUP 000517 f579 .dw XT_CELLPLUS 000518 fbb4 .dw XT_DOTO 000519 f5d3 .dw PFA_EHERE 00051a f026 .dw XT_EXIT .include "words/forth-wordlist.asm" ; Search Order ; get the system default word list VE_FORTHWORDLIST: 00051b ff0e .dw $ff0e 00051c 6f66 00051d 7472 00051e 2d68 00051f 6f77 000520 6472 000521 696c 000522 7473 .db "forth-wordlist" 000523 050b .dw VE_HEAD .set VE_HEAD = VE_FORTHWORDLIST XT_FORTHWORDLIST: 000524 f054 .dw PFA_DOVARIABLE PFA_FORTHWORDLIST: 000525 005a .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: 000526 ff09 .dw $ff09 000527 6573 000528 2d74 000529 726f 00052a 6564 00052b 0072 .db "set-order",0 00052c 051b .dw VE_HEAD .set VE_HEAD = VE_SET_ORDER XT_SET_ORDER: 00052d f001 .dw DO_COLON PFA_SET_ORDER: .endif 00052e f046 .dw XT_DOLITERAL 00052f 005c .dw CFG_ORDERLISTLEN 000530 03fd .dw XT_SET_STACK 000531 f026 .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: 000532 ff0f .dw $ff0f 000533 6573 000534 2d74 000535 6572 000536 6f63 000537 6e67 000538 7a69 000539 7265 00053a 0073 .db "set-recognizers",0 00053b 0526 .dw VE_HEAD .set VE_HEAD = VE_SET_RECOGNIZERS XT_SET_RECOGNIZERS: 00053c f001 .dw DO_COLON PFA_SET_RECOGNIZERS: .endif 00053d f046 .dw XT_DOLITERAL 00053e 006e .dw CFG_RECOGNIZERLISTLEN 00053f 03fd .dw XT_SET_STACK 000540 f026 .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: 000541 ff0f .dw $ff0f 000542 6567 000543 2d74 000544 6572 000545 6f63 000546 6e67 000547 7a69 000548 7265 000549 0073 .db "get-recognizers",0 00054a 0532 .dw VE_HEAD .set VE_HEAD = VE_GET_RECOGNIZERS XT_GET_RECOGNIZERS: 00054b f001 .dw DO_COLON PFA_GET_RECOGNIZERS: .endif 00054c f046 .dw XT_DOLITERAL 00054d 006e .dw CFG_RECOGNIZERLISTLEN 00054e 03dc .dw XT_GET_STACK 00054f f026 .dw XT_EXIT .include "words/code.asm" ; Compiler ; create named entry in the dictionary, XT is the data field VE_CODE: 000550 ff04 .dw $ff04 000551 6f63 000552 6564 .db "code" 000553 0541 .dw VE_HEAD .set VE_HEAD = VE_CODE XT_CODE: 000554 f001 .dw DO_COLON PFA_CODE: 000555 01ad .dw XT_DOCREATE 000556 030d .dw XT_REVEAL 000557 f5c9 .dw XT_DP 000558 fbc6 .dw XT_ICELLPLUS 000559 01db .dw XT_COMMA 00055a f026 .dw XT_EXIT .include "words/end-code.asm" ; Compiler ; finish a code definition VE_ENDCODE: 00055b ff08 .dw $ff08 00055c 6e65 00055d 2d64 00055e 6f63 00055f 6564 .db "end-code" 000560 0550 .dw VE_HEAD .set VE_HEAD = VE_ENDCODE XT_ENDCODE: 000561 f001 .dw DO_COLON PFA_ENDCODE: 000562 01d0 .dw XT_COMPILE 000563 940c .dw $940c 000564 01d0 .dw XT_COMPILE 000565 f005 .dw DO_NEXT 000566 f026 .dw XT_EXIT .include "words/marker.asm" ; System Value ; The eeprom address until which MARKER saves and restores the eeprom data. VE_MARKER: 000567 ff08 .dw $ff08 000568 6d28 000569 7261 00056a 656b 00056b 2972 .db "(marker)" 00056c 055b .dw VE_HEAD .set VE_HEAD = VE_MARKER XT_MARKER: 00056d f081 .dw PFA_DOVALUE1 PFA_MARKER: 00056e 007a .dw EE_MARKER 00056f fbcf .dw XT_EDEFERFETCH 000570 fbd9 .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: 000571 0008 .dw $0008 000572 6f70 000573 7473 000574 6f70 000575 656e .db "postpone" 000576 0567 .dw VE_HEAD .set VE_HEAD = VE_POSTPONE XT_POSTPONE: 000577 f001 .dw DO_COLON PFA_POSTPONE: .endif 000578 f9cf .dw XT_PARSENAME 000579 fae7 .dw XT_FORTHRECOGNIZER 00057a faf2 .dw XT_RECOGNIZE 00057b f0c3 .dw XT_DUP 00057c f111 .dw XT_TO_R 00057d fbc6 .dw XT_ICELLPLUS 00057e fbc6 .dw XT_ICELLPLUS 00057f f3e3 .dw XT_FETCHI 000580 f030 .dw XT_EXECUTE 000581 f108 .dw XT_R_FROM 000582 fbc6 .dw XT_ICELLPLUS 000583 f3e3 .dw XT_FETCHI 000584 01db .dw XT_COMMA 000585 f026 .dw XT_EXIT .endif .include "words/2r_fetch.asm" ; Stack ; fetch content of TOR VE_2R_FETCH: 000586 ff03 .dw $ff03 000587 7232 000588 0040 .db "2r@",0 000589 0571 .dw VE_HEAD .set VE_HEAD = VE_2R_FETCH XT_2R_FETCH: 00058a 058b .dw PFA_2R_FETCH PFA_2R_FETCH: 00058b 939a 00058c 938a savetos 00058d 91ef pop zl 00058e 91ff pop zh 00058f 918f pop tosl 000590 919f pop tosh 000591 939f push tosh 000592 938f push tosl 000593 93ff push zh 000594 93ef push zl 000595 939a 000596 938a savetos 000597 01cf movw tosl, zl 000598 940c f005 jmp_ DO_NEXT .set DPSTART = pc .if(pc>AMFORTH_RO_SEG) .endif .org AMFORTH_RO_SEG .include "amforth-interpreter.asm" DO_COLON: 00f001 93bf push XH 00f002 93af push XL ; PUSH IP 00f003 01db movw XL, wl 00f004 9611 adiw xl, 1 DO_NEXT: .if WANT_INTERRUPTS == 1 00f005 14b2 cp isrflag, zerol 00f006 f499 brne DO_INTERRUPT .endif 00f007 01fd movw zl, XL ; READ IP 00f008 2755 00f009 0fee 00f00a 1fff 00f00b 1f55 00f00c bf5b 00f00d 9167 00f00e 9177 readflashcell wl, wh 00f00f 9611 adiw XL, 1 ; INC IP DO_EXECUTE: 00f010 01fb movw zl, wl 00f011 2755 00f012 0fee 00f013 1fff 00f014 1f55 00f015 bf5b 00f016 9107 00f017 9117 readflashcell temp0,temp1 00f018 01f8 movw zl, temp0 00f019 9409 ijmp .if WANT_INTERRUPTS == 1 DO_INTERRUPT: ; here we deal with interrupts the forth way 00f01a 939a 00f01b 938a savetos 00f01c 2d8b mov tosl, isrflag 00f01d 2799 clr tosh 00f01e 24bb clr isrflag 00f01f eb6d ldi wl, LOW(XT_ISREXEC) 00f020 ef74 ldi wh, HIGH(XT_ISREXEC) 00f021 cfee 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: 00f022 ff04 .dw $ff04 00f023 7865 00f024 7469 .db "exit" 00f025 0586 .dw VE_HEAD .set VE_HEAD = VE_EXIT XT_EXIT: 00f026 f027 .dw PFA_EXIT PFA_EXIT: 00f027 91af pop XL 00f028 91bf pop XH 00f029 cfdb jmp_ DO_NEXT .include "words/execute.asm" ; System ; execute XT VE_EXECUTE: 00f02a ff07 .dw $ff07 00f02b 7865 00f02c 6365 00f02d 7475 00f02e 0065 .db "execute",0 00f02f f022 .dw VE_HEAD .set VE_HEAD = VE_EXECUTE XT_EXECUTE: 00f030 f031 .dw PFA_EXECUTE PFA_EXECUTE: 00f031 01bc movw wl, tosl 00f032 9189 00f033 9199 loadtos 00f034 cfdb 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: 00f035 f036 .dw PFA_DOBRANCH PFA_DOBRANCH: 00f036 01fd movw zl, XL 00f037 2755 00f038 0fee 00f039 1fff 00f03a 1f55 00f03b bf5b 00f03c 91a7 00f03d 91b7 readflashcell XL,XH 00f03e cfc6 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: 00f03f f040 .dw PFA_DOCONDBRANCH PFA_DOCONDBRANCH: 00f040 2b98 or tosh, tosl 00f041 9189 00f042 9199 loadtos 00f043 f391 brbs 1, PFA_DOBRANCH ; 1 is z flag; if tos is zero (false), do the branch 00f044 9611 adiw XL, 1 00f045 cfbf 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: 00f046 f047 .dw PFA_DOLITERAL PFA_DOLITERAL: 00f047 939a 00f048 938a savetos 00f049 01fd movw zl, xl 00f04a 2755 00f04b 0fee 00f04c 1fff 00f04d 1f55 00f04e bf5b 00f04f 9187 00f050 9197 readflashcell tosl,tosh 00f051 9611 adiw xl, 1 00f052 cfb2 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: 00f053 f054 .dw PFA_DOVARIABLE PFA_DOVARIABLE: 00f054 939a 00f055 938a savetos 00f056 01fb movw zl, wl 00f057 9631 adiw zl,1 00f058 2755 00f059 0fee 00f05a 1fff 00f05b 1f55 00f05c bf5b 00f05d 9187 00f05e 9197 readflashcell tosl,tosh 00f05f cfa5 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: 00f060 f061 .dw PFA_DOCONSTANT PFA_DOCONSTANT: 00f061 939a 00f062 938a savetos 00f063 01cb movw tosl, wl 00f064 9601 adiw tosl, 1 00f065 cf9f 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: 00f066 f067 .dw PFA_DOUSER PFA_DOUSER: 00f067 939a 00f068 938a savetos 00f069 01fb movw zl, wl 00f06a 9631 adiw zl, 1 00f06b 2755 00f06c 0fee 00f06d 1fff 00f06e 1f55 00f06f bf5b 00f070 9187 00f071 9197 readflashcell tosl,tosh 00f072 0d84 add tosl, upl 00f073 1d95 adc tosh, uph 00f074 cf90 jmp_ DO_NEXT .include "words/do-value.asm" ; System ; runtime of value VE_DOVALUE: 00f075 ff07 .dw $ff07 00f076 7628 00f077 6c61 00f078 6575 00f079 0029 .db "(value)", 0 00f07a f02a .dw VE_HEAD .set VE_HEAD = VE_DOVALUE XT_DOVALUE: 00f07b f001 .dw DO_COLON PFA_DOVALUE: 00f07c 01ad .dw XT_DOCREATE 00f07d 030d .dw XT_REVEAL 00f07e 01d0 .dw XT_COMPILE 00f07f f081 .dw PFA_DOVALUE1 00f080 f026 .dw XT_EXIT PFA_DOVALUE1: 00f081 940e 0326 call_ DO_DODOES 00f083 f0c3 .dw XT_DUP 00f084 fbc6 .dw XT_ICELLPLUS 00f085 f3e3 .dw XT_FETCHI 00f086 f030 .dw XT_EXECUTE 00f087 f026 .dw XT_EXIT ; : (value) dup icell+ @i execute ; .include "words/fetch.asm" ; Memory ; read 1 cell from RAM address VE_FETCH: 00f088 ff01 .dw $ff01 00f089 0040 .db "@",0 00f08a f075 .dw VE_HEAD .set VE_HEAD = VE_FETCH XT_FETCH: 00f08b f08c .dw PFA_FETCH PFA_FETCH: .if WANT_UNIFIED == 1 .endif PFA_FETCHRAM: 00f08c 01fc movw zl, tosl ; low byte is read before the high byte 00f08d 9181 ld tosl, z+ 00f08e 9191 ld tosh, z+ 00f08f cf75 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: 00f090 ff01 .dw $ff01 00f091 0021 .db "!",0 00f092 f088 .dw VE_HEAD .set VE_HEAD = VE_STORE XT_STORE: 00f093 f094 .dw PFA_STORE PFA_STORE: .if WANT_UNIFIED == 1 .endif PFA_STORERAM: 00f094 01fc movw zl, tosl 00f095 9189 00f096 9199 loadtos ; the high byte is written before the low byte 00f097 8391 std Z+1, tosh 00f098 8380 std Z+0, tosl 00f099 9189 00f09a 9199 loadtos 00f09b cf69 jmp_ DO_NEXT .if WANT_UNIFIED == 1 .endif .include "words/cstore.asm" ; Memory ; store a single byte to RAM address VE_CSTORE: 00f09c ff02 .dw $ff02 00f09d 2163 .db "c!" 00f09e f090 .dw VE_HEAD .set VE_HEAD = VE_CSTORE XT_CSTORE: 00f09f f0a0 .dw PFA_CSTORE PFA_CSTORE: 00f0a0 01fc movw zl, tosl 00f0a1 9189 00f0a2 9199 loadtos 00f0a3 8380 st Z, tosl 00f0a4 9189 00f0a5 9199 loadtos 00f0a6 cf5e jmp_ DO_NEXT .include "words/cfetch.asm" ; Memory ; fetch a single byte from memory mapped locations VE_CFETCH: 00f0a7 ff02 .dw $ff02 00f0a8 4063 .db "c@" 00f0a9 f09c .dw VE_HEAD .set VE_HEAD = VE_CFETCH XT_CFETCH: 00f0aa f0ab .dw PFA_CFETCH PFA_CFETCH: 00f0ab 01fc movw zl, tosl 00f0ac 2799 clr tosh 00f0ad 8180 ld tosl, Z 00f0ae cf56 jmp_ DO_NEXT .include "words/fetch-u.asm" ; Memory ; read 1 cell from USER area VE_FETCHU: 00f0af ff02 .dw $ff02 00f0b0 7540 .db "@u" 00f0b1 f0a7 .dw VE_HEAD .set VE_HEAD = VE_FETCHU XT_FETCHU: 00f0b2 f001 .dw DO_COLON PFA_FETCHU: 00f0b3 f314 .dw XT_UP_FETCH 00f0b4 f1af .dw XT_PLUS 00f0b5 f08b .dw XT_FETCH 00f0b6 f026 .dw XT_EXIT .include "words/store-u.asm" ; Memory ; write n to USER area at offset VE_STOREU: 00f0b7 ff02 .dw $ff02 00f0b8 7521 .db "!u" 00f0b9 f0af .dw VE_HEAD .set VE_HEAD = VE_STOREU XT_STOREU: 00f0ba f001 .dw DO_COLON PFA_STOREU: 00f0bb f314 .dw XT_UP_FETCH 00f0bc f1af .dw XT_PLUS 00f0bd f093 .dw XT_STORE 00f0be f026 .dw XT_EXIT ;;;;;;;;;;;;;;;;;;;;;;;;; .include "words/dup.asm" ; Stack ; duplicate TOS VE_DUP: 00f0bf ff03 .dw $ff03 00f0c0 7564 00f0c1 0070 .db "dup",0 00f0c2 f0b7 .dw VE_HEAD .set VE_HEAD = VE_DUP XT_DUP: 00f0c3 f0c4 .dw PFA_DUP PFA_DUP: 00f0c4 939a 00f0c5 938a savetos 00f0c6 cf3e jmp_ DO_NEXT .include "words/qdup.asm" ; Stack ; duplicate TOS if non-zero VE_QDUP: 00f0c7 ff04 .dw $ff04 00f0c8 643f 00f0c9 7075 .db "?dup" 00f0ca f0bf .dw VE_HEAD .set VE_HEAD = VE_QDUP XT_QDUP: 00f0cb f0cc .dw PFA_QDUP PFA_QDUP: 00f0cc 2f08 mov temp0, tosl 00f0cd 2b09 or temp0, tosh 00f0ce f011 breq PFA_QDUP1 00f0cf 939a 00f0d0 938a savetos PFA_QDUP1: 00f0d1 cf33 jmp_ DO_NEXT .include "words/swap.asm" ; Stack ; swaps the two top level stack cells VE_SWAP: 00f0d2 ff04 .dw $ff04 00f0d3 7773 00f0d4 7061 .db "swap" 00f0d5 f0c7 .dw VE_HEAD .set VE_HEAD = VE_SWAP XT_SWAP: 00f0d6 f0d7 .dw PFA_SWAP PFA_SWAP: 00f0d7 018c movw temp0, tosl 00f0d8 9189 00f0d9 9199 loadtos 00f0da 931a st -Y, temp1 00f0db 930a st -Y, temp0 00f0dc cf28 jmp_ DO_NEXT .include "words/over.asm" ; Stack ; Place a copy of x1 on top of the stack VE_OVER: 00f0dd ff04 .dw $ff04 00f0de 766f 00f0df 7265 .db "over" 00f0e0 f0d2 .dw VE_HEAD .set VE_HEAD = VE_OVER XT_OVER: 00f0e1 f0e2 .dw PFA_OVER PFA_OVER: 00f0e2 939a 00f0e3 938a savetos 00f0e4 818a ldd tosl, Y+2 00f0e5 819b ldd tosh, Y+3 00f0e6 cf1e jmp_ DO_NEXT .include "words/drop.asm" ; Stack ; drop TOS VE_DROP: 00f0e7 ff04 .dw $ff04 00f0e8 7264 00f0e9 706f .db "drop" 00f0ea f0dd .dw VE_HEAD .set VE_HEAD = VE_DROP XT_DROP: 00f0eb f0ec .dw PFA_DROP PFA_DROP: 00f0ec 9189 00f0ed 9199 loadtos 00f0ee cf16 jmp_ DO_NEXT .include "words/rot.asm" ; Stack ; rotate the three top level cells VE_ROT: 00f0ef ff03 .dw $ff03 00f0f0 6f72 00f0f1 0074 .db "rot",0 00f0f2 f0e7 .dw VE_HEAD .set VE_HEAD = VE_ROT XT_ROT: 00f0f3 f0f4 .dw PFA_ROT PFA_ROT: 00f0f4 018c movw temp0, tosl 00f0f5 9129 ld temp2, Y+ 00f0f6 9139 ld temp3, Y+ 00f0f7 9189 00f0f8 9199 loadtos 00f0f9 933a st -Y, temp3 00f0fa 932a st -Y, temp2 00f0fb 931a st -Y, temp1 00f0fc 930a st -Y, temp0 00f0fd cf07 jmp_ DO_NEXT .include "words/nip.asm" ; Stack ; Remove Second of Stack VE_NIP: 00f0fe ff03 .dw $ff03 00f0ff 696e 00f100 0070 .db "nip",0 00f101 f0ef .dw VE_HEAD .set VE_HEAD = VE_NIP XT_NIP: 00f102 f103 .dw PFA_NIP PFA_NIP: 00f103 9622 adiw yl, 2 00f104 cf00 jmp_ DO_NEXT ;;;;;;;;;;;;;;;;;;;;;;;;; .include "words/r_from.asm" ; Stack ; move TOR to TOS VE_R_FROM: 00f105 ff02 .dw $ff02 00f106 3e72 .db "r>" 00f107 f0fe .dw VE_HEAD .set VE_HEAD = VE_R_FROM XT_R_FROM: 00f108 f109 .dw PFA_R_FROM PFA_R_FROM: 00f109 939a 00f10a 938a savetos 00f10b 918f pop tosl 00f10c 919f pop tosh 00f10d cef7 jmp_ DO_NEXT .include "words/to_r.asm" ; Stack ; move TOS to TOR VE_TO_R: 00f10e ff02 .dw $ff02 00f10f 723e .db ">r" 00f110 f105 .dw VE_HEAD .set VE_HEAD = VE_TO_R XT_TO_R: 00f111 f112 .dw PFA_TO_R PFA_TO_R: 00f112 939f push tosh 00f113 938f push tosl 00f114 9189 00f115 9199 loadtos 00f116 ceee jmp_ DO_NEXT .include "words/r_fetch.asm" ; Stack ; fetch content of TOR VE_R_FETCH: 00f117 ff02 .dw $ff02 00f118 4072 .db "r@" 00f119 f10e .dw VE_HEAD .set VE_HEAD = VE_R_FETCH XT_R_FETCH: 00f11a f11b .dw PFA_R_FETCH PFA_R_FETCH: 00f11b 939a 00f11c 938a savetos 00f11d 918f pop tosl 00f11e 919f pop tosh 00f11f 939f push tosh 00f120 938f push tosl 00f121 cee3 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: 00f122 ff02 .dw $ff02 00f123 3e3c .db "<>" 00f124 f117 .dw VE_HEAD .set VE_HEAD = VE_NOTEQUAL XT_NOTEQUAL: 00f125 f001 .dw DO_COLON PFA_NOTEQUAL: .endif 00f126 fd9a 00f127 f12c 00f128 f026 .DW XT_EQUAL,XT_ZEROEQUAL,XT_EXIT .include "words/equalzero.asm" ; Compare ; compare with 0 (zero) VE_ZEROEQUAL: 00f129 ff02 .dw $ff02 00f12a 3d30 .db "0=" 00f12b f122 .dw VE_HEAD .set VE_HEAD = VE_ZEROEQUAL XT_ZEROEQUAL: 00f12c f12d .dw PFA_ZEROEQUAL PFA_ZEROEQUAL: 00f12d 2b98 or tosh, tosl 00f12e f5d1 brne PFA_ZERO1 00f12f c030 rjmp PFA_TRUE1 .include "words/lesszero.asm" ; Compare ; compare with zero VE_ZEROLESS: 00f130 ff02 .dw $ff02 00f131 3c30 .db "0<" 00f132 f129 .dw VE_HEAD .set VE_HEAD = VE_ZEROLESS XT_ZEROLESS: 00f133 f134 .dw PFA_ZEROLESS PFA_ZEROLESS: 00f134 fd97 sbrc tosh,7 00f135 c02a rjmp PFA_TRUE1 00f136 c032 rjmp PFA_ZERO1 .include "words/greaterzero.asm" ; Compare ; true if n1 is greater than 0 VE_GREATERZERO: 00f137 ff02 .dw $ff02 00f138 3e30 .db "0>" 00f139 f130 .dw VE_HEAD .set VE_HEAD = VE_GREATERZERO XT_GREATERZERO: 00f13a f13b .dw PFA_GREATERZERO PFA_GREATERZERO: 00f13b 1582 cp tosl, zerol 00f13c 0593 cpc tosh, zeroh 00f13d f15c brlt PFA_ZERO1 00f13e f151 brbs 1, PFA_ZERO1 00f13f c020 rjmp PFA_TRUE1 .include "words/d-greaterzero.asm" ; Compare ; compares if a double double cell number is greater 0 VE_DGREATERZERO: 00f140 ff03 .dw $ff03 00f141 3064 00f142 003e .db "d0>",0 00f143 f137 .dw VE_HEAD .set VE_HEAD = VE_DGREATERZERO XT_DGREATERZERO: 00f144 f145 .dw PFA_DGREATERZERO PFA_DGREATERZERO: 00f145 1582 cp tosl, zerol 00f146 0593 cpc tosh, zeroh 00f147 9189 00f148 9199 loadtos 00f149 0582 cpc tosl, zerol 00f14a 0593 cpc tosh, zeroh 00f14b f0ec brlt PFA_ZERO1 00f14c f0e1 brbs 1, PFA_ZERO1 00f14d c012 rjmp PFA_TRUE1 .include "words/d-lesszero.asm" ; Compare ; compares if a double double cell number is less than 0 VE_DXT_ZEROLESS: 00f14e ff03 .dw $ff03 00f14f 3064 00f150 003c .db "d0<",0 00f151 f140 .dw VE_HEAD .set VE_HEAD = VE_DXT_ZEROLESS XT_DXT_ZEROLESS: 00f152 f153 .dw PFA_DXT_ZEROLESS PFA_DXT_ZEROLESS: 00f153 9622 adiw Y,2 00f154 fd97 sbrc tosh,7 00f155 940c f160 jmp PFA_TRUE1 00f157 940c f169 jmp PFA_ZERO1 .include "words/true.asm" ; Arithmetics ; leaves the value -1 (true) on TOS VE_TRUE: 00f159 ff04 .dw $ff04 00f15a 7274 00f15b 6575 .db "true" 00f15c f14e .dw VE_HEAD .set VE_HEAD = VE_TRUE XT_TRUE: 00f15d f15e .dw PFA_TRUE PFA_TRUE: 00f15e 939a 00f15f 938a savetos PFA_TRUE1: 00f160 ef8f ser tosl 00f161 ef9f ser tosh 00f162 cea2 jmp_ DO_NEXT .include "words/zero.asm" ; Arithmetics ; place a value 0 on TOS VE_ZERO: 00f163 ff01 .dw $ff01 00f164 0030 .db "0",0 00f165 f159 .dw VE_HEAD .set VE_HEAD = VE_ZERO XT_ZERO: 00f166 f167 .dw PFA_ZERO PFA_ZERO: 00f167 939a 00f168 938a savetos PFA_ZERO1: 00f169 01c1 movw tosl, zerol 00f16a ce9a jmp_ DO_NEXT .include "words/uless.asm" ; Compare ; true if u1 < u2 (unsigned) VE_ULESS: 00f16b ff02 .dw $ff02 00f16c 3c75 .db "u<" 00f16d f163 .dw VE_HEAD .set VE_HEAD = VE_ULESS XT_ULESS: 00f16e f16f .dw PFA_ULESS PFA_ULESS: 00f16f 9129 ld temp2, Y+ 00f170 9139 ld temp3, Y+ 00f171 1782 cp tosl, temp2 00f172 0793 cpc tosh, temp3 00f173 f3a8 brlo PFA_ZERO1 00f174 f3a1 brbs 1, PFA_ZERO1 00f175 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: 00f176 ff02 .dw $ff02 00f177 3e75 .db "u>" 00f178 f16b .dw VE_HEAD .set VE_HEAD = VE_UGREATER XT_UGREATER: 00f179 f001 .dw DO_COLON PFA_UGREATER: .endif 00f17a f0d6 .DW XT_SWAP 00f17b f16e .dw XT_ULESS 00f17c f026 .dw XT_EXIT .include "words/less.asm" ; Compare ; true if n1 is less than n2 VE_LESS: 00f17d ff01 .dw $ff01 00f17e 003c .db "<",0 00f17f f176 .dw VE_HEAD .set VE_HEAD = VE_LESS XT_LESS: 00f180 f181 .dw PFA_LESS PFA_LESS: 00f181 9129 ld temp2, Y+ 00f182 9139 ld temp3, Y+ 00f183 1728 cp temp2, tosl 00f184 0739 cpc temp3, tosh PFA_LESSDONE: 00f185 f71c brge PFA_ZERO1 00f186 cfd9 rjmp PFA_TRUE1 .include "words/greater.asm" ; Compare ; flag is true if n1 is greater than n2 VE_GREATER: 00f187 ff01 .dw $ff01 00f188 003e .db ">",0 00f189 f17d .dw VE_HEAD .set VE_HEAD = VE_GREATER XT_GREATER: 00f18a f18b .dw PFA_GREATER PFA_GREATER: 00f18b 9129 ld temp2, Y+ 00f18c 9139 ld temp3, Y+ 00f18d 1728 cp temp2, tosl 00f18e 0739 cpc temp3, tosh PFA_GREATERDONE: 00f18f f2cc brlt PFA_ZERO1 00f190 f2c1 brbs 1, PFA_ZERO1 00f191 cfce rjmp PFA_TRUE1 .include "words/log2.asm" ; Arithmetics ; logarithm to base 2 or highest set bitnumber VE_LOG2: 00f192 ff04 .dw $ff04 00f193 6f6c 00f194 3267 .db "log2" 00f195 f187 .dw VE_HEAD .set VE_HEAD = VE_LOG2 XT_LOG2: 00f196 f197 .dw PFA_LOG2 PFA_LOG2: 00f197 01fc movw zl, tosl 00f198 2799 clr tosh 00f199 e180 ldi tosl, 16 PFA_LOG2_1: 00f19a 958a dec tosl 00f19b f022 brmi PFA_LOG2_2 ; wrong data 00f19c 0fee lsl zl 00f19d 1fff rol zh 00f19e f7d8 brcc PFA_LOG2_1 00f19f ce65 jmp_ DO_NEXT PFA_LOG2_2: 00f1a0 959a dec tosh 00f1a1 ce63 jmp_ DO_NEXT .include "words/minus.asm" ; Arithmetics ; subtract n2 from n1 VE_MINUS: 00f1a2 ff01 .dw $ff01 00f1a3 002d .db "-",0 00f1a4 f192 .dw VE_HEAD .set VE_HEAD = VE_MINUS XT_MINUS: 00f1a5 f1a6 .dw PFA_MINUS PFA_MINUS: 00f1a6 9109 ld temp0, Y+ 00f1a7 9119 ld temp1, Y+ 00f1a8 1b08 sub temp0, tosl 00f1a9 0b19 sbc temp1, tosh 00f1aa 01c8 movw tosl, temp0 00f1ab ce59 jmp_ DO_NEXT .include "words/plus.asm" ; Arithmetics ; add n1 and n2 VE_PLUS: 00f1ac ff01 .dw $ff01 00f1ad 002b .db "+",0 00f1ae f1a2 .dw VE_HEAD .set VE_HEAD = VE_PLUS XT_PLUS: 00f1af f1b0 .dw PFA_PLUS PFA_PLUS: 00f1b0 9109 ld temp0, Y+ 00f1b1 9119 ld temp1, Y+ 00f1b2 0f80 add tosl, temp0 00f1b3 1f91 adc tosh, temp1 00f1b4 ce50 jmp_ DO_NEXT .include "words/mstar.asm" ; Arithmetics ; multiply 2 cells to a double cell VE_MSTAR: 00f1b5 ff02 .dw $ff02 00f1b6 2a6d .db "m*" 00f1b7 f1ac .dw VE_HEAD .set VE_HEAD = VE_MSTAR XT_MSTAR: 00f1b8 f1b9 .dw PFA_MSTAR PFA_MSTAR: 00f1b9 018c movw temp0, tosl 00f1ba 9189 00f1bb 9199 loadtos 00f1bc 019c movw temp2, tosl ; high cell ah*bh 00f1bd 0231 muls temp3, temp1 00f1be 0170 movw temp4, r0 ; low cell al*bl 00f1bf 9f20 mul temp2, temp0 00f1c0 01c0 movw tosl, r0 ; signed ah*bl 00f1c1 0330 mulsu temp3, temp0 00f1c2 08f3 sbc temp5, zeroh 00f1c3 0d90 add tosh, r0 00f1c4 1ce1 adc temp4, r1 00f1c5 1cf3 adc temp5, zeroh ; signed al*bh 00f1c6 0312 mulsu temp1, temp2 00f1c7 08f3 sbc temp5, zeroh 00f1c8 0d90 add tosh, r0 00f1c9 1ce1 adc temp4, r1 00f1ca 1cf3 adc temp5, zeroh 00f1cb 939a 00f1cc 938a savetos 00f1cd 01c7 movw tosl, temp4 00f1ce ce36 jmp_ DO_NEXT .include "words/umslashmod.asm" ; Arithmetics ; unsigned division ud / u2 with remainder VE_UMSLASHMOD: 00f1cf ff06 .dw $ff06 00f1d0 6d75 00f1d1 6d2f 00f1d2 646f .db "um/mod" 00f1d3 f1b5 .dw VE_HEAD .set VE_HEAD = VE_UMSLASHMOD XT_UMSLASHMOD: 00f1d4 f1d5 .dw PFA_UMSLASHMOD PFA_UMSLASHMOD: 00f1d5 017c movw temp4, tosl 00f1d6 9129 ld temp2, Y+ 00f1d7 9139 ld temp3, Y+ 00f1d8 9109 ld temp0, Y+ 00f1d9 9119 ld temp1, Y+ ;; unsigned 32/16 -> 16r16 divide PFA_UMSLASHMODmod: ; set loop counter 00f1da e140 ldi temp6,$10 PFA_UMSLASHMODmod_loop: ; shift left, saving high bit 00f1db 2755 clr temp7 00f1dc 0f00 lsl temp0 00f1dd 1f11 rol temp1 00f1de 1f22 rol temp2 00f1df 1f33 rol temp3 00f1e0 1f55 rol temp7 ; try subtracting divisor 00f1e1 152e cp temp2, temp4 00f1e2 053f cpc temp3, temp5 00f1e3 0552 cpc temp7,zerol 00f1e4 f018 brcs PFA_UMSLASHMODmod_loop_control PFA_UMSLASHMODmod_subtract: ; dividend is large enough ; do the subtraction for real ; and set lowest bit 00f1e5 9503 inc temp0 00f1e6 192e sub temp2, temp4 00f1e7 093f sbc temp3, temp5 PFA_UMSLASHMODmod_loop_control: 00f1e8 954a dec temp6 00f1e9 f789 brne PFA_UMSLASHMODmod_loop PFA_UMSLASHMODmod_done: ; put remainder on stack 00f1ea 933a st -Y,temp3 00f1eb 932a st -Y,temp2 ; put quotient on stack 00f1ec 01c8 movw tosl, temp0 00f1ed ce17 jmp_ DO_NEXT .include "words/umstar.asm" ; Arithmetics ; multiply 2 unsigned cells to a double cell VE_UMSTAR: 00f1ee ff03 .dw $ff03 00f1ef 6d75 00f1f0 002a .db "um*",0 00f1f1 f1cf .dw VE_HEAD .set VE_HEAD = VE_UMSTAR XT_UMSTAR: 00f1f2 f1f3 .dw PFA_UMSTAR PFA_UMSTAR: 00f1f3 018c movw temp0, tosl 00f1f4 9189 00f1f5 9199 loadtos ; result: (temp3*temp1)* 65536 + (temp3*temp0 + temp1*temp2) * 256 + (temp0 * temp2) ; low bytes 00f1f6 9f80 mul tosl,temp0 00f1f7 01f0 movw zl, r0 00f1f8 2722 clr temp2 00f1f9 2733 clr temp3 ; middle bytes 00f1fa 9f90 mul tosh, temp0 00f1fb 0df0 add zh, r0 00f1fc 1d21 adc temp2, r1 00f1fd 1d33 adc temp3, zeroh 00f1fe 9f81 mul tosl, temp1 00f1ff 0df0 add zh, r0 00f200 1d21 adc temp2, r1 00f201 1d33 adc temp3, zeroh 00f202 9f91 mul tosh, temp1 00f203 0d20 add temp2, r0 00f204 1d31 adc temp3, r1 00f205 01cf movw tosl, zl 00f206 939a 00f207 938a savetos 00f208 01c9 movw tosl, temp2 00f209 cdfb jmp_ DO_NEXT .include "words/invert.asm" ; Arithmetics ; 1-complement of TOS VE_INVERT: 00f20a ff06 .dw $ff06 00f20b 6e69 00f20c 6576 00f20d 7472 .db "invert" 00f20e f1ee .dw VE_HEAD .set VE_HEAD = VE_INVERT XT_INVERT: 00f20f f210 .dw PFA_INVERT PFA_INVERT: 00f210 9580 com tosl 00f211 9590 com tosh 00f212 cdf2 jmp_ DO_NEXT .include "words/2slash.asm" ; Arithmetics ; arithmetic shift right VE_2SLASH: 00f213 ff02 .dw $ff02 00f214 2f32 .db "2/" 00f215 f20a .dw VE_HEAD .set VE_HEAD = VE_2SLASH XT_2SLASH: 00f216 f217 .dw PFA_2SLASH PFA_2SLASH: 00f217 9595 asr tosh 00f218 9587 ror tosl 00f219 cdeb jmp_ DO_NEXT .include "words/2star.asm" ; Arithmetics ; arithmetic shift left, filling with zero VE_2STAR: 00f21a ff02 .dw $ff02 00f21b 2a32 .db "2*" 00f21c f213 .dw VE_HEAD .set VE_HEAD = VE_2STAR XT_2STAR: 00f21d f21e .dw PFA_2STAR PFA_2STAR: 00f21e 0f88 lsl tosl 00f21f 1f99 rol tosh 00f220 cde4 jmp_ DO_NEXT .include "words/and.asm" ; Logic ; bitwise and VE_AND: 00f221 ff03 .dw $ff03 00f222 6e61 00f223 0064 .db "and",0 00f224 f21a .dw VE_HEAD .set VE_HEAD = VE_AND XT_AND: 00f225 f226 .dw PFA_AND PFA_AND: 00f226 9109 ld temp0, Y+ 00f227 9119 ld temp1, Y+ 00f228 2380 and tosl, temp0 00f229 2391 and tosh, temp1 00f22a cdda jmp_ DO_NEXT .include "words/or.asm" ; Logic ; logical or VE_OR: 00f22b ff02 .dw $ff02 00f22c 726f .db "or" 00f22d f221 .dw VE_HEAD .set VE_HEAD = VE_OR XT_OR: 00f22e f22f .dw PFA_OR PFA_OR: 00f22f 9109 ld temp0, Y+ 00f230 9119 ld temp1, Y+ 00f231 2b80 or tosl, temp0 00f232 2b91 or tosh, temp1 00f233 cdd1 jmp_ DO_NEXT .include "words/xor.asm" ; Logic ; exclusive or VE_XOR: 00f234 ff03 .dw $ff03 00f235 6f78 00f236 0072 .db "xor",0 00f237 f22b .dw VE_HEAD .set VE_HEAD = VE_XOR XT_XOR: 00f238 f239 .dw PFA_XOR PFA_XOR: 00f239 9109 ld temp0, Y+ 00f23a 9119 ld temp1, Y+ 00f23b 2780 eor tosl, temp0 00f23c 2791 eor tosh, temp1 00f23d cdc7 jmp_ DO_NEXT .include "words/1plus.asm" ; Arithmetics ; optimized increment VE_1PLUS: 00f23e ff02 .dw $ff02 00f23f 2b31 .db "1+" 00f240 f234 .dw VE_HEAD .set VE_HEAD = VE_1PLUS XT_1PLUS: 00f241 f242 .dw PFA_1PLUS PFA_1PLUS: 00f242 9601 adiw tosl,1 00f243 cdc1 jmp_ DO_NEXT .include "words/1minus.asm" ; Arithmetics ; optimized decrement VE_1MINUS: 00f244 ff02 .dw $ff02 00f245 2d31 .db "1-" 00f246 f23e .dw VE_HEAD .set VE_HEAD = VE_1MINUS XT_1MINUS: 00f247 f248 .dw PFA_1MINUS PFA_1MINUS: 00f248 9701 sbiw tosl, 1 00f249 cdbb 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: 00f24a ff07 .dw $ff07 00f24b 6e3f 00f24c 6765 00f24d 7461 ../../common\words/q-negate.asm(11): warning: .cseg .db misalignment - padding zero byte 00f24e 0065 .db "?negate" 00f24f f244 .dw VE_HEAD .set VE_HEAD = VE_QNEGATE XT_QNEGATE: 00f250 f001 .dw DO_COLON PFA_QNEGATE: .endif 00f251 f133 00f252 f03f .DW XT_ZEROLESS,XT_DOCONDBRANCH 00f253 f255 DEST(QNEG1) 00f254 f65a .DW XT_NEGATE 00f255 f026 QNEG1: .DW XT_EXIT .include "words/lshift.asm" ; Arithmetics ; logically shift n1 left n2 times VE_LSHIFT: 00f256 ff06 .dw $ff06 00f257 736c 00f258 6968 00f259 7466 .db "lshift" 00f25a f24a .dw VE_HEAD .set VE_HEAD = VE_LSHIFT XT_LSHIFT: 00f25b f25c .dw PFA_LSHIFT PFA_LSHIFT: 00f25c 01fc movw zl, tosl 00f25d 9189 00f25e 9199 loadtos PFA_LSHIFT1: 00f25f 9731 sbiw zl, 1 00f260 f01a brmi PFA_LSHIFT2 00f261 0f88 lsl tosl 00f262 1f99 rol tosh 00f263 cffb rjmp PFA_LSHIFT1 PFA_LSHIFT2: 00f264 cda0 jmp_ DO_NEXT .include "words/rshift.asm" ; Arithmetics ; shift n1 n2-times logically right VE_RSHIFT: 00f265 ff06 .dw $ff06 00f266 7372 00f267 6968 00f268 7466 .db "rshift" 00f269 f256 .dw VE_HEAD .set VE_HEAD = VE_RSHIFT XT_RSHIFT: 00f26a f26b .dw PFA_RSHIFT PFA_RSHIFT: 00f26b 01fc movw zl, tosl 00f26c 9189 00f26d 9199 loadtos PFA_RSHIFT1: 00f26e 9731 sbiw zl, 1 00f26f f01a brmi PFA_RSHIFT2 00f270 9596 lsr tosh 00f271 9587 ror tosl 00f272 cffb rjmp PFA_RSHIFT1 PFA_RSHIFT2: 00f273 cd91 jmp_ DO_NEXT .include "words/plusstore.asm" ; Arithmetics ; add n to content of RAM address a-addr VE_PLUSSTORE: 00f274 ff02 .dw $ff02 00f275 212b .db "+!" 00f276 f265 .dw VE_HEAD .set VE_HEAD = VE_PLUSSTORE XT_PLUSSTORE: 00f277 f278 .dw PFA_PLUSSTORE PFA_PLUSSTORE: 00f278 01fc movw zl, tosl 00f279 9189 00f27a 9199 loadtos 00f27b 8120 ldd temp2, Z+0 00f27c 8131 ldd temp3, Z+1 00f27d 0f82 add tosl, temp2 00f27e 1f93 adc tosh, temp3 00f27f 8380 std Z+0, tosl 00f280 8391 std Z+1, tosh 00f281 9189 00f282 9199 loadtos 00f283 cd81 jmp_ DO_NEXT ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; .include "words/rpfetch.asm" ; Stack ; current return stack pointer address VE_RP_FETCH: 00f284 ff03 .dw $ff03 00f285 7072 00f286 0040 .db "rp@",0 00f287 f274 .dw VE_HEAD .set VE_HEAD = VE_RP_FETCH XT_RP_FETCH: 00f288 f289 .dw PFA_RP_FETCH PFA_RP_FETCH: 00f289 939a 00f28a 938a savetos 00f28b b78d in tosl, SPL 00f28c b79e in tosh, SPH 00f28d cd77 jmp_ DO_NEXT .include "words/rpstore.asm" ; Stack ; set return stack pointer VE_RP_STORE: 00f28e ff03 .dw $ff03 00f28f 7072 00f290 0021 .db "rp!",0 00f291 f284 .dw VE_HEAD .set VE_HEAD = VE_RP_STORE XT_RP_STORE: 00f292 f293 .dw PFA_RP_STORE PFA_RP_STORE: 00f293 b72f in temp2, SREG 00f294 94f8 cli 00f295 bf8d out SPL, tosl 00f296 bf9e out SPH, tosh 00f297 bf2f out SREG, temp2 00f298 9189 00f299 9199 loadtos 00f29a cd6a jmp_ DO_NEXT .include "words/spfetch.asm" ; Stack ; current data stack pointer VE_SP_FETCH: 00f29b ff03 .dw $ff03 00f29c 7073 00f29d 0040 .db "sp@",0 00f29e f28e .dw VE_HEAD .set VE_HEAD = VE_SP_FETCH XT_SP_FETCH: 00f29f f2a0 .dw PFA_SP_FETCH PFA_SP_FETCH: 00f2a0 939a 00f2a1 938a savetos 00f2a2 01ce movw tosl, yl 00f2a3 cd61 jmp_ DO_NEXT .include "words/spstore.asm" ; Stack ; set data stack pointer to addr VE_SP_STORE: 00f2a4 ff03 .dw $ff03 00f2a5 7073 00f2a6 0021 .db "sp!",0 00f2a7 f29b .dw VE_HEAD .set VE_HEAD = VE_SP_STORE XT_SP_STORE: 00f2a8 f2a9 .dw PFA_SP_STORE PFA_SP_STORE: 00f2a9 01ec movw yl, tosl 00f2aa 9189 00f2ab 9199 loadtos 00f2ac cd58 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: 00f2ad f2ae .dw PFA_DODO PFA_DODO: 00f2ae 9129 ld temp2, Y+ 00f2af 9139 ld temp3, Y+ ; limit PFA_DODO1: 00f2b0 e8e0 ldi zl, $80 00f2b1 0f3e add temp3, zl 00f2b2 1b82 sub tosl, temp2 00f2b3 0b93 sbc tosh, temp3 00f2b4 933f push temp3 00f2b5 932f push temp2 ; limit ( --> limit + $8000) 00f2b6 939f push tosh 00f2b7 938f push tosl ; start -> index ( --> index - (limit - $8000) 00f2b8 9189 00f2b9 9199 loadtos 00f2ba cd4a jmp_ DO_NEXT .include "words/i.asm" ; Compiler ; current loop counter VE_I: 00f2bb ff01 .dw $FF01 00f2bc 0069 .db "i",0 00f2bd f2a4 .dw VE_HEAD .set VE_HEAD = VE_I XT_I: 00f2be f2bf .dw PFA_I PFA_I: 00f2bf 939a 00f2c0 938a savetos 00f2c1 918f pop tosl 00f2c2 919f pop tosh ; index 00f2c3 91ef pop zl 00f2c4 91ff pop zh ; limit 00f2c5 93ff push zh 00f2c6 93ef push zl 00f2c7 939f push tosh 00f2c8 938f push tosl 00f2c9 0f8e add tosl, zl 00f2ca 1f9f adc tosh, zh 00f2cb cd39 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: 00f2cc f2cd .dw PFA_DOPLUSLOOP PFA_DOPLUSLOOP: 00f2cd 91ef pop zl 00f2ce 91ff pop zh 00f2cf 0fe8 add zl, tosl 00f2d0 1ff9 adc zh, tosh 00f2d1 9189 00f2d2 9199 loadtos 00f2d3 f01b brvs PFA_DOPLUSLOOP_LEAVE ; next cycle PFA_DOPLUSLOOP_NEXT: ; next iteration 00f2d4 93ff push zh 00f2d5 93ef push zl 00f2d6 cd5f rjmp PFA_DOBRANCH ; read next cell from dictionary and jump to its destination PFA_DOPLUSLOOP_LEAVE: 00f2d7 910f pop temp0 00f2d8 911f pop temp1 ; remove limit 00f2d9 9611 adiw xl, 1 ; skip branch-back address 00f2da cd2a 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: 00f2db f2dc .dw PFA_DOLOOP PFA_DOLOOP: 00f2dc 91ef pop zl 00f2dd 91ff pop zh 00f2de 9631 adiw zl,1 00f2df f3bb brvs PFA_DOPLUSLOOP_LEAVE 00f2e0 cff3 jmp_ PFA_DOPLUSLOOP_NEXT .include "words/unloop.asm" ; Compiler ; remove loop-sys, exit the loop and continue execution after it VE_UNLOOP: 00f2e1 ff06 .dw $ff06 00f2e2 6e75 00f2e3 6f6c 00f2e4 706f .db "unloop" 00f2e5 f2bb .dw VE_HEAD .set VE_HEAD = VE_UNLOOP XT_UNLOOP: 00f2e6 f2e7 .dw PFA_UNLOOP PFA_UNLOOP: 00f2e7 911f pop temp1 00f2e8 910f pop temp0 00f2e9 911f pop temp1 00f2ea 910f pop temp0 00f2eb cd19 jmp_ DO_NEXT ;;;;;;;;;;;;;;;;;;;;;;;;;;; .include "words/cmove_g.asm" ; Memory ; copy data in RAM from higher to lower addresses. VE_CMOVE_G: 00f2ec ff06 .dw $ff06 00f2ed 6d63 00f2ee 766f 00f2ef 3e65 .db "cmove>" 00f2f0 f2e1 .dw VE_HEAD .set VE_HEAD = VE_CMOVE_G XT_CMOVE_G: 00f2f1 f2f2 .dw PFA_CMOVE_G PFA_CMOVE_G: 00f2f2 93bf push xh 00f2f3 93af push xl 00f2f4 91e9 ld zl, Y+ 00f2f5 91f9 ld zh, Y+ ; addr-to 00f2f6 91a9 ld xl, Y+ 00f2f7 91b9 ld xh, Y+ ; addr-from 00f2f8 2f09 mov temp0, tosh 00f2f9 2b08 or temp0, tosl 00f2fa f041 brbs 1, PFA_CMOVE_G1 00f2fb 0fe8 add zl, tosl 00f2fc 1ff9 adc zh, tosh 00f2fd 0fa8 add xl, tosl 00f2fe 1fb9 adc xh, tosh PFA_CMOVE_G2: 00f2ff 911e ld temp1, -X 00f300 9312 st -Z, temp1 00f301 9701 sbiw tosl, 1 00f302 f7e1 brbc 1, PFA_CMOVE_G2 PFA_CMOVE_G1: 00f303 91af pop xl 00f304 91bf pop xh 00f305 9189 00f306 9199 loadtos 00f307 ccfd jmp_ DO_NEXT .include "words/byteswap.asm" ; Arithmetics ; exchange the bytes of the TOS VE_BYTESWAP: 00f308 ff02 .dw $ff02 00f309 3c3e .db "><" 00f30a f2ec .dw VE_HEAD .set VE_HEAD = VE_BYTESWAP XT_BYTESWAP: 00f30b f30c .dw PFA_BYTESWAP PFA_BYTESWAP: 00f30c 2f09 mov temp0, tosh 00f30d 2f98 mov tosh, tosl 00f30e 2f80 mov tosl, temp0 00f30f ccf5 jmp_ DO_NEXT .include "words/up.asm" ; System Variable ; get user area pointer VE_UP_FETCH: 00f310 ff03 .dw $ff03 00f311 7075 00f312 0040 .db "up@",0 00f313 f308 .dw VE_HEAD .set VE_HEAD = VE_UP_FETCH XT_UP_FETCH: 00f314 f315 .dw PFA_UP_FETCH PFA_UP_FETCH: 00f315 939a 00f316 938a savetos 00f317 01c2 movw tosl, upl 00f318 ccec jmp_ DO_NEXT ; ( addr -- ) ; System Variable ; set user area pointer VE_UP_STORE: 00f319 ff03 .dw $ff03 00f31a 7075 00f31b 0021 .db "up!",0 00f31c f310 .dw VE_HEAD .set VE_HEAD = VE_UP_STORE XT_UP_STORE: 00f31d f31e .dw PFA_UP_STORE PFA_UP_STORE: 00f31e 012c movw upl, tosl 00f31f 9189 00f320 9199 loadtos 00f321 cce3 jmp_ DO_NEXT .include "words/1ms.asm" ; Time ; busy waits (almost) exactly 1 millisecond VE_1MS: 00f322 ff03 .dw $ff03 00f323 6d31 00f324 0073 .db "1ms",0 00f325 f319 .dw VE_HEAD .set VE_HEAD = VE_1MS XT_1MS: 00f326 f327 .dw PFA_1MS PFA_1MS: 00f327 eae0 00f328 e0ff 00f329 9731 00f32a f7f1 delay 1000 00f32b ccd9 jmp_ DO_NEXT .include "words/2to_r.asm" ; Stack ; move DTOS to TOR VE_2TO_R: 00f32c ff03 .dw $ff03 00f32d 3e32 00f32e 0072 .db "2>r",0 00f32f f322 .dw VE_HEAD .set VE_HEAD = VE_2TO_R XT_2TO_R: 00f330 f331 .dw PFA_2TO_R PFA_2TO_R: 00f331 01fc movw zl, tosl 00f332 9189 00f333 9199 loadtos 00f334 939f push tosh 00f335 938f push tosl 00f336 93ff push zh 00f337 93ef push zl 00f338 9189 00f339 9199 loadtos 00f33a ccca jmp_ DO_NEXT .include "words/2r_from.asm" ; Stack ; move DTOR to TOS VE_2R_FROM: 00f33b ff03 .dw $ff03 00f33c 7232 00f33d 003e .db "2r>",0 00f33e f32c .dw VE_HEAD .set VE_HEAD = VE_2R_FROM XT_2R_FROM: 00f33f f340 .dw PFA_2R_FROM PFA_2R_FROM: 00f340 939a 00f341 938a savetos 00f342 91ef pop zl 00f343 91ff pop zh 00f344 918f pop tosl 00f345 919f pop tosh 00f346 939a 00f347 938a savetos 00f348 01cf movw tosl, zl 00f349 ccbb jmp_ DO_NEXT .include "words/store-e.asm" ; Memory ; write n (2bytes) to eeprom address VE_STOREE: 00f34a ff02 .dw $ff02 00f34b 6521 .db "!e" 00f34c f33b .dw VE_HEAD .set VE_HEAD = VE_STOREE XT_STOREE: 00f34d f34e .dw PFA_STOREE PFA_STOREE: .if WANT_UNIFIED == 1 .endif PFA_STOREE0: 00f34e 01fc movw zl, tosl 00f34f 9189 00f350 9199 loadtos 00f351 b72f in_ temp2, SREG 00f352 94f8 cli 00f353 d028 rcall PFA_FETCHE2 00f354 b500 in_ temp0, EEDR 00f355 1708 cp temp0,tosl 00f356 f009 breq PFA_STOREE3 00f357 d00b rcall PFA_STOREE1 PFA_STOREE3: 00f358 9631 adiw zl,1 00f359 d022 rcall PFA_FETCHE2 00f35a b500 in_ temp0, EEDR 00f35b 1709 cp temp0,tosh 00f35c f011 breq PFA_STOREE4 00f35d 2f89 mov tosl, tosh 00f35e d004 rcall PFA_STOREE1 PFA_STOREE4: 00f35f bf2f out_ SREG, temp2 00f360 9189 00f361 9199 loadtos 00f362 cca2 jmp_ DO_NEXT PFA_STOREE1: 00f363 99f9 sbic EECR, EEPE 00f364 cffe rjmp PFA_STOREE1 PFA_STOREE2: ; estore_wait_low_spm: 00f365 b707 in_ temp0, SPMCSR 00f366 fd00 sbrc temp0,SPMEN 00f367 cffd rjmp PFA_STOREE2 00f368 bdf2 out_ EEARH,zh 00f369 bde1 out_ EEARL,zl 00f36a bd80 out_ EEDR, tosl 00f36b 9afa sbi EECR,EEMPE 00f36c 9af9 sbi EECR,EEPE 00f36d 9508 ret .if WANT_UNIFIED == 1 .endif .include "words/fetch-e.asm" ; Memory ; read 1 cell from eeprom VE_FETCHE: 00f36e ff02 .dw $ff02 00f36f 6540 .db "@e" 00f370 f34a .dw VE_HEAD .set VE_HEAD = VE_FETCHE XT_FETCHE: 00f371 f372 .dw PFA_FETCHE PFA_FETCHE: .if WANT_UNIFIED == 1 .endif PFA_FETCHE1: 00f372 b72f in_ temp2, SREG 00f373 94f8 cli 00f374 01fc movw zl, tosl 00f375 d006 rcall PFA_FETCHE2 00f376 b580 in_ tosl, EEDR 00f377 9631 adiw zl,1 00f378 d003 rcall PFA_FETCHE2 00f379 b590 in_ tosh, EEDR 00f37a bf2f out_ SREG, temp2 00f37b cc89 jmp_ DO_NEXT PFA_FETCHE2: 00f37c 99f9 sbic EECR, EEPE 00f37d cffe rjmp PFA_FETCHE2 00f37e bdf2 out_ EEARH,zh 00f37f bde1 out_ EEARL,zl 00f380 9af8 sbi EECR,EERE 00f381 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: 00f382 ff02 .dw $ff02 00f383 6921 .db "!i" 00f384 f36e .dw VE_HEAD .set VE_HEAD = VE_STOREI XT_STOREI: 00f385 fc2e .dw PFA_DODEFER1 PFA_STOREI: 00f386 0078 .dw EE_STOREI 00f387 fbcf .dw XT_EDEFERFETCH 00f388 fbd9 .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: 00f389 ff09 .dw $ff09 00f38a 2128 00f38b 2d69 00f38c 726e 00f38d 7777 00f38e 0029 .db "(!i-nrww)",0 00f38f f382 .dw VE_HEAD .set VE_HEAD = VE_DO_STOREI_NRWW XT_DO_STOREI: 00f390 f391 .dw PFA_DO_STOREI_NRWW PFA_DO_STOREI_NRWW: ; store status register 00f391 b71f in temp1,SREG 00f392 931f push temp1 00f393 94f8 cli 00f394 019c movw temp2, tosl ; save the (word) address 00f395 9189 00f396 9199 loadtos ; get the new value for the flash cell 00f397 93af push xl 00f398 93bf push xh 00f399 93cf push yl 00f39a 93df push yh 00f39b d009 rcall DO_STOREI_atmega 00f39c 91df pop yh 00f39d 91cf pop yl 00f39e 91bf pop xh 00f39f 91af pop xl ; finally clear the stack 00f3a0 9189 00f3a1 9199 loadtos 00f3a2 911f pop temp1 ; restore status register (and interrupt enable flag) 00f3a3 bf1f out SREG,temp1 00f3a4 cc60 jmp_ DO_NEXT ; DO_STOREI_atmega: ; write data to temp page buffer ; use the values in tosl/tosh at the ; appropiate place 00f3a5 d010 rcall pageload ; erase page if needed ; it is needed if a bit goes from 0 to 1 00f3a6 94e0 com temp4 00f3a7 94f0 com temp5 00f3a8 218e and tosl, temp4 00f3a9 219f and tosh, temp5 00f3aa 2b98 or tosh, tosl 00f3ab f019 breq DO_STOREI_writepage 00f3ac 01f9 movw zl, temp2 00f3ad 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: 00f3ed ff03 .dw $ff03 00f3ee 3e6e 00f3ef 0072 .db "n>r",0 00f3f0 f3e0 .dw VE_HEAD .set VE_HEAD = VE_N_TO_R XT_N_TO_R: 00f3f1 f3f2 .dw PFA_N_TO_R PFA_N_TO_R: 00f3f2 01fc movw zl, tosl 00f3f3 2f08 mov temp0, tosl PFA_N_TO_R1: 00f3f4 9189 00f3f5 9199 loadtos 00f3f6 939f push tosh 00f3f7 938f push tosl 00f3f8 950a dec temp0 00f3f9 f7d1 brne PFA_N_TO_R1 00f3fa 93ef push zl 00f3fb 93ff push zh 00f3fc 9189 00f3fd 9199 loadtos 00f3fe cc06 jmp_ DO_NEXT .include "words/n_r_from.asm" ; Stack ; move n items from return stack to data stack VE_N_R_FROM: 00f3ff ff03 .dw $ff03 00f400 726e 00f401 003e .db "nr>",0 00f402 f3ed .dw VE_HEAD .set VE_HEAD = VE_N_R_FROM XT_N_R_FROM: 00f403 f404 .dw PFA_N_R_FROM PFA_N_R_FROM: 00f404 939a 00f405 938a savetos 00f406 91ff pop zh 00f407 91ef pop zl 00f408 2f0e mov temp0, zl PFA_N_R_FROM1: 00f409 918f pop tosl 00f40a 919f pop tosh 00f40b 939a 00f40c 938a savetos 00f40d 950a dec temp0 00f40e f7d1 brne PFA_N_R_FROM1 00f40f 01cf movw tosl, zl 00f410 cbf4 jmp_ DO_NEXT .include "words/d-2star.asm" ; Arithmetics ; shift a double cell left VE_D2STAR: 00f411 ff03 .dw $ff03 00f412 3264 00f413 002a .db "d2*",0 00f414 f3ff .dw VE_HEAD .set VE_HEAD = VE_D2STAR XT_D2STAR: 00f415 f416 .dw PFA_D2STAR PFA_D2STAR: 00f416 9109 ld temp0, Y+ 00f417 9119 ld temp1, Y+ 00f418 0f00 lsl temp0 00f419 1f11 rol temp1 00f41a 1f88 rol tosl 00f41b 1f99 rol tosh 00f41c 931a st -Y, temp1 00f41d 930a st -Y, temp0 00f41e cbe6 jmp_ DO_NEXT .include "words/d-2slash.asm" ; Arithmetics ; shift a double cell value right VE_D2SLASH: 00f41f ff03 .dw $ff03 00f420 3264 00f421 002f .db "d2/",0 00f422 f411 .dw VE_HEAD .set VE_HEAD = VE_D2SLASH XT_D2SLASH: 00f423 f424 .dw PFA_D2SLASH PFA_D2SLASH: 00f424 9109 ld temp0, Y+ 00f425 9119 ld temp1, Y+ 00f426 9595 asr tosh 00f427 9587 ror tosl 00f428 9517 ror temp1 00f429 9507 ror temp0 00f42a 931a st -Y, temp1 00f42b 930a st -Y, temp0 00f42c cbd8 jmp_ DO_NEXT .include "words/d-plus.asm" ; Arithmetics ; add 2 double cell values VE_DPLUS: 00f42d ff02 .dw $ff02 00f42e 2b64 .db "d+" 00f42f f41f .dw VE_HEAD .set VE_HEAD = VE_DPLUS XT_DPLUS: 00f430 f431 .dw PFA_DPLUS PFA_DPLUS: 00f431 9129 ld temp2, Y+ 00f432 9139 ld temp3, Y+ 00f433 90e9 ld temp4, Y+ 00f434 90f9 ld temp5, Y+ 00f435 9149 ld temp6, Y+ 00f436 9159 ld temp7, Y+ 00f437 0f24 add temp2, temp6 00f438 1f35 adc temp3, temp7 00f439 1d8e adc tosl, temp4 00f43a 1d9f adc tosh, temp5 00f43b 933a st -Y, temp3 00f43c 932a st -Y, temp2 00f43d cbc7 jmp_ DO_NEXT .include "words/d-minus.asm" ; Arithmetics ; subtract d2 from d1 VE_DMINUS: 00f43e ff02 .dw $ff02 00f43f 2d64 .db "d-" 00f440 f42d .dw VE_HEAD .set VE_HEAD = VE_DMINUS XT_DMINUS: 00f441 f442 .dw PFA_DMINUS PFA_DMINUS: 00f442 9129 ld temp2, Y+ 00f443 9139 ld temp3, Y+ 00f444 90e9 ld temp4, Y+ 00f445 90f9 ld temp5, Y+ 00f446 9149 ld temp6, Y+ 00f447 9159 ld temp7, Y+ 00f448 1b42 sub temp6, temp2 00f449 0b53 sbc temp7, temp3 00f44a 0ae8 sbc temp4, tosl 00f44b 0af9 sbc temp5, tosh 00f44c 935a st -Y, temp7 00f44d 934a st -Y, temp6 00f44e 01c7 movw tosl, temp4 00f44f cbb5 jmp_ DO_NEXT .include "words/d-invert.asm" ; Arithmetics ; invert all bits in the double cell value VE_DINVERT: 00f450 ff07 .dw $ff07 00f451 6964 00f452 766e 00f453 7265 00f454 0074 .db "dinvert",0 00f455 f43e .dw VE_HEAD .set VE_HEAD = VE_DINVERT XT_DINVERT: 00f456 f457 .dw PFA_DINVERT PFA_DINVERT: 00f457 9109 ld temp0, Y+ 00f458 9119 ld temp1, Y+ 00f459 9580 com tosl 00f45a 9590 com tosh 00f45b 9500 com temp0 00f45c 9510 com temp1 00f45d 931a st -Y, temp1 00f45e 930a st -Y, temp0 00f45f cba5 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: 00f460 ff02 .dw $ff02 00f461 2e75 .db "u." 00f462 f450 .dw VE_HEAD .set VE_HEAD = VE_UDOT XT_UDOT: 00f463 f001 .dw DO_COLON PFA_UDOT: .endif 00f464 f166 .dw XT_ZERO 00f465 f745 .dw XT_UDDOT 00f466 f026 .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: 00f467 ff03 .dw $ff03 00f468 2e75 00f469 0072 .db "u.r",0 00f46a f460 .dw VE_HEAD .set VE_HEAD = VE_UDOTR XT_UDOTR: 00f46b f001 .dw DO_COLON PFA_UDOTR: .endif 00f46c f166 .dw XT_ZERO 00f46d f0d6 .dw XT_SWAP 00f46e f74e .dw XT_UDDOTR 00f46f f026 .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: 00f470 ff0d .dw $ff0d 00f471 6873 00f472 776f 00f473 772d 00f474 726f 00f475 6c64 00f476 7369 00f477 0074 .db "show-wordlist",0 00f478 f467 .dw VE_HEAD .set VE_HEAD = VE_SHOWWORDLIST XT_SHOWWORDLIST: 00f479 f001 .dw DO_COLON PFA_SHOWWORDLIST: .endif 00f47a f046 .dw XT_DOLITERAL 00f47b f47f .dw XT_SHOWWORD 00f47c f0d6 .dw XT_SWAP 00f47d fc72 .dw XT_TRAVERSEWORDLIST 00f47e f026 .dw XT_EXIT .if cpu_msp430==1 .endif .if cpu_avr8==1 XT_SHOWWORD: 00f47f f001 .dw DO_COLON PFA_SHOWWORD: .endif 00f480 fc8d .dw XT_NAME2STRING 00f481 f7bb .dw XT_ITYPE 00f482 f7fd .dw XT_SPACE ; ( -- addr n) 00f483 f15d .dw XT_TRUE 00f484 f026 .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: 00f485 ff05 .dw $ff05 00f486 6f77 00f487 6472 00f488 0073 .db "words",0 00f489 f470 .dw VE_HEAD .set VE_HEAD = VE_WORDS XT_WORDS: 00f48a f001 .dw DO_COLON PFA_WORDS: .endif 00f48b f046 .dw XT_DOLITERAL 00f48c 005e .dw CFG_ORDERLISTLEN+2 00f48d f371 .dw XT_FETCHE 00f48e f479 .dw XT_SHOWWORDLIST 00f48f f026 .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: 00f490 ff04 .dw $ff04 00f491 692b 00f492 746e .db "+int" 00f493 f485 .dw VE_HEAD .set VE_HEAD = VE_INTON XT_INTON: 00f494 f495 .dw PFA_INTON PFA_INTON: 00f495 9478 sei 00f496 cb6e jmp_ DO_NEXT .include "words/int-off.asm" ; Interrupt ; turns off all interrupts VE_INTOFF: 00f497 ff04 .dw $ff04 00f498 692d 00f499 746e .db "-int" 00f49a f490 .dw VE_HEAD .set VE_HEAD = VE_INTOFF XT_INTOFF: 00f49b f49c .dw PFA_INTOFF PFA_INTOFF: 00f49c 94f8 cli 00f49d cb67 jmp_ DO_NEXT .include "words/int-store.asm" ; Interrupt ; stores XT as interrupt vector i VE_INTSTORE: 00f49e ff04 .dw $ff04 00f49f 6e69 00f4a0 2174 .db "int!" 00f4a1 f497 .dw VE_HEAD .set VE_HEAD = VE_INTSTORE XT_INTSTORE: 00f4a2 f001 .dw DO_COLON PFA_INTSTORE: 00f4a3 f046 .dw XT_DOLITERAL 00f4a4 0000 .dw intvec 00f4a5 f1af .dw XT_PLUS 00f4a6 f34d .dw XT_STOREE 00f4a7 f026 .dw XT_EXIT .include "words/int-fetch.asm" ; Interrupt ; fetches XT from interrupt vector i VE_INTFETCH: 00f4a8 ff04 .dw $ff04 00f4a9 6e69 00f4aa 4074 .db "int@" 00f4ab f49e .dw VE_HEAD .set VE_HEAD = VE_INTFETCH XT_INTFETCH: 00f4ac f001 .dw DO_COLON PFA_INTFETCH: 00f4ad f046 .dw XT_DOLITERAL 00f4ae 0000 .dw intvec 00f4af f1af .dw XT_PLUS 00f4b0 f371 .dw XT_FETCHE 00f4b1 f026 .dw XT_EXIT .include "words/int-trap.asm" ; Interrupt ; trigger an interrupt VE_INTTRAP: 00f4b2 ff08 .dw $ff08 00f4b3 6e69 00f4b4 2d74 00f4b5 7274 00f4b6 7061 .db "int-trap" 00f4b7 f4a8 .dw VE_HEAD .set VE_HEAD = VE_INTTRAP XT_INTTRAP: 00f4b8 f4b9 .dw PFA_INTTRAP PFA_INTTRAP: 00f4b9 2eb8 mov isrflag, tosl 00f4ba 9189 00f4bb 9199 loadtos 00f4bc cb48 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: 00f4bd f001 .dw DO_COLON PFA_ISREXEC: 00f4be f4ac .dw XT_INTFETCH 00f4bf f030 .dw XT_EXECUTE 00f4c0 f4c2 .dw XT_ISREND 00f4c1 f026 .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: 00f4c2 f4c3 .dw PFA_ISREND PFA_ISREND: 00f4c3 d001 rcall PFA_ISREND1 ; clear the interrupt flag for the controller 00f4c4 cb40 jmp_ DO_NEXT PFA_ISREND1: 00f4c5 9518 reti .endif .include "words/pick.asm" .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_PICK: 00f4c6 ff04 .dw $ff04 00f4c7 6970 00f4c8 6b63 .db "pick" 00f4c9 f4b2 .dw VE_HEAD .set VE_HEAD = VE_PICK XT_PICK: 00f4ca f001 .dw DO_COLON PFA_PICK: .endif 00f4cb f241 .dw XT_1PLUS 00f4cc f573 .dw XT_CELLS 00f4cd f29f .dw XT_SP_FETCH 00f4ce f1af .dw XT_PLUS 00f4cf f08b .dw XT_FETCH 00f4d0 f026 .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: 00f4d1 0002 .dw $0002 00f4d2 222e .db ".",$22 00f4d3 f4c6 .dw VE_HEAD .set VE_HEAD = VE_DOTSTRING XT_DOTSTRING: 00f4d4 f001 .dw DO_COLON PFA_DOTSTRING: .endif 00f4d5 f4dc .dw XT_SQUOTE 00f4d6 01d0 .dw XT_COMPILE 00f4d7 f7bb .dw XT_ITYPE 00f4d8 f026 .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: 00f4d9 0002 .dw $0002 00f4da 2273 .db "s",$22 00f4db f4d1 .dw VE_HEAD .set VE_HEAD = VE_SQUOTE XT_SQUOTE: 00f4dc f001 .dw DO_COLON PFA_SQUOTE: .endif 00f4dd f046 .dw XT_DOLITERAL 00f4de 0022 .dw 34 ; 0x22 00f4df f9a2 .dw XT_PARSE ; ( -- addr n) 00f4e0 f566 .dw XT_STATE 00f4e1 f08b .dw XT_FETCH 00f4e2 f03f .dw XT_DOCONDBRANCH 00f4e3 f4e5 DEST(PFA_SQUOTE1) 00f4e4 01fc .dw XT_SLITERAL PFA_SQUOTE1: 00f4e5 f026 .dw XT_EXIT .include "words/fill.asm" ; Memory ; fill u bytes memory beginning at a-addr with character c VE_FILL: 00f4e6 ff04 .dw $ff04 00f4e7 6966 00f4e8 6c6c .db "fill" 00f4e9 f4d9 .dw VE_HEAD .set VE_HEAD = VE_FILL XT_FILL: 00f4ea f001 .dw DO_COLON PFA_FILL: 00f4eb f0f3 .dw XT_ROT 00f4ec f0f3 .dw XT_ROT 00f4ed f0cb 00f4ee f03f .dw XT_QDUP,XT_DOCONDBRANCH 00f4ef f4f7 DEST(PFA_FILL2) 00f4f0 fd79 .dw XT_BOUNDS 00f4f1 f2ad .dw XT_DODO PFA_FILL1: 00f4f2 f0c3 .dw XT_DUP 00f4f3 f2be .dw XT_I 00f4f4 f09f .dw XT_CSTORE ; ( -- c c-addr) 00f4f5 f2db .dw XT_DOLOOP 00f4f6 f4f2 .dw PFA_FILL1 PFA_FILL2: 00f4f7 f0eb .dw XT_DROP 00f4f8 f026 .dw XT_EXIT .include "words/environment.asm" ; System Value ; word list identifier of the environmental search list VE_ENVIRONMENT: 00f4f9 ff0b .dw $ff0b 00f4fa 6e65 00f4fb 6976 00f4fc 6f72 00f4fd 6d6e 00f4fe 6e65 00f4ff 0074 .db "environment",0 00f500 f4e6 .dw VE_HEAD .set VE_HEAD = VE_ENVIRONMENT XT_ENVIRONMENT: 00f501 f054 .dw PFA_DOVARIABLE PFA_ENVIRONMENT: 00f502 0056 .dw CFG_ENVIRONMENT .include "words/env-wordlists.asm" ; Environment ; maximum number of wordlists in the dictionary search order VE_ENVWORDLISTS: 00f503 ff09 .dw $ff09 00f504 6f77 00f505 6472 00f506 696c 00f507 7473 00f508 0073 .db "wordlists",0 00f509 0000 .dw VE_ENVHEAD .set VE_ENVHEAD = VE_ENVWORDLISTS XT_ENVWORDLISTS: 00f50a f001 .dw DO_COLON PFA_ENVWORDLISTS: 00f50b f046 .dw XT_DOLITERAL 00f50c 0008 .dw NUMWORDLISTS 00f50d f026 .dw XT_EXIT .include "words/env-slashpad.asm" ; Environment ; Size of the PAD buffer in bytes VE_ENVSLASHPAD: 00f50e ff04 .dw $ff04 00f50f 702f 00f510 6461 .db "/pad" 00f511 f503 .dw VE_ENVHEAD .set VE_ENVHEAD = VE_ENVSLASHPAD XT_ENVSLASHPAD: 00f512 f001 .dw DO_COLON PFA_ENVSLASHPAD: 00f513 f29f .dw XT_SP_FETCH 00f514 f59f .dw XT_PAD 00f515 f1a5 .dw XT_MINUS 00f516 f026 .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: 00f517 ff05 .dw $ff05 00f518 682f 00f519 6c6f 00f51a 0064 .db "/hold",0 00f51b f50e .dw VE_ENVHEAD .set VE_ENVHEAD = VE_ENVSLASHHOLD XT_ENVSLASHHOLD: 00f51c f001 .dw DO_COLON PFA_ENVSLASHHOLD: .endif 00f51d f59f .dw XT_PAD 00f51e f5da .dw XT_HERE 00f51f f1a5 .dw XT_MINUS 00f520 f026 .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: 00f521 ff0a .dw $ff0a 00f522 6f66 00f523 7472 00f524 2d68 00f525 616e 00f526 656d .db "forth-name" 00f527 f517 .dw VE_ENVHEAD .set VE_ENVHEAD = VE_ENV_FORTHNAME XT_ENV_FORTHNAME: 00f528 f001 .dw DO_COLON PFA_EN_FORTHNAME: 00f529 f788 .dw XT_DOSLITERAL 00f52a 0007 .dw 7 .endif 00f52b 6d61 00f52c 6f66 00f52d 7472 ../../common\words/env-forthname.asm(22): warning: .cseg .db misalignment - padding zero byte 00f52e 0068 .db "amforth" .if cpu_msp430==1 .endif 00f52f f026 .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: 00f530 ff07 .dw $ff07 00f531 6576 00f532 7372 00f533 6f69 00f534 006e .db "version",0 00f535 f521 .dw VE_ENVHEAD .set VE_ENVHEAD = VE_ENV_FORTHVERSION XT_ENV_FORTHVERSION: 00f536 f001 .dw DO_COLON PFA_EN_FORTHVERSION: .endif 00f537 f046 .dw XT_DOLITERAL 00f538 0041 .dw 65 00f539 f026 .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: 00f53a ff03 .dw $ff03 00f53b 7063 00f53c 0075 .db "cpu",0 00f53d f530 .dw VE_ENVHEAD .set VE_ENVHEAD = VE_ENV_CPU XT_ENV_CPU: 00f53e f001 .dw DO_COLON PFA_EN_CPU: .endif 00f53f f046 .dw XT_DOLITERAL 00f540 0049 .dw mcu_name 00f541 f7e7 .dw XT_ICOUNT 00f542 f026 .dw XT_EXIT .include "words/env-mcuinfo.asm" ; Environment ; flash address of some CPU specific parameters VE_ENV_MCUINFO: 00f543 ff08 .dw $ff08 00f544 636d 00f545 2d75 00f546 6e69 00f547 6f66 .db "mcu-info" 00f548 f53a .dw VE_ENVHEAD .set VE_ENVHEAD = VE_ENV_MCUINFO XT_ENV_MCUINFO: 00f549 f001 .dw DO_COLON PFA_EN_MCUINFO: 00f54a f046 .dw XT_DOLITERAL 00f54b 0045 .dw mcu_info 00f54c f026 .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: 00f54d ff05 .dw $ff05 00f54e 752f 00f54f 6573 00f550 0072 .db "/user",0 00f551 f543 .dw VE_ENVHEAD .set VE_ENVHEAD = VE_ENVUSERSIZE XT_ENVUSERSIZE: 00f552 f001 .dw DO_COLON PFA_ENVUSERSIZE: .endif 00f553 f046 .dw XT_DOLITERAL 00f554 002c .dw SYSUSERSIZE + APPUSERSIZE 00f555 f026 .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: 00f556 ff05 .dw $ff05 00f557 5f66 00f558 7063 00f559 0075 .db "f_cpu",0 00f55a f4f9 .dw VE_HEAD .set VE_HEAD = VE_F_CPU XT_F_CPU: 00f55b f001 .dw DO_COLON PFA_F_CPU: .endif 00f55c f046 .dw XT_DOLITERAL 00f55d 2400 .dw (F_CPU % 65536) 00f55e f046 .dw XT_DOLITERAL 00f55f 00f4 .dw (F_CPU / 65536) 00f560 f026 .dw XT_EXIT .include "words/state.asm" ; System Variable ; system state VE_STATE: 00f561 ff05 .dw $ff05 00f562 7473 00f563 7461 00f564 0065 .db "state",0 00f565 f556 .dw VE_HEAD .set VE_HEAD = VE_STATE XT_STATE: 00f566 f054 .dw PFA_DOVARIABLE PFA_STATE: 00f567 013d .dw ram_state .dseg 00013d 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: 00f568 ff04 .dw $ff04 00f569 6162 00f56a 6573 .db "base" 00f56b f561 .dw VE_HEAD .set VE_HEAD = VE_BASE XT_BASE: 00f56c f067 .dw PFA_DOUSER PFA_BASE: .endif 00f56d 000c .dw USER_BASE .include "words/cells.asm" ; Arithmetics ; n2 is the size in address units of n1 cells VE_CELLS: 00f56e ff05 .dw $ff05 00f56f 6563 00f570 6c6c 00f571 0073 .db "cells",0 00f572 f568 .dw VE_HEAD .set VE_HEAD = VE_CELLS XT_CELLS: 00f573 f21e .dw PFA_2STAR .include "words/cellplus.asm" ; Arithmetics ; add the size of an address-unit to a-addr1 VE_CELLPLUS: 00f574 ff05 .dw $ff05 00f575 6563 00f576 6c6c 00f577 002b .db "cell+",0 00f578 f56e .dw VE_HEAD .set VE_HEAD = VE_CELLPLUS XT_CELLPLUS: 00f579 f57a .dw PFA_CELLPLUS PFA_CELLPLUS: 00f57a 9602 adiw tosl, CELLSIZE 00f57b ca89 jmp_ DO_NEXT .include "words/2dup.asm" ; Stack ; Duplicate the 2 top elements .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_2DUP: 00f57c ff04 .dw $ff04 00f57d 6432 00f57e 7075 .db "2dup" 00f57f f574 .dw VE_HEAD .set VE_HEAD = VE_2DUP XT_2DUP: 00f580 f001 .dw DO_COLON PFA_2DUP: .endif 00f581 f0e1 .dw XT_OVER 00f582 f0e1 .dw XT_OVER 00f583 f026 .dw XT_EXIT .include "words/2drop.asm" ; Stack ; Remove the 2 top elements .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_2DROP: 00f584 ff05 .dw $ff05 00f585 6432 00f586 6f72 00f587 0070 .db "2drop",0 00f588 f57c .dw VE_HEAD .set VE_HEAD = VE_2DROP XT_2DROP: 00f589 f001 .dw DO_COLON PFA_2DROP: .endif 00f58a f0eb .dw XT_DROP 00f58b f0eb .dw XT_DROP 00f58c f026 .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: 00f58d ff04 .dw $ff04 00f58e 7574 00f58f 6b63 .db "tuck" 00f590 f584 .dw VE_HEAD .set VE_HEAD = VE_TUCK XT_TUCK: 00f591 f001 .dw DO_COLON PFA_TUCK: .endif 00f592 f0d6 .dw XT_SWAP 00f593 f0e1 .dw XT_OVER 00f594 f026 .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: 00f595 ff03 .dw $ff03 00f596 693e 00f597 006e .db ">in",0 00f598 f58d .dw VE_HEAD .set VE_HEAD = VE_TO_IN XT_TO_IN: 00f599 f067 .dw PFA_DOUSER PFA_TO_IN: .endif 00f59a 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: 00f59b ff03 .dw $ff03 00f59c 6170 00f59d 0064 .db "pad",0 00f59e f595 .dw VE_HEAD .set VE_HEAD = VE_PAD XT_PAD: 00f59f f001 .dw DO_COLON PFA_PAD: .endif 00f5a0 f5da .dw XT_HERE 00f5a1 f046 .dw XT_DOLITERAL 00f5a2 0028 .dw 40 00f5a3 f1af .dw XT_PLUS 00f5a4 f026 .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: 00f5a5 ff04 .dw $ff04 00f5a6 6d65 00f5a7 7469 .db "emit" 00f5a8 f59b .dw VE_HEAD .set VE_HEAD = VE_EMIT XT_EMIT: 00f5a9 fc2e .dw PFA_DODEFER1 PFA_EMIT: .endif 00f5aa 000e .dw USER_EMIT 00f5ab fbf7 .dw XT_UDEFERFETCH 00f5ac fc03 .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: 00f5ad ff05 .dw $ff05 00f5ae 6d65 00f5af 7469 00f5b0 003f .db "emit?",0 00f5b1 f5a5 .dw VE_HEAD .set VE_HEAD = VE_EMITQ XT_EMITQ: 00f5b2 fc2e .dw PFA_DODEFER1 PFA_EMITQ: .endif 00f5b3 0010 .dw USER_EMITQ 00f5b4 fbf7 .dw XT_UDEFERFETCH 00f5b5 fc03 .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: 00f5b6 ff03 .dw $ff03 00f5b7 656b 00f5b8 0079 .db "key",0 00f5b9 f5ad .dw VE_HEAD .set VE_HEAD = VE_KEY XT_KEY: 00f5ba fc2e .dw PFA_DODEFER1 PFA_KEY: .endif 00f5bb 0012 .dw USER_KEY 00f5bc fbf7 .dw XT_UDEFERFETCH 00f5bd fc03 .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: 00f5be ff04 .dw $ff04 00f5bf 656b 00f5c0 3f79 .db "key?" 00f5c1 f5b6 .dw VE_HEAD .set VE_HEAD = VE_KEYQ XT_KEYQ: 00f5c2 fc2e .dw PFA_DODEFER1 PFA_KEYQ: .endif 00f5c3 0014 .dw USER_KEYQ 00f5c4 fbf7 .dw XT_UDEFERFETCH 00f5c5 fc03 .dw XT_UDEFERSTORE .include "words/dp.asm" ; System Value ; address of the next free dictionary cell VE_DP: 00f5c6 ff02 .dw $ff02 00f5c7 7064 .db "dp" 00f5c8 f5be .dw VE_HEAD .set VE_HEAD = VE_DP XT_DP: 00f5c9 f081 .dw PFA_DOVALUE1 PFA_DP: 00f5ca 0048 .dw CFG_DP 00f5cb fbcf .dw XT_EDEFERFETCH 00f5cc fbd9 .dw XT_EDEFERSTORE .include "words/ehere.asm" ; System Value ; address of the next free address in eeprom VE_EHERE: 00f5cd ff05 .dw $ff05 00f5ce 6865 00f5cf 7265 00f5d0 0065 .db "ehere",0 00f5d1 f5c6 .dw VE_HEAD .set VE_HEAD = VE_EHERE XT_EHERE: 00f5d2 f081 .dw PFA_DOVALUE1 PFA_EHERE: 00f5d3 004c .dw EE_EHERE 00f5d4 fbcf .dw XT_EDEFERFETCH 00f5d5 fbd9 .dw XT_EDEFERSTORE .include "words/here.asm" ; System Value ; address of the next free data space (RAM) cell VE_HERE: 00f5d6 ff04 .dw $ff04 00f5d7 6568 00f5d8 6572 .db "here" 00f5d9 f5cd .dw VE_HEAD .set VE_HEAD = VE_HERE XT_HERE: 00f5da f081 .dw PFA_DOVALUE1 PFA_HERE: 00f5db 004a .dw EE_HERE 00f5dc fbcf .dw XT_EDEFERFETCH 00f5dd fbd9 .dw XT_EDEFERSTORE .include "words/allot.asm" ; System ; allocate or release memory in RAM VE_ALLOT: 00f5de ff05 .dw $ff05 00f5df 6c61 00f5e0 6f6c 00f5e1 0074 .db "allot",0 00f5e2 f5d6 .dw VE_HEAD .set VE_HEAD = VE_ALLOT XT_ALLOT: 00f5e3 f001 .dw DO_COLON PFA_ALLOT: 00f5e4 f5da .dw XT_HERE 00f5e5 f1af .dw XT_PLUS 00f5e6 fbb4 .dw XT_DOTO 00f5e7 f5db .dw PFA_HERE 00f5e8 f026 .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: 00f5e9 ff03 .dw $ff03 00f5ea 6962 00f5eb 006e .db "bin",0 00f5ec f5de .dw VE_HEAD .set VE_HEAD = VE_BIN XT_BIN: 00f5ed f001 .dw DO_COLON PFA_BIN: .endif 00f5ee fda6 .dw XT_TWO 00f5ef f56c .dw XT_BASE 00f5f0 f093 .dw XT_STORE 00f5f1 f026 .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: 00f5f2 ff07 .dw $ff07 00f5f3 6564 00f5f4 6963 00f5f5 616d 00f5f6 006c .db "decimal",0 00f5f7 f5e9 .dw VE_HEAD .set VE_HEAD = VE_DECIMAL XT_DECIMAL: 00f5f8 f001 .dw DO_COLON PFA_DECIMAL: .endif 00f5f9 f046 .dw XT_DOLITERAL 00f5fa 000a .dw 10 00f5fb f56c .dw XT_BASE 00f5fc f093 .dw XT_STORE 00f5fd f026 .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: 00f5fe ff03 .dw $ff03 00f5ff 6568 00f600 0078 .db "hex",0 00f601 f5f2 .dw VE_HEAD .set VE_HEAD = VE_HEX XT_HEX: 00f602 f001 .dw DO_COLON PFA_HEX: .endif 00f603 f046 .dw XT_DOLITERAL 00f604 0010 .dw 16 00f605 f56c .dw XT_BASE 00f606 f093 .dw XT_STORE 00f607 f026 .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: 00f608 ff02 .dw $ff02 00f609 6c62 .db "bl" 00f60a f5fe .dw VE_HEAD .set VE_HEAD = VE_BL XT_BL: 00f60b f054 .dw PFA_DOVARIABLE PFA_BL: .endif 00f60c 0020 .dw 32 .include "words/turnkey.asm" ; System Value ; Deferred action during startup/reset VE_TURNKEY: 00f60d ff07 .dw $ff07 00f60e 7574 00f60f 6e72 00f610 656b 00f611 0079 .db "turnkey",0 00f612 f608 .dw VE_HEAD .set VE_HEAD = VE_TURNKEY XT_TURNKEY: 00f613 fc2e .dw PFA_DODEFER1 PFA_TURNKEY: 00f614 0054 .dw CFG_TURNKEY 00f615 fbcf .dw XT_EDEFERFETCH 00f616 fbd9 .dw XT_EDEFERSTORE ;;;;;;;;;;;;;;;;;;;;;;;;;;;; .include "words/slashmod.asm" ; Arithmetics ; signed division n1/n2 with remainder and quotient VE_SLASHMOD: 00f617 ff04 .dw $ff04 00f618 6d2f 00f619 646f .db "/mod" 00f61a f60d .dw VE_HEAD .set VE_HEAD = VE_SLASHMOD XT_SLASHMOD: 00f61b f61c .dw PFA_SLASHMOD PFA_SLASHMOD: 00f61c 019c movw temp2, tosl 00f61d 9109 ld temp0, Y+ 00f61e 9119 ld temp1, Y+ 00f61f 2f41 mov temp6,temp1 ;move dividend High to sign register 00f620 2743 eor temp6,temp3 ;xor divisor High with sign register 00f621 ff17 sbrs temp1,7 ;if MSB in dividend set 00f622 c004 rjmp PFA_SLASHMOD_1 00f623 9510 com temp1 ; change sign of dividend 00f624 9500 com temp0 00f625 5f0f subi temp0,low(-1) 00f626 4f1f sbci temp1,high(-1) PFA_SLASHMOD_1: 00f627 ff37 sbrs temp3,7 ;if MSB in divisor set 00f628 c004 rjmp PFA_SLASHMOD_2 00f629 9530 com temp3 ; change sign of divisor 00f62a 9520 com temp2 00f62b 5f2f subi temp2,low(-1) 00f62c 4f3f sbci temp3,high(-1) 00f62d 24ee PFA_SLASHMOD_2: clr temp4 ;clear remainder Low byte 00f62e 18ff sub temp5,temp5;clear remainder High byte and carry 00f62f e151 ldi temp7,17 ;init loop counter 00f630 1f00 PFA_SLASHMOD_3: rol temp0 ;shift left dividend 00f631 1f11 rol temp1 00f632 955a dec temp7 ;decrement counter 00f633 f439 brne PFA_SLASHMOD_5 ;if done 00f634 ff47 sbrs temp6,7 ; if MSB in sign register set 00f635 c004 rjmp PFA_SLASHMOD_4 00f636 9510 com temp1 ; change sign of result 00f637 9500 com temp0 00f638 5f0f subi temp0,low(-1) 00f639 4f1f sbci temp1,high(-1) 00f63a c00b PFA_SLASHMOD_4: rjmp PFA_SLASHMODmod_done ; return 00f63b 1cee PFA_SLASHMOD_5: rol temp4 ;shift dividend into remainder 00f63c 1cff rol temp5 00f63d 1ae2 sub temp4,temp2 ;remainder = remainder - divisor 00f63e 0af3 sbc temp5,temp3 ; 00f63f f420 brcc PFA_SLASHMOD_6 ;if result negative 00f640 0ee2 add temp4,temp2 ; restore remainder 00f641 1ef3 adc temp5,temp3 00f642 9488 clc ; clear carry to be shifted into result 00f643 cfec rjmp PFA_SLASHMOD_3 ;else 00f644 9408 PFA_SLASHMOD_6: sec ; set carry to be shifted into result 00f645 cfea rjmp PFA_SLASHMOD_3 PFA_SLASHMODmod_done: ; put remainder on stack 00f646 92fa st -Y,temp5 00f647 92ea st -Y,temp4 ; put quotient on stack 00f648 01c8 movw tosl, temp0 00f649 c9bb jmp_ DO_NEXT .include "words/uslashmod.asm" ; Arithmetics ; unsigned division with remainder VE_USLASHMOD: 00f64a ff05 .dw $ff05 00f64b 2f75 00f64c 6f6d 00f64d 0064 .db "u/mod",0 00f64e f617 .dw VE_HEAD .set VE_HEAD = VE_USLASHMOD XT_USLASHMOD: 00f64f f001 .dw DO_COLON PFA_USLASHMOD: 00f650 f111 .dw XT_TO_R 00f651 f166 .dw XT_ZERO 00f652 f108 .dw XT_R_FROM 00f653 f1d4 .dw XT_UMSLASHMOD 00f654 f026 .dw XT_EXIT .include "words/negate.asm" ; Logic ; 2-complement VE_NEGATE: 00f655 ff06 .dw $ff06 00f656 656e 00f657 6167 00f658 6574 .db "negate" 00f659 f64a .dw VE_HEAD .set VE_HEAD = VE_NEGATE XT_NEGATE: 00f65a f001 .dw DO_COLON PFA_NEGATE: 00f65b f20f .dw XT_INVERT 00f65c f241 .dw XT_1PLUS 00f65d f026 .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: 00f65e ff01 .dw $ff01 00f65f 002f .db "/",0 00f660 f655 .dw VE_HEAD .set VE_HEAD = VE_SLASH XT_SLASH: 00f661 f001 .dw DO_COLON PFA_SLASH: .endif 00f662 f61b .dw XT_SLASHMOD 00f663 f102 .dw XT_NIP 00f664 f026 .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: 00f665 ff03 .dw $ff03 00f666 6f6d 00f667 0064 .db "mod",0 00f668 f65e .dw VE_HEAD .set VE_HEAD = VE_MOD XT_MOD: 00f669 f001 .dw DO_COLON PFA_MOD: .endif 00f66a f61b .dw XT_SLASHMOD 00f66b f0eb .dw XT_DROP 00f66c f026 .dw XT_EXIT .include "words/abs.asm" ; DUP ?NEGATE ; .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_ABS: 00f66d ff03 .dw $ff03 00f66e 6261 00f66f 0073 .db "abs",0 00f670 f665 .dw VE_HEAD .set VE_HEAD = VE_ABS XT_ABS: 00f671 f001 .dw DO_COLON PFA_ABS: .endif 00f672 f0c3 00f673 f250 00f674 f026 .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: 00f675 ff03 .dw $ff03 00f676 696d 00f677 006e .db "min",0 00f678 f66d .dw VE_HEAD .set VE_HEAD = VE_MIN XT_MIN: 00f679 f001 .dw DO_COLON PFA_MIN: .endif 00f67a f580 .dw XT_2DUP 00f67b f18a .dw XT_GREATER 00f67c f03f .dw XT_DOCONDBRANCH 00f67d f67f DEST(PFA_MIN1) 00f67e f0d6 .dw XT_SWAP PFA_MIN1: 00f67f f0eb .dw XT_DROP 00f680 f026 .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: 00f681 ff03 .dw $ff03 00f682 616d 00f683 0078 .db "max",0 00f684 f675 .dw VE_HEAD .set VE_HEAD = VE_MAX XT_MAX: 00f685 f001 .dw DO_COLON PFA_MAX: .endif 00f686 f580 .dw XT_2DUP 00f687 f180 .dw XT_LESS 00f688 f03f .dw XT_DOCONDBRANCH 00f689 f68b DEST(PFA_MAX1) 00f68a f0d6 .dw XT_SWAP PFA_MAX1: 00f68b f0eb .dw XT_DROP 00f68c f026 .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: 00f68d ff06 .dw $ff06 00f68e 6977 00f68f 6874 00f690 6e69 .db "within" 00f691 f681 .dw VE_HEAD .set VE_HEAD = VE_WITHIN XT_WITHIN: 00f692 f001 .dw DO_COLON PFA_WITHIN: .endif 00f693 f0e1 .dw XT_OVER 00f694 f1a5 .dw XT_MINUS 00f695 f111 .dw XT_TO_R 00f696 f1a5 .dw XT_MINUS 00f697 f108 .dw XT_R_FROM 00f698 f16e .dw XT_ULESS 00f699 f026 .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: 00f69a ff07 .dw $ff07 00f69b 6f74 00f69c 7075 00f69d 6570 00f69e 0072 .db "toupper",0 00f69f f68d .dw VE_HEAD .set VE_HEAD = VE_TOUPPER XT_TOUPPER: 00f6a0 f001 .dw DO_COLON PFA_TOUPPER: .endif 00f6a1 f0c3 .dw XT_DUP 00f6a2 f046 .dw XT_DOLITERAL 00f6a3 0061 .dw 'a' 00f6a4 f046 .dw XT_DOLITERAL 00f6a5 007b .dw 'z'+1 00f6a6 f692 .dw XT_WITHIN 00f6a7 f03f .dw XT_DOCONDBRANCH 00f6a8 f6ac DEST(PFA_TOUPPER0) 00f6a9 f046 .dw XT_DOLITERAL 00f6aa 00df .dw 223 ; inverse of 0x20: 0xdf 00f6ab f225 .dw XT_AND PFA_TOUPPER0: 00f6ac f026 .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: 00f6ad ff07 .dw $ff07 00f6ae 6f74 00f6af 6f6c 00f6b0 6577 00f6b1 0072 .db "tolower",0 00f6b2 f69a .dw VE_HEAD .set VE_HEAD = VE_TOLOWER XT_TOLOWER: 00f6b3 f001 .dw DO_COLON PFA_TOLOWER: .endif 00f6b4 f0c3 .dw XT_DUP 00f6b5 f046 .dw XT_DOLITERAL 00f6b6 0041 .dw 'A' 00f6b7 f046 .dw XT_DOLITERAL 00f6b8 005b .dw 'Z'+1 00f6b9 f692 .dw XT_WITHIN 00f6ba f03f .dw XT_DOCONDBRANCH 00f6bb f6bf DEST(PFA_TOLOWER0) 00f6bc f046 .dw XT_DOLITERAL 00f6bd 0020 .dw 32 00f6be f22e .dw XT_OR PFA_TOLOWER0: 00f6bf f026 .dw XT_EXIT ;;;;;;;;;;;;;;;;;;;;;; .include "words/hld.asm" ; Numeric IO ; pointer to current write position in the Pictured Numeric Output buffer VE_HLD: 00f6c0 ff03 .dw $ff03 00f6c1 6c68 00f6c2 0064 .db "hld",0 00f6c3 f6ad .dw VE_HEAD .set VE_HEAD = VE_HLD XT_HLD: 00f6c4 f054 .dw PFA_DOVARIABLE PFA_HLD: 00f6c5 013f .dw ram_hld .dseg 00013f 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: 00f6c6 ff04 .dw $ff04 00f6c7 6f68 00f6c8 646c .db "hold" 00f6c9 f6c0 .dw VE_HEAD .set VE_HEAD = VE_HOLD XT_HOLD: 00f6ca f001 .dw DO_COLON PFA_HOLD: .endif 00f6cb f6c4 .dw XT_HLD 00f6cc f0c3 .dw XT_DUP 00f6cd f08b .dw XT_FETCH 00f6ce f247 .dw XT_1MINUS 00f6cf f0c3 .dw XT_DUP 00f6d0 f111 .dw XT_TO_R 00f6d1 f0d6 .dw XT_SWAP 00f6d2 f093 .dw XT_STORE 00f6d3 f108 .dw XT_R_FROM 00f6d4 f09f .dw XT_CSTORE 00f6d5 f026 .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: 00f6d6 ff02 .dw $ff02 00f6d7 233c .db "<#" 00f6d8 f6c6 .dw VE_HEAD .set VE_HEAD = VE_L_SHARP XT_L_SHARP: 00f6d9 f001 .dw DO_COLON PFA_L_SHARP: .endif 00f6da f59f .dw XT_PAD 00f6db f6c4 .dw XT_HLD 00f6dc f093 .dw XT_STORE 00f6dd f026 .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: 00f6de ff01 .dw $ff01 00f6df 0023 .db "#",0 00f6e0 f6d6 .dw VE_HEAD .set VE_HEAD = VE_SHARP XT_SHARP: 00f6e1 f001 .dw DO_COLON PFA_SHARP: .endif 00f6e2 f56c .dw XT_BASE 00f6e3 f08b .dw XT_FETCH 00f6e4 f75e .dw XT_UDSLASHMOD 00f6e5 f0f3 .dw XT_ROT 00f6e6 f046 .dw XT_DOLITERAL 00f6e7 0009 .dw 9 00f6e8 f0e1 .dw XT_OVER 00f6e9 f180 .dw XT_LESS 00f6ea f03f .dw XT_DOCONDBRANCH 00f6eb f6ef DEST(PFA_SHARP1) 00f6ec f046 .dw XT_DOLITERAL 00f6ed 0007 .dw 7 00f6ee f1af .dw XT_PLUS PFA_SHARP1: 00f6ef f046 .dw XT_DOLITERAL 00f6f0 0030 .dw 48 ; ASCII 0 00f6f1 f1af .dw XT_PLUS 00f6f2 f6ca .dw XT_HOLD 00f6f3 f026 .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: 00f6f4 ff02 .dw $ff02 00f6f5 7323 .db "#s" 00f6f6 f6de .dw VE_HEAD .set VE_HEAD = VE_SHARP_S XT_SHARP_S: 00f6f7 f001 .dw DO_COLON PFA_SHARP_S: .endif NUMS1: 00f6f8 f6e1 .dw XT_SHARP 00f6f9 f580 .dw XT_2DUP 00f6fa f22e .dw XT_OR 00f6fb f12c .dw XT_ZEROEQUAL 00f6fc f03f .dw XT_DOCONDBRANCH 00f6fd f6f8 DEST(NUMS1) ; PFA_SHARP_S 00f6fe f026 .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: 00f6ff ff02 .dw $ff02 00f700 3e23 .db "#>" 00f701 f6f4 .dw VE_HEAD .set VE_HEAD = VE_SHARP_G XT_SHARP_G: 00f702 f001 .dw DO_COLON PFA_SHARP_G: .endif 00f703 f589 .dw XT_2DROP 00f704 f6c4 .dw XT_HLD 00f705 f08b .dw XT_FETCH 00f706 f59f .dw XT_PAD 00f707 f0e1 .dw XT_OVER 00f708 f1a5 .dw XT_MINUS 00f709 f026 .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: 00f70a ff04 .dw $ff04 00f70b 6973 00f70c 6e67 .db "sign" 00f70d f6ff .dw VE_HEAD .set VE_HEAD = VE_SIGN XT_SIGN: 00f70e f001 .dw DO_COLON PFA_SIGN: .endif 00f70f f133 .dw XT_ZEROLESS 00f710 f03f .dw XT_DOCONDBRANCH 00f711 f715 DEST(PFA_SIGN1) 00f712 f046 .dw XT_DOLITERAL 00f713 002d .dw 45 ; ascii - 00f714 f6ca .dw XT_HOLD PFA_SIGN1: 00f715 f026 .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: 00f716 ff03 .dw $ff03 00f717 2e64 00f718 0072 .db "d.r",0 00f719 f70a .dw VE_HEAD .set VE_HEAD = VE_DDOTR XT_DDOTR: 00f71a f001 .dw DO_COLON PFA_DDOTR: .endif 00f71b f111 .dw XT_TO_R 00f71c f591 .dw XT_TUCK 00f71d fcef .dw XT_DABS 00f71e f6d9 .dw XT_L_SHARP 00f71f f6f7 .dw XT_SHARP_S 00f720 f0f3 .dw XT_ROT 00f721 f70e .dw XT_SIGN 00f722 f702 .dw XT_SHARP_G 00f723 f108 .dw XT_R_FROM 00f724 f0e1 .dw XT_OVER 00f725 f1a5 .dw XT_MINUS 00f726 f806 .dw XT_SPACES 00f727 f816 .dw XT_TYPE 00f728 f026 .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: 00f729 ff02 .dw $ff02 00f72a 722e .db ".r" 00f72b f716 .dw VE_HEAD .set VE_HEAD = VE_DOTR XT_DOTR: 00f72c f001 .dw DO_COLON PFA_DOTR: .endif 00f72d f111 .dw XT_TO_R 00f72e fd82 .dw XT_S2D 00f72f f108 .dw XT_R_FROM 00f730 f71a .dw XT_DDOTR 00f731 f026 .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: 00f732 ff02 .dw $ff02 00f733 2e64 .db "d." 00f734 f729 .dw VE_HEAD .set VE_HEAD = VE_DDOT XT_DDOT: 00f735 f001 .dw DO_COLON PFA_DDOT: .endif 00f736 f166 .dw XT_ZERO 00f737 f71a .dw XT_DDOTR 00f738 f7fd .dw XT_SPACE 00f739 f026 .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: 00f73a ff01 .dw $ff01 00f73b 002e .db ".",0 00f73c f732 .dw VE_HEAD .set VE_HEAD = VE_DOT XT_DOT: 00f73d f001 .dw DO_COLON PFA_DOT: .endif 00f73e fd82 .dw XT_S2D 00f73f f735 .dw XT_DDOT 00f740 f026 .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: 00f741 ff03 .dw $ff03 00f742 6475 00f743 002e .db "ud.",0 00f744 f73a .dw VE_HEAD .set VE_HEAD = VE_UDDOT XT_UDDOT: 00f745 f001 .dw DO_COLON PFA_UDDOT: .endif 00f746 f166 .dw XT_ZERO 00f747 f74e .dw XT_UDDOTR 00f748 f7fd .dw XT_SPACE 00f749 f026 .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: 00f74a ff04 .dw $ff04 00f74b 6475 00f74c 722e .db "ud.r" 00f74d f741 .dw VE_HEAD .set VE_HEAD = VE_UDDOTR XT_UDDOTR: 00f74e f001 .dw DO_COLON PFA_UDDOTR: .endif 00f74f f111 .dw XT_TO_R 00f750 f6d9 .dw XT_L_SHARP 00f751 f6f7 .dw XT_SHARP_S 00f752 f702 .dw XT_SHARP_G 00f753 f108 .dw XT_R_FROM 00f754 f0e1 .dw XT_OVER 00f755 f1a5 .dw XT_MINUS 00f756 f806 .dw XT_SPACES 00f757 f816 .dw XT_TYPE 00f758 f026 .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: 00f759 ff06 .dw $ff06 00f75a 6475 00f75b 6d2f 00f75c 646f .db "ud/mod" 00f75d f74a .dw VE_HEAD .set VE_HEAD = VE_UDSLASHMOD XT_UDSLASHMOD: 00f75e f001 .dw DO_COLON PFA_UDSLASHMOD: .endif 00f75f f111 .dw XT_TO_R 00f760 f166 .dw XT_ZERO 00f761 f11a .dw XT_R_FETCH 00f762 f1d4 .dw XT_UMSLASHMOD 00f763 f108 .dw XT_R_FROM 00f764 f0d6 .dw XT_SWAP 00f765 f111 .dw XT_TO_R 00f766 f1d4 .dw XT_UMSLASHMOD 00f767 f108 .dw XT_R_FROM 00f768 f026 .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: 00f769 ff06 .dw $ff06 00f76a 6964 00f76b 6967 00f76c 3f74 .db "digit?" 00f76d f759 .dw VE_HEAD .set VE_HEAD = VE_DIGITQ XT_DIGITQ: 00f76e f001 .dw DO_COLON PFA_DIGITQ: .endif 00f76f f6a0 .dw XT_TOUPPER 00f770 f0c3 00f771 f046 00f772 0039 00f773 f18a 00f774 f046 00f775 0100 .DW XT_DUP,XT_DOLITERAL,57,XT_GREATER,XT_DOLITERAL,256 00f776 f225 00f777 f1af 00f778 f0c3 00f779 f046 00f77a 0140 00f77b f18a .DW XT_AND,XT_PLUS,XT_DUP,XT_DOLITERAL,320,XT_GREATER 00f77c f046 00f77d 0107 00f77e f225 00f77f f1a5 00f780 f046 00f781 0030 .DW XT_DOLITERAL,263,XT_AND,XT_MINUS,XT_DOLITERAL,48 00f782 f1a5 00f783 f0c3 00f784 f56c 00f785 f08b 00f786 f16e .DW XT_MINUS,XT_DUP,XT_BASE,XT_FETCH,XT_ULESS 00f787 f026 .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: 00f788 f001 .dw DO_COLON PFA_DOSLITERAL: 00f789 f11a .dw XT_R_FETCH ; ( -- addr ) 00f78a f7e7 .dw XT_ICOUNT 00f78b f108 .dw XT_R_FROM 00f78c f0e1 .dw XT_OVER ; ( -- addr' n addr n) 00f78d f241 .dw XT_1PLUS 00f78e f216 .dw XT_2SLASH ; ( -- addr' n addr k ) 00f78f f1af .dw XT_PLUS ; ( -- addr' n addr'' ) 00f790 f241 .dw XT_1PLUS 00f791 f111 .dw XT_TO_R ; ( -- ) 00f792 f026 .dw XT_EXIT .include "words/scomma.asm" ; Compiler ; compiles a string from RAM to Flash VE_SCOMMA: 00f793 ff02 .dw $ff02 00f794 2c73 .db "s",$2c 00f795 f769 .dw VE_HEAD .set VE_HEAD = VE_SCOMMA XT_SCOMMA: 00f796 f001 .dw DO_COLON PFA_SCOMMA: 00f797 f0c3 .dw XT_DUP 00f798 f79a .dw XT_DOSCOMMA 00f799 f026 .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: 00f79a f001 .dw DO_COLON PFA_DOSCOMMA: 00f79b 01db .dw XT_COMMA 00f79c f0c3 .dw XT_DUP ; ( --addr len len) 00f79d f216 .dw XT_2SLASH ; ( -- addr len len/2 00f79e f591 .dw XT_TUCK ; ( -- addr len/2 len len/2 00f79f f21d .dw XT_2STAR ; ( -- addr len/2 len len' 00f7a0 f1a5 .dw XT_MINUS ; ( -- addr len/2 rem 00f7a1 f111 .dw XT_TO_R 00f7a2 f166 .dw XT_ZERO 00f7a3 029a .dw XT_QDOCHECK 00f7a4 f03f .dw XT_DOCONDBRANCH 00f7a5 f7ad .dw PFA_SCOMMA2 00f7a6 f2ad .dw XT_DODO PFA_SCOMMA1: 00f7a7 f0c3 .dw XT_DUP ; ( -- addr addr ) 00f7a8 f08b .dw XT_FETCH ; ( -- addr c1c2 ) 00f7a9 01db .dw XT_COMMA ; ( -- addr ) 00f7aa f579 .dw XT_CELLPLUS ; ( -- addr+cell ) 00f7ab f2db .dw XT_DOLOOP 00f7ac f7a7 .dw PFA_SCOMMA1 PFA_SCOMMA2: 00f7ad f108 .dw XT_R_FROM 00f7ae f13a .dw XT_GREATERZERO 00f7af f03f .dw XT_DOCONDBRANCH 00f7b0 f7b4 .dw PFA_SCOMMA3 00f7b1 f0c3 .dw XT_DUP ; well, tricky 00f7b2 f0aa .dw XT_CFETCH 00f7b3 01db .dw XT_COMMA PFA_SCOMMA3: 00f7b4 f0eb .dw XT_DROP ; ( -- ) 00f7b5 f026 .dw XT_EXIT .include "words/itype.asm" ; Tools ; reads string from flash and prints it VE_ITYPE: 00f7b6 ff05 .dw $ff05 00f7b7 7469 00f7b8 7079 00f7b9 0065 .db "itype",0 00f7ba f793 .dw VE_HEAD .set VE_HEAD = VE_ITYPE XT_ITYPE: 00f7bb f001 .dw DO_COLON PFA_ITYPE: 00f7bc f0c3 .dw XT_DUP ; ( --addr len len) 00f7bd f216 .dw XT_2SLASH ; ( -- addr len len/2 00f7be f591 .dw XT_TUCK ; ( -- addr len/2 len len/2 00f7bf f21d .dw XT_2STAR ; ( -- addr len/2 len len' 00f7c0 f1a5 .dw XT_MINUS ; ( -- addr len/2 rem 00f7c1 f111 .dw XT_TO_R 00f7c2 f166 .dw XT_ZERO 00f7c3 029a .dw XT_QDOCHECK 00f7c4 f03f .dw XT_DOCONDBRANCH 00f7c5 f7cf .dw PFA_ITYPE2 00f7c6 f2ad .dw XT_DODO PFA_ITYPE1: 00f7c7 f0c3 .dw XT_DUP ; ( -- addr addr ) 00f7c8 f3e3 .dw XT_FETCHI ; ( -- addr c1c2 ) 00f7c9 f0c3 .dw XT_DUP 00f7ca f7dc .dw XT_LOWEMIT 00f7cb f7d8 .dw XT_HIEMIT 00f7cc f241 .dw XT_1PLUS ; ( -- addr+cell ) 00f7cd f2db .dw XT_DOLOOP 00f7ce f7c7 .dw PFA_ITYPE1 PFA_ITYPE2: 00f7cf f108 .dw XT_R_FROM 00f7d0 f13a .dw XT_GREATERZERO 00f7d1 f03f .dw XT_DOCONDBRANCH 00f7d2 f7d6 .dw PFA_ITYPE3 00f7d3 f0c3 .dw XT_DUP ; make sure the drop below has always something to do 00f7d4 f3e3 .dw XT_FETCHI 00f7d5 f7dc .dw XT_LOWEMIT PFA_ITYPE3: 00f7d6 f0eb .dw XT_DROP 00f7d7 f026 .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: 00f7d8 f001 .dw DO_COLON PFA_HIEMIT: 00f7d9 f30b .dw XT_BYTESWAP 00f7da f7dc .dw XT_LOWEMIT 00f7db f026 .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: 00f7dc f001 .dw DO_COLON PFA_LOWEMIT: 00f7dd f046 .dw XT_DOLITERAL 00f7de 00ff .dw $00ff 00f7df f225 .dw XT_AND 00f7e0 f5a9 .dw XT_EMIT 00f7e1 f026 .dw XT_EXIT .include "words/icount.asm" ; Tools ; get count information out of a counted string in flash VE_ICOUNT: 00f7e2 ff06 .dw $ff06 00f7e3 6369 00f7e4 756f 00f7e5 746e .db "icount" 00f7e6 f7b6 .dw VE_HEAD .set VE_HEAD = VE_ICOUNT XT_ICOUNT: 00f7e7 f001 .dw DO_COLON PFA_ICOUNT: 00f7e8 f0c3 .dw XT_DUP 00f7e9 f241 .dw XT_1PLUS 00f7ea f0d6 .dw XT_SWAP 00f7eb f3e3 .dw XT_FETCHI 00f7ec f026 .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: 00f7ed ff02 .dw 0xff02 00f7ee 7263 .db "cr" 00f7ef f7e2 .dw VE_HEAD .set VE_HEAD = VE_CR XT_CR: 00f7f0 f001 .dw DO_COLON PFA_CR: .endif 00f7f1 f046 .dw XT_DOLITERAL 00f7f2 000d .dw 13 00f7f3 f5a9 .dw XT_EMIT 00f7f4 f046 .dw XT_DOLITERAL 00f7f5 000a .dw 10 00f7f6 f5a9 .dw XT_EMIT 00f7f7 f026 .dw XT_EXIT .include "words/space.asm" ; Character IO ; emits a space (bl) .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_SPACE: 00f7f8 ff05 .dw $ff05 00f7f9 7073 00f7fa 6361 00f7fb 0065 .db "space",0 00f7fc f7ed .dw VE_HEAD .set VE_HEAD = VE_SPACE XT_SPACE: 00f7fd f001 .dw DO_COLON PFA_SPACE: .endif 00f7fe f60b .dw XT_BL 00f7ff f5a9 .dw XT_EMIT 00f800 f026 .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: 00f801 ff06 .dw $ff06 00f802 7073 00f803 6361 00f804 7365 .db "spaces" 00f805 f7f8 .dw VE_HEAD .set VE_HEAD = VE_SPACES XT_SPACES: 00f806 f001 .dw DO_COLON PFA_SPACES: .endif ;C SPACES n -- output n spaces ; BEGIN DUP 0> WHILE SPACE 1- REPEAT DROP ; 00f807 f166 00f808 f685 .DW XT_ZERO, XT_MAX 00f809 f0c3 00f80a f03f SPCS1: .DW XT_DUP,XT_DOCONDBRANCH 00f80b f810 DEST(SPCS2) 00f80c f7fd 00f80d f247 00f80e f035 .DW XT_SPACE,XT_1MINUS,XT_DOBRANCH 00f80f f809 DEST(SPCS1) 00f810 f0eb 00f811 f026 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: 00f812 ff04 .dw $ff04 00f813 7974 00f814 6570 .db "type" 00f815 f801 .dw VE_HEAD .set VE_HEAD = VE_TYPE XT_TYPE: 00f816 f001 .dw DO_COLON PFA_TYPE: .endif 00f817 fd79 .dw XT_BOUNDS 00f818 029a .dw XT_QDOCHECK 00f819 f03f .dw XT_DOCONDBRANCH 00f81a f821 DEST(PFA_TYPE2) 00f81b f2ad .dw XT_DODO PFA_TYPE1: 00f81c f2be .dw XT_I 00f81d f0aa .dw XT_CFETCH 00f81e f5a9 .dw XT_EMIT 00f81f f2db .dw XT_DOLOOP 00f820 f81c DEST(PFA_TYPE1) PFA_TYPE2: 00f821 f026 .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: 00f822 ff01 .dw $ff01 00f823 0027 .db "'",0 00f824 f812 .dw VE_HEAD .set VE_HEAD = VE_TICK XT_TICK: 00f825 f001 .dw DO_COLON PFA_TICK: .endif 00f826 f9cf .dw XT_PARSENAME 00f827 fae7 .dw XT_FORTHRECOGNIZER 00f828 faf2 .dw XT_RECOGNIZE ; a word is tickable unless DT:TOKEN is DT:NULL or ; the interpret action is a NOOP 00f829 f0c3 .dw XT_DUP 00f82a fb65 .dw XT_DT_NULL 00f82b fd9a .dw XT_EQUAL 00f82c f0d6 .dw XT_SWAP 00f82d f3e3 .dw XT_FETCHI 00f82e f046 .dw XT_DOLITERAL 00f82f fb9a .dw XT_NOOP 00f830 fd9a .dw XT_EQUAL 00f831 f22e .dw XT_OR 00f832 f03f .dw XT_DOCONDBRANCH 00f833 f837 DEST(PFA_TICK1) 00f834 f046 .dw XT_DOLITERAL 00f835 fff3 .dw -13 00f836 f85c .dw XT_THROW PFA_TICK1: 00f837 f0eb .dw XT_DROP 00f838 f026 .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: 00f839 ff07 .dw $ff07 00f83a 6168 00f83b 646e 00f83c 656c 00f83d 0072 .db "handler",0 00f83e f822 .dw VE_HEAD .set VE_HEAD = VE_HANDLER XT_HANDLER: 00f83f f067 .dw PFA_DOUSER PFA_HANDLER: .endif 00f840 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: 00f841 ff05 .dw $ff05 00f842 6163 00f843 6374 00f844 0068 .db "catch",0 00f845 f839 .dw VE_HEAD .set VE_HEAD = VE_CATCH XT_CATCH: 00f846 f001 .dw DO_COLON PFA_CATCH: .endif ; sp@ >r 00f847 f29f .dw XT_SP_FETCH 00f848 f111 .dw XT_TO_R ; handler @ >r 00f849 f83f .dw XT_HANDLER 00f84a f08b .dw XT_FETCH 00f84b f111 .dw XT_TO_R ; rp@ handler ! 00f84c f288 .dw XT_RP_FETCH 00f84d f83f .dw XT_HANDLER 00f84e f093 .dw XT_STORE 00f84f f030 .dw XT_EXECUTE ; r> handler ! 00f850 f108 .dw XT_R_FROM 00f851 f83f .dw XT_HANDLER 00f852 f093 .dw XT_STORE 00f853 f108 .dw XT_R_FROM 00f854 f0eb .dw XT_DROP 00f855 f166 .dw XT_ZERO 00f856 f026 .dw XT_EXIT .include "words/throw.asm" ; Exceptions ; throw an exception .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_THROW: 00f857 ff05 .dw $ff05 00f858 6874 00f859 6f72 00f85a 0077 .db "throw",0 00f85b f841 .dw VE_HEAD .set VE_HEAD = VE_THROW XT_THROW: 00f85c f001 .dw DO_COLON PFA_THROW: .endif 00f85d f0c3 .dw XT_DUP 00f85e f12c .dw XT_ZEROEQUAL 00f85f f03f .dw XT_DOCONDBRANCH 00f860 f863 DEST(PFA_THROW1) 00f861 f0eb .dw XT_DROP 00f862 f026 .dw XT_EXIT PFA_THROW1: 00f863 f83f .dw XT_HANDLER 00f864 f08b .dw XT_FETCH 00f865 f292 .dw XT_RP_STORE 00f866 f108 .dw XT_R_FROM 00f867 f83f .dw XT_HANDLER 00f868 f093 .dw XT_STORE 00f869 f108 .dw XT_R_FROM 00f86a f0d6 .dw XT_SWAP 00f86b f111 .dw XT_TO_R 00f86c f2a8 .dw XT_SP_STORE 00f86d f0eb .dw XT_DROP 00f86e f108 .dw XT_R_FROM 00f86f f026 .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: 00f870 ff05 .dw $ff05 00f871 7363 00f872 696b 00f873 0070 .db "cskip",0 00f874 f857 .dw VE_HEAD .set VE_HEAD = VE_CSKIP XT_CSKIP: 00f875 f001 .dw DO_COLON PFA_CSKIP: .endif 00f876 f111 .dw XT_TO_R ; ( -- addr1 n1 ) PFA_CSKIP1: 00f877 f0c3 .dw XT_DUP ; ( -- addr' n' n' ) 00f878 f03f .dw XT_DOCONDBRANCH ; ( -- addr' n') 00f879 f884 DEST(PFA_CSKIP2) 00f87a f0e1 .dw XT_OVER ; ( -- addr' n' addr' ) 00f87b f0aa .dw XT_CFETCH ; ( -- addr' n' c' ) 00f87c f11a .dw XT_R_FETCH ; ( -- addr' n' c' c ) 00f87d fd9a .dw XT_EQUAL ; ( -- addr' n' f ) 00f87e f03f .dw XT_DOCONDBRANCH ; ( -- addr' n') 00f87f f884 DEST(PFA_CSKIP2) 00f880 fda1 .dw XT_ONE 00f881 f9c0 .dw XT_SLASHSTRING 00f882 f035 .dw XT_DOBRANCH 00f883 f877 DEST(PFA_CSKIP1) PFA_CSKIP2: 00f884 f108 .dw XT_R_FROM 00f885 f0eb .dw XT_DROP ; ( -- addr2 n2) 00f886 f026 .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: 00f887 ff05 .dw $ff05 00f888 7363 00f889 6163 ../../common\words/cscan.asm(12): warning: .cseg .db misalignment - padding zero byte 00f88a 006e .db "cscan" 00f88b f870 .dw VE_HEAD .set VE_HEAD = VE_CSCAN XT_CSCAN: 00f88c f001 .dw DO_COLON PFA_CSCAN: .endif 00f88d f111 .dw XT_TO_R 00f88e f0e1 .dw XT_OVER PFA_CSCAN1: 00f88f f0c3 .dw XT_DUP 00f890 f0aa .dw XT_CFETCH 00f891 f11a .dw XT_R_FETCH 00f892 fd9a .dw XT_EQUAL 00f893 f12c .dw XT_ZEROEQUAL 00f894 f03f .dw XT_DOCONDBRANCH 00f895 f8a1 DEST(PFA_CSCAN2) 00f896 f0d6 .dw XT_SWAP 00f897 f247 .dw XT_1MINUS 00f898 f0d6 .dw XT_SWAP 00f899 f0e1 .dw XT_OVER 00f89a f133 .dw XT_ZEROLESS ; not negative 00f89b f12c .dw XT_ZEROEQUAL 00f89c f03f .dw XT_DOCONDBRANCH 00f89d f8a1 DEST(PFA_CSCAN2) 00f89e f241 .dw XT_1PLUS 00f89f f035 .dw XT_DOBRANCH 00f8a0 f88f DEST(PFA_CSCAN1) PFA_CSCAN2: 00f8a1 f102 .dw XT_NIP 00f8a2 f0e1 .dw XT_OVER 00f8a3 f1a5 .dw XT_MINUS 00f8a4 f108 .dw XT_R_FROM 00f8a5 f0eb .dw XT_DROP 00f8a6 f026 .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: 00f8a7 ff06 .dw $ff06 00f8a8 6361 00f8a9 6563 00f8aa 7470 .db "accept" 00f8ab f887 .dw VE_HEAD .set VE_HEAD = VE_ACCEPT XT_ACCEPT: 00f8ac f001 .dw DO_COLON PFA_ACCEPT: .endif 00f8ad f0e1 00f8ae f1af 00f8af f247 00f8b0 f0e1 .DW XT_OVER,XT_PLUS,XT_1MINUS,XT_OVER 00f8b1 f5ba 00f8b2 f0c3 00f8b3 f8ed 00f8b4 f12c 00f8b5 f03f ACC1: .DW XT_KEY,XT_DUP,XT_CRLFQ,XT_ZEROEQUAL,XT_DOCONDBRANCH 00f8b6 f8df DEST(ACC5) 00f8b7 f0c3 00f8b8 f046 00f8b9 0008 00f8ba fd9a 00f8bb f03f .DW XT_DUP,XT_DOLITERAL,8,XT_EQUAL,XT_DOCONDBRANCH 00f8bc f8cf DEST(ACC3) 00f8bd f0eb 00f8be f0f3 00f8bf f580 00f8c0 f18a 00f8c1 f111 00f8c2 f0f3 00f8c3 f0f3 00f8c4 f108 00f8c5 f03f .DW XT_DROP,XT_ROT,XT_2DUP,XT_GREATER,XT_TO_R,XT_ROT,XT_ROT,XT_R_FROM,XT_DOCONDBRANCH 00f8c6 f8cd DEST(ACC6) 00f8c7 f8e5 00f8c8 f247 00f8c9 f111 00f8ca f0e1 00f8cb f108 00f8cc 016d .DW XT_BS,XT_1MINUS,XT_TO_R,XT_OVER,XT_R_FROM,XT_UMAX 00f8cd f035 ACC6: .DW XT_DOBRANCH 00f8ce f8dd DEST(ACC4) ACC3: ; check for remaining control characters, replace them with blank 00f8cf f0c3 .dw XT_DUP ; ( -- addr k k ) 00f8d0 f60b .dw XT_BL 00f8d1 f180 .dw XT_LESS 00f8d2 f03f .dw XT_DOCONDBRANCH 00f8d3 f8d6 DEST(PFA_ACCEPT6) 00f8d4 f0eb .dw XT_DROP 00f8d5 f60b .dw XT_BL PFA_ACCEPT6: 00f8d6 f0c3 00f8d7 f5a9 00f8d8 f0e1 00f8d9 f09f 00f8da f241 00f8db f0e1 00f8dc 0179 .DW XT_DUP,XT_EMIT,XT_OVER,XT_CSTORE,XT_1PLUS,XT_OVER,XT_UMIN 00f8dd f035 ACC4: .DW XT_DOBRANCH 00f8de f8b1 DEST(ACC1) 00f8df f0eb 00f8e0 f102 00f8e1 f0d6 00f8e2 f1a5 00f8e3 f7f0 00f8e4 f026 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: 00f8e5 f001 .dw DO_COLON .endif 00f8e6 f046 .dw XT_DOLITERAL 00f8e7 0008 .dw 8 00f8e8 f0c3 .dw XT_DUP 00f8e9 f5a9 .dw XT_EMIT 00f8ea f7fd .dw XT_SPACE 00f8eb f5a9 .dw XT_EMIT 00f8ec f026 .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: 00f8ed f001 .dw DO_COLON .endif 00f8ee f0c3 .dw XT_DUP 00f8ef f046 .dw XT_DOLITERAL 00f8f0 000d .dw 13 00f8f1 fd9a .dw XT_EQUAL 00f8f2 f0d6 .dw XT_SWAP 00f8f3 f046 .dw XT_DOLITERAL 00f8f4 000a .dw 10 00f8f5 fd9a .dw XT_EQUAL 00f8f6 f22e .dw XT_OR 00f8f7 f026 .dw XT_EXIT .include "words/refill.asm" ; System ; refills the input buffer .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_REFILL: 00f8f8 ff06 .dw $ff06 00f8f9 6572 00f8fa 6966 00f8fb 6c6c .db "refill" 00f8fc f8a7 .dw VE_HEAD .set VE_HEAD = VE_REFILL XT_REFILL: 00f8fd fc2e .dw PFA_DODEFER1 PFA_REFILL: .endif 00f8fe 001a .dw USER_REFILL 00f8ff fbf7 .dw XT_UDEFERFETCH 00f900 fc03 .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: 00f901 ff04 .dw $ff04 00f902 6863 00f903 7261 .db "char" 00f904 f8f8 .dw VE_HEAD .set VE_HEAD = VE_CHAR XT_CHAR: 00f905 f001 .dw DO_COLON PFA_CHAR: .endif 00f906 f9cf .dw XT_PARSENAME 00f907 f0eb .dw XT_DROP 00f908 f0aa .dw XT_CFETCH 00f909 f026 .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: 00f90a ff06 .dw $ff06 00f90b 756e 00f90c 626d 00f90d 7265 .db "number" 00f90e f901 .dw VE_HEAD .set VE_HEAD = VE_NUMBER XT_NUMBER: 00f90f f001 .dw DO_COLON PFA_NUMBER: .endif 00f910 f56c .dw XT_BASE 00f911 f08b .dw XT_FETCH 00f912 f111 .dw XT_TO_R 00f913 f953 .dw XT_QSIGN 00f914 f111 .dw XT_TO_R 00f915 f966 .dw XT_SET_BASE 00f916 f953 .dw XT_QSIGN 00f917 f108 .dw XT_R_FROM 00f918 f22e .dw XT_OR 00f919 f111 .dw XT_TO_R ; check whether something is left 00f91a f0c3 .dw XT_DUP 00f91b f12c .dw XT_ZEROEQUAL 00f91c f03f .dw XT_DOCONDBRANCH 00f91d f926 DEST(PFA_NUMBER0) ; nothing is left. It cannot be a number at all 00f91e f589 .dw XT_2DROP 00f91f f108 .dw XT_R_FROM 00f920 f0eb .dw XT_DROP 00f921 f108 .dw XT_R_FROM 00f922 f56c .dw XT_BASE 00f923 f093 .dw XT_STORE 00f924 f166 .dw XT_ZERO 00f925 f026 .dw XT_EXIT PFA_NUMBER0: 00f926 f330 .dw XT_2TO_R 00f927 f166 .dw XT_ZERO ; starting value 00f928 f166 .dw XT_ZERO 00f929 f33f .dw XT_2R_FROM 00f92a f984 .dw XT_TO_NUMBER ; ( 0. addr len -- d addr' len' ; check length of the remaining string. ; if zero: a single cell number is entered 00f92b f0cb .dw XT_QDUP 00f92c f03f .dw XT_DOCONDBRANCH 00f92d f948 DEST(PFA_NUMBER1) ; if equal 1: mayba a trailing dot? --> double cell number 00f92e fda1 .dw XT_ONE 00f92f fd9a .dw XT_EQUAL 00f930 f03f .dw XT_DOCONDBRANCH 00f931 f93f DEST(PFA_NUMBER2) ; excatly one character is left 00f932 f0aa .dw XT_CFETCH 00f933 f046 .dw XT_DOLITERAL 00f934 002e .dw 46 ; . 00f935 fd9a .dw XT_EQUAL 00f936 f03f .dw XT_DOCONDBRANCH 00f937 f940 DEST(PFA_NUMBER6) ; its a double cell number ; incorporate sign into number 00f938 f108 .dw XT_R_FROM 00f939 f03f .dw XT_DOCONDBRANCH 00f93a f93c DEST(PFA_NUMBER3) 00f93b fcfc .dw XT_DNEGATE PFA_NUMBER3: 00f93c fda6 .dw XT_TWO 00f93d f035 .dw XT_DOBRANCH 00f93e f94e DEST(PFA_NUMBER5) PFA_NUMBER2: 00f93f f0eb .dw XT_DROP PFA_NUMBER6: 00f940 f589 .dw XT_2DROP 00f941 f108 .dw XT_R_FROM 00f942 f0eb .dw XT_DROP 00f943 f108 .dw XT_R_FROM 00f944 f56c .dw XT_BASE 00f945 f093 .dw XT_STORE 00f946 f166 .dw XT_ZERO 00f947 f026 .dw XT_EXIT PFA_NUMBER1: 00f948 f589 .dw XT_2DROP ; remove the address ; incorporate sign into number 00f949 f108 .dw XT_R_FROM 00f94a f03f .dw XT_DOCONDBRANCH 00f94b f94d DEST(PFA_NUMBER4) 00f94c f65a .dw XT_NEGATE PFA_NUMBER4: 00f94d fda1 .dw XT_ONE PFA_NUMBER5: 00f94e f108 .dw XT_R_FROM 00f94f f56c .dw XT_BASE 00f950 f093 .dw XT_STORE 00f951 f15d .dw XT_TRUE 00f952 f026 .dw XT_EXIT .include "words/q-sign.asm" .if cpu_msp430==1 .endif .if cpu_avr8==1 XT_QSIGN: 00f953 f001 .dw DO_COLON PFA_QSIGN: ; ( c -- ) .endif 00f954 f0e1 .dw XT_OVER ; ( -- addr len addr ) 00f955 f0aa .dw XT_CFETCH 00f956 f046 .dw XT_DOLITERAL 00f957 002d .dw '-' 00f958 fd9a .dw XT_EQUAL ; ( -- addr len flag ) 00f959 f0c3 .dw XT_DUP 00f95a f111 .dw XT_TO_R 00f95b f03f .dw XT_DOCONDBRANCH 00f95c f95f DEST(PFA_NUMBERSIGN_DONE) 00f95d fda1 .dw XT_ONE ; skip sign character 00f95e f9c0 .dw XT_SLASHSTRING PFA_NUMBERSIGN_DONE: 00f95f f108 .dw XT_R_FROM 00f960 f026 .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: 00f961 f061 .dw PFA_DOCONSTANT .endif 00f962 000a 00f963 0010 00f964 0002 00f965 000a .dw 10,16,2,10 ; last one could a 8 instead. .if cpu_msp430==1 .endif .if cpu_avr8==1 XT_SET_BASE: 00f966 f001 .dw DO_COLON PFA_SET_BASE: ; ( adr1 len1 -- adr2 len2 ) .endif 00f967 f0e1 .dw XT_OVER 00f968 f0aa .dw XT_CFETCH 00f969 f046 .dw XT_DOLITERAL 00f96a 0023 .dw 35 00f96b f1a5 .dw XT_MINUS 00f96c f0c3 .dw XT_DUP 00f96d f166 .dw XT_ZERO 00f96e f046 .dw XT_DOLITERAL 00f96f 0004 .dw 4 00f970 f692 .dw XT_WITHIN 00f971 f03f .dw XT_DOCONDBRANCH 00f972 f97c DEST(SET_BASE1) .if cpu_msp430==1 .endif 00f973 f961 .dw XT_BASES 00f974 f1af .dw XT_PLUS 00f975 f3e3 .dw XT_FETCHI 00f976 f56c .dw XT_BASE 00f977 f093 .dw XT_STORE 00f978 fda1 .dw XT_ONE 00f979 f9c0 .dw XT_SLASHSTRING 00f97a f035 .dw XT_DOBRANCH 00f97b f97d DEST(SET_BASE2) SET_BASE1: 00f97c f0eb .dw XT_DROP SET_BASE2: 00f97d f026 .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: 00f97e ff07 .dw $ff07 00f97f 6e3e 00f980 6d75 00f981 6562 00f982 0072 .db ">number",0 00f983 f90a .dw VE_HEAD .set VE_HEAD = VE_TO_NUMBER XT_TO_NUMBER: 00f984 f001 .dw DO_COLON .endif 00f985 f0c3 00f986 f03f TONUM1: .DW XT_DUP,XT_DOCONDBRANCH 00f987 f99c DEST(TONUM3) 00f988 f0e1 00f989 f0aa 00f98a f76e .DW XT_OVER,XT_CFETCH,XT_DIGITQ 00f98b f12c 00f98c f03f .DW XT_ZEROEQUAL,XT_DOCONDBRANCH 00f98d f990 DEST(TONUM2) 00f98e f0eb 00f98f f026 .DW XT_DROP,XT_EXIT 00f990 f111 00f991 fd20 00f992 f56c 00f993 f08b 00f994 015e TONUM2: .DW XT_TO_R,XT_2SWAP,XT_BASE,XT_FETCH,XT_UDSTAR 00f995 f108 00f996 0156 00f997 fd20 .DW XT_R_FROM,XT_MPLUS,XT_2SWAP 00f998 fda1 00f999 f9c0 00f99a f035 .DW XT_ONE,XT_SLASHSTRING,XT_DOBRANCH 00f99b f985 DEST(TONUM1) 00f99c f026 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: 00f99d ff05 .dw $ff05 00f99e 6170 00f99f 7372 00f9a0 0065 .db "parse",0 00f9a1 f97e .dw VE_HEAD .set VE_HEAD = VE_PARSE XT_PARSE: 00f9a2 f001 .dw DO_COLON PFA_PARSE: .endif 00f9a3 f111 .dw XT_TO_R ; ( -- ) 00f9a4 f9b6 .dw XT_SOURCE ; ( -- addr len) 00f9a5 f599 .dw XT_TO_IN ; ( -- addr len >in) 00f9a6 f08b .dw XT_FETCH 00f9a7 f9c0 .dw XT_SLASHSTRING ; ( -- addr' len' ) 00f9a8 f108 .dw XT_R_FROM ; ( -- addr' len' c) 00f9a9 f88c .dw XT_CSCAN ; ( -- addr' len'') 00f9aa f0c3 .dw XT_DUP ; ( -- addr' len'' len'') 00f9ab f241 .dw XT_1PLUS 00f9ac f599 .dw XT_TO_IN ; ( -- addr' len'' len'' >in) 00f9ad f277 .dw XT_PLUSSTORE ; ( -- addr' len') 00f9ae fda1 .dw XT_ONE 00f9af f9c0 .dw XT_SLASHSTRING 00f9b0 f026 .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: 00f9b1 ff06 .dw $FF06 00f9b2 6f73 00f9b3 7275 00f9b4 6563 .db "source" 00f9b5 f99d .dw VE_HEAD .set VE_HEAD = VE_SOURCE XT_SOURCE: 00f9b6 fc2e .dw PFA_DODEFER1 PFA_SOURCE: .endif 00f9b7 0016 .dw USER_SOURCE 00f9b8 fbf7 .dw XT_UDEFERFETCH 00f9b9 fc03 .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: 00f9ba ff07 .dw $ff07 00f9bb 732f 00f9bc 7274 00f9bd 6e69 00f9be 0067 .db "/string",0 00f9bf f9b1 .dw VE_HEAD .set VE_HEAD = VE_SLASHSTRING XT_SLASHSTRING: 00f9c0 f001 .dw DO_COLON PFA_SLASHSTRING: .endif 00f9c1 f0f3 .dw XT_ROT 00f9c2 f0e1 .dw XT_OVER 00f9c3 f1af .dw XT_PLUS 00f9c4 f0f3 .dw XT_ROT 00f9c5 f0f3 .dw XT_ROT 00f9c6 f1a5 .dw XT_MINUS 00f9c7 f026 .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: 00f9c8 ff0a .dw $FF0A 00f9c9 6170 00f9ca 7372 00f9cb 2d65 00f9cc 616e 00f9cd 656d .db "parse-name" 00f9ce f9ba .dw VE_HEAD .set VE_HEAD = VE_PARSENAME XT_PARSENAME: 00f9cf f001 .dw DO_COLON PFA_PARSENAME: .endif 00f9d0 f60b .dw XT_BL 00f9d1 f9d3 .dw XT_SKIPSCANCHAR 00f9d2 f026 .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: 00f9d3 f001 .dw DO_COLON PFA_SKIPSCANCHAR: .endif 00f9d4 f111 .dw XT_TO_R 00f9d5 f9b6 .dw XT_SOURCE 00f9d6 f599 .dw XT_TO_IN 00f9d7 f08b .dw XT_FETCH 00f9d8 f9c0 .dw XT_SLASHSTRING 00f9d9 f11a .dw XT_R_FETCH 00f9da f875 .dw XT_CSKIP 00f9db f108 .dw XT_R_FROM 00f9dc f88c .dw XT_CSCAN ; adjust >IN 00f9dd f580 .dw XT_2DUP 00f9de f1af .dw XT_PLUS 00f9df f9b6 .dw XT_SOURCE 00f9e0 f0eb .dw XT_DROP 00f9e1 f1a5 .dw XT_MINUS 00f9e2 f599 .dw XT_TO_IN 00f9e3 f093 .dw XT_STORE 00f9e4 f026 .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: 00f9e5 ff07 .dw $ff07 00f9e6 6966 00f9e7 646e 00f9e8 782d 00f9e9 0074 .db "find-xt",0 00f9ea f9c8 .dw VE_HEAD .set VE_HEAD = VE_FINDXT XT_FINDXT: 00f9eb f001 .dw DO_COLON PFA_FINDXT: .endif 00f9ec f046 .dw XT_DOLITERAL 00f9ed f9f7 .dw XT_FINDXTA 00f9ee f046 .dw XT_DOLITERAL 00f9ef 005c .dw CFG_ORDERLISTLEN 00f9f0 041b .dw XT_MAPSTACK 00f9f1 f12c .dw XT_ZEROEQUAL 00f9f2 f03f .dw XT_DOCONDBRANCH 00f9f3 f9f6 DEST(PFA_FINDXT1) 00f9f4 f589 .dw XT_2DROP 00f9f5 f166 .dw XT_ZERO PFA_FINDXT1: 00f9f6 f026 .dw XT_EXIT .if cpu_msp430==1 .endif .if cpu_avr8==1 XT_FINDXTA: 00f9f7 f001 .dw DO_COLON PFA_FINDXTA: .endif 00f9f8 f111 .dw XT_TO_R 00f9f9 f580 .dw XT_2DUP 00f9fa f108 .dw XT_R_FROM 00f9fb fc40 .dw XT_SEARCH_WORDLIST 00f9fc f0c3 .dw XT_DUP 00f9fd f03f .dw XT_DOCONDBRANCH 00f9fe fa04 DEST(PFA_FINDXTA1) 00f9ff f111 .dw XT_TO_R 00fa00 f102 .dw XT_NIP 00fa01 f102 .dw XT_NIP 00fa02 f108 .dw XT_R_FROM 00fa03 f15d .dw XT_TRUE PFA_FINDXTA1: 00fa04 f026 .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: 00fa05 f001 .dw DO_COLON PFA_DEFAULT_PROMPTOK: 00fa06 f788 .dw XT_DOSLITERAL 00fa07 0003 .dw 3 00fa08 6f20 00fa09 006b .db " ok",0 .endif 00fa0a f7bb .dw XT_ITYPE 00fa0b f026 .dw XT_EXIT ; ------------------------ .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_PROMPTOK: 00fa0c ff03 .dw $FF03 00fa0d 6f2e ../../common\words/prompt-ok.asm(43): warning: .cseg .db misalignment - padding zero byte 00fa0e 006b .db ".ok" 00fa0f f9e5 .dw VE_HEAD .set VE_HEAD = VE_PROMPTOK XT_PROMPTOK: 00fa10 fc2e .dw PFA_DODEFER1 PFA_PROMPTOK: .endif 00fa11 001c .dw USER_P_OK 00fa12 fbf7 .dw XT_UDEFERFETCH 00fa13 fc03 .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: 00fa14 f001 .dw DO_COLON PFA_DEFAULT_PROMPTREADY: 00fa15 f788 .dw XT_DOSLITERAL 00fa16 0002 .dw 2 00fa17 203e .db "> " .endif 00fa18 f7f0 .dw XT_CR 00fa19 f7bb .dw XT_ITYPE 00fa1a f026 .dw XT_EXIT ; ------------------------ .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_PROMPTREADY: 00fa1b ff06 .dw $FF06 00fa1c 722e 00fa1d 6165 00fa1e 7964 .db ".ready" 00fa1f fa0c .dw VE_HEAD .set VE_HEAD = VE_PROMPTREADY XT_PROMPTREADY: 00fa20 fc2e .dw PFA_DODEFER1 PFA_PROMPTREADY: .endif 00fa21 0020 .dw USER_P_RDY 00fa22 fbf7 .dw XT_UDEFERFETCH 00fa23 fc03 .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: 00fa24 f001 .dw DO_COLON PFA_DEFAULT_PROMPTERROR: 00fa25 f788 .dw XT_DOSLITERAL 00fa26 0004 .dw 4 00fa27 3f20 00fa28 203f .db " ?? " .endif 00fa29 f7bb .dw XT_ITYPE 00fa2a f56c .dw XT_BASE 00fa2b f08b .dw XT_FETCH 00fa2c f111 .dw XT_TO_R 00fa2d f5f8 .dw XT_DECIMAL 00fa2e f73d .dw XT_DOT 00fa2f f599 .dw XT_TO_IN 00fa30 f08b .dw XT_FETCH 00fa31 f73d .dw XT_DOT 00fa32 f108 .dw XT_R_FROM 00fa33 f56c .dw XT_BASE 00fa34 f093 .dw XT_STORE 00fa35 f026 .dw XT_EXIT ; ------------------------ .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_PROMPTERROR: 00fa36 ff06 .dw $FF06 00fa37 652e 00fa38 7272 00fa39 726f .db ".error" 00fa3a fa1b .dw VE_HEAD .set VE_HEAD = VE_PROMPTERROR XT_PROMPTERROR: 00fa3b fc2e .dw PFA_DODEFER1 PFA_PROMPTERROR: .endif 00fa3c 001e .dw USER_P_ERR 00fa3d fbf7 .dw XT_UDEFERFETCH 00fa3e fc03 .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: 00fa3f ff04 .dw $ff04 00fa40 7571 00fa41 7469 .db "quit" 00fa42 fa36 .dw VE_HEAD .set VE_HEAD = VE_QUIT XT_QUIT: 00fa43 f001 .dw DO_COLON .endif PFA_QUIT: 00fa44 02d0 00fa45 02d7 00fa46 f093 .dw XT_LP0,XT_LP,XT_STORE 00fa47 faa4 .dw XT_SP0 00fa48 f2a8 .dw XT_SP_STORE 00fa49 fab1 .dw XT_RP0 00fa4a f292 .dw XT_RP_STORE 00fa4b 0365 .dw XT_LBRACKET PFA_QUIT2: 00fa4c f566 .dw XT_STATE 00fa4d f08b .dw XT_FETCH 00fa4e f12c .dw XT_ZEROEQUAL 00fa4f f03f .dw XT_DOCONDBRANCH 00fa50 fa52 DEST(PFA_QUIT4) 00fa51 fa20 .dw XT_PROMPTREADY PFA_QUIT4: 00fa52 f8fd .dw XT_REFILL 00fa53 f03f .dw XT_DOCONDBRANCH 00fa54 fa64 DEST(PFA_QUIT3) 00fa55 f046 .dw XT_DOLITERAL 00fa56 faca .dw XT_INTERPRET 00fa57 f846 .dw XT_CATCH 00fa58 f0cb .dw XT_QDUP 00fa59 f03f .dw XT_DOCONDBRANCH 00fa5a fa64 DEST(PFA_QUIT3) 00fa5b f0c3 .dw XT_DUP 00fa5c f046 .dw XT_DOLITERAL 00fa5d fffe .dw -2 00fa5e f180 .dw XT_LESS 00fa5f f03f .dw XT_DOCONDBRANCH 00fa60 fa62 DEST(PFA_QUIT5) 00fa61 fa3b .dw XT_PROMPTERROR PFA_QUIT5: 00fa62 f035 .dw XT_DOBRANCH 00fa63 fa44 DEST(PFA_QUIT) PFA_QUIT3: 00fa64 fa10 .dw XT_PROMPTOK 00fa65 f035 .dw XT_DOBRANCH 00fa66 fa4c 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: 00fa67 ff05 .dw $ff05 00fa68 6170 00fa69 7375 00fa6a 0065 .db "pause",0 00fa6b fa3f .dw VE_HEAD .set VE_HEAD = VE_PAUSE XT_PAUSE: 00fa6c fc2e .dw PFA_DODEFER1 PFA_PAUSE: 00fa6d 0141 .dw ram_pause 00fa6e fbe3 .dw XT_RDEFERFETCH 00fa6f fbed .dw XT_RDEFERSTORE .dseg 000141 ram_pause: .byte 2 .cseg .include "words/cold.asm" ; System ; start up amforth. VE_COLD: 00fa70 ff04 .dw $ff04 00fa71 6f63 00fa72 646c .db "cold" 00fa73 fa67 .dw VE_HEAD .set VE_HEAD = VE_COLD XT_COLD: 00fa74 fa75 .dw PFA_COLD PFA_COLD: 00fa75 b6a4 in_ mcu_boot, MCUSR 00fa76 2422 clr zerol 00fa77 2433 clr zeroh 00fa78 24bb clr isrflag 00fa79 be24 out_ MCUSR, zerol ; clear RAM 00fa7a e0e0 ldi zl, low(ramstart) 00fa7b e0f1 ldi zh, high(ramstart) clearloop: 00fa7c 9221 st Z+, zerol 00fa7d 30e0 cpi zl, low(sram_size+ramstart) 00fa7e f7e9 brne clearloop 00fa7f 34f1 cpi zh, high(sram_size+ramstart) 00fa80 f7d9 brne clearloop ; init first user data area ; allocate space for User Area .dseg 000143 ram_user1: .byte SYSUSERSIZE + APPUSERSIZE .cseg 00fa81 e4e3 ldi zl, low(ram_user1) 00fa82 e0f1 ldi zh, high(ram_user1) 00fa83 012f movw upl, zl ; init return stack pointer 00fa84 ef0f ldi temp0,low(rstackstart) 00fa85 bf0d out_ SPL,temp0 00fa86 8304 std Z+4, temp0 00fa87 e410 ldi temp1,high(rstackstart) 00fa88 bf1e out_ SPH,temp1 00fa89 8315 std Z+5, temp1 ; init parameter stack pointer 00fa8a eacf ldi yl,low(stackstart) 00fa8b 83c6 std Z+6, yl 00fa8c e4d0 ldi yh,high(stackstart) 00fa8d 83d7 std Z+7, yh ; load Forth IP with starting word 00fa8e e9a7 ldi XL, low(PFA_WARM) 00fa8f efba ldi XH, high(PFA_WARM) ; its a far jump... 00fa90 940c f005 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: 00fa92 ff04 .dw $ff04 00fa93 6177 00fa94 6d72 .db "warm" 00fa95 fa70 .dw VE_HEAD .set VE_HEAD = VE_WARM XT_WARM: 00fa96 f001 .dw DO_COLON PFA_WARM: .endif 00fa97 fd6b .dw XT_INIT_RAM 00fa98 f046 .dw XT_DOLITERAL 00fa99 fb9a .dw XT_NOOP 00fa9a f046 .dw XT_DOLITERAL 00fa9b fa6c .dw XT_PAUSE 00fa9c fc0e .dw XT_DEFERSTORE 00fa9d 0365 .dw XT_LBRACKET 00fa9e f613 .dw XT_TURNKEY 00fa9f fa43 .dw XT_QUIT ; never returns ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; .include "words/sp0.asm" ; Stack ; start address of the data stack VE_SP0: 00faa0 ff03 .dw $ff03 00faa1 7073 00faa2 0030 .db "sp0",0 00faa3 fa92 .dw VE_HEAD .set VE_HEAD = VE_SP0 XT_SP0: 00faa4 f081 .dw PFA_DOVALUE1 PFA_SP0: 00faa5 0006 .dw USER_SP0 00faa6 fbf7 .dw XT_UDEFERFETCH 00faa7 fc03 .dw XT_UDEFERSTORE ; ( -- addr) ; Stack ; address of user variable to store top-of-stack for inactive tasks VE_SP: 00faa8 ff02 .dw $ff02 00faa9 7073 .db "sp" 00faaa faa0 .dw VE_HEAD .set VE_HEAD = VE_SP XT_SP: 00faab f067 .dw PFA_DOUSER PFA_SP: 00faac 0008 .dw USER_SP .include "words/rp0.asm" ; Stack ; start address of return stack VE_RP0: 00faad ff03 .dw $ff03 00faae 7072 00faaf 0030 .db "rp0",0 00fab0 faa8 .dw VE_HEAD .set VE_HEAD = VE_RP0 XT_RP0: 00fab1 f001 .dw DO_COLON PFA_RP0: 00fab2 fab5 .dw XT_DORP0 00fab3 f08b .dw XT_FETCH 00fab4 f026 .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: 00fab5 f067 .dw PFA_DOUSER PFA_DORP0: 00fab6 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: 00fab7 ff05 .dw $ff05 00fab8 6564 00fab9 7470 00faba 0068 .db "depth",0 00fabb faad .dw VE_HEAD .set VE_HEAD = VE_DEPTH XT_DEPTH: 00fabc f001 .dw DO_COLON PFA_DEPTH: .endif 00fabd faa4 .dw XT_SP0 00fabe f29f .dw XT_SP_FETCH 00fabf f1a5 .dw XT_MINUS 00fac0 f216 .dw XT_2SLASH 00fac1 f247 .dw XT_1MINUS 00fac2 f026 .dw XT_EXIT .include "words/interpret.asm" ; System ; Interpret SOURCE word by word. .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_INTERPRET: 00fac3 ff09 .dw $ff09 00fac4 6e69 00fac5 6574 00fac6 7072 00fac7 6572 00fac8 0074 .db "interpret",0 00fac9 fab7 .dw VE_HEAD .set VE_HEAD = VE_INTERPRET XT_INTERPRET: 00faca f001 .dw DO_COLON .endif PFA_INTERPRET: 00facb f9cf .dw XT_PARSENAME ; ( -- addr len ) 00facc f0c3 .dw XT_DUP ; ( -- addr len flag) 00facd f03f .dw XT_DOCONDBRANCH 00face fadb DEST(PFA_INTERPRET2) 00facf fae7 .dw XT_FORTHRECOGNIZER 00fad0 faf2 .dw XT_RECOGNIZE 00fad1 f566 .dw XT_STATE 00fad2 f08b .dw XT_FETCH 00fad3 f03f .dw XT_DOCONDBRANCH 00fad4 fad6 DEST(PFA_INTERPRET1) 00fad5 fbc6 .dw XT_ICELLPLUS ; we need the compile action PFA_INTERPRET1: 00fad6 f3e3 .dw XT_FETCHI 00fad7 f030 .dw XT_EXECUTE 00fad8 fb72 .dw XT_QSTACK 00fad9 f035 .dw XT_DOBRANCH 00fada facb DEST(PFA_INTERPRET) PFA_INTERPRET2: 00fadb f589 .dw XT_2DROP 00fadc f026 .dw XT_EXIT .include "words/forth-recognizer.asm" ; System Value ; address of the next free data space (RAM) cell VE_FORTHRECOGNIZER: 00fadd ff10 .dw $ff10 00fade 6f66 00fadf 7472 00fae0 2d68 00fae1 6572 00fae2 6f63 00fae3 6e67 00fae4 7a69 00fae5 7265 .db "forth-recognizer" 00fae6 fac3 .dw VE_HEAD .set VE_HEAD = VE_FORTHRECOGNIZER XT_FORTHRECOGNIZER: 00fae7 f081 .dw PFA_DOVALUE1 PFA_FORTHRECOGNIZER: 00fae8 0050 .dw CFG_FORTHRECOGNIZER 00fae9 fbcf .dw XT_EDEFERFETCH 00faea fbd9 .dw XT_EDEFERSTORE .include "words/recognize.asm" ; System ; walk the recognizer stack .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_RECOGNIZE: 00faeb ff09 .dw $ff09 00faec 6572 00faed 6f63 00faee 6e67 00faef 7a69 00faf0 0065 .db "recognize",0 00faf1 fadd .dw VE_HEAD .set VE_HEAD = VE_RECOGNIZE XT_RECOGNIZE: 00faf2 f001 .dw DO_COLON PFA_RECOGNIZE: .endif 00faf3 f046 .dw XT_DOLITERAL 00faf4 fafd .dw XT_RECOGNIZE_A 00faf5 f0d6 .dw XT_SWAP 00faf6 041b .dw XT_MAPSTACK 00faf7 f12c .dw XT_ZEROEQUAL 00faf8 f03f .dw XT_DOCONDBRANCH 00faf9 fafc DEST(PFA_RECOGNIZE1) 00fafa f589 .dw XT_2DROP 00fafb fb65 .dw XT_DT_NULL PFA_RECOGNIZE1: 00fafc f026 .dw XT_EXIT .if cpu_msp430==1 .endif .if cpu_avr8==1 ; ( addr len XT -- addr len [ dt:xt -1 | 0 ] ) XT_RECOGNIZE_A: 00fafd f001 .dw DO_COLON PFA_RECOGNIZE_A: .endif 00fafe f0f3 .dw XT_ROT ; -- len xt addr 00faff f0f3 .dw XT_ROT ; -- xt addr len 00fb00 f580 .dw XT_2DUP 00fb01 f330 .dw XT_2TO_R 00fb02 f0f3 .dw XT_ROT ; -- addr len xt 00fb03 f030 .dw XT_EXECUTE ; -- i*x dt:* | dt:null 00fb04 f33f .dw XT_2R_FROM 00fb05 f0f3 .dw XT_ROT 00fb06 f0c3 .dw XT_DUP 00fb07 fb65 .dw XT_DT_NULL 00fb08 fd9a .dw XT_EQUAL 00fb09 f03f .dw XT_DOCONDBRANCH 00fb0a fb0e DEST(PFA_RECOGNIZE_A1) 00fb0b f0eb .dw XT_DROP 00fb0c f166 .dw XT_ZERO 00fb0d f026 .dw XT_EXIT PFA_RECOGNIZE_A1: 00fb0e f102 .dw XT_NIP 00fb0f f102 .dw XT_NIP 00fb10 f15d .dw XT_TRUE 00fb11 f026 .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: 00fb12 ff06 .dw $ff06 00fb13 7464 00fb14 6e3a 00fb15 6d75 .db "dt:num" 00fb16 faeb .dw VE_HEAD .set VE_HEAD = VE_DT_NUM XT_DT_NUM: 00fb17 f061 .dw PFA_DOCONSTANT PFA_DT_NUM: .endif 00fb18 fb9a .dw XT_NOOP ; interpret 00fb19 01f1 .dw XT_LITERAL ; compile 00fb1a 01f1 .dw XT_LITERAL ; postpone ; ( -- addr ) ; Interpreter ; Method table for double cell integers .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_DT_DNUM: 00fb1b ff07 .dw $ff07 00fb1c 7464 00fb1d 643a 00fb1e 756e 00fb1f 006d .db "dt:dnum",0 00fb20 fb12 .dw VE_HEAD .set VE_HEAD = VE_DT_DNUM XT_DT_DNUM: 00fb21 f061 .dw PFA_DOCONSTANT PFA_DT_DNUM: .endif 00fb22 fb9a .dw XT_NOOP ; interpret 00fb23 fd92 .dw XT_2LITERAL ; compile 00fb24 fd92 .dw XT_2LITERAL ; postpone ; ( addr len -- f ) ; Interpreter ; recognizer for integer numbers .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_REC_NUM: 00fb25 ff07 .dw $ff07 00fb26 6572 00fb27 3a63 00fb28 756e 00fb29 006d .db "rec:num",0 00fb2a fb1b .dw VE_HEAD .set VE_HEAD = VE_REC_NUM XT_REC_NUM: 00fb2b f001 .dw DO_COLON PFA_REC_NUM: .endif ; try converting to a number 00fb2c f90f .dw XT_NUMBER 00fb2d f03f .dw XT_DOCONDBRANCH 00fb2e fb37 DEST(PFA_REC_NONUMBER) 00fb2f fda1 .dw XT_ONE 00fb30 fd9a .dw XT_EQUAL 00fb31 f03f .dw XT_DOCONDBRANCH 00fb32 fb35 DEST(PFA_REC_INTNUM2) 00fb33 fb17 .dw XT_DT_NUM 00fb34 f026 .dw XT_EXIT PFA_REC_INTNUM2: 00fb35 fb21 .dw XT_DT_DNUM 00fb36 f026 .dw XT_EXIT PFA_REC_NONUMBER: 00fb37 fb65 .dw XT_DT_NULL 00fb38 f026 .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: 00fb39 ff08 .dw $ff08 00fb3a 6572 00fb3b 3a63 00fb3c 6966 00fb3d 646e .db "rec:find" 00fb3e fb25 .dw VE_HEAD .set VE_HEAD = VE_REC_FIND XT_REC_FIND: 00fb3f f001 .dw DO_COLON PFA_REC_FIND: .endif 00fb40 f9eb .DW XT_FINDXT 00fb41 f0c3 .dw XT_DUP 00fb42 f12c .dw XT_ZEROEQUAL 00fb43 f03f .dw XT_DOCONDBRANCH 00fb44 fb48 DEST(PFA_REC_WORD_FOUND) 00fb45 f0eb .dw XT_DROP 00fb46 fb65 .dw XT_DT_NULL 00fb47 f026 .dw XT_EXIT PFA_REC_WORD_FOUND: 00fb48 fb4f .dw XT_DT_XT 00fb49 f026 .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: 00fb4a ff05 .dw $ff05 00fb4b 7464 00fb4c 783a 00fb4d 0074 .db "dt:xt",0 00fb4e fb39 .dw VE_HEAD .set VE_HEAD = VE_DT_XT XT_DT_XT: 00fb4f f061 .dw PFA_DOCONSTANT PFA_DT_XT: .endif 00fb50 fb53 .dw XT_R_WORD_INTERPRET 00fb51 fb57 .dw XT_R_WORD_COMPILE 00fb52 fd92 .dw XT_2LITERAL ; ( XT flags -- ) ; Interpreter ; interpret method for WORD recognizer .if cpu_msp430==1 .endif .if cpu_avr8==1 XT_R_WORD_INTERPRET: 00fb53 f001 .dw DO_COLON PFA_R_WORD_INTERPRET: .endif 00fb54 f0eb .dw XT_DROP ; the flags are in the way 00fb55 f030 .dw XT_EXECUTE 00fb56 f026 .dw XT_EXIT ; ( XT flags -- ) ; Interpreter ; Compile method for WORD recognizer .if cpu_msp430==1 .endif .if cpu_avr8==1 XT_R_WORD_COMPILE: 00fb57 f001 .dw DO_COLON PFA_R_WORD_COMPILE: .endif 00fb58 f133 .dw XT_ZEROLESS 00fb59 f03f .dw XT_DOCONDBRANCH 00fb5a fb5d DEST(PFA_R_WORD_COMPILE1) 00fb5b 01db .dw XT_COMMA 00fb5c f026 .dw XT_EXIT PFA_R_WORD_COMPILE1: 00fb5d f030 .dw XT_EXECUTE 00fb5e f026 .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: 00fb5f ff07 .dw $ff07 00fb60 7464 00fb61 6e3a 00fb62 6c75 ../../common\words/dt-null.asm(12): warning: .cseg .db misalignment - padding zero byte 00fb63 006c .db "dt:null" 00fb64 fb4a .dw VE_HEAD .set VE_HEAD = VE_DT_NULL XT_DT_NULL: 00fb65 f061 .dw PFA_DOCONSTANT PFA_DT_NULL: .endif 00fb66 fb69 .dw XT_FAIL ; interpret 00fb67 fb69 .dw XT_FAIL ; compile 00fb68 fb69 .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: 00fb69 f001 .dw DO_COLON PFA_FAIL: .endif 00fb6a f046 .dw XT_DOLITERAL 00fb6b fff3 .dw -13 00fb6c f85c .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: 00fb6d ff06 .dw $ff06 00fb6e 733f 00fb6f 6174 00fb70 6b63 .db "?stack" 00fb71 fb5f .dw VE_HEAD .set VE_HEAD = VE_QSTACK XT_QSTACK: 00fb72 f001 .dw DO_COLON PFA_QSTACK: .endif 00fb73 fabc .dw XT_DEPTH 00fb74 f133 .dw XT_ZEROLESS 00fb75 f03f .dw XT_DOCONDBRANCH 00fb76 fb7a DEST(PFA_QSTACK1) 00fb77 f046 .dw XT_DOLITERAL 00fb78 fffc .dw -4 00fb79 f85c .dw XT_THROW PFA_QSTACK1: 00fb7a f026 .dw XT_EXIT .include "words/ver.asm" ; Tools ; print the version string .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_DOT_VER: 00fb7b ff03 .dw $ff03 00fb7c 6576 ../../common\words/ver.asm(12): warning: .cseg .db misalignment - padding zero byte 00fb7d 0072 .db "ver" 00fb7e fb6d .dw VE_HEAD .set VE_HEAD = VE_DOT_VER XT_DOT_VER: 00fb7f f001 .dw DO_COLON PFA_DOT_VER: .endif 00fb80 f528 .dw XT_ENV_FORTHNAME 00fb81 f7bb .dw XT_ITYPE 00fb82 f7fd .dw XT_SPACE 00fb83 f56c .dw XT_BASE 00fb84 f08b .dw XT_FETCH 00fb85 f536 .dw XT_ENV_FORTHVERSION 00fb86 f5f8 .dw XT_DECIMAL 00fb87 fd82 .dw XT_S2D 00fb88 f6d9 .dw XT_L_SHARP 00fb89 f6e1 .dw XT_SHARP 00fb8a f046 .dw XT_DOLITERAL 00fb8b 002e .dw '.' 00fb8c f6ca .dw XT_HOLD 00fb8d f6f7 .dw XT_SHARP_S 00fb8e f702 .dw XT_SHARP_G 00fb8f f816 .dw XT_TYPE 00fb90 f56c .dw XT_BASE 00fb91 f093 .dw XT_STORE 00fb92 f7fd .dw XT_SPACE 00fb93 f53e .dw XT_ENV_CPU 00fb94 f7bb .dw XT_ITYPE 00fb95 f026 .dw XT_EXIT ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; .include "words/noop.asm" ; Tools ; do nothing .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_NOOP: 00fb96 ff04 .dw $ff04 00fb97 6f6e 00fb98 706f .db "noop" 00fb99 fb7b .dw VE_HEAD .set VE_HEAD = VE_NOOP XT_NOOP: 00fb9a f001 .dw DO_COLON PFA_NOOP: .endif 00fb9b f026 .DW XT_EXIT .include "words/unused.asm" ; Tools ; Amount of available RAM (incl. PAD) VE_UNUSED: 00fb9c ff06 .dw $ff06 00fb9d 6e75 00fb9e 7375 00fb9f 6465 .db "unused" 00fba0 fb96 .dw VE_HEAD .set VE_HEAD = VE_UNUSED XT_UNUSED: 00fba1 f001 .dw DO_COLON PFA_UNUSED: 00fba2 f29f .dw XT_SP_FETCH 00fba3 f5da .dw XT_HERE 00fba4 f1a5 .dw XT_MINUS 00fba5 f026 .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: 00fba6 0002 .dw $0002 00fba7 6f74 .db "to" 00fba8 fb9c .dw VE_HEAD .set VE_HEAD = VE_TO XT_TO: 00fba9 f001 .dw DO_COLON PFA_TO: .endif 00fbaa f825 .dw XT_TICK 00fbab fd8b .dw XT_TO_BODY 00fbac f566 .dw XT_STATE 00fbad f08b .dw XT_FETCH 00fbae f03f .dw XT_DOCONDBRANCH 00fbaf fbba DEST(PFA_TO1) 00fbb0 01d0 .dw XT_COMPILE 00fbb1 fbb4 .dw XT_DOTO 00fbb2 01db .dw XT_COMMA 00fbb3 f026 .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: 00fbb4 f001 .dw DO_COLON PFA_DOTO: .endif 00fbb5 f108 .dw XT_R_FROM 00fbb6 f0c3 .dw XT_DUP 00fbb7 fbc6 .dw XT_ICELLPLUS 00fbb8 f111 .dw XT_TO_R 00fbb9 f3e3 .dw XT_FETCHI PFA_TO1: 00fbba f0c3 .dw XT_DUP 00fbbb fbc6 .dw XT_ICELLPLUS 00fbbc fbc6 .dw XT_ICELLPLUS 00fbbd f3e3 .dw XT_FETCHI 00fbbe f030 .dw XT_EXECUTE 00fbbf f026 .dw XT_EXIT .include "words/i-cellplus.asm" ; Compiler ; skip to the next cell in flash VE_ICELLPLUS: 00fbc0 ff07 .dw $FF07 00fbc1 2d69 00fbc2 6563 00fbc3 6c6c 00fbc4 002b .db "i-cell+",0 00fbc5 fba6 .dw VE_HEAD .set VE_HEAD = VE_ICELLPLUS XT_ICELLPLUS: 00fbc6 f001 .dw DO_COLON PFA_ICELLPLUS: 00fbc7 f241 .dw XT_1PLUS 00fbc8 f026 .dw XT_EXIT .include "words/edefer-fetch.asm" ; System ; does the real defer@ for eeprom defers VE_EDEFERFETCH: 00fbc9 ff07 .dw $ff07 00fbca 6445 00fbcb 6665 00fbcc 7265 00fbcd 0040 .db "Edefer@",0 00fbce fbc0 .dw VE_HEAD .set VE_HEAD = VE_EDEFERFETCH XT_EDEFERFETCH: 00fbcf f001 .dw DO_COLON PFA_EDEFERFETCH: 00fbd0 f3e3 .dw XT_FETCHI 00fbd1 f371 .dw XT_FETCHE 00fbd2 f026 .dw XT_EXIT .include "words/edefer-store.asm" ; System ; does the real defer! for eeprom defers VE_EDEFERSTORE: 00fbd3 ff07 .dw $ff07 00fbd4 6445 00fbd5 6665 00fbd6 7265 00fbd7 0021 .db "Edefer!",0 00fbd8 fbc9 .dw VE_HEAD .set VE_HEAD = VE_EDEFERSTORE XT_EDEFERSTORE: 00fbd9 f001 .dw DO_COLON PFA_EDEFERSTORE: 00fbda f3e3 .dw XT_FETCHI 00fbdb f34d .dw XT_STOREE 00fbdc f026 .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: 00fbdd ff07 .dw $ff07 00fbde 6452 00fbdf 6665 00fbe0 7265 00fbe1 0040 .db "Rdefer@",0 00fbe2 fbd3 .dw VE_HEAD .set VE_HEAD = VE_RDEFERFETCH XT_RDEFERFETCH: 00fbe3 f001 .dw DO_COLON PFA_RDEFERFETCH: .endif 00fbe4 f3e3 .dw XT_FETCHI 00fbe5 f08b .dw XT_FETCH 00fbe6 f026 .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: 00fbe7 ff07 .dw $ff07 00fbe8 6452 00fbe9 6665 00fbea 7265 00fbeb 0021 .db "Rdefer!",0 00fbec fbdd .dw VE_HEAD .set VE_HEAD = VE_RDEFERSTORE XT_RDEFERSTORE: 00fbed f001 .dw DO_COLON PFA_RDEFERSTORE: .endif 00fbee f3e3 .dw XT_FETCHI 00fbef f093 .dw XT_STORE 00fbf0 f026 .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: 00fbf1 ff07 .dw $ff07 00fbf2 6455 00fbf3 6665 00fbf4 7265 00fbf5 0040 .db "Udefer@",0 00fbf6 fbe7 .dw VE_HEAD .set VE_HEAD = VE_UDEFERFETCH XT_UDEFERFETCH: 00fbf7 f001 .dw DO_COLON PFA_UDEFERFETCH: .endif 00fbf8 f3e3 .dw XT_FETCHI 00fbf9 f314 .dw XT_UP_FETCH 00fbfa f1af .dw XT_PLUS 00fbfb f08b .dw XT_FETCH 00fbfc f026 .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: 00fbfd ff07 .dw $ff07 00fbfe 6455 00fbff 6665 00fc00 7265 00fc01 0021 .db "Udefer!",0 00fc02 fbf1 .dw VE_HEAD .set VE_HEAD = VE_UDEFERSTORE XT_UDEFERSTORE: 00fc03 f001 .dw DO_COLON PFA_UDEFERSTORE: .endif 00fc04 f3e3 .dw XT_FETCHI 00fc05 f314 .dw XT_UP_FETCH 00fc06 f1af .dw XT_PLUS 00fc07 f093 .dw XT_STORE 00fc08 f026 .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: 00fc09 ff06 .dw $ff06 00fc0a 6564 00fc0b 6566 00fc0c 2172 .db "defer!" 00fc0d fbfd .dw VE_HEAD .set VE_HEAD = VE_DEFERSTORE XT_DEFERSTORE: 00fc0e f001 .dw DO_COLON PFA_DEFERSTORE: .endif 00fc0f fd8b .dw XT_TO_BODY 00fc10 f0c3 .dw XT_DUP 00fc11 fbc6 .dw XT_ICELLPLUS 00fc12 fbc6 .dw XT_ICELLPLUS 00fc13 f3e3 .dw XT_FETCHI 00fc14 f030 .dw XT_EXECUTE 00fc15 f026 .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: 00fc16 ff06 .dw $ff06 00fc17 6564 00fc18 6566 00fc19 4072 .db "defer@" 00fc1a fc09 .dw VE_HEAD .set VE_HEAD = VE_DEFERFETCH XT_DEFERFETCH: 00fc1b f001 .dw DO_COLON PFA_DEFERFETCH: .endif 00fc1c fd8b .dw XT_TO_BODY 00fc1d f0c3 .dw XT_DUP 00fc1e fbc6 .dw XT_ICELLPLUS 00fc1f f3e3 .dw XT_FETCHI 00fc20 f030 .dw XT_EXECUTE 00fc21 f026 .dw XT_EXIT .include "words/do-defer.asm" ; System ; runtime of defer VE_DODEFER: 00fc22 ff07 .dw $ff07 00fc23 6428 00fc24 6665 00fc25 7265 00fc26 0029 .db "(defer)", 0 00fc27 fc16 .dw VE_HEAD .set VE_HEAD = VE_DODEFER XT_DODEFER: 00fc28 f001 .dw DO_COLON PFA_DODEFER: 00fc29 01ad .dw XT_DOCREATE 00fc2a 030d .dw XT_REVEAL 00fc2b 01d0 .dw XT_COMPILE 00fc2c fc2e .dw PFA_DODEFER1 00fc2d f026 .dw XT_EXIT PFA_DODEFER1: 00fc2e 940e 0326 call_ DO_DODOES 00fc30 f0c3 .dw XT_DUP 00fc31 fbc6 .dw XT_ICELLPLUS 00fc32 f3e3 .dw XT_FETCHI 00fc33 f030 .dw XT_EXECUTE 00fc34 f030 .dw XT_EXECUTE 00fc35 f026 .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: 00fc36 ff0f .dw $ff0f 00fc37 6573 00fc38 7261 00fc39 6863 00fc3a 772d 00fc3b 726f 00fc3c 6c64 00fc3d 7369 00fc3e 0074 .db "search-wordlist",0 00fc3f fc22 .dw VE_HEAD .set VE_HEAD = VE_SEARCH_WORDLIST XT_SEARCH_WORDLIST: 00fc40 f001 .dw DO_COLON PFA_SEARCH_WORDLIST: .endif 00fc41 f111 .dw XT_TO_R 00fc42 f166 .dw XT_ZERO 00fc43 f046 .dw XT_DOLITERAL 00fc44 fc55 .dw XT_ISWORD 00fc45 f108 .dw XT_R_FROM 00fc46 fc72 .dw XT_TRAVERSEWORDLIST 00fc47 f0c3 .dw XT_DUP 00fc48 f12c .dw XT_ZEROEQUAL 00fc49 f03f .dw XT_DOCONDBRANCH 00fc4a fc4f DEST(PFA_SEARCH_WORDLIST1) 00fc4b f589 .dw XT_2DROP 00fc4c f0eb .dw XT_DROP 00fc4d f166 .dw XT_ZERO 00fc4e f026 .dw XT_EXIT PFA_SEARCH_WORDLIST1: ; ... get the XT ... 00fc4f f0c3 .dw XT_DUP 00fc50 fc99 .dw XT_NFA2CFA ; .. and get the header flag 00fc51 f0d6 .dw XT_SWAP 00fc52 0193 .dw XT_NAME2FLAGS 00fc53 0181 .dw XT_IMMEDIATEQ 00fc54 f026 .dw XT_EXIT .if cpu_msp430==1 .endif .if cpu_avr8==1 XT_ISWORD: 00fc55 f001 .dw DO_COLON PFA_ISWORD: .endif ; ( c-addr len 0 nt -- c-addr len 0 true| nt false ) 00fc56 f111 .dw XT_TO_R 00fc57 f0eb .dw XT_DROP 00fc58 f580 .dw XT_2DUP 00fc59 f11a .dw XT_R_FETCH ; -- addr len addr len nt 00fc5a fc8d .dw XT_NAME2STRING 00fc5b fca3 .dw XT_ICOMPARE ; (-- addr len f ) 00fc5c f03f .dw XT_DOCONDBRANCH 00fc5d fc63 DEST(PFA_ISWORD3) ; not now 00fc5e f108 .dw XT_R_FROM 00fc5f f0eb .dw XT_DROP 00fc60 f166 .dw XT_ZERO 00fc61 f15d .dw XT_TRUE ; maybe next word 00fc62 f026 .dw XT_EXIT PFA_ISWORD3: ; we found the word, now clean up iteration data ... 00fc63 f589 .dw XT_2DROP 00fc64 f108 .dw XT_R_FROM 00fc65 f166 .dw XT_ZERO ; finish traverse-wordlist 00fc66 f026 .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: 00fc67 ff11 .dw $ff11 00fc68 7274 00fc69 7661 00fc6a 7265 00fc6b 6573 00fc6c 772d 00fc6d 726f 00fc6e 6c64 00fc6f 7369 00fc70 0074 .db "traverse-wordlist",0 00fc71 fc36 .dw VE_HEAD .set VE_HEAD = VE_TRAVERSEWORDLIST XT_TRAVERSEWORDLIST: 00fc72 f001 .dw DO_COLON PFA_TRAVERSEWORDLIST: .endif 00fc73 f371 .dw XT_FETCHE PFA_TRAVERSEWORDLIST1: 00fc74 f0c3 .dw XT_DUP ; ( -- xt nt nt ) 00fc75 f03f .dw XT_DOCONDBRANCH ; ( -- nt ) is nfa = counted string 00fc76 fc83 DEST(PFA_TRAVERSEWORDLIST2) 00fc77 f580 .dw XT_2DUP 00fc78 f330 .dw XT_2TO_R 00fc79 f0d6 .dw XT_SWAP 00fc7a f030 .dw XT_EXECUTE 00fc7b f33f .dw XT_2R_FROM 00fc7c f0f3 .dw XT_ROT 00fc7d f03f .dw XT_DOCONDBRANCH 00fc7e fc83 DEST(PFA_TRAVERSEWORDLIST2) 00fc7f 048a .dw XT_NFA2LFA 00fc80 f3e3 .dw XT_FETCHI 00fc81 f035 .dw XT_DOBRANCH ; ( -- addr ) 00fc82 fc74 DEST(PFA_TRAVERSEWORDLIST1) ; ( -- addr ) PFA_TRAVERSEWORDLIST2: 00fc83 f589 .dw XT_2DROP 00fc84 f026 .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: 00fc85 ff0b .dw $ff0b 00fc86 616e 00fc87 656d 00fc88 733e 00fc89 7274 00fc8a 6e69 00fc8b 0067 .db "name>string",0 00fc8c fc67 .dw VE_HEAD .set VE_HEAD = VE_NAME2STRING XT_NAME2STRING: 00fc8d f001 .dw DO_COLON PFA_NAME2STRING: .endif 00fc8e f7e7 .dw XT_ICOUNT ; ( -- addr n ) 00fc8f f046 .dw XT_DOLITERAL 00fc90 00ff .dw 255 00fc91 f225 .dw XT_AND ; mask immediate bit 00fc92 f026 .dw XT_EXIT .include "words/nfa2cfa.asm" ; Tools ; get the XT from a name token VE_NFA2CFA: 00fc93 ff07 .dw $ff07 00fc94 666e 00fc95 3e61 00fc96 6663 ../../avr8\words/nfa2cfa.asm(6): warning: .cseg .db misalignment - padding zero byte 00fc97 0061 .db "nfa>cfa" 00fc98 fc85 .dw VE_HEAD .set VE_HEAD = VE_NFA2CFA XT_NFA2CFA: 00fc99 f001 .dw DO_COLON PFA_NFA2CFA: 00fc9a 048a .dw XT_NFA2LFA ; skip to link field 00fc9b f241 .dw XT_1PLUS ; next is the execution token 00fc9c f026 .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: 00fc9d ff08 .dw $ff08 00fc9e 6369 00fc9f 6d6f 00fca0 6170 00fca1 6572 .db "icompare" 00fca2 fc93 .dw VE_HEAD .set VE_HEAD = VE_ICOMPARE XT_ICOMPARE: 00fca3 f001 .dw DO_COLON PFA_ICOMPARE: 00fca4 f111 .dw XT_TO_R ; ( -- r-addr r-len f-addr) 00fca5 f0e1 .dw XT_OVER ; ( -- r-addr r-len f-addr r-len) 00fca6 f108 .dw XT_R_FROM ; ( -- r-addr r-len f-addr r-len f-len ) 00fca7 f125 .dw XT_NOTEQUAL ; ( -- r-addr r-len f-addr flag ) 00fca8 f03f .dw XT_DOCONDBRANCH 00fca9 fcae .dw PFA_ICOMPARE_SAMELEN 00fcaa f589 .dw XT_2DROP 00fcab f0eb .dw XT_DROP 00fcac f15d .dw XT_TRUE 00fcad f026 .dw XT_EXIT PFA_ICOMPARE_SAMELEN: 00fcae f0d6 .dw XT_SWAP ; ( -- r-addr f-addr len ) 00fcaf f166 .dw XT_ZERO 00fcb0 029a .dw XT_QDOCHECK 00fcb1 f03f .dw XT_DOCONDBRANCH 00fcb2 fcd1 .dw PFA_ICOMPARE_DONE 00fcb3 f2ad .dw XT_DODO PFA_ICOMPARE_LOOP: ; ( r-addr f-addr --) 00fcb4 f0e1 .dw XT_OVER 00fcb5 f08b .dw XT_FETCH .if WANT_IGNORECASE == 1 .endif 00fcb6 f0e1 .dw XT_OVER 00fcb7 f3e3 .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 00fcb8 f0c3 .dw XT_DUP ;.dw XT_BYTESWAP 00fcb9 f046 .dw XT_DOLITERAL 00fcba 0100 .dw $100 00fcbb f16e .dw XT_ULESS 00fcbc f03f .dw XT_DOCONDBRANCH 00fcbd fcc2 .dw PFA_ICOMPARE_LASTCELL 00fcbe f0d6 .dw XT_SWAP 00fcbf f046 .dw XT_DOLITERAL 00fcc0 00ff .dw $00FF 00fcc1 f225 .dw XT_AND ; the final swap can be omitted PFA_ICOMPARE_LASTCELL: 00fcc2 f125 .dw XT_NOTEQUAL 00fcc3 f03f .dw XT_DOCONDBRANCH 00fcc4 fcc9 .dw PFA_ICOMPARE_NEXTLOOP 00fcc5 f589 .dw XT_2DROP 00fcc6 f15d .dw XT_TRUE 00fcc7 f2e6 .dw XT_UNLOOP 00fcc8 f026 .dw XT_EXIT PFA_ICOMPARE_NEXTLOOP: 00fcc9 f241 .dw XT_1PLUS 00fcca f0d6 .dw XT_SWAP 00fccb f579 .dw XT_CELLPLUS 00fccc f0d6 .dw XT_SWAP 00fccd f046 .dw XT_DOLITERAL 00fcce 0002 .dw 2 00fccf f2cc .dw XT_DOPLUSLOOP 00fcd0 fcb4 .dw PFA_ICOMPARE_LOOP PFA_ICOMPARE_DONE: 00fcd1 f589 .dw XT_2DROP 00fcd2 f166 .dw XT_ZERO 00fcd3 f026 .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: 00fcd4 ff01 .dw $ff01 00fcd5 002a .db "*",0 00fcd6 fc9d .dw VE_HEAD .set VE_HEAD = VE_STAR XT_STAR: 00fcd7 f001 .dw DO_COLON PFA_STAR: .endif 00fcd8 f1b8 .dw XT_MSTAR 00fcd9 f0eb .dw XT_DROP 00fcda f026 .dw XT_EXIT .include "words/j.asm" ; Compiler ; loop counter of outer loop VE_J: 00fcdb ff01 .dw $FF01 00fcdc 006a .db "j",0 00fcdd fcd4 .dw VE_HEAD .set VE_HEAD = VE_J XT_J: 00fcde f001 .dw DO_COLON PFA_J: 00fcdf f288 .dw XT_RP_FETCH 00fce0 f046 .dw XT_DOLITERAL 00fce1 0007 .dw 7 00fce2 f1af .dw XT_PLUS 00fce3 f08b .dw XT_FETCH 00fce4 f288 .dw XT_RP_FETCH 00fce5 f046 .dw XT_DOLITERAL 00fce6 0009 .dw 9 00fce7 f1af .dw XT_PLUS 00fce8 f08b .dw XT_FETCH 00fce9 f1af .dw XT_PLUS 00fcea f026 .dw XT_EXIT .include "words/dabs.asm" ; Arithmetics ; double cell absolute value VE_DABS: 00fceb ff04 .dw $ff04 00fcec 6164 00fced 7362 .db "dabs" 00fcee fcdb .dw VE_HEAD .set VE_HEAD = VE_DABS XT_DABS: 00fcef f001 .dw DO_COLON PFA_DABS: 00fcf0 f0c3 .dw XT_DUP 00fcf1 f133 .dw XT_ZEROLESS 00fcf2 f03f .dw XT_DOCONDBRANCH 00fcf3 fcf5 .dw PFA_DABS1 00fcf4 fcfc .dw XT_DNEGATE PFA_DABS1: 00fcf5 f026 .dw XT_EXIT ; : dabs ( ud1 -- +d2 ) dup 0< if dnegate then ; .include "words/dnegate.asm" ; Arithmetics ; double cell negation VE_DNEGATE: 00fcf6 ff07 .dw $ff07 00fcf7 6e64 00fcf8 6765 00fcf9 7461 00fcfa 0065 .db "dnegate",0 00fcfb fceb .dw VE_HEAD .set VE_HEAD = VE_DNEGATE XT_DNEGATE: 00fcfc f001 .dw DO_COLON PFA_DNEGATE: 00fcfd f456 .dw XT_DINVERT 00fcfe fda1 .dw XT_ONE 00fcff f166 .dw XT_ZERO 00fd00 f430 .dw XT_DPLUS 00fd01 f026 .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: 00fd02 ff05 .dw $ff05 00fd03 6d63 00fd04 766f 00fd05 0065 .db "cmove",0 00fd06 fcf6 .dw VE_HEAD .set VE_HEAD = VE_CMOVE XT_CMOVE: 00fd07 fd08 .dw PFA_CMOVE PFA_CMOVE: 00fd08 93bf push xh 00fd09 93af push xl 00fd0a 91e9 ld zl, Y+ 00fd0b 91f9 ld zh, Y+ ; addr-to 00fd0c 91a9 ld xl, Y+ 00fd0d 91b9 ld xh, Y+ ; addr-from 00fd0e 2f09 mov temp0, tosh 00fd0f 2b08 or temp0, tosl 00fd10 f021 brbs 1, PFA_CMOVE1 PFA_CMOVE2: 00fd11 911d ld temp1, X+ 00fd12 9311 st Z+, temp1 00fd13 9701 sbiw tosl, 1 00fd14 f7e1 brbc 1, PFA_CMOVE2 PFA_CMOVE1: 00fd15 91af pop xl 00fd16 91bf pop xh 00fd17 9189 00fd18 9199 loadtos 00fd19 940c f005 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: 00fd1b ff05 .dw $ff05 00fd1c 7332 00fd1d 6177 00fd1e 0070 .db "2swap",0 00fd1f fd02 .dw VE_HEAD .set VE_HEAD = VE_2SWAP XT_2SWAP: 00fd20 f001 .dw DO_COLON PFA_2SWAP: .endif 00fd21 f0f3 .dw XT_ROT 00fd22 f111 .dw XT_TO_R 00fd23 f0f3 .dw XT_ROT 00fd24 f108 .dw XT_R_FROM 00fd25 f026 .dw XT_EXIT .include "words/tib.asm" ; System ; refills the input buffer .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_REFILLTIB: 00fd26 ff0a .dw $ff0a 00fd27 6572 00fd28 6966 00fd29 6c6c 00fd2a 742d 00fd2b 6269 .db "refill-tib" 00fd2c fd1b .dw VE_HEAD .set VE_HEAD = VE_REFILLTIB XT_REFILLTIB: 00fd2d f001 .dw DO_COLON PFA_REFILLTIB: .endif 00fd2e fd49 .dw XT_TIB 00fd2f f046 .dw XT_DOLITERAL 00fd30 005a .dw TIB_SIZE 00fd31 f8ac .dw XT_ACCEPT 00fd32 fd4f .dw XT_NUMBERTIB 00fd33 f093 .dw XT_STORE 00fd34 f166 .dw XT_ZERO 00fd35 f599 .dw XT_TO_IN 00fd36 f093 .dw XT_STORE 00fd37 f15d .dw XT_TRUE ; -1 00fd38 f026 .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: 00fd39 ff0a .dw $FF0A 00fd3a 6f73 00fd3b 7275 00fd3c 6563 00fd3d 742d 00fd3e 6269 .db "source-tib" 00fd3f fd26 .dw VE_HEAD .set VE_HEAD = VE_SOURCETIB XT_SOURCETIB: 00fd40 f001 .dw DO_COLON PFA_SOURCETIB: .endif 00fd41 fd49 .dw XT_TIB 00fd42 fd4f .dw XT_NUMBERTIB 00fd43 f08b .dw XT_FETCH 00fd44 f026 .dw XT_EXIT ; ( -- addr ) ; System Variable ; terminal input buffer address .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_TIB: 00fd45 ff03 .dw $ff03 00fd46 6974 00fd47 0062 .db "tib",0 00fd48 fd39 .dw VE_HEAD .set VE_HEAD = VE_TIB XT_TIB: 00fd49 f054 .dw PFA_DOVARIABLE PFA_TIB: 00fd4a 016f .dw ram_tib .dseg 00016f 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: 00fd4b ff04 .dw $ff04 00fd4c 7423 00fd4d 6269 .db "#tib" 00fd4e fd45 .dw VE_HEAD .set VE_HEAD = VE_NUMBERTIB XT_NUMBERTIB: 00fd4f f054 .dw PFA_DOVARIABLE PFA_NUMBERTIB: 00fd50 01c9 .dw ram_sharptib .dseg 0001c9 ram_sharptib: .byte 2 .cseg .endif .include "words/init-ram.asm" ; Tools ; copy len cells from eeprom to ram VE_EE2RAM: 00fd51 ff06 .dw $ff06 00fd52 6565 00fd53 723e 00fd54 6d61 .db "ee>ram" 00fd55 fd4b .dw VE_HEAD .set VE_HEAD = VE_EE2RAM XT_EE2RAM: 00fd56 f001 .dw DO_COLON PFA_EE2RAM: ; ( -- ) 00fd57 f166 .dw XT_ZERO 00fd58 f2ad .dw XT_DODO PFA_EE2RAM_1: ; ( -- e-addr r-addr ) 00fd59 f0e1 .dw XT_OVER 00fd5a f371 .dw XT_FETCHE 00fd5b f0e1 .dw XT_OVER 00fd5c f093 .dw XT_STORE 00fd5d f579 .dw XT_CELLPLUS 00fd5e f0d6 .dw XT_SWAP 00fd5f f579 .dw XT_CELLPLUS 00fd60 f0d6 .dw XT_SWAP 00fd61 f2db .dw XT_DOLOOP 00fd62 fd59 .dw PFA_EE2RAM_1 PFA_EE2RAM_2: 00fd63 f589 .dw XT_2DROP 00fd64 f026 .dw XT_EXIT ; ( -- ) ; Tools ; setup the default user area from eeprom VE_INIT_RAM: 00fd65 ff08 .dw $ff08 00fd66 6e69 00fd67 7469 00fd68 722d 00fd69 6d61 .db "init-ram" 00fd6a fd51 .dw VE_HEAD .set VE_HEAD = VE_INIT_RAM XT_INIT_RAM: 00fd6b f001 .dw DO_COLON PFA_INI_RAM: ; ( -- ) 00fd6c f046 .dw XT_DOLITERAL 00fd6d 007c .dw EE_INITUSER 00fd6e f314 .dw XT_UP_FETCH 00fd6f f046 .dw XT_DOLITERAL 00fd70 0022 .dw SYSUSERSIZE 00fd71 f216 .dw XT_2SLASH 00fd72 fd56 .dw XT_EE2RAM 00fd73 f026 .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: 00fd74 ff06 .dw $ff06 00fd75 6f62 00fd76 6e75 00fd77 7364 .db "bounds" 00fd78 fd65 .dw VE_HEAD .set VE_HEAD = VE_BOUNDS XT_BOUNDS: 00fd79 f001 .dw DO_COLON PFA_BOUNDS: .endif 00fd7a f0e1 .dw XT_OVER 00fd7b f1af .dw XT_PLUS 00fd7c f0d6 .dw XT_SWAP 00fd7d f026 .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: 00fd7e ff03 .dw $ff03 00fd7f 3e73 00fd80 0064 .db "s>d",0 00fd81 fd74 .dw VE_HEAD .set VE_HEAD = VE_S2D XT_S2D: 00fd82 f001 .dw DO_COLON PFA_S2D: .endif 00fd83 f0c3 .dw XT_DUP 00fd84 f133 .dw XT_ZEROLESS 00fd85 f026 .dw XT_EXIT .include "words/to-body.asm" ; Core ; get body from XT VE_TO_BODY: 00fd86 ff05 .dw $ff05 00fd87 623e 00fd88 646f 00fd89 0079 .db ">body",0 00fd8a fd7e .dw VE_HEAD .set VE_HEAD = VE_TO_BODY XT_TO_BODY: 00fd8b f242 .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: 00fd8c 0008 .dw $0008 00fd8d 6c32 00fd8e 7469 00fd8f 7265 00fd90 6c61 .db "2literal" 00fd91 fd86 .dw VE_HEAD .set VE_HEAD = VE_2LITERAL XT_2LITERAL: 00fd92 f001 .dw DO_COLON PFA_2LITERAL: .endif 00fd93 f0d6 .dw XT_SWAP 00fd94 01f1 .dw XT_LITERAL 00fd95 01f1 .dw XT_LITERAL 00fd96 f026 .dw XT_EXIT .include "words/equal.asm" ; Compare ; compares two values for equality VE_EQUAL: 00fd97 ff01 .dw $ff01 00fd98 003d .db "=",0 00fd99 fd8c .dw VE_HEAD .set VE_HEAD = VE_EQUAL XT_EQUAL: 00fd9a f001 .dw DO_COLON PFA_EQUAL: 00fd9b f1a5 .dw XT_MINUS 00fd9c f12c .dw XT_ZEROEQUAL 00fd9d f026 .dw XT_EXIT .include "words/num-constants.asm" .endif .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_ONE: 00fd9e ff01 .dw $ff01 00fd9f 0031 .db "1",0 00fda0 fd97 .dw VE_HEAD .set VE_HEAD = VE_ONE XT_ONE: 00fda1 f054 .dw PFA_DOVARIABLE PFA_ONE: .endif 00fda2 0001 .DW 1 .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_TWO: 00fda3 ff01 .dw $ff01 00fda4 0032 .db "2",0 00fda5 fd9e .dw VE_HEAD .set VE_HEAD = VE_TWO XT_TWO: 00fda6 f054 .dw PFA_DOVARIABLE PFA_TWO: .endif 00fda7 0002 .DW 2 .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_MINUSONE: 00fda8 ff02 .dw $ff02 00fda9 312d .db "-1" 00fdaa fda3 .dw VE_HEAD .set VE_HEAD = VE_MINUSONE XT_MINUSONE: 00fdab f054 .dw PFA_DOVARIABLE PFA_MINUSONE: .endif 00fdac 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" 000046 ff ff ; some configs 000048 9a 05 CFG_DP: .dw DPSTART ; Dictionary Pointer 00004a cb 01 EE_HERE: .dw HERESTART ; Memory Allocation 00004c a0 00 EE_EHERE: .dw EHERESTART ; EEProm Memory Allocation 00004e 42 04 CFG_WLSCOPE: .dw XT_GET_CURRENT ; default wordlist scope 000050 6e 00 CFG_FORTHRECOGNIZER: .dw CFG_RECOGNIZERLISTLEN ; Recognizer word set ; LEAVE stack is between data stack and return stack. 000052 b0 40 CFG_LP0: .dw stackstart+1 000054 ec 04 CFG_TURNKEY: .dw XT_APPLTURNKEY ; TURNKEY 000056 4d f5 CFG_ENVIRONMENT:.dw VE_ENVHEAD ; environmental queries 000058 5a 00 CFG_CURRENT: .dw CFG_FORTHWORDLIST ; forth-wordlist 00005a a8 fd CFG_FORTHWORDLIST:.dw VE_HEAD ; pre-defined (compiled in) wordlist CFG_ORDERLISTLEN: 00005c 01 00 .dw 1 CFG_ORDERLIST: ; list of wordlist id, exactly numwordlist entries 00005e 5a 00 .dw CFG_FORTHWORDLIST ; get/set-order 000060 .byte (NUMWORDLISTS-1)*CELLSIZE ; one slot is already used CFG_RECOGNIZERLISTLEN: 00006e 02 00 .dw 2 CFG_RECOGNIZERLIST: 000070 3f fb .dw XT_REC_FIND 000072 2b fb .dw XT_REC_NUM 000074 .byte (NUMRECOGNIZERS-2)*CELLSIZE ; two slots are already used EE_STOREI: 000078 90 f3 .dw XT_DO_STOREI ; Store a cell into flash ; MARKER saves everything up to here. Nothing beyond gets saved EE_MARKER: 00007a 7a 00 .dw EE_MARKER ; default user area EE_INITUSER: 00007c 00 00 .dw 0 ; USER_STATE 00007e 00 00 .dw 0 ; USER_FOLLOWER 000080 ff 40 .dw rstackstart ; USER_RP 000082 af 40 .dw stackstart ; USER_SP0 000084 af 40 .dw stackstart ; USER_SP 000086 00 00 .dw 0 ; USER_HANDLER 000088 0a 00 .dw 10 ; USER_BASE 00008a b6 00 .dw XT_TX ; USER_EMIT 00008c c4 00 .dw XT_TXQ ; USER_EMITQ 00008e 8b 00 .dw XT_RX ; USER_KEY 000090 a6 00 .dw XT_RXQ ; USER_KEYQ 000092 40 fd .dw XT_SOURCETIB ; USER_SOURCE 000094 00 00 .dw 0 ; USER_G_IN 000096 2d fd .dw XT_REFILLTIB ; USER_REFILL 000098 05 fa .dw XT_DEFAULT_PROMPTOK 00009a 24 fa .dw XT_DEFAULT_PROMPTERROR 00009c 14 fa .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: 00009e 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 "ATmega1284P" 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: 38 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%) "ATmega1284P" 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 : 23 cls : 0 clt : 0 clv : 0 clz : 0 com : 14 cp : 11 cpc : 10 cpi : 2 cpse : 0 dec : 10 elpm : 16 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 : 0 lsl : 14 lsr : 2 mov : 16 movw : 72 mul : 5 muls : 1 mulsu : 2 neg : 0 nop : 0 or : 9 ori : 2 out : 31 pop : 49 push : 43 rcall : 48 ret : 7 reti : 1 rjmp : 105 rol : 32 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 114 (63.2%) "ATmega1284P" memory use summary [bytes]: Segment Begin End Code Data Used Size Use% --------------------------------------------------------------- [.cseg] 0x000000 0x01fb5a 2156 14646 16802 131072 12.8% [.dseg] 0x000100 0x0001cb 0 203 203 16384 1.2% [.eseg] 0x000000 0x0000a0 0 160 160 4096 3.9% Assembly complete, 0 errors, 8 warnings