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