ACCOV
: FICHIERS
DES TRAVAUX PRATIQUES
fichier global.ads
-- ========================================================
--
<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-- SCHEMA PRODUCTEUR CONSOMMATEUR IMPLANTE PAR UN OBJET PROTEGE
-- paquetage de declarations generales: .ads
-- =============================================
package Global is
type Message is new Integer;
type UnOuDeux is new Integer range 1 .. 2;
type Tab_Message is array (UnOuDeux range <>) of
Message;
end Global;
fichier stock.ads
-- ========================================================
--
<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-- SCHEMA PRODUCTEUR CONSOMMATEUR IMPLANTE PAR UN OBJET PROTEGE
-- paquetage de declaration : .ads
-- =============================================
with Global; use Global;
package Stock is
procedure Deposer_Un (X : in Message);
procedure Retirer_Un (X : out Message);
procedure Deposer_Deux (X, Y : in Message);
procedure Retirer_Deux (X, Y : out Message);
procedure Deposer (Z : in Tab_Message);
procedure Retirer (Z : out Tab_Message);
end Stock;
fichier prod_cons.adb
-- ========================================================
--
<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-- SCHEMA PRODUCTEUR CONSOMMATEUR IMPLANTE PAR UN OBJET PROTEGE
-- programme principal: .ads
-- =============================================
with Global; use Global;
with Stock; use Stock;
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Exceptions; use Ada.Exceptions;
procedure Prod_Cons is
task Premier_Producteur; task Second_Producteur;
task Premier_Consommateur; task Second_Consommateur;
task body Premier_Producteur is
M : Message;
Mon_Message : Tab_Message (1 .. 1);
begin
for I in 1 .. 16 loop
M := Message (I);
Put_Line ("Le
Premier_Producteur envoie " & Message'Image (M));
Deposer_Un (M);
Put_Line ("Le
Premier_Producteur envoie a nouveau " & Message'Image (M));
Mon_Message (1) := M;
-- Deposer
(Mon_Message);
end loop;
Put_Line ("Le Premier_Producteur a
fini");
exception
when others =>
Put_Line ("Erreur dans
premier prod");
end Premier_Producteur;
task body Second_Producteur is
M, N : Message;
Mon_Message : Tab_Message (1 .. 2);
begin
for I in 1 .. 16 loop
M := Message (I);
N := 2*Message (I);
Put_Line ("Le
second_Producteur envoie " & Message'Image (M) & Message'Image
(N));
-- Deposer_Deux (M, N);
Put_Line ("Le
second_Producteur envoie a nouveau " & Message'Image (M) &
Message'Image (N));
Mon_Message (1) := M;
Mon_Message (2) := N;
-- Deposer
(Mon_Message);
end loop;
Put_Line ("Le Second_Producteur a fini");
exception
when others =>
Put_Line ("Erreur dans
second prod");
end Second_Producteur;
task body Premier_Consommateur is
M : Message;
Mon_Message : Tab_Message (1 .. 1);
begin
for I in 1 .. 16 loop
Retirer_Un (M);
Put_Line ("Le
Premier_Consommateur a recu " & Message'Image (M));
-- Retirer
(Mon_Message);
-- M := Mon_Message
(1);
-- Put_Line ("Le
Premier_Consommateur a recu autrement " & Message'Image (M));
end loop;
Put_Line ("Le Premier_Consommateur a
fini");
exception
when The_Error : others =>
Put_Line
(Ada.Exceptions.Exception_Name (The_Error));
Put_Line
(Ada.Exceptions.Exception_Message (The_Error));
Put_Line ("Erreur dans
premier cons");
end Premier_Consommateur;
task body Second_Consommateur is
M, N : Message;
Mon_Message : Tab_Message (1 .. 2);
begin
for I in 1 .. 16 loop
-- Retirer_Deux
(M, N);
-- Put_Line ("Le
Second_Consommateur a recu " & Message'Image (M) &
Message'Image (N));
-- Retirer
(Mon_Message); M := Mon_Message (1); N := Mon_Message (2);
-- Put_Line ("Le
second_Consommateur a recu autrement " & Message'Image (M) &
Message'Image (N));
null;
end loop;
Put_Line ("Le Second_Producteur a fini");
exception
when others =>
Put_Line ("Erreur dans
second cons");
end Second_Consommateur;
begin
null;
end Prod_Cons;
fichier stock.adb
-- ========================================================
--
<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-- SCHEMA PRODUCTEUR CONSOMMATEUR IMPLANTE PAR UN OBJET PROTEGE
-- paquetage de realisation : .adb
-- =============================================
package body Stock is
N : constant := 8;
type Index is mod N;
type Tab_Mess is array (Index) of Message;
protected Tampon is
entry Poser_Un (X : in Message);
entry Tirer_Un (X : out Message);
entry Poser_Deux (X, Y : in Message);
entry Tirer_Deux (X, Y : out Message);
entry Poser (Z : in Tab_Message);
entry Tirer (Z : out Tab_Message);
private
A : Tab_Mess;
T, Q : Index := Index'First;
Nombre : Integer range 0 .. N := 0;
entry Poser_Bis (Z : in Tab_Message);
entry Tirer_Bis (Z : out Tab_Message);
end Tampon;
protected body Tampon is
entry Poser_Un (X : in Message) when
Nombre < N is
-- variante when
Nombre < N and Poser_Deux'Count = 0 is
begin
A (Q) := X;
Q := Q + 1; Nombre :=
Nombre + 1;
end Poser_Un;
entry Tirer_Un (X : out Message) when
Nombre > 0 is
-- variante when
Nombre > 0 and Tirer_Deux'Count = 0 is
begin
X := A (T);
T := T + 1; Nombre :=
Nombre - 1;
end Tirer_Un;
entry Poser_Deux (X, Y : in Message)
when Nombre < N - 1 is
begin
null;
end Poser_Deux;
entry Tirer_Deux (X, Y : out
Message) when Nombre > 1 is
begin
null;
end Tirer_Deux;
entry Poser (Z : in Tab_Message) when
Nombre < N is
begin
null;
end Poser;
entry Poser_Bis (Z : in Tab_Message)
when Nombre < N is
begin
null;
end Poser_Bis;
entry Tirer (Z : out Tab_Message)
when Nombre > 0 is
begin
null;
end Tirer;
entry Tirer_Bis (Z : out
Tab_Message) when Nombre > 0 is
begin
null;
end Tirer_Bis;
end Tampon;
procedure Deposer_Un (X : in Message) is
begin
Tampon.Poser_Un (X);
end Deposer_Un;
procedure Retirer_Un (X : out Message) is
begin
Tampon.Tirer_Un (X);
end Retirer_Un;
procedure Deposer_Deux (X, Y : in Message) is
begin
Tampon.Poser_Deux (X, Y);
end Deposer_Deux;
procedure Retirer_Deux (X, Y : out Message) is
begin
Tampon.Tirer_Deux (X, Y);
end Retirer_Deux;
procedure Deposer (Z : in Tab_Message) is
begin
Tampon.Poser (Z);
end Deposer;
procedure Retirer (Z : out Tab_Message) is
begin
Tampon.Tirer (Z);
end Retirer;