1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2009, 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
) or else Is_Shared_Passive
(Ety
) then
355 Make_Function_Call
(Loc
,
357 Parameter_Associations
=>
358 New_List
(Make_String_Literal
(Loc
, Prefix_String
)));
361 Get_Pt_Id_Call
:= Make_Function_Call
(Loc
, Get_Pt_Id
);
364 -- Replace the attribute node by a conversion of the function call
365 -- to the target type.
367 Rewrite
(N
, Convert_To
(Typ
, Get_Pt_Id_Call
));
368 Analyze_And_Resolve
(N
, Typ
);
369 end Process_Partition_Id
;
371 ----------------------------------
372 -- Process_Remote_AST_Attribute --
373 ----------------------------------
375 procedure Process_Remote_AST_Attribute
377 New_Type
: Entity_Id
)
379 Loc
: constant Source_Ptr
:= Sloc
(N
);
380 Remote_Subp
: Entity_Id
;
381 Tick_Access_Conv_Call
: Node_Id
;
382 Remote_Subp_Decl
: Node_Id
;
383 RS_Pkg_Specif
: Node_Id
;
384 RS_Pkg_E
: Entity_Id
;
385 RAS_Type
: Entity_Id
:= New_Type
;
387 All_Calls_Remote_E
: Entity_Id
;
388 Attribute_Subp
: Entity_Id
;
391 -- Check if we have to expand the access attribute
393 Remote_Subp
:= Entity
(Prefix
(N
));
395 if not Expander_Active
or else Get_PCS_Name
= Name_No_DSA
then
399 if Ekind
(RAS_Type
) /= E_Record_Type
then
400 RAS_Type
:= Equivalent_Type
(RAS_Type
);
403 Attribute_Subp
:= TSS
(RAS_Type
, TSS_RAS_Access
);
404 pragma Assert
(Present
(Attribute_Subp
));
405 Remote_Subp_Decl
:= Unit_Declaration_Node
(Remote_Subp
);
407 if Nkind
(Remote_Subp_Decl
) = N_Subprogram_Body
then
408 Remote_Subp
:= Corresponding_Spec
(Remote_Subp_Decl
);
409 Remote_Subp_Decl
:= Unit_Declaration_Node
(Remote_Subp
);
412 RS_Pkg_Specif
:= Parent
(Remote_Subp_Decl
);
413 RS_Pkg_E
:= Defining_Entity
(RS_Pkg_Specif
);
416 Boolean_Literals
(Ekind
(Remote_Subp
) = E_Procedure
417 and then Is_Asynchronous
(Remote_Subp
));
419 All_Calls_Remote_E
:=
420 Boolean_Literals
(Has_All_Calls_Remote
(RS_Pkg_E
));
422 Tick_Access_Conv_Call
:=
423 Make_Function_Call
(Loc
,
424 Name
=> New_Occurrence_Of
(Attribute_Subp
, Loc
),
425 Parameter_Associations
=>
427 Make_String_Literal
(Loc
,
428 Strval
=> Full_Qualified_Name
(RS_Pkg_E
)),
429 Build_Subprogram_Id
(Loc
, Remote_Subp
),
430 New_Occurrence_Of
(Async_E
, Loc
),
431 New_Occurrence_Of
(All_Calls_Remote_E
, Loc
)));
433 Rewrite
(N
, Tick_Access_Conv_Call
);
434 Analyze_And_Resolve
(N
, RAS_Type
);
435 end Process_Remote_AST_Attribute
;
437 ------------------------------------
438 -- Process_Remote_AST_Declaration --
439 ------------------------------------
441 procedure Process_Remote_AST_Declaration
(N
: Node_Id
) is
442 Loc
: constant Source_Ptr
:= Sloc
(N
);
443 User_Type
: constant Node_Id
:= Defining_Identifier
(N
);
444 Scop
: constant Entity_Id
:= Scope
(User_Type
);
445 Is_RCI
: constant Boolean := Is_Remote_Call_Interface
(Scop
);
446 Is_RT
: constant Boolean := Is_Remote_Types
(Scop
);
447 Type_Def
: constant Node_Id
:= Type_Definition
(N
);
450 Is_Degenerate
: Boolean;
451 -- True iff this RAS has an access formal parameter (see
452 -- Exp_Dist.Add_RAS_Dereference_TSS for details).
454 Subpkg
: constant Entity_Id
:= Make_Temporary
(Loc
, 'S');
455 Subpkg_Decl
: Node_Id
;
456 Subpkg_Body
: Node_Id
;
457 Vis_Decls
: constant List_Id
:= New_List
;
458 Priv_Decls
: constant List_Id
:= New_List
;
460 Obj_Type
: constant Entity_Id
:=
461 Make_Defining_Identifier
(Loc
,
462 New_External_Name
(Chars
(User_Type
), 'R'));
464 Full_Obj_Type
: constant Entity_Id
:=
465 Make_Defining_Identifier
(Loc
, Chars
(Obj_Type
));
467 RACW_Type
: constant Entity_Id
:=
468 Make_Defining_Identifier
(Loc
,
469 New_External_Name
(Chars
(User_Type
), 'P'));
471 Fat_Type
: constant Entity_Id
:=
472 Make_Defining_Identifier
(Loc
, Chars
(User_Type
));
474 Fat_Type_Decl
: Node_Id
;
477 Is_Degenerate
:= False;
478 Parameter
:= First
(Parameter_Specifications
(Type_Def
));
479 while Present
(Parameter
) loop
480 if Nkind
(Parameter_Type
(Parameter
)) = N_Access_Definition
then
481 Error_Msg_N
("formal parameter& has anonymous access type?",
482 Defining_Identifier
(Parameter
));
483 Is_Degenerate
:= True;
490 if Is_Degenerate
then
492 ("remote access-to-subprogram type& can only be null?",
493 Defining_Identifier
(Parameter
), User_Type
);
495 -- The only legal value for a RAS with a formal parameter of an
496 -- anonymous access type is null, because it cannot be subtype-
497 -- conformant with any legal remote subprogram declaration. In this
498 -- case, we cannot generate a corresponding primitive operation.
502 if Get_PCS_Name
= Name_No_DSA
then
506 -- The tagged private type, primitive operation and RACW type associated
507 -- with a RAS need to all be declared in a subpackage of the one that
508 -- contains the RAS declaration, because the primitive of the object
509 -- type, and the associated primitive of the stub type, need to be
510 -- dispatching operations of these types, and the profile of the RAS
511 -- might contain tagged types declared in the same scope.
513 Append_To
(Vis_Decls
,
514 Make_Private_Type_Declaration
(Loc
,
515 Defining_Identifier
=> Obj_Type
,
516 Abstract_Present
=> True,
517 Tagged_Present
=> True,
518 Limited_Present
=> True));
520 Append_To
(Priv_Decls
,
521 Make_Full_Type_Declaration
(Loc
,
522 Defining_Identifier
=> Full_Obj_Type
,
524 Make_Record_Definition
(Loc
,
525 Abstract_Present
=> True,
526 Tagged_Present
=> True,
527 Limited_Present
=> True,
528 Null_Present
=> True,
529 Component_List
=> Empty
)));
531 -- Trick semantic analysis into swapping the public and full view when
532 -- freezing the public view.
534 Set_Comes_From_Source
(Full_Obj_Type
, True);
536 if not Is_Degenerate
then
537 Append_To
(Vis_Decls
,
538 Make_Abstract_Subprogram_Declaration
(Loc
,
539 Specification
=> Build_RAS_Primitive_Specification
(
540 Subp_Spec
=> Type_Def
,
541 Remote_Object_Type
=> Obj_Type
)));
544 Append_To
(Vis_Decls
,
545 Make_Full_Type_Declaration
(Loc
,
546 Defining_Identifier
=> RACW_Type
,
548 Make_Access_To_Object_Definition
(Loc
,
550 Subtype_Indication
=>
551 Make_Attribute_Reference
(Loc
,
552 Prefix
=> New_Occurrence_Of
(Obj_Type
, Loc
),
553 Attribute_Name
=> Name_Class
))));
555 Set_Is_Remote_Call_Interface
(RACW_Type
, Is_RCI
);
556 Set_Is_Remote_Types
(RACW_Type
, Is_RT
);
559 Make_Package_Declaration
(Loc
,
560 Make_Package_Specification
(Loc
,
561 Defining_Unit_Name
=> Subpkg
,
562 Visible_Declarations
=> Vis_Decls
,
563 Private_Declarations
=> Priv_Decls
,
564 End_Label
=> New_Occurrence_Of
(Subpkg
, Loc
)));
566 Set_Is_Remote_Call_Interface
(Subpkg
, Is_RCI
);
567 Set_Is_Remote_Types
(Subpkg
, Is_RT
);
568 Insert_After_And_Analyze
(N
, Subpkg_Decl
);
570 -- Generate package body to receive RACW calling stubs
572 -- Note: Analyze_Declarations has an absolute requirement that the
573 -- declaration list be non-empty, so provide dummy null statement here.
576 Make_Package_Body
(Loc
,
577 Defining_Unit_Name
=> Make_Defining_Identifier
(Loc
, Chars
(Subpkg
)),
578 Declarations
=> New_List
(Make_Null_Statement
(Loc
)));
579 Insert_After_And_Analyze
(Subpkg_Decl
, Subpkg_Body
);
581 -- Many parts of the analyzer and expander expect
582 -- that the fat pointer type used to implement remote
583 -- access to subprogram types be a record.
584 -- Note: The structure of this type must be kept consistent
585 -- with the code generated by Remote_AST_Null_Value for the
586 -- corresponding 'null' expression.
588 Fat_Type_Decl
:= Make_Full_Type_Declaration
(Loc
,
589 Defining_Identifier
=> Fat_Type
,
591 Make_Record_Definition
(Loc
,
593 Make_Component_List
(Loc
,
594 Component_Items
=> New_List
(
595 Make_Component_Declaration
(Loc
,
596 Defining_Identifier
=>
597 Make_Defining_Identifier
(Loc
, Name_Ras
),
598 Component_Definition
=>
599 Make_Component_Definition
(Loc
,
600 Aliased_Present
=> False,
601 Subtype_Indication
=>
602 New_Occurrence_Of
(RACW_Type
, Loc
)))))));
604 Set_Equivalent_Type
(User_Type
, Fat_Type
);
605 Set_Corresponding_Remote_Type
(Fat_Type
, User_Type
);
606 Insert_After_And_Analyze
(Subpkg_Body
, Fat_Type_Decl
);
608 -- The reason we suppress the initialization procedure is that we know
609 -- that no initialization is required (even if Initialize_Scalars mode
610 -- is active), and there are order of elaboration problems if we do try
611 -- to generate an init proc for this created record type.
613 Set_Suppress_Init_Proc
(Fat_Type
);
615 if Expander_Active
then
616 Add_RAST_Features
(Parent
(User_Type
));
618 end Process_Remote_AST_Declaration
;
620 -----------------------
621 -- RAS_E_Dereference --
622 -----------------------
624 procedure RAS_E_Dereference
(Pref
: Node_Id
) is
625 Loc
: constant Source_Ptr
:= Sloc
(Pref
);
627 New_Type
: constant Entity_Id
:= Etype
(Pref
);
628 Explicit_Deref
: constant Node_Id
:= Parent
(Pref
);
629 Deref_Subp_Call
: constant Node_Id
:= Parent
(Explicit_Deref
);
630 Deref_Proc
: Entity_Id
;
634 if Nkind
(Deref_Subp_Call
) = N_Procedure_Call_Statement
then
635 Params
:= Parameter_Associations
(Deref_Subp_Call
);
637 if Present
(Params
) then
638 Prepend
(Pref
, Params
);
640 Params
:= New_List
(Pref
);
643 elsif Nkind
(Deref_Subp_Call
) = N_Indexed_Component
then
644 Params
:= Expressions
(Deref_Subp_Call
);
646 if Present
(Params
) then
647 Prepend
(Pref
, Params
);
649 Params
:= New_List
(Pref
);
653 -- Context is not a call
658 if not Expander_Active
or else Get_PCS_Name
= Name_No_DSA
then
662 Deref_Proc
:= TSS
(New_Type
, TSS_RAS_Dereference
);
663 pragma Assert
(Present
(Deref_Proc
));
665 if Ekind
(Deref_Proc
) = E_Function
then
667 Make_Function_Call
(Loc
,
668 Name
=> New_Occurrence_Of
(Deref_Proc
, Loc
),
669 Parameter_Associations
=> Params
);
672 Make_Procedure_Call_Statement
(Loc
,
673 Name
=> New_Occurrence_Of
(Deref_Proc
, Loc
),
674 Parameter_Associations
=> Params
);
677 Rewrite
(Deref_Subp_Call
, Call_Node
);
678 Analyze
(Deref_Subp_Call
);
679 end RAS_E_Dereference
;
681 ------------------------------
682 -- Remote_AST_E_Dereference --
683 ------------------------------
685 function Remote_AST_E_Dereference
(P
: Node_Id
) return Boolean is
686 ET
: constant Entity_Id
:= Etype
(P
);
689 -- Perform the changes only on original dereferences, and only if
690 -- we are generating code.
692 if Comes_From_Source
(P
)
693 and then Is_Record_Type
(ET
)
694 and then (Is_Remote_Call_Interface
(ET
)
695 or else Is_Remote_Types
(ET
))
696 and then Present
(Corresponding_Remote_Type
(ET
))
697 and then Nkind_In
(Parent
(Parent
(P
)), N_Procedure_Call_Statement
,
699 and then Expander_Active
701 RAS_E_Dereference
(P
);
706 end Remote_AST_E_Dereference
;
708 ------------------------------
709 -- Remote_AST_I_Dereference --
710 ------------------------------
712 function Remote_AST_I_Dereference
(P
: Node_Id
) return Boolean is
713 ET
: constant Entity_Id
:= Etype
(P
);
717 if Comes_From_Source
(P
)
718 and then (Is_Remote_Call_Interface
(ET
)
719 or else Is_Remote_Types
(ET
))
720 and then Present
(Corresponding_Remote_Type
(ET
))
721 and then Ekind
(Entity
(P
)) /= E_Function
724 Make_Explicit_Dereference
(Sloc
(P
),
725 Prefix
=> Relocate_Node
(P
));
728 RAS_E_Dereference
(Prefix
(P
));
733 end Remote_AST_I_Dereference
;
735 ---------------------------
736 -- Remote_AST_Null_Value --
737 ---------------------------
739 function Remote_AST_Null_Value
741 Typ
: Entity_Id
) return Boolean
743 Loc
: constant Source_Ptr
:= Sloc
(N
);
744 Target_Type
: Entity_Id
;
747 if not Expander_Active
or else Get_PCS_Name
= Name_No_DSA
then
750 elsif Ekind
(Typ
) = E_Access_Subprogram_Type
751 and then (Is_Remote_Call_Interface
(Typ
)
752 or else Is_Remote_Types
(Typ
))
753 and then Comes_From_Source
(N
)
754 and then Expander_Active
756 -- Any null that comes from source and is of the RAS type must
757 -- be expanded, except if expansion is not active (nothing
758 -- gets expanded into the equivalent record type).
760 Target_Type
:= Equivalent_Type
(Typ
);
762 elsif Ekind
(Typ
) = E_Record_Type
763 and then Present
(Corresponding_Remote_Type
(Typ
))
765 -- This is a record type representing a RAS type, this must be
771 -- We do not have to handle this case
778 Component_Associations
=> New_List
(
779 Make_Component_Association
(Loc
,
780 Choices
=> New_List
(Make_Identifier
(Loc
, Name_Ras
)),
781 Expression
=> Make_Null
(Loc
)))));
782 Analyze_And_Resolve
(N
, Target_Type
);
784 end Remote_AST_Null_Value
;