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

⟦7bc8d3852⟧ TextFile

    Length: 14411 (0x384b)
    Types: TextFile
    Names: »B«

Derivation

└─⟦5829e5ed5⟧ Bits:30000534 8mm tape, Rational 1000, RCI 2_0_5
    └─ ⟦c9a165082⟧ »DATA« 
        └─⟦2162db02b⟧ 
            └─⟦this⟧ 

TextFile

separate (Parameter_Parser)
procedure Parse (Parameter : String;
                 Options : out Iterator;
                 Success : out Boolean) is

    Iter : Iterator := new Iterator_Data;
    Itns : Iteration;


    procedure Parse (Parameter : String) is
        Pos : Integer := Parameter'First;
        Last : Integer := Parameter'Last;
        Token : Token_Kind;
        Start, Finish : Integer;
        Name : Image;
        Value : Image;

        function New_Iteration (Id : Option_Id) return Iteration is
            Itn : Iteration := new Iteration_Data;
        begin
            Itn.Name := Find (Id);

            if Itn.Name /= null then
                Itn.Status := Ok;
            else
                Itn.Status := Undefined_Id;
                Itn.Diagnosis := new String'(Option_Id'Image (Id));
            end if;

            return Itn;
        end New_Iteration;

        function New_Iteration (Name : Image) return Iteration is
            Itn : Iteration := new Iteration_Data;
            Id : Option_Id;
        begin
            if Name = null then
                Itn.Status := Missing_Name;
                Itn.Diagnosis := new String'(Parameter (Start .. Finish));
            else
                declare
                    Norm : constant String := Normal (Name.all);
                begin
                    Itn.Name := Find (Norm, True);

                    if Itn.Name = null then
                        Itn.Status := Undefined_Name;
                        Itn.Diagnosis := Name;
                        return Itn;
                    end if;

                    if Norm /= Itn.Name.Name.all and then
                       Find (Norm, True, Itn.Name.Next) /= null then
                        Itn.Name := Find (Norm);  -- look for exact match

                        if Itn.Name = null then
                            -- No exact, 2 prefixes match
                            Itn.Status := Ambiguous_Name;
                            Itn.Diagnosis := Name;
                            return Itn;
                        end if;
                    end if;

                    Itn.Status := Ok;
                    Itn.Kind := Itn.Name.Kind;

                    if Itn.Kind = Literal then
                        Itn.Value := Name;
                        Id := Itn.Name.Id;
                        Itn.Name := Find (Id);

                        if Itn.Name = null then
                            Itn.Status := Undefined_Id;
                            Itn.Diagnosis := new String'(Option_Id'Image (Id));
                        end if;
                    end if;
                end;
            end if;

            return Itn;
        end New_Iteration;

        procedure Add_Iteration (Itn : Iteration) is
            Pnt : Iteration;
        begin
            if Itn.Status = Ok then
                Pnt := Itns;

                while Pnt /= null loop
                    if Pnt.Status = Ok and then Pnt.Name.Id = Itn.Name.Id then
                        return;
                    else
                        Pnt := Pnt.Next;
                    end if;
                end loop;
            end if;

            Itn.Next := Itns;
            Itns := Itn;
        end Add_Iteration;

        procedure Add_Iteration (Name1 : Image) is
        begin
            Add_Iteration (New_Iteration (Name1));
        end Add_Iteration;

        procedure Add_Iteration (Name1, Name2 : Image) is
            Itn1 : Iteration;
            Itn2 : Iteration;
        begin
            Itn1 := New_Iteration (Name1);
            Itn2 := New_Iteration (Name2);

            Add_Iteration (Itn1);

            if Itn1.Status = Ok and then Itn2.Status = Ok then
                for I in Option_Id'Succ (Itn1.Name.Id) ..
                            Option_Id'Pred (Itn2.Name.Id) loop
                    Add_Iteration (New_Iteration (I));
                end loop;
            end if;

            Add_Iteration (Itn2);
        end Add_Iteration;

        procedure Add_Range (Id1, Id2 : Option_Id) is
            Opt : Option;
            Itn : Iteration;
        begin
            for Id in Id1 .. Id2 loop
                Opt := Find (Id);

                if Opt /= null then
                    Itn := new Iteration_Data;
                    Itn.Name := Opt;
                    Itn.Status := Ok;
                    Add_Iteration (Itn);
                end if;
            end loop;
        end Add_Range;

        procedure Eat_Token is
        begin
            loop
                if Pos not in Parameter'First .. Last then
                    Token := End_String;
                    Start := Parameter'First;
                    Finish := Start - 1;
                    return;
                end if;

                exit when Parameter (Pos) /= ' ';

                Pos := Pos + 1;
            end loop;

            Start := Pos;
            Finish := Pos;

            Token := Other;

            case Parameter (Pos) is
                when '=' =>
                    if Pos < Last and then Parameter (Pos + 1) = '>' then
                        Finish := Pos + 1;
                    end if;

                    Token := Arrow;

                when ':' =>
                    if Pos < Last and then Parameter (Pos + 1) = '=' then
                        Finish := Pos + 1;
                        Token := Arrow;
                    end if;

                when '|' =>
                    Token := Bar;

                when '.' =>
                    if Pos < Last and then Parameter (Pos + 1) = '.' then
                        Finish := Pos + 1;
                        Token := Dots;
                    end if;

                when '~' =>
                    Token := Tilde;

                when ',' | ';' | Ascii.Lf =>
                    Token := Separator;

                when others =>
                    null;
            end case;

            Pos := Finish + 1;
        end Eat_Token;

        procedure Get_Value is
            D : Integer := 0;
        begin
            case Token is
                when Separator | End_String =>
                    -- null Value
                    Pos := Finish;
                    Finish := Start - 1;

                when others =>
                    if Parameter (Start) = '(' or else
                       Parameter (Start) = '[' or else
                       Parameter (Start) = '{' then
                        while Pos <= Last loop
                            case Parameter (Pos) is
                                when '(' | '[' | '{' =>
                                    D := D + 1;
                                when ')' | ']' | '}' =>
                                    exit when D = 0;
                                    D := D - 1;
                                when '\' =>
                                    Pos := Pos + 1;
                                when others =>
                                    null;
                            end case;

                            Pos := Pos + 1;
                        end loop;

                        Finish := Pos;
                        Pos := Pos + 1;
                    else
                        while Pos <= Last loop
                            case Parameter (Pos) is
                                when ',' | ';' | Ascii.Lf =>
                                    exit;
                                when '\' =>
                                    Pos := Pos + 1;
                                    Finish := Pos;
                                when ' ' =>
                                    null;
                                when others =>
                                    Finish := Pos;
                            end case;

                            Pos := Pos + 1;
                        end loop;
                    end if;
            end case;

            Value := new String'(Parameter (Start .. Finish));
            Eat_Token;
        end Get_Value;

        procedure Get_Name is
        begin
            if Token = Other then
                while Pos <= Last loop
                    case Parameter (Pos) is
                        when '=' | ';' | ',' | ' ' | Ascii.Lf | '|' =>
                            exit;
                        when ':' =>
                            exit when Pos < Last and then
                                         Parameter (Pos + 1) = '=';
                        when '.' =>
                            exit when Pos < Last and then
                                         Parameter (Pos + 1) = '.';
                        when others =>
                            null;
                    end case;

                    Pos := Pos + 1;
                end loop;

                Finish := Pos - 1;
                Name := new String'(Parameter (Start .. Finish));
                Eat_Token;
            else
                Name := null;
            end if;
        end Get_Name;

        procedure Get_Range is
            Name1 : Image;
        begin
            Get_Name;

            if Token = Dots then
                if Name = null then
                    Add_Iteration (Name);
                    Eat_Token;
                    Get_Name;
                    Add_Iteration (Name);
                else
                    Name1 := Name;
                    Eat_Token;
                    Get_Name;
                    Add_Iteration (Name1, Name);
                end if;

            elsif Name /= null and then Normal (Name.all) = "OTHERS" then
                Add_Range (Lowest, Highest);

            else
                Add_Iteration (Name);
            end if;
        end Get_Range;

        procedure Get_Option is
            Fence : Iteration := Itns;
            Itn : Iteration;
            I : Integer;
            F : Float;
            Boolean_Sense : Boolean := True;
            Tilded : Boolean := False;
            Defaulted : Boolean;
        begin
            while Token = Tilde loop
                Boolean_Sense := not Boolean_Sense;
                Tilded := True;
                Eat_Token;
            end loop;

            loop
                Get_Range;
                exit when Token /= Bar;
                Eat_Token;
            end loop;

            Itn := Itns;

            if Token = Arrow then
                Eat_Token;
                Get_Value;
                Defaulted := Value.all = "<>";

                while Itn /= Fence loop
                    if Tilded then
                        Itn.Status := Tilded_Value;
                    elsif Itn.Status = Ok then
                        if Itn.Kind = Literal then
                            Itn.Status := Literal_Has_Value;
                            Itn.Diagnosis := Value;
                        elsif Defaulted then
                            if Itn.Name.Value /= null then
                                Itn.Value := new String'(Itn.Name.Value.all);
                            end if;
                        else
                            Itn.Value := Value;

                            case Itn.Kind is
                                when Boolean_Valued =>
                                    if Su.Locate (Value.all, "False", True) /=
                                       1 and then
                                       Su.Locate (Value.all, "True", True) /=
                                          1 then
                                        Itn.Status := Malformed_Boolean;
                                    end if;
                                when Integer_Valued =>
                                    I := Get_Integer
                                            (Itn);  -- exec for side-effect
                                when Float_Valued =>
                                    F := Get_Float
                                            (Itn);  -- exec for side-effect
                                when Literal | Unspecified =>
                                    null;
                            end case;
                        end if;
                    else
                        Itn.Value := Value;
                    end if;

                    Itn := Itn.Next;
                end loop;
            else
                while Itn /= Fence loop
                    if Itn.Status = Ok then
                        if Itn.Kind = Literal then
                            if Tilded then
                                Itn.Status := Tilded_Literal;
                            end if;
                        elsif Itn.Name.Kind = Boolean_Valued then
                            Itn.Value := Boolean_Value (Boolean_Sense);
                        elsif Itn.Name.Value /= null and then
                              (Su.Locate (Itn.Name.Value.all, "False", True) =
                               1 or else
                               Su.Locate (Itn.Name.Value.all, "True", True) =
                                  1) then
                            Itn.Value := Boolean_Value (Boolean_Sense);
                        else
                            Itn.Status := Has_No_Value;
                        end if;
                    end if;

                    Itn := Itn.Next;
                end loop;
            end if;
        end Get_Option;
    begin
        Eat_Token;

        loop
            if Token /= Separator and then Token /= End_String then
                Get_Option;
            end if;

            while Token = Separator loop
                Eat_Token;
            end loop;

            exit when Token = End_String;
        end loop;
    end Parse;

    function Inverted (Itns : Iteration) return Iteration is
        Itn : Iteration := Itns;
        Nxt : Iteration;
        Prv : Iteration;
    begin
        Iter.Success := True;

        while Itn /= null loop
            Nxt := Itn.Next;
            Itn.Next := Prv;

            -- Advance Prv to this iteration if it should be kept.

            if Itn.Status /= Ok then
                Iter.Success := False;
                Prv := Itn;
            elsif Itn.Value /= null then
                Prv := Itn;
            end if;

            Itn := Nxt;
        end loop;

        return Prv;
    end Inverted;

begin
    Parse (Parameter);
    Iter.Start := Inverted (Itns);
    Iter.Point := Iter.Start;
    Success := Iter.Success;
    Options := Iter;
end Parse;