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

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