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

⟦6b3c3f3de⟧ Ada Source

    Length: 5120 (0x1400)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Lex_Jo, seg_040285

Derivation

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

with Screen;
use Screen;
package body Lex_Jo is

    Max_Mot : constant Natural := 4;

    subtype Digit is Character range '0' .. '9';
    subtype Lowercase is Character range 'a' .. 'z';
    subtype Uppercase is Character range 'A' .. 'Z';


    procedure Saisircommande (Error : in out Boolean;
                              Nb_Mot : in out Natural;
                              Tab_Mot : in out Tableau_Mot) is
        Une_Chaine : String (1 .. 80);
        Nb_Car_Lu, Cpt : Natural;
        Nouveau_Mot : Boolean := True;
    begin
        Read_Player (Une_Chaine, Nb_Car_Lu);

        Tab_Mot := (1 .. Max_Mot => Ubs.Nil);
        Cpt := 1;
        Nb_Mot := 0;
        Error := False;
        while (Cpt <= Nb_Car_Lu) and not Error loop
            case Une_Chaine (Cpt) is
                when Digit | Lowercase | Uppercase | '_' =>
                    if not Nouveau_Mot then
                        Ubs.Append (Tab_Mot (Nb_Mot), Une_Chaine (Cpt));
                        Cpt := Cpt + 1;
                    else
                        if Nb_Mot < Max_Mot then
                            Nb_Mot := Nb_Mot + 1;
                            Ubs.Free (Tab_Mot (Nb_Mot));
                            Nouveau_Mot := False;
                        else
                            Error := True;
                        end if;
                    end if;
                when ' ' =>
                    while Une_Chaine (Cpt) = ' ' loop
                        Cpt := Cpt + 1;
                    end loop;
                    Nouveau_Mot := True;
                when others =>
                    Error := True;
            end case;
        end loop;
    end Saisircommande;

    procedure Traitercommande is
        Error : Boolean;
        Tab : Tableau_Mot;
        Nb_Mots : Natural;
    begin
        Open_All_Win;
        loop
            Saisircommande (Error, Nb_Mots, Tab);
            if not Error then
                exit when Ubs.Image (Tab (1)) = "quit";
                for I in Tab'Range loop
                    Write_World (Ubs.Image (Tab (I)));
                end loop;
            else
                Write_World ("il y a eu une erreur detecte dans la phrase !!");
            end if;
        end loop;
        Close_All_Win;
    end Traitercommande;

end Lex_Jo;

    nblk1=4
    nid=3
    hdr6=6
        [0x00] rec0=1e rec1=00 rec2=01 rec3=090
        [0x01] rec0=1e rec1=00 rec2=04 rec3=032
        [0x02] rec0=0d rec1=00 rec2=02 rec3=000
        [0x03] rec0=08 rec1=00 rec2=02 rec3=000
    tail 0x2153a8340860d9577f785 0x42a00088462060003
Free Block Chain:
  0x3: 0000  00 00 01 95 80 02 65 6e 02 00 37 20 20 20 20 20  ┆      en  7     ┆