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