DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400 Tapes

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 Tapes

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download
Index: ┃ B T

⟦1dac21d3c⟧ TextFile

    Length: 9408 (0x24c0)
    Types: TextFile
    Names: »B«

Derivation

└─⟦149519bd4⟧ Bits:30000546 8mm tape, Rational 1000, !projects 93-07-13
    └─ ⟦124ff5788⟧ »DATA« 
        └─⟦this⟧ 
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
    └─ ⟦129cab021⟧ »DATA« 
        └─⟦this⟧ 
└─⟦f64eaa120⟧ Bits:30000752 8mm tape, Rational 1000, !projects 93 02 16
    └─ ⟦6f12a12be⟧ »DATA« 
        └─⟦this⟧ 
└─⟦2f6cfab89⟧ Bits:30000547 8mm tape, Rational 1000, !projects 94-01-04
    └─ ⟦d65440be7⟧ »DATA« 
        └─⟦this⟧ 

TextFile

with Text_Io, Io_Exceptions;
package body Lex is

    package Input is
        function Open (Filename : String) return Boolean;
        function Atend return Boolean;
        function Get return Character;
        procedure Unget;
        procedure Close;
        function Getline return Positive;
    end Input;


    type State is (S_Start, S_Number, S_Str, S_Ok);
    type Condition is (C_Separator, C_Letter, C_Letteraf,
                       C_Letterh, C_Digit, C_Unknown);
    type Action is (A_Nothing, A_Car_String, A_Car_Number,
                    A_Number_Hex, A_Number_Dec, A_Error);
    type Transition is
        record
            Next_State : State;
            Next_Action : Action;
        end record;

    Max_Digit_Num : constant Integer := 4;
    Max_Car_String : constant Integer := 20;
    Min_Number_Value : constant Integer := 0;
    Max_Number_Value : constant Integer := 256 * 256;

    End_Found : Boolean := False;
    Current_Symbol : Token;
    type Chaine is access String;
    Storage_String : Chaine;
    Storage_Number : Integer;
    Transition_Table : array (State, Condition) of Transition :=
       (S_Start => ((S_Start, A_Nothing), (S_Str, A_Car_String),
                    (S_Str, A_Car_String), (S_Str, A_Car_String),
                    (S_Number, A_Car_Number), (S_Ok, A_Error)),
        S_Number => ((S_Ok, A_Number_Dec), (S_Ok, A_Error),
                     (S_Number, A_Car_Number), (S_Ok, A_Number_Hex),
                     (S_Number, A_Car_Number), (S_Ok, A_Error)),
        S_Str => ((S_Ok, A_Nothing), (S_Str, A_Car_String),
                  (S_Str, A_Car_String), (S_Str, A_Car_String),
                  (S_Str, A_Car_String), (S_Ok, A_Error)),
        S_Ok => ((S_Ok, A_Error), (S_Ok, A_Error), (S_Ok, A_Error),
                 (S_Ok, A_Error), (S_Ok, A_Error), (S_Ok, A_Error)));

    package body Input is
        File : Text_Io.File_Type;
        Look_Ahead : Boolean;
        Endline : Boolean;
        Endfile : Boolean;
        Current_Char : Character;
        Line_Number : Positive;

        function Open (Filename : String) return Boolean is
        begin  
            Text_Io.Open (File, Text_Io.In_File, Filename);
            Look_Ahead := False;
            Endline := False;
            Endfile := False;
            Line_Number := 1;
            return True;
        exception
            when others =>
                return False;
        end Open;


        procedure Next is
        begin  
            if not Look_Ahead then
                if Text_Io.End_Of_Line (File) then
                    if not Endline then
                        Current_Char := ' ';
                        Endline := True;
                    else
                        Endline := False;
                        Line_Number := Line_Number + 1;
                        Text_Io.Get (File, Current_Char);
                    end if;
                else
                    Text_Io.Get (File, Current_Char);
                end if;
            else
                Look_Ahead := False;
            end if;
        exception
            when Io_Exceptions.End_Error =>
                Endfile := True;
        end Next;

        function Value return Character is
        begin
            return Current_Char;
        end Value;

        function Atend return Boolean is
        begin
            if Look_Ahead then
                return False;
            else  
                return Endfile;
            end if;
        end Atend;


        function Get return Character is
        begin
            Next;
            return Value;
        end Get;


        procedure Unget is
        begin
            Look_Ahead := True;
        end Unget;

        procedure Close is
        begin
            Text_Io.Close (File);
        exception
            when others =>
                null;
        end Close;

        function Getline return Positive is
        begin
            return Line_Number;
        end Getline;

    end Input;


    function Conv_Strtoint (Str : String; Base : Integer) return Integer is
        Int : Integer := 0;
        Poids : Integer := 0;
    begin
        for I in reverse Str'First .. Str'Last loop
            if Str (I) in '0' .. '9' then
                Int := Int + (Character'Pos (Str (I)) - Character'Pos ('0')) *
                                Base ** Poids;
            else
                Int := Int + (Character'Pos (Str (I)) -
                              Character'Pos ('A') + 10) * Base ** Poids;
            end if;
            Poids := Poids + 1;
        end loop;
        return Int;
    end Conv_Strtoint;

    function Upper_Case (Car : Character) return Character is
    begin
        if Car in 'a' .. 'z' then
            return Character'Val (Character'Pos (Car) -
                                  (Character'Pos ('a') - Character'Pos ('A')));
        else
            return Car;
        end if;
    end Upper_Case;

    function Add_Cartostr (Str : Chaine; Car : Character) return Chaine is
    begin
        return new String'(Str.all & Car);
    end Add_Cartostr;

    function Strcpy (Str : String) return Chaine is
    begin
        return new String'(Str);
    end Strcpy;

    function Open (Filename : String) return Boolean is
    begin
        return Input.Open (Filename);
    end Open;

    function Gettoken return Token is
    begin
        return Current_Symbol;
    end Gettoken;

    function Getvalue return String is
    begin
        return Storage_String.all;
    end Getvalue;

    function Getvalue return Integer is
    begin
        return Storage_Number;
    end Getvalue;

    function Evaluate_Condition (Char : Character) return Condition is
    begin
        case Char is
            when '0' .. '9' =>
                return C_Digit;
            when 'A' .. 'F' =>
                return C_Letteraf;
            when 'H' =>
                return C_Letterh;
            when 'G' | 'I' .. 'Z' =>
                return C_Letter;
            when ' ' | ',' | '-' =>
                return C_Separator;
            when others =>
                return C_Unknown;
        end case;
    end Evaluate_Condition;

    function Evaluate_Numberdec return Token is
        Int : Integer;
    begin
        Int := Conv_Strtoint (Storage_String.all, 10);
        if Int >= Min_Number_Value and Int <= Max_Number_Value then
            Storage_Number := Int;
            return Number;
        else
            return Unknown;
        end if;
    end Evaluate_Numberdec;

    function Evaluate_Numberhex return Token is
        Int : Integer;
    begin
        Int := Conv_Strtoint (Storage_String.all, 16);
        if Int >= Min_Number_Value and Int <= Max_Number_Value then
            Storage_Number := Int;
            return Number;
        else
            return Unknown;
        end if;
    end Evaluate_Numberhex;

    function Car_String (Car : Character) return Token is
    begin  
        if Storage_String'Length < Max_Car_String then
            Storage_String := Add_Cartostr (Storage_String, Car);
            return Str;
        else
            return Unknown;
        end if;
    end Car_String;

    function Car_Number (Car : Character) return Token is
    begin  
        if Storage_String'Length < Max_Digit_Num then
            Storage_String := Add_Cartostr (Storage_String, Car);
            return Number;
        else
            return Unknown;
        end if;
    end Car_Number;

    procedure Getnext is
        Current_Transition : Transition;
        Current_Condition : Condition;
        Current_Char : Character;
    begin
        if not Input.Atend then
            Current_Transition.Next_State := S_Start;
            Storage_String := Strcpy ("");
            Storage_Number := 0;
            while Current_Transition.Next_State /= S_Ok loop
                Current_Char := Upper_Case (Input.Get);
                Current_Condition := Evaluate_Condition (Current_Char);
                Current_Transition :=
                   Transition_Table (Current_Transition.Next_State,
                                     Current_Condition);
                case Current_Transition.Next_Action is
                    when A_Nothing =>
                        null;
                    when A_Car_Number =>
                        Current_Symbol := Car_Number (Current_Char);
                    when A_Car_String =>
                        Current_Symbol := Car_String (Current_Char);
                    when A_Number_Hex =>
                        Current_Symbol := Evaluate_Numberhex;
                    when A_Number_Dec =>
                        Current_Symbol := Evaluate_Numberdec;
                    when A_Error =>
                        Current_Symbol := Unknown;
                end case;
                if Current_Symbol = Unknown then
                    Current_Transition.Next_State := S_Ok;
                end if;
                if Current_Transition.Next_State /= S_Ok and Input.Atend then
                    Current_Transition.Next_State := S_Ok;
                    Current_Symbol := File_End;
                end if;
            end loop;
        else
            Current_Symbol := File_End;
        end if;
    end Getnext;

    function Getline return Positive is
    begin
        return Input.Getline;
    end Getline;

    procedure Close is
    begin
        Input.Close;
    end Close;

end Lex;