|
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: 8075 (0x1f8b)
Types: TextFile
Names: »B«
└─⟦afbc8121e⟧ Bits:30000532 8mm tape, Rational 1000, MC68020_OS2000 7_2_2
└─ ⟦77aa8350c⟧ »DATA«
└─⟦f794ecd1d⟧
└─⟦24d1ddd49⟧
└─⟦this⟧
with Storage_Management;
separate (Shared_Code_Generic_Support)
function Allocate (Type_Desc : Type_Descriptor;
Collection_Or_Heap : System.Address;
Is_Collection : Boolean;
Is_Homogenous : Boolean;
Initial_Value : Expression;
Initial_Value_Kind : Expression_Kind;
Master_Layer : System.Address;
Activation_Group : System.Address) return System.Address is
pragma Routine_Number (Runtime_Ids.Internal);
pragma Suppress_All;
Alloc : System.Address;
function Allocate_Storage
(Collection_Or_Heap : System.Address;
Is_Collection : Boolean;
Units : Integer) return System.Address is
pragma Routine_Number (Runtime_Ids.Internal);
begin
if Is_Collection then
return Storage_Management.Allocate_Fixed_Cell
(Units => Standard.Integer (Units),
Collection => Collection_Or_Heap);
else
--[] Segmented heap
[statement]
end if;
end Allocate_Storage;
-- pragma Inline (Allocate_Storage);
procedure Allocate_Uninitialized
(Type_Desc : Type_Descriptor;
Collection_Or_Heap : System.Address;
Is_Collection : Boolean;
Is_Homogenous : Boolean;
Master_Layer : System.Address;
Activation_Group : System.Address) is
pragma Routine_Number (Runtime_Ids.Internal);
With_Tasks : constant Boolean := Master_Layer /= System.Address_Zero;
begin
if Type_Desc.Allocate_Subp.Code = Nil_Code then
Alloc := Allocate_Storage (Collection_Or_Heap => Collection_Or_Heap,
Is_Collection => Is_Collection,
Units => Type_Desc.Size);
if Type_Desc.Init_Subp.Code /= Nil_Code then
if With_Tasks then
Asm_Interface.Init_With_Tasks
(Type_Desc.Init_Subp, Type_Desc, Alloc,
Master_Layer, Activation_Group);
else
Asm_Interface.Init (Type_Desc.Init_Subp, Type_Desc, Alloc);
end if;
end if;
else
if With_Tasks then
Alloc := Asm_Interface.Allocate_With_Tasks
(Subp => Type_Desc.Allocate_Subp,
Type_Desc => Type_Desc,
Collection_Or_Heap => Collection_Or_Heap,
Is_Collection => Is_Collection,
Is_Homogeneous => Is_Homogenous,
Master_Layer => Master_Layer,
Activation_Group => Activation_Group);
else
Alloc := Asm_Interface.Allocate
(Subp => Type_Desc.Allocate_Subp,
Type_Desc => Type_Desc,
Collection_Or_Heap => Collection_Or_Heap,
Is_Collection => Is_Collection,
Is_Homogeneous => Is_Homogenous);
end if;
end if;
end Allocate_Uninitialized;
-- pragma Inline (Allocate_Uninitialized);
procedure Data_Op (Exp_Data : in out Data) is
pragma Routine_Number (Runtime_Ids.Internal);
Value_Size : constant Integer := Exp_Data'Length;
-- Note that this way of getting the value size is cheaper
-- than calling Get_Value_Size since we already have Exp_
-- Data.
begin
Alloc := Allocate_Storage
(Collection_Or_Heap => Collection_Or_Heap,
Is_Collection => Is_Collection,
Units => Value_Size);
-- Copy
Copy_Indirect (Dest => Alloc,
Source => Exp_Data'Address,
Size => Value_Size);
end Data_Op;
-- pragma Inline (Data_Op);
procedure Value_Op (Exp_1 : Expression) is
pragma Routine_Number (Runtime_Ids.Internal);
begin
Alloc := Allocate_Storage
(Collection_Or_Heap => Collection_Or_Heap,
Is_Collection => Is_Collection,
Units => Type_Desc.Size);
-- Copy
Copy_Indirect (Dest => Alloc,
Source => Get_Scalar_Data_Address
(Exp_1'Address, Type_Desc.Size),
Size => Type_Desc.Size);
end Value_Op;
-- pragma Inline (Value_Op);
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);
-- Note that Dope_Vector_Size =
-- Exp_Dope'Length * Bytes_Per_Dope_Vector_Element
Value_Size : constant Integer := Exp_Data'Length;
-- Note that this way of getting the value size is cheaper
-- than calling Get_Value_Size since we already have Exp_
-- Data.
begin
if Is_Homogenous then
-- Allocate Value_Size only
Alloc := Allocate_Storage (Collection_Or_Heap => Collection_Or_Heap,
Is_Collection => Is_Collection,
Units => Value_Size);
-- Copy data
Copy_Indirect (Dest => Alloc,
Source => Exp_Data'Address,
Size => Value_Size);
else
-- Allocate Value_Size + Dope_Vector_Size (for the Dope_Vector)
Alloc := Allocate_Storage (Collection_Or_Heap => Collection_Or_Heap,
Is_Collection => Is_Collection,
Units => Value_Size + Dope_Vector_Size);
-- Copy dope vector
Copy_Indirect (Dest => Alloc,
Source => Exp_Dope'Address,
Size => Dope_Vector_Size);
-- Copy data
Copy_Indirect (Dest => Alloc + Dope_Vector_Size,
Source => Exp_Data'Address,
Size => Value_Size);
end if;
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
-- Allocation of an unconstrained record yeilds a constrained
-- object
Data_Op (Exp_Data);
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);
begin
if Initial_Value_Kind = Nil_Kind then
Allocate_Uninitialized (Type_Desc, Collection_Or_Heap, Is_Collection,
Is_Homogenous, Master_Layer, Activation_Group);
else
Dispatch (Type_Desc, Initial_Value, Initial_Value_Kind);
end if;
return Alloc;
end Allocate;
pragma Runtime_Unit (Unit_Number => Runtime_Ids.Runtime_Compunit,
Elab_Routine_Number => Runtime_Ids.Internal);