DataMuseum.dk

top - download

    Length: 5060 (0x13c4)
    Types: TextFile
    Names: »B«

└─⟦afbc8121e⟧ Bits:30000532 8mm tape, Rational 1000, MC68020_OS2000 7_2_2
    └─ ⟦77aa8350c⟧ »DATA« 
        └─⟦f794ecd1d⟧ 
            └─⟦24d1ddd49⟧ 
                └─⟦this⟧ 

TextFile

--    The use of this system is subject to the software license terms and
--    conditions agreed upon between Rational and the Customer.
--
--                Copyright 1988 by Rational.
--
--                          RESTRICTED RIGHTS LEGEND
--
--    Use, duplication, or disclosure by the Government is subject to
--    restrictions as set forth in subdivision (b)(3)(ii) of the Rights in
--    Technical Data and Computer Software clause at 52.227-7013.
--
--
--                Rational
--                3320 Scott Boulevard
--                Santa Clara, California 95054-3197
--
--   PROPRIETARY AND CONFIDENTIAL INFORMATION OF RATIONAL;
--   USE OR COPYING WITHOUT EXPRESS WRITTEN AUTHORIZATION
--   IS STRICTLY PROHIBITED.  THIS MATERIAL IS PROTECTED AS
--   AN UNPUBLISHED WORK UNDER THE U.S. COPYRIGHT ACT OF
--   1976.  CREATED 1988.  ALL RIGHTS RESERVED.
--
--

with Attribute_Definitions;
with Runtime_Ids;
with System_Definitions;
with Unchecked_Conversion;

function Enum_Value (Table         : Attribute_Definitions.Enum_Image_Table;
                     String_Length : Natural;
                     String_Value  : Attribute_Definitions.Short_String)
                    return Integer is
    pragma Routine_Number (Runtime_Ids.Enum_Value);

    -- Will raise Constraint_Error if Value is not in the table.  If the
    -- attribute is given on a subtype of an enumeration type then the
    -- caller (i.e., the Middle Pass) must generate the appropriate
    -- constraint check.  If the enumeration type has a representation clause
    -- then the caller (i.e., the Middle Pass) must call Pos on the result
    -- of this function.

    pragma Suppress (Index_Check);
    pragma Suppress (Range_Check);
    pragma Suppress (Access_Check);
    pragma Suppress (Storage_Check);

    use System_Definitions.Operators;

    function Convert is new Unchecked_Conversion
                               (System_Definitions.Address,
                                Attribute_Definitions.Ref_String);

    Image         : String (1 .. String_Length);
    Actual_Length : Natural := 0;

begin
    declare
        Next_Char  : Character;
        Found_Tick : Boolean  := False;
        Case_Bias  : constant := Character'Pos ('a') - Character'Pos ('A');
    begin
        -- Copy, eliminating leading and trailing blanks, while upper-casing.
        for I in 1 .. String_Length loop
            if String_Value (I) /= ' ' then
                -- Found a non-blank.  Copy characters, upper-casing,
                -- unless find a ''' which could means the value could
                -- be a character literal.
                --
                for J in I .. String_Length loop
                    Next_Char := String_Value (J);
                    if Next_Char in 'a' .. 'z' and then not Found_Tick then
                        Image (Actual_Length + 1) :=
                           Character'Val
                              (Character'Pos (Next_Char) - Case_Bias);
                    else
                        Image (Actual_Length + 1) := Next_Char;
                        if Next_Char = ''' then
                            Found_Tick := True;
                        end if;
                    end if;
                    Actual_Length := Actual_Length + 1;
                end loop;

                -- Eliminate trailing blanks
                while Image (Actual_Length) = ' ' loop
                    Actual_Length := Actual_Length - 1;
                end loop;
                goto Copied_Argument;
            end if;
        end loop;
    end;

    raise Constraint_Error;   -- All blanks

    <<Copied_Argument>>
        for I in 0 .. Table.Count - 1 loop
            declare
                Next_Length : constant Natural :=
                   Table.Offsets (I + 1) - Table.Offsets (I);
            begin
                if Next_Length = Actual_Length then
                    declare
                        Next_Compare :
                           constant Attribute_Definitions.Ref_String :=
                           Convert (Plus_Ai (Table'Address, Table.Offsets (I)));
                    begin
                        if Image (1) = Next_Compare (1) and then
                           Image (Actual_Length) =
                              Next_Compare (Actual_Length) then

                            for J in 2 .. Actual_Length - 1 loop
                                if Image (J) /= Next_Compare (J) then
                                    goto Test_Failed;
                                end if;
                            end loop;
                            return I;
                        end if;
                    end;
                    <<Test_Failed>> null;
                end if;
            end;
        end loop;

    raise Constraint_Error;  -- Value not found
end Enum_Value;
pragma Export_Function (Internal => Enum_Value, External => "__ENUM_VALUE");
pragma Runtime_Unit (Unit_Number         => Runtime_Ids.Runtime_Compunit,
                     Elab_Routine_Number => Runtime_Ids.Internal);