2012-05-15 Thomas Quinot <quinot@adacore.com>
+ * uintp.adb (Image_Uint): Use UI_Div_Rem to get quotient and
+ remainder of U / Base in a single operation.
+
+2012-05-15 Robert Dewar <dewar@adacore.com>
+
+ * exp_ch5.adb, inline.adb, sem_ch10.adb, prj.ads, sem_util.adb,
+ a-ngelfu.ads, exp_ch4.adb, exp_ch6.adb, aspects.ads, sem_ch6.adb,
+ vms_data.ads, exp_ch3.adb, prj-env.adb: Minor reformatting.
+
+2012-05-15 Thomas Quinot <quinot@adacore.com>
+
* exp_ch4.adb (Has_Inferable_Discriminants): For a qualified
expression, use correct node for test on the subtype denoted by
the subtype mark.
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
-- apply solely to the Post aspects that have been added to the spec. --
--- Except for these parts of the document, in accordance with the copyright --
--- of that document, you can freely copy and modify this specification, --
--- provided that if you redistribute a modified version, any changes that --
--- you have made are clearly indicated. --
-- --
-- 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- --
-- aspect specifications from the tree. The semantic processing for aspect
-- specifications is found in Sem_Ch13.Analyze_Aspect_Specifications.
+------------------------
+-- Adding New Aspects --
+------------------------
+
-- In general, each aspect should have a corresponding pragma, so that the
-- newly developed functionality is available for Ada versions < Ada 2012.
-- When both are defined, it is convenient to first transform the aspect into
-- an equivalent pragma in Sem_Ch13.Analyze_Aspect_Specifications, and then
-- analyze the pragma in Sem_Prag.Analyze_Pragma.
--- To add a new aspect:
--- * create a name in snames.ads-tmpl
--- * create a value in type Aspect_Id in this unit
--- * add a value for the aspect in the global arrays defined in this unit
--- * add code for analyzing the aspect in
--- Sem_Ch13.Analyze_Aspect_Specifications. This may involve adding some
--- nodes to the tree to perform additional treatments later.
--- * if the semantic analysis of expressions/names in the aspect should not
--- occur at the point the aspect is defined, add code in the adequate
--- semantic analysis procedure for the aspect. For example, this is the case
--- for aspects Pre and Post on subprograms, which are pre-analyzed at the
--- end of the list of declarations to which the subprogram belongs, and
--- fully analyzed (possibly with expansion) during the semantic analysis of
--- subprogram bodies.
-
--- Additionally, to add a corresponding pragma for a new aspect:
--- * create a name for the pragma in snames.ads-tmpl
--- * add code for analyzing the pragma in Sem_Prag.Analyze_Pragma
+-- To add a new aspect, you need to do the following
+
+-- 1. Create a name in snames.ads-tmpl
+
+-- 2. Create a value in type Aspect_Id in this unit
+
+-- 3. Add a value for the aspect in the global arrays defined in this unit
+
+-- 4. Add code for the aspect in Sem_Ch13.Analyze_Aspect_Specifications.
+-- This may involve adding some nodes to the tree to perform additional
+-- treatments later.
+
+-- 5. Ff the semantic analysis of expressions/names in the aspect should not
+-- occur at the point the aspect is defined, add code in the adequate
+-- semantic analysis procedure for the aspect. For example, this is the
+-- case for aspects Pre and Post on subprograms, which are pre-analyzed
+-- at the end of the declaration list to which the subprogram belongs,
+-- and fully analyzed (possibly with expansion) during the semantic
+-- analysis of subprogram bodies.
with Namet; use Namet;
with Snames; use Snames;
Set_Declarations (Body_Node, New_List (
Make_Full_Type_Declaration (Loc,
Defining_Identifier => Acc_Type,
- Type_Definition =>
+ Type_Definition =>
Make_Access_To_Object_Definition (Loc,
All_Present => True,
Null_Exclusion_Present => False,
Make_Selected_Component (Loc,
Prefix =>
Unchecked_Convert_To (Acc_Type,
- Make_Identifier (Loc, Name_uO)),
+ Make_Identifier (Loc, Name_uO)),
Selector_Name =>
New_Reference_To (Iface_Comp, Loc)),
Attribute_Name => Name_Position)))));
elsif Nkind (N) = N_Qualified_Expression then
return Is_Unchecked_Union (Etype (Subtype_Mark (N)))
- and then
- Is_Constrained (Etype (Subtype_Mark (N)));
-
+ and then Is_Constrained (Etype (Subtype_Mark (N)));
end if;
return False;
elsif Has_Controlled_Component (L_Type) then
Loop_Required := True;
- -- If changing scalar storage order and assigning a bit packed arrau,
+ -- If changing scalar storage order and assigning a bit packed array,
-- force loop expansion.
elsif Is_Bit_Packed_Array (L_Type)
- and then
- (In_Reverse_Storage_Order_Record (Rhs)
- /=
- In_Reverse_Storage_Order_Record (Lhs))
+ and then (In_Reverse_Storage_Order_Record (Rhs) /=
+ In_Reverse_Storage_Order_Record (Lhs))
then
Loop_Required := True;
end loop;
-- Handle unchecked conversion of access types generated
- -- in thunks (cf. Expand_Interface_Thunk)
+ -- in thunks (cf. Expand_Interface_Thunk).
elsif Is_Access_Type (Etype (Actual))
and then Nkind (Actual) = N_Unchecked_Type_Conversion
for Index in Inlined.First .. Inlined.Last loop
if not Is_Called (Inlined.Table (Index).Name) then
+
-- This means that Add_Inlined_Body added the subprogram to the
-- table but wasn't able to handle its code unit. Do nothing.
Inlined.Table (Index).Processed := True;
+
elsif Inlined.Table (Index).Main_Call then
Pending_Inlined.Increment_Last;
Pending_Inlined.Table (Pending_Inlined.Last) := Index;
Inlined.Table (Index).Processed := True;
+
else
Set_Is_Called (Inlined.Table (Index).Name, False);
end if;
function Get_Code_Unit_Entity (E : Entity_Id) return Entity_Id is
Unit : Entity_Id := Cunit_Entity (Get_Code_Unit (E));
+
begin
if Ekind (Unit) = E_Package_Body then
Unit := Spec_Entity (Unit);
end if;
+
return Unit;
end Get_Code_Unit_Entity;
return False;
end Has_Initialized_Type;
+ -----------------------------
+ -- In_Main_Unit_Or_Subunit --
+ -----------------------------
+
+ function In_Main_Unit_Or_Subunit (E : Entity_Id) return Boolean is
+ Comp : Node_Id := Cunit (Get_Code_Unit (E));
+
+ begin
+ -- Check whether the subprogram or package to inline is within the main
+ -- unit or its spec or within a subunit. In either case there are no
+ -- additional bodies to process. If the subprogram appears in a parent
+ -- of the current unit, the check on whether inlining is possible is
+ -- done in Analyze_Inlined_Bodies.
+
+ while Nkind (Unit (Comp)) = N_Subunit loop
+ Comp := Library_Unit (Comp);
+ end loop;
+
+ return Comp = Cunit (Main_Unit)
+ or else Comp = Library_Unit (Cunit (Main_Unit));
+ end In_Main_Unit_Or_Subunit;
+
----------------
-- Initialize --
----------------
begin
if Serious_Errors_Detected = 0 then
-
Expander_Active := (Operating_Mode = Opt.Generate_Code);
Push_Scope (Standard_Standard);
To_Clean := New_Elmt_List;
end loop;
end Remove_Dead_Instance;
- -----------------------------
- -- In_Main_Unit_Or_Subunit --
- -----------------------------
-
- function In_Main_Unit_Or_Subunit (E : Entity_Id) return Boolean is
- Comp : Node_Id := Cunit (Get_Code_Unit (E));
-
- begin
- -- Check whether the subprogram or package to inline is within the main
- -- unit or its spec or within a subunit. In either case there are no
- -- additional bodies to process. If the subprogram appears in a parent
- -- of the current unit, the check on whether inlining is possible is
- -- done in Analyze_Inlined_Bodies.
-
- while Nkind (Unit (Comp)) = N_Subunit loop
- Comp := Library_Unit (Comp);
- end loop;
-
- return
- Comp = Cunit (Main_Unit)
- or else Comp = Library_Unit (Cunit (Main_Unit));
- end In_Main_Unit_Or_Subunit;
-
end Inline;
exit when Data = No_Source;
if Data.Unit /= No_Unit_Index then
- if Data.Locally_Removed and then (not Data.Suppressed) then
+ if Data.Locally_Removed and then not Data.Suppressed then
Fmap.Add_Forbidden_File_Name (Data.File);
else
Fmap.Add_To_File_Map
Source := Prj.Element (Iter);
exit when Source = No_Source;
- if (not Source.Suppressed)
+ if not Source.Suppressed
and then Source.Replaced_By = No_Source
and then Source.Path.Name /= No_Path
and then (Source.Language.Config.Kind = File_Based
-- These sources should not be put in the mapping file.
Replaced_By : Source_Id := No_Source;
- -- Indicate the source in an extending project that replaces the current
- -- source.
+ -- Source in an extending project that replaces the current source
File : File_Name_Type := No_File;
-- Canonical file name of the source
-- with_clause on a child unit implies that the implicit with on the
-- parent is also private.
- if Nkind_In
- (Unit (N), N_Package_Declaration, N_Generic_Package_Declaration)
+ if Nkind_In (Unit (N), N_Package_Declaration,
+ N_Generic_Package_Declaration)
then
Set_Private_Present (Withn, Private_Present (Item));
end if;
begin
while Present (Old_Discr) and then Present (New_Discr) loop
-
New_Discr_Id := Defining_Identifier (New_Discr);
-- The subtype mark of the discriminant on the full type has not
function Enclosing_Lib_Unit_Entity
(E : Entity_Id := Current_Scope) return Entity_Id
is
- Unit_Entity : Entity_Id := E;
+ Unit_Entity : Entity_Id;
begin
-- Look for enclosing library unit entity by following scope links.
-- Equivalent to, but faster than indexing through the scope stack.
+ Unit_Entity := E;
while (Present (Scope (Unit_Entity))
and then Scope (Unit_Entity) /= Standard_Standard)
and not Is_Child_Unit (Unit_Entity)
H : constant array (Int range 0 .. 15) of Character :=
"0123456789ABCDEF";
+ Q, R : Uint;
begin
- if U >= Base then
- Image_Uint (U / Base);
+ UI_Div_Rem (U, Base, Q, R);
+
+ if Q > Uint_0 then
+ Image_Uint (Q);
end if;
if Digs_Output = 4 and then Base = Uint_16 then
Digs_Output := 0;
end if;
- Image_Char (H (UI_To_Int (U rem Base)));
+ Image_Char (H (UI_To_Int (R)));
Digs_Output := Digs_Output + 1;
end Image_Uint;
-- Special cases when Right is less than 13 and Left is larger
-- larger than one digit. All of these algorithms depend on the
- -- base being 2 ** 15 We work with Abs (Left) and Abs(Right)
- -- then multiply result by Sign (Left)
+ -- base being 2 ** 15. We work with Abs (Left) and Abs(Right)
+ -- then multiply result by Sign (Left).
if (Right <= Uint_12) and then (Right >= Uint_Minus_12) then
Sign := 1;
end if;
- -- All cases are listed, grouped by mathematical method It is
+ -- All cases are listed, grouped by mathematical method. It is
-- not inefficient to do have this case list out of order since
-- GCC sorts the cases we list.
when 1 =>
return Uint_0;
- -- Powers of two are simple AND's with LS Left Digit GCC
- -- will recognise these constants as powers of 2 and replace
- -- the rem with simpler operations where possible.
+ -- Powers of two are simple AND's with the least significant
+ -- digit of Left. GCC will recognise these constants as
+ -- powers of 2 and replace the rem with simpler operations
+ -- where possible.
-- Least_Sig_Digit might return Negative numbers
-- If B Rem Right = 1 then
-- Left Rem Right = Sum_Of_Digits_Base_B (Left) Rem Right
- -- Note: 2^32 mod 3 = 1
+ -- Note: 2^30 mod 3 = 1
when 3 =>
return UI_From_Int (
return UI_From_Int (
Sign * (Sum_Digits (Left, 1) rem Int (7)));
- -- Note: 2^32 mod 5 = -1
+ -- Note: 2^30 mod 5 = -1
-- Alternating sums might be negative, but rem is always
-- positive hence we must use mod here.
-- (M1 mod m1) = (M2 mod m2) = 1 AND
-- (M1 mod m2) = (M2 mod m1) = 0
- -- So u mod m = (u1 * M1 + u2 * M2) mod m Where u1 = (u mod
+ -- So u mod m = (u1 * M1 + u2 * M2) mod m where u1 = (u mod
-- m1) AND u2 = (u mod m2); Under typical circumstances the
-- last mod m can be done with a (possible) single
-- subtraction.
-- Causes errors to be displayed as soon as they are encountered, rather
-- than after compilation is terminated. If GNAT terminates prematurely
-- or goes into an infinite loop, the last error message displayed may
- -- help to pinpoint the culprit. Use with caution: This qualifier is
- -- intended for use in debugging the compiler proper, and may cause
- -- output of warnings suppressed by pragma.
+ -- help to pinpoint the culprit.
+ --
+ -- Note that this qualifier is intended only for helping to diagnose
+ -- illegal programs when the compiler fails. It disconnects many of the
+ -- normal handling procedures for error messages, and may for example
+ -- cause malfunction of pragma Warnings.
S_GCC_Inline : aliased constant S := "/INLINE=" &
"PRAGMA " &
projects / platform / upstream / linaro-gcc.git / commitdiff