Ada (llenguatge de programació)

De Viquipèdia
Dreceres ràpides: navegació, cerca
High-contrast-utilities-terminal.pngAda (llenguatge de programació)
Desenvolupador Jean Ichbiah
Anomenat en referència a Ada Lovelace
Influenciat per ALGOL 68, Pascal, Modula-2, C++, Smalltalk, Java, Llenguatge de programació Eiffel i ALGOL 60
Etiqueta d'Stack Exchange http://stackoverflow.com/tags/Ada
Pàgina web Web oficial
Modifica dades a Wikidata

Ada és un llenguatge de programació estructurat i fortament tipat que fou dissenyat per Jean Ichbiah de CII Honeywell Bull per encàrrec del Departament de Defensa dels Estats Units. És un llenguatge d'ús general, orientat a objectes i concurrent, podent arribar des de la facilitat de Pascal fins a la flexibilitat de C++. El seu nom prové d'Ada Lovelace sovint considerada la primera escriptora de programes d'ordinador.[1]

Fou dissenyat pensant en la seguretat i amb una filosofia orientada a la reducció d'errors comuns i difícils de descobrir. Per això es basa en el tipat fort i en verificacions en temps d'execució (desactivables en benefici del rendiment). La sincronització de tasques es realitza mitjançant la primitiva de comunicació síncrona rendez-vouz (cat.: trobada).[2][3]

