1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
5 -- S Y S T E M . R P C --
9 -- Copyright (C) 1992-2006 Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 2, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
22 -- As a special exception, if other files instantiate generics from this --
23 -- unit, or you link this unit with other files to produce an executable, --
24 -- this unit does not by itself cause the resulting executable to be --
25 -- covered by the GNU General Public License. This exception does not --
26 -- however invalidate any other reasons why the executable file might be --
27 -- covered by the GNU Public License. --
29 -- GNAT was originally developed by the GNAT team at New York University. --
30 -- Extensive contributions were provided by Ada Core Technologies Inc. --
32 ------------------------------------------------------------------------------
36 with Unchecked_Deallocation
;
39 with System
.RPC
.Net_Trace
;
40 with System
.RPC
.Garlic
;
41 with System
.RPC
.Streams
;
42 pragma Elaborate
(System
.RPC
.Garlic
);
44 package body System
.RPC
is
46 -- ??? general note: the debugging calls are very heavy, especially
47 -- those that create exception handlers in every procedure. Do we
48 -- really still need all this stuff?
50 use type Ada
.Streams
.Stream_Element_Count
;
51 use type Ada
.Streams
.Stream_Element_Offset
;
53 use type Garlic
.Protocol_Access
;
54 use type Garlic
.Lock_Method
;
56 Max_Of_Message_Id
: constant := 127;
58 subtype Message_Id_Type
is
59 Integer range -Max_Of_Message_Id
.. Max_Of_Message_Id
;
60 -- A message id is either a request id or reply id. A message id is
61 -- provided with a message to a receiving stub which uses the opposite
62 -- as a reply id. A message id helps to retrieve to which task is
63 -- addressed a reply. When the environment task receives a message, the
64 -- message id is extracted : a positive message id stands for a call, a
65 -- negative message id stands for a reply. A null message id stands for
66 -- an asynchronous request.
68 subtype Request_Id_Type
is Message_Id_Type
range 1 .. Max_Of_Message_Id
;
69 -- When a message id is positive, it is a request
71 type Message_Length_Per_Request
is array (Request_Id_Type
)
72 of Ada
.Streams
.Stream_Element_Count
;
74 Header_Size
: Ada
.Streams
.Stream_Element_Count
:=
75 Streams
.Get_Integer_Initial_Size
+
76 Streams
.Get_SEC_Initial_Size
;
77 -- Initial size needed for frequently used header streams
79 Stream_Error
: exception;
80 -- Occurs when a read procedure is executed on an empty stream
81 -- or when a write procedure is executed on a full stream
83 Partition_RPC_Receiver
: RPC_Receiver
;
84 -- Cache the RPC_Receiver passed by Establish_RPC_Receiver
86 type Anonymous_Task_Node
;
88 type Anonymous_Task_Node_Access
is access Anonymous_Task_Node
;
89 -- Types we need to construct a singly linked list of anonymous tasks
90 -- This pool is maintained to avoid a task creation each time a RPC
91 -- occurs - to be cont'd
93 task type Anonymous_Task_Type
(Self
: Anonymous_Task_Node_Access
) is
96 (Message_Id
: Message_Id_Type
;
97 Partition
: Partition_ID
;
98 Params_Size
: Ada
.Streams
.Stream_Element_Count
;
99 Result_Size
: Ada
.Streams
.Stream_Element_Count
;
100 Protocol
: Garlic
.Protocol_Access
);
101 -- This entry provides an anonymous task a remote call to perform.
102 -- This task calls for a Request id is provided to construct the
103 -- reply id by using -Request. Partition is used to send the reply
104 -- message. Params_Size is the size of the calling stub Params stream.
105 -- Then Protocol (used by the environment task previously) allows
106 -- extraction of the message following the header (The header is
107 -- extracted by the environment task)
108 -- Note: grammar in above is obscure??? needs cleanup
110 end Anonymous_Task_Type
;
112 type Anonymous_Task_Access
is access Anonymous_Task_Type
;
114 type Anonymous_Task_List
is record
115 Head
: Anonymous_Task_Node_Access
;
116 Tail
: Anonymous_Task_Node_Access
;
119 type Anonymous_Task_Node
is record
120 Element
: Anonymous_Task_Access
;
121 Next
: Anonymous_Task_Node_Access
;
123 -- Types we need to construct a singly linked list of anonymous tasks.
124 -- This pool is maintained to avoid a task creation each time a RPC occurs.
126 protected Garbage_Collector
is
129 (Item
: out Anonymous_Task_Node_Access
);
130 -- Anonymous task pool management : if there is an anonymous task
131 -- left, use it. Otherwise, allocate a new one
134 (Item
: in out Anonymous_Task_Node_Access
);
135 -- Anonymous task pool management : queue this task in the pool
136 -- of inactive anonymous tasks.
140 Anonymous_List
: Anonymous_Task_Node_Access
;
141 -- The list root of inactive anonymous tasks
143 end Garbage_Collector
;
147 entry New_Request
(Request
: out Request_Id_Type
);
148 -- To get a new request
150 entry Wait_On
(Request_Id_Type
)
151 (Length
: out Ada
.Streams
.Stream_Element_Count
);
152 -- To block the calling stub when it waits for a reply
153 -- When it is resumed, we provide the size of the reply
156 (Request
: Request_Id_Type
;
157 Length
: Ada
.Streams
.Stream_Element_Count
);
158 -- To wake up the calling stub when the environment task has
159 -- received a reply for this request
163 task Environnement
is
166 -- Receive no message until Partition_Receiver is set
167 -- Establish_RPC_Receiver decides when the environment task
168 -- is allowed to start
172 protected Partition_Receiver
is
175 -- Blocks if the Partition_RPC_Receiver has not been set
178 -- Done by Establish_RPC_Receiver when Partition_RPC_Receiver
183 Was_Set
: Boolean := False;
184 -- True when Partition_RPC_Receiver has been set
186 end Partition_Receiver
;
187 -- Anonymous tasks have to wait for the Partition_RPC_Receiver
191 (D_Elaborate
, -- About the elaboration of this package
192 D_Communication
, -- About calls to Send and Receive
194 D_Exception
); -- Exception handler
197 package Debugging
is new System
.RPC
.Net_Trace
(Debug_Level
, "RPC : ");
201 (Flag
: Debug_Level
; Info
: String) renames Debugging
.Debug
;
204 ------------------------
205 -- Partition_Receiver --
206 ------------------------
208 protected body Partition_Receiver
is
210 -------------------------------
211 -- Partition_Receiver.Is_Set --
212 -------------------------------
214 entry Is_Set
when Was_Set
is
219 ----------------------------
220 -- Partition_Receiver.Set --
221 ----------------------------
228 end Partition_Receiver
;
235 (Index
: out Packet_Node_Access
;
236 Stream
: Params_Stream_Type
)
239 Index
:= Stream
.Extra
.Head
;
243 D
(D_Exception
, "exception in Head_Node");
252 (Index
: out Packet_Node_Access
;
253 Stream
: Params_Stream_Type
)
256 Index
:= Stream
.Extra
.Tail
;
260 D
(D_Exception
, "exception in Tail_Node");
268 function Null_Node
(Index
: Packet_Node_Access
) return Boolean is
274 D
(D_Exception
, "exception in Null_Node");
278 ----------------------
279 -- Delete_Head_Node --
280 ----------------------
282 procedure Delete_Head_Node
(Stream
: in out Params_Stream_Type
) is
285 new Unchecked_Deallocation
286 (Packet_Node
, Packet_Node_Access
);
288 Next_Node
: Packet_Node_Access
:= Stream
.Extra
.Head
.Next
;
291 -- Delete head node and free memory usage
293 Free
(Stream
.Extra
.Head
);
294 Stream
.Extra
.Head
:= Next_Node
;
296 -- If the extra storage is empty, update tail as well
298 if Stream
.Extra
.Head
= null then
299 Stream
.Extra
.Tail
:= null;
304 D
(D_Exception
, "exception in Delete_Head_Node");
306 end Delete_Head_Node
;
312 procedure Next_Node
(Node
: in out Packet_Node_Access
) is
314 -- Node is set to the next node
315 -- If not possible, Stream_Error is raised
325 D
(D_Exception
, "exception in Next_Node");
329 ---------------------
330 -- Append_New_Node --
331 ---------------------
333 procedure Append_New_Node
(Stream
: in out Params_Stream_Type
) is
334 Index
: Packet_Node_Access
;
337 -- Set Index to the end of the linked list
339 Tail_Node
(Index
, Stream
);
341 if Null_Node
(Index
) then
343 -- The list is empty : set head as well
345 Stream
.Extra
.Head
:= new Packet_Node
;
346 Stream
.Extra
.Tail
:= Stream
.Extra
.Head
;
349 -- The list is not empty : link new node with tail
351 Stream
.Extra
.Tail
.Next
:= new Packet_Node
;
352 Stream
.Extra
.Tail
:= Stream
.Extra
.Tail
.Next
;
358 D
(D_Exception
, "exception in Append_New_Node");
367 (Stream
: in out Params_Stream_Type
;
368 Item
: out Ada
.Streams
.Stream_Element_Array
;
369 Last
: out Ada
.Streams
.Stream_Element_Offset
)
370 renames System
.RPC
.Streams
.Read
;
377 (Stream
: in out Params_Stream_Type
;
378 Item
: Ada
.Streams
.Stream_Element_Array
)
379 renames System
.RPC
.Streams
.Write
;
381 -----------------------
382 -- Garbage_Collector --
383 -----------------------
385 protected body Garbage_Collector
is
387 --------------------------------
388 -- Garbage_Collector.Allocate --
389 --------------------------------
391 procedure Allocate
(Item
: out Anonymous_Task_Node_Access
) is
392 New_Anonymous_Task_Node
: Anonymous_Task_Node_Access
;
393 Anonymous_Task
: Anonymous_Task_Access
;
396 -- If the list is empty, allocate a new anonymous task
397 -- Otherwise, reuse the first queued anonymous task
399 if Anonymous_List
= null then
401 -- Create a new anonymous task
402 -- Provide this new task with its id to allow it
403 -- to enqueue itself into the free anonymous task list
404 -- with the function Deallocate
406 New_Anonymous_Task_Node
:= new Anonymous_Task_Node
;
408 new Anonymous_Task_Type
(New_Anonymous_Task_Node
);
409 New_Anonymous_Task_Node
.all := (Anonymous_Task
, null);
412 -- Extract one task from the list
413 -- Set the Next field to null to avoid possible bugs
415 New_Anonymous_Task_Node
:= Anonymous_List
;
416 Anonymous_List
:= Anonymous_List
.Next
;
417 New_Anonymous_Task_Node
.Next
:= null;
421 -- Item is an out parameter
423 Item
:= New_Anonymous_Task_Node
;
427 D
(D_Exception
, "exception in Allocate (Anonymous Task)");
431 ----------------------------------
432 -- Garbage_Collector.Deallocate --
433 ----------------------------------
435 procedure Deallocate
(Item
: in out Anonymous_Task_Node_Access
) is
437 -- Enqueue the task in the free list
439 Item
.Next
:= Anonymous_List
;
440 Anonymous_List
:= Item
;
444 D
(D_Exception
, "exception in Deallocate (Anonymous Task)");
448 end Garbage_Collector
;
455 (Partition
: Partition_ID
;
456 Params
: access Params_Stream_Type
;
457 Result
: access Params_Stream_Type
)
459 Protocol
: Protocol_Access
;
460 Request
: Request_Id_Type
;
461 Header
: aliased Params_Stream_Type
(Header_Size
);
462 R_Length
: Ada
.Streams
.Stream_Element_Count
;
465 -- Parameters order :
466 -- Opcode (provided and used by garlic)
467 -- (1) Size (provided by s-rpc and used by garlic)
468 -- (size of (2)+(3)+(4)+(5))
469 -- (2) Request (provided by calling stub (resp receiving stub) and
470 -- used by anonymous task (resp Do_RPC))
471 -- *** ZERO IF APC ***
472 -- (3) Res.len. (provided by calling stubs and used by anonymous task)
473 -- *** ZERO IF APC ***
474 -- (4) Receiver (provided by calling stubs and used by anonymous task)
475 -- (5) Params (provided by calling stubs and used by anonymous task)
477 -- The call is a remote call or a local call. A local call occurs
478 -- when the pragma All_Calls_Remote has been specified. Do_RPC is
479 -- called and the execution has to be performed in the PCS
481 if Partition
/= Garlic
.Get_My_Partition_ID
then
483 -- Get a request id to be resumed when the reply arrives
485 Dispatcher
.New_Request
(Request
);
487 -- Build header = request (2) + result.initial_size (3)
489 D
(D_Debug
, "Do_RPC - Build header");
490 Streams
.Allocate
(Header
);
491 Streams
.Integer_Write_Attribute
-- (2)
492 (Header
'Access, Request
);
493 System
.RPC
.Streams
.SEC_Write_Attribute
-- (3)
494 (Header
'Access, Result
.Initial_Size
);
496 -- Get a protocol method to communicate with the remote partition
497 -- and give the message size
500 "Do_RPC - Lookup for protocol to talk to partition" &
501 Partition_ID
'Image (Partition
));
504 Streams
.Get_Stream_Size
(Header
'Access) +
505 Streams
.Get_Stream_Size
(Params
), -- (1)
509 -- Send the header by using the protocol method
511 D
(D_Communication
, "Do_RPC - Send Header to partition" &
512 Partition_ID
'Image (Partition
));
516 Header
'Access); -- (2) + (3)
518 -- The header is deallocated
520 Streams
.Deallocate
(Header
);
522 -- Send Params from Do_RPC
524 D
(D_Communication
, "Do_RPC - Send Params to partition" &
525 Partition_ID
'Image (Partition
));
529 Params
); -- (4) + (5)
531 -- Let Garlic know we have nothing else to send
536 D
(D_Debug
, "Do_RPC - Suspend");
538 -- Wait for a reply and get the reply message length
540 Dispatcher
.Wait_On
(Request
) (R_Length
);
541 D
(D_Debug
, "Do_RPC - Resume");
544 New_Result
: aliased Params_Stream_Type
(R_Length
);
546 -- Adjust the Result stream size right now to be able to load
547 -- the stream in one receive call. Create a temporary result
548 -- that will be substituted to Do_RPC one
550 Streams
.Allocate
(New_Result
);
552 -- Receive the reply message from receiving stub
554 D
(D_Communication
, "Do_RPC - Receive Result from partition" &
555 Partition_ID
'Image (Partition
));
561 -- Let Garlic know we have nothing else to receive
563 Garlic
.Complete_Receive
567 -- Update calling stub Result stream
569 D
(D_Debug
, "Do_RPC - Reconstruct Result");
570 Streams
.Deallocate
(Result
.all);
571 Result
.Initial
:= New_Result
.Initial
;
572 Streams
.Dump
("|||", Result
.all);
577 -- Do RPC locally and first wait for Partition_RPC_Receiver to be
580 Partition_Receiver
.Is_Set
;
581 D
(D_Debug
, "Do_RPC - Locally");
582 Partition_RPC_Receiver
.all (Params
, Result
);
588 D
(D_Exception
, "exception in Do_RPC");
597 (Partition
: Partition_ID
;
598 Params
: access Params_Stream_Type
)
600 Message_Id
: Message_Id_Type
:= 0;
601 Protocol
: Protocol_Access
;
602 Header
: aliased Params_Stream_Type
(Header_Size
);
605 -- For more informations, see above
606 -- Request = 0 as we are not waiting for a reply message
607 -- Result length = 0 as we don't expect a result at all
609 if Partition
/= Garlic
.Get_My_Partition_ID
then
611 -- Build header = request (2) + result.initial_size (3)
612 -- As we have an APC, the request id is null to indicate
613 -- to the receiving stub that we do not expect a reply
614 -- This comes from 0 = -0
616 D
(D_Debug
, "Do_APC - Build Header");
617 Streams
.Allocate
(Header
);
618 Streams
.Integer_Write_Attribute
619 (Header
'Access, Integer (Message_Id
));
620 Streams
.SEC_Write_Attribute
623 -- Get a protocol method to communicate with the remote partition
624 -- and give the message size
627 "Do_APC - Lookup for protocol to talk to partition" &
628 Partition_ID
'Image (Partition
));
631 Streams
.Get_Stream_Size
(Header
'Access) +
632 Streams
.Get_Stream_Size
(Params
),
636 -- Send the header by using the protocol method
638 D
(D_Communication
, "Do_APC - Send Header to partition" &
639 Partition_ID
'Image (Partition
));
645 -- The header is deallocated
647 Streams
.Deallocate
(Header
);
649 -- Send Params from Do_APC
651 D
(D_Communication
, "Do_APC - Send Params to partition" &
652 Partition_ID
'Image (Partition
));
658 -- Let Garlic know we have nothing else to send
666 Result
: aliased Params_Stream_Type
(0);
668 -- Result is here a dummy parameter
669 -- No reason to deallocate as it is not allocated at all
671 Partition_Receiver
.Is_Set
;
672 D
(D_Debug
, "Do_APC - Locally");
673 Partition_RPC_Receiver
.all (Params
, Result
'Access);
681 D
(D_Exception
, "exception in Do_APC");
685 ----------------------------
686 -- Establish_RPC_Receiver --
687 ----------------------------
689 procedure Establish_RPC_Receiver
690 (Partition
: Partition_ID
;
691 Receiver
: RPC_Receiver
)
694 -- Set Partition_RPC_Receiver and allow RPC mechanism
696 Partition_RPC_Receiver
:= Receiver
;
697 Partition_Receiver
.Set
;
698 D
(D_Elaborate
, "Partition_Receiver is set");
702 D
(D_Exception
, "exception in Establish_RPC_Receiver");
704 end Establish_RPC_Receiver
;
710 task body Dispatcher
is
711 Last_Request
: Request_Id_Type
:= Request_Id_Type
'First;
712 Current_Rqst
: Request_Id_Type
:= Request_Id_Type
'First;
713 Current_Size
: Ada
.Streams
.Stream_Element_Count
;
719 -- New_Request to get an entry in Dispatcher table
721 -- Wait_On for Do_RPC calls
723 -- Wake_Up called by environment task when a Do_RPC receives
724 -- the result of its remote call
727 accept New_Request
(Request
: out Request_Id_Type
) do
728 Request
:= Last_Request
;
731 -- ??? Availability check
733 if Last_Request
= Request_Id_Type
'Last then
734 Last_Request
:= Request_Id_Type
'First;
736 Last_Request
:= Last_Request
+ 1;
743 (Request
: Request_Id_Type
;
744 Length
: Ada
.Streams
.Stream_Element_Count
)
746 -- The environment reads the header and has been notified
747 -- of the reply id and the size of the result message
749 Current_Rqst
:= Request
;
750 Current_Size
:= Length
;
755 -- ??? Must be select with delay for aborted tasks
759 accept Wait_On
(Current_Rqst
)
760 (Length
: out Ada
.Streams
.Stream_Element_Count
)
762 Length
:= Current_Size
;
766 -- To free the Dispatcher when a task is aborted
780 D
(D_Exception
, "exception in Dispatcher body");
784 -------------------------
785 -- Anonymous_Task_Type --
786 -------------------------
788 task body Anonymous_Task_Type
is
789 Whoami
: Anonymous_Task_Node_Access
:= Self
;
790 C_Message_Id
: Message_Id_Type
; -- Current Message Id
791 C_Partition
: Partition_ID
; -- Current Partition
792 Params_S
: Ada
.Streams
.Stream_Element_Count
; -- Params message size
793 Result_S
: Ada
.Streams
.Stream_Element_Count
; -- Result message size
794 C_Protocol
: Protocol_Access
; -- Current Protocol
798 -- Get a new RPC to execute
802 (Message_Id
: Message_Id_Type
;
803 Partition
: Partition_ID
;
804 Params_Size
: Ada
.Streams
.Stream_Element_Count
;
805 Result_Size
: Ada
.Streams
.Stream_Element_Count
;
806 Protocol
: Protocol_Access
)
808 C_Message_Id
:= Message_Id
;
809 C_Partition
:= Partition
;
810 Params_S
:= Params_Size
;
811 Result_S
:= Result_Size
;
812 C_Protocol
:= Protocol
;
819 Params
: aliased Params_Stream_Type
(Params_S
);
820 Result
: aliased Params_Stream_Type
(Result_S
);
821 Header
: aliased Params_Stream_Type
(Header_Size
);
824 -- We reconstruct all the client context : Params and Result
825 -- with the SAME size, then we receive Params from calling stub
828 "Anonymous Task - Receive Params from partition" &
829 Partition_ID
'Image (C_Partition
));
835 -- Let Garlic know we don't receive anymore
837 Garlic
.Complete_Receive
841 -- Check that Partition_RPC_Receiver has been set
843 Partition_Receiver
.Is_Set
;
848 "Anonymous Task - Perform Partition_RPC_Receiver for request" &
849 Message_Id_Type
'Image (C_Message_Id
));
850 Partition_RPC_Receiver
(Params
'Access, Result
'Access);
852 -- If this was a RPC we send the result back
853 -- Otherwise, do nothing else than deallocation
855 if C_Message_Id
/= 0 then
857 -- Build Header = -C_Message_Id + Result Size
858 -- Provide the request id to the env task of the calling
859 -- stub partition We get the real result stream size : the
860 -- calling stub (in Do_RPC) updates its size to this one
862 D
(D_Debug
, "Anonymous Task - Build Header");
863 Streams
.Allocate
(Header
);
864 Streams
.Integer_Write_Attribute
865 (Header
'Access, Integer (-C_Message_Id
));
866 Streams
.SEC_Write_Attribute
868 Streams
.Get_Stream_Size
(Result
'Access));
870 -- Get a protocol method to communicate with the remote
871 -- partition and give the message size
874 "Anonymous Task - Lookup for protocol talk to partition" &
875 Partition_ID
'Image (C_Partition
));
878 Streams
.Get_Stream_Size
(Header
'Access) +
879 Streams
.Get_Stream_Size
(Result
'Access),
883 -- Send the header by using the protocol method
886 "Anonymous Task - Send Header to partition" &
887 Partition_ID
'Image (C_Partition
));
893 -- Send Result toDo_RPC
896 "Anonymous Task - Send Result to partition" &
897 Partition_ID
'Image (C_Partition
));
903 -- Let Garlic know we don't send anymore
908 Streams
.Deallocate
(Header
);
911 Streams
.Deallocate
(Params
);
912 Streams
.Deallocate
(Result
);
915 -- Enqueue into the anonymous task free list : become inactive
917 Garbage_Collector
.Deallocate
(Whoami
);
923 D
(D_Exception
, "exception in Anonymous_Task_Type body");
925 end Anonymous_Task_Type
;
931 task body Environnement
is
932 Partition
: Partition_ID
;
933 Message_Size
: Ada
.Streams
.Stream_Element_Count
;
934 Result_Size
: Ada
.Streams
.Stream_Element_Count
;
935 Message_Id
: Message_Id_Type
;
936 Header
: aliased Params_Stream_Type
(Header_Size
);
937 Protocol
: Protocol_Access
;
938 Anonymous
: Anonymous_Task_Node_Access
;
941 -- Wait the Partition_RPC_Receiver to be set
944 D
(D_Elaborate
, "Environment task elaborated");
947 -- We receive first a fixed size message : the header
948 -- Header = Message Id + Message Size
950 Streams
.Allocate
(Header
);
952 -- Garlic provides the size of the received message and the
953 -- protocol to use to communicate with the calling partition
955 Garlic
.Initiate_Receive
961 "Environment task - Receive protocol to talk to active partition" &
962 Partition_ID
'Image (Partition
));
964 -- Extract the header to route the message either to
965 -- an anonymous task (Message Id > 0 <=> Request Id)
966 -- or to a waiting task (Message Id < 0 <=> Reply Id)
969 "Environment task - Receive Header from partition" &
970 Partition_ID
'Image (Partition
));
976 -- Evaluate the remaining size of the message
978 Message_Size
:= Message_Size
-
979 Streams
.Get_Stream_Size
(Header
'Access);
981 -- Extract from header : message id and message size
983 Streams
.Integer_Read_Attribute
(Header
'Access, Message_Id
);
984 Streams
.SEC_Read_Attribute
(Header
'Access, Result_Size
);
986 if Streams
.Get_Stream_Size
(Header
'Access) /= 0 then
988 -- If there are stream elements left in the header ???
990 D
(D_Exception
, "Header is not empty");
995 if Message_Id
< 0 then
997 -- The message was sent by a receiving stub : wake up the
998 -- calling task - We have a reply there
1000 D
(D_Debug
, "Environment Task - Receive Reply from partition" &
1001 Partition_ID
'Image (Partition
));
1002 Dispatcher
.Wake_Up
(-Message_Id
, Result_Size
);
1005 -- The message was send by a calling stub : get an anonymous
1006 -- task to perform the job
1008 D
(D_Debug
, "Environment Task - Receive Request from partition" &
1009 Partition_ID
'Image (Partition
));
1010 Garbage_Collector
.Allocate
(Anonymous
);
1012 -- We subtracted the size of the header from the size of the
1013 -- global message in order to provide immediately Params size
1015 Anonymous
.Element
.Start
1024 -- Deallocate header : unnecessary - WARNING
1026 Streams
.Deallocate
(Header
);
1032 D
(D_Exception
, "exception in Environment");
1037 -- Set debugging information
1039 Debugging
.Set_Environment_Variable
("RPC");
1040 Debugging
.Set_Debugging_Name
("D", D_Debug
);
1041 Debugging
.Set_Debugging_Name
("E", D_Exception
);
1042 Debugging
.Set_Debugging_Name
("C", D_Communication
);
1043 Debugging
.Set_Debugging_Name
("Z", D_Elaborate
);
1044 D
(D_Elaborate
, "To be elaborated");
1046 -- When this body is elaborated we should ensure that RCI name server
1047 -- has been already elaborated : this means that Establish_RPC_Receiver
1048 -- has already been called and that Partition_RPC_Receiver is set
1050 Environnement
.Start
;
1051 D
(D_Elaborate
, "ELABORATED");