DataMuseum.dk

top - download

    Length: 7418 (0x1cfa)
    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 Convert (Type_Desc           : Type_Descriptor;
                  Exp                 : Expression;
                  Exp_Kind            : Expression_Kind;
                  Target_Kind         : Conversion_Kind;
                  Uncons_Desc_Address : System.Address;
                  Chk                 : Check_Kind) return Expression is
    pragma Suppress_All;
    pragma Routine_Number (Runtime_Ids.Internal);
    Result : Expression;

    procedure Value_Op (Exp_1 : Expression) is
        pragma Routine_Number (Runtime_Ids.Internal);
    begin
        -- Local_Object and Formal_Object are identical
        Result := Exp_1;
    end Value_Op;
    -- pragma Inline (Value_Op);


    procedure Unconstrained_Array_Op (Exp_Dope_Address : System.Address;  
                                      Exp_Data_Address : System.Address) is
        pragma Routine_Number (Runtime_Ids.Internal);

    begin
        case Data_Kind_Of (Type_Desc.Type_Kind, Target_Kind) is
            when Unconstrained_Array_Desc_Ptr =>
                declare
                    Uncons_Desc_Ref : constant Unconstrained_Descriptor_Ref :=
                       Cnvt (Uncons_Desc_Address);
                begin
                    Uncons_Desc_Ref.all.Data       := Exp_Data_Address;
                    Uncons_Desc_Ref.all.Constraint := Exp_Dope_Address;

                    -- The result is the address of the unconstrained descriptor
                    Result := Expression (Uncons_Desc_Address);
                end;

            when Data_Ptr =>
                Result := Expression (Exp_Data_Address);

            when others =>  
                pragma Assert (False);
                null;
        end case;
    end Unconstrained_Array_Op;
    -- pragma Inline (Unconstrained_Array_Op);


    procedure Unconstrained_Array_Op (Exp_Dope :        Dope_Vector;  
                                      Exp_Data : in out Data) is
        pragma Routine_Number (Runtime_Ids.Internal);
    begin
        -- Local_Object and Formal_Object are identical
        Unconstrained_Array_Op (Exp_Dope_Address => Exp_Dope'Address,
                                Exp_Data_Address => Exp_Data'Address);
    end Unconstrained_Array_Op;
    -- pragma Inline (Unconstrained_Array_Op);


    procedure Unconstrained_Record_Op (Exp_Constrained :        Boolean;  
                                       Exp_Data        : in out Data) is
        pragma Routine_Number (Runtime_Ids.Internal);

    begin
        case Data_Kind_Of (Type_Desc.Type_Kind, Target_Kind) is
            when Unconstrained_Record_Desc_Ptr =>
                declare
                    Uncons_Desc_Ref : constant Unconstrained_Descriptor_Ref :=
                       Cnvt (Uncons_Desc_Address);
                    Constrained_Ref : constant Boolean_Ref                  :=
                       Cnvt (Uncons_Desc_Ref.all.Constraint'Address);
                begin
                    -- Local_Object and Formal_Object are identical
                    Uncons_Desc_Ref.all.Data := Exp_Data'Address;
                    Constrained_Ref.all      := Exp_Constrained;

                    -- The result is the address of the unconstrained descriptor
                    Result := Expression (Uncons_Desc_Address);
                end;
            when Data_Ptr =>
                Result := Expression (Exp_Data'Address);

            when others =>  
                pragma Assert (False);
                null;
        end case;
    end Unconstrained_Record_Op;
    -- pragma Inline (Unconstrained_Record_Op);


    procedure Data_Op (Exp_Data : in out Data) is  
        pragma Routine_Number (Runtime_Ids.Internal);
    begin
        case Type_Desc.Type_Kind is
            when Scalars =>
                Result := Data_To_Expression (Exp_Data, Type_Desc.Constraints);

            when Accesses =>
                Result := Data_To_Expression (Exp_Data, Type_Desc.Constraints);
                if Target.Supports_Segmented_Heaps and then
                   Type_Desc.Is_Short_Pointer then
                    Result := Short_Pointer_Ops.Short_To_Long (Exp_Data);
                else
                    Result := Data_To_Expression
                                 (Exp_Data, Type_Desc.Constraints);
                end if;

            when Long_Scalars =>
                -- The Uncons_Desc_Address is regarded as a location into
                -- which the value of this long scalar is to be copied for
                -- value result semantics.  The result is the address of
                -- the destination.
                Copy_Indirect (Dest   => Uncons_Desc_Address,  
                               Source => Exp_Data'Address,
                               Size   => Type_Desc.Size);
                Result := Expression (Uncons_Desc_Address);

            when Simple_Records =>
                Result := Expression (Exp_Data'Address);

            when Constrained_Records =>
                case Target_Kind is
                    when Local_Object =>
                        Result := Expression (Exp_Data'Address);
                    when Formal_Object =>
                        Unconstrained_Record_Op  
                           (Exp_Constrained => True,  
                            Exp_Data        => Exp_Data);
                end case;

            when Constrained_Arrays =>
                case Target_Kind is
                    when Local_Object =>
                        Result := Expression (Exp_Data'Address);
                    when Formal_Object =>
                        Unconstrained_Array_Op  
                           (Exp_Dope_Address => Get_Dope_Vector_Address  
                                                   (Type_Desc.Constraints),
                            Exp_Data_Address => Exp_Data'Address);
                end case;

            when Unconstrained_Records =>
                Unconstrained_Record_Op  
                   (Exp_Constrained => True,  
                    Exp_Data        => Exp_Data);

            when Unconstrained_Arrays =>
                Unconstrained_Array_Op  
                   (Exp_Dope_Address => Get_Dope_Vector_Address  
                                           (Type_Desc.Constraints),
                    Exp_Data_Address => Exp_Data'Address);

            when Tasks =>
                Result := Data_To_Expression (Exp_Data, Type_Desc.Constraints);
        end case;
    end Data_Op;
    -- pragma Inline (Data_Op);


    procedure Dispatch is new Unary_Dispatch (Value_Op,  
                                              Data_Op,  
                                              Unconstrained_Array_Op,  
                                              Unconstrained_Record_Op,  
                                              Get_Value_Size);
    -- pragma Inline (Dispatch);
begin  
    if not Satisfies (Type_Desc, Exp, Exp_Kind, Chk) then
        raise Constraint_Error;
    end if;

    -- Except in the case of Long_Scalars, this operation is
    -- a noop when Target_Kind = Exp_Kind.
    if Type_Desc.Type_Kind /= Long_Scalars and then  
       Target_Kind = Exp_Kind then
        return Exp;
    end if;

    Dispatch (Type_Desc, Exp, Exp_Kind);

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