diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 47 | ||||
| -rw-r--r-- | gcc/ada/einfo.ads | 9 | ||||
| -rw-r--r-- | gcc/ada/exp_ch9.adb | 7 | ||||
| -rw-r--r-- | gcc/ada/init.c | 32 | ||||
| -rw-r--r-- | gcc/ada/mlib-tgt-specific-xi.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/scn.adb | 28 | ||||
| -rw-r--r-- | gcc/ada/scn.ads | 5 | ||||
| -rwxr-xr-x | gcc/ada/sem_aux.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/sem_ch6.adb | 82 | ||||
| -rw-r--r-- | gcc/ada/sinput-l.adb | 5 | ||||
| -rw-r--r-- | gcc/ada/snames.ads-tmpl | 18 |
11 files changed, 177 insertions, 60 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 0c842dd..c1c0391 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,50 @@ +2009-04-10 Robert Dewar <dewar@adacore.com> + + * mlib-tgt-specific-xi.adb: Minor reformatting + +2009-04-10 Bob Duff <duff@adacore.com> + + * einfo.ads: Minor comment fixes + +2009-04-10 Vincent Celier <celier@adacore.com> + + * snames.ads-tmpl: Remove names that are no longer used in the + Project Manager. + Mark specifically those that are used only in gprbuild + +2009-04-10 Eric Botcazou <ebotcazou@adacore.com> + + * init.c: Adjust EH support code on Alpha/Tru64. + +2009-04-10 Bob Duff <duff@adacore.com> + + * sem_ch6.adb (Process_PPCs): Add a call to the _Postconditions + procedure on every path that could return implicitly (not via a return + statement) from a procedure. + +2009-04-10 Ed Schonberg <schonberg@adacore.com> + + * exp_ch9.adb (Build_Master_Entity): An extended return statement is a + valid scope for a task declarations and therefore for a master id. + +2009-04-10 Robert Dewar <dewar@adacore.com> + + * sem_aux.adb: Minor reformatting + +2009-04-10 Vincent Celier <celier@adacore.com> + + * scn.adb (Obsolescent_Check_Flag): New Boolean flag, initialized to + True. + (Obsolescent_Check): Do nothing if Obsolescent_Check_Flag is False + (Set_Obsolescent_Check): New procedure to change the value of + Obsolescent_Check_Flag. + + * scn.ads (Set_Obsolescent_Check): New procedure to control + Obsolescent_Check. + + * sinput-l.adb (Load_File): Do not check for pragma Restrictions on + obsolescent features while preprocessing. + 2009-04-10 Thomas Quinot <quinot@adacore.com> * xsnamest.adb: Use XUtil to have uniform line endings (UNIX style) in diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 91df32c..99d41f3 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -4900,7 +4900,7 @@ package Einfo is -- Interface_Name (Node21) -- Scope_Depth_Value (Uint22) -- Generic_Renamings (Elist23) (for an instance) - -- Inner_Instances (Elist23) (generic function only) + -- Inner_Instances (Elist23) (generic case only) -- Protection_Object (Node23) (for concurrent kind) -- Spec_PPC_List (Node24) -- Interface_Alias (Node25) @@ -5154,8 +5154,8 @@ package Einfo is -- Last_Entity (Node20) -- Interface_Name (Node21) -- Scope_Depth_Value (Uint22) - -- Generic_Renamings (Elist23) (for instance) - -- Inner_Instances (Elist23) (for generic proc) + -- Generic_Renamings (Elist23) (for an instance) + -- Inner_Instances (Elist23) (generic case only) -- Protection_Object (Node23) (for concurrent kind) -- Spec_PPC_List (Node24) -- Interface_Alias (Node25) @@ -5177,10 +5177,9 @@ package Einfo is -- Has_Postconditions (Flag240) -- Has_Subprogram_Descriptor (Flag93) -- Implemented_By_Entry (Flag232) (non-generic case only) - -- Is_Visible_Child_Unit (Flag116) -- Is_Abstract_Subprogram (Flag19) (non-generic case only) -- Is_Asynchronous (Flag81) - -- Is_Called (Flag102) (non-generic subprog) + -- Is_Called (Flag102) (non-generic case only) -- Is_Constructor (Flag76) -- Is_Eliminated (Flag124) -- Is_Instantiated (Flag126) (generic case only) diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index 75603f0..259908f 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -2394,7 +2394,10 @@ package body Exp_Ch9 is -- in internal scopes, unless present already.. Required for nested -- limited aggregates, where the expansion of task components may -- generate inner blocks. If the block is the rewriting of a call - -- this is valid master. + -- or the scope is an extended return statement this is valid master. + -- The master in an extended return is only used within the return, + -- and is subsequently overwritten in Move_Activation_Chain, but it + -- must exist now. if Ada_Version >= Ada_05 then while Is_Internal (S) loop @@ -2403,6 +2406,8 @@ package body Exp_Ch9 is Nkind (Original_Node (Parent (S))) = N_Procedure_Call_Statement then exit; + elsif Ekind (S) = E_Return_Statement then + exit; else S := Scope (S); end if; diff --git a/gcc/ada/init.c b/gcc/ada/init.c index 1b69527..a1f46ed 100644 --- a/gcc/ada/init.c +++ b/gcc/ada/init.c @@ -290,28 +290,21 @@ extern char *__gnat_get_code_loc (struct sigcontext *); extern void __gnat_set_code_loc (struct sigcontext *, char *); extern size_t __gnat_machine_state_length (void); -/* __gnat_adjust_context_for_raise - see comments along with the default - version later in this file. */ - #define HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE void -__gnat_adjust_context_for_raise (int signo, void *context) +__gnat_adjust_context_for_raise (int signo, void *ucontext) { - struct sigcontext * sigcontext = (struct sigcontext *) context; - - /* The fallback code fetches the faulting insn address from sc_pc, so - adjust that when need be. For SIGFPE, the required adjustment depends - on the trap shadow situation (see man ieee). */ + struct sigcontext *sigcontext = (struct sigcontext *) ucontext; + + /* The unwinder expects the signal context to contain the address of the + faulting instruction. For SIGFPE, this depends on the trap shadow + situation (see man ieee). We nonetheless always compensate for it, + considering that PC designates the instruction following the one that + trapped. This is not necessarily true but corresponds to what we have + always observed. */ if (signo == SIGFPE) - { - /* ??? We never adjust here, considering that sc_pc always - designates the instruction following the one which trapped. - This is not necessarily true but corresponds to what we have - always observed. */ - } - else - sigcontext->sc_pc ++; + sigcontext->sc_pc--; } static void @@ -2224,8 +2217,9 @@ __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED, void *ucontext ATTRIBUTE_UNUSED) { /* We used to compensate here for the raised from call vs raised from signal - exception discrepancy with the GCC ZCX scheme, but this is now dealt with - generically (except for the Alpha and IA-64), see GCC PR other/26208. + exception discrepancy with the GCC ZCX scheme, but this now can be dealt + with generically in the unwinder (see GCC PR other/26208). Only the VMS + ports still do the compensation described in the few lines below. *** Call vs signal exception discrepancy with GCC ZCX scheme *** diff --git a/gcc/ada/mlib-tgt-specific-xi.adb b/gcc/ada/mlib-tgt-specific-xi.adb index 97e6e53..10c57b4 100644 --- a/gcc/ada/mlib-tgt-specific-xi.adb +++ b/gcc/ada/mlib-tgt-specific-xi.adb @@ -157,7 +157,7 @@ package body MLib.Tgt.Specific is elsif Target_Name (Target_Name'First .. Index) = "powerpc" then if Target_Name'Length >= 23 and then Target_Name (Target_Name'First .. Target_Name'First + 22) = - "powerpc-unknown-eabispe" + "powerpc-unknown-eabispe" then return "powerpc-eabispe-"; else diff --git a/gcc/ada/scn.adb b/gcc/ada/scn.adb index 805caab..81dc49b 100644 --- a/gcc/ada/scn.adb +++ b/gcc/ada/scn.adb @@ -44,6 +44,10 @@ package body Scn is use ASCII; + Obsolescent_Check_Flag : Boolean := True; + -- Obsolescent check activation. Set to False during integrated + -- preprocessing. + Used_As_Identifier : array (Token_Type) of Boolean; -- Flags set True if a given keyword is used as an identifier (used to -- make sure that we only post an error message for incorrect use of a @@ -342,12 +346,15 @@ package body Scn is procedure Obsolescent_Check (S : Source_Ptr) is begin - -- This is a pain in the neck case, since we normally need a node to - -- call Check_Restrictions, and all we have is a source pointer. The - -- easiest thing is to construct a dummy node. A bit kludgy, but this - -- is a marginal case. It's not worth trying to do things more cleanly. - - Check_Restriction (No_Obsolescent_Features, New_Node (N_Empty, S)); + if Obsolescent_Check_Flag then + -- This is a pain in the neck case, since we normally need a node to + -- call Check_Restrictions, and all we have is a source pointer. The + -- easiest thing is to construct a dummy node. A bit kludgy, but this + -- is a marginal case. It's not worth trying to do things more + -- cleanly. + + Check_Restriction (No_Obsolescent_Features, New_Node (N_Empty, S)); + end if; end Obsolescent_Check; --------------- @@ -420,4 +427,13 @@ package body Scn is Set_Chars (Token_Node, Token_Name); end Scan_Reserved_Identifier; + --------------------------- + -- Set_Obsolescent_Check -- + --------------------------- + + procedure Set_Obsolescent_Check (Value : Boolean) is + begin + Obsolescent_Check_Flag := Value; + end Set_Obsolescent_Check; + end Scn; diff --git a/gcc/ada/scn.ads b/gcc/ada/scn.ads index a236a2c..eb6be5e 100644 --- a/gcc/ada/scn.ads +++ b/gcc/ada/scn.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, 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- -- @@ -51,6 +51,9 @@ package Scn is -- Called to handle pragma restrictions check for usage of obsolescent -- character replacements during the scan. + procedure Set_Obsolescent_Check (Value : Boolean); + -- Activate or not obsolescent check + procedure Post_Scan; pragma Inline (Post_Scan); -- Create nodes for tokens: Char_Literal, Identifier, Real_Literal, diff --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb index 884c2bd..39b7443 100755 --- a/gcc/ada/sem_aux.adb +++ b/gcc/ada/sem_aux.adb @@ -733,6 +733,8 @@ package body Sem_Aux is begin pragma Assert (Is_Tag (Tag)); + -- Loop to look for next tag component + Comp := Next_Entity (Tag); while Present (Comp) loop if Is_Tag (Comp) then diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index c125a71..0f854d5 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -7843,12 +7843,40 @@ package body Sem_Ch6 is Subp : Entity_Id; Parms : List_Id; + procedure Add_Post_Call (Stms : List_Id; Post_Proc : Entity_Id); + -- Add a call to Post_Proc at the end of the statement list + function Grab_PPC (Nam : Name_Id) return Node_Id; -- Prag contains an analyzed precondition or postcondition pragma. -- This function copies the pragma, changes it to the corresponding -- Check pragma and returns the Check pragma as the result. The -- argument Nam is either Name_Precondition or Name_Postcondition. + ------------------- + -- Add_Post_Call -- + ------------------- + + procedure Add_Post_Call (Stms : List_Id; Post_Proc : Entity_Id) is + Last_Stm : Node_Id; + begin + -- Get last statement, ignoring irrelevant nodes + + Last_Stm := Last (Stms); + while Nkind (Last_Stm) in N_Pop_xxx_Label loop + Prev (Last_Stm); + end loop; + + -- Append the call to the list. This is unnecessary (but harmless) if + -- the end of the list is unreachable, so we do a simple check for + -- Is_Transfer here. + + if not Is_Transfer (Last_Stm) then + Append_To (Stms, + Make_Procedure_Call_Statement (Loc, + Name => New_Reference_To (Post_Proc, Loc))); + end if; + end Add_Post_Call; + -------------- -- Grab_PPC -- -------------- @@ -7964,12 +7992,12 @@ package body Sem_Ch6 is Next (Prag); - -- Not a pragma, if comes from source, then end scan + -- Not a pragma, if comes from source, then end scan elsif Comes_From_Source (Prag) then exit; - -- Skip stuff not coming from source + -- Skip stuff not coming from source else Next (Prag); @@ -8004,7 +8032,7 @@ package body Sem_Ch6 is end if; -- If we had any postconditions and expansion is enabled, build - -- the Postconditions procedure. + -- the _Postconditions procedure. if Present (Plist) and then Expander_Active @@ -8022,20 +8050,46 @@ package body Sem_Ch6 is Parms := No_List; end if; - Prepend_To (Declarations (N), - Make_Subprogram_Body (Loc, - Specification => - Make_Procedure_Specification (Loc, - Defining_Unit_Name => + declare + Post_Proc : constant Entity_Id := Make_Defining_Identifier (Loc, - Chars => Name_uPostconditions), - Parameter_Specifications => Parms), + Chars => Name_uPostconditions); + -- The entity for the _Postconditions procedure + HSS : constant Node_Id := Handled_Statement_Sequence (N); + Handler : Node_Id; + begin + + Prepend_To (Declarations (N), + Make_Subprogram_Body (Loc, + Specification => + Make_Procedure_Specification (Loc, + Defining_Unit_Name => Post_Proc, + Parameter_Specifications => Parms), + + Declarations => Empty_List, + + Handled_Statement_Sequence => + Make_Handled_Sequence_Of_Statements (Loc, + Statements => Plist))); - Declarations => Empty_List, + -- If this is a procedure, add a call to _postconditions to every + -- place where it could return implicitly (not via a return + -- statement, which are handled elsewhere). This is not necessary + -- for functions, since functions always return via a return + -- statement, or raise an exception. - Handled_Statement_Sequence => - Make_Handled_Sequence_Of_Statements (Loc, - Statements => Plist))); + if Etype (Subp) = Standard_Void_Type then + Add_Post_Call (Statements (HSS), Post_Proc); + + if Present (Exception_Handlers (HSS)) then + Handler := First_Non_Pragma (Exception_Handlers (HSS)); + while Present (Handler) loop + Add_Post_Call (Statements (Handler), Post_Proc); + Next_Non_Pragma (Handler); + end loop; + end if; + end if; + end; if Present (Spec_Id) then Set_Has_Postconditions (Spec_Id); diff --git a/gcc/ada/sinput-l.adb b/gcc/ada/sinput-l.adb index 8bb6778..ac9877f 100644 --- a/gcc/ada/sinput-l.adb +++ b/gcc/ada/sinput-l.adb @@ -518,7 +518,12 @@ package body Sinput.L is Save_Style_Check := Opt.Style_Check; Opt.Style_Check := False; + -- Make sure that there will be no check of pragma Restrictions + -- for obsolescent features while preprocessing the source. + + Scn.Set_Obsolescent_Check (False); Preprocess (Modified); + Scn.Set_Obsolescent_Check (True); -- Reset the scanner to its standard behavior, and restore the -- Style_Checks flag. diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index fc7f992..700034b 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -1011,21 +1011,18 @@ package Snames is -- Additional reserved words and identifiers used in GNAT Project Files -- Note that Name_External is already previously declared + -- The names with the -- GPR annotation are only used in gprbuild - Name_Ada_Roots : constant Name_Id := N + $; Name_Aggregate : constant Name_Id := N + $; Name_Archive_Builder : constant Name_Id := N + $; Name_Archive_Builder_Append_Option : constant Name_Id := N + $; Name_Archive_Indexer : constant Name_Id := N + $; Name_Archive_Suffix : constant Name_Id := N + $; Name_Binder : constant Name_Id := N + $; - Name_Binder_Prefix : constant Name_Id := N + $; Name_Body_Suffix : constant Name_Id := N + $; Name_Builder : constant Name_Id := N + $; - Name_Builder_Switches : constant Name_Id := N + $; Name_Compiler : constant Name_Id := N + $; - Name_Compiler_Command : constant Name_Id := N + $; - Name_Compiler_Kind : constant Name_Id := N + $; + Name_Compiler_Command : constant Name_Id := N + $; -- GPR Name_Config_Body_File_Name : constant Name_Id := N + $; Name_Config_Body_File_Name_Pattern : constant Name_Id := N + $; Name_Config_File_Switches : constant Name_Id := N + $; @@ -1037,7 +1034,6 @@ package Snames is Name_Default_Language : constant Name_Id := N + $; Name_Default_Switches : constant Name_Id := N + $; Name_Dependency_Driver : constant Name_Id := N + $; - Name_Dependency_File_Kind : constant Name_Id := N + $; Name_Dependency_Switches : constant Name_Id := N + $; Name_Driver : constant Name_Id := N + $; Name_Excluded_Source_Dirs : constant Name_Id := N + $; @@ -1051,7 +1047,7 @@ package Snames is Name_Finder : constant Name_Id := N + $; Name_Global_Compilation_Switches : constant Name_Id := N + $; Name_Global_Configuration_Pragmas : constant Name_Id := N + $; - Name_Global_Config_File : constant Name_Id := N + $; + Name_Global_Config_File : constant Name_Id := N + $; -- GPR Name_Gnatls : constant Name_Id := N + $; Name_Gnatstub : constant Name_Id := N + $; Name_Ide : constant Name_Id := N + $; @@ -1062,8 +1058,6 @@ package Snames is Name_Include_Path : constant Name_Id := N + $; Name_Include_Path_File : constant Name_Id := N + $; Name_Inherit_Source_Path : constant Name_Id := N + $; - Name_Language_Kind : constant Name_Id := N + $; - Name_Language_Processing : constant Name_Id := N + $; Name_Languages : constant Name_Id := N + $; Name_Library : constant Name_Id := N + $; Name_Library_Ali_Dir : constant Name_Id := N + $; @@ -1089,7 +1083,7 @@ package Snames is Name_Linker_Executable_Option : constant Name_Id := N + $; Name_Linker_Lib_Dir_Option : constant Name_Id := N + $; Name_Linker_Lib_Name_Option : constant Name_Id := N + $; - Name_Local_Config_File : constant Name_Id := N + $; + Name_Local_Config_File : constant Name_Id := N + $; -- GPR Name_Local_Configuration_Pragmas : constant Name_Id := N + $; Name_Locally_Removed_Files : constant Name_Id := N + $; Name_Map_File_Option : constant Name_Id := N + $; @@ -1109,10 +1103,9 @@ package Snames is Name_Prefix : constant Name_Id := N + $; Name_Project : constant Name_Id := N + $; Name_Project_Dir : constant Name_Id := N + $; - Name_Roots : constant Name_Id := N + $; + Name_Roots : constant Name_Id := N + $; -- GPR Name_Required_Switches : constant Name_Id := N + $; Name_Run_Path_Option : constant Name_Id := N + $; - Name_Runtime_Project : constant Name_Id := N + $; Name_Shared_Library_Minimum_Switches : constant Name_Id := N + $; Name_Shared_Library_Prefix : constant Name_Id := N + $; Name_Shared_Library_Suffix : constant Name_Id := N + $; @@ -1128,7 +1121,6 @@ package Snames is Name_Stack : constant Name_Id := N + $; Name_Switches : constant Name_Id := N + $; Name_Symbolic_Link_Supported : constant Name_Id := N + $; - Name_Sync : constant Name_Id := N + $; Name_Synchronize : constant Name_Id := N + $; Name_Toolchain_Description : constant Name_Id := N + $; Name_Toolchain_Version : constant Name_Id := N + $; |