testsource/sievegforth.bif6809

   1 ( ARCHETYPICAL IMPLEMENTATION )
   2 ( OF THE SIEVE OF ERATOSTHENES )
   3 ( IN FORTH -- BIF-6809 -- )
   4 ( COPYRIGHT 2015, 2019, )
   5 ( JOEL MATTHEW REES )
   6 ( WRITTEN BY JOEL MATHEW REES, )
   7 ( AMAGASAKI, JAPAN, 2015, 2019 )
   8 ( ALL RIGHTS RESERVED. )
   9 ( PERMISSION GRANTED BY THE )
  10 ( AUTHOR TO USE THIS CODE )
  11 ( FOR ANY PURPOSE,  )
  12 ( ON CONDITION THAT )
  13 ( SUBSTANTIAL USE  )
  14 ( SHALL RETAIN THIS COPYRIGHT )
  15 ( AND PERMISSION NOTICE. )
  16
  17 256 CONSTANT MAXSIEVE
  18 MAXSIEVE 1- 2 /
  19   CONSTANT FINALPASS
  20
  21 5 CONSTANT DISPWIDTH
  22 ( ENOUGH DIGITS )
  23 ( TO DISPLAY MAXSIEVE )
  24
  25 CREATE SIEVE MAXSIEVE ALLOT
  26
  27  -->
  28
  29
  30
  31
  32
  33 : SIEVEMAIN ( -- )
  34 0 SIEVE C!
  35 ( 0 IS NOT PRIME. )
  36 0 SIEVE 1+ C!
  37 ( 1 IS NOT PRIME. )
  38 SIEVE MAXSIEVE 2 DO
  39 ( SET FLAGS TO TRUE )
  40 ( FOR 2 TO FINALPASS. )
  41    -1 OVER I + C! LOOP
  42 ( SIEVE PTR STILL ON STACK. )
  43 FINALPASS 2 DO
  44 ( CLEAR FLAGS AT MULTIPLES. )
  45    DUP I + C@ IF
  46 ( DON'T BOTHER IF NOT PRIME. )
  47       MAXSIEVE I DUP + ?DO
  48 ( START AT FIRST MULTIPLE )
  49 ( -- DOUBLE. )
  50          0 OVER I + C!
  51 ( CLEAR AT THIS MULTIPLE. )
  52       J +LOOP
  53 ( SIEVE STILL ON STACK. )
  54    THEN
  55 LOOP  ( SIEVE STILL ON STACK. )
  56 MAXSIEVE 0 DO
  57    I DISPWIDTH .R ." : IS "
  58    DUP I + C@ 0= IF
  59       ." NOT "
  60    THEN
  61    ." PRIME." CR
  62 LOOP DROP ;
  63  -->
  64
  65
  66 SIEVEMAIN
  67
  68