Irgendwann will jeder Architekt eine
Kathedrale bauen und nicht mehr die
Abwasserleitungen in einem Slum reparieren!
First Tasking - Beispiel Programm mit zwei Ada-Tasks
In dem Beispielprogramm "First Tasking" werden zwei Ada-Tasks definiert.
Beide Tasks werden vom Hauptprogramm "First Tasking" im Abstand von einer Sekunde gestartet.
Die "First Task" gibt im Abstand von 2 Sekunden 10 mal den Text "First Task" aus.
Die "Second Task" gibt im Abstand von 1 Sekunde 20 mal den Text "Second Task" aus.
with Ada.Text_IO,
Ada.Exceptions;
procedure First_Tasking is
use Ada.Text_IO,
Ada.Exceptions;
-- task specification
task First_Task is
entry Start;
end First_Task;
-- task implementation
task body First_Task is
begin
accept Start;
Put_Line ("First Task Started!");
for index in 1 .. 10
loop
delay 2.0;
Put_Line ("First Task");
end loop;
end First_Task;
-- task specification
task Second_Task is
entry Start;
end Second_Task;
-- task implementation
task body Second_Task is
begin
accept Start;
Put_Line ("Second Task Started!");
for index in 1..20
loop
delay 1.0;
Put_Line ("Second Task");
end loop;
end Second_Task;
begin
First_Task.Start;
delay 1.0;
Second_task.Start;
exception
when Error: others =>
Put_Line ( "Exception_Name: " & Ada.Exceptions.Exception_Name (Error) );
Put_Line ( "Exception_Message: " & Ada.Exceptions.Exception_Message (Error) );
Put_Line ( "Exception_Information: " & Ada.Exceptions.Exception_Information (Error) );
end First_Tasking;
Beispiel Programm: Start und Stop einer Ada-Task durch Eingabe von Kommandos in der Kommandozeile
Dieses Programm verwendet das Paket:
Command_Line Generic.
Die Ein- und Ausgabe der Kommandos erfolgt über dieses Paket.
with Ada.Text_IO,
Ada.Exceptions,
Command_Line_Generic;
procedure Tasking_Example is
use Ada.Text_IO,
Ada.Exceptions;
-- specification of a task type
task type Task_Example_Type is
entry Start;
entry Stop;
end Task_Example_Type;
-- valid commands that can be entered through the command line
type Command_Type is (Start, Stop, Exit_Program);
-- implementation of the used task type
task body Task_Example_Type is
Exit_Main : boolean := False;
Command : Command_Type := Stop;
begin
Main : loop
select
accept Start;
or
terminate;
end select;
delay 0.5;
New_Line;
Put_Line ("Start Looping");
Periodic : loop
select
accept Stop;
exit Periodic;
or
delay 5.0;
end select;
Put_Line ("Looping.");
end loop Periodic;
delay 0.5;
New_Line;
Put_Line ("Looping Stopped");
end loop Main;
end Task_Example_Type;
-- Definition of the used task
Task_Example : Task_Example_Type;
-- The mode of the Task is defined by the following variable.
-- This variable and the mode of the Ada-Task will be controlled by
-- the function Handle_Command
Mode : Command_Type := Stop;
-- definition of the function, that controls the execution of a command
function Handle_Command (Command : in Command_Type) return boolean is
begin
case Command is
when Start => if Mode = Stop then
Task_Example.Start;
Mode := Start;
return true;
end if;
when Stop => if Mode = Start then
Task_Example.Stop;
Mode := Stop;
return true;
end if;
when Exit_Program => case Mode is
when Start =>
Task_Example.Stop;
Mode := Stop;
return false;
when others =>
Mode := Exit_Program;
return false;
end case;
end case;
return true;
end;
package Command_Line is new Command_Line_Generic ( Command_Type => Command_Type,
Handle_Command => Handle_Command );
begin
Command_Line.Get_Command;
exception
when Error: others =>
Put_Line ( "Exception_Name: " & Ada.Exceptions.Exception_Name (Error) );
Put_Line ( "Exception_Message: " & Ada.Exceptions.Exception_Message (Error) );
Put_Line ( "Exception_Information: " & Ada.Exceptions.Exception_Information (Error) );
end Tasking_Example;
Buffer Implementations: Task or Protected Type |
|
|
In Ada83 war es notwendig, Buffer Tasks zu implementieren, um zu verhindern,
das sich zwei Tasks beim warten auf den Datenaustausch gegenseitig blockieren.
Paket Spezifikation Buffer_Generic
generic
type Message_Type is private;
Storage_Size : Positive := 10;
package Buffer_Generic is
task type Buffer_Task_Type is
entry Write ( Message : in Message_Type );
entry Read ( Message : out Message_Type );
end Buffer_Task_Type;
end Buffer_Generic;
Paket Body Buffer_Generic
package body Buffer_Generic is
task body Buffer_Task_Type is
type Storage_Element_Type is
record
Message : Message_Type;
Empty : Boolean := True;
end record;
type Storage_Type is array (1 .. Storage_Size) of Storage_Element_Type;
Storage : Storage_Type;
Read_Index : Integer := 1;
Write_Index : Integer := 1;
begin
loop
select
when Storage (Write_Index).Empty =>
accept Write (Message : in Message_Type) do
Storage (Write_Index).Message := Message;
end Write;
Storage (Write_Index).Empty := False;
Write_Index := Write_Index + 1;
if Write_Index > Storage_Size then
Write_Index := 1;
end if;
or
when not Storage (Read_Index).Empty =>
accept Read (Message : out Message_Type) do
Message := Storage (Read_Index).Message;
end Read;
Storage (Read_Index).Empty := True;
Read_Index := Read_Index + 1;
if Read_Index > Storage_Size then
Read_Index := 1;
end if;
or
terminate;
end select;
end loop;
exception
when Error: others =>
Put_Line ("Exception_Name: " & Ada.Exceptions.Exception_Name ( Error ) );
Put_Line ("Exception_Message: " & Ada.Exceptions.Exception_Message ( Error ) );
Put_Line ("Exception_Information: " & Ada.Exceptions.Exception_Information ( Error ) );
end Buffer_Task_Type;
end Buffer_Generic;
Seit Ada95 ist es möglich Protected Types für den Datenaustausch zwischen Tasks zu verwenden.
Paket Spezifikation Bounded Buffer Generic
generic
type Message_Type is private;
Storage_Size : Positive := 10;
package Bounded_Buffer_Generic is
type Message_Array_Type is array (1..Storage_Size) of Message_Type;
protected type Bounded_Buffer_Type is
entry Write ( Message : in Message_Type );
entry Read ( Message : out Message_Type );
private
Message_Array : Message_Array_Type;
I, J : Integer range 1..Storage_Size := 1;
Count : Integer range 0..Storage_Size := 0;
end Bounded_Buffer_Type;
end Bounded_Buffer_Generic;
Paket Body Bounded Buffer Generic
package body Bounded_Buffer_Generic is
protected body Bounded_Buffer_Type is
entry Write ( Message : in Message_Type ) when Count < Storage_Size is
begin
Message_Array(i) := Message;
I := I mod Storage_size + 1;
Count := Count + 1;
end;
entry Read ( Message : out Message_Type ) when Count > 0 is
begin
Message := Message_Array (J);
J := J mod Storage_size + 1;
Count := Count - 1;
end;
end Bounded_Buffer_Type;
end Bounded_Buffer_Generic;
Test Frame Bounded Buffer Generic
with Ada.Text_IO,
Ada.Exceptions,
Bounded_Buffer_Generic;
procedure Protected_Type_Example is
use Ada.Text_IO,
Ada.Exceptions;
package Integer_Buffer_Package is new Bounded_Buffer_Generic
( Message_Type => Integer,
Storage_Size => 5 );
Buffer : Integer_Buffer_Package.Bounded_Buffer_Type;
Output : integer := 0;
function "&" ( left : String; right : Integer) return String is
begin
return left & integer'image(right);
end;
begin
Put_Line ("begin Protected_Type_Example");
Buffer.Write (7);
buffer.read (Output);
Put_Line ( "Output: " & Output );
Put_Line ("end Protected_Type_Example");
end Protected_Type_Example;
Beispiel Datenstruckturen |
|
|
Array von Prozeduren
with Ada.Text_IO,
Ada.Exceptions;
procedure Procedure_Pointer_Example is
use Ada.Text_IO,
Ada.Exceptions;
type Procedure_Access is access Procedure;
procedure Monday is
begin
Put_Line ("Monday");
end Monday;
procedure Tuesday is
begin
Put_Line ("Tuesday");
end Tuesday;
procedure Not_Defined is
begin
Put_Line ("Not_Defined");
end Not_Defined;
type Procedure_Array_Type is array (1..4) of Procedure_Access;
Procedure_Array : Procedure_Array_Type := ( 1 => Monday'access,
2 => Tuesday'access,
others => Not_Defined'access );
begin
Put_Line ("begin Procedure_Pointer_Example");
for index in Procedure_Array'range
loop
Procedure_Array(index).all;
end loop;
Put_Line ("end Procedure_Pointer_Example");
exception
when Error: others =>
Put_Line ( "Exception_Name: " & Ada.Exceptions.Exception_Name (Error) );
Put_Line ( "Exception_Message: " & Ada.Exceptions.Exception_Message (Error) );
Put_Line ( "Exception_Information: " & Ada.Exceptions.Exception_Information (Error) );
end Procedure_Pointer_Example;
25. September 2012 Version 1.0