AVRASM ver. 2.1.52 mega128.asm Sun Apr 30 20:10:13 2017 mega128.asm(5): Including file '../../avr8\preamble.inc' ../../avr8\preamble.inc(2): Including file '../../avr8\macros.asm' ../../avr8\macros.asm(6): Including file '../../avr8\user.inc' ../../avr8\preamble.inc(6): Including file '../../avr8/devices/atmega1280\device.asm' ../../avr8/devices/atmega1280\device.asm(5): Including file '../../avr8/Atmel/Appnotes2\m1280def.inc' mega128.asm(10): 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' mega128.asm(15): Including file '../../avr8\drivers/1wire.asm' mega128.asm(18): 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(4): 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(6): Including file 'words/applturnkey.asm' ../../avr8\amforth.asm(23): Including file '../../avr8\amforth-interpreter.asm' ../../avr8\amforth.asm(24): Including file '../../avr8\dict/nrww.inc' ../../avr8\dict/nrww.inc(4): Including file '../../avr8\words/exit.asm' ../../avr8\dict/nrww.inc(5): Including file '../../avr8\words/execute.asm' ../../avr8\dict/nrww.inc(6): Including file '../../avr8\words/dobranch.asm' ../../avr8\dict/nrww.inc(7): Including file '../../avr8\words/docondbranch.asm' ../../avr8\dict/nrww.inc(10): Including file '../../avr8\words/doliteral.asm' ../../avr8\dict/nrww.inc(11): Including file '../../avr8\words/dovariable.asm' ../../avr8\dict/nrww.inc(12): Including file '../../avr8\words/doconstant.asm' ../../avr8\dict/nrww.inc(13): Including file '../../avr8\words/douser.asm' ../../avr8\dict/nrww.inc(14): Including file '../../avr8\words/do-value.asm' ../../avr8\dict/nrww.inc(15): Including file '../../avr8\words/fetch.asm' ../../avr8\dict/nrww.inc(16): Including file '../../avr8\words/store.asm' ../../avr8\dict/nrww.inc(17): Including file '../../avr8\words/cstore.asm' ../../avr8\dict/nrww.inc(18): Including file '../../avr8\words/cfetch.asm' ../../avr8\dict/nrww.inc(19): Including file '../../avr8\words/fetch-u.asm' ../../avr8\dict/nrww.inc(20): Including file '../../avr8\words/store-u.asm' ../../avr8\dict/nrww.inc(23): Including file '../../avr8\words/dup.asm' ../../avr8\dict/nrww.inc(24): Including file '../../avr8\words/qdup.asm' ../../avr8\dict/nrww.inc(25): Including file '../../avr8\words/swap.asm' ../../avr8\dict/nrww.inc(26): Including file '../../avr8\words/over.asm' ../../avr8\dict/nrww.inc(27): Including file '../../avr8\words/drop.asm' ../../avr8\dict/nrww.inc(28): Including file '../../avr8\words/rot.asm' ../../avr8\dict/nrww.inc(29): Including file '../../avr8\words/nip.asm' ../../avr8\dict/nrww.inc(31): Including file '../../avr8\words/r_from.asm' ../../avr8\dict/nrww.inc(32): Including file '../../avr8\words/to_r.asm' ../../avr8\dict/nrww.inc(33): Including file '../../avr8\words/r_fetch.asm' ../../avr8\dict/nrww.inc(36): Including file '../../common\words/not-equal.asm' ../../avr8\dict/nrww.inc(37): Including file '../../avr8\words/equalzero.asm' ../../avr8\dict/nrww.inc(38): Including file '../../avr8\words/lesszero.asm' ../../avr8\dict/nrww.inc(39): Including file '../../avr8\words/greaterzero.asm' ../../avr8\dict/nrww.inc(40): Including file '../../avr8\words/d-greaterzero.asm' ../../avr8\dict/nrww.inc(41): Including file '../../avr8\words/d-lesszero.asm' ../../avr8\dict/nrww.inc(43): Including file '../../avr8\words/true.asm' ../../avr8\dict/nrww.inc(44): Including file '../../avr8\words/zero.asm' ../../avr8\dict/nrww.inc(45): Including file '../../avr8\words/uless.asm' ../../avr8\dict/nrww.inc(46): Including file '../../common\words/u-greater.asm' ../../avr8\dict/nrww.inc(47): Including file '../../avr8\words/less.asm' ../../avr8\dict/nrww.inc(48): Including file '../../avr8\words/greater.asm' ../../avr8\dict/nrww.inc(50): Including file '../../avr8\words/log2.asm' ../../avr8\dict/nrww.inc(51): Including file '../../avr8\words/minus.asm' ../../avr8\dict/nrww.inc(52): Including file '../../avr8\words/plus.asm' ../../avr8\dict/nrww.inc(53): Including file '../../avr8\words/mstar.asm' ../../avr8\dict/nrww.inc(54): Including file '../../avr8\words/umslashmod.asm' ../../avr8\dict/nrww.inc(55): Including file '../../avr8\words/umstar.asm' ../../avr8\dict/nrww.inc(57): Including file '../../avr8\words/invert.asm' ../../avr8\dict/nrww.inc(58): Including file '../../avr8\words/2slash.asm' ../../avr8\dict/nrww.inc(59): Including file '../../avr8\words/2star.asm' ../../avr8\dict/nrww.inc(60): Including file '../../avr8\words/and.asm' ../../avr8\dict/nrww.inc(61): Including file '../../avr8\words/or.asm' ../../avr8\dict/nrww.inc(62): Including file '../../avr8\words/xor.asm' ../../avr8\dict/nrww.inc(64): Including file '../../avr8\words/1plus.asm' ../../avr8\dict/nrww.inc(65): Including file '../../avr8\words/1minus.asm' ../../avr8\dict/nrww.inc(66): Including file '../../common\words/q-negate.asm' ../../avr8\dict/nrww.inc(67): Including file '../../avr8\words/lshift.asm' ../../avr8\dict/nrww.inc(68): Including file '../../avr8\words/rshift.asm' ../../avr8\dict/nrww.inc(69): Including file '../../avr8\words/plusstore.asm' ../../avr8\dict/nrww.inc(71): Including file '../../avr8\words/rpfetch.asm' ../../avr8\dict/nrww.inc(72): Including file '../../avr8\words/rpstore.asm' ../../avr8\dict/nrww.inc(73): Including file '../../avr8\words/spfetch.asm' ../../avr8\dict/nrww.inc(74): Including file '../../avr8\words/spstore.asm' ../../avr8\dict/nrww.inc(76): Including file '../../avr8\words/dodo.asm' ../../avr8\dict/nrww.inc(77): Including file '../../avr8\words/i.asm' ../../avr8\dict/nrww.inc(78): Including file '../../avr8\words/doplusloop.asm' ../../avr8\dict/nrww.inc(79): Including file '../../avr8\words/doloop.asm' ../../avr8\dict/nrww.inc(80): Including file '../../avr8\words/unloop.asm' ../../avr8\dict/nrww.inc(84): Including file '../../avr8\words/cmove_g.asm' ../../avr8\dict/nrww.inc(85): Including file '../../avr8\words/byteswap.asm' ../../avr8\dict/nrww.inc(86): Including file '../../avr8\words/up.asm' ../../avr8\dict/nrww.inc(87): Including file '../../avr8\words/1ms.asm' ../../avr8\dict/nrww.inc(88): Including file '../../avr8\words/2to_r.asm' ../../avr8\dict/nrww.inc(89): Including file '../../avr8\words/2r_from.asm' ../../avr8\dict/nrww.inc(91): Including file '../../avr8\words/store-e.asm' ../../avr8\dict/nrww.inc(92): Including file '../../avr8\words/fetch-e.asm' ../../avr8\dict/nrww.inc(93): Including file '../../avr8\words/store-i.asm' ../../avr8\dict/nrww.inc(97): Including file '../../avr8\words/store-i_nrww.asm' ../../avr8\dict/nrww.inc(99): Including file '../../avr8\words/fetch-i.asm' ../../avr8\dict/nrww.inc(102): Including file '../../avr8\dict/core_8k.inc' ../../avr8\dict/core_8k.inc(2): Including file '../../avr8\words/n_to_r.asm' ../../avr8\dict/core_8k.inc(3): Including file '../../avr8\words/n_r_from.asm' ../../avr8\dict/core_8k.inc(5): Including file '../../avr8\words/d-2star.asm' ../../avr8\dict/core_8k.inc(6): Including file '../../avr8\words/d-2slash.asm' ../../avr8\dict/core_8k.inc(7): Including file '../../avr8\words/d-plus.asm' ../../avr8\dict/core_8k.inc(8): Including file '../../avr8\words/d-minus.asm' ../../avr8\dict/core_8k.inc(9): Including file '../../avr8\words/d-invert.asm' ../../avr8\dict/core_8k.inc(10): Including file '../../common\words/u-dot.asm' ../../avr8\dict/core_8k.inc(11): Including file '../../common\words/u-dot-r.asm' ../../avr8\dict/core_8k.inc(13): Including file '../../common\words/show-wordlist.asm' ../../avr8\dict/core_8k.inc(14): Including file '../../common\words/words.asm' ../../avr8\dict/core_8k.inc(15): Including file '../../avr8\dict/interrupt.inc' ../../avr8\dict/interrupt.inc(8): Including file '../../avr8\words/int-on.asm' ../../avr8\dict/interrupt.inc(9): Including file '../../avr8\words/int-off.asm' ../../avr8\dict/interrupt.inc(10): Including file '../../avr8\words/int-store.asm' ../../avr8\dict/interrupt.inc(11): Including file '../../avr8\words/int-fetch.asm' ../../avr8\dict/interrupt.inc(12): Including file '../../avr8\words/int-trap.asm' ../../avr8\dict/interrupt.inc(14): Including file '../../avr8\words/isr-exec.asm' ../../avr8\dict/interrupt.inc(15): Including file '../../avr8\words/isr-end.asm' ../../avr8\dict/core_8k.inc(17): Including file '../../common\words/pick.asm' ../../avr8\dict/core_8k.inc(18): Including file '../../common\words/dot-quote.asm' ../../avr8\dict/core_8k.inc(19): Including file '../../common\words/squote.asm' ../../avr8\dict/core_8k.inc(21): Including file '../../avr8\words/fill.asm' ../../avr8\dict/core_8k.inc(23): Including file '../../avr8\words/environment.asm' ../../avr8\dict/core_8k.inc(24): Including file '../../avr8\words/env-wordlists.asm' ../../avr8\dict/core_8k.inc(25): Including file '../../avr8\words/env-slashpad.asm' ../../avr8\dict/core_8k.inc(26): Including file '../../common\words/env-slashhold.asm' ../../avr8\dict/core_8k.inc(27): Including file '../../common\words/env-forthname.asm' ../../avr8\dict/core_8k.inc(28): Including file '../../common\words/env-forthversion.asm' ../../avr8\dict/core_8k.inc(29): Including file '../../common\words/env-cpu.asm' ../../avr8\dict/core_8k.inc(30): Including file '../../avr8\words/env-mcuinfo.asm' ../../avr8\dict/core_8k.inc(31): Including file '../../common\words/env-usersize.asm' ../../avr8\dict/core_8k.inc(33): Including file '../../common\words/f_cpu.asm' ../../avr8\dict/core_8k.inc(34): Including file '../../avr8\words/state.asm' ../../avr8\dict/core_8k.inc(35): Including file '../../common\words/base.asm' ../../avr8\dict/core_8k.inc(37): Including file '../../avr8\words/cells.asm' ../../avr8\dict/core_8k.inc(38): Including file '../../avr8\words/cellplus.asm' ../../avr8\dict/core_8k.inc(40): Including file '../../common\words/2dup.asm' ../../avr8\dict/core_8k.inc(41): Including file '../../common\words/2drop.asm' ../../avr8\dict/core_8k.inc(43): Including file '../../common\words/tuck.asm' ../../avr8\dict/core_8k.inc(45): Including file '../../common\words/to-in.asm' ../../avr8\dict/core_8k.inc(46): Including file '../../common\words/pad.asm' ../../avr8\dict/core_8k.inc(47): Including file '../../common\words/emit.asm' ../../avr8\dict/core_8k.inc(48): Including file '../../common\words/emitq.asm' ../../avr8\dict/core_8k.inc(49): Including file '../../common\words/key.asm' ../../avr8\dict/core_8k.inc(50): Including file '../../common\words/keyq.asm' ../../avr8\dict/core_8k.inc(52): Including file '../../avr8\words/dp.asm' ../../avr8\dict/core_8k.inc(53): Including file '../../avr8\words/ehere.asm' ../../avr8\dict/core_8k.inc(54): Including file '../../avr8\words/here.asm' ../../avr8\dict/core_8k.inc(55): Including file '../../avr8\words/allot.asm' ../../avr8\dict/core_8k.inc(57): Including file '../../common\words/bin.asm' ../../avr8\dict/core_8k.inc(58): Including file '../../common\words/decimal.asm' ../../avr8\dict/core_8k.inc(59): Including file '../../common\words/hex.asm' ../../avr8\dict/core_8k.inc(60): Including file '../../common\words/bl.asm' ../../avr8\dict/core_8k.inc(62): Including file '../../avr8\words/turnkey.asm' ../../avr8\dict/core_8k.inc(64): Including file '../../avr8\words/slashmod.asm' ../../avr8\dict/core_8k.inc(65): Including file '../../avr8\words/uslashmod.asm' ../../avr8\dict/core_8k.inc(66): Including file '../../avr8\words/negate.asm' ../../avr8\dict/core_8k.inc(67): Including file '../../common\words/slash.asm' ../../avr8\dict/core_8k.inc(68): Including file '../../common\words/mod.asm' ../../avr8\dict/core_8k.inc(69): Including file '../../common\words/abs.asm' ../../avr8\dict/core_8k.inc(70): Including file '../../common\words/min.asm' ../../avr8\dict/core_8k.inc(71): Including file '../../common\words/max.asm' ../../avr8\dict/core_8k.inc(72): Including file '../../common\words/within.asm' ../../avr8\dict/core_8k.inc(74): Including file '../../common\words/to-upper.asm' ../../avr8\dict/core_8k.inc(75): Including file '../../common\words/to-lower.asm' ../../avr8\dict/core_8k.inc(77): Including file '../../avr8\words/hld.asm' ../../avr8\dict/core_8k.inc(78): Including file '../../common\words/hold.asm' ../../avr8\dict/core_8k.inc(79): Including file '../../common\words/less-sharp.asm' ../../avr8\dict/core_8k.inc(80): Including file '../../common\words/sharp.asm' ../../avr8\dict/core_8k.inc(81): Including file '../../common\words/sharp-s.asm' ../../avr8\dict/core_8k.inc(82): Including file '../../common\words/sharp-greater.asm' ../../avr8\dict/core_8k.inc(83): Including file '../../common\words/sign.asm' ../../avr8\dict/core_8k.inc(84): Including file '../../common\words/d-dot-r.asm' ../../avr8\dict/core_8k.inc(85): Including file '../../common\words/dot-r.asm' ../../avr8\dict/core_8k.inc(86): Including file '../../common\words/d-dot.asm' ../../avr8\dict/core_8k.inc(87): Including file '../../common\words/dot.asm' ../../avr8\dict/core_8k.inc(88): Including file '../../common\words/ud-dot.asm' ../../avr8\dict/core_8k.inc(89): Including file '../../common\words/ud-dot-r.asm' ../../avr8\dict/core_8k.inc(90): Including file '../../common\words/ud-slash-mod.asm' ../../avr8\dict/core_8k.inc(91): Including file '../../common\words/digit-q.asm' ../../avr8\dict/core_8k.inc(93): Including file '../../avr8\words/do-sliteral.asm' ../../avr8\dict/core_8k.inc(94): Including file '../../avr8\words/scomma.asm' ../../avr8\dict/core_8k.inc(95): Including file '../../avr8\words/itype.asm' ../../avr8\dict/core_8k.inc(96): Including file '../../avr8\words/icount.asm' ../../avr8\dict/core_8k.inc(97): Including file '../../common\words/cr.asm' ../../avr8\dict/core_8k.inc(98): Including file '../../common\words/space.asm' ../../avr8\dict/core_8k.inc(99): Including file '../../common\words/spaces.asm' ../../avr8\dict/core_8k.inc(100): Including file '../../common\words/type.asm' ../../avr8\dict/core_8k.inc(101): Including file '../../common\words/tick.asm' ../../avr8\dict/core_8k.inc(103): Including file '../../common\words/handler.asm' ../../avr8\dict/core_8k.inc(104): Including file '../../common\words/catch.asm' ../../avr8\dict/core_8k.inc(105): Including file '../../common\words/throw.asm' ../../avr8\dict/core_8k.inc(107): Including file '../../common\words/cskip.asm' ../../avr8\dict/core_8k.inc(108): Including file '../../common\words/cscan.asm' ../../avr8\dict/core_8k.inc(109): Including file '../../common\words/accept.asm' ../../avr8\dict/core_8k.inc(110): Including file '../../common\words/refill.asm' ../../avr8\dict/core_8k.inc(111): Including file '../../common\words/char.asm' ../../avr8\dict/core_8k.inc(112): Including file '../../common\words/number.asm' ../../avr8\dict/core_8k.inc(113): Including file '../../common\words/q-sign.asm' ../../avr8\dict/core_8k.inc(114): Including file '../../common\words/set-base.asm' ../../avr8\dict/core_8k.inc(115): Including file '../../common\words/to-number.asm' ../../avr8\dict/core_8k.inc(116): Including file '../../common\words/parse.asm' ../../avr8\dict/core_8k.inc(117): Including file '../../common\words/source.asm' ../../avr8\dict/core_8k.inc(118): Including file '../../common\words/slash-string.asm' ../../avr8\dict/core_8k.inc(119): Including file '../../common\words/parse-name.asm' ../../avr8\dict/core_8k.inc(120): Including file '../../common\words/find-xt.asm' ../../avr8\dict/core_8k.inc(122): Including file '../../common\words/prompt-ok.asm' ../../avr8\dict/core_8k.inc(123): Including file '../../common\words/prompt-ready.asm' ../../avr8\dict/core_8k.inc(124): Including file '../../common\words/prompt-error.asm' ../../avr8\dict/core_8k.inc(126): Including file '../../common\words/quit.asm' ../../avr8\dict/core_8k.inc(127): Including file '../../avr8\words/pause.asm' ../../avr8\dict/core_8k.inc(128): Including file '../../avr8\words/cold.asm' ../../avr8\dict/core_8k.inc(129): Including file '../../common\words/warm.asm' ../../avr8\dict/core_8k.inc(131): Including file '../../avr8\words/sp0.asm' ../../avr8\dict/core_8k.inc(132): Including file '../../avr8\words/rp0.asm' ../../avr8\dict/core_8k.inc(133): Including file '../../common\words/depth.asm' ../../avr8\dict/core_8k.inc(134): Including file '../../common\words/interpret.asm' ../../avr8\dict/core_8k.inc(135): Including file '../../avr8\words/forth-recognizer.asm' ../../avr8\dict/core_8k.inc(136): Including file '../../common\words/recognize.asm' ../../avr8\dict/core_8k.inc(137): Including file '../../common\words/rec-intnum.asm' ../../avr8\dict/core_8k.inc(138): Including file '../../common\words/rec-find.asm' ../../avr8\dict/core_8k.inc(139): Including file '../../common\words/dt-null.asm' ../../avr8\dict/core_8k.inc(141): Including file '../../common\words/q-stack.asm' ../../avr8\dict/core_8k.inc(142): Including file '../../common\words/ver.asm' ../../avr8\dict/core_8k.inc(144): Including file '../../common\words/noop.asm' ../../avr8\dict/core_8k.inc(145): Including file '../../avr8\words/unused.asm' ../../avr8\dict/core_8k.inc(147): Including file '../../common\words/to.asm' ../../avr8\dict/core_8k.inc(148): Including file '../../avr8\words/i-cellplus.asm' ../../avr8\dict/core_8k.inc(150): Including file '../../avr8\words/edefer-fetch.asm' ../../avr8\dict/core_8k.inc(151): Including file '../../avr8\words/edefer-store.asm' ../../avr8\dict/core_8k.inc(152): Including file '../../common\words/rdefer-fetch.asm' ../../avr8\dict/core_8k.inc(153): Including file '../../common\words/rdefer-store.asm' ../../avr8\dict/core_8k.inc(154): Including file '../../common\words/udefer-fetch.asm' ../../avr8\dict/core_8k.inc(155): Including file '../../common\words/udefer-store.asm' ../../avr8\dict/core_8k.inc(156): Including file '../../common\words/defer-store.asm' ../../avr8\dict/core_8k.inc(157): Including file '../../common\words/defer-fetch.asm' ../../avr8\dict/core_8k.inc(158): Including file '../../avr8\words/do-defer.asm' ../../avr8\dict/core_8k.inc(160): Including file '../../common\words/search-wordlist.asm' ../../avr8\dict/core_8k.inc(161): Including file '../../common\words/traverse-wordlist.asm' ../../avr8\dict/core_8k.inc(162): Including file '../../common\words/name2string.asm' ../../avr8\dict/core_8k.inc(163): Including file '../../avr8\words/nfa2cfa.asm' ../../avr8\dict/core_8k.inc(164): Including file '../../avr8\words/icompare.asm' ../../avr8\dict/core_8k.inc(166): Including file '../../common\words/star.asm' ../../avr8\dict/core_8k.inc(167): Including file '../../avr8\words/j.asm' ../../avr8\dict/core_8k.inc(169): Including file '../../avr8\words/dabs.asm' ../../avr8\dict/core_8k.inc(170): Including file '../../avr8\words/dnegate.asm' ../../avr8\dict/core_8k.inc(171): Including file '../../avr8\words/cmove.asm' ../../avr8\dict/core_8k.inc(172): Including file '../../common\words/2swap.asm' ../../avr8\dict/core_8k.inc(174): Including file '../../common\words/tib.asm' ../../avr8\dict/core_8k.inc(176): Including file '../../avr8\words/init-ram.asm' ../../avr8\dict/core_8k.inc(177): Including file '../../avr8\dict/compiler2.inc' ../../avr8\dict/core_8k.inc(178): Including file '../../common\words/bounds.asm' ../../avr8\dict/core_8k.inc(179): Including file '../../common\words/s-to-d.asm' ../../avr8\dict/core_8k.inc(180): Including file '../../avr8\words/to-body.asm' ../../avr8\dict/nrww.inc(112): Including file '../../common\words/2literal.asm' ../../avr8\dict/nrww.inc(113): Including file '../../avr8\words/equal.asm' ../../avr8\dict/nrww.inc(114): Including file '../../common\words/num-constants.asm' ../../avr8\amforth.asm(25): Including file 'dict_appl_core.inc' ../../avr8\amforth.asm(36): Including file '../../avr8\amforth-eeprom.inc' ; file see ../template/template.asm. You may want to ; copy that file to this one and edit it afterwards. .include "preamble.inc" .include "macros.asm" .set DICT_COMPILER2 = 0 ; .set cpu_msp430 = 0 .set cpu_avr8 = 1 .include "user.inc" ; ; used by the multitasker .set USER_STATE = 0 .set USER_FOLLOWER = 2 ; stackpointer, used by mulitasker .set USER_RP = 4 .set USER_SP0 = 6 .set USER_SP = 8 ; excpection handling .set USER_HANDLER = 10 ; numeric IO .set USER_BASE = 12 ; character IO .set USER_EMIT = 14 .set USER_EMITQ = 16 .set USER_KEY = 18 .set USER_KEYQ = 20 .set USER_SOURCE = 22 .set USER_TO_IN = 24 .set USER_REFILL = 26 .set USER_P_OK = 28 .set USER_P_ERR = 30 .set USER_P_RDY = 32 .set SYSUSERSIZE = 34 ; .def zerol = r2 .def zeroh = r3 .def upl = r4 .def uph = r5 .def al = r6 .def ah = r7 .def bl = r8 .def bh = r9 ; internal .def mcu_boot = r10 .def isrflag = r11 .def temp4 = r14 .def temp5 = r15 .def temp0 = r16 .def temp1 = r17 .def temp2 = r18 .def temp3 = r19 .def temp6 = r20 .def temp7 = r21 .def tosl = r24 .def tosh = r25 .def wl = r22 .def wh = r23 .macro loadtos ld tosl, Y+ ld tosh, Y+ .endmacro .macro savetos st -Y, tosh st -Y, tosl .endmacro .macro in_ .if (@1 < $40) in @0,@1 .else lds @0,@1 .endif .endmacro .macro out_ .if (@0 < $40) out @0,@1 .else sts @0,@1 .endif .endmacro .macro sbi_ .if (@0 < $40) sbi @0,@1 .else in_ @2,@0 ori @2,exp2(@1) out_ @0,@2 .endif .endmacro .macro cbi_ .if (@0 < $40) cbi @0,@1 .else in_ @2,@0 andi @2,~(exp2(@1)) out_ @0,@2 .endif .endmacro .macro jmp_ ; a more flexible macro .ifdef @0 .if (@0-pc > 2040) || (pc-@0>2040) jmp @0 .else rjmp @0 .endif .else jmp @0 .endif .endmacro .macro call_ ; a more flexible macro .ifdef @0 .if (@0-pc > 2040) || (pc-@0>2040) call @0 .else rcall @0 .endif .else call @0 .endif .endmacro ; F_CPU ; µsec 16000000 14745600 8000000 1000000 ; 1 16 14,74 8 1 ; 10 160 147,45 80 10 ; 100 1600 1474,56 800 100 ; 1000 16000 14745,6 8000 1000 ; ; cycles = µsec * f_cpu / 1e6 ; n_loops=cycles/5 ; ; cycles already used will be subtracted from the delay ; the waittime resolution is 1 cycle (delay from exact to +1 cycle) ; the maximum delay at 20MHz (50ns/clock) is 38350ns ; waitcount register must specify an immediate register ; ; busy waits a specfied amount of microseconds .macro delay .set cycles = ( ( @0 * F_CPU ) / 1000000 ) .if (cycles > ( 256 * 255 * 4 + 2)) .error "MACRO delay - too many cycles to burn" .else .if (cycles > 6) .set loop_cycles = (cycles / 4) ldi zl,low(loop_cycles) ldi zh,high(loop_cycles) sbiw Z, 1 brne pc-1 .set cycles = (cycles - (loop_cycles * 4)) .endif .if (cycles > 0) .if (cycles & 4) rjmp pc+1 rjmp pc+1 .endif .if (cycles & 2) rjmp pc+1 .endif .if (cycles & 1) nop .endif .endif .endif .endmacro ; portability macros, they come from the msp430 branches .macro DEST .dw @0 .endm ; controller specific file selected via include ; directory definition when calling the assembler (-I) .include "device.asm" ; generated automatically, do not edit .list .equ ramstart = 512 .equ CELLSIZE = 2 .macro readflashcell clr temp7 lsl zl rol zh rol temp7 out_ RAMPZ, temp7 elpm @0, Z+ elpm @1, Z+ .endmacro .macro writeflashcell clr temp7 lsl zl rol zh rol temp7 out_ RAMPZ, temp7 .endmacro .set WANT_ANALOG_COMPARATOR = 0 .set WANT_USART0 = 0 .set WANT_TWI = 0 .set WANT_SPI = 0 .set WANT_PORTA = 0 .set WANT_PORTB = 0 .set WANT_PORTC = 0 .set WANT_PORTD = 0 .set WANT_PORTE = 0 .set WANT_PORTF = 0 .set WANT_PORTG = 0 .set WANT_PORTH = 0 .set WANT_PORTJ = 0 .set WANT_PORTK = 0 .set WANT_PORTL = 0 .set WANT_TIMER_COUNTER_0 = 0 .set WANT_TIMER_COUNTER_2 = 0 .set WANT_WATCHDOG = 0 .set WANT_USART1 = 0 .set WANT_EEPROM = 0 .set WANT_TIMER_COUNTER_5 = 0 .set WANT_TIMER_COUNTER_4 = 0 .set WANT_TIMER_COUNTER_3 = 0 .set WANT_TIMER_COUNTER_1 = 0 .set WANT_JTAG = 0 .set WANT_EXTERNAL_INTERRUPT = 0 .set WANT_CPU = 0 .set WANT_AD_CONVERTER = 0 .set WANT_BOOT_LOAD = 0 .set WANT_USART2 = 0 .set WANT_USART3 = 0 .equ intvecsize = 2 ; please verify; flash size: 131072 bytes .equ pclen = 2 ; please verify .overlap .org 2 000002 d164 rcall isr ; External Interrupt Request 0 .org 4 000004 d162 rcall isr ; External Interrupt Request 1 .org 6 000006 d160 rcall isr ; External Interrupt Request 2 .org 8 000008 d15e rcall isr ; External Interrupt Request 3 .org 10 00000a d15c rcall isr ; External Interrupt Request 4 .org 12 00000c d15a rcall isr ; External Interrupt Request 5 .org 14 00000e d158 rcall isr ; External Interrupt Request 6 .org 16 000010 d156 rcall isr ; External Interrupt Request 7 .org 18 000012 d154 rcall isr ; Pin Change Interrupt Request 0 .org 20 000014 d152 rcall isr ; Pin Change Interrupt Request 1 .org 22 000016 d150 rcall isr ; Pin Change Interrupt Request 2 .org 24 000018 d14e rcall isr ; Watchdog Time-out Interrupt .org 26 00001a d14c rcall isr ; Timer/Counter2 Compare Match A .org 28 00001c d14a rcall isr ; Timer/Counter2 Compare Match B .org 30 00001e d148 rcall isr ; Timer/Counter2 Overflow .org 32 000020 d146 rcall isr ; Timer/Counter1 Capture Event .org 34 000022 d144 rcall isr ; Timer/Counter1 Compare Match A .org 36 000024 d142 rcall isr ; Timer/Counter1 Compare Match B .org 38 000026 d140 rcall isr ; Timer/Counter1 Compare Match C .org 40 000028 d13e rcall isr ; Timer/Counter1 Overflow .org 42 00002a d13c rcall isr ; Timer/Counter0 Compare Match A .org 44 00002c d13a rcall isr ; Timer/Counter0 Compare Match B .org 46 00002e d138 rcall isr ; Timer/Counter0 Overflow .org 48 000030 d136 rcall isr ; SPI Serial Transfer Complete .org 50 000032 d134 rcall isr ; USART0, Rx Complete .org 52 000034 d132 rcall isr ; USART0 Data register Empty .org 54 000036 d130 rcall isr ; USART0, Tx Complete .org 56 000038 d12e rcall isr ; Analog Comparator .org 58 00003a d12c rcall isr ; ADC Conversion Complete .org 60 00003c d12a rcall isr ; EEPROM Ready .org 62 00003e d128 rcall isr ; Timer/Counter3 Capture Event .org 64 000040 d126 rcall isr ; Timer/Counter3 Compare Match A .org 66 000042 d124 rcall isr ; Timer/Counter3 Compare Match B .org 68 000044 d122 rcall isr ; Timer/Counter3 Compare Match C .org 70 000046 d120 rcall isr ; Timer/Counter3 Overflow .org 72 000048 d11e rcall isr ; USART1, Rx Complete .org 74 00004a d11c rcall isr ; USART1 Data register Empty .org 76 00004c d11a rcall isr ; USART1, Tx Complete .org 78 00004e d118 rcall isr ; 2-wire Serial Interface .org 80 000050 d116 rcall isr ; Store Program Memory Read .org 82 000052 d114 rcall isr ; Timer/Counter4 Capture Event .org 84 000054 d112 rcall isr ; Timer/Counter4 Compare Match A .org 86 000056 d110 rcall isr ; Timer/Counter4 Compare Match B .org 88 000058 d10e rcall isr ; Timer/Counter4 Compare Match C .org 90 00005a d10c rcall isr ; Timer/Counter4 Overflow .org 92 00005c d10a rcall isr ; Timer/Counter5 Capture Event .org 94 00005e d108 rcall isr ; Timer/Counter5 Compare Match A .org 96 000060 d106 rcall isr ; Timer/Counter5 Compare Match B .org 98 000062 d104 rcall isr ; Timer/Counter5 Compare Match C .org 100 000064 d102 rcall isr ; Timer/Counter5 Overflow .org 102 000066 d100 rcall isr ; USART2, Rx Complete .org 104 000068 d0fe rcall isr ; USART2 Data register Empty .org 106 00006a d0fc rcall isr ; USART2, Tx Complete .org 108 00006c d0fa rcall isr ; USART3, Rx Complete .org 110 00006e d0f8 rcall isr ; USART3 Data register Empty .org 112 000070 d0f6 rcall isr ; USART3, Tx Complete .equ INTVECTORS = 57 .nooverlap ; compatability layer (maybe empty) ; controller data area, environment query mcu-info mcu_info: mcu_ramsize: 000071 2000 .dw 8192 mcu_eepromsize: 000072 1000 .dw 4096 mcu_maxdp: 000073 ffff .dw 65535 mcu_numints: 000074 0039 .dw 57 mcu_name: 000075 000a .dw 10 000076 5441 000077 656d 000078 6167 000079 3231 00007a 3038 .db "ATmega1280" .set codestart=pc ; some defaults, change them in your application master file ; see template.asm for an example ; enabling Interrupts, disabling them affects ; other settings as well. .set WANT_INTERRUPTS = 1 ; count the number of interrupts individually. ; requires a lot of RAM (one byte per interrupt) ; disabled by default. .set WANT_INTERRUPT_COUNTERS = 0 ; receiving is asynchronously, so an interrupt queue is useful. .set WANT_ISR_RX = 1 ; case insensitve dictionary lookup. .set WANT_IGNORECASE = 0 ; map all memories to one address space. Details in the ; technical guide .set WANT_UNIFIED = 0 ; terminal input buffer .set TIB_SIZE = 90 ; ANS94 needs at least 80 characters per line ; USER variables *in addition* to system ones .set APPUSERSIZE = 10 ; size of application specific user area in bytes ; addresses of various data segments .set rstackstart = RAMEND ; start address of return stack, grows downward .set stackstart = RAMEND - 80 ; start address of data stack, grows downward ; change only if you know what to you do .set NUMWORDLISTS = 8 ; number of word lists in the searh order, at least 8 .set NUMRECOGNIZERS = 4 ; total number of recognizers, two are always used. ; 10 per mille (1 per cent) is ok. .set BAUD = 38400 .set BAUD_MAXERROR = 10 ; Dictionary setup .set VE_HEAD = $0000 .set VE_ENVHEAD = $0000 .set WANT_IGNORECASE = 1 .equ F_CPU = 16000000 .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 000080 0000 .dw VE_HEAD .set VE_HEAD = VE_TO_RXBUF XT_TO_RXBUF: 000081 0082 .dw PFA_rx_tobuf PFA_rx_tobuf: 000082 2f08 mov temp0, tosl 000083 9110 0210 lds temp1, usart_rx_in 000085 e0e0 ldi zl, low(usart_rx_data) 000086 e0f2 ldi zh, high(usart_rx_data) 000087 0fe1 add zl, temp1 000088 1df3 adc zh, zeroh 000089 8300 st Z, temp0 00008a 9513 inc temp1 00008b 701f andi temp1,usart_rx_mask 00008c 9310 0210 sts usart_rx_in, temp1 00008e 9189 00008f 9199 loadtos 000090 940c f004 jmp_ DO_NEXT ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; setup with ; ' isr-rx URXCaddr int! VE_ISR_RX: 000092 ff06 .dw $ff06 000093 7369 000094 2d72 000095 7872 .db "isr-rx" 000096 007b .dw VE_HEAD .set VE_HEAD = VE_ISR_RX XT_ISR_RX: 000097 f000 .dw DO_COLON usart_rx_isr: 000098 f045 .dw XT_DOLITERAL 000099 00c6 .dw usart_data 00009a f0a9 .dw XT_CFETCH 00009b f0c2 .dw XT_DUP 00009c f045 .dw XT_DOLITERAL 00009d 0003 .dw 3 00009e fdaa .dw XT_EQUAL 00009f f03e .dw XT_DOCONDBRANCH 0000a0 00a2 .dw usart_rx_isr1 0000a1 fa73 .dw XT_COLD usart_rx_isr1: 0000a2 0081 .dw XT_TO_RXBUF 0000a3 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: 0000a4 f000 .dw DO_COLON PFA_USART_INIT_RX_BUFFER: ; ( -- ) 0000a5 f045 0000a6 0097 .dw XT_DOLITERAL, XT_ISR_RX 0000a7 f045 0000a8 0032 .dw XT_DOLITERAL, URXCaddr 0000a9 f4a1 .dw XT_INTSTORE 0000aa f045 .dw XT_DOLITERAL 0000ab 0200 .dw usart_rx_data 0000ac f045 .dw XT_DOLITERAL 0000ad 0016 .dw usart_rx_size + 6 0000ae f165 .dw XT_ZERO 0000af f4e9 .dw XT_FILL 0000b0 f025 .dw XT_EXIT ; ( -- c) ; MCU ; get 1 character from input queue, wait if needed using interrupt driver VE_RX_BUFFER: 0000b1 ff06 .dw $ff06 0000b2 7872 0000b3 622d 0000b4 6675 .db "rx-buf" 0000b5 0092 .dw VE_HEAD .set VE_HEAD = VE_RX_BUFFER XT_RX_BUFFER: 0000b6 f000 .dw DO_COLON PFA_RX_BUFFER: 0000b7 00d1 .dw XT_RXQ_BUFFER 0000b8 f03e .dw XT_DOCONDBRANCH 0000b9 00b7 .dw PFA_RX_BUFFER 0000ba f045 .dw XT_DOLITERAL 0000bb 0211 .dw usart_rx_out 0000bc f0a9 .dw XT_CFETCH 0000bd f0c2 .dw XT_DUP 0000be f045 .dw XT_DOLITERAL 0000bf 0200 .dw usart_rx_data 0000c0 f1ae .dw XT_PLUS 0000c1 f0a9 .dw XT_CFETCH 0000c2 f0d5 .dw XT_SWAP 0000c3 f240 .dw XT_1PLUS 0000c4 f045 .dw XT_DOLITERAL 0000c5 000f .dw usart_rx_mask 0000c6 f224 .dw XT_AND 0000c7 f045 .dw XT_DOLITERAL 0000c8 0211 .dw usart_rx_out 0000c9 f09e .dw XT_CSTORE 0000ca f025 .dw XT_EXIT ; ( -- f) ; MCU ; check if unread characters are in the input queue VE_RXQ_BUFFER: 0000cb ff07 .dw $ff07 0000cc 7872 0000cd 2d3f 0000ce 7562 0000cf 0066 .db "rx?-buf",0 0000d0 00b1 .dw VE_HEAD .set VE_HEAD = VE_RXQ_BUFFER XT_RXQ_BUFFER: 0000d1 f000 .dw DO_COLON PFA_RXQ_BUFFER: 0000d2 fa6b .dw XT_PAUSE 0000d3 f045 .dw XT_DOLITERAL 0000d4 0211 .dw usart_rx_out 0000d5 f0a9 .dw XT_CFETCH 0000d6 f045 .dw XT_DOLITERAL 0000d7 0210 .dw usart_rx_in 0000d8 f0a9 .dw XT_CFETCH 0000d9 f124 .dw XT_NOTEQUAL 0000da 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: 0000db ff07 .dw $ff07 0000dc 7874 0000dd 702d 0000de 6c6f 0000df 006c .db "tx-poll",0 0000e0 00cb .dw VE_HEAD .set VE_HEAD = VE_TX_POLL XT_TX_POLL: 0000e1 f000 .dw DO_COLON PFA_TX_POLL: ; wait for data ready 0000e2 00ef .dw XT_TXQ_POLL 0000e3 f03e .dw XT_DOCONDBRANCH 0000e4 00e2 .dw PFA_TX_POLL ; send to usart 0000e5 f045 .dw XT_DOLITERAL 0000e6 00c6 .dw USART_DATA 0000e7 f09e .dw XT_CSTORE 0000e8 f025 .dw XT_EXIT ; ( -- f) MCU ; MCU ; check if a character can be send using register poll VE_TXQ_POLL: 0000e9 ff08 .dw $ff08 0000ea 7874 0000eb 2d3f 0000ec 6f70 0000ed 6c6c .db "tx?-poll" 0000ee 00db .dw VE_HEAD .set VE_HEAD = VE_TXQ_POLL XT_TXQ_POLL: 0000ef f000 .dw DO_COLON PFA_TXQ_POLL: 0000f0 fa6b .dw XT_PAUSE 0000f1 f045 .dw XT_DOLITERAL 0000f2 00c0 .dw USART_A 0000f3 f0a9 .dw XT_CFETCH 0000f4 f045 .dw XT_DOLITERAL 0000f5 0020 .dw bm_USART_TXRD 0000f6 f224 .dw XT_AND 0000f7 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: 0000f8 ff04 .dw $ff04 0000f9 6275 0000fa 7272 .db "ubrr" 0000fb 00e9 .dw VE_HEAD .set VE_HEAD = VE_UBRR XT_UBRR: 0000fc f080 .dw PFA_DOVALUE1 PFA_UBRR: ; ( -- ) 0000fd 00ca .dw EE_UBRRVAL 0000fe fbce .dw XT_EDEFERFETCH 0000ff fbd8 .dw XT_EDEFERSTORE .include "words/usart.asm" ; MCU ; initialize usart VE_USART: 000100 ff06 .dw $ff06 000101 752b 000102 6173 000103 7472 .db "+usart" 000104 00f8 .dw VE_HEAD .set VE_HEAD = VE_USART XT_USART: 000105 f000 .dw DO_COLON PFA_USART: ; ( -- ) 000106 f045 .dw XT_DOLITERAL 000107 0098 .dw USART_B_VALUE 000108 f045 .dw XT_DOLITERAL 000109 00c1 .dw USART_B 00010a f09e .dw XT_CSTORE 00010b f045 .dw XT_DOLITERAL 00010c 0006 .dw USART_C_VALUE 00010d f045 .dw XT_DOLITERAL 00010e 00c2 .dw USART_C | bm_USARTC_en 00010f f09e .dw XT_CSTORE 000110 00fc .dw XT_UBRR 000111 f0c2 .dw XT_DUP 000112 f30a .dw XT_BYTESWAP 000113 f045 .dw XT_DOLITERAL 000114 00c5 .dw BAUDRATE_HIGH 000115 f09e .dw XT_CSTORE 000116 f045 .dw XT_DOLITERAL 000117 00c4 .dw BAUDRATE_LOW 000118 f09e .dw XT_CSTORE .if XT_USART_INIT_RX!=0 000119 00a4 .dw XT_USART_INIT_RX .endif .if XT_USART_INIT_TX!=0 .endif 00011a f025 .dw XT_EXIT ; settings for 1wire interface, if desired .equ OW_PORT=PORTE .EQU OW_BIT=4 .include "drivers/1wire.asm" ; B. J. Rodriguez (MSP 430) ; Matthias Trute (AVR Atmega) ; COPYRIGHT ; (c) 2012 Bradford J. Rodriguez for the 430 code and API ; adapted 430 assembly code to AVR ; wishlist: ; use a configurable pin at runtime, compatible with bitnames.frt ; no external pull up, no external power supply for devices ; ??? ; ;.EQU OW_BIT=4 ;.equ OW_PORT=PORTE .set OW_DDR=(OW_PORT-1) .set OW_PIN=(OW_DDR-1) ;****f* 1W.RESET ; NAME ; 1W.RESET ; SYNOPSIS ; 1W.RESET ( -- f ) Initialize 1-wire devices; return true if present ; DESCRIPTION ; This configures the port pin used by the 1-wire interface, and then ; sends an "initialize" sequence to the 1-wire devices. If any device ; is present, it will be detected. ; ; Timing, per DS18B20 data sheet: ; a) Output "0" (drive output low) for >480 usec. ; b) Output "1" (let output float). ; c) After 15 to 60 usec, device will drive pin low for 60 to 240 usec. ; So, wait 75 usec and sample input. ; d) Leave output high (floating) for at least 480 usec. ;****** ; ( -- f ) ; Hardware ; Initialize 1-wire devices; return true if present VE_OW_RESET: 00011b ff08 .dw $ff08 00011c 7731 00011d 722e 00011e 7365 00011f 7465 .db "1w.reset" 000120 0100 .dw VE_HEAD .set VE_HEAD = VE_OW_RESET XT_OW_RESET: 000121 0122 .dw PFA_OW_RESET PFA_OW_RESET: 000122 939a 000123 938a savetos ; setup to output 000124 9a6c sbi OW_DDR, OW_BIT ; Pull output low 000125 9874 cbi OW_PORT, OW_BIT ; Delay >480 usec 000126 e8e0 000127 e0f7 000128 9731 000129 f7f1 DELAY 480 ; Critical timing period, disable interrupts. 00012a b71f in temp1, SREG 00012b 94f8 cli ; Pull output high 00012c 9a74 sbi OW_PORT, OW_BIT ; make pin input, sends "1" 00012d 986c cbi OW_DDR, OW_BIT 00012e e0e0 00012f e0f1 000130 9731 000131 f7f1 DELAY 64 ; delayB ; Sample input pin, set TOS if input is zero 000132 b18c in tosl, OW_PIN 000133 ff84 sbrs tosl, OW_BIT 000134 ef9f ser tosh ; End critical timing period, enable interrupts 000135 bf1f out SREG, temp1 ; release bus 000136 986c cbi OW_DDR, OW_BIT 000137 9874 cbi OW_PORT, OW_BIT ; Delay rest of 480 usec 000138 e8e0 000139 e0f6 00013a 9731 00013b f7f1 DELAY 416 ; we now have the result flag in TOS 00013c 2f89 mov tosl, tosh 00013d 940c f004 jmp_ DO_NEXT ;****f* 1W.SLOT ; NAME ; 1W.SLOT ; SYNOPSIS ; 1W.SLOT ( c -- c' ) Write and read one bit to/from 1-wire. ; DESCRIPTION ; The "touch byte" function is described in Dallas App Note 74. ; It outputs a byte to the 1-wire pin, LSB first, and reads back ; the state of the 1-wire pin after a suitable delay. ; To read a byte, output $FF and read the reply data. ; To write a byte, output that byte and discard the reply. ; ; This function performs one bit of the "touch" operation -- ; one read/write "slot" in Dallas jargon. Perform this eight ; times in a row to get the "touch byte" function. ; ; PARAMETERS ; The input parameter is xxxxxxxxbbbbbbbo where ; 'xxxxxxxx' are don't cares, ; 'bbbbbbb' are bits to be shifted down, and ; 'o' is the bit to be output in the slot. This must be 1 ; to create a read slot. ; ; The returned value is xxxxxxxxibbbbbbb where ; 'xxxxxxxx' are not known (the input shifted down 1 position), ; 'i' is the bit read during the slot. This has no meaning ; if it was a write slot. ; 'bbbbbbb' are the 7 input bits, shifted down one position. ; ; This peculiar parameter usage allows OWTOUCH to be written as ; OWSLOT OWSLOT OWSLOT OWSLOT OWSLOT OWSLOT OWSLOT OWSLOT ; ; NOTES ; Interrupts are disabled during each bit. ; Timing, per DS18B20 data sheet: ; a) Output "0" for start period. (> 1 us, < 15 us, typ. 6 us*) ; b) Output data bit (0 or 1), open drain ; c) After MS from start of cycle, sample input (15 to 60 us, typ. 25 us*) ; d) After write-0 period from start of cycle, output "1" (>60 us) ; e) After recovery period, loop or return. (> 1 us) ; For writes, DS18B20 samples input 15 to 60 usec from start of cycle. ; * "Typical" values are per App Note 132 for a 300m cable length. ; --------- ------------------------------- ; \ / / ; ------------------------------- ; a b c d e ; | 6us | 19us | 35us | 2us | ;****** ; ( c -- c' ) ; Hardware ; Write and read one bit to/from 1-wire. VE_OW_SLOT: 00013f ff07 .dw $ff07 000140 7731 000141 732e 000142 6f6c 000143 0074 .db "1w.slot",0 000144 011b .dw VE_HEAD .set VE_HEAD = VE_OW_SLOT XT_OW_SLOT: 000145 0146 .dw PFA_OW_SLOT PFA_OW_SLOT: ; pull low 000146 9874 cbi OW_PORT, OW_BIT 000147 9a6c sbi OW_DDR, OW_BIT ; disable interrupts 000148 b71f in temp1, SREG 000149 94f8 cli 00014a e1e8 00014b e0f0 00014c 9731 00014d f7f1 DELAY 6 ; DELAY A ; check bit 00014e 9488 clc 00014f 9587 ror tosl 000150 f410 brcc PFA_OW_SLOT0 ; a 0 keeps the bus low ; release bus, a 1 is written 000151 9a74 sbi OW_PORT, OW_BIT 000152 986c cbi OW_DDR, OW_BIT PFA_OW_SLOT0: ; sample the input (no action required if zero) 000153 e2e4 000154 e0f0 000155 9731 000156 f7f1 DELAY 9 ; wait DELAY E to sample 000157 b10c in temp0, OW_PIN 000158 fd04 sbrc temp0, OW_BIT 000159 6880 ori tosl, $80 00015a ecec 00015b e0f0 00015c 9731 00015d f7f1 DELAY 51 ; DELAY B 00015e 9a74 sbi OW_PORT, OW_BIT ; release bus 00015f 986c cbi OW_DDR, OW_BIT 000160 e0e8 000161 e0f0 000162 9731 000163 f7f1 delay 2 ; re-enable interrupts 000164 bf1f out SREG, temp1 000165 940c f004 jmp_ DO_NEXT ; 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 000212 intcnt: .byte INTVECTORS .cseg ; interrupt routine gets called (again) by rcall! This gives the ; address of the int-vector on the stack. isr: 000167 920a st -Y, r0 000168 b60f in r0, SREG 000169 920a st -Y, r0 .if (pclen==3) .endif 00016a 900f pop r0 00016b 900f pop r0 ; = intnum * intvectorsize + 1 (address following the rcall) 00016c 940a dec r0 .if intvecsize == 1 ; .endif 00016d 2cb0 mov isrflag, r0 00016e 93ff push zh 00016f 93ef push zl 000170 e1e2 ldi zl, low(intcnt) 000171 e0f2 ldi zh, high(intcnt) 000172 9406 lsr r0 ; we use byte addresses in the counter array, not words 000173 0de0 add zl, r0 000174 1df3 adc zh, zeroh 000175 8000 ld r0, Z 000176 9403 inc r0 000177 8200 st Z, r0 000178 91ef pop zl 000179 91ff pop zh 00017a 9009 ld r0, Y+ 00017b be0f out SREG, r0 00017c 9009 ld r0, Y+ 00017d 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: 00017e ff02 .dw $ff02 00017f 2b6d .db "m+" 000180 013f .dw VE_HEAD .set VE_HEAD = VE_MPLUS XT_MPLUS: 000181 f000 .dw DO_COLON PFA_MPLUS: 000182 fd92 .dw XT_S2D 000183 f42f .dw XT_DPLUS 000184 f025 .dw XT_EXIT .include "words/ud-star.asm" .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_UDSTAR: 000185 ff03 .dw $ff03 000186 6475 ../../common\words/ud-star.asm(9): warning: .cseg .db misalignment - padding zero byte 000187 002a .db "ud*" 000188 017e .dw VE_HEAD .set VE_HEAD = VE_UDSTAR XT_UDSTAR: 000189 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 + ; 00018a f0c2 00018b f110 00018c f1f1 00018d f0ea .DW XT_DUP,XT_TO_R,XT_UMSTAR,XT_DROP 00018e f0d5 00018f f107 000190 f1f1 000191 f0f2 000192 f1ae 000193 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: 000194 ff04 .dw $ff04 000195 6d75 000196 7861 .db "umax" 000197 0185 .dw VE_HEAD .set VE_HEAD = VE_UMAX XT_UMAX: 000198 f000 .dw DO_COLON PFA_UMAX: .endif 000199 f57f 00019a f16d .DW XT_2DUP,XT_ULESS 00019b f03e .dw XT_DOCONDBRANCH 00019c 019e DEST(UMAX1) 00019d f0d5 .DW XT_SWAP 00019e f0ea UMAX1: .DW XT_DROP 00019f f025 .dw XT_EXIT .include "words/umin.asm" .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_UMIN: 0001a0 ff04 .dw $ff04 0001a1 6d75 0001a2 6e69 .db "umin" 0001a3 0194 .dw VE_HEAD .set VE_HEAD = VE_UMIN XT_UMIN: 0001a4 f000 .dw DO_COLON PFA_UMIN: .endif 0001a5 f57f 0001a6 f178 .DW XT_2DUP,XT_UGREATER 0001a7 f03e .dw XT_DOCONDBRANCH 0001a8 01aa DEST(UMIN1) 0001a9 f0d5 .DW XT_SWAP 0001aa f0ea UMIN1: .DW XT_DROP 0001ab 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: 0001ac f000 .dw DO_COLON PFA_IMMEDIATEQ: 0001ad f045 .dw XT_DOLITERAL 0001ae 8000 .dw $8000 0001af f224 .dw XT_AND 0001b0 f12b .dw XT_ZEROEQUAL 0001b1 f03e .dw XT_DOCONDBRANCH 0001b2 01b5 DEST(IMMEDIATEQ1) 0001b3 fdb1 .dw XT_ONE 0001b4 f025 .dw XT_EXIT IMMEDIATEQ1: ; not immediate 0001b5 f15c .dw XT_TRUE 0001b6 f025 .dw XT_EXIT .include "words/name2flags.asm" ; Tools ; get the flags from a name token VE_NAME2FLAGS: 0001b7 ff0a .dw $ff0a 0001b8 616e 0001b9 656d 0001ba 663e 0001bb 616c 0001bc 7367 .db "name>flags" 0001bd 01a0 .dw VE_HEAD .set VE_HEAD = VE_NAME2FLAGS XT_NAME2FLAGS: 0001be f000 .dw DO_COLON PFA_NAME2FLAGS: 0001bf f3e2 .dw XT_FETCHI ; skip to link field 0001c0 f045 .dw XT_DOLITERAL 0001c1 ff00 .dw $ff00 0001c2 f224 .dw XT_AND 0001c3 f025 .dw XT_EXIT .if AMFORTH_NRWW_SIZE > 8000 .include "dict/appl_8k.inc" .include "words/newest.asm" ; System Variable ; system state VE_NEWEST: 0001c4 ff06 .dw $ff06 0001c5 656e 0001c6 6577 0001c7 7473 .db "newest" 0001c8 01b7 .dw VE_HEAD .set VE_HEAD = VE_NEWEST XT_NEWEST: 0001c9 f053 .dw PFA_DOVARIABLE PFA_NEWEST: 0001ca 024b .dw ram_newest .dseg 00024b ram_newest: .byte 4 .include "words/latest.asm" ; System Variable ; system state VE_LATEST: 0001cb ff06 .dw $ff06 0001cc 616c 0001cd 6574 0001ce 7473 .db "latest" 0001cf 01c4 .dw VE_HEAD .set VE_HEAD = VE_LATEST XT_LATEST: 0001d0 f053 .dw PFA_DOVARIABLE PFA_LATEST: 0001d1 024f .dw ram_latest .dseg 00024f ram_latest: .byte 2 .include "words/do-create.asm" ; Compiler ; parse the input and create an empty vocabulary entry without XT and data field (PF) .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_DOCREATE: 0001d2 ff08 .dw $ff08 0001d3 6328 0001d4 6572 0001d5 7461 0001d6 2965 .db "(create)" 0001d7 01cb .dw VE_HEAD .set VE_HEAD = VE_DOCREATE XT_DOCREATE: 0001d8 f000 .dw DO_COLON PFA_DOCREATE: .endif 0001d9 f9ce 0001da 032f .DW XT_PARSENAME,XT_WLSCOPE ; ( -- addr len wid) 0001db f0c2 0001dc 01c9 0001dd f578 0001de f092 .DW XT_DUP,XT_NEWEST,XT_CELLPLUS,XT_STORE ; save the wid 0001df 0314 0001e0 01c9 0001e1 f092 .DW XT_HEADER,XT_NEWEST,XT_STORE ; save the nt 0001e2 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: 0001e3 0001 .dw $0001 0001e4 005c .db $5c,0 0001e5 01d2 .dw VE_HEAD .set VE_HEAD = VE_BACKSLASH XT_BACKSLASH: 0001e6 f000 .dw DO_COLON PFA_BACKSLASH: .endif 0001e7 f9b5 .dw XT_SOURCE 0001e8 f101 .dw XT_NIP 0001e9 f598 .dw XT_TO_IN 0001ea f092 .dw XT_STORE 0001eb 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: 0001ec 0001 .dw $0001 0001ed 0028 .db "(" ,0 0001ee 01e3 .dw VE_HEAD .set VE_HEAD = VE_LPAREN XT_LPAREN: 0001ef f000 .dw DO_COLON PFA_LPAREN: .endif 0001f0 f045 .dw XT_DOLITERAL 0001f1 0029 .dw ')' 0001f2 f9a1 .dw XT_PARSE 0001f3 f588 .dw XT_2DROP 0001f4 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: 0001f5 ff07 .dw $ff07 0001f6 6f63 0001f7 706d 0001f8 6c69 0001f9 0065 .db "compile",0 0001fa 01ec .dw VE_HEAD .set VE_HEAD = VE_COMPILE XT_COMPILE: 0001fb f000 .dw DO_COLON PFA_COMPILE: .endif 0001fc f107 .dw XT_R_FROM 0001fd f0c2 .dw XT_DUP 0001fe fbc5 .dw XT_ICELLPLUS 0001ff f110 .dw XT_TO_R 000200 f3e2 .dw XT_FETCHI 000201 0206 .dw XT_COMMA 000202 f025 .dw XT_EXIT .include "words/comma.asm" ; Dictionary ; compile 16 bit into flash at DP VE_COMMA: 000203 ff01 .dw $ff01 000204 002c .db ',',0 ; , 000205 01f5 .dw VE_HEAD .set VE_HEAD = VE_COMMA XT_COMMA: 000206 f000 .dw DO_COLON PFA_COMMA: 000207 f5c8 .dw XT_DP 000208 f384 .dw XT_STOREI 000209 f5c8 .dw XT_DP 00020a f240 .dw XT_1PLUS 00020b fbb3 .dw XT_DOTO 00020c f5c9 .dw PFA_DP 00020d 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: 00020e 0003 .dw $0003 00020f 275b 000210 005d .db "[']",0 000211 0203 .dw VE_HEAD .set VE_HEAD = VE_BRACKETTICK XT_BRACKETTICK: 000212 f000 .dw DO_COLON PFA_BRACKETTICK: .endif 000213 f824 .dw XT_TICK 000214 021c .dw XT_LITERAL 000215 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: 000216 0007 .dw $0007 000217 696c 000218 6574 000219 6172 00021a 006c .db "literal",0 00021b 020e .dw VE_HEAD .set VE_HEAD = VE_LITERAL XT_LITERAL: 00021c f000 .dw DO_COLON PFA_LITERAL: .endif 00021d 01fb .DW XT_COMPILE 00021e f045 .DW XT_DOLITERAL 00021f 0206 .DW XT_COMMA 000220 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: 000221 0008 .dw $0008 000222 6c73 000223 7469 000224 7265 000225 6c61 .db "sliteral" 000226 0216 .dw VE_HEAD .set VE_HEAD = VE_SLITERAL XT_SLITERAL: 000227 f000 .dw DO_COLON PFA_SLITERAL: .endif 000228 01fb .dw XT_COMPILE 000229 f787 .dw XT_DOSLITERAL ; ( -- addr n) 00022a f795 .dw XT_SCOMMA 00022b 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: 00022c f000 .dw DO_COLON PFA_GMARK: 00022d f5c8 .dw XT_DP 00022e 01fb .dw XT_COMPILE 00022f ffff .dw -1 ; ffff does not erase flash 000230 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: 000231 f000 .dw DO_COLON PFA_GRESOLVE: 000232 fb71 .dw XT_QSTACK 000233 f5c8 .dw XT_DP 000234 f0d5 .dw XT_SWAP 000235 f384 .dw XT_STOREI 000236 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: 0002c5 f000 .dw DO_COLON PFA_QDOCHECK: .endif 0002c6 f57f .dw XT_2DUP 0002c7 fdaa .dw XT_EQUAL 0002c8 f0c2 .dw XT_DUP 0002c9 f110 .dw XT_TO_R 0002ca f03e .dw XT_DOCONDBRANCH 0002cb 02cd DEST(PFA_QDOCHECK1) 0002cc f588 .dw XT_2DROP PFA_QDOCHECK1: 0002cd f107 .dw XT_R_FROM 0002ce f20e .dw XT_INVERT 0002cf f025 .dw XT_EXIT .include "words/endloop.asm" .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_ENDLOOP: 0002d0 ff07 .dw $ff07 0002d1 6e65 0002d2 6c64 0002d3 6f6f 0002d4 0070 .db "endloop",0 0002d5 02b9 .dw VE_HEAD .set VE_HEAD = VE_ENDLOOP XT_ENDLOOP: 0002d6 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. 0002d7 023a .DW XT_LRESOLVE 0002d8 02e3 0002d9 f0ca 0002da f03e LOOP1: .DW XT_L_FROM,XT_QDUP,XT_DOCONDBRANCH 0002db 02df DEST(LOOP2) 0002dc 025f .DW XT_THEN 0002dd f034 .dw XT_DOBRANCH 0002de 02d8 DEST(LOOP1) 0002df 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: 0002e0 ff02 .dw $ff02 0002e1 3e6c .db "l>" 0002e2 02d0 .dw VE_HEAD .set VE_HEAD = VE_L_FROM XT_L_FROM: 0002e3 f000 .dw DO_COLON PFA_L_FROM: .endif ;Z L> -- x L: x -- move from leave stack ; LP @ @ -2 LP +! ; 0002e4 0302 .dw XT_LP 0002e5 f08a .dw XT_FETCH 0002e6 f08a .dw XT_FETCH 0002e7 f045 .dw XT_DOLITERAL 0002e8 fffe .dw -2 0002e9 0302 .dw XT_LP 0002ea f276 .dw XT_PLUSSTORE 0002eb f025 .dw XT_EXIT .include "words/to-l.asm" .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_TO_L: 0002ec ff02 .dw $ff02 0002ed 6c3e .db ">l" 0002ee 02e0 .dw VE_HEAD .set VE_HEAD = VE_TO_L XT_TO_L: 0002ef f000 .dw DO_COLON PFA_TO_L: .endif ;Z >L x -- L: -- x move to leave stack ; CELL LP +! LP @ ! ; (L stack grows up) 0002f0 fdb6 .dw XT_TWO 0002f1 0302 .dw XT_LP 0002f2 f276 .dw XT_PLUSSTORE 0002f3 0302 .dw XT_LP 0002f4 f08a .dw XT_FETCH 0002f5 f092 .dw XT_STORE 0002f6 f025 .dw XT_EXIT .include "words/lp0.asm" ; Stack ; start address of leave stack VE_LP0: 0002f7 ff03 .dw $ff03 0002f8 706c 0002f9 0030 .db "lp0",0 0002fa 02ec .dw VE_HEAD .set VE_HEAD = VE_LP0 XT_LP0: 0002fb f080 .dw PFA_DOVALUE1 PFA_LP0: 0002fc 007e .dw CFG_LP0 0002fd fbce .dw XT_EDEFERFETCH 0002fe fbd8 .dw XT_EDEFERSTORE .include "words/lp.asm" ; System Variable ; leave stack pointer VE_LP: 0002ff ff02 .dw $ff02 000300 706c .db "lp" 000301 02f7 .dw VE_HEAD .set VE_HEAD = VE_LP XT_LP: 000302 f053 .dw PFA_DOVARIABLE PFA_LP: 000303 0251 .dw ram_lp .dseg 000251 ram_lp: .byte 2 .cseg .include "words/create.asm" ; Dictionary ; create a dictionary header. XT is (constant), with the address of the data field of name .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_CREATE: 000304 ff06 .dw $ff06 000305 7263 000306 6165 000307 6574 .db "create" 000308 02ff .dw VE_HEAD .set VE_HEAD = VE_CREATE XT_CREATE: 000309 f000 .dw DO_COLON PFA_CREATE: .endif 00030a 01d8 .dw XT_DOCREATE 00030b 0338 .dw XT_REVEAL 00030c 01fb .dw XT_COMPILE 00030d f060 .dw PFA_DOCONSTANT 00030e 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: 00030f ff06 .dw $ff06 000310 6568 000311 6461 000312 7265 .db "header" 000313 0304 .dw VE_HEAD .set VE_HEAD = VE_HEADER XT_HEADER: 000314 f000 .dw DO_COLON PFA_HEADER: 000315 f5c8 .dw XT_DP ; the new Name Field 000316 f110 .dw XT_TO_R 000317 f110 .dw XT_TO_R ; ( R: NFA WID ) 000318 f0c2 .dw XT_DUP 000319 f139 .dw XT_GREATERZERO 00031a f03e .dw XT_DOCONDBRANCH 00031b 0326 .dw PFA_HEADER1 00031c f0c2 .dw XT_DUP 00031d f045 .dw XT_DOLITERAL 00031e ff00 .dw $ff00 ; all flags are off (e.g. immediate) 00031f f22d .dw XT_OR 000320 f799 .dw XT_DOSCOMMA ; make the link to the previous entry in this wordlist 000321 f107 .dw XT_R_FROM 000322 f370 .dw XT_FETCHE 000323 0206 .dw XT_COMMA 000324 f107 .dw XT_R_FROM 000325 f025 .dw XT_EXIT PFA_HEADER1: ; -16: attempt to use zero length string as a name 000326 f045 .dw XT_DOLITERAL 000327 fff0 .dw -16 000328 f85b .dw XT_THROW .include "words/wlscope.asm" ; Compiler ; dynamically place a word in a wordlist. The word name may be changed. VE_WLSCOPE: 000329 ff07 .dw $ff07 00032a 6c77 00032b 6373 00032c 706f 00032d 0065 .db "wlscope",0 00032e 030f .dw VE_HEAD .set VE_HEAD = VE_WLSCOPE XT_WLSCOPE: 00032f fc2d .dw PFA_DODEFER1 PFA_WLSCOPE: 000330 007a .dw CFG_WLSCOPE 000331 fbce .dw XT_EDEFERFETCH 000332 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: 000333 ff06 .dw $ff06 000334 6572 000335 6576 000336 6c61 .db "reveal" 000337 0329 .dw VE_HEAD .set VE_HEAD = VE_REVEAL XT_REVEAL: 000338 f000 .dw DO_COLON PFA_REVEAL: .endif 000339 01c9 00033a f578 00033b f08a .DW XT_NEWEST,XT_CELLPLUS,XT_FETCH ; only if wordlist is in use 00033c f0ca 00033d f03e .DW XT_QDUP,XT_DOCONDBRANCH 00033e 0343 DEST(REVEAL1) 00033f 01c9 000340 f08a 000341 f0d5 000342 f34c .DW XT_NEWEST,XT_FETCH,XT_SWAP,XT_STOREE ; .DW XT_ZERO,XT_NEWEST,XT_CELLPLUS,XT_STORE ; clean wordlist entry REVEAL1: 000343 f025 .DW XT_EXIT .include "words/does.asm" ; Compiler ; organize the XT replacement to call other colon code VE_DOES: 000344 0005 .dw $0005 000345 6f64 000346 7365 000347 003e .db "does>",0 000348 0333 .dw VE_HEAD .set VE_HEAD = VE_DOES XT_DOES: 000349 f000 .dw DO_COLON PFA_DOES: 00034a 01fb .dw XT_COMPILE 00034b 035c .dw XT_DODOES 00034c 01fb .dw XT_COMPILE ; create a code snippet to be used in an embedded XT 00034d 940e .dw $940e ; the address of this compiled 00034e 01fb .dw XT_COMPILE ; code will replace the XT of the 00034f 0351 .dw DO_DODOES ; word that CREATE created 000350 f025 .dw XT_EXIT ; DO_DODOES: ; ( -- PFA ) 000351 939a 000352 938a savetos 000353 01cb movw tosl, wl 000354 9601 adiw tosl, 1 ; the following takes the address from a real uC-call .if (pclen==3) .endif 000355 917f pop wh 000356 916f pop wl 000357 93bf push XH 000358 93af push XL 000359 01db movw XL, wl 00035a 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: 00035c f000 .dw DO_COLON PFA_DODOES: 00035d f107 .dw XT_R_FROM 00035e 01c9 .dw XT_NEWEST 00035f f578 .dw XT_CELLPLUS 000360 f08a .dw XT_FETCH 000361 f370 .dw XT_FETCHE 000362 fc98 .dw XT_NFA2CFA 000363 f384 .dw XT_STOREI 000364 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: 000365 ff01 .dw $ff01 000366 003a .db ":",0 000367 0344 .dw VE_HEAD .set VE_HEAD = VE_COLON XT_COLON: 000368 f000 .dw DO_COLON PFA_COLON: .endif 000369 01d8 .dw XT_DOCREATE 00036a 0373 .dw XT_COLONNONAME 00036b f0ea .dw XT_DROP 00036c f025 .dw XT_EXIT .include "words/colon-noname.asm" ; Compiler ; create an unnamed entry in the dictionary, XT is DO_COLON VE_COLONNONAME: 00036d ff07 .dw $ff07 00036e 6e3a 00036f 6e6f 000370 6d61 000371 0065 .db ":noname",0 000372 0365 .dw VE_HEAD .set VE_HEAD = VE_COLONNONAME XT_COLONNONAME: 000373 f000 .dw DO_COLON PFA_COLONNONAME: 000374 f5c8 .dw XT_DP 000375 f0c2 .dw XT_DUP 000376 01d0 .dw XT_LATEST 000377 f092 .dw XT_STORE 000378 01fb .dw XT_COMPILE 000379 f000 .dw DO_COLON 00037a 0388 .dw XT_RBRACKET 00037b 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: 00037c 0001 .dw $0001 00037d 003b .db $3b,0 00037e 036d .dw VE_HEAD .set VE_HEAD = VE_SEMICOLON XT_SEMICOLON: 00037f f000 .dw DO_COLON PFA_SEMICOLON: .endif 000380 01fb .dw XT_COMPILE 000381 f025 .dw XT_EXIT 000382 0390 .dw XT_LBRACKET 000383 0338 .dw XT_REVEAL 000384 f025 .dw XT_EXIT .include "words/right-bracket.asm" ; Compiler ; enter compiler mode .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_RBRACKET: 000385 ff01 .dw $ff01 000386 005d .db "]",0 000387 037c .dw VE_HEAD .set VE_HEAD = VE_RBRACKET XT_RBRACKET: 000388 f000 .dw DO_COLON PFA_RBRACKET: .endif 000389 fdb1 .dw XT_ONE 00038a f565 .dw XT_STATE 00038b f092 .dw XT_STORE 00038c f025 .dw XT_EXIT .include "words/left-bracket.asm" ; Compiler ; enter interpreter mode .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_LBRACKET: 00038d 0001 .dw $0001 00038e 005b .db "[",0 00038f 0385 .dw VE_HEAD .set VE_HEAD = VE_LBRACKET XT_LBRACKET: 000390 f000 .dw DO_COLON PFA_LBRACKET: .endif 000391 f165 .dw XT_ZERO 000392 f565 .dw XT_STATE 000393 f092 .dw XT_STORE 000394 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: 000395 ff08 .dw $ff08 000396 6176 000397 6972 000398 6261 000399 656c .db "variable" 00039a 038d .dw VE_HEAD .set VE_HEAD = VE_VARIABLE XT_VARIABLE: 00039b f000 .dw DO_COLON PFA_VARIABLE: .endif 00039c f5d9 .dw XT_HERE 00039d 03a7 .dw XT_CONSTANT 00039e fdb6 .dw XT_TWO 00039f f5e2 .dw XT_ALLOT 0003a0 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: 0003a1 ff08 .dw $ff08 0003a2 6f63 0003a3 736e 0003a4 6174 0003a5 746e .db "constant" 0003a6 0395 .dw VE_HEAD .set VE_HEAD = VE_CONSTANT XT_CONSTANT: 0003a7 f000 .dw DO_COLON PFA_CONSTANT: .endif 0003a8 01d8 .dw XT_DOCREATE 0003a9 0338 .dw XT_REVEAL 0003aa 01fb .dw XT_COMPILE 0003ab f053 .dw PFA_DOVARIABLE 0003ac 0206 .dw XT_COMMA 0003ad f025 .dw XT_EXIT .include "words/user.asm" ; Compiler ; create a dictionary entry for a user variable at offset n VE_USER: 0003ae ff04 .dw $ff04 0003af 7375 0003b0 7265 .db "user" 0003b1 03a1 .dw VE_HEAD .set VE_HEAD = VE_USER XT_USER: 0003b2 f000 .dw DO_COLON PFA_USER: 0003b3 01d8 .dw XT_DOCREATE 0003b4 0338 .dw XT_REVEAL 0003b5 01fb .dw XT_COMPILE 0003b6 f066 .dw PFA_DOUSER 0003b7 0206 .dw XT_COMMA 0003b8 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: 0003b9 0007 .dw $0007 0003ba 6572 0003bb 7563 0003bc 7372 0003bd 0065 .db "recurse",0 0003be 03ae .dw VE_HEAD .set VE_HEAD = VE_RECURSE XT_RECURSE: 0003bf f000 .dw DO_COLON PFA_RECURSE: .endif 0003c0 01d0 .dw XT_LATEST 0003c1 f08a .dw XT_FETCH 0003c2 0206 .dw XT_COMMA 0003c3 f025 .dw XT_EXIT .include "words/immediate.asm" ; Compiler ; set immediate flag for the most recent word definition VE_IMMEDIATE: 0003c4 ff09 .dw $ff09 0003c5 6d69 0003c6 656d 0003c7 6964 0003c8 7461 0003c9 0065 .db "immediate",0 0003ca 03b9 .dw VE_HEAD .set VE_HEAD = VE_IMMEDIATE XT_IMMEDIATE: 0003cb f000 .dw DO_COLON PFA_IMMEDIATE: 0003cc 046d .dw XT_GET_CURRENT 0003cd f370 .dw XT_FETCHE 0003ce f0c2 .dw XT_DUP 0003cf f3e2 .dw XT_FETCHI 0003d0 f045 .dw XT_DOLITERAL 0003d1 7fff .dw $7fff 0003d2 f224 .dw XT_AND 0003d3 f0d5 .dw XT_SWAP 0003d4 f384 .dw XT_STOREI 0003d5 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: 0003d6 0006 .dw $0006 0003d7 635b 0003d8 6168 0003d9 5d72 .db "[char]" 0003da 03c4 .dw VE_HEAD .set VE_HEAD = VE_BRACKETCHAR XT_BRACKETCHAR: 0003db f000 .dw DO_COLON PFA_BRACKETCHAR: .endif 0003dc 01fb .dw XT_COMPILE 0003dd f045 .dw XT_DOLITERAL 0003de f904 .dw XT_CHAR 0003df 0206 .dw XT_COMMA 0003e0 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: 0003e1 0006 .dw $0006 0003e2 6261 0003e3 726f 0003e4 2274 .db "abort",'"' 0003e5 03d6 .dw VE_HEAD .set VE_HEAD = VE_ABORTQUOTE XT_ABORTQUOTE: 0003e6 f000 .dw DO_COLON PFA_ABORTQUOTE: .endif 0003e7 f4db .dw XT_SQUOTE 0003e8 01fb .dw XT_COMPILE 0003e9 03f8 .dw XT_QABORT 0003ea f025 .DW XT_EXIT .include "words/abort.asm" ; Exceptions ; send an exception -1 .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_ABORT: 0003eb ff05 .dw $ff05 0003ec 6261 0003ed 726f 0003ee 0074 .db "abort",0 0003ef 03e1 .dw VE_HEAD .set VE_HEAD = VE_ABORT XT_ABORT: 0003f0 f000 .dw DO_COLON PFA_ABORT: .endif 0003f1 f15c .dw XT_TRUE 0003f2 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: 0003f3 ff06 .dw $ff06 0003f4 613f 0003f5 6f62 0003f6 7472 .db "?abort" 0003f7 03eb .dw VE_HEAD .set VE_HEAD = VE_QABORT XT_QABORT: 0003f8 f000 .dw DO_COLON PFA_QABORT: .endif 0003f9 f0f2 0003fa f03e .DW XT_ROT,XT_DOCONDBRANCH 0003fb 03fe DEST(QABO1) 0003fc f7ba 0003fd 03f0 .DW XT_ITYPE,XT_ABORT 0003fe f588 0003ff 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: 000400 ff09 .dw $ff09 000401 6567 000402 2d74 000403 7473 000404 6361 000405 006b .db "get-stack",0 000406 03f3 .dw VE_HEAD .set VE_HEAD = VE_GET_STACK XT_GET_STACK: 000407 f000 .dw DO_COLON .endif 000408 f0c2 .dw XT_DUP 000409 f578 .dw XT_CELLPLUS 00040a f0d5 .dw XT_SWAP 00040b f370 .dw XT_FETCHE 00040c f0c2 .dw XT_DUP 00040d f110 .dw XT_TO_R 00040e f165 .dw XT_ZERO 00040f f0d5 .dw XT_SWAP ; go from bigger to smaller addresses 000410 02c5 .dw XT_QDOCHECK 000411 f03e .dw XT_DOCONDBRANCH 000412 041e DEST(PFA_N_FETCH_E2) 000413 f2ac .dw XT_DODO PFA_N_FETCH_E1: ; ( ee-addr ) 000414 f2bd .dw XT_I 000415 f246 .dw XT_1MINUS 000416 f572 .dw XT_CELLS ; ( -- ee-addr i*2 ) 000417 f0e0 .dw XT_OVER ; ( -- ee-addr i*2 ee-addr ) 000418 f1ae .dw XT_PLUS ; ( -- ee-addr ee-addr+i 000419 f370 .dw XT_FETCHE ;( -- ee-addr item_i ) 00041a f0d5 .dw XT_SWAP ;( -- item_i ee-addr ) 00041b f15c .dw XT_TRUE ; shortcut for -1 00041c f2cb .dw XT_DOPLUSLOOP 00041d 0414 DEST(PFA_N_FETCH_E1) PFA_N_FETCH_E2: 00041e f588 .dw XT_2DROP 00041f f107 .dw XT_R_FROM 000420 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: 000421 ff09 .dw $ff09 000422 6573 000423 2d74 000424 7473 000425 6361 000426 006b .db "set-stack",0 000427 0400 .dw VE_HEAD .set VE_HEAD = VE_SET_STACK XT_SET_STACK: 000428 f000 .dw DO_COLON PFA_SET_STACK: .endif 000429 f0e0 .dw XT_OVER 00042a f132 .dw XT_ZEROLESS 00042b f03e .dw XT_DOCONDBRANCH 00042c 0430 DEST(PFA_SET_STACK0) 00042d f045 .dw XT_DOLITERAL 00042e fffc .dw -4 00042f f85b .dw XT_THROW PFA_SET_STACK0: 000430 f57f .dw XT_2DUP 000431 f34c .dw XT_STOREE ; ( -- i_n .. i_0 n e-addr ) 000432 f0d5 .dw XT_SWAP 000433 f165 .dw XT_ZERO 000434 02c5 .dw XT_QDOCHECK 000435 f03e .dw XT_DOCONDBRANCH 000436 043d DEST(PFA_SET_STACK2) 000437 f2ac .dw XT_DODO PFA_SET_STACK1: 000438 f578 .dw XT_CELLPLUS ; ( -- i_x e-addr ) 000439 f590 .dw XT_TUCK ; ( -- e-addr i_x e-addr 00043a f34c .dw XT_STOREE 00043b f2da .dw XT_DOLOOP 00043c 0438 DEST(PFA_SET_STACK1) PFA_SET_STACK2: 00043d f0ea .dw XT_DROP 00043e 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: 00043f ff09 .dw $ff09 000440 616d 000441 2d70 000442 7473 000443 6361 000444 006b .db "map-stack",0 000445 0421 .dw VE_HEAD .set VE_HEAD = VE_MAPSTACK XT_MAPSTACK: 000446 f000 .dw DO_COLON PFA_MAPSTACK: .endif 000447 f0c2 .dw XT_DUP 000448 f578 .dw XT_CELLPLUS 000449 f0d5 .dw XT_SWAP 00044a f370 .dw XT_FETCHE 00044b f572 .dw XT_CELLS 00044c fd89 .dw XT_BOUNDS 00044d 02c5 .dw XT_QDOCHECK 00044e f03e .dw XT_DOCONDBRANCH 00044f 0462 DEST(PFA_MAPSTACK3) 000450 f2ac .dw XT_DODO PFA_MAPSTACK1: 000451 f2bd .dw XT_I 000452 f370 .dw XT_FETCHE ; -- i*x XT id 000453 f0d5 .dw XT_SWAP 000454 f110 .dw XT_TO_R 000455 f119 .dw XT_R_FETCH 000456 f02f .dw XT_EXECUTE ; i*x id -- j*y true | i*x false 000457 f0ca .dw XT_QDUP 000458 f03e .dw XT_DOCONDBRANCH 000459 045e DEST(PFA_MAPSTACK2) 00045a f107 .dw XT_R_FROM 00045b f0ea .dw XT_DROP 00045c f2e5 .dw XT_UNLOOP 00045d f025 .dw XT_EXIT PFA_MAPSTACK2: 00045e f107 .dw XT_R_FROM 00045f fdb6 .dw XT_TWO 000460 f2cb .dw XT_DOPLUSLOOP 000461 0451 DEST(PFA_MAPSTACK1) PFA_MAPSTACK3: 000462 f0ea .dw XT_DROP 000463 f165 .dw XT_ZERO 000464 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: 000465 ff0b .dw $ff0b 000466 6567 000467 2d74 000468 7563 000469 7272 00046a 6e65 00046b 0074 .db "get-current",0 00046c 043f .dw VE_HEAD .set VE_HEAD = VE_GET_CURRENT XT_GET_CURRENT: 00046d f000 .dw DO_COLON PFA_GET_CURRENT: 00046e f045 .dw XT_DOLITERAL 00046f 0084 .dw CFG_CURRENT 000470 f370 .dw XT_FETCHE 000471 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: 000472 ff09 .dw $ff09 000473 6567 000474 2d74 000475 726f 000476 6564 000477 0072 .db "get-order",0 000478 0465 .dw VE_HEAD .set VE_HEAD = VE_GET_ORDER XT_GET_ORDER: 000479 f000 .dw DO_COLON PFA_GET_ORDER: .endif 00047a f045 .dw XT_DOLITERAL 00047b 0088 .dw CFG_ORDERLISTLEN 00047c 0407 .dw XT_GET_STACK 00047d 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: 00047e ff09 .dw $ff09 00047f 6663 000480 2d67 000481 726f 000482 6564 000483 0072 .db "cfg-order",0 000484 0472 .dw VE_HEAD .set VE_HEAD = VE_CFG_ORDER XT_CFG_ORDER: 000485 f053 .dw PFA_DOVARIABLE PFA_CFG_ORDER: .endif 000486 0088 .dw CFG_ORDERLISTLEN .include "words/compare.asm" ; String ; compares two strings in RAM VE_COMPARE: 000487 ff07 .dw $ff07 000488 6f63 000489 706d 00048a 7261 00048b 0065 .db "compare",0 00048c 047e .dw VE_HEAD .set VE_HEAD = VE_COMPARE XT_COMPARE: 00048d 048e .dw PFA_COMPARE PFA_COMPARE: 00048e 93bf push xh 00048f 93af push xl 000490 018c movw temp0, tosl 000491 9189 000492 9199 loadtos 000493 01dc movw xl, tosl 000494 9189 000495 9199 loadtos 000496 019c movw temp2, tosl 000497 9189 000498 9199 loadtos 000499 01fc movw zl, tosl PFA_COMPARE_LOOP: 00049a 90ed ld temp4, X+ 00049b 90f1 ld temp5, Z+ 00049c 14ef cp temp4, temp5 00049d f451 brne PFA_COMPARE_NOTEQUAL 00049e 950a dec temp0 00049f f019 breq PFA_COMPARE_ENDREACHED2 0004a0 952a dec temp2 0004a1 f7c1 brne PFA_COMPARE_LOOP 0004a2 c001 rjmp PFA_COMPARE_ENDREACHED PFA_COMPARE_ENDREACHED2: 0004a3 952a dec temp2 PFA_COMPARE_ENDREACHED: 0004a4 2b02 or temp0, temp2 0004a5 f411 brne PFA_COMPARE_CHECKLASTCHAR 0004a6 2788 clr tosl 0004a7 c002 rjmp PFA_COMPARE_DONE PFA_COMPARE_CHECKLASTCHAR: PFA_COMPARE_NOTEQUAL: 0004a8 ef8f ser tosl 0004a9 c000 rjmp PFA_COMPARE_DONE PFA_COMPARE_DONE: 0004aa 2f98 mov tosh, tosl 0004ab 91af pop xl 0004ac 91bf pop xh 0004ad 940c f004 jmp_ DO_NEXT .include "words/nfa2lfa.asm" ; System ; get the link field address from the name field address VE_NFA2LFA: 0004af ff07 .dw $ff07 0004b0 666e 0004b1 3e61 0004b2 666c 0004b3 0061 .db "nfa>lfa",0 0004b4 0487 .dw VE_HEAD .set VE_HEAD = VE_NFA2LFA XT_NFA2LFA: 0004b5 f000 .dw DO_COLON PFA_NFA2LFA: 0004b6 fc8c .dw XT_NAME2STRING 0004b7 f240 .dw XT_1PLUS 0004b8 f215 .dw XT_2SLASH 0004b9 f1ae .dw XT_PLUS 0004ba f025 .dw XT_EXIT .elif AMFORTH_NRWW_SIZE > 4000 .elif AMFORTH_NRWW_SIZE > 2000 .else .endif .include "dict_appl.inc" ; they may be moved to the core dictionary if needed .include "dict/compiler2.inc" ; additional words for the compiler ; 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: 0004bb ff0b .dw $ff0b 0004bc 6573 0004bd 2d74 0004be 7563 0004bf 7272 0004c0 6e65 0004c1 0074 .db "set-current",0 0004c2 04af .dw VE_HEAD .set VE_HEAD = VE_SET_CURRENT XT_SET_CURRENT: 0004c3 f000 .dw DO_COLON PFA_SET_CURRENT: 0004c4 f045 .dw XT_DOLITERAL 0004c5 0084 .dw CFG_CURRENT 0004c6 f34c .dw XT_STOREE 0004c7 f025 .dw XT_EXIT .include "words/wordlist.asm" ; Search Order ; create a new, empty wordlist VE_WORDLIST: 0004c8 ff08 .dw $ff08 0004c9 6f77 0004ca 6472 0004cb 696c 0004cc 7473 .db "wordlist" 0004cd 04bb .dw VE_HEAD .set VE_HEAD = VE_WORDLIST XT_WORDLIST: 0004ce f000 .dw DO_COLON PFA_WORDLIST: 0004cf f5d1 .dw XT_EHERE 0004d0 f165 .dw XT_ZERO 0004d1 f0e0 .dw XT_OVER 0004d2 f34c .dw XT_STOREE 0004d3 f0c2 .dw XT_DUP 0004d4 f578 .dw XT_CELLPLUS 0004d5 fbb3 .dw XT_DOTO 0004d6 f5d2 .dw PFA_EHERE 0004d7 f025 .dw XT_EXIT .include "words/forth-wordlist.asm" ; Search Order ; get the system default word list VE_FORTHWORDLIST: 0004d8 ff0e .dw $ff0e 0004d9 6f66 0004da 7472 0004db 2d68 0004dc 6f77 0004dd 6472 0004de 696c 0004df 7473 .db "forth-wordlist" 0004e0 04c8 .dw VE_HEAD .set VE_HEAD = VE_FORTHWORDLIST XT_FORTHWORDLIST: 0004e1 f053 .dw PFA_DOVARIABLE PFA_FORTHWORDLIST: 0004e2 0086 .dw CFG_FORTHWORDLIST .include "words/set-order.asm" ; Search Order ; replace the search order list .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_SET_ORDER: 0004e3 ff09 .dw $ff09 0004e4 6573 0004e5 2d74 0004e6 726f 0004e7 6564 0004e8 0072 .db "set-order",0 0004e9 04d8 .dw VE_HEAD .set VE_HEAD = VE_SET_ORDER XT_SET_ORDER: 0004ea f000 .dw DO_COLON PFA_SET_ORDER: .endif 0004eb f045 .dw XT_DOLITERAL 0004ec 0088 .dw CFG_ORDERLISTLEN 0004ed 0428 .dw XT_SET_STACK 0004ee 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: 0004ef ff0f .dw $ff0f 0004f0 6573 0004f1 2d74 0004f2 6572 0004f3 6f63 0004f4 6e67 0004f5 7a69 0004f6 7265 0004f7 0073 .db "set-recognizers",0 0004f8 04e3 .dw VE_HEAD .set VE_HEAD = VE_SET_RECOGNIZERS XT_SET_RECOGNIZERS: 0004f9 f000 .dw DO_COLON PFA_SET_RECOGNIZERS: .endif 0004fa f045 .dw XT_DOLITERAL 0004fb 009a .dw CFG_RECOGNIZERLISTLEN 0004fc 0428 .dw XT_SET_STACK 0004fd 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: 0004fe ff0f .dw $ff0f 0004ff 6567 000500 2d74 000501 6572 000502 6f63 000503 6e67 000504 7a69 000505 7265 000506 0073 .db "get-recognizers",0 000507 04ef .dw VE_HEAD .set VE_HEAD = VE_GET_RECOGNIZERS XT_GET_RECOGNIZERS: 000508 f000 .dw DO_COLON PFA_GET_RECOGNIZERS: .endif 000509 f045 .dw XT_DOLITERAL 00050a 009a .dw CFG_RECOGNIZERLISTLEN 00050b 0407 .dw XT_GET_STACK 00050c f025 .dw XT_EXIT .include "words/code.asm" ; Compiler ; create named entry in the dictionary, XT is the data field VE_CODE: 00050d ff04 .dw $ff04 00050e 6f63 00050f 6564 .db "code" 000510 04fe .dw VE_HEAD .set VE_HEAD = VE_CODE XT_CODE: 000511 f000 .dw DO_COLON PFA_CODE: 000512 01d8 .dw XT_DOCREATE 000513 0338 .dw XT_REVEAL 000514 f5c8 .dw XT_DP 000515 fbc5 .dw XT_ICELLPLUS 000516 0206 .dw XT_COMMA 000517 f025 .dw XT_EXIT .include "words/end-code.asm" ; Compiler ; finish a code definition VE_ENDCODE: 000518 ff08 .dw $ff08 000519 6e65 00051a 2d64 00051b 6f63 00051c 6564 .db "end-code" 00051d 050d .dw VE_HEAD .set VE_HEAD = VE_ENDCODE XT_ENDCODE: 00051e f000 .dw DO_COLON PFA_ENDCODE: 00051f 01fb .dw XT_COMPILE 000520 940c .dw $940c 000521 01fb .dw XT_COMPILE 000522 f004 .dw DO_NEXT 000523 f025 .dw XT_EXIT .include "words/marker.asm" ; System Value ; The eeprom address until which MARKER saves and restores the eeprom data. VE_MARKER: 000524 ff08 .dw $ff08 000525 6d28 000526 7261 000527 656b 000528 2972 .db "(marker)" 000529 0518 .dw VE_HEAD .set VE_HEAD = VE_MARKER XT_MARKER: 00052a f080 .dw PFA_DOVALUE1 PFA_MARKER: 00052b 00a6 .dw EE_MARKER 00052c fbce .dw XT_EDEFERFETCH 00052d 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: 00052e 0008 .dw $0008 00052f 6f70 000530 7473 000531 6f70 000532 656e .db "postpone" 000533 0524 .dw VE_HEAD .set VE_HEAD = VE_POSTPONE XT_POSTPONE: 000534 f000 .dw DO_COLON PFA_POSTPONE: .endif 000535 f9ce .dw XT_PARSENAME 000536 fae6 .dw XT_FORTHRECOGNIZER 000537 faf1 .dw XT_RECOGNIZE 000538 f0c2 .dw XT_DUP 000539 f110 .dw XT_TO_R 00053a fbc5 .dw XT_ICELLPLUS 00053b fbc5 .dw XT_ICELLPLUS 00053c f3e2 .dw XT_FETCHI 00053d f02f .dw XT_EXECUTE 00053e f107 .dw XT_R_FROM 00053f fbc5 .dw XT_ICELLPLUS 000540 f3e2 .dw XT_FETCHI 000541 0206 .dw XT_COMMA 000542 f025 .dw XT_EXIT .endif .include "words/applturnkey.asm" ; R( -- ) ; application specific turnkey action VE_APPLTURNKEY: 000543 ff0b .dw $ff0b 000544 7061 000545 6c70 000546 7574 000547 6e72 000548 656b 000549 0079 .db "applturnkey",0 00054a 052e .dw VE_HEAD .set VE_HEAD = VE_APPLTURNKEY XT_APPLTURNKEY: 00054b f000 .dw DO_COLON PFA_APPLTURNKEY: 00054c 0105 .dw XT_USART .if WANT_INTERRUPTS == 1 00054d f493 .dw XT_INTON .endif 00054e fb7e .dw XT_DOT_VER 00054f f7fc .dw XT_SPACE 000550 f787 .dw XT_DOSLITERAL 000551 000a .dw 10 000552 6f46 000553 7472 000554 6468 000555 6975 000556 6f6e .db "Forthduino" 000557 f7ba .dw XT_ITYPE 000558 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 0543 .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 01d8 .dw XT_DOCREATE 00f07c 0338 .dw XT_REVEAL 00f07d 01fb .dw XT_COMPILE 00f07e f080 .dw PFA_DOVALUE1 00f07f f025 .dw XT_EXIT PFA_DOVALUE1: 00f080 940e 0351 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 eae0 00f327 e0ff 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 00a4 .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 008a .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 01fb .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 0227 .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 0082 .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 0075 .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 0071 .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 2400 .dw (F_CPU % 65536) 00f55d f045 .dw XT_DOLITERAL 00f55e 00f4 .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 0253 .dw ram_state .dseg 000253 ram_state: .byte 2 .include "words/base.asm" ; Numeric IO ; location of the cell containing the number conversion radix .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_BASE: 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 0074 .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 0078 .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 0076 .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 0080 .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 0255 .dw ram_hld .dseg 000255 ram_hld: .byte 2 .cseg .include "words/hold.asm" ; Numeric IO ; prepend character to pictured numeric output buffer .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_HOLD: 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 0206 .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 02c5 .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 0206 .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 0206 .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 02c5 .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 02c5 .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 0198 .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 01a4 .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 0189 TONUM2: .DW XT_TO_R,XT_2SWAP,XT_BASE,XT_FETCH,XT_UDSTAR 00f994 f107 00f995 0181 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 0088 .dw CFG_ORDERLISTLEN 00f9ef 0446 .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 02fb 00fa44 0302 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 0390 .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 0257 .dw ram_pause 00fa6d fbe2 .dw XT_RDEFERFETCH 00fa6e fbec .dw XT_RDEFERSTORE .dseg 000257 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 e0f2 ldi zh, high(ramstart) clearloop: 00fa7b 9221 st Z+, zerol 00fa7c 30e0 cpi zl, low(sram_size+ramstart) 00fa7d f7e9 brne clearloop 00fa7e 32f2 cpi zh, high(sram_size+ramstart) 00fa7f f7d9 brne clearloop ; init first user data area ; allocate space for User Area .dseg 000259 ram_user1: .byte SYSUSERSIZE + APPUSERSIZE .cseg 00fa80 e5e9 ldi zl, low(ram_user1) 00fa81 e0f2 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 e211 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 e2d1 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 0390 .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 007c .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 0446 .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 021c .dw XT_LITERAL ; compile 00fb19 021c .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 0206 .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 01fb .dw XT_COMPILE 00fbb0 fbb3 .dw XT_DOTO 00fbb1 0206 .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 01d8 .dw XT_DOCREATE 00fc29 0338 .dw XT_REVEAL 00fc2a 01fb .dw XT_COMPILE 00fc2b fc2d .dw PFA_DODEFER1 00fc2c f025 .dw XT_EXIT PFA_DODEFER1: 00fc2d 940e 0351 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 01be .dw XT_NAME2FLAGS 00fc52 01ac .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 04b5 .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 04b5 .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 02c5 .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 0285 .dw ram_tib .dseg 000285 ram_tib: .byte TIB_SIZE .cseg .endif ; ( -- addr ) ; System Variable ; variable holding the number of characters in TIB .if cpu_msp430==1 .endif .if cpu_avr8==1 VE_NUMBERTIB: 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 02df .dw ram_sharptib .dseg 0002df ram_sharptib: .byte 2 .cseg .endif .include "words/init-ram.asm" ; Tools ; copy len cells from eeprom to ram VE_EE2RAM: 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 00a8 .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 021c .dw XT_LITERAL 00fda5 021c .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" ; do not delete it! .set flashlast = pc .if (pc>FLASHEND) .endif .dseg ; define a label for the 1st free ram address HERESTART: .eseg .include "amforth-eeprom.inc" 000072 ff ff ; some configs 000074 59 05 CFG_DP: .dw DPSTART ; Dictionary Pointer 000076 e1 02 EE_HERE: .dw HERESTART ; Memory Allocation 000078 cc 00 EE_EHERE: .dw EHERESTART ; EEProm Memory Allocation 00007a 6d 04 CFG_WLSCOPE: .dw XT_GET_CURRENT ; default wordlist scope 00007c 9a 00 CFG_FORTHRECOGNIZER: .dw CFG_RECOGNIZERLISTLEN ; Recognizer word set ; LEAVE stack is between data stack and return stack. 00007e b0 21 CFG_LP0: .dw stackstart+1 000080 4b 05 CFG_TURNKEY: .dw XT_APPLTURNKEY ; TURNKEY 000082 4c f5 CFG_ENVIRONMENT:.dw VE_ENVHEAD ; environmental queries 000084 86 00 CFG_CURRENT: .dw CFG_FORTHWORDLIST ; forth-wordlist 000086 b8 fd CFG_FORTHWORDLIST:.dw VE_HEAD ; pre-defined (compiled in) wordlist CFG_ORDERLISTLEN: 000088 01 00 .dw 1 CFG_ORDERLIST: ; list of wordlist id, exactly numwordlist entries 00008a 86 00 .dw CFG_FORTHWORDLIST ; get/set-order 00008c .byte (NUMWORDLISTS-1)*CELLSIZE ; one slot is already used CFG_RECOGNIZERLISTLEN: 00009a 02 00 .dw 2 CFG_RECOGNIZERLIST: 00009c 3e fb .dw XT_REC_FIND 00009e 2a fb .dw XT_REC_NUM 0000a0 .byte (NUMRECOGNIZERS-2)*CELLSIZE ; two slots are already used EE_STOREI: 0000a4 8f f3 .dw XT_DO_STOREI ; Store a cell into flash ; MARKER saves everything up to here. Nothing beyond gets saved EE_MARKER: 0000a6 a6 00 .dw EE_MARKER ; default user area EE_INITUSER: 0000a8 00 00 .dw 0 ; USER_STATE 0000aa 00 00 .dw 0 ; USER_FOLLOWER 0000ac ff 21 .dw rstackstart ; USER_RP 0000ae af 21 .dw stackstart ; USER_SP0 0000b0 af 21 .dw stackstart ; USER_SP 0000b2 00 00 .dw 0 ; USER_HANDLER 0000b4 0a 00 .dw 10 ; USER_BASE 0000b6 e1 00 .dw XT_TX ; USER_EMIT 0000b8 ef 00 .dw XT_TXQ ; USER_EMITQ 0000ba b6 00 .dw XT_RX ; USER_KEY 0000bc d1 00 .dw XT_RXQ ; USER_KEYQ 0000be 50 fd .dw XT_SOURCETIB ; USER_SOURCE 0000c0 00 00 .dw 0 ; USER_G_IN 0000c2 3d fd .dw XT_REFILLTIB ; USER_REFILL 0000c4 04 fa .dw XT_DEFAULT_PROMPTOK 0000c6 23 fa .dw XT_DEFAULT_PROMPTERROR 0000c8 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: 0000ca 19 00 .dw UBRR_VAL ; BAUDRATE ; 1st free address in EEPROM. EHERESTART: .cseg RESOURCE USE INFORMATION ------------------------ Notice: The register and instruction counts are symbol table hit counts, and hence implicitly used resources are not counted, eg, the 'lpm' instruction without operands implicitly uses r0 and z, none of which are counted. x,y,z are separate entities in the symbol table and are counted separately from r26..r31 here. .dseg memory usage only counts static data declared with .byte "ATmega1280" 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: 80 r17: 61 r18: 52 r19: 37 r20: 13 r21: 38 r22: 11 r23: 3 r24: 193 r25: 136 r26: 28 r27: 17 r28: 7 r29: 4 r30: 85 r31: 47 x : 4 y : 205 z : 48 Registers used: 29 out of 35 (82.9%) "ATmega1280" instruction use summary: .lds : 0 .sts : 0 adc : 22 add : 17 adiw : 17 and : 4 andi : 3 asr : 2 bclr : 0 bld : 0 brbc : 2 brbs : 7 brcc : 3 brcs : 1 break : 0 breq : 6 brge : 1 brhc : 0 brhs : 0 brid : 0 brie : 0 brlo : 1 brlt : 3 brmi : 3 brne : 20 brpl : 0 brsh : 0 brtc : 0 brts : 0 brvc : 0 brvs : 2 bset : 0 bst : 0 call : 2 cbi : 7 cbr : 0 clc : 2 clh : 0 cli : 7 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 : 18 inc : 3 jmp : 10 ld : 136 ldd : 4 ldi : 41 lds : 1 lpm : 0 lsl : 14 lsr : 2 mov : 16 movw : 65 mul : 5 muls : 1 mulsu : 2 neg : 0 nop : 0 or : 9 ori : 2 out : 27 pop : 45 push : 39 rcall : 69 ret : 6 reti : 1 rjmp : 102 rol : 32 ror : 6 sbc : 9 sbci : 3 sbi : 8 sbic : 3 sbis : 0 sbiw : 14 sbr : 0 sbrc : 5 sbrs : 4 sec : 1 seh : 0 sei : 1 sen : 0 ser : 4 ses : 0 set : 0 sev : 0 sez : 0 sleep : 0 spm : 2 st : 76 std : 8 sts : 1 sub : 6 subi : 3 swap : 0 tst : 0 wdr : 0 Instructions used: 71 out of 114 (62.3%) "ATmega1280" memory use summary [bytes]: Segment Begin End Code Data Used Size Use% --------------------------------------------------------------- [.cseg] 0x000000 0x01fb7a 2076 14620 16696 131072 12.7% [.dseg] 0x000200 0x0002e1 0 225 225 8192 2.7% [.eseg] 0x000000 0x0000cc 0 204 204 4096 5.0% Assembly complete, 0 errors, 8 warnings