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

⟦57f3dc61b⟧ Ada Source

    Length: 18432 (0x4800)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Scanner, seg_037d97, seg_038a90, seg_039412, seg_039563

Derivation

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

with Errors;
with String_Utilities;
with Text_Io;
with Tiny_File;
with Trace;

package body Scanner is

    type State is (St_Normal, St_Minus, St_Comm, St_Str, St_Int,
                   St_Id, St_Id_More, St_Less, St_Great, St_Found);

    Current_Lexeme : Lexeme;
    Current_State : State;
    Current_Token : Token;
    Current_Line : Natural;
    Error_Number : Natural;
    Current_String_Length : Natural;
    Current_Id_Length : Natural;

    File_Input : Text_Io.File_Type;

    procedure Start (File_Name : String) is
    begin
        Tiny_File.Open (File_Input, File_Name);
        Current_Line := 1;
    end Start;

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

    function Get_Value return Lexeme is
    begin
        return Current_Lexeme;
    end Get_Value;

    function Get_Line_Number return Natural is
    begin
        return Current_Line;
    end Get_Line_Number;

    function Get_Error_Number return Natural is
    begin
        return Error_Number;
    end Get_Error_Number;

    procedure Check_For_Int_Error is
        Current_Number : Integer;
        Ok : Boolean;
    begin
        String_Utilities.String_To_Number
           (Bounded_String.Image (Current_Lexeme), Current_Number, Ok);
        if not Ok then
            Current_Token := L_Unk;
            Error_Number := 5;
        end if;
    end Check_For_Int_Error;

    function Check_If_Reserved (Id : String) return Token is
    begin
        if Custom.Is_Reserved_Word (Id) then
            case Custom.Reserved_Word'Value (Id) is
                when Custom.Avec =>
                    return L_Avec;
                when Custom.Pour =>
                    return L_Pour;
                when Custom.Prendre =>
                    return L_Pren;
                when Custom.Renvoyer =>
                    return L_Renv;
            end case;
        else
            return L_Id;
        end if;
    end Check_If_Reserved;

    procedure Normal_State (Current_Char : in out Character) is
    begin
        case Current_Char is
            when Ascii.Eot =>
                Current_Token := L_Eof;
                Current_State := St_Found;
            when ' ' | Ascii.Cr =>
                null;
            when '-' =>
                Current_State := St_Minus;
                Bounded_String.Append (Current_Lexeme, Current_Char);
            when '"' =>  
                Current_State := St_Str;
                Current_String_Length := 0;
            when '0' .. '9' =>
                Current_State := St_Int;
                Bounded_String.Append (Current_Lexeme, Current_Char);
            when 'a' .. 'z' | 'A' .. 'Z' =>
                Current_State := St_Id;
                String_Utilities.Upper_Case (Current_Char);
                Bounded_String.Append (Current_Lexeme, Current_Char);
                Current_Id_Length := 1;
            when '{' =>
                Current_State := St_Found;
                Bounded_String.Append (Current_Lexeme, Current_Char);
                Current_Token := L_Obra;  
            when '}' =>
                Current_State := St_Found;
                Bounded_String.Append (Current_Lexeme, Current_Char);
                Current_Token := L_Cbra;
            when '.' =>
                Current_State := St_Found;
                Bounded_String.Append (Current_Lexeme, Current_Char);
                Current_Token := L_Dot;
            when '(' =>
                Current_State := St_Found;
                Bounded_String.Append (Current_Lexeme, Current_Char);
                Current_Token := L_Opar;
            when ')' =>
                Current_State := St_Found;
                Bounded_String.Append (Current_Lexeme, Current_Char);
                Current_Token := L_Cpar;
            when '+' | '*' | '/' | '^' | '=' | '&' | '|' | '%' =>
                Current_State := St_Found;
                Bounded_String.Append (Current_Lexeme, Current_Char);
                Current_Token := L_Binm;
            when '<' =>
                Current_State := St_Less;
                Bounded_String.Append (Current_Lexeme, Current_Char);
            when '>' =>
                Current_State := St_Great;  
                Bounded_String.Append (Current_Lexeme, Current_Char);
            when others =>
                Current_State := St_Found;
                Bounded_String.Append (Current_Lexeme, Current_Char);
                Current_Token := L_Unk;
                Error_Number := 1;
        end case;
    end Normal_State;

    procedure Minus_State (Current_Char : Character) is
    begin
        case Current_Char is
            when '-' =>
                Current_State := St_Comm;
            when others =>
                Tiny_File.Unget (File_Input);
                Current_State := St_Found;  
                Current_Token := L_Binm;
        end case;
    end Minus_State;

    procedure Comm_State (Current_Char : Character) is
    begin
        case Current_Char is
            when Ascii.Cr =>
                Current_State := St_Normal;
                Bounded_String.Free (Current_Lexeme);
            when others =>
                null;
        end case;  
    end Comm_State;

    procedure Str_State (Current_Char : Character) is
    begin
        case Current_Char is
            when '"' =>
                Current_State := St_Found;
                Current_Token := L_Str;
            when Ascii.Cr =>
                null;
            when others =>
                Current_String_Length := Current_String_Length + 1;
                if Current_String_Length > Custom.String_Max_Length then
                    Current_State := St_Found;
                    Current_Token := L_Unk;
                    Error_Number := 3;
                else
                    Bounded_String.Append (Current_Lexeme, Current_Char);
                end if;
        end case;
    end Str_State;

    procedure Int_State (Current_Char : Character) is
    begin
        case Current_Char is
            when '0' .. '9' =>
                Bounded_String.Append (Current_Lexeme, Current_Char);
            when others =>  
                Tiny_File.Unget (File_Input);
                Current_State := St_Found;
                Current_Token := L_Int;
                Check_For_Int_Error;
        end case;
    end Int_State;

    procedure Id_State (Current_Char : in out Character) is
    begin
        case Current_Char is
            when '0' .. '9' | 'a' .. 'z' | 'A' .. 'Z' =>
                Current_Id_Length := Current_Id_Length + 1;
                if Current_Id_Length > Custom.Id_Max_Length then
                    Current_State := St_Found;
                    Current_Token := L_Unk;
                    Error_Number := 4;
                else
                    String_Utilities.Upper_Case (Current_Char);
                    Bounded_String.Append (Current_Lexeme, Current_Char);
                end if;
            when '_' =>
                Current_Id_Length := Current_Id_Length + 1;
                if Current_Id_Length > Custom.Id_Max_Length then
                    Current_State := St_Found;
                    Current_Token := L_Unk;
                    Error_Number := 4;
                else
                    Current_State := St_Id_More;
                    Bounded_String.Append (Current_Lexeme, Current_Char);
                end if;
            when ':' =>
                Current_Id_Length := Current_Id_Length + 1;
                if Current_Id_Length > Custom.Id_Max_Length then
                    Current_State := St_Found;
                    Current_Token := L_Unk;
                    Error_Number := 4;
                else
                    Bounded_String.Append (Current_Lexeme, Current_Char);
                    Current_State := St_Found;
                    Current_Token := L_Keyw;
                end if;
            when others =>
                Tiny_File.Unget (File_Input);
                Current_State := St_Found;
                Current_Token := Check_If_Reserved
                                    (Bounded_String.Image (Current_Lexeme));
        end case;
    end Id_State;

    procedure Id_More_State (Current_Char : in out Character) is
    begin
        case Current_Char is
            when '0' .. '9' | 'a' .. 'z' | 'A' .. 'Z' =>
                Current_Id_Length := Current_Id_Length + 1;
                if Current_Id_Length > Custom.Id_Max_Length then
                    Current_State := St_Found;
                    Current_Token := L_Unk;
                    Error_Number := 4;
                else
                    Current_State := St_Id;
                    String_Utilities.Upper_Case (Current_Char);
                    Bounded_String.Append (Current_Lexeme, Current_Char);
                end if;
            when others =>
                Current_State := St_Found;
                Bounded_String.Append (Current_Lexeme, Current_Char);
                Current_Token := L_Unk;
                Error_Number := 2;
        end case;
    end Id_More_State;

    procedure Less_State (Current_Char : Character) is
    begin
        case Current_Char is
            when '>' | '=' =>
                Current_State := St_Found;
                Current_Token := L_Binm;
                Bounded_String.Append (Current_Lexeme, Current_Char);
            when others =>  
                Tiny_File.Unget (File_Input);
                Current_State := St_Found;
                Current_Token := L_Binm;
        end case;
    end Less_State;

    procedure Great_State (Current_Char : Character) is
    begin
        case Current_Char is
            when '=' =>
                Current_State := St_Found;
                Current_Token := L_Binm;
                Bounded_String.Append (Current_Lexeme, Current_Char);
            when others =>  
                Tiny_File.Unget (File_Input);
                Current_State := St_Found;
                Current_Token := L_Binm;
        end case;
    end Great_State;

    procedure Next_Token is
        Current_Char : Character;
    begin
        Bounded_String.Free (Current_Lexeme);
        Current_State := St_Normal;
        Error_Number := 0;
        loop
            Current_Char := Tiny_File.Get (File_Input);
            if Current_Char = Ascii.Cr then
                Current_Line := Current_Line + 1;
            end if;
            case Current_State is
                when St_Normal =>
                    Normal_State (Current_Char);
                when St_Minus =>
                    Minus_State (Current_Char);
                when St_Comm =>
                    Comm_State (Current_Char);  
                when St_Str =>
                    Str_State (Current_Char);
                when St_Int =>
                    Int_State (Current_Char);
                when St_Id =>
                    Id_State (Current_Char);
                when St_Id_More =>
                    Id_More_State (Current_Char);
                when St_Less =>
                    Less_State (Current_Char);
                when St_Great =>
                    Great_State (Current_Char);
                when St_Found =>
                    exit;
            end case;
            exit when Current_State = St_Found;
        end loop;
        case Current_Token is
            when L_Unk =>
                raise Errors.Unknown_Lexeme_Found;
            when others =>
                null;
        end case;
        Trace.Display (Current_Token);
        Trace.Display (Current_Lexeme);
    end Next_Token;

    procedure Stop is
    begin
        Tiny_File.Close (File_Input);

    end Stop;

