Programación en Ada/Tareas/Ejemplos

De Wikilibros, la colección de libros de texto de contenido libre.

< Programación en Ada | Tareas

Saltar a navegación, buscar

← Tareas/Dependencia

Ejemplos completos de tareas

GLADE →

Contenido

1 Ejemplos completos de tareas
2 Manual de referencia de Ada

[editar] Ejemplos completos de tareas

[editar] Semáforos

Una posible implementación del tipo abstracto semáforo es con tareas Ada. Pero este ejemplo no se ha de tomar muy en serio, puesto que es un típico caso de inversión de la abstracción, es decir, se hace uso de un mecanismo de alto nivel, las tareas, para implementar uno de bajo nivel, los semáforos. En Ada 95 la mejor manera de implementar un semáforo es un objeto protegido. Sin embargo a efectos didácticos es un buen ejemplo.

generic
  ValorInicial: Natural := 1;  -- Parám. genérico con valor por defecto.
 package Semaforos is
  type TSemaforo is limited private;
  procedure Wait (Sem: in out TSemaforo);
  procedure Signal (Sem: in out TSemaforo);
private
  task type TSemaforo is
    entry Wait;
    entry Signal;
  end TSemaforo;
end Semaforos;

package body Semaforos is
  procedure Wait (Sem: in out TSemaforo) is
    begin
      Sem.Wait;  -- Llamada a punto de entrada de la tarea.
     end Wait;
  procedure Signal (Sem: in out TSemaforo) is
    begin
      Sem.Signal;  -- Llamada a punto de entrada de la tarea.
     end Signal;
  task body TSemaforo is
    S: Natural := ValorInicial;  -- Es el contador del semáforo.
   begin
    loop
      select
        when S > 0 =>
          accept Wait;
          S := S - 1;
      or
        accept Signal;
        S := S + 1;
      or
        terminate;
      end select;
    end loop;
  end TSemaforo;
end Semaforos;

with Semaforos;
 
procedure Prueba_Semaforos is
  package Paquete_Semaforos is new Semaforos;
  use Paquete_Semaforos;
  Semaforo: TSemaforo;
begin  -- Aquí se inicia la tarea de tipo TSemaforo (objeto Semaforo).
   -- ...
   Wait (Semaforo);
   -- ...
   Signal (Semaforo);
   -- ...
end Prueba_Semaforos;

[editar] Simulación de trenes

Problema: Escribe un programa que realice una simulación de trenes circulando por estaciones. Cada tren espera a que la estación siguiente esté libre para avanzar, es decir, hasta que un tren no ha abandonado una estación, el tren de la estación anterior no puede avanzar. Para ello puedes usar los semáforos definidos en el ejemplo anterior.

Solución:

Solución propuesta:

with Ada.Text_IO; use Ada.Text_IO;
with Ada.Numerics.Float_Random;
 
with Semaforos;
 
