Enseigner Ada, pourquoi ?, à qui ?, comment ? Choisir un langage : entre le tentant et le raisonnable !


précédentsommairesuivant

VIII. Annexes (des exemples et des compléments)

On verra dans cette dernière partie quelques exemples (ou certains développements) illustrant plus finement les arguments développés dans le texte principal. Ces lignes ne sont pas fondamentales pour la compréhension des argumentations mais devraient permettre de mieux les valider.

A. Un exemple de typage

 
Sélectionnez
type T_Température is range -20..55;

créé un famille d'objets numériques entiers dont les valeurs sont contraintes entre les bornes -20 et 55. Ada est fortement typé ce qui interdit de façon implicite les mélanges (accidentels ou voulus). Ainsi :

 
Sélectionnez
Valeur : Integer;       -- instanciation d'un entier prédéfini
Temp   : T_Température; -- instanciation d'un objet de type déclaré
Temp := Valeur; -- erreur
Temp := -25;    -- erreur

Les deux instructions ci dessus sont rejetées par le compilateur. Des conversions sont possibles, elles ne sont pas implicites et doivent être précisées.

 
Sélectionnez
Temp := T_Température (Valeur); -- conversion

est une instruction correcte syntaxiquement. Mais, à l'exécution, une valeur hors de l'intervalle lèvera une exception.

B. Travail au niveau du bit

Le langage C est « proche » de l'implémentation machine ; trop d'ailleurs, comme on l'a vu, si l'on se place dans le domaine du génie logiciel. Malgré cela il est mal commode, en C, de travailler directement au niveau du bit. Il faut en passer par des opérations (masques, xor, etc.) qui font perdre une représentation de haut niveau et nuisent à la lisibilité. Voici un morceau de code Ada permettant de travailler élégamment au niveau du bit tout en gardant un haut niveau d'abstraction. On remarquera l'utilisation de directives spécifiant au compilateur des implémentations particulières (for ... use). En gras les mots réservés du langage.

 
Sélectionnez
type T_Couleur is (Noir, Bleu, Vert, Cyan, Rouge, Magenta, Marron, Gris, Gris_Sombre,     Bleu_Clair, Vert_Clair, Cyan_Clair, Rouge_Clair, Magenta_Clair, Jaune, Blanc);
for T_Couleur use (0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15);
subtype T_Couleur_Fond is T_Couleur range Noir .. Gris;
type T_Clignotement is (Fixe, Clignotant);
for T_Clignotement use (0, 1); -- on force ainsi l'implémentation
type T_Curseur is record -- déclaration des propriétés d'un curseur
    Aspect  : T_Clignotement;
    Arrière : T_Couleur_Fond;
    Devant  : T_Couleur;
end record;
for T_Curseur use record  -- on impose un octet (bits 0 à 7)
    Aspect  at 0 range 0..0; -- bit 0
    Arrière at 0 range 1..3; -- bits 1 à 3 
    Devant  at 0 range 4..7; -- bits 4 à 7
end record;

Une instruction du style : Mon_Curseur.Aspect := Fixe; permet de modifier directement le bit n 0 de l'octet avec l'effet voulu. Ainsi que : Mon_Curseur.Aspect := Clignotement; On travaille ainsi directement sur le bit à l'insu de son plein gré !

C. Compléments interfaçage avec C.

L'interfaçage Ada avec C oblige le programmeur Ada à utiliser des nouveaux types mais compatibles C. Par exemple : int, short, long sont trois identificateurs de nouveaux types entiers Ada « compatibles » C. Le lecteur qui connaît les identificateurs des 3 types primitifs C équivalents constatent que les 3 identificateurs Ada ont été choisis identiques, en effet, ces identificateurs n'existent pas en Ada (ce sont Integer, Short_Integer et Long_Integer). C'est une bonne idée « mnémonique » ! Pour les types réels en virgule flottante on trouve C_float, double, long_double. Dans cet exemple le premier identificateur ne peut prendre son label C habituel : float pour éviter une confusion avec le type prédéfini Ada Float de même identificateur. Il sera donc nommé C_float. Les deux autres sont identiques à leur homologue C (car en Ada pas de confusion : Long_Float et Long_Long_Float). On notera aussi char et char_array. Respectivement char pour définir des « sortes » de Character et char_array pour définir des tableaux de caractères (String) ; char n'existant pas en Ada est utilisé. On notera aussi dans la bibliothèque (paquetage Interfaces.C) les fonctions To_C et To_Ada (respectivement) qui permettent de convertir des types prédéfinis Ada en leur équivalent Ada compatibles C ou les types Ada compatibles C en types prédéfinis Ada (respectivement).

