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;