|
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: 11264 (0x2c00)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, seg_021869
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
WITH Io_Exceptions;
WITH Interchange;
WITH Transport;
WITH Transport_Defs;
WITH Transport_Interchange;
PACKAGE BODY Rpc_Server IS
Supported_Versions : CONSTANT Rpc.Version_Range := (3, 5);
PROCEDURE Begin_Response (Stream : Transport_Stream.Stream_Id;
Id : Rpc.Transaction_Id) IS
Response : Rpc.Message_Header (Kind => Rpc.Return_Message) :=
(Rpc.Return_Message, Id);
BEGIN
Rpc.Put_Message (Stream, Response);
END Begin_Response;
PROCEDURE Return_Exception (Stream : Transport_Stream.Stream_Id;
Id : Rpc.Transaction_Id;
Excep : Rpc.Exception_Number) IS
Response : Rpc.Message_Header (Kind => Rpc.Abort_Message);
BEGIN
Response := (Rpc.Abort_Message, Id, Rpc.Error_Other);
Rpc.Put_Message (Stream, Response);
END Return_Exception;
PROCEDURE Serve (Connection : Transport.Connection_Id;
Blocking : Boolean := True) IS
Stream : Transport_Stream.Stream_Id;
Client_Versions : Rpc.Version_Range;
Max_Version : Rpc.Version_Number;
Status : Transport_Defs.Status_Code;
PROCEDURE Process_Calls IS
Request : Rpc.Message_Header;
FUNCTION "=" (X, Y : Rpc.Message_Kind) RETURN Boolean RENAMES Rpc."=";
FUNCTION "=" (X, Y : Rpc.Program_Number) RETURN Boolean
RENAMES Rpc."=";
PROCEDURE Do_Process_Call IS
PROCEDURE Put_Abort (Error : Rpc.Error_Type) IS
BEGIN
Rpc.Put_Message (Stream, (Kind => Rpc.Abort_Message,
Id => Request.Id,
Error => Error));
END Put_Abort;
BEGIN
IF Max_Version IN Rpc.Username_Versions.First ..
Rpc.Username_Versions.Last THEN
DECLARE
Username : CONSTANT String :=
Transport_Interchange.Get_String (Stream);
Password : CONSTANT String :=
Transport_Interchange.Get_String (Stream);
BEGIN
Process_Call (Stream, Request.Id,
Request.Version, Request.Proc);
END;
ELSE
Process_Call (Stream, Request.Id,
Request.Version, Request.Proc);
END IF;
EXCEPTION
WHEN Interchange.Constraint_Error =>
RAISE Rpc.Invalid_Argument;
WHEN Standard.Constraint_Error =>
Put_Abort (Rpc.Error_Constraint);
WHEN Standard.Numeric_Error =>
Put_Abort (Rpc.Error_Numeric);
WHEN Standard.Program_Error =>
Put_Abort (Rpc.Error_Program);
WHEN Standard.Storage_Error =>
Put_Abort (Rpc.Error_Storage);
WHEN Standard.Tasking_Error =>
Put_Abort (Rpc.Error_Tasking);
WHEN Io_Exceptions.Status_Error =>
Put_Abort (Rpc.Status_Error);
WHEN Io_Exceptions.Mode_Error =>
Put_Abort (Rpc.Mode_Error);
WHEN Io_Exceptions.Name_Error =>
Put_Abort (Rpc.Name_Error);
WHEN Io_Exceptions.Use_Error =>
Put_Abort (Rpc.Use_Error);
WHEN Io_Exceptions.Device_Error =>
Put_Abort (Rpc.Device_Error);
WHEN Io_Exceptions.End_Error =>
Put_Abort (Rpc.End_Error);
WHEN Io_Exceptions.Data_Error =>
Put_Abort (Rpc.Data_Error);
WHEN Io_Exceptions.Layout_Error =>
Put_Abort (Rpc.Layout_Error);
WHEN Rpc.Username_Or_Password_Error =>
Put_Abort (Rpc.Error_Username_Or_Password);
WHEN OTHERS => Put_Abort (Rpc.Error_Other);
END Do_Process_Call;
PROCEDURE Put_Reject (Details : Rpc.Reject_Details) IS
BEGIN
Rpc.Put_Message (Stream, (Kind => Rpc.Reject_Message,
Id => Request.Id,
Details => Details));
END Put_Reject;
BEGIN
IF NOT Blocking THEN
Transport.Set_Mode
(Connection => Connection, Status => Status, Blocking => False);
END IF;
Initialize;
LOOP
Main_Loop_Preprocess;
Transport_Stream.Flush_Transmit_Buffer (Stream);
Request := Rpc.Get_Message (Stream);
IF Request.Kind /= Rpc.Call_Message THEN
RAISE Rpc.Protocol_Error;
ELSIF Request.Program /= Program THEN
RAISE Rpc.No_Such_Program;
ELSIF NOT (Request.Version IN
Supported.First .. Supported.Last) THEN
RAISE Rpc.No_Such_Version;
ELSE
Do_Process_Call;
END IF;
Main_Loop_Postprocess;
END LOOP;
EXCEPTION
WHEN Rpc.No_Such_Program =>
Put_Reject ((Kind => Rpc.Rej_No_Such_Program));
WHEN Rpc.No_Such_Version =>
Put_Reject ((Kind => Rpc.Rej_No_Such_Version,
Supported => Supported));
WHEN Rpc.No_Such_Procedure =>
Put_Reject ((Kind => Rpc.Rej_No_Such_Procedure));
WHEN Rpc.Invalid_Argument =>
Put_Reject ((Kind => Rpc.Rej_Invalid_Argument));
WHEN OTHERS =>
NULL;
END Process_Calls;
BEGIN
BEGIN
Transport_Stream.Allocate (Stream, Connection);
Rpc.Get (Stream, Client_Versions);
Rpc.Put (Stream, Supported_Versions);
IF Rpc.Overlaps (Client_Versions, Supported_Versions) THEN
Max_Version := Rpc.Max (Client_Versions, Supported_Versions);
Process_Calls;
END IF;
Transport_Stream.Flush_Transmit_Buffer (Stream);
EXCEPTION
WHEN OTHERS =>
NULL;
END;
Transport_Stream.Deallocate (Stream);
END Serve;
END Rpc_Server;
nblk1=a
nid=2
hdr6=10
[0x00] rec0=1e rec1=00 rec2=01 rec3=00a
[0x01] rec0=19 rec1=00 rec2=03 rec3=080
[0x02] rec0=01 rec1=00 rec2=09 rec3=026
[0x03] rec0=17 rec1=00 rec2=04 rec3=018
[0x04] rec0=16 rec1=00 rec2=05 rec3=002
[0x05] rec0=1d rec1=00 rec2=07 rec3=012
[0x06] rec0=1b rec1=00 rec2=0a rec3=054
[0x07] rec0=0e rec1=00 rec2=06 rec3=000
[0x08] rec0=08 rec1=00 rec2=09 rec3=000
[0x09] rec0=30 rec1=00 rec2=20 rec3=000
tail 0x2151ce708838e7cb5da3a 0x489e0066482863c01
Free Block Chain:
0x2: 0000 00 08 01 3d 80 28 78 20 28 43 6c 69 65 6e 74 5f ┆ = (x (Client_┆
0x8: 0000 00 00 00 1e 80 18 63 6b 69 6e 67 3a 62 6f 6f 6c ┆ cking:bool┆