From 67d25d837ac55f28a366c0a3b262e439a6e75fc3 Mon Sep 17 00:00:00 2001 From: Dimitri Sokolyuk Date: Sat, 19 Aug 2017 12:15:28 +0200 Subject: Add AmForth --- amforth-6.5/appl/eval-pollin/p644-16.lst | 10444 +++++++++++++++++++++++++++++ 1 file changed, 10444 insertions(+) create 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 new file mode 100644 index 0000000..2c8872a --- /dev/null +++ b/amforth-6.5/appl/eval-pollin/p644-16.lst @@ -0,0 +1,10444 @@ + +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