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

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

diff --git a/testsource/sievegforth.fs b/testsource/sievegforth.fs
new file mode 100644 (file)
index 0000000..d008b20
--- /dev/null
+++ b/testsource/sievegforth.fs
@@ -0,0 +1,62 @@
+( Archetypical implementation of the sieve of eratosthenes in FORTH -- gforth --
+\ Copyright Joel Rees, 2015
+\ By Joel Rees, Amagasaki, Japan, 2015
+\ All rights reserved.
+\ Permission granted by the author to use this code
+\ for any purpose, 
+\ on condition that substantial use 
+\ shall retain this copyright and permission notice.
+\
+\ Timing results with MAXSIEVE set to 4194304 and output commented out:
+\ me@fun:~/work/mathgames/sieve$ time gforth forthsieve.fs -e bye
+
+\ real 0m1.061s
+\ user 0m0.988s
+\ sys 0m0.012s
+\
+\ Comparing to the C:
+\
+\ me@fun:~/work/mathgames/sieve$ time ./sieve_c
+\ 
+\ real    0m0.457s
+\ user    0m0.436s
+\ sys    0m0.020s
+\
+\ A bit more than double the run-times, 
+\ so, really, in the same ballpark,
+
+\ if not quite in the same league for speed.
+)
+
+
+256 constant MAXSIEVE
+MAXSIEVE 1- 2 / constant FINALPASS
+
+5 constant DISPWIDTH ( enough digits to display MAXSIEVE )
+
+create sieve MAXSIEVE allot
+
+
+: sieveMain ( -- )
+0 sieve c!      ( 0 is not prime. )
+0 sieve 1+ c!   ( 1 is not prime. )
+sieve MAXSIEVE 2 ?do    ( set flags to true for 2 to FINALPASS. )
+   -1 over i + c! loop  ( sieve pointer remains on stack. ) 
+FINALPASS 2 ?do ( clear flags at all multiples. )
+   dup i + c@ if      ( don't bother if not prime. )
+      MAXSIEVE i dup + ?do    ( start at first multiple -- double. )
+         0 over i + c!      ( clear at this multiple. )
+      j +loop           ( sieve still on stack. )
+   then
+loop            ( sieve still on stack. )
+MAXSIEVE 0 ?do
+   i DISPWIDTH .r ." : is "
+   dup i + c@ 0= if 
+      ." not " 
+   then
+   ." prime." cr
+loop drop ;
+
+sieveMain
+
+