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