Un exemple : déclaration d'un procédure Ada réalisée en C (puis utilisation) :

 
Sélectionnez
procedure C_System (Chaine : in Char_Array);
pragma Import (C, C_System, ”system”); 

La procédure Ada C_System est réalisée avec le sous programme C connu system grâce au pragma Import. Ainsi l'instruction Ada : C_System(To_C("ls -l")); permet d'afficher en Ada le répertoire courant Linux. La chaîne de caractères String Ada "ls -l" est convertie (grâce à To_C) en char_array chaîne compatible C et devient paramètre de system qui se substitue à C_System. Notons cependant que cette technique n'est pas celle que l'on utilise traditionnellement en Ada pour lancer une commande, en effet, une bibliothèque existe pour cela. Mais l'exemple est assez concis et significatif pour la compréhension de l'interfaçage (nous semble-t-il !).

D. Exemples de lisibilité

Ada est plutôt réputé verbeux (moins que Cobol tout de même !) mais c'est une qualité quand cette verbosité permet de relire facilement du code ou le faire partager. Voici deux exemples l'un très simple le deuxième un peu plus compliqué.

Premier exemple : comparons : une instruction Ada (en première ligne) puis son équivalent en C (deuxième ligne).

 
Sélectionnez
Vect(5..7) := Vect(10..12); -- affectation d'une tranche de tableau
memcpy (vect+5,vect+10,3*sizeof(*vect));

Quelle instruction est la plus lisible ? On remarque sur la deuxième ligne (mais c'est bien connu) que le développeur C est très préoccupé par la représentation mémoire alors qu'en Ada c'est le compilateur qui fera l'implémentation, à son idée, sans intervention du programmeur. Voir aussi plus haut l'exemple permettant de travailler au niveau du bit en Ada où l'instruction Mon_Curseur.Aspect := Fixe; est fort lisible et dit significativement ce qu'elle fait !

Deuxième exemple : écriture d'un sous programme (Ada puis C) qui place les quatre derniers caractères d'une chaîne en tête.

 
Sélectionnez
procedure Swap (Str : in out String) is begin
   if Str'length < 4 then return; end if; -- contrôle validité
   Str := Str (Str'Last-3 .. Str'Last) & Str (Str'First .. Str'Last-4);
end Swap;
voidswap (char *str)
{int len = strlen (str);
char *tmp;
if (len < 4) return;
tmp = (char *) malloc (len + 1);
strncpy (tmp, str+len-4, 4);
strncpy (tmp+4, str, len-4);
tmp[len] = '\0';
strcpy (str, tmp);
free (tmp);
}

A noter que dans ces exemples la version Ada n'utilise pas d'allocation dynamique. La construction de la nouvelle chaîne se fait sur la pile.

E. exemple simple de paquetage

Ce petit exemple, forcément simple, de paquetage (P_Date) sert à illustrer les deux paragraphes : encapsulation ainsi que spécifications et réalisation.

Seules les parties spec (ou contrat) seront mises en évidence, le corps (ou réalisation) n'apportant rien aux concepts à illustrer.

 
Sélectionnez
package P_Date is
type T_Mois is (janvier, février, mars, avril, mai, juin, juillet, août, septembre, octobre, novembre, décembre);
subtype T_Numéro is Integer range 1..31;
subtype T_Année  is Integer range 1900..9999; 
type T_Date is private;
procedure Saisir (La_Date : out T_Date);
procedure Editer (La_Date : in  T_Date);
fonction  Quantième (La_Date : in T_Date) return Positive;
fonction  Est_Bissextile (La_Date : in T_Date) return boolean;
................... -- ici d'autres méthodes
Private
type T_Date is record
    Numéro : T_Numéro;
    Mois   : T_Mois;
    Année  : T_Année;
end record;
end P_Date;

Commentaires : le type T_Date est le T.A.D. essentiel : c'est un type article ; il est déclaré dans le paquetage P_Date qui sert d'enveloppe logicielle. Ce type est privé c'est à dire que les trois champs qui le composent sont inaccessibles par contrat. Des méthodes (non déclarées ici) pourraient permettre ces accès. Seules quatre méthodes (pour faire court) sont déclarées dans le paquetage (deux procédures d'entrée sortie et deux fonctions).

