From d80736ab6e8e3cad2f1a30c6eaba2d6883dbe967 Mon Sep 17 00:00:00 2001 From: Dimitri Sokolyuk Date: Sat, 26 Aug 2017 20:31:40 +0200 Subject: Remove AmForth --- amforth-6.5/common/lib/2rvalue.frt | 15 - amforth-6.5/common/lib/anew.frt | 27 - amforth-6.5/common/lib/base-execute.frt | 7 - amforth-6.5/common/lib/bounds.frt | 5 - amforth-6.5/common/lib/builds.frt | 4 - amforth-6.5/common/lib/chain-stack-test.frt | 17 - amforth-6.5/common/lib/chain-stack.frt | 31 - amforth-6.5/common/lib/chains-wordlist-test.frt | 22 - amforth-6.5/common/lib/chains-wordlist.frt | 31 - amforth-6.5/common/lib/clip.frt | 8 - amforth-6.5/common/lib/crc8.frt | 94 -- amforth-6.5/common/lib/debug.frt | 11 - amforth-6.5/common/lib/defer-seal.frt | 11 - amforth-6.5/common/lib/dot-base.frt | 5 - amforth-6.5/common/lib/dot-recs.frt | 10 - amforth-6.5/common/lib/dot-ver.frt | 6 - amforth-6.5/common/lib/exception.frt | 15 - amforth-6.5/common/lib/execute-parsing.frt | 25 - amforth-6.5/common/lib/find-name.frt | 10 - amforth-6.5/common/lib/flags.frt | 54 -- amforth-6.5/common/lib/for-next.frt | 18 - amforth-6.5/common/lib/forth2012/blocks/blocks.frt | 68 -- .../common/lib/forth2012/blocks/list-dump.frt | 10 - amforth-6.5/common/lib/forth2012/blocks/list.frt | 24 - amforth-6.5/common/lib/forth2012/blocks/load.frt | 20 - .../common/lib/forth2012/core-ext/case-test.frt | 7 - amforth-6.5/common/lib/forth2012/core-ext/case.frt | 35 - .../lib/forth2012/core-ext/compile-comma.frt | 3 - .../common/lib/forth2012/core-ext/defers.frt | 23 - .../common/lib/forth2012/core-ext/exceptions.frt | 15 - amforth-6.5/common/lib/forth2012/core-ext/roll.frt | 7 - amforth-6.5/common/lib/forth2012/core/2over.frt | 8 - amforth-6.5/common/lib/forth2012/core/2swap.frt | 3 - .../common/lib/forth2012/core/action-of.frt | 14 - amforth-6.5/common/lib/forth2012/core/blank.frt | 4 - amforth-6.5/common/lib/forth2012/core/buffer.frt | 6 - .../common/lib/forth2012/core/char-plus.frt | 3 - amforth-6.5/common/lib/forth2012/core/chars.frt | 3 - amforth-6.5/common/lib/forth2012/core/count.frt | 3 - .../common/lib/forth2012/core/dot-paren.frt | 5 - amforth-6.5/common/lib/forth2012/core/erase.frt | 6 - amforth-6.5/common/lib/forth2012/core/find.frt | 21 - amforth-6.5/common/lib/forth2012/core/is.frt | 12 - amforth-6.5/common/lib/forth2012/core/move.frt | 5 - .../common/lib/forth2012/core/source-id.frt | 5 - .../common/lib/forth2012/core/star-slash.frt | 4 - amforth-6.5/common/lib/forth2012/core/values.frt | 16 - amforth-6.5/common/lib/forth2012/double.frt | 9 - .../common/lib/forth2012/double/2-fetch.frt | 7 - .../common/lib/forth2012/double/2-store.frt | 7 - .../common/lib/forth2012/double/2constant.frt | 6 - amforth-6.5/common/lib/forth2012/double/2nip.frt | 4 - amforth-6.5/common/lib/forth2012/double/2rot.frt | 3 - amforth-6.5/common/lib/forth2012/double/2tuck.frt | 3 - .../common/lib/forth2012/double/2variable.frt | 4 - .../common/lib/forth2012/double/d-equal.frt | 2 - .../common/lib/forth2012/double/d-greater-zero.frt | 8 - .../common/lib/forth2012/double/d-greater.frt | 3 - .../common/lib/forth2012/double/d-less-zero.frt | 2 - amforth-6.5/common/lib/forth2012/double/d-less.frt | 5 - amforth-6.5/common/lib/forth2012/double/d-max.frt | 3 - amforth-6.5/common/lib/forth2012/double/d-min.frt | 2 - .../common/lib/forth2012/double/d-plusstore.frt | 4 - .../common/lib/forth2012/double/d-zero-equal.frt | 3 - amforth-6.5/common/lib/forth2012/double/m-plus.frt | 2 - .../common/lib/forth2012/double/m-star-slash.frt | 7 - amforth-6.5/common/lib/forth2012/facility.frt | 3 - amforth-6.5/common/lib/forth2012/facility/ms.frt | 3 - .../lib/forth2012/facility/structures-array.frt | 24 - .../lib/forth2012/facility/structures-test.frt | 16 - .../common/lib/forth2012/facility/structures.frt | 24 - .../lib/forth2012/facility/time-and-date.frt | 33 - amforth-6.5/common/lib/forth2012/file/paren.frt | 11 - amforth-6.5/common/lib/forth2012/memory.frt | 2 - amforth-6.5/common/lib/forth2012/search-order.frt | 10 - amforth-6.5/common/lib/forth2012/search/also.frt | 8 - .../common/lib/forth2012/search/definitions.frt | 8 - amforth-6.5/common/lib/forth2012/search/forth.frt | 10 - .../common/lib/forth2012/search/get-order.frt | 5 - amforth-6.5/common/lib/forth2012/search/only.frt | 7 - amforth-6.5/common/lib/forth2012/search/order.frt | 9 - .../common/lib/forth2012/search/previous.frt | 8 - .../common/lib/forth2012/search/set-order.frt | 13 - amforth-6.5/common/lib/forth2012/string/search.frt | 23 - amforth-6.5/common/lib/forth2012/string/split.frt | 15 - .../common/lib/forth2012/string/trailing.frt | 10 - amforth-6.5/common/lib/forth2012/tester.frt | 6 - .../common/lib/forth2012/tester/anstests.zip | Bin 13354 -> 0 bytes .../common/lib/forth2012/tester/anstests0.9.zip | Bin 35058 -> 0 bytes amforth-6.5/common/lib/forth2012/tester/core.fr | 1002 -------------------- .../common/lib/forth2012/tester/coreexttest.fth | 322 ------- .../common/lib/forth2012/tester/coreplustest.fth | 190 ---- .../common/lib/forth2012/tester/doubletest.fth | 386 -------- .../common/lib/forth2012/tester/exceptiontest.fth | 96 -- .../common/lib/forth2012/tester/filetest.fth | 193 ---- .../common/lib/forth2012/tester/memorytest.fth | 93 -- .../common/lib/forth2012/tester/postponetest.fs | 379 -------- .../lib/forth2012/tester/searchordertest.fth | 178 ---- .../lib/forth2012/tester/searchordertest.txt | 184 ---- .../common/lib/forth2012/tester/stringtest.fth | 161 ---- .../common/lib/forth2012/tester/tester-amforth.frt | 66 -- .../common/lib/forth2012/tester/toolstest.fth | 172 ---- amforth-6.5/common/lib/forth2012/tools.frt | 6 - .../lib/forth2012/tools/bracket-conditional.frt | 20 - amforth-6.5/common/lib/forth2012/tools/defined.frt | 10 - amforth-6.5/common/lib/forth2012/tools/dot-s.frt | 3 - amforth-6.5/common/lib/forth2012/tools/dump.frt | 50 - amforth-6.5/common/lib/forth2012/tools/dumper.frt | 57 -- .../common/lib/forth2012/tools/name2compile.frt | 9 - .../common/lib/forth2012/tools/name2interpret.frt | 4 - .../common/lib/forth2012/tools/question.frt | 4 - amforth-6.5/common/lib/forth2012/tools/see.frt | 56 -- amforth-6.5/common/lib/forth2012/tools/synonym.frt | 12 - amforth-6.5/common/lib/fsm.frt | 67 -- .../common/lib/hardware/1wire-crc8-test.frt | 54 -- amforth-6.5/common/lib/hardware/1wire-crc8.frt | 65 -- amforth-6.5/common/lib/hardware/1wire-ds18s20.frt | 32 - amforth-6.5/common/lib/hardware/1wire.frt | 222 ----- amforth-6.5/common/lib/hardware/date-time.frt | 29 - amforth-6.5/common/lib/hardware/i2c-compass.frt | 49 - amforth-6.5/common/lib/hardware/i2c-detect.frt | 40 - .../common/lib/hardware/i2c-eeprom-block.frt | 77 -- .../common/lib/hardware/i2c-eeprom-value.frt | 19 - amforth-6.5/common/lib/hardware/i2c-eeprom.frt | 47 - amforth-6.5/common/lib/hardware/i2c-lcd.frt | 31 - amforth-6.5/common/lib/hardware/i2c-value.frt | 23 - amforth-6.5/common/lib/hardware/i2c.frt | 87 -- .../common/lib/hardware/int-critical-test.frt | 14 - amforth-6.5/common/lib/hardware/int-critical.frt | 12 - amforth-6.5/common/lib/hardware/mmc-test.frt | 96 -- amforth-6.5/common/lib/hardware/power-save.frt | 36 - amforth-6.5/common/lib/hardware/spi-mmc.frt | 98 -- amforth-6.5/common/lib/hardware/timer-test.frt | 22 - amforth-6.5/common/lib/hardware/timer.frt | 56 -- amforth-6.5/common/lib/hardware/vt100.frt | 59 -- amforth-6.5/common/lib/hardware/xonxoff.frt | 27 - amforth-6.5/common/lib/help-words.frt | 19 - amforth-6.5/common/lib/help.frt | 13 - amforth-6.5/common/lib/in.frt | 36 - amforth-6.5/common/lib/iniside-q.frt | 3 - amforth-6.5/common/lib/local.frt | 63 -- amforth-6.5/common/lib/macro.frt | 25 - amforth-6.5/common/lib/minus-loop.frt | 15 - amforth-6.5/common/lib/modules-test.frt | 15 - amforth-6.5/common/lib/modules.frt | 28 - amforth-6.5/common/lib/multitask-messages.frt | 14 - amforth-6.5/common/lib/multitask-new.frt | 9 - amforth-6.5/common/lib/multitask-semaphore.frt | 15 - amforth-6.5/common/lib/multitask-test.frt | 44 - amforth-6.5/common/lib/multitask.frt | 135 --- amforth-6.5/common/lib/profiler.frt | 31 - amforth-6.5/common/lib/quotations.frt | 26 - amforth-6.5/common/lib/random.frt | 15 - amforth-6.5/common/lib/recognizer.frt | 15 - amforth-6.5/common/lib/regexp.frt | 65 -- amforth-6.5/common/lib/reverse.frt | 17 - amforth-6.5/common/lib/search-name.frt | 18 - amforth-6.5/common/lib/sinus.frt | 50 - amforth-6.5/common/lib/sqrt.frt | 3 - amforth-6.5/common/lib/string-split.frt | 38 - amforth-6.5/common/lib/to-name.frt | 21 - amforth-6.5/common/lib/tracer.frt | 13 - amforth-6.5/common/lib/u-2slash.frt | 7 - amforth-6.5/common/lib/u-star-slash-mod.frt | 7 - amforth-6.5/common/lib/uzerodotr.frt | 7 - amforth-6.5/common/lib/vocabulary.frt | 11 - amforth-6.5/common/lib/watcher.frt | 21 - amforth-6.5/common/lib/wordlist-tools.frt | 18 - amforth-6.5/common/words/2drop.asm | 21 - amforth-6.5/common/words/2dup.asm | 22 - amforth-6.5/common/words/2literal.asm | 21 - amforth-6.5/common/words/2swap.asm | 24 - amforth-6.5/common/words/_template.asm | 8 - amforth-6.5/common/words/abort-string.asm | 29 - amforth-6.5/common/words/abort.asm | 19 - amforth-6.5/common/words/abs.asm | 20 - amforth-6.5/common/words/accept.asm | 95 -- amforth-6.5/common/words/again.asm | 22 - amforth-6.5/common/words/ahead.asm | 22 - amforth-6.5/common/words/backslash.asm | 30 - amforth-6.5/common/words/base.asm | 19 - amforth-6.5/common/words/begin.asm | 20 - amforth-6.5/common/words/bin.asm | 22 - amforth-6.5/common/words/bl.asm | 19 - amforth-6.5/common/words/bounds.asm | 22 - amforth-6.5/common/words/bracketchar.asm | 23 - amforth-6.5/common/words/bracketcompile.asm | 23 - amforth-6.5/common/words/brackettick.asm | 21 - amforth-6.5/common/words/build-info.tmpl | 26 - amforth-6.5/common/words/catch.asm | 39 - amforth-6.5/common/words/cfg-order.asm | 19 - amforth-6.5/common/words/cfg-recognizer.asm | 19 - amforth-6.5/common/words/char.asm | 22 - amforth-6.5/common/words/colon.asm | 22 - amforth-6.5/common/words/compile.asm | 25 - amforth-6.5/common/words/constant.asm | 25 - amforth-6.5/common/words/cr.asm | 26 - amforth-6.5/common/words/create.asm | 23 - amforth-6.5/common/words/cscan.asm | 56 -- amforth-6.5/common/words/cskip.asm | 37 - amforth-6.5/common/words/d-dot-r.asm | 35 - amforth-6.5/common/words/d-dot.asm | 24 - amforth-6.5/common/words/decimal.asm | 23 - amforth-6.5/common/words/defer-fetch.asm | 24 - amforth-6.5/common/words/defer-store.asm | 26 - amforth-6.5/common/words/depth.asm | 23 - amforth-6.5/common/words/digit-q.asm | 24 - amforth-6.5/common/words/do-create.asm | 22 - amforth-6.5/common/words/do.asm | 25 - amforth-6.5/common/words/dot-quote.asm | 31 - amforth-6.5/common/words/dot-r.asm | 32 - amforth-6.5/common/words/dot-s.asm | 42 - amforth-6.5/common/words/dot.asm | 24 - amforth-6.5/common/words/dt-null.asm | 41 - amforth-6.5/common/words/else.asm | 24 - amforth-6.5/common/words/emit.asm | 21 - amforth-6.5/common/words/emitq.asm | 21 - amforth-6.5/common/words/endloop.asm | 28 - amforth-6.5/common/words/env-cpu.asm | 22 - amforth-6.5/common/words/env-forthname.asm | 26 - amforth-6.5/common/words/env-forthversion.asm | 20 - amforth-6.5/common/words/env-slashhold.asm | 22 - amforth-6.5/common/words/env-usersize.asm | 21 - amforth-6.5/common/words/f_cpu.asm | 22 - amforth-6.5/common/words/find-xt.asm | 55 -- amforth-6.5/common/words/get-order.asm | 22 - amforth-6.5/common/words/get-recognizer.asm | 22 - amforth-6.5/common/words/get-stack.asm | 46 - amforth-6.5/common/words/git-info.tmpl | 27 - amforth-6.5/common/words/handler.asm | 19 - amforth-6.5/common/words/hex.asm | 23 - amforth-6.5/common/words/hold.asm | 29 - amforth-6.5/common/words/if.asm | 22 - amforth-6.5/common/words/interpret.asm | 38 - amforth-6.5/common/words/key.asm | 21 - amforth-6.5/common/words/keyq.asm | 21 - amforth-6.5/common/words/l-from.asm | 27 - amforth-6.5/common/words/l-paren.asm | 23 - amforth-6.5/common/words/leave.asm | 20 - amforth-6.5/common/words/left-bracket.asm | 22 - amforth-6.5/common/words/less-sharp.asm | 22 - amforth-6.5/common/words/literal.asm | 22 - amforth-6.5/common/words/loop.asm | 22 - amforth-6.5/common/words/map-stack.asm | 61 -- amforth-6.5/common/words/max.asm | 27 - amforth-6.5/common/words/min.asm | 28 - amforth-6.5/common/words/mod.asm | 23 - amforth-6.5/common/words/name2compile.asm | 31 - amforth-6.5/common/words/name2interpret.asm | 19 - amforth-6.5/common/words/name2string.asm | 24 - amforth-6.5/common/words/noop.asm | 19 - amforth-6.5/common/words/not-equal.asm | 20 - amforth-6.5/common/words/num-constants.asm | 51 - amforth-6.5/common/words/number.asm | 101 -- amforth-6.5/common/words/pad.asm | 23 - amforth-6.5/common/words/parse-name.asm | 60 -- amforth-6.5/common/words/parse.asm | 33 - amforth-6.5/common/words/pick.asm | 21 - amforth-6.5/common/words/place.asm | 24 - amforth-6.5/common/words/plusloop.asm | 22 - amforth-6.5/common/words/postpone.asm | 32 - amforth-6.5/common/words/prompt-error.asm | 64 -- amforth-6.5/common/words/prompt-ok.asm | 52 - amforth-6.5/common/words/prompt-ready.asm | 54 -- amforth-6.5/common/words/q-abort.asm | 22 - amforth-6.5/common/words/q-dnegate.asm | 21 - amforth-6.5/common/words/q-negate.asm | 22 - amforth-6.5/common/words/q-sign.asm | 24 - amforth-6.5/common/words/q-stack.asm | 26 - amforth-6.5/common/words/qdo.asm | 54 -- amforth-6.5/common/words/quit.asm | 58 -- amforth-6.5/common/words/rdefer-fetch.asm | 20 - amforth-6.5/common/words/rdefer-store.asm | 21 - amforth-6.5/common/words/rec-find.asm | 85 -- amforth-6.5/common/words/rec-intnum.asm | 76 -- amforth-6.5/common/words/recognize.asm | 73 -- amforth-6.5/common/words/recurse.asm | 22 - amforth-6.5/common/words/refill.asm | 21 - amforth-6.5/common/words/repeat.asm | 21 - amforth-6.5/common/words/reveal.asm | 25 - amforth-6.5/common/words/right-bracket.asm | 22 - amforth-6.5/common/words/s-to-d.asm | 20 - amforth-6.5/common/words/search-wordlist.asm | 72 -- amforth-6.5/common/words/semicolon.asm | 25 - amforth-6.5/common/words/set-base.asm | 58 -- amforth-6.5/common/words/set-order.asm | 23 - amforth-6.5/common/words/set-recognizer.asm | 23 - amforth-6.5/common/words/set-stack.asm | 43 - amforth-6.5/common/words/sharp-greater.asm | 25 - amforth-6.5/common/words/sharp-s.asm | 26 - amforth-6.5/common/words/sharp.asm | 41 - amforth-6.5/common/words/show-wordlist.asm | 38 - amforth-6.5/common/words/sign.asm | 26 - amforth-6.5/common/words/slash-string.asm | 26 - amforth-6.5/common/words/slash.asm | 24 - amforth-6.5/common/words/sliteral.asm | 22 - amforth-6.5/common/words/source.asm | 23 - amforth-6.5/common/words/space.asm | 21 - amforth-6.5/common/words/spaces.asm | 27 - amforth-6.5/common/words/squote.asm | 33 - amforth-6.5/common/words/star.asm | 22 - amforth-6.5/common/words/then.asm | 20 - amforth-6.5/common/words/throw.asm | 39 - amforth-6.5/common/words/tib.asm | 96 -- amforth-6.5/common/words/tick.asm | 41 - amforth-6.5/common/words/to-in.asm | 19 - amforth-6.5/common/words/to-l.asm | 25 - amforth-6.5/common/words/to-lower.asm | 33 - amforth-6.5/common/words/to-number.asm | 41 - amforth-6.5/common/words/to-upper.asm | 31 - amforth-6.5/common/words/to.asm | 59 -- amforth-6.5/common/words/traverse-wordlist.asm | 49 - amforth-6.5/common/words/tuck.asm | 21 - amforth-6.5/common/words/type.asm | 32 - amforth-6.5/common/words/u-dot-r.asm | 25 - amforth-6.5/common/words/u-dot.asm | 22 - amforth-6.5/common/words/u-greater.asm | 21 - amforth-6.5/common/words/ud-dot-r.asm | 31 - amforth-6.5/common/words/ud-dot.asm | 23 - amforth-6.5/common/words/ud-slash-mod.asm | 28 - amforth-6.5/common/words/ud-star.asm | 21 - amforth-6.5/common/words/udefer-fetch.asm | 23 - amforth-6.5/common/words/udefer-store.asm | 25 - amforth-6.5/common/words/umax.asm | 22 - amforth-6.5/common/words/umin.asm | 21 - amforth-6.5/common/words/until.asm | 24 - amforth-6.5/common/words/variable.asm | 24 - amforth-6.5/common/words/ver.asm | 42 - amforth-6.5/common/words/warm.asm | 27 - amforth-6.5/common/words/while.asm | 21 - amforth-6.5/common/words/within.asm | 25 - amforth-6.5/common/words/word.asm | 25 - amforth-6.5/common/words/words.asm | 25 - 333 files changed, 11788 deletions(-) delete mode 100644 amforth-6.5/common/lib/2rvalue.frt delete mode 100644 amforth-6.5/common/lib/anew.frt delete mode 100644 amforth-6.5/common/lib/base-execute.frt delete mode 100644 amforth-6.5/common/lib/bounds.frt delete mode 100644 amforth-6.5/common/lib/builds.frt delete mode 100644 amforth-6.5/common/lib/chain-stack-test.frt delete mode 100644 amforth-6.5/common/lib/chain-stack.frt delete mode 100644 amforth-6.5/common/lib/chains-wordlist-test.frt delete mode 100644 amforth-6.5/common/lib/chains-wordlist.frt delete mode 100644 amforth-6.5/common/lib/clip.frt delete mode 100644 amforth-6.5/common/lib/crc8.frt delete mode 100644 amforth-6.5/common/lib/debug.frt delete mode 100644 amforth-6.5/common/lib/defer-seal.frt delete mode 100644 amforth-6.5/common/lib/dot-base.frt delete mode 100644 amforth-6.5/common/lib/dot-recs.frt delete mode 100644 amforth-6.5/common/lib/dot-ver.frt delete mode 100644 amforth-6.5/common/lib/exception.frt delete mode 100644 amforth-6.5/common/lib/execute-parsing.frt delete mode 100644 amforth-6.5/common/lib/find-name.frt delete mode 100644 amforth-6.5/common/lib/flags.frt delete mode 100644 amforth-6.5/common/lib/for-next.frt delete mode 100644 amforth-6.5/common/lib/forth2012/blocks/blocks.frt delete mode 100644 amforth-6.5/common/lib/forth2012/blocks/list-dump.frt delete mode 100644 amforth-6.5/common/lib/forth2012/blocks/list.frt delete mode 100644 amforth-6.5/common/lib/forth2012/blocks/load.frt delete mode 100644 amforth-6.5/common/lib/forth2012/core-ext/case-test.frt delete mode 100644 amforth-6.5/common/lib/forth2012/core-ext/case.frt delete mode 100644 amforth-6.5/common/lib/forth2012/core-ext/compile-comma.frt delete mode 100644 amforth-6.5/common/lib/forth2012/core-ext/defers.frt delete mode 100644 amforth-6.5/common/lib/forth2012/core-ext/exceptions.frt delete mode 100644 amforth-6.5/common/lib/forth2012/core-ext/roll.frt delete mode 100644 amforth-6.5/common/lib/forth2012/core/2over.frt delete mode 100644 amforth-6.5/common/lib/forth2012/core/2swap.frt delete mode 100644 amforth-6.5/common/lib/forth2012/core/action-of.frt delete mode 100644 amforth-6.5/common/lib/forth2012/core/blank.frt delete mode 100644 amforth-6.5/common/lib/forth2012/core/buffer.frt delete mode 100644 amforth-6.5/common/lib/forth2012/core/char-plus.frt delete mode 100644 amforth-6.5/common/lib/forth2012/core/chars.frt delete mode 100644 amforth-6.5/common/lib/forth2012/core/count.frt delete mode 100644 amforth-6.5/common/lib/forth2012/core/dot-paren.frt delete mode 100644 amforth-6.5/common/lib/forth2012/core/erase.frt delete mode 100644 amforth-6.5/common/lib/forth2012/core/find.frt delete mode 100644 amforth-6.5/common/lib/forth2012/core/is.frt delete mode 100644 amforth-6.5/common/lib/forth2012/core/move.frt delete mode 100644 amforth-6.5/common/lib/forth2012/core/source-id.frt delete mode 100644 amforth-6.5/common/lib/forth2012/core/star-slash.frt delete mode 100644 amforth-6.5/common/lib/forth2012/core/values.frt delete mode 100644 amforth-6.5/common/lib/forth2012/double.frt delete mode 100644 amforth-6.5/common/lib/forth2012/double/2-fetch.frt delete mode 100644 amforth-6.5/common/lib/forth2012/double/2-store.frt delete mode 100644 amforth-6.5/common/lib/forth2012/double/2constant.frt delete mode 100644 amforth-6.5/common/lib/forth2012/double/2nip.frt delete mode 100644 amforth-6.5/common/lib/forth2012/double/2rot.frt delete mode 100644 amforth-6.5/common/lib/forth2012/double/2tuck.frt delete mode 100644 amforth-6.5/common/lib/forth2012/double/2variable.frt delete mode 100644 amforth-6.5/common/lib/forth2012/double/d-equal.frt delete mode 100644 amforth-6.5/common/lib/forth2012/double/d-greater-zero.frt delete mode 100644 amforth-6.5/common/lib/forth2012/double/d-greater.frt delete mode 100644 amforth-6.5/common/lib/forth2012/double/d-less-zero.frt delete mode 100644 amforth-6.5/common/lib/forth2012/double/d-less.frt delete mode 100644 amforth-6.5/common/lib/forth2012/double/d-max.frt delete mode 100644 amforth-6.5/common/lib/forth2012/double/d-min.frt delete mode 100644 amforth-6.5/common/lib/forth2012/double/d-plusstore.frt delete mode 100644 amforth-6.5/common/lib/forth2012/double/d-zero-equal.frt delete mode 100644 amforth-6.5/common/lib/forth2012/double/m-plus.frt delete mode 100644 amforth-6.5/common/lib/forth2012/double/m-star-slash.frt delete mode 100644 amforth-6.5/common/lib/forth2012/facility.frt delete mode 100644 amforth-6.5/common/lib/forth2012/facility/ms.frt delete mode 100644 amforth-6.5/common/lib/forth2012/facility/structures-array.frt delete mode 100644 amforth-6.5/common/lib/forth2012/facility/structures-test.frt delete mode 100644 amforth-6.5/common/lib/forth2012/facility/structures.frt delete mode 100644 amforth-6.5/common/lib/forth2012/facility/time-and-date.frt delete mode 100644 amforth-6.5/common/lib/forth2012/file/paren.frt delete mode 100644 amforth-6.5/common/lib/forth2012/memory.frt delete mode 100644 amforth-6.5/common/lib/forth2012/search-order.frt delete mode 100644 amforth-6.5/common/lib/forth2012/search/also.frt delete mode 100644 amforth-6.5/common/lib/forth2012/search/definitions.frt delete mode 100644 amforth-6.5/common/lib/forth2012/search/forth.frt delete mode 100644 amforth-6.5/common/lib/forth2012/search/get-order.frt delete mode 100644 amforth-6.5/common/lib/forth2012/search/only.frt delete mode 100644 amforth-6.5/common/lib/forth2012/search/order.frt delete mode 100644 amforth-6.5/common/lib/forth2012/search/previous.frt delete mode 100644 amforth-6.5/common/lib/forth2012/search/set-order.frt delete mode 100644 amforth-6.5/common/lib/forth2012/string/search.frt delete mode 100644 amforth-6.5/common/lib/forth2012/string/split.frt delete mode 100644 amforth-6.5/common/lib/forth2012/string/trailing.frt delete mode 100644 amforth-6.5/common/lib/forth2012/tester.frt delete mode 100644 amforth-6.5/common/lib/forth2012/tester/anstests.zip delete mode 100644 amforth-6.5/common/lib/forth2012/tester/anstests0.9.zip delete mode 100644 amforth-6.5/common/lib/forth2012/tester/core.fr delete mode 100644 amforth-6.5/common/lib/forth2012/tester/coreexttest.fth delete mode 100644 amforth-6.5/common/lib/forth2012/tester/coreplustest.fth delete mode 100644 amforth-6.5/common/lib/forth2012/tester/doubletest.fth delete mode 100644 amforth-6.5/common/lib/forth2012/tester/exceptiontest.fth delete mode 100644 amforth-6.5/common/lib/forth2012/tester/filetest.fth delete mode 100644 amforth-6.5/common/lib/forth2012/tester/memorytest.fth delete mode 100644 amforth-6.5/common/lib/forth2012/tester/postponetest.fs delete mode 100644 amforth-6.5/common/lib/forth2012/tester/searchordertest.fth delete mode 100644 amforth-6.5/common/lib/forth2012/tester/searchordertest.txt delete mode 100644 amforth-6.5/common/lib/forth2012/tester/stringtest.fth delete mode 100644 amforth-6.5/common/lib/forth2012/tester/tester-amforth.frt delete mode 100644 amforth-6.5/common/lib/forth2012/tester/toolstest.fth delete mode 100644 amforth-6.5/common/lib/forth2012/tools.frt delete mode 100644 amforth-6.5/common/lib/forth2012/tools/bracket-conditional.frt delete mode 100644 amforth-6.5/common/lib/forth2012/tools/defined.frt delete mode 100644 amforth-6.5/common/lib/forth2012/tools/dot-s.frt delete mode 100644 amforth-6.5/common/lib/forth2012/tools/dump.frt delete mode 100644 amforth-6.5/common/lib/forth2012/tools/dumper.frt delete mode 100644 amforth-6.5/common/lib/forth2012/tools/name2compile.frt delete mode 100644 amforth-6.5/common/lib/forth2012/tools/name2interpret.frt delete mode 100644 amforth-6.5/common/lib/forth2012/tools/question.frt delete mode 100644 amforth-6.5/common/lib/forth2012/tools/see.frt delete mode 100644 amforth-6.5/common/lib/forth2012/tools/synonym.frt delete mode 100644 amforth-6.5/common/lib/fsm.frt delete mode 100644 amforth-6.5/common/lib/hardware/1wire-crc8-test.frt delete mode 100644 amforth-6.5/common/lib/hardware/1wire-crc8.frt delete mode 100644 amforth-6.5/common/lib/hardware/1wire-ds18s20.frt delete mode 100644 amforth-6.5/common/lib/hardware/1wire.frt delete mode 100644 amforth-6.5/common/lib/hardware/date-time.frt delete mode 100644 amforth-6.5/common/lib/hardware/i2c-compass.frt delete mode 100644 amforth-6.5/common/lib/hardware/i2c-detect.frt delete mode 100644 amforth-6.5/common/lib/hardware/i2c-eeprom-block.frt delete mode 100644 amforth-6.5/common/lib/hardware/i2c-eeprom-value.frt delete mode 100644 amforth-6.5/common/lib/hardware/i2c-eeprom.frt delete mode 100644 amforth-6.5/common/lib/hardware/i2c-lcd.frt delete mode 100644 amforth-6.5/common/lib/hardware/i2c-value.frt delete mode 100644 amforth-6.5/common/lib/hardware/i2c.frt delete mode 100644 amforth-6.5/common/lib/hardware/int-critical-test.frt delete mode 100644 amforth-6.5/common/lib/hardware/int-critical.frt delete mode 100644 amforth-6.5/common/lib/hardware/mmc-test.frt delete mode 100644 amforth-6.5/common/lib/hardware/power-save.frt delete mode 100644 amforth-6.5/common/lib/hardware/spi-mmc.frt delete mode 100644 amforth-6.5/common/lib/hardware/timer-test.frt delete mode 100644 amforth-6.5/common/lib/hardware/timer.frt delete mode 100644 amforth-6.5/common/lib/hardware/vt100.frt delete mode 100644 amforth-6.5/common/lib/hardware/xonxoff.frt delete mode 100644 amforth-6.5/common/lib/help-words.frt delete mode 100644 amforth-6.5/common/lib/help.frt delete mode 100644 amforth-6.5/common/lib/in.frt delete mode 100644 amforth-6.5/common/lib/iniside-q.frt delete mode 100644 amforth-6.5/common/lib/local.frt delete mode 100644 amforth-6.5/common/lib/macro.frt delete mode 100644 amforth-6.5/common/lib/minus-loop.frt delete mode 100644 amforth-6.5/common/lib/modules-test.frt delete mode 100644 amforth-6.5/common/lib/modules.frt delete mode 100644 amforth-6.5/common/lib/multitask-messages.frt delete mode 100644 amforth-6.5/common/lib/multitask-new.frt delete mode 100644 amforth-6.5/common/lib/multitask-semaphore.frt delete mode 100644 amforth-6.5/common/lib/multitask-test.frt delete mode 100644 amforth-6.5/common/lib/multitask.frt delete mode 100644 amforth-6.5/common/lib/profiler.frt delete mode 100644 amforth-6.5/common/lib/quotations.frt delete mode 100644 amforth-6.5/common/lib/random.frt delete mode 100644 amforth-6.5/common/lib/recognizer.frt delete mode 100644 amforth-6.5/common/lib/regexp.frt delete mode 100644 amforth-6.5/common/lib/reverse.frt delete mode 100644 amforth-6.5/common/lib/search-name.frt delete mode 100644 amforth-6.5/common/lib/sinus.frt delete mode 100644 amforth-6.5/common/lib/sqrt.frt delete mode 100644 amforth-6.5/common/lib/string-split.frt delete mode 100644 amforth-6.5/common/lib/to-name.frt delete mode 100644 amforth-6.5/common/lib/tracer.frt delete mode 100644 amforth-6.5/common/lib/u-2slash.frt delete mode 100644 amforth-6.5/common/lib/u-star-slash-mod.frt delete mode 100644 amforth-6.5/common/lib/uzerodotr.frt delete mode 100644 amforth-6.5/common/lib/vocabulary.frt delete mode 100644 amforth-6.5/common/lib/watcher.frt delete mode 100644 amforth-6.5/common/lib/wordlist-tools.frt delete mode 100644 amforth-6.5/common/words/2drop.asm delete mode 100644 amforth-6.5/common/words/2dup.asm delete mode 100644 amforth-6.5/common/words/2literal.asm delete mode 100644 amforth-6.5/common/words/2swap.asm delete mode 100644 amforth-6.5/common/words/_template.asm delete mode 100644 amforth-6.5/common/words/abort-string.asm delete mode 100644 amforth-6.5/common/words/abort.asm delete mode 100644 amforth-6.5/common/words/abs.asm delete mode 100644 amforth-6.5/common/words/accept.asm delete mode 100644 amforth-6.5/common/words/again.asm delete mode 100644 amforth-6.5/common/words/ahead.asm delete mode 100644 amforth-6.5/common/words/backslash.asm delete mode 100644 amforth-6.5/common/words/base.asm delete mode 100644 amforth-6.5/common/words/begin.asm delete mode 100644 amforth-6.5/common/words/bin.asm delete mode 100644 amforth-6.5/common/words/bl.asm delete mode 100644 amforth-6.5/common/words/bounds.asm delete mode 100644 amforth-6.5/common/words/bracketchar.asm delete mode 100644 amforth-6.5/common/words/bracketcompile.asm delete mode 100644 amforth-6.5/common/words/brackettick.asm delete mode 100644 amforth-6.5/common/words/build-info.tmpl delete mode 100644 amforth-6.5/common/words/catch.asm delete mode 100644 amforth-6.5/common/words/cfg-order.asm delete mode 100644 amforth-6.5/common/words/cfg-recognizer.asm delete mode 100644 amforth-6.5/common/words/char.asm delete mode 100644 amforth-6.5/common/words/colon.asm delete mode 100644 amforth-6.5/common/words/compile.asm delete mode 100644 amforth-6.5/common/words/constant.asm delete mode 100644 amforth-6.5/common/words/cr.asm delete mode 100644 amforth-6.5/common/words/create.asm delete mode 100644 amforth-6.5/common/words/cscan.asm delete mode 100644 amforth-6.5/common/words/cskip.asm delete mode 100644 amforth-6.5/common/words/d-dot-r.asm delete mode 100644 amforth-6.5/common/words/d-dot.asm delete mode 100644 amforth-6.5/common/words/decimal.asm delete mode 100644 amforth-6.5/common/words/defer-fetch.asm delete mode 100644 amforth-6.5/common/words/defer-store.asm delete mode 100644 amforth-6.5/common/words/depth.asm delete mode 100644 amforth-6.5/common/words/digit-q.asm delete mode 100644 amforth-6.5/common/words/do-create.asm delete mode 100644 amforth-6.5/common/words/do.asm delete mode 100644 amforth-6.5/common/words/dot-quote.asm delete mode 100644 amforth-6.5/common/words/dot-r.asm delete mode 100644 amforth-6.5/common/words/dot-s.asm delete mode 100644 amforth-6.5/common/words/dot.asm delete mode 100644 amforth-6.5/common/words/dt-null.asm delete mode 100644 amforth-6.5/common/words/else.asm delete mode 100644 amforth-6.5/common/words/emit.asm delete mode 100644 amforth-6.5/common/words/emitq.asm delete mode 100644 amforth-6.5/common/words/endloop.asm delete mode 100644 amforth-6.5/common/words/env-cpu.asm delete mode 100644 amforth-6.5/common/words/env-forthname.asm delete mode 100644 amforth-6.5/common/words/env-forthversion.asm delete mode 100644 amforth-6.5/common/words/env-slashhold.asm delete mode 100644 amforth-6.5/common/words/env-usersize.asm delete mode 100644 amforth-6.5/common/words/f_cpu.asm delete mode 100644 amforth-6.5/common/words/find-xt.asm delete mode 100644 amforth-6.5/common/words/get-order.asm delete mode 100644 amforth-6.5/common/words/get-recognizer.asm delete mode 100644 amforth-6.5/common/words/get-stack.asm delete mode 100644 amforth-6.5/common/words/git-info.tmpl delete mode 100644 amforth-6.5/common/words/handler.asm delete mode 100644 amforth-6.5/common/words/hex.asm delete mode 100644 amforth-6.5/common/words/hold.asm delete mode 100644 amforth-6.5/common/words/if.asm delete mode 100644 amforth-6.5/common/words/interpret.asm delete mode 100644 amforth-6.5/common/words/key.asm delete mode 100644 amforth-6.5/common/words/keyq.asm delete mode 100644 amforth-6.5/common/words/l-from.asm delete mode 100644 amforth-6.5/common/words/l-paren.asm delete mode 100644 amforth-6.5/common/words/leave.asm delete mode 100644 amforth-6.5/common/words/left-bracket.asm delete mode 100644 amforth-6.5/common/words/less-sharp.asm delete mode 100644 amforth-6.5/common/words/literal.asm delete mode 100644 amforth-6.5/common/words/loop.asm delete mode 100644 amforth-6.5/common/words/map-stack.asm delete mode 100644 amforth-6.5/common/words/max.asm delete mode 100644 amforth-6.5/common/words/min.asm delete mode 100644 amforth-6.5/common/words/mod.asm delete mode 100644 amforth-6.5/common/words/name2compile.asm delete mode 100644 amforth-6.5/common/words/name2interpret.asm delete mode 100644 amforth-6.5/common/words/name2string.asm delete mode 100644 amforth-6.5/common/words/noop.asm delete mode 100644 amforth-6.5/common/words/not-equal.asm delete mode 100644 amforth-6.5/common/words/num-constants.asm delete mode 100644 amforth-6.5/common/words/number.asm delete mode 100644 amforth-6.5/common/words/pad.asm delete mode 100644 amforth-6.5/common/words/parse-name.asm delete mode 100644 amforth-6.5/common/words/parse.asm delete mode 100644 amforth-6.5/common/words/pick.asm delete mode 100644 amforth-6.5/common/words/place.asm delete mode 100644 amforth-6.5/common/words/plusloop.asm delete mode 100644 amforth-6.5/common/words/postpone.asm delete mode 100644 amforth-6.5/common/words/prompt-error.asm delete mode 100644 amforth-6.5/common/words/prompt-ok.asm delete mode 100644 amforth-6.5/common/words/prompt-ready.asm delete mode 100644 amforth-6.5/common/words/q-abort.asm delete mode 100644 amforth-6.5/common/words/q-dnegate.asm delete mode 100644 amforth-6.5/common/words/q-negate.asm delete mode 100644 amforth-6.5/common/words/q-sign.asm delete mode 100644 amforth-6.5/common/words/q-stack.asm delete mode 100644 amforth-6.5/common/words/qdo.asm delete mode 100644 amforth-6.5/common/words/quit.asm delete mode 100644 amforth-6.5/common/words/rdefer-fetch.asm delete mode 100644 amforth-6.5/common/words/rdefer-store.asm delete mode 100644 amforth-6.5/common/words/rec-find.asm delete mode 100644 amforth-6.5/common/words/rec-intnum.asm delete mode 100644 amforth-6.5/common/words/recognize.asm delete mode 100644 amforth-6.5/common/words/recurse.asm delete mode 100644 amforth-6.5/common/words/refill.asm delete mode 100644 amforth-6.5/common/words/repeat.asm delete mode 100644 amforth-6.5/common/words/reveal.asm delete mode 100644 amforth-6.5/common/words/right-bracket.asm delete mode 100644 amforth-6.5/common/words/s-to-d.asm delete mode 100644 amforth-6.5/common/words/search-wordlist.asm delete mode 100644 amforth-6.5/common/words/semicolon.asm delete mode 100644 amforth-6.5/common/words/set-base.asm delete mode 100644 amforth-6.5/common/words/set-order.asm delete mode 100644 amforth-6.5/common/words/set-recognizer.asm delete mode 100644 amforth-6.5/common/words/set-stack.asm delete mode 100644 amforth-6.5/common/words/sharp-greater.asm delete mode 100644 amforth-6.5/common/words/sharp-s.asm delete mode 100644 amforth-6.5/common/words/sharp.asm delete mode 100644 amforth-6.5/common/words/show-wordlist.asm delete mode 100644 amforth-6.5/common/words/sign.asm delete mode 100644 amforth-6.5/common/words/slash-string.asm delete mode 100644 amforth-6.5/common/words/slash.asm delete mode 100644 amforth-6.5/common/words/sliteral.asm delete mode 100644 amforth-6.5/common/words/source.asm delete mode 100644 amforth-6.5/common/words/space.asm delete mode 100644 amforth-6.5/common/words/spaces.asm delete mode 100644 amforth-6.5/common/words/squote.asm delete mode 100644 amforth-6.5/common/words/star.asm delete mode 100644 amforth-6.5/common/words/then.asm delete mode 100644 amforth-6.5/common/words/throw.asm delete mode 100644 amforth-6.5/common/words/tib.asm delete mode 100644 amforth-6.5/common/words/tick.asm delete mode 100644 amforth-6.5/common/words/to-in.asm delete mode 100644 amforth-6.5/common/words/to-l.asm delete mode 100644 amforth-6.5/common/words/to-lower.asm delete mode 100644 amforth-6.5/common/words/to-number.asm delete mode 100644 amforth-6.5/common/words/to-upper.asm delete mode 100644 amforth-6.5/common/words/to.asm delete mode 100644 amforth-6.5/common/words/traverse-wordlist.asm delete mode 100644 amforth-6.5/common/words/tuck.asm delete mode 100644 amforth-6.5/common/words/type.asm delete mode 100644 amforth-6.5/common/words/u-dot-r.asm delete mode 100644 amforth-6.5/common/words/u-dot.asm delete mode 100644 amforth-6.5/common/words/u-greater.asm delete mode 100644 amforth-6.5/common/words/ud-dot-r.asm delete mode 100644 amforth-6.5/common/words/ud-dot.asm delete mode 100644 amforth-6.5/common/words/ud-slash-mod.asm delete mode 100644 amforth-6.5/common/words/ud-star.asm delete mode 100644 amforth-6.5/common/words/udefer-fetch.asm delete mode 100644 amforth-6.5/common/words/udefer-store.asm delete mode 100644 amforth-6.5/common/words/umax.asm delete mode 100644 amforth-6.5/common/words/umin.asm delete mode 100644 amforth-6.5/common/words/until.asm delete mode 100644 amforth-6.5/common/words/variable.asm delete mode 100644 amforth-6.5/common/words/ver.asm delete mode 100644 amforth-6.5/common/words/warm.asm delete mode 100644 amforth-6.5/common/words/while.asm delete mode 100644 amforth-6.5/common/words/within.asm delete mode 100644 amforth-6.5/common/words/word.asm delete mode 100644 amforth-6.5/common/words/words.asm (limited to 'amforth-6.5/common') diff --git a/amforth-6.5/common/lib/2rvalue.frt b/amforth-6.5/common/lib/2rvalue.frt deleted file mode 100644 index 2c46d01..0000000 --- a/amforth-6.5/common/lib/2rvalue.frt +++ /dev/null @@ -1,15 +0,0 @@ - -\ a value in RAM with 2 cells data storage -\ requires quotations and 2@/2! from double wordset - -#require quotations.frt -#require 2-fetch.frt -#require 2-store.frt - -: 2rvalue ( d -- ) - (value) - here , - [: @i 2@ ;] , - [: @i 2! ;] , - here 2! 2 cells allot -; diff --git a/amforth-6.5/common/lib/anew.frt b/amforth-6.5/common/lib/anew.frt deleted file mode 100644 index a7e9330..0000000 --- a/amforth-6.5/common/lib/anew.frt +++ /dev/null @@ -1,27 +0,0 @@ -\ POSSIBLY ( "name" -- ) -\ Execute _name_ if it exists; otherwise, do nothing. -\ Useful implementation factor of `ANEW`. - -\ ANEW ( "name" -- ) -\ Compiler directive used in the form: `ANEW _name_`. -\ If the word _name_ already exists, it and all -\ subsequent words are forgotten from the current -\ dictionary, and then a `MARKER` word _name_ is -\ created that does nothing. This is usually placed -\ at the start of a file. When the code is reloaded, -\ any prior version is automatically pruned from the -\ dictionary. -\ -\ Executing _name_ will also cause it to be forgotten, -\ since it is a `MARKER` word. -\ -\ Useful implementation factor of `EMPTY`. - -\ meta comment for amforth-shell. -\ #require marker.frt - -: possibly ( "name" -- ) - parse-name find-xt if execute then ; - -: anew ( "name" -- ) >in @ possibly >in ! marker ; - diff --git a/amforth-6.5/common/lib/base-execute.frt b/amforth-6.5/common/lib/base-execute.frt deleted file mode 100644 index 44eaff8..0000000 --- a/amforth-6.5/common/lib/base-execute.frt +++ /dev/null @@ -1,7 +0,0 @@ -\ execute xt with the content of BASE being u, and -\ restoring the original BASE afterwards. -: base-execute ( i*x xt u -- j*x ) \ gforth - base @ >r - base ! execute - r> base ! -; \ No newline at end of file diff --git a/amforth-6.5/common/lib/bounds.frt b/amforth-6.5/common/lib/bounds.frt deleted file mode 100644 index 85e0c20..0000000 --- a/amforth-6.5/common/lib/bounds.frt +++ /dev/null @@ -1,5 +0,0 @@ - -: bounds \ addr len -- addr+len addr - over + swap -; - diff --git a/amforth-6.5/common/lib/builds.frt b/amforth-6.5/common/lib/builds.frt deleted file mode 100644 index 377728d..0000000 --- a/amforth-6.5/common/lib/builds.frt +++ /dev/null @@ -1,4 +0,0 @@ - -\ pre ANS94 Forth. instead of create does> -\ -: id kette set-stack - -\ there is no easy way to show the content of -\ a stack - -\ now execute the stack. The TOS element is -\ called first - -kette \ emits the version string twice and a newline between them - diff --git a/amforth-6.5/common/lib/chain-stack.frt b/amforth-6.5/common/lib/chain-stack.frt deleted file mode 100644 index 0ea3959..0000000 --- a/amforth-6.5/common/lib/chain-stack.frt +++ /dev/null @@ -1,31 +0,0 @@ -\ chains: execute a list of XT when calling the -\ anchor. Elements can be pre- and ap-pended. -\ no particular stack effect enforcment - -\ chain.run ( chainid -- i*x ) -\ chain ( -- chainid ) \ allocate an unnamed chain -\ chain: ( "name" -- ) create a named chain - -\ implementation uses configuration stacks - -\ #require quotations.frt -\ #require builds.frt - -\ #require eallot.frt -: chain ( n -- ) ehere swap 1+ cells eallot ; \ n cells for n XT's -\ for the MSP use the following line instead of the two above -\ : chain ( n -- ) here swap 1+ cells allot ; \ n cells for n XT's - -: chain.run ( chainid -- i*x ) - [: ( i*x XT -- j*y 0 ) execute 0 ;] swap map-stack ( -- 0 ) drop -; - -\ create a named chain with an action -: chain: @i chain.run ; -\ for the MSP430 use the following line instead -\ : chain: @i chain.run ; - -\ get the chainid from its name -: chain>id ( "name" -- chainid ) - ' >body @i -; diff --git a/amforth-6.5/common/lib/chains-wordlist-test.frt b/amforth-6.5/common/lib/chains-wordlist-test.frt deleted file mode 100644 index 95a36a6..0000000 --- a/amforth-6.5/common/lib/chains-wordlist-test.frt +++ /dev/null @@ -1,22 +0,0 @@ -\ test the chains with wordlist backend - -\ first create a named chain, identified by kette -chain: kette - -\ now populate the chain with words, save the -\ existing definition word list on stack -get-current - -\ chain>id is a parsing word -chain>id kette set-current -: s1 ." one " ; -: s2 ." two " ; - -\ restore the previously used definition wordlist -set-current - -\ show the content of the chain -chain>id kette show-wordlist - -\ and finally execute the words in it. -kette \ prints "two one" diff --git a/amforth-6.5/common/lib/chains-wordlist.frt b/amforth-6.5/common/lib/chains-wordlist.frt deleted file mode 100644 index f79f117..0000000 --- a/amforth-6.5/common/lib/chains-wordlist.frt +++ /dev/null @@ -1,31 +0,0 @@ -\ chains: execute a list of XT when calling the -\ anchor. Elements can be pre- and ap-pended. -\ no particular stack effect enforcment - -\ chain.run ( chainid -- i*x ) -\ chain ( -- chainid ) \ create an unnamed chain -\ chain: ( "name" -- ) \ create a named chain - -\ implementation uses wordlists - -\ #require name2interpret.frt -\ #require quotations.frt -\ #require builds.frt - -\ create an unnamed chain -: chain wordlist ; \ trivial - -: chain.run ( chainid -- i*x ) - [: name>interpret execute true ;] - swap traverse-wordlist -; - -\ create a named chain with an action -: chain: @i chain.run ; -\ for MSP430 use instead -\ : chain: @i chain.run ; - -\ get the chainid from its name -: chain>id ( "name" -- chainid ) - ' >body @i -; diff --git a/amforth-6.5/common/lib/clip.frt b/amforth-6.5/common/lib/clip.frt deleted file mode 100644 index 95c4654..0000000 --- a/amforth-6.5/common/lib/clip.frt +++ /dev/null @@ -1,8 +0,0 @@ - -: clip ( n lo hi -- n) - rot min max -; - -\ usage: -\ input @ minval maxval clip ... -\ source: CLF, Brian Fox, 21.4.1997 \ No newline at end of file diff --git a/amforth-6.5/common/lib/crc8.frt b/amforth-6.5/common/lib/crc8.frt deleted file mode 100644 index f2d4e17..0000000 --- a/amforth-6.5/common/lib/crc8.frt +++ /dev/null @@ -1,94 +0,0 @@ -\ -*- Mode: Forth; Coding: utf-8 -*- - -\ Copyright (c) 2013 Energy Measurement & Control, NJ, USA. -\ Software license: AmForth compliant, see http://amforth.sourceforge.net/ -\ -\ (crc8) is a configurable 8-bit table-driven CRC generator/checker. For usage -\ see below (*). (crc8) was adapted from Linux/lib/crc8.c, See: -\ http://lxr.free-electrons.com/source/include/linux/crc8.h -\ -\ fabtab: is a factory function for arbitrary-length byte-wide Flash look-up -\ tables. Data is read from the pad. - -\ #error-on-output - -decimal - -\ IMPORTANT: -\ amforth-shell needs the following constants defined in appl_defs.frt -\ msb-first poly: (1)11010101 = 0xD5 -\ lsb-first poly: 10101011(1) = 0xAB -\ bit-order: true = msb-first, false = lsb-first -( -$d5 constant CRC8MSB -$ab constant CRC8LSB -true constant CRC8REV -) - -\ verify having 256 pad bytes to form the crc table -\ #expect-output-next ^-1 0 $ -s" /pad" environment? . 256 < . - -\ pad bytes → flash table factory function -: fabtab: create ( "table-name" table-byte-count -- ) - dup , \ table byte count - 1+ 2/ 0 do pad i 2* + @ , loop \ table words - does> ( table-byte-index -- table-byte ) - 2dup @i U< if - over 2/ + 1+ @i \ ( table-byte-index table-word ) - swap 1 and \ ( table-word high-byte? ) - if >< then 255 and \ AVR is little endian - else - -9 throw \ index out of range - then -; - -marker ->crc8 - -\ populate pad with crc table for CRC8MSB poly in reverse bit order -: crc8_msb_pad ( -- ) - 0 pad c! \ "table[0] = 0" - 1 $80 begin \ ( 2ˣ "t" ) x: 0→7 - dup $80 and if CRC8MSB else 0 then - swap 2* xor \ update "t" - swap dup 0 do \ ( "t" 2ˣ ) - over pad i + c@ xor \ ( "t" 2ˣ "table[j] ^ t" ) - over pad + i + c! \ "table[i+j] = ..." - loop - 2* dup 256 < \ ( "t" 2ˣ⁺¹ flag ) - while swap \ ( 2ˣ⁺¹ "t" ) - repeat - 2drop -; - -\ populate pad with crc table for CRC8LSB poly in regular bit order -: crc8_lsb_pad ( -- ) - 0 pad c! \ "table[0] = 0" - 128 $01 begin \ ( 2ˣ "t") x: 7→0 - dup 1 and if CRC8LSB else 0 then - swap 2/ xor \ update "t" - swap 256 0 do \ ( "t" 2ˣ ) - over pad i + c@ xor \ ( "t" 2ˣ "table[j] ^ t" ) - over pad + i + c! \ "table[i+j] = ..." - dup 2* +loop - 2/ dup \ ( "t" 2ˣ⁻¹ flag ) - while swap \ ( 2ˣ⁻¹ "t" ) - repeat - 2drop -; - -\ CRC8REV [if] crc8_msb_pad [else] crc8_lsb_pad [then] -: crc8_pad CRC8REV if crc8_msb_pad else crc8_lsb_pad then ; crc8_pad - -->crc8 \ pad data is preserved - -256 fabtab: crc8tb@ \ 256B pad → flash lookup table - -\ (*) Using (crc8): -\ The initial crc-byte should be 255 -\ To the outgoing message append the byte-complement of crc-byte' -\ The final crc-byte' of a valid incoming message+crc is: 255 crc8tb@ - -: (crc8) ( crc-byte data-byte -- crc-byte' ) - xor crc8tb@ -; diff --git a/amforth-6.5/common/lib/debug.frt b/amforth-6.5/common/lib/debug.frt deleted file mode 100644 index 3fc07ce..0000000 --- a/amforth-6.5/common/lib/debug.frt +++ /dev/null @@ -1,11 +0,0 @@ -\ Gerry dlf 31.8.2012 "Single Step Debugging.." -\ modified: prints a debug prompt. Exits the -\ debug mode when entering an empty line - -\ more usage examples can be found at the cookbook -\ http://amforth.sf.net/recipes - -82 buffer: debugbuf -: (?) cr ." debug> " debugbuf dup 80 accept ; -: ?? begin (?) dup while (evaluate) repeat 2drop ; -\ maybe add a special debug wordlist diff --git a/amforth-6.5/common/lib/defer-seal.frt b/amforth-6.5/common/lib/defer-seal.frt deleted file mode 100644 index 9c50a84..0000000 --- a/amforth-6.5/common/lib/defer-seal.frt +++ /dev/null @@ -1,11 +0,0 @@ - -\ ' turnkey defer:seal - -: defer:seal ( XT -- ) - dup defer@ ( -- XT' XT ) - swap ( -- XT XT') - dup ['] quit @i ( get DO_COLON) swap !i - 1+ dup rot swap !i - 1+ ['] exit swap !i -; - diff --git a/amforth-6.5/common/lib/dot-base.frt b/amforth-6.5/common/lib/dot-base.frt deleted file mode 100644 index f3d293c..0000000 --- a/amforth-6.5/common/lib/dot-base.frt +++ /dev/null @@ -1,5 +0,0 @@ - -\ print current BASE in decimal, keep BASE intact -: .base ( -- ) - base @ dup decimal . base ! -; diff --git a/amforth-6.5/common/lib/dot-recs.frt b/amforth-6.5/common/lib/dot-recs.frt deleted file mode 100644 index a14dce0..0000000 --- a/amforth-6.5/common/lib/dot-recs.frt +++ /dev/null @@ -1,10 +0,0 @@ - -\ print the names of the current recognizer stack - -#require to-name.frt - -: .recs - get-recognizers 0 ?do - >name icount $ff and itype space - loop -; diff --git a/amforth-6.5/common/lib/dot-ver.frt b/amforth-6.5/common/lib/dot-ver.frt deleted file mode 100644 index 9ca17ca..0000000 --- a/amforth-6.5/common/lib/dot-ver.frt +++ /dev/null @@ -1,6 +0,0 @@ - -: .ver - s" version" environment? if - s>d <# # [char] . hold #s #> type - then -; diff --git a/amforth-6.5/common/lib/exception.frt b/amforth-6.5/common/lib/exception.frt deleted file mode 100644 index d9f7a87..0000000 --- a/amforth-6.5/common/lib/exception.frt +++ /dev/null @@ -1,15 +0,0 @@ - - -\ allocate an exception number -\ is less than -4096, keeps track in EEPROM - --4096 Evalue exception -: exception ( -- n ) exception dup 1- to exception ; - -\ usage -\ the code sequence -\ exception constant !!foo -\ ... if !!foo throw then ... -\ prints -\ ?? -4096 -\ and returns to the command prompt if not catched \ No newline at end of file diff --git a/amforth-6.5/common/lib/execute-parsing.frt b/amforth-6.5/common/lib/execute-parsing.frt deleted file mode 100644 index a5dc9bc..0000000 --- a/amforth-6.5/common/lib/execute-parsing.frt +++ /dev/null @@ -1,25 +0,0 @@ - -\ execute-parsing -\ ( addr len XT -- ) -\ execute XT with addr/len as SOURCE -\ - -variable xp-addr -variable xp-len - -: xp-source xp-addr @ xp-len @ ; - -: execute-parsing ( addr len XT -- ) - xp-addr @ xp-len @ 2>r \ make it nestable - >r \ save XT temporarily - xp-len ! xp-addr ! \ prepare new source - r> \ get back the XT - ['] source defer@ >in @ 2>r \ save and switch source - ['] xp-source is SOURCE - 0 >IN ! - catch \ DO IT - 2r> >in ! is source \ restore old source - 2r> xp-len ! xp-addr ! \ restore nested information - throw \ re-throw exception, if any -; - diff --git a/amforth-6.5/common/lib/find-name.frt b/amforth-6.5/common/lib/find-name.frt deleted file mode 100644 index df40185..0000000 --- a/amforth-6.5/common/lib/find-name.frt +++ /dev/null @@ -1,10 +0,0 @@ - -\ #require search-name.frt - -: (find-name) ( addr len wid -- addr len 0 | nt -1 ) - >r 2dup r> search-name dup if nip nip then ; - -: find-name ( addr len -- nt|0 ) - ['] (find-name) cfg-order map-stack - dup 0= if nip nip then -; diff --git a/amforth-6.5/common/lib/flags.frt b/amforth-6.5/common/lib/flags.frt deleted file mode 100644 index 43fb38b..0000000 --- a/amforth-6.5/common/lib/flags.frt +++ /dev/null @@ -1,54 +0,0 @@ -\ 2008-01-01 EW w4_flags.fs - -\ die bits einer Variablen als "flags" benutzen - -\ flag@ ( var bitnum -- f ) und flag! ( flag var bitnum -- ) - -\ variable mainFlags -\ mainFlags 0 flag: Fdebug -\ Fdebug fset ( set bit 0 in Variable mainFlags ) -\ Fdebug fclr ( clear bit ) -\ Fdebug fset? ( true if bit is set ) -\ Fdebug fclr? ( true if bit is NOT set ) - -\ compile time: store address and bitmask into pfa -\ run time: fetch bitmask and address to stack -: flag: create ( addr bit -- ) - 1 swap lshift , , -does> ( -- bitmask addr ) - dup @i swap 1+ @i -; - -\ bitvalue, convert number of bit [0..7] to mask -: bv ( bitnumber -- bitmask ) - 1 swap lshift -; - -: fset ( bitmask addr -- ) - dup @ ( mask addr value ) - rot ( addr value mask ) - or ( addr new-value ) - swap ! -; - -: fclr ( bitmask addr -- ) - dup @ ( mask addr value ) - rot ( addr value mask ) - invert and ( addr new-value ) - swap ! -; - - -: fset? ( bitmask addr -- t/f ) - @ and 0<> -; - -: fclr? ( bitmask addr -- t/f ) - @ and 0= -; - -: ftgl ( bitmask addr -- ) - over over ( mask addr mask addr ) - fset? - if fclr else fset then -; diff --git a/amforth-6.5/common/lib/for-next.frt b/amforth-6.5/common/lib/for-next.frt deleted file mode 100644 index 8a29ebf..0000000 --- a/amforth-6.5/common/lib/for-next.frt +++ /dev/null @@ -1,18 +0,0 @@ -\ for/next is from colorforth -\ note that 0 and -1 are executable words, not numbers! -\ -: for postpone 0 - postpone swap - postpone do -; immediate - -: next - postpone -1 - postpone +loop -; immediate - -\ test case -\ : test 10 for i . next ; -\ prints -\ 10 9 8 7 6 5 4 3 2 1 0 -\ \ No newline at end of file diff --git a/amforth-6.5/common/lib/forth2012/blocks/blocks.frt b/amforth-6.5/common/lib/forth2012/blocks/blocks.frt deleted file mode 100644 index c11be70..0000000 --- a/amforth-6.5/common/lib/forth2012/blocks/blocks.frt +++ /dev/null @@ -1,68 +0,0 @@ -\ -\ simple block wordset -\ single buffer management. -\ non-standard block size (to save RAM). -\ only basic routines. No hardware access -\ - -#require defer.frt -#require buffer.frt - -\ high level blocksize, ANS94 says 1024 bytes, SD Cards have 512 -#512 constant blocksize -variable scr - -\ API for low level drivers. They get the -\ buffer address in RAM and the block number. -Rdefer load-buffer ( buf-addr u -- ) -Rdefer save-buffer ( buf-addr u -- ) - -\ single buffer blocks. -variable blk1 -variable blk1-dirty -blocksize buffer: blk1-buffer - -\ for turnkey -: block:init - -1 blk1 ! - 0 blk1-dirty ! -; - -: update -1 blk1-dirty ! ; -: updated? ( u -- f ) - blk1 @ = if - blk1-dirty @ - else - 0 - then -; - -\ reloads the block only if the blocknumber differs -: block ( u -- a-addr ) - dup blk1 @ = if drop else - blk1 @ updated? if - blk1-buffer blk1 @ save-buffer - then - blk1-buffer swap dup blk1 ! load-buffer - 0 blk1-dirty ! - then - blk1-buffer -; - -\ a buffer is an un-initialized block. -: buffer ( u -- a-addr ) block ; - -: save-buffers - blk1 @ updated? if - blk1-buffer blk1 @ save-buffer - then - 0 blk1-dirty ! -; - -: empty-buffers - -1 blk1 ! - 0 blk1-dirty ! -; - -: flush save-buffers empty-buffers ; - diff --git a/amforth-6.5/common/lib/forth2012/blocks/list-dump.frt b/amforth-6.5/common/lib/forth2012/blocks/list-dump.frt deleted file mode 100644 index 28a0df7..0000000 --- a/amforth-6.5/common/lib/forth2012/blocks/list-dump.frt +++ /dev/null @@ -1,10 +0,0 @@ - -\ a trivial list in hexdump format -#require dump.frt - -: list - dup scr ! - buffer blocksize dump - scr @ updated? 0= if ." not " then ." modified" cr -; - diff --git a/amforth-6.5/common/lib/forth2012/blocks/list.frt b/amforth-6.5/common/lib/forth2012/blocks/list.frt deleted file mode 100644 index 2520aeb..0000000 --- a/amforth-6.5/common/lib/forth2012/blocks/list.frt +++ /dev/null @@ -1,24 +0,0 @@ - -\ a list in text format. not suitable -\ for binary data! - -\ #16 constant #lines -\ #64 constant #cols - - #8 constant #lines -#64 constant #cols - -: list ( blk -- ) \ list selected screen - dup scr ! - dup cr ." Listing of screen (" . - dup updated? if ." not " then ." modified)" cr - buffer - #lines 0 - do - cr i 0 <# [char] : hold # # #> type space - dup i #cols * + - #cols type - [char] | emit - loop - cr - ; diff --git a/amforth-6.5/common/lib/forth2012/blocks/load.frt b/amforth-6.5/common/lib/forth2012/blocks/load.frt deleted file mode 100644 index 55cd14b..0000000 --- a/amforth-6.5/common/lib/forth2012/blocks/load.frt +++ /dev/null @@ -1,20 +0,0 @@ -\ load a block and evaluate its content -\ -: source-block1 - blk1-buffer blocksize -; - -: load ( i*x n -- j*y ) - ['] source defer@ >r >in @ >r - 0 >in ! - buffer drop - ['] source-block1 is source - ['] interpret catch - r> >in ! r> is source - throw -; - - -: thru ( i*x n1 n2 -- j*y ) - 1+ swap ?do i load loop -; diff --git a/amforth-6.5/common/lib/forth2012/core-ext/case-test.frt b/amforth-6.5/common/lib/forth2012/core-ext/case-test.frt deleted file mode 100644 index ad9b1f1..0000000 --- a/amforth-6.5/common/lib/forth2012/core-ext/case-test.frt +++ /dev/null @@ -1,7 +0,0 @@ - : foo ( selector -- ) - case - 3 of ." three" endof - 5 9 range of ." between" endof - 1 of ." one" endof - endcase - ; diff --git a/amforth-6.5/common/lib/forth2012/core-ext/case.frt b/amforth-6.5/common/lib/forth2012/core-ext/case.frt deleted file mode 100644 index 02e73f1..0000000 --- a/amforth-6.5/common/lib/forth2012/core-ext/case.frt +++ /dev/null @@ -1,35 +0,0 @@ -\ From: eaker@ukulele.crd.ge.com (Chuck Eaker) -\ Subject: Re: Wanted .. CASE,OF,ENDOF,ENDCASE -\ Message-ID: <1992Nov25.164255.23225@crd.ge.com> -\ Date: 25 Nov 92 16:42:55 GMT - -: case 0 ; immediate -: of ( #of -- orig #of+1 / x -- ) - 1+ ( count OFs ) - >r ( move off the stack in case the control-flow ) - ( stack is the data stack. ) - postpone over postpone = ( copy and test case value ) - postpone if ( add orig to control flow stack ) - postpone drop ( discards case value if = ) - r> ; ( we can bring count back now ) - immediate - -: endof ( orig1 #of -- orig2 #of ) - >r ( move off the stack in case the control-flow ) - ( stack is the data stack. ) - postpone else - r> ; ( we can bring count back now ) - immediate - -: endcase ( orig 1..orign #of -- ) - postpone drop ( discard case value ) - 0 ?do - postpone then - loop ; - immediate - - - \ from Message-ID: -: range ( selector low high -- selector x ) - 2>r dup dup 2r> within - 0= if invert then ; diff --git a/amforth-6.5/common/lib/forth2012/core-ext/compile-comma.frt b/amforth-6.5/common/lib/forth2012/core-ext/compile-comma.frt deleted file mode 100644 index 3845e6c..0000000 --- a/amforth-6.5/common/lib/forth2012/core-ext/compile-comma.frt +++ /dev/null @@ -1,3 +0,0 @@ -\ append the XT to the dictionary -( xt -- ) -: compile, , ; diff --git a/amforth-6.5/common/lib/forth2012/core-ext/defers.frt b/amforth-6.5/common/lib/forth2012/core-ext/defers.frt deleted file mode 100644 index 25b9505..0000000 --- a/amforth-6.5/common/lib/forth2012/core-ext/defers.frt +++ /dev/null @@ -1,23 +0,0 @@ - -\ various defer definitions -\ platform specific examples are available ! - -\ place the XT in RAM, suitable for frequent changes -\ but needs to be initialized at startup - -: Rdefer ( "name" -- ) - (defer) - here , - ['] Rdefer@ , - ['] Rdefer! , - 2 allot -; - -\ use the user area to hold the XT. Similiar to -\ Rdefer but task lokal in multitasking applications -: Udefer ( u "name" -- ) - (defer) - , \ - ['] Udefer@ , - ['] Udefer! , -; diff --git a/amforth-6.5/common/lib/forth2012/core-ext/exceptions.frt b/amforth-6.5/common/lib/forth2012/core-ext/exceptions.frt deleted file mode 100644 index ec175a0..0000000 --- a/amforth-6.5/common/lib/forth2012/core-ext/exceptions.frt +++ /dev/null @@ -1,15 +0,0 @@ -\ ****************************************** -\ some exceptions -\ ****************************************** - -: ?throw ( f exc -- ) - swap if throw then drop -; - -: ?comp ( -- ) - state @ 0= -&14 ?throw -; - -: ?pairs ( n1 n2 -- ) - - -&22 ?throw -; diff --git a/amforth-6.5/common/lib/forth2012/core-ext/roll.frt b/amforth-6.5/common/lib/forth2012/core-ext/roll.frt deleted file mode 100644 index 385c14a..0000000 --- a/amforth-6.5/common/lib/forth2012/core-ext/roll.frt +++ /dev/null @@ -1,7 +0,0 @@ - -: roll ( x0 x1 .. xn n -- x1 .. xn x0 ) \ core-ext - dup 0> 0= if - drop - else - swap >r 1- recurse r> swap - then ; diff --git a/amforth-6.5/common/lib/forth2012/core/2over.frt b/amforth-6.5/common/lib/forth2012/core/2over.frt deleted file mode 100644 index cf614ca..0000000 --- a/amforth-6.5/common/lib/forth2012/core/2over.frt +++ /dev/null @@ -1,8 +0,0 @@ -\ 2over ( w1 w2 w3 w4 -- w1 w2 w3 w4 w1 w2 ) core two_over -: 2over - >r >r - over over - r> - rot rot - r> - rot rot ; diff --git a/amforth-6.5/common/lib/forth2012/core/2swap.frt b/amforth-6.5/common/lib/forth2012/core/2swap.frt deleted file mode 100644 index 773228e..0000000 --- a/amforth-6.5/common/lib/forth2012/core/2swap.frt +++ /dev/null @@ -1,3 +0,0 @@ -\ 2swap ( w1 w2 w3 w4 -- w3 w4 w1 w2 ) core two_swap -: 2swap - rot >r rot r> ; diff --git a/amforth-6.5/common/lib/forth2012/core/action-of.frt b/amforth-6.5/common/lib/forth2012/core/action-of.frt deleted file mode 100644 index 894b399..0000000 --- a/amforth-6.5/common/lib/forth2012/core/action-of.frt +++ /dev/null @@ -1,14 +0,0 @@ -\ ******************************************* -\ action-of depends on defer@ -\ ******************************************* - -\ #requires postpone.frt - -: action-of - state @ - if - postpone ['] postpone defer@ - else - ' defer@ - then -; immediate diff --git a/amforth-6.5/common/lib/forth2012/core/blank.frt b/amforth-6.5/common/lib/forth2012/core/blank.frt deleted file mode 100644 index a99ae5f..0000000 --- a/amforth-6.5/common/lib/forth2012/core/blank.frt +++ /dev/null @@ -1,4 +0,0 @@ -\ fill with blanks -: blank ( addr n -- ) - bl fill -; diff --git a/amforth-6.5/common/lib/forth2012/core/buffer.frt b/amforth-6.5/common/lib/forth2012/core/buffer.frt deleted file mode 100644 index 10db671..0000000 --- a/amforth-6.5/common/lib/forth2012/core/buffer.frt +++ /dev/null @@ -1,6 +0,0 @@ -\ allocate a buffer and give it a name in the dictionary -\ see http://www.forth200x.org/buffer.html - -: buffer: ( n "name" ) - \ variable already allocates 1 cell - variable 1 cells - allot ; diff --git a/amforth-6.5/common/lib/forth2012/core/char-plus.frt b/amforth-6.5/common/lib/forth2012/core/char-plus.frt deleted file mode 100644 index c71230e..0000000 --- a/amforth-6.5/common/lib/forth2012/core/char-plus.frt +++ /dev/null @@ -1,3 +0,0 @@ -\ a character has 1 bytes -: char+ 1+ ; - diff --git a/amforth-6.5/common/lib/forth2012/core/chars.frt b/amforth-6.5/common/lib/forth2012/core/chars.frt deleted file mode 100644 index 254b3dc..0000000 --- a/amforth-6.5/common/lib/forth2012/core/chars.frt +++ /dev/null @@ -1,3 +0,0 @@ -\ a character has 1 byte, multiply by 1 is easy -: chars ; immediate \ does nothing at all - diff --git a/amforth-6.5/common/lib/forth2012/core/count.frt b/amforth-6.5/common/lib/forth2012/core/count.frt deleted file mode 100644 index 339da65..0000000 --- a/amforth-6.5/common/lib/forth2012/core/count.frt +++ /dev/null @@ -1,3 +0,0 @@ - -\ ( addr -- addr+1 len ) -: count dup 1+ swap c@ ; diff --git a/amforth-6.5/common/lib/forth2012/core/dot-paren.frt b/amforth-6.5/common/lib/forth2012/core/dot-paren.frt deleted file mode 100644 index 6266725..0000000 --- a/amforth-6.5/common/lib/forth2012/core/dot-paren.frt +++ /dev/null @@ -1,5 +0,0 @@ - -: .( \ (s -- ) - [char] ) parse type -; immediate - diff --git a/amforth-6.5/common/lib/forth2012/core/erase.frt b/amforth-6.5/common/lib/forth2012/core/erase.frt deleted file mode 100644 index eb23f3b..0000000 --- a/amforth-6.5/common/lib/forth2012/core/erase.frt +++ /dev/null @@ -1,6 +0,0 @@ -\ fill a memory area with zeros - -: erase ( addr n -- ) - 0 fill -; - diff --git a/amforth-6.5/common/lib/forth2012/core/find.frt b/amforth-6.5/common/lib/forth2012/core/find.frt deleted file mode 100644 index a289cc8..0000000 --- a/amforth-6.5/common/lib/forth2012/core/find.frt +++ /dev/null @@ -1,21 +0,0 @@ -\ #require count.frt - -: find ( addr -- addr 0 | xt -1 | xt 1 ) - dup count find-xt dup - if rot drop then -; - -\ \ find-xt is using the order stack -\ \ with map-stack as iterator. -\ : (find-xt) ( addr len wid -- addr len 0 | xt +/-1 -1 ) -\ >r 2dup r> search-wordlist -\ dup if -\ >r nip nip r> -1 -\ then -\ ; -\ -\ : find-xt -\ ['] (find-xt) 'ORDER map-stack -\ 0= if 2drop 0 then -\ ; - diff --git a/amforth-6.5/common/lib/forth2012/core/is.frt b/amforth-6.5/common/lib/forth2012/core/is.frt deleted file mode 100644 index 9ac18ea..0000000 --- a/amforth-6.5/common/lib/forth2012/core/is.frt +++ /dev/null @@ -1,12 +0,0 @@ - -\ ******************************************* -\ IS depends on defer! -\ ******************************************* - -: is - state @ if - postpone ['] postpone defer! - else - ' defer! - then -; immediate diff --git a/amforth-6.5/common/lib/forth2012/core/move.frt b/amforth-6.5/common/lib/forth2012/core/move.frt deleted file mode 100644 index 795a8ef..0000000 --- a/amforth-6.5/common/lib/forth2012/core/move.frt +++ /dev/null @@ -1,5 +0,0 @@ -\ respect overlapping memory regions a choose -\ the proper cmove -: move - >r 2dup u< if r> cmove> else r> cmove then -; diff --git a/amforth-6.5/common/lib/forth2012/core/source-id.frt b/amforth-6.5/common/lib/forth2012/core/source-id.frt deleted file mode 100644 index aeea963..0000000 --- a/amforth-6.5/common/lib/forth2012/core/source-id.frt +++ /dev/null @@ -1,5 +0,0 @@ - -\ source-id is currently not used -: source-id ( -- f ) - 0 \ always user input device -; diff --git a/amforth-6.5/common/lib/forth2012/core/star-slash.frt b/amforth-6.5/common/lib/forth2012/core/star-slash.frt deleted file mode 100644 index 4a47ed9..0000000 --- a/amforth-6.5/common/lib/forth2012/core/star-slash.frt +++ /dev/null @@ -1,4 +0,0 @@ - -\ #require star-slash-mod.frt - -: */ */mod nip ; diff --git a/amforth-6.5/common/lib/forth2012/core/values.frt b/amforth-6.5/common/lib/forth2012/core/values.frt deleted file mode 100644 index 08bf0a1..0000000 --- a/amforth-6.5/common/lib/forth2012/core/values.frt +++ /dev/null @@ -1,16 +0,0 @@ - -: Uvalue ( n offs -- ) - (value) - dup , - ['] Udefer@ , - ['] Udefer! , - up@ + ! -; - -: Rvalue ( n -- ) - (value) - here , - ['] Rdefer@ , - ['] Rdefer! , - here ! 2 allot -; diff --git a/amforth-6.5/common/lib/forth2012/double.frt b/amforth-6.5/common/lib/forth2012/double.frt deleted file mode 100644 index 5cd2e14..0000000 --- a/amforth-6.5/common/lib/forth2012/double.frt +++ /dev/null @@ -1,9 +0,0 @@ -\ 'double.frt' generated automatically, do not edit -#include 2constant.frt -#include 2-fetch.frt -#include 2nip.frt -#include 2rot.frt -#include 2tuck.frt -#include 2-store.frt -#include 2variable.frt -#include m-star-slash.frt diff --git a/amforth-6.5/common/lib/forth2012/double/2-fetch.frt b/amforth-6.5/common/lib/forth2012/double/2-fetch.frt deleted file mode 100644 index 9b3a76a..0000000 --- a/amforth-6.5/common/lib/forth2012/double/2-fetch.frt +++ /dev/null @@ -1,7 +0,0 @@ -\ 2@ ( addr -- n1 n2 ) -: 2@ - dup ( -- addr addr ) - cell+ ( -- addr addr+2 ) - @ ( -- addr n2 ) - swap ( -- n2 addr ) - @ ; ( -- n2 n1 ) diff --git a/amforth-6.5/common/lib/forth2012/double/2-store.frt b/amforth-6.5/common/lib/forth2012/double/2-store.frt deleted file mode 100644 index 93d2402..0000000 --- a/amforth-6.5/common/lib/forth2012/double/2-store.frt +++ /dev/null @@ -1,7 +0,0 @@ -\ 2! ( n1 n2 addr -- ) -: 2! - swap ( -- n1 addr n2 ) - over ( -- n1 addr n2 addr ) - ! ( -- n1 addr ) - cell+ ( -- n1 addr+2 ) - ! ; diff --git a/amforth-6.5/common/lib/forth2012/double/2constant.frt b/amforth-6.5/common/lib/forth2012/double/2constant.frt deleted file mode 100644 index 4f012d3..0000000 --- a/amforth-6.5/common/lib/forth2012/double/2constant.frt +++ /dev/null @@ -1,6 +0,0 @@ - -: 2constant - create , , - does> - dup 1+ @i swap @i -; diff --git a/amforth-6.5/common/lib/forth2012/double/2nip.frt b/amforth-6.5/common/lib/forth2012/double/2nip.frt deleted file mode 100644 index 04c5599..0000000 --- a/amforth-6.5/common/lib/forth2012/double/2nip.frt +++ /dev/null @@ -1,4 +0,0 @@ -\ 2nip ( w1 w2 w3 w4 -- w3 w4 ) gforth two_nip -: 2nip - 2swap 2drop ; - diff --git a/amforth-6.5/common/lib/forth2012/double/2rot.frt b/amforth-6.5/common/lib/forth2012/double/2rot.frt deleted file mode 100644 index 4befd64..0000000 --- a/amforth-6.5/common/lib/forth2012/double/2rot.frt +++ /dev/null @@ -1,3 +0,0 @@ -\ 2rot ( w1 w2 w3 w4 w5 w6 -- w3 w4 w5 w6 w1 w2 ) double-ext two_rote -: 2rot - >r >r 2swap r> r> 2swap ; diff --git a/amforth-6.5/common/lib/forth2012/double/2tuck.frt b/amforth-6.5/common/lib/forth2012/double/2tuck.frt deleted file mode 100644 index 9ad9781..0000000 --- a/amforth-6.5/common/lib/forth2012/double/2tuck.frt +++ /dev/null @@ -1,3 +0,0 @@ -\ 2tuck ( w1 w2 w3 w4 -- w3 w4 w1 w2 w3 w4 ) gforth two_tuck -: 2tuck - 2swap 2over ; diff --git a/amforth-6.5/common/lib/forth2012/double/2variable.frt b/amforth-6.5/common/lib/forth2012/double/2variable.frt deleted file mode 100644 index f6b63fb..0000000 --- a/amforth-6.5/common/lib/forth2012/double/2variable.frt +++ /dev/null @@ -1,4 +0,0 @@ - -: 2variable - here 2 cells allot constant -; diff --git a/amforth-6.5/common/lib/forth2012/double/d-equal.frt b/amforth-6.5/common/lib/forth2012/double/d-equal.frt deleted file mode 100644 index db5a9c6..0000000 --- a/amforth-6.5/common/lib/forth2012/double/d-equal.frt +++ /dev/null @@ -1,2 +0,0 @@ - ( d1 d2 -- f ) -: d= d- or 0= ; diff --git a/amforth-6.5/common/lib/forth2012/double/d-greater-zero.frt b/amforth-6.5/common/lib/forth2012/double/d-greater-zero.frt deleted file mode 100644 index 3628320..0000000 --- a/amforth-6.5/common/lib/forth2012/double/d-greater-zero.frt +++ /dev/null @@ -1,8 +0,0 @@ - -\ #require d-less-zero.frt - -: d0> ( d -- f) - 2dup or >r \ not equal zero - d0< 0= r> and \ and not less zero - 0= 0= \ normalize to 0/-1 flag -; diff --git a/amforth-6.5/common/lib/forth2012/double/d-greater.frt b/amforth-6.5/common/lib/forth2012/double/d-greater.frt deleted file mode 100644 index 133cdcd..0000000 --- a/amforth-6.5/common/lib/forth2012/double/d-greater.frt +++ /dev/null @@ -1,3 +0,0 @@ - -( d1 d2 -- f ) -: d> d- d0> ; diff --git a/amforth-6.5/common/lib/forth2012/double/d-less-zero.frt b/amforth-6.5/common/lib/forth2012/double/d-less-zero.frt deleted file mode 100644 index 973b9da..0000000 --- a/amforth-6.5/common/lib/forth2012/double/d-less-zero.frt +++ /dev/null @@ -1,2 +0,0 @@ - -: d0< nip 0< ; diff --git a/amforth-6.5/common/lib/forth2012/double/d-less.frt b/amforth-6.5/common/lib/forth2012/double/d-less.frt deleted file mode 100644 index b85cbb8..0000000 --- a/amforth-6.5/common/lib/forth2012/double/d-less.frt +++ /dev/null @@ -1,5 +0,0 @@ - -\ #require d-less-zero.frt - -( d1 d2 -- f ) -: d< d- d0< ; diff --git a/amforth-6.5/common/lib/forth2012/double/d-max.frt b/amforth-6.5/common/lib/forth2012/double/d-max.frt deleted file mode 100644 index fcf979a..0000000 --- a/amforth-6.5/common/lib/forth2012/double/d-max.frt +++ /dev/null @@ -1,3 +0,0 @@ - -: dmax ( d1 d2 -- d ) \ double d-max - 2over 2over d< if 2swap then 2drop ; diff --git a/amforth-6.5/common/lib/forth2012/double/d-min.frt b/amforth-6.5/common/lib/forth2012/double/d-min.frt deleted file mode 100644 index beca796..0000000 --- a/amforth-6.5/common/lib/forth2012/double/d-min.frt +++ /dev/null @@ -1,2 +0,0 @@ -: dmin ( d1 d2 -- d ) \ double d-min - 2over 2over d> if 2swap then 2drop ; diff --git a/amforth-6.5/common/lib/forth2012/double/d-plusstore.frt b/amforth-6.5/common/lib/forth2012/double/d-plusstore.frt deleted file mode 100644 index c7405b5..0000000 --- a/amforth-6.5/common/lib/forth2012/double/d-plusstore.frt +++ /dev/null @@ -1,4 +0,0 @@ - -: d+! ( d addr -- ) \ same as +! but for double cell numbers - dup >r 2@ d+ r> 2! -; diff --git a/amforth-6.5/common/lib/forth2012/double/d-zero-equal.frt b/amforth-6.5/common/lib/forth2012/double/d-zero-equal.frt deleted file mode 100644 index a853671..0000000 --- a/amforth-6.5/common/lib/forth2012/double/d-zero-equal.frt +++ /dev/null @@ -1,3 +0,0 @@ - -( d -- f ) -: d0= or 0= ; diff --git a/amforth-6.5/common/lib/forth2012/double/m-plus.frt b/amforth-6.5/common/lib/forth2012/double/m-plus.frt deleted file mode 100644 index f716566..0000000 --- a/amforth-6.5/common/lib/forth2012/double/m-plus.frt +++ /dev/null @@ -1,2 +0,0 @@ - -: m+ s>d d+ ; diff --git a/amforth-6.5/common/lib/forth2012/double/m-star-slash.frt b/amforth-6.5/common/lib/forth2012/double/m-star-slash.frt deleted file mode 100644 index 94959d4..0000000 --- a/amforth-6.5/common/lib/forth2012/double/m-star-slash.frt +++ /dev/null @@ -1,7 +0,0 @@ - -: m*/ ( d1 n2 u3 -- dquot ) \ double m-star-slash - >r s>d >r abs rot rot - s>d r> xor r> swap >r >r dabs rot tuck um* 2swap um* - swap >r 0 d+ r> rot rot r@ um/mod rot rot r> um/mod - nip swap r> if dnegate then -; diff --git a/amforth-6.5/common/lib/forth2012/facility.frt b/amforth-6.5/common/lib/forth2012/facility.frt deleted file mode 100644 index 1be4601..0000000 --- a/amforth-6.5/common/lib/forth2012/facility.frt +++ /dev/null @@ -1,3 +0,0 @@ -\ 'facility.frt' generated automatically, do not edit -#include ms.frt -#include time-and-date.frt diff --git a/amforth-6.5/common/lib/forth2012/facility/ms.frt b/amforth-6.5/common/lib/forth2012/facility/ms.frt deleted file mode 100644 index 7dfcd5d..0000000 --- a/amforth-6.5/common/lib/forth2012/facility/ms.frt +++ /dev/null @@ -1,3 +0,0 @@ - -\ a trivial multitasking friendly ms -: ms 0 ?do pause 1ms loop ; diff --git a/amforth-6.5/common/lib/forth2012/facility/structures-array.frt b/amforth-6.5/common/lib/forth2012/facility/structures-array.frt deleted file mode 100644 index 14e62df..0000000 --- a/amforth-6.5/common/lib/forth2012/facility/structures-array.frt +++ /dev/null @@ -1,24 +0,0 @@ - -begin-structure hash - field: hash.key - field: hash.value -end-structure - -\ inspired by CELLS -: hash-cells hash * ; - -\ define a hash-array -: hash: - hash-cells buffer: - does> - swap hash-cells + -; - -\ define an array of some elements hash'es -4 hash: my-hash -cr 0 my-hash . -cr 1 my-hash . - -\ store a key/value pair -42 3 my-hash hash.key ! -4711 3 my-hash hash.value ! diff --git a/amforth-6.5/common/lib/forth2012/facility/structures-test.frt b/amforth-6.5/common/lib/forth2012/facility/structures-test.frt deleted file mode 100644 index c4e810c..0000000 --- a/amforth-6.5/common/lib/forth2012/facility/structures-test.frt +++ /dev/null @@ -1,16 +0,0 @@ -\ simple test example for forth200x structures -\ define a new data structure named list. - -begin-structure list - field: l.p \ previous - field: l.n \ next - field: l.d \ data -end-structure - -\ create an instance of the datastructure list -\ named listroot - -list buffer: listroot - -\ access an element from the instance -$55aa listroot l.d ! diff --git a/amforth-6.5/common/lib/forth2012/facility/structures.frt b/amforth-6.5/common/lib/forth2012/facility/structures.frt deleted file mode 100644 index 65f8e5e..0000000 --- a/amforth-6.5/common/lib/forth2012/facility/structures.frt +++ /dev/null @@ -1,24 +0,0 @@ -\ structures according to http://www.forth200x.org/structures.html -\ and http://www.forth200x.org/structures2.html -\ the reference implementation does not work since amforth uses -\ not the unified memory model for dictionary and data - -: +field: ( n1 "name" -- n2 ) - create over , + - does> @i + -; - -: begin-structure - create dp 0 -1 , \ -1 saves a flash erase when end-structure is executed - does> - @i -; - -: end-structure - swap !i -; - -: cfield: 1 +field: ; -: field: 2 +field: ; -\ 2field is not standard, but why not? -: 2field: 4 +field: ; diff --git a/amforth-6.5/common/lib/forth2012/facility/time-and-date.frt b/amforth-6.5/common/lib/forth2012/facility/time-and-date.frt deleted file mode 100644 index aecbeff..0000000 --- a/amforth-6.5/common/lib/forth2012/facility/time-and-date.frt +++ /dev/null @@ -1,33 +0,0 @@ - - -\ common words for date&time - -\ uses timer interrrupt module to call -\ a background task every second. - -\ holds the ever increasing time ticks -\ unfortunatly, a day has more seconds -\ a 16bit variable can store. -2variable time \ the seconds of the current day -2variable date \ a day number - -\ a background task -: next-second - time 2@ 1. d+ 2dup - 86399. d> if - 2drop 0. - 1. date d+! - then - time 2! -; - -: dateinit - 0. time 2! - 0. date 2! -; - -\ simple world. Every month has 30 days -: time&date ( -- sec min hour day month year ) - date 2@ 365 um/mod 30 /mod ( -- day month year ) - time 2@ 24 um/mod 60 /mod ( -- sec min hour ) -; diff --git a/amforth-6.5/common/lib/forth2012/file/paren.frt b/amforth-6.5/common/lib/forth2012/file/paren.frt deleted file mode 100644 index 24c8460..0000000 --- a/amforth-6.5/common/lib/forth2012/file/paren.frt +++ /dev/null @@ -1,11 +0,0 @@ -\ redefine (, still buggy -: ( - begin - >in @ [char] ) parse nip - >in @ rot - = \ something found? - while - refill 0= - if - abort" refill while searching ) failed" - then - repeat ; immediate diff --git a/amforth-6.5/common/lib/forth2012/memory.frt b/amforth-6.5/common/lib/forth2012/memory.frt deleted file mode 100644 index 82debbf..0000000 --- a/amforth-6.5/common/lib/forth2012/memory.frt +++ /dev/null @@ -1,2 +0,0 @@ -\ 'memory.frt' generated automatically, do not edit -#include memory.frt diff --git a/amforth-6.5/common/lib/forth2012/search-order.frt b/amforth-6.5/common/lib/forth2012/search-order.frt deleted file mode 100644 index db7f92a..0000000 --- a/amforth-6.5/common/lib/forth2012/search-order.frt +++ /dev/null @@ -1,10 +0,0 @@ -\ include words from the search order wordset - -\ from search order -\ #require set-order.frt -\ #require get-order.frt -\ #require also.frt -\ #require definitions.frt -\ #require forth.frt -\ #require previous.frt -\ #require order.frt diff --git a/amforth-6.5/common/lib/forth2012/search/also.frt b/amforth-6.5/common/lib/forth2012/search/also.frt deleted file mode 100644 index 8934ce4..0000000 --- a/amforth-6.5/common/lib/forth2012/search/also.frt +++ /dev/null @@ -1,8 +0,0 @@ -\ duplicate first wordlist entry - -\ #require get-order.frt -\ #require set-order.frt - -: also ( -- ) - get-order over swap 1+ set-order -; diff --git a/amforth-6.5/common/lib/forth2012/search/definitions.frt b/amforth-6.5/common/lib/forth2012/search/definitions.frt deleted file mode 100644 index 7ab89f0..0000000 --- a/amforth-6.5/common/lib/forth2012/search/definitions.frt +++ /dev/null @@ -1,8 +0,0 @@ -\ Make the compilation word list the same as the current first word list in the search order. - -\ #require get-order.frt - -: definitions ( -- ) - get-order over set-current - 0 ?do drop loop \ clean up -; diff --git a/amforth-6.5/common/lib/forth2012/search/forth.frt b/amforth-6.5/common/lib/forth2012/search/forth.frt deleted file mode 100644 index 77d6e6f..0000000 --- a/amforth-6.5/common/lib/forth2012/search/forth.frt +++ /dev/null @@ -1,10 +0,0 @@ -\ replace the first search order entry -\ with forth-wordlist - -\ #require get-order.frt -\ #require set-order.frt - -: forth - get-order nip - forth-wordlist swap set-order -; diff --git a/amforth-6.5/common/lib/forth2012/search/get-order.frt b/amforth-6.5/common/lib/forth2012/search/get-order.frt deleted file mode 100644 index 958df7a..0000000 --- a/amforth-6.5/common/lib/forth2012/search/get-order.frt +++ /dev/null @@ -1,5 +0,0 @@ -\ get the ORDER stack - -: get-order - cfg-order get-stack -; \ No newline at end of file diff --git a/amforth-6.5/common/lib/forth2012/search/only.frt b/amforth-6.5/common/lib/forth2012/search/only.frt deleted file mode 100644 index 11d1a22..0000000 --- a/amforth-6.5/common/lib/forth2012/search/only.frt +++ /dev/null @@ -1,7 +0,0 @@ -\ sets the system specific forth wordlist - -\ #require set-order.frt - -: only - forth-wordlist 1 set-order -; diff --git a/amforth-6.5/common/lib/forth2012/search/order.frt b/amforth-6.5/common/lib/forth2012/search/order.frt deleted file mode 100644 index b0c4057..0000000 --- a/amforth-6.5/common/lib/forth2012/search/order.frt +++ /dev/null @@ -1,9 +0,0 @@ -\ print the wids of the current word list and the search order - -\ #require get-order.frt - -: order ( -- ) - get-current u. cr - get-order dup u. - 0 ?do u. space loop -; diff --git a/amforth-6.5/common/lib/forth2012/search/previous.frt b/amforth-6.5/common/lib/forth2012/search/previous.frt deleted file mode 100644 index 8d78394..0000000 --- a/amforth-6.5/common/lib/forth2012/search/previous.frt +++ /dev/null @@ -1,8 +0,0 @@ -\ remove the first entry in the search order list - -\ #require get-order.frt -\ #require set-order.frt - -: previous - get-order nip 1- set-order -; diff --git a/amforth-6.5/common/lib/forth2012/search/set-order.frt b/amforth-6.5/common/lib/forth2012/search/set-order.frt deleted file mode 100644 index 5969ea3..0000000 --- a/amforth-6.5/common/lib/forth2012/search/set-order.frt +++ /dev/null @@ -1,13 +0,0 @@ -\ set a new ORDER stack - -: set-order - dup 0= if -50 throw then \ no empty search order stack - cfg-order set-stack -; - -\ A better check would be -\ : set-order -\ dup 0 [ s" wordlists" environment search-wordlist drop execute ] literal -\ within if cfg-order set-stack else -50 throw then -\ ; -\ \ No newline at end of file diff --git a/amforth-6.5/common/lib/forth2012/string/search.frt b/amforth-6.5/common/lib/forth2012/string/search.frt deleted file mode 100644 index 36c0339..0000000 --- a/amforth-6.5/common/lib/forth2012/string/search.frt +++ /dev/null @@ -1,23 +0,0 @@ - -\ mostly from gforth. Minor modifications however.. - -: str= ( c-addr1 u1 c-addr2 u2 -- f ) \ gforth - compare 0= ; - -: string-prefix? ( c-addr1 u1 c-addr2 u2 -- f ) \ gforth - \ Is c-addr2 u2 a prefix of c-addr1 u1 ? - tuck 2>r min 2r> str= ; - -: >= < 0= ; - -: search ( c-addr1 u1 c-addr2 u2 -- c-addr3 u3 flag ) \ string - 2>r 2dup - begin - dup r@ >= \ 2r@ nip >= - while - 2dup 2r@ string-prefix? if - 2swap 2drop 2r> 2drop true exit - then - 1 /string - repeat - 2drop 2r> 2drop 0 ; diff --git a/amforth-6.5/common/lib/forth2012/string/split.frt b/amforth-6.5/common/lib/forth2012/string/split.frt deleted file mode 100644 index c627ed3..0000000 --- a/amforth-6.5/common/lib/forth2012/string/split.frt +++ /dev/null @@ -1,15 +0,0 @@ -\ Newsgroups: comp.lang.forth -\ Date: Sat, 21 Jun 2014 13:48:57 -0700 (PDT) -\ From: Julian Fondren -\ slightly modified for amforth (rdrop, false) - -\ split a string at the first occurance - -\ #require 2over.frt -\ #require search.frt - -: split ( 'string' 'separator' -- 'before' 'after' -1 | 0 ) - dup >r 2over 2swap search 0= if 2drop 2drop r> drop 0 exit then - 2>r r@ - 2r> r> /string true -; - diff --git a/amforth-6.5/common/lib/forth2012/string/trailing.frt b/amforth-6.5/common/lib/forth2012/string/trailing.frt deleted file mode 100644 index 51e709d..0000000 --- a/amforth-6.5/common/lib/forth2012/string/trailing.frt +++ /dev/null @@ -1,10 +0,0 @@ - - -: -trailing ( c_addr u1 -- c_addr u2 ) \ string dash-trailing -\ Adjust the string specified by {c-addr, u1} to remove all -\ trailing spaces. {u2} is the length of the modified string. - begin - dup - while - 1- 2dup + c@ bl <> - until 1+ then ; diff --git a/amforth-6.5/common/lib/forth2012/tester.frt b/amforth-6.5/common/lib/forth2012/tester.frt deleted file mode 100644 index cb73a41..0000000 --- a/amforth-6.5/common/lib/forth2012/tester.frt +++ /dev/null @@ -1,6 +0,0 @@ -\ 'tester.frt' generated automatically, do not edit -#include anstests.zip -#include core.fr -#include doubletest.fth -#include searchordertest.txt -#include tester-amforth.frt diff --git a/amforth-6.5/common/lib/forth2012/tester/anstests.zip b/amforth-6.5/common/lib/forth2012/tester/anstests.zip deleted file mode 100644 index 34dc1bd..0000000 Binary files a/amforth-6.5/common/lib/forth2012/tester/anstests.zip and /dev/null differ diff --git a/amforth-6.5/common/lib/forth2012/tester/anstests0.9.zip b/amforth-6.5/common/lib/forth2012/tester/anstests0.9.zip deleted file mode 100644 index 89ad461..0000000 Binary files a/amforth-6.5/common/lib/forth2012/tester/anstests0.9.zip and /dev/null differ diff --git a/amforth-6.5/common/lib/forth2012/tester/core.fr b/amforth-6.5/common/lib/forth2012/tester/core.fr deleted file mode 100644 index 488db2a..0000000 --- a/amforth-6.5/common/lib/forth2012/tester/core.fr +++ /dev/null @@ -1,1002 +0,0 @@ -\ From: John Hayes S1I -\ Subject: core.fr -\ Date: Mon, 27 Nov 95 13:10 - -\ (C) 1995 JOHNS HOPKINS UNIVERSITY / APPLIED PHYSICS LABORATORY -\ MAY BE DISTRIBUTED FREELY AS LONG AS THIS COPYRIGHT NOTICE REMAINS. -\ VERSION 1.2 -\ THIS PROGRAM TESTS THE CORE WORDS OF AN ANS FORTH SYSTEM. -\ THE PROGRAM ASSUMES A TWO'S COMPLEMENT IMPLEMENTATION WHERE -\ THE RANGE OF SIGNED NUMBERS IS -2^(N-1) ... 2^(N-1)-1 AND -\ THE RANGE OF UNSIGNED NUMBERS IS 0 ... 2^(N)-1. -\ I HAVEN'T FIGURED OUT HOW TO TEST KEY, QUIT, ABORT, OR ABORT"... -\ I ALSO HAVEN'T THOUGHT OF A WAY TO TEST ENVIRONMENT?... - -CR -TESTING CORE WORDS -HEX - -\ ------------------------------------------------------------------------ -TESTING BASIC ASSUMPTIONS - -T{ -> }T \ START WITH CLEAN SLATE -( TEST IF ANY BITS ARE SET; ANSWER IN BASE 1 ) -T{ : BITSSET? IF 0 0 ELSE 0 THEN ; -> }T -T{ 0 BITSSET? -> 0 }T ( ZERO IS ALL BITS CLEAR ) -T{ 1 BITSSET? -> 0 0 }T ( OTHER NUMBER HAVE AT LEAST ONE BIT ) -T{ -1 BITSSET? -> 0 0 }T - -\ ------------------------------------------------------------------------ -TESTING BOOLEANS: INVERT AND OR XOR - -T{ 0 0 AND -> 0 }T -T{ 0 1 AND -> 0 }T -T{ 1 0 AND -> 0 }T -T{ 1 1 AND -> 1 }T - -T{ 0 INVERT 1 AND -> 1 }T -T{ 1 INVERT 1 AND -> 0 }T - -0 CONSTANT 0S -0 INVERT CONSTANT 1S - -T{ 0S INVERT -> 1S }T -T{ 1S INVERT -> 0S }T - -T{ 0S 0S AND -> 0S }T -T{ 0S 1S AND -> 0S }T -T{ 1S 0S AND -> 0S }T -T{ 1S 1S AND -> 1S }T - -T{ 0S 0S OR -> 0S }T -T{ 0S 1S OR -> 1S }T -T{ 1S 0S OR -> 1S }T -T{ 1S 1S OR -> 1S }T - -T{ 0S 0S XOR -> 0S }T -T{ 0S 1S XOR -> 1S }T -T{ 1S 0S XOR -> 1S }T -T{ 1S 1S XOR -> 0S }T - -\ ------------------------------------------------------------------------ -TESTING 2* 2/ LSHIFT RSHIFT - -( WE TRUST 1S, INVERT, AND BITSSET?; WE WILL CONFIRM RSHIFT LATER ) -1S 1 RSHIFT INVERT CONSTANT MSB -T{ MSB BITSSET? -> 0 0 }T - -T{ 0S 2* -> 0S }T -T{ 1 2* -> 2 }T -T{ 4000 2* -> 8000 }T -T{ 1S 2* 1 XOR -> 1S }T -T{ MSB 2* -> 0S }T - -T{ 0S 2/ -> 0S }T -T{ 1 2/ -> 0 }T -T{ 4000 2/ -> 2000 }T -T{ 1S 2/ -> 1S }T \ MSB PROPOGATED -T{ 1S 1 XOR 2/ -> 1S }T -T{ MSB 2/ MSB AND -> MSB }T - -T{ 1 0 LSHIFT -> 1 }T -T{ 1 1 LSHIFT -> 2 }T -T{ 1 2 LSHIFT -> 4 }T -T{ 1 F LSHIFT -> 8000 }T \ BIGGEST GUARANTEED SHIFT -T{ 1S 1 LSHIFT 1 XOR -> 1S }T -T{ MSB 1 LSHIFT -> 0 }T - -T{ 1 0 RSHIFT -> 1 }T -T{ 1 1 RSHIFT -> 0 }T -T{ 2 1 RSHIFT -> 1 }T -T{ 4 2 RSHIFT -> 1 }T -T{ 8000 F RSHIFT -> 1 }T \ BIGGEST -T{ MSB 1 RSHIFT MSB AND -> 0 }T \ RSHIFT ZERO FILLS MSBS -T{ MSB 1 RSHIFT 2* -> MSB }T - -\ ------------------------------------------------------------------------ -TESTING COMPARISONS: 0= = 0< < > U< MIN MAX -0 INVERT CONSTANT MAX-UINT -0 INVERT 1 RSHIFT CONSTANT MAX-INT -0 INVERT 1 RSHIFT INVERT CONSTANT MIN-INT -0 INVERT 1 RSHIFT CONSTANT MID-UINT -0 INVERT 1 RSHIFT INVERT CONSTANT MID-UINT+1 - -0S CONSTANT -1S CONSTANT - -T{ 0 0= -> }T -T{ 1 0= -> }T -T{ 2 0= -> }T -T{ -1 0= -> }T -T{ MAX-UINT 0= -> }T -T{ MIN-INT 0= -> }T -T{ MAX-INT 0= -> }T - -T{ 0 0 = -> }T -T{ 1 1 = -> }T -T{ -1 -1 = -> }T -T{ 1 0 = -> }T -T{ -1 0 = -> }T -T{ 0 1 = -> }T -T{ 0 -1 = -> }T - -T{ 0 0< -> }T -T{ -1 0< -> }T -T{ MIN-INT 0< -> }T -T{ 1 0< -> }T -T{ MAX-INT 0< -> }T - -T{ 0 1 < -> }T -T{ 1 2 < -> }T -T{ -1 0 < -> }T -T{ -1 1 < -> }T -T{ MIN-INT 0 < -> }T -T{ MIN-INT MAX-INT < -> }T -T{ 0 MAX-INT < -> }T -T{ 0 0 < -> }T -T{ 1 1 < -> }T -T{ 1 0 < -> }T -T{ 2 1 < -> }T -T{ 0 -1 < -> }T -T{ 1 -1 < -> }T -T{ 0 MIN-INT < -> }T -T{ MAX-INT MIN-INT < -> }T -T{ MAX-INT 0 < -> }T - -T{ 0 1 > -> }T -T{ 1 2 > -> }T -T{ -1 0 > -> }T -T{ -1 1 > -> }T -T{ MIN-INT 0 > -> }T -T{ MIN-INT MAX-INT > -> }T -T{ 0 MAX-INT > -> }T -T{ 0 0 > -> }T -T{ 1 1 > -> }T -T{ 1 0 > -> }T -T{ 2 1 > -> }T -T{ 0 -1 > -> }T -T{ 1 -1 > -> }T -T{ 0 MIN-INT > -> }T -T{ MAX-INT MIN-INT > -> }T -T{ MAX-INT 0 > -> }T - -T{ 0 1 U< -> }T -T{ 1 2 U< -> }T -T{ 0 MID-UINT U< -> }T -T{ 0 MAX-UINT U< -> }T -T{ MID-UINT MAX-UINT U< -> }T -T{ 0 0 U< -> }T -T{ 1 1 U< -> }T -T{ 1 0 U< -> }T -T{ 2 1 U< -> }T -T{ MID-UINT 0 U< -> }T -T{ MAX-UINT 0 U< -> }T -T{ MAX-UINT MID-UINT U< -> }T - -T{ 0 1 MIN -> 0 }T -T{ 1 2 MIN -> 1 }T -T{ -1 0 MIN -> -1 }T -T{ -1 1 MIN -> -1 }T -T{ MIN-INT 0 MIN -> MIN-INT }T -T{ MIN-INT MAX-INT MIN -> MIN-INT }T -T{ 0 MAX-INT MIN -> 0 }T -T{ 0 0 MIN -> 0 }T -T{ 1 1 MIN -> 1 }T -T{ 1 0 MIN -> 0 }T -T{ 2 1 MIN -> 1 }T -T{ 0 -1 MIN -> -1 }T -T{ 1 -1 MIN -> -1 }T -T{ 0 MIN-INT MIN -> MIN-INT }T -T{ MAX-INT MIN-INT MIN -> MIN-INT }T -T{ MAX-INT 0 MIN -> 0 }T - -T{ 0 1 MAX -> 1 }T -T{ 1 2 MAX -> 2 }T -T{ -1 0 MAX -> 0 }T -T{ -1 1 MAX -> 1 }T -T{ MIN-INT 0 MAX -> 0 }T -T{ MIN-INT MAX-INT MAX -> MAX-INT }T -T{ 0 MAX-INT MAX -> MAX-INT }T -T{ 0 0 MAX -> 0 }T -T{ 1 1 MAX -> 1 }T -T{ 1 0 MAX -> 1 }T -T{ 2 1 MAX -> 2 }T -T{ 0 -1 MAX -> 0 }T -T{ 1 -1 MAX -> 1 }T -T{ 0 MIN-INT MAX -> 0 }T -T{ MAX-INT MIN-INT MAX -> MAX-INT }T -T{ MAX-INT 0 MAX -> MAX-INT }T - -\ ------------------------------------------------------------------------ -TESTING STACK OPS: 2DROP 2DUP 2OVER 2SWAP ?DUP DEPTH DROP DUP OVER ROT SWAP - -T{ 1 2 2DROP -> }T -T{ 1 2 2DUP -> 1 2 1 2 }T -T{ 1 2 3 4 2OVER -> 1 2 3 4 1 2 }T -T{ 1 2 3 4 2SWAP -> 3 4 1 2 }T -T{ 0 ?DUP -> 0 }T -T{ 1 ?DUP -> 1 1 }T -T{ -1 ?DUP -> -1 -1 }T -T{ DEPTH -> 0 }T -T{ 0 DEPTH -> 0 1 }T -T{ 0 1 DEPTH -> 0 1 2 }T -T{ 0 DROP -> }T -T{ 1 2 DROP -> 1 }T -T{ 1 DUP -> 1 1 }T -T{ 1 2 OVER -> 1 2 1 }T -T{ 1 2 3 ROT -> 2 3 1 }T -T{ 1 2 SWAP -> 2 1 }T - -\ ------------------------------------------------------------------------ -TESTING >R R> R@ - -T{ : GR1 >R R> ; -> }T -T{ : GR2 >R R@ R> DROP ; -> }T -T{ 123 GR1 -> 123 }T -T{ 123 GR2 -> 123 }T -T{ 1S GR1 -> 1S }T ( RETURN STACK HOLDS CELLS ) - -\ ------------------------------------------------------------------------ -TESTING ADD/SUBTRACT: + - 1+ 1- ABS NEGATE - -T{ 0 5 + -> 5 }T -T{ 5 0 + -> 5 }T -T{ 0 -5 + -> -5 }T -T{ -5 0 + -> -5 }T -T{ 1 2 + -> 3 }T -T{ 1 -2 + -> -1 }T -T{ -1 2 + -> 1 }T -T{ -1 -2 + -> -3 }T -T{ -1 1 + -> 0 }T -T{ MID-UINT 1 + -> MID-UINT+1 }T - -T{ 0 5 - -> -5 }T -T{ 5 0 - -> 5 }T -T{ 0 -5 - -> 5 }T -T{ -5 0 - -> -5 }T -T{ 1 2 - -> -1 }T -T{ 1 -2 - -> 3 }T -T{ -1 2 - -> -3 }T -T{ -1 -2 - -> 1 }T -T{ 0 1 - -> -1 }T -T{ MID-UINT+1 1 - -> MID-UINT }T - -T{ 0 1+ -> 1 }T -T{ -1 1+ -> 0 }T -T{ 1 1+ -> 2 }T -T{ MID-UINT 1+ -> MID-UINT+1 }T - -T{ 2 1- -> 1 }T -T{ 1 1- -> 0 }T -T{ 0 1- -> -1 }T -T{ MID-UINT+1 1- -> MID-UINT }T - -T{ 0 NEGATE -> 0 }T -T{ 1 NEGATE -> -1 }T -T{ -1 NEGATE -> 1 }T -T{ 2 NEGATE -> -2 }T -T{ -2 NEGATE -> 2 }T - -T{ 0 ABS -> 0 }T -T{ 1 ABS -> 1 }T -T{ -1 ABS -> 1 }T -T{ MIN-INT ABS -> MID-UINT+1 }T - -\ ------------------------------------------------------------------------ -TESTING MULTIPLY: S>D * M* UM* - -T{ 0 S>D -> 0 0 }T -T{ 1 S>D -> 1 0 }T -T{ 2 S>D -> 2 0 }T -T{ -1 S>D -> -1 -1 }T -T{ -2 S>D -> -2 -1 }T -T{ MIN-INT S>D -> MIN-INT -1 }T -T{ MAX-INT S>D -> MAX-INT 0 }T - -T{ 0 0 M* -> 0 S>D }T -T{ 0 1 M* -> 0 S>D }T -T{ 1 0 M* -> 0 S>D }T -T{ 1 2 M* -> 2 S>D }T -T{ 2 1 M* -> 2 S>D }T -T{ 3 3 M* -> 9 S>D }T -T{ -3 3 M* -> -9 S>D }T -T{ 3 -3 M* -> -9 S>D }T -T{ -3 -3 M* -> 9 S>D }T -T{ 0 MIN-INT M* -> 0 S>D }T -T{ 1 MIN-INT M* -> MIN-INT S>D }T -T{ 2 MIN-INT M* -> 0 1S }T -T{ 0 MAX-INT M* -> 0 S>D }T -T{ 1 MAX-INT M* -> MAX-INT S>D }T -T{ 2 MAX-INT M* -> MAX-INT 1 LSHIFT 0 }T -T{ MIN-INT MIN-INT M* -> 0 MSB 1 RSHIFT }T -T{ MAX-INT MIN-INT M* -> MSB MSB 2/ }T -T{ MAX-INT MAX-INT M* -> 1 MSB 2/ INVERT }T - -T{ 0 0 * -> 0 }T \ TEST IDENTITIES -T{ 0 1 * -> 0 }T -T{ 1 0 * -> 0 }T -T{ 1 2 * -> 2 }T -T{ 2 1 * -> 2 }T -T{ 3 3 * -> 9 }T -T{ -3 3 * -> -9 }T -T{ 3 -3 * -> -9 }T -T{ -3 -3 * -> 9 }T - -T{ MID-UINT+1 1 RSHIFT 2 * -> MID-UINT+1 }T -T{ MID-UINT+1 2 RSHIFT 4 * -> MID-UINT+1 }T -T{ MID-UINT+1 1 RSHIFT MID-UINT+1 OR 2 * -> MID-UINT+1 }T - -T{ 0 0 UM* -> 0 0 }T -T{ 0 1 UM* -> 0 0 }T -T{ 1 0 UM* -> 0 0 }T -T{ 1 2 UM* -> 2 0 }T -T{ 2 1 UM* -> 2 0 }T -T{ 3 3 UM* -> 9 0 }T - -T{ MID-UINT+1 1 RSHIFT 2 UM* -> MID-UINT+1 0 }T -T{ MID-UINT+1 2 UM* -> 0 1 }T -T{ MID-UINT+1 4 UM* -> 0 2 }T -T{ 1S 2 UM* -> 1S 1 LSHIFT 1 }T -T{ MAX-UINT MAX-UINT UM* -> 1 1 INVERT }T - -\ ------------------------------------------------------------------------ -TESTING DIVIDE: FM/MOD SM/REM UM/MOD */ */MOD / /MOD MOD - -T{ 0 S>D 1 FM/MOD -> 0 0 }T -T{ 1 S>D 1 FM/MOD -> 0 1 }T -T{ 2 S>D 1 FM/MOD -> 0 2 }T -T{ -1 S>D 1 FM/MOD -> 0 -1 }T -T{ -2 S>D 1 FM/MOD -> 0 -2 }T -T{ 0 S>D -1 FM/MOD -> 0 0 }T -T{ 1 S>D -1 FM/MOD -> 0 -1 }T -T{ 2 S>D -1 FM/MOD -> 0 -2 }T -T{ -1 S>D -1 FM/MOD -> 0 1 }T -T{ -2 S>D -1 FM/MOD -> 0 2 }T -T{ 2 S>D 2 FM/MOD -> 0 1 }T -T{ -1 S>D -1 FM/MOD -> 0 1 }T -T{ -2 S>D -2 FM/MOD -> 0 1 }T -T{ 7 S>D 3 FM/MOD -> 1 2 }T -T{ 7 S>D -3 FM/MOD -> -2 -3 }T -T{ -7 S>D 3 FM/MOD -> 2 -3 }T -T{ -7 S>D -3 FM/MOD -> -1 2 }T -T{ MAX-INT S>D 1 FM/MOD -> 0 MAX-INT }T -T{ MIN-INT S>D 1 FM/MOD -> 0 MIN-INT }T -T{ MAX-INT S>D MAX-INT FM/MOD -> 0 1 }T -T{ MIN-INT S>D MIN-INT FM/MOD -> 0 1 }T -T{ 1S 1 4 FM/MOD -> 3 MAX-INT }T -T{ 1 MIN-INT M* 1 FM/MOD -> 0 MIN-INT }T -T{ 1 MIN-INT M* MIN-INT FM/MOD -> 0 1 }T -T{ 2 MIN-INT M* 2 FM/MOD -> 0 MIN-INT }T -T{ 2 MIN-INT M* MIN-INT FM/MOD -> 0 2 }T -T{ 1 MAX-INT M* 1 FM/MOD -> 0 MAX-INT }T -T{ 1 MAX-INT M* MAX-INT FM/MOD -> 0 1 }T -T{ 2 MAX-INT M* 2 FM/MOD -> 0 MAX-INT }T -T{ 2 MAX-INT M* MAX-INT FM/MOD -> 0 2 }T -T{ MIN-INT MIN-INT M* MIN-INT FM/MOD -> 0 MIN-INT }T -T{ MIN-INT MAX-INT M* MIN-INT FM/MOD -> 0 MAX-INT }T -T{ MIN-INT MAX-INT M* MAX-INT FM/MOD -> 0 MIN-INT }T -T{ MAX-INT MAX-INT M* MAX-INT FM/MOD -> 0 MAX-INT }T - -T{ 0 S>D 1 SM/REM -> 0 0 }T -T{ 1 S>D 1 SM/REM -> 0 1 }T -T{ 2 S>D 1 SM/REM -> 0 2 }T -T{ -1 S>D 1 SM/REM -> 0 -1 }T -T{ -2 S>D 1 SM/REM -> 0 -2 }T -T{ 0 S>D -1 SM/REM -> 0 0 }T -T{ 1 S>D -1 SM/REM -> 0 -1 }T -T{ 2 S>D -1 SM/REM -> 0 -2 }T -T{ -1 S>D -1 SM/REM -> 0 1 }T -T{ -2 S>D -1 SM/REM -> 0 2 }T -T{ 2 S>D 2 SM/REM -> 0 1 }T -T{ -1 S>D -1 SM/REM -> 0 1 }T -T{ -2 S>D -2 SM/REM -> 0 1 }T -T{ 7 S>D 3 SM/REM -> 1 2 }T -T{ 7 S>D -3 SM/REM -> 1 -2 }T -T{ -7 S>D 3 SM/REM -> -1 -2 }T -T{ -7 S>D -3 SM/REM -> -1 2 }T -T{ MAX-INT S>D 1 SM/REM -> 0 MAX-INT }T -T{ MIN-INT S>D 1 SM/REM -> 0 MIN-INT }T -T{ MAX-INT S>D MAX-INT SM/REM -> 0 1 }T -T{ MIN-INT S>D MIN-INT SM/REM -> 0 1 }T -T{ 1S 1 4 SM/REM -> 3 MAX-INT }T -T{ 2 MIN-INT M* 2 SM/REM -> 0 MIN-INT }T -T{ 2 MIN-INT M* MIN-INT SM/REM -> 0 2 }T -T{ 2 MAX-INT M* 2 SM/REM -> 0 MAX-INT }T -T{ 2 MAX-INT M* MAX-INT SM/REM -> 0 2 }T -T{ MIN-INT MIN-INT M* MIN-INT SM/REM -> 0 MIN-INT }T -T{ MIN-INT MAX-INT M* MIN-INT SM/REM -> 0 MAX-INT }T -T{ MIN-INT MAX-INT M* MAX-INT SM/REM -> 0 MIN-INT }T -T{ MAX-INT MAX-INT M* MAX-INT SM/REM -> 0 MAX-INT }T - -T{ 0 0 1 UM/MOD -> 0 0 }T -T{ 1 0 1 UM/MOD -> 0 1 }T -T{ 1 0 2 UM/MOD -> 1 0 }T -T{ 3 0 2 UM/MOD -> 1 1 }T -T{ MAX-UINT 2 UM* 2 UM/MOD -> 0 MAX-UINT }T -T{ MAX-UINT 2 UM* MAX-UINT UM/MOD -> 0 2 }T -T{ MAX-UINT MAX-UINT UM* MAX-UINT UM/MOD -> 0 MAX-UINT }T - -: IFFLOORED - [ -3 2 / -2 = INVERT ] LITERAL IF POSTPONE \ THEN ; - -: IFSYM - [ -3 2 / -1 = INVERT ] LITERAL IF POSTPONE \ THEN ; - -\ THE SYSTEM MIGHT DO EITHER FLOORED OR SYMMETRIC DIVISION. -\ SINCE WE HAVE ALREADY TESTED M*, FM/MOD, AND SM/REM WE CAN USE THEM IN TEST. - -IFFLOORED : T/MOD >R S>D R> FM/MOD ; -IFFLOORED : T/ T/MOD SWAP DROP ; -IFFLOORED : TMOD T/MOD DROP ; -IFFLOORED : T*/MOD >R M* R> FM/MOD ; -IFFLOORED : T*/ T*/MOD SWAP DROP ; -IFSYM : T/MOD >R S>D R> SM/REM ; -IFSYM : T/ T/MOD SWAP DROP ; -IFSYM : TMOD T/MOD DROP ; -IFSYM : T*/MOD >R M* R> SM/REM ; -IFSYM : T*/ T*/MOD SWAP DROP ; - -T{ 0 1 /MOD -> 0 1 T/MOD }T -T{ 1 1 /MOD -> 1 1 T/MOD }T -T{ 2 1 /MOD -> 2 1 T/MOD }T -T{ -1 1 /MOD -> -1 1 T/MOD }T -T{ -2 1 /MOD -> -2 1 T/MOD }T -T{ 0 -1 /MOD -> 0 -1 T/MOD }T -T{ 1 -1 /MOD -> 1 -1 T/MOD }T -T{ 2 -1 /MOD -> 2 -1 T/MOD }T -T{ -1 -1 /MOD -> -1 -1 T/MOD }T -T{ -2 -1 /MOD -> -2 -1 T/MOD }T -T{ 2 2 /MOD -> 2 2 T/MOD }T -T{ -1 -1 /MOD -> -1 -1 T/MOD }T -T{ -2 -2 /MOD -> -2 -2 T/MOD }T -T{ 7 3 /MOD -> 7 3 T/MOD }T -T{ 7 -3 /MOD -> 7 -3 T/MOD }T -T{ -7 3 /MOD -> -7 3 T/MOD }T -T{ -7 -3 /MOD -> -7 -3 T/MOD }T -T{ MAX-INT 1 /MOD -> MAX-INT 1 T/MOD }T -T{ MIN-INT 1 /MOD -> MIN-INT 1 T/MOD }T -T{ MAX-INT MAX-INT /MOD -> MAX-INT MAX-INT T/MOD }T -T{ MIN-INT MIN-INT /MOD -> MIN-INT MIN-INT T/MOD }T - -T{ 0 1 / -> 0 1 T/ }T -T{ 1 1 / -> 1 1 T/ }T -T{ 2 1 / -> 2 1 T/ }T -T{ -1 1 / -> -1 1 T/ }T -T{ -2 1 / -> -2 1 T/ }T -T{ 0 -1 / -> 0 -1 T/ }T -T{ 1 -1 / -> 1 -1 T/ }T -T{ 2 -1 / -> 2 -1 T/ }T -T{ -1 -1 / -> -1 -1 T/ }T -T{ -2 -1 / -> -2 -1 T/ }T -T{ 2 2 / -> 2 2 T/ }T -T{ -1 -1 / -> -1 -1 T/ }T -T{ -2 -2 / -> -2 -2 T/ }T -T{ 7 3 / -> 7 3 T/ }T -T{ 7 -3 / -> 7 -3 T/ }T -T{ -7 3 / -> -7 3 T/ }T -T{ -7 -3 / -> -7 -3 T/ }T -T{ MAX-INT 1 / -> MAX-INT 1 T/ }T -T{ MIN-INT 1 / -> MIN-INT 1 T/ }T -T{ MAX-INT MAX-INT / -> MAX-INT MAX-INT T/ }T -T{ MIN-INT MIN-INT / -> MIN-INT MIN-INT T/ }T - -T{ 0 1 MOD -> 0 1 TMOD }T -T{ 1 1 MOD -> 1 1 TMOD }T -T{ 2 1 MOD -> 2 1 TMOD }T -T{ -1 1 MOD -> -1 1 TMOD }T -T{ -2 1 MOD -> -2 1 TMOD }T -T{ 0 -1 MOD -> 0 -1 TMOD }T -T{ 1 -1 MOD -> 1 -1 TMOD }T -T{ 2 -1 MOD -> 2 -1 TMOD }T -T{ -1 -1 MOD -> -1 -1 TMOD }T -T{ -2 -1 MOD -> -2 -1 TMOD }T -T{ 2 2 MOD -> 2 2 TMOD }T -T{ -1 -1 MOD -> -1 -1 TMOD }T -T{ -2 -2 MOD -> -2 -2 TMOD }T -T{ 7 3 MOD -> 7 3 TMOD }T -T{ 7 -3 MOD -> 7 -3 TMOD }T -T{ -7 3 MOD -> -7 3 TMOD }T -T{ -7 -3 MOD -> -7 -3 TMOD }T -T{ MAX-INT 1 MOD -> MAX-INT 1 TMOD }T -T{ MIN-INT 1 MOD -> MIN-INT 1 TMOD }T -T{ MAX-INT MAX-INT MOD -> MAX-INT MAX-INT TMOD }T -T{ MIN-INT MIN-INT MOD -> MIN-INT MIN-INT TMOD }T - -T{ 0 2 1 */ -> 0 2 1 T*/ }T -T{ 1 2 1 */ -> 1 2 1 T*/ }T -T{ 2 2 1 */ -> 2 2 1 T*/ }T -T{ -1 2 1 */ -> -1 2 1 T*/ }T -T{ -2 2 1 */ -> -2 2 1 T*/ }T -T{ 0 2 -1 */ -> 0 2 -1 T*/ }T -T{ 1 2 -1 */ -> 1 2 -1 T*/ }T -T{ 2 2 -1 */ -> 2 2 -1 T*/ }T -T{ -1 2 -1 */ -> -1 2 -1 T*/ }T -T{ -2 2 -1 */ -> -2 2 -1 T*/ }T -T{ 2 2 2 */ -> 2 2 2 T*/ }T -T{ -1 2 -1 */ -> -1 2 -1 T*/ }T -T{ -2 2 -2 */ -> -2 2 -2 T*/ }T -T{ 7 2 3 */ -> 7 2 3 T*/ }T -T{ 7 2 -3 */ -> 7 2 -3 T*/ }T -T{ -7 2 3 */ -> -7 2 3 T*/ }T -T{ -7 2 -3 */ -> -7 2 -3 T*/ }T -T{ MAX-INT 2 MAX-INT */ -> MAX-INT 2 MAX-INT T*/ }T -T{ MIN-INT 2 MIN-INT */ -> MIN-INT 2 MIN-INT T*/ }T - -T{ 0 2 1 */MOD -> 0 2 1 T*/MOD }T -T{ 1 2 1 */MOD -> 1 2 1 T*/MOD }T -T{ 2 2 1 */MOD -> 2 2 1 T*/MOD }T -T{ -1 2 1 */MOD -> -1 2 1 T*/MOD }T -T{ -2 2 1 */MOD -> -2 2 1 T*/MOD }T -T{ 0 2 -1 */MOD -> 0 2 -1 T*/MOD }T -T{ 1 2 -1 */MOD -> 1 2 -1 T*/MOD }T -T{ 2 2 -1 */MOD -> 2 2 -1 T*/MOD }T -T{ -1 2 -1 */MOD -> -1 2 -1 T*/MOD }T -T{ -2 2 -1 */MOD -> -2 2 -1 T*/MOD }T -T{ 2 2 2 */MOD -> 2 2 2 T*/MOD }T -T{ -1 2 -1 */MOD -> -1 2 -1 T*/MOD }T -T{ -2 2 -2 */MOD -> -2 2 -2 T*/MOD }T -T{ 7 2 3 */MOD -> 7 2 3 T*/MOD }T -T{ 7 2 -3 */MOD -> 7 2 -3 T*/MOD }T -T{ -7 2 3 */MOD -> -7 2 3 T*/MOD }T -T{ -7 2 -3 */MOD -> -7 2 -3 T*/MOD }T -T{ MAX-INT 2 MAX-INT */MOD -> MAX-INT 2 MAX-INT T*/MOD }T -T{ MIN-INT 2 MIN-INT */MOD -> MIN-INT 2 MIN-INT T*/MOD }T - -\ ------------------------------------------------------------------------ -TESTING HERE , @ ! CELL+ CELLS C, C@ C! CHARS 2@ 2! ALIGN ALIGNED +! ALLOT - -HERE 1 ALLOT -HERE -CONSTANT 2NDA -CONSTANT 1STA -T{ 1STA 2NDA U< -> }T \ HERE MUST GROW WITH ALLOT -T{ 1STA 1+ -> 2NDA }T \ ... BY ONE ADDRESS UNIT -( MISSING TEST: NEGATIVE ALLOT ) - -HERE 1 , -HERE 2 , -CONSTANT 2ND -CONSTANT 1ST -T{ 1ST 2ND U< -> }T \ HERE MUST GROW WITH ALLOT -T{ 1ST CELL+ -> 2ND }T \ ... BY ONE CELL -T{ 1ST 1 CELLS + -> 2ND }T -T{ 1ST @ 2ND @ -> 1 2 }T -T{ 5 1ST ! -> }T -T{ 1ST @ 2ND @ -> 5 2 }T -T{ 6 2ND ! -> }T -T{ 1ST @ 2ND @ -> 5 6 }T -T{ 1ST 2@ -> 6 5 }T -T{ 2 1 1ST 2! -> }T -T{ 1ST 2@ -> 2 1 }T -T{ 1S 1ST ! 1ST @ -> 1S }T \ CAN STORE CELL-WIDE VALUE - -HERE 1 C, -HERE 2 C, -CONSTANT 2NDC -CONSTANT 1STC -T{ 1STC 2NDC U< -> }T \ HERE MUST GROW WITH ALLOT -T{ 1STC CHAR+ -> 2NDC }T \ ... BY ONE CHAR -T{ 1STC 1 CHARS + -> 2NDC }T -T{ 1STC C@ 2NDC C@ -> 1 2 }T -T{ 3 1STC C! -> }T -T{ 1STC C@ 2NDC C@ -> 3 2 }T -T{ 4 2NDC C! -> }T -T{ 1STC C@ 2NDC C@ -> 3 4 }T - -ALIGN 1 ALLOT HERE ALIGN HERE 3 CELLS ALLOT -CONSTANT A-ADDR CONSTANT UA-ADDR -T{ UA-ADDR ALIGNED -> A-ADDR }T -T{ 1 A-ADDR C! A-ADDR C@ -> 1 }T -T{ 1234 A-ADDR ! A-ADDR @ -> 1234 }T -T{ 123 456 A-ADDR 2! A-ADDR 2@ -> 123 456 }T -T{ 2 A-ADDR CHAR+ C! A-ADDR CHAR+ C@ -> 2 }T -T{ 3 A-ADDR CELL+ C! A-ADDR CELL+ C@ -> 3 }T -T{ 1234 A-ADDR CELL+ ! A-ADDR CELL+ @ -> 1234 }T -T{ 123 456 A-ADDR CELL+ 2! A-ADDR CELL+ 2@ -> 123 456 }T - -: BITS ( X -- U ) - 0 SWAP BEGIN DUP WHILE DUP MSB AND IF >R 1+ R> THEN 2* REPEAT DROP ; -( CHARACTERS >= 1 AU, <= SIZE OF CELL, >= 8 BITS ) -T{ 1 CHARS 1 < -> }T -T{ 1 CHARS 1 CELLS > -> }T -( TBD: HOW TO FIND NUMBER OF BITS? ) - -( CELLS >= 1 AU, INTEGRAL MULTIPLE OF CHAR SIZE, >= 16 BITS ) -T{ 1 CELLS 1 < -> }T -T{ 1 CELLS 1 CHARS MOD -> 0 }T -T{ 1S BITS 10 < -> }T - -T{ 0 1ST ! -> }T -T{ 1 1ST +! -> }T -T{ 1ST @ -> 1 }T -T{ -1 1ST +! 1ST @ -> 0 }T - -\ ------------------------------------------------------------------------ -TESTING CHAR [CHAR] [ ] BL S" - -T{ BL -> 20 }T -T{ CHAR X -> 58 }T -T{ CHAR HELLO -> 48 }T -T{ : GC1 [CHAR] X ; -> }T -T{ : GC2 [CHAR] HELLO ; -> }T -T{ GC1 -> 58 }T -T{ GC2 -> 48 }T -T{ : GC3 [ GC1 ] LITERAL ; -> }T -T{ GC3 -> 58 }T -T{ : GC4 S" XY" ; -> }T -T{ GC4 SWAP DROP -> 2 }T -T{ GC4 DROP DUP C@ SWAP CHAR+ C@ -> 58 59 }T - -\ ------------------------------------------------------------------------ -TESTING ' ['] FIND EXECUTE IMMEDIATE COUNT LITERAL POSTPONE STATE - -T{ : GT1 123 ; -> }T -T{ ' GT1 EXECUTE -> 123 }T -T{ : GT2 ['] GT1 ; IMMEDIATE -> }T -T{ GT2 EXECUTE -> 123 }T -HERE 3 C, CHAR G C, CHAR T C, CHAR 1 C, CONSTANT GT1STRING -HERE 3 C, CHAR G C, CHAR T C, CHAR 2 C, CONSTANT GT2STRING -T{ GT1STRING FIND -> ' GT1 -1 }T -T{ GT2STRING FIND -> ' GT2 1 }T -( HOW TO SEARCH FOR NON-EXISTENT WORD? ) -\ T{ : GT3 GT2 LITERAL ; -> }T -\ T{ GT3 -> ' GT1 }T -\ T{ GT1STRING COUNT -> GT1STRING CHAR+ 3 }T - -T{ : GT4 POSTPONE GT1 ; IMMEDIATE -> }T -T{ : GT5 GT4 ; -> }T -T{ GT5 -> 123 }T -T{ : GT6 345 ; IMMEDIATE -> }T -T{ : GT7 POSTPONE GT6 ; -> }T -T{ GT7 -> 345 }T - -T{ : GT8 STATE @ ; IMMEDIATE -> }T -T{ GT8 -> 0 }T -T{ : GT9 GT8 LITERAL ; -> }T -T{ GT9 0= -> }T - -\ ------------------------------------------------------------------------ -TESTING IF ELSE THEN BEGIN WHILE REPEAT UNTIL RECURSE - -T{ : GI1 IF 123 THEN ; -> }T -T{ : GI2 IF 123 ELSE 234 THEN ; -> }T -T{ 0 GI1 -> }T -T{ 1 GI1 -> 123 }T -T{ -1 GI1 -> 123 }T -T{ 0 GI2 -> 234 }T -T{ 1 GI2 -> 123 }T -T{ -1 GI1 -> 123 }T - -T{ : GI3 BEGIN DUP 5 < WHILE DUP 1+ REPEAT ; -> }T -T{ 0 GI3 -> 0 1 2 3 4 5 }T -T{ 4 GI3 -> 4 5 }T -T{ 5 GI3 -> 5 }T -T{ 6 GI3 -> 6 }T - -T{ : GI4 BEGIN DUP 1+ DUP 5 > UNTIL ; -> }T -T{ 3 GI4 -> 3 4 5 6 }T -T{ 5 GI4 -> 5 6 }T -T{ 6 GI4 -> 6 7 }T - -T{ : GI5 BEGIN DUP 2 > WHILE DUP 5 < WHILE DUP 1+ REPEAT 123 ELSE 345 THEN ; -> }T -T{ 1 GI5 -> 1 345 }T -T{ 2 GI5 -> 2 345 }T -T{ 3 GI5 -> 3 4 5 123 }T -T{ 4 GI5 -> 4 5 123 }T -T{ 5 GI5 -> 5 123 }T - -T{ : GI6 ( N -- 0,1,..N ) DUP IF DUP >R 1- RECURSE R> THEN ; -> }T -T{ 0 GI6 -> 0 }T -T{ 1 GI6 -> 0 1 }T -T{ 2 GI6 -> 0 1 2 }T -T{ 3 GI6 -> 0 1 2 3 }T -T{ 4 GI6 -> 0 1 2 3 4 }T - -\ ------------------------------------------------------------------------ -TESTING DO LOOP +LOOP I J UNLOOP LEAVE EXIT - -T{ : GD1 DO I LOOP ; -> }T -T{ 4 1 GD1 -> 1 2 3 }T -T{ 2 -1 GD1 -> -1 0 1 }T -T{ MID-UINT+1 MID-UINT GD1 -> MID-UINT }T - -T{ : GD2 DO I -1 +LOOP ; -> }T -T{ 1 4 GD2 -> 4 3 2 1 }T -T{ -1 2 GD2 -> 2 1 0 -1 }T -T{ MID-UINT MID-UINT+1 GD2 -> MID-UINT+1 MID-UINT }T - -T{ : GD3 DO 1 0 DO J LOOP LOOP ; -> }T -T{ 4 1 GD3 -> 1 2 3 }T -T{ 2 -1 GD3 -> -1 0 1 }T -T{ MID-UINT+1 MID-UINT GD3 -> MID-UINT }T - -T{ : GD4 DO 1 0 DO J LOOP -1 +LOOP ; -> }T -T{ 1 4 GD4 -> 4 3 2 1 }T -T{ -1 2 GD4 -> 2 1 0 -1 }T -T{ MID-UINT MID-UINT+1 GD4 -> MID-UINT+1 MID-UINT }T - -T{ : GD5 123 SWAP 0 DO I 4 > IF DROP 234 LEAVE THEN LOOP ; -> }T -T{ 1 GD5 -> 123 }T -T{ 5 GD5 -> 123 }T -T{ 6 GD5 -> 234 }T - -T{ : GD6 ( PAT: T{0 0}T,T{0 0}TT{1 0}TT{1 1}T,T{0 0}TT{1 0}TT{1 1}TT{2 0}TT{2 1}TT{2 2}T ) - 0 SWAP 0 DO - I 1+ 0 DO I J + 3 = IF I UNLOOP I UNLOOP EXIT THEN 1+ LOOP - LOOP ; -> }T -T{ 1 GD6 -> 1 }T -T{ 2 GD6 -> 3 }T -T{ 3 GD6 -> 4 1 2 }T - -\ ------------------------------------------------------------------------ -TESTING DEFINING WORDS: : ; CONSTANT VARIABLE CREATE DOES> >BODY - -T{ 123 CONSTANT X123 -> }T -T{ X123 -> 123 }T -T{ : EQU CONSTANT ; -> }T -T{ X123 EQU Y123 -> }T -T{ Y123 -> 123 }T - -T{ VARIABLE V1 -> }T -T{ 123 V1 ! -> }T -T{ V1 @ -> 123 }T - -T{ : NOP : POSTPONE ; ; -> }T -T{ NOP NOP1 NOP NOP2 -> }T -T{ NOP1 -> }T -T{ NOP2 -> }T - -T{ : DOES1 DOES> @ 1 + ; -> }T -T{ : DOES2 DOES> @ 2 + ; -> }T -T{ CREATE CR1 -> }T -T{ CR1 -> HERE }T -T{ ' CR1 >BODY -> HERE }T -T{ 1 , -> }T -T{ CR1 @ -> 1 }T -T{ DOES1 -> }T -T{ CR1 -> 2 }T -T{ DOES2 -> }T -T{ CR1 -> 3 }T - -T{ : WEIRD: CREATE DOES> 1 + DOES> 2 + ; -> }T -T{ WEIRD: W1 -> }T -T{ ' W1 >BODY -> HERE }T -T{ W1 -> HERE 1 + }T -T{ W1 -> HERE 2 + }T - -\ ------------------------------------------------------------------------ -TESTING EVALUATE - -: GE1 S" 123" ; IMMEDIATE -: GE2 S" 123 1+" ; IMMEDIATE -: GE3 S" : GE4 345 ;" ; -: GE5 EVALUATE ; IMMEDIATE - -T{ GE1 EVALUATE -> 123 }T ( TEST EVALUATE IN INTERP. STATE ) -T{ GE2 EVALUATE -> 124 }T -T{ GE3 EVALUATE -> }T -T{ GE4 -> 345 }T - -T{ : GE6 GE1 GE5 ; -> }T ( TEST EVALUATE IN COMPILE STATE ) -T{ GE6 -> 123 }T -T{ : GE7 GE2 GE5 ; -> }T -T{ GE7 -> 124 }T - -\ ------------------------------------------------------------------------ -TESTING SOURCE >IN WORD - -: GS1 S" SOURCE" 2DUP EVALUATE - >R SWAP >R = R> R> = ; -T{ GS1 -> }T - -VARIABLE SCANS -: RESCAN? -1 SCANS +! SCANS @ IF 0 >IN ! THEN ; - -T{ 2 SCANS ! -345 RESCAN? --> 345 345 }T - -: GS2 5 SCANS ! S" 123 RESCAN?" EVALUATE ; -T{ GS2 -> 123 123 123 123 123 }T - -: GS3 WORD COUNT SWAP C@ ; -T{ BL GS3 HELLO -> 5 CHAR H }T -T{ CHAR " GS3 GOODBYE" -> 7 CHAR G }T -T{ BL GS3 -DROP -> 0 }T \ BLANK LINE RETURN ZERO-LENGTH STRING - -: GS4 SOURCE >IN ! DROP ; -T{ GS4 123 456 --> }T - -\ ------------------------------------------------------------------------ -TESTING <# # #S #> HOLD SIGN BASE >NUMBER HEX DECIMAL - -: S= \ ( ADDR1 C1 ADDR2 C2 -- T/F ) COMPARE TWO STRINGS. - >R SWAP R@ = IF \ MAKE SURE STRINGS HAVE SAME LENGTH - R> ?DUP IF \ IF NON-EMPTY STRINGS - 0 DO - OVER C@ OVER C@ - IF 2DROP UNLOOP EXIT THEN - SWAP CHAR+ SWAP CHAR+ - LOOP - THEN - 2DROP \ IF WE GET HERE, STRINGS MATCH - ELSE - R> DROP 2DROP \ LENGTHS MISMATCH - THEN ; - -: GP1 <# 41 HOLD 42 HOLD 0 0 #> S" BA" S= ; -T{ GP1 -> }T - -: GP2 <# -1 SIGN 0 SIGN -1 SIGN 0 0 #> S" --" S= ; -T{ GP2 -> }T - -: GP3 <# 1 0 # # #> S" 01" S= ; -T{ GP3 -> }T - -: GP4 <# 1 0 #S #> S" 1" S= ; -T{ GP4 -> }T - -24 CONSTANT MAX-BASE \ BASE 2 .. 36 -: COUNT-BITS - 0 0 INVERT BEGIN DUP WHILE >R 1+ R> 2* REPEAT DROP ; -COUNT-BITS 2* CONSTANT #BITS-UD \ NUMBER OF BITS IN UD - -: GP5 - BASE @ - MAX-BASE 1+ 2 DO \ FOR EACH POSSIBLE BASE - I BASE ! \ TBD: ASSUMES BASE WORKS - I 0 <# #S #> S" 10" S= AND - LOOP - SWAP BASE ! ; -T{ GP5 -> }T - -: GP6 - BASE @ >R 2 BASE ! - MAX-UINT MAX-UINT <# #S #> \ MAXIMUM UD TO BINARY - R> BASE ! \ S: C-ADDR U - DUP #BITS-UD = SWAP - 0 DO \ S: C-ADDR FLAG - OVER C@ [CHAR] 1 = AND \ ALL ONES - >R CHAR+ R> - LOOP SWAP DROP ; -T{ GP6 -> }T - -: GP7 - BASE @ >R MAX-BASE BASE ! - - A 0 DO - I 0 <# #S #> - 1 = SWAP C@ I 30 + = AND AND - LOOP - MAX-BASE A DO - I 0 <# #S #> - 1 = SWAP C@ 41 I A - + = AND AND - LOOP - R> BASE ! ; - -T{ GP7 -> }T - -\ >NUMBER TESTS -CREATE GN-BUF 0 C, -: GN-STRING GN-BUF 1 ; -: GN-CONSUMED GN-BUF CHAR+ 0 ; -: GN' [CHAR] ' WORD CHAR+ C@ GN-BUF C! GN-STRING ; - -T{ 0 0 GN' 0' >NUMBER -> 0 0 GN-CONSUMED }T -T{ 0 0 GN' 1' >NUMBER -> 1 0 GN-CONSUMED }T -T{ 1 0 GN' 1' >NUMBER -> BASE @ 1+ 0 GN-CONSUMED }T -T{ 0 0 GN' -' >NUMBER -> 0 0 GN-STRING }T \ SHOULD FAIL TO CONVERT THESE -T{ 0 0 GN' +' >NUMBER -> 0 0 GN-STRING }T -T{ 0 0 GN' .' >NUMBER -> 0 0 GN-STRING }T - -: >NUMBER-BASED - BASE @ >R BASE ! >NUMBER R> BASE ! ; - -T{ 0 0 GN' 2' 10 >NUMBER-BASED -> 2 0 GN-CONSUMED }T -T{ 0 0 GN' 2' 2 >NUMBER-BASED -> 0 0 GN-STRING }T -T{ 0 0 GN' F' 10 >NUMBER-BASED -> F 0 GN-CONSUMED }T -T{ 0 0 GN' G' 10 >NUMBER-BASED -> 0 0 GN-STRING }T -T{ 0 0 GN' G' MAX-BASE >NUMBER-BASED -> 10 0 GN-CONSUMED }T -T{ 0 0 GN' Z' MAX-BASE >NUMBER-BASED -> 23 0 GN-CONSUMED }T - -: GN1 \ ( UD BASE -- UD' LEN ) UD SHOULD EQUAL UD' AND LEN SHOULD BE ZERO. - BASE @ >R BASE ! - <# #S #> - 0 0 2SWAP >NUMBER SWAP DROP \ RETURN LENGTH ONLY - R> BASE ! ; -T{ 0 0 2 GN1 -> 0 0 0 }T -T{ MAX-UINT 0 2 GN1 -> MAX-UINT 0 0 }T -T{ MAX-UINT DUP 2 GN1 -> MAX-UINT DUP 0 }T -T{ 0 0 MAX-BASE GN1 -> 0 0 0 }T -T{ MAX-UINT 0 MAX-BASE GN1 -> MAX-UINT 0 0 }T -T{ MAX-UINT DUP MAX-BASE GN1 -> MAX-UINT DUP 0 }T - -: GN2 \ ( -- 16 10 ) - BASE @ >R HEX BASE @ DECIMAL BASE @ R> BASE ! ; -T{ GN2 -> 10 A }T - -\ ------------------------------------------------------------------------ -TESTING FILL MOVE - -CREATE FBUF 00 C, 00 C, 00 C, -CREATE SBUF 12 C, 34 C, 56 C, -: SEEBUF FBUF C@ FBUF CHAR+ C@ FBUF CHAR+ CHAR+ C@ ; - -T{ FBUF 0 20 FILL -> }T -T{ SEEBUF -> 00 00 00 }T - -T{ FBUF 1 20 FILL -> }T -T{ SEEBUF -> 20 00 00 }T - -T{ FBUF 3 20 FILL -> }T -T{ SEEBUF -> 20 20 20 }T - -T{ FBUF FBUF 3 CHARS MOVE -> }T \ BIZARRE SPECIAL CASE -T{ SEEBUF -> 20 20 20 }T - -T{ SBUF FBUF 0 CHARS MOVE -> }T -T{ SEEBUF -> 20 20 20 }T - -T{ SBUF FBUF 1 CHARS MOVE -> }T -T{ SEEBUF -> 12 20 20 }T - -T{ SBUF FBUF 3 CHARS MOVE -> }T -T{ SEEBUF -> 12 34 56 }T - -T{ FBUF FBUF CHAR+ 2 CHARS MOVE -> }T -T{ SEEBUF -> 12 12 34 }T - -T{ FBUF CHAR+ FBUF 2 CHARS MOVE -> }T -T{ SEEBUF -> 12 34 34 }T - -\ ------------------------------------------------------------------------ -TESTING OUTPUT: . ." CR EMIT SPACE SPACES TYPE U. - -: OUTPUT-TEST - ." YOU SHOULD SEE THE STANDARD GRAPHIC CHARACTERS:" CR - 41 BL DO I EMIT LOOP CR - 61 41 DO I EMIT LOOP CR - 7F 61 DO I EMIT LOOP CR - ." YOU SHOULD SEE 0-9 SEPARATED BY A SPACE:" CR - 9 1+ 0 DO I . LOOP CR - ." YOU SHOULD SEE 0-9 (WITH NO SPACES):" CR - [CHAR] 9 1+ [CHAR] 0 DO I 0 SPACES EMIT LOOP CR - ." YOU SHOULD SEE A-G SEPARATED BY A SPACE:" CR - [CHAR] G 1+ [CHAR] A DO I EMIT SPACE LOOP CR - ." YOU SHOULD SEE 0-5 SEPARATED BY TWO SPACES:" CR - 5 1+ 0 DO I [CHAR] 0 + EMIT 2 SPACES LOOP CR - ." YOU SHOULD SEE TWO SEPARATE LINES:" CR - S" LINE 1" TYPE CR S" LINE 2" TYPE CR - ." YOU SHOULD SEE THE NUMBER RANGES OF SIGNED AND UNSIGNED NUMBERS:" CR - ." SIGNED: " MIN-INT . MAX-INT . CR - ." UNSIGNED: " 0 U. MAX-UINT U. CR -; - -T{ OUTPUT-TEST -> }T - - -\ ------------------------------------------------------------------------ -TESTING INPUT: ACCEPT - -CREATE ABUF 80 CHARS ALLOT - -: ACCEPT-TEST - CR ." PLEASE TYPE UP TO 80 CHARACTERS:" CR - ABUF 80 ACCEPT - CR ." RECEIVED: " [CHAR] " EMIT - ABUF SWAP TYPE [CHAR] " EMIT CR -; - -T{ ACCEPT-TEST -> }T - -\ ------------------------------------------------------------------------ -TESTING DICTIONARY SEARCH RULES - -T{ : GDX 123 ; : GDX GDX 234 ; -> }T - -T{ GDX -> 123 234 }T - -CR .( End of Core word set tests) CR - - diff --git a/amforth-6.5/common/lib/forth2012/tester/coreexttest.fth b/amforth-6.5/common/lib/forth2012/tester/coreexttest.fth deleted file mode 100644 index a7de63d..0000000 --- a/amforth-6.5/common/lib/forth2012/tester/coreexttest.fth +++ /dev/null @@ -1,322 +0,0 @@ -\ To test some of the ANS Forth Core Extension word set - -\ This program was written by Gerry Jackson in 2006, with contributions from -\ others where indicated, and is in the public domain - it can be distributed -\ and/or modified in any way but please retain this notice. - -\ This program is distributed in the hope that it will be useful, -\ but WITHOUT ANY WARRANTY; without even the implied warranty of -\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. - -\ The tests are not claimed to be comprehensive or correct - -\ ------------------------------------------------------------------------------ -\ Version 0.6 1 April 2012 Tests placed in the public domain. -\ SAVE-INPUT & RESTORE-INPUT tests, position -\ of T{ moved so that tests work with ttester.fs -\ CONVERT test deleted - obsolete word removed from Forth 200X -\ IMMEDIATE VALUEs tested -\ RECURSE with :NONAME tested -\ PARSE and .( tested -\ Parsing behaviour of C" added -\ 0.5 14 September 2011 Removed the double [ELSE] from the -\ initial SAVE-INPUT & RESTORE-INPUT test -\ 0.4 30 November 2009 max-int replaced with max-intx to -\ avoid redefinition warnings. -\ 0.3 6 March 2009 { and } replaced with T{ and }T -\ CONVERT test now independent of cell size -\ 0.2 20 April 2007 ANS Forth words changed to upper case -\ Tests qd3 to qd6 by Reinhold Straub -\ 0.1 Oct 2006 First version released -\ ------------------------------------------------------------------------------ -\ This is only a partial test of the core extension words. -\ The tests are based on John Hayes test program for the core word set - -\ Words tested in this file are: -\ TRUE FALSE :NONAME ?DO VALUE TO CASE OF ENDOF ENDCASE PARSE -\ C" CONVERT COMPILE, [COMPILE] SAVE-INPUT RESTORE-INPUT .( -\ ------------------------------------------------------------------------------ -\ Assumptions: -\ - tester.fr or ttester.fs has been included prior to this file -\ ------------------------------------------------------------------------------ -TESTING Core Extension words - -DECIMAL - -0 INVERT 1 RSHIFT CONSTANT max-intx \ 01...1 - - -TESTING TRUE FALSE - -T{ TRUE -> 0 INVERT }T -T{ FALSE -> 0 }T - -\ ------------------------------------------------------------------------------ -TESTING :NONAME with and without RECURSEs - -VARIABLE nn1 -VARIABLE nn2 -:NONAME 1234 ; nn1 ! -:NONAME 9876 ; nn2 ! -T{ nn1 @ EXECUTE -> 1234 }T -T{ nn2 @ EXECUTE -> 9876 }T - -T{ :NONAME ( n -- 0,1,..n ) DUP IF DUP >R 1- RECURSE R> THEN ; - CONSTANT rn1 -> }T -T{ 0 rn1 EXECUTE -> 0 }T -T{ 4 rn1 EXECUTE -> 0 1 2 3 4 }T - -:NONAME ( n -- n1 ) \ Multiple RECURSEs in one definition - 1- DUP - CASE 0 OF EXIT ENDOF - 1 OF 11 SWAP RECURSE ENDOF - 2 OF 22 SWAP RECURSE ENDOF - 3 OF 33 SWAP RECURSE ENDOF - DROP ABS RECURSE EXIT - ENDCASE -; CONSTANT rn2 - -T{ 1 rn2 EXECUTE -> 0 }T -T{ 2 rn2 EXECUTE -> 11 0 }T -T{ 4 rn2 EXECUTE -> 33 22 11 0 }T -T{ 25 rn2 EXECUTE -> 33 22 11 0 }T - -\ ------------------------------------------------------------------------------ -TESTING ?DO - -: qd ?DO I LOOP ; -T{ 789 789 qd -> }T -T{ -9876 -9876 qd -> }T -T{ 5 0 qd -> 0 1 2 3 4 }T - -: qd1 ?DO I 10 +LOOP ; -T{ 50 1 qd1 -> 1 11 21 31 41 }T -T{ 50 0 qd1 -> 0 10 20 30 40 }T - -: qd2 ?DO I 3 > IF LEAVE ELSE I THEN LOOP ; -T{ 5 -1 qd2 -> -1 0 1 2 3 }T - -: qd3 ?DO I 1 +LOOP ; -T{ 4 4 qd3 -> }T -T{ 4 1 qd3 -> 1 2 3 }T -T{ 2 -1 qd3 -> -1 0 1 }T - -: qd4 ?DO I -1 +LOOP ; -T{ 4 4 qd4 -> }T -T{ 1 4 qd4 -> 4 3 2 1 }T -T{ -1 2 qd4 -> 2 1 0 -1 }T - -: qd5 ?DO I -10 +LOOP ; -T{ 1 50 qd5 -> 50 40 30 20 10 }T -T{ 0 50 qd5 -> 50 40 30 20 10 0 }T -T{ -25 10 qd5 -> 10 0 -10 -20 }T - -VARIABLE iters -VARIABLE incrmnt - -: qd6 ( limit start increment -- ) - incrmnt ! - 0 iters ! - ?DO - 1 iters +! - I - iters @ 6 = IF LEAVE THEN - incrmnt @ - +LOOP iters @ -; - -T{ 4 4 -1 qd6 -> 0 }T -T{ 1 4 -1 qd6 -> 4 3 2 1 4 }T -T{ 4 1 -1 qd6 -> 1 0 -1 -2 -3 -4 6 }T -T{ 4 1 0 qd6 -> 1 1 1 1 1 1 6 }T -T{ 0 0 0 qd6 -> 0 }T -T{ 1 4 0 qd6 -> 4 4 4 4 4 4 6 }T -T{ 1 4 1 qd6 -> 4 5 6 7 8 9 6 }T -T{ 4 1 1 qd6 -> 1 2 3 3 }T -T{ 4 4 1 qd6 -> 0 }T -T{ 2 -1 -1 qd6 -> -1 -2 -3 -4 -5 -6 6 }T -T{ -1 2 -1 qd6 -> 2 1 0 -1 4 }T -T{ 2 -1 0 qd6 -> -1 -1 -1 -1 -1 -1 6 }T -T{ -1 2 0 qd6 -> 2 2 2 2 2 2 6 }T -T{ -1 2 1 qd6 -> 2 3 4 5 6 7 6 }T -T{ 2 -1 1 qd6 -> -1 0 1 3 }T - -\ ------------------------------------------------------------------------------ -TESTING VALUE TO - -T{ 111 VALUE val1 -999 VALUE val2 -> }T -T{ val1 -> 111 }T -T{ val2 -> -999 }T -T{ 222 TO val1 -> }T -T{ val1 -> 222 }T -T{ : vd1 val1 ; -> }T -T{ vd1 -> 222 }T -T{ : vd2 TO val2 ; -> }T -T{ val2 -> -999 }T -T{ -333 vd2 -> }T -T{ val2 -> -333 }T -T{ val1 -> 222 }T -T{ 123 VALUE val3 IMMEDIATE val3 -> 123 }T -T{ : vd3 val3 LITERAL ; vd3 -> 123 }T - -\ ------------------------------------------------------------------------------ -TESTING CASE OF ENDOF ENDCASE - -: cs1 CASE 1 OF 111 ENDOF - 2 OF 222 ENDOF - 3 OF 333 ENDOF - >R 999 R> - ENDCASE -; - -T{ 1 cs1 -> 111 }T -T{ 2 cs1 -> 222 }T -T{ 3 cs1 -> 333 }T -T{ 4 cs1 -> 999 }T - -: cs2 >R CASE -1 OF CASE R@ 1 OF 100 ENDOF - 2 OF 200 ENDOF - >R -300 R> - ENDCASE - ENDOF - -2 OF CASE R@ 1 OF -99 ENDOF - >R -199 R> - ENDCASE - ENDOF - >R 299 R> - ENDCASE R> DROP -; - -T{ -1 1 cs2 -> 100 }T -T{ -1 2 cs2 -> 200 }T -T{ -1 3 cs2 -> -300 }T -T{ -2 1 cs2 -> -99 }T -T{ -2 2 cs2 -> -199 }T -T{ 0 2 cs2 -> 299 }T - -\ ------------------------------------------------------------------------------ -TESTING C" - -T{ : cq1 C" 123" ; -> }T -T{ cq1 COUNT EVALUATE -> 123 }T -T{ : cq2 C" " ; -> }T -T{ cq2 COUNT EVALUATE -> }T -T{ : cq3 C" 2345"COUNT EVALUATE ; cq3 -> 2345 }T - -\ ------------------------------------------------------------------------------ -TESTING COMPILE, [COMPILE] - -:NONAME DUP + ; CONSTANT dup+ -T{ : q dup+ COMPILE, ; -> }T -T{ : as1 [ q ] ; -> }T -T{ 123 as1 -> 246 }T - -T{ : [c1] [COMPILE] DUP ; IMMEDIATE -> }T -T{ 123 [c1] -> 123 123 }T \ With default compilation semantics -T{ : [c2] [COMPILE] [c1] ; -> }T -T{ 234 [c2] -> 234 234 }T \ With an immediate word -T{ : [cif] [COMPILE] IF ; IMMEDIATE -> }T -T{ : [c3] [cif] 111 ELSE 222 THEN ; -> }T \ With special compilation semantics -T{ -1 [c3] -> 111 }T -T{ 0 [c3] -> 222 }T - -\ ------------------------------------------------------------------------------ -\ Cannot automatically test SAVE-INPUT and RESTORE-INPUT from a console source - -TESTING SAVE-INPUT and RESTORE-INPUT with a file source - -VARIABLE siv -1 siv ! - -: NeverExecuted - ." This should never be executed" ABORT -; - -T{ 11111 SAVE-INPUT - -siv @ - -[IF] - 0 siv ! - RESTORE-INPUT - NeverExecuted -[ELSE] - -TESTING the -[ELSE]- part is executed -22222 - -[THEN] - - -> 11111 0 22222 }T \ 0 comes from RESTORE-INPUT - -TESTING SAVE-INPUT and RESTORE-INPUT with a string source - -VARIABLE si_inc 0 si_inc ! - -: si1 - si_inc @ >IN +! - 15 si_inc ! -; - -: s$ S" SAVE-INPUT si1 RESTORE-INPUT 12345" ; - -T{ s$ EVALUATE si_inc @ -> 0 2345 15 }T - -TESTING nested SAVE-INPUT and RESTORE-INPUT - -: read_a_line - REFILL 0= - ABORT" REFILL failed" -; - -0 si_inc ! - -2VARIABLE 2res -1. 2res 2! - -: si2 - read_a_line - read_a_line - SAVE-INPUT - read_a_line - read_a_line - s$ EVALUATE 2res 2! - RESTORE-INPUT -; - -\ WARNING: do not delete or insert lines of text after si2 is called -\ otherwise the next test will fail - -T{ si2 -33333 \ This line should be ignored -2res 2@ 44444 \ RESTORE-INPUT should return to this line - -55555 -TESTING the nested results - -> 0 0 2345 44444 55555 }T - -\ End of warning - -\ ------------------------------------------------------------------------------ -TESTING .( - -T{ S" A string"2DROP -> }T -T{ CR .( You should see -9876: ) -9876 . -> }T -T{ CR .( Repeated: ).( -9876)CR -> }T - -\ ------------------------------------------------------------------------------ -TESTING PARSE - -T{ CHAR | PARSE 1234| DUP ROT ROT EVALUATE -> 4 1234 }T -T{ CHAR ^ PARSE 23 45 ^ DUP ROT ROT EVALUATE -> 7 23 45 }T -: pa1 [CHAR] $ PARSE DUP >R PAD SWAP CHARS MOVE PAD R> ; -T{ pa1 3456 - DUP ROT ROT EVALUATE -> 4 3456 }T -T{ CHAR a PARSE a SWAP DROP -> 0 }T -T{ CHAR z PARSE - SWAP DROP -> 0 }T -T{ CHAR " PARSE 4567 "DUP ROT ROT EVALUATE -> 5 4567 }T - -\ ------------------------------------------------------------------------------ - -CR .( End of Core Extension word tests) CR - - diff --git a/amforth-6.5/common/lib/forth2012/tester/coreplustest.fth b/amforth-6.5/common/lib/forth2012/tester/coreplustest.fth deleted file mode 100644 index ff165d4..0000000 --- a/amforth-6.5/common/lib/forth2012/tester/coreplustest.fth +++ /dev/null @@ -1,190 +0,0 @@ -\ Additional tests on the the ANS Forth Core word set - -\ This program was written by Gerry Jackson in 2007, with contributions from -\ others where indicated, and is in the public domain - it can be distributed -\ and/or modified in any way but please retain this notice. - -\ This program is distributed in the hope that it will be useful, -\ but WITHOUT ANY WARRANTY; without even the implied warranty of -\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. - -\ The tests are not claimed to be comprehensive or correct - -\ ------------------------------------------------------------------------------ -\ Version 0.3 1 April 2012 Tests placed in the public domain. -\ Testing multiple ELSE's. -\ Further tests on DO +LOOPs. -\ Ackermann function added to test RECURSE. -\ >IN manipulation in interpreter mode -\ Immediate CONSTANTs, VARIABLEs and CREATEd words tests. -\ :NONAME with RECURSE moved to core extension tests. -\ Parsing behaviour of S" ." and ( tested -\ 0.2 6 March 2009 { and } replaced with T{ and }T -\ Added extra RECURSE tests -\ 0.1 20 April 2007 Created -\ ------------------------------------------------------------------------------ -\ The tests are based on John Hayes test program for the core word set -\ -\ This file provides some more tests on Core words where the original Hayes -\ tests are thought to be incomplete -\ -\ Words tested in this file are: -\ DO +LOOP RECURSE ELSE >IN IMMEDIATE -\ ------------------------------------------------------------------------------ -\ Assumptions and dependencies: -\ - tester.fr or ttester.fs has been loaded prior to this file -\ - core.fr has been loaded so that constants MAX-INT, MIN-INT and -\ MAX-UINT are defined -\ ------------------------------------------------------------------------------ - -DECIMAL - -TESTING DO +LOOP with run-time increment, negative increment, infinite loop -\ Contributed by Reinhold Straub - -VARIABLE iterations -VARIABLE increment -: gd7 ( limit start increment -- ) - increment ! - 0 iterations ! - DO - 1 iterations +! - I - iterations @ 6 = IF LEAVE THEN - increment @ - +LOOP iterations @ -; - -T{ 4 4 -1 gd7 -> 4 1 }T -T{ 1 4 -1 gd7 -> 4 3 2 1 4 }T -T{ 4 1 -1 gd7 -> 1 0 -1 -2 -3 -4 6 }T -T{ 4 1 0 gd7 -> 1 1 1 1 1 1 6 }T -T{ 0 0 0 gd7 -> 0 0 0 0 0 0 6 }T -T{ 1 4 0 gd7 -> 4 4 4 4 4 4 6 }T -T{ 1 4 1 gd7 -> 4 5 6 7 8 9 6 }T -T{ 4 1 1 gd7 -> 1 2 3 3 }T -T{ 4 4 1 gd7 -> 4 5 6 7 8 9 6 }T -T{ 2 -1 -1 gd7 -> -1 -2 -3 -4 -5 -6 6 }T -T{ -1 2 -1 gd7 -> 2 1 0 -1 4 }T -T{ 2 -1 0 gd7 -> -1 -1 -1 -1 -1 -1 6 }T -T{ -1 2 0 gd7 -> 2 2 2 2 2 2 6 }T -T{ -1 2 1 gd7 -> 2 3 4 5 6 7 6 }T -T{ 2 -1 1 gd7 -> -1 0 1 3 }T -T{ -20 30 -10 gd7 -> 30 20 10 0 -10 -20 6 }T -T{ -20 31 -10 gd7 -> 31 21 11 1 -9 -19 6 }T -T{ -20 29 -10 gd7 -> 29 19 9 -1 -11 5 }T - -\ ------------------------------------------------------------------------------ -TESTING DO +LOOP with large and small increments - -\ Contributed by Andrew Haley - -MAX-UINT 8 RSHIFT 1+ CONSTANT ustep -ustep NEGATE CONSTANT -ustep -MAX-INT 7 RSHIFT 1+ CONSTANT step -step NEGATE CONSTANT -step - -VARIABLE bump - -T{ : gd8 bump ! DO 1+ bump @ +LOOP ; -> }T - -T{ 0 MAX-UINT 0 ustep gd8 -> 256 }T -T{ 0 0 MAX-UINT -ustep gd8 -> 256 }T - -T{ 0 MAX-INT MIN-INT step gd8 -> 256 }T -T{ 0 MIN-INT MAX-INT -step gd8 -> 256 }T - -\ Two's complement arithmetic, wraps around modulo wordsize -\ Only tested if the Forth system does wrap around, use of conditional -\ compilation deliberately avoided - -MAX-INT 1+ MIN-INT = CONSTANT +wrap? -MIN-INT 1- MAX-INT = CONSTANT -wrap? -MAX-UINT 1+ 0= CONSTANT +uwrap? -0 1- MAX-UINT = CONSTANT -uwrap? - -: gd9 ( n limit start step f result -- ) - >R IF gd8 ELSE 2DROP 2DROP R@ THEN -> R> }T -; - -T{ 0 0 0 ustep +uwrap? 256 gd9 -T{ 0 0 0 -ustep -uwrap? 1 gd9 -T{ 0 MIN-INT MAX-INT step +wrap? 1 gd9 -T{ 0 MAX-INT MIN-INT -step -wrap? 1 gd9 - -\ ------------------------------------------------------------------------------ -TESTING DO +LOOP with maximum and minimum increments - -: (-mi) MAX-INT DUP NEGATE + 0= IF MAX-INT NEGATE ELSE -32767 THEN ; -(-mi) CONSTANT -max-int - -T{ 0 1 0 MAX-INT gd8 -> 1 }T -T{ 0 -max-int NEGATE -max-int OVER gd8 -> 2 }T - -T{ 0 MAX-INT 0 MAX-INT gd8 -> 1 }T -T{ 0 MAX-INT 1 MAX-INT gd8 -> 1 }T -T{ 0 MAX-INT -1 MAX-INT gd8 -> 2 }T -T{ 0 MAX-INT dup 1- MAX-INT gd8 -> 1 }T - -T{ 0 MIN-INT 1+ 0 MIN-INT gd8 -> 1 }T -T{ 0 MIN-INT 1+ -1 MIN-INT gd8 -> 1 }T -T{ 0 MIN-INT 1+ 1 MIN-INT gd8 -> 2 }T -T{ 0 MIN-INT 1+ DUP MIN-INT gd8 -> 1 }T - -\ ------------------------------------------------------------------------------ -TESTING multiple RECURSEs in one colon definition - -: ack ( m n -- u ) \ Ackermann function, from Rosetta Code - OVER 0= IF NIP 1+ EXIT THEN \ ack(0, n) = n+1 - SWAP 1- SWAP ( -- m-1 n ) - DUP 0= IF 1+ RECURSE EXIT THEN \ ack(m, 0) = ack(m-1, 1) - 1- OVER 1+ SWAP RECURSE RECURSE \ ack(m, n) = ack(m-1, ack(m,n-1)) -; - -T{ 0 0 ack -> 1 }T -T{ 3 0 ack -> 5 }T -T{ 2 4 ack -> 11 }T - -\ ------------------------------------------------------------------------------ -TESTING multiple ELSE's in an IF statement -\ Discussed on comp.lang.forth and accepted as valid ANS Forth - -: melse IF 1 ELSE 2 ELSE 3 ELSE 4 ELSE 5 THEN ; -T{ 0 melse -> 2 4 }T -T{ -1 melse -> 1 3 5 }T - -\ ------------------------------------------------------------------------------ -TESTING manipulation of >IN in interpreter mode - -T{ 123456 depth over 9 < 35 and + 3 + >in ! -> 123456 23456 3456 456 56 6 }T -T{ 14145 8115 ?dup 0= 34 and >in +! tuck mod 14 >in ! GCD calculation -> 15 }T - -\ ------------------------------------------------------------------------------ -TESTING IMMEDIATE with CONSTANT VARIABLE and CREATE [ ... DOES> ] - -T{ 123 CONSTANT iw1 IMMEDIATE iw1 -> 123 }T -T{ : iw2 iw1 LITERAL ; iw2 -> 123 }T -T{ VARIABLE iw3 IMMEDIATE 234 iw3 ! iw3 @ -> 234 }T -T{ : iw4 iw3 [ @ ] LITERAL ; iw4 -> 234 }T -T{ :noname [ 345 ] iw3 [ ! ] ; DROP iw3 @ -> 345 }T -T{ CREATE iw5 456 , IMMEDIATE -> }T -T{ :noname iw5 [ @ iw3 ! ] ; DROP iw3 @ -> 456 }T -T{ : iw6 CREATE , IMMEDIATE DOES> @ 1+ ; -> }T -T{ 111 iw6 iw7 iw7 -> 112 }T -T{ : iw8 iw7 LITERAL 1+ ; iw8 -> 113 }T -T{ : iw9 CREATE , DOES> @ 2 + IMMEDIATE ; -> }T -: find-iw bl word find nip ; ( -- 0 | 1 | -1 ) -T{ 222 iw9 iw10 find-iw iw10 -> -1 }T \ iw10 is not immediate -T{ iw10 find-iw iw10 -> 224 1 }T \ iw10 becomes immediate - -\ ------------------------------------------------------------------------------ -TESTING parsing behaviour of S" ." and ( -\ which should parse to just beyond the terminating character no space needed - -T{ S" A string"2DROP -> }T -T{ ( A comment)1234 -> 1234 }T -T{ : pb1 cr ." You should see 2345: "." 2345"( A comment); pb1 -> }T - -\ ------------------------------------------------------------------------------ - -CR .( End of additional Core tests) CR diff --git a/amforth-6.5/common/lib/forth2012/tester/doubletest.fth b/amforth-6.5/common/lib/forth2012/tester/doubletest.fth deleted file mode 100644 index 523b110..0000000 --- a/amforth-6.5/common/lib/forth2012/tester/doubletest.fth +++ /dev/null @@ -1,386 +0,0 @@ -\ To test the ANS Forth Double-Number word set and double number extensions - -\ This program was written by Gerry Jackson in 2006, with contributions from -\ others where indicated, and is in the public domain - it can be distributed -\ and/or modified in any way but please retain this notice. - -\ This program is distributed in the hope that it will be useful, -\ but WITHOUT ANY WARRANTY; without even the implied warranty of -\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. - -\ The tests are not claimed to be comprehensive or correct -\ ------------------------------------------------------------------------------ -\ Version 0.6 1 April 2012 Tests placed in the public domain. -\ Immediate 2CONSTANTs and 2VARIABLEs tested -\ 0.5 20 November 2009 Various constants renamed to avoid -\ redefinition warnings. and replaced -\ with TRUE and FALSE -\ 0.4 6 March 2009 { and } replaced with T{ and }T -\ Tests rewritten to be independent of word size and -\ tests re-ordered -\ 0.3 20 April 2007 ANS Forth words changed to upper case -\ 0.2 30 Oct 2006 Updated following GForth test to include -\ various constants from core.fr -\ 0.1 Oct 2006 First version released -\ ------------------------------------------------------------------------------ -\ The tests are based on John Hayes test program for the core word set - -\ Words tested in this file are: -\ 2CONSTANT 2LITERAL 2VARIABLE D+ D- D. D.R D0< D0= D2* D2/ -\ D< D= D>S DABS DMAX DMIN DNEGATE M*/ M+ 2ROT DU< -\ Also tests the interpreter and compiler reading a double number -\ ------------------------------------------------------------------------------ -\ Assumptions and dependencies: -\ - tester.fr or ttester.fs has been included prior to this file -\ - core words and core extension words have been tested -\ ------------------------------------------------------------------------------ -\ Constant definitions - -DECIMAL -0 INVERT CONSTANT 1sd -1sd 1 RSHIFT CONSTANT max-intd \ 01...1 -max-intd INVERT CONSTANT min-intd \ 10...0 -max-intd 2/ CONSTANT hi-int \ 001...1 -min-intd 2/ CONSTANT lo-int \ 110...1 - -\ ------------------------------------------------------------------------------ -TESTING interpreter and compiler reading a double number - -T{ 1. -> 1 0 }T -T{ -2. -> -2 -1 }T -T{ : rdl1 3. ; rdl1 -> 3 0 }T -T{ : rdl2 -4. ; rdl2 -> -4 -1 }T - -\ ------------------------------------------------------------------------------ -TESTING 2CONSTANT - -T{ 1 2 2CONSTANT 2c1 -> }T -T{ 2c1 -> 1 2 }T -T{ : cd1 2c1 ; -> }T -T{ cd1 -> 1 2 }T -T{ : cd2 2CONSTANT ; -> }T -T{ -1 -2 cd2 2c2 -> }T -T{ 2c2 -> -1 -2 }T -T{ 4 5 2CONSTANT 2c3 IMMEDIATE 2c3 -> 4 5 }T -T{ : cd6 2c3 2LITERAL ; cd6 -> 4 5 }T - -\ ------------------------------------------------------------------------------ -\ Some 2CONSTANTs for the following tests - -1sd max-intd 2CONSTANT max-2int \ 01...1 -0 min-intd 2CONSTANT min-2int \ 10...0 -max-2int 2/ 2CONSTANT hi-2int \ 001...1 -min-2int 2/ 2CONSTANT lo-2int \ 110...0 - -\ ------------------------------------------------------------------------------ -TESTING DNEGATE - -T{ 0. DNEGATE -> 0. }T -T{ 1. DNEGATE -> -1. }T -T{ -1. DNEGATE -> 1. }T -T{ max-2int DNEGATE -> min-2int SWAP 1+ SWAP }T -T{ min-2int SWAP 1+ SWAP DNEGATE -> max-2int }T - -\ ------------------------------------------------------------------------------ -TESTING D+ with small integers - -T{ 0. 5. D+ -> 5. }T -T{ -5. 0. D+ -> -5. }T -T{ 1. 2. D+ -> 3. }T -T{ 1. -2. D+ -> -1. }T -T{ -1. 2. D+ -> 1. }T -T{ -1. -2. D+ -> -3. }T -T{ -1. 1. D+ -> 0. }T - -TESTING D+ with mid range integers - -T{ 0 0 0 5 D+ -> 0 5 }T -T{ -1 5 0 0 D+ -> -1 5 }T -T{ 0 0 0 -5 D+ -> 0 -5 }T -T{ 0 -5 -1 0 D+ -> -1 -5 }T -T{ 0 1 0 2 D+ -> 0 3 }T -T{ -1 1 0 -2 D+ -> -1 -1 }T -T{ 0 -1 0 2 D+ -> 0 1 }T -T{ 0 -1 -1 -2 D+ -> -1 -3 }T -T{ -1 -1 0 1 D+ -> -1 0 }T -T{ min-intd 0 2DUP D+ -> 0 1 }T -T{ min-intd S>D min-intd 0 D+ -> 0 0 }T - -TESTING D+ with large double integers - -T{ hi-2int 1. D+ -> 0 hi-int 1+ }T -T{ hi-2int 2DUP D+ -> 1sd 1- max-intd }T -T{ max-2int min-2int D+ -> -1. }T -T{ max-2int lo-2int D+ -> hi-2int }T -T{ hi-2int min-2int D+ 1. D+ -> lo-2int }T -T{ lo-2int 2DUP D+ -> min-2int }T - -\ ------------------------------------------------------------------------------ -TESTING D- with small integers - -T{ 0. 5. D- -> -5. }T -T{ 5. 0. D- -> 5. }T -T{ 0. -5. D- -> 5. }T -T{ 1. 2. D- -> -1. }T -T{ 1. -2. D- -> 3. }T -T{ -1. 2. D- -> -3. }T -T{ -1. -2. D- -> 1. }T -T{ -1. -1. D- -> 0. }T - -TESTING D- with mid-range integers - -T{ 0 0 0 5 D- -> 0 -5 }T -T{ -1 5 0 0 D- -> -1 5 }T -T{ 0 0 -1 -5 D- -> 1 4 }T -T{ 0 -5 0 0 D- -> 0 -5 }T -T{ -1 1 0 2 D- -> -1 -1 }T -T{ 0 1 -1 -2 D- -> 1 2 }T -T{ 0 -1 0 2 D- -> 0 -3 }T -T{ 0 -1 0 -2 D- -> 0 1 }T -T{ 0 0 0 1 D- -> 0 -1 }T -T{ min-intd 0 2DUP D- -> 0. }T -T{ min-intd S>D max-intd 0 D- -> 1 1sd }T - -TESTING D- with large integers - -T{ max-2int max-2int D- -> 0. }T -T{ min-2int min-2int D- -> 0. }T -T{ max-2int hi-2int D- -> lo-2int DNEGATE }T -T{ hi-2int lo-2int D- -> max-2int }T -T{ lo-2int hi-2int D- -> min-2int 1. D+ }T -T{ min-2int min-2int D- -> 0. }T -T{ min-2int lo-2int D- -> lo-2int }T - -\ ------------------------------------------------------------------------------ -TESTING D0< D0= - -T{ 0. D0< -> FALSE }T -T{ 1. D0< -> FALSE }T -T{ min-intd 0 D0< -> FALSE }T -T{ 0 max-intd D0< -> FALSE }T -T{ max-2int D0< -> FALSE }T -T{ -1. D0< -> TRUE }T -T{ min-2int D0< -> TRUE }T - -T{ 1. D0= -> FALSE }T -T{ min-intd 0 D0= -> FALSE }T -T{ max-2int D0= -> FALSE }T -T{ -1 max-intd D0= -> FALSE }T -T{ 0. D0= -> TRUE }T -T{ -1. D0= -> FALSE }T -T{ 0 min-intd D0= -> FALSE }T - -\ ------------------------------------------------------------------------------ -TESTING D2* D2/ - -T{ 0. D2* -> 0. D2* }T -T{ min-intd 0 D2* -> 0 1 }T -T{ hi-2int D2* -> max-2int 1. D- }T -T{ lo-2int D2* -> min-2int }T - -T{ 0. D2/ -> 0. }T -T{ 1. D2/ -> 0. }T -T{ 0 1 D2/ -> min-intd 0 }T -T{ max-2int D2/ -> hi-2int }T -T{ -1. D2/ -> -1. }T -T{ min-2int D2/ -> lo-2int }T - -\ ------------------------------------------------------------------------------ -TESTING D< D= - -T{ 0. 1. D< -> TRUE }T -T{ 0. 0. D< -> FALSE }T -T{ 1. 0. D< -> FALSE }T -T{ -1. 1. D< -> TRUE }T -T{ -1. 0. D< -> TRUE }T -T{ -2. -1. D< -> TRUE }T -T{ -1. -2. D< -> FALSE }T -T{ -1. max-2int D< -> TRUE }T -T{ min-2int max-2int D< -> TRUE }T -T{ max-2int -1. D< -> FALSE }T -T{ max-2int min-2int D< -> FALSE }T -T{ max-2int 2DUP -1. D+ D< -> FALSE }T -T{ min-2int 2DUP 1. D+ D< -> TRUE }T - -T{ -1. -1. D= -> TRUE }T -T{ -1. 0. D= -> FALSE }T -T{ -1. 1. D= -> FALSE }T -T{ 0. -1. D= -> FALSE }T -T{ 0. 0. D= -> TRUE }T -T{ 0. 1. D= -> FALSE }T -T{ 1. -1. D= -> FALSE }T -T{ 1. 0. D= -> FALSE }T -T{ 1. 1. D= -> TRUE }T - -T{ 0 -1 0 -1 D= -> TRUE }T -T{ 0 -1 0 0 D= -> FALSE }T -T{ 0 -1 0 1 D= -> FALSE }T -T{ 0 0 0 -1 D= -> FALSE }T -T{ 0 0 0 0 D= -> TRUE }T -T{ 0 0 0 1 D= -> FALSE }T -T{ 0 1 0 -1 D= -> FALSE }T -T{ 0 1 0 0 D= -> FALSE }T -T{ 0 1 0 1 D= -> TRUE }T - -T{ max-2int min-2int D= -> FALSE }T -T{ max-2int 0. D= -> FALSE }T -T{ max-2int max-2int D= -> TRUE }T -T{ max-2int hi-2int D= -> FALSE }T -T{ max-2int min-2int D= -> FALSE }T -T{ min-2int min-2int D= -> TRUE }T -T{ min-2int lo-2int D= -> FALSE }T -T{ min-2int max-2int D= -> FALSE }T - -\ ------------------------------------------------------------------------------ -TESTING 2LITERAL 2VARIABLE - -T{ : cd3 [ max-2int ] 2LITERAL ; -> }T -T{ cd3 -> max-2int }T -T{ 2VARIABLE 2v1 -> }T -T{ 0. 2v1 2! -> }T -T{ 2v1 2@ -> 0. }T -T{ -1 -2 2v1 2! -> }T -T{ 2v1 2@ -> -1 -2 }T -T{ : cd4 2VARIABLE ; -> }T -T{ cd4 2v2 -> }T -T{ : cd5 2v2 2! ; -> }T -T{ -2 -1 cd5 -> }T -T{ 2v2 2@ -> -2 -1 }T -T{ 2VARIABLE 2v3 IMMEDIATE 5 6 2v3 2! -> }T -T{ 2v3 2@ -> 5 6 }T -T{ : cd7 2v3 [ 2@ ] 2LITERAL ; cd7 -> 5 6 }T -T{ : cd8 [ 6 7 ] 2v3 [ 2! ] ; 2v3 2@ -> 6 7 }T - -\ ------------------------------------------------------------------------------ -TESTING DMAX DMIN - -T{ 1. 2. DMAX -> 2. }T -T{ 1. 0. DMAX -> 1. }T -T{ 1. -1. DMAX -> 1. }T -T{ 1. 1. DMAX -> 1. }T -T{ 0. 1. DMAX -> 1. }T -T{ 0. -1. DMAX -> 0. }T -T{ -1. 1. DMAX -> 1. }T -T{ -1. -2. DMAX -> -1. }T - -T{ max-2int hi-2int DMAX -> max-2int }T -T{ max-2int min-2int DMAX -> max-2int }T -T{ min-2int max-2int DMAX -> max-2int }T -T{ min-2int lo-2int DMAX -> lo-2int }T - -T{ max-2int 1. DMAX -> max-2int }T -T{ max-2int -1. DMAX -> max-2int }T -T{ min-2int 1. DMAX -> 1. }T -T{ min-2int -1. DMAX -> -1. }T - - -T{ 1. 2. DMIN -> 1. }T -T{ 1. 0. DMIN -> 0. }T -T{ 1. -1. DMIN -> -1. }T -T{ 1. 1. DMIN -> 1. }T -T{ 0. 1. DMIN -> 0. }T -T{ 0. -1. DMIN -> -1. }T -T{ -1. 1. DMIN -> -1. }T -T{ -1. -2. DMIN -> -2. }T - -T{ max-2int hi-2int DMIN -> hi-2int }T -T{ max-2int min-2int DMIN -> min-2int }T -T{ min-2int max-2int DMIN -> min-2int }T -T{ min-2int lo-2int DMIN -> min-2int }T - -T{ max-2int 1. DMIN -> 1. }T -T{ max-2int -1. DMIN -> -1. }T -T{ min-2int 1. DMIN -> min-2int }T -T{ min-2int -1. DMIN -> min-2int }T - -\ ------------------------------------------------------------------------------ -TESTING D>S DABS - -T{ 1234 0 D>S -> 1234 }T -T{ -1234 -1 D>S -> -1234 }T -T{ max-intd 0 D>S -> max-intd }T -T{ min-intd -1 D>S -> min-intd }T - -T{ 1. DABS -> 1. }T -T{ -1. DABS -> 1. }T -T{ max-2int DABS -> max-2int }T -T{ min-2int 1. D+ DABS -> max-2int }T - -\ ------------------------------------------------------------------------------ -TESTING M+ M*/ - -T{ hi-2int 1 M+ -> hi-2int 1. D+ }T -T{ max-2int -1 M+ -> max-2int -1. D+ }T -T{ min-2int 1 M+ -> min-2int 1. D+ }T -T{ lo-2int -1 M+ -> lo-2int -1. D+ }T - -\ To correct the result if the division is floored, only used when -\ necessary i.e. negative quotient and remainder <> 0 - -: ?floored [ -3 2 / -2 = ] LITERAL IF 1. D- THEN ; - -T{ 5. 7 11 M*/ -> 3. }T -T{ 5. -7 11 M*/ -> -3. ?floored }T \ floored -4. -T{ -5. 7 11 M*/ -> -3. ?floored }T \ floored -4. -T{ -5. -7 11 M*/ -> 3. }T -T{ max-2int 8 16 M*/ -> hi-2int }T -T{ max-2int -8 16 M*/ -> hi-2int DNEGATE ?floored }T \ floored subtract 1 -T{ min-2int 8 16 M*/ -> lo-2int }T -T{ min-2int -8 16 M*/ -> lo-2int DNEGATE }T -T{ max-2int max-intd max-intd M*/ -> max-2int }T -T{ max-2int max-intd 2/ max-intd M*/ -> max-intd 1- hi-2int NIP }T -T{ min-2int lo-2int NIP DUP NEGATE M*/ -> min-2int }T -T{ min-2int lo-2int NIP 1- max-intd M*/ -> min-intd 3 + hi-2int NIP 2 + }T -T{ max-2int lo-2int NIP DUP NEGATE M*/ -> max-2int DNEGATE }T -T{ min-2int max-intd DUP M*/ -> min-2int }T - -\ ------------------------------------------------------------------------------ -TESTING D. D.R - -\ Create some large double numbers -max-2int 71 73 M*/ 2CONSTANT dbl1 -min-2int 73 79 M*/ 2CONSTANT dbl2 - -: d>ascii ( d -- caddr u ) - DUP >R <# DABS #S R> SIGN #> ( -- caddr1 u ) - HERE SWAP 2DUP 2>R CHARS DUP ALLOT MOVE 2R> -; - -dbl1 d>ascii 2CONSTANT "dbl1" -dbl2 d>ascii 2CONSTANT "dbl2" - -: DoubleOutput - CR ." You should see lines duplicated:" CR - 5 SPACES "dbl1" TYPE CR - 5 SPACES dbl1 D. CR - 8 SPACES "dbl1" DUP >R TYPE CR - 5 SPACES dbl1 R> 3 + D.R CR - 5 SPACES "dbl2" TYPE CR - 5 SPACES dbl2 D. CR - 10 SPACES "dbl2" DUP >R TYPE CR - 5 SPACES dbl2 R> 5 + D.R CR -; - -T{ DoubleOutput -> }T - -\ ------------------------------------------------------------------------------ -TESTING 2ROT DU< (Double Number extension words) - -T{ 1. 2. 3. 2ROT -> 2. 3. 1. }T -T{ max-2int min-2int 1. 2ROT -> min-2int 1. max-2int }T - -T{ 1. 1. DU< -> FALSE }T -T{ 1. -1. DU< -> TRUE }T -T{ -1. 1. DU< -> FALSE }T -T{ -1. -2. DU< -> FALSE }T - -T{ max-2int hi-2int DU< -> FALSE }T -T{ hi-2int max-2int DU< -> TRUE }T -T{ max-2int min-2int DU< -> TRUE }T -T{ min-2int max-2int DU< -> FALSE }T -T{ min-2int lo-2int DU< -> TRUE }T - -\ ------------------------------------------------------------------------------ - -CR .( End of Double-Number word tests) CR - diff --git a/amforth-6.5/common/lib/forth2012/tester/exceptiontest.fth b/amforth-6.5/common/lib/forth2012/tester/exceptiontest.fth deleted file mode 100644 index 7b612bf..0000000 --- a/amforth-6.5/common/lib/forth2012/tester/exceptiontest.fth +++ /dev/null @@ -1,96 +0,0 @@ -\ To test the ANS Forth Exception word set and extension words - -\ This program was written by Gerry Jackson in 2006, with contributions from -\ others where indicated, and is in the public domain - it can be distributed -\ and/or modified in any way but please retain this notice. - -\ This program is distributed in the hope that it will be useful, -\ but WITHOUT ANY WARRANTY; without even the implied warranty of -\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. - -\ The tests are not claimed to be comprehensive or correct - -\ ------------------------------------------------------------------------------ -\ Version 0.4 1 April 2012 Tests placed in the public domain. -\ 0.3 6 March 2009 { and } replaced with T{ and }T -\ 0.2 20 April 2007 ANS Forth words changed to upper case -\ 0.1 Oct 2006 First version released - -\ ------------------------------------------------------------------------------ -\ The tests are based on John Hayes test program for the core word set -\ -\ Words tested in this file are: -\ CATCH THROW ABORT ABORT" -\ -\ ------------------------------------------------------------------------------ -\ Assumptions and dependencies: -\ - the forth system under test throws an exception with throw -\ code -13 for a word not found by the text interpreter. The -\ undefined word used is $$qweqweqwert$$, if this happens to be -\ a valid word in your system change the definition of t7 below -\ - tester.fr or ttester.fs has been loaded prior to this file -\ - CASE, OF, ENDOF and ENDCASE from the core extension wordset -\ are present and work correctly -\ ------------------------------------------------------------------------------ -TESTING CATCH THROW - -DECIMAL - -: t1 9 ; -: c1 1 2 3 ['] t1 CATCH ; -T{ c1 -> 1 2 3 9 0 }T \ No THROW executed - -: t2 8 0 THROW ; -: c2 1 2 ['] t2 CATCH ; -T{ c2 -> 1 2 8 0 }T \ 0 THROW does nothing - -: t3 7 8 9 99 THROW ; -: c3 1 2 ['] t3 CATCH ; -T{ c3 -> 1 2 99 }T \ Restores stack to CATCH depth - -: t4 1- DUP 0> IF RECURSE ELSE 999 THROW -222 THEN ; -: c4 3 4 5 10 ['] t4 CATCH -111 ; -T{ c4 -> 3 4 5 0 999 -111 }T \ Test return stack unwinding - -: t5 2DROP 2DROP 9999 THROW ; -: c5 1 2 3 4 ['] t5 CATCH \ Test depth restored correctly - DEPTH >R DROP 2DROP 2DROP R> ; \ after stack has been emptied -T{ c5 -> 5 }T - -\ ------------------------------------------------------------------------------ -TESTING ABORT ABORT" - --1 CONSTANT exc_abort --2 CONSTANT exc_abort" --13 CONSTANT exc_undef -: t6 ABORT ; - -\ The 77 in t10 is necessary for the second ABORT" test as the data stack -\ is restored to a depth of 2 when THROW is executed. The 77 ensures the top -\ of stack value is known for the results check - -: t10 77 SWAP ABORT" This should not be displayed" ; -: c6 CATCH - CASE exc_abort OF 11 ENDOF - exc_abort" OF 12 ENDOF - exc_undef OF 13 ENDOF - ENDCASE -; - -T{ 1 2 ' t6 c6 -> 1 2 11 }T \ Test that ABORT is caught -T{ 3 0 ' t10 c6 -> 3 77 }T \ ABORT" does nothing -T{ 4 5 ' t10 c6 -> 4 77 12 }T \ ABORT" caught, no message - -\ ------------------------------------------------------------------------------ -TESTING a system generated exception - -: t7 S" 333 $$qweqweqwert$$ 334" EVALUATE 335 ; -: t8 S" 222 t7 223" EVALUATE 224 ; -: t9 S" 111 112 t8 113" EVALUATE 114 ; - -T{ 6 7 ' t9 c6 3 -> 6 7 13 3 }T \ Test unlinking of sources - -\ ------------------------------------------------------------------------------ - -CR .( End of Exception word tests) CR - diff --git a/amforth-6.5/common/lib/forth2012/tester/filetest.fth b/amforth-6.5/common/lib/forth2012/tester/filetest.fth deleted file mode 100644 index 0364360..0000000 --- a/amforth-6.5/common/lib/forth2012/tester/filetest.fth +++ /dev/null @@ -1,193 +0,0 @@ -\ To test the ANS File Access word set and extension words - -\ This program was written by Gerry Jackson in 2006, with contributions from -\ others where indicated, and is in the public domain - it can be distributed -\ and/or modified in any way but please retain this notice. - -\ This program is distributed in the hope that it will be useful, -\ but WITHOUT ANY WARRANTY; without even the implied warranty of -\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. - -\ The tests are not claimed to be comprehensive or correct - -\ ------------------------------------------------------------------------------ -\ Version 0.5 1 April 2012 Tests placed in the public domain. -\ 0.4 22 March 2009 { and } replaced with T{ and }T -\ 0.3 20 April 2007 ANS Forth words changed to upper case. -\ Removed directory test from the filenames. -\ 0.2 30 Oct 2006 updated following GForth tests to remove -\ system dependency on file size, to allow for file -\ buffering and to allow for PAD moving around. -\ 0.1 Oct 2006 First version released. - -\ ------------------------------------------------------------------------------ -\ The tests are based on John Hayes test program for the core word set -\ and requires those files to have been loaded - -\ Words tested in this file are: -\ ( BIN CLOSE-FILE CREATE-FILE DELETE-FILE FILE-POSITION FILE-SIZE -\ OPEN-FILE R/O R/W READ-FILE READ-LINE REPOSITION-FILE RESIZE-FILE -\ S" SOURCE-ID W/O WRITE-FILE WRITE-LINE -\ FILE-STATUS FLUSH-FILE RENAME-FILE - -\ Words not tested: -\ REFILL INCLUDED INCLUDE-FILE (as these will likely have been -\ tested in the execution of the test files) -\ ------------------------------------------------------------------------------ -\ Assumptions, dependencies and notes: -\ - tester.fr or ttester.fs has been loaded prior to this file -\ - These tests create files in the current directory, if all goes -\ well these will be deleted. If something fails they may not be -\ deleted. If this is a problem ensure you set a suitable -\ directory before running this test. There is no ANS standard -\ way of doing this. Also be aware of the file names used below -\ which are: fatest1.txt, fatest2.txt and fatest3.txt -\ - TRUE and FALSE are present from the Core extension word set -\ ------------------------------------------------------------------------------ - -TESTING File Access word set - -DECIMAL - -\ ------------------------------------------------------------------------------ -TESTING CREATE-FILE CLOSE-FILE - -: fn1 S" fatest1.txt" ; -VARIABLE fid1 - -T{ fn1 R/W CREATE-FILE SWAP fid1 ! -> 0 }T -T{ fid1 @ CLOSE-FILE -> 0 }T - -\ ------------------------------------------------------------------------------ -TESTING OPEN-FILE W/O WRITE-LINE - -: line1 S" Line 1" ; - -T{ fn1 W/O OPEN-FILE SWAP fid1 ! -> 0 }T -T{ line1 fid1 @ WRITE-LINE -> 0 }T -T{ fid1 @ CLOSE-FILE -> 0 }T - -\ ------------------------------------------------------------------------------ -TESTING R/O FILE-POSITION (simple) READ-LINE - -200 CONSTANT bsize -CREATE buf bsize ALLOT -VARIABLE #chars - -T{ fn1 R/O OPEN-FILE SWAP fid1 ! -> 0 }T -T{ fid1 @ FILE-POSITION -> 0. 0 }T -T{ buf 100 fid1 @ READ-LINE ROT DUP #chars ! -> TRUE 0 line1 SWAP DROP }T -T{ buf #chars @ line1 COMPARE -> 0 }T -T{ fid1 @ CLOSE-FILE -> 0 }T - -\ ------------------------------------------------------------------------------ -TESTING R/W WRITE-FILE REPOSITION-FILE READ-FILE FILE-POSITION S" - -: line2 S" Line 2 blah blah blah" ; -: rl1 buf 100 fid1 @ READ-LINE ; -2VARIABLE fp - -T{ fn1 R/W OPEN-FILE SWAP fid1 ! -> 0 }T -T{ fid1 @ FILE-SIZE DROP fid1 @ REPOSITION-FILE -> 0 }T -T{ fid1 @ FILE-SIZE -> fid1 @ FILE-POSITION }T -T{ line2 fid1 @ WRITE-FILE -> 0 }T -T{ 10. fid1 @ REPOSITION-FILE -> 0 }T -T{ fid1 @ FILE-POSITION -> 10. 0 }T -T{ 0. fid1 @ REPOSITION-FILE -> 0 }T -T{ rl1 -> line1 SWAP DROP TRUE 0 }T -T{ rl1 ROT DUP #chars ! -> TRUE 0 line2 SWAP DROP }T -T{ buf #chars @ line2 COMPARE -> 0 }T -T{ rl1 -> 0 FALSE 0 }T -T{ fid1 @ FILE-POSITION ROT ROT fp 2! -> 0 }T -T{ fp 2@ fid1 @ FILE-SIZE DROP D= -> TRUE }T -T{ S" " fid1 @ WRITE-LINE -> 0 }T -T{ S" " fid1 @ WRITE-LINE -> 0 }T -T{ fp 2@ fid1 @ REPOSITION-FILE -> 0 }T -T{ rl1 -> 0 TRUE 0 }T -T{ rl1 -> 0 TRUE 0 }T -T{ rl1 -> 0 FALSE 0 }T -T{ fid1 @ CLOSE-FILE -> 0 }T - -\ ------------------------------------------------------------------------------ -TESTING BIN READ-FILE FILE-SIZE - -: cbuf buf bsize 0 FILL ; -: fn2 S" fatest2.txt" ; -VARIABLE fid2 -: setpad PAD 50 0 DO I OVER C! CHAR+ LOOP DROP ; - -setpad \ If anything else is defined setpad must be called again - \ as pad may move - -T{ fn2 R/W BIN CREATE-FILE SWAP fid2 ! -> 0 }T -T{ PAD 50 fid2 @ WRITE-FILE fid2 @ FLUSH-FILE -> 0 0 }T -T{ fid2 @ FILE-SIZE -> 50. 0 }T -T{ 0. fid2 @ REPOSITION-FILE -> 0 }T -T{ cbuf buf 29 fid2 @ READ-FILE -> 29 0 }T -T{ PAD 29 buf 29 COMPARE -> 0 }T -T{ PAD 30 buf 30 COMPARE -> 1 }T -T{ cbuf buf 29 fid2 @ READ-FILE -> 21 0 }T -T{ PAD 29 + 21 buf 21 COMPARE -> 0 }T -T{ fid2 @ FILE-SIZE DROP fid2 @ FILE-POSITION DROP D= -> TRUE }T -T{ buf 10 fid2 @ READ-FILE -> 0 0 }T -T{ fid2 @ CLOSE-FILE -> 0 }T - -\ ------------------------------------------------------------------------------ -TESTING RESIZE-FILE - -T{ fn2 R/W BIN OPEN-FILE SWAP fid2 ! -> 0 }T -T{ 37. fid2 @ RESIZE-FILE -> 0 }T -T{ fid2 @ FILE-SIZE -> 37. 0 }T -T{ 0. fid2 @ REPOSITION-FILE -> 0 }T -T{ cbuf buf 100 fid2 @ READ-FILE -> 37 0 }T -T{ PAD 37 buf 37 COMPARE -> 0 }T -T{ PAD 38 buf 38 COMPARE -> 1 }T -T{ 500. fid2 @ RESIZE-FILE -> 0 }T -T{ fid2 @ FILE-SIZE -> 500. 0 }T -T{ 0. fid2 @ REPOSITION-FILE -> 0 }T -T{ cbuf buf 100 fid2 @ READ-FILE -> 100 0 }T -T{ PAD 37 buf 37 COMPARE -> 0 }T -T{ fid2 @ CLOSE-FILE -> 0 }T - -\ ------------------------------------------------------------------------------ -TESTING DELETE-FILE - -T{ fn2 DELETE-FILE -> 0 }T -T{ fn2 R/W BIN OPEN-FILE SWAP DROP 0= -> FALSE }T -T{ fn2 DELETE-FILE 0= -> FALSE }T - -\ ------------------------------------------------------------------------------ -TESTING multi-line ( comments - -T{ ( 1 2 3 -4 5 6 -7 8 9 ) 11 22 33 -> 11 22 33 }T - -\ ------------------------------------------------------------------------------ -TESTING SOURCE-ID (can only test it does not return 0 or -1) - -T{ SOURCE-ID DUP -1 = SWAP 0= OR -> FALSE }T - -\ ------------------------------------------------------------------------------ -TESTING RENAME-FILE FILE-STATUS FLUSH-FILE - -: fn3 S" fatest3.txt" ; -: >end fid1 @ FILE-SIZE DROP fid1 @ REPOSITION-FILE ; - - -T{ fn3 DELETE-FILE DROP -> }T -T{ fn1 fn3 RENAME-FILE 0= -> TRUE }T -T{ fn1 FILE-STATUS SWAP DROP 0= -> FALSE }T -T{ fn3 FILE-STATUS SWAP DROP 0= -> TRUE }T \ Return value is undefined -T{ fn3 R/W OPEN-FILE SWAP fid1 ! -> 0 }T -T{ >end -> 0 }T -T{ S" Final line" fid1 @ WRITE-LINE -> 0 }T -T{ fid1 @ FLUSH-FILE -> 0 }T \ Can only test FLUSH-FILE doesn't fail -T{ fid1 @ CLOSE-FILE -> 0 }T - -\ Tidy the test folder -T{ fn3 DELETE-FILE DROP -> }T - -\ ------------------------------------------------------------------------------ - -CR .( End of File-Access word tests) CR diff --git a/amforth-6.5/common/lib/forth2012/tester/memorytest.fth b/amforth-6.5/common/lib/forth2012/tester/memorytest.fth deleted file mode 100644 index 1967fc3..0000000 --- a/amforth-6.5/common/lib/forth2012/tester/memorytest.fth +++ /dev/null @@ -1,93 +0,0 @@ -\ To test the ANS Forth Memory-Allocation word set - -\ This program was written by Gerry Jackson in 2006, with contributions from -\ others where indicated, and is in the public domain - it can be distributed -\ and/or modified in any way but please retain this notice. - -\ This program is distributed in the hope that it will be useful, -\ but WITHOUT ANY WARRANTY; without even the implied warranty of -\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. - -\ The tests are not claimed to be comprehensive or correct - -\ ------------------------------------------------------------------------------ -\ Version 0.7 1 April 2012 Tests placed in the public domain. -\ 0.6 30 January 2011 CHECKMEM modified to work with ttester.fs -\ 0.5 30 November 2009 replaced with FALSE -\ 0.4 9 March 2009 Aligned test improved and data space pointer tested -\ 0.3 6 March 2009 { and } replaced with T{ and }T -\ 0.2 20 April 2007 ANS Forth words changed to upper case -\ 0.1 October 2006 First version released - -\ ------------------------------------------------------------------------------ -\ The tests are based on John Hayes test program for the core word set -\ and requires those files to have been loaded - -\ Words tested in this file are: -\ ALLOCATE FREE RESIZE -\ -\ ------------------------------------------------------------------------------ -\ Assumptions and dependencies: -\ - that 'addr -1 ALLOCATE' and 'addr -1 RESIZE' will return an error -\ - tester.fr or ttester.fs has been loaded prior to this file -\ - testing FREE failing is not done as it is likely to crash the -\ system -\ ------------------------------------------------------------------------------ - -TESTING Memory-Allocation word set - -DECIMAL - -\ ------------------------------------------------------------------------------ -TESTING ALLOCATE FREE RESIZE - -VARIABLE addr1 -VARIABLE datsp - -HERE datsp ! -T{ 100 ALLOCATE SWAP addr1 ! -> 0 }T -T{ addr1 @ ALIGNED -> addr1 @ }T \ Test address is aligned -T{ HERE -> datsp @ }T \ Check data space pointer is unchanged -T{ addr1 @ FREE -> 0 }T - -T{ 99 ALLOCATE SWAP addr1 ! -> 0 }T -T{ addr1 @ ALIGNED -> addr1 @ }T -T{ addr1 @ FREE -> 0 }T - -T{ 50 ALLOCATE SWAP addr1 ! -> 0 }T - -: writemem 0 DO I 1+ OVER C! 1+ LOOP DROP ; ( ad n -- ) - -\ checkmem is defined this way to maintain compatibility with both -\ tester.fr and ttester.fs which differ in their definitions of T{ - -: checkmem ( ad n --- ) - 0 - DO - >R - T{ R@ C@ -> R> I 1+ SWAP >R }T - R> 1+ - LOOP - DROP -; - -addr1 @ 50 writemem addr1 @ 50 checkmem - -T{ addr1 @ 28 RESIZE SWAP addr1 ! -> 0 }T -addr1 @ 28 checkmem - -T{ addr1 @ 200 RESIZE SWAP addr1 ! -> 0 }T -addr1 @ 28 checkmem - -\ ------------------------------------------------------------------------------ -TESTING failure of RESIZE and ALLOCATE (unlikely to be enough memory) - -T{ addr1 @ -1 RESIZE 0= -> addr1 @ FALSE }T - -T{ addr1 @ FREE -> 0 }T - -T{ -1 ALLOCATE SWAP DROP 0= -> FALSE }T \ Memory allocate failed - -\ ------------------------------------------------------------------------------ - -CR .( End of Memory-Allocation word tests) CR diff --git a/amforth-6.5/common/lib/forth2012/tester/postponetest.fs b/amforth-6.5/common/lib/forth2012/tester/postponetest.fs deleted file mode 100644 index b178be6..0000000 --- a/amforth-6.5/common/lib/forth2012/tester/postponetest.fs +++ /dev/null @@ -1,379 +0,0 @@ -\ checks that postpone works correctly with words with special -\ compilation semantics - -\ by M. Anton Ertl 1996 - -\ This file is based on John Hayes' core.fr (coretest.fs), which has -\ the following copyright notice: - -\ (C) 1995 JOHNS HOPKINS UNIVERSITY / APPLIED PHYSICS LABORATORY -\ MAY BE DISTRIBUTED FREELY AS LONG AS THIS COPYRIGHT NOTICE REMAINS. - -\ my contributions to this file are in the public domain - -\ you have to load John Hayes' tester.fs (=tester.fr) and coretest.fs -\ (core.fr) first - -\ These tests are especially useful for showing that state-smart -\ implementations of words with special compilation semantics, -\ combined with a straight-forward implementation of POSTPONE (and -\ [COMPILE]) do not conform to the ANS Forth standard. The essential -\ sentences in the standad are: - -\ 6.1.2033 POSTPONE CORE -\ ... -\ Compilation: ( name -- ) - -\ Skip leading space delimiters. Parse name delimited by a space. Find -\ name. Append the compilation semantics of name to the current -\ definition. - -\ 6.2.2530 [COMPILE] bracket-compile CORE EXT -\ ... -\ Compilation: ( name -- ) - -\ Skip leading space delimiters. Parse name delimited by a space. Find -\ name. If name has other than default compilation semantics, append -\ them to the current definition;... - - -\ Note that the compilation semantics are appended, not some -\ state-dependent semantics. - -\ first I test against a non-ANS solution suggested by Bernd Paysan - -: STATE@-NOW ( -- F ) - STATE @ ; IMMEDIATE - -: STATE@ ( -- F ) - POSTPONE STATE@-NOW ; - -t{ STATE@ -> STATE @ }t - -0 INVERT CONSTANT MAX-UINT -0 INVERT 1 RSHIFT CONSTANT MAX-INT -0 INVERT 1 RSHIFT INVERT CONSTANT MIN-INT -0 INVERT 1 RSHIFT CONSTANT MID-UINT -0 INVERT 1 RSHIFT INVERT CONSTANT MID-UINT+1 - -\ here I test POSTPONE with all core words with special compilation -\ semantics. - -TESTING POSTPONE +LOOP - -: POSTPONE-+LOOP - POSTPONE +LOOP ; - -t{ : PGD2 DO I -1 [ POSTPONE-+LOOP ] ; -> }t -t{ 1 4 PGD2 -> 4 3 2 1 }t -t{ -1 2 PGD2 -> 2 1 0 -1 }t -t{ MID-UINT MID-UINT+1 PGD2 -> MID-UINT+1 MID-UINT }t - -t{ : PGD4 DO 1 0 DO J LOOP -1 [ POSTPONE-+LOOP ] ; -> }t -t{ 1 4 PGD4 -> 4 3 2 1 }t -t{ -1 2 PGD4 -> 2 1 0 -1 }t -t{ MID-UINT MID-UINT+1 PGD4 -> MID-UINT+1 MID-UINT }t - -TESTING POSTPONE ." - -: POSTPONE-." - POSTPONE ." ; - -: PDQ2 [ POSTPONE-." YOU SHOULD SEE THIS LATER. " ] CR ; -: PDQ1 [ POSTPONE-." YOU SHOULD SEE THIS FIRST. " ] CR ; -t{ PDQ1 PDQ2 -> }t - -TESTING POSTPONE ; -: POSTPONE-; - POSTPONE ; ; - -t{ : PSC [ POSTPONE-; -> }t -t{ PSC -> }t - -TESTING POSTPONE ABORT" - -: POSTPONE-ABORT" - POSTPONE ABORT" ; - -t{ : PAQ1 [ POSTPONE-ABORT" THIS SHOULD NOT ABORT" ] ; -> }t - -TESTING POSTPONE BEGIN -: POSTPONE-BEGIN - POSTPONE BEGIN ; - -t{ : PB3 [ POSTPONE-BEGIN ] DUP 5 < WHILE DUP 1+ REPEAT ; -> }t -t{ 0 PB3 -> 0 1 2 3 4 5 }t -t{ 4 PB3 -> 4 5 }t -t{ 5 PB3 -> 5 }t -t{ 6 PB3 -> 6 }t - -t{ : PB4 [ POSTPONE-BEGIN ] DUP 1+ DUP 5 > UNTIL ; -> }t -t{ 3 PB4 -> 3 4 5 6 }t -t{ 5 PB4 -> 5 6 }t -t{ 6 PB4 -> 6 7 }t - -t{ : PB5 [ POSTPONE-BEGIN ] DUP 2 > WHILE DUP 5 < WHILE DUP 1+ REPEAT 123 ELSE 345 THEN ; -> }t -t{ 1 PB5 -> 1 345 }t -t{ 2 PB5 -> 2 345 }t -t{ 3 PB5 -> 3 4 5 123 }t -t{ 4 PB5 -> 4 5 123 }t -t{ 5 PB5 -> 5 123 }t - -TESTING POSTPONE DO -: POSTPONE-DO - POSTPONE DO ; - -t{ : PDO1 [ POSTPONE-DO ] I LOOP ; -> }t -t{ 4 1 PDO1 -> 1 2 3 }t -t{ 2 -1 PDO1 -> -1 0 1 }t -t{ MID-UINT+1 MID-UINT PDO1 -> MID-UINT }t - -t{ : PDO2 [ POSTPONE-DO ] I -1 +LOOP ; -> }t -t{ 1 4 PDO2 -> 4 3 2 1 }t -t{ -1 2 PDO2 -> 2 1 0 -1 }t -t{ MID-UINT MID-UINT+1 PDO2 -> MID-UINT+1 MID-UINT }t - -t{ : PDO3 [ POSTPONE-DO ] 1 0 [ POSTPONE-DO ] J LOOP LOOP ; -> }t -t{ 4 1 PDO3 -> 1 2 3 }t -t{ 2 -1 PDO3 -> -1 0 1 }t -t{ MID-UINT+1 MID-UINT PDO3 -> MID-UINT }t - -t{ : PDO4 [ POSTPONE-DO ] 1 0 [ POSTPONE-DO ] J LOOP -1 +LOOP ; -> }t -t{ 1 4 PDO4 -> 4 3 2 1 }t -t{ -1 2 PDO4 -> 2 1 0 -1 }t -t{ MID-UINT MID-UINT+1 PDO4 -> MID-UINT+1 MID-UINT }t - -t{ : PDO5 123 SWAP 0 [ POSTPONE-DO ] I 4 > IF DROP 234 LEAVE THEN LOOP ; -> }t -t{ 1 PDO5 -> 123 }t -t{ 5 PDO5 -> 123 }t -t{ 6 PDO5 -> 234 }t - -t{ : PDO6 ( PAT: {0 0},{0 0}{1 0}{1 1},{0 0}{1 0}{1 1}{2 0}{2 1}{2 2} ) - 0 SWAP 0 [ POSTPONE-DO ] - I 1+ 0 [ POSTPONE-DO ] I J + 3 = IF I UNLOOP I UNLOOP EXIT THEN 1+ LOOP - LOOP ; -> }t -t{ 1 PDO6 -> 1 }t -t{ 2 PDO6 -> 3 }t -t{ 3 PDO6 -> 4 1 2 }t - -TESTING POSTPONE DOES> -: POSTPONE-DOES> - POSTPONE DOES> ; - -t{ : PDOES1 [ POSTPONE-DOES> ] @ 1 + ; -> }t -t{ : PDOES2 [ POSTPONE-DOES> ] @ 2 + ; -> }t -t{ CREATE PCR1 -> }t -t{ PCR1 -> HERE }t -t{ ' PCR1 >BODY -> HERE }t -t{ 1 , -> }t -t{ PCR1 @ -> 1 }t -t{ PDOES1 -> }t -t{ PCR1 -> 2 }t -t{ PDOES2 -> }t -t{ PCR1 -> 3 }t - -t{ : PWEIRD: CREATE [ POSTPONE-DOES> ] 1 + [ POSTPONE-DOES> ] 2 + ; -> }t -t{ PWEIRD: PW1 -> }t -t{ ' PW1 >BODY -> HERE }t -t{ PW1 -> HERE 1 + }t -t{ PW1 -> HERE 2 + }t - -TESTING POSTPONE ELSE -: POSTPONE-ELSE - POSTPONE ELSE ; - -t{ : PELSE1 IF 123 [ POSTPONE-ELSE ] 234 THEN ; -> }t -t{ 0 PELSE1 -> 234 }t -t{ 1 PELSE1 -> 123 }t - -t{ : PELSE2 BEGIN DUP 2 > WHILE DUP 5 < WHILE DUP 1+ REPEAT 123 [ POSTPONE-ELSE ] 345 THEN ; -> }t -t{ 1 PELSE2 -> 1 345 }t -t{ 2 PELSE2 -> 2 345 }t -t{ 3 PELSE2 -> 3 4 5 123 }t -t{ 4 PELSE2 -> 4 5 123 }t -t{ 5 PELSE2 -> 5 123 }t - -TESTING POSTPONE IF -: POSTPONE-IF - POSTPONE IF ; - -t{ : PIF1 [ POSTPONE-IF ] 123 THEN ; -> }t -t{ : PIF2 [ POSTPONE-IF ] 123 ELSE 234 THEN ; -> }t -t{ 0 PIF1 -> }t -t{ 1 PIF1 -> 123 }t -t{ -1 PIF1 -> 123 }t -t{ 0 PIF2 -> 234 }t -t{ 1 PIF2 -> 123 }t -t{ -1 PIF1 -> 123 }t - -t{ : PIF6 ( N -- 0,1,..N ) DUP [ POSTPONE-IF ] DUP >R 1- RECURSE R> THEN ; -> }t -t{ 0 PIF6 -> 0 }t -t{ 1 PIF6 -> 0 1 }t -t{ 2 PIF6 -> 0 1 2 }t -t{ 3 PIF6 -> 0 1 2 3 }t -t{ 4 PIF6 -> 0 1 2 3 4 }t - -TESTING POSTPONE LITERAL -: POSTPONE-LITERAL - POSTPONE LITERAL ; - -t{ : PLIT [ 42 POSTPONE-LITERAL ] ; -> }t -t{ PLIT -> 42 }t - -TESTING POSTPONE LOOP -: POSTPONE-LOOP - POSTPONE LOOP ; - -t{ : PLOOP1 DO I [ POSTPONE-LOOP ] ; -> }t -t{ 4 1 PLOOP1 -> 1 2 3 }t -t{ 2 -1 PLOOP1 -> -1 0 1 }t -t{ MID-UINT+1 MID-UINT PLOOP1 -> MID-UINT }t - -t{ : PLOOP3 DO 1 0 DO J [ POSTPONE-LOOP ] [ POSTPONE-LOOP ] ; -> }t -t{ 4 1 PLOOP3 -> 1 2 3 }t -t{ 2 -1 PLOOP3 -> -1 0 1 }t -t{ MID-UINT+1 MID-UINT PLOOP3 -> MID-UINT }t - -t{ : PLOOP4 DO 1 0 DO J [ POSTPONE-LOOP ] -1 +LOOP ; -> }t -t{ 1 4 PLOOP4 -> 4 3 2 1 }t -t{ -1 2 PLOOP4 -> 2 1 0 -1 }t -t{ MID-UINT MID-UINT+1 PLOOP4 -> MID-UINT+1 MID-UINT }t - -t{ : PLOOP5 123 SWAP 0 DO I 4 > IF DROP 234 LEAVE THEN [ POSTPONE-LOOP ] ; -> }t -t{ 1 PLOOP5 -> 123 }t -t{ 5 PLOOP5 -> 123 }t -t{ 6 PLOOP5 -> 234 }t - -t{ : PLOOP6 ( PAT: {0 0},{0 0}{1 0}{1 1},{0 0}{1 0}{1 1}{2 0}{2 1}{2 2} ) - 0 SWAP 0 DO - I 1+ 0 DO I J + 3 = IF I UNLOOP I UNLOOP EXIT THEN 1+ [ POSTPONE-LOOP ] - [ POSTPONE-LOOP ] ; -> }t -t{ 1 PLOOP6 -> 1 }t -t{ 2 PLOOP6 -> 3 }t -t{ 3 PLOOP6 -> 4 1 2 }t - -TESTING POSTPONE POSTPONE -: POSTPONE-POSTPONE - POSTPONE POSTPONE ; - -t{ : PPP1 123 ; -> }t -t{ : PPP4 [ POSTPONE-POSTPONE PPP1 ] ; IMMEDIATE -> }t -t{ : PPP5 PPP4 ; -> }t -t{ PPP5 -> 123 }t -t{ : PPP6 345 ; IMMEDIATE -> }t -t{ : PPP7 [ POSTPONE-POSTPONE PPP6 ] ; -> }t -t{ PPP7 -> 345 }t - -TESTING POSTPONE RECURSE -: POSTPONE-RECURSE - POSTPONE RECURSE ; - -t{ : GREC ( N -- 0,1,..N ) DUP IF DUP >R 1- [ POSTPONE-RECURSE ] R> THEN ; -> }t -t{ 0 GREC -> 0 }t -t{ 1 GREC -> 0 1 }t -t{ 2 GREC -> 0 1 2 }t -t{ 3 GREC -> 0 1 2 3 }t -t{ 4 GREC -> 0 1 2 3 4 }t - -TESTING POSTPONE REPEAT -: POSTPONE-REPEAT - POSTPONE REPEAT ; - -t{ : PREP3 BEGIN DUP 5 < WHILE DUP 1+ [ POSTPONE-REPEAT ] ; -> }t -t{ 0 PREP3 -> 0 1 2 3 4 5 }t -t{ 4 PREP3 -> 4 5 }t -t{ 5 PREP3 -> 5 }t -t{ 6 PREP3 -> 6 }t - -t{ : PREP5 BEGIN DUP 2 > WHILE DUP 5 < WHILE DUP 1+ [ POSTPONE-REPEAT ] 123 ELSE 345 THEN ; -> }t -t{ 1 PREP5 -> 1 345 }t -t{ 2 PREP5 -> 2 345 }t -t{ 3 PREP5 -> 3 4 5 123 }t -t{ 4 PREP5 -> 4 5 123 }t -t{ 5 PREP5 -> 5 123 }t - -TESTING POSTPONE S" -: POSTPONE-S" - POSTPONE S" ; - -t{ : PSQ4 [ POSTPONE-S" XY" ] ; -> }t -t{ PSQ4 SWAP DROP -> 2 }t -t{ PSQ4 DROP DUP C@ SWAP CHAR+ C@ -> 58 59 }t - -TESTING POSTPONE THEN -: POSTPONE-THEN - POSTPONE THEN ; - -t{ : PTH1 IF 123 [ POSTPONE-THEN ] ; -> }t -t{ : PTH2 IF 123 ELSE 234 [ POSTPONE-THEN ] ; -> }t -t{ 0 PTH1 -> }t -t{ 1 PTH1 -> 123 }t -t{ -1 PTH1 -> 123 }t -t{ 0 PTH2 -> 234 }t -t{ 1 PTH2 -> 123 }t -t{ -1 PTH1 -> 123 }t - -t{ : PTH5 BEGIN DUP 2 > WHILE DUP 5 < WHILE DUP 1+ REPEAT 123 ELSE 345 [ POSTPONE-THEN ] ; -> }t -t{ 1 PTH5 -> 1 345 }t -t{ 2 PTH5 -> 2 345 }t -t{ 3 PTH5 -> 3 4 5 123 }t -t{ 4 PTH5 -> 4 5 123 }t -t{ 5 PTH5 -> 5 123 }t - -t{ : PTH6 ( N -- 0,1,..N ) DUP IF DUP >R 1- RECURSE R> [ POSTPONE-THEN ] ; -> }t -t{ 0 PTH6 -> 0 }t -t{ 1 PTH6 -> 0 1 }t -t{ 2 PTH6 -> 0 1 2 }t -t{ 3 PTH6 -> 0 1 2 3 }t -t{ 4 PTH6 -> 0 1 2 3 4 }t - -TESTING POSTPONE UNTIL -: POSTPONE-UNTIL - POSTPONE UNTIL ; - -t{ : PUNT4 BEGIN DUP 1+ DUP 5 > [ POSTPONE-UNTIL ] ; -> }t -t{ 3 PUNT4 -> 3 4 5 6 }t -t{ 5 PUNT4 -> 5 6 }t -t{ 6 PUNT4 -> 6 7 }t - -TESTING POSTPONE WHILE -: POSTPONE-WHILE - POSTPONE WHILE ; - -t{ : PWH3 BEGIN DUP 5 < [ POSTPONE-WHILE ] DUP 1+ REPEAT ; -> }t -t{ 0 PWH3 -> 0 1 2 3 4 5 }t -t{ 4 PWH3 -> 4 5 }t -t{ 5 PWH3 -> 5 }t -t{ 6 PWH3 -> 6 }t - -t{ : PWH5 BEGIN DUP 2 > [ POSTPONE-WHILE ] DUP 5 < [ POSTPONE-WHILE ] DUP 1+ REPEAT 123 ELSE 345 THEN ; -> }t -t{ 1 PWH5 -> 1 345 }t -t{ 2 PWH5 -> 2 345 }t -t{ 3 PWH5 -> 3 4 5 123 }t -t{ 4 PWH5 -> 4 5 123 }t -t{ 5 PWH5 -> 5 123 }t - - -TESTING POSTPONE [ -: POSTPONE-[ - POSTPONE [ ; - -t{ HERE POSTPONE-[ -> HERE }t - -TESTING POSTPONE ['] -: POSTPONE-['] - POSTPONE ['] ; - -t{ : PTICK1 123 ; -> }t -t{ : PTICK2 [ POSTPONE-['] PTICK1 ] ; IMMEDIATE -> }t -t{ PTICK2 EXECUTE -> 123 }t - -TESTING POSTPONE [CHAR] -: POSTPONE-[CHAR] - POSTPONE [CHAR] ; - -t{ : PCHAR1 [ POSTPONE-[CHAR] X ] ; -> }t -t{ : PCHAR2 [ POSTPONE-[CHAR] HELLO ] ; -> }t -t{ PCHAR1 -> 58 }t -t{ PCHAR2 -> 48 }t - diff --git a/amforth-6.5/common/lib/forth2012/tester/searchordertest.fth b/amforth-6.5/common/lib/forth2012/tester/searchordertest.fth deleted file mode 100644 index 79f9de9..0000000 --- a/amforth-6.5/common/lib/forth2012/tester/searchordertest.fth +++ /dev/null @@ -1,178 +0,0 @@ -\ To test the ANS Forth search-order word set and search order extensions - -\ This program was written by Gerry Jackson in 2006, with contributions from -\ others where indicated, and is in the public domain - it can be distributed -\ and/or modified in any way but please retain this notice. - -\ This program is distributed in the hope that it will be useful, -\ but WITHOUT ANY WARRANTY; without even the implied warranty of -\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. - -\ The tests are not claimed to be comprehensive or correct - -\ ------------------------------------------------------------------------------ -\ Version 0.5 1 April 2012 Tests placed in the public domain. -\ 0.4 6 March 2009 { and } replaced with T{ and }T -\ 0.3 20 April 2007 ANS Forth words changed to upper case -\ 0.2 30 Oct 2006 updated following GForth tests to get -\ initial search order into a known state -\ 0.1 Oct 2006 First version released - -\ ------------------------------------------------------------------------------ -\ The tests are based on John Hayes test program for the core word set -\ and requires those files to have been loaded - -\ Words tested in this file are: -\ FORTH-WORDLIST GET-ORDER SET-ORDER ALSO ONLY FORTH GET-CURRENT -\ SET-CURRENT DEFINITIONS PREVIOUS SEARCH-WORDLIST WORDLIST FIND -\ Words not fully tested: -\ ORDER only tests that it executes, display is implementation -\ dependent and should be visually inspected - -\ ------------------------------------------------------------------------------ -\ Assumptions and dependencies: -\ - tester.fr or ttester.fs has been loaded prior to this file -\ - that ONLY FORTH DEFINITIONS will work at the start of the file -\ to ensure the search order is in a known state -\ ------------------------------------------------------------------------------ - -ONLY FORTH DEFINITIONS - -TESTING Search-order word set - -DECIMAL - -VARIABLE wid1 VARIABLE wid2 - -: save-orderlist ( widn ... wid1 n -> ) DUP , 0 ?DO , LOOP ; - -\ ------------------------------------------------------------------------------ -TESTING FORTH-WORDLIST GET-ORDER SET-ORDER - -T{ FORTH-WORDLIST wid1 ! -> }T - -CREATE order-list - -T{ GET-ORDER save-orderlist -> }T - -: get-orderlist ( -- widn ... wid1 n ) - order-list DUP @ CELLS ( -- ad n ) - OVER + ( -- ad ad' ) - ?DO I @ -1 CELLS +LOOP ( -- ) -; - -T{ GET-ORDER OVER -> GET-ORDER wid1 @ }T \ Forth wordlist at top -T{ GET-ORDER SET-ORDER -> }T \ Effectively noop -T{ GET-ORDER -> get-orderlist }T \ Check nothing changed -T{ get-orderlist DROP get-orderlist 2* SET-ORDER -> }T -T{ GET-ORDER -> get-orderlist DROP get-orderlist 2* }T -T{ get-orderlist SET-ORDER GET-ORDER -> get-orderlist }T - -\ ------------------------------------------------------------------------------ -TESTING ALSO ONLY FORTH - -T{ ALSO GET-ORDER -> get-orderlist OVER SWAP 1+ }T -T{ ONLY FORTH GET-ORDER -> get-orderlist }T \ See assumptions above - -\ ------------------------------------------------------------------------------ -TESTING GET-CURRENT SET-CURRENT WORDLIST (simple) - -T{ GET-CURRENT -> wid1 @ }T \ See assumptions above -T{ WORDLIST wid2 ! -> }T -T{ wid2 @ SET-CURRENT -> }T -T{ GET-CURRENT -> wid2 @ }T -T{ wid1 @ SET-CURRENT -> }T - -\ ------------------------------------------------------------------------------ -TESTING minimum search order list contains FORTH-WORDLIST and SET-ORDER - -: so1 SET-ORDER ; \ In case it is unavailable in the forth wordlist - -T{ ONLY FORTH-WORDLIST 1 SET-ORDER get-orderlist so1 -> }T -T{ GET-ORDER -> get-orderlist }T - -\ ------------------------------------------------------------------------------ -TESTING GET-ORDER SET-ORDER with 0 and -1 number of wids argument - -: so2a GET-ORDER get-orderlist SET-ORDER ; \ To recover search order -: so2 0 SET-ORDER so2a ; - -T{ so2 -> 0 }T \ 0 set-order leaves an empty search order - -: so3 -1 SET-ORDER so2a ; -: so4 ONLY so2a ; - -T{ so3 -> so4 }T \ -1 SET-ORDER = ONLY - -\ ------------------------------------------------------------------------------ -TESTING DEFINITIONS PREVIOUS - -T{ ONLY FORTH DEFINITIONS -> }T -T{ GET-CURRENT -> FORTH-WORDLIST }T -T{ GET-ORDER wid2 @ SWAP 1+ SET-ORDER DEFINITIONS GET-CURRENT -> wid2 @ }T -T{ GET-ORDER -> get-orderlist wid2 @ SWAP 1+ }T -T{ PREVIOUS GET-ORDER -> get-orderlist }T -T{ DEFINITIONS GET-CURRENT -> FORTH-WORDLIST }T - -\ ------------------------------------------------------------------------------ -TESTING SEARCH-WORDLIST WORDLIST FIND - -ONLY FORTH DEFINITIONS -VARIABLE xt ' DUP xt ! -VARIABLE xti ' .( xti ! \ Immediate word - -T{ S" DUP" wid1 @ SEARCH-WORDLIST -> xt @ -1 }T -T{ S" .(" wid1 @ SEARCH-WORDLIST -> xti @ 1 }T -T{ S" DUP" wid2 @ SEARCH-WORDLIST -> 0 }T - -: c"dup" C" DUP" ; -: c".(" C" .(" ; -: c"x" C" unknown word" ; - -T{ c"dup" FIND -> xt @ -1 }T -T{ c".(" FIND -> xti @ 1 }T -T{ c"x" FIND -> c"x" 0 }T - -\ ------------------------------------------------------------------------------ -TESTING new definitions are put into the correct wordlist - -: alsowid2 ALSO GET-ORDER wid2 @ ROT DROP SWAP SET-ORDER ; -alsowid2 -: w1 1234 ; -DEFINITIONS -: w1 -9876 ; IMMEDIATE - -ONLY FORTH -T{ w1 -> 1234 }T -DEFINITIONS -T{ w1 -> 1234 }T -alsowid2 -T{ w1 -> -9876 }T -DEFINITIONS -T{ w1 -> -9876 }T - -ONLY FORTH DEFINITIONS - -: so5 DUP IF SWAP EXECUTE THEN ; - -T{ S" w1" wid1 @ SEARCH-WORDLIST so5 -> -1 1234 }T -T{ S" w1" wid2 @ SEARCH-WORDLIST so5 -> 1 -9876 }T - -: c"w1" C" w1" ; -T{ alsowid2 c"w1" FIND so5 -> 1 -9876 }T -T{ PREVIOUS c"w1" FIND so5 -> -1 1234 }T - -\ ------------------------------------------------------------------------------ -TESTING ORDER \ Should display search order and compilation wordlist - -CR .( ONLY FORTH DEFINITIONS search order and compilation list) CR -T{ ONLY FORTH DEFINITIONS ORDER -> }T - -CR .( Plus another unnamed wordlist at the head of the search order) CR -T{ alsowid2 DEFINITIONS ORDER -> }T - -\ ------------------------------------------------------------------------------ - -CR .( End of Search Order word tests) CR - -ONLY FORTH DEFINITIONS \ Leave search order in the standard state diff --git a/amforth-6.5/common/lib/forth2012/tester/searchordertest.txt b/amforth-6.5/common/lib/forth2012/tester/searchordertest.txt deleted file mode 100644 index 9018a5d..0000000 --- a/amforth-6.5/common/lib/forth2012/tester/searchordertest.txt +++ /dev/null @@ -1,184 +0,0 @@ -\ To test the ANS Forth search-order word set and search order extensions - -\ Copyright (C) Gerry Jackson 2006 - -\ This program is free software; you can redistribute it and/or -\ modify it any way. - -\ This program is distributed in the hope that it will be useful, -\ but WITHOUT ANY WARRANTY; without even the implied warranty of -\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. - -\ The tests are not claimed to be comprehensive or correct - -\ -------------------------------------------------------------------- -\ Version 0.1 Oct 2006 First version released - -\ -------------------------------------------------------------------- -\ The tests are based on John Hayes test program for the core word set -\ and requires those files to have been loaded - -\ Words tested in this file are: -\ forth-wordlist get-order set-order also only forth get-current -\ set-current definitions previous search-wordlist wordlist find -\ Words not fully tested: -\ order only tests that it executes, display is implementation -\ dependent - -\ -------------------------------------------------------------------- -\ Assumptions and dependencies: -\ - running on a case insensitive system. Strictly speaking ANS -\ Forth words should be in upper case only, this file is mostly -\ lower case -\ - the forth wordlist is at the head of the search order and is -\ also the compilation wordlist -\ - tester.fr has been loaded prior to this file -\ -------------------------------------------------------------------- - -Testing Search-order word set - -decimal - -variable wid1 variable wid2 - -: save-orderlist ( widn ... wid1 n -> ) dup , 0 ?do , loop ; - -\ -------------------------------------------------------------------- - -Testing forth-wordlist get-order set-order - -{ forth-wordlist wid1 ! -> } - -create order-list - -{ get-order save-orderlist -> } - -: get-orderlist ( -- widn ... wid1 n ) - order-list dup @ cells ( -- ad n ) - over + ( -- ad ad' ) - ?do i @ -1 cells +loop ( -- ) -; - -{ get-order over -> get-order wid1 @ } \ Forth wordlist at top -{ get-order set-order -> } \ Effectively noop -{ get-order -> get-orderlist } \ Check nothing changed -{ get-orderlist drop get-orderList 2* set-order -> } -{ get-order -> get-orderlist drop get-orderList 2* } -{ get-orderlist set-order get-order -> get-orderlist } - -\ -------------------------------------------------------------------- - -Testing also only forth - -{ also get-order -> get-orderlist over swap 1+ } -{ only forth get-order -> get-orderlist } \ See assumptions above - -\ -------------------------------------------------------------------- - -Testing get-current set-current wordlist (simple) - -{ get-current -> wid1 @ } \ See assumptions above -{ wordlist wid2 ! -> } -{ wid2 @ set-current -> } -{ get-current -> wid2 @ } -{ wid1 @ set-current - -\ -------------------------------------------------------------------- - -Testing minimum search order list contains forth-wordlist and set-order - -: so1 set-order ; \ In case it is unavailable in the forth wordlist - -{ only forth-wordlist 1 set-order get-orderlist so1 -> } -{ get-order -> get-orderlist } - -\ -------------------------------------------------------------------- - -Testing get-order set-order with 0 and -1 number of wids argument - -: so2a get-order get-orderlist set-order ; \ To recover search order -: so2 0 set-order so2a ; - -{ so2 -> 0 } \ 0 set-order leaves an empty search order - -: so3 -1 set-order so2a ; -: so4 only so2a ; - -{ so3 -> so4 } \ -1 set-order = only - -\ -------------------------------------------------------------------- - -Testing definitions previous - -{ only forth definitions -> } -{ get-current -> forth-wordlist } -{ get-order wid2 @ swap 1+ set-order definitions get-current -> wid2 @ } -{ get-order -> get-orderlist wid2 @ swap 1+ } -{ previous get-order -> get-orderlist } -{ definitions get-current -> forth-wordlist } - -\ -------------------------------------------------------------------- - -Testing search-wordlist wordlist find - -only forth definitions -variable xt ' dup xt ! -variable xti ' .( xti ! \ Immediate word - -{ s" dup" wid1 @ search-wordlist -> xt @ -1 } -{ s" .(" wid1 @ search-wordlist -> xti @ 1 } -{ s" dup" wid2 @ search-wordlist -> 0 } - -: c"dup" c" dup" ; -: c".(" c" .(" ; -: c"x" c" unknown word" ; - -{ c"dup" find -> xt @ -1 } -{ c".(" find -> xti @ 1 } -{ c"x" find -> c"x" 0 } - -\ -------------------------------------------------------------------- - -Testing new definitions are put into the correct wordlist - -: alsowid2 also get-order wid2 @ rot drop swap set-order ; -alsowid2 -: w1 1234 ; -definitions -: w1 -9876 ; immediate - -only forth -{ w1 -> 1234 } -definitions -{ w1 -> 1234 } -alsowid2 -{ w1 -> -9876 } -definitions -{ w1 -> -9876 } - -only forth definitions - -: so5 dup if swap execute then ; - -{ s" w1" wid1 @ search-wordlist so5 -> -1 1234 } -{ s" w1" wid2 @ search-wordlist so5 -> 1 -9876 } - -: c"w1" c" w1" ; -{ alsowid2 c"w1" find so5 -> 1 -9876 } -{ previous c"w1" find so5 -> -1 1234 } - -\ -------------------------------------------------------------------- - -Testing order \ Should display search order and compilation wordlist - -cr .( ONLY FORTH DEFINITIONS search order and compilation list) cr -{ only forth definitions order -> } - -cr .( Plus another unnamed wordlist at the head of the search order) cr -{ alsowid2 definitions order -> } - -\ -------------------------------------------------------------------- - -cr .( Tests on Search Order words completed successfully) cr - -only forth definitions \ Leave search order in the standard state diff --git a/amforth-6.5/common/lib/forth2012/tester/stringtest.fth b/amforth-6.5/common/lib/forth2012/tester/stringtest.fth deleted file mode 100644 index 95e2bfe..0000000 --- a/amforth-6.5/common/lib/forth2012/tester/stringtest.fth +++ /dev/null @@ -1,161 +0,0 @@ -\ To test the ANS Forth String word set - -\ This program was written by Gerry Jackson in 2006, with contributions from -\ others where indicated, and is in the public domain - it can be distributed -\ and/or modified in any way but please retain this notice. - -\ This program is distributed in the hope that it will be useful, -\ but WITHOUT ANY WARRANTY; without even the implied warranty of -\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. - -\ The tests are not claimed to be comprehensive or correct - -\ ------------------------------------------------------------------------------ -\ Version 0.6 1 April 2012 Tests placed in the public domain. -\ 0.5 29 April 2010 Added tests for SEARCH and COMPARE with -\ all strings zero length (suggested by Krishna Myneni). -\ SLITERAL test amended in line with comp.lang.forth -\ discussion -\ 0.4 30 November 2009 and replaced with TRUE -\ and FALSE -\ 0.3 6 March 2009 { and } replaced with T{ and }T -\ 0.2 20 April 2007 ANS Forth words changed to upper case -\ 0.1 Oct 2006 First version released - -\ ------------------------------------------------------------------------------ -\ The tests are based on John Hayes test program for the core word set -\ and requires those files to have been loaded - -\ Words tested in this file are: -\ -TRAILING /STRING BLANK CMOVE CMOVE> COMPARE SEARCH SLITERAL -\ -\ ------------------------------------------------------------------------------ -\ Assumptions and dependencies: -\ - tester.fr or ttester.fs has been loaded prior to this file -\ - COMPARE is case sensitive -\ ------------------------------------------------------------------------------ - -TESTING String word set - -DECIMAL - -T{ : s1 S" abcdefghijklmnopqrstuvwxyz" ; -> }T -T{ : s2 S" abc" ; -> }T -T{ : s3 S" jklmn" ; -> }T -T{ : s4 S" z" ; -> }T -T{ : s5 S" mnoq" ; -> }T -T{ : s6 S" 12345" ; -> }T -T{ : s7 S" " ; -> }T -T{ : s8 S" abc " ; -> }T -T{ : s9 S" " ; -> }T -T{ : s10 S" a " ; -> }T - -\ ------------------------------------------------------------------------------ -TESTING -TRAILING - -T{ s1 -TRAILING -> s1 }T -T{ s8 -TRAILING -> s8 2 - }T -T{ s7 -TRAILING -> s7 }T -T{ s9 -TRAILING -> s9 DROP 0 }T -T{ s10 -TRAILING -> s10 1- }T - -\ ------------------------------------------------------------------------------ -TESTING /STRING - -T{ s1 5 /STRING -> s1 SWAP 5 + SWAP 5 - }T -T{ s1 10 /STRING -4 /STRING -> s1 6 /STRING }T -T{ s1 0 /STRING -> s1 }T - -\ ------------------------------------------------------------------------------ -TESTING SEARCH - -T{ s1 s2 SEARCH -> s1 TRUE }T -T{ s1 s3 SEARCH -> s1 9 /STRING TRUE }T -T{ s1 s4 SEARCH -> s1 25 /STRING TRUE }T -T{ s1 s5 SEARCH -> s1 FALSE }T -T{ s1 s6 SEARCH -> s1 FALSE }T -T{ s1 s7 SEARCH -> s1 TRUE }T -T{ s7 PAD 0 SEARCH -> s7 TRUE }T - -\ ------------------------------------------------------------------------------ -TESTING COMPARE - -T{ s1 s1 COMPARE -> 0 }T -T{ s1 PAD SWAP CMOVE -> }T -T{ s1 PAD OVER COMPARE -> 0 }T -T{ s1 PAD 6 COMPARE -> 1 }T -T{ PAD 10 s1 COMPARE -> -1 }T -T{ s1 PAD 0 COMPARE -> 1 }T -T{ PAD 0 s1 COMPARE -> -1 }T -T{ s1 s6 COMPARE -> 1 }T -T{ s6 s1 COMPARE -> -1 }T -T{ s7 PAD 0 COMPARE -> 0 }T - -: "abdde" S" abdde" ; -: "abbde" S" abbde" ; -: "abcdf" S" abcdf" ; -: "abcdee" S" abcdee" ; - -T{ s1 "abdde" COMPARE -> -1 }T -T{ s1 "abbde" COMPARE -> 1 }T -T{ s1 "abcdf" COMPARE -> -1 }T -T{ s1 "abcdee" COMPARE -> 1 }T - -: s11 S" 0abc" ; -: s12 S" 0aBc" ; - -T{ s11 s12 COMPARE -> 1 }T -T{ s12 s11 COMPARE -> -1 }T - -\ ------------------------------------------------------------------------------ -TESTING CMOVE and CMOVE> - -PAD 30 CHARS 0 FILL -T{ s1 PAD SWAP CMOVE -> }T -T{ s1 PAD s1 SWAP DROP COMPARE -> 0 }T -T{ s6 PAD 10 CHARS + SWAP CMOVE -> }T -T{ S" abcdefghij12345pqrstuvwxyz" PAD s1 SWAP DROP COMPARE -> 0 }T -T{ PAD 15 CHARS + PAD CHAR+ 6 CMOVE -> }T -T{ S" apqrstuhij12345pqrstuvwxyz" PAD 26 COMPARE -> 0 }T -T{ PAD PAD 3 CHARS + 7 CMOVE -> }T -T{ S" apqapqapqa12345pqrstuvwxyz" PAD 26 COMPARE -> 0 }T -T{ PAD PAD CHAR+ 10 CMOVE -> }T -T{ S" aaaaaaaaaaa2345pqrstuvwxyz" PAD 26 COMPARE -> 0 }T -T{ s7 PAD 14 CHARS + SWAP CMOVE -> }T -T{ S" aaaaaaaaaaa2345pqrstuvwxyz" PAD 26 COMPARE -> 0 }T - -PAD 30 CHARS 0 FILL - -T{ s1 PAD SWAP CMOVE> -> }T -T{ s1 PAD s1 SWAP DROP COMPARE -> 0 }T -T{ s6 PAD 10 CHARS + SWAP CMOVE> -> }T -T{ S" abcdefghij12345pqrstuvwxyz" PAD s1 SWAP DROP COMPARE -> 0 }T -T{ PAD 15 CHARS + PAD CHAR+ 6 CMOVE> -> }T -T{ S" apqrstuhij12345pqrstuvwxyz" PAD 26 COMPARE -> 0 }T -T{ PAD 13 CHARS + PAD 10 CHARS + 7 CMOVE> -> }T -T{ S" apqrstuhijtrstrstrstuvwxyz" PAD 26 COMPARE -> 0 }T -T{ PAD 12 CHARS + PAD 11 CHARS + 10 CMOVE> -> }T -T{ S" apqrstuhijtvvvvvvvvvvvwxyz" PAD 26 COMPARE -> 0 }T -T{ s7 PAD 14 CHARS + SWAP CMOVE> -> }T -T{ S" apqrstuhijtvvvvvvvvvvvwxyz" PAD 26 COMPARE -> 0 }T - -\ ------------------------------------------------------------------------------ -TESTING BLANK - -: s13 S" aaaaa a" ; \ Don't move this down or might corrupt PAD - -T{ PAD 25 CHAR a FILL -> }T -T{ PAD 5 CHARS + 6 BLANK -> }T -T{ PAD 12 s13 COMPARE -> 0 }T - -\ ------------------------------------------------------------------------------ -TESTING SLITERAL - -T{ HERE DUP s1 DUP ALLOT ROT SWAP CMOVE s1 SWAP DROP 2CONSTANT s1a -> }T -T{ : s14 [ s1a ] SLITERAL ; -> }T -T{ s1a s14 COMPARE -> 0 }T -T{ s1a DROP s14 DROP = -> FALSE }T - -\ ------------------------------------------------------------------------------ - -CR .( End of String word tests) CR diff --git a/amforth-6.5/common/lib/forth2012/tester/tester-amforth.frt b/amforth-6.5/common/lib/forth2012/tester/tester-amforth.frt deleted file mode 100644 index 01d3ca5..0000000 --- a/amforth-6.5/common/lib/forth2012/tester/tester-amforth.frt +++ /dev/null @@ -1,66 +0,0 @@ -\ From: John Hayes S1I -\ Subject: tester.fr -\ Date: Mon, 27 Nov 95 13:10:09 PST - -\ (C) 1995 JOHNS HOPKINS UNIVERSITY / APPLIED PHYSICS LABORATORY -\ MAY BE DISTRIBUTED FREELY AS LONG AS THIS COPYRIGHT NOTICE REMAINS. -\ VERSION 1.1 - -\ modified for amforth by Matthias Trute 2007 - -\ SET THE FOLLOWING FLAG TO TRUE FOR MORE VERBOSE OUTPUT; THIS MAY -\ ALLOW YOU TO TELL WHICH TEST CAUSED YOUR SYSTEM TO HANG. -variable VERBOSE - 0 VERBOSE ! - -variable ACTUAL-DEPTH \ STACK RECORD -variable START-DEPTH - -: EMPTY-STACK \ ( ... -- ) EMPTY STACK: HANDLES UNDERFLOWED STACK TOO. - depth START-DEPTH @ < if - depth START-DEPTH @ swap do 0 loop - then - depth START-DEPTH @ > if - depth START-DEPTH @ do drop loop - then -; - -: ERROR \ ( C-ADDR U -- ) DISPLAY AN ERROR MESSAGE FOLLOWED BY - \ THE LINE THAT HAD THE ERROR. - itype source type cr \ DISPLAY LINE CORRESPONDING TO ERROR - EMPTY-STACK \ THROW AWAY EVERY THING ELSE -; - -variable ACTUAL-DEPTH \ STACK RECORD -variable ACTUAL-RESULTS 20 cells allot \ reserve space in RAM - -: t{ \ ( -- ) SYNTACTIC SUGAR. - depth START-DEPTH ! -; - -: -> \ ( ... -- ) RECORD DEPTH AND CONTENT OF STACK. - depth dup ACTUAL-DEPTH ! \ RECORD DEPTH - START-DEPTH @ > if \ IF THERE IS SOMETHING ON STACK - depth START-DEPTH @ - 0 do ACTUAL-RESULTS i cells + ! loop \ SAVE THEM - then -; - -: }t \ ( ... -- ) COMPARE STACK (EXPECTED) CONTENTS WITH SAVED - depth ACTUAL-DEPTH @ = if \ IF DEPTHS MATCH - depth START-DEPTH @ > if \ IF THERE IS SOMETHING ON THE STACK - depth START-DEPTH @ - 0 do \ FOR EACH STACK ITEM - ACTUAL-RESULTS i cells + @ \ COMPARE ACTUAL WITH EXPECTED - <> if s" INCORRECT RESULT: " ERROR leave then - loop - then - else \ DEPTH MISMATCH - s" WRONG NUMBER OF RESULTS: " ERROR - then -; - -: TESTING \ ( -- ) TALKING COMMENT. - source VERBOSE @ - if dup >r type cr r> >in ! - else >in ! drop - then ; - diff --git a/amforth-6.5/common/lib/forth2012/tester/toolstest.fth b/amforth-6.5/common/lib/forth2012/tester/toolstest.fth deleted file mode 100644 index a35450b..0000000 --- a/amforth-6.5/common/lib/forth2012/tester/toolstest.fth +++ /dev/null @@ -1,172 +0,0 @@ -\ To test some of the ANS Forth Programming Tools and extension wordset - -\ This program was written by Gerry Jackson in 2006, with contributions from -\ others where indicated, and is in the public domain - it can be distributed -\ and/or modified in any way but please retain this notice. - -\ This program is distributed in the hope that it will be useful, -\ but WITHOUT ANY WARRANTY; without even the implied warranty of -\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. - -\ The tests are not claimed to be comprehensive or correct - -\ ------------------------------------------------------------------------------ -\ Version 0.6 1 April 2012 Tests placed in the public domain. -\ Further tests on [IF] [ELSE] [THEN] -\ 0.5 30 November 2009 and replaced with TRUE and FALSE -\ 0.4 6 March 2009 ENDIF changed to THEN. {...} changed to T{...}T -\ 0.3 20 April 2007 ANS Forth words changed to upper case -\ 0.2 30 Oct 2006 updated following GForth test to avoid -\ changing stack depth during a colon definition -\ 0.1 Oct 2006 First version released - -\ ------------------------------------------------------------------------------ -\ The tests are based on John Hayes test program - -\ Words tested in this file are: -\ AHEAD [IF] [ELSE] [THEN] CS-PICK CS-ROLL -\ - -\ Words not tested: -\ .S ? DUMP SEE WORDS -\ ;CODE ASSEMBLER BYE CODE EDITOR FORGET STATE -\ ------------------------------------------------------------------------------ -\ Assumptions and dependencies: -\ - tester.fr or ttester.fs has been loaded prior to this file -\ ------------------------------------------------------------------------------ - -DECIMAL - -\ ------------------------------------------------------------------------------ -TESTING AHEAD - -T{ : pt1 AHEAD 1111 2222 THEN 3333 ; -> }T -T{ pt1 -> 3333 }T - -\ ------------------------------------------------------------------------------ -TESTING [IF] [ELSE] [THEN] - -T{ TRUE [IF] 111 [ELSE] 222 [THEN] -> 111 }T -T{ FALSE [IF] 111 [ELSE] 222 [THEN] -> 222 }T - -T{ TRUE [IF] 1 \ Code spread over more than 1 line - 2 - [ELSE] - 3 - 4 - [THEN] -> 1 2 }T -T{ FALSE [IF] - 1 2 - [ELSE] - 3 4 - [THEN] -> 3 4 }T - -T{ TRUE [IF] 1 TRUE [IF] 2 [ELSE] 3 [THEN] [ELSE] 4 [THEN] -> 1 2 }T -T{ FALSE [IF] 1 TRUE [IF] 2 [ELSE] 3 [THEN] [ELSE] 4 [THEN] -> 4 }T -T{ TRUE [IF] 1 FALSE [IF] 2 [ELSE] 3 [THEN] [ELSE] 4 [THEN] -> 1 3 }T -T{ FALSE [IF] 1 FALSE [IF] 2 [ELSE] 3 [THEN] [ELSE] 4 [THEN] -> 4 }T - -\ ------------------------------------------------------------------------------ -TESTING immediacy of [IF] [ELSE] [THEN] - -T{ : pt2 [ 0 ] [IF] 1111 [ELSE] 2222 [THEN] ; pt2 -> 2222 }T -T{ : pt3 [ -1 ] [IF] 3333 [ELSE] 4444 [THEN] ; pt3 -> 3333 }T -: pt9 bl WORD FIND ; -T{ pt9 [IF] NIP -> 1 }T -T{ pt9 [ELSE] NIP -> 1 }T -T{ pt9 [THEN] NIP -> 1 }T - -\ ----------------------------------------------------------------------------- -TESTING [IF] and [ELSE] carry out a text scan by parsing and discarding words -\ so that an [ELSE] or [THEN] in a comment or string is recognised - -: pt10 REFILL DROP REFILL DROP ; - -T{ 0 [IF] \ Words ignored up to [ELSE] 2 - [THEN] -> 2 }T -T{ -1 [IF] 2 [ELSE] 3 s" [THEN] 4 pt10 ignored to end of line" - [THEN] \ Precaution in case [THEN] in string isn't recognised - -> 2 4 }T - -\ ------------------------------------------------------------------------------ -TESTING CS-PICK and CS-ROLL - -\ Test pt5 based on example in ANS document p 176. - -: ?repeat - 0 CS-PICK POSTPONE UNTIL -; IMMEDIATE - -VARIABLE pt4 - -T{ : pt5 ( n1 -- ) - pt4 ! - BEGIN - -1 pt4 +! - pt4 @ 4 > 0= ?repeat \ Back to BEGIN if false - 111 - pt4 @ 3 > 0= ?repeat - 222 - pt4 @ 2 > 0= ?repeat - 333 - pt4 @ 1 = - UNTIL -; -> }T - -T{ 6 pt5 -> 111 111 222 111 222 333 111 222 333 }T - - -T{ : ?DONE POSTPONE IF 1 CS-ROLL ; IMMEDIATE -> }T \ Same as WHILE -T{ : pt6 - >R - BEGIN - R@ - ?DONE - R@ - R> 1- >R - REPEAT - R> DROP - ; -> }T - -T{ 5 pt6 -> 5 4 3 2 1 }T - -: mix_up 2 CS-ROLL ; IMMEDIATE \ cs-rot - -: pt7 ( f3 f2 f1 -- ? ) - IF 1111 ROT ROT ( -- 1111 f3 f2 ) ( cs: -- orig1 ) - IF 2222 SWAP ( -- 1111 2222 f3 ) ( cs: -- orig1 orig2 ) - IF ( cs: -- orig1 orig2 orig3 ) - 3333 mix_up ( -- 1111 2222 3333 ) ( cs: -- orig2 orig3 orig1 ) - THEN ( cs: -- orig2 orig3 ) - 4444 \ Hence failure of first IF comes here and falls through - THEN ( cs: -- orig2 ) - 5555 \ Failure of 3rd IF comes here - THEN ( cs: -- ) - 6666 \ Failure of 2nd IF comes here -; - -T{ -1 -1 -1 pt7 -> 1111 2222 3333 4444 5555 6666 }T -T{ 0 -1 -1 pt7 -> 1111 2222 5555 6666 }T -T{ 0 0 -1 pt7 -> 1111 0 6666 }T -T{ 0 0 0 pt7 -> 0 0 4444 5555 6666 }T - -: [1cs-roll] 1 CS-ROLL ; IMMEDIATE - -T{ : pt8 - >R - AHEAD 111 - BEGIN 222 - [1cs-roll] - THEN - 333 - R> 1- >R - R@ 0< - UNTIL - R> DROP - ; -> }T - -T{ 1 pt8 -> 333 222 333 }T - -\ ------------------------------------------------------------------------------ - -CR .( End of Programming Tools word tests) CR diff --git a/amforth-6.5/common/lib/forth2012/tools.frt b/amforth-6.5/common/lib/forth2012/tools.frt deleted file mode 100644 index fdc8f08..0000000 --- a/amforth-6.5/common/lib/forth2012/tools.frt +++ /dev/null @@ -1,6 +0,0 @@ -\ 'tools.frt' generated automatically, do not edit -#include defined.frt -#include dot-s.frt -#include dumper.frt -#include dump.frt -#include question.frt diff --git a/amforth-6.5/common/lib/forth2012/tools/bracket-conditional.frt b/amforth-6.5/common/lib/forth2012/tools/bracket-conditional.frt deleted file mode 100644 index 5df8c28..0000000 --- a/amforth-6.5/common/lib/forth2012/tools/bracket-conditional.frt +++ /dev/null @@ -1,20 +0,0 @@ - -: [else] \ ( -- ) - begin - begin - parse-name - dup - while - 2dup s" [else]" icompare - ?dup 0= - if exit then - repeat 2drop - refill 0= - until -; immediate - -: [if] \ ( flag -- ) - 0= if postpone [else] then -; immediate - -: [then] ; immediate diff --git a/amforth-6.5/common/lib/forth2012/tools/defined.frt b/amforth-6.5/common/lib/forth2012/tools/defined.frt deleted file mode 100644 index cef7e78..0000000 --- a/amforth-6.5/common/lib/forth2012/tools/defined.frt +++ /dev/null @@ -1,10 +0,0 @@ - -\ http://www.forth200x.org/defined.html -\ adapted to non-counted strings - -: [defined] parse-name find-name dup if swap drop then ; immediate -: [undefined] postpone [defined] 0= ; immediate - -\ ... and without postpone (Enoch, Feb-2013) -\ : [defined] parse-name find-name if drop -1 else 0 then ; immediate -\ : [undefined] parse-name find-name if drop 0 else -1 then ; immediate diff --git a/amforth-6.5/common/lib/forth2012/tools/dot-s.frt b/amforth-6.5/common/lib/forth2012/tools/dot-s.frt deleted file mode 100644 index 1c86dd8..0000000 --- a/amforth-6.5/common/lib/forth2012/tools/dot-s.frt +++ /dev/null @@ -1,3 +0,0 @@ - -\ a .s with the TOS printed *last* -: .s depth 0 ?do depth i - 1- pick . loop ; \ No newline at end of file diff --git a/amforth-6.5/common/lib/forth2012/tools/dump.frt b/amforth-6.5/common/lib/forth2012/tools/dump.frt deleted file mode 100644 index fba47d7..0000000 --- a/amforth-6.5/common/lib/forth2012/tools/dump.frt +++ /dev/null @@ -1,50 +0,0 @@ - -\ dump memories -\ usage is -\ addr len [ei]dump -\ output looks like (for word oriented memories) -\ (ATmega32)> 0 10 edump -\ 0000 - FFFF D9FF 17D9 2117 0121 5201 0052 DE00 .......!!..RR... -\ 0008 - 0CDE 6F0C 3B6F 193B 0019 3200 0B32 140B ...oo;;....22... - -\ RAM dump is byte oriented: -\ 00B0 BD 3E 55 33 5B E6 C4 9B 4A 63 72 20 63 72 20 24 .>U3[...Jcr.cr.$ -\ 00C0 62 30 20 32 30 20 64 75 6D 70 20 63 72 20 63 72 b0.20.dump.cr.cr - -hex - -: ?ascii ( char -- printable-char ) - dup 20 < if drop 2e - else dup 7e > - if drop 2e then - then ; - -: .2hex s>d <# # # #> type ; -: .4hex s>d <# # # # # #> type ; - -: dump ( addr count -- ) - cr 0 - do dup .4hex space - 10 0 do dup i + c@ .2hex space loop 2 spaces - 10 0 do dup i + c@ ?ascii emit loop - 10 + cr - 10 +loop drop ; - -: split ( n - c c ) dup $ff and swap $ff00 and $100 / $ff and swap ; - -: idump ( addr count -- ) - cr 0 - do dup .4hex space [char] - emit space - 8 0 do dup i + @i .4hex space loop 2 spaces - 8 0 do dup i + @i split ?ascii emit ?ascii emit loop - 8 + cr - 8 +loop drop ; - -: edump ( addr count -- ) - cr 0 - do dup .4hex space [char] - emit space - 08 0 do dup i cells + @e .4hex space loop 2 spaces - 08 0 do dup i cells + @e split ?ascii emit ?ascii emit loop - 10 + cr - 10 +loop drop ; - diff --git a/amforth-6.5/common/lib/forth2012/tools/dumper.frt b/amforth-6.5/common/lib/forth2012/tools/dumper.frt deleted file mode 100644 index fdb1c09..0000000 --- a/amforth-6.5/common/lib/forth2012/tools/dumper.frt +++ /dev/null @@ -1,57 +0,0 @@ -\ dump cells from addr upward for len. mk03.10.2008 - -\ We want xdump ( addr len -- ) doing output like this: -\ xxx0 cccc cccc cccc cccc cccc cccc cccc cccc -\ xxx8 cccc cccc cccc cccc cccc cccc cccc cccc -\ ... - -\ That is, we alway print 8 cells. And want to see them in segments of 8 cells, -\ all starting at xxx0 or xxx8 addresses. -\ So we have to trimm addr and len first: -\ Clear lower 3 bits of addr, then set lower 3 bits of len -\ The rest shoud be obvious. - -hex - -\ helper word -\ print a number in a field with 0 filled -: u.r ( u w -- ) - >r 0 \ see u. - <# - r> 0 ?do # loop - #> - type -; - -( item -- ) -: .item 4 u.r space ; - -( addr -- ) -: i? @i .item ; -: e? @e .item ; -: ? @ .item ; - -( addr n -- addr+n ) -: .icells 0 do dup i? 1+ loop ; \ flash -: .ecells 0 do dup e? cell+ loop ; \ eeprom -: .rcells 0 do dup ? cell+ loop ; \ ram - -( addr -- ) -: .addr cr .item space ; - -( addr1 len1 -- addr2 len2 ) -: trimm swap fff8 and swap 7 or ; - -( adr len -- ) -: postpone +loop postpone drop ; immediate - -( addr len -- ) -: idump ; -: edump ; -: dump ; - -\ finis tested ok on amforth-2.9 05.10.2008 mk diff --git a/amforth-6.5/common/lib/forth2012/tools/name2compile.frt b/amforth-6.5/common/lib/forth2012/tools/name2compile.frt deleted file mode 100644 index fa50d2b..0000000 --- a/amforth-6.5/common/lib/forth2012/tools/name2compile.frt +++ /dev/null @@ -1,9 +0,0 @@ - -: name>compile ( nt -- xt1 xt2) - dup nfa>cfa swap name>flags immediate? 1 = if - ['] execute - else - ['] , - then -; - diff --git a/amforth-6.5/common/lib/forth2012/tools/name2interpret.frt b/amforth-6.5/common/lib/forth2012/tools/name2interpret.frt deleted file mode 100644 index 417980a..0000000 --- a/amforth-6.5/common/lib/forth2012/tools/name2interpret.frt +++ /dev/null @@ -1,4 +0,0 @@ - -: name>interpret ( nt -- xt ) - nfa>cfa -; diff --git a/amforth-6.5/common/lib/forth2012/tools/question.frt b/amforth-6.5/common/lib/forth2012/tools/question.frt deleted file mode 100644 index bd96e6c..0000000 --- a/amforth-6.5/common/lib/forth2012/tools/question.frt +++ /dev/null @@ -1,4 +0,0 @@ - -\ displays the value of the given address with current base -: ? ( addr -- ) - @ . ; diff --git a/amforth-6.5/common/lib/forth2012/tools/see.frt b/amforth-6.5/common/lib/forth2012/tools/see.frt deleted file mode 100644 index 5b5fda5..0000000 --- a/amforth-6.5/common/lib/forth2012/tools/see.frt +++ /dev/null @@ -1,56 +0,0 @@ -hex -\ decompiler - -\ marker --see-- - -: .name ( nfa -- ) \ Namensfeld ausgeben - icount $ff and dup 15 < if itype else drop drop ." :noname" then ; - -' exit constant exitxt \ Adresse des xt zu "exit" speichern -' cr @i constant docolxt \ Adresse des Forth-DOCOLON VM Interpreter -' cr 1+ @i constant litxt \ Adresse des xt zu "(lit)" speichern -' bl @i constant dovarxt \ Adresse des xt zu "VARIABLE" -' base @i constant douser \ Adresse des xt zu "USER" -' emit @i constant dodefer \ -' s" 9 + @i constant doslit \ Adresse des xt zu "(slit)" speichern -' if 2 + @i constant do0branch \ Adresse des xt zu "0branch" speichern -' else 2 + @i constant dobranch \ Adresse des xt zu "branch" speichern -' loop 2 + @i constant doloop \ Adresse des xt zu "(loop)" speichern -' +loop 2 + @i constant do+loop \ Adresse des xt zu "(+loop)" speichern -' do 2 + @i constant dodo \ Adresse des xt zu "(do)" speichern -' ?do 2 + @i constant doqdo \ Adresse des xt zu "(?do)" speichern - -: see ( "name" -- ) \ decompiler - parse-name find-name if - dup @i over - 1 = if dup >name .name space ." is a primitive" then - dup @i dovarxt = if ." variable " 1+ dup @i . then - dup @i douser = if ." user " 1+ dup @i . then - dup @i dodefer = if ." defer " then - dup @i docolxt = if - [char] : emit space dup >name .name - begin - cr [char] [ emit space dup u. [char] ] emit space 2 spaces - 1+ dup @i dup 4 .r space ( get next xt ) - dup litxt = if drop 1+ dup @i . 0 then - dup exitxt = if drop [char] ; emit 1 then - dup doslit = if - drop [char] . emit [char] " emit space 1+ dup .name [char] " emit - dup @i $FF and 2/ 2 + + 0 - then - dup do0branch = if drop ." 0branch -> " 1+ dup @i 1- u. 0 then - dup dobranch = if drop ." branch -> " 1+ dup @i 1- u. 0 then - dup dodo = if drop ." do -> " 1+ dup @i 1- u. 0 then - dup doqdo = if drop ." ?do -> " 1+ dup @i 1- u. 0 then - dup doloop = if drop ." loop -> " 1+ dup @i 1- u. 0 then - dup do+loop = if drop ." +loop -> " 1+ dup @i 1- u. 0 then - dup 1 > if dup >name .name then - 1 = - until then - drop - else - ." not found" - then -; - -\ Beispiel: -\ ' see see diff --git a/amforth-6.5/common/lib/forth2012/tools/synonym.frt b/amforth-6.5/common/lib/forth2012/tools/synonym.frt deleted file mode 100644 index bb51c61..0000000 --- a/amforth-6.5/common/lib/forth2012/tools/synonym.frt +++ /dev/null @@ -1,12 +0,0 @@ -\ SYNONYM - -\ -\ does not check for reference to itself -\ -: synonym - create immediate ' , - does> - @i state @ if , else execute then -; - -\ : synonym : bl word find >r compile, postpone ; r> 0> IF immedate THEN ; \ No newline at end of file diff --git a/amforth-6.5/common/lib/fsm.frt b/amforth-6.5/common/lib/fsm.frt deleted file mode 100644 index 94af976..0000000 --- a/amforth-6.5/common/lib/fsm.frt +++ /dev/null @@ -1,67 +0,0 @@ -\ FSM routines, from a paper presented by J . Noble----- -\ --------------------------------------------------------- -\ you can find the paper at http://www.forth.org/literature/noble.html -\ The fsm: word has been modified to correctly increment addresses by -\ word, instead of byte. and to also use the i@ dictionary fetch word. -\ Ver 1.1 fsm: now implements "The best FSM so far" (see paper). State -\ is now a heap variable with it's address in the dictionary of the fsm. -\ Written by Bernard Mentink - -marker _fsm_ - -hex - -\ dummy nop word for readability -: wide ; - -\ perform word that executes vector -: perform - @i execute ; - -\ Get 2 cells from dictionary space -: 2@i - dup 1+ @i swap @i ; - -\ comment if you have this word. -: tuck swap over ; - -\ Allocate a RAM variable on the data space, init with x, and return RAM address -: >ram ( x -- addr ) here 1 cells allot tuck ! ; - - -\ This word creates FSM transition tables -: fsm: ( width -- ) - create 0 >ram , , ] \ ram addr of state stored in dict,also width. - does> ( col# adr -- ) - dup dup >r 2@i @ * 2* + ( -- col#+width*state ) - swap 2* 1+ 1+ + ( -- offset-to-action) - dup >r ( -- offset-to-action) - perform ( ? ) - r> 1+ ( -- offset-to-update) - perform ( -- state') - r> @i ! ; \ update state - - -\ ......... some test code .............. -\ un-comment the code lines to test state changes dependant on input supplied -\ e.g 2 test_fsm, 0 test_fsm etc -\ If you want the address of the state variable associated with your state -\ machine, create the following word : mystate ['] test_fsm 1+ i@ ; - -\ : one ." one " ; -\ : two ." two " ; -\ : three ." three " ; -\ : four ." four " ; -\ : nop ." nop " ; - -\ 0 constant >0 -\ 1 constant >1 -\ 2 constant >2 - -\ a test state-machine table -\ 4 wide fsm: test_fsm -\ input: | 0 | 1 | 2 | 3 | -\ state: --------------------------------------------- -\ ( 0 ) nop >0 one >1 one >1 two >2 -\ ( 1 ) four >1 one >1 nop >1 two >2 -\ ( 2 ) nop >2 two >2 nop >2 nop >2 ; diff --git a/amforth-6.5/common/lib/hardware/1wire-crc8-test.frt b/amforth-6.5/common/lib/hardware/1wire-crc8-test.frt deleted file mode 100644 index 1c628d6..0000000 --- a/amforth-6.5/common/lib/hardware/1wire-crc8-test.frt +++ /dev/null @@ -1,54 +0,0 @@ -\ 2013-01-21 EW - -marker --start-- - -include ewlib/1wire_crc8.fs - -\ testdata from Dallas Application Note 27 -\ A2 00 00 00 01 B8 1C 02 -\ ^^crc fam.code^^ - -: run_test - $A2 \ crc - $00 $00 $00 $01 $B8 $1C $02 \ rom id - #7 \ N - .s - 1w.crc8? if - ." crc ok" - else - ." crc error" - then - cr - $A2 1+ \ WRONG CRC! - $00 $00 $00 $01 $B8 $1C $02 \ rom id - #7 \ N - .s - 1w.crc8? if - ." crc ok" - else - ." crc error" - then - cr - - \ reverse test - $02 $1C $B8 $01 $00 $00 $00 $A2 - #7 .s - 1w.crc8.rev? if - ." crc ok" - else - ." crc error" - then - cr - - $02 $1C $B8 $01 $00 $00 $00 $A2 1+ \ WRONG CRC! - #7 .s - 1w.crc8.rev? if - ." crc ok" - else - ." crc error" - then - cr - - -; - diff --git a/amforth-6.5/common/lib/hardware/1wire-crc8.frt b/amforth-6.5/common/lib/hardware/1wire-crc8.frt deleted file mode 100644 index e727ac7..0000000 --- a/amforth-6.5/common/lib/hardware/1wire-crc8.frt +++ /dev/null @@ -1,65 +0,0 @@ -\ 2013-01-21 EW ewlib/1wire_crc8.fs -\ 1wire 8bit crc check, as used by ds18s20 -\ based on C code by Colin O'Flynn and M.Thomas, found at -\ http://www.siwawi.arubi.uni-kl.de/avr_projects/tempsensor/ds18x20_demo_20110209.zip - - -$18 constant 1w.crc8.polynom -variable 1w.crc.shreg \ crc shift register -variable 1w.crc.byte \ current input byte -variable 1w.crc.fbit \ feedbackbit - -\ process 1 bit from input -: ((1w.crc8)) - 1w.crc.shreg @ 1w.crc.byte @ xor $01 and - dup 1w.crc.fbit ! - if \ fbit set - 1w.crc.shreg @ 1w.crc8.polynom xor - 1w.crc.shreg ! - then - 1w.crc.shreg @ 1 rshift $7f and - 1w.crc.shreg ! - 1w.crc.fbit @ if - 1w.crc.shreg @ $80 or - 1w.crc.shreg ! - then -; -\ process 1 byte of input -: (1w.crc8) ( x -- ) - ( tos ) 1w.crc.byte ! - 8 0 do - ((1w.crc8)) - 1w.crc.byte @ 1 rshift - 1w.crc.byte ! - loop -; - -\ process N bytes from stack, leave crc -: 1w.crc8 ( xN-1 .. x0 N -- crc ) - 0 1w.crc.shreg ! - 0 1w.crc.byte ! - 0 1w.crc.fbit ! - 0 ?do - (1w.crc8) - loop - 1w.crc.shreg @ -; -\ process N bytes from stack, compare with crc, leave flag -: 1w.crc8? ( crc xN-1 .. x0 N -- t/f ) - 1w.crc8 = -; - -\ same as 1w.crc8, but process data in reverse (stack) order! -: 1w.crc8.rev ( x0 .. xN-1 N -- crc ) - 0 1w.crc.shreg ! - 0 1w.crc.byte ! - 0 1w.crc.fbit ! - 1 over ?do i pick (1w.crc8) -1 +loop - 0 ?do drop loop - 1w.crc.shreg @ -; -: 1w.crc8.rev? ( x0 .. xN-1 crc N -- t/f ) - swap >r \ save crc - 1w.crc8.rev - r> = -; diff --git a/amforth-6.5/common/lib/hardware/1wire-ds18s20.frt b/amforth-6.5/common/lib/hardware/1wire-ds18s20.frt deleted file mode 100644 index 95be0c1..0000000 --- a/amforth-6.5/common/lib/hardware/1wire-ds18s20.frt +++ /dev/null @@ -1,32 +0,0 @@ -\ 2009-12-23 EW ewlib/1w_ds18s20.fs -\ 2013-01-13 ported to amforth-5.0 - -\ --- Fam.10 DS18S20 thermometer ----------------------------- - -\ conversion + warten ist schon rum! -: 1w.rd.T ( addr[8] -- x1=Tl x2=Th x3 .. x9=crc ) - 1w.reset drop \ fixme: if ... then - \ device addressieren - 1w.cmd.matchrom &9 >1w - 1w.cmd.readdata &1 >1w - &9 <1w -; - -\ convert answer to physical units 1/100 C -: ds18s20.decode ( x1 .. x9=crc -- T*100 ok ) - 7 0 do drop loop \ ignore crc - 8 lshift + \ combine T_h T_l - &100 &2 */ \ scale - 0 \ ok, because we ignore crc -; -: ds18s20.decode.check ( x1 .. x9=crc -- T*100 ok=0 | error=1 ) - 7 pick >r 8 pick >r \ save data - 8 1w.crc8.rev? if \ crc good? - r> r> 8 lshift + - &100 &2 */ - 0 \ ok - else - r> r> drop drop - 1 \ error - then -; \ No newline at end of file diff --git a/amforth-6.5/common/lib/hardware/1wire.frt b/amforth-6.5/common/lib/hardware/1wire.frt deleted file mode 100644 index 6d96759..0000000 --- a/amforth-6.5/common/lib/hardware/1wire.frt +++ /dev/null @@ -1,222 +0,0 @@ -\ Adapted from 4e4th: -\ all relevant words are lowercase. -\ romid is now a forth 2012 buffer. -\ assembly part rewritten from scratch -\ renamed to file extension frt -\ requires buffer: -\ NAME -\ 1wire.frt -\ SYNOPSIS -\ Example high-level Forth functions for Dallas 1-wire devices -\ DESCRIPTION -\ -\ USES -\ Uses the following kernel functions (provided by 1wire.asm) -\ 1W.RESET [ -- f ] Initialize 1-wire devices; return true if present -\ 1W.SLOT [ c -- c' ] Write and read one bit to/from 1-wire. -\ -\ COPYRIGHT -\ [c] 2012 Bradford J. Rodriguez. -\ -\ This program is free software; you can redistribute it and/or modify -\ it under the terms of the GNU General Public License as published by -\ the Free Software Foundation; either version 3 of the License, or -\ [at your option] any later version. -\ -\ This program is distributed in the hope that it will be useful, -\ but WITHOUT ANY WARRANTY; without even the implied warranty of -\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -\ GNU General Public License for more details. -\ -\ You should have received a copy of the GNU General Public License -\ along with this program. If not, see . -\ -\ Commercial inquiries should be directed to the author at -\ 115 First St., #105, Collingwood, Ontario L9Y 4W3 Canada -\ or via email to bj@camelforth.com -\ ****** - - -\ Basic 1-wire operations -\ 1W.TOUCH ( c1 -- c2 ) Write and read one byte to/from 1-wire bus. -\ This implements the "touch byte" function described in Dallas -\ Application Note 74. It expects a byte c1 which is sent over the -\ 1-wire bus. To perform a read operation, this must be FF hex. -\ The returned byte c2 is the data read back from the bus. For a -\ read operation, this is the read data; for a write operation, this -\ has no significance and can be discarded. -\ -\ C!1W ( c -- ) Write one byte to the 1-wire bus. -\ This uses 1W.TOUCH to write one byte of data. The value returned -\ by 1W.TOUCH is discarded. -\ -\ C@1W ( -- c ) Read one byte from the 1-wire bus. -\ This uses 1W.TOUCH with an input parameter of FF hex to read one -\ byte from a 1-wire device. -\ - -\ #include buffer.frt - -: 1w.touch ( c1 -- c2 ) - 1w.slot 1w.slot 1w.slot 1w.slot - 1w.slot 1w.slot 1w.slot 1w.slot ; - -: c!1w ( c -- ) 1w.touch drop ; -: c@1w ( -- c ) $ff 1w.touch ; -: n>1w ( xN .. x1 N -- ) 0 ?do c!1w loop ; -: n<1w ( N -- x1 .. xN ) 0 ?do c@1w loop ; - -\ SHOWID should be used ONLY if there is a single 1-wire device attached. -: 1w.showid - 1w.reset if base @ hex - $33 c!1w - c@1w . c@1w . c@1w . c@1w . - c@1w . c@1w . c@1w . c@1w . - base ! - then ; - -\ Maxim 1-wire ROM Search algorithm -\ per AN937 "Book of iButton Standards", figure 5-3 - -variable lastdisc ( used as byte variable ) -lastdisc 1+ constant doneflag ( used as byte variable ) - -variable rombit ( used as byte variable, 1..64 ) -rombit 1+ constant discmark ( used as byte variable ) - -8 buffer: romid ( 8 byte array ) - -: !rombit ( f -- ) - rombit c@ 1- 8 /mod ( -- f bit# byte# ) - romid + ( -- f bit# addr ) - 1 rot lshift ( -- f addr bitmask ) - rot if ( f true, set bit ) - over c@ or swap c! - else ( f false, clear bit ) - invert over c@ and swap c! - then -; - -: @rombit ( -- f ) - rombit c@ 1- 8 /mod ( -- bit# byte# ) - romid + c@ ( -- bit# byte ) - 1 rot lshift ( -- byte bitmask ) - and -; - -: newsearch 0 lastdisc ! ; ( clear LASTDISC and DONEFLAG ) - -: romsearch ( -- f ) ( Returns 0 or 1 ) - 0 ( default return value ) - doneflag c@ if - 0 doneflag c! - exit - then - 1w.reset if ( presence signal detected? ) - - 1 rombit c! ( yes: set ROM bit index to 1 ) - 0 discmark c! ( set discrepancy marker to 0 ) - $f0 c!1w ( send search command on bus ) - begin - $03 1w.slot 1w.slot ( read two bits: ba000000 ) - dup $c0 = if ( bitA = bitB = 1?) - drop - 0 lastdisc c! - exit - else dup 0= if ( bitA = bitB = 0?) - drop - rombit c@ lastdisc c@ = if - 1 !rombit - else rombit c@ lastdisc c@ > if - 0 !rombit - rombit c@ discmark c! - else @rombit 0= if - rombit c@ discmark c! - then then then - else - $40 and ( bit A value ) - !rombit - then then - @rombit if 1 else 0 then 1w.slot drop ( send ROM bit to bus ) - rombit c@ 1+ dup rombit c! - $40 > until - discmark c@ dup lastdisc c! - 0= if - 1 doneflag c! - else - drop 1 ( set return value to true ) - then - - else ( no presence signal ) - 0 lastdisc c! - then -; - -\ Demonstrates how to use ROMSEARCH to find all attached devices ) - -: 1w.scan ( -- ) - 1w.reset if ( presence signal detected? ) - base @ hex - newsearch - begin - romsearch - romid 8 + romid do i c@ 3 u.r loop cr - 0= until - cr base ! - then -; - -\ 1w.current is the device the host is currently -\ communicating with. -8 buffer: 1w.current - -\ define a 1wire device. At compile time -\ take 8 numbers from the stack, at runtime -\ copy these numbers to owcurrent and give -\ this address back to the caller -\ e.g. -\ > hex 1w.scan -\ 28 4C 75 CC 2 0 0 CD -\ ok -\ > 28 4C 75 CC 2 0 0 CD 1w.device: sensor1 -\ > sensor1 ( -- addr) -\ note that the byte order is the same that -\ 1w.scan prints, your numbers will be different. -: 1w.device: - ( n1 .. n8 -- ) - create - , , , , , , , , - does> - ( -- n1 .. n8 ) - 8 bounds do - i @i - loop ; - -\ Start an addressed command. This sends RESET, Match ROM [55h], -\ and the 8 bytes of ROMID. It should be followed by a DS18B20 -\ function command. - -: 1w.matchrom ( rom-id -- ) - 1w.reset if - $55 c!1w ( send Match ROM command ) - 8 0 do c!1w loop ( send 8 id bytes ) - else ." failed" drop then -; - -: 1w.skiprom ( -- ) - 1w.reset if - $cc c!1w - then -; - -\ Function commands that address a single device. -\ They require either a 1w.skiprom to talk to the -\ only device present on the bus or 1w.matchrom with -\ a specific ROM-ID to activate a specific one. - -: 1w.dumpscratch ( -- ) ( display 9 bytes of scratchpad ) - $BE c!1w - c@1w . c@1w . c@1w . c@1w . - c@1w . c@1w . c@1w . c@1w . - c@1w . -; diff --git a/amforth-6.5/common/lib/hardware/date-time.frt b/amforth-6.5/common/lib/hardware/date-time.frt deleted file mode 100644 index 13e5d25..0000000 --- a/amforth-6.5/common/lib/hardware/date-time.frt +++ /dev/null @@ -1,29 +0,0 @@ - -\ create task space -$20 $20 0 task: t:date&time - -variable seconds -\ runs every second -: job-date&time - 1 seconds +! - \ more code for minute/hour/day... - 0 \ flag for an endless loop -; - -\ set up the task -: setup-date&time - t:date&time task-init \ create TCB in RAM - 0 seconds ! \ more code for minutes etc - t:date&time tcb>tid activate - \ code from here is executed as task, later on - ['] job-date&time every-second -; - -\ setup and start the task "date/time" -: turnkey-date&time - onlytask \ set up multitasker - 6 timer0.init timer0.start \ 16 MHz quartz - \ insert task into task list - setup-date&time t:date&time tcb>tid alsotask - multi \ start multitasking -; diff --git a/amforth-6.5/common/lib/hardware/i2c-compass.frt b/amforth-6.5/common/lib/hardware/i2c-compass.frt deleted file mode 100644 index daa6380..0000000 --- a/amforth-6.5/common/lib/hardware/i2c-compass.frt +++ /dev/null @@ -1,49 +0,0 @@ -\ -\ compass module mmc2120 (memsic) -\ hwid is always $30 -\ provides: -\ -\ i2c.compass.get ( -- status X Y) -\ X and Y are around 2000 (raw data) -\ status is 0 if no error occured - -\ dechiffer of the raw data: -\ according to http://www.aurob.com/?p=467 -\ interpolate linearly -\ x=map(1900,2188,-180,180) -\ y=map(1910,2193,-180,180) -\ grad=atan2(x,y)*180/pi - -#require i2c.frt -#require ms.frt - -$30 constant i2c.compass - -\ internal commands -: i2c.compass.setcoil - %00000010 0 2 i2c.compass i2c.n! -; -: i2c.compass.resetcoil - %00000100 0 2 i2c.compass i2c.n! -; - -: i2c.compass.measure - %00000001 0 2 i2c.compass i2c.n! -; - -: i2c.compass.fetchdata ( -- status x y ) - 5 0 i2c.compass i2c.n@ - ( -- status msb-x lsb-x msb-y lsb-y) - swap >< or $fff and >r \ Y - swap >< or $fff and r> \ X -; - -\ get the raw data from the module -\ the numbers for X/Y are usually around 2000. -\ status is 0 if everything is ok -: i2c.compass.get ( -- status x y ) - i2c.compass.resetcoil 1ms - i2c.compass.setcoil 5 ms - i2c.compass.measure 5 ms - i2c.compass.fetchdata -; diff --git a/amforth-6.5/common/lib/hardware/i2c-detect.frt b/amforth-6.5/common/lib/hardware/i2c-detect.frt deleted file mode 100644 index 6bd7fe4..0000000 --- a/amforth-6.5/common/lib/hardware/i2c-detect.frt +++ /dev/null @@ -1,40 +0,0 @@ -\ detect presence of all possible devices on I2C bus -\ only the 7 bit address schema is supported - -\ not all bitpatterns are valid 7bit i2c addresses -: i2c.7bitaddr? ( a -- f) $7 $78 within ; - -: i2c.detect ( -- ) - base @ hex - \ header line - 4 spaces $10 0 do i 3 .r loop - $80 0 do - i $0f and 0= if - cr i 2 .r [char] : emit space - then - i i2c.7bitaddr? if - i i2c.ping? if \ does device respond? - i 3 .r - else - ." --" - then - else - ." " - then - loop - cr base ! -; - -\ output looks like -\ (ATmega1280)> i2c.detect -\ 0 1 2 3 4 5 6 7 8 9 A B C D E F -\ 0: -- -- -- -- -- -- -- -- -- -\ 10: -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -\ 20: -- -- -- -- -- -- -- 27 -- -- -- -- -- -- -- -- -\ 30: -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -\ 40: -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -\ 50: 50 -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -\ 60: -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -\ 70: -- -- -- -- -- -- -- -- -\ ok -\ diff --git a/amforth-6.5/common/lib/hardware/i2c-eeprom-block.frt b/amforth-6.5/common/lib/hardware/i2c-eeprom-block.frt deleted file mode 100644 index 22351fb..0000000 --- a/amforth-6.5/common/lib/hardware/i2c-eeprom-block.frt +++ /dev/null @@ -1,77 +0,0 @@ -\ -\ I2C EEPROM driver for BLOCK wordset -\ -\ call i2c.ee.blockinit to activate the driver -\ for the BLOCK words. - -#require blocks.frt -#require bounds.frt -#require i2c-eeprom.frt -#require ms.frt - -\ select a eeprom module. -\ the pages differ in size. -\ do not overrun them -#16 constant 24c08 -#16 constant 24c16 -#32 constant 24c32 -#32 constant 24c64 -#64 constant 24c128 -#64 constant 24c256 -#128 constant 24c512 -#256 constant 24c1024 - -\ runtime configurable parameters, taken from or -\ calculated in i2c.ee.blockinit. Never change them directly -variable i2c.ee.hwid -variable i2c.ee.pagesize -variable i2c.ee.pages/block - -: i2c.ee.read-page ( addr len page hwid -- ) - dup i2c.begin - swap i2c.ee.pagesize @ * i2c.ee.send-addr - i2c.restart \ repeated start - i2c.rd i2c.tx - 1- bounds over >r ?do i2c.rx i c! loop - i2c.rxn r> c! \ last byte - i2c.end -; - -: i2c.ee.load-buffer ( a-addr u -- ) \ BLOCK API - 1- i2c.ee.pages/block @ * \ start address - i2c.ee.pages/block @ bounds ?do - dup i2c.ee.pagesize @ i i2c.ee.hwid @ i2c.ee.read-page - i2c.ee.pagesize @ + - loop drop -; - -: i2c.ee.write-page ( addr len page hwid -- ) - i2c.begin - i2c.ee.pagesize @ * i2c.ee.send-addr - bounds ?do i c@ i2c.tx loop - i2c.end 5 ms \ make sure the eeprom gets ready again -; - -: i2c.ee.save-buffer ( a-addr u -- ) \ BLOCK API - 1- i2c.ee.pages/block @ * \ start address - i2c.ee.pages/block @ bounds ?do - dup i2c.ee.pagesize @ i i2c.ee.hwid @ i2c.ee.write-page - i2c.ee.pagesize @ + - loop drop -; - -\ adjust the page size and update the #pages per block buffer -: i2c.ee.setpagesize ( 24cxx -- ) - blocksize over / i2c.ee.pages/block ! - i2c.ee.pagesize ! -; - -\ for turnkey -\ does not initialize TWI/I2C interface! (i2c.init.default) -: i2c.ee.blockinit ( pagesize hwid -- ) - block:init - ['] i2c.ee.load-buffer is load-buffer - ['] i2c.ee.save-buffer is save-buffer - i2c.ee.hwid ! - i2c.ee.setpagesize -; diff --git a/amforth-6.5/common/lib/hardware/i2c-eeprom-value.frt b/amforth-6.5/common/lib/hardware/i2c-eeprom-value.frt deleted file mode 100644 index 50f0941..0000000 --- a/amforth-6.5/common/lib/hardware/i2c-eeprom-value.frt +++ /dev/null @@ -1,19 +0,0 @@ -\ -\ A value stored in I2C EEPROM. -\ - -#require value.frt -#require quotations.frt -#require ms.frt -#require i2c-eeprom.frt - -\ initial addr hwid ... -\ 17 0 $50 i2c.value "name" -: i2c.ee.value ( n addr hwid -- ) - (value) - over , \ store the addr - [: dup @i ( addr ) swap 3 + @i ( hwid) @i2c.ee ;] , - [: dup @i ( addr ) swap 3 + @i ( hwid) !i2c.ee 5 ms ;] , - dup , \ store hwid - !i2c.ee \ store inital data -; diff --git a/amforth-6.5/common/lib/hardware/i2c-eeprom.frt b/amforth-6.5/common/lib/hardware/i2c-eeprom.frt deleted file mode 100644 index 7468933..0000000 --- a/amforth-6.5/common/lib/hardware/i2c-eeprom.frt +++ /dev/null @@ -1,47 +0,0 @@ -\ -\ Basic Access to I2C EEPROM -\ -\ useful words are -\ [¢]@i2c.ee/[c]!i2c.ee -\ See cookbook for further information - -#require i2c.frt - -: i2c.ee.send-addr ( n -- ) - dup >< i2c.tx ( high byte ) i2c.tx ( low byte ) - \ no stop condition -; - -\ The write methods do not wait afterwards! -\ at least 5ms have to pass -: c!i2c.ee ( c addr hwid -- ) - i2c.begin - i2c.ee.send-addr - i2c.tx - i2c.end -; - -: !i2c.ee ( c addr hwid -- ) - i2c.begin - i2c.ee.send-addr - dup >< i2c.tx i2c.tx - i2c.end -; - -: c@i2c.ee ( addr hwid -- c ) - dup i2c.begin - swap i2c.ee.send-addr - i2c.start \ repeated start - i2c.rd i2c.tx \ hwid for reading - i2c.rx - i2c.end -; - -: @i2c.ee ( addr hwid -- n ) - dup i2c.begin - swap i2c.ee.send-addr - i2c.start \ repeated start - i2c.rd i2c.tx \ hwid for reading - i2c.rx >< i2c.rxn or - i2c.end -; diff --git a/amforth-6.5/common/lib/hardware/i2c-lcd.frt b/amforth-6.5/common/lib/hardware/i2c-lcd.frt deleted file mode 100644 index b404f21..0000000 --- a/amforth-6.5/common/lib/hardware/i2c-lcd.frt +++ /dev/null @@ -1,31 +0,0 @@ - -\ #require i2c-pe.frt - -$27 Evalue i2c.lcd.hwid - -%00010000 Evalue lcd.En \ enable bit -%00100000 Evalue lcd.Rw \ read/write bit -%01000000 Evalue lcd.Rs \ register select bit - -: i2c.lcd.pulse ( n -- ) - dup lcd.En or i2c.pe.c! - lcd.En invert and i2c.pe.c! -; - -: i2c.lcd.!4bit ( n -- ) - dup i2c.pe.c! - i2c.lcd.pulse -; - -: i2c.lcd.send ( c mode -- ) - >r dup >< $0f and r@ or i2c.lcd.!4bit ( high ) - $0f and r> or i2c.lcd.!4bit ( low ) -; - -: i2c.lcd.cmd ( c -- ) - 0 i2c.lcd.send -; - -: i2c.lcd.write ( c -- ) - lcd.Rs i2c.lcd.send -; diff --git a/amforth-6.5/common/lib/hardware/i2c-value.frt b/amforth-6.5/common/lib/hardware/i2c-value.frt deleted file mode 100644 index 7638be6..0000000 --- a/amforth-6.5/common/lib/hardware/i2c-value.frt +++ /dev/null @@ -1,23 +0,0 @@ -\ -\ an I2C value -\ - -#require values.frt -#require quotations.frt -#require i2c.frt - -\ initial hwid ... -\ 17 $3D i2c.cvalue "name" -: i2c.cvalue ( n addr hwid -- ) - (value) - dup , \ store the hwid - [: dup @i ( hwid) i2c.c@ ;] , - [: dup @i ( hwid) i2c.c! ;] , - i2c.c! \ store inital data -; - -\ use case: port extender -\ $ff $3d i2c.cvalue keys -\ $00 to keys ( turn all off ) -\ keys $01 and if ( if key 1 is pressed ) -\ diff --git a/amforth-6.5/common/lib/hardware/i2c.frt b/amforth-6.5/common/lib/hardware/i2c.frt deleted file mode 100644 index 8941c5f..0000000 --- a/amforth-6.5/common/lib/hardware/i2c.frt +++ /dev/null @@ -1,87 +0,0 @@ -\ basic I2C operations, uses 7bit bus addresses -\ uses the TWI module of the Atmega's. -\ #require builds.frt -\ #require bitnames.frt - -\ low level driver words -\ #require i2c-twi-master.frt - -\ provides public commands - -\ i2c.begin -- starts a I2C bus cycle -\ i2c.end -- ends a I2C bus cycle -\ the following operation use a complete bus cycle -\ i2c.c! -- send one byte -\ i2c.c@ -- read one byte -\ i2c.n! -- send n bytes to device -\ i2c.n@ -- read n bytes from device -\ i2c.m!n@ -- first send m bytes, than read n bytes - -\ convert the bus address into a sendable byte -\ the address bits are the upper 7 ones, -\ the LSB is the read/write bit. - -: i2c.wr 2* ; -: i2c.rd 2* 1+ ; - -\ aquire the bus and select a device -\ start a write transaction -: i2c.begin ( hwid -- ) - dup i2c.current ! - i2c.start i2c.wr i2c.tx -; - -\ start a read transaction -: i2c.begin-read ( hwid -- ) - dup i2c.current ! - i2c.start i2c.rd i2c.tx -; - -\ release the bus and deselect the device -: i2c.end ( -- ) - i2c.stop - 0 i2c.current ! -; - -\ tranfser data from/to data stack - -\ fetch a byte from the device -: i2c.c@ ( hwid -- c ) - i2c.begin-read - i2c.rxn - i2c.end -; - -\ store a byte to a device -: i2c.c! ( c hwid -- ) - i2c.begin - i2c.tx - i2c.end -; - -\ send n bytes to device -: i2c.n! ( xn .. x1 N hwid -- ) - i2c.begin - 0 ?do \ uses N - i2c.tx \ send x1 ... xn - loop - i2c.end -; - -\ get n bytes from device -: i2c.n@ ( n hwid -- x1 .. xn ) - i2c.begin-read - 1- 0 max 0 ?do i2c.rx loop i2c.rxn - i2c.end -; - -\ complex and flexible transaction word -\ send m bytes x1..xm and fetch n bytes y1..yn afterwards -: i2c.m!n@ ( n xm .. x1 m hwid -- x1 .. xn ) - dup >r i2c.begin - 0 ?do i2c.tx loop \ send m bytes - i2c.restart \ repeated start - r> i2c.rd i2c.tx \ re-send addr, switch to read mode - 1- 0 max 0 ?do i2c.rx loop i2c.rxn \ read x1 .. xn - i2c.end -; diff --git a/amforth-6.5/common/lib/hardware/int-critical-test.frt b/amforth-6.5/common/lib/hardware/int-critical-test.frt deleted file mode 100644 index ac07fe7..0000000 --- a/amforth-6.5/common/lib/hardware/int-critical-test.frt +++ /dev/null @@ -1,14 +0,0 @@ - -\ #require int-critical.frt - -: bar ." bar" int? . ; -: baz ." baz" int? . ; -: qux ." qux" int? . ; - -: foo - bar - critical[ - \ nothing will disturb us here - baz - ]critical \ now interrupts or other things may happen again - qux ; diff --git a/amforth-6.5/common/lib/hardware/int-critical.frt b/amforth-6.5/common/lib/hardware/int-critical.frt deleted file mode 100644 index d3bbf7f..0000000 --- a/amforth-6.5/common/lib/hardware/int-critical.frt +++ /dev/null @@ -1,12 +0,0 @@ - -\ include mcu specific file -\ #require int-q.frt - -: critical[ - r> int? >r >r \ keep the current state - -int -; - -: ]critical - r> r> if +int then >r \ will crash if not matched -; diff --git a/amforth-6.5/common/lib/hardware/mmc-test.frt b/amforth-6.5/common/lib/hardware/mmc-test.frt deleted file mode 100644 index b69fd90..0000000 --- a/amforth-6.5/common/lib/hardware/mmc-test.frt +++ /dev/null @@ -1,96 +0,0 @@ -\ MMC+SD card - Lubos Pekny, www.forth.cz -\ Library for amforth 3.0, mFC modification -\ Max. 4GB no SDHC, access thru buffer 512B or short block or direct - -\ V.1.0, 16.07.2009, tested on atmega32, amforth30mFC12.zip -\ - used SPI (MOSI, MISO, SCK, SS) -\ mmc_init, mmc_CID, mmc_CSD, mmc_read, mmc_mread, mmc_write, -\ mmc_blk@, mmc_blk!, mmc_c@, mmc_c!, mmc_end?, mmc_end! - -hex - -\ ----- Test ----- - -mmc_init . \ init card -mmc_CID . 10 0 mmc. \ view 16B of mmc_buf -mmc_CSD . 10 0 mmc. - - -\ read -200 1234 0 mmc_read . \ read 512B from sect. 0:1234 -200 0 mmc. \ view buf - - -\ open+read, short block -100 1234 0 mmc_read . \ open sector 0:1234, read 256B -mmc_buf 100 + 100 mmc_blk@ \ read 256B, buf+offset 256B -200 0 mmc. \ view buf - - -\ open, short block -0 1234 0 mmc_read . \ open sector 0:1234 -mmc_buf 100 + 100 mmc_blk@ \ read 256B, buf+offset 256B -mmc_buf 100 mmc_blk@ \ read 256B, switched 256B -200 0 mmc. \ view buf - - -\ open, direct byte access -0 1234 0 mmc_read . \ open sector 0:1234 -+mmc -mmc_c@ . mmc_c@ . \ read 2 bytes from sector -1FE mmc_dummy \ read other 510 bytes -1FE mmc_#buf +! \ update counter -mmc_end? . \ if end of sector then crc dummy --mmc - - -\ multiread -200 1234 0 mmc_mread . \ open,read 512B from sect. 1234 -200 0 mmc. \ view buf -+mmc -200 0 mmc_(read) . \ read 512B from sect. 1235 -200 0 mmc. \ view buf -200 0 mmc_(read) . \ read 512B from sect. 1236 -200 0 mmc. \ view buf -mmc_rstop . \ stop and -mmc - - -\ write -200 1234 0 mmc_read . -200 0 mmc. -ABBA mmc_buf ! \ change 2 bytes in buf -200 1234 0 mmc_write . \ write 512B to addr. 1234 -200 1234 0 mmc_read . -200 0 mmc. - - -\ open+write, short block -ACCA mmc_buf ! \ change 2 bytes in buf -ADDA mmc_buf 100 + ! \ change 2 bytes in buf -100 1234 0 mmc_write . \ open sector 1234, write 256B -mmc_buf 100 + 100 mmc_blk! . \ write 256B, buf+offset 256B -200 1234 0 mmc_read . -200 0 mmc. - - -\ open, direct byte access -0 1234 0 mmc_write . -+mmc -AE mmc_c! EA mmc_c! \ write 2 bytes to sector -1FE mmc_dummy \ write FF, 510x -1FE mmc_#buf +! \ update counter -mmc_end! . \ if end then wait while busy --mmc -200 1234 0 mmc_read . -200 0 mmc. - - -\ multiwrite -ABCD mmc_buf ! -200 1234 0 mmc_mwrite . \ open,write 512B to sect. 1234 -+mmc -200 0 mmc_(mwrite) . \ write 512B to sect. 1235 -200 0 mmc_(mwrite) . \ write 512B to sect. 1236 -mmc_wstop . \ stop and -mmc - -\ end of file diff --git a/amforth-6.5/common/lib/hardware/power-save.frt b/amforth-6.5/common/lib/hardware/power-save.frt deleted file mode 100644 index 36e729f..0000000 --- a/amforth-6.5/common/lib/hardware/power-save.frt +++ /dev/null @@ -1,36 +0,0 @@ - -\ fixme: currently the controller sleep too often -\ that breaks the poll based emit almost completely -\ either use the interrupt based emit or include an -\ empty timer task that wakes the controller up -\ -: idle - begin - $0 sleep \ save power, returns on interrupt - pause \ give cpu away - again -; - -$20 $20 0 task: idle-task - -: start-idle-task - idle-task tcb>tid - activate \ words after this line are run in new task - idle -; - -: starttasker - idle-task task-init \ create TCB in RAM - start-idle-task \ activate tasks job - - onlytask \ make cmd loop task-1 - idle-task tcb>tid alsotask \ start task-2 - multi \ activate multitasking -; -: run-turnkey - applturnkey - init - starttasker -; - -\ ' run-turnkey is turnkey \ make run-turnkey start on power up diff --git a/amforth-6.5/common/lib/hardware/spi-mmc.frt b/amforth-6.5/common/lib/hardware/spi-mmc.frt deleted file mode 100644 index 7513e58..0000000 --- a/amforth-6.5/common/lib/hardware/spi-mmc.frt +++ /dev/null @@ -1,98 +0,0 @@ - - -: spi.init ( -- ) - +spi - spi.mode0 spi.setmode - -spi2x -; - -: spi.mmc.dummy ( x -- ) - 0 ?do $ff c!spi loop -; - -: spi.mmc.init ( -- ) - sd.init - spi.init - $11 spi.sd.dummy -; - -\ every command has 48 bits=6bytes -: mmc.cmd ( n1 n2 ... n6 -- ) - -mmc 20 ms \ de-select the card - $FF c!spi \ some random bits - +mmc 20 ms \ re-select the card - $40 or \ set bit 6 if the first byte assuming bit7 is 0 - &6 0 do c!spi loop ; \ send 48bits - - -\ response actions -\ there are different resonses: r1, r2, r3, r7 -\ r1 is the single byte response ( 0 means no error) -\ 0 b6 b5 b4 b3 b2 b1 b0 -\ | | | | | | | -\ | | | | | | In idle state -\ | | | | | Erase Reset -\ | | | | Illegal Command -\ | | | Command CRC error -\ | | Erase Sequence Error -\ | Address Error -\ Parameter Error - -\ waiting for cmd response -: mmc.cresp ( -- c|-1 ) - $FF 0 do - c@spi dup $80 and 0= \ bit7=0? - if unloop exit then \ -- c, 0=ok - drop \ -- - loop -1 ; \ -- -1, timeout - - -\ waiting for data response -: mmc.dresp ( -- c|-1 ) - $FF 0 do - c@spi dup $11 and 1 = \ xxx0ccc1 - if - $0F and unloop exit \ -- c, 5=ok - then - drop \ -- - loop -1 ; \ -- -1, timeout - -: R1 ( -- f ) - mmc.cresp -; - -: cmd0 ( -- f ) $95 0 0 0 0 0 mmc.cmd R1 1 = ; \ GO_IDLE_STATE - reset -: cmd1 ( -- f ) $ff 0 0 0 0 1 mmc.cmd R1 0= ; \ SEND_OP_COND init -: cmd16 ( -- ) $FF 0 0 2 0 16 mmc.cmd R1 drop ; \ SET_BLOCKLEN default 512 - -\ waiting for data token - -: mmc.wait_data_token ( -- f ) 0 16 0 do c@spi $FE = if drop true leave then loop ; - -\ read CSD and CID into a 16 byte buffer -16 buffer: mmc.infoblock - -: mmc.readblock ( addr len -- ) - mmc.wait_data_token - if - bounds do c@spi i c! loop - else abort" Could not read MMC data block" - then ; - -: cmd9 ( -- ) $ff 0 0 0 0 9 mmc.cmd R1 mmc.infoblock 16 mmc.readblock ; \ SEND_CSD -: cmd10 ( -- ) $ff 0 0 0 0 10 mmc.cmd R1 mmc.infoblock 16 mmc.readblock ; \ SEND_CID - -\ READ SINGLE BLOCK -: cmd17 ( addr n -- f ) - >r $ff ( CRC ) r> s>d 17 mmc.cmd R1 mmc.readblock ; - -: mmc.writeblock ( addr len -- ) - mmc.wait_data_token - if - bounds do i c@ c!spi loop - else abort" Could not write MMC data block" - then ; - -\ WRITE SINGLE BLOCK (n=512 bytes) -: cmd24 ( addr n -- f ) - >r $ff ( CRC ) r> s>d 24 mmc.cmd R1 mmc.writeblock ; diff --git a/amforth-6.5/common/lib/hardware/timer-test.frt b/amforth-6.5/common/lib/hardware/timer-test.frt deleted file mode 100644 index 7092892..0000000 --- a/amforth-6.5/common/lib/hardware/timer-test.frt +++ /dev/null @@ -1,22 +0,0 @@ -\ test routines for timer - -\ prints the tick value every second (or so) -\ until a key is pressed. Usage: -\ ' test-every-second every-second -: test-every-second - @tick u. key? -; - -\ runs a single word n-times. prints the milliseconds -\ for the whole run -\ usage -\ ' foo 10 benchme -\ executes too 10 times and prints the elapsed time - -: benchme ( xt n -- ) - dup >r - @tick >r - 0 ?do dup execute loop drop - @tick r> - - cr r> u. ." iterations in " u. ." ms" cr -; diff --git a/amforth-6.5/common/lib/hardware/timer.frt b/amforth-6.5/common/lib/hardware/timer.frt deleted file mode 100644 index 5e73b6e..0000000 --- a/amforth-6.5/common/lib/hardware/timer.frt +++ /dev/null @@ -1,56 +0,0 @@ -\ generic timer routines, based -\ upon hardware modules. - -\ requires -\ timer0.frt OR timer1.frt -\ provides -\ expired? -- checks whether a counter has expired -\ elapsed -- get the elapsed time in ms -\ after -- execute a word after n ms after now -\ ms -- alternative implementation for ANS94 ms -\ every -- runs a word every cycle. the word provides an exit flag -\ every-second -- runs a word every second -\ -: @tick - timer0.tick @ - \ timer1.tick @ - \ timer2.tick @ -; - -\ a timer is generally a timer tick number. -\ the actual meaning is either the start time -\ or the desired end time. All math is done -\ using unsigned numbers. The maximum interval -\ is 65.535 seconds (little more then a minute) - -\ check if the the timer t has expired -: expired? ( t -- flag ) - pause @tick - 0> invert -; - -\ alternative implementation for ms -: ms @tick + begin dup expired? until drop ; - -\ get the elapsed time since t -: elapsed ( t -- n ) - @tick swap - -; - -\ execute the word after u milliseconds -\ ex: ' foo 10 after -: after ( xt u -- ) - ms execute -; - -\ execute a word every u ms. The word -\ has the stack effect ( -- f). If f is -\ false, the loop ends -: every ( xt u -- ) - begin over over after until drop drop -; - -\ -: every-second ( xt -- ) - 1000 every -; - diff --git a/amforth-6.5/common/lib/hardware/vt100.frt b/amforth-6.5/common/lib/hardware/vt100.frt deleted file mode 100644 index ca84bd6..0000000 --- a/amforth-6.5/common/lib/hardware/vt100.frt +++ /dev/null @@ -1,59 +0,0 @@ -\ ansi terminal codes - -: ESC[ #27 emit [char] ] emit ; - -\ some helper words: print a number *without* -\ leading space in decimal -: .n base @ swap decimal 0 u.r base ! ; -: .;n [char] ; emit .n ; -: ESC[ #27 emit [char] [ emit ; - -\ position curser on terminal -: at-xy ( u1 u2 -- ) - 1+ swap 1+ swap ESC[ .n .;n [char] H emit -; - -\ clear page -: page ( -- ) - ESC[ ." 2J" 0 0 at-xy -; - -\ more definitions based on gforth' ansi.fs - -: foreground ( n -- | set foreground color to n ) - ESC[ #30 + .n [char] m emit -; - -: background ( n -- | set background color to n ) - ESC[ #40 + .n [char] m emit -; - -: text_normal ( -- | set normal text display ) - ESC[ [char] 0 emit [char] m emit -; - -: text_bold ( -- | set bold text ) - ESC[ [char] 1 emit [char] m emit -; - -: text_underline ( -- | set underlined text ) - ESC[ [char] 4 emit [char] m emit -; - -: text_blink ( -- | set blinking text ) - ESC[ [char] 5 emit [char] m emit -; - -: text_reverse ( -- | set reverse video text ) - ESC[ [char] 7 emit [char] m emit -; - - -#0 constant Black -#1 constant Red -#2 constant Green -#3 constant Yellow -#4 constant Blue -#5 constant Brown -#6 constant Cyan -#7 constant White diff --git a/amforth-6.5/common/lib/hardware/xonxoff.frt b/amforth-6.5/common/lib/hardware/xonxoff.frt deleted file mode 100644 index d6a59d9..0000000 --- a/amforth-6.5/common/lib/hardware/xonxoff.frt +++ /dev/null @@ -1,27 +0,0 @@ -\ -\ enrich the serial IO with XON/XOFF -\ this is not a complete and fool-proof -\ - -\ #requires is.frt - -$11 constant XON -$13 constant XOFF - -\ original refill -variable xt-refill - -: refill-xon - XON emit - xt-refill @ execute - XOFF emit -; - -: +xonxoff - ['] refill defer@ xt-refill ! - ['] refill-xon is refill -; - -: -xonxoff - xt-refill @ is refill -; diff --git a/amforth-6.5/common/lib/help-words.frt b/amforth-6.5/common/lib/help-words.frt deleted file mode 100644 index e3e85cd..0000000 --- a/amforth-6.5/common/lib/help-words.frt +++ /dev/null @@ -1,19 +0,0 @@ - -\ requires help - -get-current -help-wl set-current - -: emit - ." ( c -- ) " - ." R:( -- ) " - ." emits a single character on the terminal, calls pause" ; - -: key - ." ( -- c ) " - ." R: ( -- ) " - ." waits for a key stroke, calls pause " -; - - -set-current diff --git a/amforth-6.5/common/lib/help.frt b/amforth-6.5/common/lib/help.frt deleted file mode 100644 index 45e877e..0000000 --- a/amforth-6.5/common/lib/help.frt +++ /dev/null @@ -1,13 +0,0 @@ -\ small online help system - -\ usage -\ help -\ prints the stack effects and a short description - -wordlist constant help-wl - -: help - parse-name help-wl search-wordlist - if execute then -; - diff --git a/amforth-6.5/common/lib/in.frt b/amforth-6.5/common/lib/in.frt deleted file mode 100644 index b2af5f3..0000000 --- a/amforth-6.5/common/lib/in.frt +++ /dev/null @@ -1,36 +0,0 @@ -\ invented at the Euro Forth 2016 to -\ define a word in a vocabulary different -\ to CURRENT - -\ #require also.frt -\ #require previous.frt -\ #require definitions.frt - - -: in ( "voc" "defining-word" -- ) - get-current >r also ' execute - definitions previous ' execute r> set-current -; - -\ use as follows, require vocabulary.frt first -\ vocabulary gui -\ in gui : foo ( .. -- .. ) ... ; -\ in gui variable bar -\ in gui defer baz -\ show what's in gui -\ also gui words previous -\ remeber: gui is a vocabulary, not a wordlist -\ -\ Alternative implementation uses wordlist id's -\ instead of vocabularies. All the #require -\ lines can be omitted. -\ -\ : IN ( wid "action" -- ) -\ get-current >r set-current ' execute r> set-current ; -\ -\ use it like -\ wordlist constant gui -\ ... same as above -\ show the content of gui -\ gui show-wordlist -\ diff --git a/amforth-6.5/common/lib/iniside-q.frt b/amforth-6.5/common/lib/iniside-q.frt deleted file mode 100644 index 15c56e7..0000000 --- a/amforth-6.5/common/lib/iniside-q.frt +++ /dev/null @@ -1,3 +0,0 @@ - -: inside? ( x start len -- flag ) >r - r> u< ; - diff --git a/amforth-6.5/common/lib/local.frt b/amforth-6.5/common/lib/local.frt deleted file mode 100644 index 94cf86d..0000000 --- a/amforth-6.5/common/lib/local.frt +++ /dev/null @@ -1,63 +0,0 @@ -\ trivial local - -\ there is exactly one local called X -\ it is not initialized upon entry -\ it works like a local should do: -\ get the content by calling X, assign -\ a new value with TO - -\ separate local stack - -\ max. call depth 10 -#10 cells constant l-sizee - -\ the local stack pointer and the stack itself -l-size cell+ buffer: lsp - -\ initialize l-stackpointer, call it -\ in e.g. turnkey prior to use! -: l-init lsp l-size + lsp ! ; - -\ general stack access, unsued -: l@ lsp @ @ ; -: l! lsp @ ! ; -: l-free 1 cells lsp +! ; -: l-alloc -1 cells lsp +! ; -: >l l! l-alloc ; -: l> l-free l@ ; - -: local@ negate lsp @ + @ ; -: local! negate lsp @ + ! ; - -\ define a local by its offset -\ relative to the local stack pointer -: local ( offset "name" -- ) - (value) , - ['] local@ , - ['] local! , -; - -\ should be smarter, it should -\ check whether X is used at all -\ and allocate the local stack -\ only if needed. -: : : l-alloc ; -: ; l-free postpone ; ; immediate - -\ globally define a label for the first -\ local variable. The X is a global name -\ but has local content. If using more, -\ add a l-alloc/l-free pair in the : and ; -\ definitions above. - -0 local X - -\ test cases -\ l-init -\ : test1 to X X . ; -\ 1 test1 -\ -> 1 -\ : test2 1 test1 to X X . ; -\ 2 test2 -\ -> 1 2 -\ \ No newline at end of file diff --git a/amforth-6.5/common/lib/macro.frt b/amforth-6.5/common/lib/macro.frt deleted file mode 100644 index cde7dee..0000000 --- a/amforth-6.5/common/lib/macro.frt +++ /dev/null @@ -1,25 +0,0 @@ -\ source -\ Message-ID: -\ From: "Gerry" -\ Newsgroups: comp.lang.forth -\ Subject: Re: LC53 statistics -\ Date: Thu, 26 Nov 2009 16:52:34 -0000 - -\ macros are strings delimited by a single -\ character not to be used within the macro -\ itself - -: macro - : char parse postpone sliteral postpone evaluate - postpone ; immediate -; - -\ Usage is e.g. - -\ macro square " dup *" ok -\ : foo 5 square . ; ok -\ foo 25 ok -\ macro s2 - dup + - ok -\ : bar 6 s2 ; ok -\ bar 12 ok - diff --git a/amforth-6.5/common/lib/minus-loop.frt b/amforth-6.5/common/lib/minus-loop.frt deleted file mode 100644 index 89e2dbd..0000000 --- a/amforth-6.5/common/lib/minus-loop.frt +++ /dev/null @@ -1,15 +0,0 @@ -\ just like +loop but counts -\ downward for positive numbers. - -: -loop ( runtime: x -- ) - postpone negate postpone +loop -; immediate - -\ use case -\ : test 0 ?do i . 1 -loop ; -\ -2 test -\ prints -\ 0 -1 -2 -\ be aware that this is not common sense; gforth prints only -\ 0 -1 -\ \ No newline at end of file diff --git a/amforth-6.5/common/lib/modules-test.frt b/amforth-6.5/common/lib/modules-test.frt deleted file mode 100644 index df45c7c..0000000 --- a/amforth-6.5/common/lib/modules-test.frt +++ /dev/null @@ -1,15 +0,0 @@ -\ Test case for modules - Example code from -\ http://theforth.net/package/modules -\ http://theforth.net/package/modules/current-view/glossary.md - -\ #require modules.frt - -module greet - - : hello ." Hello " ; - : mods ." Modules " ; - - : hi hello mods ; - - export hi -end-module diff --git a/amforth-6.5/common/lib/modules.frt b/amforth-6.5/common/lib/modules.frt deleted file mode 100644 index 7948e58..0000000 --- a/amforth-6.5/common/lib/modules.frt +++ /dev/null @@ -1,28 +0,0 @@ -\ VFX like modules based on Forth-94 wordlists uho 2016-04-16 -\ ---------------------------------------------------------------- -\ http://theforth.net/package/modules -\ http://theforth.net/package/modules/current-view/glossary.md - -\ modified for amforth (@ -> @i for numbers kept in the dictionary ) - -\ #require set-order.frt -\ #require get-order.frt -\ #require previous.frt - -: module ( -- old-current ) - get-current wordlist create dup >r , - get-order r@ swap 1+ set-order - r> set-current ; - -: export ( old-current -- old-currrent ) - >r >in @ ' swap >in ! ( -- 'name ) - get-current r@ set-current ( -- 'name current ) - create swap , set-current r> - does> @i execute ; - -: expose-module ( -- ) - get-order ' >body @i swap 1+ set-order ; - -: end-module ( old-current -- ) - set-current previous ; - diff --git a/amforth-6.5/common/lib/multitask-messages.frt b/amforth-6.5/common/lib/multitask-messages.frt deleted file mode 100644 index af16249..0000000 --- a/amforth-6.5/common/lib/multitask-messages.frt +++ /dev/null @@ -1,14 +0,0 @@ -variable message \ the message box, the data exchanged itself. -cvariable sender \ a task local semaphore - -: send ( message -- ) - sender wait - message ! - sender signal -; - -: receive - sender wait - message @ - sender signal -; diff --git a/amforth-6.5/common/lib/multitask-new.frt b/amforth-6.5/common/lib/multitask-new.frt deleted file mode 100644 index 1612f32..0000000 --- a/amforth-6.5/common/lib/multitask-new.frt +++ /dev/null @@ -1,9 +0,0 @@ -\ Multitasker -\ new - -\ idea: fork the current task, leaving it empty -\ assign a new XT to it -\ start/stop/pause/resume it -\ PAUSE based -\ - diff --git a/amforth-6.5/common/lib/multitask-semaphore.frt b/amforth-6.5/common/lib/multitask-semaphore.frt deleted file mode 100644 index 3b9cca4..0000000 --- a/amforth-6.5/common/lib/multitask-semaphore.frt +++ /dev/null @@ -1,15 +0,0 @@ -\ Semaphores (Source: B. Rodriguez) -\ cvariable sem1 -\ : read sem1 wait do-something sem1 signal ; -\ do-something has the ressource controlled by sem1 exlusivly -\ wait can be used to communicate with interrupt service routines too -\ -: wait ( addr - ) - begin pause dup c@ until \ wait for non-zero = available - 0 swap c! -; - -: signal ( addr -- ) - 1 swap c! \ non-zero means available -; - diff --git a/amforth-6.5/common/lib/multitask-test.frt b/amforth-6.5/common/lib/multitask-test.frt deleted file mode 100644 index 8574bb9..0000000 --- a/amforth-6.5/common/lib/multitask-test.frt +++ /dev/null @@ -1,44 +0,0 @@ - -\ load the multitasker -\ #require multitask.frt - -: 1ms 1000 0 do 500 0 do loop loop ; - -: ms ( n -- ) \ call pause on wait - pause 0 ?do 1ms loop ; - - \ create a persistent task -variable N -: init - 0 N ! -; -\ --- task 2 --- -: demo-task - begin - 1 N +! - &500 ms - again ; - -$40 $40 0 task: task_demo \ allocate task data space - -: setup-demo-task - task_demo tib>tcb - activate \ words after this line are run in new task - demo-task -; - -: starttasker - task_demo task-init \ create TCB in RAM - setup-demo-task \ activate tasks job - - onlytask \ make cmd loop task-1 - task_demo tib>tcb alsotask \ start task-2 - multi \ activate multitasking -; -\ make this the turnkey vector -\ -: task-turnkey - applturnkey - init - starttasker -; diff --git a/amforth-6.5/common/lib/multitask.frt b/amforth-6.5/common/lib/multitask.frt deleted file mode 100644 index 4d2f699..0000000 --- a/amforth-6.5/common/lib/multitask.frt +++ /dev/null @@ -1,135 +0,0 @@ -\ lib/multitask.frt -\ ------------------------------------------------------------------- -\ Cooperative Multitasker based on -\ Message-ID: <1187362648.046634.262200@o80g2000hse.googlegroups.com> -\ From: Brad Eckert -\ Newsgroups: comp.lang.forth -\ Subject: Re: Tiny OS based on byte-code interpreter -\ Date: Fri, 17 Aug 2007 07:57:28 -0700 - -\ TCB (task control block) structure, identical to user area -\ Offs_| _Name___ | __Description__________________________ | -\ 0 | status | xt of word that resumes this task | <-- UP -\ 2 | follower | address of the next task's status | -\ 4 | RP0 | initial return stack pointer | -\ 6 | SP0 | initial data stack pointer | -\ 8 | sp | -> top of stack | -\ 10 | handler | catch/throw handler | -\ ... more user variables (mostly IO related) - -\ please note that with amforth rp@ @ accesses another location -\ than r@ due to hardware characteristics. - -\ marker _multitask_ -\ #require builds.frt - -#0 user status -#2 user follower - -:noname ( 'status1 -- 'status2 ) cell+ @ dup @ i-cell+ >r ; constant pass -:noname ( 'status1 -- ) up! sp @ sp! rp! ; constant wake - -\ switch to the next task in the list -: multitaskpause ( -- ) rp@ sp@ sp ! follower @ dup @ i-cell+ >r ; -: stop ( -- ) pass status ! pause ; \ sleep current task -: task-sleep ( tid -- ) pass swap ! ; \ sleep another task -: task-awake ( tid -- ) wake swap ! ; \ wake another task - -: cell- negate cell+ negate ; - -\ continue the code as a task in a predefined tcb -: activate ( tid -- ) - dup #6 + @ cell- - over #4 + @ cell- ( -- tid sp rp ) \ point to RP0 SP0 - r> over i-cell+ ! ( save entry at rp ) \ skip all after ACTIVATE - over ! ( save rp at sp ) \ save stack context for WAKE - over #8 + ! ( save sp in tos ) - task-awake -; - -\ task: allocates stack space and creates the task control block -\ alsotask appends the tcb to the (circular, existing) list of TCB - -: task: ( C: dstacksize rstacksize add.usersize "name" -- ) - ( R: -- task-information-block ) - - \ leave flash addr on stack -; - -: tib>tcb ( tib -- tcb ) @i ; -: tib>rp0 ( tib -- rp0 ) i-cell+ @i ; -: tib>sp0 ( tib -- sp0 ) i-cell+ i-cell+ @i ; -: tib>size ( tib -- size ) - dup tib>tcb swap tib>sp0 1+ swap - -; -: task-init ( tib -- ) - dup tib>tcb over tib>size 0 fill \ clear RAM for tcb and stacks - dup tib>sp0 over tib>tcb #6 + ! \ store sp0 in tcb[6] - dup tib>sp0 cell- over tib>tcb #8 + ! \ store sp0-- in tcb[8], tos - dup tib>rp0 over tib>tcb #4 + ! \ store rp0 in tcb[4] - #10 over tib>tcb #12 + ! \ store base in tcb[12] - tib>tcb task-sleep \ store 'pass' in tcb[0] -; - -\ stop multitasking -: single ( -- ) \ initialize the multitasker with the serial terminal - ['] noop ['] pause defer! -; - -\ start multitasking -: multi ( -- ) - ['] multitaskpause ['] pause defer! -; - - -\ initialize the multitasker with the current task only -: onlytask ( -- ) - wake status ! \ own status is running - up@ follower ! \ point to myself -; - - -\ insert new task structure into task list -: alsotask ( tid -- ) - ['] pause defer@ >r \ stop multitasking - single - follower @ ( -- tid f) - over ( -- tid f tid ) - follower ! ( -- tid f ) - swap cell+ ( -- f tid-f ) - ! - r> ['] pause defer! \ restore multitasking -; - -\ print all tasks with their id and status -: tasks ( -- ) - status ( -- tid ) \ starting value - dup - begin ( -- tid1 ctid ) - dup u. ( -- tid1 ctid ) - dup @ ( -- tid1 ctid status ) - dup wake = if ." running" drop else - pass = if ." sleeping" else - -1 abort" unknown" then - then -\ dup #4 + @ ." rp0=" dup u. cell- @ ." TOR=" u. -\ dup #6 + @ ." sp0=" dup u. cell- @ ." TOS=" u. -\ dup #8 + @ ." sp=" u. - cr - cell+ @ ( -- tid1 next-tid ) - 2dup = ( -- f flag) - until - 2drop - ." Multitasker is " - ['] pause defer@ ['] noop = if ." not " then - ." running" -; diff --git a/amforth-6.5/common/lib/profiler.frt b/amforth-6.5/common/lib/profiler.frt deleted file mode 100644 index d2515e7..0000000 --- a/amforth-6.5/common/lib/profiler.frt +++ /dev/null @@ -1,31 +0,0 @@ -\ A profiler counts the number of calls -\ of any word being defined afterwards. -\ -\ global state: on and off -variable profiling? -: profile:on -1 profiling? ! ; -: profile:off 0 profiling? ! ; - -: profiler profiling? @ if 1 swap +! else drop then ; -\ re-define colon -: : : - here 2 allot postpone literal postpone profiler -; - -\ get the address of the profiling data. -: xt>prf ( xt -- addr ) - cell+ @i -; - -\ useful stuff -: .prf xt>prf @ u. ; -: prf-reset xt>prf 0 swap ! ; - -\ usage -\ : foo bar baz ; -\ profile:on -- turn on profiling -\ ' foo .prf -- gets the number of calls to foo -\ ' foo prf-reset -- resets this number -\ profile:off -- turn off profiling -\ wanna profile system words? just re-define them now ;) -\ e.g. : + + ; diff --git a/amforth-6.5/common/lib/quotations.frt b/amforth-6.5/common/lib/quotations.frt deleted file mode 100644 index 7f7659b..0000000 --- a/amforth-6.5/common/lib/quotations.frt +++ /dev/null @@ -1,26 +0,0 @@ -\ anonymous definitions in a definition -\ typical usage -\ : foo ... [: some words ;] ... ; -\ -\ is equivalent to -\ -\ :noname some words ; Constant #temp# -\ : foo ... #temp# ... ; -\ -\ #require 2-fetch.frt -\ #require 2-store.frt - -: [: ( -- quotation-sys ) - postpone ahead - latest @ newest 2@ \ save definition state - :noname \ defines quotation-sys as ( -- latest newest XT ) ( 4 cells) -; immediate - -: ;] ( compile-time: quotation-sys -- ; run-time: -- xt ) - postpone ; >r - newest 2! latest ! \ restore definiion state - postpone then - r> - postpone literal - ] -; immediate diff --git a/amforth-6.5/common/lib/random.frt b/amforth-6.5/common/lib/random.frt deleted file mode 100644 index 4f2138c..0000000 --- a/amforth-6.5/common/lib/random.frt +++ /dev/null @@ -1,15 +0,0 @@ - -\ simple random number generator. -\ based upon comus by Will Baden - -variable rnd \ holds some entropy - -\ get a random number -: random ( -- n ) - rnd @ 31421 * 6927 + dup rnd ! -; - -\ get a random number between 0 and u -: rand ( u -- 0..u-1) - random um* nip ; -; diff --git a/amforth-6.5/common/lib/recognizer.frt b/amforth-6.5/common/lib/recognizer.frt deleted file mode 100644 index 87e812a..0000000 --- a/amforth-6.5/common/lib/recognizer.frt +++ /dev/null @@ -1,15 +0,0 @@ -\ common recognizer words -\ -\ platform specific code, selected via include directory -\ #include recognizer-arch.frt -\ -\ build the methods table for a recognizer -: dt:token: ( interpret-xt compile-xt postpone-xt "name" -- ) - create swap rot , , , -; - -\ get and set the stack content -: set-recognizers forth-recognizer set-stack ; -: get-recognizers forth-recognizer get-stack ; - -\ usage see Recognizer Recipes diff --git a/amforth-6.5/common/lib/regexp.frt b/amforth-6.5/common/lib/regexp.frt deleted file mode 100644 index eda1d4a..0000000 --- a/amforth-6.5/common/lib/regexp.frt +++ /dev/null @@ -1,65 +0,0 @@ -\ Regular Expressions by Brian W. Kernighan and Rob Pike -\ Believed to be in the public domain (The Beez) - -\ adaption for amforth by MT -Edefer (matchhere) - -: false 0 ; -: 0<> 0= 0= ; -\ end adaption for amforth - -: (match*) ( a n ra rn c --f) - begin - >r 2over 2over (matchhere) if r> drop 2drop 2drop true exit then - 2over if c@ dup [char] . = swap r@ = or else dup xor then r> swap - while \ character equals text? - >r 2>r 1 /string 2r> r> \ if so, match again - repeat - drop 2drop 2drop false \ clean up, return false -; - -: (match?) ( a n ra rn c --f) - >r 2over 2over (matchhere) if r> drop 2drop 2drop true exit then - 2over if c@ dup [char] . = swap r> = or else r> drop dup xor then - if 2>r 1 /string 2r> (matchhere) else 2drop 2drop false then -; \ character equals text? -:noname ( a n ra rn -- f) - dup if \ regular expression a null string? - over char+ c@ dup [char] * = \ if not, does it equal a '*' - if \ if so, call (match*) - drop over c@ >r 2 /string r> (match*) exit - else \ otherwise, does it equal a '?' - [char] ? = - if \ if so, call (match?) - over c@ >r 2 /string r> (match?) exit - else \ otherwise does it equal a '$' - over c@ [char] $ = over 1 = and - if \ and is it the last character? - 2drop nip 0= exit \ is so, check length of text - else \ finally, check if it char matches - 2over 0<> >r c@ >r over c@ dup - [char] . = swap r> = or r> and - if 1 /string 2>r 1 /string 2r> recurse exit then false - then \ if so recurse, otherwise quit - then - then - else - true \ zero length regular expression - then >r 2drop 2drop r> \ clean up and exit -; is (matchhere) \ assign to DEFER (we got 'em) - -: match ( a n ra rn --f) - dup if over c@ [char] ^ = if 1 /string (matchhere) exit then then - begin \ if caret, chop it - 2over 2over (matchhere) if 2drop 2drop true exit then - >r over r> swap \ match characters - while \ until no more text - 2>r 1 /string 2r> \ chop text - repeat 2drop 2drop false \ clean up -; - -\ s" 0,9" s" ^0,?9$" match . .s cr -\ s" 0:9" s" ^0,?9$" match . .s cr -\ s" 09" s" ^0,?9$" match . .s cr -\ s" 009" s" ^0,?9$" match . .s cr -\ s" 0,,9" s" ^0,?9$" match . .s cr cr diff --git a/amforth-6.5/common/lib/reverse.frt b/amforth-6.5/common/lib/reverse.frt deleted file mode 100644 index 9d468f4..0000000 --- a/amforth-6.5/common/lib/reverse.frt +++ /dev/null @@ -1,17 +0,0 @@ -\ LIFO made FIFO -\ ( X1 .. Xn n -- Xn .. X1 n ) -: reverse - >r - sp@ sp@ r@ cells + \ ( bot-addr top-addr ) - begin - over over < \ bot top cross each other? - while \ no - dup @ >r \ save top-cell content - over @ over ! \ replace top-cell - over r> swap ! \ replace bot-cell - cell- swap cell+ swap - repeat - 2drop - r> -; - diff --git a/amforth-6.5/common/lib/search-name.frt b/amforth-6.5/common/lib/search-name.frt deleted file mode 100644 index b47ddd9..0000000 --- a/amforth-6.5/common/lib/search-name.frt +++ /dev/null @@ -1,18 +0,0 @@ - -\ just like search-wordlist -\ searches a given wordlist for a word and returns its -\ name token (NT) or 0 if not found. -\ - -\ #require quotations.frt - -\ the analogon to search-wordlist -: search-name ( addr len wid -- nt | 0 ) - >r 0 [: ( addr len ignored nt -- addr len false true | nt false ) - >r drop 2dup r@ name>string icompare if - r> drop 0 -1 else 2drop r> 0 then ;] - r> traverse-wordlist ( -- addr len false | nt ) - dup 0= if - nip nip - then -; diff --git a/amforth-6.5/common/lib/sinus.frt b/amforth-6.5/common/lib/sinus.frt deleted file mode 100644 index e2a6733..0000000 --- a/amforth-6.5/common/lib/sinus.frt +++ /dev/null @@ -1,50 +0,0 @@ -\ Sinus and Cosinus -\ Use table calculating integer sin. -\ Get values scaled by 10K. - -\ tested ok on amforth-1.5 build 24.09.08 - -decimal - -create sintab \ 0...90 degrees, Index in degrees -0000 , 0175 , 0349 , 0523 , 0698 , 0872 , -1045 , 1219 , 1392 , 1564 , 1736 , 1908 , -2079 , 2250 , 2419 , 2588 , 2756 , 2924 , -3090 , 3256 , 3420 , 3584 , 3746 , 3907 , -4067 , 4226 , 4384 , 4540 , 4695 , 4848 , -5000 , 5150 , 5299 , 5446 , 5592 , 5736 , -5878 , 6018 , 6157 , 6293 , 6428 , 6561 , -6691 , 6820 , 6947 , 7071 , 7193 , 7314 , -7431 , 7547 , 7660 , 7771 , 7880 , 7986 , -8090 , 8192 , 8290 , 8387 , 8480 , 8572 , -8660 , 8746 , 8829 , 8910 , 8988 , 9063 , -9135 , 9205 , 9272 , 9336 , 9397 , 9455 , -9511 , 9563 , 9613 , 9659 , 9703 , 9744 , -9781 , 9816 , 9848 , 9877 , 9903 , 9925 , -9945 , 9962 , 9976 , 9986 , 9994 , 9998 , -10000 , - -: sinus@ sintab + @i ; -: sin ( degrees -- sinus ) - dup 0< >r abs - 360 mod - dup 180 > if 180 - 1 >r else 0 >r then - dup 90 > if 180 swap - then - sinus@ - r> if negate then - r> if negate then ; -: cos 90 + sin ; - -( finis) - -\ Notes: - -\ In gforth it has to be : sinus@ ( degree -- ) cell * sintab + @i ; -\ Since @i increments by 2 bytes each step in an atmega flash, -\ there is no need for cell adjustment in amforth. - -\ In the phrase -\ dup 180 > if 180 - 1 >r else 0 >r then -\ 1 and 0 act as flags; TRUE and FALSE do this in gforth. - -\ mk diff --git a/amforth-6.5/common/lib/sqrt.frt b/amforth-6.5/common/lib/sqrt.frt deleted file mode 100644 index 577d370..0000000 --- a/amforth-6.5/common/lib/sqrt.frt +++ /dev/null @@ -1,3 +0,0 @@ -\ Paul E Bennet comp.arch.embedded 4 May 2008 -: sqrt -1 swap over do 2 + dup +loop 2/ ; - diff --git a/amforth-6.5/common/lib/string-split.frt b/amforth-6.5/common/lib/string-split.frt deleted file mode 100644 index 848102d..0000000 --- a/amforth-6.5/common/lib/string-split.frt +++ /dev/null @@ -1,38 +0,0 @@ - -\ split a string at position n -: split ( addr u n -- addr1 u1 addr2 u2 ) - \ addr2 = addr + n - \ u2 = n - u - >r ( -- addr u) - r@ swap ( -- addr u1 u ) - r@ - ( -- addr u1 u2) - rot dup r> + ( -- u1 u2 addr1 addr2) - rot 2>r swap 2r> -; - -\ split a string into two at the leftmost char position -: $split ( addr u char -- addr1 u1 addr2 u2 ) - >r 2dup r> cscan ( -- addr u addr u1 ) - nip split -; - -\ mostly syntactic sugar, improves readability however -\ left part of a string -: $left ( addr len l -- addr len') - nip -; - -\ right part of a string -: $right ( addr len l -- addr' len' ) - /string -; - -\ test cases -\ > source char r $split type cr type -\ rce char r $split type cr type -\ sou -\ > source 10 $right type -\ $right type -\ > source 8 $left type -\ source 8 ok -\ \ No newline at end of file diff --git a/amforth-6.5/common/lib/to-name.frt b/amforth-6.5/common/lib/to-name.frt deleted file mode 100644 index 806dc21..0000000 --- a/amforth-6.5/common/lib/to-name.frt +++ /dev/null @@ -1,21 +0,0 @@ -\ go from the XT backwards to get the Name field -: >name ( xt -- nfa ) - 1- \ link address - \ tricky: we look for the flash cell whose address + it content & 0x00ff is - \ this address - dup 1- >r ( -- lfa ) - $ff swap - begin - 1- dup ( -- cnt lfa lfa ) - @i $00ff and 1+ 2/ ( -- cnt fla len ) - over + ( cnt fla lfa? ) - r@ = ( cnt fla lfa? ) - rot 1- dup >r 0= or ( fla flag ) - r> ( fla flag cnt ) - swap ( fla cnt flag ) - rot - swap - until - swap drop - r> drop -; diff --git a/amforth-6.5/common/lib/tracer.frt b/amforth-6.5/common/lib/tracer.frt deleted file mode 100644 index 9c3536e..0000000 --- a/amforth-6.5/common/lib/tracer.frt +++ /dev/null @@ -1,13 +0,0 @@ -\ tracer Emma Ledwidge's and Gerry -\ flag to dynamically turn trace output -\ on and off -variable tracing? -: trace:on -1 tracing? ! ; -: trace:off 0 tracing? ! ; - -: tracer tracing? @ if cr itype space .s else 2drop then ; - -: : >in @ >r : r> >in ! - parse-name postpone sliteral postpone tracer -; - diff --git a/amforth-6.5/common/lib/u-2slash.frt b/amforth-6.5/common/lib/u-2slash.frt deleted file mode 100644 index 3f36bb5..0000000 --- a/amforth-6.5/common/lib/u-2slash.frt +++ /dev/null @@ -1,7 +0,0 @@ - -\ unsigned division by 2. -\ -1 u2/ . gives 32737 -\ -1 2/ . gives -1 -\ -1 2 / . gives 0 - -: u2/ 1 rshift ; diff --git a/amforth-6.5/common/lib/u-star-slash-mod.frt b/amforth-6.5/common/lib/u-star-slash-mod.frt deleted file mode 100644 index 8d1e28f..0000000 --- a/amforth-6.5/common/lib/u-star-slash-mod.frt +++ /dev/null @@ -1,7 +0,0 @@ - -\ was part of the core -: u*/mod - >r um* r> - um/mod -; - diff --git a/amforth-6.5/common/lib/uzerodotr.frt b/amforth-6.5/common/lib/uzerodotr.frt deleted file mode 100644 index b8c7312..0000000 --- a/amforth-6.5/common/lib/uzerodotr.frt +++ /dev/null @@ -1,7 +0,0 @@ -\ ( ud n -- ) -\ Numeric IO -\ Print n digits, fill in preceeding zeros if needed - -: u0.r ( u n -- ) - >r 0 <# r> 0 ?do # loop #> type -; \ No newline at end of file diff --git a/amforth-6.5/common/lib/vocabulary.frt b/amforth-6.5/common/lib/vocabulary.frt deleted file mode 100644 index 6f47dfd..0000000 --- a/amforth-6.5/common/lib/vocabulary.frt +++ /dev/null @@ -1,11 +0,0 @@ -\ create a vocabulary, at runtime replace -\ the first entry in the search-list -: vocabulary ( "char" -- ) - - @i >r - get-order nip - r> swap - set-order -; diff --git a/amforth-6.5/common/lib/watcher.frt b/amforth-6.5/common/lib/watcher.frt deleted file mode 100644 index dedf190..0000000 --- a/amforth-6.5/common/lib/watcher.frt +++ /dev/null @@ -1,21 +0,0 @@ - -\ watcher -\ catch a read/write action on a particular address -\ and execute a predefined debug action. - -\ core routines -variable watch-addr -defer watch-action -\ redefine memory access words -: ! dup watch-addr @ = if watch-action then ! ; -: c@ dup watch-addr @ = if watch-action then c@ ; -: c! dup watch-addr @ = if watch-action then c! ; -\ this one is last -: @ dup watch-addr @ = if watch-action then @ ; -\ simply use the debugshell -' ?? is watch-action - -\ possible modifications -\ use an address range -\ use a list of addresses (address ranges) -\ ? \ No newline at end of file diff --git a/amforth-6.5/common/lib/wordlist-tools.frt b/amforth-6.5/common/lib/wordlist-tools.frt deleted file mode 100644 index 43a5f63..0000000 --- a/amforth-6.5/common/lib/wordlist-tools.frt +++ /dev/null @@ -1,18 +0,0 @@ -\ Message-ID: -\ From: "David N. Williams" -\ Newsgroups: comp.lang.forth -\ Subject: >ORDER ORDER> ORDER@ -\ Date: Fri, 22 Jan 2010 11:41:50 -0500 - - -: >order ( wid -- order: wid ) - >r get-order r> swap 1+ set-order ; - -: order> ( order: wid -- s: wid ) - get-order swap >r 1- set-order r> ; - -: order@ ( order: wid -- s: wid ) - get-order over >r 0 ?do drop loop r> ; -\ mlg's definition: -\ : order@ ( -- wid ) order> dup >order ; - diff --git a/amforth-6.5/common/words/2drop.asm b/amforth-6.5/common/words/2drop.asm deleted file mode 100644 index 8db2003..0000000 --- a/amforth-6.5/common/words/2drop.asm +++ /dev/null @@ -1,21 +0,0 @@ -; ( x1 x2 -- ) -; Stack -; Remove the 2 top elements - -.if cpu_msp430==1 - HEADER(XT_2DROP,5,"2drop",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_2DROP: - .dw $ff05 - .db "2drop",0 - .dw VE_HEAD - .set VE_HEAD = VE_2DROP -XT_2DROP: - .dw DO_COLON -PFA_2DROP: -.endif - .dw XT_DROP - .dw XT_DROP - .dw XT_EXIT diff --git a/amforth-6.5/common/words/2dup.asm b/amforth-6.5/common/words/2dup.asm deleted file mode 100644 index 258c4f9..0000000 --- a/amforth-6.5/common/words/2dup.asm +++ /dev/null @@ -1,22 +0,0 @@ -; ( x1 x2 -- x1 x2 x1 x2 ) -; Stack -; Duplicate the 2 top elements - -.if cpu_msp430==1 - HEADER(XT_2DUP,4,"2dup",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_2DUP: - .dw $ff04 - .db "2dup" - .dw VE_HEAD - .set VE_HEAD = VE_2DUP -XT_2DUP: - .dw DO_COLON -PFA_2DUP: -.endif - - .dw XT_OVER - .dw XT_OVER - .dw XT_EXIT diff --git a/amforth-6.5/common/words/2literal.asm b/amforth-6.5/common/words/2literal.asm deleted file mode 100644 index 31b03cf..0000000 --- a/amforth-6.5/common/words/2literal.asm +++ /dev/null @@ -1,21 +0,0 @@ -; ( -- x1 x2 ) (C: x1 x2 -- ) -; Compiler -; compile a cell pair literal in colon definitions -.if cpu_msp430==1 - IMMED(XT_2LITERAL,8,"2literal",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_2LITERAL: - .dw $0008 - .db "2literal" - .dw VE_HEAD - .set VE_HEAD = VE_2LITERAL -XT_2LITERAL: - .dw DO_COLON -PFA_2LITERAL: -.endif - .dw XT_SWAP - .dw XT_LITERAL - .dw XT_LITERAL - .dw XT_EXIT diff --git a/amforth-6.5/common/words/2swap.asm b/amforth-6.5/common/words/2swap.asm deleted file mode 100644 index 1056c54..0000000 --- a/amforth-6.5/common/words/2swap.asm +++ /dev/null @@ -1,24 +0,0 @@ -; ( x1 x2 x3 x4 -- x3 x4 x1 x2 ) -; Stack -; Exchange the two top cell pairs - -.if cpu_msp430==1 - HEADER(XT_2SWAP,5,"2swap",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_2SWAP: - .dw $ff05 - .db "2swap",0 - .dw VE_HEAD - .set VE_HEAD = VE_2SWAP -XT_2SWAP: - .dw DO_COLON -PFA_2SWAP: - -.endif - .dw XT_ROT - .dw XT_TO_R - .dw XT_ROT - .dw XT_R_FROM - .dw XT_EXIT diff --git a/amforth-6.5/common/words/_template.asm b/amforth-6.5/common/words/_template.asm deleted file mode 100644 index 1b42fcf..0000000 --- a/amforth-6.5/common/words/_template.asm +++ /dev/null @@ -1,8 +0,0 @@ - -.if cpu_msp430==1 -; HEADER(XT_2SWAP,5,"2swap",DOCOLON) -.endif - -.if cpu_avr8==1 - -.endif diff --git a/amforth-6.5/common/words/abort-string.asm b/amforth-6.5/common/words/abort-string.asm deleted file mode 100644 index 116b1dc..0000000 --- a/amforth-6.5/common/words/abort-string.asm +++ /dev/null @@ -1,29 +0,0 @@ -;C ABORT" i*x 0 -- i*x R: j*x -- j*x x1=0 -;C i*x x1 -- R: j*x -- x1<>0 -; POSTPONE IS" POSTPONE ?ABORT ; IMMEDIATE - -.if cpu_msp430==1 - ; IMMED(ABORTQUOTE,6,"ABORT"",DOCOLON) - DW link - DB 0FEh ; immediate -.set link = $ - DB 6,"abort",'"' - .align 16 -XT_ABORTQUOTE: - .DW DOCOLON -.endif - -.if cpu_avr8==1 -VE_ABORTQUOTE: - .dw $0006 - .db "abort",'"' - .dw VE_HEAD - .set VE_HEAD = VE_ABORTQUOTE -XT_ABORTQUOTE: - .dw DO_COLON -PFA_ABORTQUOTE: -.endif - .dw XT_SQUOTE - .dw XT_COMPILE - .dw XT_QABORT - .DW XT_EXIT diff --git a/amforth-6.5/common/words/abort.asm b/amforth-6.5/common/words/abort.asm deleted file mode 100644 index 05fe858..0000000 --- a/amforth-6.5/common/words/abort.asm +++ /dev/null @@ -1,19 +0,0 @@ -; ( i*x -- ) (R: j*y -- ) -; Exceptions -; send an exception -1 -.if cpu_msp430==1 - HEADER(XT_ABORT,5,"abort",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_ABORT: - .dw $ff05 - .db "abort",0 - .dw VE_HEAD - .set VE_HEAD = VE_ABORT -XT_ABORT: - .dw DO_COLON -PFA_ABORT: -.endif - .dw XT_TRUE - .dw XT_THROW diff --git a/amforth-6.5/common/words/abs.asm b/amforth-6.5/common/words/abs.asm deleted file mode 100644 index 429a603..0000000 --- a/amforth-6.5/common/words/abs.asm +++ /dev/null @@ -1,20 +0,0 @@ -;C ABS n1 -- +n2 absolute value -; DUP ?NEGATE ; - -.if cpu_msp430==1 - HEADER(XT_ABS,3,"abs",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_ABS: - .dw $ff03 - .db "abs",0 - .dw VE_HEAD - .set VE_HEAD = VE_ABS -XT_ABS: - .dw DO_COLON -PFA_ABS: - -.endif - - .DW XT_DUP,XT_QNEGATE,XT_EXIT diff --git a/amforth-6.5/common/words/accept.asm b/amforth-6.5/common/words/accept.asm deleted file mode 100644 index 68afdb1..0000000 --- a/amforth-6.5/common/words/accept.asm +++ /dev/null @@ -1,95 +0,0 @@ - -.if cpu_msp430==1 - HEADER(XT_ACCEPT,6,"accept",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_ACCEPT: - .dw $ff06 - .db "accept" - .dw VE_HEAD - .set VE_HEAD = VE_ACCEPT -XT_ACCEPT: - .dw DO_COLON -PFA_ACCEPT: - -.endif - .DW XT_OVER,XT_PLUS,XT_1MINUS,XT_OVER -ACC1: .DW XT_KEY,XT_DUP,XT_CRLFQ,XT_ZEROEQUAL,XT_DOCONDBRANCH - DEST(ACC5) - .DW XT_DUP,XT_DOLITERAL,8,XT_EQUAL,XT_DOCONDBRANCH - DEST(ACC3) - .DW XT_DROP,XT_ROT,XT_2DUP,XT_GREATER,XT_TO_R,XT_ROT,XT_ROT,XT_R_FROM,XT_DOCONDBRANCH - DEST(ACC6) - .DW XT_BS,XT_1MINUS,XT_TO_R,XT_OVER,XT_R_FROM,XT_UMAX -ACC6: .DW XT_DOBRANCH - DEST(ACC4) - - -ACC3: ; check for remaining control characters, replace them with blank - .dw XT_DUP ; ( -- addr k k ) - .dw XT_BL - .dw XT_LESS - .dw XT_DOCONDBRANCH - DEST(PFA_ACCEPT6) - .dw XT_DROP - .dw XT_BL -PFA_ACCEPT6: - .DW XT_DUP,XT_EMIT,XT_OVER,XT_CSTORE,XT_1PLUS,XT_OVER,XT_UMIN -ACC4: .DW XT_DOBRANCH - DEST(ACC1) -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 - HEADLESS(XT_BS,DOCOLON) -.endif - -.if cpu_avr8==1 - -;VE_BS: -; .dw $ff02 -; .db "bs" -; .dw VE_HEAD -; .set VE_HEAD = VE_BS -XT_BS: - .dw DO_COLON -.endif - .dw XT_DOLITERAL - .dw 8 - .dw XT_DUP - .dw XT_EMIT - .dw XT_SPACE - .dw XT_EMIT - .dw XT_EXIT - - -; ( c -- f ) -; System -; is the character a line end character? -.if cpu_msp430==1 - HEADLESS(XT_CRLFQ,DOCOLON) -.endif - -.if cpu_avr8==1 -;VE_CRLFQ: -; .dw $ff02 -; .db "crlf?" -; .dw VE_HEAD -; .set VE_HEAD = VE_CRLFQ -XT_CRLFQ: - .dw DO_COLON -.endif - .dw XT_DUP - .dw XT_DOLITERAL - .dw 13 - .dw XT_EQUAL - .dw XT_SWAP - .dw XT_DOLITERAL - .dw 10 - .dw XT_EQUAL - .dw XT_OR - .dw XT_EXIT diff --git a/amforth-6.5/common/words/again.asm b/amforth-6.5/common/words/again.asm deleted file mode 100644 index 507e1ed..0000000 --- a/amforth-6.5/common/words/again.asm +++ /dev/null @@ -1,22 +0,0 @@ -; ( -- ) (C: dest -- ) -; Compiler -; compile a jump back to dest - -.if cpu_msp430==1 - IMMED(XT_AGAIN,5,"again",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_AGAIN: - .dw $0005 - .db "again",0 - .dw VE_HEAD - .set VE_HEAD = VE_AGAIN -XT_AGAIN: - .dw DO_COLON -PFA_AGAIN: -.endif - .dw XT_COMPILE - .dw XT_DOBRANCH - .dw XT_LRESOLVE - .dw XT_EXIT diff --git a/amforth-6.5/common/words/ahead.asm b/amforth-6.5/common/words/ahead.asm deleted file mode 100644 index d883543..0000000 --- a/amforth-6.5/common/words/ahead.asm +++ /dev/null @@ -1,22 +0,0 @@ -; ( f -- ) (C: -- orig ) -; Compiler -; do a unconditional branch - -.if cpu_msp430==1 - IMMED(XT_AHEAD,5,"ahead",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_AHEAD: - .dw $0005 - .db "ahead",0 - .dw VE_HEAD - .set VE_HEAD = VE_AHEAD -XT_AHEAD: - .dw DO_COLON -PFA_AHEAD: -.endif - .dw XT_COMPILE - .dw XT_DOBRANCH - .dw XT_GMARK - .dw XT_EXIT diff --git a/amforth-6.5/common/words/backslash.asm b/amforth-6.5/common/words/backslash.asm deleted file mode 100644 index 5364b9f..0000000 --- a/amforth-6.5/common/words/backslash.asm +++ /dev/null @@ -1,30 +0,0 @@ -; ( "ccc" -- ) -; Compiler -; everything up to the end of the current line is a comment - -.if cpu_msp430==1 -; HEADER(XT_BACKSLASH,1,'\',DOCOLON) - DW link - DB 0FEh ; immediate -.set link = $ - DB 1,5ch - .align 16 -XT_BACKSLASH: - .DW DOCOLON -.endif - -.if cpu_avr8==1 -VE_BACKSLASH: - .dw $0001 - .db $5c,0 - .dw VE_HEAD - .set VE_HEAD = VE_BACKSLASH -XT_BACKSLASH: - .dw DO_COLON -PFA_BACKSLASH: -.endif - .dw XT_SOURCE - .dw XT_NIP - .dw XT_TO_IN - .dw XT_STORE - .dw XT_EXIT diff --git a/amforth-6.5/common/words/base.asm b/amforth-6.5/common/words/base.asm deleted file mode 100644 index 5f686b6..0000000 --- a/amforth-6.5/common/words/base.asm +++ /dev/null @@ -1,19 +0,0 @@ -; ( -- a-addr ) -; Numeric IO -; location of the cell containing the number conversion radix - -.if cpu_msp430==1 - HEADER(XT_BASE,4,"base",DOUSER) -.endif - -.if cpu_avr8==1 -VE_BASE: - .dw $ff04 - .db "base" - .dw VE_HEAD - .set VE_HEAD = VE_BASE -XT_BASE: - .dw PFA_DOUSER -PFA_BASE: -.endif - .dw USER_BASE diff --git a/amforth-6.5/common/words/begin.asm b/amforth-6.5/common/words/begin.asm deleted file mode 100644 index b2e3c22..0000000 --- a/amforth-6.5/common/words/begin.asm +++ /dev/null @@ -1,20 +0,0 @@ -; ( -- ) (C: -- dest ) -; Compiler -; put the next location for a transfer of control onto the control flow stack - -.if cpu_msp430==1 - IMMED(XT_BEGIN,5,"begin",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_BEGIN: - .dw $0005 - .db "begin",0 - .dw VE_HEAD - .set VE_HEAD = VE_BEGIN -XT_BEGIN: - .dw DO_COLON -PFA_BEGIN: -.endif - .dw XT_LMARK - .dw XT_EXIT diff --git a/amforth-6.5/common/words/bin.asm b/amforth-6.5/common/words/bin.asm deleted file mode 100644 index 573c2f6..0000000 --- a/amforth-6.5/common/words/bin.asm +++ /dev/null @@ -1,22 +0,0 @@ -; ( -- ) -; Numeric IO -; set base for numeric conversion to 10 - -.if cpu_msp430==1 - HEADER(XT_BIN,3,"bin",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_BIN: - .dw $ff03 - .db "bin",0 - .dw VE_HEAD - .set VE_HEAD = VE_BIN -XT_BIN: - .dw DO_COLON -PFA_BIN: -.endif - .dw XT_TWO - .dw XT_BASE - .dw XT_STORE - .dw XT_EXIT diff --git a/amforth-6.5/common/words/bl.asm b/amforth-6.5/common/words/bl.asm deleted file mode 100644 index cf242da..0000000 --- a/amforth-6.5/common/words/bl.asm +++ /dev/null @@ -1,19 +0,0 @@ -; ( -- 32 ) -; Character IO -; put ascii code of the blank to the stack - -.if cpu_msp430==1 - HEADER(XT_BL,2,"bl",DOCON) -.endif - -.if cpu_avr8==1 -VE_BL: - .dw $ff02 - .db "bl" - .dw VE_HEAD - .set VE_HEAD = VE_BL -XT_BL: - .dw PFA_DOVARIABLE -PFA_BL: -.endif - .dw 32 diff --git a/amforth-6.5/common/words/bounds.asm b/amforth-6.5/common/words/bounds.asm deleted file mode 100644 index 0dd0555..0000000 --- a/amforth-6.5/common/words/bounds.asm +++ /dev/null @@ -1,22 +0,0 @@ -; ( addr len -- addr+len addr ) -; Tools -; convert a string to an address range - -.if cpu_msp430==1 - HEADER(XT_BOUNDS,6,"bounds",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_BOUNDS: - .dw $ff06 - .db "bounds" - .dw VE_HEAD - .set VE_HEAD = VE_BOUNDS -XT_BOUNDS: - .dw DO_COLON -PFA_BOUNDS: -.endif - .dw XT_OVER - .dw XT_PLUS - .dw XT_SWAP - .dw XT_EXIT diff --git a/amforth-6.5/common/words/bracketchar.asm b/amforth-6.5/common/words/bracketchar.asm deleted file mode 100644 index ee55be0..0000000 --- a/amforth-6.5/common/words/bracketchar.asm +++ /dev/null @@ -1,23 +0,0 @@ -; ( -- c ) (C: "name" -- ) -; Tools -; skip leading space delimites, place the first character of the word on the stack - -.if cpu_msp430==1 - IMMED(XT_BRACKETCHAR,6,"[char]",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_BRACKETCHAR: - .dw $0006 - .db "[char]" - .dw VE_HEAD - .set VE_HEAD = VE_BRACKETCHAR -XT_BRACKETCHAR: - .dw DO_COLON -PFA_BRACKETCHAR: -.endif - .dw XT_COMPILE - .dw XT_DOLITERAL - .dw XT_CHAR - .dw XT_COMMA - .dw XT_EXIT diff --git a/amforth-6.5/common/words/bracketcompile.asm b/amforth-6.5/common/words/bracketcompile.asm deleted file mode 100644 index 01a1512..0000000 --- a/amforth-6.5/common/words/bracketcompile.asm +++ /dev/null @@ -1,23 +0,0 @@ -; ( -- c ) (C: "name" -- ) -; Compiler -; Append the compilation semantics of "name" to the dictionary, if any - -.if cpu_msp430==1 - IMMED(XT_BRACKETCOMPILE,9,"[compile]",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_BRACKETCOMPILE: - .dw $0009 - .db "[compile]",0 - .dw VE_HEAD - .set VE_HEAD = VE_BRACKETCOMPILE -XT_BRACKETCOMPILE: - .dw DO_COLON -PFA_BRACKETCOMPILE: -.endif - .dw XT_COMPILE - .dw XT_COMPILE - .dw XT_TICK - .dw XT_COMMA - .dw XT_EXIT diff --git a/amforth-6.5/common/words/brackettick.asm b/amforth-6.5/common/words/brackettick.asm deleted file mode 100644 index 4905ae3..0000000 --- a/amforth-6.5/common/words/brackettick.asm +++ /dev/null @@ -1,21 +0,0 @@ -; ( -- xt ) (C: "name" -- ) -; Compiler -; what ' does in the interpreter mode, do in colon definitions - -.if cpu_msp430==1 - IMMED(XT_BRACKETTICK,3,"[']",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_BRACKETTICK: - .dw $0003 - .db "[']",0 - .dw VE_HEAD - .set VE_HEAD = VE_BRACKETTICK -XT_BRACKETTICK: - .dw DO_COLON -PFA_BRACKETTICK: -.endif - .dw XT_TICK - .dw XT_LITERAL - .dw XT_EXIT diff --git a/amforth-6.5/common/words/build-info.tmpl b/amforth-6.5/common/words/build-info.tmpl deleted file mode 100644 index 6df97b8..0000000 --- a/amforth-6.5/common/words/build-info.tmpl +++ /dev/null @@ -1,26 +0,0 @@ -; ( -- i-addr len ) System -; R( -- ) -; Build Info as flash string - -.if cpu_msp430==1 - HEADER(XT_BUILDINFO,10,"build-info",DOCOLON) - .dw XT_DOSLITERAL - .db @TSTAMPLEN@ - .db "@TSTAMP@" - .align 16 -.endif - -.if cpu_avr8==1 -VE_BUILDINFO: - .dw $ff0a - .db "build-info" - .dw VE_HEAD - .set VE_HEAD = VE_BUILDINFO -XT_BUILDINFO: - .dw DO_COLON -PFA_BUILDINFO: - .dw XT_DOSLITERAL - .dw @TSTAMPLEN@ - .db "@TSTAMP@" -.endif - .dw XT_EXIT diff --git a/amforth-6.5/common/words/catch.asm b/amforth-6.5/common/words/catch.asm deleted file mode 100644 index c67be65..0000000 --- a/amforth-6.5/common/words/catch.asm +++ /dev/null @@ -1,39 +0,0 @@ -; ( i*x xt -- j*x 0 | i*x n ) -; Exceptions -; execute XT and check for exceptions. - -.if cpu_msp430==1 - HEADER(XT_CATCH,5,"catch",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_CATCH: - .dw $ff05 - .db "catch",0 - .dw VE_HEAD - .set VE_HEAD = VE_CATCH -XT_CATCH: - .dw DO_COLON -PFA_CATCH: -.endif - - ; sp@ >r - .dw XT_SP_FETCH - .dw XT_TO_R - ; handler @ >r - .dw XT_HANDLER - .dw XT_FETCH - .dw XT_TO_R - ; rp@ handler ! - .dw XT_RP_FETCH - .dw XT_HANDLER - .dw XT_STORE - .dw XT_EXECUTE - ; r> handler ! - .dw XT_R_FROM - .dw XT_HANDLER - .dw XT_STORE - .dw XT_R_FROM - .dw XT_DROP - .dw XT_ZERO - .dw XT_EXIT diff --git a/amforth-6.5/common/words/cfg-order.asm b/amforth-6.5/common/words/cfg-order.asm deleted file mode 100644 index 2fba330..0000000 --- a/amforth-6.5/common/words/cfg-order.asm +++ /dev/null @@ -1,19 +0,0 @@ -; ( -- wid-n .. wid-1 n) -; Search Order -; Get the current search order word list - -.if cpu_msp430==1 - HEADER(XT_CFG_ORDER,9,"cfg-order",DOCON) -.endif - -.if cpu_avr8==1 -VE_CFG_ORDER: - .dw $ff09 - .db "cfg-order",0 - .dw VE_HEAD - .set VE_HEAD = VE_CFG_ORDER -XT_CFG_ORDER: - .dw PFA_DOVARIABLE -PFA_CFG_ORDER: -.endif - .dw CFG_ORDERLISTLEN diff --git a/amforth-6.5/common/words/cfg-recognizer.asm b/amforth-6.5/common/words/cfg-recognizer.asm deleted file mode 100644 index 8e6322a..0000000 --- a/amforth-6.5/common/words/cfg-recognizer.asm +++ /dev/null @@ -1,19 +0,0 @@ -; ( -- wid-n .. wid-1 n) -; Search Order -; Get the current search order word list - -.if cpu_msp430==1 - HEADER(XT_CFG_RECOGNIZER,8,"cfg-recs",DOCON) -.endif - -.if cpu_avr8==1 -VE_CFG_RECOGNIZER: - .dw $ff08 - .db "cfg-recs" - .dw VE_HEAD - .set VE_HEAD = VE_CFG_RECOGNIZER -XT_CFG_RECOGNIZER: - .dw PFA_DOVARIABLE -PFA_CFG_RECOGNIZER: -.endif - .dw CFG_RECOGNIZERLISTLEN diff --git a/amforth-6.5/common/words/char.asm b/amforth-6.5/common/words/char.asm deleted file mode 100644 index 0fde37b..0000000 --- a/amforth-6.5/common/words/char.asm +++ /dev/null @@ -1,22 +0,0 @@ -; ( "name" -- c ) -; Tools -; copy the first character of the next word onto the stack - -.if cpu_msp430==1 - HEADER(XT_CHAR,4,"char",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_CHAR: - .dw $ff04 - .db "char" - .dw VE_HEAD - .set VE_HEAD = VE_CHAR -XT_CHAR: - .dw DO_COLON -PFA_CHAR: -.endif - .dw XT_PARSENAME - .dw XT_DROP - .dw XT_CFETCH - .dw XT_EXIT diff --git a/amforth-6.5/common/words/colon.asm b/amforth-6.5/common/words/colon.asm deleted file mode 100644 index 3ec45ae..0000000 --- a/amforth-6.5/common/words/colon.asm +++ /dev/null @@ -1,22 +0,0 @@ -; ( -- ) (C: "name" -- ) -; Compiler -; create a named entry in the dictionary, XT is DO_COLON - -.if cpu_msp430==1 - HEADER(XT_COLON,1,":",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_COLON: - .dw $ff01 - .db ":",0 - .dw VE_HEAD - .set VE_HEAD = VE_COLON -XT_COLON: - .dw DO_COLON -PFA_COLON: -.endif - .dw XT_DOCREATE - .dw XT_COLONNONAME - .dw XT_DROP - .dw XT_EXIT diff --git a/amforth-6.5/common/words/compile.asm b/amforth-6.5/common/words/compile.asm deleted file mode 100644 index 524cee6..0000000 --- a/amforth-6.5/common/words/compile.asm +++ /dev/null @@ -1,25 +0,0 @@ -; ( -- ) -; Dictionary -; read the following cell from the dictionary and append it to the current dictionary position. - -.if cpu_msp430==1 - HEADER(XT_COMPILE,7,"compile",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_COMPILE: - .dw $ff07 - .db "compile",0 - .dw VE_HEAD - .set VE_HEAD = VE_COMPILE -XT_COMPILE: - .dw DO_COLON -PFA_COMPILE: -.endif - .dw XT_R_FROM - .dw XT_DUP - .dw XT_ICELLPLUS - .dw XT_TO_R - .dw XT_FETCHI - .dw XT_COMMA - .dw XT_EXIT diff --git a/amforth-6.5/common/words/constant.asm b/amforth-6.5/common/words/constant.asm deleted file mode 100644 index 2f79dc3..0000000 --- a/amforth-6.5/common/words/constant.asm +++ /dev/null @@ -1,25 +0,0 @@ -; ( -- x ) (C: x "name" -- ) -; Compiler -; create a constant in the dictionary - -.if cpu_msp430==1 - HEADER(XT_CONSTANT,8,"constant",DOCOLON) -.endif - -.if cpu_avr8==1 - -VE_CONSTANT: - .dw $ff08 - .db "constant" - .dw VE_HEAD - .set VE_HEAD = VE_CONSTANT -XT_CONSTANT: - .dw DO_COLON -PFA_CONSTANT: -.endif - .dw XT_DOCREATE - .dw XT_REVEAL - .dw XT_COMPILE - .dw PFA_DOVARIABLE - .dw XT_COMMA - .dw XT_EXIT diff --git a/amforth-6.5/common/words/cr.asm b/amforth-6.5/common/words/cr.asm deleted file mode 100644 index ba704ba..0000000 --- a/amforth-6.5/common/words/cr.asm +++ /dev/null @@ -1,26 +0,0 @@ -; ( -- ) -; Character IO -; cause subsequent output appear at the beginning of the next line - -.if cpu_msp430==1 - HEADER(XT_CR,2,"cr",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_CR: - .dw 0xff02 - .db "cr" - .dw VE_HEAD - .set VE_HEAD = VE_CR -XT_CR: - .dw DO_COLON -PFA_CR: -.endif - - .dw XT_DOLITERAL - .dw 13 - .dw XT_EMIT - .dw XT_DOLITERAL - .dw 10 - .dw XT_EMIT - .dw XT_EXIT diff --git a/amforth-6.5/common/words/create.asm b/amforth-6.5/common/words/create.asm deleted file mode 100644 index b288474..0000000 --- a/amforth-6.5/common/words/create.asm +++ /dev/null @@ -1,23 +0,0 @@ -; ( -- a-addr ) (C: "name" -- ) -; Dictionary -; create a dictionary header. XT is (constant), with the address of the data field of name - -.if cpu_msp430==1 - HEADER(XT_CREATE,6,"create",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_CREATE: - .dw $ff06 - .db "create" - .dw VE_HEAD - .set VE_HEAD = VE_CREATE -XT_CREATE: - .dw DO_COLON -PFA_CREATE: -.endif - .dw XT_DOCREATE - .dw XT_REVEAL - .dw XT_COMPILE - .dw PFA_DOCONSTANT - .dw XT_EXIT diff --git a/amforth-6.5/common/words/cscan.asm b/amforth-6.5/common/words/cscan.asm deleted file mode 100644 index e043f60..0000000 --- a/amforth-6.5/common/words/cscan.asm +++ /dev/null @@ -1,56 +0,0 @@ -; ( addr1 n1 c -- addr1 n2 ) -; 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 - HEADER(XT_CSCAN,5,"cscan",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_CSCAN: - .dw $ff05 - .db "cscan" - .dw VE_HEAD - .set VE_HEAD = VE_CSCAN -XT_CSCAN: - .dw DO_COLON -PFA_CSCAN: -.endif - .dw XT_TO_R - .dw XT_OVER -PFA_CSCAN1: - .dw XT_DUP - .dw XT_CFETCH - .dw XT_R_FETCH - .dw XT_EQUAL - .dw XT_ZEROEQUAL - .dw XT_DOCONDBRANCH - DEST(PFA_CSCAN2) - .dw XT_SWAP - .dw XT_1MINUS - .dw XT_SWAP - .dw XT_OVER - .dw XT_ZEROLESS ; not negative - .dw XT_ZEROEQUAL - .dw XT_DOCONDBRANCH - DEST(PFA_CSCAN2) - .dw XT_1PLUS - .dw XT_DOBRANCH - DEST(PFA_CSCAN1) -PFA_CSCAN2: - .dw XT_NIP - .dw XT_OVER - .dw XT_MINUS - .dw XT_R_FROM - .dw XT_DROP - .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 -; ; diff --git a/amforth-6.5/common/words/cskip.asm b/amforth-6.5/common/words/cskip.asm deleted file mode 100644 index d57ff9c..0000000 --- a/amforth-6.5/common/words/cskip.asm +++ /dev/null @@ -1,37 +0,0 @@ -; ( addr1 n1 c -- addr2 n2 ) -; String -; skips leading occurancies in string at addr1/n1 leaving addr2/n2 pointing to the 1st non-c character - -.if cpu_msp430==1 - HEADER(XT_CSKIP,5,"cskip",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_CSKIP: - .dw $ff05 - .db "cskip",0 - .dw VE_HEAD - .set VE_HEAD = VE_CSKIP -XT_CSKIP: - .dw DO_COLON -PFA_CSKIP: -.endif - .dw XT_TO_R ; ( -- addr1 n1 ) -PFA_CSKIP1: - .dw XT_DUP ; ( -- addr' n' n' ) - .dw XT_DOCONDBRANCH ; ( -- addr' n') - DEST(PFA_CSKIP2) - .dw XT_OVER ; ( -- addr' n' addr' ) - .dw XT_CFETCH ; ( -- addr' n' c' ) - .dw XT_R_FETCH ; ( -- addr' n' c' c ) - .dw XT_EQUAL ; ( -- addr' n' f ) - .dw XT_DOCONDBRANCH ; ( -- addr' n') - DEST(PFA_CSKIP2) - .dw XT_ONE - .dw XT_SLASHSTRING - .dw XT_DOBRANCH - DEST(PFA_CSKIP1) -PFA_CSKIP2: - .dw XT_R_FROM - .dw XT_DROP ; ( -- addr2 n2) - .dw XT_EXIT diff --git a/amforth-6.5/common/words/d-dot-r.asm b/amforth-6.5/common/words/d-dot-r.asm deleted file mode 100644 index cc556d7..0000000 --- a/amforth-6.5/common/words/d-dot-r.asm +++ /dev/null @@ -1,35 +0,0 @@ -; ( d w -- ) -; Numeric IO -; singed PNO with double cell numbers, right aligned in width w - -.if cpu_msp430==1 - HEADER(XT_DDOTR,3,"d.r",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_DDOTR: - .dw $ff03 - .db "d.r",0 - .dw VE_HEAD - .set VE_HEAD = VE_DDOTR -XT_DDOTR: - .dw DO_COLON -PFA_DDOTR: - -.endif - .dw XT_TO_R - .dw XT_TUCK - .dw XT_DABS - .dw XT_L_SHARP - .dw XT_SHARP_S - .dw XT_ROT - .dw XT_SIGN - .dw XT_SHARP_G - .dw XT_R_FROM - .dw XT_OVER - .dw XT_MINUS - .dw XT_SPACES - .dw XT_TYPE - .dw XT_EXIT -; : d.r ( d n -- ) -; >r swap over dabs <# #s rot sign #> r> over - spaces type ; diff --git a/amforth-6.5/common/words/d-dot.asm b/amforth-6.5/common/words/d-dot.asm deleted file mode 100644 index 8aa1169..0000000 --- a/amforth-6.5/common/words/d-dot.asm +++ /dev/null @@ -1,24 +0,0 @@ -; ( d -- ) -; Numeric IO -; singed PNO with double cell numbers - -.if cpu_msp430==1 - HEADER(XT_DDOT,2,"d.",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_DDOT: - .dw $ff02 - .db "d." - .dw VE_HEAD - .set VE_HEAD = VE_DDOT -XT_DDOT: - .dw DO_COLON -PFA_DDOT: - -.endif - .dw XT_ZERO - .dw XT_DDOTR - .dw XT_SPACE - .dw XT_EXIT -; : d. ( d -- ) 0 d.r space ; diff --git a/amforth-6.5/common/words/decimal.asm b/amforth-6.5/common/words/decimal.asm deleted file mode 100644 index de65dd4..0000000 --- a/amforth-6.5/common/words/decimal.asm +++ /dev/null @@ -1,23 +0,0 @@ -; ( -- ) -; Numeric IO -; set base for numeric conversion to 10 - -.if cpu_msp430==1 - HEADER(XT_DECIMAL,7,"decimal",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_DECIMAL: - .dw $ff07 - .db "decimal",0 - .dw VE_HEAD - .set VE_HEAD = VE_DECIMAL -XT_DECIMAL: - .dw DO_COLON -PFA_DECIMAL: -.endif - .dw XT_DOLITERAL - .dw 10 - .dw XT_BASE - .dw XT_STORE - .dw XT_EXIT diff --git a/amforth-6.5/common/words/defer-fetch.asm b/amforth-6.5/common/words/defer-fetch.asm deleted file mode 100644 index 6044afc..0000000 --- a/amforth-6.5/common/words/defer-fetch.asm +++ /dev/null @@ -1,24 +0,0 @@ -; ( xt1 -- xt2 ) -; System -; returns the XT associated with the given XT - -.if cpu_msp430==1 - HEADER(XT_DEFERFETCH,6,"defer@",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_DEFERFETCH: - .dw $ff06 - .db "defer@" - .dw VE_HEAD - .set VE_HEAD = VE_DEFERFETCH -XT_DEFERFETCH: - .dw DO_COLON -PFA_DEFERFETCH: -.endif - .dw XT_TO_BODY - .dw XT_DUP - .dw XT_ICELLPLUS - .dw XT_FETCHI - .dw XT_EXECUTE - .dw XT_EXIT diff --git a/amforth-6.5/common/words/defer-store.asm b/amforth-6.5/common/words/defer-store.asm deleted file mode 100644 index 4ca579c..0000000 --- a/amforth-6.5/common/words/defer-store.asm +++ /dev/null @@ -1,26 +0,0 @@ -; ( xt1 xt2 -- ) -; System -; stores xt1 as the xt to be executed when xt2 is called - -.if cpu_msp430==1 - HEADER(XT_DEFERSTORE,6,"defer!",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_DEFERSTORE: - .dw $ff06 - .db "defer!" - .dw VE_HEAD - .set VE_HEAD = VE_DEFERSTORE -XT_DEFERSTORE: - .dw DO_COLON -PFA_DEFERSTORE: -.endif - .dw XT_TO_BODY - .dw XT_DUP - .dw XT_ICELLPLUS - .dw XT_ICELLPLUS - .dw XT_FETCHI - .dw XT_EXECUTE - .dw XT_EXIT - diff --git a/amforth-6.5/common/words/depth.asm b/amforth-6.5/common/words/depth.asm deleted file mode 100644 index c17d84d..0000000 --- a/amforth-6.5/common/words/depth.asm +++ /dev/null @@ -1,23 +0,0 @@ -; ( -- n ) -; Stack -; number of single-cell values contained in the data stack before n was placed on the stack. -.if cpu_msp430==1 - HEADER(XT_DEPTH,5,"depth",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_DEPTH: - .dw $ff05 - .db "depth",0 - .dw VE_HEAD - .set VE_HEAD = VE_DEPTH -XT_DEPTH: - .dw DO_COLON -PFA_DEPTH: -.endif - .dw XT_SP0 - .dw XT_SP_FETCH - .dw XT_MINUS - .dw XT_2SLASH - .dw XT_1MINUS - .dw XT_EXIT diff --git a/amforth-6.5/common/words/digit-q.asm b/amforth-6.5/common/words/digit-q.asm deleted file mode 100644 index da19b55..0000000 --- a/amforth-6.5/common/words/digit-q.asm +++ /dev/null @@ -1,24 +0,0 @@ -; ( c -- (number|) flag ) -; Numeric IO -; tries to convert a character to a number, set flag accordingly - -.if cpu_msp430==1 - HEADER(XT_DIGITQ,6,"digit?",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_DIGITQ: - .dw $ff06 - .db "digit?" - .dw VE_HEAD - .set VE_HEAD = VE_DIGITQ -XT_DIGITQ: - .dw DO_COLON -PFA_DIGITQ: -.endif - .dw XT_TOUPPER - .DW XT_DUP,XT_DOLITERAL,57,XT_GREATER,XT_DOLITERAL,256 - .DW XT_AND,XT_PLUS,XT_DUP,XT_DOLITERAL,320,XT_GREATER - .DW XT_DOLITERAL,263,XT_AND,XT_MINUS,XT_DOLITERAL,48 - .DW XT_MINUS,XT_DUP,XT_BASE,XT_FETCH,XT_ULESS - .DW XT_EXIT diff --git a/amforth-6.5/common/words/do-create.asm b/amforth-6.5/common/words/do-create.asm deleted file mode 100644 index 3f78729..0000000 --- a/amforth-6.5/common/words/do-create.asm +++ /dev/null @@ -1,22 +0,0 @@ -; ( -- ) (C: "name" -- ) -; Compiler -; parse the input and create an empty vocabulary entry without XT and data field (PF) - -.if cpu_msp430==1 - HEADER(XT_DOCREATE,8,"(create)",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_DOCREATE: - .dw $ff08 - .db "(create)" - .dw VE_HEAD - .set VE_HEAD = VE_DOCREATE -XT_DOCREATE: - .dw DO_COLON -PFA_DOCREATE: -.endif - .DW XT_PARSENAME,XT_WLSCOPE ; ( -- addr len wid) - .DW XT_DUP,XT_NEWEST,XT_CELLPLUS,XT_STORE ; save the wid - .DW XT_HEADER,XT_NEWEST,XT_STORE ; save the nt - .DW XT_EXIT diff --git a/amforth-6.5/common/words/do.asm b/amforth-6.5/common/words/do.asm deleted file mode 100644 index a289bf8..0000000 --- a/amforth-6.5/common/words/do.asm +++ /dev/null @@ -1,25 +0,0 @@ -; ( n1 n2 -- ) (R: -- loop-sys ) (C: -- do-sys ) -; Compiler -; start do .. [+]loop - -.if cpu_msp430==1 - IMMED(XT_DO,2,"do",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_DO: - .dw $0002 - .db "do" - .dw VE_HEAD - .set VE_HEAD = VE_DO -XT_DO: - .dw DO_COLON -PFA_DO: - -.endif - .dw XT_COMPILE - .dw XT_DODO - .dw XT_LMARK - .dw XT_ZERO - .dw XT_TO_L - .dw XT_EXIT diff --git a/amforth-6.5/common/words/dot-quote.asm b/amforth-6.5/common/words/dot-quote.asm deleted file mode 100644 index 46efce1..0000000 --- a/amforth-6.5/common/words/dot-quote.asm +++ /dev/null @@ -1,31 +0,0 @@ -; ( -- ) (C: "ccc" -- ) -; Compiler -; compiles string into dictionary to be printed at runtime - -.if cpu_msp430==1 - ; IMMED(DOTQUOTE,2,"."",DOCOLON) - DW link - DB 0FEh ; immediate -.set link = $ - DB 2,'.','"' - .align 16 -DOTQUOTE: DW DOCOLON - -.endif - -.if cpu_avr8==1 - - -VE_DOTSTRING: - .dw $0002 - .db ".",$22 - .dw VE_HEAD - .set VE_HEAD = VE_DOTSTRING -XT_DOTSTRING: - .dw DO_COLON -PFA_DOTSTRING: -.endif - .dw XT_SQUOTE - .dw XT_COMPILE - .dw XT_ITYPE - .dw XT_EXIT diff --git a/amforth-6.5/common/words/dot-r.asm b/amforth-6.5/common/words/dot-r.asm deleted file mode 100644 index 5a19168..0000000 --- a/amforth-6.5/common/words/dot-r.asm +++ /dev/null @@ -1,32 +0,0 @@ -; ( n w -- ) -; Numeric IO -; singed PNO with single cell numbers, right aligned in width w - -.if cpu_msp430==1 -; HEADER(XT_DOTR,2,"..",DOCOLON) - DW link - DB 0FFh -.set link = $ - DB 2,".",'r' - .align 16 -XT_DOTR: - .DW DOCOLON -.endif - -.if cpu_avr8==1 -VE_DOTR: - .dw $ff02 - .db ".r" - .dw VE_HEAD - .set VE_HEAD = VE_DOTR -XT_DOTR: - .dw DO_COLON -PFA_DOTR: - -.endif - .dw XT_TO_R - .dw XT_S2D - .dw XT_R_FROM - .dw XT_DDOTR - .dw XT_EXIT -; : .r ( s n -- ) >r s>d r> d.r ; diff --git a/amforth-6.5/common/words/dot-s.asm b/amforth-6.5/common/words/dot-s.asm deleted file mode 100644 index b6736a5..0000000 --- a/amforth-6.5/common/words/dot-s.asm +++ /dev/null @@ -1,42 +0,0 @@ -; ( -- ) -; Tools -; stack dump - -.if cpu_msp430==1 -; HEADER(XT_DOTS,2,"..",DOCOLON) - DW link - DB 0FFh -.set link = $ - DB 2,".",'s' - .align 16 -XT_DOTS: - .DW DOCOLON -.endif - -.if cpu_avr8==1 -VE_DOTS: - .dw $ff02 - .db ".s" - .dw VE_HEAD - .set VE_HEAD = VE_DOTS -XT_DOTS: - .dw DO_COLON -PFA_DOTS: -.endif - .dw XT_DEPTH - .dw XT_UDOT - .dw XT_SPACE - .dw XT_DEPTH - .dw XT_ZERO - .dw XT_QDOCHECK - .dw XT_DOCONDBRANCH - DEST(PFA_DOTS2) - .dw XT_DODO -PFA_DOTS1: - .dw XT_I - .dw XT_PICK - .dw XT_UDOT - .dw XT_DOLOOP - DEST(PFA_DOTS1) -PFA_DOTS2: - .dw XT_EXIT diff --git a/amforth-6.5/common/words/dot.asm b/amforth-6.5/common/words/dot.asm deleted file mode 100644 index 32ad95f..0000000 --- a/amforth-6.5/common/words/dot.asm +++ /dev/null @@ -1,24 +0,0 @@ -; ( n -- ) -; Numeric IO -; singed PNO with single cell numbers - -.if cpu_msp430==1 - HEADER(XT_DOT,1,".",DOCOLON) -.endif - -.if cpu_avr8==1 - - -VE_DOT: - .dw $ff01 - .db ".",0 - .dw VE_HEAD - .set VE_HEAD = VE_DOT -XT_DOT: - .dw DO_COLON -PFA_DOT: -.endif - .dw XT_S2D - .dw XT_DDOT - .dw XT_EXIT -; : . ( s -- ) s>d d. ; diff --git a/amforth-6.5/common/words/dt-null.asm b/amforth-6.5/common/words/dt-null.asm deleted file mode 100644 index 640562f..0000000 --- a/amforth-6.5/common/words/dt-null.asm +++ /dev/null @@ -1,41 +0,0 @@ -; ( -- addr ) -; Interpreter -; there is no parser for this recognizer, this is the default and failsafe part - -.if cpu_msp430==1 - HEADER(XT_DT_NULL,7,"dt:null",DOROM) -.endif - -.if cpu_avr8==1 -VE_DT_NULL: - .dw $ff07 - .db "dt:null" - .dw VE_HEAD - .set VE_HEAD = VE_DT_NULL -XT_DT_NULL: - .dw PFA_DOCONSTANT -PFA_DT_NULL: -.endif - .dw XT_FAIL ; interpret - .dw XT_FAIL ; compile - .dw XT_FAIL ; postpone - -; ( addr len -- ) -; Interpreter -; default failure action: throw exception -13. -.if cpu_msp430==1 - HEADLESS(XT_FAIL,DOCOLON) -.endif -.if cpu_avr8==1 -;VE_FAIL: -; .dw $ff04 -; .db "fail" -; .dw VE_HEAD -; .set VE_HEAD = VE_FAIL -XT_FAIL: - .dw DO_COLON -PFA_FAIL: -.endif - .dw XT_DOLITERAL - .dw -13 - .dw XT_THROW diff --git a/amforth-6.5/common/words/else.asm b/amforth-6.5/common/words/else.asm deleted file mode 100644 index e0e2ff3..0000000 --- a/amforth-6.5/common/words/else.asm +++ /dev/null @@ -1,24 +0,0 @@ -; (C: orig1 -- orig2 ) -; Compiler -; resolve the forward reference and place a new unresolved forward reference - -.if cpu_msp430==1 - IMMED(XT_ELSE,4,"else",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_ELSE: - .dw $0004 - .db "else" - .dw VE_HEAD - .set VE_HEAD = VE_ELSE -XT_ELSE: - .dw DO_COLON -PFA_ELSE: -.endif - .dw XT_COMPILE - .dw XT_DOBRANCH - .dw XT_GMARK - .dw XT_SWAP - .dw XT_GRESOLVE - .dw XT_EXIT diff --git a/amforth-6.5/common/words/emit.asm b/amforth-6.5/common/words/emit.asm deleted file mode 100644 index de194c3..0000000 --- a/amforth-6.5/common/words/emit.asm +++ /dev/null @@ -1,21 +0,0 @@ -; ( c -- ) -; Character IO -; fetch the emit vector and execute it. should emit a character from TOS - -.if cpu_msp430==1 - DEFER(XT_EMIT,4,"emit") -.endif - -.if cpu_avr8==1 -VE_EMIT: - .dw $ff04 - .db "emit" - .dw VE_HEAD - .set VE_HEAD = VE_EMIT -XT_EMIT: - .dw PFA_DODEFER1 -PFA_EMIT: -.endif - .dw USER_EMIT - .dw XT_UDEFERFETCH - .dw XT_UDEFERSTORE diff --git a/amforth-6.5/common/words/emitq.asm b/amforth-6.5/common/words/emitq.asm deleted file mode 100644 index b1c04f2..0000000 --- a/amforth-6.5/common/words/emitq.asm +++ /dev/null @@ -1,21 +0,0 @@ -; ( -- f ) -; Character IO -; fetch emit? vector and execute it. should return the ready-to-send condition - -.if cpu_msp430==1 - DEFER(XT_EMITQ,5,"emit?") -.endif - -.if cpu_avr8==1 -VE_EMITQ: - .dw $ff05 - .db "emit?",0 - .dw VE_HEAD - .set VE_HEAD = VE_EMITQ -XT_EMITQ: - .dw PFA_DODEFER1 -PFA_EMITQ: -.endif - .dw USER_EMITQ - .dw XT_UDEFERFETCH - .dw XT_UDEFERSTORE diff --git a/amforth-6.5/common/words/endloop.asm b/amforth-6.5/common/words/endloop.asm deleted file mode 100644 index 26c9847..0000000 --- a/amforth-6.5/common/words/endloop.asm +++ /dev/null @@ -1,28 +0,0 @@ - -.if cpu_msp430==1 - HEADER(XT_ENDLOOP,7,"endloop",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_ENDLOOP: - .dw $ff07 - .db "endloop",0 - .dw VE_HEAD - .set VE_HEAD = VE_ENDLOOP -XT_ENDLOOP: - .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. - - .DW XT_LRESOLVE -LOOP1: .DW XT_L_FROM,XT_QDUP,XT_DOCONDBRANCH - DEST(LOOP2) - .DW XT_THEN - .dw XT_DOBRANCH - DEST(LOOP1) -LOOP2: .DW XT_EXIT diff --git a/amforth-6.5/common/words/env-cpu.asm b/amforth-6.5/common/words/env-cpu.asm deleted file mode 100644 index 3266b03..0000000 --- a/amforth-6.5/common/words/env-cpu.asm +++ /dev/null @@ -1,22 +0,0 @@ -; ( -- faddr len ) -; Environment -; flash address of the CPU identification string - -.if cpu_msp430==1 - ENVIRONMENT(XT_ENV_CPU,3,"cpu") -.endif - -.if cpu_avr8==1 -VE_ENV_CPU: - .dw $ff03 - .db "cpu",0 - .dw VE_ENVHEAD - .set VE_ENVHEAD = VE_ENV_CPU -XT_ENV_CPU: - .dw DO_COLON -PFA_EN_CPU: -.endif - .dw XT_DOLITERAL - .dw mcu_name - .dw XT_ICOUNT - .dw XT_EXIT diff --git a/amforth-6.5/common/words/env-forthname.asm b/amforth-6.5/common/words/env-forthname.asm deleted file mode 100644 index 025f818..0000000 --- a/amforth-6.5/common/words/env-forthname.asm +++ /dev/null @@ -1,26 +0,0 @@ -; ( -- faddr len ) -; Environment -; flash address of the amforth name string -.if cpu_msp430==1 - ENVIRONMENT(XT_ENV_FORTHNAME,10,"forth-name") - .dw XT_DOSLITERAL - .db 7 -.endif - -.if cpu_avr8==1 -VE_ENV_FORTHNAME: - .dw $ff0a - .db "forth-name" - .dw VE_ENVHEAD - .set VE_ENVHEAD = VE_ENV_FORTHNAME -XT_ENV_FORTHNAME: - .dw DO_COLON -PFA_EN_FORTHNAME: - .dw XT_DOSLITERAL - .dw 7 -.endif - .db "amforth" -.if cpu_msp430==1 - .align 16 -.endif - .dw XT_EXIT diff --git a/amforth-6.5/common/words/env-forthversion.asm b/amforth-6.5/common/words/env-forthversion.asm deleted file mode 100644 index 202e82b..0000000 --- a/amforth-6.5/common/words/env-forthversion.asm +++ /dev/null @@ -1,20 +0,0 @@ -; ( -- n ) -; Environment -; version number of amforth -.if cpu_msp430==1 - ENVIRONMENT(XT_ENV_FORTHVERSION,7,"version") -.endif - -.if cpu_avr8==1 -VE_ENV_FORTHVERSION: - .dw $ff07 - .db "version",0 - .dw VE_ENVHEAD - .set VE_ENVHEAD = VE_ENV_FORTHVERSION -XT_ENV_FORTHVERSION: - .dw DO_COLON -PFA_EN_FORTHVERSION: -.endif - .dw XT_DOLITERAL - .dw 65 - .dw XT_EXIT diff --git a/amforth-6.5/common/words/env-slashhold.asm b/amforth-6.5/common/words/env-slashhold.asm deleted file mode 100644 index 9fa9468..0000000 --- a/amforth-6.5/common/words/env-slashhold.asm +++ /dev/null @@ -1,22 +0,0 @@ -; ( -- hldsize ) -; Environment -; size of the pictured numeric output buffer in bytes - -.if cpu_msp430==1 - ENVIRONMENT(XT_ENVSLASHHOLD,5,"/hold",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_ENVSLASHHOLD: - .dw $ff05 - .db "/hold",0 - .dw VE_ENVHEAD - .set VE_ENVHEAD = VE_ENVSLASHHOLD -XT_ENVSLASHHOLD: - .dw DO_COLON -PFA_ENVSLASHHOLD: -.endif - .dw XT_PAD - .dw XT_HERE - .dw XT_MINUS - .dw XT_EXIT diff --git a/amforth-6.5/common/words/env-usersize.asm b/amforth-6.5/common/words/env-usersize.asm deleted file mode 100644 index 53bd58a..0000000 --- a/amforth-6.5/common/words/env-usersize.asm +++ /dev/null @@ -1,21 +0,0 @@ -; ( -- usersize ) -; Environment -; size of the USER area in bytes -.if cpu_msp430==1 - ENVIRONMENT(XT_ENVUSERSIZE,5,"/user") -.endif - -.if cpu_avr8==1 - -VE_ENVUSERSIZE: - .dw $ff05 - .db "/user",0 - .dw VE_ENVHEAD - .set VE_ENVHEAD = VE_ENVUSERSIZE -XT_ENVUSERSIZE: - .dw DO_COLON -PFA_ENVUSERSIZE: -.endif - .dw XT_DOLITERAL - .dw SYSUSERSIZE + APPUSERSIZE - .dw XT_EXIT diff --git a/amforth-6.5/common/words/f_cpu.asm b/amforth-6.5/common/words/f_cpu.asm deleted file mode 100644 index 3632b0c..0000000 --- a/amforth-6.5/common/words/f_cpu.asm +++ /dev/null @@ -1,22 +0,0 @@ -; ( -- d ) -; System -; put the cpu frequency in Hz on stack -.if cpu_msp430==1 - HEADER(XT_F_CPU,5,"f_cpu",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_F_CPU: - .dw $ff05 - .db "f_cpu",0 - .dw VE_HEAD - .set VE_HEAD = VE_F_CPU -XT_F_CPU: - .dw DO_COLON -PFA_F_CPU: -.endif - .dw XT_DOLITERAL - .dw (F_CPU % 65536) - .dw XT_DOLITERAL - .dw (F_CPU / 65536) - .dw XT_EXIT diff --git a/amforth-6.5/common/words/find-xt.asm b/amforth-6.5/common/words/find-xt.asm deleted file mode 100644 index 0ed50b8..0000000 --- a/amforth-6.5/common/words/find-xt.asm +++ /dev/null @@ -1,55 +0,0 @@ -; ( c-addr len -- 0 | xt -1 | xt 1 ) -; Tools -; search wordlists for an entry with the xt from c-addr/len - -.if cpu_msp430==1 - HEADER(XT_FINDXT,7,"find-xt",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_FINDXT: - .dw $ff07 - .db "find-xt",0 - .dw VE_HEAD - .set VE_HEAD = VE_FINDXT -XT_FINDXT: - .dw DO_COLON -PFA_FINDXT: -.endif - .dw XT_DOLITERAL - .dw XT_FINDXTA - .dw XT_DOLITERAL - .dw CFG_ORDERLISTLEN - .dw XT_MAPSTACK - .dw XT_ZEROEQUAL - .dw XT_DOCONDBRANCH - DEST(PFA_FINDXT1) - .dw XT_2DROP - .dw XT_ZERO -PFA_FINDXT1: - .dw XT_EXIT - -.if cpu_msp430==1 - HEADLESS(XT_FINDXTA,DOCOLON) -.endif - -.if cpu_avr8==1 - -XT_FINDXTA: - .dw DO_COLON -PFA_FINDXTA: -.endif - .dw XT_TO_R - .dw XT_2DUP - .dw XT_R_FROM - .dw XT_SEARCH_WORDLIST - .dw XT_DUP - .dw XT_DOCONDBRANCH - DEST(PFA_FINDXTA1) - .dw XT_TO_R - .dw XT_NIP - .dw XT_NIP - .dw XT_R_FROM - .dw XT_TRUE -PFA_FINDXTA1: - .dw XT_EXIT diff --git a/amforth-6.5/common/words/get-order.asm b/amforth-6.5/common/words/get-order.asm deleted file mode 100644 index df9ee77..0000000 --- a/amforth-6.5/common/words/get-order.asm +++ /dev/null @@ -1,22 +0,0 @@ -; ( -- wid-n .. wid-1 n) -; Search Order -; Get the current search order word list - -.if cpu_msp430==1 - HEADER(XT_GET_ORDER,9,"get-order",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_GET_ORDER: - .dw $ff09 - .db "get-order",0 - .dw VE_HEAD - .set VE_HEAD = VE_GET_ORDER -XT_GET_ORDER: - .dw DO_COLON -PFA_GET_ORDER: -.endif - .dw XT_DOLITERAL - .dw CFG_ORDERLISTLEN - .dw XT_GET_STACK - .dw XT_EXIT diff --git a/amforth-6.5/common/words/get-recognizer.asm b/amforth-6.5/common/words/get-recognizer.asm deleted file mode 100644 index abfbe07..0000000 --- a/amforth-6.5/common/words/get-recognizer.asm +++ /dev/null @@ -1,22 +0,0 @@ -; ( -- rec-n .. rec-1 n) -; Interpreter -; Get the current recognizer list - -.if cpu_msp430==1 - HEADER(XT_GET_RECOGNIZERS,15,"get-recognizers",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_GET_RECOGNIZERS: - .dw $ff0f - .db "get-recognizers",0 - .dw VE_HEAD - .set VE_HEAD = VE_GET_RECOGNIZERS -XT_GET_RECOGNIZERS: - .dw DO_COLON -PFA_GET_RECOGNIZERS: -.endif - .dw XT_DOLITERAL - .dw CFG_RECOGNIZERLISTLEN - .dw XT_GET_STACK - .dw XT_EXIT diff --git a/amforth-6.5/common/words/get-stack.asm b/amforth-6.5/common/words/get-stack.asm deleted file mode 100644 index 3127d76..0000000 --- a/amforth-6.5/common/words/get-stack.asm +++ /dev/null @@ -1,46 +0,0 @@ -; ( e-addr -- item-n .. item-1 n) -; Tools -; Get a stack from EEPROM - -.if cpu_msp430==1 - HEADER(XT_GET_STACK,9,"get-stack",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_GET_STACK: - .dw $ff09 - .db "get-stack",0 - .dw VE_HEAD - .set VE_HEAD = VE_GET_STACK -XT_GET_STACK: - .dw DO_COLON -.endif - .dw XT_DUP - .dw XT_CELLPLUS - .dw XT_SWAP - .dw XT_FETCHE - .dw XT_DUP - .dw XT_TO_R - .dw XT_ZERO - .dw XT_SWAP ; go from bigger to smaller addresses - .dw XT_QDOCHECK - .dw XT_DOCONDBRANCH - DEST(PFA_N_FETCH_E2) - .dw XT_DODO -PFA_N_FETCH_E1: - ; ( ee-addr ) - .dw XT_I - .dw XT_1MINUS - .dw XT_CELLS ; ( -- ee-addr i*2 ) - .dw XT_OVER ; ( -- ee-addr i*2 ee-addr ) - .dw XT_PLUS ; ( -- ee-addr ee-addr+i - .dw XT_FETCHE ;( -- ee-addr item_i ) - .dw XT_SWAP ;( -- item_i ee-addr ) - .dw XT_TRUE ; shortcut for -1 - .dw XT_DOPLUSLOOP - DEST(PFA_N_FETCH_E1) -PFA_N_FETCH_E2: - .dw XT_2DROP - .dw XT_R_FROM - .dw XT_EXIT - diff --git a/amforth-6.5/common/words/git-info.tmpl b/amforth-6.5/common/words/git-info.tmpl deleted file mode 100644 index 2486d16..0000000 --- a/amforth-6.5/common/words/git-info.tmpl +++ /dev/null @@ -1,27 +0,0 @@ -; ( -- ) System -; R( -- ) -; GIT Info - -.if cpu_msp430==1 - HEADER(XT_GITINFO,8,"git-info",DOCOLON) - .dw XT_DOSLITERAL - .db @BRLEN@ -.endif - -.if cpu_avr8==1 -VE_GITINFO: - .dw $ff08 - .db "git-info" - .dw VE_HEAD - .set VE_HEAD = VE_GITINFO -XT_GITINFO: - .dw DO_COLON -PFA_GITINFO: - .dw XT_DOSLITERAL - .dw @BRLEN@ -.endif - .db "@BRNAME@" -.if cpu_msp430==1 - .align 16 -.endif - .dw XT_EXIT diff --git a/amforth-6.5/common/words/handler.asm b/amforth-6.5/common/words/handler.asm deleted file mode 100644 index 61b1c58..0000000 --- a/amforth-6.5/common/words/handler.asm +++ /dev/null @@ -1,19 +0,0 @@ -; ( -- a-addr ) -; Exceptions -; USER variable used by catch/throw - -.if cpu_msp430==1 - HEADER(XT_HANDLER,7,"handler",DOUSER) -.endif - -.if cpu_avr8==1 -VE_HANDLER: - .dw $ff07 - .db "handler",0 - .dw VE_HEAD - .set VE_HEAD = VE_HANDLER -XT_HANDLER: - .dw PFA_DOUSER -PFA_HANDLER: -.endif - .dw USER_HANDLER diff --git a/amforth-6.5/common/words/hex.asm b/amforth-6.5/common/words/hex.asm deleted file mode 100644 index c87fa69..0000000 --- a/amforth-6.5/common/words/hex.asm +++ /dev/null @@ -1,23 +0,0 @@ -; ( -- ) -; Numeric IO -; set base for numeric conversion to 10 - -.if cpu_msp430==1 - HEADER(XT_HEX,3,"hex",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_HEX: - .dw $ff03 - .db "hex",0 - .dw VE_HEAD - .set VE_HEAD = VE_HEX -XT_HEX: - .dw DO_COLON -PFA_HEX: -.endif - .dw XT_DOLITERAL - .dw 16 - .dw XT_BASE - .dw XT_STORE - .dw XT_EXIT diff --git a/amforth-6.5/common/words/hold.asm b/amforth-6.5/common/words/hold.asm deleted file mode 100644 index dda538a..0000000 --- a/amforth-6.5/common/words/hold.asm +++ /dev/null @@ -1,29 +0,0 @@ -; ( c -- ) -; Numeric IO -; prepend character to pictured numeric output buffer - -.if cpu_msp430==1 - HEADER(XT_HOLD,4,"hold",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_HOLD: - .dw $ff04 - .db "hold" - .dw VE_HEAD - .set VE_HEAD = VE_HOLD -XT_HOLD: - .dw DO_COLON -PFA_HOLD: -.endif - .dw XT_HLD - .dw XT_DUP - .dw XT_FETCH - .dw XT_1MINUS - .dw XT_DUP - .dw XT_TO_R - .dw XT_SWAP - .dw XT_STORE - .dw XT_R_FROM - .dw XT_CSTORE - .dw XT_EXIT diff --git a/amforth-6.5/common/words/if.asm b/amforth-6.5/common/words/if.asm deleted file mode 100644 index a3a0cc8..0000000 --- a/amforth-6.5/common/words/if.asm +++ /dev/null @@ -1,22 +0,0 @@ -; ( f -- ) (C: -- orig ) -; Compiler -; start conditional branch - -.if cpu_msp430==1 - IMMED(XT_IF,2,"if",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_IF: - .dw $0002 - .db "if" - .dw VE_HEAD - .set VE_HEAD = VE_IF -XT_IF: - .dw DO_COLON -PFA_IF: -.endif - .dw XT_COMPILE - .dw XT_DOCONDBRANCH - .dw XT_GMARK - .dw XT_EXIT diff --git a/amforth-6.5/common/words/interpret.asm b/amforth-6.5/common/words/interpret.asm deleted file mode 100644 index 37489ae..0000000 --- a/amforth-6.5/common/words/interpret.asm +++ /dev/null @@ -1,38 +0,0 @@ -; (i*x - j*x ) -; System -; Interpret SOURCE word by word. - -.if cpu_msp430==1 - HEADER(XT_INTERPRET,9,"interpret",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_INTERPRET: - .dw $ff09 - .db "interpret",0 - .dw VE_HEAD - .set VE_HEAD = VE_INTERPRET -XT_INTERPRET: - .dw DO_COLON -.endif -PFA_INTERPRET: - .dw XT_PARSENAME ; ( -- addr len ) - .dw XT_DUP ; ( -- addr len flag) - .dw XT_DOCONDBRANCH - DEST(PFA_INTERPRET2) - .dw XT_FORTHRECOGNIZER - .dw XT_RECOGNIZE - .dw XT_STATE - .dw XT_FETCH - .dw XT_DOCONDBRANCH - DEST(PFA_INTERPRET1) - .dw XT_ICELLPLUS ; we need the compile action -PFA_INTERPRET1: - .dw XT_FETCHI - .dw XT_EXECUTE - .dw XT_QSTACK - .dw XT_DOBRANCH - DEST(PFA_INTERPRET) -PFA_INTERPRET2: - .dw XT_2DROP - .dw XT_EXIT diff --git a/amforth-6.5/common/words/key.asm b/amforth-6.5/common/words/key.asm deleted file mode 100644 index 06a4b47..0000000 --- a/amforth-6.5/common/words/key.asm +++ /dev/null @@ -1,21 +0,0 @@ -; ( -- c ) -; Character IO -; fetch key vector and execute it, should leave a single character on TOS - -.if cpu_msp430==1 - DEFER(XT_KEY,3,"key") -.endif - -.if cpu_avr8==1 -VE_KEY: - .dw $ff03 - .db "key",0 - .dw VE_HEAD - .set VE_HEAD = VE_KEY -XT_KEY: - .dw PFA_DODEFER1 -PFA_KEY: -.endif - .dw USER_KEY - .dw XT_UDEFERFETCH - .dw XT_UDEFERSTORE diff --git a/amforth-6.5/common/words/keyq.asm b/amforth-6.5/common/words/keyq.asm deleted file mode 100644 index 70e8c73..0000000 --- a/amforth-6.5/common/words/keyq.asm +++ /dev/null @@ -1,21 +0,0 @@ -; ( -- f) -; Character IO -; fetch key? vector and execute it. should turn on key sender, if it is disabled/stopped - -.if cpu_msp430==1 - DEFER(XT_KEYQ,4,"key?") -.endif - -.if cpu_avr8==1 -VE_KEYQ: - .dw $ff04 - .db "key?" - .dw VE_HEAD - .set VE_HEAD = VE_KEYQ -XT_KEYQ: - .dw PFA_DODEFER1 -PFA_KEYQ: -.endif - .dw USER_KEYQ - .dw XT_UDEFERFETCH - .dw XT_UDEFERSTORE diff --git a/amforth-6.5/common/words/l-from.asm b/amforth-6.5/common/words/l-from.asm deleted file mode 100644 index 353fbeb..0000000 --- a/amforth-6.5/common/words/l-from.asm +++ /dev/null @@ -1,27 +0,0 @@ - -.if cpu_msp430==1 - HEADER(XT_L_FROM,2,"l>",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_L_FROM: - .dw $ff02 - .db "l>" - .dw VE_HEAD - .set VE_HEAD = VE_L_FROM -XT_L_FROM: - .dw DO_COLON -PFA_L_FROM: - -.endif -;Z L> -- x L: x -- move from leave stack -; LP @ @ -2 LP +! ; - - .dw XT_LP - .dw XT_FETCH - .dw XT_FETCH - .dw XT_DOLITERAL - .dw -2 - .dw XT_LP - .dw XT_PLUSSTORE - .dw XT_EXIT diff --git a/amforth-6.5/common/words/l-paren.asm b/amforth-6.5/common/words/l-paren.asm deleted file mode 100644 index b1d0ef1..0000000 --- a/amforth-6.5/common/words/l-paren.asm +++ /dev/null @@ -1,23 +0,0 @@ -; ( "ccc" -- ) -; Compiler -; skip everything up to the closing bracket on the same line - -.if cpu_msp430==1 - IMMED(XT_PAREN,1,"(",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_LPAREN: - .dw $0001 - .db "(" ,0 - .dw VE_HEAD - .set VE_HEAD = VE_LPAREN -XT_LPAREN: - .dw DO_COLON -PFA_LPAREN: -.endif - .dw XT_DOLITERAL - .dw ')' - .dw XT_PARSE - .dw XT_2DROP - .dw XT_EXIT diff --git a/amforth-6.5/common/words/leave.asm b/amforth-6.5/common/words/leave.asm deleted file mode 100644 index a7e676c..0000000 --- a/amforth-6.5/common/words/leave.asm +++ /dev/null @@ -1,20 +0,0 @@ -; ( -- ) (R: loop-sys -- ) -; Compiler -; immediatly leave the current DO..LOOP - -.if cpu_msp430==1 - IMMED(XT_LEAVE,5,"leave",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_LEAVE: - .dw $0005 - .db "leave",0 - .dw VE_HEAD - .set VE_HEAD = VE_LEAVE -XT_LEAVE: - .dw DO_COLON -PFA_LEAVE: -.endif - .DW XT_COMPILE,XT_UNLOOP - .DW XT_AHEAD,XT_TO_L,XT_EXIT diff --git a/amforth-6.5/common/words/left-bracket.asm b/amforth-6.5/common/words/left-bracket.asm deleted file mode 100644 index 1957d4f..0000000 --- a/amforth-6.5/common/words/left-bracket.asm +++ /dev/null @@ -1,22 +0,0 @@ -; ( -- ) -; Compiler -; enter interpreter mode - -.if cpu_msp430==1 - IMMED(XT_LBRACKET,1,"[",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_LBRACKET: - .dw $0001 - .db "[",0 - .dw VE_HEAD - .set VE_HEAD = VE_LBRACKET -XT_LBRACKET: - .dw DO_COLON -PFA_LBRACKET: -.endif - .dw XT_ZERO - .dw XT_STATE - .dw XT_STORE - .dw XT_EXIT diff --git a/amforth-6.5/common/words/less-sharp.asm b/amforth-6.5/common/words/less-sharp.asm deleted file mode 100644 index 122c246..0000000 --- a/amforth-6.5/common/words/less-sharp.asm +++ /dev/null @@ -1,22 +0,0 @@ -; ( -- ) -; Numeric IO -; initialize the pictured numeric output conversion process - -.if cpu_msp430==1 - HEADER(XT_L_SHARP,2,"<#",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_L_SHARP: - .dw $ff02 - .db "<#" - .dw VE_HEAD - .set VE_HEAD = VE_L_SHARP -XT_L_SHARP: - .dw DO_COLON -PFA_L_SHARP: -.endif - .dw XT_PAD - .dw XT_HLD - .dw XT_STORE - .dw XT_EXIT diff --git a/amforth-6.5/common/words/literal.asm b/amforth-6.5/common/words/literal.asm deleted file mode 100644 index 7d69652..0000000 --- a/amforth-6.5/common/words/literal.asm +++ /dev/null @@ -1,22 +0,0 @@ -; ( -- n ) (C: n -- ) -; Compiler -; compile a literal in colon defintions - -.if cpu_msp430==1 - IMMED(XT_LITERAL,7,"literal",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_LITERAL: - .dw $0007 - .db "literal",0 - .dw VE_HEAD - .set VE_HEAD = VE_LITERAL -XT_LITERAL: - .dw DO_COLON -PFA_LITERAL: -.endif - .DW XT_COMPILE - .DW XT_DOLITERAL - .DW XT_COMMA - .DW XT_EXIT diff --git a/amforth-6.5/common/words/loop.asm b/amforth-6.5/common/words/loop.asm deleted file mode 100644 index 9ffbfac..0000000 --- a/amforth-6.5/common/words/loop.asm +++ /dev/null @@ -1,22 +0,0 @@ -; (R: loop-sys -- ) (C: do-sys -- ) -; Compiler -; compile (loop) and resolve the backward branch - -.if cpu_msp430==1 - IMMED(XT_LOOP,4,"loop",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_LOOP: - .dw $0004 - .db "loop" - .dw VE_HEAD - .set VE_HEAD = VE_LOOP -XT_LOOP: - .dw DO_COLON -PFA_LOOP: -.endif - .dw XT_COMPILE - .dw XT_DOLOOP - .dw XT_ENDLOOP - .dw XT_EXIT diff --git a/amforth-6.5/common/words/map-stack.asm b/amforth-6.5/common/words/map-stack.asm deleted file mode 100644 index 48995a1..0000000 --- a/amforth-6.5/common/words/map-stack.asm +++ /dev/null @@ -1,61 +0,0 @@ -; ( i*x XT e-addr -- j*y true | i*x false ) -; Tools -; Iterate over a stack - -.if cpu_msp430==1 - HEADER(XT_MAPSTACK,9,"map-stack",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_MAPSTACK: - .dw $ff09 - .db "map-stack",0 - .dw VE_HEAD - .set VE_HEAD = VE_MAPSTACK -XT_MAPSTACK: - .dw DO_COLON -PFA_MAPSTACK: -.endif - .dw XT_DUP - .dw XT_CELLPLUS - .dw XT_SWAP - .dw XT_FETCHE - .dw XT_CELLS - .dw XT_BOUNDS - .dw XT_QDOCHECK - .dw XT_DOCONDBRANCH - DEST(PFA_MAPSTACK3) - .dw XT_DODO -PFA_MAPSTACK1: - .dw XT_I - .dw XT_FETCHE ; -- i*x XT id - .dw XT_SWAP - .dw XT_TO_R - .dw XT_R_FETCH - .dw XT_EXECUTE ; i*x id -- j*y true | i*x false - .dw XT_QDUP - .dw XT_DOCONDBRANCH - DEST(PFA_MAPSTACK2) - .dw XT_R_FROM - .dw XT_DROP - .dw XT_UNLOOP - .dw XT_EXIT -PFA_MAPSTACK2: - .dw XT_R_FROM - .dw XT_TWO - .dw XT_DOPLUSLOOP - DEST(PFA_MAPSTACK1) -PFA_MAPSTACK3: - .dw XT_DROP - .dw XT_ZERO - .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 -; ; diff --git a/amforth-6.5/common/words/max.asm b/amforth-6.5/common/words/max.asm deleted file mode 100644 index 44cbbad..0000000 --- a/amforth-6.5/common/words/max.asm +++ /dev/null @@ -1,27 +0,0 @@ -; ( n1 n2 -- n1|n2 ) -; Compare -; compare two values, leave the bigger one - -.if cpu_msp430==1 - HEADER(XT_MAX,3,"max",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_MAX: - .dw $ff03 - .db "max",0 - .dw VE_HEAD - .set VE_HEAD = VE_MAX -XT_MAX: - .dw DO_COLON -PFA_MAX: - -.endif - .dw XT_2DUP - .dw XT_LESS - .dw XT_DOCONDBRANCH - DEST(PFA_MAX1) - .dw XT_SWAP -PFA_MAX1: - .dw XT_DROP - .dw XT_EXIT diff --git a/amforth-6.5/common/words/min.asm b/amforth-6.5/common/words/min.asm deleted file mode 100644 index 59e9965..0000000 --- a/amforth-6.5/common/words/min.asm +++ /dev/null @@ -1,28 +0,0 @@ -; ( n1 n2 -- n1|n2 ) -; Compare -; compare two values leave the smaller one - -.if cpu_msp430==1 - HEADER(XT_MIN,3,"min",DOCOLON) -.endif - -.if cpu_avr8==1 - - -VE_MIN: - .dw $ff03 - .db "min",0 - .dw VE_HEAD - .set VE_HEAD = VE_MIN -XT_MIN: - .dw DO_COLON -PFA_MIN: -.endif - .dw XT_2DUP - .dw XT_GREATER - .dw XT_DOCONDBRANCH - DEST(PFA_MIN1) - .dw XT_SWAP -PFA_MIN1: - .dw XT_DROP - .dw XT_EXIT diff --git a/amforth-6.5/common/words/mod.asm b/amforth-6.5/common/words/mod.asm deleted file mode 100644 index 1f6cdee..0000000 --- a/amforth-6.5/common/words/mod.asm +++ /dev/null @@ -1,23 +0,0 @@ -; ( n1 n2 -- n3) -; Arithmetics -; divide n1 by n2 giving the remainder n3 - -.if cpu_msp430==1 - HEADER(XT_MOD,3,"mod",DOCOLON) -.endif - -.if cpu_avr8==1 - - -VE_MOD: - .dw $ff03 - .db "mod",0 - .dw VE_HEAD - .set VE_HEAD = VE_MOD -XT_MOD: - .dw DO_COLON -PFA_MOD: -.endif - .dw XT_SLASHMOD - .dw XT_DROP - .dw XT_EXIT diff --git a/amforth-6.5/common/words/name2compile.asm b/amforth-6.5/common/words/name2compile.asm deleted file mode 100644 index 129ea0f..0000000 --- a/amforth-6.5/common/words/name2compile.asm +++ /dev/null @@ -1,31 +0,0 @@ -; ( nt -- xt1 xt2 ) -; Tools (ext) -; get the execution token from the name token in compile state -.if cpu_msp430==1 - HEADER(XT_NAME2COMPILE,12,"name>compile",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_NAME2COMPILE: - .dw $ff0c - .db "name>compile" - .dw VE_HEAD - .set VE_HEAD = VE_NAME2COMPILE -XT_NAME2COMPILE: - .dw DO_COLON -PFA_NAME2COMPILE: -.endif - .dw XT_DUP - .dw XT_NFA2CFA - .dw XT_SWAP - .dw XT_NAME2FLAGS - .dw XT_IMMEDIATEQ - .dw XT_DOCONDBRANCH - DEST(NAME2COMPILE1) - .dw XT_DOLITERAL - .dw XT_COMMA - .dw XT_EXIT -NAME2COMPILE1: - .dw XT_DOLITERAL - .dw XT_EXECUTE - .dw XT_EXIT diff --git a/amforth-6.5/common/words/name2interpret.asm b/amforth-6.5/common/words/name2interpret.asm deleted file mode 100644 index 5a43389..0000000 --- a/amforth-6.5/common/words/name2interpret.asm +++ /dev/null @@ -1,19 +0,0 @@ -; ( nt -- xt ) -; Tools (ext) -; get the execution token from the name token -.if cpu_msp430==1 - HEADER(XT_NAME2INTERPRET,14,"name>interpret",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_NAME2INTERPRET: - .dw $ff0e - .db "name>interpret" - .dw VE_HEAD - .set VE_HEAD = VE_NAME2INTERPRET -XT_NAME2INTERPRET: - .dw DO_COLON -PFA_NAME2INTERPRET: -.endif - .dw XT_NFA2CFA - .dw XT_EXIT diff --git a/amforth-6.5/common/words/name2string.asm b/amforth-6.5/common/words/name2string.asm deleted file mode 100644 index 733e143..0000000 --- a/amforth-6.5/common/words/name2string.asm +++ /dev/null @@ -1,24 +0,0 @@ -; ( nt -- addr len ) -; Tools Ext (2012) -; get a (flash) string from a name token nt - -.if cpu_msp430==1 - HEADER(XT_NAME2STRING,11,"name>string",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_NAME2STRING: - .dw $ff0b - .db "name>string",0 - .dw VE_HEAD - .set VE_HEAD = VE_NAME2STRING -XT_NAME2STRING: - .dw DO_COLON -PFA_NAME2STRING: - -.endif - .dw XT_ICOUNT ; ( -- addr n ) - .dw XT_DOLITERAL - .dw 255 - .dw XT_AND ; mask immediate bit - .dw XT_EXIT diff --git a/amforth-6.5/common/words/noop.asm b/amforth-6.5/common/words/noop.asm deleted file mode 100644 index 9a99c28..0000000 --- a/amforth-6.5/common/words/noop.asm +++ /dev/null @@ -1,19 +0,0 @@ -; ( -- ) -; Tools -; do nothing - -.if cpu_msp430==1 - HEADER(XT_NOOP,4,"noop",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_NOOP: - .dw $ff04 - .db "noop" - .dw VE_HEAD - .set VE_HEAD = VE_NOOP -XT_NOOP: - .dw DO_COLON -PFA_NOOP: -.endif - .DW XT_EXIT diff --git a/amforth-6.5/common/words/not-equal.asm b/amforth-6.5/common/words/not-equal.asm deleted file mode 100644 index 2d103ed..0000000 --- a/amforth-6.5/common/words/not-equal.asm +++ /dev/null @@ -1,20 +0,0 @@ -; ( n1 n2 -- flag) -; Compare -; true if n1 is not equal to n2 - -.if cpu_msp430==1 - HEADER(XT_NOTEQUAL,2,"<>",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_NOTEQUAL: - .dw $ff02 - .db "<>" - .dw VE_HEAD - .set VE_HEAD = VE_NOTEQUAL -XT_NOTEQUAL: - .dw DO_COLON -PFA_NOTEQUAL: -.endif - - .DW XT_EQUAL,XT_ZEROEQUAL,XT_EXIT diff --git a/amforth-6.5/common/words/num-constants.asm b/amforth-6.5/common/words/num-constants.asm deleted file mode 100644 index 88d1449..0000000 --- a/amforth-6.5/common/words/num-constants.asm +++ /dev/null @@ -1,51 +0,0 @@ -.if cpu_msp430==1 - HEADER(XT_ZERO,1,"0",DOCON) - DW 0 -.endif - -.if cpu_msp430==1 - HEADER(XT_ONE,1,"1",DOCON) -.endif - -.if cpu_avr8==1 -VE_ONE: - .dw $ff01 - .db "1",0 - .dw VE_HEAD - .set VE_HEAD = VE_ONE -XT_ONE: - .dw PFA_DOVARIABLE -PFA_ONE: -.endif - .DW 1 - -.if cpu_msp430==1 - HEADER(XT_TWO,1,"2",DOCON) -.endif - -.if cpu_avr8==1 -VE_TWO: - .dw $ff01 - .db "2",0 - .dw VE_HEAD - .set VE_HEAD = VE_TWO -XT_TWO: - .dw PFA_DOVARIABLE -PFA_TWO: -.endif - .DW 2 -.if cpu_msp430==1 - HEADER(XT_MINUSONE,2,"-1",DOCON) -.endif - -.if cpu_avr8==1 -VE_MINUSONE: - .dw $ff02 - .db "-1" - .dw VE_HEAD - .set VE_HEAD = VE_MINUSONE -XT_MINUSONE: - .dw PFA_DOVARIABLE -PFA_MINUSONE: -.endif - .DW -1 diff --git a/amforth-6.5/common/words/number.asm b/amforth-6.5/common/words/number.asm deleted file mode 100644 index 0c22655..0000000 --- a/amforth-6.5/common/words/number.asm +++ /dev/null @@ -1,101 +0,0 @@ -; (addr len -- [n|d size] f) -; Numeric IO -; convert a string at addr to a number - -.if cpu_msp430==1 - HEADER(XT_NUMBER,6,"number",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_NUMBER: - .dw $ff06 - .db "number" - .dw VE_HEAD - .set VE_HEAD = VE_NUMBER -XT_NUMBER: - .dw DO_COLON -PFA_NUMBER: -.endif - .dw XT_BASE - .dw XT_FETCH - .dw XT_TO_R - .dw XT_QSIGN - .dw XT_TO_R - .dw XT_SET_BASE - .dw XT_QSIGN - .dw XT_R_FROM - .dw XT_OR - .dw XT_TO_R - ; check whether something is left - .dw XT_DUP - .dw XT_ZEROEQUAL - .dw XT_DOCONDBRANCH - DEST(PFA_NUMBER0) - ; nothing is left. It cannot be a number at all - .dw XT_2DROP - .dw XT_R_FROM - .dw XT_DROP - .dw XT_R_FROM - .dw XT_BASE - .dw XT_STORE - .dw XT_ZERO - .dw XT_EXIT -PFA_NUMBER0: - .dw XT_2TO_R - .dw XT_ZERO ; starting value - .dw XT_ZERO - .dw XT_2R_FROM - .dw XT_TO_NUMBER ; ( 0. addr len -- d addr' len' - ; check length of the remaining string. - ; if zero: a single cell number is entered - .dw XT_QDUP - .dw XT_DOCONDBRANCH - DEST(PFA_NUMBER1) - ; if equal 1: mayba a trailing dot? --> double cell number - .dw XT_ONE - .dw XT_EQUAL - .dw XT_DOCONDBRANCH - DEST(PFA_NUMBER2) - ; excatly one character is left - .dw XT_CFETCH - .dw XT_DOLITERAL - .dw 46 ; . - .dw XT_EQUAL - .dw XT_DOCONDBRANCH - DEST(PFA_NUMBER6) - ; its a double cell number - ; incorporate sign into number - .dw XT_R_FROM - .dw XT_DOCONDBRANCH - DEST(PFA_NUMBER3) - .dw XT_DNEGATE -PFA_NUMBER3: - .dw XT_TWO - .dw XT_DOBRANCH - DEST(PFA_NUMBER5) -PFA_NUMBER2: - .dw XT_DROP -PFA_NUMBER6: - .dw XT_2DROP - .dw XT_R_FROM - .dw XT_DROP - .dw XT_R_FROM - .dw XT_BASE - .dw XT_STORE - .dw XT_ZERO - .dw XT_EXIT -PFA_NUMBER1: - .dw XT_2DROP ; remove the address - ; incorporate sign into number - .dw XT_R_FROM - .dw XT_DOCONDBRANCH - DEST(PFA_NUMBER4) - .dw XT_NEGATE -PFA_NUMBER4: - .dw XT_ONE -PFA_NUMBER5: - .dw XT_R_FROM - .dw XT_BASE - .dw XT_STORE - .dw XT_TRUE - .dw XT_EXIT diff --git a/amforth-6.5/common/words/pad.asm b/amforth-6.5/common/words/pad.asm deleted file mode 100644 index 93a2863..0000000 --- a/amforth-6.5/common/words/pad.asm +++ /dev/null @@ -1,23 +0,0 @@ -; ( -- a-addr ) -; System Variable -; Address of the temporary scratch buffer. - -.if cpu_msp430==1 - HEADER(XT_PAD,3,"pad",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_PAD: - .dw $ff03 - .db "pad",0 - .dw VE_HEAD - .set VE_HEAD = VE_PAD -XT_PAD: - .dw DO_COLON -PFA_PAD: -.endif - .dw XT_HERE - .dw XT_DOLITERAL - .dw 40 - .dw XT_PLUS - .dw XT_EXIT diff --git a/amforth-6.5/common/words/parse-name.asm b/amforth-6.5/common/words/parse-name.asm deleted file mode 100644 index 3c26396..0000000 --- a/amforth-6.5/common/words/parse-name.asm +++ /dev/null @@ -1,60 +0,0 @@ -; ( "" -- c-addr u ) -; String -; In the SOURCE buffer parse whitespace delimited string. Returns string address within SOURCE. - -.if cpu_msp430==1 - HEADER(XT_PARSENAME,10,"parse-name",DOCOLON) -.endif - -.if cpu_avr8==1 - -VE_PARSENAME: - .dw $FF0A - .db "parse-name" - .dw VE_HEAD - .set VE_HEAD = VE_PARSENAME -XT_PARSENAME: - .dw DO_COLON -PFA_PARSENAME: -.endif - .dw XT_BL - .dw XT_SKIPSCANCHAR - .dw XT_EXIT - -; ( c -- addr2 len2 ) -; String -; skips char and scan what's left in source for char -.if cpu_msp430==1 - HEADLESS(XT_SKIPSCANCHAR,DOCOLON) -.endif - -.if cpu_avr8==1 -;VE_SKIPSCANCHAR: -; .dw $FF0A -; .db "skipscanchar" -; .dw VE_HEAD -; .set VE_HEAD = VE_SKIPSCANCHAR -XT_SKIPSCANCHAR: - .dw DO_COLON -PFA_SKIPSCANCHAR: -.endif - .dw XT_TO_R - .dw XT_SOURCE - .dw XT_TO_IN - .dw XT_FETCH - .dw XT_SLASHSTRING - - .dw XT_R_FETCH - .dw XT_CSKIP - .dw XT_R_FROM - .dw XT_CSCAN - - ; adjust >IN - .dw XT_2DUP - .dw XT_PLUS - .dw XT_SOURCE - .dw XT_DROP - .dw XT_MINUS - .dw XT_TO_IN - .dw XT_STORE - .dw XT_EXIT diff --git a/amforth-6.5/common/words/parse.asm b/amforth-6.5/common/words/parse.asm deleted file mode 100644 index 0e51c05..0000000 --- a/amforth-6.5/common/words/parse.asm +++ /dev/null @@ -1,33 +0,0 @@ -; ( char "ccc" -- c-addr u ) -; String -; in input buffer parse ccc delimited string by the delimiter char. - -.if cpu_msp430==1 - HEADER(XT_PARSE,5,"parse",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_PARSE: - .dw $ff05 - .db "parse",0 - .dw VE_HEAD - .set VE_HEAD = VE_PARSE -XT_PARSE: - .dw DO_COLON -PFA_PARSE: -.endif - .dw XT_TO_R ; ( -- ) - .dw XT_SOURCE ; ( -- addr len) - .dw XT_TO_IN ; ( -- addr len >in) - .dw XT_FETCH - .dw XT_SLASHSTRING ; ( -- addr' len' ) - - .dw XT_R_FROM ; ( -- addr' len' c) - .dw XT_CSCAN ; ( -- addr' len'') - .dw XT_DUP ; ( -- addr' len'' len'') - .dw XT_1PLUS - .dw XT_TO_IN ; ( -- addr' len'' len'' >in) - .dw XT_PLUSSTORE ; ( -- addr' len') - .dw XT_ONE - .dw XT_SLASHSTRING - .dw XT_EXIT diff --git a/amforth-6.5/common/words/pick.asm b/amforth-6.5/common/words/pick.asm deleted file mode 100644 index 4e246ea..0000000 --- a/amforth-6.5/common/words/pick.asm +++ /dev/null @@ -1,21 +0,0 @@ - -.if cpu_msp430==1 - HEADER(XT_PICK,4,"pick",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_PICK: - .dw $ff04 - .db "pick" - .dw VE_HEAD - .set VE_HEAD = VE_PICK -XT_PICK: - .dw DO_COLON -PFA_PICK: -.endif - .dw XT_1PLUS - .dw XT_CELLS - .dw XT_SP_FETCH - .dw XT_PLUS - .dw XT_FETCH - .dw XT_EXIT diff --git a/amforth-6.5/common/words/place.asm b/amforth-6.5/common/words/place.asm deleted file mode 100644 index 916b0ae..0000000 --- a/amforth-6.5/common/words/place.asm +++ /dev/null @@ -1,24 +0,0 @@ -; ( addr1 len1 addr2 -- ) -; String -; copy string as counted string - -.if cpu_msp430==1 - HEADER(XT_PLACE,5,"place",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_PLACE: - .dw $ff05 - .db "place",0 - .dw VE_HEAD - .set VE_HEAD = VE_PLACE -XT_PLACE: - .dw DO_COLON -PFA_PLACE: -.endif - .dw XT_2DUP ; ( -- addr1 len1 addr2 len1 addr2) - .dw XT_CSTORE ; ( -- addr1 len1 addr2) - .dw XT_1PLUS ; ( -- addr1 len1 addr2') - .dw XT_SWAP ; ( -- addr1 addr2' len1) - .dw XT_CMOVE ; ( --- ) - .dw XT_EXIT diff --git a/amforth-6.5/common/words/plusloop.asm b/amforth-6.5/common/words/plusloop.asm deleted file mode 100644 index df7925c..0000000 --- a/amforth-6.5/common/words/plusloop.asm +++ /dev/null @@ -1,22 +0,0 @@ -; ( n -- ) (R: loop-sys -- loop-sys| ) (C: do-sys -- ) -; Compiler -; compile (+loop) and resolve branches - -.if cpu_msp430==1 - IMMED(XT_PLUSLOOP,5,"+loop",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_PLUSLOOP: - .dw $0005 - .db "+loop",0 - .dw VE_HEAD - .set VE_HEAD = VE_PLUSLOOP -XT_PLUSLOOP: - .dw DO_COLON -PFA_PLUSLOOP: -.endif - .dw XT_COMPILE - .dw XT_DOPLUSLOOP - .dw XT_ENDLOOP - .dw XT_EXIT diff --git a/amforth-6.5/common/words/postpone.asm b/amforth-6.5/common/words/postpone.asm deleted file mode 100644 index 10f36df..0000000 --- a/amforth-6.5/common/words/postpone.asm +++ /dev/null @@ -1,32 +0,0 @@ -; ( "name" -- ) -; Compiler -; Append the compilation semantics of "name" to the dictionary - -.if cpu_msp430==1 - IMMED(XT_POSTPONE,8,"postpone",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_POSTPONE: - .dw $0008 - .db "postpone" - .dw VE_HEAD - .set VE_HEAD = VE_POSTPONE -XT_POSTPONE: - .dw DO_COLON -PFA_POSTPONE: -.endif - .dw XT_PARSENAME - .dw XT_FORTHRECOGNIZER - .dw XT_RECOGNIZE - .dw XT_DUP - .dw XT_TO_R - .dw XT_ICELLPLUS - .dw XT_ICELLPLUS - .dw XT_FETCHI - .dw XT_EXECUTE - .dw XT_R_FROM - .dw XT_ICELLPLUS - .dw XT_FETCHI - .dw XT_COMMA - .dw XT_EXIT diff --git a/amforth-6.5/common/words/prompt-error.asm b/amforth-6.5/common/words/prompt-error.asm deleted file mode 100644 index 5d94faa..0000000 --- a/amforth-6.5/common/words/prompt-error.asm +++ /dev/null @@ -1,64 +0,0 @@ -; ( n -- ) -; System -; process the error prompt - -.if cpu_msp430==1 - HEADLESS(XT_DEFAULT_PROMPTERROR,DOCOLON) - DW XT_DOSLITERAL - DB 4," ?? " - .align 16 -.endif - -.if cpu_avr8==1 -;VE_PROMPTERROR: -; .dw $ff04 -; .db "p_er" -; .dw VE_HEAD -; .set VE_HEAD = VE_PROMPTERROR -XT_DEFAULT_PROMPTERROR: - .dw DO_COLON -PFA_DEFAULT_PROMPTERROR: - .dw XT_DOSLITERAL - .dw 4 - .db " ?? " -.endif - .dw XT_ITYPE - .dw XT_BASE - .dw XT_FETCH - .dw XT_TO_R - .dw XT_DECIMAL - .dw XT_DOT - .dw XT_TO_IN - .dw XT_FETCH - .dw XT_DOT - .dw XT_R_FROM - .dw XT_BASE - .dw XT_STORE - .dw XT_EXIT - -; ------------------------ - -.if cpu_msp430==1 -; DEFER(XT_PROMPTERROR,6,".error") - DW link - DB 0FFh -.set link = $ - DB 6,".","error" - .align 16 -XT_PROMPTERROR: - DW DODEFER -.endif - -.if cpu_avr8==1 -VE_PROMPTERROR: - .dw $FF06 - .db ".error" - .dw VE_HEAD - .set VE_HEAD = VE_PROMPTERROR -XT_PROMPTERROR: - .dw PFA_DODEFER1 -PFA_PROMPTERROR: -.endif - .dw USER_P_ERR - .dw XT_UDEFERFETCH - .dw XT_UDEFERSTORE diff --git a/amforth-6.5/common/words/prompt-ok.asm b/amforth-6.5/common/words/prompt-ok.asm deleted file mode 100644 index 6a73974..0000000 --- a/amforth-6.5/common/words/prompt-ok.asm +++ /dev/null @@ -1,52 +0,0 @@ -; ( -- ) -; System -; send the READY prompt to the command line - -.if cpu_msp430==1 - HEADLESS(XT_DEFAULT_PROMPTOK,DOCOLON) - DW XT_DOSLITERAL - DB 3," ok" -.endif - -.if cpu_avr8==1 -;VE_PROMPTOK: -; .dw $ff02 -; .db "ok" -; .dw VE_HEAD -; .set VE_HEAD = VE_PROMPTOK -XT_DEFAULT_PROMPTOK: - .dw DO_COLON -PFA_DEFAULT_PROMPTOK: - .dw XT_DOSLITERAL - .dw 3 - .db " ok",0 -.endif - .dw XT_ITYPE - .dw XT_EXIT - -; ------------------------ - -.if cpu_msp430==1 -; DEFER(XT_PROMPTOK,2,"ok") - DW link - DB 0FFh -.set link = $ - DB 3,".","ok" - .align 16 -XT_PROMPTOK: - DW DODEFER -.endif - -.if cpu_avr8==1 -VE_PROMPTOK: - .dw $FF03 - .db ".ok" - .dw VE_HEAD - .set VE_HEAD = VE_PROMPTOK -XT_PROMPTOK: - .dw PFA_DODEFER1 -PFA_PROMPTOK: -.endif - .dw USER_P_OK - .dw XT_UDEFERFETCH - .dw XT_UDEFERSTORE diff --git a/amforth-6.5/common/words/prompt-ready.asm b/amforth-6.5/common/words/prompt-ready.asm deleted file mode 100644 index ad5915c..0000000 --- a/amforth-6.5/common/words/prompt-ready.asm +++ /dev/null @@ -1,54 +0,0 @@ -; ( n -- ) -; System -; process the error prompt - -.if cpu_msp430==1 - HEADLESS(XT_DEFAULT_PROMPTREADY,DOCOLON) - DW XT_DOSLITERAL - DB 2,"> " - .align 16 -.endif - -.if cpu_avr8==1 -;VE_PROMPTRDY: -; .dw $ff04 -; .db "p_er" -; .dw VE_HEAD -; .set VE_HEAD = VE_PROMPTRDY -XT_DEFAULT_PROMPTREADY: - .dw DO_COLON -PFA_DEFAULT_PROMPTREADY: - .dw XT_DOSLITERAL - .dw 2 - .db "> " -.endif - .dw XT_CR - .dw XT_ITYPE - .dw XT_EXIT - -; ------------------------ - -.if cpu_msp430==1 -; DEFER(XT_PROMPTREADY,6,".ready") - DW link - DB 0FFh -.set link = $ - DB 6,".","ready" - .align 16 -XT_PROMPTREADY: - DW DODEFER -.endif - -.if cpu_avr8==1 -VE_PROMPTREADY: - .dw $FF06 - .db ".ready" - .dw VE_HEAD - .set VE_HEAD = VE_PROMPTREADY -XT_PROMPTREADY: - .dw PFA_DODEFER1 -PFA_PROMPTREADY: -.endif - .dw USER_P_RDY - .dw XT_UDEFERFETCH - .dw XT_UDEFERSTORE diff --git a/amforth-6.5/common/words/q-abort.asm b/amforth-6.5/common/words/q-abort.asm deleted file mode 100644 index 89f25bf..0000000 --- a/amforth-6.5/common/words/q-abort.asm +++ /dev/null @@ -1,22 +0,0 @@ -;Z ?ABORT f c-addr u -- abort & print msg -; ROT IF ITYPE ABORT THEN 2DROP ; - -.if cpu_msp430==1 - HEADER(XT_QABORT,6,"?abort",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_QABORT: - .dw $ff06 - .db "?abort" - .dw VE_HEAD - .set VE_HEAD = VE_QABORT -XT_QABORT: - .dw DO_COLON -PFA_QABORT: - -.endif - .DW XT_ROT,XT_DOCONDBRANCH - DEST(QABO1) - .DW XT_ITYPE,XT_ABORT -QABO1: .DW XT_2DROP,XT_EXIT diff --git a/amforth-6.5/common/words/q-dnegate.asm b/amforth-6.5/common/words/q-dnegate.asm deleted file mode 100644 index a9938c6..0000000 --- a/amforth-6.5/common/words/q-dnegate.asm +++ /dev/null @@ -1,21 +0,0 @@ -;Z ?DNEGATE d1 n -- d2 negate d1 if n negative -; 0< IF DNEGATE THEN ; ...a common factor - -.if cpu_msp430==1 - HEADER(XT_QDNEGATE,8,"?dnegate",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_QDNEGATE: - .dw $ff08 - .db "?dnegate" - .dw VE_HEAD - .set VE_HEAD = VE_QDNEGATE -XT_QDNEGATE: - .dw DO_COLON -PFA_QDNEGATE: -.endif - .DW XT_ZEROLESS,XT_DOCONDBRANCH - DEST(DNEG1) - .DW XT_DNEGATE -DNEG1: .DW XT_EXIT diff --git a/amforth-6.5/common/words/q-negate.asm b/amforth-6.5/common/words/q-negate.asm deleted file mode 100644 index b6fe534..0000000 --- a/amforth-6.5/common/words/q-negate.asm +++ /dev/null @@ -1,22 +0,0 @@ -;Z ?NEGATE n1 n2 -- n3 negate n1 if n2 negative -; 0< IF NEGATE THEN ; ...a common factor - -.if cpu_msp430==1 - HEADER(XT_QNEGATE,7,"?negate",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_QNEGATE: - .dw $ff07 - .db "?negate" - .dw VE_HEAD - .set VE_HEAD = VE_QNEGATE -XT_QNEGATE: - .dw DO_COLON -PFA_QNEGATE: - -.endif - .DW XT_ZEROLESS,XT_DOCONDBRANCH - DEST(QNEG1) - .DW XT_NEGATE -QNEG1: .DW XT_EXIT diff --git a/amforth-6.5/common/words/q-sign.asm b/amforth-6.5/common/words/q-sign.asm deleted file mode 100644 index 8f0422b..0000000 --- a/amforth-6.5/common/words/q-sign.asm +++ /dev/null @@ -1,24 +0,0 @@ - -.if cpu_msp430==1 - HEADLESS(XT_QSIGN,DOCOLON) -.endif - -.if cpu_avr8==1 -XT_QSIGN: - .dw DO_COLON -PFA_QSIGN: ; ( c -- ) -.endif - .dw XT_OVER ; ( -- addr len addr ) - .dw XT_CFETCH - .dw XT_DOLITERAL - .dw '-' - .dw XT_EQUAL ; ( -- addr len flag ) - .dw XT_DUP - .dw XT_TO_R - .dw XT_DOCONDBRANCH - DEST(PFA_NUMBERSIGN_DONE) - .dw XT_ONE ; skip sign character - .dw XT_SLASHSTRING -PFA_NUMBERSIGN_DONE: - .dw XT_R_FROM - .dw XT_EXIT diff --git a/amforth-6.5/common/words/q-stack.asm b/amforth-6.5/common/words/q-stack.asm deleted file mode 100644 index f652bb2..0000000 --- a/amforth-6.5/common/words/q-stack.asm +++ /dev/null @@ -1,26 +0,0 @@ -; ( -- ) -; Tools -; check data stack depth and exit to quit if underrun -.if cpu_msp430==1 - HEADER(XT_QSTACK,6,"?stack",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_QSTACK: - .dw $ff06 - .db "?stack" - .dw VE_HEAD - .set VE_HEAD = VE_QSTACK -XT_QSTACK: - .dw DO_COLON -PFA_QSTACK: -.endif - .dw XT_DEPTH - .dw XT_ZEROLESS - .dw XT_DOCONDBRANCH - DEST(PFA_QSTACK1) - .dw XT_DOLITERAL - .dw -4 - .dw XT_THROW -PFA_QSTACK1: - .dw XT_EXIT diff --git a/amforth-6.5/common/words/qdo.asm b/amforth-6.5/common/words/qdo.asm deleted file mode 100644 index 491d06c..0000000 --- a/amforth-6.5/common/words/qdo.asm +++ /dev/null @@ -1,54 +0,0 @@ -; ( n1|u1 n2|u2 -- ) R( -- | loop-sys ) (C: -- do-sys) -; Compiler -; start a ?do .. [+]loop control structure - -.if cpu_msp430==1 - IMMED(XT_QDO,3,"?do",DOCOLON) -.endif - -.if cpu_avr8==1 - -VE_QDO: - .dw $0003 - .db "?do",0 - .dw VE_HEAD - .set VE_HEAD = VE_QDO -XT_QDO: - .dw DO_COLON -PFA_QDO: -.endif - .dw XT_COMPILE - .dw XT_QDOCHECK - .dw XT_IF - .dw XT_DO - .dw XT_SWAP ; DO sets a 0 marker on the leave stack - .dw XT_TO_L ; then follows at the end. - .dw XT_EXIT - -; there is no special runtime for ?do, the do runtime -; gets wrapped with the sequence -; ... ?do-check if do ..... loop then -; with -; : ?do-check ( n1 n2 -- n1 n2 true | false ) -; 2dup = dup >r if 2drop then r> invert ; - -.if cpu_msp430==1 - HEADLESS(XT_QDOCHECK,DOCOLON) -.endif - -.if cpu_avr8==1 -XT_QDOCHECK: - .dw DO_COLON -PFA_QDOCHECK: -.endif - .dw XT_2DUP - .dw XT_EQUAL - .dw XT_DUP - .dw XT_TO_R - .dw XT_DOCONDBRANCH - DEST(PFA_QDOCHECK1) - .dw XT_2DROP -PFA_QDOCHECK1: - .dw XT_R_FROM - .dw XT_INVERT - .dw XT_EXIT diff --git a/amforth-6.5/common/words/quit.asm b/amforth-6.5/common/words/quit.asm deleted file mode 100644 index 2a30e4c..0000000 --- a/amforth-6.5/common/words/quit.asm +++ /dev/null @@ -1,58 +0,0 @@ -; ( -- ) -; System -; main loop of amforth. accept - interpret in an endless loop - -.if cpu_msp430==1 - HEADER(XT_QUIT,4,"quit",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_QUIT: - .dw $ff04 - .db "quit" - .dw VE_HEAD - .set VE_HEAD = VE_QUIT -XT_QUIT: - .dw DO_COLON -.endif -PFA_QUIT: - .dw XT_LP0,XT_LP,XT_STORE - .dw XT_SP0 - .dw XT_SP_STORE - .dw XT_RP0 - .dw XT_RP_STORE - .dw XT_LBRACKET - -PFA_QUIT2: - .dw XT_STATE - .dw XT_FETCH - .dw XT_ZEROEQUAL - .dw XT_DOCONDBRANCH - DEST(PFA_QUIT4) - .dw XT_PROMPTREADY -PFA_QUIT4: - .dw XT_REFILL - .dw XT_DOCONDBRANCH - DEST(PFA_QUIT3) - .dw XT_DOLITERAL - .dw XT_INTERPRET - .dw XT_CATCH - .dw XT_QDUP - .dw XT_DOCONDBRANCH - DEST(PFA_QUIT3) - .dw XT_DUP - .dw XT_DOLITERAL - .dw -2 - .dw XT_LESS - .dw XT_DOCONDBRANCH - DEST(PFA_QUIT5) - .dw XT_PROMPTERROR -PFA_QUIT5: - .dw XT_DOBRANCH - DEST(PFA_QUIT) -PFA_QUIT3: - .dw XT_PROMPTOK - .dw XT_DOBRANCH - DEST(PFA_QUIT2) -; .dw XT_EXIT ; never reached - diff --git a/amforth-6.5/common/words/rdefer-fetch.asm b/amforth-6.5/common/words/rdefer-fetch.asm deleted file mode 100644 index 0424bd8..0000000 --- a/amforth-6.5/common/words/rdefer-fetch.asm +++ /dev/null @@ -1,20 +0,0 @@ -; ( xt1 -- xt2 ) -; System -; The defer@ for ram defers -.if cpu_msp430==1 - HEADER(XT_RDEFERFETCH,7,"Rdefer@",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_RDEFERFETCH: - .dw $ff07 - .db "Rdefer@",0 - .dw VE_HEAD - .set VE_HEAD = VE_RDEFERFETCH -XT_RDEFERFETCH: - .dw DO_COLON -PFA_RDEFERFETCH: -.endif - .dw XT_FETCHI - .dw XT_FETCH - .dw XT_EXIT diff --git a/amforth-6.5/common/words/rdefer-store.asm b/amforth-6.5/common/words/rdefer-store.asm deleted file mode 100644 index 906ca15..0000000 --- a/amforth-6.5/common/words/rdefer-store.asm +++ /dev/null @@ -1,21 +0,0 @@ -; ( xt1 xt2 -- ) -; System -; The defer! for ram defers -.if cpu_msp430==1 - HEADER(XT_RDEFERSTORE,7,"Rdefer!",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_RDEFERSTORE: - .dw $ff07 - .db "Rdefer!",0 - .dw VE_HEAD - .set VE_HEAD = VE_RDEFERSTORE -XT_RDEFERSTORE: - .dw DO_COLON -PFA_RDEFERSTORE: -.endif - .dw XT_FETCHI - .dw XT_STORE - .dw XT_EXIT - diff --git a/amforth-6.5/common/words/rec-find.asm b/amforth-6.5/common/words/rec-find.asm deleted file mode 100644 index 01a2aa1..0000000 --- a/amforth-6.5/common/words/rec-find.asm +++ /dev/null @@ -1,85 +0,0 @@ -; ( addr len -- xt flags dt:xt | dt:null ) -; Interpreter -; search for a word -.if cpu_msp430==1 - HEADER(XT_REC_FIND,8,"rec:find",DOCOLON) -.endif -.if cpu_avr8==1 -VE_REC_FIND: - .dw $ff08 - .db "rec:find" - .dw VE_HEAD - .set VE_HEAD = VE_REC_FIND -XT_REC_FIND: - .dw DO_COLON -PFA_REC_FIND: -.endif - .DW XT_FINDXT - .dw XT_DUP - .dw XT_ZEROEQUAL - .dw XT_DOCONDBRANCH - DEST(PFA_REC_WORD_FOUND) - .dw XT_DROP - .dw XT_DT_NULL - .dw XT_EXIT -PFA_REC_WORD_FOUND: - .dw XT_DT_XT - - .dw XT_EXIT - -; ( -- addr ) -; Interpreter -; actions to handle execution tokens and their flags -.if cpu_msp430==1 - HEADER(XT_DT_XT,6,"dt:xt",DOROM) -.endif - -.if cpu_avr8==1 -VE_DT_XT: - .dw $ff05 - .db "dt:xt",0 - .dw VE_HEAD - .set VE_HEAD = VE_DT_XT -XT_DT_XT: - .dw PFA_DOCONSTANT -PFA_DT_XT: -.endif - .dw XT_R_WORD_INTERPRET - .dw XT_R_WORD_COMPILE - .dw XT_2LITERAL - -; ( XT flags -- ) -; Interpreter -; interpret method for WORD recognizer -.if cpu_msp430==1 - HEADLESS(XT_R_WORD_INTERPRET,DOCOLON) -.endif - -.if cpu_avr8==1 -XT_R_WORD_INTERPRET: - .dw DO_COLON -PFA_R_WORD_INTERPRET: -.endif - .dw XT_DROP ; the flags are in the way - .dw XT_EXECUTE - .dw XT_EXIT - -; ( XT flags -- ) -; Interpreter -; Compile method for WORD recognizer -.if cpu_msp430==1 - HEADLESS(XT_R_WORD_COMPILE,DOCOLON) -.endif -.if cpu_avr8==1 -XT_R_WORD_COMPILE: - .dw DO_COLON -PFA_R_WORD_COMPILE: -.endif - .dw XT_ZEROLESS - .dw XT_DOCONDBRANCH - DEST(PFA_R_WORD_COMPILE1) - .dw XT_COMMA - .dw XT_EXIT -PFA_R_WORD_COMPILE1: - .dw XT_EXECUTE - .dw XT_EXIT diff --git a/amforth-6.5/common/words/rec-intnum.asm b/amforth-6.5/common/words/rec-intnum.asm deleted file mode 100644 index 15400e1..0000000 --- a/amforth-6.5/common/words/rec-intnum.asm +++ /dev/null @@ -1,76 +0,0 @@ -; ( -- addr ) -; Interpreter -; Method table for single cell integers -.if cpu_msp430==1 - HEADER(XT_DT_NUM,6,"dt:num",DOROM) -.endif - -.if cpu_avr8==1 -VE_DT_NUM: - .dw $ff06 - .db "dt:num" - .dw VE_HEAD - .set VE_HEAD = VE_DT_NUM -XT_DT_NUM: - .dw PFA_DOCONSTANT -PFA_DT_NUM: -.endif - .dw XT_NOOP ; interpret - .dw XT_LITERAL ; compile - .dw XT_LITERAL ; postpone - -; ( -- addr ) -; Interpreter -; Method table for double cell integers -.if cpu_msp430==1 - HEADER(XT_DT_DNUM,7,"dt:dnum",DOROM) -.endif - -.if cpu_avr8==1 -VE_DT_DNUM: - .dw $ff07 - .db "dt:dnum",0 - .dw VE_HEAD - .set VE_HEAD = VE_DT_DNUM -XT_DT_DNUM: - .dw PFA_DOCONSTANT -PFA_DT_DNUM: -.endif - .dw XT_NOOP ; interpret - .dw XT_2LITERAL ; compile - .dw XT_2LITERAL ; postpone - -; ( addr len -- f ) -; Interpreter -; recognizer for integer numbers -.if cpu_msp430==1 - HEADER(XT_REC_NUM,7,"rec:num",DOCOLON) -.endif - -.if cpu_avr8==1 - -VE_REC_NUM: - .dw $ff07 - .db "rec:num",0 - .dw VE_HEAD - .set VE_HEAD = VE_REC_NUM -XT_REC_NUM: - .dw DO_COLON -PFA_REC_NUM: -.endif - ; try converting to a number - .dw XT_NUMBER - .dw XT_DOCONDBRANCH - DEST(PFA_REC_NONUMBER) - .dw XT_ONE - .dw XT_EQUAL - .dw XT_DOCONDBRANCH - DEST(PFA_REC_INTNUM2) - .dw XT_DT_NUM - .dw XT_EXIT -PFA_REC_INTNUM2: - .dw XT_DT_DNUM - .dw XT_EXIT -PFA_REC_NONUMBER: - .dw XT_DT_NULL - .dw XT_EXIT diff --git a/amforth-6.5/common/words/recognize.asm b/amforth-6.5/common/words/recognize.asm deleted file mode 100644 index 2dc9690..0000000 --- a/amforth-6.5/common/words/recognize.asm +++ /dev/null @@ -1,73 +0,0 @@ -; (addr len recstack -- i*x dt:token | dt:null ) -; System -; walk the recognizer stack - -.if cpu_msp430==1 - HEADER(XT_RECOGNIZE,9,"recognize",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_RECOGNIZE: - .dw $ff09 - .db "recognize",0 - .dw VE_HEAD - .set VE_HEAD = VE_RECOGNIZE -XT_RECOGNIZE: - .dw DO_COLON -PFA_RECOGNIZE: -.endif - .dw XT_DOLITERAL - .dw XT_RECOGNIZE_A - .dw XT_SWAP - .dw XT_MAPSTACK - .dw XT_ZEROEQUAL - .dw XT_DOCONDBRANCH - DEST(PFA_RECOGNIZE1) - .dw XT_2DROP - .dw XT_DT_NULL -PFA_RECOGNIZE1: - .dw XT_EXIT - -.if cpu_msp430==1 - HEADLESS(XT_RECOGNIZE_A,DOCOLON) -.endif - -.if cpu_avr8==1 -; ( addr len XT -- addr len [ dt:xt -1 | 0 ] ) -XT_RECOGNIZE_A: - .dw DO_COLON -PFA_RECOGNIZE_A: -.endif - .dw XT_ROT ; -- len xt addr - .dw XT_ROT ; -- xt addr len - .dw XT_2DUP - .dw XT_2TO_R - .dw XT_ROT ; -- addr len xt - .dw XT_EXECUTE ; -- i*x dt:* | dt:null - .dw XT_2R_FROM - .dw XT_ROT - .dw XT_DUP - .dw XT_DT_NULL - .dw XT_EQUAL - .dw XT_DOCONDBRANCH - DEST(PFA_RECOGNIZE_A1) - .dw XT_DROP - .dw XT_ZERO - .dw XT_EXIT -PFA_RECOGNIZE_A1: - .dw XT_NIP - .dw XT_NIP - .dw XT_TRUE - .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 ; -; diff --git a/amforth-6.5/common/words/recurse.asm b/amforth-6.5/common/words/recurse.asm deleted file mode 100644 index c1f0114..0000000 --- a/amforth-6.5/common/words/recurse.asm +++ /dev/null @@ -1,22 +0,0 @@ -; ( -- ) -; Compiler -; compile the XT of the word currently being defined into the dictionary - -.if cpu_msp430==1 - IMMED(RECURSE,7,"recurse",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_RECURSE: - .dw $0007 - .db "recurse",0 - .dw VE_HEAD - .set VE_HEAD = VE_RECURSE -XT_RECURSE: - .dw DO_COLON -PFA_RECURSE: -.endif - .dw XT_LATEST - .dw XT_FETCH - .dw XT_COMMA - .dw XT_EXIT diff --git a/amforth-6.5/common/words/refill.asm b/amforth-6.5/common/words/refill.asm deleted file mode 100644 index a7c918d..0000000 --- a/amforth-6.5/common/words/refill.asm +++ /dev/null @@ -1,21 +0,0 @@ -; ( -- f ) -; System -; refills the input buffer - -.if cpu_msp430==1 - DEFER(XT_REFILL,6,"refill") -.endif - -.if cpu_avr8==1 -VE_REFILL: - .dw $ff06 - .db "refill" - .dw VE_HEAD - .set VE_HEAD = VE_REFILL -XT_REFILL: - .dw PFA_DODEFER1 -PFA_REFILL: -.endif - .dw USER_REFILL - .dw XT_UDEFERFETCH - .dw XT_UDEFERSTORE diff --git a/amforth-6.5/common/words/repeat.asm b/amforth-6.5/common/words/repeat.asm deleted file mode 100644 index 9ee9b09..0000000 --- a/amforth-6.5/common/words/repeat.asm +++ /dev/null @@ -1,21 +0,0 @@ -; ( -- ) (C: orig dest -- ) -; Compiler -; continue execution at dest, resolve orig - -.if cpu_msp430==1 - IMMED(XT_REPEAT,6,"repeat",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_REPEAT: - .dw $0006 - .db "repeat" - .dw VE_HEAD - .set VE_HEAD = VE_REPEAT -XT_REPEAT: - .dw DO_COLON -PFA_REPEAT: -.endif - .dw XT_AGAIN - .dw XT_THEN - .dw XT_EXIT diff --git a/amforth-6.5/common/words/reveal.asm b/amforth-6.5/common/words/reveal.asm deleted file mode 100644 index b0b4931..0000000 --- a/amforth-6.5/common/words/reveal.asm +++ /dev/null @@ -1,25 +0,0 @@ -; ( -- ) -; Dictionary -; makes an entry in a wordlist visible, if not already done. - -.if cpu_msp430==1 - HEADER(XT_REVEAL,6,"reveal",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_REVEAL: - .dw $ff06 - .db "reveal" - .dw VE_HEAD - .set VE_HEAD = VE_REVEAL -XT_REVEAL: - .dw DO_COLON -PFA_REVEAL: -.endif - .DW XT_NEWEST,XT_CELLPLUS,XT_FETCH ; only if wordlist is in use - .DW XT_QDUP,XT_DOCONDBRANCH - DEST(REVEAL1) - .DW XT_NEWEST,XT_FETCH,XT_SWAP,XT_STOREE -; .DW XT_ZERO,XT_NEWEST,XT_CELLPLUS,XT_STORE ; clean wordlist entry -REVEAL1: - .DW XT_EXIT diff --git a/amforth-6.5/common/words/right-bracket.asm b/amforth-6.5/common/words/right-bracket.asm deleted file mode 100644 index 85dbd6a..0000000 --- a/amforth-6.5/common/words/right-bracket.asm +++ /dev/null @@ -1,22 +0,0 @@ -; ( -- ) -; Compiler -; enter compiler mode - -.if cpu_msp430==1 - HEADER(XT_RBRACKET,1,"]",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_RBRACKET: - .dw $ff01 - .db "]",0 - .dw VE_HEAD - .set VE_HEAD = VE_RBRACKET -XT_RBRACKET: - .dw DO_COLON -PFA_RBRACKET: -.endif - .dw XT_ONE - .dw XT_STATE - .dw XT_STORE - .dw XT_EXIT diff --git a/amforth-6.5/common/words/s-to-d.asm b/amforth-6.5/common/words/s-to-d.asm deleted file mode 100644 index 374cc6a..0000000 --- a/amforth-6.5/common/words/s-to-d.asm +++ /dev/null @@ -1,20 +0,0 @@ -; ( n1 -- d1 ) -; Conversion -; extend (signed) single cell value to double cell -.if cpu_msp430==1 - HEADER(XT_S2D,3,"s>d",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_S2D: - .dw $ff03 - .db "s>d",0 - .dw VE_HEAD - .set VE_HEAD = VE_S2D -XT_S2D: - .dw DO_COLON -PFA_S2D: -.endif - .dw XT_DUP - .dw XT_ZEROLESS - .dw XT_EXIT diff --git a/amforth-6.5/common/words/search-wordlist.asm b/amforth-6.5/common/words/search-wordlist.asm deleted file mode 100644 index 3d82de4..0000000 --- a/amforth-6.5/common/words/search-wordlist.asm +++ /dev/null @@ -1,72 +0,0 @@ -; ( c-addr len wid -- [ 0 ] | [ xt [-1|1]] ) -; Search Order -; searches the word list wid for the word at c-addr/len - -.if cpu_msp430==1 - HEADER(XT_SEARCH_WORDLIST,15,"search-wordlist",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_SEARCH_WORDLIST: - .dw $ff0f - .db "search-wordlist",0 - .dw VE_HEAD - .set VE_HEAD = VE_SEARCH_WORDLIST -XT_SEARCH_WORDLIST: - .dw DO_COLON -PFA_SEARCH_WORDLIST: -.endif - .dw XT_TO_R - .dw XT_ZERO - .dw XT_DOLITERAL - .dw XT_ISWORD - .dw XT_R_FROM - .dw XT_TRAVERSEWORDLIST - .dw XT_DUP - .dw XT_ZEROEQUAL - .dw XT_DOCONDBRANCH - DEST(PFA_SEARCH_WORDLIST1) - .dw XT_2DROP - .dw XT_DROP - .dw XT_ZERO - .dw XT_EXIT -PFA_SEARCH_WORDLIST1: - ; ... get the XT ... - .dw XT_DUP - .dw XT_NFA2CFA - ; .. and get the header flag - .dw XT_SWAP - .dw XT_NAME2FLAGS - .dw XT_IMMEDIATEQ - .dw XT_EXIT - -.if cpu_msp430==1 - HEADLESS(XT_ISWORD,DOCOLON) -.endif - -.if cpu_avr8==1 -XT_ISWORD: - .dw DO_COLON -PFA_ISWORD: -.endif - ; ( c-addr len 0 nt -- c-addr len 0 true| nt false ) - .dw XT_TO_R - .dw XT_DROP - .dw XT_2DUP - .dw XT_R_FETCH ; -- addr len addr len nt - .dw XT_NAME2STRING - .dw XT_ICOMPARE ; (-- addr len f ) - .dw XT_DOCONDBRANCH - DEST(PFA_ISWORD3) - ; not now - .dw XT_R_FROM - .dw XT_DROP - .dw XT_ZERO - .dw XT_TRUE ; maybe next word - .dw XT_EXIT -PFA_ISWORD3: - ; we found the word, now clean up iteration data ... - .dw XT_2DROP - .dw XT_R_FROM - .dw XT_ZERO ; finish traverse-wordlist - .dw XT_EXIT diff --git a/amforth-6.5/common/words/semicolon.asm b/amforth-6.5/common/words/semicolon.asm deleted file mode 100644 index 35c3a17..0000000 --- a/amforth-6.5/common/words/semicolon.asm +++ /dev/null @@ -1,25 +0,0 @@ -; ( -- ) -; Compiler -; finish colon defintion, compiles (exit) and returns to interpret state - -.if cpu_msp430==1 - IMMED(XT_SEMICOLON,1,";",DOCOLON) -.endif - -.if cpu_avr8==1 - - -VE_SEMICOLON: - .dw $0001 - .db $3b,0 - .dw VE_HEAD - .set VE_HEAD = VE_SEMICOLON -XT_SEMICOLON: - .dw DO_COLON -PFA_SEMICOLON: -.endif - .dw XT_COMPILE - .dw XT_EXIT - .dw XT_LBRACKET - .dw XT_REVEAL - .dw XT_EXIT diff --git a/amforth-6.5/common/words/set-base.asm b/amforth-6.5/common/words/set-base.asm deleted file mode 100644 index 8e9c10b..0000000 --- a/amforth-6.5/common/words/set-base.asm +++ /dev/null @@ -1,58 +0,0 @@ -; ( addr len -- addr' len' ) -; Numeric IO -; skip a numeric prefix character - -.if cpu_msp430==1 - HEADLESS(XT_BASES,DOROM) -.endif - -.if cpu_avr8==1 -XT_BASES: - .dw PFA_DOCONSTANT -.endif - .dw 10,16,2,10 ; last one could a 8 instead. - -.if cpu_msp430==1 - HEADLESS(XT_SET_BASE,DOCOLON) -.endif - -.if cpu_avr8==1 -XT_SET_BASE: - .dw DO_COLON -PFA_SET_BASE: ; ( adr1 len1 -- adr2 len2 ) -.endif - .dw XT_OVER - .dw XT_CFETCH - .dw XT_DOLITERAL - .dw 35 - .dw XT_MINUS - .dw XT_DUP - .dw XT_ZERO - .dw XT_DOLITERAL - .dw 4 - .dw XT_WITHIN - .dw XT_DOCONDBRANCH - DEST(SET_BASE1) - .if cpu_msp430==1 - .dw XT_CELLS - .endif - .dw XT_BASES - .dw XT_PLUS - .dw XT_FETCHI - .dw XT_BASE - .dw XT_STORE - .dw XT_ONE - .dw XT_SLASHSTRING - .dw XT_DOBRANCH - DEST(SET_BASE2) -SET_BASE1: - .dw XT_DROP -SET_BASE2: - .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 ; diff --git a/amforth-6.5/common/words/set-order.asm b/amforth-6.5/common/words/set-order.asm deleted file mode 100644 index f9b0439..0000000 --- a/amforth-6.5/common/words/set-order.asm +++ /dev/null @@ -1,23 +0,0 @@ -; ( widn .. wid-1 n -- ) -; Search Order -; replace the search order list - -.if cpu_msp430==1 - HEADER(XT_SET_ORDER,9,"set-order",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_SET_ORDER: - .dw $ff09 - .db "set-order",0 - .dw VE_HEAD - .set VE_HEAD = VE_SET_ORDER -XT_SET_ORDER: - .dw DO_COLON -PFA_SET_ORDER: -.endif - .dw XT_DOLITERAL - .dw CFG_ORDERLISTLEN - .dw XT_SET_STACK - .dw XT_EXIT - diff --git a/amforth-6.5/common/words/set-recognizer.asm b/amforth-6.5/common/words/set-recognizer.asm deleted file mode 100644 index 7d9dc1c..0000000 --- a/amforth-6.5/common/words/set-recognizer.asm +++ /dev/null @@ -1,23 +0,0 @@ -; ( rec-n .. rec-1 n -- ) -; Interpreter -; replace the recognizer list - -.if cpu_msp430==1 - HEADER(XT_SET_RECOGNIZERS,15,"set-recognizers",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_SET_RECOGNIZERS: - .dw $ff0f - .db "set-recognizers",0 - .dw VE_HEAD - .set VE_HEAD = VE_SET_RECOGNIZERS -XT_SET_RECOGNIZERS: - .dw DO_COLON -PFA_SET_RECOGNIZERS: -.endif - .dw XT_DOLITERAL - .dw CFG_RECOGNIZERLISTLEN - .dw XT_SET_STACK - .dw XT_EXIT - diff --git a/amforth-6.5/common/words/set-stack.asm b/amforth-6.5/common/words/set-stack.asm deleted file mode 100644 index 9c95a0b..0000000 --- a/amforth-6.5/common/words/set-stack.asm +++ /dev/null @@ -1,43 +0,0 @@ -; ( rec-n .. rec-1 n ee-addr -- ) -; Tools -; Write a stack to EEPROM -.if cpu_msp430==1 - HEADER(XT_SET_STACK,9,"set-stack",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_SET_STACK: - .dw $ff09 - .db "set-stack",0 - .dw VE_HEAD - .set VE_HEAD = VE_SET_STACK -XT_SET_STACK: - .dw DO_COLON -PFA_SET_STACK: -.endif - .dw XT_OVER - .dw XT_ZEROLESS - .dw XT_DOCONDBRANCH - DEST(PFA_SET_STACK0) - .dw XT_DOLITERAL - .dw -4 - .dw XT_THROW -PFA_SET_STACK0: - .dw XT_2DUP - .dw XT_STOREE ; ( -- i_n .. i_0 n e-addr ) - .dw XT_SWAP - .dw XT_ZERO - .dw XT_QDOCHECK - .dw XT_DOCONDBRANCH - DEST(PFA_SET_STACK2) - .dw XT_DODO -PFA_SET_STACK1: - .dw XT_CELLPLUS ; ( -- i_x e-addr ) - .dw XT_TUCK ; ( -- e-addr i_x e-addr - .dw XT_STOREE - .dw XT_DOLOOP - DEST(PFA_SET_STACK1) -PFA_SET_STACK2: - .dw XT_DROP - .dw XT_EXIT - diff --git a/amforth-6.5/common/words/sharp-greater.asm b/amforth-6.5/common/words/sharp-greater.asm deleted file mode 100644 index 914aba2..0000000 --- a/amforth-6.5/common/words/sharp-greater.asm +++ /dev/null @@ -1,25 +0,0 @@ -; ( d1 -- addr count ) -; Numeric IO -; Pictured Numeric Output: convert PNO buffer into an string - -.if cpu_msp430==1 - HEADER(XT_SHARP_G,2,"#>",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_SHARP_G: - .dw $ff02 - .db "#>" - .dw VE_HEAD - .set VE_HEAD = VE_SHARP_G -XT_SHARP_G: - .dw DO_COLON -PFA_SHARP_G: -.endif - .dw XT_2DROP - .dw XT_HLD - .dw XT_FETCH - .dw XT_PAD - .dw XT_OVER - .dw XT_MINUS - .dw XT_EXIT diff --git a/amforth-6.5/common/words/sharp-s.asm b/amforth-6.5/common/words/sharp-s.asm deleted file mode 100644 index 58fd508..0000000 --- a/amforth-6.5/common/words/sharp-s.asm +++ /dev/null @@ -1,26 +0,0 @@ -; ( d -- 0 ) -; Numeric IO -; pictured numeric output: convert all digits until 0 (zero) is reached - -.if cpu_msp430==1 - HEADER(XT_SHARP_S,2,"#s",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_SHARP_S: - .dw $ff02 - .db "#s" - .dw VE_HEAD - .set VE_HEAD = VE_SHARP_S -XT_SHARP_S: - .dw DO_COLON -PFA_SHARP_S: -.endif -NUMS1: - .dw XT_SHARP - .dw XT_2DUP - .dw XT_OR - .dw XT_ZEROEQUAL - .dw XT_DOCONDBRANCH - DEST(NUMS1) ; PFA_SHARP_S - .dw XT_EXIT diff --git a/amforth-6.5/common/words/sharp.asm b/amforth-6.5/common/words/sharp.asm deleted file mode 100644 index 7659a39..0000000 --- a/amforth-6.5/common/words/sharp.asm +++ /dev/null @@ -1,41 +0,0 @@ -; ( d1 -- d2 ) -; Numeric IO -; pictured numeric output: convert one digit - -.if cpu_msp430==1 - HEADER(XT_SHARP,1,"#",DOCOLON) -.endif - -.if cpu_avr8==1 - - -VE_SHARP: - .dw $ff01 - .db "#",0 - .dw VE_HEAD - .set VE_HEAD = VE_SHARP -XT_SHARP: - .dw DO_COLON -PFA_SHARP: -.endif - .dw XT_BASE - .dw XT_FETCH - .dw XT_UDSLASHMOD - .dw XT_ROT - .dw XT_DOLITERAL - .dw 9 - .dw XT_OVER - .dw XT_LESS - .dw XT_DOCONDBRANCH - DEST(PFA_SHARP1) - .dw XT_DOLITERAL - .dw 7 - .dw XT_PLUS -PFA_SHARP1: - .dw XT_DOLITERAL - .dw 48 ; ASCII 0 - .dw XT_PLUS - .dw XT_HOLD - .dw XT_EXIT -; : # ( ud1 -- ud2 ) -; base @ ud/mod rot 9 over < if 7 + then 30 + hold ; diff --git a/amforth-6.5/common/words/show-wordlist.asm b/amforth-6.5/common/words/show-wordlist.asm deleted file mode 100644 index d150639..0000000 --- a/amforth-6.5/common/words/show-wordlist.asm +++ /dev/null @@ -1,38 +0,0 @@ -; ( wid -- ) -; Tools -; prints the name of the words in a wordlist - -.if cpu_msp430==1 - HEADER(XT_SHOWWORDLIST,13,"show-wordlist",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_SHOWWORDLIST: - .dw $ff0d - .db "show-wordlist",0 - .dw VE_HEAD - .set VE_HEAD = VE_SHOWWORDLIST -XT_SHOWWORDLIST: - .dw DO_COLON -PFA_SHOWWORDLIST: -.endif - .dw XT_DOLITERAL - .dw XT_SHOWWORD - .dw XT_SWAP - .dw XT_TRAVERSEWORDLIST - .dw XT_EXIT - -.if cpu_msp430==1 - HEADLESS(XT_SHOWWORD,DOCOLON) -.endif - -.if cpu_avr8==1 -XT_SHOWWORD: - .dw DO_COLON -PFA_SHOWWORD: -.endif - .dw XT_NAME2STRING - .dw XT_ITYPE - .dw XT_SPACE ; ( -- addr n) - .dw XT_TRUE - .dw XT_EXIT diff --git a/amforth-6.5/common/words/sign.asm b/amforth-6.5/common/words/sign.asm deleted file mode 100644 index f532bbe..0000000 --- a/amforth-6.5/common/words/sign.asm +++ /dev/null @@ -1,26 +0,0 @@ -; ( n -- ) -; Numeric IO -; place a - in HLD if n is negative - -.if cpu_msp430==1 - HEADER(XT_SIGN,4,"sign",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_SIGN: - .dw $ff04 - .db "sign" - .dw VE_HEAD - .set VE_HEAD = VE_SIGN -XT_SIGN: - .dw DO_COLON -PFA_SIGN: -.endif - .dw XT_ZEROLESS - .dw XT_DOCONDBRANCH - DEST(PFA_SIGN1) - .dw XT_DOLITERAL - .dw 45 ; ascii - - .dw XT_HOLD -PFA_SIGN1: - .dw XT_EXIT diff --git a/amforth-6.5/common/words/slash-string.asm b/amforth-6.5/common/words/slash-string.asm deleted file mode 100644 index bded983..0000000 --- a/amforth-6.5/common/words/slash-string.asm +++ /dev/null @@ -1,26 +0,0 @@ -; ( addr1 u1 n -- addr2 u2 ) -; String -; adjust string from addr1 to addr1+n, reduce length from u1 to u2 by n - -.if cpu_msp430==1 - HEADER(XT_SLASHSTRING,7,"/string",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_SLASHSTRING: - .dw $ff07 - .db "/string",0 - .dw VE_HEAD - .set VE_HEAD = VE_SLASHSTRING -XT_SLASHSTRING: - .dw DO_COLON -PFA_SLASHSTRING: -.endif - .dw XT_ROT - .dw XT_OVER - .dw XT_PLUS - .dw XT_ROT - .dw XT_ROT - .dw XT_MINUS - .dw XT_EXIT - diff --git a/amforth-6.5/common/words/slash.asm b/amforth-6.5/common/words/slash.asm deleted file mode 100644 index 3f0e3af..0000000 --- a/amforth-6.5/common/words/slash.asm +++ /dev/null @@ -1,24 +0,0 @@ -; ( n1 n2 -- n3) -; Arithmetics -; divide n1 by n2. giving the quotient - -.if cpu_msp430==1 - HEADER(SLASH,1,"/",DOCOLON) -.endif - -.if cpu_avr8==1 - - -VE_SLASH: - .dw $ff01 - .db "/",0 - .dw VE_HEAD - .set VE_HEAD = VE_SLASH -XT_SLASH: - .dw DO_COLON -PFA_SLASH: -.endif - .dw XT_SLASHMOD - .dw XT_NIP - .dw XT_EXIT - diff --git a/amforth-6.5/common/words/sliteral.asm b/amforth-6.5/common/words/sliteral.asm deleted file mode 100644 index 9233796..0000000 --- a/amforth-6.5/common/words/sliteral.asm +++ /dev/null @@ -1,22 +0,0 @@ -; (C: addr len -- ) -; String -; compiles a string to flash, at runtime leaves ( -- flash-addr count) on stack - -.if cpu_msp430==1 - IMMED(XT_SLITERAL,8,"sliteral",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_SLITERAL: - .dw $0008 - .db "sliteral" - .dw VE_HEAD - .set VE_HEAD = VE_SLITERAL -XT_SLITERAL: - .dw DO_COLON -PFA_SLITERAL: -.endif - .dw XT_COMPILE - .dw XT_DOSLITERAL ; ( -- addr n) - .dw XT_SCOMMA - .dw XT_EXIT diff --git a/amforth-6.5/common/words/source.asm b/amforth-6.5/common/words/source.asm deleted file mode 100644 index a1ac867..0000000 --- a/amforth-6.5/common/words/source.asm +++ /dev/null @@ -1,23 +0,0 @@ -; ( -- addr n ) -; System -; address and current length of the input buffer - -.if cpu_msp430==1 - DEFER(XT_SOURCE,6,"source") -.endif - -.if cpu_avr8==1 -VE_SOURCE: - .dw $FF06 - .db "source" - .dw VE_HEAD - .set VE_HEAD = VE_SOURCE -XT_SOURCE: - .dw PFA_DODEFER1 -PFA_SOURCE: -.endif - .dw USER_SOURCE - .dw XT_UDEFERFETCH - .dw XT_UDEFERSTORE - - diff --git a/amforth-6.5/common/words/space.asm b/amforth-6.5/common/words/space.asm deleted file mode 100644 index bf4175d..0000000 --- a/amforth-6.5/common/words/space.asm +++ /dev/null @@ -1,21 +0,0 @@ -; ( -- ) -; Character IO -; emits a space (bl) - -.if cpu_msp430==1 - HEADER(XT_SPACE,5,"space",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_SPACE: - .dw $ff05 - .db "space",0 - .dw VE_HEAD - .set VE_HEAD = VE_SPACE -XT_SPACE: - .dw DO_COLON -PFA_SPACE: -.endif - .dw XT_BL - .dw XT_EMIT - .dw XT_EXIT diff --git a/amforth-6.5/common/words/spaces.asm b/amforth-6.5/common/words/spaces.asm deleted file mode 100644 index 7ecbcd8..0000000 --- a/amforth-6.5/common/words/spaces.asm +++ /dev/null @@ -1,27 +0,0 @@ -; ( n -- ) -; Character IO -; emits n space(s) (bl) - -.if cpu_msp430==1 - HEADER(XT_SPACES,6,"spaces",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_SPACES: - .dw $ff06 - .db "spaces" - .dw VE_HEAD - .set VE_HEAD = VE_SPACES -XT_SPACES: - .dw DO_COLON -PFA_SPACES: - -.endif -;C SPACES n -- output n spaces -; BEGIN DUP 0> WHILE SPACE 1- REPEAT DROP ; - .DW XT_ZERO, XT_MAX -SPCS1: .DW XT_DUP,XT_DOCONDBRANCH - DEST(SPCS2) - .DW XT_SPACE,XT_1MINUS,XT_DOBRANCH - DEST(SPCS1) -SPCS2: .DW XT_DROP,XT_EXIT diff --git a/amforth-6.5/common/words/squote.asm b/amforth-6.5/common/words/squote.asm deleted file mode 100644 index 98cfa33..0000000 --- a/amforth-6.5/common/words/squote.asm +++ /dev/null @@ -1,33 +0,0 @@ -; ( -- addr len) (C: -- ) -; Compiler -; compiles a string to flash, at runtime leaves ( -- flash-addr count) on stack - -.if cpu_msp430==1 - DW link - DB 0FEh ; immediate -.set link = $ - DB 2,"s",'"' - .align 16 -XT_SQUOTE: DW DOCOLON -.endif - -.if cpu_avr8==1 -VE_SQUOTE: - .dw $0002 - .db "s",$22 - .dw VE_HEAD - .set VE_HEAD = VE_SQUOTE -XT_SQUOTE: - .dw DO_COLON -PFA_SQUOTE: -.endif - .dw XT_DOLITERAL - .dw 34 ; 0x22 - .dw XT_PARSE ; ( -- addr n) - .dw XT_STATE - .dw XT_FETCH - .dw XT_DOCONDBRANCH - DEST(PFA_SQUOTE1) - .dw XT_SLITERAL -PFA_SQUOTE1: - .dw XT_EXIT diff --git a/amforth-6.5/common/words/star.asm b/amforth-6.5/common/words/star.asm deleted file mode 100644 index a09e00c..0000000 --- a/amforth-6.5/common/words/star.asm +++ /dev/null @@ -1,22 +0,0 @@ -; ( n1 n2 -- n3 ) -; Arithmetics -; multiply routine - -.if cpu_msp430==1 - HEADER(STAR,1,"*",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_STAR: - .dw $ff01 - .db "*",0 - .dw VE_HEAD - .set VE_HEAD = VE_STAR -XT_STAR: - .dw DO_COLON -PFA_STAR: -.endif - - .dw XT_MSTAR - .dw XT_DROP - .dw XT_EXIT diff --git a/amforth-6.5/common/words/then.asm b/amforth-6.5/common/words/then.asm deleted file mode 100644 index edd0665..0000000 --- a/amforth-6.5/common/words/then.asm +++ /dev/null @@ -1,20 +0,0 @@ -; ( -- ) (C: orig -- ) -; Compiler -; finish if - -.if cpu_msp430==1 - IMMED(XT_THEN,4,"then",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_THEN: - .dw $0004 - .db "then" - .dw VE_HEAD - .set VE_HEAD = VE_THEN -XT_THEN: - .dw DO_COLON -PFA_THEN: -.endif - .dw XT_GRESOLVE - .dw XT_EXIT diff --git a/amforth-6.5/common/words/throw.asm b/amforth-6.5/common/words/throw.asm deleted file mode 100644 index 24877a3..0000000 --- a/amforth-6.5/common/words/throw.asm +++ /dev/null @@ -1,39 +0,0 @@ -; ( n -- ) -; Exceptions -; throw an exception - -.if cpu_msp430==1 - HEADER(XT_THROW,5,"throw",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_THROW: - .dw $ff05 - .db "throw",0 - .dw VE_HEAD - .set VE_HEAD = VE_THROW -XT_THROW: - .dw DO_COLON -PFA_THROW: -.endif - .dw XT_DUP - .dw XT_ZEROEQUAL - .dw XT_DOCONDBRANCH - DEST(PFA_THROW1) - .dw XT_DROP - .dw XT_EXIT -PFA_THROW1: - .dw XT_HANDLER - .dw XT_FETCH - .dw XT_RP_STORE - .dw XT_R_FROM - .dw XT_HANDLER - .dw XT_STORE - .dw XT_R_FROM - .dw XT_SWAP - .dw XT_TO_R - .dw XT_SP_STORE - .dw XT_DROP - .dw XT_R_FROM - .dw XT_EXIT - diff --git a/amforth-6.5/common/words/tib.asm b/amforth-6.5/common/words/tib.asm deleted file mode 100644 index ca5601f..0000000 --- a/amforth-6.5/common/words/tib.asm +++ /dev/null @@ -1,96 +0,0 @@ -; ( -- f ) -; System -; refills the input buffer -.if cpu_msp430==1 - HEADER(XT_REFILLTIB,10,"refill-tib",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_REFILLTIB: - .dw $ff0a - .db "refill-tib" - .dw VE_HEAD - .set VE_HEAD = VE_REFILLTIB -XT_REFILLTIB: - .dw DO_COLON -PFA_REFILLTIB: -.endif - .dw XT_TIB - .dw XT_DOLITERAL - .dw TIB_SIZE - .dw XT_ACCEPT - .dw XT_NUMBERTIB - .dw XT_STORE - .dw XT_ZERO - .dw XT_TO_IN - .dw XT_STORE - .dw XT_TRUE ; -1 - .dw XT_EXIT - -; ( -- addr n ) -; System -; address and current length of the input buffer -.if cpu_msp430==1 - HEADER(XT_SOURCETIB,10,"source-tib",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_SOURCETIB: - .dw $FF0A - .db "source-tib" - .dw VE_HEAD - .set VE_HEAD = VE_SOURCETIB -XT_SOURCETIB: - .dw DO_COLON -PFA_SOURCETIB: -.endif - .dw XT_TIB - .dw XT_NUMBERTIB - .dw XT_FETCH - .dw XT_EXIT - -; ( -- addr ) -; System Variable -; terminal input buffer address -.if cpu_msp430==1 - VARIABLE(XT_TIB,3,"tib") - .DW TIBAREA -.endif - -.if cpu_avr8==1 -VE_TIB: - .dw $ff03 - .db "tib",0 - .dw VE_HEAD - .set VE_HEAD = VE_TIB -XT_TIB: - .dw PFA_DOVARIABLE -PFA_TIB: - .dw ram_tib -.dseg -ram_tib: .byte TIB_SIZE -.cseg -.endif - -; ( -- addr ) -; System Variable -; variable holding the number of characters in TIB -.if cpu_msp430==1 - VARIABLE(XT_NUMBERTIB,4,"#tib") - .DW RAM_NUMBERTIB -.endif - -.if cpu_avr8==1 -VE_NUMBERTIB: - .dw $ff04 - .db "#tib" - .dw VE_HEAD - .set VE_HEAD = VE_NUMBERTIB -XT_NUMBERTIB: - .dw PFA_DOVARIABLE -PFA_NUMBERTIB: - .dw ram_sharptib -.dseg -ram_sharptib: .byte 2 -.cseg -.endif diff --git a/amforth-6.5/common/words/tick.asm b/amforth-6.5/common/words/tick.asm deleted file mode 100644 index 3d04411..0000000 --- a/amforth-6.5/common/words/tick.asm +++ /dev/null @@ -1,41 +0,0 @@ -; ( "name" -- XT ) -; Dictionary -; search dictionary for name, return XT or throw an exception -13 - -.if cpu_msp430==1 - HEADER(XT_TICK,1,27h,DOCOLON) -.endif - -.if cpu_avr8==1 -VE_TICK: - .dw $ff01 - .db "'",0 - .dw VE_HEAD - .set VE_HEAD = VE_TICK -XT_TICK: - .dw DO_COLON -PFA_TICK: -.endif - .dw XT_PARSENAME - .dw XT_FORTHRECOGNIZER - .dw XT_RECOGNIZE - ; a word is tickable unless DT:TOKEN is DT:NULL or - ; the interpret action is a NOOP - .dw XT_DUP - .dw XT_DT_NULL - .dw XT_EQUAL - .dw XT_SWAP - .dw XT_FETCHI - .dw XT_DOLITERAL - .dw XT_NOOP - .dw XT_EQUAL - .dw XT_OR - .dw XT_DOCONDBRANCH - DEST(PFA_TICK1) - .dw XT_DOLITERAL - .dw -13 - .dw XT_THROW -PFA_TICK1: - .dw XT_DROP - .dw XT_EXIT - diff --git a/amforth-6.5/common/words/to-in.asm b/amforth-6.5/common/words/to-in.asm deleted file mode 100644 index 29ca20c..0000000 --- a/amforth-6.5/common/words/to-in.asm +++ /dev/null @@ -1,19 +0,0 @@ -; ( -- a-addr ) -; System Variable -; pointer to current read position in input buffer - -.if cpu_msp430==1 - HEADER(XT_TO_IN,3,">in",DOUSER) -.endif - -.if cpu_avr8==1 -VE_TO_IN: - .dw $ff03 - .db ">in",0 - .dw VE_HEAD - .set VE_HEAD = VE_TO_IN -XT_TO_IN: - .dw PFA_DOUSER -PFA_TO_IN: -.endif - .dw USER_TO_IN diff --git a/amforth-6.5/common/words/to-l.asm b/amforth-6.5/common/words/to-l.asm deleted file mode 100644 index 0312da9..0000000 --- a/amforth-6.5/common/words/to-l.asm +++ /dev/null @@ -1,25 +0,0 @@ - -.if cpu_msp430==1 - HEADER(XT_TO_L,2,">l",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_TO_L: - .dw $ff02 - .db ">l" - .dw VE_HEAD - .set VE_HEAD = VE_TO_L -XT_TO_L: - .dw DO_COLON -PFA_TO_L: -.endif -;Z >L x -- L: -- x move to leave stack -; CELL LP +! LP @ ! ; (L stack grows up) - - .dw XT_TWO - .dw XT_LP - .dw XT_PLUSSTORE - .dw XT_LP - .dw XT_FETCH - .dw XT_STORE - .dw XT_EXIT diff --git a/amforth-6.5/common/words/to-lower.asm b/amforth-6.5/common/words/to-lower.asm deleted file mode 100644 index fe9328c..0000000 --- a/amforth-6.5/common/words/to-lower.asm +++ /dev/null @@ -1,33 +0,0 @@ -; ( C -- c) -; String -; if C is an uppercase letter convert it to lowercase - -.if cpu_msp430==1 - HEADER(XT_TOLOWER,7,"tolower",DOCOLON) -.endif - -.if cpu_avr8==1 - - -VE_TOLOWER: - .dw $ff07 - .db "tolower",0 - .dw VE_HEAD - .set VE_HEAD = VE_TOLOWER -XT_TOLOWER: - .dw DO_COLON -PFA_TOLOWER: -.endif - .dw XT_DUP - .dw XT_DOLITERAL - .dw 'A' - .dw XT_DOLITERAL - .dw 'Z'+1 - .dw XT_WITHIN - .dw XT_DOCONDBRANCH - DEST(PFA_TOLOWER0) - .dw XT_DOLITERAL - .dw 32 - .dw XT_OR -PFA_TOLOWER0: - .dw XT_EXIT diff --git a/amforth-6.5/common/words/to-number.asm b/amforth-6.5/common/words/to-number.asm deleted file mode 100644 index 18ab6f4..0000000 --- a/amforth-6.5/common/words/to-number.asm +++ /dev/null @@ -1,41 +0,0 @@ -; ( ud1 c-addr1 u1 -- ud2 c-addr2 u2 ) -; Numeric IO -; convert a string to a number c-addr2/u2 is the unconverted string - -.if cpu_msp430==1 - HEADER(XT_TO_NUMBER,7,">number",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_TO_NUMBER: - .dw $ff07 - .db ">number",0 - .dw VE_HEAD - .set VE_HEAD = VE_TO_NUMBER -XT_TO_NUMBER: - .dw DO_COLON - -.endif - -TONUM1: .DW XT_DUP,XT_DOCONDBRANCH - DEST(TONUM3) - .DW XT_OVER,XT_CFETCH,XT_DIGITQ - .DW XT_ZEROEQUAL,XT_DOCONDBRANCH - DEST(TONUM2) - .DW XT_DROP,XT_EXIT -TONUM2: .DW XT_TO_R,XT_2SWAP,XT_BASE,XT_FETCH,XT_UDSTAR - .DW XT_R_FROM,XT_MPLUS,XT_2SWAP - .DW XT_ONE,XT_SLASHSTRING,XT_DOBRANCH - DEST(TONUM1) -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 ; diff --git a/amforth-6.5/common/words/to-upper.asm b/amforth-6.5/common/words/to-upper.asm deleted file mode 100644 index 180cd5d..0000000 --- a/amforth-6.5/common/words/to-upper.asm +++ /dev/null @@ -1,31 +0,0 @@ -; ( c -- C ) -; String -; if c is a lowercase letter convert it to uppercase - -.if cpu_msp430==1 - HEADER(XT_TOUPPER,7,"toupper",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_TOUPPER: - .dw $ff07 - .db "toupper",0 - .dw VE_HEAD - .set VE_HEAD = VE_TOUPPER -XT_TOUPPER: - .dw DO_COLON -PFA_TOUPPER: -.endif - .dw XT_DUP - .dw XT_DOLITERAL - .dw 'a' - .dw XT_DOLITERAL - .dw 'z'+1 - .dw XT_WITHIN - .dw XT_DOCONDBRANCH - DEST(PFA_TOUPPER0) - .dw XT_DOLITERAL - .dw 223 ; inverse of 0x20: 0xdf - .dw XT_AND -PFA_TOUPPER0: - .dw XT_EXIT diff --git a/amforth-6.5/common/words/to.asm b/amforth-6.5/common/words/to.asm deleted file mode 100644 index 0bb1aec..0000000 --- a/amforth-6.5/common/words/to.asm +++ /dev/null @@ -1,59 +0,0 @@ -; ( n -- ) -; Tools -; store the TOS to the named value (eeprom cell) - -.if cpu_msp430==1 - IMMED(XT_TO,2,"to",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_TO: - .dw $0002 - .db "to" - .dw VE_HEAD - .set VE_HEAD = VE_TO -XT_TO: - .dw DO_COLON -PFA_TO: -.endif - .dw XT_TICK - .dw XT_TO_BODY - .dw XT_STATE - .dw XT_FETCH - .dw XT_DOCONDBRANCH - DEST(PFA_TO1) - .dw XT_COMPILE - .dw XT_DOTO - .dw XT_COMMA - .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 - HEADLESS(XT_DOTO,DOCOLON) -.endif - -.if cpu_avr8==1 - -XT_DOTO: - .dw DO_COLON -PFA_DOTO: -.endif - .dw XT_R_FROM - .dw XT_DUP - .dw XT_ICELLPLUS - .dw XT_TO_R - .dw XT_FETCHI -PFA_TO1: - .dw XT_DUP - .dw XT_ICELLPLUS - .dw XT_ICELLPLUS - .dw XT_FETCHI - .dw XT_EXECUTE - .dw XT_EXIT diff --git a/amforth-6.5/common/words/traverse-wordlist.asm b/amforth-6.5/common/words/traverse-wordlist.asm deleted file mode 100644 index b6c00e0..0000000 --- a/amforth-6.5/common/words/traverse-wordlist.asm +++ /dev/null @@ -1,49 +0,0 @@ -; ( i*x xt wid -- j*x ) -; Tools Ext (2012) -; call the xt for every member of the wordlist wid until xt returns false - -.if cpu_msp430==1 - HEADER(XT_TRAVERSEWORDLIST,17,"traverse-wordlist",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_TRAVERSEWORDLIST: - .dw $ff11 - .db "traverse-wordlist",0 - .dw VE_HEAD - .set VE_HEAD = VE_TRAVERSEWORDLIST -XT_TRAVERSEWORDLIST: - .dw DO_COLON -PFA_TRAVERSEWORDLIST: - -.endif - .dw XT_FETCHE -PFA_TRAVERSEWORDLIST1: - .dw XT_DUP ; ( -- xt nt nt ) - .dw XT_DOCONDBRANCH ; ( -- nt ) is nfa = counted string - DEST(PFA_TRAVERSEWORDLIST2) - .dw XT_2DUP - .dw XT_2TO_R - .dw XT_SWAP - .dw XT_EXECUTE - .dw XT_2R_FROM - .dw XT_ROT - .dw XT_DOCONDBRANCH - DEST(PFA_TRAVERSEWORDLIST2) - .dw XT_NFA2LFA - .dw XT_FETCHI - .dw XT_DOBRANCH ; ( -- addr ) - DEST(PFA_TRAVERSEWORDLIST1) ; ( -- addr ) -PFA_TRAVERSEWORDLIST2: - .dw XT_2DROP - .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 ; diff --git a/amforth-6.5/common/words/tuck.asm b/amforth-6.5/common/words/tuck.asm deleted file mode 100644 index 173dc8c..0000000 --- a/amforth-6.5/common/words/tuck.asm +++ /dev/null @@ -1,21 +0,0 @@ -; ( n1 n2 -- n2 n1 n2 ) -; Stack -; Copy the first (top) stack item below the second stack item. - -.if cpu_msp430==1 - HEADER(XT_TUCK,4,"tuck",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_TUCK: - .dw $ff04 - .db "tuck" - .dw VE_HEAD - .set VE_HEAD = VE_TUCK -XT_TUCK: - .dw DO_COLON -PFA_TUCK: -.endif - .dw XT_SWAP - .dw XT_OVER - .dw XT_EXIT diff --git a/amforth-6.5/common/words/type.asm b/amforth-6.5/common/words/type.asm deleted file mode 100644 index 66929b0..0000000 --- a/amforth-6.5/common/words/type.asm +++ /dev/null @@ -1,32 +0,0 @@ -; ( addr n -- ) -; Character IO -; print a RAM based string - -.if cpu_msp430==1 - HEADER(XT_TYPE,4,"type",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_TYPE: - .dw $ff04 - .db "type" - .dw VE_HEAD - .set VE_HEAD = VE_TYPE -XT_TYPE: - .dw DO_COLON -PFA_TYPE: - -.endif - .dw XT_BOUNDS - .dw XT_QDOCHECK - .dw XT_DOCONDBRANCH - DEST(PFA_TYPE2) - .dw XT_DODO -PFA_TYPE1: - .dw XT_I - .dw XT_CFETCH - .dw XT_EMIT - .dw XT_DOLOOP - DEST(PFA_TYPE1) -PFA_TYPE2: - .dw XT_EXIT diff --git a/amforth-6.5/common/words/u-dot-r.asm b/amforth-6.5/common/words/u-dot-r.asm deleted file mode 100644 index 18cb089..0000000 --- a/amforth-6.5/common/words/u-dot-r.asm +++ /dev/null @@ -1,25 +0,0 @@ -; ( u w -- ) -; Numeric IO -; unsigned PNO with single cells numbers, right aligned in width w - -.if cpu_msp430==1 - HEADER(XT_UDOTR,3,"u.r",DOCOLON) -.endif - -.if cpu_avr8==1 - - -VE_UDOTR: - .dw $ff03 - .db "u.r",0 - .dw VE_HEAD - .set VE_HEAD = VE_UDOTR -XT_UDOTR: - .dw DO_COLON -PFA_UDOTR: -.endif - .dw XT_ZERO - .dw XT_SWAP - .dw XT_UDDOTR - .dw XT_EXIT -; : u.r ( s n -- ) 0 swap ud.r ; diff --git a/amforth-6.5/common/words/u-dot.asm b/amforth-6.5/common/words/u-dot.asm deleted file mode 100644 index 100a53d..0000000 --- a/amforth-6.5/common/words/u-dot.asm +++ /dev/null @@ -1,22 +0,0 @@ -; ( u -- ) -; Numeric IO -; unsigned PNO with single cell numbers - -.if cpu_msp430==1 - HEADER(XT_UDOT,2,"u.",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_UDOT: - .dw $ff02 - .db "u." - .dw VE_HEAD - .set VE_HEAD = VE_UDOT -XT_UDOT: - .dw DO_COLON -PFA_UDOT: -.endif - .dw XT_ZERO - .dw XT_UDDOT - .dw XT_EXIT -; : u. ( us -- ) 0 ud. ; diff --git a/amforth-6.5/common/words/u-greater.asm b/amforth-6.5/common/words/u-greater.asm deleted file mode 100644 index 4de1b85..0000000 --- a/amforth-6.5/common/words/u-greater.asm +++ /dev/null @@ -1,21 +0,0 @@ -; ( u1 u2 -- flag ) -; Compare -; true if u1 > u2 (unsigned) - -.if cpu_msp430==1 - HEADER(XT_UGREATER,2,"u>",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_UGREATER: - .dw $ff02 - .db "u>" - .dw VE_HEAD - .set VE_HEAD = VE_UGREATER -XT_UGREATER: - .dw DO_COLON -PFA_UGREATER: -.endif - .DW XT_SWAP - .dw XT_ULESS - .dw XT_EXIT diff --git a/amforth-6.5/common/words/ud-dot-r.asm b/amforth-6.5/common/words/ud-dot-r.asm deleted file mode 100644 index 7db9c2e..0000000 --- a/amforth-6.5/common/words/ud-dot-r.asm +++ /dev/null @@ -1,31 +0,0 @@ -; ( ud w -- ) -; Numeric IO -; unsigned PNO with double cell numbers, right aligned in width w - -.if cpu_msp430==1 - HEADER(XT_UDDOTR,4,"ud.r",DOCOLON) -.endif - -.if cpu_avr8==1 - - -VE_UDDOTR: - .dw $ff04 - .db "ud.r" - .dw VE_HEAD - .set VE_HEAD = VE_UDDOTR -XT_UDDOTR: - .dw DO_COLON -PFA_UDDOTR: -.endif - .dw XT_TO_R - .dw XT_L_SHARP - .dw XT_SHARP_S - .dw XT_SHARP_G - .dw XT_R_FROM - .dw XT_OVER - .dw XT_MINUS - .dw XT_SPACES - .dw XT_TYPE - .dw XT_EXIT -; : ud.r ( ud n -- ) >r <# #s #> r> over - spaces type ; \ No newline at end of file diff --git a/amforth-6.5/common/words/ud-dot.asm b/amforth-6.5/common/words/ud-dot.asm deleted file mode 100644 index c45ed5e..0000000 --- a/amforth-6.5/common/words/ud-dot.asm +++ /dev/null @@ -1,23 +0,0 @@ -; ( ud -- ) -; Numeric IO -; unsigned PNO with double cell numbers - -.if cpu_msp430==1 - HEADER(XT_UDDOT,3,"ud.",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_UDDOT: - .dw $ff03 - .db "ud.",0 - .dw VE_HEAD - .set VE_HEAD = VE_UDDOT -XT_UDDOT: - .dw DO_COLON -PFA_UDDOT: -.endif - .dw XT_ZERO - .dw XT_UDDOTR - .dw XT_SPACE - .dw XT_EXIT -; : ud. ( ud -- ) 0 ud.r space ; \ No newline at end of file diff --git a/amforth-6.5/common/words/ud-slash-mod.asm b/amforth-6.5/common/words/ud-slash-mod.asm deleted file mode 100644 index ad50afa..0000000 --- a/amforth-6.5/common/words/ud-slash-mod.asm +++ /dev/null @@ -1,28 +0,0 @@ -; ( d1 n -- rem ud2 ) -; Arithmetics -; unsigned double cell division with remainder - -.if cpu_msp430==1 - HEADER(XT_UDSLASHMOD,6,"ud/mod",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_UDSLASHMOD: - .dw $ff06 - .db "ud/mod" - .dw VE_HEAD - .set VE_HEAD = VE_UDSLASHMOD -XT_UDSLASHMOD: - .dw DO_COLON -PFA_UDSLASHMOD: -.endif - .dw XT_TO_R - .dw XT_ZERO - .dw XT_R_FETCH - .dw XT_UMSLASHMOD - .dw XT_R_FROM - .dw XT_SWAP - .dw XT_TO_R - .dw XT_UMSLASHMOD - .dw XT_R_FROM - .dw XT_EXIT diff --git a/amforth-6.5/common/words/ud-star.asm b/amforth-6.5/common/words/ud-star.asm deleted file mode 100644 index 64642da..0000000 --- a/amforth-6.5/common/words/ud-star.asm +++ /dev/null @@ -1,21 +0,0 @@ - -.if cpu_msp430==1 - HEADER(XT_UDSTAR,3,"ud*",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_UDSTAR: - .dw $ff03 - .db "ud*" - .dw VE_HEAD - .set VE_HEAD = VE_UDSTAR -XT_UDSTAR: - .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 + ; - - .DW XT_DUP,XT_TO_R,XT_UMSTAR,XT_DROP - .DW XT_SWAP,XT_R_FROM,XT_UMSTAR,XT_ROT,XT_PLUS,XT_EXIT diff --git a/amforth-6.5/common/words/udefer-fetch.asm b/amforth-6.5/common/words/udefer-fetch.asm deleted file mode 100644 index 81a1084..0000000 --- a/amforth-6.5/common/words/udefer-fetch.asm +++ /dev/null @@ -1,23 +0,0 @@ -; ( xt1 -- xt2 ) -; System -; does the real defer@ for user based defers - -.if cpu_msp430==1 - HEADER(XT_UDEFERFETCH,7,"Udefer@",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_UDEFERFETCH: - .dw $ff07 - .db "Udefer@",0 - .dw VE_HEAD - .set VE_HEAD = VE_UDEFERFETCH -XT_UDEFERFETCH: - .dw DO_COLON -PFA_UDEFERFETCH: -.endif - .dw XT_FETCHI - .dw XT_UP_FETCH - .dw XT_PLUS - .dw XT_FETCH - .dw XT_EXIT diff --git a/amforth-6.5/common/words/udefer-store.asm b/amforth-6.5/common/words/udefer-store.asm deleted file mode 100644 index 447f58e..0000000 --- a/amforth-6.5/common/words/udefer-store.asm +++ /dev/null @@ -1,25 +0,0 @@ -; ( xt1 xt2 -- ) -; System -; does the real defer! for user based defers - -.if cpu_msp430==1 - HEADER(XT_UDEFERSTORE,7,"Udefer!",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_UDEFERSTORE: - .dw $ff07 - .db "Udefer!",0 - .dw VE_HEAD - .set VE_HEAD = VE_UDEFERSTORE -XT_UDEFERSTORE: - .dw DO_COLON -PFA_UDEFERSTORE: -.endif - - .dw XT_FETCHI - .dw XT_UP_FETCH - .dw XT_PLUS - .dw XT_STORE - .dw XT_EXIT - diff --git a/amforth-6.5/common/words/umax.asm b/amforth-6.5/common/words/umax.asm deleted file mode 100644 index fb16de5..0000000 --- a/amforth-6.5/common/words/umax.asm +++ /dev/null @@ -1,22 +0,0 @@ - -.if cpu_msp430==1 - HEADER(XT_UMAX,4,"umax",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_UMAX: - .dw $ff04 - .db "umax" - .dw VE_HEAD - .set VE_HEAD = VE_UMAX -XT_UMAX: - .dw DO_COLON -PFA_UMAX: -.endif - - .DW XT_2DUP,XT_ULESS - .dw XT_DOCONDBRANCH - DEST(UMAX1) - .DW XT_SWAP -UMAX1: .DW XT_DROP - .dw XT_EXIT diff --git a/amforth-6.5/common/words/umin.asm b/amforth-6.5/common/words/umin.asm deleted file mode 100644 index c789095..0000000 --- a/amforth-6.5/common/words/umin.asm +++ /dev/null @@ -1,21 +0,0 @@ - -.if cpu_msp430==1 - HEADER(XT_UMIN,4,"umin",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_UMIN: - .dw $ff04 - .db "umin" - .dw VE_HEAD - .set VE_HEAD = VE_UMIN -XT_UMIN: - .dw DO_COLON -PFA_UMIN: -.endif - .DW XT_2DUP,XT_UGREATER - .dw XT_DOCONDBRANCH - DEST(UMIN1) - .DW XT_SWAP -UMIN1: .DW XT_DROP - .dw XT_EXIT diff --git a/amforth-6.5/common/words/until.asm b/amforth-6.5/common/words/until.asm deleted file mode 100644 index 74ec04b..0000000 --- a/amforth-6.5/common/words/until.asm +++ /dev/null @@ -1,24 +0,0 @@ -; ( f -- ) (C: dest -- ) -; Compiler -; finish begin with conditional branch, leaves the loop if true flag at runtime - -.if cpu_msp430==1 - IMMED(XT_UNTIL,5,"until",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_UNTIL: - .dw $0005 - .db "until",0 - .dw VE_HEAD - .set VE_HEAD = VE_UNTIL -XT_UNTIL: - .dw DO_COLON -PFA_UNTIL: -.endif - .dw XT_DOLITERAL - .dw XT_DOCONDBRANCH - .dw XT_COMMA - - .dw XT_LRESOLVE - .dw XT_EXIT diff --git a/amforth-6.5/common/words/variable.asm b/amforth-6.5/common/words/variable.asm deleted file mode 100644 index fe3e245..0000000 --- a/amforth-6.5/common/words/variable.asm +++ /dev/null @@ -1,24 +0,0 @@ -; ( cchar -- ) -; Compiler -; create a dictionary entry for a variable and allocate 1 cell RAM - -.if cpu_msp430==1 - HEADER(XT_VARIABLE,8,"variable",DOCOLON) -.endif - -.if cpu_avr8==1 - -VE_VARIABLE: - .dw $ff08 - .db "variable" - .dw VE_HEAD - .set VE_HEAD = VE_VARIABLE -XT_VARIABLE: - .dw DO_COLON -PFA_VARIABLE: -.endif - .dw XT_HERE - .dw XT_CONSTANT - .dw XT_TWO - .dw XT_ALLOT - .dw XT_EXIT diff --git a/amforth-6.5/common/words/ver.asm b/amforth-6.5/common/words/ver.asm deleted file mode 100644 index 3e0105a..0000000 --- a/amforth-6.5/common/words/ver.asm +++ /dev/null @@ -1,42 +0,0 @@ -; ( -- ) -; Tools -; print the version string - -.if cpu_msp430==1 - HEADER(XT_DOT_VER,3,"ver",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_DOT_VER: - .dw $ff03 - .db "ver" - .dw VE_HEAD - .set VE_HEAD = VE_DOT_VER -XT_DOT_VER: - .dw DO_COLON -PFA_DOT_VER: -.endif - .dw XT_ENV_FORTHNAME - .dw XT_ITYPE - .dw XT_SPACE - .dw XT_BASE - .dw XT_FETCH - - .dw XT_ENV_FORTHVERSION - .dw XT_DECIMAL - .dw XT_S2D - .dw XT_L_SHARP - .dw XT_SHARP - .dw XT_DOLITERAL - .dw '.' - .dw XT_HOLD - .dw XT_SHARP_S - .dw XT_SHARP_G - .dw XT_TYPE - .dw XT_BASE - .dw XT_STORE - .dw XT_SPACE - .dw XT_ENV_CPU - .dw XT_ITYPE - - .dw XT_EXIT diff --git a/amforth-6.5/common/words/warm.asm b/amforth-6.5/common/words/warm.asm deleted file mode 100644 index 5634fa0..0000000 --- a/amforth-6.5/common/words/warm.asm +++ /dev/null @@ -1,27 +0,0 @@ -; ( nx* -- ) (R: ny* -- ) -; System -; initialize amforth further. executes turnkey operation and go to quit - -.if cpu_msp430==1 - HEADER(XT_WARM,4,"warm",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_WARM: - .dw $ff04 - .db "warm" - .dw VE_HEAD - .set VE_HEAD = VE_WARM -XT_WARM: - .dw DO_COLON -PFA_WARM: -.endif - .dw XT_INIT_RAM - .dw XT_DOLITERAL - .dw XT_NOOP - .dw XT_DOLITERAL - .dw XT_PAUSE - .dw XT_DEFERSTORE - .dw XT_LBRACKET - .dw XT_TURNKEY - .dw XT_QUIT ; never returns diff --git a/amforth-6.5/common/words/while.asm b/amforth-6.5/common/words/while.asm deleted file mode 100644 index c21a6c1..0000000 --- a/amforth-6.5/common/words/while.asm +++ /dev/null @@ -1,21 +0,0 @@ -; ( f -- ) (C: dest -- orig dest ) -; Compiler -; at runtime skip until repeat if non-true - -.if cpu_msp430==1 - IMMED(XT_WHILE,5,"while",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_WHILE: - .dw $0005 - .db "while",0 - .dw VE_HEAD - .set VE_HEAD = VE_WHILE -XT_WHILE: - .dw DO_COLON -PFA_WHILE: -.endif - .dw XT_IF - .dw XT_SWAP - .dw XT_EXIT diff --git a/amforth-6.5/common/words/within.asm b/amforth-6.5/common/words/within.asm deleted file mode 100644 index 9aaa77a..0000000 --- a/amforth-6.5/common/words/within.asm +++ /dev/null @@ -1,25 +0,0 @@ -; ( n min max -- f) -; Compare -; check if n is within min..max - -.if cpu_msp430==1 - HEADER(XT_WITHIN,6,"within",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_WITHIN: - .dw $ff06 - .db "within" - .dw VE_HEAD - .set VE_HEAD = VE_WITHIN -XT_WITHIN: - .dw DO_COLON -PFA_WITHIN: -.endif - .dw XT_OVER - .dw XT_MINUS - .dw XT_TO_R - .dw XT_MINUS - .dw XT_R_FROM - .dw XT_ULESS - .dw XT_EXIT diff --git a/amforth-6.5/common/words/word.asm b/amforth-6.5/common/words/word.asm deleted file mode 100644 index 9f24f85..0000000 --- a/amforth-6.5/common/words/word.asm +++ /dev/null @@ -1,25 +0,0 @@ -; ( c -- addr ) -; Tools -; skip leading delimiter character and parse SOURCE until the next delimiter. copy the word to HERE - -.if cpu_msp430==1 - HEADER(XT_WORD,4,"word",DOCOLON) -.endif - -.if cpu_avr8==1 -VE_WORD: - .dw $ff04 - .db "word" - .dw VE_HEAD - .set VE_HEAD = VE_WORD -XT_WORD: - .dw DO_COLON -PFA_WORD: -.endif - .dw XT_SKIPSCANCHAR ; factor for both parse/word - ; move to HERE - .dw XT_HERE - .dw XT_PLACE - ; leave result - .dw XT_HERE - .dw XT_EXIT diff --git a/amforth-6.5/common/words/words.asm b/amforth-6.5/common/words/words.asm deleted file mode 100644 index a6f345e..0000000 --- a/amforth-6.5/common/words/words.asm +++ /dev/null @@ -1,25 +0,0 @@ -; ( -- ) -; Tools -; prints a list of all (visible) words in the dictionary - -.if cpu_msp430==1 - HEADER(XT_WORDS,5,"words",DOCOLON) -.endif - -.if cpu_avr8==1 - - -VE_WORDS: - .dw $ff05 - .db "words",0 - .dw VE_HEAD - .set VE_HEAD = VE_WORDS -XT_WORDS: - .dw DO_COLON -PFA_WORDS: -.endif - .dw XT_DOLITERAL - .dw CFG_ORDERLISTLEN+2 - .dw XT_FETCHE - .dw XT_SHOWWORDLIST - .dw XT_EXIT -- cgit v1.2.3