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

⟦d4d41957e⟧ Ada Source

    Length: 11264 (0x2c00)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Document, seg_044b34

Derivation

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

E3 Source Code



with Text_Io, Filtre_D_Entree;
package body Document is

    Indice : Natural := 0;
    Ligne_Courante : Numeros_De_Lignes.Numero := 1;
    The_File : Text_Io.File_Type;
    Existe_Instruction : Boolean := False;

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

    procedure Open is
    begin
        Text_Io.Set_Input (Text_Io.Standard_Input);
    exception
        when others =>
            Text_Io.Put_Line ("Erreur open");
    end Open;

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

    procedure Close is
    begin
        Text_Io.Put_Line ("fin de programme");
--        Text_Io.Set_Input (Text_Io.Standard_Input);
    exception
        when others =>
            Text_Io.Put_Line ("Erreur Close");
    end Close;


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

    procedure Fopen (File_Name : in String) is
    begin
        Text_Io.Open (The_File, Text_Io.In_File, File_Name);
        Text_Io.Set_Input (The_File);
        Filtre_D_Entree.Purger;
    exception
        when others =>
            Text_Io.Put_Line ("Erreur Fopen");
    end Fopen;

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

    procedure Fclose is
    begin
        Text_Io.Close (The_File);
        Text_Io.Set_Input (Text_Io.Standard_Input);
    exception
        when others =>
            Text_Io.Put_Line ("Erreur Fclose");
    end Fclose;

------------------------------------------------------------------------------
    procedure File_Get (Le_Mot : out Mots.Mot;
                        Le_Numero : out Numeros_De_Lignes.Numero) is

        Caractere_Temporaire : Character;
        Mot_Temporaire : String (1 .. 80);
        Indice : Natural := 0;

        function "+" (X, Y : in Numeros_De_Lignes.Numero)
                     return Numeros_De_Lignes.Numero
            renames Numeros_De_Lignes."+";



    begin
        loop
            Filtre_D_Entree.File_Entrer (Caractere_Temporaire);
            case Caractere_Temporaire is
                when 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' =>
                    Indice := Indice + 1;
                    Mot_Temporaire (Indice) := Caractere_Temporaire;
                when Filtre_D_Entree.Termine_Fichier =>
                    raise Fin_De_Fichier;
                when Filtre_D_Entree.Termine_Page =>
                    null;
                when Filtre_D_Entree.Termine_Ligne =>
                    if Indice > 0 then
                        Mots.Creer (Le_Mot, Mot_Temporaire (1 .. Indice));
                        Le_Numero := Ligne_Courante + 1;
                        Ligne_Courante := Ligne_Courante + 1;
                        return;
                    end if;
                when others =>
                    if Indice > 0 then
                        Mots.Creer (Le_Mot, Mot_Temporaire (1 .. Indice));
                        Le_Numero := Ligne_Courante;
                        return;
                    end if;
            end case;
        end loop;
    exception
        when Text_Io.End_Error =>
            raise Fin_De_Fichier;
        when Constraint_Error =>
            raise Mot_Trop_Long;
    end File_Get;
    ---------------------------------------------------------------------------

    function En_Fin_De_Fichier return Boolean is
    begin
        return Text_Io.End_Of_File;
    end En_Fin_De_Fichier;

------------------------------------------------------------------------------
    procedure Purger is
    begin
        Existe_Instruction := False;
        Indice := 0;
    end Purger;

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

    procedure Get (Les_Mots : in out Mots.Tableau; Tab_Len : out Natural) is
        --package t is new text_io.integer_io(natural);

        Caractere_Temporaire : Character;
        Mot_Temporaire : String (1 .. 80);
        Ligne_Temporaire : String (1 .. 80);
        Indice_Tab : Natural := 0;
        Len : Natural := 0;

        function E (S : String; A : Natural) return Character is
        begin
            return S (A .. A);
        end E;


    begin
        Filtre_D_Entree.Entrer (Ligne_Temporaire, Len);
        for I in 1 .. Len loop




            Caractere_Temporaire := E (Ligne_Temporaire, I);
            Text_Io.Put_Line (Ligne_Temporaire (I .. I));
            case Caractere_Temporaire is
                when 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' =>
                    Indice := Indice + 1;
                    --t.put(indice_tab);
                    --t.put(indice);
                    --text_io.skip_line;
                    Mot_Temporaire (Indice) := Ligne_Temporaire (I);
                    Existe_Instruction := True;
                when Filtre_D_Entree.Termine_Ligne =>
                    if Indice > 0 then
                        Mots.Creer_Table (Les_Mots, Mot_Temporai);

                        --t.put(indice_tab);
                        --text_io.skip_line;

                        Purger;
                    else
                        Mots.Creer_Table (Les_Mots, "nothing");
                        if not Existe_Instruction then
                            Text_Io.Put_Line ("Il n'y a rien");
                            --t.put(indice_tab);
                            --text_io.skip_line;
                            Purger;
                        else
                            --t.put(indice_tab);
                            --text_io.skip_line;
                            Purger;
                        end if;
                        --t.put(indice_tab);
                        --text_io.skip_line;
                        Tab_Len := Indice_Tab;
                        return;
                    end if;
                when others =>
                    if Indice > 0 then
                        --t.put(indice_tab);
                        --text_io.skip_line;
                        if Indice_Tab > 4 then
                            Purger;
                        end if;
                        Mots.Creer_Table (Les_Mots, Mot_Temporai);
                        return;
                        --t.put(indice_tab);
                        --text_io.skip_line;
                    end if;
            end case;
        end loop;
    exception
        when Constraint_Error =>
            raise Mot_Trop_Long;
        when others =>
            Text_Io.Put_Line ("Erreur get!");
    end Get;

end Document;


E3 Meta Data

    nblk1=a
    nid=2
    hdr6=e
        [0x00] rec0=24 rec1=00 rec2=01 rec3=024
        [0x01] rec0=1d rec1=00 rec2=0a rec3=028
        [0x02] rec0=18 rec1=00 rec2=03 rec3=056
        [0x03] rec0=1e rec1=00 rec2=04 rec3=000
        [0x04] rec0=1e rec1=00 rec2=07 rec3=040
        [0x05] rec0=18 rec1=00 rec2=05 rec3=016
        [0x06] rec0=18 rec1=00 rec2=06 rec3=000
        [0x07] rec0=1a rec1=00 rec2=02 rec3=000
        [0x08] rec0=11 rec1=00 rec2=0a rec3=000
        [0x09] rec0=cd rec1=0c rec2=78 rec3=580
    tail 0x21540b9e686433a6f0d52 0x42a00088462060003
Free Block Chain:
  0x2: 0000  00 08 03 50 80 16 54 61 62 5f 4c 65 6e 20 3a 3d  ┆   P  Tab_Len :=┆
  0x8: 0000  00 09 03 fc 80 13 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d  ┆      ----------┆
  0x9: 0000  00 00 03 fc 80 13 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d  ┆      ----------┆