procedure Simulador_Trenes is
 
   Num_Estaciones : constant := 5;
   Num_Trenes : constant := 3;
 
   type Num_Estación is range 1 .. Num_Estaciones;
   type Num_Tren is range 1 .. Num_Trenes;
 
   package Num_Estación_IO is new Ada.Text_IO.Integer_IO (Num_Estación);
   use Num_Estación_IO;
   package Num_Tren_IO is new Ada.Text_IO.Integer_IO (Num_Tren);
   use Num_Tren_IO;
 
   package Semaforos_Inicial_1 is new
     Semaforos (Valorinicial => 1);
   use Semaforos_Inicial_1;
 
   Semaforos_Estaciones : array (Num_Estación) of TSemaforo;
 
   task type Tren is
      entry Comenzar (Tu_Num : in Num_Tren);
   end Tren;
 
   Lista_Trenes : array (Num_Tren) of Tren;
 
   task body Tren is
 
      Mi_Num: Num_Tren;
 
      procedure Pon_Nombre is
      begin
         Put ("Tren nº"); Put (Mi_Num); Put (": ");
      end Pon_Nombre;
 
      Espera_En_Estación: constant Duration := 5.0;
      Duración_Mínima: constant Duration := 2.0;
      Factor_Duración: constant Duration := 10.0;
      Azar_Gen: Ada.Numerics.Float_Random.Generator;
 
      Actual, Siguiente: Num_Estación;
   begin
 
      Ada.Numerics.Float_Random.Reset (Azar_Gen);
 
      accept Comenzar (Tu_Num : in Num_Tren) do
         Mi_Num := Tu_Num;
      end Comenzar;
 
      Pon_Nombre;
      Put_Line ("Comienzo el trayecto");
      Actual := 1;
 
      loop
 
         Pon_Nombre; Put ("En estación "); Put (Actual); New_Line;
 
         delay Espera_En_Estación;
 
         if Actual = Num_Estaciones then
            Siguiente := 1;
         else
            Siguiente := Actual + 1;
         end if;
 
         Wait (Semaforos_Estaciones (Siguiente));
 
         Pon_Nombre;
         Put ("Trayecto hacia estación ");
         Put (Siguiente);
         New_Line;
 
         Signal (Semaforos_Estaciones (Actual));
         delay Duration (Ada.Numerics.Float_Random.Random (Azar_Gen))
           * Factor_Duración + Duración_Mínima;
 
         Actual := Siguiente;
 
      end loop;
   end Tren;
 
 
begin
 
   for I in Lista_Trenes'Range loop
      Lista_Trenes (I).Comenzar (Tu_Num => I);
   end loop;
 
end Simulador_Trenes;

[editar] Buffer circular

Otro ejemplo, una posible implementación de un buffer circular:

generic
   type TElemento is private;
   Tamaño: Positive := 32;
package Buffer_servidor is
   type TBuffer is limited private;
   procedure EscribirBuf (B: in out TBuffer; E: TElemento);
   procedure LeerBuf (B: in out TBuffer; E: out TElemento);
private
   task type TBuffer is
      entry Escribir (E: TElemento);
      entry Leer (E: out TElemento);
   end TBuffer;
end Buffer_servidor;

package body Buffer_servidor is
   task body TBuffer is
      subtype TCardinalBuffer is Natural range 0 .. Tamaño;
      subtype TRangoBuffer is TCardinalBuffer range 0 .. Tamaño - 1;
      Buf: array (TRangoBuffer) of TElemento;
      Cima, Base: TRangoBuffer := 0;
      NumElementos: TCardinalBuffer := 0;
   begin
      loop
         select
            when NumElementos < Tamaño =>
               accept Escribir (E: TElemento) do
                  Buf(Cima) := E;
               end Escribir;
               Cima := TRangoBuffer(Integer(Cima + 1) mod Tamaño);
               NumElementos := NumElementos + 1;
         or
            when NumElementos > 0 =>
               accept Leer (E: out TElemento) do
                  E := Buf(Base);
               end Leer;
               Base := TRangoBuffer(Integer(Base + 1) mod Tamaño);
               NumElementos := NumElementos - 1;
         or
            terminate;
         end select;
      end loop;
   end TBuffer;
 
   procedure EscribirBuf (B: in out TBuffer; E: TElemento) is
   begin
      B.Escribir (E);
   end EscribirBuf;
 
   procedure LeerBuf (B: in out TBuffer; E: out TElemento) is
   begin
      B.Leer (E);
   end LeerBuf;
end Buffer_servidor;

