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