|
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 - metrics - download
Length: 20480 (0x5000)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, procedure Build_Server_Package_Body, seg_020ba7, separate Rpc_Io
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
separate (Rpc_Io)
procedure Build_Server_Package_Body (From_Db : Analysis.Database;
Named_With_Root : String;
In_File : Io.File_Type) is
function "=" (Left, Right : Declarations.Subprogram_Parameter_Kinds)
return Boolean renames Declarations."=";
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
Put (Ada_Io.Make_With_Clause (Name => "Rpc"));
Put (Ada_Io.Make_With_Clause (Name => "Rpc_Server"));
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 => Rpc_Names.Interchange_Package (Named_With_Root)));
Put (Ada_Io.Make_With_Clause (Name => "Interchange"));
Put (Ada_Io.Make_With_Clause (Name => Named_With_Root));
-- 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 => Rpc_Names.Remote_Server_Package (Named_With_Root),
Kind => Ada_Io.Body_Part), 1);
-- The Process_Call procedure is used by the server to collect all
-- input data, make the actual call, the return all output data
Put (Ada_Io.Make_Procedure
(Name => "Process_Call",
Kind => Ada_Io.Body_Part,
Parameters_Image =>
"Stream : Transport_Stream.Stream_Id; " & Ascii.Lf &
"Id : Rpc.Transaction_Id; " & Ascii.Lf &
"Version : Rpc.Version_Number; " & Ascii.Lf &
"Proc : Rpc.Procedure_Number"));
Put (Ada_Io.Make_Begin);
Put (Ada_Io.Make_Case_Header (Expression => "Proc"));
Analysis.Init (From_Db => From_Db, Iter => Subprogram_Iter);
while not Analysis.Done (Subprogram_Iter) loop
Put (Ada_Io.Make_Alternative
(Expression => Defs & ".Procedure_Number." &
Analysis.Unique_Name (Subprogram_Iter)));
Put (Ada_Io.Make_Declare);
-- Create a local declaration for all paramters to the subprogram
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 | Decls.Out_Parameter =>
Id_Iter := Analysis.Names (Parameter_Iter);
if not Is_Constrained (Param_Type) then
while not Analysis.Done (Id_Iter) loop
-- if unconstrained make a constant decl
-- with a call to the functional get
Put (Ada_Io.Make_Constant_Declaration
(Name => Analysis.Name (Id_Iter),
Type_Mark => Analysis.Reference
(Analysis.Formals_Type_Decl
(Parameter_Iter)),
Initial_Value =>
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)));
Analysis.Next (Id_Iter);
end loop;
else
while not Analysis.Done (Id_Iter) loop
-- Put the local decl
Put (Ada_Io.Make_Variable_Declaration
(Name => Analysis.Name (Id_Iter),
Type_Mark => Analysis.Reference
(Analysis.Formals_Type_Decl
(Parameter_Iter))));
-- if the subprogram has an in or in out parameter
-- of type duration, then another local is required
if Is_Duration (Param_Type) and then
(Analysis.Mode (Parameter_Iter) =
Decls.Default_In_Parameter or else
Analysis.Mode (Parameter_Iter) =
Decls.In_Out_Parameter or else
Analysis.Mode (Parameter_Iter) =
Decls.In_Parameter) then
Put (Ada_Io.Make_Variable_Declaration
(Name => Rpc_Names.Interchange_Type_Decl
(Analysis.Name (Id_Iter)),
Type_Mark => "Interchange.Duration"));
end if;
Analysis.Next (Id_Iter);
end loop;
end if;
when others =>
null;
end case;
Analysis.Next (Parameter_Iter);
end loop;
case Analysis.Kind (Subprogram_Iter) is
when Analysis.A_Procedure =>
null;
when Analysis.A_Function =>
Return_Type := Analysis.Return_Type_Decl (Subprogram_Iter);
-- if the return type is constrained, then add another local
-- declaration
if Is_Constrained (Return_Type) then
Put (Ada_Io.Make_Variable_Declaration
(Name => Return_Name (Return_Type),
Type_Mark => Analysis.Reference (Return_Type)));
end if;
end case;
Put (Ada_Io.Make_Begin);
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 =>
-- Issues a procedure call to get all constrained
-- types
if Is_Constrained (Param_Type) then
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
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);
end if;
Analysis.Next (Id_Iter);
end loop;
end if;
when others =>
null;
end case;
Analysis.Next (Parameter_Iter);
end loop;
Parameter_Iter := Analysis.Parameters (Subprogram_Iter);
case Analysis.Kind (Subprogram_Iter) is
when Analysis.A_Procedure =>
-- Issue the call to the subprogram
Put (Subprograms.Make_Procedure
(Analysis.Reference (Subprogram_Iter),
Ada_Io.Call, Parameter_Iter), 1);
when Analysis.A_Function =>
if Is_Constrained (Return_Type) then
-- if constrained make the assignment directly
-- to the return type
Put (Ada_Io.Make_Assignment
(Name => Return_Name (Return_Type),
Expression => Subprograms.Make_Function
(Analysis.Reference
(Subprogram_Iter),
Ada_Io.Call, Parameter_Iter,
Return_Name (Return_Type))));
else
-- otherwise make a local constant declaration
Put (Ada_Io.Make_Declare);
Put (Ada_Io.Make_Constant_Declaration
(Name => Return_Name (Return_Type),
Type_Mark => Analysis.Reference (Return_Type),
Initial_Value =>
Subprograms.Make_Function
(Analysis.Reference (Subprogram_Iter),
Ada_Io.Call, Parameter_Iter,
Analysis.Name (Return_Type))));
Put (Ada_Io.Make_Begin);
end if;
end case;
Put ("Rpc_Server.Begin_Response (Stream, Id);", 1);
-- Issue a put 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
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;
when Analysis.A_Function =>
-- put the return value for a function
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 => Put), 1);
if not Is_Constrained (Return_Type) then
Put (Ada_Io.Make_End);
end if;
end case;
Put (Ada_Io.Make_End);
Analysis.Next (Subprogram_Iter);
end loop;
-- raise error for undefined procedures
Put (Ada_Io.Make_Alternative (Expression => "others"));
Put (Ada_Io.Make_Raise ("Rpc.No_Such_Procedure"));
Put (Ada_Io.Make_End_Case);
-- handle all predefined and user defined exceptions
Put (Ada_Io.Make_Exception_Handler);
-- predefined exceptions
Put (Ada_Io.Make_Alternative (Expression => "Constraint_Error"));
Put ("Rpc_Server.Return_Exception (Stream, id, " &
Defs & ".Exception_Number.Constraint_Error);", 2);
Put (Ada_Io.Make_Alternative (Expression => "Numeric_Error"));
Put ("Rpc_Server.Return_Exception (Stream, id, " &
Defs & ".Exception_Number.Numeric_Error);", 2);
Put (Ada_Io.Make_Alternative (Expression => "Program_Error"));
Put ("Rpc_Server.Return_Exception (Stream, id, " &
Defs & ".Exception_Number.Program_Error);", 2);
Put (Ada_Io.Make_Alternative (Expression => "Storage_Error"));
Put ("Rpc_Server.Return_Exception (Stream, id, " &
Defs & ".Exception_Number.Storage_Error);", 2);
Put (Ada_Io.Make_Alternative (Expression => "Tasking_Error"));
Put ("Rpc_Server.Return_Exception (Stream, id, " &
Defs & ".Exception_Number.Tasking_Error);", 2);
-- User defined exceptions
Analysis.Init (From_Db => From_Db, Iter => Exception_Iter);
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 => Named_With_Root & "." &
Analysis.Name (Id_Iter)));
Put ("Rpc_Server.Return_Exception (Stream, id, " & Defs &
".Exception_Number." & Analysis.Name (Id_Iter) & ");", 2);
Analysis.Next (Id_Iter);
end loop;
Analysis.Next (Exception_Iter);
end loop;
Put (Ada_Io.Make_End, 1);
-- Instantiate the RPC server generic
Put ("procedure Serve_Guts is new Rpc_Server.Serve" & "(Program => " &
Defs & ".program," & "Process_Call => Process_Call);", 2);
-- body to start the server
Put ("procedure Serve (Connection : Transport.COnnection_Id) is ");
Put (Ada_Io.Make_Begin);
Put ("Serve_Guts (Connection);");
Put (Ada_Io.Make_End, 1);
Put (Ada_Io.Make_End);
end Build_Server_Package_Body;
nblk1=13
nid=0
hdr6=26
[0x00] rec0=19 rec1=00 rec2=01 rec3=064
[0x01] rec0=00 rec1=00 rec2=13 rec3=01c
[0x02] rec0=19 rec1=00 rec2=02 rec3=08c
[0x03] rec0=17 rec1=00 rec2=03 rec3=07e
[0x04] rec0=17 rec1=00 rec2=04 rec3=008
[0x05] rec0=10 rec1=00 rec2=05 rec3=02e
[0x06] rec0=11 rec1=00 rec2=06 rec3=054
[0x07] rec0=18 rec1=00 rec2=07 rec3=07e
[0x08] rec0=17 rec1=00 rec2=08 rec3=06c
[0x09] rec0=10 rec1=00 rec2=09 rec3=06c
[0x0a] rec0=0f rec1=00 rec2=0a rec3=08a
[0x0b] rec0=1b rec1=00 rec2=0b rec3=02e
[0x0c] rec0=12 rec1=00 rec2=0c rec3=076
[0x0d] rec0=16 rec1=00 rec2=0d rec3=004
[0x0e] rec0=14 rec1=00 rec2=0e rec3=038
[0x0f] rec0=1a rec1=00 rec2=0f rec3=014
[0x10] rec0=13 rec1=00 rec2=10 rec3=020
[0x11] rec0=19 rec1=00 rec2=11 rec3=084
[0x12] rec0=08 rec1=00 rec2=12 rec3=000
tail 0x2151c80be838d451b96d7 0x42a00088462061e03