with Text_IO, Buffer_servidor;
use Text_IO;
procedure Buffer is
  Clave_Salida : constant String := "Salir";
  type TMensaje is
    record
      NumOrden: Positive;
      Contenido: String (1..20);
    end record;
  package Cola_mensajes is new Buffer_servidor (TElemento => TMensaje);
  use Cola_mensajes;
  Cola: TBuffer;
  task Emisor;
  task Receptor;
  task body Emisor is
    M: TMensaje := (NumOrden => 1, Contenido => (others => ' '));
    Último: Natural;
  begin
    loop
      Put ("[Emisor] Mensaje: ");
      Get_Line (M.Contenido, Último);
      M.Contenido (Último + 1 .. M.Contenido'Last) := (others => ' ');
      EscribirBuf (Cola, M);
      M.NumOrden := M.NumOrden + 1;
      exit when M.Contenido(Clave_Salida'range) = Clave_Salida;
    end loop;
  end Emisor;
  task body Receptor is
    package Ent_IO is new Text_IO.Integer_IO(Integer);
    use Ent_IO;
    M: TMensaje;
  begin
    loop
      LeerBuf (Cola, M);
      exit when M.Contenido(Clave_Salida'range) = Clave_Salida;
      Put ("[Receptor] Mensaje número ");
      Put (M.NumOrden);
      Put (": ");
      Put (M.Contenido);
      New_Line;
    end loop;
  end Receptor;
 
begin
  null;
end Buffer;

[editar] Problema del barbero durmiente

Esta es una solución al problema del barbero durmiente.

with Ada.Text_IO; use Ada.Text_IO;
 
with Ada.Numerics.Discrete_Random;
 
procedure Barberia is
 
   type Rango_Demora is range 1 .. 30;
   type Duracion_Afeitado is range 5 .. 10;
   type Nombre_Cliente is (Jose, Juan, Iñaki, Antonio, Camilo);
 
   package Demora_Al_Azar is new Ada.Numerics.Discrete_Random
     (Rango_Demora);
   package Afeitado_Al_Azar is new Ada.Numerics.Discrete_Random
     (Duracion_Afeitado);
 
   task Barbero is
      entry Afeitar (Cliente : in Nombre_Cliente);
   end Barbero;
 
   task type Cliente is
      entry Comenzar (Nombre : in Nombre_Cliente);
   end Cliente;
 
   Lista_Clientes : array (Nombre_Cliente) of Cliente;
 
   task body Barbero is
      Generador : Afeitado_Al_Azar.Generator;
      Espera_Máxima_Por_Cliente : constant Duration := 30.0;
   begin
      Afeitado_Al_Azar.Reset (Generador);
      Put_Line ("Barbero: Abro la barbería.");
      loop
         Put_Line ("Barbero: Miro si hay cliente.");
         select
            accept Afeitar (Cliente : in Nombre_Cliente) do
               Put_Line ("Barbero: Afeitando a " & Nombre_Cliente'Image
                         (Cliente));
               delay Duration (Afeitado_Al_Azar.Random (Generador));
               Put_Line ("Barbero: Termino con " & Nombre_Cliente'Image
                         (Cliente));
            end Afeitar;
         or
            delay Espera_Máxima_Por_Cliente;
            Put_Line ("Barbero: Parece que ya no viene nadie,"
                      & " cierro la barbería.");
            exit;
         end select;
      end loop;
   end Barbero;
 
   task body Cliente is
      Generador : Demora_Al_Azar.Generator;
      Mi_Nombre : Nombre_Cliente;
   begin
      accept Comenzar (Nombre : in Nombre_Cliente) do
         Mi_Nombre := Nombre;
      end Comenzar;
 
      Demora_Al_Azar.Reset (Gen       => Generador,
                            Initiator => Nombre_Cliente'Pos (Mi_Nombre));
 
      delay Duration (Demora_Al_Azar.Random (Generador));
 
      Put_Line (Nombre_Cliente'Image (Mi_Nombre) &
                ": Entro en la barbería.");
      Barbero.Afeitar (Cliente => Mi_Nombre);
      Put_Line (Nombre_Cliente'Image (Mi_Nombre) &
                ": Estoy afeitado, me marcho.");
   end Cliente;
 
begin
   for I in Lista_Clientes'Range loop
      Lista_Clientes (I).Comenzar (Nombre => I);
   end loop;
end Barberia;

[editar] Problema de los filósofos cenando

Ilustración del problema de los filósofos cenando

Una solución con tareas y objetos protegidos del conocido problema de los filósofos cenando.

    package Cubiertos is
 
       type Cubierto is limited private;
 
       procedure Coger(C: in out Cubierto);
       procedure Soltar(C: in out Cubierto);
 
    private
 
       type Status is (LIBRE, OCUPADO);
 
       protected type Cubierto(Estado_Cubierto: Status := LIBRE) is
          entry Coger;
          entry Soltar;
       private
          Estado: Status := Estado_Cubierto;
       end Cubierto;
 
    end Cubiertos;

    package body Cubiertos is
 
       procedure Coger (C: in out Cubierto) is
       begin
          C.Coger;
       end Coger;
 
       procedure Soltar (C: in out Cubierto) is
       begin
          C.Soltar;
       end Soltar;
 
       protected body Cubierto is
 
          entry Coger when Estado = LIBRE is
          begin
             Estado := OCUPADO;
          end Coger;
 
 
          entry Soltar when Estado = OCUPADO is
          begin
             Estado := LIBRE;
          end Soltar;
 
       end Cubierto;
 
    end Cubiertos;

    with Ada.Text_IO; use Ada.Text_IO;
    with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
    with Cubiertos; use Cubiertos;
 
    procedure Problema_Filosofos is
 
       type PCubierto is access Cubierto;
 
       task type TFilosofo(Id: Character; Cubierto1: PCubierto; Cubierto2: PCubierto);
 
       task body TFilosofo is
 
          procedure Comer is
          begin
             Coger(Cubierto1.all);
             Coger(Cubierto2.all);
             for i in 1..10 loop
                Put(Id & "c ");
                delay 1.0;
             end loop;
             Soltar(Cubierto2.all);
             Soltar(Cubierto1.all);
          end Comer;
 
          Procedure Pensar is
          begin
             for i in 1..10 loop
                Put(Id & "p ");
                delay 1.0;
             end loop;
          end Pensar;
 
       begin
          loop
             Comer;
             Pensar;
          end loop;
       end TFilosofo;
 
       Num_Cubiertos: Positive;
 
    begin
 
       Put("Introduce el numero de cubiertos: "); Get(Num_Cubiertos); New_line;
 
       declare
          type PTFilosofo is access TFilosofo;
          P: PTFilosofo;
          C: Character := 'A';
          Cuberteria: array (1..Num_Cubiertos) of PCubierto;
       begin
          for i in 1..Num_Cubiertos loop
             Cuberteria(i) := new Cubierto;
          end loop;
 
          for i in 1..Num_Cubiertos-1 loop
            P := new TFilosofo(C, Cuberteria(i), Cuberteria(i+1));
            C := Character'Succ(C);
          end loop;
          P := new TFilosofo(C, Cuberteria(1), Cuberteria(Num_Cubiertos));
       end;
    end Problema_Filosofos;

Para evitar el bloqueo mutuo es totalmente imprescindible que al último filósofo se le asignen los cubiertos en ese orden. Sí se hiciese al contrario, el bloqueo no tardaría en aparecer (sobre todo si se eliminan las instrucciones delay):

          P := new TFilosofo(C, Cuberteria(Num_Cubiertos), Cuberteria(1));

[editar] Chinos: una implementación concurrente en Ada

-- Chinos2: Otra implementación concurrente en Ada
-- Tomás Javier Robles Prado
-- tjavier@usuarios.retecal.es
 
 
-- Uso: ./chinos <numero_jugadores>
 
-- El juego consiste en jugar sucesivas partidas a los chinos. Si un
--  jugador acierta, no paga y queda excluido de las siguientes
--  rondas. El último que quede paga los vinos
 
 
--   Copyright (C) 2003 T. Javier Robles Prado
--
--   This program is free software; you can redistribute it and/or modify
--   it under the terms of the GNU General Public License as published by
--   the Free Software Foundation; either version 2 of the License, or
--   (at your option) any later version.
--
--   This program is distributed in the hope that it will be useful,
--   but WITHOUT ANY WARRANTY; without even the implied warranty of
--   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
--   GNU General Public License for more details.
--
--   You should have received a copy of the GNU General Public License
--   along with this program; if not, write to the Free Software
--   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
 
 
with Ada.Text_IO; use Ada.Text_IO;
 
with Ada.Numerics.Discrete_Random;
with Ada.Command_Line;
with Ada.Strings.Unbounded;
with Ada.Exceptions;
 
procedure Chinos is
 
   -- Número Máximo Jugadores que pueden participar (aforo máximo del bar)
   MAX   : constant Natural := 20;
 
   -- Posibles mensajes que recibe un jugador tras una partida
   type Estados is (NO_SIGUES_JUGANDO, SIGUES_JUGANDO, HAS_PERDIDO);
 
   -- Subtipo que modela el número de jugadores posibles
 
   subtype NumMaxJugadores is Natural range 0..MAX;
 
   -- Modela la máxima apuesta que puede darse
   subtype MAX_APUESTA is Natural range 0..3*MAX;
 
   -- Nombres posibles para los jugadores. El 0 se utilizará para
 
   --  controlar el caso de que no haya ganador en una partida
   subtype TNombre is Integer range -1..MAX;
 
   -- Paquete para Numeros aleatorios:
   package Integer_Random is new Ada.Numerics.Discrete_Random(MAX_APUESTA);
 
   -- Apuesta de cada Jugador
 
   Subtype TApuesta is  Integer range -1..3*MAX;
 
   -- Mano de cada jugador
   subtype TMano is Natural range 0..3;
 
 
   -- Ficha de cada jugador que guardara el arbitro
 
   type TFicha is record
      Nombre       : TNombre;
      Apuesta      : TApuesta := -1;
      Mano         : TMano;
      SigueJugando : Boolean;
   end record;
 
   -- Array de Fichas
   type TTablon is array(1..MAX) of TFicha;
 
 
   -- Se define el tipo jugador
 
   task type Jugador;
 
   task  Arbitro is
      -- El árbitro controla las partidas y sincroniza a los jugadores
 
      entry FijaNumeroJugadores (Num : in NumMaxJugadores);
      -- Recoge el argumento de la línea de comandos para saber
 
      --  cuántos jugadores van a participar
 
      entry AsignaNombre (Nombre: out TNombre; NumJug: out NumMaxJugadores);
      -- Asigna Nombres (de 1 a NumerosJugadores) a los jugadores que
 
      --  van a participar. A los que no, les asigna un -1 como
      --  indicación de que finalicen.
 
      entry SiguesJugando
        (Nombre: in TNombre;
         JugadorSigueJugando : out Estados;
         HuboGanador : out boolean);
      -- Mensaje que envía el árbitro a cada jugador tras una
 
      --  partida, comunicándole si ha ganado y deja de jugar, si
      --  sigue jugando o si ha perdido y tiene que pagar
 
      entry EnviaApuesta (Nombre: in TNombre ; Apuesta: in TApuesta);
      -- El árbitro recibe la apuesta de un jugador
 
 
      entry ConfirmaApuesta (Confirmada : out Boolean);
      -- Respuesta del árbitro sobre si la apuesta es válida (no la
      --  ha hecho otro antes)
 
 
      entry ReEnviaApuesta (Apuesta: in TApuesta);
      -- Si la apuesta no es válida se reenvia hasta que lo sea
 
      entry EnviaMano (Nombre: in TNombre ; Mano: in TMano);
      -- El jugador envía el número de manos que saca al árbitro
 
 
   end Arbitro;
 
 
 
 
   task body Arbitro is
 
      -- Funciones y Procedimientos
 
      function NumeroJugadores return NumMaxJugadores is
 
         -- Devuelve el número de jugadores
      begin
         return 5;
      end NumeroJugadores;
 
      function EsApuestaValida (Apuesta: in TApuesta; Tablon: in TTablon)
                               return Boolean is
 
         -- Devuelve verdadero si la apuesta no ha sido realizada
         --  antes por algún otro jugador
 
         Valida : Boolean := True ;
         I      : TNombre := 1;
      begin
 
         for I in 1..MAX loop
 
            if Tablon(I).SigueJugando then
               if Tablon(I).Apuesta = Apuesta  then
                  -- Ya está dicha, la apuesta NO es válida
 
                  Valida := False ;
               end if;
            end if;
         end loop;
 
         return Valida;
      end EsApuestaValida;
 
      function ResultadoGanador (Tablon: in TTablon) return TApuesta is
 
         -- Devuelve el número de monedas que sacaron los jugadores
         Suma : TApuesta := 0 ;
      begin
         for I in 1..MAX loop
 
            if Tablon(I).SigueJugando then
               Suma := Suma + Tablon(I).Mano ;
            end if;
         end loop;
         return Suma;
      end ResultadoGanador;
 
      procedure ImprimeGanador (Tablon: in TTablon) is
 
         -- Imprimer el nombre del ganador
         I         : TNombre := 1 ;
         Resultado : TApuesta ;
         Terminar  : Boolean := False;
      begin
         Resultado := ResultadoGanador(Tablon);
         while not Terminar loop
 
            if Tablon(I).Apuesta = Resultado and Tablon(I).SigueJugando then
 
               Put_Line("Ha Ganado el Jugador " & I'Img);
               Terminar := True ;
            else
               if I = MAX then
                  Put_Line("No ha habido Ganador");
                  Terminar := True;
               else
 
                  I :=  I + 1;
               end if;
            end if;
 
         end loop;
      end ImprimeGanador;
 
 
 
      function JugadorEliminado (Tablon: in TTablon) return NumMaxJugadores is
 
         -- Devuelve el jugador que cuya apuesta sea la correcta
 
         Resultado : TApuesta;
 
 
         Ganador   : NumMaxJugadores := 0;
      begin
         Resultado := ResultadoGanador(Tablon);
 
         for I in 1..MAX loop
 
            if Tablon(I).SigueJugando then
 
               if Resultado =  Tablon(I).Apuesta then
                  Ganador := I ;
               end if;
            end if;
         end loop;
 
         return Ganador;
      end JugadorEliminado;
 
 
 
      procedure ImprimeTablon(Tablon: in TTablon) is
 
         -- Imprime las apuestas y monedas de los jugadores
      begin
 
         for I in 1..MAX loop
            if Tablon(I).SigueJugando then
 
               Put_Line("Nombre =" & Tablon(I).Nombre'Img &
                                " | Apuesta =" & Tablon(I).Apuesta'Img &
                                " | Mano =" &Tablon(I).Mano'Img );
            end if;
         end loop;
         Put_Line
           ("Resultado ganador: " & ResultadoGanador(Tablon)'Img);
 
      end ImprimeTablon;
 
 
      procedure SeparaPartidas (NumPar :in Natural)  is
 
         -- Un simple separador para aumentar la claridad
      begin
         New_Line;
         Put_Line("******************************************");
         Put_Line("Partida número " & NumPar'Img);
         Put_Line("******************************************");
      end SeparaPartidas;
 
 
 
      -- Variables
 
 
      -- Número de jugadores de la partida
      N : NumMaxJugadores;
      Permitidos : NumMaxJugadores;
 
      -- Partida Actual
      PartidaActual : NumMaxJugadores;
 
      -- Tablón
      Tablon : TTablon;
 
      NombreActual : NumMaxJugadores;
      ApuestaValida : Boolean;
      Ganador : NumMaxJugadores;
 
      NumeroPartida :  Natural;
 
   begin
 
      -- Averigua número de jugadores
 
      accept FijaNumeroJugadores (Num : in NumMaxJugadores) do
         N := Num;
      end FijaNumeroJugadores;
 
      -- Nombra solo a aquellos que vayan a jugar, a los que no, los
 
      --  nombra como -1
      Permitidos := N;
 
 
      for I in 1..MAX loop
         accept AsignaNombre
 
           (Nombre: out TNombre ; NumJug: out NumMaxJugadores) do
            if Permitidos > 0 then
 
               Nombre := I;
               NumJug := N;
               Tablon(I).Nombre  := I ;
               Tablon(I).SigueJugando  := True;
               Permitidos := Permitidos - 1;
            else
               Nombre := -1;
               Tablon(I).Nombre := -1;
               Tablon(I).SigueJugando := False;
 
 
            end if;
         end AsignaNombre;
      end loop;
 
      NumeroPartida := 1;
 
      while N /= 1 loop
 
         -- Para separar las diferentes partidas
         SeparaPartidas(NumeroPartida);
 
 
         -- Recibe las apuestas de cada jugador
         for I in 1..N loop
            accept EnviaApuesta (Nombre: in TNombre; Apuesta: in TApuesta) do
 
               NombreActual := Nombre;
               ApuestaValida := EsApuestaValida(Apuesta,Tablon);
               if ApuestaValida then
                  Tablon(Nombre).Apuesta := Apuesta ;
               end if;
            end EnviaApuesta;
 
            -- La Apuesta es Válida, se confirma y a otra cosa
 
            if ApuestaValida then
               accept ConfirmaApuesta(Confirmada: out Boolean) do
 
                  Confirmada := True;
               end ConfirmaApuesta;
 
            else
               -- La apuesta no es válida. Se comunica esto al jugador para
               -- que envíe una nueva apuesta
               accept ConfirmaApuesta(Confirmada: out Boolean) do
 
                  Confirmada := False;
               end ConfirmaApuesta;
               while not ApuestaValida loop
                  -- Aceptará diferentes apuestas hasta q sea válida.
 
                  accept ReEnviaApuesta (Apuesta: in TApuesta) do
                     if EsApuestaValida(Apuesta,Tablon) then
 
                        ApuestaValida := True;
                        Tablon(NombreActual).Apuesta := Apuesta ;
                     end if;
                  end ReEnviaApuesta;
                  accept ConfirmaApuesta(Confirmada: out Boolean) do
 
                     Confirmada := ApuestaValida;
                  end ConfirmaApuesta;
               end loop;
 
            end if;
         end loop;
 
         -- Recibe lo q saca cada jugador
 
         for I in 1..N loop
            accept EnviaMano(Nombre: in TNombre; Mano: in TMano) do
 
               Tablon(Nombre).Mano := Mano ;
            end EnviaMano;
         end loop;
 
         -- ImprimeResultados de la partida
         ImprimeTablon(Tablon);
         ImprimeGanador(Tablon);
 
 
         -- Envía a cada jugador su nuevo estado
         Ganador  := JugadorEliminado (Tablon);
         if Ganador = 0 then
 
            -- Nadie acertó
            for I in 1..N loop
               accept SiguesJugando
 
                 (Nombre: in TNombre;
                  JugadorSigueJugando : out Estados;
                  HuboGanador : out boolean) do
 
                  JugadorSigueJugando := SIGUES_JUGANDO;
                  Tablon(Nombre).SigueJugando := True;
                  HuboGanador := false ;
               end SiguesJugando;
            end loop;
 
         else
            -- Hay ganador
            for I in 1..N loop
 
               accept SiguesJugando
                 (Nombre: in TNombre;
                  JugadorSigueJugando : out Estados;
                  HuboGanador : out boolean) do
 
                  HuboGanador := true;
                  if Nombre = Ganador then
                     JugadorSigueJugando := NO_SIGUES_JUGANDO;
                     Tablon(Nombre).SigueJugando := False;
                  else
                     if N /= 2 then
 
                        JugadorSigueJugando := SIGUES_JUGANDO;
                        Tablon(Nombre).SigueJugando := True;
                     else
                        JugadorSigueJugando := HAS_PERDIDO;
                        Tablon(Nombre).SigueJugando := False;
                     end if;
                  end if;
               end SiguesJugando;
            end loop;
         end if;
 
 
         NumeroPartida := NumeroPartida + 1;
         if Ganador /= 0 then
 
            N := N - 1;
         end if;
 
 
      end loop;
 
   end Arbitro;
 
 
   task body Jugador is
 
      MiNombre : TNombre;
      NumJug   : NumMaxJugadores;
      Apuesta : TApuesta;
      ApuestaValidada : Boolean;
      Mano    : Tmano;
      G : Integer_Random.Generator;
      YoSigo : Estados;
      Terminar : Boolean := False;
      HuboGanador : boolean;
 
   begin
      Arbitro.AsignaNombre(MiNombre, NumJug);
 
 
      -- Si MiNombre es -1, entonces termina su ejecución. Se sigue
      --  este método para ceñirnos a los jugadores que quiere el
      --  usuario
      if MiNombre /= -1 then
 
         -- Semillas aleatorias
         Integer_Random.Reset(G);
 
         while not Terminar loop
 
            -- Envia Apuesta
            for I in 1..MiNombre loop
 
               Apuesta := Integer_Random.Random(G) mod (NumJug * 3);
            end loop;
            Arbitro.EnviaApuesta(MiNombre, Apuesta);
 
            -- Proceso de confirmación de apuesta
            ApuestaValidada := False ;
            while not ApuestaValidada loop
 
               Arbitro.ConfirmaApuesta(ApuestaValidada);
               if not ApuestaValidada then
                  -- Genera Nueva apuesta
                  for I in 1..MiNombre loop
 
                     Apuesta := Integer_Random.Random(G) mod (NumJug * 3) ;
                  end loop;
                  Arbitro.ReEnviaApuesta(Apuesta);
               end if;
 
            end loop;
 
 
 
            -- Envía Mano
 
            for I in 1..MiNombre loop
               Mano := Integer_Random.Random(G) mod 4;
            end loop;
            Arbitro.EnviaMano(MiNombre, Mano);
 
            -- Comprueba su estado, si sigue jugando, si ha perdido o
 
            --  si ha ganado y deja de jugar
            Arbitro.SiguesJugando(MiNombre, YoSigo, HuboGanador);
            if YoSigo = SIGUES_JUGANDO then
               Terminar := False;
            else
               if YoSigo = NO_SIGUES_JUGANDO then
 
                  Terminar := True;
               else
                  -- Ha perdido
                  Put_Line("Jugador " & MiNombre'Img &
                                   ": He perdido, tengo que pagar :_(");
               end if;
 
            end if;
            if HuboGanador then
 
               NumJug := NumJug - 1;
            end if;
         end loop;
 
 
      end if;
 
   end Jugador;
 
 
   Jugadores : array (1..MAX) of Jugador;
   NumJug : Natural;
 
 
begin
   if Ada.Command_Line.Argument_Count /= 1 then
      -- Número incorrecto de parámetros
      Put_Line("Uso: ./chinos <num_jugadores>");
      NumJug := 1;
 
   else
 
      NumJug := Integer'Value(Ada.Command_Line.Argument(1));
 
      if NumJug < 2 then
         -- Número mínimo de jugadores
         Put_Line("El número de jugadores ha de ser mayor que 1." &
 
                          NumJug'Img & " no es mayor que 1");
         Put_Line("Seleccione un valor mayor o igual que 2");
         NumJug := 1;
      end if;
 
      if NumJug > MAX then
 
         -- Número máximo de jugadores
         Put_Line(NumJug'Img & " es mayor que " & MAX'Img);
         Put_Line("Seleccione un valor menor o igual que " &
                              MAX'Img);
         NumJug := 1;
      end if;
 
 
   end if;
 
 
   Arbitro.FijaNumeroJugadores(NumJug);
 
   -- Por si nos intentan colar algún valor no válido
 
exception
   when Constraint_Error =>
      NumJug := 1;
      Arbitro.FijaNumeroJugadores(NumJug);
      Put_Line("El Valor Introducido no es correcto.");
      Put_Line("Uso: ./chinos <num_jugadores>");
 
end Chinos;

[editar] Manual de referencia de Ada

9.11 Example of Tasking and Synchronization

Programación en Ada/Tareas/Ejemplos

De Wikilibros, la colección de libros de texto de contenido libre.

Contenido

[editar] Ejemplos completos de tareas

[editar] Semáforos

[editar] Simulación de trenes

[editar] Buffer circular

[editar] Problema del barbero durmiente

[editar] Problema de los filósofos cenando

[editar] Chinos: una implementación concurrente en Ada

[editar] Manual de referencia de Ada

Vistas

Herramientas personales

Navegación

Imprimir/exportar

Buscar

Herramientas