1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2005, 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 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 ------------------------------------------------------------------------------
27 with Atree
; use Atree
;
28 with Casing
; use Casing
;
29 with Debug
; use Debug
;
30 with Einfo
; use Einfo
;
31 with Errout
; use Errout
;
32 with Exp_Ch7
; use Exp_Ch7
;
33 with Exp_Util
; use Exp_Util
;
34 with Hostparm
; use Hostparm
;
35 with Namet
; use Namet
;
36 with Nlists
; use Nlists
;
37 with Nmake
; use Nmake
;
39 with Rtsfind
; use Rtsfind
;
40 with Restrict
; use Restrict
;
41 with Rident
; use Rident
;
43 with Sem_Ch8
; use Sem_Ch8
;
44 with Sem_Res
; use Sem_Res
;
45 with Sem_Util
; use Sem_Util
;
46 with Sinfo
; use Sinfo
;
47 with Sinput
; use Sinput
;
48 with Snames
; use Snames
;
49 with Stand
; use Stand
;
50 with Stringt
; use Stringt
;
51 with Targparm
; use Targparm
;
52 with Tbuild
; use Tbuild
;
53 with Uintp
; use Uintp
;
55 package body Exp_Ch11
is
57 ---------------------------
58 -- Expand_At_End_Handler --
59 ---------------------------
61 -- For a handled statement sequence that has a cleanup (At_End_Proc
62 -- field set), an exception handler of the following form is required:
69 -- Note: this exception handler is treated rather specially by
70 -- subsequent expansion in two respects:
72 -- The normal call to Undefer_Abort is omitted
73 -- The raise call does not do Defer_Abort
75 -- This is because the current tasking code seems to assume that
76 -- the call to the cleanup routine that is made from an exception
77 -- handler for the abort signal is called with aborts deferred.
79 -- This expansion is only done if we have front end exception handling.
80 -- If we have back end exception handling, then the AT END handler is
81 -- left alone, and cleanups (including the exceptional case) are handled
84 -- In the front end case, the exception handler described above handles
85 -- the exceptional case. The AT END handler is left in the generated tree
86 -- and the code generator (e.g. gigi) must still handle proper generation
87 -- of cleanup calls for the non-exceptional case.
89 procedure Expand_At_End_Handler
(HSS
: Node_Id
; Block
: Node_Id
) is
90 Clean
: constant Entity_Id
:= Entity
(At_End_Proc
(HSS
));
91 Loc
: constant Source_Ptr
:= Sloc
(Clean
);
96 pragma Assert
(Present
(Clean
));
97 pragma Assert
(No
(Exception_Handlers
(HSS
)));
99 -- Don't expand if back end exception handling active
101 if Exception_Mechanism
= Back_End_Exceptions
then
105 -- Don't expand an At End handler if we have already had configurable
106 -- run-time violations, since likely this will just be a matter of
107 -- generating useless cascaded messages
109 if Configurable_Run_Time_Violations
> 0 then
113 if Restriction_Active
(No_Exception_Handlers
) then
117 if Present
(Block
) then
122 Make_Others_Choice
(Loc
);
123 Set_All_Others
(Ohandle
);
126 Make_Procedure_Call_Statement
(Loc
,
127 Name
=> New_Occurrence_Of
(Clean
, Loc
)),
128 Make_Raise_Statement
(Loc
));
130 Set_Exception_Handlers
(HSS
, New_List
(
131 Make_Exception_Handler
(Loc
,
132 Exception_Choices
=> New_List
(Ohandle
),
133 Statements
=> Stmnts
)));
135 Analyze_List
(Stmnts
, Suppress
=> All_Checks
);
136 Expand_Exception_Handlers
(HSS
);
138 if Present
(Block
) then
141 end Expand_At_End_Handler
;
143 -------------------------------
144 -- Expand_Exception_Handlers --
145 -------------------------------
147 procedure Expand_Exception_Handlers
(HSS
: Node_Id
) is
148 Handlrs
: constant List_Id
:= Exception_Handlers
(HSS
);
151 Others_Choice
: Boolean;
154 procedure Prepend_Call_To_Handler
156 Args
: List_Id
:= No_List
);
157 -- Routine to prepend a call to the procedure referenced by Proc at
158 -- the start of the handler code for the current Handler.
160 -----------------------------
161 -- Prepend_Call_To_Handler --
162 -----------------------------
164 procedure Prepend_Call_To_Handler
166 Args
: List_Id
:= No_List
)
168 Ent
: constant Entity_Id
:= RTE
(Proc
);
171 -- If we have no Entity, then we are probably in no run time mode
172 -- or some weird error has occured. In either case do do nothing!
174 if Present
(Ent
) then
176 Call
: constant Node_Id
:=
177 Make_Procedure_Call_Statement
(Loc
,
178 Name
=> New_Occurrence_Of
(RTE
(Proc
), Loc
),
179 Parameter_Associations
=> Args
);
182 Prepend_To
(Statements
(Handler
), Call
);
183 Analyze
(Call
, Suppress
=> All_Checks
);
186 end Prepend_Call_To_Handler
;
188 -- Start of processing for Expand_Exception_Handlers
191 -- Loop through handlers
193 Handler
:= First_Non_Pragma
(Handlrs
);
194 Handler_Loop
: while Present
(Handler
) loop
195 Loc
:= Sloc
(Handler
);
197 -- Remove source handler if gnat debug flag N is set
199 if Debug_Flag_Dot_X
and then Comes_From_Source
(Handler
) then
201 H
: constant Node_Id
:= Handler
;
203 Next_Non_Pragma
(Handler
);
205 goto Continue_Handler_Loop
;
209 -- If an exception occurrence is present, then we must declare it
210 -- and initialize it from the value stored in the TSD
213 -- name : Exception_Occurrence;
216 -- Save_Occurrence (name, Get_Current_Excep.all)
220 if Present
(Choice_Parameter
(Handler
)) then
222 Cparm
: constant Entity_Id
:= Choice_Parameter
(Handler
);
223 Clc
: constant Source_Ptr
:= Sloc
(Cparm
);
228 Make_Procedure_Call_Statement
(Loc
,
230 New_Occurrence_Of
(RTE
(RE_Save_Occurrence
), Loc
),
231 Parameter_Associations
=> New_List
(
232 New_Occurrence_Of
(Cparm
, Clc
),
233 Make_Explicit_Dereference
(Loc
,
234 Make_Function_Call
(Loc
,
235 Name
=> Make_Explicit_Dereference
(Loc
,
237 (RTE
(RE_Get_Current_Excep
), Loc
))))));
239 Mark_Rewrite_Insertion
(Save
);
240 Prepend
(Save
, Statements
(Handler
));
243 Make_Object_Declaration
(Clc
,
244 Defining_Identifier
=> Cparm
,
247 (RTE
(RE_Exception_Occurrence
), Clc
));
248 Set_No_Initialization
(Obj_Decl
, True);
251 Make_Exception_Handler
(Loc
,
252 Exception_Choices
=> Exception_Choices
(Handler
),
254 Statements
=> New_List
(
255 Make_Block_Statement
(Loc
,
256 Declarations
=> New_List
(Obj_Decl
),
257 Handled_Statement_Sequence
=>
258 Make_Handled_Sequence_Of_Statements
(Loc
,
259 Statements
=> Statements
(Handler
))))));
261 Analyze_List
(Statements
(Handler
), Suppress
=> All_Checks
);
265 -- The processing at this point is rather different for the
266 -- JVM case, so we completely separate the processing.
268 -- For the JVM case, we unconditionally call Update_Exception,
269 -- passing a call to the intrinsic function Current_Target_Exception
270 -- (see JVM version of Ada.Exceptions in 4jexcept.adb for details).
272 if Hostparm
.Java_VM
then
274 Arg
: constant Node_Id
:=
275 Make_Function_Call
(Loc
,
276 Name
=> New_Occurrence_Of
277 (RTE
(RE_Current_Target_Exception
), Loc
));
279 Prepend_Call_To_Handler
(RE_Update_Exception
, New_List
(Arg
));
282 -- For the normal case, we have to worry about the state of abort
283 -- deferral. Generally, we defer abort during runtime handling of
284 -- exceptions. When control is passed to the handler, then in the
285 -- normal case we undefer aborts. In any case this entire handling
286 -- is relevant only if aborts are allowed!
288 elsif Abort_Allowed
then
290 -- There are some special cases in which we do not do the
291 -- undefer. In particular a finalization (AT END) handler
292 -- wants to operate with aborts still deferred.
294 -- We also suppress the call if this is the special handler
295 -- for Abort_Signal, since if we are aborting, we want to keep
296 -- aborts deferred (one abort is enough thank you very much :-)
298 -- If abort really needs to be deferred the expander must add
299 -- this call explicitly, see Exp_Ch9.Expand_N_Asynchronous_Select.
302 Nkind
(First
(Exception_Choices
(Handler
))) = N_Others_Choice
;
305 or else Entity
(First
(Exception_Choices
(Handler
))) /=
309 and then All_Others
(First
(Exception_Choices
(Handler
))))
310 and then Abort_Allowed
312 Prepend_Call_To_Handler
(RE_Abort_Undefer
);
316 Next_Non_Pragma
(Handler
);
318 <<Continue_Handler_Loop
>>
320 end loop Handler_Loop
;
322 -- If all handlers got removed by gnatdN, then remove the list
325 and then Is_Empty_List
(Exception_Handlers
(HSS
))
327 Set_Exception_Handlers
(HSS
, No_List
);
329 end Expand_Exception_Handlers
;
331 ------------------------------------
332 -- Expand_N_Exception_Declaration --
333 ------------------------------------
336 -- exceptE : constant String := "A.B.EXCEP"; -- static data
337 -- except : exception_data := (
338 -- Handled_By_Other => False,
340 -- Name_Length => exceptE'Length,
341 -- Full_Name => exceptE'Address,
342 -- HTable_Ptr => null,
344 -- Raise_Hook => null,
347 -- (protecting test only needed if not at library level)
349 -- exceptF : Boolean := True -- static data
352 -- Register_Exception (except'Unchecked_Access);
355 procedure Expand_N_Exception_Declaration
(N
: Node_Id
) is
356 Loc
: constant Source_Ptr
:= Sloc
(N
);
357 Id
: constant Entity_Id
:= Defining_Identifier
(N
);
358 L
: List_Id
:= New_List
;
361 Name_Exname
: constant Name_Id
:= New_External_Name
(Chars
(Id
), 'E');
362 Exname
: constant Node_Id
:=
363 Make_Defining_Identifier
(Loc
, Name_Exname
);
366 -- There is no expansion needed when compiling for the JVM since the
367 -- JVM has a built-in exception mechanism. See 4jexcept.ads for details.
369 if Hostparm
.Java_VM
then
373 -- Definition of the external name: nam : constant String := "A.B.NAME";
376 Make_Object_Declaration
(Loc
,
377 Defining_Identifier
=> Exname
,
378 Constant_Present
=> True,
379 Object_Definition
=> New_Occurrence_Of
(Standard_String
, Loc
),
380 Expression
=> Make_String_Literal
(Loc
, Full_Qualified_Name
(Id
))));
382 Set_Is_Statically_Allocated
(Exname
);
384 -- Create the aggregate list for type Standard.Exception_Type:
385 -- Handled_By_Other component: False
387 Append_To
(L
, New_Occurrence_Of
(Standard_False
, Loc
));
389 -- Lang component: 'A'
392 Make_Character_Literal
(Loc
,
394 Char_Literal_Value
=> UI_From_Int
(Character'Pos ('A'))));
396 -- Name_Length component: Nam'Length
399 Make_Attribute_Reference
(Loc
,
400 Prefix
=> New_Occurrence_Of
(Exname
, Loc
),
401 Attribute_Name
=> Name_Length
));
403 -- Full_Name component: Standard.A_Char!(Nam'Address)
405 Append_To
(L
, Unchecked_Convert_To
(Standard_A_Char
,
406 Make_Attribute_Reference
(Loc
,
407 Prefix
=> New_Occurrence_Of
(Exname
, Loc
),
408 Attribute_Name
=> Name_Address
)));
410 -- HTable_Ptr component: null
412 Append_To
(L
, Make_Null
(Loc
));
414 -- Import_Code component: 0
416 Append_To
(L
, Make_Integer_Literal
(Loc
, 0));
418 -- Raise_Hook component: null
420 Append_To
(L
, Make_Null
(Loc
));
422 Set_Expression
(N
, Make_Aggregate
(Loc
, Expressions
=> L
));
423 Analyze_And_Resolve
(Expression
(N
), Etype
(Id
));
425 -- Register_Exception (except'Unchecked_Access);
427 if not Restriction_Active
(No_Exception_Handlers
)
428 and then not Restriction_Active
(No_Exception_Registration
)
431 Make_Procedure_Call_Statement
(Loc
,
432 Name
=> New_Occurrence_Of
(RTE
(RE_Register_Exception
), Loc
),
433 Parameter_Associations
=> New_List
(
434 Unchecked_Convert_To
(RTE
(RE_Exception_Data_Ptr
),
435 Make_Attribute_Reference
(Loc
,
436 Prefix
=> New_Occurrence_Of
(Id
, Loc
),
437 Attribute_Name
=> Name_Unrestricted_Access
)))));
439 Set_Register_Exception_Call
(Id
, First
(L
));
441 if not Is_Library_Level_Entity
(Id
) then
442 Flag_Id
:= Make_Defining_Identifier
(Loc
,
443 New_External_Name
(Chars
(Id
), 'F'));
446 Make_Object_Declaration
(Loc
,
447 Defining_Identifier
=> Flag_Id
,
449 New_Occurrence_Of
(Standard_Boolean
, Loc
),
451 New_Occurrence_Of
(Standard_True
, Loc
)));
453 Set_Is_Statically_Allocated
(Flag_Id
);
456 Make_Assignment_Statement
(Loc
,
457 Name
=> New_Occurrence_Of
(Flag_Id
, Loc
),
458 Expression
=> New_Occurrence_Of
(Standard_False
, Loc
)));
460 Insert_After_And_Analyze
(N
,
461 Make_Implicit_If_Statement
(N
,
462 Condition
=> New_Occurrence_Of
(Flag_Id
, Loc
),
463 Then_Statements
=> L
));
466 Insert_List_After_And_Analyze
(N
, L
);
470 end Expand_N_Exception_Declaration
;
472 ---------------------------------------------
473 -- Expand_N_Handled_Sequence_Of_Statements --
474 ---------------------------------------------
476 procedure Expand_N_Handled_Sequence_Of_Statements
(N
: Node_Id
) is
478 if Present
(Exception_Handlers
(N
))
479 and then not Restriction_Active
(No_Exception_Handlers
)
481 Expand_Exception_Handlers
(N
);
484 -- The following code needs comments ???
486 if Nkind
(Parent
(N
)) /= N_Package_Body
487 and then Nkind
(Parent
(N
)) /= N_Accept_Statement
488 and then not Delay_Cleanups
(Current_Scope
)
490 Expand_Cleanup_Actions
(Parent
(N
));
492 Set_First_Real_Statement
(N
, First
(Statements
(N
)));
495 end Expand_N_Handled_Sequence_Of_Statements
;
497 -------------------------------------
498 -- Expand_N_Raise_Constraint_Error --
499 -------------------------------------
501 -- The only processing required is to adjust the condition to deal
502 -- with the C/Fortran boolean case. This may well not be necessary,
503 -- as all such conditions are generated by the expander and probably
504 -- are all standard boolean, but who knows what strange optimization
505 -- in future may require this adjustment!
507 procedure Expand_N_Raise_Constraint_Error
(N
: Node_Id
) is
509 Adjust_Condition
(Condition
(N
));
510 end Expand_N_Raise_Constraint_Error
;
512 ----------------------------------
513 -- Expand_N_Raise_Program_Error --
514 ----------------------------------
516 -- The only processing required is to adjust the condition to deal
517 -- with the C/Fortran boolean case. This may well not be necessary,
518 -- as all such conditions are generated by the expander and probably
519 -- are all standard boolean, but who knows what strange optimization
520 -- in future may require this adjustment!
522 procedure Expand_N_Raise_Program_Error
(N
: Node_Id
) is
524 Adjust_Condition
(Condition
(N
));
525 end Expand_N_Raise_Program_Error
;
527 ------------------------------
528 -- Expand_N_Raise_Statement --
529 ------------------------------
531 procedure Expand_N_Raise_Statement
(N
: Node_Id
) is
532 Loc
: constant Source_Ptr
:= Sloc
(N
);
538 -- If a string expression is present, then the raise statement is
539 -- converted to a call:
541 -- Raise_Exception (exception-name'Identity, string);
543 -- and there is nothing else to do
545 if Present
(Expression
(N
)) then
547 Make_Procedure_Call_Statement
(Loc
,
548 Name
=> New_Occurrence_Of
(RTE
(RE_Raise_Exception
), Loc
),
549 Parameter_Associations
=> New_List
(
550 Make_Attribute_Reference
(Loc
,
552 Attribute_Name
=> Name_Identity
),
558 -- Remaining processing is for the case where no string expression
561 -- There is no expansion needed for statement "raise <exception>;" when
562 -- compiling for the JVM since the JVM has a built-in exception
563 -- mechanism. However we need the keep the expansion for "raise;"
564 -- statements. See 4jexcept.ads for details.
566 if Present
(Name
(N
)) and then Hostparm
.Java_VM
then
570 -- Don't expand a raise statement that does not come from source
571 -- if we have already had configurable run-time violations, since
572 -- most likely it will be junk cascaded nonsense.
574 if Configurable_Run_Time_Violations
> 0
575 and then not Comes_From_Source
(N
)
580 -- Convert explicit raise of Program_Error, Constraint_Error, and
581 -- Storage_Error into the corresponding raise (in High_Integrity_Mode
582 -- all other raises will get normal expansion and be disallowed,
583 -- but this is also faster in all modes).
585 if Present
(Name
(N
)) and then Nkind
(Name
(N
)) = N_Identifier
then
586 if Entity
(Name
(N
)) = Standard_Constraint_Error
then
588 Make_Raise_Constraint_Error
(Loc
,
589 Reason
=> CE_Explicit_Raise
));
593 elsif Entity
(Name
(N
)) = Standard_Program_Error
then
595 Make_Raise_Program_Error
(Loc
,
596 Reason
=> PE_Explicit_Raise
));
600 elsif Entity
(Name
(N
)) = Standard_Storage_Error
then
602 Make_Raise_Storage_Error
(Loc
,
603 Reason
=> SE_Explicit_Raise
));
609 -- Case of name present, in this case we expand raise name to
611 -- Raise_Exception (name'Identity, location_string);
613 -- where location_string identifies the file/line of the raise
615 if Present
(Name
(N
)) then
617 Id
: Entity_Id
:= Entity
(Name
(N
));
620 Build_Location_String
(Loc
);
622 -- If the exception is a renaming, use the exception that it
623 -- renames (which might be a predefined exception, e.g.).
625 if Present
(Renamed_Object
(Id
)) then
626 Id
:= Renamed_Object
(Id
);
629 -- Build a C-compatible string in case of no exception handlers,
630 -- since this is what the last chance handler is expecting.
632 if Restriction_Active
(No_Exception_Handlers
) then
634 -- Generate an empty message if configuration pragma
635 -- Suppress_Exception_Locations is set for this unit.
637 if Opt
.Exception_Locations_Suppressed
then
640 Name_Len
:= Name_Len
+ 1;
643 Name_Buffer
(Name_Len
) := ASCII
.NUL
;
646 if Opt
.Exception_Locations_Suppressed
then
650 Str
:= String_From_Name_Buffer
;
652 -- For VMS exceptions, convert the raise into a call to
653 -- lib$stop so it will be handled by __gnat_error_handler.
655 if Is_VMS_Exception
(Id
) then
657 Excep_Image
: String_Id
;
661 if Present
(Interface_Name
(Id
)) then
662 Excep_Image
:= Strval
(Interface_Name
(Id
));
664 Get_Name_String
(Chars
(Id
));
666 Excep_Image
:= String_From_Name_Buffer
;
669 if Exception_Code
(Id
) /= No_Uint
then
671 Make_Integer_Literal
(Loc
, Exception_Code
(Id
));
674 Unchecked_Convert_To
(Standard_Integer
,
675 Make_Function_Call
(Loc
,
676 Name
=> New_Occurrence_Of
677 (RTE
(RE_Import_Value
), Loc
),
678 Parameter_Associations
=> New_List
679 (Make_String_Literal
(Loc
,
680 Strval
=> Excep_Image
))));
684 Make_Procedure_Call_Statement
(Loc
,
686 New_Occurrence_Of
(RTE
(RE_Lib_Stop
), Loc
),
687 Parameter_Associations
=> New_List
(Cond
)));
688 Analyze_And_Resolve
(Cond
, Standard_Integer
);
691 -- Not VMS exception case, convert raise to call to the
692 -- Raise_Exception routine.
696 Make_Procedure_Call_Statement
(Loc
,
697 Name
=> New_Occurrence_Of
(RTE
(RE_Raise_Exception
), Loc
),
698 Parameter_Associations
=> New_List
(
699 Make_Attribute_Reference
(Loc
,
701 Attribute_Name
=> Name_Identity
),
702 Make_String_Literal
(Loc
,
707 -- Case of no name present (reraise). We rewrite the raise to:
709 -- Reraise_Occurrence_Always (EO);
711 -- where EO is the current exception occurrence. If the current handler
712 -- does not have a choice parameter specification, then we provide one.
715 -- Find innermost enclosing exception handler (there must be one,
716 -- since the semantics has already verified that this raise statement
717 -- is valid, and a raise with no arguments is only permitted in the
718 -- context of an exception handler.
721 while Nkind
(Ehand
) /= N_Exception_Handler
loop
722 Ehand
:= Parent
(Ehand
);
725 -- Make exception choice parameter if none present. Note that we do
726 -- not need to put the entity on the entity chain, since no one will
727 -- be referencing this entity by normal visibility methods.
729 if No
(Choice_Parameter
(Ehand
)) then
730 E
:= Make_Defining_Identifier
(Loc
, New_Internal_Name
('E'));
731 Set_Choice_Parameter
(Ehand
, E
);
732 Set_Ekind
(E
, E_Variable
);
733 Set_Etype
(E
, RTE
(RE_Exception_Occurrence
));
734 Set_Scope
(E
, Current_Scope
);
737 -- Now rewrite the raise as a call to Reraise. A special case arises
738 -- if this raise statement occurs in the context of a handler for
739 -- all others (i.e. an at end handler). in this case we avoid
740 -- the call to defer abort, cleanup routines are expected to be
741 -- called in this case with aborts deferred.
744 Ech
: constant Node_Id
:= First
(Exception_Choices
(Ehand
));
748 if Nkind
(Ech
) = N_Others_Choice
749 and then All_Others
(Ech
)
751 Ent
:= RTE
(RE_Reraise_Occurrence_No_Defer
);
753 Ent
:= RTE
(RE_Reraise_Occurrence_Always
);
757 Make_Procedure_Call_Statement
(Loc
,
758 Name
=> New_Occurrence_Of
(Ent
, Loc
),
759 Parameter_Associations
=> New_List
(
760 New_Occurrence_Of
(Choice_Parameter
(Ehand
), Loc
))));
765 end Expand_N_Raise_Statement
;
767 ----------------------------------
768 -- Expand_N_Raise_Storage_Error --
769 ----------------------------------
771 -- The only processing required is to adjust the condition to deal
772 -- with the C/Fortran boolean case. This may well not be necessary,
773 -- as all such conditions are generated by the expander and probably
774 -- are all standard boolean, but who knows what strange optimization
775 -- in future may require this adjustment!
777 procedure Expand_N_Raise_Storage_Error
(N
: Node_Id
) is
779 Adjust_Condition
(Condition
(N
));
780 end Expand_N_Raise_Storage_Error
;
782 ------------------------------
783 -- Expand_N_Subprogram_Info --
784 ------------------------------
786 procedure Expand_N_Subprogram_Info
(N
: Node_Id
) is
787 Loc
: constant Source_Ptr
:= Sloc
(N
);
790 -- For now, we replace an Expand_N_Subprogram_Info node with an
791 -- attribute reference that gives the address of the procedure.
792 -- This is because gigi does not yet recognize this node, and
793 -- for the initial targets, this is the right value anyway.
796 Make_Attribute_Reference
(Loc
,
797 Prefix
=> Identifier
(N
),
798 Attribute_Name
=> Name_Code_Address
));
800 Analyze_And_Resolve
(N
, RTE
(RE_Code_Loc
));
801 end Expand_N_Subprogram_Info
;
803 ----------------------
804 -- Is_Non_Ada_Error --
805 ----------------------
807 function Is_Non_Ada_Error
(E
: Entity_Id
) return Boolean is
809 if not OpenVMS_On_Target
then
813 Get_Name_String
(Chars
(E
));
815 -- Note: it is a little irregular for the body of exp_ch11 to know
816 -- the details of the encoding scheme for names, but on the other
817 -- hand, gigi knows them, and this is for gigi's benefit anyway!
819 if Name_Buffer
(1 .. 30) /= "system__aux_dec__non_ada_error" then
824 end Is_Non_Ada_Error
;