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

⟦7ccc173d3⟧ Ada Source

    Length: 12288 (0x3000)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Lexical, seg_0491b6

Derivation

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

with Bounded_String, Source, Text_Io;

use Bounded_String;

package body Lexical is

    type State is (St_Normal, St_Comment, St_Nbr, St_Debstr, St_Finstr,
                   St_Id, St_2point, St_Affect, St_Inf, St_Infequ,
                   St_Diffr, St_Sup, St_Supequ, St_Newlinestr, St_Found);
    subtype Minuscule is Character range 'a' .. 'z';
    subtype Majuscule is Character range 'A' .. 'Z';
    subtype Digit is Character range '0' .. '9';
    subtype Keyword is Token range Jeu .. Fin;

    The_Case_Offset : constant := Character'Pos ('a') - Character'Pos ('A');

    Currentvalue : Variable_String (Maxstring);
    Currenttoken : Token;

    function Make_Uppercase (The_Character : in Character) return Character is
    begin -- Make_Uppercase
        if The_Character in Minuscule then
            return Character'Val
                      (Character'Pos (The_Character) - The_Case_Offset);
        else
            return The_Character;
        end if;
    end Make_Uppercase;

    function Iskeyword (The_String : in String) return Boolean is
        T : Keyword;
    begin
        T := Keyword'Value (The_String);
        return True;
    exception
        when Constraint_Error =>
            return False;
    end Iskeyword;



    function Keywordtotoken (Word : in String) return Token is
    begin
        if Iskeyword (Word) then
            return Token'Value (Word);
        else
            return Id;
        end if;
    end Keywordtotoken;



    procedure Get_State_After_Inf
                 (Astate : in out State; Achar : in Character) is
    begin
        case Achar is
            when '=' =>
                Currenttoken := Infequ;
            when '>' =>
                Currenttoken := Diffr;
            when others =>
                Source.Unget;
                Currenttoken := Inf;
        end case;
        Astate := St_Found;
    end Get_State_After_Inf;


    procedure Get_State_After_Sup
                 (Astate : in out State; Achar : in Character) is
    begin
        if (Achar = '=') then
            Currenttoken := Supequ;
        else
            Currenttoken := Sup;
            Source.Unget;
        end if;
        Astate := St_Found;
    end Get_State_After_Sup;

    procedure Get_String_After_Debstr
                 (Astate : in out State; Achar : in Character) is
    begin
        if (Achar = '"') then
            Astate := St_Finstr;
        elsif (Achar = '\') then
            Astate := St_Newlinestr;
        elsif not (Achar = Ascii.Cr) then
            Bounded_String.Append (Currentvalue, Achar);
        end if;
    end Get_String_After_Debstr;


    procedure Get_String_After_Newlinestr
                 (Astate : in out State; Achar : in Character) is
    begin
        if (Achar = '\') then
            Astate := St_Debstr;
        elsif (Achar = ' ' or Achar = Ascii.Cr or Achar = Ascii.Ht) then
            Astate := St_Newlinestr;
        else
            Currenttoken := Unk;
            Astate := St_Found;
        end if;
    end Get_String_After_Newlinestr;


    procedure Get_String_After_Finstr
                 (Astate : in out State; Achar : in Character) is
    begin
        if (Achar = '"') then
            Bounded_String.Append (Currentvalue, Achar);
            Astate := St_Debstr;
        else
            Currenttoken := Str;
            Astate := St_Found;
            Source.Unget;
        end if;
    end Get_String_After_Finstr;

    procedure Get_State_After_2point
                 (Astate : in out State; Achar : in Character) is
    begin
        if (Achar = '=') then
            Currenttoken := Affect;
        else
            Currenttoken := Unk;
        end if;
        Astate := St_Found;
    end Get_State_After_2point;


    procedure Get_Id (Astate : in out State; Achar : in Character) is
    begin

        if (Achar in Minuscule or Achar in Majuscule or
            Achar in Digit or Achar = '_') then
            Bounded_String.Append (Currentvalue, Make_Uppercase (Achar));
        else
            Source.Unget;
            Astate := St_Found;
            Currenttoken := Keywordtotoken
                               (Bounded_String.Image (Currentvalue));
        end if;
    end Get_Id;


    procedure Get_Nbr (Astate : in out State; Achar : in Character) is
    begin
        if (Achar in Digit) then
            Bounded_String.Append (Currentvalue, Achar);
        else
            Source.Unget;
            Astate := St_Found;
            Currenttoken := Nbr;
        end if;
    end Get_Nbr;


    procedure Get_State_After_Normal
                 (Astate : in out State; Achar : in Character) is
    begin
        case Achar is
            when Ascii.Cr | Ascii.Ht | ' ' =>
                Astate := St_Normal;
            when '*' =>
                Currenttoken := Mul;
                Astate := St_Found;
            when '/' =>
                Currenttoken := Div;
                Astate := St_Found;
            when '[' =>
                Currenttoken := Crocho;
                Astate := St_Found;
            when ']' =>
                Currenttoken := Crochf;
                Astate := St_Found;
            when '(' =>
                Currenttoken := Parnto;
                Astate := St_Found;
            when ')' =>
                Currenttoken := Parntf;
                Astate := St_Found;
            when ',' =>
                Currenttoken := Virgul;
                Astate := St_Found;
            when '+' =>
                Currenttoken := Plus;
                Astate := St_Found;
            when '-' =>
                Currenttoken := Moins;
                Astate := St_Found;
            when '.' =>
                Currenttoken := Point;
                Astate := St_Found;
            when '=' =>
                Currenttoken := Equ;
                Astate := St_Found;
            when '{' =>
                Astate := St_Comment;
            when '"' =>
                Astate := St_Debstr;
            when ':' =>
                Astate := St_2point;
            when '<' =>
                Astate := St_Inf;
            when '>' =>
                Astate := St_Sup;

            when Digit =>
                Bounded_String.Append (Currentvalue, Achar);
                Astate := St_Nbr;
            when Majuscule | Minuscule =>
                Bounded_String.Append (Currentvalue, Make_Uppercase (Achar));
                Astate := St_Id;
            when others =>
                Bounded_String.Append (Currentvalue, Achar);
                Currenttoken := Unk;
                Astate := St_Found;
        end case;
    end Get_State_After_Normal;





    procedure Init (Nomf : String) is

    begin
        Source.Init (Nomf);
    end Init;

    function Get_Token return Token is
    begin
        return Currenttoken;
    end Get_Token;

    function Get_Value return String is
    begin
        return Bounded_String.Image (Currentvalue);
    end Get_Value;

    function At_End return Boolean is
    begin
        return Source.At_End;
    end At_End;

    function Get_Line return Natural is
    begin
        return Source.Get_Line;
    end Get_Line;

    function Get_Column return Natural is
    begin
        return Source.Get_Column;
    end Get_Column;


    procedure Next is

        Currentchar : Character;
        Currentstate : State;

    begin
        if not (Source.At_End) then
            Bounded_String.Free (Currentvalue);
            Currentstate := St_Normal;
            Search_Token:
                loop
                    if not (Source.At_End) then
                        Source.Next;
                        Currentchar := Source.Value;
                    else
                        Currenttoken := Lexend;
                        exit Search_Token;
                    end if;

                    case Currentstate is
                        when St_Normal =>
                            Get_State_After_Normal (Currentstate, Currentchar);
                        when St_Comment =>
                            if (Currentchar = '}') then
                                Currentstate := St_Normal;
                            end if;
                        when St_Debstr =>
                            Get_String_After_Debstr (Currentstate, Currentchar);
                        when St_Newlinestr =>
                            Get_String_After_Newlinestr
                               (Currentstate, Currentchar);
                        when St_Finstr =>
                            Get_String_After_Finstr (Currentstate, Currentchar);
                        when St_2point =>
                            Get_State_After_2point (Currentstate, Currentchar);
                        when St_Inf =>
                            Get_State_After_Inf (Currentstate, Currentchar);
                        when St_Sup =>
                            Get_State_After_Sup (Currentstate, Currentchar);
                        when St_Id =>
                            Get_Id (Currentstate, Currentchar);
                        when St_Nbr =>
                            Get_Nbr (Currentstate, Currentchar);
                        when others =>
                            Currenttoken := Unk;
                            Bounded_String.Append (Currentvalue, Currentchar);
                            Currentstate := St_Found;
                    end case;
                    exit when Currentstate = St_Found;

                end loop Search_Token;
        else
            Currenttoken := Lexend;
        end if;
    end Next;
   procedure Close is
    begin
        Source.Close;
    end Close;

end Lexical;

    nblk1=b
    nid=0
    hdr6=16
        [0x00] rec0=1c rec1=00 rec2=01 rec3=00a
        [0x01] rec0=27 rec1=00 rec2=02 rec3=034
        [0x02] rec0=21 rec1=00 rec2=03 rec3=05c
        [0x03] rec0=22 rec1=00 rec2=04 rec3=07a
        [0x04] rec0=21 rec1=00 rec2=05 rec3=00e
        [0x05] rec0=1d rec1=00 rec2=06 rec3=018
        [0x06] rec0=21 rec1=00 rec2=07 rec3=000
        [0x07] rec0=2c rec1=00 rec2=08 rec3=004
        [0x08] rec0=14 rec1=00 rec2=09 rec3=020
        [0x09] rec0=17 rec1=00 rec2=0a rec3=002
        [0x0a] rec0=08 rec1=00 rec2=0b rec3=000
    tail 0x215467726865b46639d0d 0x42a00088462060003