|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 20480 (0x5000)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, procedure Build_Local_Package_Body, seg_020c18, separate Rpc_Io
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
-- this procedure creates the new body rpc body for the package.
--
separate (Rpc_Io)
procedure Build_Local_Package_Body (From_Db : Analysis.Database;
Named_With_Root : String;
In_File : Io.File_Type) is
Subprogram_Iter : Analysis.Subprogram_Iterator;
Exception_Iter : Analysis.Exception_Iterator;
Parameter_Iter : Analysis.Parameter_Iterator;
Ref_Package_Iter : Analysis.Reference_Iterator;
Id_Iter : Analysis.Id_Iterator;
Return_Type, Param_Type : Ada.Element;
Defs : constant String := Rpc_Names.Rpc_Defs_Package (Named_With_Root);
procedure Put (Line : String; Line_Feeds : Natural := 0) is
begin
Io.Put (In_File, Line);
if Line_Feeds > 0 then
Io.New_Line (File => In_File,
Spacing => Io.Positive_Count (Line_Feeds));
end if;
end Put;
use Rpc_Conventions;
begin
Analysis.Init (From_Db => From_Db, Iter => Subprogram_Iter);
Analysis.Init (From_Db => From_Db, Iter => Exception_Iter);
Put (Ada_Io.Make_With_Clause (Name => "Rpc"));
Put (Ada_Io.Make_With_Clause (Name => "Interchange"));
Put (Ada_Io.Make_With_Clause (Name => "Transport_Stream"));
Put (Ada_Io.Make_With_Clause (Name => "Transport_Interchange"));
Put (Ada_Io.Make_With_Clause (Name => "Transport_Name"));
Put (Ada_Io.Make_With_Clause (Name => "Transport_Defs"));
Put (Ada_Io.Make_With_Clause (Name => "Rpc_Client"));
Put (Ada_Io.Make_With_Clause
(Name => Rpc_Names.Interchange_Package (Named_With_Root)));
Put (Ada_Io.Make_With_Clause (Name => Defs));
-- Add with clauses to units referenced by the package:
-- This may add redundant clauses
Analysis.Init (From_Db, Ref_Package_Iter);
while not Analysis.Done (Ref_Package_Iter) loop
Put (Ada_Io.Make_With_Clause (Analysis.Reference (Ref_Package_Iter)));
Analysis.Next (Ref_Package_Iter);
end loop;
Put (Ada_Io.Make_Package (Name => Named_With_Root,
Kind => Ada_Io.Body_Part));
-- local constant declaration for the name of the remote host:
-- requires completion by user
Put (Ada_Io.Make_Constant_Declaration
(Name => "Remote_Host",
Type_Mark => "Transport_Defs.Host_Id",
Initial_Value =>
"Transport_Name.Host_To_Host_Id ([STRING-expression])"), 1);
-- instantiation of the Start_Request_Generic:
Put ("procedure Start_Request is new Rpc_Client.Start_Request_Generic(" &
Defs & ".Network, " & Ascii.Lf & " Remote_Host, " & Ascii.Lf &
Defs & ".Socket, " & Defs & ".Program, " & Defs & ".Version);", 2);
-- Local procedure to translate exception numbers into raises of real
-- exceptions
Put (Ada_Io.Make_Procedure
(Name => "Raise_Exception",
Kind => Ada_Io.Body_Part,
Parameters_Image => "The_Exception : Rpc.Exception_Number"));
Put (Ada_Io.Make_Begin);
Put (Ada_Io.Make_Case_Header (Expression => "the_exception"));
-- add predefined exceptions
Put (Ada_Io.Make_Alternative
(Expression => Defs & ".Exception_Number.Constraint_Error"));
Put (Ada_Io.Make_Raise ("Constraint_Error"));
Put (Ada_Io.Make_Alternative (Expression =>
Defs & ".Exception_Number.Numeric_Error"));
Put (Ada_Io.Make_Raise ("Numeric_Error"));
Put (Ada_Io.Make_Alternative (Expression =>
Defs & ".Exception_Number.Program_Error"));
Put (Ada_Io.Make_Raise ("Program_Error"));
Put (Ada_Io.Make_Alternative (Expression =>
Defs & ".Exception_Number.Storage_Error"));
Put (Ada_Io.Make_Raise ("Storage_Error"));
Put (Ada_Io.Make_Alternative (Expression =>
Defs & ".Exception_Number.Tasking_Error"));
Put (Ada_Io.Make_Raise ("Tasking_Error"));
-- User defined exceptions
while not Analysis.Done (Exception_Iter) loop
Id_Iter := Analysis.Names (Exception_Iter);
while not Analysis.Done (Id_Iter) loop
Put (Ada_Io.Make_Alternative
(Expression => Defs & ".Exception_Number." &
Analysis.Name (Id_Iter)));
Put (Ada_Io.Make_Raise (Analysis.Name (Id_Iter)));
Analysis.Next (Id_Iter);
end loop;
Analysis.Next (Exception_Iter);
end loop;
Put (Ada_Io.Make_Alternative (Expression => "others"));
Put (Ada_Io.Make_Raise ("Rpc.Other_Error"), 1);
Put (Ada_Io.Make_End_Case);
Put (Ada_Io.Make_End, 1);
-- instantiation of the End_Request_Generic:
Put ("procedure End_Request is new " &
"Rpc_Client.End_Request_With_Exception (Raise_Exception);", 2);
-- Body of the finalize procedure:
Put ("procedure Finalize is", 1);
Put (Ada_Io.Make_Begin);
Put ("Transport_Stream.Finalize;", 1);
Put (Ada_Io.Make_End, 1);
-- generate the body of each exported interface:
while not Analysis.Done (Subprogram_Iter) loop
case Analysis.Kind (Subprogram_Iter) is
when Analysis.A_Procedure =>
Put (Subprograms.Make_Procedure
(Name => Analysis.Name (Subprogram_Iter),
Kind => Ada_Io.Body_Part,
Param_Iter => Analysis.Parameters (Subprogram_Iter)));
-- local Stream decl
Put (Ada_Io.Make_Variable_Declaration
(Name => "Stream",
Type_Mark => "Transport_Stream.Stream_Id"));
when Analysis.A_Function =>
Put (Subprograms.Make_Function
(Name => Analysis.Name (Subprogram_Iter),
Kind => Ada_Io.Body_Part,
Param_Iter => Analysis.Parameters (Subprogram_Iter),
Return_Expression => Analysis.Reference
(Analysis.Return_Type_Decl
(Subprogram_Iter))));
-- local Stream decl
Put (Ada_Io.Make_Variable_Declaration
(Name => "Stream",
Type_Mark => "Transport_Stream.Stream_Id"));
Return_Type := Analysis.Return_Type_Decl (Subprogram_Iter);
-- add local declarations to hold values returned by
-- functional forms of Interchange.Get. These are
-- used for unconstrained types
if Is_Constrained (Return_Type) then
if Is_Duration (Return_Type) then
Put (Ada_Io.Make_Variable_Declaration
(Name => Return_Name (Return_Type),
Type_Mark => "Interchange.Duration"), 1);
else
Put (Ada_Io.Make_Variable_Declaration
(Name => Return_Name (Return_Type),
Type_Mark => Analysis.Reference (Return_Type)),
1);
end if;
end if;
end case;
-- Create local declarations for parameters of type
-- duration
Parameter_Iter := Analysis.Parameters (Subprogram_Iter);
while not Analysis.Done (Parameter_Iter) loop
Param_Type := Analysis.Formals_Type_Decl (Parameter_Iter);
case Analysis.Mode (Parameter_Iter) is
when Decls.Out_Parameter | Decls.In_Out_Parameter =>
if Is_Duration (Param_Type) then
Id_Iter := Analysis.Names (Parameter_Iter);
while not Analysis.Done (Id_Iter) loop
Put (Ada_Io.Make_Variable_Declaration
(Name => Rpc_Names.Interchange_Type_Decl
(Analysis.Name (Id_Iter)),
Type_Mark => "Interchange.Duration"));
Analysis.Next (Id_Iter);
end loop;
end if;
when others =>
null;
end case;
Analysis.Next (Parameter_Iter);
end loop;
Put (Ada_Io.Make_Begin);
-- Issue a start request containing the procedure number
Put (Ada_Io.Make_Procedure
(Name => "Start_Request",
Kind => Ada_Io.Call,
Parameters_Image => "Stream, " & Defs & ".Procedure_Number." &
Analysis.Unique_Name (Subprogram_Iter)),
1);
-- Issues Interchange.Put calls for an "input" parameters
Parameter_Iter := Analysis.Parameters (Subprogram_Iter);
while not Analysis.Done (Parameter_Iter) loop
Param_Type := Analysis.Formals_Type_Decl (Parameter_Iter);
case Analysis.Mode (Parameter_Iter) is
when Decls.In_Parameter | Decls.Default_In_Parameter |
Decls.In_Out_Parameter =>
Id_Iter := Analysis.Names (Parameter_Iter);
while not Analysis.Done (Id_Iter) loop
Put (Make_Interchange_Call
(Data_Name => Analysis.Name (Id_Iter),
Data_Conversion =>
Predefined_Interchange_Conversion
(Param_Type),
Root_Name => Named_With_Root,
Data_Type => Param_Type,
Kind => Put), 1);
Analysis.Next (Id_Iter);
end loop;
when others =>
null;
end case;
Analysis.Next (Parameter_Iter);
end loop;
Put ("End_Request (Stream);", 2);
-- Issue Interchange.Get calls for all "output" parameters
case Analysis.Kind (Subprogram_Iter) is
when Analysis.A_Procedure =>
Parameter_Iter := Analysis.Parameters (Subprogram_Iter);
while not Analysis.Done (Parameter_Iter) loop
Param_Type := Analysis.Formals_Type_Decl (Parameter_Iter);
case Analysis.Mode (Parameter_Iter) is
when Decls.Out_Parameter | Decls.In_Out_Parameter =>
Id_Iter := Analysis.Names (Parameter_Iter);
while not Analysis.Done (Id_Iter) loop
if Is_Duration (Param_Type) then
-- Get the value into the local Intechange.Duration
Put
(Make_Interchange_Call
(Data_Name =>
Rpc_Names.Interchange_Type_Decl
(Analysis.Name (Id_Iter)),
Data_Conversion =>
Predefined_Interchange_Conversion
(Param_Type),
Root_Name => Named_With_Root,
Data_Type => Param_Type,
Kind => Get),
1);
-- assign the converted value into the real duration
-- object:
Put
(Ada_Io.Make_Assignment
(Name => Analysis.Name (Id_Iter),
Expression =>
Predefined_Interchange_Conversion
(Param_Type) &
"(" &
Rpc_Names.Interchange_Type_Decl
(Analysis.Name (Id_Iter)) &
")"));
else
if Is_Constrained (Param_Type) then
Put
(Make_Interchange_Call
(Data_Name =>
Analysis.Name (Id_Iter),
Data_Conversion =>
Predefined_Interchange_Conversion
(Param_Type),
Root_Name => Named_With_Root,
Data_Type => Param_Type,
Kind => Get),
1);
else
Put
(Ada_Io.Make_Assignment
(Name => Analysis.Name (Id_Iter),
Expression =>
Make_Interchange_Call
(Data_Name =>
Analysis.Name
(Id_Iter),
Data_Conversion =>
Predefined_Interchange_Conversion
(Param_Type),
Root_Name =>
Named_With_Root,
Data_Type => Param_Type,
Kind => Get)));
end if;
end if;
Analysis.Next (Id_Iter);
end loop;
when others =>
null;
end case;
Analysis.Next (Parameter_Iter);
end loop;
Put ("Rpc_Client.End_Response (Stream);", 2);
when Analysis.A_Function =>
-- make a local constant declaration for the unconstrained
-- type
if not Is_Constrained (Return_Type) then
Put (Ada_Io.Make_Declare);
Put (Ada_Io.Make_Constant_Declaration
(Name => Return_Name (Return_Type),
Type_Mark => Analysis.Reference (Return_Type),
Initial_Value =>
Make_Interchange_Call
(Data_Name => Analysis.Name (Return_Type),
Data_Conversion =>
Predefined_Interchange_Conversion
(Return_Type),
Root_Name => Named_With_Root,
Data_Type => Return_Type,
Kind => Get)));
Put (Ada_Io.Make_Begin);
Put ("Rpc_Client.End_Response (Stream);", 2);
Put (Ada_Io.Make_Return (Return_Name (Return_Type)));
Put (Ada_Io.Make_End); -- of declare
else
-- otherwise just call to get the function result
Put (Make_Interchange_Call
(Data_Name => Return_Name (Return_Type),
Data_Conversion =>
Predefined_Interchange_Conversion (Return_Type),
Root_Name => Named_With_Root,
Data_Type => Return_Type,
Kind => Get), 1);
Put ("Rpc_Client.End_Response (Stream);", 2);
if Is_Duration (Return_Type) then
Put (Ada_Io.Make_Return
(Predefined_Interchange_Conversion
(Return_Type) &
"(" & Return_Name (Return_Type) & ")"));
else
Put (Ada_Io.Make_Return (Return_Name (Return_Type)));
end if;
end if;
end case;
Put (Ada_Io.Make_End, 1); -- of subprogram
Analysis.Next (Subprogram_Iter);
end loop;
Put (Ada_Io.Make_End);
end Build_Local_Package_Body;
nblk1=13
nid=0
hdr6=26
[0x00] rec0=1b rec1=00 rec2=01 rec3=01e
[0x01] rec0=01 rec1=00 rec2=13 rec3=004
[0x02] rec0=13 rec1=00 rec2=02 rec3=086
[0x03] rec0=18 rec1=00 rec2=03 rec3=038
[0x04] rec0=15 rec1=00 rec2=04 rec3=010
[0x05] rec0=19 rec1=00 rec2=05 rec3=00c
[0x06] rec0=17 rec1=00 rec2=06 rec3=02c
[0x07] rec0=14 rec1=00 rec2=07 rec3=01e
[0x08] rec0=14 rec1=00 rec2=08 rec3=07a
[0x09] rec0=1a rec1=00 rec2=09 rec3=03c
[0x0a] rec0=13 rec1=00 rec2=0a rec3=064
[0x0b] rec0=1a rec1=00 rec2=0b rec3=074
[0x0c] rec0=10 rec1=00 rec2=0c rec3=010
[0x0d] rec0=0f rec1=00 rec2=0d rec3=02e
[0x0e] rec0=10 rec1=00 rec2=0e rec3=022
[0x0f] rec0=0d rec1=00 rec2=0f rec3=056
[0x10] rec0=1b rec1=00 rec2=10 rec3=030
[0x11] rec0=15 rec1=00 rec2=11 rec3=05e
[0x12] rec0=1b rec1=00 rec2=12 rec3=000
tail 0x2171d3382838d45d03aec 0x42a00088462061e03