end Scanner;

    nblk1=11
    nid=8
    hdr6=1a
        [0x00] rec0=2a rec1=00 rec2=01 rec3=024
        [0x01] rec0=1f rec1=00 rec2=0a rec3=02a
        [0x02] rec0=1b rec1=00 rec2=0b rec3=00c
        [0x03] rec0=03 rec1=00 rec2=10 rec3=058
        [0x04] rec0=15 rec1=00 rec2=0e rec3=020
        [0x05] rec0=1b rec1=00 rec2=07 rec3=05c
        [0x06] rec0=1d rec1=00 rec2=0c rec3=010
        [0x07] rec0=1a rec1=00 rec2=02 rec3=03c
        [0x08] rec0=15 rec1=00 rec2=04 rec3=04e
        [0x09] rec0=18 rec1=00 rec2=0d rec3=01e
        [0x0a] rec0=1c rec1=00 rec2=05 rec3=050
        [0x0b] rec0=1c rec1=00 rec2=06 rec3=018
        [0x0c] rec0=20 rec1=00 rec2=03 rec3=000
        [0x0d] rec0=21 rec1=00 rec2=03 rec3=000
        [0x0e] rec0=19 rec1=00 rec2=03 rec3=000
        [0x0f] rec0=10 rec1=00 rec2=02 rec3=000
        [0x10] rec0=00 rec1=00 rec2=00 rec3=000
    tail 0x21531268084e5885989c7 0x42a00088462060003
Free Block Chain:
  0x8: 0000  00 0f 00 06 80 03 65 5f 4e 03 5f 4e 06 20 47 65  ┆      e_N _N  Ge┆
  0xf: 0000  00 09 03 fc 80 06 20 63 61 73 65 3b 06 00 0c 20  ┆       case;    ┆
  0x9: 0000  00 11 03 fc 80 24 5f 53 74 61 74 65 20 28 43 75  ┆     $_State (Cu┆
  0x11: 0000  00 00 00 04 00 01 20 01 02 03 04 00 00 01 57 3a  ┆              W:┆