DataMuseum.dk

top - download

    Length: 5258 (0x148a)
    Types: TextFile
    Names: »B«

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

TextFile

separate (Shared_Code_Generic_Support)
function Equal (Type_Desc  : Type_Descriptor;
                Left       : Expression;
                Left_Kind  : Expression_Kind;
                Right      : Expression;
                Right_Kind : Expression_Kind) return Boolean is
    pragma Suppress_All;
    pragma Routine_Number (Runtime_Ids.Internal);

    Result : Boolean;

    procedure Value_Op (Left_Exp  : Expression;  
                        Right_Exp : Expression) is
        pragma Routine_Number (Runtime_Ids.Internal);
    begin
        -- Even though we have values, we cannot use the full expression
        -- unless it occupies Bytes_Per_Integer since it may have gar-
        -- bage.
        if Type_Desc.Size = Target.Bytes_Per_Integer then
            Result := Left_Exp = Right_Exp;
        else
            -- Note that when we have Value's, a short pointer is really
            -- a long pointer, and hence we need not special case them.
            Result := Equal_Indirect
                         (Left  => Get_Scalar_Data_Address
                                      (Left_Exp'Address, Type_Desc.Size),
                          Right => Get_Scalar_Data_Address
                                      (Right_Exp'Address, Type_Desc.Size),
                          Size  => Type_Desc.Size);
        end if;
    end Value_Op;
    -- pragma Inline (Value_Op);


    procedure Data_Op (Left_Data  : in out Data;  
                       Right_Data : in out Data) is
        pragma Routine_Number (Runtime_Ids.Internal);
    begin
        if Target.Supports_Segmented_Heaps and then
           Type_Desc.Is_Short_Pointer then
            Result := Short_Pointer_Ops.Short_To_Long (Left_Data) =
                         Short_Pointer_Ops.Short_To_Long (Right_Data);
        else
            Result := Left_Data = Right_Data;
        end if;
    end Data_Op;
    -- pragma Inline (Data_Op);


    procedure Value_Data_Op (Left_Exp : Expression; Right_Data : in out Data) is
        pragma Routine_Number (Runtime_Ids.Internal);  
    begin
        if Target.Supports_Segmented_Heaps and then
           Type_Desc.Is_Short_Pointer then
            Result := Left_Exp =  
                         Short_Pointer_Ops.Short_To_Long (Right_Data);
        else
            Result := Equal_Indirect
                         (Left  => Get_Scalar_Data_Address
                                      (Left_Exp'Address, Type_Desc.Size),
                          Right => Right_Data'Address,
                          Size  => Type_Desc.Size);
        end if;
    end Value_Data_Op;
    -- pragma Inline (Value_Data_Op);


    procedure Data_Value_Op (Left_Data : in out Data;  
                             Right_Exp :        Expression) is
        pragma Routine_Number (Runtime_Ids.Internal);
    begin
        if Target.Supports_Segmented_Heaps and then
           Type_Desc.Is_Short_Pointer then
            Result := Short_Pointer_Ops.Short_To_Long (Left_Data) =  
                         Right_Exp;
        else
            Result := Equal_Indirect
                         (Left  => Left_Data'Address,
                          Right => Get_Scalar_Data_Address
                                      (Right_Exp'Address, Type_Desc.Size),
                          Size  => Type_Desc.Size);
        end if;
    end Data_Value_Op;
    -- pragma Inline (Data_Value_Op);


    procedure Unconstrained_Array_Op (Left_Dope  :        Dope_Vector;
                                      Left_Data  : in out Data;
                                      Right_Dope :        Dope_Vector;
                                      Right_Data : in out Data) is
        pragma Routine_Number (Runtime_Ids.Internal);
    begin
        for I in Left_Dope'Range loop
            if Left_Dope (I).Size /= Right_Dope (I).Size then
                Result := False;
                return;
            end if;
        end loop;

        Result := Left_Data = Right_Data;
    end Unconstrained_Array_Op;
    -- pragma Inline (Unconstrained_Array_Op);


    procedure Unconstrained_Record_Op (Left_Constrained  :        Boolean;
                                       Left_Data         : in out Data;
                                       Right_Constrained :        Boolean;
                                       Right_Data        : in out Data) is
        pragma Routine_Number (Runtime_Ids.Internal);
    begin  
        Result := Left_Data = Right_Data;  
    end Unconstrained_Record_Op;
    -- pragma Inline (Unconstrained_Record_Op);


    procedure Dispatch is new Binary_Dispatch (Value_Op,  
                                               Data_Op,  
                                               Value_Data_Op,  
                                               Data_Value_Op,  
                                               Unconstrained_Array_Op,  
                                               Unconstrained_Record_Op,  
                                               Get_Value_Size);
    -- pragma Inline (Dispatch);
begin
    Dispatch (Type_Desc, Left, Left_Kind, Right, Right_Kind);

    return Result;
end Equal;
pragma Runtime_Unit (Unit_Number         => Runtime_Ids.Runtime_Compunit,
                     Elab_Routine_Number => Runtime_Ids.Internal);