OSDN Git Service

still trying to make the sieve stuff work.
[bif-6809/bif-6809.git] / testsource / sievegforth.bif6809
index 88a68a5..aca59d7 100644 (file)
@@ -1,67 +1,68 @@
-( Archetypical implementation )
-( of the sieve of eratosthenes )
-( in FORTH -- BIF-6809 -- )
-( Copyright 2015, 2019, )
-( Joel Matthew Rees )
-( Written by Joel Mathew Rees, )
-( Amagasaki, Japan, 2015, 2019 )
-( 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. )
+( ARCHETYPICAL IMPLEMENTATION )
+( OF THE SIEVE OF ERATOSTHENES )
+( IN FORTH -- BIF-6809 -- )
+( COPYRIGHT 2015, 2019, )
+( JOEL MATTHEW REES )
+( WRITTEN BY JOEL MATHEW REES, )
+( AMAGASAKI, JAPAN, 2015, 2019 )
+( 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. )
 
-256 constant MAXSIEVE
+256 CONSTANT MAXSIEVE
 MAXSIEVE 1- 2 / 
-  constant FINALPASS
+  CONSTANT FINALPASS
 
-5 constant DISPWIDTH 
-( enough digits )
-( to display MAXSIEVE )
+5 CONSTANT DISPWIDTH 
+( ENOUGH DIGITS )
+( TO DISPLAY MAXSIEVE )
 
-create sieve MAXSIEVE allot
+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 ptr still on stack. ) 
-FINALPASS 2 do 
-( clear flags at 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 ( -- )
+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 PTR STILL ON STACK. ) 
+FINALPASS 2 DO 
+( CLEAR FLAGS AT 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
+SIEVEMAIN