Ada s'usa principalment en entorns en què es necessita una gran seguretat i fiabilitat com pot ser la defensa, l'aeronàutica (Boeing o Airbus), la gestió del trànsit aeri (com Indra a l'Estat espanyol) i la indústria aeroespacial (ESA) entre d'altres, en estreta relació amb els Sistemes operatius de Temps Real.[4]

Contingut

Programa d'exemple[modifica | modifica el codi]

Aquest programa escriu "Hola, món!" al dispositiu de sortida per defecte (habitualment la consola de comandes).

-- fitxer hola.adb

-- mòduls dels quals depèn
with Ada.Text_IO; 
 
procedure Hola is

  use Ada.Text_IO;  -- importa espai de noms

begin
  Put_Line("Hola, món!");
end Hola;

Compilació i execució a Linux

gnatmake hola.adb

./hola

Compiladors[modifica | modifica el codi]

Des del Març de 2008 es disposa d'una versió experimental sobre el sistema LLVM.[5]

Característiques[modifica | modifica el codi]

Especificació i API biblioteca estàndard aquí.[6]

Lèxic[modifica | modifica el codi]

  • Tots els identificadors són independents de caixa de lletra (majúscula/minúscula). Abc equival a abc i també a ABC.

Sintaxi dels blocs de codi[modifica | modifica el codi]

function | procedure | declare
  -- declaracions
begin
  -- instruccions
exception
  -- gestors d'excepcions:
  when E: TipusExcepcio => -- tractament

  when E: others => -- tracta altres excepcions

end NomDelBloc ;

Tipus[modifica | modifica el codi]

Vegeu refs.[7][8][6]

Si no s'especifica un tipus predefinit, es dedueix el tipus base per les clàusules de restricció:

  • clàusula range : sencer -- restricció de rang
  • clàusula mod : "modulars" (naturals) -- restricció pel valor del mòdul
  • clàusula dígits : coma flotant -- precisió
  • clàusula delta : coma-fixa (binari si no s'especifica precisió);
    • cas de clàusula dígits addicional a la clàusula delta, llavors és coma-fixa decimal
  • range <> -- <> : restricció indefinida:
    • o bé abstracte (paràmetre formal d'un genèric)
    • o bé indica "rang per defecte"
    • o bé "rang segons implementació".

sencers[modifica | modifica el codi]

Predefinits:

  • sencers: Integer (mínim 16 bits)
  • subtipus Long_Integer (mínim 32 bits), opcionalment Long_Long_Integer (64 bits), Short_Integer (16 bits)
  • subtipus restringits: Natural [0..), Positive[1..)
  type Recompte is range 0 .. 999               -- restricció de rang sobre sencers

aritmètica sense signe (modulars)[modifica | modifica el codi]

  • sense signe: rang definit per l'operació mòdul, anomenats modulars.
  type Byte is mod 2**8

enumerats (discrets)[modifica | modifica el codi]

  • discrets: (enumeració d'identificadors o de caràcters). Predefinits: Boolean, Character
  type Hexa   is ('A', 'B', 'C', 'D', 'E', 'F');        
  type Boolean is (False, True) ;

coma flotant[modifica | modifica el codi]

  • predefinits: Float (precisió simple de 6 dígits), Long_Float (precisió doble de 15 dígits), ...
  type Percentatge is digits 4 range 0.0 .. 1.0 -- [[coma flotant]] precisió amb restricció de rang

coma fixa[modifica | modifica el codi]

  • coma fixa binaris o bé decimals quan s'especifica la precisió.
  • les operacions entre coma fixes de delta diferents són més ràpides si les deltes són potència de la base.
  type Kilo_Octet is delta 2.0**10               -- [[coma fixa]] binari, delta és el valor incremental (la resolució del tipus)
  type Durada is delta Resolució_rellotge

  type Centims_DEuro is delta 0.01 digits 14     -- [[coma fixa]] decimal quan incorpora precisió en dígits,
                        -- pels coma-fixa decimals la delta (resolució) ha d'ésser obligatòriament potència de deu.

Entrada / Sortida específica per tipus[modifica | modifica el codi]

Els mòduls d'entrada sortida són genèrics. Per imprimir o llegir valors, cal obtenir una instància del genèric adequat per al tipus específic.

  -- instància del genèric 'Integer_IO' per a la precisió Long_Integer
  package Long_Integer_IO is new Ada.Text_IO.Integer_IO (Long_Integer)
 
  -- instància del genèric 'Float_IO' per a la precisió Long_Float
  package Long_Float_IO is new Ada.Text_IO.Float_IO (Long_Float)
 
  -- instància del genèric 'Fixed_IO' (coma-fixa) per al tipus específic
  type Kilo_Octet is delta 2.0**10 ;
  package Kilo_Octet_IO is new Ada.Text_IO.Fixed_IO (Kilo_Octet) ;
 
  -- instància del genèric 'Enumeration_IO' per al tipus específic
  type Discret is (OPCIO_A, OPCIO_B) ;
  package Discret_IO is new Ada.Text_IO.Enumeration_IO (Discret) ;
 
  -- instància del genèric 'Modular_IO' per al tipus específic
  type Byte is mod 2**8 ;
  package Byte_IO is new Ada.Text_IO.Modular_IO (Byte) ;

Atributs[modifica | modifica el codi]

  • atributs dels tipus, després d'un apòstrof com el genitiu de l'idioma anglès (per ex.: John's car)[9]
-- lectura
  Positive'First   -- el primer del tipus
 
-- escriptura
  for Tipus'Atribut use ValorNouDeLAtribut    -- modificació d'atributs actualitzables

Constructor del tipus i conversions[modifica | modifica el codi]

-- constructor i components especificant '(x ,..) l'atribut per defecte: el constructor 
  K: Positive := Positive'(10)  

-- conversió amb NomDelTipus( expressió)
  Percentatge( Valor/100.0)

Tipus derivats i subtipus[modifica | modifica el codi]

  • tipus derivats: amb new el compilador els discrimina
  • categories: subtipus (acceptats en paràmetres del tipus)
  type Poma is new Recompte range 0 .. 100

  subtype OuDeLaDotzena is OuDelGalliner range 0 .. 12

Registres i punters[modifica | modifica el codi]

  • registres
  type Registre is record
      A, B : Boolean;
      Mida : Positive;
  end record;
  VarR : Registre := (A => False, B => True, Mida => 10) ;
  • punters (amb access)[10]
  -- Amb ''access''/''access constant'' només poden apuntar dins el propi dipòsit de dades (''storage pool'')
  type PunterARegistre is [not_null] ''access'' Registre            -- accés RW
  type PunterARegistre is [not_null] ''access constant'' Registre   -- accés RO

  -- Amb ''access all'' els punters no tenen restriccions d'apuntament.
  type PunterARegistre is [not_null] ''access all'' Registre        -- accés RW
  • Per assignar un nou valor a l'objecte apuntat cal desreferenciar el punter amb .all (equival en C a prefixar un punter amb l'asterisc: * punter)
  punterARegistreTal.all := (A => False, B => True, Mida => 10) ;
  • limited: per al cas d'estructures amb punters, prohibeix les operacions d'assignació (:=) i comparació (=) que ho fan bit a bit (superficials). (Per exemple, la comparació estructural de nodes encadenats no estaria garantida amb (=) doncs només compara bit-a-bit les primeres ceŀles)
  type Tupla is record     -- no limitat, admet assignació i comparació bit a bit del registre
      A, B : Boolean;
  end record;  
  
  type Llista is ''limited'' record  -- limitat, la comparació estructural no es pot basar 
                                     --      en la igualtat bit a bit de la primera cel·la. 
      Cap: Integer ;
      Cua: access constant Llista    -- PunterALlista 
  end record ;

Vectors, Tipus paramètrics, Variants[modifica | modifica el codi]

  • vectors
  type VectorDeSencers is array (1 .. 10) of Integer
  -- exemple d'ús amb inicialització 
  --   (el d'índex 1 => 15, el segon 16, altres => valor_per_defecte)
  VA: VectorDeSencers := (1 => 15, 2 => 16, others => 0)
  • tipus indexats (depenents de valors)
 type BUFFER( MIDA : BUFFER_SIZE := 100)  is        
       record
          Posicio : BUFFER_SIZE := 0;
          Valor : STRING(1 .. MIDA);
       end record;
    type TIP_ARBRE is (FULLA, BRANCA) ;
  
    type ARBRE_DE_SENCERS( Constructor: TIP_ARBRE) is record     -- registre variant
          case Constructor is
            when FULLA => dadaFulla: Integer ;
            when BRANCA => dadaNus: Integer ;
                           esquerre,dreta: access ARBRE_DE_SENCERS;   -- punters a arbres
        end case ;
    end record ;

Genèrics - Parametrització de tipus en mòduls, procediments i funcions[modifica | modifica el codi]

  • Cal precedir l'element a parametritzar amb la clàusula generic seguida dels paràmetres de tipus.
  • Tipus formals: paràmetres formals de tipus en un genèric.

Vegeu exemple #Composició. Mòduls genèrics i Functors.

 generic
    type Item is private;                              -- paràmetre de tipus opac 
    type Poma  is range <>;                            -- paràmetre de tipus enter, <>: abstracte en el rang 
    type Mass  is digits <>;                           -- paràmetre de tipus coma flotant, <>: abstracte en la precisió 
    type Angle is delta <>;                            -- paràmetre de tipus coma fixa binari, <>: abstracte en la resolució (valor mínim)
    type Esdeveniment is (<>);          -- paràmetre de tipus enumerable (pels parèntesis) <>: abstracte en els valors

    type Buffer(Length : Natural) is limited private;  -- paràmetre de tipus indexat 
         -- (limited: assig. i comparació superficials prohibides (quan hi ha punters)) (private: opac)
   
 
    type Table is array (Esdeveniment) of Item;        -- paràmetre de tipus vector amb tipus d'elements i d'índex declarats prèviament

Depuració, Assercions i Contractes[modifica | modifica el codi]

Assercions[modifica | modifica el codi]

Des de l'Ada2005.[11]

pragma Assert([Check =>] boolean_expression[, [Message =>] string_expression]);

havent afegit la següent pragma de configuració a l'inici del fitxer o al fitxer de configuració del projecte gnat.adc

pragma Assertion_Policy(Check) ;

Precondicions i Postcondicions[modifica | modifica el codi]

Des de l'Ada2012.[12]

generic
   type Elem is private;

package Piles is
   type Pila is private;

   function Es_Buit(S: Pila) return Boolean;
   function Es_Ple(S: Pila) return Boolean;

   procedure Apila(S: in out Pila; X: in Elem)
      with
         Pre => not Es_Ple(S),
         Post => not Es_Buit(S);

   procedure Desapila(S: in out Pila; X: out Elem)
      with
         Pre => not Es_Buit(S),
         Post => not Es_Ple(S);
private
      ...
end Stacks;

API estàndard i predefinits[modifica | modifica el codi]

  • API biblioteca estàndard.[6]
  • Atributs dels tipus estàndard.[9]
  • Elements predefinits (mòdul Ada.Standard)[13]

Gestió de memòria[modifica | modifica el codi]

Ada permet a l'usuari un control fi de la gestió de memòria així com definir els seus propis gestors.[14]

Tipus de gestors[modifica | modifica el codi]

Gestors d'allotjament de mem. dinàmica (Storage_Pool) assignables a diferents tipus de dades[15][16]

Munt d'allotjament (ang: heap) principal de vida il·limitada[modifica | modifica el codi]

Amb el tipus de gestor Unbounded_No_Reclaim de System.Pool_Global

Segons la ref. el recol·lector de brossa no hi passa.[17] Al codi, però no a l'estàndard, hi diu: Allotjament per defecte dels tipus de punters declarats globalment.[18] GNAT de GNU permet associar-hi un recol·lector de brossa recompilant GCC amb --enable-objc-gc incorporant la biblio. libobjc-gc.a si l'arquitectura la suporta.[19]

Munt d'allotjament amb vida associada a un àmbit[modifica | modifica el codi]

Amb el tipus de gestor Unbounded_Reclaim_Pool de System.Pool_Local.

Quan l'execució surt de l'àmbit on el munt (Storage Pool) està definit, se'n reclama la memòria.[16] Al codi, però no a l'estàndard, hi diu: Allotjament per defecte dels tipus de punters declarats localment.[20] Sembla que era una pràctica en alguns compiladors de l'Ada83. AdaCore parla d'associació explícita.[16] Vegeu exemple #Allotjament dinàmic i Memòria d'àmbit.

 Local_Pool: System.Pool_Local.Unbounded_Reclaim_Pool;  -- munt reclamat en sortir de l'àmbit

 for Punter_A_T'Storage_Pool use Local_Pool ;

 -- en sortir de l'àmbit, el Local_Pool queda inaccessible
 --   i se n'executa automàticament el mètode ''Finalize'' que n'allibera la memòria.
Munt d'allotjament a la pila[modifica | modifica el codi]

Amb tipus de gestor Stack_Bounded_Pool de System.Pool_Size, per reservar memòria dinàmica a la pila de manera acotada.

Allotja elements d'un únic tipus.[21] El manual de AdaCore diu que aquest mòdul no està pensat per un ús directe per l'usuari, i que és el que es fa servir automàticament quan s'especifica el nombre d'elements per al tipus de punter.[16]

 for Punter_A_T'Storage_Size use 10_000; -- reserva un Stack_Bounded_Pool per a 10000 elems. del tipus

Tipus de punters[modifica | modifica el codi]

  • Punters (clàusula access) restringits a apuntar només a elements de l'Storage_Pool associat al seu tipus.[14]
type Punter_A_Sencer is access Integer ;
for Punter_A_Sencer'Storage_Pool use Nom_del_Pool;  -- assignació de Storage_Pool específic a un tipus
  • Punters no restringits (clàusula: access all): permet apuntar a elements de qualsevol Storage_Pool
  • Punters amb accés de només lectura (clàusula: access constant)[22]
aliased
Qualificador per indicar que un element d'una estructura pot ser accedit per punter i evitar que l'optimitzador del compilador l'empaqueti.[23]

Registres amb membres punters i restricció de còpia/comparació superficials[modifica | modifica el codi]

  • Les operacions d'assignació (:=) i comparació (=) són superficials (bit a bit), no tenen en compte si el registre conté punters.
  • Es pot retornar un registre (tipus compost) com a resultat d'una funció.
  • El qualificador limited: prohibeix assignacions i comparacions superficials (bit a bit) per a tipus que designin estructures de més profunditat (per quan hi ha punters).[24]

Allotjament i desallotjament de dades referides per punters[modifica | modifica el codi]

new
allotjament amb new Punter_A_Tipus,
Unchecked_Deallocation
alliberament amb Unchecked_Deallocation similar al Free() del C/C++[25][26] Vegeu exemple #Allotjament dinàmic i Memòria d'àmbit

Directives de compilació (Pragma) relacionades amb la memòria[modifica | modifica el codi]

Pragma Controlled
Pragma per evitar que el recol·lector de memòria brossa (si l'habilitem), gestioni un determinat tipus[27]
Volatile
Pragma per indicar que un element de memòria pot ser modificat externament i cal llegir-lo a memòria cada vegada evitant optimitzacions.[28]
Atomic
Pragma per forçar la lectura i escriptura de manera atòmica (no interrompible i respectant l'ordre a les CPU's de procés especulatiu( ang: out-of-order CPU))[29]

Orientació a objectes[modifica | modifica el codi]

  • Classes d'objectes formades per
    1. un tipus tagged (etiquetat), descrit a la implementació com a registre amb els camps de l'objecte.
    2. procediments i funcions de la instància quan el primer paràmetre és la instància del tipus definit.
    3. procediments i funcions estàtiques (de la classe) quan no duen la instància com a primer paràmetre.
  • Els procediments i funcions a nivell de paquet són heretables (virtuals).
  • Per definir generadors i altres funcions com a no-heretables cal fer-ho en un submòdul.
package Persona is
   type Objecte is tagged     -- ''etiquetat'' (defineix el tipus com a constitutiu de classe)
                   private ;  -- private: definició opaca dels camps

   procedure MètodeDeLaInstància (This : Objecte);  -- la instància és el primer paràmetre

   procedure MètodeEstàtic (Param: Integer); -- no duu la instància com a primer paràmetre

   function To_String( This: Objecte) return String; -- per a l'exemple a ''herència''

   -- submòdul 
   package Eines is
     -- Generadors i Funcions que no volem que s'heretin han d'estar en un submòdul.
     function Nou_Persona (...) return Objecte ;
   end Eines ;
private
   type Objecte is tagged record    -- camps de dades del tipus de la classe
         Nom   : String (1 .. 10);
         Gènere : Tipus_Gènere;
     end record;
end Persona;

Vegeu exemple.

herència[modifica | modifica el codi]

  • qualificatiu overriding per redefinir un procediment o funció
  • per referir-se al mètode homònim de la classe base, cal caracteritzar la instància amb el tipus del pare, mitjançant una conversió de tipus: Tipus_del_pare( This).
with Persona;

package Programador is
   type Objecte is new Persona.Objecte -- nou tipus ''Objecte'' derivat de Persona.Objecte
                   with private;  -- opac, definit a l'àrea privada

   overriding function To_String( This: Objecte) return String; 

   type Llenguatge is (LLENG_ADA, HASKELL, OCAML); -- ADA és paraula reservada

   package Eines is  -- submòdul per a funcions no heretables

     function Nou_programador (pers: Persona.Objecte; esp: Llenguatge) return Objecte ;
   end Eines ;

private
   type Objecte is new Persona.Objecte with   -- objecte derivat del tipus de la superclasse
     record                                   -- ampliació del registre de camps    
        Especialitat : Llenguatge;
     end record;
end Programador;
-- implementació
with Ada.Text_IO ;
with Ada.Strings ;

package body Programador is

   package body Eines is
     function Nou_programador (pers: Persona.Objecte; esp: Llenguatge) return Objecte is
     begin
       return Objecte'(pers with Especialitat => esp); -- extensió de registre
     end ;
   end Eines ;

   package Llenguatge_IO is new Ada.Text_IO.Enumeration_IO (Llenguatge) ;

   function To_String( This: Objecte) return String is
     str_Esp: String (1..20) ;
   begin
     Llenguatge_IO.Put( To => str_Esp, Item => This.Especialitat) ;

     return (Persona.To_String(           -- crida al mateix mètode, a la superclasse
                Persona.Objecte( This))   -- caracterització a la superclasse
             & "; Especialitat: " & str_Esp) ;
   end ;
   ...
end Programador ;

Constructors, Destructors i Clonadors[modifica | modifica el codi]

Per fer una gestió fina de la memòria cal que els tipus implementin les classes Controlled o bé Limited_Controlled, que proporcionen mètodes per intervenir en les ops. de lligar un objecte a una variable i en deslligar-lo.

Sobre aquestes classes abstractes s'hi pot implementar, si hom vol, un mecanisme d'alliberament per comptador de referències.[30] Com a l'exemple més avall.

El mòdul Ada.Finalization incorpora les classes abstractes Controlled i Limited_Controlled que ofereixen mètodes cridats automàticament en inicialitzar, en assignar, i en sortir de l'àmbit les variables dels tipus de les classes que se'n derivin. Vegeu refs.[31][32]

  • Classe Controlled: amb mètodes abstractes Initialize, Adjust i Finalize (cridats respectivament de manera automàtica,
  1. Initialize, cridat en la declaració de variables del tipus quan no s'inicialitzen.
  2. Finalize, cridat en deslligar l'objecte de la variable, perquè, o bé se li ha assignat un altre valor a la variable, o bé la variable surt de l'àmbit.
  3. Adjust, cridat en lligar un objecte a una variable en les assignacions, pel cas que hi hagi punters, poder completar la clonació d'una estructura després de la còpia superficial (bit a bit) que el compilador genera per a l'objecte.
  • Classe Limited_Controlled: Inclou Initialize, i Finalize però no Adjust.
  • En els mètodes Adjust i Finalize s'hi pot implementar un comptador de referències com a l'exemple proposat.

Tipus definits per signatures (Interface)[modifica | modifica el codi]

Des de l'Ada2005.

package Imprimible is

   type Objecte is interface;

   procedure Imprimeix (This : Objecte) is abstract;  -- is abstract => cal implementar-lo en classes derivades.
   procedure UnAltreMètode (This : Objecte) is null; -- is null => buit, no requereix implem. en classes derivades.

end Imprimible;
with Programador ;
with Imprimible ;

package ProgramadorAmbImprimible is

  type Objecte is new Programador.Objecte  -- derivat de Programador.Objecte
                  and Imprimible.Objecte   -- i també de Imprimible.Objecte
                  with private;  

  procedure Imprimeix (This : Objecte) ;   -- redefineix el procediment virtual (abstracte a Imprimible)

private 
  -- declaració privada
end ProgramadorAmbImprimible ;

package body ProgramadorAmbImprimible is

  procedure Imprimeix (This : Objecte) is  -- implementa Imprimible 
  begin
    ...
  end ;
end ProgramadorAmbImprimible ;

Concurrència[modifica | modifica el codi]

  • Fils d'execució:
    • La clàusula task designa un fil d'execució que engega tot just en acabar d'inicialitzar la construcció que l'enclou. (exemple).
    • La seva definició inclourà els canals d'entrada (Entry) del fil d'execució.
  • Exclusió mútua i espera condicionada (POSIX condition variables): La construcció Protected incorpora un monitor a l'estructura. (exemple)
  • Transferència de control asíncrona: La clàusula select {esdeveniment} then-abort procediment pot incloure un procediment que es cancel·larà en el moment que s'esdevingui algun dels esdeveniments especificats al select.(exemple)[33]

Compilació[modifica | modifica el codi]

  • Compilació: compila l'arbre de paquets obtingut de les clàusules d'importació with Nom_Paquet;
gnatmake hola.adb
  • Compilació separada:
gcc -c hola.adb
gnatbind hola    # genera b~hola.ads i .adb que conté el ''package ada_main'' autogenerat de l'aplicació.
gnatlink hola

Fitxer de configuració del projecte[modifica | modifica el codi]

  • El fitxer gnat.adc es pot establir per contenir Pragmes de Configuració del projecte del directori.[34] El compilador cercarà el fitxer de configuració al directori de treball.

L'ordre d'inicialització dels mòduls[modifica | modifica el codi]

El mòdul autogenerat ada_main inclou els procediments d'inicialització adainit i de tancament adafinal. El procediment adainit executa la inicialització de cada mòdul en l'ordre deduït de les clàusules with i les pragmes Elaborate.

Vegeu ref.[35]

  • gnatbind: genera els fitxers .ads i .adb que conté el mòdul ada_main, amb nom de fitxer obtingut prefixant amb b~ el nom del mòdul principal.

L'ordre d'inicialització es pot alterar quan a un mòdul li convé que un altre s'inicialitzi abans, especificant-ho amb la pragma Elaborate o Elaborate_All.[35]

 -- força la inicialització prèvia del mòdul_M i els mòduls que importi.
 --    alterant l'ordre d'exec. de les inicialitzacions al procés autogenerat ''adainit''
 Pragma Elaborate_All (mòdul_M)

Generació de biblioteques[modifica | modifica el codi]

En cas de voler generar una biblioteca en comptes d'un executable, caldrà fer un programa principal de pega que cridi a les rutines de la biblioteca i extreure'n del mòdul principal generat (ada_main) els processos d'inicialització i tancament adainit i adafinal que inclourem a les rutines d'inicialització i finalització de la biblioteca de relligat dinàmic (.dll o bé .so), nom_biblioinit i nom_bibliofinal.[36]

JGNAT a la Màquina Virtual Java[modifica | modifica el codi]

AdaCore, mantenidor del compilador GNAT, disposa a la pàgina de descàrregues de codi obert d'una versió per a "jvm-windows"[37][38] que també funciona sobre Linux mitjançant l'emulador Wine excepte pels caràcters no anglosaxons (la codif. de caràcters és Latin-1 a Windows i UTF-8 a GNU/Linux).

Compilació a GNU/Linux:

  wineconsole --backend=curses cmd
     jvm-gnatmake -gnat05 principal
     exit

Execució (a la consola Unix):

  export JGNAT_JAR=~/.wine/drive_c/GNAT/2010/lib/jgnat.jar
  java -cp .:$JGNAT_JAR principal

Exemples[modifica | modifica el codi]

Composició. Mòduls genèrics i Functors[modifica | modifica el codi]

  • La biblio paramètrica en tipus i operacions (funció d'un tipus T i d'una op. formal Producte) :
-- fitxer la_meva_biblio.ads -- signatura

generic 
    type T is private;                           -- paràmetre de tipus (''private'': tipus opac)
    with function Producte (X, Y: T) return T;   -- paràmetre funció
                                                  --     el param. actual ha de coincidir en la signatura de la funció

package La_Meva_Biblio is

  function Quadrat (x:T) return T ;

end La_Meva_Biblio ;
-- fitxer la_meva_biblio.adb -- implementació

package body La_Meva_Biblio is

  -- implementa Quadrat basat en la funció Producte que és paràmetre del genèric
  function Quadrat (x:T) return T is
  begin
    return Producte (x, x) ;
  end quadrat ;

end La_Meva_Biblio ;
  • Un Functor (mòdul amb un mòdul abstracte com a paràmetre formal). Transformarà instàncies que implementin La_Meva_Biblio.
-- fitxer el_meu_functor.ads -- signatura
with La_Meva_Biblio ;

generic 
    with package Biblio is new La_Meva_Biblio (<>);   -- mòdul formal. cal que el mòdul paràmetre actual n'implementi la signatura
                                                      -- en aquest cas, cal que sigui derivat de La_Meva_Biblio
                                                      -- <>: indefinit en la parametrització (abstracte)

package El_meu_functor is

  use Biblio;                     -- incorpora l'espai de noms del mòdul formal

  function Cub(x: T) return T ;

  function Quadrat(x: T) return T renames Biblio.quadrat;  -- publica una funció del mòdul formal

end El_meu_functor ;
-- fitxer el_meu_functor.adb -- implementació
package body El_Meu_Functor is

  function Cub (x:T) return T is
  begin
    return Producte ( Quadrat( x), x) ;
  end ;

end El_Meu_Functor ;
  • El principal:
-- fitxer principal.adb

-- paquets per relligar amb el ''linker''
with La_Meva_Biblio ;
with El_Meu_Functor ;
with Ada.Text_IO; 
 
procedure Principal is
  -- nom curt per al mòdul
  package TextIO renames Ada.Text_IO ;

  -- instanciem mòduls genèrics per a l'entrada/sortida dels tipus primitius per als tipus concrets

  package IntIO is new Ada.Text_IO.Integer_IO (Integer);       -- Integer_IO per a precisió Integer
  package LFloatIO is new Ada.Text_IO.Float_IO (Long_Float) ;  -- Float_IO per a precisió Long_Float
  package BoolIO is new Ada.Text_IO.Enumeration_IO (Boolean) ; -- Enumeration_IO per al cas Boolean

  -- instanciem biblioteques

  package La_Meva_Biblio_sobre_Sencers is new La_Meva_Biblio( T => Integer, Producte => "*") ;
  package La_Meva_Biblio_sobre_Reals is new La_Meva_Biblio( T => Long_Float, Producte => "*") ;

  package El_Meu_Functor_sobre_Sencers is new El_Meu_Functor( La_Meva_Biblio_sobre_Sencers) ;
  package El_Meu_Functor_sobre_Reals is new El_Meu_Functor( La_Meva_Biblio_sobre_Reals) ;

  -- declaració variables
  
  i : constant Integer := 2 ;
  j,k : Integer ;
  x : constant Long_Float := 2.0 ;
  y,z : Long_Float ;

  comprovacio: Boolean ;

begin
  j := La_Meva_Biblio_sobre_Sencers.Quadrat( i) ;
  y := La_Meva_Biblio_sobre_Reals.Quadrat( x) ;

  k := El_Meu_Functor_sobre_Sencers.Cub( i) ;
  z := El_Meu_Functor_sobre_Reals.Cub( x) ;

  TextIO.Put("Quadrat i Cub de 2 Integer, i comprovació:");
  IntIO.Put( j, Width => 4);                              -- format: %4d
  IntIO.Put( k, 4) ;

  comprovacio := j = El_Meu_Functor_sobre_Sencers.Quadrat( i) ;

  TextIO.Put( " ") ;
  BoolIO.Put( comprovacio) ;

  TextIO.New_Line( Spacing => 2); -- spacing: nombre de salts de línia

  TextIO.Put("Quadrat i Cub de 2.0 Long_Float, i comprovació:");
  LFloatIO.Put( y, Fore => 3, Aft => 2, Exp => 0);        -- format: %3.2f; Exp (dígits exponent)
  LFloatIO.Put( z, 3, 2, 0) ;

  comprovacio := y = El_Meu_Functor_sobre_Reals.Quadrat( x) ;

  TextIO.Put( " ") ;
  BoolIO.Put( comprovacio) ;

  TextIO.New_Line;                 

end Principal;

Compila i executa:

 gnatmake principal.adb
 ./principal

dóna el resultat:

Quadrat i Cub de 2 Integer, i comprovació:   4   8 TRUE

Quadrat i Cub de 2.0 Long_Float, i comprovació:  4.00  8.00 TRUE

Composició en O.O. - Parametritzant per tipus d'objecte[modifica | modifica el codi]

Parametritzant per tipus d'objecte amb requeriments de superclasse i interfaces

  • Les constants de configuració de l'aplicació
-- fitxer definicions.ads
package Definicions is
  TITOL_APLICACIO : constant String := "Títol_aplicació" ;
end Definicions ;
  • L'interface :
-- fitxer imprimible.ads -- només signatura
package Imprimible is

  type Objecte is interface ;

  procedure Imprimeix( obj: Objecte) is abstract;  -- is abstract => cal redefinir-lo en la classe derivada
  -- procedure Imprimeix( obj: Objecte) is null;   -- is null => no implementat, no és obligat redefinir-lo

end Imprimible ;
  • La biblio paramètrica en un tipus descendent d'un tipus d'objecte i amb requeriment d'interface
-- fitxer la_meva_biblio.ads -- signatura
with Persona ;
with Imprimible ;

generic 
    type T is new Persona.Objecte and Imprimible.Objecte with private;     -- tipus formal 
                                           -- (cal que sigui derivat de Persona.Objecte 
                                           --   i que implementi Imprimible.Objecte)

package La_Meva_Biblio is

  procedure ImprimeixISaltaLinia (obj:T) ;

end La_Meva_Biblio ;
-- fitxer la_meva_biblio.adb -- implementació
with Ada.Text_IO ;
with Ada.Text_IO.Bounded_IO ;

with Ada.Strings ;
with Ada.Strings.Bounded;

package body La_Meva_Biblio is

  MAX_BUF : constant Integer := 20 ;
  package SB_Buf is new Ada.Strings.Bounded.Generic_Bounded_Length ( MAX_BUF) ;
  package SB_Buf_IO is new Ada.Text_IO.Bounded_IO( SB_Buf) ;

  package TextIO renames Ada.Text_IO ;

  títol: SB_Buf.Bounded_String ;

  procedure ImprimeixISaltaLinia (obj:T) is
  begin
    SB_Buf_IO.Put ( títol) ;
    Imprimeix (obj) ;
    TextIO.New_Line( Spacing => 1) ;

  end ImprimeixISaltaLinia ;

begin                                           -- inicialització de mòdul
                                                -- útil per inicialitzacions que depenen d'un altre mòdul

  títol := SB_Buf.To_Bounded_String( Definicions.TITOL_APLICACIO & ": ") ;

end La_Meva_Biblio ;
  • La classe arrel Persona (incorpora un constructor i un mètode Put_To_String( obj))
-- fitxer persona.ads -- signatura
with Ada.Strings.Bounded;    -- cadenes de text acotades

package Persona is

  type Objecte is tagged private;  -- ''tagged'': objectes, ''private'': opac, definit a l'àrea privada
 
  function Put_To_String( obj: Objecte) return String ;

  package Eines is       -- mòdul niuat per a les funcions que no volem virtuals (heretables)

    function Nou_Persona( nom: String; edat: Integer) return Objecte ;
  end Eines ;

  MAX_NOM : constant integer := 16 ;
  package SB_Nom is new Ada.Strings.Bounded.Generic_Bounded_Length ( MAX_NOM) ;

private 
  type Objecte is tagged record
         Nom: SB_Nom.Bounded_String ;
         Edat: Integer ;
  end record ;

end Persona;
-- fitxer persona.adb -- implementació
with Ada.Text_IO ;
with Ada.Strings ;
with Ada.Strings.Fixed ;
with Ada.Strings.Bounded ;

package body Persona is

  package IntIO is new Ada.Text_IO.Integer_IO (Integer) ;

  package body Eines is       -- mòdul niuat per les funcions que no volem virtuals (heretables)

    function Nou_Persona( nom: String; edat: Integer) return Objecte is
    begin
      return Persona.Objecte'( Nom => Persona.SB_Nom.To_Bounded_String(nom)
			, Edat => edat
			      ) ;
    exception
      when E: Ada.Strings.Length_Error => 
                               Ada.Text_IO.Put( "error: nom massa llarg, màxim: ") ;
                               IntIO.Put( MAX_NOM) ;
                               Ada.Text_IO.New_Line( 1) ;
                               raise ;
 
    end Nou_Persona ;
  end Eines ;

-----------------------
  function Put_To_String( obj: Objecte) return String is

    MAX_BUF : constant Integer := 40 ;
    package SB_Buf is new Ada.Strings.Bounded.Generic_Bounded_Length ( MAX_BUF) ;

    sb_buf1: SB_Buf.Bounded_String ;
    buf2: String (1 .. 10) ;

    use SB_Buf;   -- incorpora espai de noms
    use Ada.Strings ;

    begin
      sb_buf1 := To_Bounded_String( SB_Nom.To_String( obj.nom)) ;

      IntIO.Put (To => buf2, Item => obj.edat) ;

      return To_String( sb_buf1 & " " & Fixed.Trim( buf2, Left)) ;
  end Put_To_String ;

end Persona;
  • La classe derivada Programador: implementa l'interface i, a banda, incorpora un constructor i sobrescriu el mètode Put_To_String( obj).
-- fitxer programador.ads -- signatura
with Persona ;
with Imprimible ;

package Programador is

  type Objecte is new Persona.Objecte              -- deriva de Persona.Objecte       
                    and Imprimible.Objecte         -- i també de Imprimible.Objecte
                    with private;                 -- extensió de camps opaca (a l'àrea privada)

  overriding function Put_To_String( obj: Objecte) return String;    -- sobrescriu mètode de la superclasse

  procedure Imprimeix (obj: Objecte) ;

  type Llenguatge is (LLENG_ADA, HASKELL, OCAML, SCALA);    -- LLENG_ADA doncs ADA és nom reservat

  package Eines is     -- mòdul niuat per les funcions que no volem virtuals (heretables)

    function Nou_Programador( nom: String; edat: Integer; especialitat: Llenguatge) 
		  return Objecte ;
  end Eines ;

private

  type Objecte is new Persona.Objecte and Imprimible.Objecte with record  -- extensió de registre de camps

    Especialitat: Llenguatge ;
  end record; 

end Programador;
-- fitxer programador.adb -- implementació
with Ada.Text_IO ;
with Ada.Strings ;
with Ada.Strings.Bounded ;

package body Programador is

  package body Eines is   -- mòdul niuat per les funcions que no volem virtuals (heretables)

    function Nou_Programador( nom: String; edat: Integer; especialitat: Llenguatge) 
		    return Objecte is
    begin
      return Objecte'(Persona.Eines.Nou_Persona( nom, edat) with Especialitat => especialitat) ;
    end Nou_Programador ;
  end Eines ;

------------
  function Put_To_String( obj: Objecte) return String is

    package Llenguatge_IO is new Ada.Text_IO.Enumeration_IO( Llenguatge) ;

    MAX_BUF : constant Integer := 60 ;
    package SB_Buf is new Ada.Strings.Bounded.Generic_Bounded_Length ( MAX_BUF) ;

    sb_buf1: SB_Buf.Bounded_String ;
    buf2: String (1 .. 12) ;

    use SB_Buf;   -- incorpora espai de noms

    begin
      sb_buf1 := To_Bounded_String( 
                      Persona.Put_To_String(   -- crida al mètode homònim de la superclasse
                           Persona.Objecte( obj)   -- cal fer un ''up-cast'' (caracterització) de l'objecte 
                                                   --   al supertipus corresp. al mètode
                      )) ;

      Llenguatge_IO.Put( buf2, obj.especialitat) ;

      return To_String( sb_buf1 & " " & buf2) ;
  end Put_To_String ;

------------
  procedure Imprimeix (obj: Objecte) is

    package TextIO renames Ada.Text_IO ;

  begin
    TextIO.Put ("Programador: ") ;
    TextIO.Put ( Put_To_String( obj)) ;
  end Imprimeix ;

end Programador;
  • Principal:
-- fitxer principal.adb
with La_Meva_Biblio ;
with Programador ;
 
procedure Principal is

  package La_Meva_Biblio_ProgImp is new La_Meva_Biblio( T => Programador.Objecte) ;

  obj : Programador.Objecte ;

  use Programador;   -- incorpora espai de noms del mòdul
  use La_Meva_Biblio_ProgImp ;

begin
  obj := Eines.Nou_Programador( "Gabriel", 59, Especialitat => HASKELL) ;
  
  ImprimeixISaltaLinia( obj) ;
end Principal;

Compila i executa:

 gnatmake principal.adb
 ./principal

Comunicació síncrona (rendez-vous)[modifica | modifica el codi]

Vegeu ref.[39]

task: fil d'execució (ang: ''thread'')
entry: canal d'entrada (bústia de comunicació amb cua de missatges)

[40]

(when condició => accept canal) : entrada del canal amb guarda (procés condicionat)
Activació de tasques[41]
-- fitxer prova.adb
with Ada.Strings ;
with Ada.Strings.Fixed ;
with Ada.Strings.Bounded ;

with Ada.Text_IO ;
with Ada.Text_IO.Bounded_IO ;

procedure Prova is
  package TextIO renames Ada.Text_IO ;

  str1 : String := "abcdefghi" ;
  MAX_BUF : constant Integer := str1'Last ;

  package SB_Buf is new Ada.Strings.Bounded.Generic_Bounded_Length ( MAX_BUF) ;
  package SB_Buf_IO is new Ada.Text_IO.Bounded_IO( SB_Buf) ;

  sb_buf2 : SB_Buf.Bounded_String ;

  type T_ESTAT is range 1..(MAX_BUF +1) ;

  task Automata is                  -- task és fil d'execució (''thread'')
    entry Llegeix( ch: in Character);   -- canal d'entrada
    entry Imprimeix;                    -- canal d'entrada
  end Automata ;

  task body Automata is          -- l'activació s'inicia en completar la inicialització de l'objecte que l'enclou
    
    Estat: T_ESTAT := T_ESTAT'First ;
    -- use SB_Buf ;
  begin
    loop
      select
	when Estat < T_ESTAT'Last =>
		accept Llegeix( ch: in Character) do

                    SB_Buf.Append( sb_buf2, ch) ;
                    TextIO.Put( ch);                -- fem l'eco 
		end Llegeix ;
		Estat := Estat +1 ;
      or
        when Estat = T_ESTAT'Last =>
	      accept Imprimeix do

                TextIO.New_Line ;
		SB_Buf_IO.Put( sb_buf2 ) ;
	      end Imprimeix ;
      or 
        terminate;  -- acaba quan hi ha una opció ''terminate'' oberta
                     -- i no hi ha entrades pendents 
                     -- i totes les tasques (fils d'execució) estan igual 
                     -- i el procés principal enllesteix.

      -- o bé, en comptes d'acabar, especificar un lapse de temps i les accions a prendre

        delay 1.0; TextIO.New_Line -- termini i accions subseqüents al venciment

      end select ;
    end loop ;
              
  end Automata ;
begin
  for i in str1'Range loop

    Automata.Llegeix( str1( i)) ;
    delay 0.2 ;

  end loop ;
  Automata.Imprimeix ;

end prova ;
gnatmake prova.adb
./prova

Transferència de control asíncrona[modifica | modifica el codi]

Càlculs abortables per venciment de terminis o altres esdeveniments esmentats a la clàusula select. Detalls a la documentació.[42]

select
   -- ''delay or triggering statement''
   delay 5.0;
   Put_Line("El càlcul no convergeix");
then abort
   -- Aquest càlcul està limitat en temps pel termini prèviament esmentat
   Càlcul_que_pot_excedir_el_temps_tolerable(X, Y) ;
end select;

protected - Exclusió mútua i accés condicionat[modifica | modifica el codi]

La construcció protected aporta coherència al manteniment d'estructures compartides per diferents fils d'execució.

Aporta un monitor a l'estructura per garantir l'exclusió mútua dels fils d'execució que executin els membres exportats de l'estructura.[43]

Les clàusules Entry permeten condicionar el desblocatge d'execució (monitor) a una condició expressada en la clàusula when.

-- fitxer prova.adb   -- procés cua d'esdeveniments

with Ada.Text_IO ;
with Ada.Containers.Doubly_Linked_Lists ;

procedure Prova is

  package TextIO renames Ada.Text_IO ;

  type TEsdeveniment is (SUCCES_A, SUCCES_B, FINAL) ;

  package TEsdeveniment_IO is new Ada.Text_IO.Enumeration_IO (TEsdeveniment) ;

  package Cua_Esdev is new Ada.Containers.Doubly_Linked_Lists (TEsdeveniment); -- cua de dos caps, il·limitada

----------------

  protected Cua_Protegida is

    procedure Afegir( Esdev: TEsdeveniment);        -- procedure (no bloca) (cua és il·limitada) 
    entry Retirar_Primer(Esdev: out TEsdeveniment); -- entry  (pot blocar) (Retirar_Primer requereix cua no buida)
  private
    Cua: Cua_Esdev.List ;
  end Cua_Protegida;  

  protected body Cua_Protegida is

    procedure Afegir( Esdev: TEsdeveniment) is
    begin
      Cua_Esdev.Append( Cua, Esdev) ;
    end Afegir;

    entry Retirar_Primer (Esdev: out TEsdeveniment)    -- canal d'entrada 
           when not Cua_Esdev.Is_Empty( Cua) is        -- requeriment d'accés
    begin
      Esdev := Cua_Esdev.First_Element( Cua) ;
      Cua_Esdev.Delete_First( Cua) ;
    end Retirar_Primer;
      
  end Cua_Protegida ;

----------------

  task Processa_Esdeveniments;   -- no exporta res

  task body Processa_Esdeveniments is
  Es_Final: Boolean := False ;
  begin
    while not Es_Final loop
      declare
        Esdev: TEsdeveniment ;
      begin

        Cua_Protegida.Retirar_Primer( Esdev) ;

        TEsdeveniment_IO.Put( Esdev) ;
        TextIO.New_Line ;

        Es_Final := Esdev = FINAL ;
      end ;
    end loop ;
  end Processa_Esdeveniments ;

begin
  Cua_Protegida.Afegir (SUCCES_A) ;
  Cua_Protegida.Afegir (SUCCES_B) ;
  delay 1.0 ;

  Cua_Protegida.Afegir (FINAL) ;
end Prova ;
gnatmake prova.adb
./prova

Allotjament dinàmic i Memòria d'àmbit[modifica | modifica el codi]

Vegeu #Gestió de memòria

-- fitxer prova_mem.ads

package Prova_Mem is
  procedure Prova ;
end Prova_Mem ;
-- fitxer prova_mem.adb

with Ada.Text_IO ;
with Ada.Unchecked_Deallocation ;
with System.Pool_Local ;
with Ada.Exceptions ;

package body Prova_Mem is

  package Except renames Ada.Exceptions ;

  package Txt_IO renames Ada.Text_IO ;
  package Int_IO is new Ada.Text_IO.Integer_IO (Integer) ;
  package Boolean_IO is new Ada.Text_IO.Enumeration_IO (Boolean) ;

  procedure Prova is

    type Tipus is array (1..1000) of Integer;
    type Ptr_A_Tipus is access Tipus;

    Local_Pool : System.Pool_Local.Unbounded_Reclaim_Pool;            -- memòria d'àmbit.
    for Ptr_A_Tipus'Storage_Pool use Local_Pool ;

    procedure Free_Ptr_A_Tipus is new Ada.Unchecked_Deallocation (Tipus, Ptr_A_Tipus);

    subtype  Ptr_No_Nul_A_Tipus is not null Ptr_A_Tipus ;

    A : Ptr_A_Tipus;

    procedure Allotja is
    begin
	A := new Tipus'(others=>10); -- allotja i inicialitza
    end Allotja;

    procedure DesAllotja  is
    begin
	Free_Ptr_A_Tipus (A);
    end DesAllotja;

    procedure Comprova_Nul (B: Ptr_A_Tipus)  is
    begin

      Txt_IO.Put ("Que és nul el punter? ") ;
      Boolean_IO.Put ( B = null ) ;
      Txt_IO.New_Line ;
    end Comprova_Nul ;

    procedure Imprimeix_Elem (B: Ptr_No_Nul_A_Tipus)  is  -- restringit pel subtipus, dispara exc. Constraint_Error
    -- procedure Imprimeix_Elem (B: not null access Tipus) is  -- alternativa
      vec: Tipus ;
    begin
      vec := B.all ;
      Txt_IO.Put ("El primer elem. és") ;
      Int_IO.Put ( vec( 1), Width => 4) ;
      Txt_IO.New_Line; 
    end Imprimeix_Elem ;

  begin

    Allotja ;

    A.all := (others => 20) ;

    Comprova_Nul( A) ;

    Imprimeix_Elem( A) ;

    Allotja ;
    DesAllotja;       -- A queda ''null''

    Comprova_Nul( A) ;

    begin
      Imprimeix_Elem( A) ;

    exception
      when Constraint_Error => Txt_IO.Put_Line ("Restricció ''not null'' fallida: El punter era nul") ;

      when E: others => Txt_IO.Put_Line ("disparada: " & Except.Exception_Name (E));
    end ;

    Allotja ;
  end Prova;  -- el Local_Pool queda fora d'àmbit i se'n reclama la memòria
end Prova_Mem ;
-- fitxer principal.adb

with Prova_Mem ;

procedure Principal is
begin
  Prova_Mem.Prova ;
end ;
gnatmake principal.adb
./principal

O.O. - Finalització controlada - Estructura amb component allotjat dinàmicament i comptador de referències[modifica | modifica el codi]

Classe d'objectes amb Finalització controlada, derivats de la classe abstracta Ada.Finalization.Controlled. Mètodes cridats automàticament:

  • Initialize: cridat en les declaracions sense inicialització
  • Finalize: cridat en deslligar l'objecte de la variable, perquè, o bé se li ha assignat un altre valor a la variable, o bé la variable surt de l'àmbit
  • Adjust: cridat en lligar un objecte a una variable a les assignacions, després de la còpia superficial (bit a bit) de l'objecte, per si cal clonar els membres referits per punters o si cal portar un comptador de referències.

Vegeu #Constructors, Destructors i Clonadors.

-- fitxer controlat.ads
with Carrega ;
with Ada.Finalization; 

package Controlat is

  use Carrega ;

  type Objecte is new Ada.Finalization.Controlled with    -- classe derivada de ''Ada.Finalization.Controlled''
  record
    Ptr_A_La_Meva_Carrega: Carrega.Ptr_A_Carrega := null ;
  end record;

private
  
  procedure Initialize( Obj: in out Objecte);        -- constructor buit (cridat quan no hi ha inicialització en la declaració)
  procedure Adjust( Obj: in out Objecte);                 -- constructor de còpia (ajustatge després de còpia superficial)
  procedure Finalize ( Obj: in out Objecte);     -- cridat en sortir de l'àmbit o quan l'obj. es deslliga de la variable quan és modificada
end Controlat;
-- fitxer controlat.adb
with Ada.Text_IO; 

package body Controlat is

  package Txt_IO renames Ada.Text_IO ;
  package Int_IO is new Ada.Text_IO.Integer_IO (Integer) ;

  procedure Initialize( Obj: in out Objecte) is    -- constructor buit 
  begin
    Txt_IO.Put( "Initialize:"); 

    Obj.Ptr_A_La_Meva_Carrega := Carrega.Nova_Carrega ( Id => 1);   
    Txt_IO.New_Line ;
  end;

  procedure Adjust( Obj: in out Objecte) is      -- constructor de còpia (ajustatge després de còpia superficial bit a bit)
  begin
    Txt_IO.Put( "Adjust    :"); 

    Carrega.Incr_Refs( Obj.Ptr_A_La_Meva_Carrega) ;
    Txt_IO.New_Line ;
  end;

  procedure Finalize ( Obj: in out Objecte) is    -- en sortir de l'àmbit o en ésser deslligat de la ref.
    refs: Natural ;
  begin
    Txt_IO.Put( "Finalize  :"); 
    if not Carrega.Es_Nul (Obj.Ptr_A_La_Meva_Carrega) then 

      Carrega.Decr_Refs( Obj.Ptr_A_La_Meva_Carrega, refs) ;

      if refs = 0 then
	Carrega.Allibera_Carrega (Obj.Ptr_A_La_Meva_Carrega) ;
	Txt_IO.Put( "; Desallotjat") ;
      end if ;
    end if ;
    Txt_IO.New_Line ;
  end;
end Controlat;
  • La càrrega
-- fitxer carrega.ads
with Ada.Unchecked_Deallocation; 

package Carrega is

  type Carrega is private ;

  type Ptr_A_Carrega is access Carrega ;

  function Nova_Carrega ( Id: integer) return Ptr_A_Carrega ;
  function Es_Nul( ptr_carr: Ptr_A_Carrega) return Boolean ;

  procedure Incr_Refs (ptr_carr: in Ptr_A_Carrega) ;
  procedure Decr_Refs (ptr_carr: in Ptr_A_Carrega; refs: out Natural) ;

  procedure Allibera_Carrega (ptr_carr: in out Ptr_A_Carrega) ;

  private
    type Carrega is record 
      Id: Integer ;
      Num_Refs: Natural := 1 ;
    end record ;

    procedure Free_Carrega is new Ada.Unchecked_Deallocation (Carrega, Ptr_A_Carrega);

end Carrega;
-- fitxer carrega.adb
with Ada.Text_IO; 

package body Carrega is

  package Txt_IO renames Ada.Text_IO ;
  package Int_IO is new Ada.Text_IO.Integer_IO (Integer) ;

  function Nova_Carrega ( Id: integer) return Ptr_A_Carrega is
    Ptr: Ptr_A_Carrega := null ;
  begin
    Ptr := new Carrega'(Id => Id, others => <>); -- ''<>'': valors per defecte

    Txt_IO.Put( " Càrrega Id.: "); Int_IO.Put( Id, 4) ;
    Txt_IO.Put( " Refs: "); Int_IO.Put( Ptr.all.Num_Refs, 4) ;
    Txt_IO.New_Line ;
    return Ptr ;
  end Nova_Carrega ;

  function Es_Nul( ptr_carr: Ptr_A_Carrega) return Boolean is
  begin
    return ptr_carr = null ;
  end ;

  procedure Incr_Refs (ptr_carr: in Ptr_A_Carrega) is
  begin
    ptr_carr.all.Num_Refs := ptr_carr.all.Num_Refs +1 ;

    Txt_IO.Put( " Càrrega Id.: "); Int_IO.Put( ptr_carr.all.Id, 4) ;
    Txt_IO.Put( " Refs: "); Int_IO.Put( ptr_carr.all.Num_Refs, 4) ;
  end ;

  procedure Decr_Refs (ptr_carr: in Ptr_A_Carrega; refs: out Natural) is
  begin
    if ptr_carr.all.Num_Refs > 0 then
      ptr_carr.all.Num_Refs := ptr_carr.all.Num_Refs -1 ;
    end if ;
    refs := ptr_carr.all.Num_Refs ;

    Txt_IO.Put( " Càrrega Id.: "); Int_IO.Put( ptr_carr.all.Id, 4) ;
    Txt_IO.Put( " Refs: "); Int_IO.Put( ptr_carr.all.Num_Refs, 4) ;

  end ;

  procedure Allibera_Carrega (ptr_carr: in out Ptr_A_Carrega) is
  begin
    Free_Carrega( ptr_carr) ;
  end ;

end Carrega;
  • Provatura:
-- fitxer principal.adb
with Carrega ;
with Controlat ;
with Ada.Finalization; 
with Ada.Text_IO ;

procedure Principal is

  package Txt_IO renames Ada.Text_IO ;

  use Controlat ;
  obj1: Controlat.Objecte;                                  -- Sense inicialitzar, ''Initialize'' s'executa

begin
  declare -- àmbit intern fet a posta per a l'exemple
    obj2: Controlat.Objecte := (Ada.Finalization.Controlled 
                                  with Ptr_A_La_Meva_Carrega => Carrega.Nova_Carrega (Id => 2));  -- ''Initialize'' no actúa
    obj3: Controlat.Objecte := (Ada.Finalization.Controlled 
                                  with Ptr_A_La_Meva_Carrega => Carrega.Nova_Carrega (Id => 3));  -- ''Initialize'' no actúa
  begin
    Txt_IO.New_Line; Txt_IO.Put_Line("-- obj2 := obj3  -- finalitza objecte de la var obj2; adjust objecte de la var obj3") ;
    obj2 := obj3;   
 
    Txt_IO.New_Line; 
    Txt_IO.Put_Line("-- sortida àmbit intern, variables obj2 i obj3 surten del seu àmbit") ;
  end; -- sortida de l'àmbit, 
 
  Txt_IO.New_Line; 
  Txt_IO.Put_Line("-- sortida àmbit extern, variable obj1 surt de l'àmbit") ;
end Principal;

Compila i executa:

gnatmake principal.adb
./principal

dóna:

Initialize: Càrrega Id.:    1 Refs:    1

 Càrrega Id.:    2 Refs:    1
 Càrrega Id.:    3 Refs:    1

-- obj2 := obj3  -- finalitza objecte de la var obj2; adjust objecte de la var obj3
Finalize  : Càrrega Id.:    2 Refs:    0; Desallotjat
Adjust    : Càrrega Id.:    3 Refs:    2

-- sortida àmbit intern, variables obj2 i obj3 surten del seu àmbit
Finalize  : Càrrega Id.:    3 Refs:    1
Finalize  : Càrrega Id.:    3 Refs:    0; Desallotjat

-- sortida àmbit extern, variable obj1 surt de l'àmbit
Finalize  : Càrrega Id.:    1 Refs:    0; Desallotjat

Vegeu també[modifica | modifica el codi]

Referències[modifica | modifica el codi]

  1. Fuegi,, J.; Francis,, J. «Lovelace & Babbage and the creation of the 1843 'notes'». IEEE Annals of the History of Computing, V.25, n.4, Octubre-desembre 2003, p.16-26.
  2. Concurrència en Ada(castellà)
  3. La trobada en Ada(castellà)
  4. Burns, Alan; Wellings, Andrew J. Concurrent and real-time programming in Ada 2005 (en anglès). Cambridge University Press, 2007. ISBN 0521866979. 
  5. GNAT portat al sistema de compiladors LLVM en anglès
  6. 6,0 6,1 6,2 Especificació i API estàndard de l'Ada 2005 en anglès Firefox mostra pàgines en blanc. Cal refrescar un parell de cops i surten o fer servir un navegador basat en Webkit com ara Chrome o Safari
  7. Fundamental data types
  8. Tipus en anglès
  9. 9,0 9,1 Atributs dels tipus estàndard en Ada2005 en anglès
  10. Tipus access en anglès
  11. Assercions
  12. Precondicions i Postcondicions(anglès)
  13. Ada2005 Elements predefinits al mòdul Ada.Standard en anglès
  14. 14,0 14,1 Access i mecanismes de gestió de memòria en anglès
  15. Gestors d'allotjament en anglès
  16. 16,0 16,1 16,2 16,3 Adacore - Memory management en anglès
  17. Big Book of Ada - Advanced - Packages en anglès Vegeu apartats "Dynamic Allocation" i "Storage Pools".
  18. Gestor d'allotjament Unbounded_No_Reclaim en anglès
  19. Garbage Collection a GNAT de GNU en anglès
  20. Gestor d'allotjament Unbounded_Reclaim_Pool en anglès
  21. Gestor d'allotjament Stack_Bounded_Pool en anglès
  22. Ada programming - Access_to_Constant
  23. Qualificador Aliased en anglès
  24. Tipus limitats en anglès
  25. Eliminar un objecte d'un Storage_Pool en anglès
  26. Unchecked_Deallocation
  27. Pragma Controlled en anglès
  28. Pragma Volatile en anglès
  29. Pragma Atomic en anglès
  30. AdaCore - Gem #97: Reference Counting in Ada - Part 1(anglès)
  31. Constructors, clonadors i destructors en anglès
  32. Viquillibre: prog. en Ada - Orientació a Objectes per a programadors de C++ en anglès
  33. Expansion of Rendez-vous(anglès) 10.3 Asynchronous Transfer of Control
  34. Pragmes de Configuració en anglès
  35. 35,0 35,1 Elaboration Order Handling in GNAT
  36. GNAT i Creació de biblioteques en anglès
  37. Descàrrega de GNAT per a JVM en anglès
  38. Manual de JGNAT en anglès
  39. Viquillibre Ada programming - Tasking en anglès
  40. Ada2005 - clàusules Entry en anglès
  41. Activació de tasques en anglès
  42. Asynchronous Transfer of Control
  43. Protected objects en anglès

Bibliografia[modifica | modifica el codi]

Enllaços externs[modifica | modifica el codi]

A Wikimedia Commons hi ha contingut multimèdia relatiu a: Ada (llenguatge de programació) Modifica l'enllaç a Wikidata