Curso de Ada - Ejemplos de tareas

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. Sin embargo a efectos didácticos es un buen ejemplo.

generic ValorInicial: Natural := 1; -- Parám. genérico con valor por defecto. package Semáforos is type TSemáforo is limited private; procedure Wait (Sem: in out TSemáforo); procedure Signal (Sem: in out TSemáforo); private task type TSemáforo is entry Wait; entry Signal; end TSemáforo; end Semáforos; package body Semáforos is procedure Wait (Sem: in out TSemáforo) is begin Sem.Wait; -- Llamada a punto de entrada de la tarea. end Wait; procedure Signal (Sem: in out TSemáforo) is begin Sem.Signal; -- Llamada a punto de entrada de la tarea. end Signal; task body TSemáforo 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 TSemáforo; end Semáforos; with Semáforos; procedure Prueba_semáforos is package paquete_semáforos is new Semáforos; use paquete_semáforos; Semáforo: TSemáforo; begin -- Aquí se inicia la tarea de tipo TSemáforo (objeto Semáforo). -- ... Wait (Semáforo); -- ... Signal (Semáforo); -- ... end Prueba_semáforos;  

Simulación de trenes

Una simulación de trenes circulando por estaciones. Cada tren espera a que la estación siguiente esté libre para avanzar. Para ello se usan los semáforos definidos en el ejemplo anterior.

with Ada.Text_IO; use Ada.Text_IO; with Ada.Numerics.Float_Random; with Semáforos; 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 Semáforos_Inicial_1 is new Semáforos (Valorinicial => 1); use Semáforos_Inicial_1; Semáforos_Estaciones : array (Num_Estación) of TSemáforo; 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 (Semáforos_Estaciones (Siguiente)); Pon_Nombre; Put ("Trayecto hacia estación "); Put (Siguiente); New_Line; Signal (Semáforos_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;  

Buffer circular

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

generic type TElemento is limited 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 type TRangoBuffer is range 1..(Tamaño - 1); Buf: array (TrangoBuffer) of TElemento; Cima, Base: RangoBuffer := 0; NumElementos: Integer range 0..Tamaño := 0; begin loop select when NumElementos < Tamaño => accept Escribir (E: TElemento) do Buf(Cima) := E; end Escribir; Cima := RangoBuffer(Integer(Cima + 1) mod Integer(Tamaño)); NumElementos := NumElementos + 1; or when NumElementos >0 => accept Leer (E: out TElemento) do E := Buf(Base); end Escribir; Base := RangoBuffer(Integer(Base + 1) mod Integer(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); begin B.Leer (E); end LeerBuf; end Buffer_servidor; with Text_IO, Buffer_servidor; use Text_IO; procedure Buffer is type TMensaje is record NumOrden: Posotive; 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 (M.Contenido, Último); EscribirBuf (Cola, M); M.NumOrden := M.NumOrden + 1; end loop; end Emisor; task body Receptor is package Ent_IO is new Text_IO.Integer_IO(Integer); use Ent_IO; M: Mensaje; begin loop LeerBuf (Cola, M); exit when M.Contenido(1..5) = "Salir"; Put ("[Receptor] Mensaje número "); Put (M.NumOrden); Put (": "); Put (M.Contenido); New_Line; end loop; end Receptor; begin null; end Buffer;  

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;  

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;  

Manual de referencia de Ada

• 9.11 Example of Tasking and Synchronization∞