+2009-07-27 Ed Schonberg <schonberg@adacore.com>
+
+ * 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 <bosch@adacore.com>
+
+ * 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 <rybin@adacore.com>
+
+ * gnat_ugn.texi (gnatcheck Complex_Inlined_Subprograms rule): Update
+ rule definition.
+
+2009-07-27 Olivier Hainque <hainque@adacore.com>
+
+ * g-sse.ads, g-ssvety.ads: Update comments.
+
2009-07-27 Sergey Rybin <rybin@adacore.com>
* gnat_ugn.texi: Update gnatcheck doc.
-- 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)
---------------------
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,
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,
-- 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;
@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
@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
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
-- --
-- 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- --
-- 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;
-- 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,
OSDN Git Service
