From 03a72cd36ee1a0d2bb412f7e7353e30512627fe3 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 20 Oct 2015 14:05:48 +0200 Subject: [PATCH] [multiple changes] 2015-10-20 Yannick Moy * exp_ch9.adb (Expand_Entry_Barrier): Default initialize local variable Func. 2015-10-20 Jerome Lambourg * init.c (__gnat_error_handler for vxworks): Force SPE bit in the MSR when handling signals 2015-10-20 Arnaud Charlet * einfo.ads, sem_ch12.adb, sem_ch6.adb, table.ads, s-stposu.ads, g-table.ads, g-dyntab.ads, makeutl.ads, a-crdlli.ads: Fix typos. 2015-10-20 Ed Schonberg * sem_ch5.adb (Analyze_Loop_Statement): Element iterators over multidimensional arrays create additional loops during expansion. For such loops we create a label as a scope name. Attach this label properly to tree, for use in GNATProve over such element iterators. * sem_attr.adb (Analyze_Attribute, case Loop_Entry): The loop to which the attribute applies comes from source, not from expansion of an element iterator or a quantified expression. * exp_attr.adb (Expand_N_Attribute_Reference): Ditto. From-SVN: r229057 --- gcc/ada/ChangeLog | 27 +++++++++++++++++++++++++++ gcc/ada/a-crdlli.ads | 4 ++-- gcc/ada/einfo.ads | 4 ++-- gcc/ada/exp_attr.adb | 6 ++++-- gcc/ada/exp_ch9.adb | 7 ++++++- gcc/ada/g-dyntab.ads | 4 ++-- gcc/ada/g-table.ads | 4 ++-- gcc/ada/init.c | 15 +++++++++++++++ gcc/ada/makeutl.ads | 2 +- gcc/ada/s-stposu.ads | 4 ++-- gcc/ada/sem_attr.adb | 5 ++++- gcc/ada/sem_ch12.adb | 2 +- gcc/ada/sem_ch5.adb | 7 +++++-- gcc/ada/sem_ch6.adb | 2 +- gcc/ada/table.ads | 6 +++--- 15 files changed, 77 insertions(+), 22 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 4022dfc0a07..fda8e8bbf93 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,30 @@ +2015-10-20 Yannick Moy + + * exp_ch9.adb (Expand_Entry_Barrier): Default initialize local variable + Func. + +2015-10-20 Jerome Lambourg + + * init.c (__gnat_error_handler for vxworks): Force + SPE bit in the MSR when handling signals + +2015-10-20 Arnaud Charlet + + * einfo.ads, sem_ch12.adb, sem_ch6.adb, table.ads, s-stposu.ads, + g-table.ads, g-dyntab.ads, makeutl.ads, a-crdlli.ads: Fix typos. + +2015-10-20 Ed Schonberg + + * sem_ch5.adb (Analyze_Loop_Statement): Element iterators + over multidimensional arrays create additional loops during + expansion. For such loops we create a label as a scope + name. Attach this label properly to tree, for use in GNATProve + over such element iterators. + * sem_attr.adb (Analyze_Attribute, case Loop_Entry): The loop to + which the attribute applies comes from source, not from expansion + of an element iterator or a quantified expression. + * exp_attr.adb (Expand_N_Attribute_Reference): Ditto. + 2015-10-20 Ed Schonberg * exp_ch6.adb (Expand_Call): Check for a call to a function diff --git a/gcc/ada/a-crdlli.ads b/gcc/ada/a-crdlli.ads index c18005fc720..151d3f94a0b 100644 --- a/gcc/ada/a-crdlli.ads +++ b/gcc/ada/a-crdlli.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2004-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 2004-2015, 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- -- @@ -208,7 +208,7 @@ package Ada.Containers.Restricted_Doubly_Linked_Lists is Before : Cursor; Position : in out Cursor); -- If Before is associated with a list object different from Container, - -- then Program_Error is raised. If Position equals No_element, then + -- then Program_Error is raised. If Position equals No_Element, then -- Constraint_Error is raised; if it associated with a list object -- different from Container, then Program_Error is raised. Otherwise, the -- node designated by Position is relinked immediately prior to Before. If diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index f536615d733..58d3ba866f3 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -2031,7 +2031,7 @@ package Einfo is -- their subtypes have unknown discriminants and can have declared ones -- as well. Private types declared with unknown discriminants may have a -- full view that has explicit discriminants, and both flag will be set --- on the partial view, to insure that discriminants are properly +-- on the partial view, to ensure that discriminants are properly -- inherited in certain contexts. -- Has_Visible_Refinement (Flag263) @@ -3460,7 +3460,7 @@ package Einfo is -- Next_Inlined_Subprogram (Node12) -- Defined in subprograms. Used to chain inlined subprograms used in -- the current compilation, in the order in which they must be compiled --- by the backend to insure that all inlinings are performed. +-- by the backend to ensure that all inlinings are performed. -- Next_Literal (synthesized) -- Applies to enumeration literals, returns the next literal, or diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 87819271f4e..f6f22f00473 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -1012,13 +1012,15 @@ package body Exp_Attr is Loop_Stmt := Label_Construct (Parent (Loop_Id)); -- Climb the parent chain to find the nearest enclosing loop. Skip all - -- internally generated loops for quantified expressions. + -- internally generated loops for quantified expressions and for + -- element iterators over multidimensional arrays: pragma applies to + -- source loop. else Loop_Stmt := N; while Present (Loop_Stmt) loop if Nkind (Loop_Stmt) = N_Loop_Statement - and then Present (Identifier (Loop_Stmt)) + and then Comes_From_Source (Loop_Stmt) then exit; end if; diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index f0276350013..3e13126a481 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -6184,7 +6184,7 @@ package body Exp_Ch9 is Condition (Entry_Body_Formal_Part (N)); Prot : constant Entity_Id := Scope (Ent); Spec_Decl : constant Node_Id := Parent (Prot); - Func : Entity_Id; + Func : Entity_Id := Empty; B_F : Node_Id; Body_Decl : Node_Id; @@ -6206,6 +6206,11 @@ package body Exp_Ch9 is S := Scope (E); if Ekind (E) = E_Variable then + + -- If the variable is local to the barrier function generated + -- during expansion, it is ok. If expansion is not performed, + -- then Func is Empty so this test cannot succeed. + if Scope (E) = Func then null; diff --git a/gcc/ada/g-dyntab.ads b/gcc/ada/g-dyntab.ads index cfffd2f8947..59d993200aa 100644 --- a/gcc/ada/g-dyntab.ads +++ b/gcc/ada/g-dyntab.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2000-2013, AdaCore -- +-- Copyright (C) 2000-2015, AdaCore -- -- -- -- 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- -- @@ -58,7 +58,7 @@ generic package GNAT.Dynamic_Tables is -- Table_Component_Type and Table_Index_Type specify the type of the - -- array, Table_Low_Bound is the lower bound. Index_type must be an + -- array, Table_Low_Bound is the lower bound. Table_Index_Type must be an -- integer type. The effect is roughly to declare: -- Table : array (Table_Low_Bound .. <>) of Table_Component_Type; diff --git a/gcc/ada/g-table.ads b/gcc/ada/g-table.ads index c9b75f61648..1b4b04c492d 100644 --- a/gcc/ada/g-table.ads +++ b/gcc/ada/g-table.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1998-2013, AdaCore -- +-- Copyright (C) 1998-2015, AdaCore -- -- -- -- 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- -- @@ -57,7 +57,7 @@ package GNAT.Table is pragma Elaborate_Body; -- Table_Component_Type and Table_Index_Type specify the type of the - -- array, Table_Low_Bound is the lower bound. Index_type must be an + -- array, Table_Low_Bound is the lower bound. Table_Index_Type must be an -- integer type. The effect is roughly to declare: -- Table : array (Table_Index_Type range Table_Low_Bound .. <>) diff --git a/gcc/ada/init.c b/gcc/ada/init.c index c76ae646b67..1db30099317 100644 --- a/gcc/ada/init.c +++ b/gcc/ada/init.c @@ -46,6 +46,7 @@ that the __vxworks header appear before any other include. */ #ifdef __vxworks #include "vxWorks.h" +#include "version.h" /* for _WRS_VXWORKS_MAJOR */ #endif #ifdef __ANDROID__ @@ -1916,6 +1917,20 @@ __gnat_error_handler (int sig, siginfo_t *si, void *sc) { sigset_t mask; + /* VxWorks 7 on e500v2 clears the SPE bit of the MSR when entering CPU + exception state. To allow the handler and exception to work properly + when they contain SPE instructions, we need to set it back before doing + anything else. */ +#if (CPU == PPCE500V2) && (_WRS_VXWORKS_MAJOR == 7) + register unsigned msr; + /* Read the MSR value */ + asm volatile ("mfmsr %0" : "=r" (msr)); + /* Force the SPE bit */ + msr |= 0x02000000; + /* Store to MSR */ + asm volatile ("mtmsr %0" : : "r" (msr)); +#endif + /* VxWorks will always mask out the signal during the signal handler and will reenable it on a longjmp. GNAT does not generate a longjmp to return from a signal handler so the signal will still be masked unless diff --git a/gcc/ada/makeutl.ads b/gcc/ada/makeutl.ads index e012e9426ba..185569bca19 100644 --- a/gcc/ada/makeutl.ads +++ b/gcc/ada/makeutl.ads @@ -306,7 +306,7 @@ package Makeutl is -- least equal to Minimum_Verbosity, then print Prefix to standard output -- followed by N1 and S1. If N2 /= No_Name then N2 is printed after S1. S2 -- is printed last. Both N1 and N2 are printed in quotation marks. The two - -- forms differ only in taking Name_Id or File_name_Type arguments. + -- forms differ only in taking Name_Id or File_Name_Type arguments. ------------------------- -- Program termination -- diff --git a/gcc/ada/s-stposu.ads b/gcc/ada/s-stposu.ads index 68f6b17920d..f473dc279b9 100644 --- a/gcc/ada/s-stposu.ads +++ b/gcc/ada/s-stposu.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2011-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 2011-2015, Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- @@ -106,7 +106,7 @@ package System.Storage_Pools.Subpools is (Pool : in out Root_Storage_Pool_With_Subpools) return not null Subpool_Handle; -- Return a common subpool which is used for object allocations without a - -- Subpool_Handle_name in the allocator. The default implementation of this + -- Subpool_Handle_Name in the allocator. The default implementation of this -- routine raises Program_Error. function Pool_Of_Subpool diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 20ce9df0f13..fc24b35fa9b 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -4284,10 +4284,13 @@ package body Sem_Attr is -- Locate the enclosing loop (if any). Note that Ada 2012 array -- iteration may be expanded into several nested loops, we are - -- interested in the outermost one which has the loop identifier. + -- interested in the outermost one which has the loop identifier, + -- and comes from source. elsif Nkind (Stmt) = N_Loop_Statement and then Present (Identifier (Stmt)) + and then Comes_From_Source (Original_Node (Stmt)) + and then Nkind (Original_Node (Stmt)) = N_Loop_Statement then Enclosing_Loop := Stmt; diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 3410973a306..18e3e387429 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -5004,7 +5004,7 @@ package body Sem_Ch12 is end loop; if No (Renaming_Decl) then - Append (Unit_Renaming, Renaming_List); + Append (Unit_Renaming, Renaming_List); end if; end Build_Subprogram_Renaming; diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 4f60c96acda..d340b8f385a 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -3215,12 +3215,15 @@ package body Sem_Ch5 is end if; end if; - -- Case of no identifier present + -- Case of no identifier present. Create one and attach it to the + -- loop statement for use as a scope and as a reference for later + -- expansions. Indicate that the label does not come from source. else Ent := New_Internal_Entity (E_Loop, Current_Scope, Loc, 'L'); Set_Etype (Ent, Standard_Void_Type); - Set_Parent (Ent, N); + Set_Identifier (N, New_Occurrence_Of (Ent, Loc)); + Set_Has_Created_Identifier (N); end if; -- Iteration over a container in Ada 2012 involves the creation of a diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 927a4762a89..f626ea4b4a3 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -6798,7 +6798,7 @@ package body Sem_Ch6 is Next_Formal (Formal); end loop; - -- If Extra_formals were already created, don't do it again. This + -- If Extra_Formals were already created, don't do it again. This -- situation may arise for subprogram types created as part of -- dispatching calls (see Expand_Dispatching_Call) diff --git a/gcc/ada/table.ads b/gcc/ada/table.ads index 2b398d762cd..4788016738c 100644 --- a/gcc/ada/table.ads +++ b/gcc/ada/table.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2015, 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- -- @@ -55,8 +55,8 @@ package Table is package Table is -- Table_Component_Type and Table_Index_Type specify the type of the - -- array, Table_Low_Bound is the lower bound. Index_type must be an - -- integer type. The effect is roughly to declare: + -- array, Table_Low_Bound is the lower bound. Table_Index_Type must be + -- an integer type. The effect is roughly to declare: -- Table : array (Table_Index_Type range Table_Low_Bound .. <>) -- of Table_Component_Type; -- 2.30.2