From d80736ab6e8e3cad2f1a30c6eaba2d6883dbe967 Mon Sep 17 00:00:00 2001 From: Dimitri Sokolyuk Date: Sat, 26 Aug 2017 20:31:40 +0200 Subject: Remove AmForth --- amforth-6.5/appl/eval-pollin/p16-8.lst | 10363 ------------------------------- 1 file changed, 10363 deletions(-) delete mode 100644 amforth-6.5/appl/eval-pollin/p16-8.lst (limited to 'amforth-6.5/appl/eval-pollin/p16-8.lst') diff --git a/amforth-6.5/appl/eval-pollin/p16-8.lst b/amforth-6.5/appl/eval-pollin/p16-8.lst deleted file mode 100644 index 4cb21fb..0000000 --- a/amforth-6.5/appl/eval-pollin/p16-8.lst +++ /dev/null @@ -1,10363 +0,0 @@ - -AVRASM ver. 2.1.52 p16-8.asm Sun Apr 30 20:10:14 2017 - -p16-8.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/atmega16\device.asm' -../../avr8/devices/atmega16\device.asm(5): Including file '../../avr8/Atmel/Appnotes2\m16def.inc' -p16-8.asm(14): Including file '../../avr8\drivers/usart.asm' -../../avr8\drivers/usart.asm(30): 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' -p16-8.asm(19): Including file '../../avr8\drivers/1wire.asm' -p16-8.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(13): Including file '../../avr8\dict/appl_2k.inc' -../../avr8\dict/appl_2k.inc(1): Including file '../../avr8\words/d-2star.asm' -../../avr8\dict/appl_2k.inc(2): Including file '../../avr8\words/d-2slash.asm' -../../avr8\dict/appl_2k.inc(3): Including file '../../avr8\words/d-plus.asm' -../../avr8\dict/appl_2k.inc(4): Including file '../../avr8\words/d-minus.asm' -../../avr8\dict/appl_2k.inc(5): Including file '../../avr8\words/d-invert.asm' -../../avr8\dict/appl_2k.inc(6): Including file '../../common\words/u-dot.asm' -../../avr8\dict/appl_2k.inc(7): Including file '../../common\words/u-dot-r.asm' -../../avr8\dict/appl_2k.inc(9): Including file '../../common\words/show-wordlist.asm' -../../avr8\dict/appl_2k.inc(10): Including file '../../common\words/words.asm' -../../avr8\dict/appl_2k.inc(11): 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/appl_2k.inc(13): Including file '../../common\words/pick.asm' -../../avr8\dict/appl_2k.inc(14): Including file '../../common\words/dot-quote.asm' -../../avr8\dict/appl_2k.inc(15): Including file '../../common\words/squote.asm' -../../avr8\dict/appl_2k.inc(17): Including file '../../avr8\words/fill.asm' -../../avr8\dict/appl_2k.inc(18): 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\dict/appl_2k.inc(20): Including file '../../avr8\words/environment.asm' -../../avr8\dict/appl_2k.inc(21): Including file '../../avr8\words/env-wordlists.asm' -../../avr8\dict/appl_2k.inc(22): Including file '../../avr8\words/env-slashpad.asm' -../../avr8\dict/appl_2k.inc(23): Including file '../../common\words/env-slashhold.asm' -../../avr8\dict/appl_2k.inc(24): Including file '../../common\words/env-forthname.asm' -../../avr8\dict/appl_2k.inc(25): Including file '../../common\words/env-forthversion.asm' -../../avr8\dict/appl_2k.inc(26): Including file '../../common\words/env-cpu.asm' -../../avr8\dict/appl_2k.inc(27): Including file '../../avr8\words/env-mcuinfo.asm' -../../avr8\dict/appl_2k.inc(28): Including file '../../common\words/env-usersize.asm' -../../avr8\dict/appl_2k.inc(30): Including file '../../common\words/f_cpu.asm' -../../avr8\dict/appl_2k.inc(31): Including file '../../avr8\words/state.asm' -../../avr8\dict/appl_2k.inc(32): Including file '../../common\words/base.asm' -../../avr8\dict/appl_2k.inc(34): Including file '../../avr8\words/cells.asm' -../../avr8\dict/appl_2k.inc(35): Including file '../../avr8\words/cellplus.asm' -../../avr8\dict/appl_2k.inc(37): Including file '../../common\words/2dup.asm' -../../avr8\dict/appl_2k.inc(38): Including file '../../common\words/2drop.asm' -../../avr8\dict/appl_2k.inc(40): Including file '../../common\words/tuck.asm' -../../avr8\dict/appl_2k.inc(42): Including file '../../common\words/to-in.asm' -../../avr8\dict/appl_2k.inc(43): Including file '../../common\words/pad.asm' -../../avr8\dict/appl_2k.inc(44): Including file '../../common\words/emit.asm' -../../avr8\dict/appl_2k.inc(45): Including file '../../common\words/emitq.asm' -../../avr8\dict/appl_2k.inc(46): Including file '../../common\words/key.asm' -../../avr8\dict/appl_2k.inc(47): Including file '../../common\words/keyq.asm' -../../avr8\dict/appl_2k.inc(49): Including file '../../avr8\words/dp.asm' -../../avr8\dict/appl_2k.inc(50): Including file '../../avr8\words/ehere.asm' -../../avr8\dict/appl_2k.inc(51): Including file '../../avr8\words/here.asm' -../../avr8\dict/appl_2k.inc(52): Including file '../../avr8\words/allot.asm' -../../avr8\dict/appl_2k.inc(54): Including file '../../common\words/bin.asm' -../../avr8\dict/appl_2k.inc(55): Including file '../../common\words/decimal.asm' -../../avr8\dict/appl_2k.inc(56): Including file '../../common\words/hex.asm' -../../avr8\dict/appl_2k.inc(57): Including file '../../common\words/bl.asm' -../../avr8\dict/appl_2k.inc(59): Including file '../../avr8\words/turnkey.asm' -../../avr8\dict/appl_2k.inc(61): Including file '../../avr8\words/slashmod.asm' -../../avr8\dict/appl_2k.inc(62): Including file '../../avr8\words/uslashmod.asm' -../../avr8\dict/appl_2k.inc(63): Including file '../../avr8\words/negate.asm' -../../avr8\dict/appl_2k.inc(64): Including file '../../common\words/slash.asm' -../../avr8\dict/appl_2k.inc(65): Including file '../../common\words/mod.asm' -../../avr8\dict/appl_2k.inc(66): Including file '../../common\words/abs.asm' -../../avr8\dict/appl_2k.inc(67): Including file '../../common\words/min.asm' -../../avr8\dict/appl_2k.inc(68): Including file '../../common\words/max.asm' -../../avr8\dict/appl_2k.inc(69): Including file '../../common\words/within.asm' -../../avr8\dict/appl_2k.inc(71): Including file '../../common\words/to-upper.asm' -../../avr8\dict/appl_2k.inc(72): Including file '../../common\words/to-lower.asm' -../../avr8\dict/appl_2k.inc(74): Including file '../../avr8\words/hld.asm' -../../avr8\dict/appl_2k.inc(75): Including file '../../common\words/hold.asm' -../../avr8\dict/appl_2k.inc(76): Including file '../../common\words/less-sharp.asm' -../../avr8\dict/appl_2k.inc(77): Including file '../../common\words/sharp.asm' -../../avr8\dict/appl_2k.inc(78): Including file '../../common\words/sharp-s.asm' -../../avr8\dict/appl_2k.inc(79): Including file '../../common\words/sharp-greater.asm' -../../avr8\dict/appl_2k.inc(80): Including file '../../common\words/sign.asm' -../../avr8\dict/appl_2k.inc(81): Including file '../../common\words/d-dot-r.asm' -../../avr8\dict/appl_2k.inc(82): Including file '../../common\words/dot-r.asm' -../../avr8\dict/appl_2k.inc(83): Including file '../../common\words/d-dot.asm' -../../avr8\dict/appl_2k.inc(84): Including file '../../common\words/dot.asm' -../../avr8\dict/appl_2k.inc(85): Including file '../../common\words/ud-dot.asm' -../../avr8\dict/appl_2k.inc(86): Including file '../../common\words/ud-dot-r.asm' -../../avr8\dict/appl_2k.inc(87): Including file '../../common\words/ud-slash-mod.asm' -../../avr8\dict/appl_2k.inc(88): Including file '../../common\words/digit-q.asm' -../../avr8\dict/appl_2k.inc(90): Including file '../../avr8\words/do-sliteral.asm' -../../avr8\dict/appl_2k.inc(91): Including file '../../avr8\words/scomma.asm' -../../avr8\dict/appl_2k.inc(92): Including file '../../avr8\words/itype.asm' -../../avr8\dict/appl_2k.inc(93): Including file '../../avr8\words/icount.asm' -../../avr8\dict/appl_2k.inc(94): Including file '../../common\words/cr.asm' -../../avr8\dict/appl_2k.inc(95): Including file '../../common\words/space.asm' -../../avr8\dict/appl_2k.inc(96): Including file '../../common\words/spaces.asm' -../../avr8\dict/appl_2k.inc(97): Including file '../../common\words/type.asm' -../../avr8\dict/appl_2k.inc(98): Including file '../../common\words/tick.asm' -../../avr8\dict/appl_2k.inc(100): Including file '../../common\words/handler.asm' -../../avr8\dict/appl_2k.inc(101): Including file '../../common\words/catch.asm' -../../avr8\dict/appl_2k.inc(102): Including file '../../common\words/throw.asm' -../../avr8\dict/appl_2k.inc(104): Including file '../../common\words/cskip.asm' -../../avr8\dict/appl_2k.inc(105): Including file '../../common\words/cscan.asm' -../../avr8\dict/appl_2k.inc(106): Including file '../../common\words/accept.asm' -../../avr8\dict/appl_2k.inc(107): Including file '../../common\words/refill.asm' -../../avr8\dict/appl_2k.inc(108): Including file '../../common\words/char.asm' -../../avr8\dict/appl_2k.inc(109): Including file '../../common\words/number.asm' -../../avr8\dict/appl_2k.inc(110): Including file '../../common\words/q-sign.asm' -../../avr8\dict/appl_2k.inc(111): Including file '../../common\words/set-base.asm' -../../avr8\dict/appl_2k.inc(112): Including file '../../common\words/to-number.asm' -../../avr8\dict/appl_2k.inc(113): Including file '../../common\words/parse.asm' -../../avr8\dict/appl_2k.inc(114): Including file '../../common\words/source.asm' -../../avr8\dict/appl_2k.inc(115): Including file '../../common\words/slash-string.asm' -../../avr8\dict/appl_2k.inc(116): Including file '../../common\words/parse-name.asm' -../../avr8\dict/appl_2k.inc(117): Including file '../../common\words/find-xt.asm' -../../avr8\dict/appl_2k.inc(119): Including file '../../common\words/quit.asm' -../../avr8\dict/appl_2k.inc(120): Including file '../../common\words/prompt-ok.asm' -../../avr8\dict/appl_2k.inc(121): Including file '../../common\words/prompt-ready.asm' -../../avr8\dict/appl_2k.inc(122): Including file '../../common\words/prompt-error.asm' -../../avr8\dict/appl_2k.inc(123): Including file '../../avr8\words/pause.asm' -../../avr8\dict/appl_2k.inc(124): Including file '../../avr8\words/cold.asm' -../../avr8\dict/appl_2k.inc(125): Including file '../../common\words/warm.asm' -../../avr8\dict/appl_2k.inc(127): Including file '../../avr8\words/sp0.asm' -../../avr8\dict/appl_2k.inc(128): Including file '../../avr8\words/rp0.asm' -../../avr8\dict/appl_2k.inc(129): Including file '../../common\words/depth.asm' -../../avr8\dict/appl_2k.inc(130): Including file '../../common\words/recognize.asm' -../../avr8\dict/appl_2k.inc(131): Including file '../../avr8\words/forth-recognizer.asm' -../../avr8\dict/appl_2k.inc(132): Including file '../../common\words/interpret.asm' -../../avr8\dict/appl_2k.inc(133): Including file '../../common\words/rec-intnum.asm' -../../avr8\dict/appl_2k.inc(134): Including file '../../common\words/rec-find.asm' -../../avr8\dict/appl_2k.inc(135): Including file '../../common\words/dt-null.asm' -../../avr8\dict/appl_2k.inc(137): Including file '../../common\words/q-stack.asm' -../../avr8\dict/appl_2k.inc(138): Including file '../../common\words/ver.asm' -../../avr8\dict/appl_2k.inc(140): Including file '../../common\words/noop.asm' -../../avr8\dict/appl_2k.inc(141): Including file '../../avr8\words/unused.asm' -../../avr8\dict/appl_2k.inc(143): Including file '../../common\words/to.asm' -../../avr8\dict/appl_2k.inc(144): Including file '../../avr8\words/i-cellplus.asm' -../../avr8\dict/appl_2k.inc(146): Including file '../../avr8\words/edefer-fetch.asm' -../../avr8\dict/appl_2k.inc(147): Including file '../../avr8\words/edefer-store.asm' -../../avr8\dict/appl_2k.inc(148): Including file '../../common\words/rdefer-fetch.asm' -../../avr8\dict/appl_2k.inc(149): Including file '../../common\words/rdefer-store.asm' -../../avr8\dict/appl_2k.inc(150): Including file '../../common\words/udefer-fetch.asm' -../../avr8\dict/appl_2k.inc(151): Including file '../../common\words/udefer-store.asm' -../../avr8\dict/appl_2k.inc(152): Including file '../../common\words/defer-store.asm' -../../avr8\dict/appl_2k.inc(153): Including file '../../common\words/defer-fetch.asm' -../../avr8\dict/appl_2k.inc(154): Including file '../../avr8\words/do-defer.asm' -../../avr8\dict/appl_2k.inc(156): Including file '../../common\words/search-wordlist.asm' -../../avr8\dict/appl_2k.inc(157): Including file '../../common\words/traverse-wordlist.asm' -../../avr8\dict/appl_2k.inc(158): Including file '../../common\words/name2string.asm' -../../avr8\dict/appl_2k.inc(159): Including file '../../avr8\words/nfa2cfa.asm' -../../avr8\dict/appl_2k.inc(160): Including file '../../avr8\words/icompare.asm' -../../avr8\dict/appl_2k.inc(162): Including file '../../common\words/star.asm' -../../avr8\dict/appl_2k.inc(163): Including file '../../avr8\words/j.asm' -../../avr8\dict/appl_2k.inc(165): Including file '../../avr8\words/dabs.asm' -../../avr8\dict/appl_2k.inc(166): Including file '../../avr8\words/dnegate.asm' -../../avr8\dict/appl_2k.inc(167): Including file '../../avr8\words/cmove.asm' -../../avr8\dict/appl_2k.inc(168): Including file '../../common\words/2swap.asm' -../../avr8\dict/appl_2k.inc(170): Including file '../../common\words/tib.asm' -../../avr8\dict/appl_2k.inc(172): Including file '../../avr8\words/init-ram.asm' -../../avr8\dict/appl_2k.inc(173): Including file '../../common\words/bounds.asm' -../../avr8\dict/appl_2k.inc(174): Including file '../../common\words/s-to-d.asm' -../../avr8\dict/appl_2k.inc(175): Including file '../../avr8\words/to-body.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(106): Including file '../../avr8\dict/core_2k.inc' -../../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 = 96 - .equ CELLSIZE = 2 - .macro readflashcell - lsl zl - rol zh - lpm @0, Z+ - lpm @1, Z+ - .endmacro - .macro writeflashcell - lsl zl - rol zh - .endmacro - .set WANT_TIMER_COUNTER_0 = 0 - .set WANT_TIMER_COUNTER_1 = 0 - .set WANT_EXTERNAL_INTERRUPT = 0 - .set WANT_EEPROM = 0 - .set WANT_CPU = 0 - .set WANT_TIMER_COUNTER_2 = 0 - .set WANT_SPI = 0 - .set WANT_USART = 0 - .set WANT_TWI = 0 - .set WANT_ANALOG_COMPARATOR = 0 - .set WANT_AD_CONVERTER = 0 - .set WANT_JTAG = 0 - .set WANT_BOOT_LOAD = 0 - .set WANT_PORTA = 0 - .set WANT_PORTB = 0 - .set WANT_PORTC = 0 - .set WANT_PORTD = 0 - .set WANT_WATCHDOG = 0 - .equ intvecsize = 2 ; please verify; flash size: 16384 bytes - .equ pclen = 2 ; please verify - .overlap - .org 2 -000002 d11b rcall isr ; External Interrupt Request 0 - .org 4 -000004 d119 rcall isr ; External Interrupt Request 1 - .org 6 -000006 d117 rcall isr ; Timer/Counter2 Compare Match - .org 8 -000008 d115 rcall isr ; Timer/Counter2 Overflow - .org 10 -00000a d113 rcall isr ; Timer/Counter1 Capture Event - .org 12 -00000c d111 rcall isr ; Timer/Counter1 Compare Match A - .org 14 -00000e d10f rcall isr ; Timer/Counter1 Compare Match B - .org 16 -000010 d10d rcall isr ; Timer/Counter1 Overflow - .org 18 -000012 d10b rcall isr ; Timer/Counter0 Overflow - .org 20 -000014 d109 rcall isr ; Serial Transfer Complete - .org 22 -000016 d107 rcall isr ; USART, Rx Complete - .org 24 -000018 d105 rcall isr ; USART Data Register Empty - .org 26 -00001a d103 rcall isr ; USART, Tx Complete - .org 28 -00001c d101 rcall isr ; ADC Conversion Complete - .org 30 -00001e d0ff rcall isr ; EEPROM Ready - .org 32 -000020 d0fd rcall isr ; Analog Comparator - .org 34 -000022 d0fb rcall isr ; 2-wire Serial Interface - .org 36 -000024 d0f9 rcall isr ; External Interrupt Request 2 - .org 38 -000026 d0f7 rcall isr ; Timer/Counter0 Compare Match - .org 40 -000028 d0f5 rcall isr ; Store Program Memory Ready - .equ INTVECTORS = 21 - .nooverlap - - ; compatability layer (maybe empty) - .equ EEPE = EEWE - .equ EEMPE = EEMWE - - ; controller data area, environment query mcu-info - mcu_info: - mcu_ramsize: -000029 0400 .dw 1024 - mcu_eepromsize: -00002a 0200 .dw 512 - mcu_maxdp: -00002b 3800 .dw 14336 - mcu_numints: -00002c 0015 .dw 21 - mcu_name: -00002d 0008 .dw 8 -00002e 5441 -00002f 656d -000030 6167 -000031 3631 .db "ATmega16" - .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 = 8000000 - .set BAUD_MAXERROR = 30 - .equ TIMER_INT = OVF2addr - - .include "drivers/usart.asm" - - .equ BAUDRATE_LOW = UBRRL+$20 - .equ BAUDRATE_HIGH = UBRRH+$20 - .equ USART_C = UCSRC+$20 - .equ USART_B = UCSRB+$20 - .equ USART_A = UCSRA+$20 - .equ USART_DATA = UDR+$20 - .equ bm_USARTC_en = 1 << 7 - - ; some generic constants - .equ bm_USART_RXRD = 1 << RXC - .equ bm_USART_TXRD = 1 << UDRE - .equ bm_ENABLE_TX = 1 << TXEN - .equ bm_ENABLE_RX = 1 << RXEN - .equ bm_ENABLE_INT_RX = 1<rx-buf",0 -000037 0000 .dw VE_HEAD - .set VE_HEAD = VE_TO_RXBUF - XT_TO_RXBUF: -000038 0039 .dw PFA_rx_tobuf - PFA_rx_tobuf: -000039 2f08 mov temp0, tosl -00003a 9110 0070 lds temp1, usart_rx_in -00003c e6e0 ldi zl, low(usart_rx_data) -00003d e0f0 ldi zh, high(usart_rx_data) -00003e 0fe1 add zl, temp1 -00003f 1df3 adc zh, zeroh -000040 8300 st Z, temp0 -000041 9513 inc temp1 -000042 701f andi temp1,usart_rx_mask -000043 9310 0070 sts usart_rx_in, temp1 -000045 9189 -000046 9199 loadtos -000047 940c 1c05 jmp_ DO_NEXT - - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ; setup with - ; ' isr-rx URXCaddr int! - VE_ISR_RX: -000049 ff06 .dw $ff06 -00004a 7369 -00004b 2d72 -00004c 7872 .db "isr-rx" -00004d 0032 .dw VE_HEAD - .set VE_HEAD = VE_ISR_RX - XT_ISR_RX: -00004e 1c01 .dw DO_COLON - usart_rx_isr: -00004f 1c3d .dw XT_DOLITERAL -000050 002c .dw usart_data -000051 1c98 .dw XT_CFETCH -000052 1cb1 .dw XT_DUP -000053 1c3d .dw XT_DOLITERAL -000054 0003 .dw 3 -000055 1fe0 .dw XT_EQUAL -000056 1c36 .dw XT_DOCONDBRANCH -000057 0059 .dw usart_rx_isr1 -000058 0ae0 .dw XT_COLD - usart_rx_isr1: -000059 0038 .dw XT_TO_RXBUF -00005a 1c20 .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: -00005b 1c01 .dw DO_COLON - PFA_USART_INIT_RX_BUFFER: ; ( -- ) -00005c 1c3d -00005d 004e .dw XT_DOLITERAL, XT_ISR_RX -00005e 1c3d -00005f 0016 .dw XT_DOLITERAL, URXCaddr -000060 0213 .dw XT_INTSTORE - -000061 1c3d .dw XT_DOLITERAL -000062 0060 .dw usart_rx_data -000063 1c3d .dw XT_DOLITERAL -000064 0016 .dw usart_rx_size + 6 -000065 1d54 .dw XT_ZERO -000066 025d .dw XT_FILL -000067 1c20 .dw XT_EXIT - - ; ( -- c) - ; MCU - ; get 1 character from input queue, wait if needed using interrupt driver - VE_RX_BUFFER: -000068 ff06 .dw $ff06 -000069 7872 -00006a 622d -00006b 6675 .db "rx-buf" -00006c 0049 .dw VE_HEAD - .set VE_HEAD = VE_RX_BUFFER - XT_RX_BUFFER: -00006d 1c01 .dw DO_COLON - PFA_RX_BUFFER: -00006e 0088 .dw XT_RXQ_BUFFER -00006f 1c36 .dw XT_DOCONDBRANCH -000070 006e .dw PFA_RX_BUFFER -000071 1c3d .dw XT_DOLITERAL -000072 0071 .dw usart_rx_out -000073 1c98 .dw XT_CFETCH -000074 1cb1 .dw XT_DUP -000075 1c3d .dw XT_DOLITERAL -000076 0060 .dw usart_rx_data -000077 1d9d .dw XT_PLUS -000078 1c98 .dw XT_CFETCH -000079 1cc4 .dw XT_SWAP -00007a 1e2f .dw XT_1PLUS -00007b 1c3d .dw XT_DOLITERAL -00007c 000f .dw usart_rx_mask -00007d 1e13 .dw XT_AND -00007e 1c3d .dw XT_DOLITERAL -00007f 0071 .dw usart_rx_out -000080 1c8d .dw XT_CSTORE -000081 1c20 .dw XT_EXIT - - ; ( -- f) - ; MCU - ; check if unread characters are in the input queue - VE_RXQ_BUFFER: -000082 ff07 .dw $ff07 -000083 7872 -000084 2d3f -000085 7562 -000086 0066 .db "rx?-buf",0 -000087 0068 .dw VE_HEAD - .set VE_HEAD = VE_RXQ_BUFFER - XT_RXQ_BUFFER: -000088 1c01 .dw DO_COLON - PFA_RXQ_BUFFER: -000089 0ad8 .dw XT_PAUSE -00008a 1c3d .dw XT_DOLITERAL -00008b 0071 .dw usart_rx_out -00008c 1c98 .dw XT_CFETCH -00008d 1c3d .dw XT_DOLITERAL -00008e 0070 .dw usart_rx_in -00008f 1c98 .dw XT_CFETCH -000090 1d13 .dw XT_NOTEQUAL -000091 1c20 .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: -000092 ff07 .dw $ff07 -000093 7874 -000094 702d -000095 6c6f -000096 006c .db "tx-poll",0 -000097 0082 .dw VE_HEAD - .set VE_HEAD = VE_TX_POLL - XT_TX_POLL: -000098 1c01 .dw DO_COLON - PFA_TX_POLL: - ; wait for data ready -000099 00a6 .dw XT_TXQ_POLL -00009a 1c36 .dw XT_DOCONDBRANCH -00009b 0099 .dw PFA_TX_POLL - ; send to usart -00009c 1c3d .dw XT_DOLITERAL -00009d 002c .dw USART_DATA -00009e 1c8d .dw XT_CSTORE -00009f 1c20 .dw XT_EXIT - - ; ( -- f) MCU - ; MCU - ; check if a character can be send using register poll - VE_TXQ_POLL: -0000a0 ff08 .dw $ff08 -0000a1 7874 -0000a2 2d3f -0000a3 6f70 -0000a4 6c6c .db "tx?-poll" -0000a5 0092 .dw VE_HEAD - .set VE_HEAD = VE_TXQ_POLL - XT_TXQ_POLL: -0000a6 1c01 .dw DO_COLON - PFA_TXQ_POLL: -0000a7 0ad8 .dw XT_PAUSE -0000a8 1c3d .dw XT_DOLITERAL -0000a9 002b .dw USART_A -0000aa 1c98 .dw XT_CFETCH -0000ab 1c3d .dw XT_DOLITERAL -0000ac 0020 .dw bm_USART_TXRD -0000ad 1e13 .dw XT_AND -0000ae 1c20 .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: -0000af ff04 .dw $ff04 -0000b0 6275 -0000b1 7272 .db "ubrr" -0000b2 00a0 .dw VE_HEAD - .set VE_HEAD = VE_UBRR - XT_UBRR: -0000b3 1c6f .dw PFA_DOVALUE1 - PFA_UBRR: ; ( -- ) -0000b4 0082 .dw EE_UBRRVAL -0000b5 0c3b .dw XT_EDEFERFETCH -0000b6 0c45 .dw XT_EDEFERSTORE - .include "words/usart.asm" - - ; MCU - ; initialize usart - VE_USART: -0000b7 ff06 .dw $ff06 -0000b8 752b -0000b9 6173 -0000ba 7472 .db "+usart" -0000bb 00af .dw VE_HEAD - .set VE_HEAD = VE_USART - XT_USART: -0000bc 1c01 .dw DO_COLON - PFA_USART: ; ( -- ) - -0000bd 1c3d .dw XT_DOLITERAL -0000be 0098 .dw USART_B_VALUE -0000bf 1c3d .dw XT_DOLITERAL -0000c0 002a .dw USART_B -0000c1 1c8d .dw XT_CSTORE - -0000c2 1c3d .dw XT_DOLITERAL -0000c3 0006 .dw USART_C_VALUE -0000c4 1c3d .dw XT_DOLITERAL -0000c5 00c0 .dw USART_C | bm_USARTC_en -0000c6 1c8d .dw XT_CSTORE - -0000c7 00b3 .dw XT_UBRR -0000c8 1cb1 .dw XT_DUP -0000c9 1ef9 .dw XT_BYTESWAP -0000ca 1c3d .dw XT_DOLITERAL -0000cb 0040 .dw BAUDRATE_HIGH -0000cc 1c8d .dw XT_CSTORE -0000cd 1c3d .dw XT_DOLITERAL -0000ce 0029 .dw BAUDRATE_LOW -0000cf 1c8d .dw XT_CSTORE - .if XT_USART_INIT_RX!=0 -0000d0 005b .dw XT_USART_INIT_RX - .endif - .if XT_USART_INIT_TX!=0 - .endif - -0000d1 1c20 .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: -0000d2 ff08 .dw $ff08 -0000d3 7731 -0000d4 722e -0000d5 7365 -0000d6 7465 .db "1w.reset" -0000d7 00b7 .dw VE_HEAD - .set VE_HEAD = VE_OW_RESET - XT_OW_RESET: -0000d8 00d9 .dw PFA_OW_RESET - PFA_OW_RESET: -0000d9 939a -0000da 938a savetos - ; setup to output -0000db 9abc sbi OW_DDR, OW_BIT - ; Pull output low -0000dc 98c4 cbi OW_PORT, OW_BIT - ; Delay >480 usec -0000dd ece0 -0000de e0f3 -0000df 9731 -0000e0 f7f1 DELAY 480 - ; Critical timing period, disable interrupts. -0000e1 b71f in temp1, SREG -0000e2 94f8 cli - ; Pull output high -0000e3 9ac4 sbi OW_PORT, OW_BIT - ; make pin input, sends "1" -0000e4 98bc cbi OW_DDR, OW_BIT -0000e5 e8e0 -0000e6 e0f0 -0000e7 9731 -0000e8 f7f1 DELAY 64 ; delayB - ; Sample input pin, set TOS if input is zero -0000e9 b386 in tosl, OW_PIN -0000ea ff84 sbrs tosl, OW_BIT -0000eb ef9f ser tosh - ; End critical timing period, enable interrupts -0000ec bf1f out SREG, temp1 - ; release bus -0000ed 98bc cbi OW_DDR, OW_BIT -0000ee 98c4 cbi OW_PORT, OW_BIT - - ; Delay rest of 480 usec -0000ef e4e0 -0000f0 e0f3 -0000f1 9731 -0000f2 f7f1 DELAY 416 - ; we now have the result flag in TOS -0000f3 2f89 mov tosl, tosh -0000f4 940c 1c05 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: -0000f6 ff07 .dw $ff07 -0000f7 7731 -0000f8 732e -0000f9 6f6c -0000fa 0074 .db "1w.slot",0 -0000fb 00d2 .dw VE_HEAD - .set VE_HEAD = VE_OW_SLOT - XT_OW_SLOT: -0000fc 00fd .dw PFA_OW_SLOT - PFA_OW_SLOT: - ; pull low -0000fd 98c4 cbi OW_PORT, OW_BIT -0000fe 9abc sbi OW_DDR, OW_BIT - ; disable interrupts -0000ff b71f in temp1, SREG -000100 94f8 cli -000101 e0ec -000102 e0f0 -000103 9731 -000104 f7f1 DELAY 6 ; DELAY A - ; check bit -000105 9488 clc -000106 9587 ror tosl -000107 f410 brcc PFA_OW_SLOT0 ; a 0 keeps the bus low - ; release bus, a 1 is written -000108 9ac4 sbi OW_PORT, OW_BIT -000109 98bc cbi OW_DDR, OW_BIT - PFA_OW_SLOT0: - ; sample the input (no action required if zero) -00010a e1e2 -00010b e0f0 -00010c 9731 -00010d f7f1 DELAY 9 ; wait DELAY E to sample -00010e b306 in temp0, OW_PIN -00010f fd04 sbrc temp0, OW_BIT -000110 6880 ori tosl, $80 - -000111 e6e6 -000112 e0f0 -000113 9731 -000114 f7f1 DELAY 51 ; DELAY B -000115 9ac4 sbi OW_PORT, OW_BIT ; release bus -000116 98bc cbi OW_DDR, OW_BIT -000117 e0e4 -000118 e0f0 -000119 9731 -00011a f7f1 delay 2 - ; re-enable interrupts -00011b bf1f out SREG, temp1 -00011c 940c 1c05 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 0ae1 jmp_ PFA_COLD - - .org corepc - .include "drivers/generic-isr.asm" - - .eseg -000000 intvec: .byte INTVECTORS * CELLSIZE - .dseg -000072 intcnt: .byte INTVECTORS - .cseg - - ; interrupt routine gets called (again) by rcall! This gives the - ; address of the int-vector on the stack. - isr: -00011e 920a st -Y, r0 -00011f b60f in r0, SREG -000120 920a st -Y, r0 - .if (pclen==3) - .endif -000121 900f pop r0 -000122 900f pop r0 ; = intnum * intvectorsize + 1 (address following the rcall) -000123 940a dec r0 - .if intvecsize == 1 ; - .endif -000124 2cb0 mov isrflag, r0 -000125 93ff push zh -000126 93ef push zl -000127 e7e2 ldi zl, low(intcnt) -000128 e0f0 ldi zh, high(intcnt) -000129 9406 lsr r0 ; we use byte addresses in the counter array, not words -00012a 0de0 add zl, r0 -00012b 1df3 adc zh, zeroh -00012c 8000 ld r0, Z -00012d 9403 inc r0 -00012e 8200 st Z, r0 -00012f 91ef pop zl -000130 91ff pop zh - -000131 9009 ld r0, Y+ -000132 be0f out SREG, r0 -000133 9009 ld r0, Y+ -000134 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: -000135 ff02 .dw $ff02 -000136 2b6d .db "m+" -000137 00f6 .dw VE_HEAD - .set VE_HEAD = VE_MPLUS - XT_MPLUS: -000138 1c01 .dw DO_COLON - PFA_MPLUS: -000139 0dee .dw XT_S2D -00013a 019c .dw XT_DPLUS -00013b 1c20 .dw XT_EXIT - .include "words/ud-star.asm" - - .if cpu_msp430==1 - .endif - - .if cpu_avr8==1 - VE_UDSTAR: -00013c ff03 .dw $ff03 -00013d 6475 -../../common\words/ud-star.asm(9): warning: .cseg .db misalignment - padding zero byte -00013e 002a .db "ud*" -00013f 0135 .dw VE_HEAD - .set VE_HEAD = VE_UDSTAR - XT_UDSTAR: -000140 1c01 .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 + ; - -000141 1cb1 -000142 1cff -000143 1de0 -000144 1cd9 .DW XT_DUP,XT_TO_R,XT_UMSTAR,XT_DROP -000145 1cc4 -000146 1cf6 -000147 1de0 -000148 1ce1 -000149 1d9d -00014a 1c20 .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: -00014b ff04 .dw $ff04 -00014c 6d75 -00014d 7861 .db "umax" -00014e 013c .dw VE_HEAD - .set VE_HEAD = VE_UMAX - XT_UMAX: -00014f 1c01 .dw DO_COLON - PFA_UMAX: - .endif - -000150 05eb -000151 1d5c .DW XT_2DUP,XT_ULESS -000152 1c36 .dw XT_DOCONDBRANCH -000153 0155 DEST(UMAX1) -000154 1cc4 .DW XT_SWAP -000155 1cd9 UMAX1: .DW XT_DROP -000156 1c20 .dw XT_EXIT - .include "words/umin.asm" - - .if cpu_msp430==1 - .endif - - .if cpu_avr8==1 - VE_UMIN: -000157 ff04 .dw $ff04 -000158 6d75 -000159 6e69 .db "umin" -00015a 014b .dw VE_HEAD - .set VE_HEAD = VE_UMIN - XT_UMIN: -00015b 1c01 .dw DO_COLON - PFA_UMIN: - .endif -00015c 05eb -00015d 1d67 .DW XT_2DUP,XT_UGREATER -00015e 1c36 .dw XT_DOCONDBRANCH -00015f 0161 DEST(UMIN1) -000160 1cc4 .DW XT_SWAP -000161 1cd9 UMIN1: .DW XT_DROP -000162 1c20 .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: -000163 1c01 .dw DO_COLON - PFA_IMMEDIATEQ: -000164 1c3d .dw XT_DOLITERAL -000165 8000 .dw $8000 -000166 1e13 .dw XT_AND -000167 1d1a .dw XT_ZEROEQUAL -000168 1c36 .dw XT_DOCONDBRANCH -000169 016c DEST(IMMEDIATEQ1) -00016a 1fe7 .dw XT_ONE -00016b 1c20 .dw XT_EXIT - IMMEDIATEQ1: - ; not immediate -00016c 1d4b .dw XT_TRUE -00016d 1c20 .dw XT_EXIT - .include "words/name2flags.asm" - - ; Tools - ; get the flags from a name token - VE_NAME2FLAGS: -00016e ff0a .dw $ff0a -00016f 616e -000170 656d -000171 663e -000172 616c -000173 7367 .db "name>flags" -000174 0157 .dw VE_HEAD - .set VE_HEAD = VE_NAME2FLAGS - XT_NAME2FLAGS: -000175 1c01 .dw DO_COLON - PFA_NAME2FLAGS: -000176 1fcb .dw XT_FETCHI ; skip to link field -000177 1c3d .dw XT_DOLITERAL -000178 ff00 .dw $ff00 -000179 1e13 .dw XT_AND -00017a 1c20 .dw XT_EXIT - - .if AMFORTH_NRWW_SIZE > 8000 - .elif AMFORTH_NRWW_SIZE > 4000 - .elif AMFORTH_NRWW_SIZE > 2000 - .include "dict/appl_2k.inc" - - - ; Arithmetics - ; shift a double cell left - VE_D2STAR: -00017b ff03 .dw $ff03 -00017c 3264 -00017d 002a .db "d2*",0 -00017e 016e .dw VE_HEAD - .set VE_HEAD = VE_D2STAR - XT_D2STAR: -00017f 0180 .dw PFA_D2STAR - PFA_D2STAR: -000180 9109 ld temp0, Y+ -000181 9119 ld temp1, Y+ -000182 0f00 lsl temp0 -000183 1f11 rol temp1 -000184 1f88 rol tosl -000185 1f99 rol tosh -000186 931a st -Y, temp1 -000187 930a st -Y, temp0 -000188 940c 1c05 jmp_ DO_NEXT - .include "words/d-2slash.asm" - - ; Arithmetics - ; shift a double cell value right - VE_D2SLASH: -00018a ff03 .dw $ff03 -00018b 3264 -00018c 002f .db "d2/",0 -00018d 017b .dw VE_HEAD - .set VE_HEAD = VE_D2SLASH - XT_D2SLASH: -00018e 018f .dw PFA_D2SLASH - PFA_D2SLASH: -00018f 9109 ld temp0, Y+ -000190 9119 ld temp1, Y+ -000191 9595 asr tosh -000192 9587 ror tosl -000193 9517 ror temp1 -000194 9507 ror temp0 -000195 931a st -Y, temp1 -000196 930a st -Y, temp0 -000197 940c 1c05 jmp_ DO_NEXT - .include "words/d-plus.asm" - - ; Arithmetics - ; add 2 double cell values - VE_DPLUS: -000199 ff02 .dw $ff02 -00019a 2b64 .db "d+" -00019b 018a .dw VE_HEAD - .set VE_HEAD = VE_DPLUS - XT_DPLUS: -00019c 019d .dw PFA_DPLUS - PFA_DPLUS: -00019d 9129 ld temp2, Y+ -00019e 9139 ld temp3, Y+ - -00019f 90e9 ld temp4, Y+ -0001a0 90f9 ld temp5, Y+ -0001a1 9149 ld temp6, Y+ -0001a2 9159 ld temp7, Y+ - -0001a3 0f24 add temp2, temp6 -0001a4 1f35 adc temp3, temp7 -0001a5 1d8e adc tosl, temp4 -0001a6 1d9f adc tosh, temp5 - -0001a7 933a st -Y, temp3 -0001a8 932a st -Y, temp2 -0001a9 940c 1c05 jmp_ DO_NEXT - .include "words/d-minus.asm" - - ; Arithmetics - ; subtract d2 from d1 - VE_DMINUS: -0001ab ff02 .dw $ff02 -0001ac 2d64 .db "d-" -0001ad 0199 .dw VE_HEAD - .set VE_HEAD = VE_DMINUS - XT_DMINUS: -0001ae 01af .dw PFA_DMINUS - PFA_DMINUS: -0001af 9129 ld temp2, Y+ -0001b0 9139 ld temp3, Y+ - -0001b1 90e9 ld temp4, Y+ -0001b2 90f9 ld temp5, Y+ -0001b3 9149 ld temp6, Y+ -0001b4 9159 ld temp7, Y+ - -0001b5 1b42 sub temp6, temp2 -0001b6 0b53 sbc temp7, temp3 -0001b7 0ae8 sbc temp4, tosl -0001b8 0af9 sbc temp5, tosh - -0001b9 935a st -Y, temp7 -0001ba 934a st -Y, temp6 -0001bb 01c7 movw tosl, temp4 -0001bc 940c 1c05 jmp_ DO_NEXT - .include "words/d-invert.asm" - - ; Arithmetics - ; invert all bits in the double cell value - VE_DINVERT: -0001be ff07 .dw $ff07 -0001bf 6964 -0001c0 766e -0001c1 7265 -0001c2 0074 .db "dinvert",0 -0001c3 01ab .dw VE_HEAD - .set VE_HEAD = VE_DINVERT - XT_DINVERT: -0001c4 01c5 .dw PFA_DINVERT - PFA_DINVERT: -0001c5 9109 ld temp0, Y+ -0001c6 9119 ld temp1, Y+ -0001c7 9580 com tosl -0001c8 9590 com tosh -0001c9 9500 com temp0 -0001ca 9510 com temp1 -0001cb 931a st -Y, temp1 -0001cc 930a st -Y, temp0 -0001cd 940c 1c05 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: -0001cf ff02 .dw $ff02 -0001d0 2e75 .db "u." -0001d1 01be .dw VE_HEAD - .set VE_HEAD = VE_UDOT - XT_UDOT: -0001d2 1c01 .dw DO_COLON - PFA_UDOT: - .endif -0001d3 1d54 .dw XT_ZERO -0001d4 07b1 .dw XT_UDDOT -0001d5 1c20 .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: -0001d6 ff03 .dw $ff03 -0001d7 2e75 -0001d8 0072 .db "u.r",0 -0001d9 01cf .dw VE_HEAD - .set VE_HEAD = VE_UDOTR - XT_UDOTR: -0001da 1c01 .dw DO_COLON - PFA_UDOTR: - .endif -0001db 1d54 .dw XT_ZERO -0001dc 1cc4 .dw XT_SWAP -0001dd 07ba .dw XT_UDDOTR -0001de 1c20 .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: -0001df ff0d .dw $ff0d -0001e0 6873 -0001e1 776f -0001e2 772d -0001e3 726f -0001e4 6c64 -0001e5 7369 -0001e6 0074 .db "show-wordlist",0 -0001e7 01d6 .dw VE_HEAD - .set VE_HEAD = VE_SHOWWORDLIST - XT_SHOWWORDLIST: -0001e8 1c01 .dw DO_COLON - PFA_SHOWWORDLIST: - .endif -0001e9 1c3d .dw XT_DOLITERAL -0001ea 01ee .dw XT_SHOWWORD -0001eb 1cc4 .dw XT_SWAP -0001ec 0cde .dw XT_TRAVERSEWORDLIST -0001ed 1c20 .dw XT_EXIT - - .if cpu_msp430==1 - .endif - - .if cpu_avr8==1 - XT_SHOWWORD: -0001ee 1c01 .dw DO_COLON - PFA_SHOWWORD: - .endif -0001ef 0cf9 .dw XT_NAME2STRING -0001f0 0827 .dw XT_ITYPE -0001f1 0869 .dw XT_SPACE ; ( -- addr n) -0001f2 1d4b .dw XT_TRUE -0001f3 1c20 .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: -0001f4 ff05 .dw $ff05 -0001f5 6f77 -0001f6 6472 -0001f7 0073 .db "words",0 -0001f8 01df .dw VE_HEAD - .set VE_HEAD = VE_WORDS - XT_WORDS: -0001f9 1c01 .dw DO_COLON - PFA_WORDS: - .endif -0001fa 1c3d .dw XT_DOLITERAL -0001fb 0042 .dw CFG_ORDERLISTLEN+2 -0001fc 1f5f .dw XT_FETCHE -0001fd 01e8 .dw XT_SHOWWORDLIST -0001fe 1c20 .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: -0001ff ff04 .dw $ff04 -000200 692b -000201 746e .db "+int" -000202 01f4 .dw VE_HEAD - .set VE_HEAD = VE_INTON - XT_INTON: -000203 0204 .dw PFA_INTON - PFA_INTON: -000204 9478 sei -000205 940c 1c05 jmp_ DO_NEXT - .include "words/int-off.asm" - - ; Interrupt - ; turns off all interrupts - VE_INTOFF: -000207 ff04 .dw $ff04 -000208 692d -000209 746e .db "-int" -00020a 01ff .dw VE_HEAD - .set VE_HEAD = VE_INTOFF - XT_INTOFF: -00020b 020c .dw PFA_INTOFF - PFA_INTOFF: -00020c 94f8 cli -00020d 940c 1c05 jmp_ DO_NEXT - .include "words/int-store.asm" - - ; Interrupt - ; stores XT as interrupt vector i - VE_INTSTORE: -00020f ff04 .dw $ff04 -000210 6e69 -000211 2174 .db "int!" -000212 0207 .dw VE_HEAD - .set VE_HEAD = VE_INTSTORE - XT_INTSTORE: -000213 1c01 .dw DO_COLON - PFA_INTSTORE: -000214 1c3d .dw XT_DOLITERAL -000215 0000 .dw intvec -000216 1d9d .dw XT_PLUS -000217 1f3b .dw XT_STOREE -000218 1c20 .dw XT_EXIT - .include "words/int-fetch.asm" - - ; Interrupt - ; fetches XT from interrupt vector i - VE_INTFETCH: -000219 ff04 .dw $ff04 -00021a 6e69 -00021b 4074 .db "int@" -00021c 020f .dw VE_HEAD - .set VE_HEAD = VE_INTFETCH - XT_INTFETCH: -00021d 1c01 .dw DO_COLON - PFA_INTFETCH: -00021e 1c3d .dw XT_DOLITERAL -00021f 0000 .dw intvec -000220 1d9d .dw XT_PLUS -000221 1f5f .dw XT_FETCHE -000222 1c20 .dw XT_EXIT - .include "words/int-trap.asm" - - ; Interrupt - ; trigger an interrupt - VE_INTTRAP: -000223 ff08 .dw $ff08 -000224 6e69 -000225 2d74 -000226 7274 -000227 7061 .db "int-trap" -000228 0219 .dw VE_HEAD - .set VE_HEAD = VE_INTTRAP - XT_INTTRAP: -000229 022a .dw PFA_INTTRAP - PFA_INTTRAP: -00022a 2eb8 mov isrflag, tosl -00022b 9189 -00022c 9199 loadtos -00022d 940c 1c05 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: -00022f 1c01 .dw DO_COLON - PFA_ISREXEC: -000230 021d .dw XT_INTFETCH -000231 1c2a .dw XT_EXECUTE -000232 0234 .dw XT_ISREND -000233 1c20 .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: -000234 0235 .dw PFA_ISREND - PFA_ISREND: -000235 d002 rcall PFA_ISREND1 ; clear the interrupt flag for the controller -000236 940c 1c05 jmp_ DO_NEXT - PFA_ISREND1: -000238 9518 reti - .endif - - .include "words/pick.asm" - - .if cpu_msp430==1 - .endif - - .if cpu_avr8==1 - VE_PICK: -000239 ff04 .dw $ff04 -00023a 6970 -00023b 6b63 .db "pick" -00023c 0223 .dw VE_HEAD - .set VE_HEAD = VE_PICK - XT_PICK: -00023d 1c01 .dw DO_COLON - PFA_PICK: - .endif -00023e 1e2f .dw XT_1PLUS -00023f 05dd .dw XT_CELLS -000240 1e8d .dw XT_SP_FETCH -000241 1d9d .dw XT_PLUS -000242 1c79 .dw XT_FETCH -000243 1c20 .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: -000244 0002 .dw $0002 -000245 222e .db ".",$22 -000246 0239 .dw VE_HEAD - .set VE_HEAD = VE_DOTSTRING - XT_DOTSTRING: -000247 1c01 .dw DO_COLON - PFA_DOTSTRING: - .endif -000248 024f .dw XT_SQUOTE -000249 02a3 .dw XT_COMPILE -00024a 0827 .dw XT_ITYPE -00024b 1c20 .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: -00024c 0002 .dw $0002 -00024d 2273 .db "s",$22 -00024e 0244 .dw VE_HEAD - .set VE_HEAD = VE_SQUOTE - XT_SQUOTE: -00024f 1c01 .dw DO_COLON - PFA_SQUOTE: - .endif -000250 1c3d .dw XT_DOLITERAL -000251 0022 .dw 34 ; 0x22 -000252 0a0e .dw XT_PARSE ; ( -- addr n) -000253 05d0 .dw XT_STATE -000254 1c79 .dw XT_FETCH -000255 1c36 .dw XT_DOCONDBRANCH -000256 0258 DEST(PFA_SQUOTE1) -000257 02cf .dw XT_SLITERAL - PFA_SQUOTE1: -000258 1c20 .dw XT_EXIT - - .include "words/fill.asm" - - ; Memory - ; fill u bytes memory beginning at a-addr with character c - VE_FILL: -000259 ff04 .dw $ff04 -00025a 6966 -00025b 6c6c .db "fill" -00025c 024c .dw VE_HEAD - .set VE_HEAD = VE_FILL - XT_FILL: -00025d 1c01 .dw DO_COLON - PFA_FILL: -00025e 1ce1 .dw XT_ROT -00025f 1ce1 .dw XT_ROT -000260 1cb9 -000261 1c36 .dw XT_QDUP,XT_DOCONDBRANCH -000262 026a DEST(PFA_FILL2) -000263 0de5 .dw XT_BOUNDS -000264 1e9b .dw XT_DODO - PFA_FILL1: -000265 1cb1 .dw XT_DUP -000266 1eac .dw XT_I -000267 1c8d .dw XT_CSTORE ; ( -- c c-addr) -000268 1ec9 .dw XT_DOLOOP -000269 0265 .dw PFA_FILL1 - PFA_FILL2: -00026a 1cd9 .dw XT_DROP -00026b 1c20 .dw XT_EXIT - .include "dict/compiler1.inc" - - .include "words/newest.asm" - - ; System Variable - ; system state - VE_NEWEST: -00026c ff06 .dw $ff06 -00026d 656e -00026e 6577 -00026f 7473 .db "newest" -000270 0259 .dw VE_HEAD - .set VE_HEAD = VE_NEWEST - XT_NEWEST: -000271 1c48 .dw PFA_DOVARIABLE - PFA_NEWEST: -000272 0087 .dw ram_newest - - .dseg -000087 ram_newest: .byte 4 - .include "words/latest.asm" - - ; System Variable - ; system state - VE_LATEST: -000273 ff06 .dw $ff06 -000274 616c -000275 6574 -000276 7473 .db "latest" -000277 026c .dw VE_HEAD - .set VE_HEAD = VE_LATEST - XT_LATEST: -000278 1c48 .dw PFA_DOVARIABLE - PFA_LATEST: -000279 008b .dw ram_latest - - .dseg -00008b 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: -00027a ff08 .dw $ff08 -00027b 6328 -00027c 6572 -00027d 7461 -00027e 2965 .db "(create)" -00027f 0273 .dw VE_HEAD - .set VE_HEAD = VE_DOCREATE - XT_DOCREATE: -000280 1c01 .dw DO_COLON - PFA_DOCREATE: - .endif -000281 0a3b -000282 03d7 .DW XT_PARSENAME,XT_WLSCOPE ; ( -- addr len wid) -000283 1cb1 -000284 0271 -000285 05e3 -000286 1c81 .DW XT_DUP,XT_NEWEST,XT_CELLPLUS,XT_STORE ; save the wid -000287 03bc -000288 0271 -000289 1c81 .DW XT_HEADER,XT_NEWEST,XT_STORE ; save the nt -00028a 1c20 .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: -00028b 0001 .dw $0001 -00028c 005c .db $5c,0 -00028d 027a .dw VE_HEAD - .set VE_HEAD = VE_BACKSLASH - XT_BACKSLASH: -00028e 1c01 .dw DO_COLON - PFA_BACKSLASH: - .endif -00028f 0a22 .dw XT_SOURCE -000290 1cf0 .dw XT_NIP -000291 0604 .dw XT_TO_IN -000292 1c81 .dw XT_STORE -000293 1c20 .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: -000294 0001 .dw $0001 -000295 0028 .db "(" ,0 -000296 028b .dw VE_HEAD - .set VE_HEAD = VE_LPAREN - XT_LPAREN: -000297 1c01 .dw DO_COLON - PFA_LPAREN: - .endif -000298 1c3d .dw XT_DOLITERAL -000299 0029 .dw ')' -00029a 0a0e .dw XT_PARSE -00029b 05f4 .dw XT_2DROP -00029c 1c20 .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: -00029d ff07 .dw $ff07 -00029e 6f63 -00029f 706d -0002a0 6c69 -0002a1 0065 .db "compile",0 -0002a2 0294 .dw VE_HEAD - .set VE_HEAD = VE_COMPILE - XT_COMPILE: -0002a3 1c01 .dw DO_COLON - PFA_COMPILE: - .endif -0002a4 1cf6 .dw XT_R_FROM -0002a5 1cb1 .dw XT_DUP -0002a6 0c32 .dw XT_ICELLPLUS -0002a7 1cff .dw XT_TO_R -0002a8 1fcb .dw XT_FETCHI -0002a9 02ae .dw XT_COMMA -0002aa 1c20 .dw XT_EXIT - .include "words/comma.asm" - - ; Dictionary - ; compile 16 bit into flash at DP - VE_COMMA: -0002ab ff01 .dw $ff01 -0002ac 002c .db ',',0 ; , -0002ad 029d .dw VE_HEAD - .set VE_HEAD = VE_COMMA - XT_COMMA: -0002ae 1c01 .dw DO_COLON - PFA_COMMA: -0002af 0634 .dw XT_DP -0002b0 1f73 .dw XT_STOREI -0002b1 0634 .dw XT_DP -0002b2 1e2f .dw XT_1PLUS -0002b3 0c20 .dw XT_DOTO -0002b4 0635 .dw PFA_DP -0002b5 1c20 .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: -0002b6 0003 .dw $0003 -0002b7 275b -0002b8 005d .db "[']",0 -0002b9 02ab .dw VE_HEAD - .set VE_HEAD = VE_BRACKETTICK - XT_BRACKETTICK: -0002ba 1c01 .dw DO_COLON - PFA_BRACKETTICK: - .endif -0002bb 0891 .dw XT_TICK -0002bc 02c4 .dw XT_LITERAL -0002bd 1c20 .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: -0002be 0007 .dw $0007 -0002bf 696c -0002c0 6574 -0002c1 6172 -0002c2 006c .db "literal",0 -0002c3 02b6 .dw VE_HEAD - .set VE_HEAD = VE_LITERAL - XT_LITERAL: -0002c4 1c01 .dw DO_COLON - PFA_LITERAL: - .endif -0002c5 02a3 .DW XT_COMPILE -0002c6 1c3d .DW XT_DOLITERAL -0002c7 02ae .DW XT_COMMA -0002c8 1c20 .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: -0002c9 0008 .dw $0008 -0002ca 6c73 -0002cb 7469 -0002cc 7265 -0002cd 6c61 .db "sliteral" -0002ce 02be .dw VE_HEAD - .set VE_HEAD = VE_SLITERAL - XT_SLITERAL: -0002cf 1c01 .dw DO_COLON - PFA_SLITERAL: - .endif -0002d0 02a3 .dw XT_COMPILE -0002d1 07f4 .dw XT_DOSLITERAL ; ( -- addr n) -0002d2 0802 .dw XT_SCOMMA -0002d3 1c20 .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: -0002d4 1c01 .dw DO_COLON - PFA_GMARK: -0002d5 0634 .dw XT_DP -0002d6 02a3 .dw XT_COMPILE -0002d7 ffff .dw -1 ; ffff does not erase flash -0002d8 1c20 .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: -0002d9 1c01 .dw DO_COLON - PFA_GRESOLVE: -0002da 0bde .dw XT_QSTACK -0002db 0634 .dw XT_DP -0002dc 1cc4 .dw XT_SWAP -0002dd 1f73 .dw XT_STOREI -0002de 1c20 .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: -00036d 1c01 .dw DO_COLON - PFA_QDOCHECK: - .endif -00036e 05eb .dw XT_2DUP -00036f 1fe0 .dw XT_EQUAL -000370 1cb1 .dw XT_DUP -000371 1cff .dw XT_TO_R -000372 1c36 .dw XT_DOCONDBRANCH -000373 0375 DEST(PFA_QDOCHECK1) -000374 05f4 .dw XT_2DROP - PFA_QDOCHECK1: -000375 1cf6 .dw XT_R_FROM -000376 1dfd .dw XT_INVERT -000377 1c20 .dw XT_EXIT - .include "words/endloop.asm" - - .if cpu_msp430==1 - .endif - - .if cpu_avr8==1 - VE_ENDLOOP: -000378 ff07 .dw $ff07 -000379 6e65 -00037a 6c64 -00037b 6f6f -00037c 0070 .db "endloop",0 -00037d 0361 .dw VE_HEAD - .set VE_HEAD = VE_ENDLOOP - XT_ENDLOOP: -00037e 1c01 .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. - -00037f 02e2 .DW XT_LRESOLVE -000380 038b -000381 1cb9 -000382 1c36 LOOP1: .DW XT_L_FROM,XT_QDUP,XT_DOCONDBRANCH -000383 0387 DEST(LOOP2) -000384 0307 .DW XT_THEN -000385 1c2f .dw XT_DOBRANCH -000386 0380 DEST(LOOP1) -000387 1c20 LOOP2: .DW XT_EXIT - ; leave address stack - .include "words/l-from.asm" - - .if cpu_msp430==1 - .endif - - .if cpu_avr8==1 - VE_L_FROM: -000388 ff02 .dw $ff02 -000389 3e6c .db "l>" -00038a 0378 .dw VE_HEAD - .set VE_HEAD = VE_L_FROM - XT_L_FROM: -00038b 1c01 .dw DO_COLON - PFA_L_FROM: - - .endif - ;Z L> -- x L: x -- move from leave stack - ; LP @ @ -2 LP +! ; - -00038c 03aa .dw XT_LP -00038d 1c79 .dw XT_FETCH -00038e 1c79 .dw XT_FETCH -00038f 1c3d .dw XT_DOLITERAL -000390 fffe .dw -2 -000391 03aa .dw XT_LP -000392 1e65 .dw XT_PLUSSTORE -000393 1c20 .dw XT_EXIT - .include "words/to-l.asm" - - .if cpu_msp430==1 - .endif - - .if cpu_avr8==1 - VE_TO_L: -000394 ff02 .dw $ff02 -000395 6c3e .db ">l" -000396 0388 .dw VE_HEAD - .set VE_HEAD = VE_TO_L - XT_TO_L: -000397 1c01 .dw DO_COLON - PFA_TO_L: - .endif - ;Z >L x -- L: -- x move to leave stack - ; CELL LP +! LP @ ! ; (L stack grows up) - -000398 1fec .dw XT_TWO -000399 03aa .dw XT_LP -00039a 1e65 .dw XT_PLUSSTORE -00039b 03aa .dw XT_LP -00039c 1c79 .dw XT_FETCH -00039d 1c81 .dw XT_STORE -00039e 1c20 .dw XT_EXIT - .include "words/lp0.asm" - - ; Stack - ; start address of leave stack - VE_LP0: -00039f ff03 .dw $ff03 -0003a0 706c -0003a1 0030 .db "lp0",0 -0003a2 0394 .dw VE_HEAD - .set VE_HEAD = VE_LP0 - XT_LP0: -0003a3 1c6f .dw PFA_DOVALUE1 - PFA_LP0: -0003a4 0036 .dw CFG_LP0 -0003a5 0c3b .dw XT_EDEFERFETCH -0003a6 0c45 .dw XT_EDEFERSTORE - .include "words/lp.asm" - - ; System Variable - ; leave stack pointer - VE_LP: -0003a7 ff02 .dw $ff02 -0003a8 706c .db "lp" -0003a9 039f .dw VE_HEAD - .set VE_HEAD = VE_LP - XT_LP: -0003aa 1c48 .dw PFA_DOVARIABLE - PFA_LP: -0003ab 008d .dw ram_lp - - .dseg -00008d 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: -0003ac ff06 .dw $ff06 -0003ad 7263 -0003ae 6165 -0003af 6574 .db "create" -0003b0 03a7 .dw VE_HEAD - .set VE_HEAD = VE_CREATE - XT_CREATE: -0003b1 1c01 .dw DO_COLON - PFA_CREATE: - .endif -0003b2 0280 .dw XT_DOCREATE -0003b3 03e0 .dw XT_REVEAL -0003b4 02a3 .dw XT_COMPILE -0003b5 1c52 .dw PFA_DOCONSTANT -0003b6 1c20 .dw XT_EXIT - .include "words/header.asm" - - ; Compiler - ; creates the vocabulary header without XT and data field (PF) in the wordlist wid - VE_HEADER: -0003b7 ff06 .dw $ff06 -0003b8 6568 -0003b9 6461 -0003ba 7265 .db "header" -0003bb 03ac .dw VE_HEAD - .set VE_HEAD = VE_HEADER - XT_HEADER: -0003bc 1c01 .dw DO_COLON - PFA_HEADER: -0003bd 0634 .dw XT_DP ; the new Name Field -0003be 1cff .dw XT_TO_R -0003bf 1cff .dw XT_TO_R ; ( R: NFA WID ) -0003c0 1cb1 .dw XT_DUP -0003c1 1d28 .dw XT_GREATERZERO -0003c2 1c36 .dw XT_DOCONDBRANCH -0003c3 03ce .dw PFA_HEADER1 -0003c4 1cb1 .dw XT_DUP -0003c5 1c3d .dw XT_DOLITERAL -0003c6 ff00 .dw $ff00 ; all flags are off (e.g. immediate) -0003c7 1e1c .dw XT_OR -0003c8 0806 .dw XT_DOSCOMMA - ; make the link to the previous entry in this wordlist -0003c9 1cf6 .dw XT_R_FROM -0003ca 1f5f .dw XT_FETCHE -0003cb 02ae .dw XT_COMMA -0003cc 1cf6 .dw XT_R_FROM -0003cd 1c20 .dw XT_EXIT - - PFA_HEADER1: - ; -16: attempt to use zero length string as a name -0003ce 1c3d .dw XT_DOLITERAL -0003cf fff0 .dw -16 -0003d0 08c8 .dw XT_THROW - - .include "words/wlscope.asm" - - ; Compiler - ; dynamically place a word in a wordlist. The word name may be changed. - VE_WLSCOPE: -0003d1 ff07 .dw $ff07 -0003d2 6c77 -0003d3 6373 -0003d4 706f -0003d5 0065 .db "wlscope",0 -0003d6 03b7 .dw VE_HEAD - .set VE_HEAD = VE_WLSCOPE - XT_WLSCOPE: -0003d7 0c9a .dw PFA_DODEFER1 - PFA_WLSCOPE: -0003d8 0032 .dw CFG_WLSCOPE -0003d9 0c3b .dw XT_EDEFERFETCH -0003da 0c45 .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: -0003db ff06 .dw $ff06 -0003dc 6572 -0003dd 6576 -0003de 6c61 .db "reveal" -0003df 03d1 .dw VE_HEAD - .set VE_HEAD = VE_REVEAL - XT_REVEAL: -0003e0 1c01 .dw DO_COLON - PFA_REVEAL: - .endif -0003e1 0271 -0003e2 05e3 -0003e3 1c79 .DW XT_NEWEST,XT_CELLPLUS,XT_FETCH ; only if wordlist is in use -0003e4 1cb9 -0003e5 1c36 .DW XT_QDUP,XT_DOCONDBRANCH -0003e6 03eb DEST(REVEAL1) -0003e7 0271 -0003e8 1c79 -0003e9 1cc4 -0003ea 1f3b .DW XT_NEWEST,XT_FETCH,XT_SWAP,XT_STOREE - ; .DW XT_ZERO,XT_NEWEST,XT_CELLPLUS,XT_STORE ; clean wordlist entry - REVEAL1: -0003eb 1c20 .DW XT_EXIT - .include "words/does.asm" - - ; Compiler - ; organize the XT replacement to call other colon code - VE_DOES: -0003ec 0005 .dw $0005 -0003ed 6f64 -0003ee 7365 -0003ef 003e .db "does>",0 -0003f0 03db .dw VE_HEAD - .set VE_HEAD = VE_DOES - XT_DOES: -0003f1 1c01 .dw DO_COLON - PFA_DOES: -0003f2 02a3 .dw XT_COMPILE -0003f3 0404 .dw XT_DODOES -0003f4 02a3 .dw XT_COMPILE ; create a code snippet to be used in an embedded XT -0003f5 940e .dw $940e ; the address of this compiled -0003f6 02a3 .dw XT_COMPILE ; code will replace the XT of the -0003f7 03f9 .dw DO_DODOES ; word that CREATE created -0003f8 1c20 .dw XT_EXIT ; - - DO_DODOES: ; ( -- PFA ) -0003f9 939a -0003fa 938a savetos -0003fb 01cb movw tosl, wl -0003fc 9601 adiw tosl, 1 - ; the following takes the address from a real uC-call - .if (pclen==3) - .endif -0003fd 917f pop wh -0003fe 916f pop wl - -0003ff 93bf push XH -000400 93af push XL -000401 01db movw XL, wl -000402 940c 1c05 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: -000404 1c01 .dw DO_COLON - PFA_DODOES: -000405 1cf6 .dw XT_R_FROM -000406 0271 .dw XT_NEWEST -000407 05e3 .dw XT_CELLPLUS -000408 1c79 .dw XT_FETCH -000409 1f5f .dw XT_FETCHE -00040a 0d05 .dw XT_NFA2CFA -00040b 1f73 .dw XT_STOREI -00040c 1c20 .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: -00040d ff01 .dw $ff01 -00040e 003a .db ":",0 -00040f 03ec .dw VE_HEAD - .set VE_HEAD = VE_COLON - XT_COLON: -000410 1c01 .dw DO_COLON - PFA_COLON: - .endif -000411 0280 .dw XT_DOCREATE -000412 041b .dw XT_COLONNONAME -000413 1cd9 .dw XT_DROP -000414 1c20 .dw XT_EXIT - .include "words/colon-noname.asm" - - ; Compiler - ; create an unnamed entry in the dictionary, XT is DO_COLON - VE_COLONNONAME: -000415 ff07 .dw $ff07 -000416 6e3a -000417 6e6f -000418 6d61 -000419 0065 .db ":noname",0 -00041a 040d .dw VE_HEAD - .set VE_HEAD = VE_COLONNONAME - XT_COLONNONAME: -00041b 1c01 .dw DO_COLON - PFA_COLONNONAME: -00041c 0634 .dw XT_DP -00041d 1cb1 .dw XT_DUP -00041e 0278 .dw XT_LATEST -00041f 1c81 .dw XT_STORE - -000420 02a3 .dw XT_COMPILE -000421 1c01 .dw DO_COLON - -000422 0430 .dw XT_RBRACKET -000423 1c20 .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: -000424 0001 .dw $0001 -000425 003b .db $3b,0 -000426 0415 .dw VE_HEAD - .set VE_HEAD = VE_SEMICOLON - XT_SEMICOLON: -000427 1c01 .dw DO_COLON - PFA_SEMICOLON: - .endif -000428 02a3 .dw XT_COMPILE -000429 1c20 .dw XT_EXIT -00042a 0438 .dw XT_LBRACKET -00042b 03e0 .dw XT_REVEAL -00042c 1c20 .dw XT_EXIT - .include "words/right-bracket.asm" - - ; Compiler - ; enter compiler mode - - .if cpu_msp430==1 - .endif - - .if cpu_avr8==1 - VE_RBRACKET: -00042d ff01 .dw $ff01 -00042e 005d .db "]",0 -00042f 0424 .dw VE_HEAD - .set VE_HEAD = VE_RBRACKET - XT_RBRACKET: -000430 1c01 .dw DO_COLON - PFA_RBRACKET: - .endif -000431 1fe7 .dw XT_ONE -000432 05d0 .dw XT_STATE -000433 1c81 .dw XT_STORE -000434 1c20 .dw XT_EXIT - .include "words/left-bracket.asm" - - ; Compiler - ; enter interpreter mode - - .if cpu_msp430==1 - .endif - - .if cpu_avr8==1 - VE_LBRACKET: -000435 0001 .dw $0001 -000436 005b .db "[",0 -000437 042d .dw VE_HEAD - .set VE_HEAD = VE_LBRACKET - XT_LBRACKET: -000438 1c01 .dw DO_COLON - PFA_LBRACKET: - .endif -000439 1d54 .dw XT_ZERO -00043a 05d0 .dw XT_STATE -00043b 1c81 .dw XT_STORE -00043c 1c20 .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: -00043d ff08 .dw $ff08 -00043e 6176 -00043f 6972 -000440 6261 -000441 656c .db "variable" -000442 0435 .dw VE_HEAD - .set VE_HEAD = VE_VARIABLE - XT_VARIABLE: -000443 1c01 .dw DO_COLON - PFA_VARIABLE: - .endif -000444 0645 .dw XT_HERE -000445 044f .dw XT_CONSTANT -000446 1fec .dw XT_TWO -000447 064e .dw XT_ALLOT -000448 1c20 .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: -000449 ff08 .dw $ff08 -00044a 6f63 -00044b 736e -00044c 6174 -00044d 746e .db "constant" -00044e 043d .dw VE_HEAD - .set VE_HEAD = VE_CONSTANT - XT_CONSTANT: -00044f 1c01 .dw DO_COLON - PFA_CONSTANT: - .endif -000450 0280 .dw XT_DOCREATE -000451 03e0 .dw XT_REVEAL -000452 02a3 .dw XT_COMPILE -000453 1c48 .dw PFA_DOVARIABLE -000454 02ae .dw XT_COMMA -000455 1c20 .dw XT_EXIT - .include "words/user.asm" - - ; Compiler - ; create a dictionary entry for a user variable at offset n - VE_USER: -000456 ff04 .dw $ff04 -000457 7375 -000458 7265 .db "user" -000459 0449 .dw VE_HEAD - .set VE_HEAD = VE_USER - XT_USER: -00045a 1c01 .dw DO_COLON - PFA_USER: -00045b 0280 .dw XT_DOCREATE -00045c 03e0 .dw XT_REVEAL - -00045d 02a3 .dw XT_COMPILE -00045e 1c58 .dw PFA_DOUSER -00045f 02ae .dw XT_COMMA -000460 1c20 .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: -000461 0007 .dw $0007 -000462 6572 -000463 7563 -000464 7372 -000465 0065 .db "recurse",0 -000466 0456 .dw VE_HEAD - .set VE_HEAD = VE_RECURSE - XT_RECURSE: -000467 1c01 .dw DO_COLON - PFA_RECURSE: - .endif -000468 0278 .dw XT_LATEST -000469 1c79 .dw XT_FETCH -00046a 02ae .dw XT_COMMA -00046b 1c20 .dw XT_EXIT - .include "words/immediate.asm" - - ; Compiler - ; set immediate flag for the most recent word definition - VE_IMMEDIATE: -00046c ff09 .dw $ff09 -00046d 6d69 -00046e 656d -00046f 6964 -000470 7461 -000471 0065 .db "immediate",0 -000472 0461 .dw VE_HEAD - .set VE_HEAD = VE_IMMEDIATE - XT_IMMEDIATE: -000473 1c01 .dw DO_COLON - PFA_IMMEDIATE: -000474 0515 .dw XT_GET_CURRENT -000475 1f5f .dw XT_FETCHE -000476 1cb1 .dw XT_DUP -000477 1fcb .dw XT_FETCHI -000478 1c3d .dw XT_DOLITERAL -000479 7fff .dw $7fff -00047a 1e13 .dw XT_AND -00047b 1cc4 .dw XT_SWAP -00047c 1f73 .dw XT_STOREI -00047d 1c20 .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: -00047e 0006 .dw $0006 -00047f 635b -000480 6168 -000481 5d72 .db "[char]" -000482 046c .dw VE_HEAD - .set VE_HEAD = VE_BRACKETCHAR - XT_BRACKETCHAR: -000483 1c01 .dw DO_COLON - PFA_BRACKETCHAR: - .endif -000484 02a3 .dw XT_COMPILE -000485 1c3d .dw XT_DOLITERAL -000486 0971 .dw XT_CHAR -000487 02ae .dw XT_COMMA -000488 1c20 .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: -000489 0006 .dw $0006 -00048a 6261 -00048b 726f -00048c 2274 .db "abort",'"' -00048d 047e .dw VE_HEAD - .set VE_HEAD = VE_ABORTQUOTE - XT_ABORTQUOTE: -00048e 1c01 .dw DO_COLON - PFA_ABORTQUOTE: - .endif -00048f 024f .dw XT_SQUOTE -000490 02a3 .dw XT_COMPILE -000491 04a0 .dw XT_QABORT -000492 1c20 .DW XT_EXIT - .include "words/abort.asm" - - ; Exceptions - ; send an exception -1 - .if cpu_msp430==1 - .endif - - .if cpu_avr8==1 - VE_ABORT: -000493 ff05 .dw $ff05 -000494 6261 -000495 726f -000496 0074 .db "abort",0 -000497 0489 .dw VE_HEAD - .set VE_HEAD = VE_ABORT - XT_ABORT: -000498 1c01 .dw DO_COLON - PFA_ABORT: - .endif -000499 1d4b .dw XT_TRUE -00049a 08c8 .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: -00049b ff06 .dw $ff06 -00049c 613f -00049d 6f62 -00049e 7472 .db "?abort" -00049f 0493 .dw VE_HEAD - .set VE_HEAD = VE_QABORT - XT_QABORT: -0004a0 1c01 .dw DO_COLON - PFA_QABORT: - - .endif -0004a1 1ce1 -0004a2 1c36 .DW XT_ROT,XT_DOCONDBRANCH -0004a3 04a6 DEST(QABO1) -0004a4 0827 -0004a5 0498 .DW XT_ITYPE,XT_ABORT -0004a6 05f4 -0004a7 1c20 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: -0004a8 ff09 .dw $ff09 -0004a9 6567 -0004aa 2d74 -0004ab 7473 -0004ac 6361 -0004ad 006b .db "get-stack",0 -0004ae 049b .dw VE_HEAD - .set VE_HEAD = VE_GET_STACK - XT_GET_STACK: -0004af 1c01 .dw DO_COLON - .endif -0004b0 1cb1 .dw XT_DUP -0004b1 05e3 .dw XT_CELLPLUS -0004b2 1cc4 .dw XT_SWAP -0004b3 1f5f .dw XT_FETCHE -0004b4 1cb1 .dw XT_DUP -0004b5 1cff .dw XT_TO_R -0004b6 1d54 .dw XT_ZERO -0004b7 1cc4 .dw XT_SWAP ; go from bigger to smaller addresses -0004b8 036d .dw XT_QDOCHECK -0004b9 1c36 .dw XT_DOCONDBRANCH -0004ba 04c6 DEST(PFA_N_FETCH_E2) -0004bb 1e9b .dw XT_DODO - PFA_N_FETCH_E1: - ; ( ee-addr ) -0004bc 1eac .dw XT_I -0004bd 1e35 .dw XT_1MINUS -0004be 05dd .dw XT_CELLS ; ( -- ee-addr i*2 ) -0004bf 1ccf .dw XT_OVER ; ( -- ee-addr i*2 ee-addr ) -0004c0 1d9d .dw XT_PLUS ; ( -- ee-addr ee-addr+i -0004c1 1f5f .dw XT_FETCHE ;( -- ee-addr item_i ) -0004c2 1cc4 .dw XT_SWAP ;( -- item_i ee-addr ) -0004c3 1d4b .dw XT_TRUE ; shortcut for -1 -0004c4 1eba .dw XT_DOPLUSLOOP -0004c5 04bc DEST(PFA_N_FETCH_E1) - PFA_N_FETCH_E2: -0004c6 05f4 .dw XT_2DROP -0004c7 1cf6 .dw XT_R_FROM -0004c8 1c20 .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: -0004c9 ff09 .dw $ff09 -0004ca 6573 -0004cb 2d74 -0004cc 7473 -0004cd 6361 -0004ce 006b .db "set-stack",0 -0004cf 04a8 .dw VE_HEAD - .set VE_HEAD = VE_SET_STACK - XT_SET_STACK: -0004d0 1c01 .dw DO_COLON - PFA_SET_STACK: - .endif -0004d1 1ccf .dw XT_OVER -0004d2 1d21 .dw XT_ZEROLESS -0004d3 1c36 .dw XT_DOCONDBRANCH -0004d4 04d8 DEST(PFA_SET_STACK0) -0004d5 1c3d .dw XT_DOLITERAL -0004d6 fffc .dw -4 -0004d7 08c8 .dw XT_THROW - PFA_SET_STACK0: -0004d8 05eb .dw XT_2DUP -0004d9 1f3b .dw XT_STOREE ; ( -- i_n .. i_0 n e-addr ) -0004da 1cc4 .dw XT_SWAP -0004db 1d54 .dw XT_ZERO -0004dc 036d .dw XT_QDOCHECK -0004dd 1c36 .dw XT_DOCONDBRANCH -0004de 04e5 DEST(PFA_SET_STACK2) -0004df 1e9b .dw XT_DODO - PFA_SET_STACK1: -0004e0 05e3 .dw XT_CELLPLUS ; ( -- i_x e-addr ) -0004e1 05fc .dw XT_TUCK ; ( -- e-addr i_x e-addr -0004e2 1f3b .dw XT_STOREE -0004e3 1ec9 .dw XT_DOLOOP -0004e4 04e0 DEST(PFA_SET_STACK1) - PFA_SET_STACK2: -0004e5 1cd9 .dw XT_DROP -0004e6 1c20 .dw XT_EXIT - - .include "words/map-stack.asm" - - ; Tools - ; Iterate over a stack - - .if cpu_msp430==1 - .endif - - .if cpu_avr8==1 - VE_MAPSTACK: -0004e7 ff09 .dw $ff09 -0004e8 616d -0004e9 2d70 -0004ea 7473 -0004eb 6361 -0004ec 006b .db "map-stack",0 -0004ed 04c9 .dw VE_HEAD - .set VE_HEAD = VE_MAPSTACK - XT_MAPSTACK: -0004ee 1c01 .dw DO_COLON - PFA_MAPSTACK: - .endif -0004ef 1cb1 .dw XT_DUP -0004f0 05e3 .dw XT_CELLPLUS -0004f1 1cc4 .dw XT_SWAP -0004f2 1f5f .dw XT_FETCHE -0004f3 05dd .dw XT_CELLS -0004f4 0de5 .dw XT_BOUNDS -0004f5 036d .dw XT_QDOCHECK -0004f6 1c36 .dw XT_DOCONDBRANCH -0004f7 050a DEST(PFA_MAPSTACK3) -0004f8 1e9b .dw XT_DODO - PFA_MAPSTACK1: -0004f9 1eac .dw XT_I -0004fa 1f5f .dw XT_FETCHE ; -- i*x XT id -0004fb 1cc4 .dw XT_SWAP -0004fc 1cff .dw XT_TO_R -0004fd 1d08 .dw XT_R_FETCH -0004fe 1c2a .dw XT_EXECUTE ; i*x id -- j*y true | i*x false -0004ff 1cb9 .dw XT_QDUP -000500 1c36 .dw XT_DOCONDBRANCH -000501 0506 DEST(PFA_MAPSTACK2) -000502 1cf6 .dw XT_R_FROM -000503 1cd9 .dw XT_DROP -000504 1ed4 .dw XT_UNLOOP -000505 1c20 .dw XT_EXIT - PFA_MAPSTACK2: -000506 1cf6 .dw XT_R_FROM -000507 1fec .dw XT_TWO -000508 1eba .dw XT_DOPLUSLOOP -000509 04f9 DEST(PFA_MAPSTACK1) - PFA_MAPSTACK3: -00050a 1cd9 .dw XT_DROP -00050b 1d54 .dw XT_ZERO -00050c 1c20 .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: -00050d ff0b .dw $ff0b -00050e 6567 -00050f 2d74 -000510 7563 -000511 7272 -000512 6e65 -000513 0074 .db "get-current",0 -000514 04e7 .dw VE_HEAD - .set VE_HEAD = VE_GET_CURRENT - XT_GET_CURRENT: -000515 1c01 .dw DO_COLON - PFA_GET_CURRENT: -000516 1c3d .dw XT_DOLITERAL -000517 003c .dw CFG_CURRENT -000518 1f5f .dw XT_FETCHE -000519 1c20 .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: -00051a ff09 .dw $ff09 -00051b 6567 -00051c 2d74 -00051d 726f -00051e 6564 -00051f 0072 .db "get-order",0 -000520 050d .dw VE_HEAD - .set VE_HEAD = VE_GET_ORDER - XT_GET_ORDER: -000521 1c01 .dw DO_COLON - PFA_GET_ORDER: - .endif -000522 1c3d .dw XT_DOLITERAL -000523 0040 .dw CFG_ORDERLISTLEN -000524 04af .dw XT_GET_STACK -000525 1c20 .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: -000526 ff09 .dw $ff09 -000527 6663 -000528 2d67 -000529 726f -00052a 6564 -00052b 0072 .db "cfg-order",0 -00052c 051a .dw VE_HEAD - .set VE_HEAD = VE_CFG_ORDER - XT_CFG_ORDER: -00052d 1c48 .dw PFA_DOVARIABLE - PFA_CFG_ORDER: - .endif -00052e 0040 .dw CFG_ORDERLISTLEN - .include "words/compare.asm" - - ; String - ; compares two strings in RAM - VE_COMPARE: -00052f ff07 .dw $ff07 -000530 6f63 -000531 706d -000532 7261 -000533 0065 .db "compare",0 -000534 0526 .dw VE_HEAD - .set VE_HEAD = VE_COMPARE - XT_COMPARE: -000535 0536 .dw PFA_COMPARE - PFA_COMPARE: -000536 93bf push xh -000537 93af push xl -000538 018c movw temp0, tosl -000539 9189 -00053a 9199 loadtos -00053b 01dc movw xl, tosl -00053c 9189 -00053d 9199 loadtos -00053e 019c movw temp2, tosl -00053f 9189 -000540 9199 loadtos -000541 01fc movw zl, tosl - PFA_COMPARE_LOOP: -000542 90ed ld temp4, X+ -000543 90f1 ld temp5, Z+ -000544 14ef cp temp4, temp5 -000545 f451 brne PFA_COMPARE_NOTEQUAL -000546 950a dec temp0 -000547 f019 breq PFA_COMPARE_ENDREACHED2 -000548 952a dec temp2 -000549 f7c1 brne PFA_COMPARE_LOOP -00054a c001 rjmp PFA_COMPARE_ENDREACHED - PFA_COMPARE_ENDREACHED2: -00054b 952a dec temp2 - PFA_COMPARE_ENDREACHED: -00054c 2b02 or temp0, temp2 -00054d f411 brne PFA_COMPARE_CHECKLASTCHAR -00054e 2788 clr tosl -00054f c002 rjmp PFA_COMPARE_DONE - PFA_COMPARE_CHECKLASTCHAR: - PFA_COMPARE_NOTEQUAL: -000550 ef8f ser tosl -000551 c000 rjmp PFA_COMPARE_DONE - - PFA_COMPARE_DONE: -000552 2f98 mov tosh, tosl -000553 91af pop xl -000554 91bf pop xh -000555 940c 1c05 jmp_ DO_NEXT - .include "words/nfa2lfa.asm" - - ; System - ; get the link field address from the name field address - VE_NFA2LFA: -000557 ff07 .dw $ff07 -000558 666e -000559 3e61 -00055a 666c -00055b 0061 .db "nfa>lfa",0 -00055c 052f .dw VE_HEAD - .set VE_HEAD = VE_NFA2LFA - XT_NFA2LFA: -00055d 1c01 .dw DO_COLON - PFA_NFA2LFA: -00055e 0cf9 .dw XT_NAME2STRING -00055f 1e2f .dw XT_1PLUS -000560 1e04 .dw XT_2SLASH -000561 1d9d .dw XT_PLUS -000562 1c20 .dw XT_EXIT - - .include "words/environment.asm" - - ; System Value - ; word list identifier of the environmental search list - VE_ENVIRONMENT: -000563 ff0b .dw $ff0b -000564 6e65 -000565 6976 -000566 6f72 -000567 6d6e -000568 6e65 -000569 0074 .db "environment",0 -00056a 0557 .dw VE_HEAD - .set VE_HEAD = VE_ENVIRONMENT - XT_ENVIRONMENT: -00056b 1c48 .dw PFA_DOVARIABLE - PFA_ENVIRONMENT: -00056c 003a .dw CFG_ENVIRONMENT - .include "words/env-wordlists.asm" - - ; Environment - ; maximum number of wordlists in the dictionary search order - VE_ENVWORDLISTS: -00056d ff09 .dw $ff09 -00056e 6f77 -00056f 6472 -000570 696c -000571 7473 -000572 0073 .db "wordlists",0 -000573 0000 .dw VE_ENVHEAD - .set VE_ENVHEAD = VE_ENVWORDLISTS - XT_ENVWORDLISTS: -000574 1c01 .dw DO_COLON - PFA_ENVWORDLISTS: -000575 1c3d .dw XT_DOLITERAL -000576 0008 .dw NUMWORDLISTS -000577 1c20 .dw XT_EXIT - .include "words/env-slashpad.asm" - - ; Environment - ; Size of the PAD buffer in bytes - VE_ENVSLASHPAD: -000578 ff04 .dw $ff04 -000579 702f -00057a 6461 .db "/pad" -00057b 056d .dw VE_ENVHEAD - .set VE_ENVHEAD = VE_ENVSLASHPAD - XT_ENVSLASHPAD: -00057c 1c01 .dw DO_COLON - PFA_ENVSLASHPAD: -00057d 1e8d .dw XT_SP_FETCH -00057e 060a .dw XT_PAD -00057f 1d93 .dw XT_MINUS -000580 1c20 .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: -000581 ff05 .dw $ff05 -000582 682f -000583 6c6f -000584 0064 .db "/hold",0 -000585 0578 .dw VE_ENVHEAD - .set VE_ENVHEAD = VE_ENVSLASHHOLD - XT_ENVSLASHHOLD: -000586 1c01 .dw DO_COLON - PFA_ENVSLASHHOLD: - .endif -000587 060a .dw XT_PAD -000588 0645 .dw XT_HERE -000589 1d93 .dw XT_MINUS -00058a 1c20 .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: -00058b ff0a .dw $ff0a -00058c 6f66 -00058d 7472 -00058e 2d68 -00058f 616e -000590 656d .db "forth-name" -000591 0581 .dw VE_ENVHEAD - .set VE_ENVHEAD = VE_ENV_FORTHNAME - XT_ENV_FORTHNAME: -000592 1c01 .dw DO_COLON - PFA_EN_FORTHNAME: -000593 07f4 .dw XT_DOSLITERAL -000594 0007 .dw 7 - .endif -000595 6d61 -000596 6f66 -000597 7472 -../../common\words/env-forthname.asm(22): warning: .cseg .db misalignment - padding zero byte -000598 0068 .db "amforth" - .if cpu_msp430==1 - .endif -000599 1c20 .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: -00059a ff07 .dw $ff07 -00059b 6576 -00059c 7372 -00059d 6f69 -00059e 006e .db "version",0 -00059f 058b .dw VE_ENVHEAD - .set VE_ENVHEAD = VE_ENV_FORTHVERSION - XT_ENV_FORTHVERSION: -0005a0 1c01 .dw DO_COLON - PFA_EN_FORTHVERSION: - .endif -0005a1 1c3d .dw XT_DOLITERAL -0005a2 0041 .dw 65 -0005a3 1c20 .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: -0005a4 ff03 .dw $ff03 -0005a5 7063 -0005a6 0075 .db "cpu",0 -0005a7 059a .dw VE_ENVHEAD - .set VE_ENVHEAD = VE_ENV_CPU - XT_ENV_CPU: -0005a8 1c01 .dw DO_COLON - PFA_EN_CPU: - .endif -0005a9 1c3d .dw XT_DOLITERAL -0005aa 002d .dw mcu_name -0005ab 0853 .dw XT_ICOUNT -0005ac 1c20 .dw XT_EXIT - .include "words/env-mcuinfo.asm" - - ; Environment - ; flash address of some CPU specific parameters - VE_ENV_MCUINFO: -0005ad ff08 .dw $ff08 -0005ae 636d -0005af 2d75 -0005b0 6e69 -0005b1 6f66 .db "mcu-info" -0005b2 05a4 .dw VE_ENVHEAD - .set VE_ENVHEAD = VE_ENV_MCUINFO - XT_ENV_MCUINFO: -0005b3 1c01 .dw DO_COLON - PFA_EN_MCUINFO: -0005b4 1c3d .dw XT_DOLITERAL -0005b5 0029 .dw mcu_info -0005b6 1c20 .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: -0005b7 ff05 .dw $ff05 -0005b8 752f -0005b9 6573 -0005ba 0072 .db "/user",0 -0005bb 05ad .dw VE_ENVHEAD - .set VE_ENVHEAD = VE_ENVUSERSIZE - XT_ENVUSERSIZE: -0005bc 1c01 .dw DO_COLON - PFA_ENVUSERSIZE: - .endif -0005bd 1c3d .dw XT_DOLITERAL -0005be 002c .dw SYSUSERSIZE + APPUSERSIZE -0005bf 1c20 .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: -0005c0 ff05 .dw $ff05 -0005c1 5f66 -0005c2 7063 -0005c3 0075 .db "f_cpu",0 -0005c4 0563 .dw VE_HEAD - .set VE_HEAD = VE_F_CPU - XT_F_CPU: -0005c5 1c01 .dw DO_COLON - PFA_F_CPU: - .endif -0005c6 1c3d .dw XT_DOLITERAL -0005c7 1200 .dw (F_CPU % 65536) -0005c8 1c3d .dw XT_DOLITERAL -0005c9 007a .dw (F_CPU / 65536) -0005ca 1c20 .dw XT_EXIT - .include "words/state.asm" - - ; System Variable - ; system state - VE_STATE: -0005cb ff05 .dw $ff05 -0005cc 7473 -0005cd 7461 -0005ce 0065 .db "state",0 -0005cf 05c0 .dw VE_HEAD - .set VE_HEAD = VE_STATE - XT_STATE: -0005d0 1c48 .dw PFA_DOVARIABLE - PFA_STATE: -0005d1 008f .dw ram_state - - .dseg -00008f 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: -0005d2 ff04 .dw $ff04 -0005d3 6162 -0005d4 6573 .db "base" -0005d5 05cb .dw VE_HEAD - .set VE_HEAD = VE_BASE - XT_BASE: -0005d6 1c58 .dw PFA_DOUSER - PFA_BASE: - .endif -0005d7 000c .dw USER_BASE - - .include "words/cells.asm" - - ; Arithmetics - ; n2 is the size in address units of n1 cells - VE_CELLS: -0005d8 ff05 .dw $ff05 -0005d9 6563 -0005da 6c6c -0005db 0073 .db "cells",0 -0005dc 05d2 .dw VE_HEAD - .set VE_HEAD = VE_CELLS - XT_CELLS: -0005dd 1e0c .dw PFA_2STAR - .include "words/cellplus.asm" - - ; Arithmetics - ; add the size of an address-unit to a-addr1 - VE_CELLPLUS: -0005de ff05 .dw $ff05 -0005df 6563 -0005e0 6c6c -0005e1 002b .db "cell+",0 -0005e2 05d8 .dw VE_HEAD - .set VE_HEAD = VE_CELLPLUS - XT_CELLPLUS: -0005e3 05e4 .dw PFA_CELLPLUS - PFA_CELLPLUS: -0005e4 9602 adiw tosl, CELLSIZE -0005e5 940c 1c05 jmp_ DO_NEXT - - .include "words/2dup.asm" - - ; Stack - ; Duplicate the 2 top elements - - .if cpu_msp430==1 - .endif - - .if cpu_avr8==1 - VE_2DUP: -0005e7 ff04 .dw $ff04 -0005e8 6432 -0005e9 7075 .db "2dup" -0005ea 05de .dw VE_HEAD - .set VE_HEAD = VE_2DUP - XT_2DUP: -0005eb 1c01 .dw DO_COLON - PFA_2DUP: - .endif - -0005ec 1ccf .dw XT_OVER -0005ed 1ccf .dw XT_OVER -0005ee 1c20 .dw XT_EXIT - .include "words/2drop.asm" - - ; Stack - ; Remove the 2 top elements - - .if cpu_msp430==1 - .endif - - .if cpu_avr8==1 - VE_2DROP: -0005ef ff05 .dw $ff05 -0005f0 6432 -0005f1 6f72 -0005f2 0070 .db "2drop",0 -0005f3 05e7 .dw VE_HEAD - .set VE_HEAD = VE_2DROP - XT_2DROP: -0005f4 1c01 .dw DO_COLON - PFA_2DROP: - .endif -0005f5 1cd9 .dw XT_DROP -0005f6 1cd9 .dw XT_DROP -0005f7 1c20 .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: -0005f8 ff04 .dw $ff04 -0005f9 7574 -0005fa 6b63 .db "tuck" -0005fb 05ef .dw VE_HEAD - .set VE_HEAD = VE_TUCK - XT_TUCK: -0005fc 1c01 .dw DO_COLON - PFA_TUCK: - .endif -0005fd 1cc4 .dw XT_SWAP -0005fe 1ccf .dw XT_OVER -0005ff 1c20 .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: -000600 ff03 .dw $ff03 -000601 693e -000602 006e .db ">in",0 -000603 05f8 .dw VE_HEAD - .set VE_HEAD = VE_TO_IN - XT_TO_IN: -000604 1c58 .dw PFA_DOUSER - PFA_TO_IN: - .endif -000605 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: -000606 ff03 .dw $ff03 -000607 6170 -000608 0064 .db "pad",0 -000609 0600 .dw VE_HEAD - .set VE_HEAD = VE_PAD - XT_PAD: -00060a 1c01 .dw DO_COLON - PFA_PAD: - .endif -00060b 0645 .dw XT_HERE -00060c 1c3d .dw XT_DOLITERAL -00060d 0028 .dw 40 -00060e 1d9d .dw XT_PLUS -00060f 1c20 .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: -000610 ff04 .dw $ff04 -000611 6d65 -000612 7469 .db "emit" -000613 0606 .dw VE_HEAD - .set VE_HEAD = VE_EMIT - XT_EMIT: -000614 0c9a .dw PFA_DODEFER1 - PFA_EMIT: - .endif -000615 000e .dw USER_EMIT -000616 0c63 .dw XT_UDEFERFETCH -000617 0c6f .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: -000618 ff05 .dw $ff05 -000619 6d65 -00061a 7469 -00061b 003f .db "emit?",0 -00061c 0610 .dw VE_HEAD - .set VE_HEAD = VE_EMITQ - XT_EMITQ: -00061d 0c9a .dw PFA_DODEFER1 - PFA_EMITQ: - .endif -00061e 0010 .dw USER_EMITQ -00061f 0c63 .dw XT_UDEFERFETCH -000620 0c6f .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: -000621 ff03 .dw $ff03 -000622 656b -000623 0079 .db "key",0 -000624 0618 .dw VE_HEAD - .set VE_HEAD = VE_KEY - XT_KEY: -000625 0c9a .dw PFA_DODEFER1 - PFA_KEY: - .endif -000626 0012 .dw USER_KEY -000627 0c63 .dw XT_UDEFERFETCH -000628 0c6f .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: -000629 ff04 .dw $ff04 -00062a 656b -00062b 3f79 .db "key?" -00062c 0621 .dw VE_HEAD - .set VE_HEAD = VE_KEYQ - XT_KEYQ: -00062d 0c9a .dw PFA_DODEFER1 - PFA_KEYQ: - .endif -00062e 0014 .dw USER_KEYQ -00062f 0c63 .dw XT_UDEFERFETCH -000630 0c6f .dw XT_UDEFERSTORE - - .include "words/dp.asm" - - ; System Value - ; address of the next free dictionary cell - VE_DP: -000631 ff02 .dw $ff02 -000632 7064 .db "dp" -000633 0629 .dw VE_HEAD - .set VE_HEAD = VE_DP - XT_DP: -000634 1c6f .dw PFA_DOVALUE1 - PFA_DP: -000635 002c .dw CFG_DP -000636 0c3b .dw XT_EDEFERFETCH -000637 0c45 .dw XT_EDEFERSTORE - .include "words/ehere.asm" - - ; System Value - ; address of the next free address in eeprom - VE_EHERE: -000638 ff05 .dw $ff05 -000639 6865 -00063a 7265 -00063b 0065 .db "ehere",0 -00063c 0631 .dw VE_HEAD - .set VE_HEAD = VE_EHERE - XT_EHERE: -00063d 1c6f .dw PFA_DOVALUE1 - PFA_EHERE: -00063e 0030 .dw EE_EHERE -00063f 0c3b .dw XT_EDEFERFETCH -000640 0c45 .dw XT_EDEFERSTORE - .include "words/here.asm" - - ; System Value - ; address of the next free data space (RAM) cell - VE_HERE: -000641 ff04 .dw $ff04 -000642 6568 -000643 6572 .db "here" -000644 0638 .dw VE_HEAD - .set VE_HEAD = VE_HERE - XT_HERE: -000645 1c6f .dw PFA_DOVALUE1 - PFA_HERE: -000646 002e .dw EE_HERE -000647 0c3b .dw XT_EDEFERFETCH -000648 0c45 .dw XT_EDEFERSTORE - .include "words/allot.asm" - - ; System - ; allocate or release memory in RAM - VE_ALLOT: -000649 ff05 .dw $ff05 -00064a 6c61 -00064b 6f6c -00064c 0074 .db "allot",0 -00064d 0641 .dw VE_HEAD - .set VE_HEAD = VE_ALLOT - XT_ALLOT: -00064e 1c01 .dw DO_COLON - PFA_ALLOT: -00064f 0645 .dw XT_HERE -000650 1d9d .dw XT_PLUS -000651 0c20 .dw XT_DOTO -000652 0646 .dw PFA_HERE -000653 1c20 .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: -000654 ff03 .dw $ff03 -000655 6962 -000656 006e .db "bin",0 -000657 0649 .dw VE_HEAD - .set VE_HEAD = VE_BIN - XT_BIN: -000658 1c01 .dw DO_COLON - PFA_BIN: - .endif -000659 1fec .dw XT_TWO -00065a 05d6 .dw XT_BASE -00065b 1c81 .dw XT_STORE -00065c 1c20 .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: -00065d ff07 .dw $ff07 -00065e 6564 -00065f 6963 -000660 616d -000661 006c .db "decimal",0 -000662 0654 .dw VE_HEAD - .set VE_HEAD = VE_DECIMAL - XT_DECIMAL: -000663 1c01 .dw DO_COLON - PFA_DECIMAL: - .endif -000664 1c3d .dw XT_DOLITERAL -000665 000a .dw 10 -000666 05d6 .dw XT_BASE -000667 1c81 .dw XT_STORE -000668 1c20 .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: -000669 ff03 .dw $ff03 -00066a 6568 -00066b 0078 .db "hex",0 -00066c 065d .dw VE_HEAD - .set VE_HEAD = VE_HEX - XT_HEX: -00066d 1c01 .dw DO_COLON - PFA_HEX: - .endif -00066e 1c3d .dw XT_DOLITERAL -00066f 0010 .dw 16 -000670 05d6 .dw XT_BASE -000671 1c81 .dw XT_STORE -000672 1c20 .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: -000673 ff02 .dw $ff02 -000674 6c62 .db "bl" -000675 0669 .dw VE_HEAD - .set VE_HEAD = VE_BL - XT_BL: -000676 1c48 .dw PFA_DOVARIABLE - PFA_BL: - .endif -000677 0020 .dw 32 - - .include "words/turnkey.asm" - - ; System Value - ; Deferred action during startup/reset - VE_TURNKEY: -000678 ff07 .dw $ff07 -000679 7574 -00067a 6e72 -00067b 656b -00067c 0079 .db "turnkey",0 -00067d 0673 .dw VE_HEAD - .set VE_HEAD = VE_TURNKEY - XT_TURNKEY: -00067e 0c9a .dw PFA_DODEFER1 - PFA_TURNKEY: -00067f 0038 .dw CFG_TURNKEY -000680 0c3b .dw XT_EDEFERFETCH -000681 0c45 .dw XT_EDEFERSTORE - - .include "words/slashmod.asm" - - ; Arithmetics - ; signed division n1/n2 with remainder and quotient - VE_SLASHMOD: -000682 ff04 .dw $ff04 -000683 6d2f -000684 646f .db "/mod" -000685 0678 .dw VE_HEAD - .set VE_HEAD = VE_SLASHMOD - XT_SLASHMOD: -000686 0687 .dw PFA_SLASHMOD - PFA_SLASHMOD: -000687 019c movw temp2, tosl - -000688 9109 ld temp0, Y+ -000689 9119 ld temp1, Y+ - -00068a 2f41 mov temp6,temp1 ;move dividend High to sign register -00068b 2743 eor temp6,temp3 ;xor divisor High with sign register -00068c ff17 sbrs temp1,7 ;if MSB in dividend set -00068d c004 rjmp PFA_SLASHMOD_1 -00068e 9510 com temp1 ; change sign of dividend -00068f 9500 com temp0 -000690 5f0f subi temp0,low(-1) -000691 4f1f sbci temp1,high(-1) - PFA_SLASHMOD_1: -000692 ff37 sbrs temp3,7 ;if MSB in divisor set -000693 c004 rjmp PFA_SLASHMOD_2 -000694 9530 com temp3 ; change sign of divisor -000695 9520 com temp2 -000696 5f2f subi temp2,low(-1) -000697 4f3f sbci temp3,high(-1) -000698 24ee PFA_SLASHMOD_2: clr temp4 ;clear remainder Low byte -000699 18ff sub temp5,temp5;clear remainder High byte and carry -00069a e151 ldi temp7,17 ;init loop counter - -00069b 1f00 PFA_SLASHMOD_3: rol temp0 ;shift left dividend -00069c 1f11 rol temp1 -00069d 955a dec temp7 ;decrement counter -00069e f439 brne PFA_SLASHMOD_5 ;if done -00069f ff47 sbrs temp6,7 ; if MSB in sign register set -0006a0 c004 rjmp PFA_SLASHMOD_4 -0006a1 9510 com temp1 ; change sign of result -0006a2 9500 com temp0 -0006a3 5f0f subi temp0,low(-1) -0006a4 4f1f sbci temp1,high(-1) -0006a5 c00b PFA_SLASHMOD_4: rjmp PFA_SLASHMODmod_done ; return -0006a6 1cee PFA_SLASHMOD_5: rol temp4 ;shift dividend into remainder -0006a7 1cff rol temp5 -0006a8 1ae2 sub temp4,temp2 ;remainder = remainder - divisor -0006a9 0af3 sbc temp5,temp3 ; -0006aa f420 brcc PFA_SLASHMOD_6 ;if result negative -0006ab 0ee2 add temp4,temp2 ; restore remainder -0006ac 1ef3 adc temp5,temp3 -0006ad 9488 clc ; clear carry to be shifted into result -0006ae cfec rjmp PFA_SLASHMOD_3 ;else -0006af 9408 PFA_SLASHMOD_6: sec ; set carry to be shifted into result -0006b0 cfea rjmp PFA_SLASHMOD_3 - - PFA_SLASHMODmod_done: - ; put remainder on stack -0006b1 92fa st -Y,temp5 -0006b2 92ea st -Y,temp4 - - ; put quotient on stack -0006b3 01c8 movw tosl, temp0 -0006b4 940c 1c05 jmp_ DO_NEXT - .include "words/uslashmod.asm" - - ; Arithmetics - ; unsigned division with remainder - VE_USLASHMOD: -0006b6 ff05 .dw $ff05 -0006b7 2f75 -0006b8 6f6d -0006b9 0064 .db "u/mod",0 -0006ba 0682 .dw VE_HEAD - .set VE_HEAD = VE_USLASHMOD - XT_USLASHMOD: -0006bb 1c01 .dw DO_COLON - PFA_USLASHMOD: -0006bc 1cff .dw XT_TO_R -0006bd 1d54 .dw XT_ZERO -0006be 1cf6 .dw XT_R_FROM -0006bf 1dc2 .dw XT_UMSLASHMOD -0006c0 1c20 .dw XT_EXIT - .include "words/negate.asm" - - ; Logic - ; 2-complement - VE_NEGATE: -0006c1 ff06 .dw $ff06 -0006c2 656e -0006c3 6167 -0006c4 6574 .db "negate" -0006c5 06b6 .dw VE_HEAD - .set VE_HEAD = VE_NEGATE - XT_NEGATE: -0006c6 1c01 .dw DO_COLON - PFA_NEGATE: -0006c7 1dfd .dw XT_INVERT -0006c8 1e2f .dw XT_1PLUS -0006c9 1c20 .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: -0006ca ff01 .dw $ff01 -0006cb 002f .db "/",0 -0006cc 06c1 .dw VE_HEAD - .set VE_HEAD = VE_SLASH - XT_SLASH: -0006cd 1c01 .dw DO_COLON - PFA_SLASH: - .endif -0006ce 0686 .dw XT_SLASHMOD -0006cf 1cf0 .dw XT_NIP -0006d0 1c20 .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: -0006d1 ff03 .dw $ff03 -0006d2 6f6d -0006d3 0064 .db "mod",0 -0006d4 06ca .dw VE_HEAD - .set VE_HEAD = VE_MOD - XT_MOD: -0006d5 1c01 .dw DO_COLON - PFA_MOD: - .endif -0006d6 0686 .dw XT_SLASHMOD -0006d7 1cd9 .dw XT_DROP -0006d8 1c20 .dw XT_EXIT - .include "words/abs.asm" - - ; DUP ?NEGATE ; - - .if cpu_msp430==1 - .endif - - .if cpu_avr8==1 - VE_ABS: -0006d9 ff03 .dw $ff03 -0006da 6261 -0006db 0073 .db "abs",0 -0006dc 06d1 .dw VE_HEAD - .set VE_HEAD = VE_ABS - XT_ABS: -0006dd 1c01 .dw DO_COLON - PFA_ABS: - - .endif - -0006de 1cb1 -0006df 1e3e -0006e0 1c20 .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: -0006e1 ff03 .dw $ff03 -0006e2 696d -0006e3 006e .db "min",0 -0006e4 06d9 .dw VE_HEAD - .set VE_HEAD = VE_MIN - XT_MIN: -0006e5 1c01 .dw DO_COLON - PFA_MIN: - .endif -0006e6 05eb .dw XT_2DUP -0006e7 1d78 .dw XT_GREATER -0006e8 1c36 .dw XT_DOCONDBRANCH -0006e9 06eb DEST(PFA_MIN1) -0006ea 1cc4 .dw XT_SWAP - PFA_MIN1: -0006eb 1cd9 .dw XT_DROP -0006ec 1c20 .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: -0006ed ff03 .dw $ff03 -0006ee 616d -0006ef 0078 .db "max",0 -0006f0 06e1 .dw VE_HEAD - .set VE_HEAD = VE_MAX - XT_MAX: -0006f1 1c01 .dw DO_COLON - PFA_MAX: - - .endif -0006f2 05eb .dw XT_2DUP -0006f3 1d6e .dw XT_LESS -0006f4 1c36 .dw XT_DOCONDBRANCH -0006f5 06f7 DEST(PFA_MAX1) -0006f6 1cc4 .dw XT_SWAP - PFA_MAX1: -0006f7 1cd9 .dw XT_DROP -0006f8 1c20 .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: -0006f9 ff06 .dw $ff06 -0006fa 6977 -0006fb 6874 -0006fc 6e69 .db "within" -0006fd 06ed .dw VE_HEAD - .set VE_HEAD = VE_WITHIN - XT_WITHIN: -0006fe 1c01 .dw DO_COLON - PFA_WITHIN: - .endif -0006ff 1ccf .dw XT_OVER -000700 1d93 .dw XT_MINUS -000701 1cff .dw XT_TO_R -000702 1d93 .dw XT_MINUS -000703 1cf6 .dw XT_R_FROM -000704 1d5c .dw XT_ULESS -000705 1c20 .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: -000706 ff07 .dw $ff07 -000707 6f74 -000708 7075 -000709 6570 -00070a 0072 .db "toupper",0 -00070b 06f9 .dw VE_HEAD - .set VE_HEAD = VE_TOUPPER - XT_TOUPPER: -00070c 1c01 .dw DO_COLON - PFA_TOUPPER: - .endif -00070d 1cb1 .dw XT_DUP -00070e 1c3d .dw XT_DOLITERAL -00070f 0061 .dw 'a' -000710 1c3d .dw XT_DOLITERAL -000711 007b .dw 'z'+1 -000712 06fe .dw XT_WITHIN -000713 1c36 .dw XT_DOCONDBRANCH -000714 0718 DEST(PFA_TOUPPER0) -000715 1c3d .dw XT_DOLITERAL -000716 00df .dw 223 ; inverse of 0x20: 0xdf -000717 1e13 .dw XT_AND - PFA_TOUPPER0: -000718 1c20 .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: -000719 ff07 .dw $ff07 -00071a 6f74 -00071b 6f6c -00071c 6577 -00071d 0072 .db "tolower",0 -00071e 0706 .dw VE_HEAD - .set VE_HEAD = VE_TOLOWER - XT_TOLOWER: -00071f 1c01 .dw DO_COLON - PFA_TOLOWER: - .endif -000720 1cb1 .dw XT_DUP -000721 1c3d .dw XT_DOLITERAL -000722 0041 .dw 'A' -000723 1c3d .dw XT_DOLITERAL -000724 005b .dw 'Z'+1 -000725 06fe .dw XT_WITHIN -000726 1c36 .dw XT_DOCONDBRANCH -000727 072b DEST(PFA_TOLOWER0) -000728 1c3d .dw XT_DOLITERAL -000729 0020 .dw 32 -00072a 1e1c .dw XT_OR - PFA_TOLOWER0: -00072b 1c20 .dw XT_EXIT - ;;;;;;;;;;;;;;;;;;;;;; - .include "words/hld.asm" - - ; Numeric IO - ; pointer to current write position in the Pictured Numeric Output buffer - VE_HLD: -00072c ff03 .dw $ff03 -00072d 6c68 -00072e 0064 .db "hld",0 -00072f 0719 .dw VE_HEAD - .set VE_HEAD = VE_HLD - XT_HLD: -000730 1c48 .dw PFA_DOVARIABLE - PFA_HLD: -000731 0091 .dw ram_hld - - .dseg -000091 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: -000732 ff04 .dw $ff04 -000733 6f68 -000734 646c .db "hold" -000735 072c .dw VE_HEAD - .set VE_HEAD = VE_HOLD - XT_HOLD: -000736 1c01 .dw DO_COLON - PFA_HOLD: - .endif -000737 0730 .dw XT_HLD -000738 1cb1 .dw XT_DUP -000739 1c79 .dw XT_FETCH -00073a 1e35 .dw XT_1MINUS -00073b 1cb1 .dw XT_DUP -00073c 1cff .dw XT_TO_R -00073d 1cc4 .dw XT_SWAP -00073e 1c81 .dw XT_STORE -00073f 1cf6 .dw XT_R_FROM -000740 1c8d .dw XT_CSTORE -000741 1c20 .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: -000742 ff02 .dw $ff02 -000743 233c .db "<#" -000744 0732 .dw VE_HEAD - .set VE_HEAD = VE_L_SHARP - XT_L_SHARP: -000745 1c01 .dw DO_COLON - PFA_L_SHARP: - .endif -000746 060a .dw XT_PAD -000747 0730 .dw XT_HLD -000748 1c81 .dw XT_STORE -000749 1c20 .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: -00074a ff01 .dw $ff01 -00074b 0023 .db "#",0 -00074c 0742 .dw VE_HEAD - .set VE_HEAD = VE_SHARP - XT_SHARP: -00074d 1c01 .dw DO_COLON - PFA_SHARP: - .endif -00074e 05d6 .dw XT_BASE -00074f 1c79 .dw XT_FETCH -000750 07ca .dw XT_UDSLASHMOD -000751 1ce1 .dw XT_ROT -000752 1c3d .dw XT_DOLITERAL -000753 0009 .dw 9 -000754 1ccf .dw XT_OVER -000755 1d6e .dw XT_LESS -000756 1c36 .dw XT_DOCONDBRANCH -000757 075b DEST(PFA_SHARP1) -000758 1c3d .dw XT_DOLITERAL -000759 0007 .dw 7 -00075a 1d9d .dw XT_PLUS - PFA_SHARP1: -00075b 1c3d .dw XT_DOLITERAL -00075c 0030 .dw 48 ; ASCII 0 -00075d 1d9d .dw XT_PLUS -00075e 0736 .dw XT_HOLD -00075f 1c20 .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: -000760 ff02 .dw $ff02 -000761 7323 .db "#s" -000762 074a .dw VE_HEAD - .set VE_HEAD = VE_SHARP_S - XT_SHARP_S: -000763 1c01 .dw DO_COLON - PFA_SHARP_S: - .endif - NUMS1: -000764 074d .dw XT_SHARP -000765 05eb .dw XT_2DUP -000766 1e1c .dw XT_OR -000767 1d1a .dw XT_ZEROEQUAL -000768 1c36 .dw XT_DOCONDBRANCH -000769 0764 DEST(NUMS1) ; PFA_SHARP_S -00076a 1c20 .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: -00076b ff02 .dw $ff02 -00076c 3e23 .db "#>" -00076d 0760 .dw VE_HEAD - .set VE_HEAD = VE_SHARP_G - XT_SHARP_G: -00076e 1c01 .dw DO_COLON - PFA_SHARP_G: - .endif -00076f 05f4 .dw XT_2DROP -000770 0730 .dw XT_HLD -000771 1c79 .dw XT_FETCH -000772 060a .dw XT_PAD -000773 1ccf .dw XT_OVER -000774 1d93 .dw XT_MINUS -000775 1c20 .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: -000776 ff04 .dw $ff04 -000777 6973 -000778 6e67 .db "sign" -000779 076b .dw VE_HEAD - .set VE_HEAD = VE_SIGN - XT_SIGN: -00077a 1c01 .dw DO_COLON - PFA_SIGN: - .endif -00077b 1d21 .dw XT_ZEROLESS -00077c 1c36 .dw XT_DOCONDBRANCH -00077d 0781 DEST(PFA_SIGN1) -00077e 1c3d .dw XT_DOLITERAL -00077f 002d .dw 45 ; ascii - -000780 0736 .dw XT_HOLD - PFA_SIGN1: -000781 1c20 .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: -000782 ff03 .dw $ff03 -000783 2e64 -000784 0072 .db "d.r",0 -000785 0776 .dw VE_HEAD - .set VE_HEAD = VE_DDOTR - XT_DDOTR: -000786 1c01 .dw DO_COLON - PFA_DDOTR: - - .endif -000787 1cff .dw XT_TO_R -000788 05fc .dw XT_TUCK -000789 0d5b .dw XT_DABS -00078a 0745 .dw XT_L_SHARP -00078b 0763 .dw XT_SHARP_S -00078c 1ce1 .dw XT_ROT -00078d 077a .dw XT_SIGN -00078e 076e .dw XT_SHARP_G -00078f 1cf6 .dw XT_R_FROM -000790 1ccf .dw XT_OVER -000791 1d93 .dw XT_MINUS -000792 0872 .dw XT_SPACES -000793 0882 .dw XT_TYPE -000794 1c20 .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: -000795 ff02 .dw $ff02 -000796 722e .db ".r" -000797 0782 .dw VE_HEAD - .set VE_HEAD = VE_DOTR - XT_DOTR: -000798 1c01 .dw DO_COLON - PFA_DOTR: - - .endif -000799 1cff .dw XT_TO_R -00079a 0dee .dw XT_S2D -00079b 1cf6 .dw XT_R_FROM -00079c 0786 .dw XT_DDOTR -00079d 1c20 .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: -00079e ff02 .dw $ff02 -00079f 2e64 .db "d." -0007a0 0795 .dw VE_HEAD - .set VE_HEAD = VE_DDOT - XT_DDOT: -0007a1 1c01 .dw DO_COLON - PFA_DDOT: - - .endif -0007a2 1d54 .dw XT_ZERO -0007a3 0786 .dw XT_DDOTR -0007a4 0869 .dw XT_SPACE -0007a5 1c20 .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: -0007a6 ff01 .dw $ff01 -0007a7 002e .db ".",0 -0007a8 079e .dw VE_HEAD - .set VE_HEAD = VE_DOT - XT_DOT: -0007a9 1c01 .dw DO_COLON - PFA_DOT: - .endif -0007aa 0dee .dw XT_S2D -0007ab 07a1 .dw XT_DDOT -0007ac 1c20 .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: -0007ad ff03 .dw $ff03 -0007ae 6475 -0007af 002e .db "ud.",0 -0007b0 07a6 .dw VE_HEAD - .set VE_HEAD = VE_UDDOT - XT_UDDOT: -0007b1 1c01 .dw DO_COLON - PFA_UDDOT: - .endif -0007b2 1d54 .dw XT_ZERO -0007b3 07ba .dw XT_UDDOTR -0007b4 0869 .dw XT_SPACE -0007b5 1c20 .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: -0007b6 ff04 .dw $ff04 -0007b7 6475 -0007b8 722e .db "ud.r" -0007b9 07ad .dw VE_HEAD - .set VE_HEAD = VE_UDDOTR - XT_UDDOTR: -0007ba 1c01 .dw DO_COLON - PFA_UDDOTR: - .endif -0007bb 1cff .dw XT_TO_R -0007bc 0745 .dw XT_L_SHARP -0007bd 0763 .dw XT_SHARP_S -0007be 076e .dw XT_SHARP_G -0007bf 1cf6 .dw XT_R_FROM -0007c0 1ccf .dw XT_OVER -0007c1 1d93 .dw XT_MINUS -0007c2 0872 .dw XT_SPACES -0007c3 0882 .dw XT_TYPE -0007c4 1c20 .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: -0007c5 ff06 .dw $ff06 -0007c6 6475 -0007c7 6d2f -0007c8 646f .db "ud/mod" -0007c9 07b6 .dw VE_HEAD - .set VE_HEAD = VE_UDSLASHMOD - XT_UDSLASHMOD: -0007ca 1c01 .dw DO_COLON - PFA_UDSLASHMOD: - .endif -0007cb 1cff .dw XT_TO_R -0007cc 1d54 .dw XT_ZERO -0007cd 1d08 .dw XT_R_FETCH -0007ce 1dc2 .dw XT_UMSLASHMOD -0007cf 1cf6 .dw XT_R_FROM -0007d0 1cc4 .dw XT_SWAP -0007d1 1cff .dw XT_TO_R -0007d2 1dc2 .dw XT_UMSLASHMOD -0007d3 1cf6 .dw XT_R_FROM -0007d4 1c20 .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: -0007d5 ff06 .dw $ff06 -0007d6 6964 -0007d7 6967 -0007d8 3f74 .db "digit?" -0007d9 07c5 .dw VE_HEAD - .set VE_HEAD = VE_DIGITQ - XT_DIGITQ: -0007da 1c01 .dw DO_COLON - PFA_DIGITQ: - .endif -0007db 070c .dw XT_TOUPPER -0007dc 1cb1 -0007dd 1c3d -0007de 0039 -0007df 1d78 -0007e0 1c3d -0007e1 0100 .DW XT_DUP,XT_DOLITERAL,57,XT_GREATER,XT_DOLITERAL,256 -0007e2 1e13 -0007e3 1d9d -0007e4 1cb1 -0007e5 1c3d -0007e6 0140 -0007e7 1d78 .DW XT_AND,XT_PLUS,XT_DUP,XT_DOLITERAL,320,XT_GREATER -0007e8 1c3d -0007e9 0107 -0007ea 1e13 -0007eb 1d93 -0007ec 1c3d -0007ed 0030 .DW XT_DOLITERAL,263,XT_AND,XT_MINUS,XT_DOLITERAL,48 -0007ee 1d93 -0007ef 1cb1 -0007f0 05d6 -0007f1 1c79 -0007f2 1d5c .DW XT_MINUS,XT_DUP,XT_BASE,XT_FETCH,XT_ULESS -0007f3 1c20 .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: -0007f4 1c01 .dw DO_COLON - PFA_DOSLITERAL: -0007f5 1d08 .dw XT_R_FETCH ; ( -- addr ) -0007f6 0853 .dw XT_ICOUNT -0007f7 1cf6 .dw XT_R_FROM -0007f8 1ccf .dw XT_OVER ; ( -- addr' n addr n) -0007f9 1e2f .dw XT_1PLUS -0007fa 1e04 .dw XT_2SLASH ; ( -- addr' n addr k ) -0007fb 1d9d .dw XT_PLUS ; ( -- addr' n addr'' ) -0007fc 1e2f .dw XT_1PLUS -0007fd 1cff .dw XT_TO_R ; ( -- ) -0007fe 1c20 .dw XT_EXIT - .include "words/scomma.asm" - - ; Compiler - ; compiles a string from RAM to Flash - VE_SCOMMA: -0007ff ff02 .dw $ff02 -000800 2c73 .db "s",$2c -000801 07d5 .dw VE_HEAD - .set VE_HEAD = VE_SCOMMA - XT_SCOMMA: -000802 1c01 .dw DO_COLON - PFA_SCOMMA: -000803 1cb1 .dw XT_DUP -000804 0806 .dw XT_DOSCOMMA -000805 1c20 .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: -000806 1c01 .dw DO_COLON - PFA_DOSCOMMA: -000807 02ae .dw XT_COMMA -000808 1cb1 .dw XT_DUP ; ( --addr len len) -000809 1e04 .dw XT_2SLASH ; ( -- addr len len/2 -00080a 05fc .dw XT_TUCK ; ( -- addr len/2 len len/2 -00080b 1e0b .dw XT_2STAR ; ( -- addr len/2 len len' -00080c 1d93 .dw XT_MINUS ; ( -- addr len/2 rem -00080d 1cff .dw XT_TO_R -00080e 1d54 .dw XT_ZERO -00080f 036d .dw XT_QDOCHECK -000810 1c36 .dw XT_DOCONDBRANCH -000811 0819 .dw PFA_SCOMMA2 -000812 1e9b .dw XT_DODO - PFA_SCOMMA1: -000813 1cb1 .dw XT_DUP ; ( -- addr addr ) -000814 1c79 .dw XT_FETCH ; ( -- addr c1c2 ) -000815 02ae .dw XT_COMMA ; ( -- addr ) -000816 05e3 .dw XT_CELLPLUS ; ( -- addr+cell ) -000817 1ec9 .dw XT_DOLOOP -000818 0813 .dw PFA_SCOMMA1 - PFA_SCOMMA2: -000819 1cf6 .dw XT_R_FROM -00081a 1d28 .dw XT_GREATERZERO -00081b 1c36 .dw XT_DOCONDBRANCH -00081c 0820 .dw PFA_SCOMMA3 -00081d 1cb1 .dw XT_DUP ; well, tricky -00081e 1c98 .dw XT_CFETCH -00081f 02ae .dw XT_COMMA - PFA_SCOMMA3: -000820 1cd9 .dw XT_DROP ; ( -- ) -000821 1c20 .dw XT_EXIT - .include "words/itype.asm" - - ; Tools - ; reads string from flash and prints it - VE_ITYPE: -000822 ff05 .dw $ff05 -000823 7469 -000824 7079 -000825 0065 .db "itype",0 -000826 07ff .dw VE_HEAD - .set VE_HEAD = VE_ITYPE - XT_ITYPE: -000827 1c01 .dw DO_COLON - PFA_ITYPE: -000828 1cb1 .dw XT_DUP ; ( --addr len len) -000829 1e04 .dw XT_2SLASH ; ( -- addr len len/2 -00082a 05fc .dw XT_TUCK ; ( -- addr len/2 len len/2 -00082b 1e0b .dw XT_2STAR ; ( -- addr len/2 len len' -00082c 1d93 .dw XT_MINUS ; ( -- addr len/2 rem -00082d 1cff .dw XT_TO_R -00082e 1d54 .dw XT_ZERO -00082f 036d .dw XT_QDOCHECK -000830 1c36 .dw XT_DOCONDBRANCH -000831 083b .dw PFA_ITYPE2 -000832 1e9b .dw XT_DODO - PFA_ITYPE1: -000833 1cb1 .dw XT_DUP ; ( -- addr addr ) -000834 1fcb .dw XT_FETCHI ; ( -- addr c1c2 ) -000835 1cb1 .dw XT_DUP -000836 0848 .dw XT_LOWEMIT -000837 0844 .dw XT_HIEMIT -000838 1e2f .dw XT_1PLUS ; ( -- addr+cell ) -000839 1ec9 .dw XT_DOLOOP -00083a 0833 .dw PFA_ITYPE1 - PFA_ITYPE2: -00083b 1cf6 .dw XT_R_FROM -00083c 1d28 .dw XT_GREATERZERO -00083d 1c36 .dw XT_DOCONDBRANCH -00083e 0842 .dw PFA_ITYPE3 -00083f 1cb1 .dw XT_DUP ; make sure the drop below has always something to do -000840 1fcb .dw XT_FETCHI -000841 0848 .dw XT_LOWEMIT - PFA_ITYPE3: -000842 1cd9 .dw XT_DROP -000843 1c20 .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: -000844 1c01 .dw DO_COLON - PFA_HIEMIT: -000845 1ef9 .dw XT_BYTESWAP -000846 0848 .dw XT_LOWEMIT -000847 1c20 .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: -000848 1c01 .dw DO_COLON - PFA_LOWEMIT: -000849 1c3d .dw XT_DOLITERAL -00084a 00ff .dw $00ff -00084b 1e13 .dw XT_AND -00084c 0614 .dw XT_EMIT -00084d 1c20 .dw XT_EXIT - .include "words/icount.asm" - - ; Tools - ; get count information out of a counted string in flash - VE_ICOUNT: -00084e ff06 .dw $ff06 -00084f 6369 -000850 756f -000851 746e .db "icount" -000852 0822 .dw VE_HEAD - .set VE_HEAD = VE_ICOUNT - XT_ICOUNT: -000853 1c01 .dw DO_COLON - PFA_ICOUNT: -000854 1cb1 .dw XT_DUP -000855 1e2f .dw XT_1PLUS -000856 1cc4 .dw XT_SWAP -000857 1fcb .dw XT_FETCHI -000858 1c20 .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: -000859 ff02 .dw 0xff02 -00085a 7263 .db "cr" -00085b 084e .dw VE_HEAD - .set VE_HEAD = VE_CR - XT_CR: -00085c 1c01 .dw DO_COLON - PFA_CR: - .endif - -00085d 1c3d .dw XT_DOLITERAL -00085e 000d .dw 13 -00085f 0614 .dw XT_EMIT -000860 1c3d .dw XT_DOLITERAL -000861 000a .dw 10 -000862 0614 .dw XT_EMIT -000863 1c20 .dw XT_EXIT - .include "words/space.asm" - - ; Character IO - ; emits a space (bl) - - .if cpu_msp430==1 - .endif - - .if cpu_avr8==1 - VE_SPACE: -000864 ff05 .dw $ff05 -000865 7073 -000866 6361 -000867 0065 .db "space",0 -000868 0859 .dw VE_HEAD - .set VE_HEAD = VE_SPACE - XT_SPACE: -000869 1c01 .dw DO_COLON - PFA_SPACE: - .endif -00086a 0676 .dw XT_BL -00086b 0614 .dw XT_EMIT -00086c 1c20 .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: -00086d ff06 .dw $ff06 -00086e 7073 -00086f 6361 -000870 7365 .db "spaces" -000871 0864 .dw VE_HEAD - .set VE_HEAD = VE_SPACES - XT_SPACES: -000872 1c01 .dw DO_COLON - PFA_SPACES: - - .endif - ;C SPACES n -- output n spaces - ; BEGIN DUP 0> WHILE SPACE 1- REPEAT DROP ; -000873 1d54 -000874 06f1 .DW XT_ZERO, XT_MAX -000875 1cb1 -000876 1c36 SPCS1: .DW XT_DUP,XT_DOCONDBRANCH -000877 087c DEST(SPCS2) -000878 0869 -000879 1e35 -00087a 1c2f .DW XT_SPACE,XT_1MINUS,XT_DOBRANCH -00087b 0875 DEST(SPCS1) -00087c 1cd9 -00087d 1c20 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: -00087e ff04 .dw $ff04 -00087f 7974 -000880 6570 .db "type" -000881 086d .dw VE_HEAD - .set VE_HEAD = VE_TYPE - XT_TYPE: -000882 1c01 .dw DO_COLON - PFA_TYPE: - - .endif -000883 0de5 .dw XT_BOUNDS -000884 036d .dw XT_QDOCHECK -000885 1c36 .dw XT_DOCONDBRANCH -000886 088d DEST(PFA_TYPE2) -000887 1e9b .dw XT_DODO - PFA_TYPE1: -000888 1eac .dw XT_I -000889 1c98 .dw XT_CFETCH -00088a 0614 .dw XT_EMIT -00088b 1ec9 .dw XT_DOLOOP -00088c 0888 DEST(PFA_TYPE1) - PFA_TYPE2: -00088d 1c20 .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: -00088e ff01 .dw $ff01 -00088f 0027 .db "'",0 -000890 087e .dw VE_HEAD - .set VE_HEAD = VE_TICK - XT_TICK: -000891 1c01 .dw DO_COLON - PFA_TICK: - .endif -000892 0a3b .dw XT_PARSENAME -000893 0b60 .dw XT_FORTHRECOGNIZER -000894 0b36 .dw XT_RECOGNIZE - ; a word is tickable unless DT:TOKEN is DT:NULL or - ; the interpret action is a NOOP -000895 1cb1 .dw XT_DUP -000896 0bd1 .dw XT_DT_NULL -000897 1fe0 .dw XT_EQUAL -000898 1cc4 .dw XT_SWAP -000899 1fcb .dw XT_FETCHI -00089a 1c3d .dw XT_DOLITERAL -00089b 0c06 .dw XT_NOOP -00089c 1fe0 .dw XT_EQUAL -00089d 1e1c .dw XT_OR -00089e 1c36 .dw XT_DOCONDBRANCH -00089f 08a3 DEST(PFA_TICK1) -0008a0 1c3d .dw XT_DOLITERAL -0008a1 fff3 .dw -13 -0008a2 08c8 .dw XT_THROW - PFA_TICK1: -0008a3 1cd9 .dw XT_DROP -0008a4 1c20 .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: -0008a5 ff07 .dw $ff07 -0008a6 6168 -0008a7 646e -0008a8 656c -0008a9 0072 .db "handler",0 -0008aa 088e .dw VE_HEAD - .set VE_HEAD = VE_HANDLER - XT_HANDLER: -0008ab 1c58 .dw PFA_DOUSER - PFA_HANDLER: - .endif -0008ac 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: -0008ad ff05 .dw $ff05 -0008ae 6163 -0008af 6374 -0008b0 0068 .db "catch",0 -0008b1 08a5 .dw VE_HEAD - .set VE_HEAD = VE_CATCH - XT_CATCH: -0008b2 1c01 .dw DO_COLON - PFA_CATCH: - .endif - - ; sp@ >r -0008b3 1e8d .dw XT_SP_FETCH -0008b4 1cff .dw XT_TO_R - ; handler @ >r -0008b5 08ab .dw XT_HANDLER -0008b6 1c79 .dw XT_FETCH -0008b7 1cff .dw XT_TO_R - ; rp@ handler ! -0008b8 1e76 .dw XT_RP_FETCH -0008b9 08ab .dw XT_HANDLER -0008ba 1c81 .dw XT_STORE -0008bb 1c2a .dw XT_EXECUTE - ; r> handler ! -0008bc 1cf6 .dw XT_R_FROM -0008bd 08ab .dw XT_HANDLER -0008be 1c81 .dw XT_STORE -0008bf 1cf6 .dw XT_R_FROM -0008c0 1cd9 .dw XT_DROP -0008c1 1d54 .dw XT_ZERO -0008c2 1c20 .dw XT_EXIT - .include "words/throw.asm" - - ; Exceptions - ; throw an exception - - .if cpu_msp430==1 - .endif - - .if cpu_avr8==1 - VE_THROW: -0008c3 ff05 .dw $ff05 -0008c4 6874 -0008c5 6f72 -0008c6 0077 .db "throw",0 -0008c7 08ad .dw VE_HEAD - .set VE_HEAD = VE_THROW - XT_THROW: -0008c8 1c01 .dw DO_COLON - PFA_THROW: - .endif -0008c9 1cb1 .dw XT_DUP -0008ca 1d1a .dw XT_ZEROEQUAL -0008cb 1c36 .dw XT_DOCONDBRANCH -0008cc 08cf DEST(PFA_THROW1) -0008cd 1cd9 .dw XT_DROP -0008ce 1c20 .dw XT_EXIT - PFA_THROW1: -0008cf 08ab .dw XT_HANDLER -0008d0 1c79 .dw XT_FETCH -0008d1 1e80 .dw XT_RP_STORE -0008d2 1cf6 .dw XT_R_FROM -0008d3 08ab .dw XT_HANDLER -0008d4 1c81 .dw XT_STORE -0008d5 1cf6 .dw XT_R_FROM -0008d6 1cc4 .dw XT_SWAP -0008d7 1cff .dw XT_TO_R -0008d8 1e96 .dw XT_SP_STORE -0008d9 1cd9 .dw XT_DROP -0008da 1cf6 .dw XT_R_FROM -0008db 1c20 .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: -0008dc ff05 .dw $ff05 -0008dd 7363 -0008de 696b -0008df 0070 .db "cskip",0 -0008e0 08c3 .dw VE_HEAD - .set VE_HEAD = VE_CSKIP - XT_CSKIP: -0008e1 1c01 .dw DO_COLON - PFA_CSKIP: - .endif -0008e2 1cff .dw XT_TO_R ; ( -- addr1 n1 ) - PFA_CSKIP1: -0008e3 1cb1 .dw XT_DUP ; ( -- addr' n' n' ) -0008e4 1c36 .dw XT_DOCONDBRANCH ; ( -- addr' n') -0008e5 08f0 DEST(PFA_CSKIP2) -0008e6 1ccf .dw XT_OVER ; ( -- addr' n' addr' ) -0008e7 1c98 .dw XT_CFETCH ; ( -- addr' n' c' ) -0008e8 1d08 .dw XT_R_FETCH ; ( -- addr' n' c' c ) -0008e9 1fe0 .dw XT_EQUAL ; ( -- addr' n' f ) -0008ea 1c36 .dw XT_DOCONDBRANCH ; ( -- addr' n') -0008eb 08f0 DEST(PFA_CSKIP2) -0008ec 1fe7 .dw XT_ONE -0008ed 0a2c .dw XT_SLASHSTRING -0008ee 1c2f .dw XT_DOBRANCH -0008ef 08e3 DEST(PFA_CSKIP1) - PFA_CSKIP2: -0008f0 1cf6 .dw XT_R_FROM -0008f1 1cd9 .dw XT_DROP ; ( -- addr2 n2) -0008f2 1c20 .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: -0008f3 ff05 .dw $ff05 -0008f4 7363 -0008f5 6163 -../../common\words/cscan.asm(12): warning: .cseg .db misalignment - padding zero byte -0008f6 006e .db "cscan" -0008f7 08dc .dw VE_HEAD - .set VE_HEAD = VE_CSCAN - XT_CSCAN: -0008f8 1c01 .dw DO_COLON - PFA_CSCAN: - .endif -0008f9 1cff .dw XT_TO_R -0008fa 1ccf .dw XT_OVER - PFA_CSCAN1: -0008fb 1cb1 .dw XT_DUP -0008fc 1c98 .dw XT_CFETCH -0008fd 1d08 .dw XT_R_FETCH -0008fe 1fe0 .dw XT_EQUAL -0008ff 1d1a .dw XT_ZEROEQUAL -000900 1c36 .dw XT_DOCONDBRANCH -000901 090d DEST(PFA_CSCAN2) -000902 1cc4 .dw XT_SWAP -000903 1e35 .dw XT_1MINUS -000904 1cc4 .dw XT_SWAP -000905 1ccf .dw XT_OVER -000906 1d21 .dw XT_ZEROLESS ; not negative -000907 1d1a .dw XT_ZEROEQUAL -000908 1c36 .dw XT_DOCONDBRANCH -000909 090d DEST(PFA_CSCAN2) -00090a 1e2f .dw XT_1PLUS -00090b 1c2f .dw XT_DOBRANCH -00090c 08fb DEST(PFA_CSCAN1) - PFA_CSCAN2: -00090d 1cf0 .dw XT_NIP -00090e 1ccf .dw XT_OVER -00090f 1d93 .dw XT_MINUS -000910 1cf6 .dw XT_R_FROM -000911 1cd9 .dw XT_DROP -000912 1c20 .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: -000913 ff06 .dw $ff06 -000914 6361 -000915 6563 -000916 7470 .db "accept" -000917 08f3 .dw VE_HEAD - .set VE_HEAD = VE_ACCEPT - XT_ACCEPT: -000918 1c01 .dw DO_COLON - PFA_ACCEPT: - - .endif -000919 1ccf -00091a 1d9d -00091b 1e35 -00091c 1ccf .DW XT_OVER,XT_PLUS,XT_1MINUS,XT_OVER -00091d 0625 -00091e 1cb1 -00091f 0959 -000920 1d1a -000921 1c36 ACC1: .DW XT_KEY,XT_DUP,XT_CRLFQ,XT_ZEROEQUAL,XT_DOCONDBRANCH -000922 094b DEST(ACC5) -000923 1cb1 -000924 1c3d -000925 0008 -000926 1fe0 -000927 1c36 .DW XT_DUP,XT_DOLITERAL,8,XT_EQUAL,XT_DOCONDBRANCH -000928 093b DEST(ACC3) -000929 1cd9 -00092a 1ce1 -00092b 05eb -00092c 1d78 -00092d 1cff -00092e 1ce1 -00092f 1ce1 -000930 1cf6 -000931 1c36 .DW XT_DROP,XT_ROT,XT_2DUP,XT_GREATER,XT_TO_R,XT_ROT,XT_ROT,XT_R_FROM,XT_DOCONDBRANCH -000932 0939 DEST(ACC6) -000933 0951 -000934 1e35 -000935 1cff -000936 1ccf -000937 1cf6 -000938 014f .DW XT_BS,XT_1MINUS,XT_TO_R,XT_OVER,XT_R_FROM,XT_UMAX -000939 1c2f ACC6: .DW XT_DOBRANCH -00093a 0949 DEST(ACC4) - - - ACC3: ; check for remaining control characters, replace them with blank -00093b 1cb1 .dw XT_DUP ; ( -- addr k k ) -00093c 0676 .dw XT_BL -00093d 1d6e .dw XT_LESS -00093e 1c36 .dw XT_DOCONDBRANCH -00093f 0942 DEST(PFA_ACCEPT6) -000940 1cd9 .dw XT_DROP -000941 0676 .dw XT_BL - PFA_ACCEPT6: -000942 1cb1 -000943 0614 -000944 1ccf -000945 1c8d -000946 1e2f -000947 1ccf -000948 015b .DW XT_DUP,XT_EMIT,XT_OVER,XT_CSTORE,XT_1PLUS,XT_OVER,XT_UMIN -000949 1c2f ACC4: .DW XT_DOBRANCH -00094a 091d DEST(ACC1) -00094b 1cd9 -00094c 1cf0 -00094d 1cc4 -00094e 1d93 -00094f 085c -000950 1c20 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: -000951 1c01 .dw DO_COLON - .endif -000952 1c3d .dw XT_DOLITERAL -000953 0008 .dw 8 -000954 1cb1 .dw XT_DUP -000955 0614 .dw XT_EMIT -000956 0869 .dw XT_SPACE -000957 0614 .dw XT_EMIT -000958 1c20 .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: -000959 1c01 .dw DO_COLON - .endif -00095a 1cb1 .dw XT_DUP -00095b 1c3d .dw XT_DOLITERAL -00095c 000d .dw 13 -00095d 1fe0 .dw XT_EQUAL -00095e 1cc4 .dw XT_SWAP -00095f 1c3d .dw XT_DOLITERAL -000960 000a .dw 10 -000961 1fe0 .dw XT_EQUAL -000962 1e1c .dw XT_OR -000963 1c20 .dw XT_EXIT - .include "words/refill.asm" - - ; System - ; refills the input buffer - - .if cpu_msp430==1 - .endif - - .if cpu_avr8==1 - VE_REFILL: -000964 ff06 .dw $ff06 -000965 6572 -000966 6966 -000967 6c6c .db "refill" -000968 0913 .dw VE_HEAD - .set VE_HEAD = VE_REFILL - XT_REFILL: -000969 0c9a .dw PFA_DODEFER1 - PFA_REFILL: - .endif -00096a 001a .dw USER_REFILL -00096b 0c63 .dw XT_UDEFERFETCH -00096c 0c6f .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: -00096d ff04 .dw $ff04 -00096e 6863 -00096f 7261 .db "char" -000970 0964 .dw VE_HEAD - .set VE_HEAD = VE_CHAR - XT_CHAR: -000971 1c01 .dw DO_COLON - PFA_CHAR: - .endif -000972 0a3b .dw XT_PARSENAME -000973 1cd9 .dw XT_DROP -000974 1c98 .dw XT_CFETCH -000975 1c20 .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: -000976 ff06 .dw $ff06 -000977 756e -000978 626d -000979 7265 .db "number" -00097a 096d .dw VE_HEAD - .set VE_HEAD = VE_NUMBER - XT_NUMBER: -00097b 1c01 .dw DO_COLON - PFA_NUMBER: - .endif -00097c 05d6 .dw XT_BASE -00097d 1c79 .dw XT_FETCH -00097e 1cff .dw XT_TO_R -00097f 09bf .dw XT_QSIGN -000980 1cff .dw XT_TO_R -000981 09d2 .dw XT_SET_BASE -000982 09bf .dw XT_QSIGN -000983 1cf6 .dw XT_R_FROM -000984 1e1c .dw XT_OR -000985 1cff .dw XT_TO_R - ; check whether something is left -000986 1cb1 .dw XT_DUP -000987 1d1a .dw XT_ZEROEQUAL -000988 1c36 .dw XT_DOCONDBRANCH -000989 0992 DEST(PFA_NUMBER0) - ; nothing is left. It cannot be a number at all -00098a 05f4 .dw XT_2DROP -00098b 1cf6 .dw XT_R_FROM -00098c 1cd9 .dw XT_DROP -00098d 1cf6 .dw XT_R_FROM -00098e 05d6 .dw XT_BASE -00098f 1c81 .dw XT_STORE -000990 1d54 .dw XT_ZERO -000991 1c20 .dw XT_EXIT - PFA_NUMBER0: -000992 1f1e .dw XT_2TO_R -000993 1d54 .dw XT_ZERO ; starting value -000994 1d54 .dw XT_ZERO -000995 1f2d .dw XT_2R_FROM -000996 09f0 .dw XT_TO_NUMBER ; ( 0. addr len -- d addr' len' - ; check length of the remaining string. - ; if zero: a single cell number is entered -000997 1cb9 .dw XT_QDUP -000998 1c36 .dw XT_DOCONDBRANCH -000999 09b4 DEST(PFA_NUMBER1) - ; if equal 1: mayba a trailing dot? --> double cell number -00099a 1fe7 .dw XT_ONE -00099b 1fe0 .dw XT_EQUAL -00099c 1c36 .dw XT_DOCONDBRANCH -00099d 09ab DEST(PFA_NUMBER2) - ; excatly one character is left -00099e 1c98 .dw XT_CFETCH -00099f 1c3d .dw XT_DOLITERAL -0009a0 002e .dw 46 ; . -0009a1 1fe0 .dw XT_EQUAL -0009a2 1c36 .dw XT_DOCONDBRANCH -0009a3 09ac DEST(PFA_NUMBER6) - ; its a double cell number - ; incorporate sign into number -0009a4 1cf6 .dw XT_R_FROM -0009a5 1c36 .dw XT_DOCONDBRANCH -0009a6 09a8 DEST(PFA_NUMBER3) -0009a7 0d68 .dw XT_DNEGATE - PFA_NUMBER3: -0009a8 1fec .dw XT_TWO -0009a9 1c2f .dw XT_DOBRANCH -0009aa 09ba DEST(PFA_NUMBER5) - PFA_NUMBER2: -0009ab 1cd9 .dw XT_DROP - PFA_NUMBER6: -0009ac 05f4 .dw XT_2DROP -0009ad 1cf6 .dw XT_R_FROM -0009ae 1cd9 .dw XT_DROP -0009af 1cf6 .dw XT_R_FROM -0009b0 05d6 .dw XT_BASE -0009b1 1c81 .dw XT_STORE -0009b2 1d54 .dw XT_ZERO -0009b3 1c20 .dw XT_EXIT - PFA_NUMBER1: -0009b4 05f4 .dw XT_2DROP ; remove the address - ; incorporate sign into number -0009b5 1cf6 .dw XT_R_FROM -0009b6 1c36 .dw XT_DOCONDBRANCH -0009b7 09b9 DEST(PFA_NUMBER4) -0009b8 06c6 .dw XT_NEGATE - PFA_NUMBER4: -0009b9 1fe7 .dw XT_ONE - PFA_NUMBER5: -0009ba 1cf6 .dw XT_R_FROM -0009bb 05d6 .dw XT_BASE -0009bc 1c81 .dw XT_STORE -0009bd 1d4b .dw XT_TRUE -0009be 1c20 .dw XT_EXIT - .include "words/q-sign.asm" - - .if cpu_msp430==1 - .endif - - .if cpu_avr8==1 - XT_QSIGN: -0009bf 1c01 .dw DO_COLON - PFA_QSIGN: ; ( c -- ) - .endif -0009c0 1ccf .dw XT_OVER ; ( -- addr len addr ) -0009c1 1c98 .dw XT_CFETCH -0009c2 1c3d .dw XT_DOLITERAL -0009c3 002d .dw '-' -0009c4 1fe0 .dw XT_EQUAL ; ( -- addr len flag ) -0009c5 1cb1 .dw XT_DUP -0009c6 1cff .dw XT_TO_R -0009c7 1c36 .dw XT_DOCONDBRANCH -0009c8 09cb DEST(PFA_NUMBERSIGN_DONE) -0009c9 1fe7 .dw XT_ONE ; skip sign character -0009ca 0a2c .dw XT_SLASHSTRING - PFA_NUMBERSIGN_DONE: -0009cb 1cf6 .dw XT_R_FROM -0009cc 1c20 .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: -0009cd 1c52 .dw PFA_DOCONSTANT - .endif -0009ce 000a -0009cf 0010 -0009d0 0002 -0009d1 000a .dw 10,16,2,10 ; last one could a 8 instead. - - .if cpu_msp430==1 - .endif - - .if cpu_avr8==1 - XT_SET_BASE: -0009d2 1c01 .dw DO_COLON - PFA_SET_BASE: ; ( adr1 len1 -- adr2 len2 ) - .endif -0009d3 1ccf .dw XT_OVER -0009d4 1c98 .dw XT_CFETCH -0009d5 1c3d .dw XT_DOLITERAL -0009d6 0023 .dw 35 -0009d7 1d93 .dw XT_MINUS -0009d8 1cb1 .dw XT_DUP -0009d9 1d54 .dw XT_ZERO -0009da 1c3d .dw XT_DOLITERAL -0009db 0004 .dw 4 -0009dc 06fe .dw XT_WITHIN -0009dd 1c36 .dw XT_DOCONDBRANCH -0009de 09e8 DEST(SET_BASE1) - .if cpu_msp430==1 - .endif -0009df 09cd .dw XT_BASES -0009e0 1d9d .dw XT_PLUS -0009e1 1fcb .dw XT_FETCHI -0009e2 05d6 .dw XT_BASE -0009e3 1c81 .dw XT_STORE -0009e4 1fe7 .dw XT_ONE -0009e5 0a2c .dw XT_SLASHSTRING -0009e6 1c2f .dw XT_DOBRANCH -0009e7 09e9 DEST(SET_BASE2) - SET_BASE1: -0009e8 1cd9 .dw XT_DROP - SET_BASE2: -0009e9 1c20 .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: -0009ea ff07 .dw $ff07 -0009eb 6e3e -0009ec 6d75 -0009ed 6562 -0009ee 0072 .db ">number",0 -0009ef 0976 .dw VE_HEAD - .set VE_HEAD = VE_TO_NUMBER - XT_TO_NUMBER: -0009f0 1c01 .dw DO_COLON - - .endif - -0009f1 1cb1 -0009f2 1c36 TONUM1: .DW XT_DUP,XT_DOCONDBRANCH -0009f3 0a08 DEST(TONUM3) -0009f4 1ccf -0009f5 1c98 -0009f6 07da .DW XT_OVER,XT_CFETCH,XT_DIGITQ -0009f7 1d1a -0009f8 1c36 .DW XT_ZEROEQUAL,XT_DOCONDBRANCH -0009f9 09fc DEST(TONUM2) -0009fa 1cd9 -0009fb 1c20 .DW XT_DROP,XT_EXIT -0009fc 1cff -0009fd 0d8c -0009fe 05d6 -0009ff 1c79 -000a00 0140 TONUM2: .DW XT_TO_R,XT_2SWAP,XT_BASE,XT_FETCH,XT_UDSTAR -000a01 1cf6 -000a02 0138 -000a03 0d8c .DW XT_R_FROM,XT_MPLUS,XT_2SWAP -000a04 1fe7 -000a05 0a2c -000a06 1c2f .DW XT_ONE,XT_SLASHSTRING,XT_DOBRANCH -000a07 09f1 DEST(TONUM1) -000a08 1c20 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: -000a09 ff05 .dw $ff05 -000a0a 6170 -000a0b 7372 -000a0c 0065 .db "parse",0 -000a0d 09ea .dw VE_HEAD - .set VE_HEAD = VE_PARSE - XT_PARSE: -000a0e 1c01 .dw DO_COLON - PFA_PARSE: - .endif -000a0f 1cff .dw XT_TO_R ; ( -- ) -000a10 0a22 .dw XT_SOURCE ; ( -- addr len) -000a11 0604 .dw XT_TO_IN ; ( -- addr len >in) -000a12 1c79 .dw XT_FETCH -000a13 0a2c .dw XT_SLASHSTRING ; ( -- addr' len' ) - -000a14 1cf6 .dw XT_R_FROM ; ( -- addr' len' c) -000a15 08f8 .dw XT_CSCAN ; ( -- addr' len'') -000a16 1cb1 .dw XT_DUP ; ( -- addr' len'' len'') -000a17 1e2f .dw XT_1PLUS -000a18 0604 .dw XT_TO_IN ; ( -- addr' len'' len'' >in) -000a19 1e65 .dw XT_PLUSSTORE ; ( -- addr' len') -000a1a 1fe7 .dw XT_ONE -000a1b 0a2c .dw XT_SLASHSTRING -000a1c 1c20 .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: -000a1d ff06 .dw $FF06 -000a1e 6f73 -000a1f 7275 -000a20 6563 .db "source" -000a21 0a09 .dw VE_HEAD - .set VE_HEAD = VE_SOURCE - XT_SOURCE: -000a22 0c9a .dw PFA_DODEFER1 - PFA_SOURCE: - .endif -000a23 0016 .dw USER_SOURCE -000a24 0c63 .dw XT_UDEFERFETCH -000a25 0c6f .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: -000a26 ff07 .dw $ff07 -000a27 732f -000a28 7274 -000a29 6e69 -000a2a 0067 .db "/string",0 -000a2b 0a1d .dw VE_HEAD - .set VE_HEAD = VE_SLASHSTRING - XT_SLASHSTRING: -000a2c 1c01 .dw DO_COLON - PFA_SLASHSTRING: - .endif -000a2d 1ce1 .dw XT_ROT -000a2e 1ccf .dw XT_OVER -000a2f 1d9d .dw XT_PLUS -000a30 1ce1 .dw XT_ROT -000a31 1ce1 .dw XT_ROT -000a32 1d93 .dw XT_MINUS -000a33 1c20 .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: -000a34 ff0a .dw $FF0A -000a35 6170 -000a36 7372 -000a37 2d65 -000a38 616e -000a39 656d .db "parse-name" -000a3a 0a26 .dw VE_HEAD - .set VE_HEAD = VE_PARSENAME - XT_PARSENAME: -000a3b 1c01 .dw DO_COLON - PFA_PARSENAME: - .endif -000a3c 0676 .dw XT_BL -000a3d 0a3f .dw XT_SKIPSCANCHAR -000a3e 1c20 .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: -000a3f 1c01 .dw DO_COLON - PFA_SKIPSCANCHAR: - .endif -000a40 1cff .dw XT_TO_R -000a41 0a22 .dw XT_SOURCE -000a42 0604 .dw XT_TO_IN -000a43 1c79 .dw XT_FETCH -000a44 0a2c .dw XT_SLASHSTRING - -000a45 1d08 .dw XT_R_FETCH -000a46 08e1 .dw XT_CSKIP -000a47 1cf6 .dw XT_R_FROM -000a48 08f8 .dw XT_CSCAN - - ; adjust >IN -000a49 05eb .dw XT_2DUP -000a4a 1d9d .dw XT_PLUS -000a4b 0a22 .dw XT_SOURCE -000a4c 1cd9 .dw XT_DROP -000a4d 1d93 .dw XT_MINUS -000a4e 0604 .dw XT_TO_IN -000a4f 1c81 .dw XT_STORE -000a50 1c20 .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: -000a51 ff07 .dw $ff07 -000a52 6966 -000a53 646e -000a54 782d -000a55 0074 .db "find-xt",0 -000a56 0a34 .dw VE_HEAD - .set VE_HEAD = VE_FINDXT - XT_FINDXT: -000a57 1c01 .dw DO_COLON - PFA_FINDXT: - .endif -000a58 1c3d .dw XT_DOLITERAL -000a59 0a63 .dw XT_FINDXTA -000a5a 1c3d .dw XT_DOLITERAL -000a5b 0040 .dw CFG_ORDERLISTLEN -000a5c 04ee .dw XT_MAPSTACK -000a5d 1d1a .dw XT_ZEROEQUAL -000a5e 1c36 .dw XT_DOCONDBRANCH -000a5f 0a62 DEST(PFA_FINDXT1) -000a60 05f4 .dw XT_2DROP -000a61 1d54 .dw XT_ZERO - PFA_FINDXT1: -000a62 1c20 .dw XT_EXIT - - .if cpu_msp430==1 - .endif - - .if cpu_avr8==1 - - XT_FINDXTA: -000a63 1c01 .dw DO_COLON - PFA_FINDXTA: - .endif -000a64 1cff .dw XT_TO_R -000a65 05eb .dw XT_2DUP -000a66 1cf6 .dw XT_R_FROM -000a67 0cac .dw XT_SEARCH_WORDLIST -000a68 1cb1 .dw XT_DUP -000a69 1c36 .dw XT_DOCONDBRANCH -000a6a 0a70 DEST(PFA_FINDXTA1) -000a6b 1cff .dw XT_TO_R -000a6c 1cf0 .dw XT_NIP -000a6d 1cf0 .dw XT_NIP -000a6e 1cf6 .dw XT_R_FROM -000a6f 1d4b .dw XT_TRUE - PFA_FINDXTA1: -000a70 1c20 .dw XT_EXIT - - .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: -000a71 ff04 .dw $ff04 -000a72 7571 -000a73 7469 .db "quit" -000a74 0a51 .dw VE_HEAD - .set VE_HEAD = VE_QUIT - XT_QUIT: -000a75 1c01 .dw DO_COLON - .endif - PFA_QUIT: -000a76 03a3 -000a77 03aa -000a78 1c81 .dw XT_LP0,XT_LP,XT_STORE -000a79 0b10 .dw XT_SP0 -000a7a 1e96 .dw XT_SP_STORE -000a7b 0b1d .dw XT_RP0 -000a7c 1e80 .dw XT_RP_STORE -000a7d 0438 .dw XT_LBRACKET - - PFA_QUIT2: -000a7e 05d0 .dw XT_STATE -000a7f 1c79 .dw XT_FETCH -000a80 1d1a .dw XT_ZEROEQUAL -000a81 1c36 .dw XT_DOCONDBRANCH -000a82 0a84 DEST(PFA_QUIT4) -000a83 0ab4 .dw XT_PROMPTREADY - PFA_QUIT4: -000a84 0969 .dw XT_REFILL -000a85 1c36 .dw XT_DOCONDBRANCH -000a86 0a96 DEST(PFA_QUIT3) -000a87 1c3d .dw XT_DOLITERAL -000a88 0b6b .dw XT_INTERPRET -000a89 08b2 .dw XT_CATCH -000a8a 1cb9 .dw XT_QDUP -000a8b 1c36 .dw XT_DOCONDBRANCH -000a8c 0a96 DEST(PFA_QUIT3) -000a8d 1cb1 .dw XT_DUP -000a8e 1c3d .dw XT_DOLITERAL -000a8f fffe .dw -2 -000a90 1d6e .dw XT_LESS -000a91 1c36 .dw XT_DOCONDBRANCH -000a92 0a94 DEST(PFA_QUIT5) -000a93 0acf .dw XT_PROMPTERROR - PFA_QUIT5: -000a94 1c2f .dw XT_DOBRANCH -000a95 0a76 DEST(PFA_QUIT) - PFA_QUIT3: -000a96 0aa4 .dw XT_PROMPTOK -000a97 1c2f .dw XT_DOBRANCH -000a98 0a7e DEST(PFA_QUIT2) - ; .dw XT_EXIT ; never reached - - .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: -000a99 1c01 .dw DO_COLON - PFA_DEFAULT_PROMPTOK: -000a9a 07f4 .dw XT_DOSLITERAL -000a9b 0003 .dw 3 -000a9c 6f20 -000a9d 006b .db " ok",0 - .endif -000a9e 0827 .dw XT_ITYPE -000a9f 1c20 .dw XT_EXIT - - ; ------------------------ - - .if cpu_msp430==1 - .endif - - .if cpu_avr8==1 - VE_PROMPTOK: -000aa0 ff03 .dw $FF03 -000aa1 6f2e -../../common\words/prompt-ok.asm(43): warning: .cseg .db misalignment - padding zero byte -000aa2 006b .db ".ok" -000aa3 0a71 .dw VE_HEAD - .set VE_HEAD = VE_PROMPTOK - XT_PROMPTOK: -000aa4 0c9a .dw PFA_DODEFER1 - PFA_PROMPTOK: - .endif -000aa5 001c .dw USER_P_OK -000aa6 0c63 .dw XT_UDEFERFETCH -000aa7 0c6f .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: -000aa8 1c01 .dw DO_COLON - PFA_DEFAULT_PROMPTREADY: -000aa9 07f4 .dw XT_DOSLITERAL -000aaa 0002 .dw 2 -000aab 203e .db "> " - .endif -000aac 085c .dw XT_CR -000aad 0827 .dw XT_ITYPE -000aae 1c20 .dw XT_EXIT - - ; ------------------------ - - .if cpu_msp430==1 - .endif - - .if cpu_avr8==1 - VE_PROMPTREADY: -000aaf ff06 .dw $FF06 -000ab0 722e -000ab1 6165 -000ab2 7964 .db ".ready" -000ab3 0aa0 .dw VE_HEAD - .set VE_HEAD = VE_PROMPTREADY - XT_PROMPTREADY: -000ab4 0c9a .dw PFA_DODEFER1 - PFA_PROMPTREADY: - .endif -000ab5 0020 .dw USER_P_RDY -000ab6 0c63 .dw XT_UDEFERFETCH -000ab7 0c6f .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: -000ab8 1c01 .dw DO_COLON - PFA_DEFAULT_PROMPTERROR: -000ab9 07f4 .dw XT_DOSLITERAL -000aba 0004 .dw 4 -000abb 3f20 -000abc 203f .db " ?? " - .endif -000abd 0827 .dw XT_ITYPE -000abe 05d6 .dw XT_BASE -000abf 1c79 .dw XT_FETCH -000ac0 1cff .dw XT_TO_R -000ac1 0663 .dw XT_DECIMAL -000ac2 07a9 .dw XT_DOT -000ac3 0604 .dw XT_TO_IN -000ac4 1c79 .dw XT_FETCH -000ac5 07a9 .dw XT_DOT -000ac6 1cf6 .dw XT_R_FROM -000ac7 05d6 .dw XT_BASE -000ac8 1c81 .dw XT_STORE -000ac9 1c20 .dw XT_EXIT - - ; ------------------------ - - .if cpu_msp430==1 - .endif - - .if cpu_avr8==1 - VE_PROMPTERROR: -000aca ff06 .dw $FF06 -000acb 652e -000acc 7272 -000acd 726f .db ".error" -000ace 0aaf .dw VE_HEAD - .set VE_HEAD = VE_PROMPTERROR - XT_PROMPTERROR: -000acf 0c9a .dw PFA_DODEFER1 - PFA_PROMPTERROR: - .endif -000ad0 001e .dw USER_P_ERR -000ad1 0c63 .dw XT_UDEFERFETCH -000ad2 0c6f .dw XT_UDEFERSTORE - .include "words/pause.asm" - - ; Multitasking - ; Fetch pause vector and execute it. may make a context/task switch - VE_PAUSE: -000ad3 ff05 .dw $ff05 -000ad4 6170 -000ad5 7375 -000ad6 0065 .db "pause",0 -000ad7 0aca .dw VE_HEAD - .set VE_HEAD = VE_PAUSE - XT_PAUSE: -000ad8 0c9a .dw PFA_DODEFER1 - PFA_PAUSE: -000ad9 0093 .dw ram_pause -000ada 0c4f .dw XT_RDEFERFETCH -000adb 0c59 .dw XT_RDEFERSTORE - - .dseg -000093 ram_pause: .byte 2 - .cseg - .include "words/cold.asm" - - ; System - ; start up amforth. - VE_COLD: -000adc ff04 .dw $ff04 -000add 6f63 -000ade 646c .db "cold" -000adf 0ad3 .dw VE_HEAD - .set VE_HEAD = VE_COLD - XT_COLD: -000ae0 0ae1 .dw PFA_COLD - PFA_COLD: -000ae1 b6a4 in_ mcu_boot, MCUSR -000ae2 2422 clr zerol -000ae3 2433 clr zeroh -000ae4 24bb clr isrflag -000ae5 be24 out_ MCUSR, zerol - ; clear RAM -000ae6 e6e0 ldi zl, low(ramstart) -000ae7 e0f0 ldi zh, high(ramstart) - clearloop: -000ae8 9221 st Z+, zerol -000ae9 36e0 cpi zl, low(sram_size+ramstart) -000aea f7e9 brne clearloop -000aeb 30f4 cpi zh, high(sram_size+ramstart) -000aec f7d9 brne clearloop - ; init first user data area - ; allocate space for User Area - .dseg -000095 ram_user1: .byte SYSUSERSIZE + APPUSERSIZE - .cseg -000aed e9e5 ldi zl, low(ram_user1) -000aee e0f0 ldi zh, high(ram_user1) -000aef 012f movw upl, zl - ; init return stack pointer -000af0 e50f ldi temp0,low(rstackstart) -000af1 bf0d out_ SPL,temp0 -000af2 8304 std Z+4, temp0 -000af3 e014 ldi temp1,high(rstackstart) -000af4 bf1e out_ SPH,temp1 -000af5 8315 std Z+5, temp1 - - ; init parameter stack pointer -000af6 e0cf ldi yl,low(stackstart) -000af7 83c6 std Z+6, yl -000af8 e0d4 ldi yh,high(stackstart) -000af9 83d7 std Z+7, yh - - ; load Forth IP with starting word -000afa e0a3 ldi XL, low(PFA_WARM) -000afb e0bb ldi XH, high(PFA_WARM) - ; its a far jump... -000afc 940c 1c05 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: -000afe ff04 .dw $ff04 -000aff 6177 -000b00 6d72 .db "warm" -000b01 0adc .dw VE_HEAD - .set VE_HEAD = VE_WARM - XT_WARM: -000b02 1c01 .dw DO_COLON - PFA_WARM: - .endif -000b03 0dd7 .dw XT_INIT_RAM -000b04 1c3d .dw XT_DOLITERAL -000b05 0c06 .dw XT_NOOP -000b06 1c3d .dw XT_DOLITERAL -000b07 0ad8 .dw XT_PAUSE -000b08 0c7a .dw XT_DEFERSTORE -000b09 0438 .dw XT_LBRACKET -000b0a 067e .dw XT_TURNKEY -000b0b 0a75 .dw XT_QUIT ; never returns - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - .include "words/sp0.asm" - - ; Stack - ; start address of the data stack - VE_SP0: -000b0c ff03 .dw $ff03 -000b0d 7073 -000b0e 0030 .db "sp0",0 -000b0f 0afe .dw VE_HEAD - .set VE_HEAD = VE_SP0 - XT_SP0: -000b10 1c6f .dw PFA_DOVALUE1 - PFA_SP0: -000b11 0006 .dw USER_SP0 -000b12 0c63 .dw XT_UDEFERFETCH -000b13 0c6f .dw XT_UDEFERSTORE - - ; ( -- addr) - ; Stack - ; address of user variable to store top-of-stack for inactive tasks - VE_SP: -000b14 ff02 .dw $ff02 -000b15 7073 .db "sp" -000b16 0b0c .dw VE_HEAD - .set VE_HEAD = VE_SP - XT_SP: -000b17 1c58 .dw PFA_DOUSER - PFA_SP: -000b18 0008 .dw USER_SP - .include "words/rp0.asm" - - ; Stack - ; start address of return stack - VE_RP0: -000b19 ff03 .dw $ff03 -000b1a 7072 -000b1b 0030 .db "rp0",0 -000b1c 0b14 .dw VE_HEAD - .set VE_HEAD = VE_RP0 - XT_RP0: -000b1d 1c01 .dw DO_COLON - PFA_RP0: -000b1e 0b21 .dw XT_DORP0 -000b1f 1c79 .dw XT_FETCH -000b20 1c20 .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: -000b21 1c58 .dw PFA_DOUSER - PFA_DORP0: -000b22 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: -000b23 ff05 .dw $ff05 -000b24 6564 -000b25 7470 -000b26 0068 .db "depth",0 -000b27 0b19 .dw VE_HEAD - .set VE_HEAD = VE_DEPTH - XT_DEPTH: -000b28 1c01 .dw DO_COLON - PFA_DEPTH: - .endif -000b29 0b10 .dw XT_SP0 -000b2a 1e8d .dw XT_SP_FETCH -000b2b 1d93 .dw XT_MINUS -000b2c 1e04 .dw XT_2SLASH -000b2d 1e35 .dw XT_1MINUS -000b2e 1c20 .dw XT_EXIT - .include "words/recognize.asm" - - ; System - ; walk the recognizer stack - - .if cpu_msp430==1 - .endif - - .if cpu_avr8==1 - VE_RECOGNIZE: -000b2f ff09 .dw $ff09 -000b30 6572 -000b31 6f63 -000b32 6e67 -000b33 7a69 -000b34 0065 .db "recognize",0 -000b35 0b23 .dw VE_HEAD - .set VE_HEAD = VE_RECOGNIZE - XT_RECOGNIZE: -000b36 1c01 .dw DO_COLON - PFA_RECOGNIZE: - .endif -000b37 1c3d .dw XT_DOLITERAL -000b38 0b41 .dw XT_RECOGNIZE_A -000b39 1cc4 .dw XT_SWAP -000b3a 04ee .dw XT_MAPSTACK -000b3b 1d1a .dw XT_ZEROEQUAL -000b3c 1c36 .dw XT_DOCONDBRANCH -000b3d 0b40 DEST(PFA_RECOGNIZE1) -000b3e 05f4 .dw XT_2DROP -000b3f 0bd1 .dw XT_DT_NULL - PFA_RECOGNIZE1: -000b40 1c20 .dw XT_EXIT - - .if cpu_msp430==1 - .endif - - .if cpu_avr8==1 - ; ( addr len XT -- addr len [ dt:xt -1 | 0 ] ) - XT_RECOGNIZE_A: -000b41 1c01 .dw DO_COLON - PFA_RECOGNIZE_A: - .endif -000b42 1ce1 .dw XT_ROT ; -- len xt addr -000b43 1ce1 .dw XT_ROT ; -- xt addr len -000b44 05eb .dw XT_2DUP -000b45 1f1e .dw XT_2TO_R -000b46 1ce1 .dw XT_ROT ; -- addr len xt -000b47 1c2a .dw XT_EXECUTE ; -- i*x dt:* | dt:null -000b48 1f2d .dw XT_2R_FROM -000b49 1ce1 .dw XT_ROT -000b4a 1cb1 .dw XT_DUP -000b4b 0bd1 .dw XT_DT_NULL -000b4c 1fe0 .dw XT_EQUAL -000b4d 1c36 .dw XT_DOCONDBRANCH -000b4e 0b52 DEST(PFA_RECOGNIZE_A1) -000b4f 1cd9 .dw XT_DROP -000b50 1d54 .dw XT_ZERO -000b51 1c20 .dw XT_EXIT - PFA_RECOGNIZE_A1: -000b52 1cf0 .dw XT_NIP -000b53 1cf0 .dw XT_NIP -000b54 1d4b .dw XT_TRUE -000b55 1c20 .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/forth-recognizer.asm" - - ; System Value - ; address of the next free data space (RAM) cell - VE_FORTHRECOGNIZER: -000b56 ff10 .dw $ff10 -000b57 6f66 -000b58 7472 -000b59 2d68 -000b5a 6572 -000b5b 6f63 -000b5c 6e67 -000b5d 7a69 -000b5e 7265 .db "forth-recognizer" -000b5f 0b2f .dw VE_HEAD - .set VE_HEAD = VE_FORTHRECOGNIZER - XT_FORTHRECOGNIZER: -000b60 1c6f .dw PFA_DOVALUE1 - PFA_FORTHRECOGNIZER: -000b61 0034 .dw CFG_FORTHRECOGNIZER -000b62 0c3b .dw XT_EDEFERFETCH -000b63 0c45 .dw XT_EDEFERSTORE - .include "words/interpret.asm" - - ; System - ; Interpret SOURCE word by word. - - .if cpu_msp430==1 - .endif - - .if cpu_avr8==1 - VE_INTERPRET: -000b64 ff09 .dw $ff09 -000b65 6e69 -000b66 6574 -000b67 7072 -000b68 6572 -000b69 0074 .db "interpret",0 -000b6a 0b56 .dw VE_HEAD - .set VE_HEAD = VE_INTERPRET - XT_INTERPRET: -000b6b 1c01 .dw DO_COLON - .endif - PFA_INTERPRET: -000b6c 0a3b .dw XT_PARSENAME ; ( -- addr len ) -000b6d 1cb1 .dw XT_DUP ; ( -- addr len flag) -000b6e 1c36 .dw XT_DOCONDBRANCH -000b6f 0b7c DEST(PFA_INTERPRET2) -000b70 0b60 .dw XT_FORTHRECOGNIZER -000b71 0b36 .dw XT_RECOGNIZE -000b72 05d0 .dw XT_STATE -000b73 1c79 .dw XT_FETCH -000b74 1c36 .dw XT_DOCONDBRANCH -000b75 0b77 DEST(PFA_INTERPRET1) -000b76 0c32 .dw XT_ICELLPLUS ; we need the compile action - PFA_INTERPRET1: -000b77 1fcb .dw XT_FETCHI -000b78 1c2a .dw XT_EXECUTE -000b79 0bde .dw XT_QSTACK -000b7a 1c2f .dw XT_DOBRANCH -000b7b 0b6c DEST(PFA_INTERPRET) - PFA_INTERPRET2: -000b7c 05f4 .dw XT_2DROP -000b7d 1c20 .dw XT_EXIT - .include "words/rec-intnum.asm" - - ; Interpreter - ; Method table for single cell integers - .if cpu_msp430==1 - .endif - - .if cpu_avr8==1 - VE_DT_NUM: -000b7e ff06 .dw $ff06 -000b7f 7464 -000b80 6e3a -000b81 6d75 .db "dt:num" -000b82 0b64 .dw VE_HEAD - .set VE_HEAD = VE_DT_NUM - XT_DT_NUM: -000b83 1c52 .dw PFA_DOCONSTANT - PFA_DT_NUM: - .endif -000b84 0c06 .dw XT_NOOP ; interpret -000b85 02c4 .dw XT_LITERAL ; compile -000b86 02c4 .dw XT_LITERAL ; postpone - - ; ( -- addr ) - ; Interpreter - ; Method table for double cell integers - .if cpu_msp430==1 - .endif - - .if cpu_avr8==1 - VE_DT_DNUM: -000b87 ff07 .dw $ff07 -000b88 7464 -000b89 643a -000b8a 756e -000b8b 006d .db "dt:dnum",0 -000b8c 0b7e .dw VE_HEAD - .set VE_HEAD = VE_DT_DNUM - XT_DT_DNUM: -000b8d 1c52 .dw PFA_DOCONSTANT - PFA_DT_DNUM: - .endif -000b8e 0c06 .dw XT_NOOP ; interpret -000b8f 1fd8 .dw XT_2LITERAL ; compile -000b90 1fd8 .dw XT_2LITERAL ; postpone - - ; ( addr len -- f ) - ; Interpreter - ; recognizer for integer numbers - .if cpu_msp430==1 - .endif - - .if cpu_avr8==1 - - VE_REC_NUM: -000b91 ff07 .dw $ff07 -000b92 6572 -000b93 3a63 -000b94 756e -000b95 006d .db "rec:num",0 -000b96 0b87 .dw VE_HEAD - .set VE_HEAD = VE_REC_NUM - XT_REC_NUM: -000b97 1c01 .dw DO_COLON - PFA_REC_NUM: - .endif - ; try converting to a number -000b98 097b .dw XT_NUMBER -000b99 1c36 .dw XT_DOCONDBRANCH -000b9a 0ba3 DEST(PFA_REC_NONUMBER) -000b9b 1fe7 .dw XT_ONE -000b9c 1fe0 .dw XT_EQUAL -000b9d 1c36 .dw XT_DOCONDBRANCH -000b9e 0ba1 DEST(PFA_REC_INTNUM2) -000b9f 0b83 .dw XT_DT_NUM -000ba0 1c20 .dw XT_EXIT - PFA_REC_INTNUM2: -000ba1 0b8d .dw XT_DT_DNUM -000ba2 1c20 .dw XT_EXIT - PFA_REC_NONUMBER: -000ba3 0bd1 .dw XT_DT_NULL -000ba4 1c20 .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: -000ba5 ff08 .dw $ff08 -000ba6 6572 -000ba7 3a63 -000ba8 6966 -000ba9 646e .db "rec:find" -000baa 0b91 .dw VE_HEAD - .set VE_HEAD = VE_REC_FIND - XT_REC_FIND: -000bab 1c01 .dw DO_COLON - PFA_REC_FIND: - .endif -000bac 0a57 .DW XT_FINDXT -000bad 1cb1 .dw XT_DUP -000bae 1d1a .dw XT_ZEROEQUAL -000baf 1c36 .dw XT_DOCONDBRANCH -000bb0 0bb4 DEST(PFA_REC_WORD_FOUND) -000bb1 1cd9 .dw XT_DROP -000bb2 0bd1 .dw XT_DT_NULL -000bb3 1c20 .dw XT_EXIT - PFA_REC_WORD_FOUND: -000bb4 0bbb .dw XT_DT_XT - -000bb5 1c20 .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: -000bb6 ff05 .dw $ff05 -000bb7 7464 -000bb8 783a -000bb9 0074 .db "dt:xt",0 -000bba 0ba5 .dw VE_HEAD - .set VE_HEAD = VE_DT_XT - XT_DT_XT: -000bbb 1c52 .dw PFA_DOCONSTANT - PFA_DT_XT: - .endif -000bbc 0bbf .dw XT_R_WORD_INTERPRET -000bbd 0bc3 .dw XT_R_WORD_COMPILE -000bbe 1fd8 .dw XT_2LITERAL - - ; ( XT flags -- ) - ; Interpreter - ; interpret method for WORD recognizer - .if cpu_msp430==1 - .endif - - .if cpu_avr8==1 - XT_R_WORD_INTERPRET: -000bbf 1c01 .dw DO_COLON - PFA_R_WORD_INTERPRET: - .endif -000bc0 1cd9 .dw XT_DROP ; the flags are in the way -000bc1 1c2a .dw XT_EXECUTE -000bc2 1c20 .dw XT_EXIT - - ; ( XT flags -- ) - ; Interpreter - ; Compile method for WORD recognizer - .if cpu_msp430==1 - .endif - .if cpu_avr8==1 - XT_R_WORD_COMPILE: -000bc3 1c01 .dw DO_COLON - PFA_R_WORD_COMPILE: - .endif -000bc4 1d21 .dw XT_ZEROLESS -000bc5 1c36 .dw XT_DOCONDBRANCH -000bc6 0bc9 DEST(PFA_R_WORD_COMPILE1) -000bc7 02ae .dw XT_COMMA -000bc8 1c20 .dw XT_EXIT - PFA_R_WORD_COMPILE1: -000bc9 1c2a .dw XT_EXECUTE -000bca 1c20 .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: -000bcb ff07 .dw $ff07 -000bcc 7464 -000bcd 6e3a -000bce 6c75 -../../common\words/dt-null.asm(12): warning: .cseg .db misalignment - padding zero byte -000bcf 006c .db "dt:null" -000bd0 0bb6 .dw VE_HEAD - .set VE_HEAD = VE_DT_NULL - XT_DT_NULL: -000bd1 1c52 .dw PFA_DOCONSTANT - PFA_DT_NULL: - .endif -000bd2 0bd5 .dw XT_FAIL ; interpret -000bd3 0bd5 .dw XT_FAIL ; compile -000bd4 0bd5 .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: -000bd5 1c01 .dw DO_COLON - PFA_FAIL: - .endif -000bd6 1c3d .dw XT_DOLITERAL -000bd7 fff3 .dw -13 -000bd8 08c8 .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: -000bd9 ff06 .dw $ff06 -000bda 733f -000bdb 6174 -000bdc 6b63 .db "?stack" -000bdd 0bcb .dw VE_HEAD - .set VE_HEAD = VE_QSTACK - XT_QSTACK: -000bde 1c01 .dw DO_COLON - PFA_QSTACK: - .endif -000bdf 0b28 .dw XT_DEPTH -000be0 1d21 .dw XT_ZEROLESS -000be1 1c36 .dw XT_DOCONDBRANCH -000be2 0be6 DEST(PFA_QSTACK1) -000be3 1c3d .dw XT_DOLITERAL -000be4 fffc .dw -4 -000be5 08c8 .dw XT_THROW - PFA_QSTACK1: -000be6 1c20 .dw XT_EXIT - .include "words/ver.asm" - - ; Tools - ; print the version string - - .if cpu_msp430==1 - .endif - - .if cpu_avr8==1 - VE_DOT_VER: -000be7 ff03 .dw $ff03 -000be8 6576 -../../common\words/ver.asm(12): warning: .cseg .db misalignment - padding zero byte -000be9 0072 .db "ver" -000bea 0bd9 .dw VE_HEAD - .set VE_HEAD = VE_DOT_VER - XT_DOT_VER: -000beb 1c01 .dw DO_COLON - PFA_DOT_VER: - .endif -000bec 0592 .dw XT_ENV_FORTHNAME -000bed 0827 .dw XT_ITYPE -000bee 0869 .dw XT_SPACE -000bef 05d6 .dw XT_BASE -000bf0 1c79 .dw XT_FETCH - -000bf1 05a0 .dw XT_ENV_FORTHVERSION -000bf2 0663 .dw XT_DECIMAL -000bf3 0dee .dw XT_S2D -000bf4 0745 .dw XT_L_SHARP -000bf5 074d .dw XT_SHARP -000bf6 1c3d .dw XT_DOLITERAL -000bf7 002e .dw '.' -000bf8 0736 .dw XT_HOLD -000bf9 0763 .dw XT_SHARP_S -000bfa 076e .dw XT_SHARP_G -000bfb 0882 .dw XT_TYPE -000bfc 05d6 .dw XT_BASE -000bfd 1c81 .dw XT_STORE -000bfe 0869 .dw XT_SPACE -000bff 05a8 .dw XT_ENV_CPU -000c00 0827 .dw XT_ITYPE - -000c01 1c20 .dw XT_EXIT - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - .include "words/noop.asm" - - ; Tools - ; do nothing - - .if cpu_msp430==1 - .endif - - .if cpu_avr8==1 - VE_NOOP: -000c02 ff04 .dw $ff04 -000c03 6f6e -000c04 706f .db "noop" -000c05 0be7 .dw VE_HEAD - .set VE_HEAD = VE_NOOP - XT_NOOP: -000c06 1c01 .dw DO_COLON - PFA_NOOP: - .endif -000c07 1c20 .DW XT_EXIT - .include "words/unused.asm" - - ; Tools - ; Amount of available RAM (incl. PAD) - VE_UNUSED: -000c08 ff06 .dw $ff06 -000c09 6e75 -000c0a 7375 -000c0b 6465 .db "unused" -000c0c 0c02 .dw VE_HEAD - .set VE_HEAD = VE_UNUSED - XT_UNUSED: -000c0d 1c01 .dw DO_COLON - PFA_UNUSED: -000c0e 1e8d .dw XT_SP_FETCH -000c0f 0645 .dw XT_HERE -000c10 1d93 .dw XT_MINUS -000c11 1c20 .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: -000c12 0002 .dw $0002 -000c13 6f74 .db "to" -000c14 0c08 .dw VE_HEAD - .set VE_HEAD = VE_TO - XT_TO: -000c15 1c01 .dw DO_COLON - PFA_TO: - .endif -000c16 0891 .dw XT_TICK -000c17 0df7 .dw XT_TO_BODY -000c18 05d0 .dw XT_STATE -000c19 1c79 .dw XT_FETCH -000c1a 1c36 .dw XT_DOCONDBRANCH -000c1b 0c26 DEST(PFA_TO1) -000c1c 02a3 .dw XT_COMPILE -000c1d 0c20 .dw XT_DOTO -000c1e 02ae .dw XT_COMMA -000c1f 1c20 .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: -000c20 1c01 .dw DO_COLON - PFA_DOTO: - .endif -000c21 1cf6 .dw XT_R_FROM -000c22 1cb1 .dw XT_DUP -000c23 0c32 .dw XT_ICELLPLUS -000c24 1cff .dw XT_TO_R -000c25 1fcb .dw XT_FETCHI - PFA_TO1: -000c26 1cb1 .dw XT_DUP -000c27 0c32 .dw XT_ICELLPLUS -000c28 0c32 .dw XT_ICELLPLUS -000c29 1fcb .dw XT_FETCHI -000c2a 1c2a .dw XT_EXECUTE -000c2b 1c20 .dw XT_EXIT - .include "words/i-cellplus.asm" - - ; Compiler - ; skip to the next cell in flash - VE_ICELLPLUS: -000c2c ff07 .dw $FF07 -000c2d 2d69 -000c2e 6563 -000c2f 6c6c -000c30 002b .db "i-cell+",0 -000c31 0c12 .dw VE_HEAD - .set VE_HEAD = VE_ICELLPLUS - XT_ICELLPLUS: -000c32 1c01 .dw DO_COLON - PFA_ICELLPLUS: -000c33 1e2f .dw XT_1PLUS -000c34 1c20 .dw XT_EXIT - - .include "words/edefer-fetch.asm" - - ; System - ; does the real defer@ for eeprom defers - VE_EDEFERFETCH: -000c35 ff07 .dw $ff07 -000c36 6445 -000c37 6665 -000c38 7265 -000c39 0040 .db "Edefer@",0 -000c3a 0c2c .dw VE_HEAD - .set VE_HEAD = VE_EDEFERFETCH - XT_EDEFERFETCH: -000c3b 1c01 .dw DO_COLON - PFA_EDEFERFETCH: -000c3c 1fcb .dw XT_FETCHI -000c3d 1f5f .dw XT_FETCHE -000c3e 1c20 .dw XT_EXIT - .include "words/edefer-store.asm" - - ; System - ; does the real defer! for eeprom defers - VE_EDEFERSTORE: -000c3f ff07 .dw $ff07 -000c40 6445 -000c41 6665 -000c42 7265 -000c43 0021 .db "Edefer!",0 -000c44 0c35 .dw VE_HEAD - .set VE_HEAD = VE_EDEFERSTORE - XT_EDEFERSTORE: -000c45 1c01 .dw DO_COLON - PFA_EDEFERSTORE: -000c46 1fcb .dw XT_FETCHI -000c47 1f3b .dw XT_STOREE -000c48 1c20 .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: -000c49 ff07 .dw $ff07 -000c4a 6452 -000c4b 6665 -000c4c 7265 -000c4d 0040 .db "Rdefer@",0 -000c4e 0c3f .dw VE_HEAD - .set VE_HEAD = VE_RDEFERFETCH - XT_RDEFERFETCH: -000c4f 1c01 .dw DO_COLON - PFA_RDEFERFETCH: - .endif -000c50 1fcb .dw XT_FETCHI -000c51 1c79 .dw XT_FETCH -000c52 1c20 .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: -000c53 ff07 .dw $ff07 -000c54 6452 -000c55 6665 -000c56 7265 -000c57 0021 .db "Rdefer!",0 -000c58 0c49 .dw VE_HEAD - .set VE_HEAD = VE_RDEFERSTORE - XT_RDEFERSTORE: -000c59 1c01 .dw DO_COLON - PFA_RDEFERSTORE: - .endif -000c5a 1fcb .dw XT_FETCHI -000c5b 1c81 .dw XT_STORE -000c5c 1c20 .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: -000c5d ff07 .dw $ff07 -000c5e 6455 -000c5f 6665 -000c60 7265 -000c61 0040 .db "Udefer@",0 -000c62 0c53 .dw VE_HEAD - .set VE_HEAD = VE_UDEFERFETCH - XT_UDEFERFETCH: -000c63 1c01 .dw DO_COLON - PFA_UDEFERFETCH: - .endif -000c64 1fcb .dw XT_FETCHI -000c65 1f02 .dw XT_UP_FETCH -000c66 1d9d .dw XT_PLUS -000c67 1c79 .dw XT_FETCH -000c68 1c20 .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: -000c69 ff07 .dw $ff07 -000c6a 6455 -000c6b 6665 -000c6c 7265 -000c6d 0021 .db "Udefer!",0 -000c6e 0c5d .dw VE_HEAD - .set VE_HEAD = VE_UDEFERSTORE - XT_UDEFERSTORE: -000c6f 1c01 .dw DO_COLON - PFA_UDEFERSTORE: - .endif - -000c70 1fcb .dw XT_FETCHI -000c71 1f02 .dw XT_UP_FETCH -000c72 1d9d .dw XT_PLUS -000c73 1c81 .dw XT_STORE -000c74 1c20 .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: -000c75 ff06 .dw $ff06 -000c76 6564 -000c77 6566 -000c78 2172 .db "defer!" -000c79 0c69 .dw VE_HEAD - .set VE_HEAD = VE_DEFERSTORE - XT_DEFERSTORE: -000c7a 1c01 .dw DO_COLON - PFA_DEFERSTORE: - .endif -000c7b 0df7 .dw XT_TO_BODY -000c7c 1cb1 .dw XT_DUP -000c7d 0c32 .dw XT_ICELLPLUS -000c7e 0c32 .dw XT_ICELLPLUS -000c7f 1fcb .dw XT_FETCHI -000c80 1c2a .dw XT_EXECUTE -000c81 1c20 .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: -000c82 ff06 .dw $ff06 -000c83 6564 -000c84 6566 -000c85 4072 .db "defer@" -000c86 0c75 .dw VE_HEAD - .set VE_HEAD = VE_DEFERFETCH - XT_DEFERFETCH: -000c87 1c01 .dw DO_COLON - PFA_DEFERFETCH: - .endif -000c88 0df7 .dw XT_TO_BODY -000c89 1cb1 .dw XT_DUP -000c8a 0c32 .dw XT_ICELLPLUS -000c8b 1fcb .dw XT_FETCHI -000c8c 1c2a .dw XT_EXECUTE -000c8d 1c20 .dw XT_EXIT - .include "words/do-defer.asm" - - ; System - ; runtime of defer - VE_DODEFER: -000c8e ff07 .dw $ff07 -000c8f 6428 -000c90 6665 -000c91 7265 -000c92 0029 .db "(defer)", 0 -000c93 0c82 .dw VE_HEAD - .set VE_HEAD = VE_DODEFER - XT_DODEFER: -000c94 1c01 .dw DO_COLON - PFA_DODEFER: -000c95 0280 .dw XT_DOCREATE -000c96 03e0 .dw XT_REVEAL -000c97 02a3 .dw XT_COMPILE -000c98 0c9a .dw PFA_DODEFER1 -000c99 1c20 .dw XT_EXIT - PFA_DODEFER1: -000c9a 940e 03f9 call_ DO_DODOES -000c9c 1cb1 .dw XT_DUP -000c9d 0c32 .dw XT_ICELLPLUS -000c9e 1fcb .dw XT_FETCHI -000c9f 1c2a .dw XT_EXECUTE -000ca0 1c2a .dw XT_EXECUTE -000ca1 1c20 .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: -000ca2 ff0f .dw $ff0f -000ca3 6573 -000ca4 7261 -000ca5 6863 -000ca6 772d -000ca7 726f -000ca8 6c64 -000ca9 7369 -000caa 0074 .db "search-wordlist",0 -000cab 0c8e .dw VE_HEAD - .set VE_HEAD = VE_SEARCH_WORDLIST - XT_SEARCH_WORDLIST: -000cac 1c01 .dw DO_COLON - PFA_SEARCH_WORDLIST: - .endif -000cad 1cff .dw XT_TO_R -000cae 1d54 .dw XT_ZERO -000caf 1c3d .dw XT_DOLITERAL -000cb0 0cc1 .dw XT_ISWORD -000cb1 1cf6 .dw XT_R_FROM -000cb2 0cde .dw XT_TRAVERSEWORDLIST -000cb3 1cb1 .dw XT_DUP -000cb4 1d1a .dw XT_ZEROEQUAL -000cb5 1c36 .dw XT_DOCONDBRANCH -000cb6 0cbb DEST(PFA_SEARCH_WORDLIST1) -000cb7 05f4 .dw XT_2DROP -000cb8 1cd9 .dw XT_DROP -000cb9 1d54 .dw XT_ZERO -000cba 1c20 .dw XT_EXIT - PFA_SEARCH_WORDLIST1: - ; ... get the XT ... -000cbb 1cb1 .dw XT_DUP -000cbc 0d05 .dw XT_NFA2CFA - ; .. and get the header flag -000cbd 1cc4 .dw XT_SWAP -000cbe 0175 .dw XT_NAME2FLAGS -000cbf 0163 .dw XT_IMMEDIATEQ -000cc0 1c20 .dw XT_EXIT - - .if cpu_msp430==1 - .endif - - .if cpu_avr8==1 - XT_ISWORD: -000cc1 1c01 .dw DO_COLON - PFA_ISWORD: - .endif - ; ( c-addr len 0 nt -- c-addr len 0 true| nt false ) -000cc2 1cff .dw XT_TO_R -000cc3 1cd9 .dw XT_DROP -000cc4 05eb .dw XT_2DUP -000cc5 1d08 .dw XT_R_FETCH ; -- addr len addr len nt -000cc6 0cf9 .dw XT_NAME2STRING -000cc7 0d0f .dw XT_ICOMPARE ; (-- addr len f ) -000cc8 1c36 .dw XT_DOCONDBRANCH -000cc9 0ccf DEST(PFA_ISWORD3) - ; not now -000cca 1cf6 .dw XT_R_FROM -000ccb 1cd9 .dw XT_DROP -000ccc 1d54 .dw XT_ZERO -000ccd 1d4b .dw XT_TRUE ; maybe next word -000cce 1c20 .dw XT_EXIT - PFA_ISWORD3: - ; we found the word, now clean up iteration data ... -000ccf 05f4 .dw XT_2DROP -000cd0 1cf6 .dw XT_R_FROM -000cd1 1d54 .dw XT_ZERO ; finish traverse-wordlist -000cd2 1c20 .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: -000cd3 ff11 .dw $ff11 -000cd4 7274 -000cd5 7661 -000cd6 7265 -000cd7 6573 -000cd8 772d -000cd9 726f -000cda 6c64 -000cdb 7369 -000cdc 0074 .db "traverse-wordlist",0 -000cdd 0ca2 .dw VE_HEAD - .set VE_HEAD = VE_TRAVERSEWORDLIST - XT_TRAVERSEWORDLIST: -000cde 1c01 .dw DO_COLON - PFA_TRAVERSEWORDLIST: - - .endif -000cdf 1f5f .dw XT_FETCHE - PFA_TRAVERSEWORDLIST1: -000ce0 1cb1 .dw XT_DUP ; ( -- xt nt nt ) -000ce1 1c36 .dw XT_DOCONDBRANCH ; ( -- nt ) is nfa = counted string -000ce2 0cef DEST(PFA_TRAVERSEWORDLIST2) -000ce3 05eb .dw XT_2DUP -000ce4 1f1e .dw XT_2TO_R -000ce5 1cc4 .dw XT_SWAP -000ce6 1c2a .dw XT_EXECUTE -000ce7 1f2d .dw XT_2R_FROM -000ce8 1ce1 .dw XT_ROT -000ce9 1c36 .dw XT_DOCONDBRANCH -000cea 0cef DEST(PFA_TRAVERSEWORDLIST2) -000ceb 055d .dw XT_NFA2LFA -000cec 1fcb .dw XT_FETCHI -000ced 1c2f .dw XT_DOBRANCH ; ( -- addr ) -000cee 0ce0 DEST(PFA_TRAVERSEWORDLIST1) ; ( -- addr ) - PFA_TRAVERSEWORDLIST2: -000cef 05f4 .dw XT_2DROP -000cf0 1c20 .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: -000cf1 ff0b .dw $ff0b -000cf2 616e -000cf3 656d -000cf4 733e -000cf5 7274 -000cf6 6e69 -000cf7 0067 .db "name>string",0 -000cf8 0cd3 .dw VE_HEAD - .set VE_HEAD = VE_NAME2STRING - XT_NAME2STRING: -000cf9 1c01 .dw DO_COLON - PFA_NAME2STRING: - - .endif -000cfa 0853 .dw XT_ICOUNT ; ( -- addr n ) -000cfb 1c3d .dw XT_DOLITERAL -000cfc 00ff .dw 255 -000cfd 1e13 .dw XT_AND ; mask immediate bit -000cfe 1c20 .dw XT_EXIT - .include "words/nfa2cfa.asm" - - ; Tools - ; get the XT from a name token - VE_NFA2CFA: -000cff ff07 .dw $ff07 -000d00 666e -000d01 3e61 -000d02 6663 -../../avr8\words/nfa2cfa.asm(6): warning: .cseg .db misalignment - padding zero byte -000d03 0061 .db "nfa>cfa" -000d04 0cf1 .dw VE_HEAD - .set VE_HEAD = VE_NFA2CFA - XT_NFA2CFA: -000d05 1c01 .dw DO_COLON - PFA_NFA2CFA: -000d06 055d .dw XT_NFA2LFA ; skip to link field -000d07 1e2f .dw XT_1PLUS ; next is the execution token -000d08 1c20 .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: -000d09 ff08 .dw $ff08 -000d0a 6369 -000d0b 6d6f -000d0c 6170 -000d0d 6572 .db "icompare" -000d0e 0cff .dw VE_HEAD - .set VE_HEAD = VE_ICOMPARE - XT_ICOMPARE: -000d0f 1c01 .dw DO_COLON - PFA_ICOMPARE: -000d10 1cff .dw XT_TO_R ; ( -- r-addr r-len f-addr) -000d11 1ccf .dw XT_OVER ; ( -- r-addr r-len f-addr r-len) -000d12 1cf6 .dw XT_R_FROM ; ( -- r-addr r-len f-addr r-len f-len ) -000d13 1d13 .dw XT_NOTEQUAL ; ( -- r-addr r-len f-addr flag ) -000d14 1c36 .dw XT_DOCONDBRANCH -000d15 0d1a .dw PFA_ICOMPARE_SAMELEN -000d16 05f4 .dw XT_2DROP -000d17 1cd9 .dw XT_DROP -000d18 1d4b .dw XT_TRUE -000d19 1c20 .dw XT_EXIT - PFA_ICOMPARE_SAMELEN: -000d1a 1cc4 .dw XT_SWAP ; ( -- r-addr f-addr len ) -000d1b 1d54 .dw XT_ZERO -000d1c 036d .dw XT_QDOCHECK -000d1d 1c36 .dw XT_DOCONDBRANCH -000d1e 0d3d .dw PFA_ICOMPARE_DONE -000d1f 1e9b .dw XT_DODO - PFA_ICOMPARE_LOOP: - ; ( r-addr f-addr --) -000d20 1ccf .dw XT_OVER -000d21 1c79 .dw XT_FETCH - .if WANT_IGNORECASE == 1 - .endif -000d22 1ccf .dw XT_OVER -000d23 1fcb .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 -000d24 1cb1 .dw XT_DUP - ;.dw XT_BYTESWAP -000d25 1c3d .dw XT_DOLITERAL -000d26 0100 .dw $100 -000d27 1d5c .dw XT_ULESS -000d28 1c36 .dw XT_DOCONDBRANCH -000d29 0d2e .dw PFA_ICOMPARE_LASTCELL -000d2a 1cc4 .dw XT_SWAP -000d2b 1c3d .dw XT_DOLITERAL -000d2c 00ff .dw $00FF -000d2d 1e13 .dw XT_AND ; the final swap can be omitted - PFA_ICOMPARE_LASTCELL: -000d2e 1d13 .dw XT_NOTEQUAL -000d2f 1c36 .dw XT_DOCONDBRANCH -000d30 0d35 .dw PFA_ICOMPARE_NEXTLOOP -000d31 05f4 .dw XT_2DROP -000d32 1d4b .dw XT_TRUE -000d33 1ed4 .dw XT_UNLOOP -000d34 1c20 .dw XT_EXIT - PFA_ICOMPARE_NEXTLOOP: -000d35 1e2f .dw XT_1PLUS -000d36 1cc4 .dw XT_SWAP -000d37 05e3 .dw XT_CELLPLUS -000d38 1cc4 .dw XT_SWAP -000d39 1c3d .dw XT_DOLITERAL -000d3a 0002 .dw 2 -000d3b 1eba .dw XT_DOPLUSLOOP -000d3c 0d20 .dw PFA_ICOMPARE_LOOP - PFA_ICOMPARE_DONE: -000d3d 05f4 .dw XT_2DROP -000d3e 1d54 .dw XT_ZERO -000d3f 1c20 .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: -000d40 ff01 .dw $ff01 -000d41 002a .db "*",0 -000d42 0d09 .dw VE_HEAD - .set VE_HEAD = VE_STAR - XT_STAR: -000d43 1c01 .dw DO_COLON - PFA_STAR: - .endif - -000d44 1da6 .dw XT_MSTAR -000d45 1cd9 .dw XT_DROP -000d46 1c20 .dw XT_EXIT - .include "words/j.asm" - - ; Compiler - ; loop counter of outer loop - VE_J: -000d47 ff01 .dw $FF01 -000d48 006a .db "j",0 -000d49 0d40 .dw VE_HEAD - .set VE_HEAD = VE_J - XT_J: -000d4a 1c01 .dw DO_COLON - PFA_J: -000d4b 1e76 .dw XT_RP_FETCH -000d4c 1c3d .dw XT_DOLITERAL -000d4d 0007 .dw 7 -000d4e 1d9d .dw XT_PLUS -000d4f 1c79 .dw XT_FETCH -000d50 1e76 .dw XT_RP_FETCH -000d51 1c3d .dw XT_DOLITERAL -000d52 0009 .dw 9 -000d53 1d9d .dw XT_PLUS -000d54 1c79 .dw XT_FETCH -000d55 1d9d .dw XT_PLUS -000d56 1c20 .dw XT_EXIT - - .include "words/dabs.asm" - - ; Arithmetics - ; double cell absolute value - VE_DABS: -000d57 ff04 .dw $ff04 -000d58 6164 -000d59 7362 .db "dabs" -000d5a 0d47 .dw VE_HEAD - .set VE_HEAD = VE_DABS - XT_DABS: -000d5b 1c01 .dw DO_COLON - PFA_DABS: -000d5c 1cb1 .dw XT_DUP -000d5d 1d21 .dw XT_ZEROLESS -000d5e 1c36 .dw XT_DOCONDBRANCH -000d5f 0d61 .dw PFA_DABS1 -000d60 0d68 .dw XT_DNEGATE - PFA_DABS1: -000d61 1c20 .dw XT_EXIT - ; : dabs ( ud1 -- +d2 ) dup 0< if dnegate then ; - .include "words/dnegate.asm" - - ; Arithmetics - ; double cell negation - VE_DNEGATE: -000d62 ff07 .dw $ff07 -000d63 6e64 -000d64 6765 -000d65 7461 -000d66 0065 .db "dnegate",0 -000d67 0d57 .dw VE_HEAD - .set VE_HEAD = VE_DNEGATE - XT_DNEGATE: -000d68 1c01 .dw DO_COLON - PFA_DNEGATE: -000d69 01c4 .dw XT_DINVERT -000d6a 1fe7 .dw XT_ONE -000d6b 1d54 .dw XT_ZERO -000d6c 019c .dw XT_DPLUS -000d6d 1c20 .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: -000d6e ff05 .dw $ff05 -000d6f 6d63 -000d70 766f -000d71 0065 .db "cmove",0 -000d72 0d62 .dw VE_HEAD - .set VE_HEAD = VE_CMOVE - XT_CMOVE: -000d73 0d74 .dw PFA_CMOVE - PFA_CMOVE: -000d74 93bf push xh -000d75 93af push xl -000d76 91e9 ld zl, Y+ -000d77 91f9 ld zh, Y+ ; addr-to -000d78 91a9 ld xl, Y+ -000d79 91b9 ld xh, Y+ ; addr-from -000d7a 2f09 mov temp0, tosh -000d7b 2b08 or temp0, tosl -000d7c f021 brbs 1, PFA_CMOVE1 - PFA_CMOVE2: -000d7d 911d ld temp1, X+ -000d7e 9311 st Z+, temp1 -000d7f 9701 sbiw tosl, 1 -000d80 f7e1 brbc 1, PFA_CMOVE2 - PFA_CMOVE1: -000d81 91af pop xl -000d82 91bf pop xh -000d83 9189 -000d84 9199 loadtos -000d85 940c 1c05 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: -000d87 ff05 .dw $ff05 -000d88 7332 -000d89 6177 -000d8a 0070 .db "2swap",0 -000d8b 0d6e .dw VE_HEAD - .set VE_HEAD = VE_2SWAP - XT_2SWAP: -000d8c 1c01 .dw DO_COLON - PFA_2SWAP: - - .endif -000d8d 1ce1 .dw XT_ROT -000d8e 1cff .dw XT_TO_R -000d8f 1ce1 .dw XT_ROT -000d90 1cf6 .dw XT_R_FROM -000d91 1c20 .dw XT_EXIT - - .include "words/tib.asm" - - ; System - ; refills the input buffer - .if cpu_msp430==1 - .endif - - .if cpu_avr8==1 - VE_REFILLTIB: -000d92 ff0a .dw $ff0a -000d93 6572 -000d94 6966 -000d95 6c6c -000d96 742d -000d97 6269 .db "refill-tib" -000d98 0d87 .dw VE_HEAD - .set VE_HEAD = VE_REFILLTIB - XT_REFILLTIB: -000d99 1c01 .dw DO_COLON - PFA_REFILLTIB: - .endif -000d9a 0db5 .dw XT_TIB -000d9b 1c3d .dw XT_DOLITERAL -000d9c 005a .dw TIB_SIZE -000d9d 0918 .dw XT_ACCEPT -000d9e 0dbb .dw XT_NUMBERTIB -000d9f 1c81 .dw XT_STORE -000da0 1d54 .dw XT_ZERO -000da1 0604 .dw XT_TO_IN -000da2 1c81 .dw XT_STORE -000da3 1d4b .dw XT_TRUE ; -1 -000da4 1c20 .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: -000da5 ff0a .dw $FF0A -000da6 6f73 -000da7 7275 -000da8 6563 -000da9 742d -000daa 6269 .db "source-tib" -000dab 0d92 .dw VE_HEAD - .set VE_HEAD = VE_SOURCETIB - XT_SOURCETIB: -000dac 1c01 .dw DO_COLON - PFA_SOURCETIB: - .endif -000dad 0db5 .dw XT_TIB -000dae 0dbb .dw XT_NUMBERTIB -000daf 1c79 .dw XT_FETCH -000db0 1c20 .dw XT_EXIT - - ; ( -- addr ) - ; System Variable - ; terminal input buffer address - .if cpu_msp430==1 - .endif - - .if cpu_avr8==1 - VE_TIB: -000db1 ff03 .dw $ff03 -000db2 6974 -000db3 0062 .db "tib",0 -000db4 0da5 .dw VE_HEAD - .set VE_HEAD = VE_TIB - XT_TIB: -000db5 1c48 .dw PFA_DOVARIABLE - PFA_TIB: -000db6 00c1 .dw ram_tib - .dseg -0000c1 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: -000db7 ff04 .dw $ff04 -000db8 7423 -000db9 6269 .db "#tib" -000dba 0db1 .dw VE_HEAD - .set VE_HEAD = VE_NUMBERTIB - XT_NUMBERTIB: -000dbb 1c48 .dw PFA_DOVARIABLE - PFA_NUMBERTIB: -000dbc 011b .dw ram_sharptib - .dseg -00011b ram_sharptib: .byte 2 - .cseg - .endif - - .include "words/init-ram.asm" - - ; Tools - ; copy len cells from eeprom to ram - VE_EE2RAM: -000dbd ff06 .dw $ff06 -000dbe 6565 -000dbf 723e -000dc0 6d61 .db "ee>ram" -000dc1 0db7 .dw VE_HEAD - .set VE_HEAD = VE_EE2RAM - XT_EE2RAM: -000dc2 1c01 .dw DO_COLON - PFA_EE2RAM: ; ( -- ) -000dc3 1d54 .dw XT_ZERO -000dc4 1e9b .dw XT_DODO - PFA_EE2RAM_1: - ; ( -- e-addr r-addr ) -000dc5 1ccf .dw XT_OVER -000dc6 1f5f .dw XT_FETCHE -000dc7 1ccf .dw XT_OVER -000dc8 1c81 .dw XT_STORE -000dc9 05e3 .dw XT_CELLPLUS -000dca 1cc4 .dw XT_SWAP -000dcb 05e3 .dw XT_CELLPLUS -000dcc 1cc4 .dw XT_SWAP -000dcd 1ec9 .dw XT_DOLOOP -000dce 0dc5 .dw PFA_EE2RAM_1 - PFA_EE2RAM_2: -000dcf 05f4 .dw XT_2DROP -000dd0 1c20 .dw XT_EXIT - - ; ( -- ) - ; Tools - ; setup the default user area from eeprom - VE_INIT_RAM: -000dd1 ff08 .dw $ff08 -000dd2 6e69 -000dd3 7469 -000dd4 722d -000dd5 6d61 .db "init-ram" -000dd6 0dbd .dw VE_HEAD - .set VE_HEAD = VE_INIT_RAM - XT_INIT_RAM: -000dd7 1c01 .dw DO_COLON - PFA_INI_RAM: ; ( -- ) -000dd8 1c3d .dw XT_DOLITERAL -000dd9 0060 .dw EE_INITUSER -000dda 1f02 .dw XT_UP_FETCH -000ddb 1c3d .dw XT_DOLITERAL -000ddc 0022 .dw SYSUSERSIZE -000ddd 1e04 .dw XT_2SLASH -000dde 0dc2 .dw XT_EE2RAM -000ddf 1c20 .dw XT_EXIT - .include "words/bounds.asm" - - ; Tools - ; convert a string to an address range - - .if cpu_msp430==1 - .endif - - .if cpu_avr8==1 - VE_BOUNDS: -000de0 ff06 .dw $ff06 -000de1 6f62 -000de2 6e75 -000de3 7364 .db "bounds" -000de4 0dd1 .dw VE_HEAD - .set VE_HEAD = VE_BOUNDS - XT_BOUNDS: -000de5 1c01 .dw DO_COLON - PFA_BOUNDS: - .endif -000de6 1ccf .dw XT_OVER -000de7 1d9d .dw XT_PLUS -000de8 1cc4 .dw XT_SWAP -000de9 1c20 .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: -000dea ff03 .dw $ff03 -000deb 3e73 -000dec 0064 .db "s>d",0 -000ded 0de0 .dw VE_HEAD - .set VE_HEAD = VE_S2D - XT_S2D: -000dee 1c01 .dw DO_COLON - PFA_S2D: - .endif -000def 1cb1 .dw XT_DUP -000df0 1d21 .dw XT_ZEROLESS -000df1 1c20 .dw XT_EXIT - .include "words/to-body.asm" - - ; Core - ; get body from XT - VE_TO_BODY: -000df2 ff05 .dw $ff05 -000df3 623e -000df4 646f -000df5 0079 .db ">body",0 -000df6 0dea .dw VE_HEAD - .set VE_HEAD = VE_TO_BODY - XT_TO_BODY: -000df7 1e30 .dw PFA_1PLUS - .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: -000df8 ff02 .dw $ff02 -000df9 732e .db ".s" -000dfa 0df2 .dw VE_HEAD - .set VE_HEAD = VE_DOTS - XT_DOTS: -000dfb 1c01 .dw DO_COLON - PFA_DOTS: - .endif -000dfc 0b28 .dw XT_DEPTH -000dfd 01d2 .dw XT_UDOT -000dfe 0869 .dw XT_SPACE -000dff 0b28 .dw XT_DEPTH -000e00 1d54 .dw XT_ZERO -000e01 036d .dw XT_QDOCHECK -000e02 1c36 .dw XT_DOCONDBRANCH -000e03 0e0a DEST(PFA_DOTS2) -000e04 1e9b .dw XT_DODO - PFA_DOTS1: -000e05 1eac .dw XT_I -000e06 023d .dw XT_PICK -000e07 01d2 .dw XT_UDOT -000e08 1ec9 .dw XT_DOLOOP -000e09 0e05 DEST(PFA_DOTS1) - PFA_DOTS2: -000e0a 1c20 .dw XT_EXIT - .include "words/spirw.asm" - - ; MCU - ; SPI exchange of 1 byte - VE_SPIRW: -000e0b ff06 .dw $ff06 -000e0c 2163 -000e0d 7340 -000e0e 6970 .db "c!@spi" -000e0f 0df8 .dw VE_HEAD - .set VE_HEAD = VE_SPIRW - XT_SPIRW: -000e10 0e11 .dw PFA_SPIRW - PFA_SPIRW: -000e11 d003 rcall do_spirw -000e12 2799 clr tosh -000e13 940c 1c05 jmp_ DO_NEXT - - do_spirw: -000e15 b98f out_ SPDR, tosl - do_spirw1: -000e16 b10e in_ temp0, SPSR -000e17 7f08 cbr temp0,7 -000e18 b90e out_ SPSR, temp0 -000e19 b10e in_ temp0, SPSR -000e1a ff07 sbrs temp0, 7 -000e1b cffa rjmp do_spirw1 ; wait until complete -000e1c b18f in_ tosl, SPDR -000e1d 9508 ret - .include "words/n-spi.asm" - - ; MCU - ; read len bytes from SPI to addr - VE_N_SPIR: -000e1e ff05 .dw $ff05 -000e1f 406e -000e20 7073 -000e21 0069 .db "n@spi",0 -000e22 0e0b .dw VE_HEAD - .set VE_HEAD = VE_N_SPIR - XT_N_SPIR: -000e23 0e24 .dw PFA_N_SPIR - PFA_N_SPIR: -000e24 018c movw temp0, tosl -000e25 9189 -000e26 9199 loadtos -000e27 01fc movw zl, tosl -000e28 01c8 movw tosl, temp0 - PFA_N_SPIR_LOOP: -000e29 b82f out_ SPDR, zerol - PFA_N_SPIR_LOOP1: -000e2a b12e in_ temp2, SPSR -000e2b ff27 sbrs temp2, SPIF -000e2c cffd rjmp PFA_N_SPIR_LOOP1 -000e2d b12f in_ temp2, SPDR -000e2e 9321 st Z+, temp2 -000e2f 9701 sbiw tosl, 1 -000e30 f7c1 brne PFA_N_SPIR_LOOP -000e31 9189 -000e32 9199 loadtos -000e33 940c 1c05 jmp_ DO_NEXT - - ; ( addr len -- ) - ; MCU - ; write len bytes to SPI from addr - VE_N_SPIW: -000e35 ff05 .dw $ff05 -000e36 216e -000e37 7073 -000e38 0069 .db "n!spi",0 -000e39 0e1e .dw VE_HEAD - .set VE_HEAD = VE_N_SPIW - XT_N_SPIW: -000e3a 0e3b .dw PFA_N_SPIW - PFA_N_SPIW: -000e3b 018c movw temp0, tosl -000e3c 9189 -000e3d 9199 loadtos -000e3e 01fc movw zl, tosl -000e3f 01c8 movw tosl, temp0 - PFA_N_SPIW_LOOP: -000e40 9121 ld temp2, Z+ -000e41 b92f out_ SPDR, temp2 - PFA_N_SPIW_LOOP1: -000e42 b12e in_ temp2, SPSR -000e43 ff27 sbrs temp2, SPIF -000e44 cffd rjmp PFA_N_SPIW_LOOP1 -000e45 b12f in_ temp2, SPDR ; ignore the data -000e46 9701 sbiw tosl, 1 -000e47 f7c1 brne PFA_N_SPIW_LOOP -000e48 9189 -000e49 9199 loadtos -000e4a 940c 1c05 jmp_ DO_NEXT - .include "words/applturnkey.asm" - - ; R( -- ) - ; application specific turnkey action - VE_APPLTURNKEY: -000e4c ff0b .dw $ff0b -000e4d 7061 -000e4e 6c70 -000e4f 7574 -000e50 6e72 -000e51 656b -000e52 0079 .db "applturnkey",0 -000e53 0e35 .dw VE_HEAD - .set VE_HEAD = VE_APPLTURNKEY - XT_APPLTURNKEY: -000e54 1c01 .dw DO_COLON - PFA_APPLTURNKEY: -000e55 00bc .dw XT_USART - - .if WANT_INTERRUPTS == 1 -000e56 0203 .dw XT_INTON - .endif -000e57 0beb .dw XT_DOT_VER -000e58 0869 .dw XT_SPACE -000e59 05c5 .dw XT_F_CPU -000e5a 1c3d .dw XT_DOLITERAL -000e5b 03e8 .dw 1000 -000e5c 1dc2 .dw XT_UMSLASHMOD -000e5d 1cf0 .dw XT_NIP -000e5e 0663 .dw XT_DECIMAL -000e5f 07a9 .dw XT_DOT -000e60 07f4 .dw XT_DOSLITERAL -000e61 0004 .dw 4 -000e62 486b -000e63 207a .db "kHz " -000e64 0827 .dw XT_ITYPE -000e65 1c20 .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: -000e66 ff0b .dw $ff0b -000e67 6573 -000e68 2d74 -000e69 7563 -000e6a 7272 -000e6b 6e65 -000e6c 0074 .db "set-current",0 -000e6d 0e4c .dw VE_HEAD - .set VE_HEAD = VE_SET_CURRENT - XT_SET_CURRENT: -000e6e 1c01 .dw DO_COLON - PFA_SET_CURRENT: -000e6f 1c3d .dw XT_DOLITERAL -000e70 003c .dw CFG_CURRENT -000e71 1f3b .dw XT_STOREE -000e72 1c20 .dw XT_EXIT - .include "words/wordlist.asm" - - ; Search Order - ; create a new, empty wordlist - VE_WORDLIST: -000e73 ff08 .dw $ff08 -000e74 6f77 -000e75 6472 -000e76 696c -000e77 7473 .db "wordlist" -000e78 0e66 .dw VE_HEAD - .set VE_HEAD = VE_WORDLIST - XT_WORDLIST: -000e79 1c01 .dw DO_COLON - PFA_WORDLIST: -000e7a 063d .dw XT_EHERE -000e7b 1d54 .dw XT_ZERO -000e7c 1ccf .dw XT_OVER -000e7d 1f3b .dw XT_STOREE -000e7e 1cb1 .dw XT_DUP -000e7f 05e3 .dw XT_CELLPLUS -000e80 0c20 .dw XT_DOTO -000e81 063e .dw PFA_EHERE -000e82 1c20 .dw XT_EXIT - - .include "words/forth-wordlist.asm" - - ; Search Order - ; get the system default word list - VE_FORTHWORDLIST: -000e83 ff0e .dw $ff0e -000e84 6f66 -000e85 7472 -000e86 2d68 -000e87 6f77 -000e88 6472 -000e89 696c -000e8a 7473 .db "forth-wordlist" -000e8b 0e73 .dw VE_HEAD - .set VE_HEAD = VE_FORTHWORDLIST - XT_FORTHWORDLIST: -000e8c 1c48 .dw PFA_DOVARIABLE - PFA_FORTHWORDLIST: -000e8d 003e .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: -000e8e ff09 .dw $ff09 -000e8f 6573 -000e90 2d74 -000e91 726f -000e92 6564 -000e93 0072 .db "set-order",0 -000e94 0e83 .dw VE_HEAD - .set VE_HEAD = VE_SET_ORDER - XT_SET_ORDER: -000e95 1c01 .dw DO_COLON - PFA_SET_ORDER: - .endif -000e96 1c3d .dw XT_DOLITERAL -000e97 0040 .dw CFG_ORDERLISTLEN -000e98 04d0 .dw XT_SET_STACK -000e99 1c20 .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: -000e9a ff0f .dw $ff0f -000e9b 6573 -000e9c 2d74 -000e9d 6572 -000e9e 6f63 -000e9f 6e67 -000ea0 7a69 -000ea1 7265 -000ea2 0073 .db "set-recognizers",0 -000ea3 0e8e .dw VE_HEAD - .set VE_HEAD = VE_SET_RECOGNIZERS - XT_SET_RECOGNIZERS: -000ea4 1c01 .dw DO_COLON - PFA_SET_RECOGNIZERS: - .endif -000ea5 1c3d .dw XT_DOLITERAL -000ea6 0052 .dw CFG_RECOGNIZERLISTLEN -000ea7 04d0 .dw XT_SET_STACK -000ea8 1c20 .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: -000ea9 ff0f .dw $ff0f -000eaa 6567 -000eab 2d74 -000eac 6572 -000ead 6f63 -000eae 6e67 -000eaf 7a69 -000eb0 7265 -000eb1 0073 .db "get-recognizers",0 -000eb2 0e9a .dw VE_HEAD - .set VE_HEAD = VE_GET_RECOGNIZERS - XT_GET_RECOGNIZERS: -000eb3 1c01 .dw DO_COLON - PFA_GET_RECOGNIZERS: - .endif -000eb4 1c3d .dw XT_DOLITERAL -000eb5 0052 .dw CFG_RECOGNIZERLISTLEN -000eb6 04af .dw XT_GET_STACK -000eb7 1c20 .dw XT_EXIT - .include "words/code.asm" - - ; Compiler - ; create named entry in the dictionary, XT is the data field - VE_CODE: -000eb8 ff04 .dw $ff04 -000eb9 6f63 -000eba 6564 .db "code" -000ebb 0ea9 .dw VE_HEAD - .set VE_HEAD = VE_CODE - XT_CODE: -000ebc 1c01 .dw DO_COLON - PFA_CODE: -000ebd 0280 .dw XT_DOCREATE -000ebe 03e0 .dw XT_REVEAL -000ebf 0634 .dw XT_DP -000ec0 0c32 .dw XT_ICELLPLUS -000ec1 02ae .dw XT_COMMA -000ec2 1c20 .dw XT_EXIT - .include "words/end-code.asm" - - ; Compiler - ; finish a code definition - VE_ENDCODE: -000ec3 ff08 .dw $ff08 -000ec4 6e65 -000ec5 2d64 -000ec6 6f63 -000ec7 6564 .db "end-code" -000ec8 0eb8 .dw VE_HEAD - .set VE_HEAD = VE_ENDCODE - XT_ENDCODE: -000ec9 1c01 .dw DO_COLON - PFA_ENDCODE: -000eca 02a3 .dw XT_COMPILE -000ecb 940c .dw $940c -000ecc 02a3 .dw XT_COMPILE -000ecd 1c05 .dw DO_NEXT -000ece 1c20 .dw XT_EXIT - .include "words/marker.asm" - - ; System Value - ; The eeprom address until which MARKER saves and restores the eeprom data. - VE_MARKER: -000ecf ff08 .dw $ff08 -000ed0 6d28 -000ed1 7261 -000ed2 656b -000ed3 2972 .db "(marker)" -000ed4 0ec3 .dw VE_HEAD - .set VE_HEAD = VE_MARKER - XT_MARKER: -000ed5 1c6f .dw PFA_DOVALUE1 - PFA_MARKER: -000ed6 005e .dw EE_MARKER -000ed7 0c3b .dw XT_EDEFERFETCH -000ed8 0c45 .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: -000ed9 0008 .dw $0008 -000eda 6f70 -000edb 7473 -000edc 6f70 -000edd 656e .db "postpone" -000ede 0ecf .dw VE_HEAD - .set VE_HEAD = VE_POSTPONE - XT_POSTPONE: -000edf 1c01 .dw DO_COLON - PFA_POSTPONE: - .endif -000ee0 0a3b .dw XT_PARSENAME -000ee1 0b60 .dw XT_FORTHRECOGNIZER -000ee2 0b36 .dw XT_RECOGNIZE -000ee3 1cb1 .dw XT_DUP -000ee4 1cff .dw XT_TO_R -000ee5 0c32 .dw XT_ICELLPLUS -000ee6 0c32 .dw XT_ICELLPLUS -000ee7 1fcb .dw XT_FETCHI -000ee8 1c2a .dw XT_EXECUTE -000ee9 1cf6 .dw XT_R_FROM -000eea 0c32 .dw XT_ICELLPLUS -000eeb 1fcb .dw XT_FETCHI -000eec 02ae .dw XT_COMMA -000eed 1c20 .dw XT_EXIT - .endif - .include "words/2r_fetch.asm" - - ; Stack - ; fetch content of TOR - VE_2R_FETCH: -000eee ff03 .dw $ff03 -000eef 7232 -000ef0 0040 .db "2r@",0 -000ef1 0ed9 .dw VE_HEAD - .set VE_HEAD = VE_2R_FETCH - XT_2R_FETCH: -000ef2 0ef3 .dw PFA_2R_FETCH - PFA_2R_FETCH: -000ef3 939a -000ef4 938a savetos -000ef5 91ef pop zl -000ef6 91ff pop zh -000ef7 918f pop tosl -000ef8 919f pop tosh -000ef9 939f push tosh -000efa 938f push tosl -000efb 93ff push zh -000efc 93ef push zl -000efd 939a -000efe 938a savetos -000eff 01cf movw tosl, zl -000f00 940c 1c05 jmp_ DO_NEXT - - .set DPSTART = pc - .if(pc>AMFORTH_RO_SEG) - .endif - - .org AMFORTH_RO_SEG - .include "amforth-interpreter.asm" - - - DO_COLON: -001c01 93bf push XH -001c02 93af push XL ; PUSH IP -001c03 01db movw XL, wl -001c04 9611 adiw xl, 1 - DO_NEXT: - .if WANT_INTERRUPTS == 1 -001c05 14b2 cp isrflag, zerol -001c06 f469 brne DO_INTERRUPT - .endif -001c07 01fd movw zl, XL ; READ IP -001c08 0fee -001c09 1fff -001c0a 9165 -001c0b 9175 readflashcell wl, wh -001c0c 9611 adiw XL, 1 ; INC IP - - DO_EXECUTE: -001c0d 01fb movw zl, wl -001c0e 0fee -001c0f 1fff -001c10 9105 -001c11 9115 readflashcell temp0,temp1 -001c12 01f8 movw zl, temp0 -001c13 9409 ijmp - - .if WANT_INTERRUPTS == 1 - DO_INTERRUPT: - ; here we deal with interrupts the forth way -001c14 939a -001c15 938a savetos -001c16 2d8b mov tosl, isrflag -001c17 2799 clr tosh -001c18 24bb clr isrflag -001c19 e26f ldi wl, LOW(XT_ISREXEC) -001c1a e072 ldi wh, HIGH(XT_ISREXEC) -001c1b cff1 rjmp DO_EXECUTE - .include "dict/nrww.inc" - - ; section together with the forth inner interpreter - - .include "words/exit.asm" - - ; Compiler - ; end of current colon word - VE_EXIT: -001c1c ff04 .dw $ff04 -001c1d 7865 -001c1e 7469 .db "exit" -001c1f 0eee .dw VE_HEAD - .set VE_HEAD = VE_EXIT - XT_EXIT: -001c20 1c21 .dw PFA_EXIT - PFA_EXIT: -001c21 91af pop XL -001c22 91bf pop XH -001c23 cfe1 jmp_ DO_NEXT - .include "words/execute.asm" - - ; System - ; execute XT - VE_EXECUTE: -001c24 ff07 .dw $ff07 -001c25 7865 -001c26 6365 -001c27 7475 -001c28 0065 .db "execute",0 -001c29 1c1c .dw VE_HEAD - .set VE_HEAD = VE_EXECUTE - XT_EXECUTE: -001c2a 1c2b .dw PFA_EXECUTE - PFA_EXECUTE: -001c2b 01bc movw wl, tosl -001c2c 9189 -001c2d 9199 loadtos -001c2e cfde jmp_ DO_EXECUTE - .include "words/dobranch.asm" - - ; System - ; runtime of branch - ;VE_DOBRANCH: - ; .dw $ff08 - ; .db "(branch)" - ; .dw VE_HEAD - ; .set VE_HEAD = VE_DOBRANCH - XT_DOBRANCH: -001c2f 1c30 .dw PFA_DOBRANCH - PFA_DOBRANCH: -001c30 01fd movw zl, XL -001c31 0fee -001c32 1fff -001c33 91a5 -001c34 91b5 readflashcell XL,XH -001c35 cfcf jmp_ DO_NEXT - .include "words/docondbranch.asm" - - ; System - ; runtime of ?branch - ;VE_DOCONDBRANCH: - ; .dw $ff09 - ; .db "(?branch)" - ; .dw VE_HEAD - ; .set VE_HEAD = VE_DOCONDBRANCH - XT_DOCONDBRANCH: -001c36 1c37 .dw PFA_DOCONDBRANCH - PFA_DOCONDBRANCH: -001c37 2b98 or tosh, tosl -001c38 9189 -001c39 9199 loadtos -001c3a f3a9 brbs 1, PFA_DOBRANCH ; 1 is z flag; if tos is zero (false), do the branch -001c3b 9611 adiw XL, 1 -001c3c cfc8 jmp_ DO_NEXT - - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - .include "words/doliteral.asm" - - ; System - ; runtime of literal - ;VE_DOLITERAL: - ; .dw $ff09 - ; .db "(literal)" - ; .dw VE_HEAD - ; .set VE_HEAD = VE_DOLITERAL - XT_DOLITERAL: -001c3d 1c3e .dw PFA_DOLITERAL - PFA_DOLITERAL: -001c3e 939a -001c3f 938a savetos -001c40 01fd movw zl, xl -001c41 0fee -001c42 1fff -001c43 9185 -001c44 9195 readflashcell tosl,tosh -001c45 9611 adiw xl, 1 -001c46 cfbe jmp_ DO_NEXT - - .include "words/dovariable.asm" - - ; System - ; puts content of parameter field (1 cell) to TOS - ;VE_DOVARIABLE: - ; .dw $ff0a - ; .db "(variable)" - ; .dw VE_HEAD - ; .set VE_HEAD = VE_DOVARIABLE - XT_DOVARIABLE: -001c47 1c48 .dw PFA_DOVARIABLE - PFA_DOVARIABLE: -001c48 939a -001c49 938a savetos -001c4a 01fb movw zl, wl -001c4b 9631 adiw zl,1 -001c4c 0fee -001c4d 1fff -001c4e 9185 -001c4f 9195 readflashcell tosl,tosh -001c50 cfb4 jmp_ DO_NEXT - .include "words/doconstant.asm" - - ; System - ; place data field address on TOS - ;VE_DOCONSTANT: - ; .dw $ff0a - ; .db "(constant)" - ; .dw VE_HEAD - ; .set VE_HEAD = VE_DOCONSTANT - XT_DOCONSTANT: -001c51 1c52 .dw PFA_DOCONSTANT - PFA_DOCONSTANT: -001c52 939a -001c53 938a savetos -001c54 01cb movw tosl, wl -001c55 9601 adiw tosl, 1 -001c56 cfae jmp_ DO_NEXT - .include "words/douser.asm" - - ; System - ; runtime part of user - ;VE_DOUSER: - ; .dw $ff06 - ; .db "(user)" - ; .dw VE_HEAD - ; .set VE_HEAD = VE_DOUSER - XT_DOUSER: -001c57 1c58 .dw PFA_DOUSER - PFA_DOUSER: -001c58 939a -001c59 938a savetos -001c5a 01fb movw zl, wl -001c5b 9631 adiw zl, 1 -001c5c 0fee -001c5d 1fff -001c5e 9185 -001c5f 9195 readflashcell tosl,tosh -001c60 0d84 add tosl, upl -001c61 1d95 adc tosh, uph -001c62 cfa2 jmp_ DO_NEXT - .include "words/do-value.asm" - - ; System - ; runtime of value - VE_DOVALUE: -001c63 ff07 .dw $ff07 -001c64 7628 -001c65 6c61 -001c66 6575 -001c67 0029 .db "(value)", 0 -001c68 1c24 .dw VE_HEAD - .set VE_HEAD = VE_DOVALUE - XT_DOVALUE: -001c69 1c01 .dw DO_COLON - PFA_DOVALUE: -001c6a 0280 .dw XT_DOCREATE -001c6b 03e0 .dw XT_REVEAL -001c6c 02a3 .dw XT_COMPILE -001c6d 1c6f .dw PFA_DOVALUE1 -001c6e 1c20 .dw XT_EXIT - PFA_DOVALUE1: -001c6f 940e 03f9 call_ DO_DODOES -001c71 1cb1 .dw XT_DUP -001c72 0c32 .dw XT_ICELLPLUS -001c73 1fcb .dw XT_FETCHI -001c74 1c2a .dw XT_EXECUTE -001c75 1c20 .dw XT_EXIT - - ; : (value) dup icell+ @i execute ; - .include "words/fetch.asm" - - ; Memory - ; read 1 cell from RAM address - VE_FETCH: -001c76 ff01 .dw $ff01 -001c77 0040 .db "@",0 -001c78 1c63 .dw VE_HEAD - .set VE_HEAD = VE_FETCH - XT_FETCH: -001c79 1c7a .dw PFA_FETCH - PFA_FETCH: - .if WANT_UNIFIED == 1 - .endif - PFA_FETCHRAM: -001c7a 01fc movw zl, tosl - ; low byte is read before the high byte -001c7b 9181 ld tosl, z+ -001c7c 9191 ld tosh, z+ -001c7d cf87 jmp_ DO_NEXT - .if WANT_UNIFIED == 1 - .endif - .include "words/store.asm" - - ; Memory - ; write n to RAM memory at addr, low byte first - VE_STORE: -001c7e ff01 .dw $ff01 -001c7f 0021 .db "!",0 -001c80 1c76 .dw VE_HEAD - .set VE_HEAD = VE_STORE - XT_STORE: -001c81 1c82 .dw PFA_STORE - PFA_STORE: - .if WANT_UNIFIED == 1 - .endif - PFA_STORERAM: -001c82 01fc movw zl, tosl -001c83 9189 -001c84 9199 loadtos - ; the high byte is written before the low byte -001c85 8391 std Z+1, tosh -001c86 8380 std Z+0, tosl -001c87 9189 -001c88 9199 loadtos -001c89 cf7b jmp_ DO_NEXT - .if WANT_UNIFIED == 1 - .endif - .include "words/cstore.asm" - - ; Memory - ; store a single byte to RAM address - VE_CSTORE: -001c8a ff02 .dw $ff02 -001c8b 2163 .db "c!" -001c8c 1c7e .dw VE_HEAD - .set VE_HEAD = VE_CSTORE - XT_CSTORE: -001c8d 1c8e .dw PFA_CSTORE - PFA_CSTORE: -001c8e 01fc movw zl, tosl -001c8f 9189 -001c90 9199 loadtos -001c91 8380 st Z, tosl -001c92 9189 -001c93 9199 loadtos -001c94 cf70 jmp_ DO_NEXT - .include "words/cfetch.asm" - - ; Memory - ; fetch a single byte from memory mapped locations - VE_CFETCH: -001c95 ff02 .dw $ff02 -001c96 4063 .db "c@" -001c97 1c8a .dw VE_HEAD - .set VE_HEAD = VE_CFETCH - XT_CFETCH: -001c98 1c99 .dw PFA_CFETCH - PFA_CFETCH: -001c99 01fc movw zl, tosl -001c9a 2799 clr tosh -001c9b 8180 ld tosl, Z -001c9c cf68 jmp_ DO_NEXT - .include "words/fetch-u.asm" - - ; Memory - ; read 1 cell from USER area - VE_FETCHU: -001c9d ff02 .dw $ff02 -001c9e 7540 .db "@u" -001c9f 1c95 .dw VE_HEAD - .set VE_HEAD = VE_FETCHU - XT_FETCHU: -001ca0 1c01 .dw DO_COLON - PFA_FETCHU: -001ca1 1f02 .dw XT_UP_FETCH -001ca2 1d9d .dw XT_PLUS -001ca3 1c79 .dw XT_FETCH -001ca4 1c20 .dw XT_EXIT - .include "words/store-u.asm" - - ; Memory - ; write n to USER area at offset - VE_STOREU: -001ca5 ff02 .dw $ff02 -001ca6 7521 .db "!u" -001ca7 1c9d .dw VE_HEAD - .set VE_HEAD = VE_STOREU - XT_STOREU: -001ca8 1c01 .dw DO_COLON - PFA_STOREU: -001ca9 1f02 .dw XT_UP_FETCH -001caa 1d9d .dw XT_PLUS -001cab 1c81 .dw XT_STORE -001cac 1c20 .dw XT_EXIT - - ;;;;;;;;;;;;;;;;;;;;;;;;; - .include "words/dup.asm" - - ; Stack - ; duplicate TOS - VE_DUP: -001cad ff03 .dw $ff03 -001cae 7564 -001caf 0070 .db "dup",0 -001cb0 1ca5 .dw VE_HEAD - .set VE_HEAD = VE_DUP - XT_DUP: -001cb1 1cb2 .dw PFA_DUP - PFA_DUP: -001cb2 939a -001cb3 938a savetos -001cb4 cf50 jmp_ DO_NEXT - .include "words/qdup.asm" - - ; Stack - ; duplicate TOS if non-zero - VE_QDUP: -001cb5 ff04 .dw $ff04 -001cb6 643f -001cb7 7075 .db "?dup" -001cb8 1cad .dw VE_HEAD - .set VE_HEAD = VE_QDUP - XT_QDUP: -001cb9 1cba .dw PFA_QDUP - PFA_QDUP: -001cba 2f08 mov temp0, tosl -001cbb 2b09 or temp0, tosh -001cbc f011 breq PFA_QDUP1 -001cbd 939a -001cbe 938a savetos - PFA_QDUP1: -001cbf cf45 jmp_ DO_NEXT - .include "words/swap.asm" - - ; Stack - ; swaps the two top level stack cells - VE_SWAP: -001cc0 ff04 .dw $ff04 -001cc1 7773 -001cc2 7061 .db "swap" -001cc3 1cb5 .dw VE_HEAD - .set VE_HEAD = VE_SWAP - XT_SWAP: -001cc4 1cc5 .dw PFA_SWAP - PFA_SWAP: -001cc5 018c movw temp0, tosl -001cc6 9189 -001cc7 9199 loadtos -001cc8 931a st -Y, temp1 -001cc9 930a st -Y, temp0 -001cca cf3a jmp_ DO_NEXT - .include "words/over.asm" - - ; Stack - ; Place a copy of x1 on top of the stack - VE_OVER: -001ccb ff04 .dw $ff04 -001ccc 766f -001ccd 7265 .db "over" -001cce 1cc0 .dw VE_HEAD - .set VE_HEAD = VE_OVER - XT_OVER: -001ccf 1cd0 .dw PFA_OVER - PFA_OVER: -001cd0 939a -001cd1 938a savetos -001cd2 818a ldd tosl, Y+2 -001cd3 819b ldd tosh, Y+3 - -001cd4 cf30 jmp_ DO_NEXT - .include "words/drop.asm" - - ; Stack - ; drop TOS - VE_DROP: -001cd5 ff04 .dw $ff04 -001cd6 7264 -001cd7 706f .db "drop" -001cd8 1ccb .dw VE_HEAD - .set VE_HEAD = VE_DROP - XT_DROP: -001cd9 1cda .dw PFA_DROP - PFA_DROP: -001cda 9189 -001cdb 9199 loadtos -001cdc cf28 jmp_ DO_NEXT - .include "words/rot.asm" - - ; Stack - ; rotate the three top level cells - VE_ROT: -001cdd ff03 .dw $ff03 -001cde 6f72 -001cdf 0074 .db "rot",0 -001ce0 1cd5 .dw VE_HEAD - .set VE_HEAD = VE_ROT - XT_ROT: -001ce1 1ce2 .dw PFA_ROT - PFA_ROT: -001ce2 018c movw temp0, tosl -001ce3 9129 ld temp2, Y+ -001ce4 9139 ld temp3, Y+ -001ce5 9189 -001ce6 9199 loadtos - -001ce7 933a st -Y, temp3 -001ce8 932a st -Y, temp2 -001ce9 931a st -Y, temp1 -001cea 930a st -Y, temp0 - -001ceb cf19 jmp_ DO_NEXT - .include "words/nip.asm" - - ; Stack - ; Remove Second of Stack - VE_NIP: -001cec ff03 .dw $ff03 -001ced 696e -001cee 0070 .db "nip",0 -001cef 1cdd .dw VE_HEAD - .set VE_HEAD = VE_NIP - XT_NIP: -001cf0 1cf1 .dw PFA_NIP - PFA_NIP: -001cf1 9622 adiw yl, 2 -001cf2 cf12 jmp_ DO_NEXT - ;;;;;;;;;;;;;;;;;;;;;;;;; - .include "words/r_from.asm" - - ; Stack - ; move TOR to TOS - VE_R_FROM: -001cf3 ff02 .dw $ff02 -001cf4 3e72 .db "r>" -001cf5 1cec .dw VE_HEAD - .set VE_HEAD = VE_R_FROM - XT_R_FROM: -001cf6 1cf7 .dw PFA_R_FROM - PFA_R_FROM: -001cf7 939a -001cf8 938a savetos -001cf9 918f pop tosl -001cfa 919f pop tosh -001cfb cf09 jmp_ DO_NEXT - .include "words/to_r.asm" - - ; Stack - ; move TOS to TOR - VE_TO_R: -001cfc ff02 .dw $ff02 -001cfd 723e .db ">r" -001cfe 1cf3 .dw VE_HEAD - .set VE_HEAD = VE_TO_R - XT_TO_R: -001cff 1d00 .dw PFA_TO_R - PFA_TO_R: -001d00 939f push tosh -001d01 938f push tosl -001d02 9189 -001d03 9199 loadtos -001d04 cf00 jmp_ DO_NEXT - .include "words/r_fetch.asm" - - ; Stack - ; fetch content of TOR - VE_R_FETCH: -001d05 ff02 .dw $ff02 -001d06 4072 .db "r@" -001d07 1cfc .dw VE_HEAD - .set VE_HEAD = VE_R_FETCH - XT_R_FETCH: -001d08 1d09 .dw PFA_R_FETCH - PFA_R_FETCH: -001d09 939a -001d0a 938a savetos -001d0b 918f pop tosl -001d0c 919f pop tosh -001d0d 939f push tosh -001d0e 938f push tosl -001d0f cef5 jmp_ DO_NEXT - - - .include "words/not-equal.asm" - - ; Compare - ; true if n1 is not equal to n2 - - .if cpu_msp430==1 - .endif - - .if cpu_avr8==1 - VE_NOTEQUAL: -001d10 ff02 .dw $ff02 -001d11 3e3c .db "<>" -001d12 1d05 .dw VE_HEAD - .set VE_HEAD = VE_NOTEQUAL - XT_NOTEQUAL: -001d13 1c01 .dw DO_COLON - PFA_NOTEQUAL: - .endif - -001d14 1fe0 -001d15 1d1a -001d16 1c20 .DW XT_EQUAL,XT_ZEROEQUAL,XT_EXIT - .include "words/equalzero.asm" - - ; Compare - ; compare with 0 (zero) - VE_ZEROEQUAL: -001d17 ff02 .dw $ff02 -001d18 3d30 .db "0=" -001d19 1d10 .dw VE_HEAD - .set VE_HEAD = VE_ZEROEQUAL - XT_ZEROEQUAL: -001d1a 1d1b .dw PFA_ZEROEQUAL - PFA_ZEROEQUAL: -001d1b 2b98 or tosh, tosl -001d1c f5d1 brne PFA_ZERO1 -001d1d c030 rjmp PFA_TRUE1 - .include "words/lesszero.asm" - - ; Compare - ; compare with zero - VE_ZEROLESS: -001d1e ff02 .dw $ff02 -001d1f 3c30 .db "0<" -001d20 1d17 .dw VE_HEAD - .set VE_HEAD = VE_ZEROLESS - XT_ZEROLESS: -001d21 1d22 .dw PFA_ZEROLESS - PFA_ZEROLESS: -001d22 fd97 sbrc tosh,7 -001d23 c02a rjmp PFA_TRUE1 -001d24 c032 rjmp PFA_ZERO1 - .include "words/greaterzero.asm" - - ; Compare - ; true if n1 is greater than 0 - VE_GREATERZERO: -001d25 ff02 .dw $ff02 -001d26 3e30 .db "0>" -001d27 1d1e .dw VE_HEAD - .set VE_HEAD = VE_GREATERZERO - XT_GREATERZERO: -001d28 1d29 .dw PFA_GREATERZERO - PFA_GREATERZERO: -001d29 1582 cp tosl, zerol -001d2a 0593 cpc tosh, zeroh -001d2b f15c brlt PFA_ZERO1 -001d2c f151 brbs 1, PFA_ZERO1 -001d2d c020 rjmp PFA_TRUE1 - .include "words/d-greaterzero.asm" - - ; Compare - ; compares if a double double cell number is greater 0 - VE_DGREATERZERO: -001d2e ff03 .dw $ff03 -001d2f 3064 -001d30 003e .db "d0>",0 -001d31 1d25 .dw VE_HEAD - .set VE_HEAD = VE_DGREATERZERO - XT_DGREATERZERO: -001d32 1d33 .dw PFA_DGREATERZERO - PFA_DGREATERZERO: -001d33 1582 cp tosl, zerol -001d34 0593 cpc tosh, zeroh -001d35 9189 -001d36 9199 loadtos -001d37 0582 cpc tosl, zerol -001d38 0593 cpc tosh, zeroh -001d39 f0ec brlt PFA_ZERO1 -001d3a f0e1 brbs 1, PFA_ZERO1 -001d3b c012 rjmp PFA_TRUE1 - .include "words/d-lesszero.asm" - - ; Compare - ; compares if a double double cell number is less than 0 - VE_DXT_ZEROLESS: -001d3c ff03 .dw $ff03 -001d3d 3064 -001d3e 003c .db "d0<",0 -001d3f 1d2e .dw VE_HEAD - .set VE_HEAD = VE_DXT_ZEROLESS - XT_DXT_ZEROLESS: -001d40 1d41 .dw PFA_DXT_ZEROLESS - PFA_DXT_ZEROLESS: -001d41 9622 adiw Y,2 -001d42 fd97 sbrc tosh,7 -001d43 940c 1d4e jmp PFA_TRUE1 -001d45 940c 1d57 jmp PFA_ZERO1 - - .include "words/true.asm" - - ; Arithmetics - ; leaves the value -1 (true) on TOS - VE_TRUE: -001d47 ff04 .dw $ff04 -001d48 7274 -001d49 6575 .db "true" -001d4a 1d3c .dw VE_HEAD - .set VE_HEAD = VE_TRUE - XT_TRUE: -001d4b 1d4c .dw PFA_TRUE - PFA_TRUE: -001d4c 939a -001d4d 938a savetos - PFA_TRUE1: -001d4e ef8f ser tosl -001d4f ef9f ser tosh -001d50 ceb4 jmp_ DO_NEXT - .include "words/zero.asm" - - ; Arithmetics - ; place a value 0 on TOS - VE_ZERO: -001d51 ff01 .dw $ff01 -001d52 0030 .db "0",0 -001d53 1d47 .dw VE_HEAD - .set VE_HEAD = VE_ZERO - XT_ZERO: -001d54 1d55 .dw PFA_ZERO - PFA_ZERO: -001d55 939a -001d56 938a savetos - PFA_ZERO1: -001d57 01c1 movw tosl, zerol -001d58 ceac jmp_ DO_NEXT - .include "words/uless.asm" - - ; Compare - ; true if u1 < u2 (unsigned) - VE_ULESS: -001d59 ff02 .dw $ff02 -001d5a 3c75 .db "u<" -001d5b 1d51 .dw VE_HEAD - .set VE_HEAD = VE_ULESS - XT_ULESS: -001d5c 1d5d .dw PFA_ULESS - PFA_ULESS: -001d5d 9129 ld temp2, Y+ -001d5e 9139 ld temp3, Y+ -001d5f 1782 cp tosl, temp2 -001d60 0793 cpc tosh, temp3 -001d61 f3a8 brlo PFA_ZERO1 -001d62 f3a1 brbs 1, PFA_ZERO1 -001d63 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: -001d64 ff02 .dw $ff02 -001d65 3e75 .db "u>" -001d66 1d59 .dw VE_HEAD - .set VE_HEAD = VE_UGREATER - XT_UGREATER: -001d67 1c01 .dw DO_COLON - PFA_UGREATER: - .endif -001d68 1cc4 .DW XT_SWAP -001d69 1d5c .dw XT_ULESS -001d6a 1c20 .dw XT_EXIT - .include "words/less.asm" - - ; Compare - ; true if n1 is less than n2 - VE_LESS: -001d6b ff01 .dw $ff01 -001d6c 003c .db "<",0 -001d6d 1d64 .dw VE_HEAD - .set VE_HEAD = VE_LESS - XT_LESS: -001d6e 1d6f .dw PFA_LESS - PFA_LESS: -001d6f 9129 ld temp2, Y+ -001d70 9139 ld temp3, Y+ -001d71 1728 cp temp2, tosl -001d72 0739 cpc temp3, tosh - PFA_LESSDONE: -001d73 f71c brge PFA_ZERO1 -001d74 cfd9 rjmp PFA_TRUE1 - .include "words/greater.asm" - - ; Compare - ; flag is true if n1 is greater than n2 - VE_GREATER: -001d75 ff01 .dw $ff01 -001d76 003e .db ">",0 -001d77 1d6b .dw VE_HEAD - .set VE_HEAD = VE_GREATER - XT_GREATER: -001d78 1d79 .dw PFA_GREATER - PFA_GREATER: -001d79 9129 ld temp2, Y+ -001d7a 9139 ld temp3, Y+ -001d7b 1728 cp temp2, tosl -001d7c 0739 cpc temp3, tosh - PFA_GREATERDONE: -001d7d f2cc brlt PFA_ZERO1 -001d7e f2c1 brbs 1, PFA_ZERO1 -001d7f cfce rjmp PFA_TRUE1 - - .include "words/log2.asm" - - ; Arithmetics - ; logarithm to base 2 or highest set bitnumber - VE_LOG2: -001d80 ff04 .dw $ff04 -001d81 6f6c -001d82 3267 .db "log2" -001d83 1d75 .dw VE_HEAD - .set VE_HEAD = VE_LOG2 - XT_LOG2: -001d84 1d85 .dw PFA_LOG2 - PFA_LOG2: -001d85 01fc movw zl, tosl -001d86 2799 clr tosh -001d87 e180 ldi tosl, 16 - PFA_LOG2_1: -001d88 958a dec tosl -001d89 f022 brmi PFA_LOG2_2 ; wrong data -001d8a 0fee lsl zl -001d8b 1fff rol zh -001d8c f7d8 brcc PFA_LOG2_1 -001d8d ce77 jmp_ DO_NEXT - - PFA_LOG2_2: -001d8e 959a dec tosh -001d8f ce75 jmp_ DO_NEXT - .include "words/minus.asm" - - ; Arithmetics - ; subtract n2 from n1 - VE_MINUS: -001d90 ff01 .dw $ff01 -001d91 002d .db "-",0 -001d92 1d80 .dw VE_HEAD - .set VE_HEAD = VE_MINUS - XT_MINUS: -001d93 1d94 .dw PFA_MINUS - PFA_MINUS: -001d94 9109 ld temp0, Y+ -001d95 9119 ld temp1, Y+ -001d96 1b08 sub temp0, tosl -001d97 0b19 sbc temp1, tosh -001d98 01c8 movw tosl, temp0 -001d99 ce6b jmp_ DO_NEXT - .include "words/plus.asm" - - ; Arithmetics - ; add n1 and n2 - VE_PLUS: -001d9a ff01 .dw $ff01 -001d9b 002b .db "+",0 -001d9c 1d90 .dw VE_HEAD - .set VE_HEAD = VE_PLUS - XT_PLUS: -001d9d 1d9e .dw PFA_PLUS - PFA_PLUS: -001d9e 9109 ld temp0, Y+ -001d9f 9119 ld temp1, Y+ -001da0 0f80 add tosl, temp0 -001da1 1f91 adc tosh, temp1 -001da2 ce62 jmp_ DO_NEXT - .include "words/mstar.asm" - - ; Arithmetics - ; multiply 2 cells to a double cell - VE_MSTAR: -001da3 ff02 .dw $ff02 -001da4 2a6d .db "m*" -001da5 1d9a .dw VE_HEAD - .set VE_HEAD = VE_MSTAR - XT_MSTAR: -001da6 1da7 .dw PFA_MSTAR - PFA_MSTAR: -001da7 018c movw temp0, tosl -001da8 9189 -001da9 9199 loadtos -001daa 019c movw temp2, tosl - ; high cell ah*bh -001dab 0231 muls temp3, temp1 -001dac 0170 movw temp4, r0 - ; low cell al*bl -001dad 9f20 mul temp2, temp0 -001dae 01c0 movw tosl, r0 - ; signed ah*bl -001daf 0330 mulsu temp3, temp0 -001db0 08f3 sbc temp5, zeroh -001db1 0d90 add tosh, r0 -001db2 1ce1 adc temp4, r1 -001db3 1cf3 adc temp5, zeroh - - ; signed al*bh -001db4 0312 mulsu temp1, temp2 -001db5 08f3 sbc temp5, zeroh -001db6 0d90 add tosh, r0 -001db7 1ce1 adc temp4, r1 -001db8 1cf3 adc temp5, zeroh - -001db9 939a -001dba 938a savetos -001dbb 01c7 movw tosl, temp4 -001dbc ce48 jmp_ DO_NEXT - .include "words/umslashmod.asm" - - ; Arithmetics - ; unsigned division ud / u2 with remainder - VE_UMSLASHMOD: -001dbd ff06 .dw $ff06 -001dbe 6d75 -001dbf 6d2f -001dc0 646f .db "um/mod" -001dc1 1da3 .dw VE_HEAD - .set VE_HEAD = VE_UMSLASHMOD - XT_UMSLASHMOD: -001dc2 1dc3 .dw PFA_UMSLASHMOD - PFA_UMSLASHMOD: -001dc3 017c movw temp4, tosl - -001dc4 9129 ld temp2, Y+ -001dc5 9139 ld temp3, Y+ - -001dc6 9109 ld temp0, Y+ -001dc7 9119 ld temp1, Y+ - - ;; unsigned 32/16 -> 16r16 divide - - PFA_UMSLASHMODmod: - - ; set loop counter -001dc8 e140 ldi temp6,$10 - - PFA_UMSLASHMODmod_loop: - ; shift left, saving high bit -001dc9 2755 clr temp7 -001dca 0f00 lsl temp0 -001dcb 1f11 rol temp1 -001dcc 1f22 rol temp2 -001dcd 1f33 rol temp3 -001dce 1f55 rol temp7 - - ; try subtracting divisor -001dcf 152e cp temp2, temp4 -001dd0 053f cpc temp3, temp5 -001dd1 0552 cpc temp7,zerol - -001dd2 f018 brcs PFA_UMSLASHMODmod_loop_control - - PFA_UMSLASHMODmod_subtract: - ; dividend is large enough - ; do the subtraction for real - ; and set lowest bit -001dd3 9503 inc temp0 -001dd4 192e sub temp2, temp4 -001dd5 093f sbc temp3, temp5 - - PFA_UMSLASHMODmod_loop_control: -001dd6 954a dec temp6 -001dd7 f789 brne PFA_UMSLASHMODmod_loop - - PFA_UMSLASHMODmod_done: - ; put remainder on stack -001dd8 933a st -Y,temp3 -001dd9 932a st -Y,temp2 - - ; put quotient on stack -001dda 01c8 movw tosl, temp0 -001ddb ce29 jmp_ DO_NEXT - .include "words/umstar.asm" - - ; Arithmetics - ; multiply 2 unsigned cells to a double cell - VE_UMSTAR: -001ddc ff03 .dw $ff03 -001ddd 6d75 -001dde 002a .db "um*",0 -001ddf 1dbd .dw VE_HEAD - .set VE_HEAD = VE_UMSTAR - XT_UMSTAR: -001de0 1de1 .dw PFA_UMSTAR - PFA_UMSTAR: -001de1 018c movw temp0, tosl -001de2 9189 -001de3 9199 loadtos - ; result: (temp3*temp1)* 65536 + (temp3*temp0 + temp1*temp2) * 256 + (temp0 * temp2) - ; low bytes -001de4 9f80 mul tosl,temp0 -001de5 01f0 movw zl, r0 -001de6 2722 clr temp2 -001de7 2733 clr temp3 - ; middle bytes -001de8 9f90 mul tosh, temp0 -001de9 0df0 add zh, r0 -001dea 1d21 adc temp2, r1 -001deb 1d33 adc temp3, zeroh - -001dec 9f81 mul tosl, temp1 -001ded 0df0 add zh, r0 -001dee 1d21 adc temp2, r1 -001def 1d33 adc temp3, zeroh - -001df0 9f91 mul tosh, temp1 -001df1 0d20 add temp2, r0 -001df2 1d31 adc temp3, r1 -001df3 01cf movw tosl, zl -001df4 939a -001df5 938a savetos -001df6 01c9 movw tosl, temp2 -001df7 ce0d jmp_ DO_NEXT - - .include "words/invert.asm" - - ; Arithmetics - ; 1-complement of TOS - VE_INVERT: -001df8 ff06 .dw $ff06 -001df9 6e69 -001dfa 6576 -001dfb 7472 .db "invert" -001dfc 1ddc .dw VE_HEAD - .set VE_HEAD = VE_INVERT - XT_INVERT: -001dfd 1dfe .dw PFA_INVERT - PFA_INVERT: -001dfe 9580 com tosl -001dff 9590 com tosh -001e00 ce04 jmp_ DO_NEXT - .include "words/2slash.asm" - - ; Arithmetics - ; arithmetic shift right - VE_2SLASH: -001e01 ff02 .dw $ff02 -001e02 2f32 .db "2/" -001e03 1df8 .dw VE_HEAD - .set VE_HEAD = VE_2SLASH - XT_2SLASH: -001e04 1e05 .dw PFA_2SLASH - PFA_2SLASH: -001e05 9595 asr tosh -001e06 9587 ror tosl -001e07 cdfd jmp_ DO_NEXT - .include "words/2star.asm" - - ; Arithmetics - ; arithmetic shift left, filling with zero - VE_2STAR: -001e08 ff02 .dw $ff02 -001e09 2a32 .db "2*" -001e0a 1e01 .dw VE_HEAD - .set VE_HEAD = VE_2STAR - XT_2STAR: -001e0b 1e0c .dw PFA_2STAR - PFA_2STAR: -001e0c 0f88 lsl tosl -001e0d 1f99 rol tosh -001e0e cdf6 jmp_ DO_NEXT - .include "words/and.asm" - - ; Logic - ; bitwise and - VE_AND: -001e0f ff03 .dw $ff03 -001e10 6e61 -001e11 0064 .db "and",0 -001e12 1e08 .dw VE_HEAD - .set VE_HEAD = VE_AND - XT_AND: -001e13 1e14 .dw PFA_AND - PFA_AND: -001e14 9109 ld temp0, Y+ -001e15 9119 ld temp1, Y+ -001e16 2380 and tosl, temp0 -001e17 2391 and tosh, temp1 -001e18 cdec jmp_ DO_NEXT - .include "words/or.asm" - - ; Logic - ; logical or - VE_OR: -001e19 ff02 .dw $ff02 -001e1a 726f .db "or" -001e1b 1e0f .dw VE_HEAD - .set VE_HEAD = VE_OR - XT_OR: -001e1c 1e1d .dw PFA_OR - PFA_OR: -001e1d 9109 ld temp0, Y+ -001e1e 9119 ld temp1, Y+ -001e1f 2b80 or tosl, temp0 -001e20 2b91 or tosh, temp1 -001e21 cde3 jmp_ DO_NEXT - - .include "words/xor.asm" - - ; Logic - ; exclusive or - VE_XOR: -001e22 ff03 .dw $ff03 -001e23 6f78 -001e24 0072 .db "xor",0 -001e25 1e19 .dw VE_HEAD - .set VE_HEAD = VE_XOR - XT_XOR: -001e26 1e27 .dw PFA_XOR - PFA_XOR: -001e27 9109 ld temp0, Y+ -001e28 9119 ld temp1, Y+ -001e29 2780 eor tosl, temp0 -001e2a 2791 eor tosh, temp1 -001e2b cdd9 jmp_ DO_NEXT - - .include "words/1plus.asm" - - ; Arithmetics - ; optimized increment - VE_1PLUS: -001e2c ff02 .dw $ff02 -001e2d 2b31 .db "1+" -001e2e 1e22 .dw VE_HEAD - .set VE_HEAD = VE_1PLUS - XT_1PLUS: -001e2f 1e30 .dw PFA_1PLUS - PFA_1PLUS: -001e30 9601 adiw tosl,1 -001e31 cdd3 jmp_ DO_NEXT - .include "words/1minus.asm" - - ; Arithmetics - ; optimized decrement - VE_1MINUS: -001e32 ff02 .dw $ff02 -001e33 2d31 .db "1-" -001e34 1e2c .dw VE_HEAD - .set VE_HEAD = VE_1MINUS - XT_1MINUS: -001e35 1e36 .dw PFA_1MINUS - PFA_1MINUS: -001e36 9701 sbiw tosl, 1 -001e37 cdcd jmp_ DO_NEXT - .include "words/q-negate.asm" - - ; 0< IF NEGATE THEN ; ...a common factor - - .if cpu_msp430==1 - .endif - - .if cpu_avr8==1 - VE_QNEGATE: -001e38 ff07 .dw $ff07 -001e39 6e3f -001e3a 6765 -001e3b 7461 -../../common\words/q-negate.asm(11): warning: .cseg .db misalignment - padding zero byte -001e3c 0065 .db "?negate" -001e3d 1e32 .dw VE_HEAD - .set VE_HEAD = VE_QNEGATE - XT_QNEGATE: -001e3e 1c01 .dw DO_COLON - PFA_QNEGATE: - - .endif -001e3f 1d21 -001e40 1c36 .DW XT_ZEROLESS,XT_DOCONDBRANCH -001e41 1e43 DEST(QNEG1) -001e42 06c6 .DW XT_NEGATE -001e43 1c20 QNEG1: .DW XT_EXIT - .include "words/lshift.asm" - - ; Arithmetics - ; logically shift n1 left n2 times - VE_LSHIFT: -001e44 ff06 .dw $ff06 -001e45 736c -001e46 6968 -001e47 7466 .db "lshift" -001e48 1e38 .dw VE_HEAD - .set VE_HEAD = VE_LSHIFT - XT_LSHIFT: -001e49 1e4a .dw PFA_LSHIFT - PFA_LSHIFT: -001e4a 01fc movw zl, tosl -001e4b 9189 -001e4c 9199 loadtos - PFA_LSHIFT1: -001e4d 9731 sbiw zl, 1 -001e4e f01a brmi PFA_LSHIFT2 -001e4f 0f88 lsl tosl -001e50 1f99 rol tosh -001e51 cffb rjmp PFA_LSHIFT1 - PFA_LSHIFT2: -001e52 cdb2 jmp_ DO_NEXT - - .include "words/rshift.asm" - - ; Arithmetics - ; shift n1 n2-times logically right - VE_RSHIFT: -001e53 ff06 .dw $ff06 -001e54 7372 -001e55 6968 -001e56 7466 .db "rshift" -001e57 1e44 .dw VE_HEAD - .set VE_HEAD = VE_RSHIFT - XT_RSHIFT: -001e58 1e59 .dw PFA_RSHIFT - PFA_RSHIFT: -001e59 01fc movw zl, tosl -001e5a 9189 -001e5b 9199 loadtos - PFA_RSHIFT1: -001e5c 9731 sbiw zl, 1 -001e5d f01a brmi PFA_RSHIFT2 -001e5e 9596 lsr tosh -001e5f 9587 ror tosl -001e60 cffb rjmp PFA_RSHIFT1 - PFA_RSHIFT2: -001e61 cda3 jmp_ DO_NEXT - - .include "words/plusstore.asm" - - ; Arithmetics - ; add n to content of RAM address a-addr - VE_PLUSSTORE: -001e62 ff02 .dw $ff02 -001e63 212b .db "+!" -001e64 1e53 .dw VE_HEAD - .set VE_HEAD = VE_PLUSSTORE - XT_PLUSSTORE: -001e65 1e66 .dw PFA_PLUSSTORE - PFA_PLUSSTORE: -001e66 01fc movw zl, tosl -001e67 9189 -001e68 9199 loadtos -001e69 8120 ldd temp2, Z+0 -001e6a 8131 ldd temp3, Z+1 -001e6b 0f82 add tosl, temp2 -001e6c 1f93 adc tosh, temp3 -001e6d 8380 std Z+0, tosl -001e6e 8391 std Z+1, tosh -001e6f 9189 -001e70 9199 loadtos -001e71 cd93 jmp_ DO_NEXT - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - .include "words/rpfetch.asm" - - ; Stack - ; current return stack pointer address - VE_RP_FETCH: -001e72 ff03 .dw $ff03 -001e73 7072 -001e74 0040 .db "rp@",0 -001e75 1e62 .dw VE_HEAD - .set VE_HEAD = VE_RP_FETCH - XT_RP_FETCH: -001e76 1e77 .dw PFA_RP_FETCH - PFA_RP_FETCH: -001e77 939a -001e78 938a savetos -001e79 b78d in tosl, SPL -001e7a b79e in tosh, SPH -001e7b cd89 jmp_ DO_NEXT - .include "words/rpstore.asm" - - ; Stack - ; set return stack pointer - VE_RP_STORE: -001e7c ff03 .dw $ff03 -001e7d 7072 -001e7e 0021 .db "rp!",0 -001e7f 1e72 .dw VE_HEAD - .set VE_HEAD = VE_RP_STORE - XT_RP_STORE: -001e80 1e81 .dw PFA_RP_STORE - PFA_RP_STORE: -001e81 b72f in temp2, SREG -001e82 94f8 cli -001e83 bf8d out SPL, tosl -001e84 bf9e out SPH, tosh -001e85 bf2f out SREG, temp2 -001e86 9189 -001e87 9199 loadtos -001e88 cd7c jmp_ DO_NEXT - .include "words/spfetch.asm" - - ; Stack - ; current data stack pointer - VE_SP_FETCH: -001e89 ff03 .dw $ff03 -001e8a 7073 -001e8b 0040 .db "sp@",0 -001e8c 1e7c .dw VE_HEAD - .set VE_HEAD = VE_SP_FETCH - XT_SP_FETCH: -001e8d 1e8e .dw PFA_SP_FETCH - PFA_SP_FETCH: -001e8e 939a -001e8f 938a savetos -001e90 01ce movw tosl, yl -001e91 cd73 jmp_ DO_NEXT - .include "words/spstore.asm" - - ; Stack - ; set data stack pointer to addr - VE_SP_STORE: -001e92 ff03 .dw $ff03 -001e93 7073 -001e94 0021 .db "sp!",0 -001e95 1e89 .dw VE_HEAD - .set VE_HEAD = VE_SP_STORE - XT_SP_STORE: -001e96 1e97 .dw PFA_SP_STORE - PFA_SP_STORE: -001e97 01ec movw yl, tosl -001e98 9189 -001e99 9199 loadtos -001e9a cd6a jmp_ DO_NEXT - - .include "words/dodo.asm" - - ; System - ; runtime of do - ;VE_DODO: - ; .dw $ff04 - ; .db "(do)" - ; .dw VE_HEAD - ; .set VE_HEAD = VE_DODO - XT_DODO: -001e9b 1e9c .dw PFA_DODO - PFA_DODO: -001e9c 9129 ld temp2, Y+ -001e9d 9139 ld temp3, Y+ ; limit - PFA_DODO1: -001e9e e8e0 ldi zl, $80 -001e9f 0f3e add temp3, zl -001ea0 1b82 sub tosl, temp2 -001ea1 0b93 sbc tosh, temp3 - -001ea2 933f push temp3 -001ea3 932f push temp2 ; limit ( --> limit + $8000) -001ea4 939f push tosh -001ea5 938f push tosl ; start -> index ( --> index - (limit - $8000) -001ea6 9189 -001ea7 9199 loadtos -001ea8 cd5c jmp_ DO_NEXT - .include "words/i.asm" - - ; Compiler - ; current loop counter - VE_I: -001ea9 ff01 .dw $FF01 -001eaa 0069 .db "i",0 -001eab 1e92 .dw VE_HEAD - .set VE_HEAD = VE_I - XT_I: -001eac 1ead .dw PFA_I - PFA_I: -001ead 939a -001eae 938a savetos -001eaf 918f pop tosl -001eb0 919f pop tosh ; index -001eb1 91ef pop zl -001eb2 91ff pop zh ; limit -001eb3 93ff push zh -001eb4 93ef push zl -001eb5 939f push tosh -001eb6 938f push tosl -001eb7 0f8e add tosl, zl -001eb8 1f9f adc tosh, zh -001eb9 cd4b jmp_ DO_NEXT - .include "words/doplusloop.asm" - - ; System - ; runtime of +loop - ;VE_DOPLUSLOOP: - ; .dw $ff07 - ; .db "(+loop)" - ; .dw VE_HEAD - ; .set VE_HEAD = VE_DOPLUSLOOP - XT_DOPLUSLOOP: -001eba 1ebb .dw PFA_DOPLUSLOOP - PFA_DOPLUSLOOP: -001ebb 91ef pop zl -001ebc 91ff pop zh -001ebd 0fe8 add zl, tosl -001ebe 1ff9 adc zh, tosh -001ebf 9189 -001ec0 9199 loadtos -001ec1 f01b brvs PFA_DOPLUSLOOP_LEAVE - ; next cycle - PFA_DOPLUSLOOP_NEXT: - ; next iteration -001ec2 93ff push zh -001ec3 93ef push zl -001ec4 cd6b rjmp PFA_DOBRANCH ; read next cell from dictionary and jump to its destination - PFA_DOPLUSLOOP_LEAVE: -001ec5 910f pop temp0 -001ec6 911f pop temp1 ; remove limit -001ec7 9611 adiw xl, 1 ; skip branch-back address -001ec8 cd3c jmp_ DO_NEXT - .include "words/doloop.asm" - - ; System - ; runtime of loop - ;VE_DOLOOP: - ; .dw $ff06 - ; .db "(loop)" - ; .dw VE_HEAD - ; .set VE_HEAD = VE_DOLOOP - XT_DOLOOP: -001ec9 1eca .dw PFA_DOLOOP - PFA_DOLOOP: -001eca 91ef pop zl -001ecb 91ff pop zh -001ecc 9631 adiw zl,1 -001ecd f3bb brvs PFA_DOPLUSLOOP_LEAVE -001ece cff3 jmp_ PFA_DOPLUSLOOP_NEXT - .include "words/unloop.asm" - - ; Compiler - ; remove loop-sys, exit the loop and continue execution after it - VE_UNLOOP: -001ecf ff06 .dw $ff06 -001ed0 6e75 -001ed1 6f6c -001ed2 706f .db "unloop" -001ed3 1ea9 .dw VE_HEAD - .set VE_HEAD = VE_UNLOOP - XT_UNLOOP: -001ed4 1ed5 .dw PFA_UNLOOP - PFA_UNLOOP: -001ed5 911f pop temp1 -001ed6 910f pop temp0 -001ed7 911f pop temp1 -001ed8 910f pop temp0 -001ed9 cd2b jmp_ DO_NEXT - - ;;;;;;;;;;;;;;;;;;;;;;;;;;; - - .include "words/cmove_g.asm" - - ; Memory - ; copy data in RAM from higher to lower addresses. - VE_CMOVE_G: -001eda ff06 .dw $ff06 -001edb 6d63 -001edc 766f -001edd 3e65 .db "cmove>" -001ede 1ecf .dw VE_HEAD - .set VE_HEAD = VE_CMOVE_G - XT_CMOVE_G: -001edf 1ee0 .dw PFA_CMOVE_G - PFA_CMOVE_G: -001ee0 93bf push xh -001ee1 93af push xl -001ee2 91e9 ld zl, Y+ -001ee3 91f9 ld zh, Y+ ; addr-to -001ee4 91a9 ld xl, Y+ -001ee5 91b9 ld xh, Y+ ; addr-from -001ee6 2f09 mov temp0, tosh -001ee7 2b08 or temp0, tosl -001ee8 f041 brbs 1, PFA_CMOVE_G1 -001ee9 0fe8 add zl, tosl -001eea 1ff9 adc zh, tosh -001eeb 0fa8 add xl, tosl -001eec 1fb9 adc xh, tosh - PFA_CMOVE_G2: -001eed 911e ld temp1, -X -001eee 9312 st -Z, temp1 -001eef 9701 sbiw tosl, 1 -001ef0 f7e1 brbc 1, PFA_CMOVE_G2 - PFA_CMOVE_G1: -001ef1 91af pop xl -001ef2 91bf pop xh -001ef3 9189 -001ef4 9199 loadtos -001ef5 cd0f jmp_ DO_NEXT - .include "words/byteswap.asm" - - ; Arithmetics - ; exchange the bytes of the TOS - VE_BYTESWAP: -001ef6 ff02 .dw $ff02 -001ef7 3c3e .db "><" -001ef8 1eda .dw VE_HEAD - .set VE_HEAD = VE_BYTESWAP - XT_BYTESWAP: -001ef9 1efa .dw PFA_BYTESWAP - PFA_BYTESWAP: -001efa 2f09 mov temp0, tosh -001efb 2f98 mov tosh, tosl -001efc 2f80 mov tosl, temp0 -001efd cd07 jmp_ DO_NEXT - .include "words/up.asm" - - ; System Variable - ; get user area pointer - VE_UP_FETCH: -001efe ff03 .dw $ff03 -001eff 7075 -001f00 0040 .db "up@",0 -001f01 1ef6 .dw VE_HEAD - .set VE_HEAD = VE_UP_FETCH - XT_UP_FETCH: -001f02 1f03 .dw PFA_UP_FETCH - PFA_UP_FETCH: -001f03 939a -001f04 938a savetos -001f05 01c2 movw tosl, upl -001f06 ccfe jmp_ DO_NEXT - - ; ( addr -- ) - ; System Variable - ; set user area pointer - VE_UP_STORE: -001f07 ff03 .dw $ff03 -001f08 7075 -001f09 0021 .db "up!",0 -001f0a 1efe .dw VE_HEAD - .set VE_HEAD = VE_UP_STORE - XT_UP_STORE: -001f0b 1f0c .dw PFA_UP_STORE - PFA_UP_STORE: -001f0c 012c movw upl, tosl -001f0d 9189 -001f0e 9199 loadtos -001f0f ccf5 jmp_ DO_NEXT - .include "words/1ms.asm" - - ; Time - ; busy waits (almost) exactly 1 millisecond - VE_1MS: -001f10 ff03 .dw $ff03 -001f11 6d31 -001f12 0073 .db "1ms",0 -001f13 1f07 .dw VE_HEAD - .set VE_HEAD = VE_1MS - XT_1MS: -001f14 1f15 .dw PFA_1MS - PFA_1MS: -001f15 ede0 -001f16 e0f7 -001f17 9731 -001f18 f7f1 delay 1000 -001f19 cceb jmp_ DO_NEXT - .include "words/2to_r.asm" - - ; Stack - ; move DTOS to TOR - VE_2TO_R: -001f1a ff03 .dw $ff03 -001f1b 3e32 -001f1c 0072 .db "2>r",0 -001f1d 1f10 .dw VE_HEAD - .set VE_HEAD = VE_2TO_R - XT_2TO_R: -001f1e 1f1f .dw PFA_2TO_R - PFA_2TO_R: -001f1f 01fc movw zl, tosl -001f20 9189 -001f21 9199 loadtos -001f22 939f push tosh -001f23 938f push tosl -001f24 93ff push zh -001f25 93ef push zl -001f26 9189 -001f27 9199 loadtos -001f28 ccdc jmp_ DO_NEXT - .include "words/2r_from.asm" - - ; Stack - ; move DTOR to TOS - VE_2R_FROM: -001f29 ff03 .dw $ff03 -001f2a 7232 -001f2b 003e .db "2r>",0 -001f2c 1f1a .dw VE_HEAD - .set VE_HEAD = VE_2R_FROM - XT_2R_FROM: -001f2d 1f2e .dw PFA_2R_FROM - PFA_2R_FROM: -001f2e 939a -001f2f 938a savetos -001f30 91ef pop zl -001f31 91ff pop zh -001f32 918f pop tosl -001f33 919f pop tosh -001f34 939a -001f35 938a savetos -001f36 01cf movw tosl, zl -001f37 cccd jmp_ DO_NEXT - - .include "words/store-e.asm" - - ; Memory - ; write n (2bytes) to eeprom address - VE_STOREE: -001f38 ff02 .dw $ff02 -001f39 6521 .db "!e" -001f3a 1f29 .dw VE_HEAD - .set VE_HEAD = VE_STOREE - XT_STOREE: -001f3b 1f3c .dw PFA_STOREE - PFA_STOREE: - .if WANT_UNIFIED == 1 - .endif - PFA_STOREE0: -001f3c 01fc movw zl, tosl -001f3d 9189 -001f3e 9199 loadtos -001f3f b72f in_ temp2, SREG -001f40 94f8 cli -001f41 d028 rcall PFA_FETCHE2 -001f42 b30d in_ temp0, EEDR -001f43 1708 cp temp0,tosl -001f44 f009 breq PFA_STOREE3 -001f45 d00b rcall PFA_STOREE1 - PFA_STOREE3: -001f46 9631 adiw zl,1 -001f47 d022 rcall PFA_FETCHE2 -001f48 b30d in_ temp0, EEDR -001f49 1709 cp temp0,tosh -001f4a f011 breq PFA_STOREE4 -001f4b 2f89 mov tosl, tosh -001f4c d004 rcall PFA_STOREE1 - PFA_STOREE4: -001f4d bf2f out_ SREG, temp2 -001f4e 9189 -001f4f 9199 loadtos -001f50 ccb4 jmp_ DO_NEXT - - PFA_STOREE1: -001f51 99e1 sbic EECR, EEPE -001f52 cffe rjmp PFA_STOREE1 - - PFA_STOREE2: ; estore_wait_low_spm: -001f53 b707 in_ temp0, SPMCSR -001f54 fd00 sbrc temp0,SPMEN -001f55 cffd rjmp PFA_STOREE2 - -001f56 bbff out_ EEARH,zh -001f57 bbee out_ EEARL,zl -001f58 bb8d out_ EEDR, tosl -001f59 9ae2 sbi EECR,EEMPE -001f5a 9ae1 sbi EECR,EEPE - -001f5b 9508 ret - .if WANT_UNIFIED == 1 - .endif - .include "words/fetch-e.asm" - - ; Memory - ; read 1 cell from eeprom - VE_FETCHE: -001f5c ff02 .dw $ff02 -001f5d 6540 .db "@e" -001f5e 1f38 .dw VE_HEAD - .set VE_HEAD = VE_FETCHE - XT_FETCHE: -001f5f 1f60 .dw PFA_FETCHE - PFA_FETCHE: - .if WANT_UNIFIED == 1 - .endif - PFA_FETCHE1: -001f60 b72f in_ temp2, SREG -001f61 94f8 cli -001f62 01fc movw zl, tosl -001f63 d006 rcall PFA_FETCHE2 -001f64 b38d in_ tosl, EEDR - -001f65 9631 adiw zl,1 - -001f66 d003 rcall PFA_FETCHE2 -001f67 b39d in_ tosh, EEDR -001f68 bf2f out_ SREG, temp2 -001f69 cc9b jmp_ DO_NEXT - - PFA_FETCHE2: -001f6a 99e1 sbic EECR, EEPE -001f6b cffe rjmp PFA_FETCHE2 - -001f6c bbff out_ EEARH,zh -001f6d bbee out_ EEARL,zl - -001f6e 9ae0 sbi EECR,EERE -001f6f 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: -001f70 ff02 .dw $ff02 -001f71 6921 .db "!i" -001f72 1f5c .dw VE_HEAD - .set VE_HEAD = VE_STOREI - XT_STOREI: -001f73 0c9a .dw PFA_DODEFER1 - PFA_STOREI: -001f74 005c .dw EE_STOREI -001f75 0c3b .dw XT_EDEFERFETCH -001f76 0c45 .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: -001f77 ff09 .dw $ff09 -001f78 2128 -001f79 2d69 -001f7a 726e -001f7b 7777 -001f7c 0029 .db "(!i-nrww)",0 -001f7d 1f70 .dw VE_HEAD - .set VE_HEAD = VE_DO_STOREI_NRWW - XT_DO_STOREI: -001f7e 1f7f .dw PFA_DO_STOREI_NRWW - PFA_DO_STOREI_NRWW: - ; store status register -001f7f b71f in temp1,SREG -001f80 931f push temp1 -001f81 94f8 cli - -001f82 019c movw temp2, tosl ; save the (word) address -001f83 9189 -001f84 9199 loadtos ; get the new value for the flash cell -001f85 93af push xl -001f86 93bf push xh -001f87 93cf push yl -001f88 93df push yh -001f89 d009 rcall DO_STOREI_atmega -001f8a 91df pop yh -001f8b 91cf pop yl -001f8c 91bf pop xh -001f8d 91af pop xl - ; finally clear the stack -001f8e 9189 -001f8f 9199 loadtos -001f90 911f pop temp1 - ; restore status register (and interrupt enable flag) -001f91 bf1f out SREG,temp1 - -001f92 cc72 jmp_ DO_NEXT - - ; - DO_STOREI_atmega: - ; write data to temp page buffer - ; use the values in tosl/tosh at the - ; appropiate place -001f93 d010 rcall pageload - - ; erase page if needed - ; it is needed if a bit goes from 0 to 1 -001f94 94e0 com temp4 -001f95 94f0 com temp5 -001f96 218e and tosl, temp4 -001f97 219f and tosh, temp5 -001f98 2b98 or tosh, tosl -001f99 f019 breq DO_STOREI_writepage -001f9a 01f9 movw zl, temp2 -001f9b e002 ldi temp0,(1<8000 - .elif AMFORTH_NRWW_SIZE>4000 - .elif AMFORTH_NRWW_SIZE>2000 - .include "dict/core_2k.inc" - - .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: -001fd2 0008 .dw $0008 -001fd3 6c32 -001fd4 7469 -001fd5 7265 -001fd6 6c61 .db "2literal" -001fd7 1fc8 .dw VE_HEAD - .set VE_HEAD = VE_2LITERAL - XT_2LITERAL: -001fd8 1c01 .dw DO_COLON - PFA_2LITERAL: - .endif -001fd9 1cc4 .dw XT_SWAP -001fda 02c4 .dw XT_LITERAL -001fdb 02c4 .dw XT_LITERAL -001fdc 1c20 .dw XT_EXIT - .include "words/equal.asm" - - ; Compare - ; compares two values for equality - VE_EQUAL: -001fdd ff01 .dw $ff01 -001fde 003d .db "=",0 -001fdf 1fd2 .dw VE_HEAD - .set VE_HEAD = VE_EQUAL - XT_EQUAL: -001fe0 1c01 .dw DO_COLON - PFA_EQUAL: -001fe1 1d93 .dw XT_MINUS -001fe2 1d1a .dw XT_ZEROEQUAL -001fe3 1c20 .dw XT_EXIT - .include "words/num-constants.asm" - - .endif - - .if cpu_msp430==1 - .endif - - .if cpu_avr8==1 - VE_ONE: -001fe4 ff01 .dw $ff01 -001fe5 0031 .db "1",0 -001fe6 1fdd .dw VE_HEAD - .set VE_HEAD = VE_ONE - XT_ONE: -001fe7 1c48 .dw PFA_DOVARIABLE - PFA_ONE: - .endif -001fe8 0001 .DW 1 - - .if cpu_msp430==1 - .endif - - .if cpu_avr8==1 - VE_TWO: -001fe9 ff01 .dw $ff01 -001fea 0032 .db "2",0 -001feb 1fe4 .dw VE_HEAD - .set VE_HEAD = VE_TWO - XT_TWO: -001fec 1c48 .dw PFA_DOVARIABLE - PFA_TWO: - .endif -001fed 0002 .DW 2 - .if cpu_msp430==1 - .endif - - .if cpu_avr8==1 - VE_MINUSONE: -001fee ff02 .dw $ff02 -001fef 312d .db "-1" -001ff0 1fe9 .dw VE_HEAD - .set VE_HEAD = VE_MINUSONE - XT_MINUSONE: -001ff1 1c48 .dw PFA_DOVARIABLE - PFA_MINUSONE: - .endif -001ff2 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" -00002a ff ff - ; some configs -00002c 02 0f CFG_DP: .dw DPSTART ; Dictionary Pointer -00002e 1d 01 EE_HERE: .dw HERESTART ; Memory Allocation -000030 84 00 EE_EHERE: .dw EHERESTART ; EEProm Memory Allocation -000032 15 05 CFG_WLSCOPE: .dw XT_GET_CURRENT ; default wordlist scope -000034 52 00 CFG_FORTHRECOGNIZER: .dw CFG_RECOGNIZERLISTLEN ; Recognizer word set - ; LEAVE stack is between data stack and return stack. -000036 10 04 CFG_LP0: .dw stackstart+1 -000038 54 0e CFG_TURNKEY: .dw XT_APPLTURNKEY ; TURNKEY -00003a b7 05 CFG_ENVIRONMENT:.dw VE_ENVHEAD ; environmental queries -00003c 3e 00 CFG_CURRENT: .dw CFG_FORTHWORDLIST ; forth-wordlist -00003e ee 1f CFG_FORTHWORDLIST:.dw VE_HEAD ; pre-defined (compiled in) wordlist - CFG_ORDERLISTLEN: -000040 01 00 .dw 1 - CFG_ORDERLIST: ; list of wordlist id, exactly numwordlist entries -000042 3e 00 .dw CFG_FORTHWORDLIST ; get/set-order -000044 .byte (NUMWORDLISTS-1)*CELLSIZE ; one slot is already used - CFG_RECOGNIZERLISTLEN: -000052 02 00 .dw 2 - CFG_RECOGNIZERLIST: -000054 ab 0b .dw XT_REC_FIND -000056 97 0b .dw XT_REC_NUM -000058 .byte (NUMRECOGNIZERS-2)*CELLSIZE ; two slots are already used - - EE_STOREI: -00005c 7e 1f .dw XT_DO_STOREI ; Store a cell into flash - - ; MARKER saves everything up to here. Nothing beyond gets saved - EE_MARKER: -00005e 5e 00 .dw EE_MARKER - - ; default user area - EE_INITUSER: -000060 00 00 .dw 0 ; USER_STATE -000062 00 00 .dw 0 ; USER_FOLLOWER -000064 5f 04 .dw rstackstart ; USER_RP -000066 0f 04 .dw stackstart ; USER_SP0 -000068 0f 04 .dw stackstart ; USER_SP - -00006a 00 00 .dw 0 ; USER_HANDLER -00006c 0a 00 .dw 10 ; USER_BASE - -00006e 98 00 .dw XT_TX ; USER_EMIT -000070 a6 00 .dw XT_TXQ ; USER_EMITQ -000072 6d 00 .dw XT_RX ; USER_KEY -000074 88 00 .dw XT_RXQ ; USER_KEYQ -000076 ac 0d .dw XT_SOURCETIB ; USER_SOURCE -000078 00 00 .dw 0 ; USER_G_IN -00007a 99 0d .dw XT_REFILLTIB ; USER_REFILL -00007c 99 0a .dw XT_DEFAULT_PROMPTOK -00007e b8 0a .dw XT_DEFAULT_PROMPTERROR -000080 a8 0a .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: -000082 0c 00 .dw UBRR_VAL ; BAUDRATE - ; 1st free address in EEPROM. - EHERESTART: - .cseg - - -RESOURCE USE INFORMATION ------------------------- - -Notice: -The register and instruction counts are symbol table hit counts, -and hence implicitly used resources are not counted, eg, the -'lpm' instruction without operands implicitly uses r0 and z, -none of which are counted. - -x,y,z are separate entities in the symbol table and are -counted separately from r26..r31 here. - -.dseg memory usage only counts static data declared with .byte - -"ATmega16" 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: 85 r17: 61 r18: 61 r19: 37 r20: 13 r21: 11 r22: 11 r23: 3 -r24: 203 r25: 139 r26: 28 r27: 17 r28: 7 r29: 4 r30: 85 r31: 47 -x : 4 y : 209 z : 50 -Registers used: 29 out of 35 (82.9%) - -"ATmega16" instruction use summary: -.lds : 0 .sts : 0 adc : 22 add : 17 adiw : 17 and : 4 -andi : 3 asr : 2 bclr : 0 bld : 0 brbc : 2 brbs : 7 -brcc : 3 brcs : 1 break : 0 breq : 6 brge : 1 brhc : 0 -brhs : 0 brid : 0 brie : 0 brlo : 1 brlt : 3 brmi : 3 -brne : 20 brpl : 0 brsh : 0 brtc : 0 brts : 0 brvc : 0 -brvs : 2 bset : 0 bst : 0 call : 2 cbi : 7 cbr : 1 -clc : 2 clh : 0 cli : 7 cln : 0 clr : 14 cls : 0 -clt : 0 clv : 0 clz : 0 com : 14 cp : 11 cpc : 10 -cpi : 2 cpse : 0 dec : 8 eor : 3 fmul : 0 fmuls : 0 -fmulsu: 0 icall : 0 ijmp : 1 in : 25 inc : 3 jmp : 25 -ld : 141 ldd : 4 ldi : 41 lds : 1 lpm : 16 lsl : 14 -lsr : 2 mov : 14 movw : 70 mul : 5 muls : 1 mulsu : 2 -neg : 0 nop : 0 or : 9 ori : 2 out : 22 pop : 45 -push : 39 rcall : 34 ret : 7 reti : 1 rjmp : 92 rol : 23 -ror : 6 sbc : 9 sbci : 3 sbi : 8 sbic : 3 sbis : 0 -sbiw : 16 sbr : 0 sbrc : 5 sbrs : 7 sec : 1 seh : 0 -sei : 1 sen : 0 ser : 4 ses : 0 set : 0 sev : 0 -sez : 0 sleep : 0 spm : 2 st : 77 std : 8 sts : 1 -sub : 6 subi : 3 swap : 0 tst : 0 wdr : 0 -Instructions used: 72 out of 113 (63.7%) - -"ATmega16" memory use summary [bytes]: -Segment Begin End Code Data Used Size Use% ---------------------------------------------------------------- -[.cseg] 0x000000 0x003fe6 2044 9642 11686 16384 71.3% -[.dseg] 0x000060 0x00011d 0 189 189 1024 18.5% -[.eseg] 0x000000 0x000084 0 132 132 512 25.8% - -Assembly complete, 0 errors, 8 warnings -- cgit v1.2.3