git.gag.com Git - debian/pforth/blob - fth/siev.fth

   1 \ #! /usr/stud/paysan/bin/forth\r
   2 \r
   3 DECIMAL\r
   4 \ : SECS TIME&DATE  SWAP 60 * + SWAP 3600 * +  NIP NIP NIP ;\r
   5 CREATE FLAGS 8190 ALLOT\r
   6 variable eflag\r
   7 \ FLAGS 8190 + CONSTANT EFLAG\r
   8 \r
   9 \ use secondary fill like pForth   !!!\r
  10 : FILL { caddr num charval -- }\r
  11         num 0\r
  12         ?DO\r
  13                 charval caddr i + c!\r
  14         LOOP\r
  15 ;\r
  16 \r
  17 : PRIMES  ( -- n )  FLAGS 8190 1 FILL  0 3  EFLAG @ FLAGS\r
  18   DO   I C@\r
  19        IF  DUP I + DUP EFLAG @ <\r
  20            IF    EFLAG @ SWAP\r
  21                  DO  0 I C! DUP  +LOOP\r
  22            ELSE  DROP  THEN  SWAP 1+ SWAP\r
  23            THEN  2 +\r
  24        LOOP  DROP ;\r
  25 \r
  26 : BENCHMARK  0 100 0 DO  PRIMES NIP  LOOP ;                       \ !!! ONLY 100\r
  27 \ SECS BENCHMARK . SECS SWAP - CR . .( secs)\r
  28 : main \r
  29         flags 8190 + eflag !\r
  30         benchmark ( . ) drop\r
  31 ;\r