DataMuseum.dk Presents historical artifacts from the history of: Rational R1000/400

This is an automatic "excavation" of a thematic subset of artifacts from Datamuseum.dk's BitArchive. See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software.

top - download

⟦3f5c6f4db⟧ Ada Source

    Length: 20480 (0x5000)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Acteurs, package body Calcul, package body Groupe, package body Materiels, package body Script, package body Semantique, package body Verif_Actions, seg_039080

Derivation

└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
    └─ ⟦5a81ac88f⟧ »Space Info Vol 1« 
        └─⟦this⟧ 

with Text_Io;
with Erreurs;
with Lexical;
use Lexical;

package body Semantique is

    Max : constant := 255;


    type Un_Acteur is
        record
            L_Acteur : Standard_String.Object;
            L_Adresse : Integer;
            Le_Type : Standard_String.Object;
        end record;

    type Une_Action is
        record
            L_Action : Standard_String.Object;
            Le_Type : Standard_String.Object;
            Le_Code : Integer;
            De, Vers, En : Lexical.Token;
        end record;

    Tableau_Actions : array (1 .. Max) of Une_Action;
    Tableau_Acteurs : array (1 .. Max) of Un_Acteur;

    Nombre_Actions : Integer range 0 .. Max;
    Nombre_Acteurs : Integer range 0 .. Max;


    package Materiels is

        procedure Ouvrir_Bloc_Materiel;
        procedure Fermer_Bloc_Materiel;
        procedure Nouveau_Type (Un_Type : Standard_String.Object);
        procedure Fin_Nouveau_Type;
        procedure Nouvelle_Action (Une_Action : Standard_String.Object);
        procedure Donner_Code_Action (Un_Code : Integer);
        procedure Fin_Nouvelle_Action;
        procedure Ouvrir_Champ_Option;
        procedure Option (Une_Option : Lexical.Token);
        procedure Fermer_Champ_Option;  
        procedure Imprimer_Materiel;
        function Type_Existe (Un_Type : Standard_String.Object) return Boolean;
        function Action_Existe
                    (Un_Type : Standard_String.Object;
                     Une_Action : Standard_String.Object) return Boolean;


    end Materiels;


    procedure Ouvrir_Bloc_Materiel is  
    begin
        Materiels.Ouvrir_Bloc_Materiel;
    end Ouvrir_Bloc_Materiel;


    procedure Fermer_Bloc_Materiel is
    begin
        Materiels.Fermer_Bloc_Materiel;
    end Fermer_Bloc_Materiel;


    procedure Nouveau_Type (Un_Type : Standard_String.Object) is
    begin
        Materiels.Nouveau_Type (Un_Type);
    end Nouveau_Type;


    procedure Fin_Nouveau_Type is
    begin
        Materiels.Fin_Nouveau_Type;
    end Fin_Nouveau_Type;


    procedure Nouvelle_Action (Une_Action : Standard_String.Object) is
    begin
        Materiels.Nouvelle_Action (Une_Action);
    end Nouvelle_Action;


    procedure Donner_Code_Action (Un_Code : Integer) is
    begin
        Materiels.Donner_Code_Action (Un_Code);
    end Donner_Code_Action;


    procedure Fin_Nouvelle_Action is
    begin
        Materiels.Fin_Nouvelle_Action;
    end Fin_Nouvelle_Action;


    procedure Ouvrir_Champ_Option is
    begin
        Materiels.Ouvrir_Champ_Option;
    end Ouvrir_Champ_Option;


    procedure Option (Une_Option : Lexical.Token) is
    begin
        Materiels.Option (Une_Option);
    end Option;


    procedure Fermer_Champ_Option is
    begin
        Materiels.Fermer_Champ_Option;
    end Fermer_Champ_Option;


    procedure Imprimer_Materiel is
    begin
        Materiels.Imprimer_Materiel;
    end Imprimer_Materiel;


    package body Materiels is separate;


    package Acteurs is
        procedure Ouvrir_Bloc_Acteur;
        procedure Fermer_Bloc_Acteur;
        procedure Nouvel_Acteur (Un_Acteur : Standard_String.Object);
        procedure Fin_Nouvel_Acteur;
        procedure Donner_Type_Acteur (Un_Type : Standard_String.Object);
        procedure Donner_Adresse_Station (Une_Adresse : Integer);  
        procedure Imprimer_Acteur;
        function Acteur_Existe
                    (Un_Acteur : Standard_String.Object) return Boolean;
        function Donne_Type_Acteur (Un_Acteur : Standard_String.Object)
                                   return Standard_String.Object;
    end Acteurs;


    procedure Ouvrir_Bloc_Acteur is
    begin
        Acteurs.Ouvrir_Bloc_Acteur;
    end Ouvrir_Bloc_Acteur;


    procedure Fermer_Bloc_Acteur is
    begin
        Acteurs.Fermer_Bloc_Acteur;
    end Fermer_Bloc_Acteur;


    procedure Nouvel_Acteur (Un_Acteur : Standard_String.Object) is
    begin
        Acteurs.Nouvel_Acteur (Un_Acteur);
    end Nouvel_Acteur;


    procedure Fin_Nouvel_Acteur is
    begin
        Acteurs.Fin_Nouvel_Acteur;
    end Fin_Nouvel_Acteur;


    procedure Donner_Type_Acteur (Un_Type : Standard_String.Object) is
    begin
        Acteurs.Donner_Type_Acteur (Un_Type);
    end Donner_Type_Acteur;


    procedure Donner_Adresse_Station (Une_Adresse : Integer) is
    begin
        Acteurs.Donner_Adresse_Station (Une_Adresse);
    end Donner_Adresse_Station;


    procedure Imprimer_Acteur is
    begin
        Acteurs.Imprimer_Acteur;
    end Imprimer_Acteur;


    package body Acteurs is separate;


    package Verif_Actions is

        function Action_Possible
                    (Une_Action : Standard_String.Object;
                     Un_Acteur : Standard_String.Object;
                     De, Vers, En : Lexical.Token := L_Unk) return Boolean;
        function Donne_Indice_Tableau_Acteurs
                    (Un_Type, Un_Acteur : Standard_String.Object)
                    return Integer;
        function Donne_Indice_Tableau_Actions
                    (Un_Type, Une_Action : Standard_String.Object)
                    return Integer;

    end Verif_Actions;


    function Action_Possible
                (Une_Action : Standard_String.Object;
                 Un_Acteur : Standard_String.Object;
                 De, Vers, En : Lexical.Token := L_Unk) return Boolean is  
    begin
        return Verif_Actions.Action_Possible
                  (Une_Action, Un_Acteur, De, Vers, En);
    end Action_Possible;


    package body Verif_Actions is separate;


    package Script is

        procedure Ouvrir_Nouveau_Bloc_Scenario;
        procedure Fermer_Bloc_Scenario;
        procedure Ouvrir_Nouveau_Bloc_Scene
                     (Une_Scene : Standard_String.Object);
        procedure Fermer_Bloc_Scene;
        procedure Ouvrir_Bloc_Enchainement;
        procedure Fermer_Bloc_Enchainement;
        procedure Ouvrir_Bloc (Nature : Lexical.Token);
        procedure Fermer_Bloc (Nature : Lexical.Token);
        procedure Lire_Liste_Temps;
        procedure Lire_Nombre (Un_Nombre : Integer);
        procedure Lire_Nombre (Un_Id : Standard_String.Object);
        procedure Complete_Liste (Un_Nom : Standard_String.Object);
        procedure Controle_Option (Une_Option : Lexical.Token);
        procedure Complete_Action (Une_Action : Standard_String.Object);
        procedure Insere_Action;
        procedure Nouveau_Bloc_Groupe_Temps (Un_Jeton : Lexical.Token);
        procedure Ajouter_Bloc_Groupe_Temps (Un_Nom : Standard_String.Object);  
        procedure Ajouter_Bloc_Groupe_Temps (Un_Nombre : Integer);  
        procedure Fermer_Bloc_Groupe_Temps;
        function Donne_Id_Courant return Standard_String.Object;
        function Donne_Nombre_Courant return Integer;
        procedure Inserer_Liste_Symbole (Un_Element : Standard_String.Object;
                                         Une_Valeur : Integer);
        procedure Genere_Scene (Une_Scene : Standard_String.Object);

    end Script;


    procedure Ouvrir_Nouveau_Bloc_Scenario is
    begin
        Script.Ouvrir_Nouveau_Bloc_Scenario;
    end Ouvrir_Nouveau_Bloc_Scenario;


    procedure Fermer_Bloc_Scenario is
    begin
        Script.Fermer_Bloc_Scenario;
    end Fermer_Bloc_Scenario;


    procedure Ouvrir_Nouveau_Bloc_Scene (Une_Scene : Standard_String.Object) is
    begin
        Script.Ouvrir_Nouveau_Bloc_Scene (Une_Scene);
    end Ouvrir_Nouveau_Bloc_Scene;


    procedure Fermer_Bloc_Scene is
    begin
        Script.Fermer_Bloc_Scene;
    end Fermer_Bloc_Scene;


    procedure Ouvrir_Bloc_Enchainement is
    begin
        Script.Ouvrir_Bloc_Enchainement;
    end Ouvrir_Bloc_Enchainement;


    procedure Fermer_Bloc_Enchainement is
    begin
        Script.Fermer_Bloc_Enchainement;
    end Fermer_Bloc_Enchainement;


    procedure Ouvrir_Bloc (Nature : Lexical.Token) is
    begin
        Script.Ouvrir_Bloc (Nature);
    end Ouvrir_Bloc;


    procedure Fermer_Bloc (Nature : Lexical.Token) is
    begin
        Script.Fermer_Bloc (Nature);
    end Fermer_Bloc;


    procedure Lire_Liste_Temps is
    begin
        Script.Lire_Liste_Temps;
    end Lire_Liste_Temps;


    procedure Lire_Nombre (Un_Nombre : Integer) is
    begin
        Script.Lire_Nombre (Un_Nombre => Un_Nombre);
    end Lire_Nombre;


    procedure Lire_Nombre (Un_Id : Standard_String.Object) is
    begin
        Script.Lire_Nombre (Un_Id => Un_Id);
    end Lire_Nombre;


    procedure Complete_Liste (Un_Nom : Standard_String.Object) is
    begin
        Script.Complete_Liste (Un_Nom);
    end Complete_Liste;


    procedure Controle_Option (Une_Option : Lexical.Token) is
    begin
        Script.Controle_Option (Une_Option);
    end Controle_Option;


    procedure Complete_Action (Une_Action : Standard_String.Object) is
    begin
        Script.Complete_Action (Une_Action);
    end Complete_Action;


    procedure Insere_Action is
    begin
        Script.Insere_Action;
    end Insere_Action;


    procedure Nouveau_Bloc_Groupe_Temps (Un_Jeton : Lexical.Token) is
    begin
        Script.Nouveau_Bloc_Groupe_Temps (Un_Jeton);
    end Nouveau_Bloc_Groupe_Temps;


    procedure Ajouter_Bloc_Groupe_Temps (Un_Nom : Standard_String.Object) is
    begin
        Script.Ajouter_Bloc_Groupe_Temps (Un_Nom);
    end Ajouter_Bloc_Groupe_Temps;


    procedure Ajouter_Bloc_Groupe_Temps (Un_Nombre : Integer) is
    begin
        Script.Ajouter_Bloc_Groupe_Temps (Un_Nombre);
    end Ajouter_Bloc_Groupe_Temps;


    procedure Fermer_Bloc_Groupe_Temps is
    begin
        Script.Fermer_Bloc_Groupe_Temps;
    end Fermer_Bloc_Groupe_Temps;


    procedure Genere_Scene (Une_Scene : Standard_String.Object) is  
    begin
        Script.Genere_Scene (Une_Scene);
    end Genere_Scene;


    package body Script is separate;


    package Calcul is

        procedure Demarre_Calcul;  
        procedure Empiler (Un_Jeton : Lexical.Token; Une_Valeur : Integer := 0);
        procedure Evaluer_Expression (La_Valeur : out Integer);

    end Calcul;


    procedure Demarre_Calcul is
    begin
        Calcul.Demarre_Calcul;
    end Demarre_Calcul;


    procedure Empiler (Un_Jeton : Lexical.Token; Une_Valeur : Integer := 0) is
    begin
        Calcul.Empiler (Un_Jeton, Une_Valeur);
    end Empiler;


    procedure Empiler (Un_Id : Standard_String.Object) is
        La_Valeur : Integer;
    begin  
        Script.Lire_Nombre (Un_Id);
        La_Valeur := Script.Donne_Nombre_Courant;
        Calcul.Empiler (L_Number, La_Valeur);
    end Empiler;


    procedure Evaluer_Expression is
        La_Valeur : Integer := 0;
    begin  
        Calcul.Empiler (Un_Jeton => L_Ok);
        Calcul.Evaluer_Expression (La_Valeur);
        Script.Inserer_Liste_Symbole
           (Un_Element => Script.Donne_Id_Courant, Une_Valeur => La_Valeur);
        Text_Io.Put_Line (Integer'Image (La_Valeur));
    end Evaluer_Expression;


    package body Calcul is separate;


    package Groupe is

        procedure Nouveau_Bloc_Groupe;
        procedure Complete_Action;
        procedure Complete_Liste_Action (Une_Action : Lexical.Token);
        procedure Ajoute_Action (Une_Action : Standard_String.Object);
        procedure Nouveau_Bloc_Groupe (Une_Action : Lexical.Token;
                                       Un_Nom : Standard_String.Object);
        procedure Nouveau_Bloc_Groupe (Une_Action : Lexical.Token);
        procedure Fermer_Bloc_Groupe;
        procedure Ajouter_Bloc_Groupe (Un_Groupe : Standard_String.Object);
        procedure Ajouter_Bloc_Groupe (Une_Valeur : Integer);
        procedure Retourner_Valeur;
        procedure Nouveau_Bloc_Groupe_Affecte
                     (Un_Groupe : Standard_String.Object);
        procedure Fermer_Bloc_Groupe_Affecte;

    end Groupe;


    procedure Nouveau_Bloc_Groupe is
    begin
        Groupe.Nouveau_Bloc_Groupe;
    end Nouveau_Bloc_Groupe;


    procedure Complete_Action is
    begin
        Groupe.Complete_Action;
    end Complete_Action;


    procedure Complete_Liste_Action (Une_Action : Lexical.Token) is
    begin
        Groupe.Complete_Liste_Action (Une_Action);
    end Complete_Liste_Action;


    procedure Ajoute_Action (Une_Action : Standard_String.Object) is
    begin
        Groupe.Ajoute_Action (Une_Action);
    end Ajoute_Action;


    procedure Nouveau_Bloc_Groupe (Une_Action : Lexical.Token;
                                   Un_Nom : Standard_String.Object) is
    begin
        Groupe.Nouveau_Bloc_Groupe (Une_Action, Un_Nom);
    end Nouveau_Bloc_Groupe;


    procedure Nouveau_Bloc_Groupe (Une_Action : Lexical.Token) is
    begin
        Groupe.Nouveau_Bloc_Groupe (Une_Action);
    end Nouveau_Bloc_Groupe;


    procedure Fermer_Bloc_Groupe is
    begin
        Groupe.Fermer_Bloc_Groupe;
    end Fermer_Bloc_Groupe;


    procedure Ajouter_Bloc_Groupe (Un_Groupe : Standard_String.Object) is
    begin
        Groupe.Ajouter_Bloc_Groupe (Un_Groupe);
    end Ajouter_Bloc_Groupe;


    procedure Ajouter_Bloc_Groupe (Une_Valeur : Integer) is
    begin
        Groupe.Ajouter_Bloc_Groupe (Une_Valeur);
    end Ajouter_Bloc_Groupe;


    procedure Nouveau_Bloc_Groupe_Affecte
                 (Un_Groupe : Standard_String.Object) is
    begin
        Groupe.Nouveau_Bloc_Groupe_Affecte (Un_Groupe);
    end Nouveau_Bloc_Groupe_Affecte;


    procedure Fermer_Bloc_Groupe_Affecte is
    begin
        Groupe.Fermer_Bloc_Groupe_Affecte;
    end Fermer_Bloc_Groupe_Affecte;


    procedure Retourner_Valeur is
    begin
        Groupe.Retourner_Valeur;
    end Retourner_Valeur;


    package body Groupe is separate;


    procedure La_Fin is  
    begin
        null;
    end La_Fin;

end Semantique;

    nblk1=13
    nid=e
    hdr6=24
        [0x00] rec0=28 rec1=00 rec2=01 rec3=00e
        [0x01] rec0=00 rec1=00 rec2=0c rec3=058
        [0x02] rec0=22 rec1=00 rec2=09 rec3=018
        [0x03] rec0=2c rec1=00 rec2=07 rec3=022
        [0x04] rec0=1f rec1=00 rec2=0b rec3=036
        [0x05] rec0=29 rec1=00 rec2=10 rec3=050
        [0x06] rec0=1d rec1=00 rec2=11 rec3=060
        [0x07] rec0=07 rec1=00 rec2=12 rec3=016
        [0x08] rec0=13 rec1=00 rec2=08 rec3=028
        [0x09] rec0=14 rec1=00 rec2=13 rec3=032
        [0x0a] rec0=2d rec1=00 rec2=0f rec3=000
        [0x0b] rec0=25 rec1=00 rec2=02 rec3=080
        [0x0c] rec0=2a rec1=00 rec2=03 rec3=05a
        [0x0d] rec0=05 rec1=00 rec2=0d rec3=00c
        [0x0e] rec0=1c rec1=00 rec2=05 rec3=012
        [0x0f] rec0=16 rec1=00 rec2=04 rec3=070
        [0x10] rec0=25 rec1=00 rec2=0a rec3=038
        [0x11] rec0=27 rec1=00 rec2=06 rec3=000
        [0x12] rec0=10 rec1=00 rec2=0e rec3=000
    tail 0x21735cbf484e68cb379a1 0x42a00088462060003
Free Block Chain:
  0xe: 0000  00 00 00 1f 80 09 63 74 69 6f 6e 73 3a 3d 30 09  ┆      ctions:=0 ┆