Program Listing

Compiler:  Open PL/I 08.00.B2 - Copyright (c) 2009 Micro Focus (IP) Limited
Date/Time: December 11, 2009 (15:35:27)
File:      primes.pl1
Directory: C:\Program Files\Micro Focus\Open PLI 8.0\EXAMPLES\OPEN-PLI
Options:   deb l noopt Pentium obj primes.obj list primes.lst
       1   /* Sieve of Eratosthenes: Copyright (c) 2009 Micro Focus (IP) Limited */
       2   
       3   primes: procedure options (main);
       4   
       5   %replace FALSE      by '0'B;
       6   %replace TRUE       by '1'B;
       7   
       8   %replace MAX_VALUE  by 1000;
       9   %replace MAX_PRIMES by  500;
      10   
      11   
      12   read_input: procedure (maxv);
      13   
      14       declare maxv fixed binary(31);
      15       declare instring char(4) varying;
      16   
      17       declare ok bit(1);
      18   
      19       ok = FALSE;
      20   
      21       do while (^ok);
      22           put list ('Input maximum prime boundary:');
      23           put skip;
      24           get list (instring);
      25           maxv = decimal(instring);
      26           if maxv > MAX_VALUE then do;
      27               put list ('Value too big.  Try again.');
      28               put skip;
      29           end;
      30           else do;
      31               ok = TRUE;
      32           end;
      33       end;
      34           
      35   end read_input;
      36   
      37   isprime: procedure (number,values,total) returns (fixed binary(31));
      38   
      39       declare number                fixed binary(31),
      40                   values(1:MAX_PRIMES)  fixed binary(31),
      41           total                 fixed binary(31);
      42       declare n                     fixed binary(31);
      43   
      44           do n = 1 to total;
      45           if number = values(n) then
      46                  return (number);
      47           end; 
      48   
      49           return(-1);
      50   
      51   end isprime;
      52   
      53   print_out: procedure (values,total);
      54   
      55       declare values(1:MAX_PRIMES) fixed binary(31),
      56           total                fixed binary(31);
      57   
      58       declare i fixed binary(15);
      59   
      60       put list ('Number of primes found was');
      61       if isprime (total,values,total) >= 0 then
      62           put list(' (prime itself)');
      63       put edit (total) (F(4));
      64       put skip (2);
      65   
      66       do i = 1 to total;
      67           put edit (values(i)) (F(7));
      68           if mod(i,10) = 0 then do;
      69               put skip;
      70           end;
      71       end;
      72   
      73       put skip (2);
      74   
      75   end print_out;
      76   
      77   sift: procedure (n);
      78   
      79       declare n fixed binary(31);
      80   
      81       declare (i, k, count, this_prime) fixed binary(31),
      82           flags(1:MAX_VALUE) bit(1),
      83           primes(1:MAX_PRIMES) fixed binary(31);
      84   
      85       do i = 1 to n;
      86           flags(i) = TRUE;
      87       end;
      88   
      89       count = 1;
      90       primes(1) = 1;
      91   
      92       do i = 1 to n;
      93           if flags(i) = TRUE then do;
      94               this_prime = i + 1;
      95               count = count + 1;
      96               primes(count) = this_prime;
      97               k = i + this_prime;
      98               do while (k < n);
      99                   /* cancel all multiples */
     100                   flags(k) = FALSE;
     101                   k = k + this_prime;
     102               end;
     103           end;
     104       end;
     105       call print_out(primes,count);  /* should be count - 1 */
     106   
     107   end sift;
     108   
     109       /* main procedure */
     110   
     111       declare n fixed binary(31);
     112   
     113       put skip;
     114       put list ('*** Sieve of Eratosthenes ***');
     115       put skip (2);
     116   
     117       call read_input(n);
     118   
     119       do while (n > 1);
     120           call sift(n);
     121           call read_input(n);
     122       end;
     123   
     124   end;