F. Exemple de paquetage hiérarchique

Cet exemple reprend le paquetage P_Date précédent en le complétant avec d'autres fonctionnalités dans un paquetage fils P_Date.Suite.

 
Sélectionnez
package P_Date.Suite is
fonction "<"  (Date1, Date2 : in T_Date) return boolean;
fonction ">"  (Date1, Date2 : in T_Date) return boolean;
fonction "<=" (Date1, Date2 : in T_Date) return boolean;
fonction ">=" (Date1, Date2 : in T_Date) return boolean; 
end P_Date.Suite; 

Commentaires : Comme on l'a noté dans l'exemple ci dessus le type T_Date déclaré dans le paquetage P_Date manque de fonctionnalités. Elles peuvent être déclarées plus tard en fonction des besoins des développements sans changer les premières spécifications (naturellement héritées sans dérivation). Ici nous montrons la déclaration des quatre opérateurs relationnels traditionnels. L'opérateur d'égalité n'a pas à être déclaré car il est implicite pour un type article. L'utilisation des ces opérateurs qui sont des surcharges des opérateurs prédéfinis est simple. Exemple :

 
Sélectionnez
Aujourd_hui, Demain : T_Date; -- instanciation de deux dates
if Aujourd_hui > Hier then .....

G. un exemple de classe

Cet exemple reprend le premier exemple de type abstrait de données T_Date en le déclarant (même identificateur) mais dans une enveloppe de classe le paquetage P_Date_Classe. On notera bien qu'en Ada le constructeur class n'existe pas !

 
Sélectionnez
package P_Date_Classe is
type T_Mois is (janvier, février, mars, avril, mai, juin, juillet, août, septembre, octobre, novembre, décembre);
subtype T_Numéro is Integer range 1..31;
subtype T_Année is Integer range 1900..9999;
type T_Date is tagged private; -- racine de la classe
procedure Saisir (La_Date : out T_Date);
procedure Editer (La_Date : in  T_Date);
fonction Quantième (La_Date : in T_Date) return Positive;
fonction  Est_Bissextile (La_Date : in T_Date) return boolean;
................... -- ici d'autres méthodes
Private
type T_Date is tagged record
    Numéro : T_Numéro;
    Mois   : T_Mois;
    Année  : T_Année;
end record;
end P_Date_Classe;

Commentaires : pratiquement aucune différence sauf le mot tagged qui transforme le T.A.D en classe ! Mais bien sûr c'est une autre approche où l'on postule, a priori, une extension possible de la structure de données.

Voyons maintenant le côté extension (par dérivation) de la structure de données de la classe T_Date.

 
Sélectionnez
package P_Date_Classe.Suite is
type T_Jour is (Lundi, Mardi, Mercredi, Jeudi, Vendredi, Samedi, Dimanche);
type T_Date_Complétée is new T_Date with record
     Jour : T_Jour; -- dérivation avec extension
end record;
procedure Saisir (La_Date : out T_Date_Complétée);
procedure Editer (La_Date : in  T_Date_Complétée);
fonction Ajuster (La_Date : in T_Date) return T_Date_Complétée;
................... -- ici d'autres méthodes
end P_Date_Classe.Suite;

