1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2008, 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 3, 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 COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 with Atree
; use Atree
;
27 with Casing
; use Casing
;
28 with Einfo
; use Einfo
;
29 with Errout
; use Errout
;
30 with Exp_Dist
; use Exp_Dist
;
31 with Exp_Tss
; use Exp_Tss
;
32 with Nlists
; use Nlists
;
33 with Nmake
; use Nmake
;
34 with Namet
; use Namet
;
36 with Rtsfind
; use Rtsfind
;
38 with Sem_Aux
; use Sem_Aux
;
39 with Sem_Disp
; use Sem_Disp
;
40 with Sem_Eval
; use Sem_Eval
;
41 with Sem_Res
; use Sem_Res
;
42 with Sem_Util
; use Sem_Util
;
43 with Sinfo
; use Sinfo
;
44 with Stand
; use Stand
;
45 with Stringt
; use Stringt
;
46 with Tbuild
; use Tbuild
;
47 with Uintp
; use Uintp
;
49 package body Sem_Dist
is
51 -----------------------
52 -- Local Subprograms --
53 -----------------------
55 procedure RAS_E_Dereference
(Pref
: Node_Id
);
56 -- Handles explicit dereference of Remote Access to Subprograms
58 function Full_Qualified_Name
(E
: Entity_Id
) return String_Id
;
59 -- returns the full qualified name of the entity in lower case
61 -------------------------
62 -- Add_Stub_Constructs --
63 -------------------------
65 procedure Add_Stub_Constructs
(N
: Node_Id
) is
66 U
: constant Node_Id
:= Unit
(N
);
67 Spec
: Entity_Id
:= Empty
;
70 -- Unit that will be expanded
73 pragma Assert
(Distribution_Stub_Mode
/= No_Stubs
);
75 if Nkind
(U
) = N_Package_Declaration
then
76 Spec
:= Defining_Entity
(Specification
(U
));
78 elsif Nkind
(U
) = N_Package_Body
then
79 Spec
:= Corresponding_Spec
(U
);
81 else pragma Assert
(Nkind
(U
) = N_Package_Instantiation
);
82 Exp
:= Instance_Spec
(U
);
83 Spec
:= Defining_Entity
(Specification
(Exp
));
86 pragma Assert
(Is_Shared_Passive
(Spec
)
87 or else Is_Remote_Call_Interface
(Spec
));
89 if Distribution_Stub_Mode
= Generate_Caller_Stub_Body
then
90 if Is_Shared_Passive
(Spec
) then
92 elsif Nkind
(U
) = N_Package_Body
then
94 ("Specification file expected from command line", U
);
96 Expand_Calling_Stubs_Bodies
(Exp
);
100 if Is_Shared_Passive
(Spec
) then
101 Build_Passive_Partition_Stub
(Exp
);
103 Expand_Receiving_Stubs_Bodies
(Exp
);
107 end Add_Stub_Constructs
;
109 ---------------------------------------
110 -- Build_RAS_Primitive_Specification --
111 ---------------------------------------
113 function Build_RAS_Primitive_Specification
114 (Subp_Spec
: Node_Id
;
115 Remote_Object_Type
: Node_Id
) return Node_Id
117 Loc
: constant Source_Ptr
:= Sloc
(Subp_Spec
);
119 Primitive_Spec
: constant Node_Id
:=
120 Copy_Specification
(Loc
,
122 New_Name
=> Name_uCall
);
124 Subtype_Mark_For_Self
: Node_Id
;
127 if No
(Parameter_Specifications
(Primitive_Spec
)) then
128 Set_Parameter_Specifications
(Primitive_Spec
, New_List
);
131 if Nkind
(Remote_Object_Type
) in N_Entity
then
132 Subtype_Mark_For_Self
:=
133 New_Occurrence_Of
(Remote_Object_Type
, Loc
);
135 Subtype_Mark_For_Self
:= Remote_Object_Type
;
139 Parameter_Specifications
(Primitive_Spec
),
140 Make_Parameter_Specification
(Loc
,
141 Defining_Identifier
=>
142 Make_Defining_Identifier
(Loc
, Name_uS
),
144 Make_Access_Definition
(Loc
,
146 Subtype_Mark_For_Self
)));
148 -- Trick later semantic analysis into considering this operation as a
149 -- primitive (dispatching) operation of tagged type Obj_Type.
151 Set_Comes_From_Source
(
152 Defining_Unit_Name
(Primitive_Spec
), True);
154 return Primitive_Spec
;
155 end Build_RAS_Primitive_Specification
;
157 -------------------------
158 -- Full_Qualified_Name --
159 -------------------------
161 function Full_Qualified_Name
(E
: Entity_Id
) return String_Id
is
162 Ent
: Entity_Id
:= E
;
163 Parent_Name
: String_Id
:= No_String
;
166 -- Deals properly with child units
168 if Nkind
(Ent
) = N_Defining_Program_Unit_Name
then
169 Ent
:= Defining_Identifier
(Ent
);
172 -- Compute recursively the qualification (only "Standard" has no scope)
174 if Present
(Scope
(Scope
(Ent
))) then
175 Parent_Name
:= Full_Qualified_Name
(Scope
(Ent
));
178 -- Every entity should have a name except some expanded blocks. Do not
179 -- bother about those.
181 if Chars
(Ent
) = No_Name
then
185 -- Add a period between Name and qualification
187 if Parent_Name
/= No_String
then
188 Start_String
(Parent_Name
);
189 Store_String_Char
(Get_Char_Code
('.'));
194 -- Generates the entity name in upper case
196 Get_Name_String
(Chars
(Ent
));
197 Set_Casing
(All_Lower_Case
);
198 Store_String_Chars
(Name_Buffer
(1 .. Name_Len
));
200 end Full_Qualified_Name
;
206 function Get_PCS_Name
return PCS_Names
is
209 Chars
(Entity
(Expression
(Parent
(RTE
(RE_DSA_Implementation
)))));
212 ---------------------
213 -- Get_PCS_Version --
214 ---------------------
216 function Get_PCS_Version
return Int
is
217 PCS_Version_Entity
: Entity_Id
;
221 if RTE_Available
(RE_PCS_Version
) then
222 PCS_Version_Entity
:= RTE
(RE_PCS_Version
);
223 pragma Assert
(Ekind
(PCS_Version_Entity
) = E_Named_Integer
);
225 UI_To_Int
(Expr_Value
(Constant_Value
(PCS_Version_Entity
)));
228 -- Case of System.Partition_Interface.PCS_Version not found:
229 -- return a null version.
237 ------------------------
238 -- Is_All_Remote_Call --
239 ------------------------
241 function Is_All_Remote_Call
(N
: Node_Id
) return Boolean is
245 if Nkind_In
(N
, N_Function_Call
, N_Procedure_Call_Statement
)
246 and then Nkind
(Name
(N
)) in N_Has_Entity
247 and then Is_Remote_Call_Interface
(Entity
(Name
(N
)))
248 and then Has_All_Calls_Remote
(Scope
(Entity
(Name
(N
))))
249 and then Comes_From_Source
(N
)
251 Par
:= Parent
(Entity
(Name
(N
)));
253 and then (Nkind
(Par
) /= N_Package_Specification
254 or else Is_Wrapper_Package
(Defining_Entity
(Par
)))
259 if Present
(Par
) then
261 not Scope_Within_Or_Same
(Current_Scope
, Defining_Entity
(Par
));
268 end Is_All_Remote_Call
;
270 ---------------------------------
271 -- Is_RACW_Stub_Type_Operation --
272 ---------------------------------
274 function Is_RACW_Stub_Type_Operation
(Op
: Entity_Id
) return Boolean is
275 Dispatching_Type
: Entity_Id
;
279 when E_Function | E_Procedure
=>
280 Dispatching_Type
:= Find_Dispatching_Type
(Op
);
281 return Present
(Dispatching_Type
)
282 and then Is_RACW_Stub_Type
(Dispatching_Type
)
283 and then not Is_Internal
(Op
);
288 end Is_RACW_Stub_Type_Operation
;
290 ------------------------------------
291 -- Package_Specification_Of_Scope --
292 ------------------------------------
294 function Package_Specification_Of_Scope
(E
: Entity_Id
) return Node_Id
is
299 while Nkind
(N
) /= N_Package_Specification
loop
304 end Package_Specification_Of_Scope
;
306 --------------------------
307 -- Process_Partition_ID --
308 --------------------------
310 procedure Process_Partition_Id
(N
: Node_Id
) is
311 Loc
: constant Source_Ptr
:= Sloc
(N
);
314 Get_Pt_Id_Call
: Node_Id
;
315 Prefix_String
: String_Id
;
316 Typ
: constant Entity_Id
:= Etype
(N
);
319 -- In case prefix is not a library unit entity, get the entity
322 Ety
:= Entity
(Prefix
(N
));
323 while (Present
(Scope
(Ety
))
324 and then Scope
(Ety
) /= Standard_Standard
)
325 and not Is_Child_Unit
(Ety
)
330 -- Retrieve the proper function to call
332 if Is_Remote_Call_Interface
(Ety
) then
333 Get_Pt_Id
:= New_Occurrence_Of
334 (RTE
(RE_Get_Active_Partition_Id
), Loc
);
336 elsif Is_Shared_Passive
(Ety
) then
337 Get_Pt_Id
:= New_Occurrence_Of
338 (RTE
(RE_Get_Passive_Partition_Id
), Loc
);
341 Get_Pt_Id
:= New_Occurrence_Of
342 (RTE
(RE_Get_Local_Partition_Id
), Loc
);
345 -- Get and store the String_Id corresponding to the name of the
346 -- library unit whose Partition_Id is needed.
348 Get_Library_Unit_Name_String
(Unit_Declaration_Node
(Ety
));
349 Prefix_String
:= String_From_Name_Buffer
;
351 -- Build the function call which will replace the attribute
353 if Is_Remote_Call_Interface
(Ety
)
354 or else Is_Shared_Passive
(Ety
)
357 Make_Function_Call
(Loc
,
359 Parameter_Associations
=>
360 New_List
(Make_String_Literal
(Loc
, Prefix_String
)));
363 Get_Pt_Id_Call
:= Make_Function_Call
(Loc
, Get_Pt_Id
);
366 -- Replace the attribute node by a conversion of the function call
367 -- to the target type.
369 Rewrite
(N
, Convert_To
(Typ
, Get_Pt_Id_Call
));
370 Analyze_And_Resolve
(N
, Typ
);
371 end Process_Partition_Id
;
373 ----------------------------------
374 -- Process_Remote_AST_Attribute --
375 ----------------------------------
377 procedure Process_Remote_AST_Attribute
379 New_Type
: Entity_Id
)
381 Loc
: constant Source_Ptr
:= Sloc
(N
);
382 Remote_Subp
: Entity_Id
;
383 Tick_Access_Conv_Call
: Node_Id
;
384 Remote_Subp_Decl
: Node_Id
;
385 RS_Pkg_Specif
: Node_Id
;
386 RS_Pkg_E
: Entity_Id
;
387 RAS_Type
: Entity_Id
:= New_Type
;
389 All_Calls_Remote_E
: Entity_Id
;
390 Attribute_Subp
: Entity_Id
;
393 -- Check if we have to expand the access attribute
395 Remote_Subp
:= Entity
(Prefix
(N
));
397 if not Expander_Active
or else Get_PCS_Name
= Name_No_DSA
then
401 if Ekind
(RAS_Type
) /= E_Record_Type
then
402 RAS_Type
:= Equivalent_Type
(RAS_Type
);
405 Attribute_Subp
:= TSS
(RAS_Type
, TSS_RAS_Access
);
406 pragma Assert
(Present
(Attribute_Subp
));
407 Remote_Subp_Decl
:= Unit_Declaration_Node
(Remote_Subp
);
409 if Nkind
(Remote_Subp_Decl
) = N_Subprogram_Body
then
410 Remote_Subp
:= Corresponding_Spec
(Remote_Subp_Decl
);
411 Remote_Subp_Decl
:= Unit_Declaration_Node
(Remote_Subp
);
414 RS_Pkg_Specif
:= Parent
(Remote_Subp_Decl
);
415 RS_Pkg_E
:= Defining_Entity
(RS_Pkg_Specif
);
418 Boolean_Literals
(Ekind
(Remote_Subp
) = E_Procedure
419 and then Is_Asynchronous
(Remote_Subp
));
421 All_Calls_Remote_E
:=
422 Boolean_Literals
(Has_All_Calls_Remote
(RS_Pkg_E
));
424 Tick_Access_Conv_Call
:=
425 Make_Function_Call
(Loc
,
426 Name
=> New_Occurrence_Of
(Attribute_Subp
, Loc
),
427 Parameter_Associations
=>
429 Make_String_Literal
(Loc
,
430 Strval
=> Full_Qualified_Name
(RS_Pkg_E
)),
431 Build_Subprogram_Id
(Loc
, Remote_Subp
),
432 New_Occurrence_Of
(Async_E
, Loc
),
433 New_Occurrence_Of
(All_Calls_Remote_E
, Loc
)));
435 Rewrite
(N
, Tick_Access_Conv_Call
);
436 Analyze_And_Resolve
(N
, RAS_Type
);
437 end Process_Remote_AST_Attribute
;
439 ------------------------------------
440 -- Process_Remote_AST_Declaration --
441 ------------------------------------
443 procedure Process_Remote_AST_Declaration
(N
: Node_Id
) is
444 Loc
: constant Source_Ptr
:= Sloc
(N
);
445 User_Type
: constant Node_Id
:= Defining_Identifier
(N
);
446 Scop
: constant Entity_Id
:= Scope
(User_Type
);
447 Is_RCI
: constant Boolean := Is_Remote_Call_Interface
(Scop
);
448 Is_RT
: constant Boolean := Is_Remote_Types
(Scop
);
449 Type_Def
: constant Node_Id
:= Type_Definition
(N
);
452 Is_Degenerate
: Boolean;
453 -- True iff this RAS has an access formal parameter (see
454 -- Exp_Dist.Add_RAS_Dereference_TSS for details).
456 Subpkg
: constant Entity_Id
:=
457 Make_Defining_Identifier
(Loc
,
458 New_Internal_Name
('S'));
459 Subpkg_Decl
: Node_Id
;
460 Subpkg_Body
: Node_Id
;
461 Vis_Decls
: constant List_Id
:= New_List
;
462 Priv_Decls
: constant List_Id
:= New_List
;
464 Obj_Type
: constant Entity_Id
:=
465 Make_Defining_Identifier
(Loc
,
466 New_External_Name
(Chars
(User_Type
), 'R'));
468 Full_Obj_Type
: constant Entity_Id
:=
469 Make_Defining_Identifier
(Loc
,
472 RACW_Type
: constant Entity_Id
:=
473 Make_Defining_Identifier
(Loc
,
474 New_External_Name
(Chars
(User_Type
), 'P'));
476 Fat_Type
: constant Entity_Id
:=
477 Make_Defining_Identifier
(Loc
,
480 Fat_Type_Decl
: Node_Id
;
483 Is_Degenerate
:= False;
484 Parameter
:= First
(Parameter_Specifications
(Type_Def
));
485 while Present
(Parameter
) loop
486 if Nkind
(Parameter_Type
(Parameter
)) = N_Access_Definition
then
487 Error_Msg_N
("formal parameter& has anonymous access type?",
488 Defining_Identifier
(Parameter
));
489 Is_Degenerate
:= True;
496 if Is_Degenerate
then
498 ("remote access-to-subprogram type& can only be null?",
499 Defining_Identifier
(Parameter
), User_Type
);
501 -- The only legal value for a RAS with a formal parameter of an
502 -- anonymous access type is null, because it cannot be subtype-
503 -- conformant with any legal remote subprogram declaration. In this
504 -- case, we cannot generate a corresponding primitive operation.
508 if Get_PCS_Name
= Name_No_DSA
then
512 -- The tagged private type, primitive operation and RACW type associated
513 -- with a RAS need to all be declared in a subpackage of the one that
514 -- contains the RAS declaration, because the primitive of the object
515 -- type, and the associated primitive of the stub type, need to be
516 -- dispatching operations of these types, and the profile of the RAS
517 -- might contain tagged types declared in the same scope.
519 Append_To
(Vis_Decls
,
520 Make_Private_Type_Declaration
(Loc
,
521 Defining_Identifier
=> Obj_Type
,
522 Abstract_Present
=> True,
523 Tagged_Present
=> True,
524 Limited_Present
=> True));
526 Append_To
(Priv_Decls
,
527 Make_Full_Type_Declaration
(Loc
,
528 Defining_Identifier
=> Full_Obj_Type
,
530 Make_Record_Definition
(Loc
,
531 Abstract_Present
=> True,
532 Tagged_Present
=> True,
533 Limited_Present
=> True,
534 Null_Present
=> True,
535 Component_List
=> Empty
)));
537 -- Trick semantic analysis into swapping the public and full view when
538 -- freezing the public view.
540 Set_Comes_From_Source
(Full_Obj_Type
, True);
542 if not Is_Degenerate
then
543 Append_To
(Vis_Decls
,
544 Make_Abstract_Subprogram_Declaration
(Loc
,
545 Specification
=> Build_RAS_Primitive_Specification
(
546 Subp_Spec
=> Type_Def
,
547 Remote_Object_Type
=> Obj_Type
)));
550 Append_To
(Vis_Decls
,
551 Make_Full_Type_Declaration
(Loc
,
552 Defining_Identifier
=> RACW_Type
,
554 Make_Access_To_Object_Definition
(Loc
,
556 Subtype_Indication
=>
557 Make_Attribute_Reference
(Loc
,
558 Prefix
=> New_Occurrence_Of
(Obj_Type
, Loc
),
559 Attribute_Name
=> Name_Class
))));
561 Set_Is_Remote_Call_Interface
(RACW_Type
, Is_RCI
);
562 Set_Is_Remote_Types
(RACW_Type
, Is_RT
);
565 Make_Package_Declaration
(Loc
,
566 Make_Package_Specification
(Loc
,
567 Defining_Unit_Name
=> Subpkg
,
568 Visible_Declarations
=> Vis_Decls
,
569 Private_Declarations
=> Priv_Decls
,
570 End_Label
=> New_Occurrence_Of
(Subpkg
, Loc
)));
572 Set_Is_Remote_Call_Interface
(Subpkg
, Is_RCI
);
573 Set_Is_Remote_Types
(Subpkg
, Is_RT
);
574 Insert_After_And_Analyze
(N
, Subpkg_Decl
);
576 -- Generate package body to receive RACW calling stubs
578 -- Note: Analyze_Declarations has an absolute requirement that the
579 -- declaration list be non-empty, so provide dummy null statement here.
582 Make_Package_Body
(Loc
,
583 Defining_Unit_Name
=> Make_Defining_Identifier
(Loc
, Chars
(Subpkg
)),
584 Declarations
=> New_List
(Make_Null_Statement
(Loc
)));
585 Insert_After_And_Analyze
(Subpkg_Decl
, Subpkg_Body
);
587 -- Many parts of the analyzer and expander expect
588 -- that the fat pointer type used to implement remote
589 -- access to subprogram types be a record.
590 -- Note: The structure of this type must be kept consistent
591 -- with the code generated by Remote_AST_Null_Value for the
592 -- corresponding 'null' expression.
594 Fat_Type_Decl
:= Make_Full_Type_Declaration
(Loc
,
595 Defining_Identifier
=> Fat_Type
,
597 Make_Record_Definition
(Loc
,
599 Make_Component_List
(Loc
,
600 Component_Items
=> New_List
(
601 Make_Component_Declaration
(Loc
,
602 Defining_Identifier
=>
603 Make_Defining_Identifier
(Loc
, Name_Ras
),
604 Component_Definition
=>
605 Make_Component_Definition
(Loc
,
606 Aliased_Present
=> False,
607 Subtype_Indication
=>
608 New_Occurrence_Of
(RACW_Type
, Loc
)))))));
610 Set_Equivalent_Type
(User_Type
, Fat_Type
);
611 Set_Corresponding_Remote_Type
(Fat_Type
, User_Type
);
612 Insert_After_And_Analyze
(Subpkg_Body
, Fat_Type_Decl
);
614 -- The reason we suppress the initialization procedure is that we know
615 -- that no initialization is required (even if Initialize_Scalars mode
616 -- is active), and there are order of elaboration problems if we do try
617 -- to generate an init proc for this created record type.
619 Set_Suppress_Init_Proc
(Fat_Type
);
621 if Expander_Active
then
622 Add_RAST_Features
(Parent
(User_Type
));
624 end Process_Remote_AST_Declaration
;
626 -----------------------
627 -- RAS_E_Dereference --
628 -----------------------
630 procedure RAS_E_Dereference
(Pref
: Node_Id
) is
631 Loc
: constant Source_Ptr
:= Sloc
(Pref
);
633 New_Type
: constant Entity_Id
:= Etype
(Pref
);
634 Explicit_Deref
: constant Node_Id
:= Parent
(Pref
);
635 Deref_Subp_Call
: constant Node_Id
:= Parent
(Explicit_Deref
);
636 Deref_Proc
: Entity_Id
;
640 if Nkind
(Deref_Subp_Call
) = N_Procedure_Call_Statement
then
641 Params
:= Parameter_Associations
(Deref_Subp_Call
);
643 if Present
(Params
) then
644 Prepend
(Pref
, Params
);
646 Params
:= New_List
(Pref
);
649 elsif Nkind
(Deref_Subp_Call
) = N_Indexed_Component
then
650 Params
:= Expressions
(Deref_Subp_Call
);
652 if Present
(Params
) then
653 Prepend
(Pref
, Params
);
655 Params
:= New_List
(Pref
);
659 -- Context is not a call
664 if not Expander_Active
or else Get_PCS_Name
= Name_No_DSA
then
668 Deref_Proc
:= TSS
(New_Type
, TSS_RAS_Dereference
);
669 pragma Assert
(Present
(Deref_Proc
));
671 if Ekind
(Deref_Proc
) = E_Function
then
673 Make_Function_Call
(Loc
,
674 Name
=> New_Occurrence_Of
(Deref_Proc
, Loc
),
675 Parameter_Associations
=> Params
);
678 Make_Procedure_Call_Statement
(Loc
,
679 Name
=> New_Occurrence_Of
(Deref_Proc
, Loc
),
680 Parameter_Associations
=> Params
);
683 Rewrite
(Deref_Subp_Call
, Call_Node
);
684 Analyze
(Deref_Subp_Call
);
685 end RAS_E_Dereference
;
687 ------------------------------
688 -- Remote_AST_E_Dereference --
689 ------------------------------
691 function Remote_AST_E_Dereference
(P
: Node_Id
) return Boolean is
692 ET
: constant Entity_Id
:= Etype
(P
);
695 -- Perform the changes only on original dereferences, and only if
696 -- we are generating code.
698 if Comes_From_Source
(P
)
699 and then Is_Record_Type
(ET
)
700 and then (Is_Remote_Call_Interface
(ET
)
701 or else Is_Remote_Types
(ET
))
702 and then Present
(Corresponding_Remote_Type
(ET
))
703 and then Nkind_In
(Parent
(Parent
(P
)), N_Procedure_Call_Statement
,
705 and then Expander_Active
707 RAS_E_Dereference
(P
);
712 end Remote_AST_E_Dereference
;
714 ------------------------------
715 -- Remote_AST_I_Dereference --
716 ------------------------------
718 function Remote_AST_I_Dereference
(P
: Node_Id
) return Boolean is
719 ET
: constant Entity_Id
:= Etype
(P
);
723 if Comes_From_Source
(P
)
724 and then (Is_Remote_Call_Interface
(ET
)
725 or else Is_Remote_Types
(ET
))
726 and then Present
(Corresponding_Remote_Type
(ET
))
727 and then Ekind
(Entity
(P
)) /= E_Function
730 Make_Explicit_Dereference
(Sloc
(P
),
731 Prefix
=> Relocate_Node
(P
));
734 RAS_E_Dereference
(Prefix
(P
));
739 end Remote_AST_I_Dereference
;
741 ---------------------------
742 -- Remote_AST_Null_Value --
743 ---------------------------
745 function Remote_AST_Null_Value
747 Typ
: Entity_Id
) return Boolean
749 Loc
: constant Source_Ptr
:= Sloc
(N
);
750 Target_Type
: Entity_Id
;
753 if not Expander_Active
or else Get_PCS_Name
= Name_No_DSA
then
756 elsif Ekind
(Typ
) = E_Access_Subprogram_Type
757 and then (Is_Remote_Call_Interface
(Typ
)
758 or else Is_Remote_Types
(Typ
))
759 and then Comes_From_Source
(N
)
760 and then Expander_Active
762 -- Any null that comes from source and is of the RAS type must
763 -- be expanded, except if expansion is not active (nothing
764 -- gets expanded into the equivalent record type).
766 Target_Type
:= Equivalent_Type
(Typ
);
768 elsif Ekind
(Typ
) = E_Record_Type
769 and then Present
(Corresponding_Remote_Type
(Typ
))
771 -- This is a record type representing a RAS type, this must be
777 -- We do not have to handle this case
784 Component_Associations
=> New_List
(
785 Make_Component_Association
(Loc
,
786 Choices
=> New_List
(Make_Identifier
(Loc
, Name_Ras
)),
787 Expression
=> Make_Null
(Loc
)))));
788 Analyze_And_Resolve
(N
, Target_Type
);
790 end Remote_AST_Null_Value
;