sieve stuff for testing, original files and the working disk image.

[bif-6809/bif-6809.git] / testsource / rs_sieve.fs

diff --git a/testsource/rs_sieve.fs b/testsource/rs_sieve.fs
new file mode 100644 (file)
index 0000000..e46782a
--- /dev/null
+++ b/testsource/rs_sieve.fs
@@ -0,0 +1,23 @@
+( from rosetta code )
+: prime? ( n -- ? ) HERE + C@ 0= ;
+: composite! ( n -- ) HERE + 1 SWAP C! ;
+( : 2dup OVER OVER ; )
+
+: sieve ( n -- )
+  HERE OVER ERASE
+  2
+  BEGIN
+    2dup DUP * >
+  WHILE
+    DUP prime? IF
+      2dup DUP * DO
+        I composite!
+      DUP +LOOP
+    ENDIF
+    1+
+  REPEAT
+  DROP
+(  ." Primes: " 2 DO I prime? IF I . ENDIF LOOP ) ;
+
+100 sieve
+