|
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: 10808 (0x2a38)
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)
procedure Unchecked_Convert (Source : Expression;
Source_Desc : Type_Descriptor;
Source_Kind : Expression_Kind;
Source_Size : Integer;
Target_Address : System.Address;
Target_Desc : Type_Descriptor;
Target_Kind : Expression_Kind;
Target_Size : Integer) is
pragma Routine_Number (Runtime_Ids.Internal);
pragma Suppress_All;
S_Size : Integer;
T_Size : Integer;
T_Expr : Expression;
Smaller_Size : Integer;
function "<=" (R, L : Standard.Target.Integer) return Boolean
renames Standard.Target."<=";
function "=" (R, L : Standard.Target.Integer) return Boolean
renames Standard.Target."=";
function "mod" (R, L : Standard.Target.Integer)
return Standard.Target.Integer renames Standard.Target."mod";
procedure Sp_Data_Op (Exp_Data : in out Data) is
pragma Routine_Number (Runtime_Ids.Internal);
begin
Copy_Indirect (Dest => Target_Address,
Source => Exp_Data'Address,
Size => Smaller_Size);
end Sp_Data_Op;
procedure Sp_Value_Op (Exp_1 : Expression) is
pragma Routine_Number (Runtime_Ids.Internal);
begin
Cnvt (Target_Address).all := Exp_1;
end Sp_Value_Op;
procedure Tp_Data_Op (Exp_Data : in out Data) is
pragma Routine_Number (Runtime_Ids.Internal);
Address_Size : Integer;
begin
-- This is so we avoid subtracting more than 4 if source happens
-- to be a record or array of more than four bytes
if S_Size > Target.Bytes_Per_Integer then
Address_Size := Target.Bytes_Per_Integer;
else
Address_Size := S_Size;
end if;
Copy_Indirect (Dest => Exp_Data'Address,
Source => Get_Scalar_Data_Address
(Source'Address, Address_Size),
Size => Smaller_Size);
end Tp_Data_Op;
procedure Tp_Value_Op (Exp_1 : Expression) is
pragma Routine_Number (Runtime_Ids.Internal);
begin
Cnvt (Target_Address).all := Expression (Source);
end Tp_Value_Op;
procedure Unconstrained_Array_Op_Raise (Exp_Dope : Dope_Vector;
Exp_Data : in out Data) is
pragma Routine_Number (Runtime_Ids.Internal);
begin
raise Program_Error;
end Unconstrained_Array_Op_Raise;
procedure Unconstrained_Record_Op_Raise (Exp_Constrained : Boolean;
Exp_Data : in out Data) is
pragma Routine_Number (Runtime_Ids.Internal);
begin
raise Program_Error;
end Unconstrained_Record_Op_Raise;
procedure Bp_Value_Op (Source_Exp : Expression;
Dest_Exp : Expression) is
pragma Routine_Number (Runtime_Ids.Internal);
begin
-- Note that when we have Value's, a short pointer is really
-- a long pointer, and hence we need not special case them.
-- In case Type_Desc.Size < Bytes_Per_Integer, this will copy
-- some garbage bytes. Thats ok!
Cnvt (Target_Address).all := Source_Exp;
end Bp_Value_Op;
procedure Bp_Data_Op (Source_Data : in out Data;
Dest_Data : in out Data) is
pragma Routine_Number (Runtime_Ids.Internal);
begin
-- What do we do with short pointers???
-- if Target.Supports_Segmented_Heaps and then
-- Type_Desc.Is_Short_Pointer then
--
-- Short_Pointer_Ops.Copy_Data_To_Data (Source_Data, Dest_Address);
--
-- return;
-- end if;
--
Copy_Indirect (Dest => Dest_Data'Address,
Source => Source_Data'Address,
Size => Smaller_Size);
end Bp_Data_Op;
procedure Bp_Value_Data_Op (Source_Exp : Expression;
Dest_Data : in out Data) is
pragma Routine_Number (Runtime_Ids.Internal);
Address_Size : Integer;
begin
-- if Target.Supports_Segmented_Heaps and then
-- Type_Desc.Is_Short_Pointer then
-- Short_Pointer_Ops.Copy_Value_To_Data (Source_Exp, Dest_Address);
--
-- return;
-- end if;
--
-- This is so we avoid subtracting more than 4 if source happens
-- to be a record or array of more than four bytes
if S_Size > Target.Bytes_Per_Integer then
Address_Size := Target.Bytes_Per_Integer;
else
Address_Size := S_Size;
end if;
Copy_Indirect (Dest => Dest_Data'Address,
Source => Get_Scalar_Data_Address
(Source_Exp'Address, Address_Size),
Size => Smaller_Size);
end Bp_Value_Data_Op;
procedure Bp_Data_Value_Op (Source_Data : in out Data;
Dest_Exp : Expression) is
pragma Routine_Number (Runtime_Ids.Internal);
Address_Size : Integer;
begin
-- if Target.Supports_Segmented_Heaps and then
-- Type_Desc.Is_Short_Pointer then
-- Short_Pointer_Ops.Copy_Data_To_Value (Source_Data, Dest_Address);
--
-- return;
-- end if;
--
-- This is so we avoid subtracting more than 4 if source happens
-- to be a record or array of more than four bytes
if T_Size > Target.Bytes_Per_Integer then
Address_Size := Target.Bytes_Per_Integer;
else
Address_Size := T_Size;
end if;
-- Tricky! Note that Target must be a Value. So we put the
-- result in the PROPER portion of the Target_Address!
Copy_Indirect (Dest => Get_Scalar_Data_Address
(Target_Address, Address_Size),
Source => Source_Data'Address,
Size => Smaller_Size);
end Bp_Data_Value_Op;
procedure Bp_Unconstrained_Array_Op (Source_Dope : Dope_Vector;
Source_Data : in out Data;
Dest_Dope : Dope_Vector;
Dest_Data : in out Data) is
pragma Routine_Number (Runtime_Ids.Internal);
begin
raise Program_Error;
end Bp_Unconstrained_Array_Op;
procedure Bp_Unconstrained_Record_Op (Source_Constrained : Boolean;
Source_Data : in out Data;
Dest_Constrained : Boolean;
Dest_Data : in out Data) is
pragma Routine_Number (Runtime_Ids.Internal);
begin
raise Program_Error;
end Bp_Unconstrained_Record_Op;
-- Sp stands for "Source Private", so this dispatch is used when
-- the source is private and the target is not.
procedure Sp_Dispatch is new Unary_Dispatch (Sp_Value_Op,
Sp_Data_Op,
Unconstrained_Array_Op_Raise,
Unconstrained_Record_Op_Raise,
Get_Value_Size);
-- Tp stands for "Target Private", so this dispatch is used when
-- the target is private and the source is not.
procedure Tp_Dispatch is new Unary_Dispatch (Tp_Value_Op,
Tp_Data_Op,
Unconstrained_Array_Op_Raise,
Unconstrained_Record_Op_Raise,
Get_Value_Size);
procedure Bp_Dispatch is
new Two_Kind_Binary_Dispatch (Bp_Value_Op,
Bp_Data_Op,
Bp_Value_Data_Op,
Bp_Data_Value_Op,
Bp_Unconstrained_Array_Op,
Bp_Unconstrained_Record_Op,
Get_Value_Size);
begin
if Source_Size = 0 then
-- Source is private
S_Size := Get_Value_Size (Source_Desc, Source, Source_Kind);
if Target_Size = 0 then
-- Both are private
T_Expr := Get_Expression (Target_Address, Target_Kind);
T_Size := Get_Value_Size (Target_Desc, T_Expr, Target_Kind);
if S_Size <= T_Size then
Smaller_Size := S_Size;
else
Smaller_Size := T_Size;
end if;
Bp_Dispatch (Type_Desc_1 => Source_Desc,
Exp_1 => Source,
Exp_1_Kind => Source_Kind,
Type_Desc_2 => Target_Desc,
Exp_2 => T_Expr,
Exp_2_Kind => Target_Kind);
else
if S_Size <= Target_Size / 8 then
Smaller_Size := S_Size;
else
Smaller_Size := Target_Size / 8;
end if;
Sp_Dispatch (Source_Desc, Source, Source_Kind);
end if;
else
if Target_Size = 0 then
-- Target is private and source is not
-- If size is non-zero, then it is size in bits, not bytes, so
-- we convert to bytes. If size is not an exact number of bytes,
-- we set size to include the whole final byte (since it doesn't
-- hurt us to get our garbage from the source as opposed to the
-- target).
S_Size := Source_Size / 8;
if (Source_Size mod 8) /= 0 then
S_Size := S_Size + 1;
end if;
T_Expr := Get_Expression (Target_Address, Target_Kind);
T_Size := Get_Value_Size (Target_Desc, T_Expr, Target_Kind);
if S_Size <= T_Size then
Smaller_Size := S_Size;
else
Smaller_Size := T_Size;
end if;
Tp_Dispatch (Target_Desc, T_Expr, Target_Kind);
else
raise Program_Error;
end if;
end if;
end Unchecked_Convert;
pragma Runtime_Unit (Unit_Number => Runtime_Ids.Runtime_Compunit,
Elab_Routine_Number => Runtime_Ids.Internal);