diff options
Diffstat (limited to 'gcc-4.2.1/gcc/ada/exp_ch11.adb')
| -rw-r--r-- | gcc-4.2.1/gcc/ada/exp_ch11.adb | 826 |
1 files changed, 0 insertions, 826 deletions
diff --git a/gcc-4.2.1/gcc/ada/exp_ch11.adb b/gcc-4.2.1/gcc/ada/exp_ch11.adb deleted file mode 100644 index 56c3095b2..000000000 --- a/gcc-4.2.1/gcc/ada/exp_ch11.adb +++ /dev/null @@ -1,826 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- E X P _ C H 1 1 -- --- -- --- B o d y -- --- -- --- Copyright (C) 1992-2005, Free Software Foundation, Inc. -- --- -- --- GNAT is free software; you can redistribute it and/or modify it under -- --- terms of the GNU General Public License as published by the Free Soft- -- --- ware Foundation; either version 2, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- --- for more details. You should have received a copy of the GNU General -- --- Public License distributed with GNAT; see file COPYING. If not, write -- --- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, -- --- Boston, MA 02110-1301, USA. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - -with Atree; use Atree; -with Casing; use Casing; -with Debug; use Debug; -with Einfo; use Einfo; -with Errout; use Errout; -with Exp_Ch7; use Exp_Ch7; -with Exp_Util; use Exp_Util; -with Hostparm; use Hostparm; -with Namet; use Namet; -with Nlists; use Nlists; -with Nmake; use Nmake; -with Opt; use Opt; -with Rtsfind; use Rtsfind; -with Restrict; use Restrict; -with Rident; use Rident; -with Sem; use Sem; -with Sem_Ch8; use Sem_Ch8; -with Sem_Res; use Sem_Res; -with Sem_Util; use Sem_Util; -with Sinfo; use Sinfo; -with Sinput; use Sinput; -with Snames; use Snames; -with Stand; use Stand; -with Stringt; use Stringt; -with Targparm; use Targparm; -with Tbuild; use Tbuild; -with Uintp; use Uintp; - -package body Exp_Ch11 is - - --------------------------- - -- Expand_At_End_Handler -- - --------------------------- - - -- For a handled statement sequence that has a cleanup (At_End_Proc - -- field set), an exception handler of the following form is required: - - -- exception - -- when all others => - -- cleanup call - -- raise; - - -- Note: this exception handler is treated rather specially by - -- subsequent expansion in two respects: - - -- The normal call to Undefer_Abort is omitted - -- The raise call does not do Defer_Abort - - -- This is because the current tasking code seems to assume that - -- the call to the cleanup routine that is made from an exception - -- handler for the abort signal is called with aborts deferred. - - -- This expansion is only done if we have front end exception handling. - -- If we have back end exception handling, then the AT END handler is - -- left alone, and cleanups (including the exceptional case) are handled - -- by the back end. - - -- In the front end case, the exception handler described above handles - -- the exceptional case. The AT END handler is left in the generated tree - -- and the code generator (e.g. gigi) must still handle proper generation - -- of cleanup calls for the non-exceptional case. - - procedure Expand_At_End_Handler (HSS : Node_Id; Block : Node_Id) is - Clean : constant Entity_Id := Entity (At_End_Proc (HSS)); - Loc : constant Source_Ptr := Sloc (Clean); - Ohandle : Node_Id; - Stmnts : List_Id; - - begin - pragma Assert (Present (Clean)); - pragma Assert (No (Exception_Handlers (HSS))); - - -- Don't expand if back end exception handling active - - if Exception_Mechanism = Back_End_Exceptions then - return; - end if; - - -- Don't expand an At End handler if we have already had configurable - -- run-time violations, since likely this will just be a matter of - -- generating useless cascaded messages - - if Configurable_Run_Time_Violations > 0 then - return; - end if; - - if Restriction_Active (No_Exception_Handlers) then - return; - end if; - - if Present (Block) then - New_Scope (Block); - end if; - - Ohandle := - Make_Others_Choice (Loc); - Set_All_Others (Ohandle); - - Stmnts := New_List ( - Make_Procedure_Call_Statement (Loc, - Name => New_Occurrence_Of (Clean, Loc)), - Make_Raise_Statement (Loc)); - - Set_Exception_Handlers (HSS, New_List ( - Make_Exception_Handler (Loc, - Exception_Choices => New_List (Ohandle), - Statements => Stmnts))); - - Analyze_List (Stmnts, Suppress => All_Checks); - Expand_Exception_Handlers (HSS); - - if Present (Block) then - Pop_Scope; - end if; - end Expand_At_End_Handler; - - ------------------------------- - -- Expand_Exception_Handlers -- - ------------------------------- - - procedure Expand_Exception_Handlers (HSS : Node_Id) is - Handlrs : constant List_Id := Exception_Handlers (HSS); - Loc : Source_Ptr; - Handler : Node_Id; - Others_Choice : Boolean; - Obj_Decl : Node_Id; - - procedure Prepend_Call_To_Handler - (Proc : RE_Id; - Args : List_Id := No_List); - -- Routine to prepend a call to the procedure referenced by Proc at - -- the start of the handler code for the current Handler. - - ----------------------------- - -- Prepend_Call_To_Handler -- - ----------------------------- - - procedure Prepend_Call_To_Handler - (Proc : RE_Id; - Args : List_Id := No_List) - is - Ent : constant Entity_Id := RTE (Proc); - - begin - -- If we have no Entity, then we are probably in no run time mode - -- or some weird error has occured. In either case do do nothing! - - if Present (Ent) then - declare - Call : constant Node_Id := - Make_Procedure_Call_Statement (Loc, - Name => New_Occurrence_Of (RTE (Proc), Loc), - Parameter_Associations => Args); - - begin - Prepend_To (Statements (Handler), Call); - Analyze (Call, Suppress => All_Checks); - end; - end if; - end Prepend_Call_To_Handler; - - -- Start of processing for Expand_Exception_Handlers - - begin - -- Loop through handlers - - Handler := First_Non_Pragma (Handlrs); - Handler_Loop : while Present (Handler) loop - Loc := Sloc (Handler); - - -- Remove source handler if gnat debug flag N is set - - if Debug_Flag_Dot_X and then Comes_From_Source (Handler) then - declare - H : constant Node_Id := Handler; - begin - Next_Non_Pragma (Handler); - Remove (H); - goto Continue_Handler_Loop; - end; - end if; - - -- If an exception occurrence is present, then we must declare it - -- and initialize it from the value stored in the TSD - - -- declare - -- name : Exception_Occurrence; - -- - -- begin - -- Save_Occurrence (name, Get_Current_Excep.all) - -- ... - -- end; - - if Present (Choice_Parameter (Handler)) then - declare - Cparm : constant Entity_Id := Choice_Parameter (Handler); - Clc : constant Source_Ptr := Sloc (Cparm); - Save : Node_Id; - - begin - Save := - Make_Procedure_Call_Statement (Loc, - Name => - New_Occurrence_Of (RTE (RE_Save_Occurrence), Loc), - Parameter_Associations => New_List ( - New_Occurrence_Of (Cparm, Clc), - Make_Explicit_Dereference (Loc, - Make_Function_Call (Loc, - Name => Make_Explicit_Dereference (Loc, - New_Occurrence_Of - (RTE (RE_Get_Current_Excep), Loc)))))); - - Mark_Rewrite_Insertion (Save); - Prepend (Save, Statements (Handler)); - - Obj_Decl := - Make_Object_Declaration (Clc, - Defining_Identifier => Cparm, - Object_Definition => - New_Occurrence_Of - (RTE (RE_Exception_Occurrence), Clc)); - Set_No_Initialization (Obj_Decl, True); - - Rewrite (Handler, - Make_Exception_Handler (Loc, - Exception_Choices => Exception_Choices (Handler), - - Statements => New_List ( - Make_Block_Statement (Loc, - Declarations => New_List (Obj_Decl), - Handled_Statement_Sequence => - Make_Handled_Sequence_Of_Statements (Loc, - Statements => Statements (Handler)))))); - - Analyze_List (Statements (Handler), Suppress => All_Checks); - end; - end if; - - -- The processing at this point is rather different for the - -- JVM case, so we completely separate the processing. - - -- For the JVM case, we unconditionally call Update_Exception, - -- passing a call to the intrinsic function Current_Target_Exception - -- (see JVM version of Ada.Exceptions in 4jexcept.adb for details). - - if Hostparm.Java_VM then - declare - Arg : constant Node_Id := - Make_Function_Call (Loc, - Name => New_Occurrence_Of - (RTE (RE_Current_Target_Exception), Loc)); - begin - Prepend_Call_To_Handler (RE_Update_Exception, New_List (Arg)); - end; - - -- For the normal case, we have to worry about the state of abort - -- deferral. Generally, we defer abort during runtime handling of - -- exceptions. When control is passed to the handler, then in the - -- normal case we undefer aborts. In any case this entire handling - -- is relevant only if aborts are allowed! - - elsif Abort_Allowed then - - -- There are some special cases in which we do not do the - -- undefer. In particular a finalization (AT END) handler - -- wants to operate with aborts still deferred. - - -- We also suppress the call if this is the special handler - -- for Abort_Signal, since if we are aborting, we want to keep - -- aborts deferred (one abort is enough thank you very much :-) - - -- If abort really needs to be deferred the expander must add - -- this call explicitly, see Exp_Ch9.Expand_N_Asynchronous_Select. - - Others_Choice := - Nkind (First (Exception_Choices (Handler))) = N_Others_Choice; - - if (Others_Choice - or else Entity (First (Exception_Choices (Handler))) /= - Stand.Abort_Signal) - and then not - (Others_Choice - and then All_Others (First (Exception_Choices (Handler)))) - and then Abort_Allowed - then - Prepend_Call_To_Handler (RE_Abort_Undefer); - end if; - end if; - - Next_Non_Pragma (Handler); - - <<Continue_Handler_Loop>> - null; - end loop Handler_Loop; - - -- If all handlers got removed by gnatdN, then remove the list - - if Debug_Flag_Dot_X - and then Is_Empty_List (Exception_Handlers (HSS)) - then - Set_Exception_Handlers (HSS, No_List); - end if; - end Expand_Exception_Handlers; - - ------------------------------------ - -- Expand_N_Exception_Declaration -- - ------------------------------------ - - -- Generates: - -- exceptE : constant String := "A.B.EXCEP"; -- static data - -- except : exception_data := ( - -- Handled_By_Other => False, - -- Lang => 'A', - -- Name_Length => exceptE'Length, - -- Full_Name => exceptE'Address, - -- HTable_Ptr => null, - -- Import_Code => 0, - -- Raise_Hook => null, - -- ); - - -- (protecting test only needed if not at library level) - -- - -- exceptF : Boolean := True -- static data - -- if exceptF then - -- exceptF := False; - -- Register_Exception (except'Unchecked_Access); - -- end if; - - procedure Expand_N_Exception_Declaration (N : Node_Id) is - Loc : constant Source_Ptr := Sloc (N); - Id : constant Entity_Id := Defining_Identifier (N); - L : List_Id := New_List; - Flag_Id : Entity_Id; - - Name_Exname : constant Name_Id := New_External_Name (Chars (Id), 'E'); - Exname : constant Node_Id := - Make_Defining_Identifier (Loc, Name_Exname); - - begin - -- There is no expansion needed when compiling for the JVM since the - -- JVM has a built-in exception mechanism. See 4jexcept.ads for details. - - if Hostparm.Java_VM then - return; - end if; - - -- Definition of the external name: nam : constant String := "A.B.NAME"; - - Insert_Action (N, - Make_Object_Declaration (Loc, - Defining_Identifier => Exname, - Constant_Present => True, - Object_Definition => New_Occurrence_Of (Standard_String, Loc), - Expression => Make_String_Literal (Loc, Full_Qualified_Name (Id)))); - - Set_Is_Statically_Allocated (Exname); - - -- Create the aggregate list for type Standard.Exception_Type: - -- Handled_By_Other component: False - - Append_To (L, New_Occurrence_Of (Standard_False, Loc)); - - -- Lang component: 'A' - - Append_To (L, - Make_Character_Literal (Loc, - Chars => Name_uA, - Char_Literal_Value => UI_From_Int (Character'Pos ('A')))); - - -- Name_Length component: Nam'Length - - Append_To (L, - Make_Attribute_Reference (Loc, - Prefix => New_Occurrence_Of (Exname, Loc), - Attribute_Name => Name_Length)); - - -- Full_Name component: Standard.A_Char!(Nam'Address) - - Append_To (L, Unchecked_Convert_To (Standard_A_Char, - Make_Attribute_Reference (Loc, - Prefix => New_Occurrence_Of (Exname, Loc), - Attribute_Name => Name_Address))); - - -- HTable_Ptr component: null - - Append_To (L, Make_Null (Loc)); - - -- Import_Code component: 0 - - Append_To (L, Make_Integer_Literal (Loc, 0)); - - -- Raise_Hook component: null - - Append_To (L, Make_Null (Loc)); - - Set_Expression (N, Make_Aggregate (Loc, Expressions => L)); - Analyze_And_Resolve (Expression (N), Etype (Id)); - - -- Register_Exception (except'Unchecked_Access); - - if not Restriction_Active (No_Exception_Handlers) - and then not Restriction_Active (No_Exception_Registration) - then - L := New_List ( - Make_Procedure_Call_Statement (Loc, - Name => New_Occurrence_Of (RTE (RE_Register_Exception), Loc), - Parameter_Associations => New_List ( - Unchecked_Convert_To (RTE (RE_Exception_Data_Ptr), - Make_Attribute_Reference (Loc, - Prefix => New_Occurrence_Of (Id, Loc), - Attribute_Name => Name_Unrestricted_Access))))); - - Set_Register_Exception_Call (Id, First (L)); - - if not Is_Library_Level_Entity (Id) then - Flag_Id := Make_Defining_Identifier (Loc, - New_External_Name (Chars (Id), 'F')); - - Insert_Action (N, - Make_Object_Declaration (Loc, - Defining_Identifier => Flag_Id, - Object_Definition => - New_Occurrence_Of (Standard_Boolean, Loc), - Expression => - New_Occurrence_Of (Standard_True, Loc))); - - Set_Is_Statically_Allocated (Flag_Id); - - Append_To (L, - Make_Assignment_Statement (Loc, - Name => New_Occurrence_Of (Flag_Id, Loc), - Expression => New_Occurrence_Of (Standard_False, Loc))); - - Insert_After_And_Analyze (N, - Make_Implicit_If_Statement (N, - Condition => New_Occurrence_Of (Flag_Id, Loc), - Then_Statements => L)); - - else - Insert_List_After_And_Analyze (N, L); - end if; - end if; - - end Expand_N_Exception_Declaration; - - --------------------------------------------- - -- Expand_N_Handled_Sequence_Of_Statements -- - --------------------------------------------- - - procedure Expand_N_Handled_Sequence_Of_Statements (N : Node_Id) is - begin - if Present (Exception_Handlers (N)) - and then not Restriction_Active (No_Exception_Handlers) - then - Expand_Exception_Handlers (N); - end if; - - -- The following code needs comments ??? - - if Nkind (Parent (N)) /= N_Package_Body - and then Nkind (Parent (N)) /= N_Accept_Statement - and then not Delay_Cleanups (Current_Scope) - then - Expand_Cleanup_Actions (Parent (N)); - else - Set_First_Real_Statement (N, First (Statements (N))); - end if; - - end Expand_N_Handled_Sequence_Of_Statements; - - ------------------------------------- - -- Expand_N_Raise_Constraint_Error -- - ------------------------------------- - - -- The only processing required is to adjust the condition to deal - -- with the C/Fortran boolean case. This may well not be necessary, - -- as all such conditions are generated by the expander and probably - -- are all standard boolean, but who knows what strange optimization - -- in future may require this adjustment! - - procedure Expand_N_Raise_Constraint_Error (N : Node_Id) is - begin - Adjust_Condition (Condition (N)); - end Expand_N_Raise_Constraint_Error; - - ---------------------------------- - -- Expand_N_Raise_Program_Error -- - ---------------------------------- - - -- The only processing required is to adjust the condition to deal - -- with the C/Fortran boolean case. This may well not be necessary, - -- as all such conditions are generated by the expander and probably - -- are all standard boolean, but who knows what strange optimization - -- in future may require this adjustment! - - procedure Expand_N_Raise_Program_Error (N : Node_Id) is - begin - Adjust_Condition (Condition (N)); - end Expand_N_Raise_Program_Error; - - ------------------------------ - -- Expand_N_Raise_Statement -- - ------------------------------ - - procedure Expand_N_Raise_Statement (N : Node_Id) is - Loc : constant Source_Ptr := Sloc (N); - Ehand : Node_Id; - E : Entity_Id; - Str : String_Id; - - begin - -- If a string expression is present, then the raise statement is - -- converted to a call: - - -- Raise_Exception (exception-name'Identity, string); - - -- and there is nothing else to do - - if Present (Expression (N)) then - Rewrite (N, - Make_Procedure_Call_Statement (Loc, - Name => New_Occurrence_Of (RTE (RE_Raise_Exception), Loc), - Parameter_Associations => New_List ( - Make_Attribute_Reference (Loc, - Prefix => Name (N), - Attribute_Name => Name_Identity), - Expression (N)))); - Analyze (N); - return; - end if; - - -- Remaining processing is for the case where no string expression - -- is present. - - -- There is no expansion needed for statement "raise <exception>;" when - -- compiling for the JVM since the JVM has a built-in exception - -- mechanism. However we need the keep the expansion for "raise;" - -- statements. See 4jexcept.ads for details. - - if Present (Name (N)) and then Hostparm.Java_VM then - return; - end if; - - -- Don't expand a raise statement that does not come from source - -- if we have already had configurable run-time violations, since - -- most likely it will be junk cascaded nonsense. - - if Configurable_Run_Time_Violations > 0 - and then not Comes_From_Source (N) - then - return; - end if; - - -- Convert explicit raise of Program_Error, Constraint_Error, and - -- Storage_Error into the corresponding raise (in High_Integrity_Mode - -- all other raises will get normal expansion and be disallowed, - -- but this is also faster in all modes). - - if Present (Name (N)) and then Nkind (Name (N)) = N_Identifier then - if Entity (Name (N)) = Standard_Constraint_Error then - Rewrite (N, - Make_Raise_Constraint_Error (Loc, - Reason => CE_Explicit_Raise)); - Analyze (N); - return; - - elsif Entity (Name (N)) = Standard_Program_Error then - Rewrite (N, - Make_Raise_Program_Error (Loc, - Reason => PE_Explicit_Raise)); - Analyze (N); - return; - - elsif Entity (Name (N)) = Standard_Storage_Error then - Rewrite (N, - Make_Raise_Storage_Error (Loc, - Reason => SE_Explicit_Raise)); - Analyze (N); - return; - end if; - end if; - - -- Case of name present, in this case we expand raise name to - - -- Raise_Exception (name'Identity, location_string); - - -- where location_string identifies the file/line of the raise - - if Present (Name (N)) then - declare - Id : Entity_Id := Entity (Name (N)); - - begin - Build_Location_String (Loc); - - -- If the exception is a renaming, use the exception that it - -- renames (which might be a predefined exception, e.g.). - - if Present (Renamed_Object (Id)) then - Id := Renamed_Object (Id); - end if; - - -- Build a C-compatible string in case of no exception handlers, - -- since this is what the last chance handler is expecting. - - if Restriction_Active (No_Exception_Handlers) then - - -- Generate an empty message if configuration pragma - -- Suppress_Exception_Locations is set for this unit. - - if Opt.Exception_Locations_Suppressed then - Name_Len := 1; - else - Name_Len := Name_Len + 1; - end if; - - Name_Buffer (Name_Len) := ASCII.NUL; - end if; - - if Opt.Exception_Locations_Suppressed then - Name_Len := 0; - end if; - - Str := String_From_Name_Buffer; - - -- For VMS exceptions, convert the raise into a call to - -- lib$stop so it will be handled by __gnat_error_handler. - - if Is_VMS_Exception (Id) then - declare - Excep_Image : String_Id; - Cond : Node_Id; - - begin - if Present (Interface_Name (Id)) then - Excep_Image := Strval (Interface_Name (Id)); - else - Get_Name_String (Chars (Id)); - Set_All_Upper_Case; - Excep_Image := String_From_Name_Buffer; - end if; - - if Exception_Code (Id) /= No_Uint then - Cond := - Make_Integer_Literal (Loc, Exception_Code (Id)); - else - Cond := - Unchecked_Convert_To (Standard_Integer, - Make_Function_Call (Loc, - Name => New_Occurrence_Of - (RTE (RE_Import_Value), Loc), - Parameter_Associations => New_List - (Make_String_Literal (Loc, - Strval => Excep_Image)))); - end if; - - Rewrite (N, - Make_Procedure_Call_Statement (Loc, - Name => - New_Occurrence_Of (RTE (RE_Lib_Stop), Loc), - Parameter_Associations => New_List (Cond))); - Analyze_And_Resolve (Cond, Standard_Integer); - end; - - -- Not VMS exception case, convert raise to call to the - -- Raise_Exception routine. - - else - Rewrite (N, - Make_Procedure_Call_Statement (Loc, - Name => New_Occurrence_Of (RTE (RE_Raise_Exception), Loc), - Parameter_Associations => New_List ( - Make_Attribute_Reference (Loc, - Prefix => Name (N), - Attribute_Name => Name_Identity), - Make_String_Literal (Loc, - Strval => Str)))); - end if; - end; - - -- Case of no name present (reraise). We rewrite the raise to: - - -- Reraise_Occurrence_Always (EO); - - -- where EO is the current exception occurrence. If the current handler - -- does not have a choice parameter specification, then we provide one. - - else - -- Find innermost enclosing exception handler (there must be one, - -- since the semantics has already verified that this raise statement - -- is valid, and a raise with no arguments is only permitted in the - -- context of an exception handler. - - Ehand := Parent (N); - while Nkind (Ehand) /= N_Exception_Handler loop - Ehand := Parent (Ehand); - end loop; - - -- Make exception choice parameter if none present. Note that we do - -- not need to put the entity on the entity chain, since no one will - -- be referencing this entity by normal visibility methods. - - if No (Choice_Parameter (Ehand)) then - E := Make_Defining_Identifier (Loc, New_Internal_Name ('E')); - Set_Choice_Parameter (Ehand, E); - Set_Ekind (E, E_Variable); - Set_Etype (E, RTE (RE_Exception_Occurrence)); - Set_Scope (E, Current_Scope); - end if; - - -- Now rewrite the raise as a call to Reraise. A special case arises - -- if this raise statement occurs in the context of a handler for - -- all others (i.e. an at end handler). in this case we avoid - -- the call to defer abort, cleanup routines are expected to be - -- called in this case with aborts deferred. - - declare - Ech : constant Node_Id := First (Exception_Choices (Ehand)); - Ent : Entity_Id; - - begin - if Nkind (Ech) = N_Others_Choice - and then All_Others (Ech) - then - Ent := RTE (RE_Reraise_Occurrence_No_Defer); - else - Ent := RTE (RE_Reraise_Occurrence_Always); - end if; - - Rewrite (N, - Make_Procedure_Call_Statement (Loc, - Name => New_Occurrence_Of (Ent, Loc), - Parameter_Associations => New_List ( - New_Occurrence_Of (Choice_Parameter (Ehand), Loc)))); - end; - end if; - - Analyze (N); - end Expand_N_Raise_Statement; - - ---------------------------------- - -- Expand_N_Raise_Storage_Error -- - ---------------------------------- - - -- The only processing required is to adjust the condition to deal - -- with the C/Fortran boolean case. This may well not be necessary, - -- as all such conditions are generated by the expander and probably - -- are all standard boolean, but who knows what strange optimization - -- in future may require this adjustment! - - procedure Expand_N_Raise_Storage_Error (N : Node_Id) is - begin - Adjust_Condition (Condition (N)); - end Expand_N_Raise_Storage_Error; - - ------------------------------ - -- Expand_N_Subprogram_Info -- - ------------------------------ - - procedure Expand_N_Subprogram_Info (N : Node_Id) is - Loc : constant Source_Ptr := Sloc (N); - - begin - -- For now, we replace an Expand_N_Subprogram_Info node with an - -- attribute reference that gives the address of the procedure. - -- This is because gigi does not yet recognize this node, and - -- for the initial targets, this is the right value anyway. - - Rewrite (N, - Make_Attribute_Reference (Loc, - Prefix => Identifier (N), - Attribute_Name => Name_Code_Address)); - - Analyze_And_Resolve (N, RTE (RE_Code_Loc)); - end Expand_N_Subprogram_Info; - - ---------------------- - -- Is_Non_Ada_Error -- - ---------------------- - - function Is_Non_Ada_Error (E : Entity_Id) return Boolean is - begin - if not OpenVMS_On_Target then - return False; - end if; - - Get_Name_String (Chars (E)); - - -- Note: it is a little irregular for the body of exp_ch11 to know - -- the details of the encoding scheme for names, but on the other - -- hand, gigi knows them, and this is for gigi's benefit anyway! - - if Name_Buffer (1 .. 30) /= "system__aux_dec__non_ada_error" then - return False; - end if; - - return True; - end Is_Non_Ada_Error; - -end Exp_Ch11; |