DataMuseum.dk

top - download

    Length: 4361 (0x1109)
    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 Satisfies (Type_Desc : Type_Descriptor;
                    Exp       : Expression;
                    Exp_Kind  : Expression_Kind;
                    Chk       : Check_Kind) return Boolean is

    pragma Suppress_All;
    pragma Routine_Number (Runtime_Ids.Internal);
    Result : Boolean := False;

    procedure Value_Op (Exp_1 : Expression) is
        pragma Routine_Number (Runtime_Ids.Internal);
    begin
        -- Note that when we have a Value, a short pointer is really
        -- a long pointer, and hence we need not special case them.
        Result := Satisfies_Ops.Satisfies_Value
                     (Type_Desc   => Type_Desc,
                      Exp         => Exp_1,
                      Constraints => Type_Desc.Constraints,
                      Type_Kind   => Type_Desc.Type_Kind,
                      Size        => Type_Desc.Size,
                      Chk         => Chk);
    end Value_Op;
    -- pragma Inline (Value_Op);


    procedure Data_Op (Exp_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 := Satisfies_Ops.Satisfies_Value
                         (Type_Desc   => Type_Desc,
                          Exp         => Short_Pointer_Ops.Short_To_Long  
                                            (Exp_Data),
                          Constraints => Type_Desc.Constraints,
                          Type_Kind   => Type_Desc.Type_Kind,
                          Size        => Type_Desc.Size,
                          Chk         => Chk);
            return;
        end if;

        Result := Satisfies_Ops.Satisfies_Data
                     (Type_Desc   => Type_Desc,
                      Exp_Data    => Exp_Data,
                      Constraints => Type_Desc.Constraints,
                      Type_Kind   => Type_Desc.Type_Kind,
                      Size        => Type_Desc.Size,
                      Chk         => Chk);
    end Data_Op;
    -- pragma Inline (Data_Op);


    procedure Unconstrained_Array_Op (Exp_Dope :        Dope_Vector;  
                                      Exp_Data : in out Data) is
        pragma Routine_Number (Runtime_Ids.Internal);
    begin
        Result := Satisfies_Ops.Satisfies_Unconstrained_Array
                     (Exp_Dope    => Exp_Dope,
                      Constraints => Type_Desc.Constraints,
                      Chk         => Chk);
    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
        -- Note that if we got here, Type_Desc.Dscrmt_Record_Satisfies_
        -- Subp must be nil.
        Result := True;
    end Unconstrained_Record_Op;
    -- pragma Inline (Unconstrained_Record_Op);


    procedure Dispatch is new Unary_Dispatch (Value_Op,  
                                              Data_Op,  
                                              Unconstrained_Array_Op,  
                                              Unconstrained_Record_Op,  
                                              Get_Value_Size);
    -- pragma Inline (Dispatch);
    --[workaround]
begin
    -- Trivially true if no check is necessary
    if Chk = Nil_Check then
        return True;
    elsif Can_Be_Trusted (Exp_Kind) then
        return True;
    else  
        declare
            Satisfies_Subp : constant Subprogram_Variable :=
               Get_Dscrmt_Record_Satisfies_Subp (Type_Desc);
        begin
            if Satisfies_Subp.Code /= Nil_Code then
                return Asm_Interface.Dscrmt_Record_Satisfies
                          (Subp      => Satisfies_Subp,
                           Type_Desc => Type_Desc,
                           Exp       => Exp,
                           Exp_Kind  => Exp_Kind);
            else
                Dispatch (Type_Desc, Exp, Exp_Kind);

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