still trying to make the sieve stuff work.

[bif-6809/bif-6809.git] / testsource / sievefig.bif6809

diff --git a/testsource/sievefig.bif6809 b/testsource/sievefig.bif6809
index 1320e32..cf02aea 100644 (file)
--- a/testsource/sievefig.bif6809
+++ b/testsource/sievefig.bif6809
@@ -1,28 +1,28 @@
-( Archetypical implementation )
-( of the sieve of eratosthenes )
-( in FORTH -- fig, bif-c --  )
-( using more )
-( of the FORTH idiom. )
-( Copyright 2015, 2019,
-( Joel Matthew Rees )
-( By Joel Matthew 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. )
-
-
-
-VOCABULARY sieve-local 
-( Make a local symbol table. )
-sieve-local DEFINITIONS 
-( Switch to the )
-( local vocabulary. )
+( ARCHETYPICAL IMPLEMENTATION )
+( OF THE SIEVE OF ERATOSTHENES )
+( IN FORTH -- BIF, FIG --  )
+( USING A LITTLE MORE )
+( OF THE FORTH AND BIF IDIOMS. )
+( COPYRIGHT 2015, 2019,
+( JOEL MATTHEW REES )
+( BY JOEL MATTHEW 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. )
+
+( PERL-ESQUE, TOO. )
+
+VOCABULARY SIEVE-LOCAL 
+( MAKE A LOCAL SYMBOL TABLE. )
+SIEVE-LOCAL DEFINITIONS 
+( SWITCH TO THE )
+( LOCAL VOCABULARY. )
 
 
 256 CONSTANT MAXSIEVE
@@ -32,92 +32,60 @@ MAXSIEVE 1 - 2 /
 
 
 5 CONSTANT DISPWIDTH 
-( enough digits )
-( to display MAXSIEVE )
+( ENOUGH DIGITS )
+( TO DISPLAY MAXSIEVE )
 
 
-0 VARIABLE sieve 
-( Old FORTHs don't provide a ) 
-( default behavior for CREATE )
-( gforth will leave )
-( the zero there. )
-( Old FORTHs need )
-( an initial value. )
-
-   HERE sieve - DUP 
-( Old FORTHs don't provide )
-( a CELL width. )
-   MAXSIEVE SWAP - ALLOT 
-( Allocate the rest )
-( of the byte array. )
+0 VARIABLE SIEVE 
+( OLD FORTHS DON'T PROVIDE A ) 
+( DEFAULT BEHAVIOR FOR CREATE )
+( GFORTH WILL LEAVE )
+( THE ZERO THERE. )
+( OLD FORTHS NEED )
+( AN INITIAL VALUE. )
 
+   HERE SIEVE -
+( OLD FORTHS DON'T PROVIDE )
+( A CELL WIDTH. )
    CONSTANT CELLWIDTH 
-( To show how it can be done. )
-
-  -->
-
-
-
-
-
-
-
-
-: sieveInit ( -- adr )
-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 -- )
-( still on stack. )
-;
-
- -->
-
-
-
-
-
-
-
-
-
-
-
+( TO SHOW HOW IT CAN BE DONE. )
 
+CELLWIDTH MAXSIEVE SWAP - ALLOT 
+( ALLOCATE THE REST )
+( OF THE BYTE ARRAY. )
 
+: NOT-PRIME! ( ADR N -- )
++ 0 SWAP ! ;
 
+: IS-PRIME? ( ADR N -- F )
++ @ ;
+  -->
 
 
+: SIEVE-INIT ( ADR -- )
+0 OVER C!      
+( 0 IS NOT PRIME. )
+0 OVER 1+ C!   
+( 1 IS NOT PRIME. )
+( SET FLAGS TO TRUE )
+( FOR 2 TO FINALPASS. )
+2+ MAXSIEVE 2- -1 FILL    
+ ;
 
 
-: primePass ( adr prime -- adr )
+: PRIME-PASS ( ADR PRIME -- )
+(  DOUBLE IS FIRST MULTIPLE )
 MAXSIEVE OVER DUP + DO    
-( start at first multiple )
-(  -- double. )
-   OVER I + 0 SWAP C!     
-( clear at this multiple. )
-   DUP +LOOP              
-( next multiple )
+   OVER I NOT-PRIME!    
+   DUP +LOOP ( NEXT MULTIPLE )
 DROP ;      
-( sieve address still )
-( on stack. )
 
-: findPrimes ( adr -- adr )
+: FIND-PRIMES ( ADR -- )
 FINALPASS 2 DO   
-( clear flags )
-( at all multiples. )
-   DUP I + C@ IF 
-( don't bother if not prime. )
-      I primePass
+   DUP I IS-PRIME? IF 
+      I PRIME-PASS
    ENDIF
 LOOP ;           
-( sieve still on stack. )
-
 
 -->
 
@@ -126,29 +94,49 @@ LOOP ;
 
 
 
+: COUNT-PRIMES ( ADR -- )
+." COUNT: " .
+0 SWAP
+MAXSIEVE 0 DO
+   DUP I IS-PRIME? IF
+      SWAP 1+ SWAP
+   ENDIF
+LOOP DROP CR
+ ;
 
 
+: PRINT-ALL ( ADR -- )
+MAXSIEVE 0 DO
+   I DISPWIDTH .R ." : IS "
+   DUP I IS-PRIME? 0= IF
+      ." NOT "
+   ENDIF
+   ." PRIME." CR
+LOOP 
+DROP ;
 
 
-
-: printPrimes ( adr -- )
+: PRINT-PRIMES ( ADR -- )
 MAXSIEVE 0 DO
-   I DISPWIDTH .R ." : is "
-   DUP I + C@ 0= IF
-      ." not "
-   ENDIF
-   ." prime." CR
-LOOP DROP ;
+   DUP I IS-PRIME? 
+   IF . ENDIF
+LOOP 
+DROP CR ;
+-->
+
+
 
 
-FORTH DEFINITIONS
+BIF   DEFINITIONS
 
-: sieveMain ( -- )
-[ sieve-local ] sieveInit
-findPrimes
-printPrimes ;
+: SIEVEMAIN ( -- )
+[ SIEVE-LOCAL ]
+SIEVE SIEVE-INIT
+SIEVE FIND-PRIMES
+SIEVE PRINT-PRIMES
+SIEVE COUNT-PRIMES ;
 
 
-sieveMain
+SIEVEMAIN