1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
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 -- 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 Elists; use Elists;
32 with Errout; use Errout;
33 with Exp_Ch7; use Exp_Ch7;
34 with Exp_Util; use Exp_Util;
35 with Hostparm; use Hostparm;
36 with Namet; use Namet;
37 with Nlists; use Nlists;
38 with Nmake; use Nmake;
40 with Rtsfind; use Rtsfind;
41 with Restrict; use Restrict;
42 with Rident; use Rident;
44 with Sem_Ch8; use Sem_Ch8;
45 with Sem_Res; use Sem_Res;
46 with Sem_Util; use Sem_Util;
47 with Sinfo; use Sinfo;
48 with Sinput; use Sinput;
49 with Snames; use Snames;
50 with Stand; use Stand;
51 with Stringt; use Stringt;
52 with Targparm; use Targparm;
53 with Tbuild; use Tbuild;
54 with Uintp; use Uintp;
56 package body Exp_Ch11 is
58 -----------------------
59 -- Local Subprograms --
60 -----------------------
62 function Find_Local_Handler
64 Nod : Node_Id) return Node_Id;
65 pragma Warnings (Off, Find_Local_Handler);
66 -- This function searches for a local exception handler that will handle
67 -- the exception named by Ename. If such a local hander exists, then the
68 -- corresponding N_Exception_Handler is returned. If no such handler is
69 -- found then Empty is returned. In order to match and return True, the
70 -- handler may not have a choice parameter specification. N is the raise
71 -- node that references the handler.
73 procedure Warn_If_No_Propagation (N : Node_Id);
74 -- Called for an exception raise that is not a local raise (and thus can
75 -- not be optimized to a goto. Issues warning if No_Exception_Propagation
76 -- restriction is set. N is the node for the raise or equivalent call.
78 ---------------------------
79 -- Expand_At_End_Handler --
80 ---------------------------
82 -- For a handled statement sequence that has a cleanup (At_End_Proc
83 -- field set), an exception handler of the following form is required:
90 -- Note: this exception handler is treated rather specially by
91 -- subsequent expansion in two respects:
93 -- The normal call to Undefer_Abort is omitted
94 -- The raise call does not do Defer_Abort
96 -- This is because the current tasking code seems to assume that
97 -- the call to the cleanup routine that is made from an exception
98 -- handler for the abort signal is called with aborts deferred.
100 -- This expansion is only done if we have front end exception handling.
101 -- If we have back end exception handling, then the AT END handler is
102 -- left alone, and cleanups (including the exceptional case) are handled
105 -- In the front end case, the exception handler described above handles
106 -- the exceptional case. The AT END handler is left in the generated tree
107 -- and the code generator (e.g. gigi) must still handle proper generation
108 -- of cleanup calls for the non-exceptional case.
110 procedure Expand_At_End_Handler (HSS : Node_Id; Block : Node_Id) is
111 Clean : constant Entity_Id := Entity (At_End_Proc (HSS));
112 Loc : constant Source_Ptr := Sloc (Clean);
117 pragma Assert (Present (Clean));
118 pragma Assert (No (Exception_Handlers (HSS)));
120 -- Don't expand if back end exception handling active
122 if Exception_Mechanism = Back_End_Exceptions then
126 -- Don't expand an At End handler if we have already had configurable
127 -- run-time violations, since likely this will just be a matter of
128 -- generating useless cascaded messages
130 if Configurable_Run_Time_Violations > 0 then
134 if Restriction_Active (No_Exception_Handlers) then
138 if Present (Block) then
143 Make_Others_Choice (Loc);
144 Set_All_Others (Ohandle);
147 Make_Procedure_Call_Statement (Loc,
148 Name => New_Occurrence_Of (Clean, Loc)),
149 Make_Raise_Statement (Loc));
151 Set_Exception_Handlers (HSS, New_List (
152 Make_Implicit_Exception_Handler (Loc,
153 Exception_Choices => New_List (Ohandle),
154 Statements => Stmnts)));
156 Analyze_List (Stmnts, Suppress => All_Checks);
157 Expand_Exception_Handlers (HSS);
159 if Present (Block) then
162 end Expand_At_End_Handler;
164 -------------------------------
165 -- Expand_Exception_Handlers --
166 -------------------------------
168 procedure Expand_Exception_Handlers (HSS : Node_Id) is
169 Handlrs : constant List_Id := Exception_Handlers (HSS);
170 Loc : constant Source_Ptr := Sloc (HSS);
172 Others_Choice : Boolean;
174 Next_Handler : Node_Id;
176 procedure Expand_Local_Exception_Handlers;
177 -- This procedure handles the expansion of exception handlers for the
178 -- optimization of local raise statements into goto statements.
180 procedure Prepend_Call_To_Handler
182 Args : List_Id := No_List);
183 -- Routine to prepend a call to the procedure referenced by Proc at
184 -- the start of the handler code for the current Handler.
186 procedure Replace_Raise_By_Goto (Raise_S : Node_Id; Goto_L1 : Node_Id);
187 -- Raise_S is a raise statement (possibly expanded, and possibly of the
188 -- form of a Raise_xxx_Error node with a condition. This procedure is
189 -- called to replace the raise action with the (already analyzed) goto
190 -- statement passed as Goto_L1. This procedure also takes care of the
191 -- requirement of inserting a Local_Raise call where possible.
193 -------------------------------------
194 -- Expand_Local_Exception_Handlers --
195 -------------------------------------
197 -- There are two cases for this transformation. First the case of
198 -- explicit raise statements. For this case, the transformation we do
199 -- looks like this. Right now we have for example (where L1,L2 are
204 -- raise_exception (excep1'identity); -- was raise excep1
206 -- raise_exception (excep2'identity); -- was raise excep2
215 -- This gets transformed into:
224 -- local_raise (excep1'Identity); -- was raise excep1
227 -- local_raise (excep2'Identity); -- was raise excep2
237 -- goto L3; -- skip handler when exception not raised
239 -- <<L1>> -- target label for local exception
249 -- Note: the reason we wrap the original statement sequence in an
250 -- inner block is that there may be raise statements within the
251 -- sequence of statements in the handlers, and we must ensure that
252 -- these are properly handled, and in particular, such raise statements
253 -- must not reenter the same exception handlers.
255 -- If the restriction No_Exception_Propagation is in effect, then we
256 -- can omit the exception handlers, and we do not need the inner block.
264 -- local_raise (excep1'Identity); -- was raise excep1
267 -- local_raise (excep2'Identity); -- was raise excep2
271 -- goto L3; -- skip handler when exception not raised
273 -- <<L1>> -- target label for local exception
283 -- The second case is for exceptions generated by the back end in one
284 -- of three situations:
286 -- 1. Front end generates N_Raise_xxx_Error node
287 -- 2. Front end sets Do_xxx_Check flag in subexpression node
288 -- 3. Back end detects a situation where an exception is appropriate
290 -- In all these cases, the current processing in gigi is to generate a
291 -- call to the appropriate Rcheck_xx routine (where xx encodes both the
292 -- exception message and the exception to be raised, Constraint_Error,
293 -- Program_Error, or Storage_Error.
295 -- We could handle some subcases of 1 using the same front end expansion
296 -- into gotos, but even for case 1, we can't handle all cases, since
297 -- generating gotos in the middle of expressions is not possible (it's
298 -- possible at the gigi/gcc level, but not at the level of the GNAT
301 -- In any case, it seems easier to have a scheme which handles all three
302 -- cases in a uniform manner. So here is how we proceed in this case.
304 -- This procedure detects all handlers for these three exceptions,
305 -- Constraint_Error, Program_Error and Storage_Error (including WHEN
306 -- OTHERS handlers that cover one or more of these cases).
308 -- If the handler meets the requirements for being the target of a local
309 -- raise, then the front end does the expansion described previously,
310 -- creating a label to be used as a goto target to raise the exception.
311 -- However, no attempt is made in the front end to convert any related
312 -- raise statements into gotos, e.g. all Raise_xxx_Error nodes are left
313 -- unchanged and passed to the back end.
315 -- Instead, the front end generates two nodes
317 -- N_Push_Constraint_Error_Label
318 -- N_Push_Program_Error_Label
319 -- N_Push_Storage_Error_Label
321 -- The Push node is generated at the start of the statements
322 -- covered by the handler, and has as a parameter the label to be
323 -- used as the raise target.
325 -- N_Pop_Constraint_Error_Label
326 -- N_Pop_Program_Error_Label
327 -- N_Pop_Storage_Error_Label
329 -- The Pop node is generated at the end of the covered statements
330 -- and undoes the effect of the preceding corresponding Push node.
332 -- In the case where the handler does NOT meet the requirements, the
333 -- front end will still generate the Push and Pop nodes, but the label
334 -- field in the Push node will be empty signifying that for this region
335 -- of code, no optimization is possible.
337 -- The back end must maintain three stacks, one for each exception case,
338 -- the Push node pushes an entry onto the corresponding stack, and pop
339 -- node pops off the entry. Then instead of calling Rcheck_nn, if the
340 -- corresponding top stack entry has an non-empty label, a goto is
341 -- generated instead of the call. This goto should be preceded by a
342 -- call to Local_Raise as described above.
344 -- An example of this transformation is as follows, given:
347 -- A : Integer range 1 .. 10;
351 -- when Constraint_Error =>
355 -- gets transformed to:
358 -- A : Integer range 1 .. 10;
365 -- %push_constraint_error_label (L1)
366 -- R1b : constant long_long_integer := long_long_integer?(b) +
367 -- long_long_integer?(c);
368 -- [constraint_error when
369 -- not (R1b in -16#8000_0000# .. 16#7FFF_FFFF#)
370 -- "overflow check failed"]
371 -- a := integer?(R1b);
372 -- %pop_constraint_error_Label
376 -- when constraint_error =>
380 -- goto L2; -- skip handler when exception not raised
381 -- <<L1>> -- target label for local exception
386 CE_Locally_Handled : Boolean := False;
387 SE_Locally_Handled : Boolean := False;
388 PE_Locally_Handled : Boolean := False;
389 -- These three flags indicate whether a handler for the corresponding
390 -- exception (CE=Constraint_Error, SE=Storage_Error, PE=Program_Error)
391 -- is present. If so the switch is set to True, the Exception_Label
392 -- field of the corresponding handler is set, and appropriate Push
393 -- and Pop nodes are inserted into the code.
395 Local_Expansion_Required : Boolean := False;
396 -- Set True if we have at least one handler requiring local raise
397 -- expansion as described above.
399 procedure Expand_Local_Exception_Handlers is
401 procedure Add_Exception_Label (H : Node_Id);
402 -- H is an exception handler. First check for an Exception_Label
403 -- already allocated for H. If not, allocate one, set the field in
404 -- the handler node, add the label declaration, and set the flag
405 -- Local_Expansion_Required. Note: if Local_Handlers_Not_OK is set
406 -- the call has no effect and Exception_Label is left empty.
408 procedure Add_Label_Declaration (L : Entity_Id);
409 -- Add an implicit declaration of the given label to the declaration
410 -- list in the parent of the current sequence of handled statements.
413 Exc_Locally_Handled : in out Boolean;
414 -- Flag indicating whether a local handler for this exception
415 -- has already been generated.
417 with function Make_Push_Label (Loc : Source_Ptr) return Node_Id;
418 -- Function to create a Push_xxx_Label node
420 with function Make_Pop_Label (Loc : Source_Ptr) return Node_Id;
421 -- Function to create a Pop_xxx_Label node
423 procedure Generate_Push_Pop (H : Node_Id);
424 -- Common code for Generate_Push_Pop_xxx below, used to generate an
425 -- exception label and Push/Pop nodes for Constraint_Error,
426 -- Program_Error, or Storage_Error.
428 -------------------------
429 -- Add_Exception_Label --
430 -------------------------
432 procedure Add_Exception_Label (H : Node_Id) is
434 if No (Exception_Label (H))
435 and then not Local_Raise_Not_OK (H)
437 Local_Expansion_Required := True;
440 L : constant Entity_Id :=
441 Make_Defining_Identifier (Sloc (H),
442 Chars => New_Internal_Name ('L'));
444 Set_Exception_Label (H, L);
445 Add_Label_Declaration (L);
448 end Add_Exception_Label;
450 ---------------------------
451 -- Add_Label_Declaration --
452 ---------------------------
454 procedure Add_Label_Declaration (L : Entity_Id) is
455 P : constant Node_Id := Parent (HSS);
457 Decl_L : constant Node_Id :=
458 Make_Implicit_Label_Declaration (Loc,
459 Defining_Identifier => L);
462 if Declarations (P) = No_List then
463 Set_Declarations (P, Empty_List);
466 Append (Decl_L, Declarations (P));
468 end Add_Label_Declaration;
470 -----------------------
471 -- Generate_Push_Pop --
472 -----------------------
474 procedure Generate_Push_Pop (H : Node_Id) is
476 if Exc_Locally_Handled then
479 Exc_Locally_Handled := True;
482 Add_Exception_Label (H);
485 F : constant Node_Id := First (Statements (HSS));
486 L : constant Node_Id := Last (Statements (HSS));
488 Push : constant Node_Id := Make_Push_Label (Sloc (F));
489 Pop : constant Node_Id := Make_Pop_Label (Sloc (L));
492 Set_Exception_Label (Push, Exception_Label (H));
494 Insert_Before (F, Push);
497 Insert_After (L, Pop);
500 end Generate_Push_Pop;
502 -- Local declarations
504 Loc : constant Source_Ptr := Sloc (HSS);
508 procedure Generate_Push_Pop_For_Constraint_Error is
509 new Generate_Push_Pop
510 (Exc_Locally_Handled => CE_Locally_Handled,
511 Make_Push_Label => Make_Push_Constraint_Error_Label,
512 Make_Pop_Label => Make_Pop_Constraint_Error_Label);
513 -- If no Push/Pop has been generated for CE yet, then set the flag
514 -- CE_Locally_Handled, allocate an Exception_Label for handler H (if
515 -- not already done), and generate Push/Pop nodes for the exception
516 -- label at the start and end of the statements of HSS.
518 procedure Generate_Push_Pop_For_Program_Error is
519 new Generate_Push_Pop
520 (Exc_Locally_Handled => PE_Locally_Handled,
521 Make_Push_Label => Make_Push_Program_Error_Label,
522 Make_Pop_Label => Make_Pop_Program_Error_Label);
523 -- If no Push/Pop has been generated for PE yet, then set the flag
524 -- PE_Locally_Handled, allocate an Exception_Label for handler H (if
525 -- not already done), and generate Push/Pop nodes for the exception
526 -- label at the start and end of the statements of HSS.
528 procedure Generate_Push_Pop_For_Storage_Error is
529 new Generate_Push_Pop
530 (Exc_Locally_Handled => SE_Locally_Handled,
531 Make_Push_Label => Make_Push_Storage_Error_Label,
532 Make_Pop_Label => Make_Pop_Storage_Error_Label);
533 -- If no Push/Pop has been generated for SE yet, then set the flag
534 -- SE_Locally_Handled, allocate an Exception_Label for handler H (if
535 -- not already done), and generate Push/Pop nodes for the exception
536 -- label at the start and end of the statements of HSS.
539 -- See if we have any potential local raises to expand
541 Handler := First_Non_Pragma (Handlrs);
542 while Present (Handler) loop
544 -- Note, we do not test Local_Raise_Not_OK here, because in the
545 -- case of Push/Pop generation we want to generate push with a
546 -- null label. The Add_Exception_Label routine has no effect if
547 -- Local_Raise_Not_OK is set, so this works as required.
549 if Present (Local_Raise_Statements (Handler)) then
550 Add_Exception_Label (Handler);
553 -- If we are doing local raise to goto optimization (restriction
554 -- No_Exception_Propagation set or debug flag .g set), then check
555 -- to see if handler handles CE,PE,SE and if so generate the
556 -- appropriate push/pop sequences for the back end
559 or else Restriction_Active (No_Exception_Propagation)
561 Choice := First (Exception_Choices (Handler));
562 while Present (Choice) loop
563 if Nkind (Choice) = N_Others_Choice then
564 Generate_Push_Pop_For_Constraint_Error (Handler);
565 Generate_Push_Pop_For_Program_Error (Handler);
566 Generate_Push_Pop_For_Storage_Error (Handler);
568 elsif Is_Entity_Name (Choice) then
569 if Entity (Choice) = Standard_Constraint_Error then
570 Generate_Push_Pop_For_Constraint_Error (Handler);
571 elsif Entity (Choice) = Standard_Program_Error then
572 Generate_Push_Pop_For_Program_Error (Handler);
573 elsif Entity (Choice) = Standard_Storage_Error then
574 Generate_Push_Pop_For_Storage_Error (Handler);
582 Next_Non_Pragma (Handler);
585 -- Nothing to do if no handlers requiring the goto transformation
587 if not (Local_Expansion_Required) then
591 -- Prepare to do the transformation
594 L3_Dent : constant Entity_Id :=
595 Make_Defining_Identifier (Loc,
596 Chars => New_Internal_Name ('L'));
598 Labl_L3 : constant Node_Id :=
600 Identifier => New_Occurrence_Of (L3_Dent, Loc));
607 Add_Label_Declaration (L3_Dent);
609 -- If the No_Exception_Propagation restriction is not active,
610 -- then we must wrap the existing statements and exception
611 -- handlers in an inner block.
613 if not Restriction_Active (No_Exception_Propagation) then
614 Old_HSS := Relocate_Node (HSS);
616 -- Construct and analyze the block with a dummy HSS inside it
617 -- for now (if we do the analyze call with the real HSS in
618 -- place we have nasty recursion problems).
621 Make_Block_Statement (Loc,
622 Handled_Statement_Sequence =>
623 Make_Handled_Sequence_Of_Statements (Loc,
624 Statements => Empty_List));
627 Make_Handled_Sequence_Of_Statements (Loc,
628 Statements => New_List (Blk_Stm)));
631 -- Now we can set the real statement sequence in place
633 Set_Handled_Statement_Sequence (Blk_Stm, Old_HSS);
636 -- Now loop through the exception handlers to deal with those that
637 -- are targets of local raise statements.
639 Handler := First_Non_Pragma (Handlrs);
640 while Present (Handler) loop
641 if Present (Exception_Label (Handler)) then
643 -- This handler needs the goto expansion
646 Loc : constant Source_Ptr := Sloc (Handler);
648 L1_Dent : constant Entity_Id := Exception_Label (Handler);
650 Labl_L1 : constant Node_Id :=
653 New_Occurrence_Of (L1_Dent, Loc));
655 Name_L1 : constant Node_Id :=
656 New_Occurrence_Of (L1_Dent, Loc);
658 Goto_L1 : constant Node_Id :=
659 Make_Goto_Statement (Loc,
662 Name_L3 : constant Node_Id :=
663 New_Occurrence_Of (L3_Dent, Loc);
665 Goto_L3 : constant Node_Id :=
666 Make_Goto_Statement (Loc,
669 H_Stmts : constant List_Id := Statements (Handler);
672 -- Replace handler by a goto L1. We can mark this as
673 -- analyzed since it is fully formed, and we don't
674 -- want it going through any further checks.
676 Set_Statements (Handler, New_List (Goto_L1));
677 Set_Analyzed (Goto_L1);
678 Set_Etype (Name_L1, Standard_Void_Type);
680 -- Now replace all the raise statements by goto L1
682 if Present (Local_Raise_Statements (Handler)) then
683 Relmt := First_Elmt (Local_Raise_Statements (Handler));
684 while Present (Relmt) loop
686 Raise_S : constant Node_Id := Node (Relmt);
688 Name_L1 : constant Node_Id :=
689 New_Occurrence_Of (L1_Dent, Loc);
691 Goto_L1 : constant Node_Id :=
692 Make_Goto_Statement (Loc,
696 -- Replace raise by goto L1
698 Set_Analyzed (Goto_L1);
699 Set_Etype (Name_L1, Standard_Void_Type);
700 Replace_Raise_By_Goto (Raise_S, Goto_L1);
707 -- Add goto L3 at end of statement list in block. The
708 -- first time, this is what skips over the exception
709 -- handlers in the normal case. Subsequent times, it
710 -- terminates the execution of the handler code, and
711 -- skips subsequent handlers.
713 Stmts := Statements (HSS);
715 Insert_After (Last (Stmts), Goto_L3);
716 Set_Analyzed (Goto_L3);
717 Set_Etype (Name_L3, Standard_Void_Type);
719 -- Now we drop the label that marks the handler start,
720 -- followed by the statements of the handler.
722 Set_Etype (Identifier (Labl_L1), Standard_Void_Type);
724 Insert_After_And_Analyze (Last (Stmts), Labl_L1);
725 Insert_List_After (Last (Stmts), H_Stmts);
728 -- Here if we have local raise statements but the handler is
729 -- not suitable for processing with a local raise. In this
730 -- case we have to delete the Local_Raise call and also
731 -- generate possible diagnostics.
734 Relmt := First_Elmt (Local_Raise_Statements (Handler));
735 while Present (Relmt) loop
736 Warn_If_No_Propagation (Node (Relmt));
737 Remove (Prev (Node (Relmt)));
745 -- Only remaining step is to drop the L3 label and we are done
747 Set_Etype (Identifier (Labl_L3), Standard_Void_Type);
748 Insert_After_And_Analyze (Last (Stmts), Labl_L3);
751 end Expand_Local_Exception_Handlers;
753 -----------------------------
754 -- Prepend_Call_To_Handler --
755 -----------------------------
757 procedure Prepend_Call_To_Handler
759 Args : List_Id := No_List)
761 Ent : constant Entity_Id := RTE (Proc);
764 -- If we have no Entity, then we are probably in no run time mode
765 -- or some weird error has occured. In either case do do nothing!
767 if Present (Ent) then
769 Call : constant Node_Id :=
770 Make_Procedure_Call_Statement (Loc,
771 Name => New_Occurrence_Of (RTE (Proc), Loc),
772 Parameter_Associations => Args);
775 Prepend_To (Statements (Handler), Call);
776 Analyze (Call, Suppress => All_Checks);
779 end Prepend_Call_To_Handler;
781 ---------------------------
782 -- Replace_Raise_By_Goto --
783 ---------------------------
785 procedure Replace_Raise_By_Goto (Raise_S : Node_Id; Goto_L1 : Node_Id) is
786 Loc : constant Source_Ptr := Sloc (Raise_S);
793 -- If we have a null statement, it means that there is no replacement
794 -- needed (typically this results from a suppressed check).
796 if Nkind (Raise_S) = N_Null_Statement then
799 -- Test for Raise_xxx_Error
801 elsif Nkind (Raise_S) = N_Raise_Constraint_Error then
802 Excep := Standard_Constraint_Error;
803 Cond := Condition (Raise_S);
805 elsif Nkind (Raise_S) = N_Raise_Storage_Error then
806 Excep := Standard_Storage_Error;
807 Cond := Condition (Raise_S);
809 elsif Nkind (Raise_S) = N_Raise_Program_Error then
810 Excep := Standard_Program_Error;
811 Cond := Condition (Raise_S);
813 -- The only other possibility is a node that is or used to be
814 -- a simple raise statement.
817 Orig := Original_Node (Raise_S);
818 pragma Assert (Nkind (Orig) = N_Raise_Statement
819 and then Present (Name (Orig))
820 and then No (Expression (Orig)));
821 Excep := Entity (Name (Orig));
825 -- Here Excep is the exception to raise, and Cond is the condition
826 -- First prepare the call to Local_Raise (excep'Identity).
828 if RTE_Available (RE_Local_Raise) then
830 Make_Procedure_Call_Statement (Loc,
831 Name => New_Occurrence_Of (RTE (RE_Local_Raise), Loc),
832 Parameter_Associations => New_List (
833 Make_Attribute_Reference (Loc,
834 Prefix => New_Occurrence_Of (Excep, Loc),
835 Attribute_Name => Name_Identity)));
837 -- Use null statement if Local_Raise not available
841 Make_Null_Statement (Loc);
844 -- If there is no condition, we rewrite as
847 -- Local_Raise (excep'Identity);
853 Make_Block_Statement (Loc,
854 Handled_Statement_Sequence =>
855 Make_Handled_Sequence_Of_Statements (Loc,
856 Statements => New_List (LR, Goto_L1))));
858 -- If there is a condition, we rewrite as
861 -- Local_Raise (excep'Identity);
867 Make_If_Statement (Loc,
869 Then_Statements => New_List (LR, Goto_L1)));
873 end Replace_Raise_By_Goto;
875 -- Start of processing for Expand_Exception_Handlers
878 Expand_Local_Exception_Handlers;
880 -- Loop through handlers
882 Handler := First_Non_Pragma (Handlrs);
883 Handler_Loop : while Present (Handler) loop
884 Next_Handler := Next_Non_Pragma (Handler);
886 -- Remove source handler if gnat debug flag N is set
888 if Debug_Flag_Dot_X and then Comes_From_Source (Handler) then
891 -- Remove handler if no exception propagation, generating a warning
892 -- if a source generated handler was not the target of a local raise.
894 elsif Restriction_Active (No_Exception_Propagation) then
895 if No (Local_Raise_Statements (Handler))
896 and then Comes_From_Source (Handler)
897 and then Warn_On_Non_Local_Exception
900 ("?pragma Restrictions (No_Exception_Propagation) in effect",
903 ("\?this handler can never be entered, and has been removed",
909 -- Exception handler is active and retained and must be processed
912 -- If an exception occurrence is present, then we must declare it
913 -- and initialize it from the value stored in the TSD
916 -- name : Exception_Occurrence;
918 -- Save_Occurrence (name, Get_Current_Excep.all)
922 if Present (Choice_Parameter (Handler)) then
924 Cparm : constant Entity_Id := Choice_Parameter (Handler);
925 Clc : constant Source_Ptr := Sloc (Cparm);
930 Make_Procedure_Call_Statement (Loc,
932 New_Occurrence_Of (RTE (RE_Save_Occurrence), Loc),
933 Parameter_Associations => New_List (
934 New_Occurrence_Of (Cparm, Clc),
935 Make_Explicit_Dereference (Loc,
936 Make_Function_Call (Loc,
937 Name => Make_Explicit_Dereference (Loc,
939 (RTE (RE_Get_Current_Excep), Loc))))));
941 Mark_Rewrite_Insertion (Save);
942 Prepend (Save, Statements (Handler));
945 Make_Object_Declaration
947 Defining_Identifier => Cparm,
950 (RTE (RE_Exception_Occurrence), Clc));
951 Set_No_Initialization (Obj_Decl, True);
954 Make_Implicit_Exception_Handler (Loc,
955 Exception_Choices => Exception_Choices (Handler),
957 Statements => New_List (
958 Make_Block_Statement (Loc,
959 Declarations => New_List (Obj_Decl),
960 Handled_Statement_Sequence =>
961 Make_Handled_Sequence_Of_Statements (Loc,
962 Statements => Statements (Handler))))));
964 Analyze_List (Statements (Handler), Suppress => All_Checks);
968 -- The processing at this point is rather different for the JVM
969 -- case, so we completely separate the processing.
971 -- For the JVM case, we unconditionally call Update_Exception,
972 -- passing a call to the intrinsic Current_Target_Exception (see
973 -- JVM version of Ada.Exceptions in 4jexcept.adb for details).
975 if Hostparm.Java_VM then
977 Arg : constant Node_Id :=
978 Make_Function_Call (Loc,
981 (RTE (RE_Current_Target_Exception), Loc));
983 Prepend_Call_To_Handler
984 (RE_Update_Exception, New_List (Arg));
987 -- For the normal case, we have to worry about the state of
988 -- abort deferral. Generally, we defer abort during runtime
989 -- handling of exceptions. When control is passed to the
990 -- handler, then in the normal case we undefer aborts. In any
991 -- case this entire handling is relevant only if aborts are
994 elsif Abort_Allowed then
996 -- There are some special cases in which we do not do the
997 -- undefer. In particular a finalization (AT END) handler
998 -- wants to operate with aborts still deferred.
1000 -- We also suppress the call if this is the special handler
1001 -- for Abort_Signal, since if we are aborting, we want to keep
1002 -- aborts deferred (one abort is enough thank you very much :-)
1004 -- If abort really needs to be deferred the expander must add
1005 -- this call explicitly, see Expand_N_Asynchronous_Select.
1008 Nkind (First (Exception_Choices (Handler))) = N_Others_Choice;
1011 or else Entity (First (Exception_Choices (Handler))) /=
1015 and then All_Others (First (Exception_Choices (Handler))))
1016 and then Abort_Allowed
1018 Prepend_Call_To_Handler (RE_Abort_Undefer);
1023 Handler := Next_Handler;
1024 end loop Handler_Loop;
1026 -- If all handlers got removed, then remove the list
1028 if Is_Empty_List (Exception_Handlers (HSS)) then
1029 Set_Exception_Handlers (HSS, No_List);
1031 end Expand_Exception_Handlers;
1033 ------------------------------------
1034 -- Expand_N_Exception_Declaration --
1035 ------------------------------------
1038 -- exceptE : constant String := "A.B.EXCEP"; -- static data
1039 -- except : exception_data := (
1040 -- Handled_By_Other => False,
1042 -- Name_Length => exceptE'Length,
1043 -- Full_Name => exceptE'Address,
1044 -- HTable_Ptr => null,
1045 -- Import_Code => 0,
1046 -- Raise_Hook => null,
1049 -- (protecting test only needed if not at library level)
1051 -- exceptF : Boolean := True -- static data
1053 -- exceptF := False;
1054 -- Register_Exception (except'Unchecked_Access);
1057 procedure Expand_N_Exception_Declaration (N : Node_Id) is
1058 Loc : constant Source_Ptr := Sloc (N);
1059 Id : constant Entity_Id := Defining_Identifier (N);
1060 L : List_Id := New_List;
1061 Flag_Id : Entity_Id;
1063 Name_Exname : constant Name_Id := New_External_Name (Chars (Id), 'E');
1064 Exname : constant Node_Id :=
1065 Make_Defining_Identifier (Loc, Name_Exname);
1068 -- There is no expansion needed when compiling for the JVM since the
1069 -- JVM has a built-in exception mechanism. See 4jexcept.ads for details.
1071 if Hostparm.Java_VM then
1075 -- Definition of the external name: nam : constant String := "A.B.NAME";
1078 Make_Object_Declaration (Loc,
1079 Defining_Identifier => Exname,
1080 Constant_Present => True,
1081 Object_Definition => New_Occurrence_Of (Standard_String, Loc),
1082 Expression => Make_String_Literal (Loc, Full_Qualified_Name (Id))));
1084 Set_Is_Statically_Allocated (Exname);
1086 -- Create the aggregate list for type Standard.Exception_Type:
1087 -- Handled_By_Other component: False
1089 Append_To (L, New_Occurrence_Of (Standard_False, Loc));
1091 -- Lang component: 'A'
1094 Make_Character_Literal (Loc,
1096 Char_Literal_Value => UI_From_Int (Character'Pos ('A'))));
1098 -- Name_Length component: Nam'Length
1101 Make_Attribute_Reference (Loc,
1102 Prefix => New_Occurrence_Of (Exname, Loc),
1103 Attribute_Name => Name_Length));
1105 -- Full_Name component: Standard.A_Char!(Nam'Address)
1107 Append_To (L, Unchecked_Convert_To (Standard_A_Char,
1108 Make_Attribute_Reference (Loc,
1109 Prefix => New_Occurrence_Of (Exname, Loc),
1110 Attribute_Name => Name_Address)));
1112 -- HTable_Ptr component: null
1114 Append_To (L, Make_Null (Loc));
1116 -- Import_Code component: 0
1118 Append_To (L, Make_Integer_Literal (Loc, 0));
1120 -- Raise_Hook component: null
1122 Append_To (L, Make_Null (Loc));
1124 Set_Expression (N, Make_Aggregate (Loc, Expressions => L));
1125 Analyze_And_Resolve (Expression (N), Etype (Id));
1127 -- Register_Exception (except'Unchecked_Access);
1129 if not Restriction_Active (No_Exception_Handlers)
1130 and then not Restriction_Active (No_Exception_Registration)
1133 Make_Procedure_Call_Statement (Loc,
1134 Name => New_Occurrence_Of (RTE (RE_Register_Exception), Loc),
1135 Parameter_Associations => New_List (
1136 Unchecked_Convert_To (RTE (RE_Exception_Data_Ptr),
1137 Make_Attribute_Reference (Loc,
1138 Prefix => New_Occurrence_Of (Id, Loc),
1139 Attribute_Name => Name_Unrestricted_Access)))));
1141 Set_Register_Exception_Call (Id, First (L));
1143 if not Is_Library_Level_Entity (Id) then
1144 Flag_Id := Make_Defining_Identifier (Loc,
1145 New_External_Name (Chars (Id), 'F'));
1148 Make_Object_Declaration (Loc,
1149 Defining_Identifier => Flag_Id,
1150 Object_Definition =>
1151 New_Occurrence_Of (Standard_Boolean, Loc),
1153 New_Occurrence_Of (Standard_True, Loc)));
1155 Set_Is_Statically_Allocated (Flag_Id);
1158 Make_Assignment_Statement (Loc,
1159 Name => New_Occurrence_Of (Flag_Id, Loc),
1160 Expression => New_Occurrence_Of (Standard_False, Loc)));
1162 Insert_After_And_Analyze (N,
1163 Make_Implicit_If_Statement (N,
1164 Condition => New_Occurrence_Of (Flag_Id, Loc),
1165 Then_Statements => L));
1168 Insert_List_After_And_Analyze (N, L);
1172 end Expand_N_Exception_Declaration;
1174 ---------------------------------------------
1175 -- Expand_N_Handled_Sequence_Of_Statements --
1176 ---------------------------------------------
1178 procedure Expand_N_Handled_Sequence_Of_Statements (N : Node_Id) is
1180 if Present (Exception_Handlers (N))
1181 and then not Restriction_Active (No_Exception_Handlers)
1183 Expand_Exception_Handlers (N);
1186 -- The following code needs comments ???
1188 if Nkind (Parent (N)) /= N_Package_Body
1189 and then Nkind (Parent (N)) /= N_Accept_Statement
1190 and then Nkind (Parent (N)) /= N_Extended_Return_Statement
1191 and then not Delay_Cleanups (Current_Scope)
1193 Expand_Cleanup_Actions (Parent (N));
1195 Set_First_Real_Statement (N, First (Statements (N)));
1197 end Expand_N_Handled_Sequence_Of_Statements;
1199 -------------------------------------
1200 -- Expand_N_Raise_Constraint_Error --
1201 -------------------------------------
1203 procedure Expand_N_Raise_Constraint_Error (N : Node_Id) is
1205 -- We adjust the condition to deal with the C/Fortran boolean case. This
1206 -- may well not be necessary, as all such conditions are generated by
1207 -- the expander and probably are all standard boolean, but who knows
1208 -- what strange optimization in future may require this adjustment!
1210 Adjust_Condition (Condition (N));
1211 end Expand_N_Raise_Constraint_Error;
1213 ----------------------------------
1214 -- Expand_N_Raise_Program_Error --
1215 ----------------------------------
1217 procedure Expand_N_Raise_Program_Error (N : Node_Id) is
1219 -- We adjust the condition to deal with the C/Fortran boolean case. This
1220 -- may well not be necessary, as all such conditions are generated by
1221 -- the expander and probably are all standard boolean, but who knows
1222 -- what strange optimization in future may require this adjustment!
1224 Adjust_Condition (Condition (N));
1225 end Expand_N_Raise_Program_Error;
1227 ------------------------------
1228 -- Expand_N_Raise_Statement --
1229 ------------------------------
1231 procedure Expand_N_Raise_Statement (N : Node_Id) is
1232 Loc : constant Source_Ptr := Sloc (N);
1239 -- Debug_Flag_Dot_G := True;
1241 -- Processing for locally handled exception (exclude reraise case)
1243 if Present (Name (N)) and then Nkind (Name (N)) = N_Identifier then
1245 or else Restriction_Active (No_Exception_Propagation)
1247 -- If we have a local handler, then note that this is potentially
1248 -- able to be transformed into a goto statement.
1250 H := Find_Local_Handler (Entity (Name (N)), N);
1253 if Local_Raise_Statements (H) = No_Elist then
1254 Set_Local_Raise_Statements (H, New_Elmt_List);
1257 -- Append the new entry if it is not there already. Sometimes
1258 -- we have situations where due to reexpansion, the same node
1259 -- is analyzed twice and would otherwise be added twice.
1261 Append_Unique_Elmt (N, Local_Raise_Statements (H));
1265 Warn_If_No_Propagation (N);
1269 -- If a string expression is present, then the raise statement is
1270 -- converted to a call:
1272 -- Raise_Exception (exception-name'Identity, string);
1274 -- and there is nothing else to do
1276 if Present (Expression (N)) then
1278 Make_Procedure_Call_Statement (Loc,
1279 Name => New_Occurrence_Of (RTE (RE_Raise_Exception), Loc),
1280 Parameter_Associations => New_List (
1281 Make_Attribute_Reference (Loc,
1283 Attribute_Name => Name_Identity),
1289 -- Remaining processing is for the case where no string expression
1292 -- There is no expansion needed for statement "raise <exception>;" when
1293 -- compiling for the JVM since the JVM has a built-in exception
1294 -- mechanism. However we need to keep the expansion for "raise;"
1295 -- statements. See 4jexcept.ads for details.
1297 if Present (Name (N)) and then Hostparm.Java_VM then
1301 -- Don't expand a raise statement that does not come from source
1302 -- if we have already had configurable run-time violations, since
1303 -- most likely it will be junk cascaded nonsense.
1305 if Configurable_Run_Time_Violations > 0
1306 and then not Comes_From_Source (N)
1311 -- Convert explicit raise of Program_Error, Constraint_Error, and
1312 -- Storage_Error into the corresponding raise (in High_Integrity_Mode
1313 -- all other raises will get normal expansion and be disallowed,
1314 -- but this is also faster in all modes).
1316 if Present (Name (N)) and then Nkind (Name (N)) = N_Identifier then
1317 if Entity (Name (N)) = Standard_Constraint_Error then
1319 Make_Raise_Constraint_Error (Loc,
1320 Reason => CE_Explicit_Raise));
1324 elsif Entity (Name (N)) = Standard_Program_Error then
1326 Make_Raise_Program_Error (Loc,
1327 Reason => PE_Explicit_Raise));
1331 elsif Entity (Name (N)) = Standard_Storage_Error then
1333 Make_Raise_Storage_Error (Loc,
1334 Reason => SE_Explicit_Raise));
1340 -- Case of name present, in this case we expand raise name to
1342 -- Raise_Exception (name'Identity, location_string);
1344 -- where location_string identifies the file/line of the raise
1346 if Present (Name (N)) then
1348 Id : Entity_Id := Entity (Name (N));
1351 Build_Location_String (Loc);
1353 -- If the exception is a renaming, use the exception that it
1354 -- renames (which might be a predefined exception, e.g.).
1356 if Present (Renamed_Object (Id)) then
1357 Id := Renamed_Object (Id);
1360 -- Build a C-compatible string in case of no exception handlers,
1361 -- since this is what the last chance handler is expecting.
1363 if Restriction_Active (No_Exception_Handlers) then
1365 -- Generate an empty message if configuration pragma
1366 -- Suppress_Exception_Locations is set for this unit.
1368 if Opt.Exception_Locations_Suppressed then
1371 Name_Len := Name_Len + 1;
1374 Name_Buffer (Name_Len) := ASCII.NUL;
1377 if Opt.Exception_Locations_Suppressed then
1381 Str := String_From_Name_Buffer;
1383 -- For VMS exceptions, convert the raise into a call to
1384 -- lib$stop so it will be handled by __gnat_error_handler.
1386 if Is_VMS_Exception (Id) then
1388 Excep_Image : String_Id;
1392 if Present (Interface_Name (Id)) then
1393 Excep_Image := Strval (Interface_Name (Id));
1395 Get_Name_String (Chars (Id));
1397 Excep_Image := String_From_Name_Buffer;
1400 if Exception_Code (Id) /= No_Uint then
1402 Make_Integer_Literal (Loc, Exception_Code (Id));
1405 Unchecked_Convert_To (Standard_Integer,
1406 Make_Function_Call (Loc,
1407 Name => New_Occurrence_Of
1408 (RTE (RE_Import_Value), Loc),
1409 Parameter_Associations => New_List
1410 (Make_String_Literal (Loc,
1411 Strval => Excep_Image))));
1415 Make_Procedure_Call_Statement (Loc,
1417 New_Occurrence_Of (RTE (RE_Lib_Stop), Loc),
1418 Parameter_Associations => New_List (Cond)));
1419 Analyze_And_Resolve (Cond, Standard_Integer);
1422 -- Not VMS exception case, convert raise to call to the
1423 -- Raise_Exception routine.
1427 Make_Procedure_Call_Statement (Loc,
1428 Name => New_Occurrence_Of (RTE (RE_Raise_Exception), Loc),
1429 Parameter_Associations => New_List (
1430 Make_Attribute_Reference (Loc,
1432 Attribute_Name => Name_Identity),
1433 Make_String_Literal (Loc,
1438 -- Case of no name present (reraise). We rewrite the raise to:
1440 -- Reraise_Occurrence_Always (EO);
1442 -- where EO is the current exception occurrence. If the current handler
1443 -- does not have a choice parameter specification, then we provide one.
1446 -- Find innermost enclosing exception handler (there must be one,
1447 -- since the semantics has already verified that this raise statement
1448 -- is valid, and a raise with no arguments is only permitted in the
1449 -- context of an exception handler.
1451 Ehand := Parent (N);
1452 while Nkind (Ehand) /= N_Exception_Handler loop
1453 Ehand := Parent (Ehand);
1456 -- Make exception choice parameter if none present. Note that we do
1457 -- not need to put the entity on the entity chain, since no one will
1458 -- be referencing this entity by normal visibility methods.
1460 if No (Choice_Parameter (Ehand)) then
1461 E := Make_Defining_Identifier (Loc, New_Internal_Name ('E'));
1462 Set_Choice_Parameter (Ehand, E);
1463 Set_Ekind (E, E_Variable);
1464 Set_Etype (E, RTE (RE_Exception_Occurrence));
1465 Set_Scope (E, Current_Scope);
1468 -- Now rewrite the raise as a call to Reraise. A special case arises
1469 -- if this raise statement occurs in the context of a handler for
1470 -- all others (i.e. an at end handler). in this case we avoid
1471 -- the call to defer abort, cleanup routines are expected to be
1472 -- called in this case with aborts deferred.
1475 Ech : constant Node_Id := First (Exception_Choices (Ehand));
1479 if Nkind (Ech) = N_Others_Choice
1480 and then All_Others (Ech)
1482 Ent := RTE (RE_Reraise_Occurrence_No_Defer);
1484 Ent := RTE (RE_Reraise_Occurrence_Always);
1488 Make_Procedure_Call_Statement (Loc,
1489 Name => New_Occurrence_Of (Ent, Loc),
1490 Parameter_Associations => New_List (
1491 New_Occurrence_Of (Choice_Parameter (Ehand), Loc))));
1496 end Expand_N_Raise_Statement;
1498 ----------------------------------
1499 -- Expand_N_Raise_Storage_Error --
1500 ----------------------------------
1502 procedure Expand_N_Raise_Storage_Error (N : Node_Id) is
1504 -- We adjust the condition to deal with the C/Fortran boolean case. This
1505 -- may well not be necessary, as all such conditions are generated by
1506 -- the expander and probably are all standard boolean, but who knows
1507 -- what strange optimization in future may require this adjustment!
1509 Adjust_Condition (Condition (N));
1510 end Expand_N_Raise_Storage_Error;
1512 ------------------------------
1513 -- Expand_N_Subprogram_Info --
1514 ------------------------------
1516 procedure Expand_N_Subprogram_Info (N : Node_Id) is
1517 Loc : constant Source_Ptr := Sloc (N);
1520 -- For now, we replace an Expand_N_Subprogram_Info node with an
1521 -- attribute reference that gives the address of the procedure.
1522 -- This is because gigi does not yet recognize this node, and
1523 -- for the initial targets, this is the right value anyway.
1526 Make_Attribute_Reference (Loc,
1527 Prefix => Identifier (N),
1528 Attribute_Name => Name_Code_Address));
1530 Analyze_And_Resolve (N, RTE (RE_Code_Loc));
1531 end Expand_N_Subprogram_Info;
1533 ------------------------
1534 -- Find_Local_Handler --
1535 ------------------------
1537 function Find_Local_Handler
1539 Nod : Node_Id) return Node_Id
1547 EHandle : Entity_Id;
1548 -- The entity Id's for the exception we are raising and handling, using
1549 -- the renamed exception if a Renamed_Entity is present.
1552 -- Get the exception we are raising, allowing for renaming
1555 while Present (Renamed_Entity (ERaise)) loop
1556 ERaise := Renamed_Entity (ERaise);
1559 -- Loop to search up the tree
1565 -- If we get to the top of the tree, or to a subprogram, task, entry,
1566 -- or protected body without having found a matching handler, then
1567 -- there is no local handler.
1570 or else Nkind (P) = N_Subprogram_Body
1571 or else Nkind (P) = N_Task_Body
1572 or else Nkind (P) = N_Protected_Body
1573 or else Nkind (P) = N_Entry_Body
1577 -- Test for handled sequence of statements, where we are in the
1578 -- statement section (the exception handlers of a handled sequence
1579 -- of statements do not cover themselves!)
1581 elsif Nkind (P) = N_Handled_Sequence_Of_Statements
1582 and then Is_List_Member (N)
1583 and then List_Containing (N) = Statements (P)
1585 -- If we have exception handlers, look at them
1587 if Present (Exception_Handlers (P)) then
1589 -- Loop through exception handlers
1591 H := First (Exception_Handlers (P));
1592 while Present (H) loop
1594 -- Loop through choices in one handler
1596 C := First (Exception_Choices (H));
1597 while Present (C) loop
1599 -- Deal with others case
1601 if Nkind (C) = N_Others_Choice then
1603 -- Matching others handler, but we need to ensure
1604 -- there is no choice parameter. If there is, then we
1605 -- don't have a local handler after all (since we do
1606 -- not allow choice parameters for local handlers).
1608 if No (Choice_Parameter (H)) then
1614 -- If not others must be entity name
1616 elsif Nkind (C) /= N_Others_Choice then
1617 pragma Assert (Is_Entity_Name (C));
1618 pragma Assert (Present (Entity (C)));
1620 -- Get exception being handled, dealing with renaming
1622 EHandle := Entity (C);
1623 while Present (Renamed_Entity (EHandle)) loop
1624 EHandle := Renamed_Entity (EHandle);
1627 -- If match, then check choice parameter
1629 if ERaise = EHandle then
1630 if No (Choice_Parameter (H)) then
1648 end Find_Local_Handler;
1650 ---------------------------------
1651 -- Get_Local_Raise_Call_Entity --
1652 ---------------------------------
1654 function Get_Local_Raise_Call_Entity return Entity_Id is
1656 if RTE_Available (RE_Local_Raise) then
1657 return RTE (RE_Local_Raise);
1661 end Get_Local_Raise_Call_Entity;
1663 -----------------------------
1664 -- Get_RT_Exception_Entity --
1665 -----------------------------
1667 function Get_RT_Exception_Entity (R : RT_Exception_Code) return Entity_Id is
1670 when RT_CE_Exceptions => return Standard_Constraint_Error;
1671 when RT_PE_Exceptions => return Standard_Program_Error;
1672 when RT_SE_Exceptions => return Standard_Storage_Error;
1674 end Get_RT_Exception_Entity;
1676 ----------------------
1677 -- Is_Non_Ada_Error --
1678 ----------------------
1680 function Is_Non_Ada_Error (E : Entity_Id) return Boolean is
1682 if not OpenVMS_On_Target then
1686 Get_Name_String (Chars (E));
1688 -- Note: it is a little irregular for the body of exp_ch11 to know
1689 -- the details of the encoding scheme for names, but on the other
1690 -- hand, gigi knows them, and this is for gigi's benefit anyway!
1692 if Name_Buffer (1 .. 30) /= "system__aux_dec__non_ada_error" then
1697 end Is_Non_Ada_Error;
1699 ----------------------------
1700 -- Warn_If_No_Propagation --
1701 ----------------------------
1703 procedure Warn_If_No_Propagation (N : Node_Id) is
1705 if Restriction_Active (No_Exception_Propagation)
1706 and then Warn_On_Non_Local_Exception
1709 ("?No_Exception_Propagation restriction is active", N);
1711 if Configurable_Run_Time_Mode then
1713 ("?Last_Chance_Handler will be called on exception", N);
1716 ("?program may terminate with unhandled exception", N);
1719 end Warn_If_No_Propagation;