From 16069793496f7270745d59f98cf31bf3465fa822 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Remko=20Tron=C3=A7on?= Date: Sun, 17 Apr 2022 09:59:08 +0200 Subject: [PATCH] use forth loader for web build --- build-web.js | 3 +- scripts/esbuild/forth.js | 35 + src/examples/sieve.f | 21 + .../tests => }/standard-testsuite/README.md | 0 .../core.f.js => standard-testsuite/core.f} | 664 +++++++++--------- src/standard-testsuite/tester.f | 62 ++ src/web/benchmarks/benchmarks.js | 2 +- src/web/shell/shell.js | 2 +- src/web/sieve.js | 22 - src/web/tests/standard-testsuite/tester.f.js | 64 -- src/web/tests/suite.js | 6 +- test-web.js | 3 +- 12 files changed, 457 insertions(+), 427 deletions(-) create mode 100644 scripts/esbuild/forth.js create mode 100644 src/examples/sieve.f rename src/{web/tests => }/standard-testsuite/README.md (100%) rename src/{web/tests/standard-testsuite/core.f.js => standard-testsuite/core.f} (52%) create mode 100644 src/standard-testsuite/tester.f delete mode 100644 src/web/sieve.js delete mode 100644 src/web/tests/standard-testsuite/tester.f.js diff --git a/build-web.js b/build-web.js index c50acec..17e8806 100755 --- a/build-web.js +++ b/build-web.js @@ -6,6 +6,7 @@ const path = require("path"); const fs = require("fs"); const { createServer } = require("http"); const { wasmTextPlugin } = require("./scripts/esbuild/wasm-text"); +const { forthPlugin } = require("./scripts/esbuild/forth"); function withWatcher(config, handleBuildFinished = () => {}, port = 8880) { const watchClients = []; @@ -73,7 +74,7 @@ let buildConfig = { }, sourcemap: true, metafile: true, - plugins: [wasmTextPlugin()], + plugins: [wasmTextPlugin(), forthPlugin()], }; const INDEX_TEMPLATE = ` diff --git a/scripts/esbuild/forth.js b/scripts/esbuild/forth.js new file mode 100644 index 0000000..7e45984 --- /dev/null +++ b/scripts/esbuild/forth.js @@ -0,0 +1,35 @@ +/* eslint-env node */ + +const fs = require("fs"); +const path = require("path"); + +function forthPlugin() { + return { + name: "forth", + setup(build) { + build.onResolve({ filter: /.\.f$/ }, async (args) => { + if (args.resolveDir === "") { + return; + } + const filePath = path.isAbsolute(args.path) + ? args.path + : path.join(args.resolveDir, args.path); + return { + path: filePath, + namespace: "forth", + watchFiles: [filePath], + }; + }); + build.onLoad({ filter: /.*/, namespace: "forth" }, async (args) => { + return { + contents: await fs.promises.readFile(args.path), + loader: "text", + }; + }); + }, + }; +} + +module.exports = { + forthPlugin, +}; diff --git a/src/examples/sieve.f b/src/examples/sieve.f new file mode 100644 index 0000000..617f0b6 --- /dev/null +++ b/src/examples/sieve.f @@ -0,0 +1,21 @@ +( Copied from https://rosettacode.org/wiki/Sieve_of_Eratosthenes#Forth ) + +: prime? HERE + C@ 0= ; +: composite! HERE + 1 SWAP C! ; + +: sieve + HERE OVER ERASE + 2 + BEGIN + 2DUP DUP * > + WHILE + DUP prime? IF + 2DUP DUP * DO + I composite! + DUP +LOOP + THEN + 1+ + REPEAT + DROP + 1 SWAP 2 DO I prime? IF DROP I THEN LOOP . +; diff --git a/src/web/tests/standard-testsuite/README.md b/src/standard-testsuite/README.md similarity index 100% rename from src/web/tests/standard-testsuite/README.md rename to src/standard-testsuite/README.md diff --git a/src/web/tests/standard-testsuite/core.f.js b/src/standard-testsuite/core.f similarity index 52% rename from src/web/tests/standard-testsuite/core.f.js rename to src/standard-testsuite/core.f index acfaae5..4913b28 100644 --- a/src/web/tests/standard-testsuite/core.f.js +++ b/src/standard-testsuite/core.f @@ -1,20 +1,18 @@ -export default ` - CR TESTING CORE WORDS -\\ ------------------------------------------------------------------------ +\ ------------------------------------------------------------------------ TESTING BASIC ASSUMPTIONS -T{ -> }T \\ START WITH CLEAN SLATE +T{ -> }T \ START WITH CLEAN SLATE -\\ TEST IF ANY BITS ARE SET; ANSWER IN BASE 1 +\ 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{ 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 @@ -46,7 +44,7 @@ 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 ) @@ -62,14 +60,14 @@ 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 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{ 1 F LSHIFT -> 8000 }T \ BIGGEST GUARANTEED SHIFT T{ 1S 1 LSHIFT 1 XOR -> 1S }T T{ MSB 1 LSHIFT -> 0 }T @@ -77,11 +75,11 @@ 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{ 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 @@ -195,7 +193,7 @@ 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 @@ -215,16 +213,16 @@ 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 ) +T{ 1S GR1 -> 1S }T \ ( RETURN STACK HOLDS CELLS ) -\\ ------------------------------------------------------------------------ +\ ------------------------------------------------------------------------ TESTING ADD/SUBTRACT: + - 1+ 1- ABS NEGATE T{ 0 5 + -> 5 }T @@ -270,7 +268,7 @@ 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 @@ -300,7 +298,7 @@ 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 0 * -> 0 }T \ TEST IDENTITIES T{ 0 1 * -> 0 }T T{ 1 0 * -> 0 }T T{ 1 2 * -> 2 }T @@ -327,7 +325,7 @@ 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 @@ -344,8 +342,8 @@ 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 -\\ TODO T{ 7 S>D -3 FM/MOD -> -2 -3 }T -\\ TODO T{ -7 S>D 3 FM/MOD -> 2 -3 }T +\ TODO T{ 7 S>D -3 FM/MOD -> -2 -3 }T +\ TODO 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 @@ -365,194 +363,194 @@ 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 -\\ TODO T{ 0 S>D 1 SM/REM -> 0 0 }T -\\ TODO T{ 1 S>D 1 SM/REM -> 0 1 }T -\\ TODO T{ 2 S>D 1 SM/REM -> 0 2 }T -\\ TODO T{ -1 S>D 1 SM/REM -> 0 -1 }T -\\ TODO T{ -2 S>D 1 SM/REM -> 0 -2 }T -\\ TODO T{ 0 S>D -1 SM/REM -> 0 0 }T -\\ TODO T{ 1 S>D -1 SM/REM -> 0 -1 }T -\\ TODO T{ 2 S>D -1 SM/REM -> 0 -2 }T -\\ TODO T{ -1 S>D -1 SM/REM -> 0 1 }T -\\ TODO T{ -2 S>D -1 SM/REM -> 0 2 }T -\\ TODO T{ 2 S>D 2 SM/REM -> 0 1 }T -\\ TODO T{ -1 S>D -1 SM/REM -> 0 1 }T -\\ TODO T{ -2 S>D -2 SM/REM -> 0 1 }T -\\ TODO T{ 7 S>D 3 SM/REM -> 1 2 }T -\\ TODO T{ 7 S>D -3 SM/REM -> 1 -2 }T -\\ TODO T{ -7 S>D 3 SM/REM -> -1 -2 }T -\\ TODO T{ -7 S>D -3 SM/REM -> -1 2 }T -\\ TODO T{ MAX-INT S>D 1 SM/REM -> 0 MAX-INT }T -\\ TODO T{ MIN-INT S>D 1 SM/REM -> 0 MIN-INT }T -\\ TODO T{ MAX-INT S>D MAX-INT SM/REM -> 0 1 }T -\\ TODO T{ MIN-INT S>D MIN-INT SM/REM -> 0 1 }T -\\ TODO T{ 1S 1 4 SM/REM -> 3 MAX-INT }T -\\ TODO T{ 2 MIN-INT M* 2 SM/REM -> 0 MIN-INT }T -\\ TODO T{ 2 MIN-INT M* MIN-INT SM/REM -> 0 2 }T -\\ TODO T{ 2 MAX-INT M* 2 SM/REM -> 0 MAX-INT }T -\\ TODO T{ 2 MAX-INT M* MAX-INT SM/REM -> 0 2 }T -\\ TODO T{ MIN-INT MIN-INT M* MIN-INT SM/REM -> 0 MIN-INT }T -\\ TODO T{ MIN-INT MAX-INT M* MIN-INT SM/REM -> 0 MAX-INT }T -\\ TODO T{ MIN-INT MAX-INT M* MAX-INT SM/REM -> 0 MIN-INT }T -\\ TODO T{ MAX-INT MAX-INT M* MAX-INT SM/REM -> 0 MAX-INT }T -\\ TODO -\\ TODO T{ 0 0 1 UM/MOD -> 0 0 }T -\\ TODO T{ 1 0 1 UM/MOD -> 0 1 }T -\\ TODO T{ 1 0 2 UM/MOD -> 1 0 }T -\\ TODO T{ 3 0 2 UM/MOD -> 1 1 }T -\\ TODO T{ MAX-UINT 2 UM* 2 UM/MOD -> 0 MAX-UINT }T -\\ TODO T{ MAX-UINT 2 UM* MAX-UINT UM/MOD -> 0 2 }T -\\ TODO T{ MAX-UINT MAX-UINT UM* MAX-UINT UM/MOD -> 0 MAX-UINT }T +\ TODO T{ 0 S>D 1 SM/REM -> 0 0 }T +\ TODO T{ 1 S>D 1 SM/REM -> 0 1 }T +\ TODO T{ 2 S>D 1 SM/REM -> 0 2 }T +\ TODO T{ -1 S>D 1 SM/REM -> 0 -1 }T +\ TODO T{ -2 S>D 1 SM/REM -> 0 -2 }T +\ TODO T{ 0 S>D -1 SM/REM -> 0 0 }T +\ TODO T{ 1 S>D -1 SM/REM -> 0 -1 }T +\ TODO T{ 2 S>D -1 SM/REM -> 0 -2 }T +\ TODO T{ -1 S>D -1 SM/REM -> 0 1 }T +\ TODO T{ -2 S>D -1 SM/REM -> 0 2 }T +\ TODO T{ 2 S>D 2 SM/REM -> 0 1 }T +\ TODO T{ -1 S>D -1 SM/REM -> 0 1 }T +\ TODO T{ -2 S>D -2 SM/REM -> 0 1 }T +\ TODO T{ 7 S>D 3 SM/REM -> 1 2 }T +\ TODO T{ 7 S>D -3 SM/REM -> 1 -2 }T +\ TODO T{ -7 S>D 3 SM/REM -> -1 -2 }T +\ TODO T{ -7 S>D -3 SM/REM -> -1 2 }T +\ TODO T{ MAX-INT S>D 1 SM/REM -> 0 MAX-INT }T +\ TODO T{ MIN-INT S>D 1 SM/REM -> 0 MIN-INT }T +\ TODO T{ MAX-INT S>D MAX-INT SM/REM -> 0 1 }T +\ TODO T{ MIN-INT S>D MIN-INT SM/REM -> 0 1 }T +\ TODO T{ 1S 1 4 SM/REM -> 3 MAX-INT }T +\ TODO T{ 2 MIN-INT M* 2 SM/REM -> 0 MIN-INT }T +\ TODO T{ 2 MIN-INT M* MIN-INT SM/REM -> 0 2 }T +\ TODO T{ 2 MAX-INT M* 2 SM/REM -> 0 MAX-INT }T +\ TODO T{ 2 MAX-INT M* MAX-INT SM/REM -> 0 2 }T +\ TODO T{ MIN-INT MIN-INT M* MIN-INT SM/REM -> 0 MIN-INT }T +\ TODO T{ MIN-INT MAX-INT M* MIN-INT SM/REM -> 0 MAX-INT }T +\ TODO T{ MIN-INT MAX-INT M* MAX-INT SM/REM -> 0 MIN-INT }T +\ TODO T{ MAX-INT MAX-INT M* MAX-INT SM/REM -> 0 MAX-INT }T +\ TODO +\ TODO T{ 0 0 1 UM/MOD -> 0 0 }T +\ TODO T{ 1 0 1 UM/MOD -> 0 1 }T +\ TODO T{ 1 0 2 UM/MOD -> 1 0 }T +\ TODO T{ 3 0 2 UM/MOD -> 1 1 }T +\ TODO T{ MAX-UINT 2 UM* 2 UM/MOD -> 0 MAX-UINT }T +\ TODO T{ MAX-UINT 2 UM* MAX-UINT UM/MOD -> 0 2 }T +\ TODO T{ MAX-UINT MAX-UINT UM* MAX-UINT UM/MOD -> 0 MAX-UINT }T : IFFLOORED - [ -3 2 / -2 = INVERT ] LITERAL IF POSTPONE \\ THEN ; + [ -3 2 / -2 = INVERT ] LITERAL IF POSTPONE \ THEN ; : IFSYM - [ -3 2 / -1 = INVERT ] LITERAL IF POSTPONE \\ THEN ; + [ -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. +\ 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. -\\ TODO IFFLOORED : T/MOD >R S>D R> FM/MOD ; -\\ TODO IFFLOORED : T/ T/MOD SWAP DROP ; -\\ TODO IFFLOORED : TMOD T/MOD DROP ; -\\ TODO IFFLOORED : T*/MOD >R M* R> FM/MOD ; -\\ TODO IFFLOORED : T*/ T*/MOD SWAP DROP ; -\\ TODO IFSYM : T/MOD >R S>D R> SM/REM ; -\\ TODO IFSYM : T/ T/MOD SWAP DROP ; -\\ TODO IFSYM : TMOD T/MOD DROP ; -\\ TODO IFSYM : T*/MOD >R M* R> SM/REM ; -\\ TODO IFSYM : T*/ T*/MOD SWAP DROP ; +\ TODO IFFLOORED : T/MOD >R S>D R> FM/MOD ; +\ TODO IFFLOORED : T/ T/MOD SWAP DROP ; +\ TODO IFFLOORED : TMOD T/MOD DROP ; +\ TODO IFFLOORED : T*/MOD >R M* R> FM/MOD ; +\ TODO IFFLOORED : T*/ T*/MOD SWAP DROP ; +\ TODO IFSYM : T/MOD >R S>D R> SM/REM ; +\ TODO IFSYM : T/ T/MOD SWAP DROP ; +\ TODO IFSYM : TMOD T/MOD DROP ; +\ TODO IFSYM : T*/MOD >R M* R> SM/REM ; +\ TODO IFSYM : T*/ T*/MOD SWAP DROP ; -\\ TODO T{ 0 1 /MOD -> 0 1 T/MOD }T -\\ TODO T{ 1 1 /MOD -> 1 1 T/MOD }T -\\ TODO T{ 2 1 /MOD -> 2 1 T/MOD }T -\\ TODO T{ -1 1 /MOD -> -1 1 T/MOD }T -\\ TODO T{ -2 1 /MOD -> -2 1 T/MOD }T -\\ TODO T{ 0 -1 /MOD -> 0 -1 T/MOD }T -\\ TODO T{ 1 -1 /MOD -> 1 -1 T/MOD }T -\\ TODO T{ 2 -1 /MOD -> 2 -1 T/MOD }T -\\ TODO T{ -1 -1 /MOD -> -1 -1 T/MOD }T -\\ TODO T{ -2 -1 /MOD -> -2 -1 T/MOD }T -\\ TODO T{ 2 2 /MOD -> 2 2 T/MOD }T -\\ TODO T{ -1 -1 /MOD -> -1 -1 T/MOD }T -\\ TODO T{ -2 -2 /MOD -> -2 -2 T/MOD }T -\\ TODO T{ 7 3 /MOD -> 7 3 T/MOD }T -\\ TODO T{ 7 -3 /MOD -> 7 -3 T/MOD }T -\\ TODO T{ -7 3 /MOD -> -7 3 T/MOD }T -\\ TODO T{ -7 -3 /MOD -> -7 -3 T/MOD }T -\\ TODO T{ MAX-INT 1 /MOD -> MAX-INT 1 T/MOD }T -\\ TODO T{ MIN-INT 1 /MOD -> MIN-INT 1 T/MOD }T -\\ TODO T{ MAX-INT MAX-INT /MOD -> MAX-INT MAX-INT T/MOD }T -\\ TODO T{ MIN-INT MIN-INT /MOD -> MIN-INT MIN-INT T/MOD }T -\\ TODO -\\ TODO T{ 0 1 / -> 0 1 T/ }T -\\ TODO T{ 1 1 / -> 1 1 T/ }T -\\ TODO T{ 2 1 / -> 2 1 T/ }T -\\ TODO T{ -1 1 / -> -1 1 T/ }T -\\ TODO T{ -2 1 / -> -2 1 T/ }T -\\ TODO T{ 0 -1 / -> 0 -1 T/ }T -\\ TODO T{ 1 -1 / -> 1 -1 T/ }T -\\ TODO T{ 2 -1 / -> 2 -1 T/ }T -\\ TODO T{ -1 -1 / -> -1 -1 T/ }T -\\ TODO T{ -2 -1 / -> -2 -1 T/ }T -\\ TODO T{ 2 2 / -> 2 2 T/ }T -\\ TODO T{ -1 -1 / -> -1 -1 T/ }T -\\ TODO T{ -2 -2 / -> -2 -2 T/ }T -\\ TODO T{ 7 3 / -> 7 3 T/ }T -\\ TODO T{ 7 -3 / -> 7 -3 T/ }T -\\ TODO T{ -7 3 / -> -7 3 T/ }T -\\ TODO T{ -7 -3 / -> -7 -3 T/ }T -\\ TODO T{ MAX-INT 1 / -> MAX-INT 1 T/ }T -\\ TODO T{ MIN-INT 1 / -> MIN-INT 1 T/ }T -\\ TODO T{ MAX-INT MAX-INT / -> MAX-INT MAX-INT T/ }T -\\ TODO T{ MIN-INT MIN-INT / -> MIN-INT MIN-INT T/ }T -\\ TODO -\\ TODO T{ 0 1 MOD -> 0 1 TMOD }T -\\ TODO T{ 1 1 MOD -> 1 1 TMOD }T -\\ TODO T{ 2 1 MOD -> 2 1 TMOD }T -\\ TODO T{ -1 1 MOD -> -1 1 TMOD }T -\\ TODO T{ -2 1 MOD -> -2 1 TMOD }T -\\ TODO T{ 0 -1 MOD -> 0 -1 TMOD }T -\\ TODO T{ 1 -1 MOD -> 1 -1 TMOD }T -\\ TODO T{ 2 -1 MOD -> 2 -1 TMOD }T -\\ TODO T{ -1 -1 MOD -> -1 -1 TMOD }T -\\ TODO T{ -2 -1 MOD -> -2 -1 TMOD }T -\\ TODO T{ 2 2 MOD -> 2 2 TMOD }T -\\ TODO T{ -1 -1 MOD -> -1 -1 TMOD }T -\\ TODO T{ -2 -2 MOD -> -2 -2 TMOD }T -\\ TODO T{ 7 3 MOD -> 7 3 TMOD }T -\\ TODO T{ 7 -3 MOD -> 7 -3 TMOD }T -\\ TODO T{ -7 3 MOD -> -7 3 TMOD }T -\\ TODO T{ -7 -3 MOD -> -7 -3 TMOD }T -\\ TODO T{ MAX-INT 1 MOD -> MAX-INT 1 TMOD }T -\\ TODO T{ MIN-INT 1 MOD -> MIN-INT 1 TMOD }T -\\ TODO T{ MAX-INT MAX-INT MOD -> MAX-INT MAX-INT TMOD }T -\\ TODO T{ MIN-INT MIN-INT MOD -> MIN-INT MIN-INT TMOD }T -\\ TODO -\\ TODO T{ 0 2 1 */ -> 0 2 1 T*/ }T -\\ TODO T{ 1 2 1 */ -> 1 2 1 T*/ }T -\\ TODO T{ 2 2 1 */ -> 2 2 1 T*/ }T -\\ TODO T{ -1 2 1 */ -> -1 2 1 T*/ }T -\\ TODO T{ -2 2 1 */ -> -2 2 1 T*/ }T -\\ TODO T{ 0 2 -1 */ -> 0 2 -1 T*/ }T -\\ TODO T{ 1 2 -1 */ -> 1 2 -1 T*/ }T -\\ TODO T{ 2 2 -1 */ -> 2 2 -1 T*/ }T -\\ TODO T{ -1 2 -1 */ -> -1 2 -1 T*/ }T -\\ TODO T{ -2 2 -1 */ -> -2 2 -1 T*/ }T -\\ TODO T{ 2 2 2 */ -> 2 2 2 T*/ }T -\\ TODO T{ -1 2 -1 */ -> -1 2 -1 T*/ }T -\\ TODO T{ -2 2 -2 */ -> -2 2 -2 T*/ }T -\\ TODO T{ 7 2 3 */ -> 7 2 3 T*/ }T -\\ TODO T{ 7 2 -3 */ -> 7 2 -3 T*/ }T -\\ TODO T{ -7 2 3 */ -> -7 2 3 T*/ }T -\\ TODO T{ -7 2 -3 */ -> -7 2 -3 T*/ }T -\\ TODO T{ MAX-INT 2 MAX-INT */ -> MAX-INT 2 MAX-INT T*/ }T -\\ TODO T{ MIN-INT 2 MIN-INT */ -> MIN-INT 2 MIN-INT T*/ }T -\\ TODO -\\ TODO T{ 0 2 1 */MOD -> 0 2 1 T*/MOD }T -\\ TODO T{ 1 2 1 */MOD -> 1 2 1 T*/MOD }T -\\ TODO T{ 2 2 1 */MOD -> 2 2 1 T*/MOD }T -\\ TODO T{ -1 2 1 */MOD -> -1 2 1 T*/MOD }T -\\ TODO T{ -2 2 1 */MOD -> -2 2 1 T*/MOD }T -\\ TODO T{ 0 2 -1 */MOD -> 0 2 -1 T*/MOD }T -\\ TODO T{ 1 2 -1 */MOD -> 1 2 -1 T*/MOD }T -\\ TODO T{ 2 2 -1 */MOD -> 2 2 -1 T*/MOD }T -\\ TODO T{ -1 2 -1 */MOD -> -1 2 -1 T*/MOD }T -\\ TODO T{ -2 2 -1 */MOD -> -2 2 -1 T*/MOD }T -\\ TODO T{ 2 2 2 */MOD -> 2 2 2 T*/MOD }T -\\ TODO T{ -1 2 -1 */MOD -> -1 2 -1 T*/MOD }T -\\ TODO T{ -2 2 -2 */MOD -> -2 2 -2 T*/MOD }T -\\ TODO T{ 7 2 3 */MOD -> 7 2 3 T*/MOD }T -\\ TODO T{ 7 2 -3 */MOD -> 7 2 -3 T*/MOD }T -\\ TODO T{ -7 2 3 */MOD -> -7 2 3 T*/MOD }T -\\ TODO T{ -7 2 -3 */MOD -> -7 2 -3 T*/MOD }T -\\ TODO T{ MAX-INT 2 MAX-INT */MOD -> MAX-INT 2 MAX-INT T*/MOD }T -\\ TODO T{ MIN-INT 2 MIN-INT */MOD -> MIN-INT 2 MIN-INT T*/MOD }T +\ TODO T{ 0 1 /MOD -> 0 1 T/MOD }T +\ TODO T{ 1 1 /MOD -> 1 1 T/MOD }T +\ TODO T{ 2 1 /MOD -> 2 1 T/MOD }T +\ TODO T{ -1 1 /MOD -> -1 1 T/MOD }T +\ TODO T{ -2 1 /MOD -> -2 1 T/MOD }T +\ TODO T{ 0 -1 /MOD -> 0 -1 T/MOD }T +\ TODO T{ 1 -1 /MOD -> 1 -1 T/MOD }T +\ TODO T{ 2 -1 /MOD -> 2 -1 T/MOD }T +\ TODO T{ -1 -1 /MOD -> -1 -1 T/MOD }T +\ TODO T{ -2 -1 /MOD -> -2 -1 T/MOD }T +\ TODO T{ 2 2 /MOD -> 2 2 T/MOD }T +\ TODO T{ -1 -1 /MOD -> -1 -1 T/MOD }T +\ TODO T{ -2 -2 /MOD -> -2 -2 T/MOD }T +\ TODO T{ 7 3 /MOD -> 7 3 T/MOD }T +\ TODO T{ 7 -3 /MOD -> 7 -3 T/MOD }T +\ TODO T{ -7 3 /MOD -> -7 3 T/MOD }T +\ TODO T{ -7 -3 /MOD -> -7 -3 T/MOD }T +\ TODO T{ MAX-INT 1 /MOD -> MAX-INT 1 T/MOD }T +\ TODO T{ MIN-INT 1 /MOD -> MIN-INT 1 T/MOD }T +\ TODO T{ MAX-INT MAX-INT /MOD -> MAX-INT MAX-INT T/MOD }T +\ TODO T{ MIN-INT MIN-INT /MOD -> MIN-INT MIN-INT T/MOD }T +\ TODO +\ TODO T{ 0 1 / -> 0 1 T/ }T +\ TODO T{ 1 1 / -> 1 1 T/ }T +\ TODO T{ 2 1 / -> 2 1 T/ }T +\ TODO T{ -1 1 / -> -1 1 T/ }T +\ TODO T{ -2 1 / -> -2 1 T/ }T +\ TODO T{ 0 -1 / -> 0 -1 T/ }T +\ TODO T{ 1 -1 / -> 1 -1 T/ }T +\ TODO T{ 2 -1 / -> 2 -1 T/ }T +\ TODO T{ -1 -1 / -> -1 -1 T/ }T +\ TODO T{ -2 -1 / -> -2 -1 T/ }T +\ TODO T{ 2 2 / -> 2 2 T/ }T +\ TODO T{ -1 -1 / -> -1 -1 T/ }T +\ TODO T{ -2 -2 / -> -2 -2 T/ }T +\ TODO T{ 7 3 / -> 7 3 T/ }T +\ TODO T{ 7 -3 / -> 7 -3 T/ }T +\ TODO T{ -7 3 / -> -7 3 T/ }T +\ TODO T{ -7 -3 / -> -7 -3 T/ }T +\ TODO T{ MAX-INT 1 / -> MAX-INT 1 T/ }T +\ TODO T{ MIN-INT 1 / -> MIN-INT 1 T/ }T +\ TODO T{ MAX-INT MAX-INT / -> MAX-INT MAX-INT T/ }T +\ TODO T{ MIN-INT MIN-INT / -> MIN-INT MIN-INT T/ }T +\ TODO +\ TODO T{ 0 1 MOD -> 0 1 TMOD }T +\ TODO T{ 1 1 MOD -> 1 1 TMOD }T +\ TODO T{ 2 1 MOD -> 2 1 TMOD }T +\ TODO T{ -1 1 MOD -> -1 1 TMOD }T +\ TODO T{ -2 1 MOD -> -2 1 TMOD }T +\ TODO T{ 0 -1 MOD -> 0 -1 TMOD }T +\ TODO T{ 1 -1 MOD -> 1 -1 TMOD }T +\ TODO T{ 2 -1 MOD -> 2 -1 TMOD }T +\ TODO T{ -1 -1 MOD -> -1 -1 TMOD }T +\ TODO T{ -2 -1 MOD -> -2 -1 TMOD }T +\ TODO T{ 2 2 MOD -> 2 2 TMOD }T +\ TODO T{ -1 -1 MOD -> -1 -1 TMOD }T +\ TODO T{ -2 -2 MOD -> -2 -2 TMOD }T +\ TODO T{ 7 3 MOD -> 7 3 TMOD }T +\ TODO T{ 7 -3 MOD -> 7 -3 TMOD }T +\ TODO T{ -7 3 MOD -> -7 3 TMOD }T +\ TODO T{ -7 -3 MOD -> -7 -3 TMOD }T +\ TODO T{ MAX-INT 1 MOD -> MAX-INT 1 TMOD }T +\ TODO T{ MIN-INT 1 MOD -> MIN-INT 1 TMOD }T +\ TODO T{ MAX-INT MAX-INT MOD -> MAX-INT MAX-INT TMOD }T +\ TODO T{ MIN-INT MIN-INT MOD -> MIN-INT MIN-INT TMOD }T +\ TODO +\ TODO T{ 0 2 1 */ -> 0 2 1 T*/ }T +\ TODO T{ 1 2 1 */ -> 1 2 1 T*/ }T +\ TODO T{ 2 2 1 */ -> 2 2 1 T*/ }T +\ TODO T{ -1 2 1 */ -> -1 2 1 T*/ }T +\ TODO T{ -2 2 1 */ -> -2 2 1 T*/ }T +\ TODO T{ 0 2 -1 */ -> 0 2 -1 T*/ }T +\ TODO T{ 1 2 -1 */ -> 1 2 -1 T*/ }T +\ TODO T{ 2 2 -1 */ -> 2 2 -1 T*/ }T +\ TODO T{ -1 2 -1 */ -> -1 2 -1 T*/ }T +\ TODO T{ -2 2 -1 */ -> -2 2 -1 T*/ }T +\ TODO T{ 2 2 2 */ -> 2 2 2 T*/ }T +\ TODO T{ -1 2 -1 */ -> -1 2 -1 T*/ }T +\ TODO T{ -2 2 -2 */ -> -2 2 -2 T*/ }T +\ TODO T{ 7 2 3 */ -> 7 2 3 T*/ }T +\ TODO T{ 7 2 -3 */ -> 7 2 -3 T*/ }T +\ TODO T{ -7 2 3 */ -> -7 2 3 T*/ }T +\ TODO T{ -7 2 -3 */ -> -7 2 -3 T*/ }T +\ TODO T{ MAX-INT 2 MAX-INT */ -> MAX-INT 2 MAX-INT T*/ }T +\ TODO T{ MIN-INT 2 MIN-INT */ -> MIN-INT 2 MIN-INT T*/ }T +\ TODO +\ TODO T{ 0 2 1 */MOD -> 0 2 1 T*/MOD }T +\ TODO T{ 1 2 1 */MOD -> 1 2 1 T*/MOD }T +\ TODO T{ 2 2 1 */MOD -> 2 2 1 T*/MOD }T +\ TODO T{ -1 2 1 */MOD -> -1 2 1 T*/MOD }T +\ TODO T{ -2 2 1 */MOD -> -2 2 1 T*/MOD }T +\ TODO T{ 0 2 -1 */MOD -> 0 2 -1 T*/MOD }T +\ TODO T{ 1 2 -1 */MOD -> 1 2 -1 T*/MOD }T +\ TODO T{ 2 2 -1 */MOD -> 2 2 -1 T*/MOD }T +\ TODO T{ -1 2 -1 */MOD -> -1 2 -1 T*/MOD }T +\ TODO T{ -2 2 -1 */MOD -> -2 2 -1 T*/MOD }T +\ TODO T{ 2 2 2 */MOD -> 2 2 2 T*/MOD }T +\ TODO T{ -1 2 -1 */MOD -> -1 2 -1 T*/MOD }T +\ TODO T{ -2 2 -2 */MOD -> -2 2 -2 T*/MOD }T +\ TODO T{ 7 2 3 */MOD -> 7 2 3 T*/MOD }T +\ TODO T{ 7 2 -3 */MOD -> 7 2 -3 T*/MOD }T +\ TODO T{ -7 2 3 */MOD -> -7 2 3 T*/MOD }T +\ TODO T{ -7 2 -3 */MOD -> -7 2 -3 T*/MOD }T +\ TODO T{ MAX-INT 2 MAX-INT */MOD -> MAX-INT 2 MAX-INT T*/MOD }T +\ TODO 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 +T{ 1STA 2NDA U< -> }T \ HERE MUST GROW WITH ALLOT +T{ 1STA 1+ -> 2NDA }T \ ... BY ONE ADDRESS UNIT ( MISSING TEST: NEGATIVE ALLOT ) -\\ Added by GWJ so that ALIGN can be used before , (comma) is tested -1 ALIGNED CONSTANT ALMNT \\ -- 1|2|4|8 for 8|16|32|64 bit alignment +\ Added by GWJ so that ALIGN can be used before , (comma) is tested +1 ALIGNED CONSTANT ALMNT \ -- 1|2|4|8 for 8|16|32|64 bit alignment ALIGN T{ HERE 1 ALLOT ALIGN HERE SWAP - ALMNT = -> }T -\\ End of extra test +\ End of extra test 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 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 @@ -562,14 +560,14 @@ 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 +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 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 @@ -605,7 +603,7 @@ T{ 1 1ST +! -> }T T{ 1ST @ -> 1 }T T{ -1 1ST +! 1ST @ -> 0 }T -\\ ------------------------------------------------------------------------ +\ ------------------------------------------------------------------------ TESTING CHAR [CHAR] [ ] BL S" T{ BL -> 20 }T @@ -621,7 +619,7 @@ 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 @@ -649,7 +647,7 @@ 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 @@ -672,13 +670,13 @@ T{ 3 GI4 -> 3 4 5 6 }T T{ 5 GI4 -> 5 6 }T T{ 6 GI4 -> 6 7 }T -\\ TODO T{ : GI5 BEGIN DUP 2 > -\\ TODO WHILE DUP 5 < WHILE DUP 1+ REPEAT 123 ELSE 345 THEN ; -> }T -\\ TODO T{ 1 GI5 -> 1 345 }T -\\ TODO T{ 2 GI5 -> 2 345 }T -\\ TODO T{ 3 GI5 -> 3 4 5 123 }T -\\ TODO T{ 4 GI5 -> 4 5 123 }T -\\ TODO T{ 5 GI5 -> 5 123 }T +\ TODO T{ : GI5 BEGIN DUP 2 > +\ TODO WHILE DUP 5 < WHILE DUP 1+ REPEAT 123 ELSE 345 THEN ; -> }T +\ TODO T{ 1 GI5 -> 1 345 }T +\ TODO T{ 2 GI5 -> 2 345 }T +\ TODO T{ 3 GI5 -> 3 4 5 123 }T +\ TODO T{ 4 GI5 -> 4 5 123 }T +\ TODO 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 @@ -687,7 +685,7 @@ 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 @@ -698,7 +696,7 @@ 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 -\\ TODO T{ MID-UINT MID-UINT+1 GD2 -> MID-UINT+1 MID-UINT }T +\ TODO 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 @@ -708,7 +706,7 @@ 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 -\\ TODO T{ MID-UINT MID-UINT+1 GD4 -> MID-UINT+1 MID-UINT }T +\ TODO 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 @@ -721,9 +719,9 @@ T{ : GD6 ( PAT: T{0 0},{0 0}{1 0}{1 1},{0 0}{1 0}{1 1}{2 0}{2 1}{2 2} ) LOOP ; -> }T T{ 1 GD6 -> 1 }T T{ 2 GD6 -> 3 }T -\\ TODO T{ 3 GD6 -> 4 1 2 }T +\ TODO T{ 3 GD6 -> 4 1 2 }T -\\ ------------------------------------------------------------------------ +\ ------------------------------------------------------------------------ TESTING DEFINING WORDS: : ; CONSTANT VARIABLE CREATE DOES> >BODY T{ 123 CONSTANT X123 -> }T @@ -759,7 +757,7 @@ T{ ' W1 >BODY -> HERE }T T{ W1 -> HERE 1 + }T T{ W1 -> HERE 2 + }T -\\ ------------------------------------------------------------------------ +\ ------------------------------------------------------------------------ TESTING EVALUATE : GE1 S" 123" ; IMMEDIATE @@ -777,7 +775,7 @@ T{ GE6 -> 123 }T T{ : GE7 GE2 GE5 ; -> }T T{ GE7 -> 124 }T -\\ ------------------------------------------------------------------------ +\ ------------------------------------------------------------------------ TESTING SOURCE >IN WORD : GS1 S" SOURCE" 2DUP EVALUATE @@ -798,120 +796,120 @@ T{ GS2 -> 123 123 123 123 123 }T 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 +DROP -> 0 }T \ BLANK LINE RETURN ZERO-LENGTH STRING : GS4 SOURCE >IN ! DROP ; T{ GS4 123 456 -> }T -\\ ------------------------------------------------------------------------ -\\ TODO TESTING <# # #S #> HOLD SIGN BASE >NUMBER HEX DECIMAL +\ ------------------------------------------------------------------------ +\ TODO TESTING <# # #S #> HOLD SIGN BASE >NUMBER HEX DECIMAL -\\ TODO : S= \\ ( ADDR1 C1 ADDR2 C2 -- T/F ) COMPARE TWO STRINGS. -\\ TODO >R SWAP R@ = IF \\ MAKE SURE STRINGS HAVE SAME LENGTH -\\ TODO R> ?DUP IF \\ IF NON-EMPTY STRINGS -\\ TODO 0 DO -\\ TODO OVER C@ OVER C@ - IF 2DROP UNLOOP EXIT THEN -\\ TODO SWAP CHAR+ SWAP CHAR+ -\\ TODO LOOP -\\ TODO THEN -\\ TODO 2DROP \\ IF WE GET HERE, STRINGS MATCH -\\ TODO ELSE -\\ TODO R> DROP 2DROP \\ LENGTHS MISMATCH -\\ TODO THEN ; -\\ TODO -\\ TODO : GP1 <# 41 HOLD 42 HOLD 0 0 #> S" BA" S= ; -\\ TODO T{ GP1 -> }T -\\ TODO -\\ TODO : GP2 <# -1 SIGN 0 SIGN -1 SIGN 0 0 #> S" --" S= ; -\\ TODO T{ GP2 -> }T -\\ TODO -\\ TODO : GP3 <# 1 0 # # #> S" 01" S= ; -\\ TODO T{ GP3 -> }T -\\ TODO -\\ TODO : GP4 <# 1 0 #S #> S" 1" S= ; -\\ TODO T{ GP4 -> }T -\\ TODO -\\ TODO 24 CONSTANT MAX-BASE \\ BASE 2 .. 36 -\\ TODO : COUNT-BITS -\\ TODO 0 0 INVERT BEGIN DUP WHILE >R 1+ R> 2* REPEAT DROP ; -\\ TODO COUNT-BITS 2* CONSTANT #BITS-UD \\ NUMBER OF BITS IN UD -\\ TODO -\\ TODO : GP5 -\\ TODO BASE @ -\\ TODO MAX-BASE 1+ 2 DO \\ FOR EACH POSSIBLE BASE -\\ TODO I BASE ! \\ TBD: ASSUMES BASE WORKS -\\ TODO I 0 <# #S #> S" 10" S= AND -\\ TODO LOOP -\\ TODO SWAP BASE ! ; -\\ TODO T{ GP5 -> }T -\\ TODO -\\ TODO : GP6 -\\ TODO BASE @ >R 2 BASE ! -\\ TODO MAX-UINT MAX-UINT <# #S #> \\ MAXIMUM UD TO BINARY -\\ TODO R> BASE ! \\ S: C-ADDR U -\\ TODO DUP #BITS-UD = SWAP -\\ TODO 0 DO \\ S: C-ADDR FLAG -\\ TODO OVER C@ [CHAR] 1 = AND \\ ALL ONES -\\ TODO >R CHAR+ R> -\\ TODO LOOP SWAP DROP ; -\\ TODO T{ GP6 -> }T -\\ TODO -\\ TODO : GP7 -\\ TODO BASE @ >R MAX-BASE BASE ! -\\ TODO -\\ TODO A 0 DO -\\ TODO I 0 <# #S #> -\\ TODO 1 = SWAP C@ I 30 + = AND AND -\\ TODO LOOP -\\ TODO MAX-BASE A DO -\\ TODO I 0 <# #S #> -\\ TODO 1 = SWAP C@ 41 I A - + = AND AND -\\ TODO LOOP -\\ TODO R> BASE ! ; -\\ TODO -\\ TODO T{ GP7 -> }T -\\ TODO -\\ TODO \\ >NUMBER TESTS -\\ TODO CREATE GN-BUF 0 C, -\\ TODO : GN-STRING GN-BUF 1 ; -\\ TODO : GN-CONSUMED GN-BUF CHAR+ 0 ; -\\ TODO : GN' [CHAR] ' WORD CHAR+ C@ GN-BUF C! GN-STRING ; -\\ TODO -\\ TODO T{ 0 0 GN' 0' >NUMBER -> 0 0 GN-CONSUMED }T -\\ TODO T{ 0 0 GN' 1' >NUMBER -> 1 0 GN-CONSUMED }T -\\ TODO T{ 1 0 GN' 1' >NUMBER -> BASE @ 1+ 0 GN-CONSUMED }T -\\ TODO T{ 0 0 GN' -' >NUMBER -> 0 0 GN-STRING }T \\ SHOULD FAIL TO CONVERT THESE -\\ TODO T{ 0 0 GN' +' >NUMBER -> 0 0 GN-STRING }T -\\ TODO T{ 0 0 GN' .' >NUMBER -> 0 0 GN-STRING }T -\\ TODO -\\ TODO : >NUMBER-BASED -\\ TODO BASE @ >R BASE ! >NUMBER R> BASE ! ; -\\ TODO -\\ TODO T{ 0 0 GN' 2' 10 >NUMBER-BASED -> 2 0 GN-CONSUMED }T -\\ TODO T{ 0 0 GN' 2' 2 >NUMBER-BASED -> 0 0 GN-STRING }T -\\ TODO T{ 0 0 GN' F' 10 >NUMBER-BASED -> F 0 GN-CONSUMED }T -\\ TODO T{ 0 0 GN' G' 10 >NUMBER-BASED -> 0 0 GN-STRING }T -\\ TODO T{ 0 0 GN' G' MAX-BASE >NUMBER-BASED -> 10 0 GN-CONSUMED }T -\\ TODO T{ 0 0 GN' Z' MAX-BASE >NUMBER-BASED -> 23 0 GN-CONSUMED }T -\\ TODO -\\ TODO : GN1 \\ ( UD BASE -- UD' LEN ) UD SHOULD EQUAL UD' AND LEN SHOULD BE ZERO. -\\ TODO BASE @ >R BASE ! -\\ TODO <# #S #> -\\ TODO 0 0 2SWAP >NUMBER SWAP DROP \\ RETURN LENGTH ONLY -\\ TODO R> BASE ! ; -\\ TODO T{ 0 0 2 GN1 -> 0 0 0 }T -\\ TODO T{ MAX-UINT 0 2 GN1 -> MAX-UINT 0 0 }T -\\ TODO T{ MAX-UINT DUP 2 GN1 -> MAX-UINT DUP 0 }T -\\ TODO T{ 0 0 MAX-BASE GN1 -> 0 0 0 }T -\\ TODO T{ MAX-UINT 0 MAX-BASE GN1 -> MAX-UINT 0 0 }T -\\ TODO T{ MAX-UINT DUP MAX-BASE GN1 -> MAX-UINT DUP 0 }T -\\ TODO -\\ TODO : GN2 \\ ( -- 16 10 ) -\\ TODO BASE @ >R HEX BASE @ DECIMAL BASE @ R> BASE ! ; -\\ TODO T{ GN2 -> 10 A }T +\ TODO : S= \ ( ADDR1 C1 ADDR2 C2 -- T/F ) COMPARE TWO STRINGS. +\ TODO >R SWAP R@ = IF \ MAKE SURE STRINGS HAVE SAME LENGTH +\ TODO R> ?DUP IF \ IF NON-EMPTY STRINGS +\ TODO 0 DO +\ TODO OVER C@ OVER C@ - IF 2DROP UNLOOP EXIT THEN +\ TODO SWAP CHAR+ SWAP CHAR+ +\ TODO LOOP +\ TODO THEN +\ TODO 2DROP \ IF WE GET HERE, STRINGS MATCH +\ TODO ELSE +\ TODO R> DROP 2DROP \ LENGTHS MISMATCH +\ TODO THEN ; +\ TODO +\ TODO : GP1 <# 41 HOLD 42 HOLD 0 0 #> S" BA" S= ; +\ TODO T{ GP1 -> }T +\ TODO +\ TODO : GP2 <# -1 SIGN 0 SIGN -1 SIGN 0 0 #> S" --" S= ; +\ TODO T{ GP2 -> }T +\ TODO +\ TODO : GP3 <# 1 0 # # #> S" 01" S= ; +\ TODO T{ GP3 -> }T +\ TODO +\ TODO : GP4 <# 1 0 #S #> S" 1" S= ; +\ TODO T{ GP4 -> }T +\ TODO +\ TODO 24 CONSTANT MAX-BASE \ BASE 2 .. 36 +\ TODO : COUNT-BITS +\ TODO 0 0 INVERT BEGIN DUP WHILE >R 1+ R> 2* REPEAT DROP ; +\ TODO COUNT-BITS 2* CONSTANT #BITS-UD \ NUMBER OF BITS IN UD +\ TODO +\ TODO : GP5 +\ TODO BASE @ +\ TODO MAX-BASE 1+ 2 DO \ FOR EACH POSSIBLE BASE +\ TODO I BASE ! \ TBD: ASSUMES BASE WORKS +\ TODO I 0 <# #S #> S" 10" S= AND +\ TODO LOOP +\ TODO SWAP BASE ! ; +\ TODO T{ GP5 -> }T +\ TODO +\ TODO : GP6 +\ TODO BASE @ >R 2 BASE ! +\ TODO MAX-UINT MAX-UINT <# #S #> \ MAXIMUM UD TO BINARY +\ TODO R> BASE ! \ S: C-ADDR U +\ TODO DUP #BITS-UD = SWAP +\ TODO 0 DO \ S: C-ADDR FLAG +\ TODO OVER C@ [CHAR] 1 = AND \ ALL ONES +\ TODO >R CHAR+ R> +\ TODO LOOP SWAP DROP ; +\ TODO T{ GP6 -> }T +\ TODO +\ TODO : GP7 +\ TODO BASE @ >R MAX-BASE BASE ! +\ TODO +\ TODO A 0 DO +\ TODO I 0 <# #S #> +\ TODO 1 = SWAP C@ I 30 + = AND AND +\ TODO LOOP +\ TODO MAX-BASE A DO +\ TODO I 0 <# #S #> +\ TODO 1 = SWAP C@ 41 I A - + = AND AND +\ TODO LOOP +\ TODO R> BASE ! ; +\ TODO +\ TODO T{ GP7 -> }T +\ TODO +\ TODO \ >NUMBER TESTS +\ TODO CREATE GN-BUF 0 C, +\ TODO : GN-STRING GN-BUF 1 ; +\ TODO : GN-CONSUMED GN-BUF CHAR+ 0 ; +\ TODO : GN' [CHAR] ' WORD CHAR+ C@ GN-BUF C! GN-STRING ; +\ TODO +\ TODO T{ 0 0 GN' 0' >NUMBER -> 0 0 GN-CONSUMED }T +\ TODO T{ 0 0 GN' 1' >NUMBER -> 1 0 GN-CONSUMED }T +\ TODO T{ 1 0 GN' 1' >NUMBER -> BASE @ 1+ 0 GN-CONSUMED }T +\ TODO T{ 0 0 GN' -' >NUMBER -> 0 0 GN-STRING }T \ SHOULD FAIL TO CONVERT THESE +\ TODO T{ 0 0 GN' +' >NUMBER -> 0 0 GN-STRING }T +\ TODO T{ 0 0 GN' .' >NUMBER -> 0 0 GN-STRING }T +\ TODO +\ TODO : >NUMBER-BASED +\ TODO BASE @ >R BASE ! >NUMBER R> BASE ! ; +\ TODO +\ TODO T{ 0 0 GN' 2' 10 >NUMBER-BASED -> 2 0 GN-CONSUMED }T +\ TODO T{ 0 0 GN' 2' 2 >NUMBER-BASED -> 0 0 GN-STRING }T +\ TODO T{ 0 0 GN' F' 10 >NUMBER-BASED -> F 0 GN-CONSUMED }T +\ TODO T{ 0 0 GN' G' 10 >NUMBER-BASED -> 0 0 GN-STRING }T +\ TODO T{ 0 0 GN' G' MAX-BASE >NUMBER-BASED -> 10 0 GN-CONSUMED }T +\ TODO T{ 0 0 GN' Z' MAX-BASE >NUMBER-BASED -> 23 0 GN-CONSUMED }T +\ TODO +\ TODO : GN1 \ ( UD BASE -- UD' LEN ) UD SHOULD EQUAL UD' AND LEN SHOULD BE ZERO. +\ TODO BASE @ >R BASE ! +\ TODO <# #S #> +\ TODO 0 0 2SWAP >NUMBER SWAP DROP \ RETURN LENGTH ONLY +\ TODO R> BASE ! ; +\ TODO T{ 0 0 2 GN1 -> 0 0 0 }T +\ TODO T{ MAX-UINT 0 2 GN1 -> MAX-UINT 0 0 }T +\ TODO T{ MAX-UINT DUP 2 GN1 -> MAX-UINT DUP 0 }T +\ TODO T{ 0 0 MAX-BASE GN1 -> 0 0 0 }T +\ TODO T{ MAX-UINT 0 MAX-BASE GN1 -> MAX-UINT 0 0 }T +\ TODO T{ MAX-UINT DUP MAX-BASE GN1 -> MAX-UINT DUP 0 }T +\ TODO +\ TODO : GN2 \ ( -- 16 10 ) +\ TODO BASE @ >R HEX BASE @ DECIMAL BASE @ R> BASE ! ; +\ TODO T{ GN2 -> 10 A }T -\\ ------------------------------------------------------------------------ +\ ------------------------------------------------------------------------ TESTING FILL MOVE CREATE FBUF 00 C, 00 C, 00 C, @@ -927,7 +925,7 @@ 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{ FBUF FBUF 3 CHARS MOVE -> }T \ BIZARRE SPECIAL CASE T{ SEEBUF -> 20 20 20 }T T{ SBUF FBUF 0 CHARS MOVE -> }T @@ -945,8 +943,8 @@ 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. +\ ------------------------------------------------------------------------ +\ TESTING OUTPUT: . ." CR EMIT SPACE SPACES TYPE U. : OUTPUT-TEST ." YOU SHOULD SEE THE STANDARD GRAPHIC CHARACTERS:" CR @@ -971,25 +969,23 @@ T{ SEEBUF -> 12 34 34 }T T{ OUTPUT-TEST -> }T -\\ ------------------------------------------------------------------------ -\\ TESTING INPUT: ACCEPT -\\ -\\ CREATE ABUF 50 CHARS ALLOT -\\ -\\ : ACCEPT-TEST -\\ CR ." PLEASE TYPE UP TO 80 CHARACTERS:" CR -\\ ABUF 50 ACCEPT -\\ CR ." RECEIVED: " [CHAR] " EMIT -\\ ABUF SWAP TYPE [CHAR] " EMIT CR -\\ ; -\\ -\\ T{ ACCEPT-TEST -> }T +\ ------------------------------------------------------------------------ +\ TESTING INPUT: ACCEPT +\ +\ CREATE ABUF 50 CHARS ALLOT +\ +\ : ACCEPT-TEST +\ CR ." PLEASE TYPE UP TO 80 CHARACTERS:" CR +\ ABUF 50 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 - -`; diff --git a/src/standard-testsuite/tester.f b/src/standard-testsuite/tester.f new file mode 100644 index 0000000..72e9388 --- /dev/null +++ b/src/standard-testsuite/tester.f @@ -0,0 +1,62 @@ +\ 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.2 + +\ 24/11/2015 Replaced Core Ext word <> with = 0= +\ 31/3/2015 Variable #ERRORS added and incremented for each error reported. +\ 22/1/09 The words { and } have been changed to T{ and }T respectively to +\ agree with the Forth 200X file ttester.fs. This avoids clashes with +\ locals using { ... } and the FSL use of } + +HEX + +\ 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 + FALSE VERBOSE ! +\ TRUE VERBOSE ! + +: EMPTY-STACK \ ( ... -- ) EMPTY STACK: HANDLES UNDERFLOWED STACK TOO. + DEPTH ?DUP IF DUP 0< IF NEGATE 0 DO 0 LOOP ELSE 0 DO DROP LOOP THEN THEN ; + +VARIABLE #ERRORS 0 #ERRORS ! + +: ERROR \ ( C-ADDR U -- ) DISPLAY AN ERROR MESSAGE FOLLOWED BY THE LINE THAT HAD THE ERROR. + CR TYPE SOURCE TYPE \ DISPLAY LINE CORRESPONDING TO ERROR + EMPTY-STACK \ THROW AWAY EVERY THING ELSE + #ERRORS @ 1 + #ERRORS ! +\ QUIT \ *** Uncomment this line to QUIT on an error +; + +VARIABLE ACTUAL-DEPTH \ STACK RECORD +CREATE ACTUAL-RESULTS 20 CELLS ALLOT + +: T{ ; \ ( -- ) SYNTACTIC SUGAR. + +: -> \ ( ... -- ) RECORD DEPTH AND CONTENT OF STACK. + DEPTH DUP ACTUAL-DEPTH ! \ RECORD DEPTH + ?DUP IF \ IF THERE IS SOMETHING ON STACK + 0 DO ACTUAL-RESULTS I CELLS + ! LOOP \ SAVE THEM + THEN ; + +: }T \ ( ... -- ) COMPARE STACK (EXPECTED) CONTENTS WITH SAVED (ACTUAL) CONTENTS. + DEPTH ACTUAL-DEPTH @ = IF \ IF DEPTHS MATCH + DEPTH ?DUP IF \ IF THERE IS SOMETHING ON THE STACK + 0 DO \ FOR EACH STACK ITEM + ACTUAL-RESULTS I CELLS + @ \ COMPARE ACTUAL WITH EXPECTED + = 0= 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 [CHAR] * EMIT + THEN ; diff --git a/src/web/benchmarks/benchmarks.js b/src/web/benchmarks/benchmarks.js index aa51c27..cce7f88 100644 --- a/src/web/benchmarks/benchmarks.js +++ b/src/web/benchmarks/benchmarks.js @@ -1,7 +1,7 @@ import React from "react"; import { createRoot } from "react-dom/client"; import WAForth from "../WAForth"; -import sieve from "../sieve"; +import sieve from "../../examples/sieve.f"; import sieveVanillaModule from "./sieve-vanilla.wat"; import update from "immutability-helper"; import "./benchmarks.css"; diff --git a/src/web/shell/shell.js b/src/web/shell/shell.js index bcf61f0..07d8d46 100644 --- a/src/web/shell/shell.js +++ b/src/web/shell/shell.js @@ -1,5 +1,5 @@ import WAForth from "../WAForth"; -import sieve from "../sieve"; +import sieve from "../../examples/sieve.f"; import "./shell.css"; document.title = "WAForth"; diff --git a/src/web/sieve.js b/src/web/sieve.js deleted file mode 100644 index 27b5f60..0000000 --- a/src/web/sieve.js +++ /dev/null @@ -1,22 +0,0 @@ -// Copied from https://rosettacode.org/wiki/Sieve_of_Eratosthenes#Forth -export default ` - : prime? HERE + C@ 0= ; - : composite! HERE + 1 SWAP C! ; - - : sieve - HERE OVER ERASE - 2 - BEGIN - 2DUP DUP * > - WHILE - DUP prime? IF - 2DUP DUP * DO - I composite! - DUP +LOOP - THEN - 1+ - REPEAT - DROP - 1 SWAP 2 DO I prime? IF DROP I THEN LOOP . - ; -`; diff --git a/src/web/tests/standard-testsuite/tester.f.js b/src/web/tests/standard-testsuite/tester.f.js deleted file mode 100644 index b8f95da..0000000 --- a/src/web/tests/standard-testsuite/tester.f.js +++ /dev/null @@ -1,64 +0,0 @@ -export default ` -\\ 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.2 - -\\ 24/11/2015 Replaced Core Ext word <> with = 0= -\\ 31/3/2015 Variable #ERRORS added and incremented for each error reported. -\\ 22/1/09 The words { and } have been changed to T{ and }T respectively to -\\ agree with the Forth 200X file ttester.fs. This avoids clashes with -\\ locals using { ... } and the FSL use of } - -HEX - -\\ 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 - FALSE VERBOSE ! -\\ TRUE VERBOSE ! - -: EMPTY-STACK \\ ( ... -- ) EMPTY STACK: HANDLES UNDERFLOWED STACK TOO. - DEPTH ?DUP IF DUP 0< IF NEGATE 0 DO 0 LOOP ELSE 0 DO DROP LOOP THEN THEN ; - -VARIABLE #ERRORS 0 #ERRORS ! - -: ERROR \\ ( C-ADDR U -- ) DISPLAY AN ERROR MESSAGE FOLLOWED BY THE LINE THAT HAD THE ERROR. - CR TYPE SOURCE TYPE \\ DISPLAY LINE CORRESPONDING TO ERROR - EMPTY-STACK \\ THROW AWAY EVERY THING ELSE - #ERRORS @ 1 + #ERRORS ! -\\ QUIT \\ *** Uncomment this line to QUIT on an error -; - -VARIABLE ACTUAL-DEPTH \\ STACK RECORD -CREATE ACTUAL-RESULTS 20 CELLS ALLOT - -: T{ ; \\ ( -- ) SYNTACTIC SUGAR. - -: -> \\ ( ... -- ) RECORD DEPTH AND CONTENT OF STACK. - DEPTH DUP ACTUAL-DEPTH ! \\ RECORD DEPTH - ?DUP IF \\ IF THERE IS SOMETHING ON STACK - 0 DO ACTUAL-RESULTS I CELLS + ! LOOP \\ SAVE THEM - THEN ; - -: }T \\ ( ... -- ) COMPARE STACK (EXPECTED) CONTENTS WITH SAVED (ACTUAL) CONTENTS. - DEPTH ACTUAL-DEPTH @ = IF \\ IF DEPTHS MATCH - DEPTH ?DUP IF \\ IF THERE IS SOMETHING ON THE STACK - 0 DO \\ FOR EACH STACK ITEM - ACTUAL-RESULTS I CELLS + @ \\ COMPARE ACTUAL WITH EXPECTED - = 0= 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 [CHAR] * EMIT - THEN ; -`; diff --git a/src/web/tests/suite.js b/src/web/tests/suite.js index 9753bec..a0cd4a6 100644 --- a/src/web/tests/suite.js +++ b/src/web/tests/suite.js @@ -1,7 +1,7 @@ import WAForth from "../WAForth"; -import sieve from "../sieve"; -import standardTestSuiteTester from "./standard-testsuite/tester.f"; -import standardCoreWordsTestSuite from "./standard-testsuite/core.f"; +import sieve from "../../examples/sieve.f"; +import standardTestSuiteTester from "../../standard-testsuite/tester.f"; +import standardCoreWordsTestSuite from "../../standard-testsuite/core.f"; import { expect, assert } from "chai"; function loadTests() { diff --git a/test-web.js b/test-web.js index 8511cf2..72a05f2 100755 --- a/test-web.js +++ b/test-web.js @@ -5,6 +5,7 @@ const esbuild = require("esbuild"); const path = require("path"); const { wasmTextPlugin } = require("./scripts/esbuild/wasm-text"); const Mocha = require("mocha"); +const { forthPlugin } = require("./scripts/esbuild/forth"); let watch = false; for (const arg of process.argv.slice(2)) { @@ -34,7 +35,7 @@ let buildConfig = { ".wasm": "binary", }, sourcemap: true, - plugins: [wasmTextPlugin()], + plugins: [wasmTextPlugin(), forthPlugin()], ...(watch ? { watch: {