From 58f8748b2c3d7c396a060cdcb14f61bafb65e7e9 Mon Sep 17 00:00:00 2001 From: charlet Date: Mon, 27 Jul 2009 13:33:32 +0000 Subject: [PATCH] 2009-07-27 Ed Schonberg * exp_attr.adb (Expand_Attribute_Reference, case 'Valid): Reset the Is_Known_Valid flag on the temporary created for the value whose validity is being checked. * sem.adb (Do_Unit_And_Dependents): Further code reorganization to handle properly main units that are package specifications. 2009-07-27 Geert Bosch * einfo.ads (Checks_May_Be_Suppressed): Fix typo in comment * sem_aux.ads: Fix typo in comment * sem_util.ads (Is_LHS): Adjust comment to match body 2009-07-27 Sergey Rybin * gnat_ugn.texi (gnatcheck Complex_Inlined_Subprograms rule): Update rule definition. 2009-07-27 Olivier Hainque * g-sse.ads, g-ssvety.ads: Update comments. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@150113 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 24 +++++++++ gcc/ada/einfo.ads | 2 +- gcc/ada/exp_attr.adb | 15 ++++-- gcc/ada/g-sse.ads | 67 +++++++++++++++++-------- gcc/ada/gnat_ugn.texi | 25 ++++++---- gcc/ada/sem.adb | 136 +++++++++++++++++++++++++------------------------- gcc/ada/sem_aux.ads | 4 +- gcc/ada/sem_util.ads | 6 +-- 8 files changed, 167 insertions(+), 112 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 5e68e47219b..45ce028e78c 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,27 @@ +2009-07-27 Ed Schonberg + + * exp_attr.adb (Expand_Attribute_Reference, case 'Valid): Reset the + Is_Known_Valid flag on the temporary created for the value whose + validity is being checked. + + * sem.adb (Do_Unit_And_Dependents): Further code reorganization to + handle properly main units that are package specifications. + +2009-07-27 Geert Bosch + + * einfo.ads (Checks_May_Be_Suppressed): Fix typo in comment + * sem_aux.ads: Fix typo in comment + * sem_util.ads (Is_LHS): Adjust comment to match body + +2009-07-27 Sergey Rybin + + * gnat_ugn.texi (gnatcheck Complex_Inlined_Subprograms rule): Update + rule definition. + +2009-07-27 Olivier Hainque + + * g-sse.ads, g-ssvety.ads: Update comments. + 2009-07-27 Sergey Rybin * gnat_ugn.texi: Update gnatcheck doc. diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 7a17efd9f7a..e2f1cbe0575 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -491,7 +491,7 @@ package Einfo is -- Present in all entities. Set if a pragma Suppress or Unsuppress -- mentions the entity specifically in the second argument. If this -- flag is set the Global_Entity_Suppress and Local_Entity_Suppress --- tables must be consulted to determine if the is actually an active +-- tables must be consulted to determine if there actually is an active -- Suppress or Unsuppress pragma that applies to the entity. -- Class_Wide_Type (Node9) diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 2df553c4585..599d0ca5323 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -4682,13 +4682,23 @@ package body Exp_Attr is --------------------- function Make_Range_Test return Node_Id is + Temp : constant Node_Id := Duplicate_Subexpr (Pref); + begin + -- The value whose validity is being checked has been captured in + -- an object declaration. We certainly don't want this object to + -- appear valid because the declaration initializes it! + + if Is_Entity_Name (Temp) then + Set_Is_Known_Valid (Entity (Temp), False); + end if; + return Make_And_Then (Loc, Left_Opnd => Make_Op_Ge (Loc, Left_Opnd => - Unchecked_Convert_To (Btyp, Duplicate_Subexpr (Pref)), + Unchecked_Convert_To (Btyp, Temp), Right_Opnd => Unchecked_Convert_To (Btyp, @@ -4699,8 +4709,7 @@ package body Exp_Attr is Right_Opnd => Make_Op_Le (Loc, Left_Opnd => - Unchecked_Convert_To (Btyp, - Duplicate_Subexpr_No_Checks (Pref)), + Unchecked_Convert_To (Btyp, Temp), Right_Opnd => Unchecked_Convert_To (Btyp, diff --git a/gcc/ada/g-sse.ads b/gcc/ada/g-sse.ads index d7b01a991be..8ce2b5d902d 100644 --- a/gcc/ada/g-sse.ads +++ b/gcc/ada/g-sse.ads @@ -44,43 +44,68 @@ -- This unit exposes vector _component_ types together with general comments -- on the binding contents. --- As of today, one other unit is offered: GNAT.SSE.Vector__Types, which +-- One other unit is offered as of today: GNAT.SSE.Vector_Types, which -- exposes Ada types corresponding to the reference types (__m128 and the --- like) over which GCC builtins will operate. The exposed Ada types are --- private. Object initializations or value observations may be performed --- with unchecked conversions or address overlays, for example: +-- like) over which a binding to the SSE GCC builtins may operate. + +-- The exposed Ada types are private. Object initializations or value +-- observations may be performed with unchecked conversions or address +-- overlays, for example: -- with Ada.Unchecked_Conversion; --- with GNAT.SSE.Vector_Types; use GNAT.SSE; use GNAT.SSE.Vector_Types; +-- with GNAT.SSE.Vector_Types; use GNAT.SSE, GNAT.SSE.Vector_Types; -- procedure SSE_Base is -- -- Core operations --- function mm_add_ss (A, B : M128) return M128; --- pragma Import (Intrinsic, mm_add_ss, "__builtin_ia32_addss"); +-- function ia32_addps (A, B : m128) return m128; +-- pragma Import (Intrinsic, ia32_addps, "__builtin_ia32_addps"); --- -- User views / conversions or overlays +-- -- User views & conversions --- type Vf32_View is array (1 .. 4) of Float; +-- type Vf32_View is array (1 .. 4) of GNAT.SSE.Float32; -- for Vf32_View'Alignment use VECTOR_ALIGN; --- function To_M128 is new Ada.Unchecked_Conversion (Vf32_View, M128); +-- function To_m128 is new Ada.Unchecked_Conversion (Vf32_View, m128); --- X, Y, Z : M128; +-- Xf32 : constant Vf32_View := (1.0, 1.0, 2.0, 2.0); +-- Yf32 : constant Vf32_View := (2.0, 2.0, 1.0, 1.0); --- Vz : Vf32_View; --- for Vz'Address use Z'Address; +-- X128 : constant m128 := To_m128 (Xf32); +-- Y128 : constant m128 := To_m128 (Yf32); -- begin --- X := To_M128 ((1.0, 1.0, 2.0, 2.0)); --- Y := To_M128 ((2.0, 2.0, 1.0, 1.0)); --- Z := mm_add_ss (X, Y); - --- if vz /= (3.0, 1.0, 2.0, 2.0) then --- raise Program_Error; --- end if; --- end; +-- -- Operations & overlays + +-- declare +-- Z128 : m128; +-- Zf32 : Vf32_View; +-- for Zf32'Address use Z128'Address; +-- begin +-- Z128 := ia32_addps (X128, Y128); +-- if Zf32 /= (3.0, 3.0, 3.0, 3.0) then +-- raise Program_Error; +-- end if; +-- end; + +-- declare +-- type m128_View_Kind is (SSE, F32); +-- type m128_Object (View : m128_View_Kind := F32) is record +-- case View is +-- when SSE => V128 : m128; +-- when F32 => Vf32 : Vf32_View; +-- end case; +-- end record; +-- pragma Unchecked_Union (m128_Object); + +-- O1 : constant m128_Object := (View => SSE, V128 => X128); +-- begin +-- if O1.Vf32 /= Xf32 then +-- raise Program_Error; +-- end if; +-- end; +-- end SSE_Base; package GNAT.SSE is type Float32 is new Float; diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index bec5bbb6f38..a1bb7bf306c 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -21209,20 +21209,23 @@ This rule has no parameters. @cindex @code{Complex_Inlined_Subprograms} rule (for @command{gnatcheck}) @noindent -Flags the body of a subprogram (or generic subprogram) if -pragma Inline has been applied to the subprogram but the body -is too complex to be expanded inline. - -A subprogram (or generic subprogram) is considered too complex for inline -expansion if its body meets at least one of the following conditions: +Flags a subprogram (or generic subprogram) if +pragma Inline is applied to the subprogram and at least one of the following +conditions is met: @itemize @bullet @item -The number of local declarations and statements exceeds -a value specified by the @option{N} rule parameter; +it contains at least one complex declaration such as a subprogram body, +package, task, protected object declaration, or a generic instantiation +(except instantiation of @code{Ada.Unchecked_Conversion}); @item -The body contains a @code{loop}, @code{if} or @code{case} statement; +it contains at least one complex statement such as a loop, a case +or a if statement, or a short circuit control form; + +@item +the number of statements exceeds +a value specified by the @option{N} rule parameter; @end itemize @noindent @@ -21230,8 +21233,8 @@ This rule has the following (mandatory) parameter for the @option{+R} option: @table @emph @item N -Positive integer specifying the maximum allowed total number of local -declarations and statements in the subprogram body. +Positive integer specifying the maximum allowed total number of statements +in the subprogram body. @end table diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb index 94b2acf3a48..69c4497f135 100644 --- a/gcc/ada/sem.adb +++ b/gcc/ada/sem.adb @@ -1691,104 +1691,102 @@ package body Sem is begin if not Seen (Unit_Num) then - Seen (Unit_Num) := True; - - -- Process corresponding spec of body first - - if Nkind_In (Item, N_Package_Body, N_Subprogram_Body) then - declare - Spec_Unit : constant Node_Id := Library_Unit (CU); - begin - if Spec_Unit = CU then -- ???Why needed? - pragma Assert (Acts_As_Spec (CU)); - null; - else - Do_Unit_And_Dependents (Spec_Unit, Unit (Spec_Unit)); - end if; - end; - end if; - -- Process the with clauses Do_Withed_Units (CU, Include_Limited => False); - -- Process the unit itself + -- Process the unit if it is a spec. If it is the main unit, + -- process it only if we have done all other units. if not Nkind_In (Item, N_Package_Body, N_Subprogram_Body) or else Acts_As_Spec (CU) - or else (CU = Cunit (Main_Unit) and then Do_Main) then - Do_Action (CU, Item); - Done (Unit_Num) := True; + if CU = Cunit (Main_Unit) and then not Do_Main then + Seen (Unit_Num) := False; + + else + Seen (Unit_Num) := True; + Do_Action (CU, Item); + Done (Unit_Num) := True; + end if; end if; end if; - -- Process corresponding body of spec last. This is either the main - -- unit, or the body of a spec that is in the context of the main - -- unit, and that is instantiated, or else contains a generic that - -- is instantiated, or a subprogram that is inlined in the main unit. + -- Process bodies. The spec, if present, has been processed already. + -- A body appears if it is the main, or the body of a spec that is + -- in the context of the main unit, and that is instantiated, or else + -- contains a generic that is instantiated, or a subprogram that is + -- or a subprogram that is inlined in the main unit. -- We exclude bodies that may appear in a circular dependency list, -- where spec A depends on spec B and body of B depends on spec A. -- This is not an elaboration issue, but body B must be excluded -- from the processing. - if Nkind (Item) = N_Package_Declaration then - declare - Body_Unit : constant Node_Id := Library_Unit (CU); + declare + Body_Unit : Node_Id := Empty; + Body_Num : Unit_Number_Type; - function Circular_Dependence (B : Node_Id) return Boolean; - -- Check whether this body depends on a spec that is pending, - -- that is to say has been seen but not processed yet. + function Circular_Dependence (B : Node_Id) return Boolean; + -- Check whether this body depends on a spec that is pending, + -- that is to say has been seen but not processed yet. - ------------------------- - -- Circular_Dependence -- - ------------------------- + ------------------------- + -- Circular_Dependence -- + ------------------------- - function Circular_Dependence (B : Node_Id) return Boolean is - Item : Node_Id; - UN : Unit_Number_Type; + function Circular_Dependence (B : Node_Id) return Boolean is + Item : Node_Id; + UN : Unit_Number_Type; - begin - Item := First (Context_Items (B)); - while Present (Item) loop - if Nkind (Item) = N_With_Clause then - UN := Get_Cunit_Unit_Number (Library_Unit (Item)); - - if Seen (UN) - and then not Done (UN) - then - return True; - end if; + begin + Item := First (Context_Items (B)); + while Present (Item) loop + if Nkind (Item) = N_With_Clause then + UN := Get_Cunit_Unit_Number (Library_Unit (Item)); + + if Seen (UN) + and then not Done (UN) + then + return True; end if; + end if; - Next (Item); - end loop; + Next (Item); + end loop; - return False; - end Circular_Dependence; + return False; + end Circular_Dependence; - begin - if Present (Body_Unit) + begin + if Nkind (Item) = N_Package_Declaration then + Body_Unit := Library_Unit (CU); - -- Since specs and bodies are not done at the same time, - -- guard against listing a body more than once. + elsif Nkind (Item) = N_Package_Body then + Body_Unit := CU; + end if; - and then not Seen (Get_Cunit_Unit_Number (Body_Unit)) + if Present (Body_Unit) - -- Would be good to comment each of these tests ??? + -- Since specs and bodies are not done at the same time, + -- guard against listing a body more than once. Bodies are + -- only processed when the main unit is being processed, + -- after all other units in the list. The DEC extension + -- to System is excluded because of circularities. - and then Body_Unit /= Cunit (Main_Unit) - and then Unit_Num /= Get_Source_Unit (System_Aux_Id) - and then not Circular_Dependence (Body_Unit) - and then Do_Main - then - Do_Unit_And_Dependents (Body_Unit, Unit (Body_Unit)); - Do_Action (Body_Unit, Unit (Body_Unit)); - Done (Get_Cunit_Unit_Number (Body_Unit)) := True; - end if; - end; - end if; + and then not Seen (Get_Cunit_Unit_Number (Body_Unit)) + and then + (No (System_Aux_Id) + or else Unit_Num /= Get_Source_Unit (System_Aux_Id)) + and then not Circular_Dependence (Body_Unit) + and then Do_Main + then + Body_Num := Get_Cunit_Unit_Number (Body_Unit); + Seen (Body_Num) := True; + Do_Action (Body_Unit, Unit (Body_Unit)); + Done (Body_Num) := True; + end if; + end; end Do_Unit_And_Dependents; -- Local Declarations diff --git a/gcc/ada/sem_aux.ads b/gcc/ada/sem_aux.ads index f8467446130..464a764a3e3 100755 --- a/gcc/ada/sem_aux.ads +++ b/gcc/ada/sem_aux.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2008, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2009, 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- -- @@ -36,7 +36,7 @@ -- Historical note. Many of the routines here were originally in Einfo, but -- Einfo is supposed to be a relatively low level package dealing with the -- content of entities in the tree, so this package is used for routines that --- require more than minimal semantic knowldge. +-- require more than minimal semantic knowledge. with Alloc; use Alloc; with Table; diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 5906d98677b..81dcf1f216c 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -705,11 +705,7 @@ package Sem_Util is -- by a derived type declarations. function Is_LHS (N : Node_Id) return Boolean; - -- Returns True iff N is an identifier used as Name in an assignment - -- statement. - -- Which is true, the spec or the body??? - -- The body does not restrict N to be an identifier, it can be any - -- expression on the left side of an assignment ??? + -- Returns True iff N is used as Name in an assignment statement. function Is_Library_Level_Entity (E : Entity_Id) return Boolean; -- A library-level declaration is one that is accessible from Standard, -- 2.11.0