|
The lowest index of the array of boolean is set to 2 so that all calculations begin at 2.
<lang GLBasic>// Sieve of Eratosthenes (find primes)
<lang ada>with Ada.Text_Io; use Ada.Text_Io;
// GLBasic implementation
with Ada.Command_Line; use Ada.Command_Line;
with Ada.Numerics.Elementary_Functions; use Ada.Numerics.Elementary_Functions;
procedure Sieve is
package Nat_Io is new Ada.Text_Io.Integer_Io(Natural);
use Nat_Io;
type Bool_Array is array(Positive range <>) of Boolean;
pragma pack (Bool_Array);
GLOBAL n%, k%, limit%, flags%[]
procedure Get_Sieve (A : out Bool_Array) is
Test_Num : Positive;
limit = 100 // search primes up to this number
Limit : Positive := Positive(sqrt(float(A'Last)));
begin
A := (Others => True); -- set all values to true
for Num in A'First..Limit loop
if A(Num) then
Test_Num := Num * Num;
while Test_Num <= A'Last loop
A(Test_Num) := False;
Test_Num := Test_Num + Num;
end loop;
end if;
end loop;
end Get_Sieve;
DIM flags[limit+1] // GLBasic arrays start at 0
pragma Inline(Get_Sieve);
FOR n = 2 TO SQR(limit)
N : Positive := 2;
IF flags[n] = 0
begin
FOR k = n*n TO limit STEP n
if Argument_Count > 0 then
flags[k] = 1
N := Positive'Value(Argument(1));
end if; NEXT
declare ENDIF
NEXT
Vals : Bool_Array(2..N);
begin
// Display the primes
Get_Sieve(Vals);
FOR n = 2 TO limit
for I in Vals'range loop
IF flags[n] = 0 THEN ifSTDOUT Vals(I)n then+ ", "
NEXT
Put_Line(Positive'Image(I));
end if;
end loop;
end;
end Sieve;</lang>
KEYWAIT
This version uses tasking to try to improve the performance on multiprocessor systems which are becoming common. It is still an implementation of the Sieve of Eratosthenes: the list of numbers is in the main task, and the list of primes is in the list of Siever tasks.
</lang>
<lang ada>with Ada.Command_Line;
with Ada.Text_IO;
procedure Sieve is
task type Siever is
entry Check (Value : in Positive);
entry Print;
end Siever;
subtype Siever_Task is Siever;
type Sieve_Ptr is access Siever;
task body Siever is
Number : Positive;
Candidate : Positive;
Next : Sieve_Ptr;
begin -- Siever
accept Check (Value : in Positive) do
Number := Value;
end Check;
All_Values : loop
select
accept Check (Value : in Positive) do
Candidate := Value;
end Check;
if Candidate rem Number /= 0 then
if Next = null then
Next := new Siever_Task;
end if;
Next.Check (Value => Candidate);
end if;
or
accept Print do
Ada.Text_IO.Put (Item => Integer'Image (Number) );
if Next /= null then
Next.Print;
end if;
end Print;
exit All_Values;
end select;
end loop All_Values;
end Siever;
Head : Sieve_Ptr := new Siever;
Max : Positive := 20;
begin -- Sieve
if Ada.Command_Line.Argument_Count > 0 then
Max := Integer'Value (Ada.Command_Line.Argument (1) );
end if;
All_Values : for I in 2 .. Max loop
Head.Check (Value => I);
end loop All_Values;
Head.Print;
end Sieve;</lang>
This version is the same as the previous version, but with a wheel of 2.
<lang ada>with Ada.Command_Line;
with Ada.Text_IO;
procedure Sieve_With_Wheel is
task type Siever is
entry Check (Value : in Positive);
entry Print;
end Siever;
subtype Siever_Task is Siever;
type Sieve_Ptr is access Siever;
task body Siever is
Number : Positive;
Candidate : Positive;
Next : Sieve_Ptr;
begin -- Siever
accept Check (Value : in Positive) do
Number := Value;
end Check;
All_Values : loop
select
accept Check (Value : in Positive) do
Candidate := Value;
end Check;
if Candidate rem Number /= 0 then
if Next = null then
Next := new Siever_Task;
end if;
Next.Check (Value => Candidate);
end if;
or
accept Print do
Ada.Text_IO.Put (Item => Integer'Image (Number) );
if Next /= null then
Next.Print;
end if;
end Print;
exit All_Values;
end select;
end loop All_Values;
end Siever;
Head : Sieve_Ptr := new Siever;
Max : Positive := 20;
Value : Positive := 3;
begin -- Sieve_With_Wheel
if Ada.Command_Line.Argument_Count > 0 then
Max := Integer'Value (Ada.Command_Line.Argument (1) );
end if;
All_Values : loop
exit All_Values when Value > Max;
Head.Check (Value => Value);
Value := Value + 2;
end loop All_Values;
Ada.Text_IO.Put (Item => " 2");
Head.Print;
end Sieve_With_Wheel;</lang>
=={{header|ALGOL 68}}==
|