Commentaires : la nouvelle classe étendue T_Date_Complétée se déclare toujours dans un paquetage (ici un fils). un seul champ est ajouté celui du nom du jour de la date. Deux nouvelles procédures d'entrée sortie sont déclarées (surcharge) pour la nouvelle classe ainsi qu'une fonction permettant (c'est un exemple) de rendre une date (T_Date) en son équivalente dans l'autre classe (T_Date_Complétée). La réalisation de la fonction Ajuster (faite dans le body) consiste simplement à initialiser le jour d'une date donnée.

Nous ne résistons pas au plaisir d'écrire une réalisation (qui se fait, rappelons le, dans le body !) :

 
Sélectionnez
procedure Saisir (La_Date : out T_Date_Complétée) is
Date_Simple : T_Date;
begin    Saisir (Date_Simple);
    La_Date := Ajuster (Date_Simple);
end Saisir;

C'est court et sûr !

La surcharge de Saisir est parfaitement résolu par le compilateur grâce au type (T_Date) du paramètre effectif Date_Simple.

H. Deux exemples de programmation concurrente

Voici maintenant deux exemples de programmation concurrente proposés par C. Kaiser. À notre connaissance, ces exemples ne sont, ni dans le manuel de référence, ni dans des ouvrages de cours. Ces exemples ont été choisis pour montrer la simplicité et la puissance de l'objet protégé. Et aussi l'utilisation qu'on peut faire des choix sémantiques pris par le langage. Si on essaie, sans précautions, de transposer ces solutions, élégantes, dans d'autres langages, comme Java, ou de les utiliser avec Posix, on va vers des catastrophes (inter blocage, incohérences). Bien entendu, les solutions présentées sont transposables en Java ou en Posix, mais au prix d'une complication résultant de la programmation défensive qu'il faut mettre en œuvre.

La documentation de ces programmes resterait à développer. Il s'agit d'abord ici de montrer des exemples de style de programmation de concurrence avec les objets protégés. Et combien on peut avoir un plaisir esthétique en programmant la concurrence en Ada. Comme on l'a déjà dit : un vrai bonheur didactique !

UN CLASSIQUE : LE DÎNER DES PHILOSOPHES

Version utilisant des familles d'entrées et du « requeue ». Elle est sans inter blocage grâce à la sémantique de l'objet protégé (dite sémantique de l'œuf), et sans famine.

 
Sélectionnez
--  REPAS DES PHILOSOPHES
--  protocole interne et une baguette après l'autre

package General is
   N : constant Integer := 5;
   type Philo_Id is mod N;
end General;
-- 
with General; use  General;
package LesBaguettes is
   procedure Prendre (PourMoi : in Philo_Id);
   procedure Rendre (PourMoi : in Philo_Id);
end LesBaguettes; 
package body LesBaguettes is
   type Tableau_De_Booleens is array (Philo_Id) of Boolean;

   protected Baguettes is
      entry Saisir (Philo_Id); -- famille d'entrées
      procedure Restituer (X : in Philo_Id);
   private
      Disponible : Tableau_De_Booleens := (others => True);
      entry Completer (Philo_Id); -- autre famille d'entrées
   end Baguettes; 
   protected body Baguettes is
      entry Saisir (for I in Philo_Id) when Disponible (I) is
      begin
         Disponible (I) := False;
         requeue Completer (I + 1);
      end Saisir; 
      entry Completer (for I in Philo_Id) when Disponible (I) is
      begin
         Disponible (I) := False;
      end Completer;
     procedure Restituer (X : in Philo_Id) is
      begin
         Disponible (X) := True;
         Disponible (X + 1) := True;
      end Restituer;
   end Baguettes; 
    procedure Prendre (PourMoi : in Philo_Id) is
   begin
      Baguettes.Saisir (PourMoi);
   end Prendre;  
   procedure Rendre (PourMoi : in Philo_Id) is
   begin
      Baguettes.Restituer (PourMoi);
   end Rendre; 
end LesBaguettes; 
--  *************************************************
--  voici de quoi essayer l'algorithme
--  simulation du comportement des philosophes
--  ********************************************** 
generic 
   type Resultat is private; 
   type Etat_Interne is limited private; 
   with procedure Reset (V : in Etat_Interne); 
   with function Prochaine_Valeur (V : Etat_Interne) return Resultat;   
package Machine_Protegee is 
  function Prochaine_Valeur_Protegee return Resultat;   
end Machine_Protegee; 
package body Machine_Protegee is 
   protected Machine_Interne is 
      procedure Reset_Interne; 
      function Prochaine_Valeur_Interne return Resultat; 
   private 
      Etat : Etat_Interne; 
   end Machine_Interne; 
   protected body Machine_Interne is 
      function Prochaine_Valeur_Interne return Resultat is 
      begin 
         return Prochaine_Valeur (Etat); 
      end Prochaine_Valeur_Interne; 
      procedure Reset_Interne is 
      begin 
         Reset (Etat); 
      end Reset_Interne; 
   end Machine_Interne; 
   function Prochaine_Valeur_Protegee return Resultat is 
   begin 

      return Machine_Interne.Prochaine_Valeur_Interne; 
   end Prochaine_Valeur_Protegee; 
begin 
   Machine_Interne.Reset_Interne;   
end Machine_Protegee; 

--==================================== 
with General; use  General;   
package Scene_Philo is 
   procedure Pense (X : in Philo_Id); 
   procedure Mange (X : in Philo_Id);   
end Scene_Philo; 
with Ada.Text_IO, Ada.Numerics.Float_Random;   
use  Ada.Text_IO, Ada.Numerics.Float_Random;   
with Machine_Protegee;   
pragma Elaborate_All (Machine_Protegee); 
package body Scene_Philo is 
   package Protected_Float_Random is new Machine_Protegee 
     (Resultat         => Float, 
      Etat_Interne     => Ada.Numerics.Float_Random.Generator, 
      Reset            => Ada.Numerics.Float_Random.Reset, 
      Prochaine_Valeur => Ada.Numerics.Float_Random.Random); 
   use Protected_Float_Random; 
   procedure Pense (X : in Philo_Id) is 
      Duree : Float range 0.0 .. 1.0; 
   begin  --  nouveau tirage aléatoire d'une durée 
      Duree := Prochaine_Valeur_Protegee; 
      Put_Line ("le philosophe " & Philo_Id'Image (X) & " pense"); 
      delay (Duration (Duree)); -- x pense un certain temps 
      Put_Line ("le philosophe " & Philo_Id'Image (X) & " a faim"); 
   end Pense; 
  procedure Mange (X : in Philo_Id) is 
      Duree : Float range 0.0 .. 1.0; 
   begin --  nouveau tirage aléatoire d'une durée 
      Duree := Prochaine_Valeur_Protegee; 
      Put_Line ("le philosophe " & Philo_Id'Image (X) & "  mange"); 
      delay (Duration (Duree)); -- x mange un certain temps 
      Put_Line ("le philosophe " & Philo_Id'Image (X) & "  n'a plus faim"); 
   end Mange;   
end Scene_Philo; 

--====================================
  --  VOICI LE REPAS DES PHILOSOPHES   
--==================================== 
with General, Scene_Philo, LesBaguettes;   
use  General, Scene_Philo; 
procedure Application is 
   package Nom is 
      function Unique return Philo_Id; 
   end Nom; 
   package body Nom is 
      Next_Id : Philo_Id := Philo_Id'Last;   
      -- protégé par le package 
      function Unique return Philo_Id is 
      begin 
         Next_Id := Next_Id + 1; -- addition modulo N 
         return Next_Id; 
      end Unique; 
   end Nom; 
   task type Philo (X : Philo_Id  := Nom.Unique); 
      Philosophes : array (Philo_Id) of Philo; 
   task body Philo is 
   begin 
      for I in 1 .. 65 loop 
         Pense (X); 
         LesBaguettes.Prendre (X); 
         Mange (X); 
         LesBaguettes.Rendre (X); 
      end loop; 
   end Philo; 
begin 
   null;   
end Application;   
--  
======================================================= 
 
--  UN EXEMPLE MOINS CLASSIQUE D'ALLOCATION DE RESSOURCE
--  Ce genre d'exemple nécessite de réévaluer l'état 
--  au moment du retour des ressources,
--  et de passer de l'information entre processus. 
--  En dehors de Ada, cela donne généralement
--  soit une solution compliquée 
--  soit beaucoup de réveils intempestifs de tâches 
--  Ici encore Ada permet une solution élégante.
--  Voici deux exemples, l'un très simple, l'autre compliqué 
--  comme l'est la réalité des applications concurrentes . 
--  ============================================= 
--  ALLOCATEUR DE RESSOURCES : VARIANTE 1
--  allocation de ressources contrôlée par un objet protégé
--  variante 1 : la première tâche en attente 
--  bloque les nouvelles requêtes et alors
--  les nouvelles requêtes doivent attendre que 
--  la tâche en attente sur l'entrée Servir soit servie
--  Les requêtes en attente sont servies selon 
--  l'ordre de la file de Demander
--  ============================================= 
package Allocation1 is 
   Max : constant Integer := 100; -- nombre de ressources
   type Des_Ressources is new Integer range -Max .. Max;
   subtype Nb_Ressources is Des_Ressources range 1 .. Des_Ressources'Last;
   type Liste_Resource is new Integer; 
   --  type à redéfinir ultérieurement   
   protected Controleur is
      entry Demander 
            (R : out Liste_Resource; Nombre : Nb_Ressources);
      procedure Rendre 
            (R : in Liste_Resource; Nombre : Nb_Ressources);
   Private
      entry Servir (R : out Liste_Resource; Nombre : Nb_Ressources);
      Disponible : Des_Ressources := Des_Ressources'Last;
   end Controleur;
end Allocation1; 
--  =================================================== 
package body Allocation1 is
   protected body Controleur is  
      entry Demander (R : out Liste_Resource; Nombre : Nb_Ressources)
      when Servir'Count = 0 is
      begin
         Disponible := Disponible - Nombre; 
         if Disponible < 0 then   --  la demande doit attendre
            requeue Servir;
         else           --  la demande peut être satisfaite
            --  Fournir_Les_Ressources_Dans(R);
            null;
         end if;
      end Demander; 
      entry Servir (R : out Liste_Resource; Nombre : Nb_Ressources)
      when Disponible  >=  0 is
      begin
         --  Fournir_Les_Ressources_Dans(R);
         null;
      end Servir; 
      procedure Rendre 
            (R : in Liste_Resource; Nombre : Nb_Ressources) is
      Begin
         --  Recuperer_Les_Ressources_De(R);
         Disponible := Disponible + Nombre;  
            -- enregistre ce nombre de ressources rendues
      end Rendre;
   end Controleur; 
begin
   null;
end Allocation1;
--  =============================================
--  ALLOCATEUR DE RESSOURCES : VARIANTE 2
--  allocation de ressources contrôlée par un objet protégé
--  variante 2 : il y a un premier groupe de tâches en attente
--  les tâches de ce groupe reçoivent les ressources une par une
--  et attendent d'avoir toute leur requête avant de continuer
--  les autres tâches en attente, s'il y en a, sont servies après.
--  ============================================= 
package Allocation2 is
   Max : constant Integer := 100; --  nombre de ressources
   type Des_Ressources is new Integer range 0 .. Max;
   subtype Nb_Ressources is Des_Ressources range 1 .. Des_Ressources'Last;
   type Liste_Resource is new Integer; --  à modifier ultérieurement
   Taille_Groupe : constant Integer := 10; 
      --  nombre de tâches distinguées
   type Index_Groupe is mod Taille_Groupe;
   type Gestion_Groupe is array (Index_Groupe) of Des_Ressources; 
  protected Controleuse is
      entry Demander (R : out Liste_Resource; Nombre : Nb_Ressources);
      procedure Rendre (R : in Liste_Resource; Nombre : Nb_Ressources);
   private
      entry Servir (Index_Groupe)
        (R : out Liste_Resource; Nombre : Nb_Ressources);
      Disponible : Des_Ressources := Des_Ressources'Last;
      Deficit : Gestion_Groupe; 
                --  tableau des ressources encore attendues
      J : Index_Groupe := Index_Groupe'Last; -- témoin de parcours
      function Recevable return Boolean;
   end Controleuse;
end Allocation2; 
package body Allocation2 is
   protected body Controleuse is
      function Recevable return Boolean is
         --  il suffit d une place non utilisée, c'est à dire vide
         --  la sémantique de l'objet protégé garantit 
         --  qu'avant ce test
         --  toute entrée de Servir qui a sa garde à vrai, 
         --  parce que la place est vide, a été activée
      Begin
         for K in Index_Groupe loop
            if Deficit (K) = 0 then
               return True;
            end if;
         end loop;
         return False;
      end Recevable; 
      entry Demander 
            (R : out Liste_Resource; Nombre : Nb_Ressources)
      when Recevable is
         I : Index_Groupe;
         function Index_Disponible return Index_Groupe is
         begin --  choix selon la politique d'allocation
            for K in Index_Groupe loop
               if Deficit (K) = 0 then
                  return K;
               end if;
            end loop; --  Recevable => on est sûr d'en trouver un
            raise Program_Error; --  ne doit pas servir
         end Index_Disponible; 
      begin
         if Nombre <= Disponible then
            Disponible := Disponible - Nombre; -- effet immédiat
            --  Fournir_Les_Ressources_Dans(R);
         else         --  la demande ne peut être satisfaite
            I := Index_Disponible;
            Deficit (I) := Nombre - Disponible;
            requeue Servir (I);
         end if;
      end Demander; 
      entry Servir (for I in Index_Groupe)
                (R : out Liste_Resource; Nombre : Nb_Ressources)
      when Deficit (I) = 0 is
      begin
         --  Fournir_Les_Ressources_Dans(R);
         null;
      end Servir; 
      procedure Rendre 
            (R : in Liste_Resource; Nombre : Nb_Ressources) is
         Compte_Des_Nuls : Integer := 0;
         Nb : Nb_Ressources := Nombre;
      Begin
         --  Recuperer_Les_Ressources_De(R) ;
         --  attribution de ressource, une par une, 
         --  à tour de rôle, à chaque requête J en attente, 
         --  connue parce que Deficit(J) > 0
         Loop
            J := J + 1; --  Progression de l'indice de parcours
            if Deficit (J) > 0 then
               Compte_Des_Nuls := 0;
               Deficit (J) := Deficit (J) - 1;
            Else
               Compte_Des_Nuls  := Compte_Des_Nuls  + 1;
            end if;
            Nb := Nb - 1;
            exit when (Nb = 0) or (Compte_Des_Nuls = Taille_Groupe);
         end loop;
         Disponible := Nb; -- reste = ressources non réparties
      end Rendre;
   end Controleuse; 
begin
   null;
end Allocation2; 
--   <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
--   voici  de quoi essayer les allocateurs 
--   chaque générateur de nombres aléatoires est partagé
--   et en accès concurrent; il doit être protégé
--   <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
--==================================== 
Generic
   type Resultat is private;
   type Etat_Interne is limited private;
   with procedure Reset (V: in Etat_Interne);
   with function Prochaine_Valeur (V: Etat_Interne) return Resultat;
package Machine_Protegee is
    function Prochaine_Valeur_Protegee return Resultat;
end Machine_Protegee; 
package body Machine_Protegee is
  protected Machine_Interne is
      procedure Reset_Interne;
      function Prochaine_Valeur_Interne return Resultat;
   private
      Etat : Etat_Interne;
  end Machine_Interne; 
  protected body Machine_Interne is
      function Prochaine_Valeur_Interne return Resultat is
      begin
         return Prochaine_Valeur(Etat);
      end Prochaine_Valeur_Interne;
      procedure Reset_Interne is
      begin
         Reset (Etat);
      end Reset_Interne;
   end Machine_Interne; 
   function Prochaine_Valeur_Protegee return Resultat is
   begin
      return Machine_Interne.Prochaine_Valeur_Interne;
   end Prochaine_Valeur_Protegee; 
begin
   Machine_Interne.Reset_Interne; 
end Machine_Protegee; 
--  =============================================
--  PROGRAMME PRINCIPAL
--  ============================================= 
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Numerics.Discrete_Random;
with Ada.Numerics.Float_Random;
with Allocation1; use Allocation1;
with Allocation2; use Allocation2;
with Machine_Protegee; 
procedure Exemple_Ressource_Allocation is
   package R_Number_Random is new
     Ada.Numerics.Discrete_Random (Allocation1.Nb_Ressources);  
  package Protected_R_Random is new Machine_Protegee
     ( Resultat         => Allocation1.Nb_Ressources,
       Etat_Interne     => R_Number_Random.Generator,
       Reset            => R_Number_Random.Reset,
       Prochaine_Valeur => R_Number_Random.Random); 
   package Protected_Float_Random is new Machine_Protegee
     ( Resultat         => Float,
       Etat_Interne     => Ada.Numerics.Float_Random.Generator,
       Reset            => Ada.Numerics.Float_Random.Reset,
       Prochaine_Valeur => Ada.Numerics.Float_Random.Random); 
   task type Pilote_Type (X : Allocation1.Nb_Ressources := 
                Protected_R_Random.Prochaine_Valeur_Protegee); 
   task body Pilote_Type is
      R : Allocation1.Liste_Resource;
      D1: Float := Protected_Float_Random.Prochaine_Valeur_Protegee;
      D2: Float := Protected_Float_Random.Prochaine_Valeur_Protegee; 
      task Copilote;
      task body Copilote is
         Y : Allocation2.Nb_Ressources := Allocation2.Nb_Ressources (X);
         R : Allocation2.Liste_Resource;
      begin 
         delay (Duration (D1)); --  attente aléatoire
         Put_Line (" cas 2 : demande de  " & Allocation2.Nb_Ressources'Image (Y));
         Controleuse.Demander (R, Y);
         delay (Duration (D2)); --  attente aléatoire
         Put_Line (" cas 2 : retour de  " & Allocation2.Nb_Ressources'Image (Y));
         Controleuse.Rendre (R, Y);
      end Copilote; 
   begin
      delay (Duration (D1));  --  attente aléatoire
      Put_Line (" cas 1 : demande de  " & Allocation1.Nb_Ressources'Image (X));
      Controleur.Demander (R, X);
      delay (Duration (D2)); --  attente aléatoire
      Put_Line (" cas 1 : retour de  " & Allocation1.Nb_Ressources'Image (X));
      Controleur.Rendre (R, X);
   end Pilote_Type; 
   Usagers : array (1..30) of Pilote_Type; 
begin  -- maintenant on a soixante et une tâches actives
        -- leur exécution va donc imprimer 120 lignes de texte
   null;
end Exemple_Ressource_Allocation; 
--====================================

I. Un exemple de programmation distribuée

La programmation distribuée revient à découper un programme en plusieurs exécutables appelés partitions en Ada) devant s'exécuter sur des machines (voir des OS) différentes. Une grande force de l'approche distribuée d'Ada et de permettre que le même programme puisse être compilé en mode distribué et non-distribué. Cette approche simple et pragmatique permet de rapidement construire une application distribuée, atout qui sera apprécié lors de l'enseignement (il n'est pas nécessaire de rentrer dans des détails de bas niveau). Pour illustrer ce point, prenons comme exemple une version distribuée du fameux hello World !

Le serveur:

 
Sélectionnez
package Hello_Server is
    pragma Remote_Call_Interface;
   function Message return String;
end Hello_Server;

package body Hello_Server is 
    function Message return String is
    begin
        return "Hello World!";
    end Message;
end Hello_Server;

Le client:

 
Sélectionnez
with Ada.Text_Io;
with Hello_Server;

procedure Hello_Client is
use Ada;
begin
    Text_Io.Put_Line (Hello_Server.Message);
end Hello_Client;

La seule addition par rapport à la version non-distribuée est le pragma Remote_Call_Interface. On peut difficilement faire plus simple!


précédentsommairesuivant

Vous avez aimé ce tutoriel ? Alors partagez-le en cliquant sur les boutons suivants : Viadeo Twitter Facebook Share on Google+   

  

Copyright © 2003 Daniel Feneuille Developpez LLC. Tous droits réservés Developpez LLC. Aucune reproduction, même partielle, ne peut être faite de ce site et de l'ensemble de son contenu : textes, documents et images sans l'autorisation expresse de Developpez LLC. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.