package body System.Partition_Interface is
pragma Warnings (Off);
M : constant := 7;
type String_Access is access String;
type Pkg_Node;
type Pkg_List is access Pkg_Node;
type Pkg_Node is record
Name : String_Access;
Subp_Info : System.Address;
Subp_Info_Len : Integer;
Next : Pkg_List;
end record;
Pkg_Head : Pkg_List;
Pkg_Tail : Pkg_List;
function getpid return Integer;
pragma Import (C, getpid);
PID : constant Integer := getpid;
function Lower (S : String) return String;
Passive_Prefix : constant String := "SP__";
procedure Check
(Name : Unit_Name;
Version : String;
RCI : Boolean := True)
is
begin
null;
end Check;
function Get_Active_Partition_ID
(Name : Unit_Name) return System.RPC.Partition_ID
is
P : Pkg_List := Pkg_Head;
N : String := Lower (Name);
begin
while P /= null loop
if P.Name.all = N then
return Get_Local_Partition_ID;
end if;
P := P.Next;
end loop;
return M;
end Get_Active_Partition_ID;
function Get_Active_Version (Name : Unit_Name) return String is
begin
return "";
end Get_Active_Version;
function Get_Local_Partition_ID return System.RPC.Partition_ID is
begin
return System.RPC.Partition_ID (PID mod M);
end Get_Local_Partition_ID;
function Get_Passive_Partition_ID
(Name : Unit_Name) return System.RPC.Partition_ID
is
begin
return Get_Local_Partition_ID;
end Get_Passive_Partition_ID;
function Get_Passive_Version (Name : Unit_Name) return String is
begin
return "";
end Get_Passive_Version;
procedure Get_RAS_Info
(Name : Unit_Name;
Subp_Id : Subprogram_Id;
Proxy_Address : out Interfaces.Unsigned_64)
is
LName : constant String := Lower (Name);
N : Pkg_List;
begin
N := Pkg_Head;
while N /= null loop
if N.Name.all = LName then
declare
subtype Subprogram_Array is RCI_Subp_Info_Array
(First_RCI_Subprogram_Id ..
First_RCI_Subprogram_Id + N.Subp_Info_Len - 1);
Subprograms : Subprogram_Array;
for Subprograms'Address use N.Subp_Info;
pragma Import (Ada, Subprograms);
begin
Proxy_Address :=
Interfaces.Unsigned_64 (Subprograms (Integer (Subp_Id)).Addr);
return;
end;
end if;
N := N.Next;
end loop;
Proxy_Address := 0;
end Get_RAS_Info;
function Get_RCI_Package_Receiver
(Name : Unit_Name) return Interfaces.Unsigned_64
is
begin
return 0;
end Get_RCI_Package_Receiver;
procedure Get_Unique_Remote_Pointer
(Handler : in out RACW_Stub_Type_Access)
is
begin
null;
end Get_Unique_Remote_Pointer;
function Lower (S : String) return String is
T : String := S;
begin
for J in T'Range loop
if T (J) in 'A' .. 'Z' then
T (J) := Character'Val (Character'Pos (T (J)) -
Character'Pos ('A') +
Character'Pos ('a'));
end if;
end loop;
return T;
end Lower;
procedure Raise_Program_Error_Unknown_Tag
(E : Ada.Exceptions.Exception_Occurrence)
is
begin
Ada.Exceptions.Raise_Exception
(Program_Error'Identity, Ada.Exceptions.Exception_Message (E));
end Raise_Program_Error_Unknown_Tag;
package body RCI_Locator is
function Get_Active_Partition_ID return System.RPC.Partition_ID is
P : Pkg_List := Pkg_Head;
N : String := Lower (RCI_Name);
begin
while P /= null loop
if P.Name.all = N then
return Get_Local_Partition_ID;
end if;
P := P.Next;
end loop;
return M;
end Get_Active_Partition_ID;
function Get_RCI_Package_Receiver return Interfaces.Unsigned_64 is
begin
return 0;
end Get_RCI_Package_Receiver;
end RCI_Locator;
procedure Register_Passive_Package
(Name : Unit_Name;
Version : String := "")
is
begin
Register_Receiving_Stub
(Passive_Prefix & Name, null, Version, System.Null_Address, 0);
end Register_Passive_Package;
procedure Register_Receiving_Stub
(Name : Unit_Name;
Receiver : RPC_Receiver;
Version : String := "";
Subp_Info : System.Address;
Subp_Info_Len : Integer)
is
N : constant Pkg_List :=
new Pkg_Node'(new String'(Lower (Name)),
Subp_Info, Subp_Info_Len,
Next => null);
begin
if Pkg_Tail = null then
Pkg_Head := N;
else
Pkg_Tail.Next := N;
end if;
Pkg_Tail := N;
end Register_Receiving_Stub;
procedure Run
(Main : Main_Subprogram_Type := null)
is
begin
if Main /= null then
Main.all;
end if;
end Run;
function Same_Partition
(Left : access RACW_Stub_Type;
Right : access RACW_Stub_Type) return Boolean
is
pragma Unreferenced (Left);
pragma Unreferenced (Right);
begin
return True;
end Same_Partition;
end System.Partition_Interface;