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

⟦2077e0f75⟧ Ada Source

    Length: 10240 (0x2800)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Document, seg_045a0b

Derivation

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

E3 Source Code



with Text_Io, Filtre_D_Entree, Nos_Chaines;
package body Document is

    Ligne_Courante : Numeros_De_Lignes.Numero := 1;
    The_File : Text_Io.File_Type;

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

    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_mot_courant is
--begin
--  if mot_courant <= 4 then
--    mot_courant := 0;
--  end if;
--  Mot_Temporaire(1..80) := (others=>' ');
--  Mots.Creer (Le_Mot, Mot_Temporaire (1 .. Indice));
--end purger_mot_courant;

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


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


    procedure Get (Table_Of_Word : in out Mots.T_Tab_Commande;
                   Number_Of_Words : out Nombre_De_Mots.Numero) is

        Num_Of_Words : Nombre_De_Mots.Numero := 0;
        Existe_Instruction : Boolean := False;  
        Error_Number : Boolean := False;
        Tmp_Char : Character;
        Tmp_Word, Tmp1_Word : Mots.Word;
        Tmp_String : String (1 .. 80);
        Line_Len : Natural := 0;
        Word_Len : Natural := 0;

        Debug_Tab : Mots.T_Tab_Commande;

    begin
        Filtre_D_Entree.Enter (Tmp_String, Line_Len);

        if Line_Len > 0 then
            Tmp_Word := Nos_Chaines.Unbounded_Value (Tmp_String);

            for Indice in 1 .. Line_Len loop

                Tmp_Char := Nos_Chaines.Char_At_Pos (Tmp_Word, Indice);
                case Tmp_Char is
                    when 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' =>
                        Nos_Chaines.Infinite_String.Append
                           (Tmp1_Word, Tmp_Char);
                        Word_Len := Word_Len + 1;
                        Existe_Instruction := True;
                        if Indice = Line_Len then
                            if Word_Len > 0 then
                                if Num_Of_Words >= Nombre_De_Mots.
                                                      Nombre_Max_Mots then
                                    Error_Number := True;
                                    exit;
                                else
                                    Num_Of_Words := Num_Of_Words + 1;
                                    Nos_Chaines.Copy
                                       (Table_Of_Word (Num_Of_Words),
                                        Tmp1_Word);

                                    Nos_Chaines.Free (Tmp1_Word);
                                    Nos_Chaines.Free (Tmp_Word);
                                    Word_Len := 0;
                                end if;
                            else  
                                if not Existe_Instruction then
                                    Table_Of_Word (1) :=
                                       Nos_Chaines.Unbounded_Value ("nothing");
                                end if;
                            end if;
                        end if;
                    when others =>
                        if Word_Len > 0 then
                            if Num_Of_Words >= Nombre_De_Mots.
                                                  Nombre_Max_Mots then
                                Error_Number := True;
                                exit;
                            else
                                Num_Of_Words := Num_Of_Words + 1;
                                Nos_Chaines.Copy
                                   (Table_Of_Word (Num_Of_Words), Tmp1_Word);
                                Nos_Chaines.Free (Tmp1_Word);
                                Word_Len := 0;
                            end if;
                        end if;  
                end case;
            end loop;
            if Error_Number then
                Number_Of_Words := Nombre_De_Mots.Nombre_Max_Mots + 1;
            else
                Number_Of_Words := Num_Of_Words;
            end if;
        else
            Number_Of_Words := Num_Of_Words;
        end if;
    exception
        when Constraint_Error =>
            raise Mot_Trop_Long;
        when others =>
            Text_Io.Put_Line ("Erreur get!");
    end Get;

end Document;


E3 Meta Data

    nblk1=9
    nid=3
    hdr6=10
        [0x00] rec0=23 rec1=00 rec2=01 rec3=020
        [0x01] rec0=20 rec1=00 rec2=07 rec3=00c
        [0x02] rec0=13 rec1=00 rec2=06 rec3=042
        [0x03] rec0=23 rec1=00 rec2=05 rec3=028
        [0x04] rec0=1c rec1=00 rec2=04 rec3=034
        [0x05] rec0=12 rec1=00 rec2=09 rec3=052
        [0x06] rec0=13 rec1=00 rec2=02 rec3=06c
        [0x07] rec0=17 rec1=00 rec2=08 rec3=000
        [0x08] rec0=16 rec1=00 rec2=03 rec3=000
    tail 0x217479290864b830f6eb0 0x42a00088462060003
Free Block Chain:
  0x3: 0000  00 00 00 6c 80 33 20 20 20 4d 6f 74 5f 54 65 6d  ┆   l 3   Mot_Tem┆