OSDN Git Service

The sieve example programs in testsource run, such as they are.
[bif-6809/bif-6809.git] / testsource / sievefig.bif6809
index cf02aea..3aafd2c 100644 (file)
@@ -39,34 +39,33 @@ MAXSIEVE 1 - 2 /
 0 VARIABLE SIEVE 
 ( OLD FORTHS DON'T PROVIDE A ) 
 ( DEFAULT BEHAVIOR FOR CREATE )
-( GFORTH WILL LEAVE )
+( NEW FORTHS 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. )
+  HERE SIEVE - DUP ( CELLWIDTH )
 
-CELLWIDTH MAXSIEVE SWAP - ALLOT 
 ( ALLOCATE THE REST )
 ( OF THE BYTE ARRAY. )
+  MAXSIEVE SWAP - ALLOT 
+
+( NOW DEFINE THE CONSTANT: )
+  CONSTANT CELLWIDTH 
 
 : NOT-PRIME! ( ADR N -- )
-+ 0 SWAP ! ;
++ 0 SWAP C! ;
 
 : IS-PRIME? ( ADR N -- F )
-+ @ ;
++ C@ ;
   -->
 
 
 : SIEVE-INIT ( ADR -- )
-0 OVER C!      
-( 0 IS NOT PRIME. )
-0 OVER 1+ C!   
-( 1 IS NOT PRIME. )
+DUP 0 NOT-PRIME!      
+DUP 1 NOT-PRIME!
 ( SET FLAGS TO TRUE )
 ( FOR 2 TO FINALPASS. )
 2+ MAXSIEVE 2- -1 FILL    
@@ -94,14 +93,15 @@ LOOP ;
 
 
 
+
+
 : COUNT-PRIMES ( ADR -- )
-." COUNT: " .
 0 SWAP
 MAXSIEVE 0 DO
    DUP I IS-PRIME? IF
       SWAP 1+ SWAP
    ENDIF
-LOOP DROP CR
+LOOP DROP
  ;
 
 
@@ -119,7 +119,7 @@ DROP ;
 : PRINT-PRIMES ( ADR -- )
 MAXSIEVE 0 DO
    DUP I IS-PRIME? 
-   IF . ENDIF
+   IF . ENDIF
 LOOP 
 DROP CR ;
 -->
@@ -133,10 +133,15 @@ BIF   DEFINITIONS
 [ SIEVE-LOCAL ]
 SIEVE SIEVE-INIT
 SIEVE FIND-PRIMES
-SIEVE PRINT-PRIMES
-SIEVE COUNT-PRIMES ;
+SIEVE PRINT-PRIMES CR
+." COUNT: "
+SIEVE COUNT-PRIMES . CR ;
 
 
 SIEVEMAIN
 
 
+( 8192: 8 SECONDS TO FIND )
+( 3 TO COUNT )
+( XROAR, NORMAL CLOCK )
+