|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - downloadIndex: ┃ B T ┃
Length: 8722 (0x2212)
Types: TextFile
Names: »B«
└─⟦afbc8121e⟧ Bits:30000532 8mm tape, Rational 1000, MC68020_OS2000 7_2_2
└─ ⟦77aa8350c⟧ »DATA«
└─⟦f794ecd1d⟧
└─⟦24d1ddd49⟧
└─⟦this⟧
separate (Shared_Code_Generic_Support)
function Return_Value (Type_Desc : Type_Descriptor;
Exp : Expression;
Exp_Kind : Expression_Kind;
Size_Address : System.Address;
Result_Address : System.Address;
Result_Kind : Conversion_Kind)
return System.Address is
pragma Suppress_All;
pragma Routine_Number (Runtime_Ids.Internal);
function Return_Value_For_Copy_Down (Type_Desc : Type_Descriptor;
Exp : Expression;
Exp_Kind : Expression_Kind;
Size_Address : System.Address;
Result_Address : System.Address;
Result_Kind : Conversion_Kind)
return System.Address is
pragma Routine_Number (Runtime_Ids.Internal);
Returned_Value : System.Address := System.Address_Zero;
function Result_Constraint_Address return System.Address is
pragma Routine_Number (Runtime_Ids.Internal);
begin
-- Result_Address is the address of an object descriptor
-- that has the address of the unconstrained descriptor.
-- We need the constraint field of the unconstrained de-
-- scriptor.
return Cnvt (Cnvt (Result_Address).all).all.Constraint'Address;
end Result_Constraint_Address;
-- pragma Inline (Result_Constraint_Address);
procedure Unconstrained_Array_Op
(Exp_Dope : Dope_Vector;
Exp_Data : in out Data) is
pragma Routine_Number (Runtime_Ids.Internal);
Dope_Vector_Size : constant Integer :=
Get_Dope_Vector_Size (Type_Desc.Constraints);
Result_Dope_Address : constant System.Address :=
To_Address (Cnvt (Result_Constraint_Address).all);
begin
-- DONT copy the data. Only copy the dope
Copy_Indirect (Dest => Result_Dope_Address,
Source => Exp_Dope'Address,
Size => Dope_Vector_Size);
Returned_Value := 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);
Result_Constrained_Address : constant System.Address :=
Result_Constraint_Address;
begin
-- Set the Is_Constrained bit in the result.
Cnvt (Result_Constrained_Address).all := True;
Returned_Value := Exp_Data'Address;
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 Constrained_Records | Unconstrained_Records =>
Unconstrained_Record_Op
(Exp_Constrained => True, Exp_Data => Exp_Data);
when Constrained_Arrays =>
declare
Dope_Vector_Size : constant Integer :=
Get_Dope_Vector_Size (Type_Desc.Constraints);
package Dv_Subtype is
new Establish_Dope_Vector_Subtype (Dope_Vector_Size);
Dope_Ref : constant Dv_Subtype.Dope_Ref :=
Dv_Subtype.Cnvt (Get_Dope_Vector_Address
(Type_Desc.Constraints));
Exp_Dope : Dv_Subtype.Actual_Dope renames Dope_Ref.all;
begin
Unconstrained_Array_Op
(Exp_Dope => Exp_Dope, Exp_Data => Exp_Data);
end;
when others =>
pragma Assert (False);
null;
end case;
end Data_Op;
-- pragma Inline (Data_Op);
procedure Dispatch is new Unary_Dispatch (Bogus_Value_Op,
Data_Op,
Unconstrained_Array_Op,
Unconstrained_Record_Op,
Get_Value_Size);
-- pragma Inline (Dispatch);
procedure Copy_Expression is
new Copy_Expression_Generic (Get_Value_Size);
-- pragma Inline (Copy_Expression);
begin
case Data_Kind_Of (Type_Desc.Type_Kind, Result_Kind) is
when Unconstrained_Array_Desc_Ptr | Unconstrained_Record_Desc_Ptr =>
-- Set the Size to the value
Cnvt (Size_Address).all := Get_Value_Size
(Type_Desc => Type_Desc,
Value => Exp,
Value_Kind => Exp_Kind);
Dispatch (Type_Desc, Exp, Exp_Kind);
when others =>
-- Zap the Size
Cnvt (Size_Address).all := 0;
-- Now copy the expression
Copy_Expression (Type_Desc => Type_Desc,
Source => Exp,
Source_Kind => Exp_Kind,
Dest_Address => Result_Address,
Dest_Kind => Result_Kind,
Dest_Constraints => Nil_Constraints,
Chk => Nil_Check);
end case;
return Returned_Value;
end Return_Value_For_Copy_Down;
-- pragma Inline (Return_Value_For_Copy_Down);
function Return_Value_For_No_Copy_Down (Type_Desc : Type_Descriptor;
Exp : Expression;
Exp_Kind : Expression_Kind;
Size_Address : System.Address;
Result_Address : System.Address;
Result_Kind : Conversion_Kind)
return System.Address is
pragma Routine_Number (Runtime_Ids.Internal);
function Get_Value_Size (Type_Desc : Type_Descriptor;
Value : Expression;
Value_Kind : Expression_Kind) return Integer is
pragma Routine_Number (N => Runtime_Ids.Internal);
begin
return Cnvt (Size_Address).all;
end Get_Value_Size;
-- pragma Inline (Get_Value_Size);
procedure Copy_Expression is
new Copy_Expression_Generic (Get_Value_Size);
-- pragma Inline (Copy_Expression);
begin
-- We ignore Size_Address and get the size of Exp from
-- the type descriptor or dope vector.
Copy_Expression (Type_Desc => Type_Desc,
Source => Exp,
Source_Kind => Exp_Kind,
Dest_Address => Result_Address,
Dest_Kind => Result_Kind,
Dest_Constraints => Nil_Constraints,
Chk => Nil_Check);
-- Result is the value at Result_Address, returned as an Address
-- to satisfy this function's return type.
return System.Address (Get_Expression
(Result_Address, Result_Kind));
end Return_Value_For_No_Copy_Down;
-- pragma Inline (Return_Value_For_No_Copy_Down);
begin
if Target.Copy_Down then
return Return_Value_For_Copy_Down
(Type_Desc, Exp, Exp_Kind,
Size_Address, Result_Address, Result_Kind);
else
return Return_Value_For_No_Copy_Down
(Type_Desc, Exp, Exp_Kind,
Size_Address, Result_Address, Result_Kind);
end if;
end Return_Value;
pragma Runtime_Unit (Unit_Number => Runtime_Ids.Runtime_Compunit,
Elab_Routine_Number => Runtime_Ids.Internal);