* s-atacco.ads, a-direio.adb: Protect use of 'Constrained by warnings

	on/off, since this is an obsolescent feature, for which we now generate
	a warning.

	* sem_attr.adb (Analyze_Attribute, case Constrained): Issue warning if
	warning mode is set and obsolescent usage of this attribute occurs.
	(Resolve_Access, case 'Access): Note that GNAT uses the context type to
	disambiguate overloaded prefixes, in accordance with AI-235. GNAT code
	predates, and partly motivates, the adoption of the AI.
	Implement new Ada 2005 attribute Mod

	* exp_attr.adb (Expand_N_Attribute_Reference): Implement Ada 2005
	attribute Mod.

	* par-ch4.adb (P_Name): In Ada 2005 mode, recognize new attribute Mod

	* snames.h, snames.ads, snames.adb: Add entry for No_Dependence for
	pragma restrictions.
	New entry for Ada 2005 attribute Mod.

	* par-prag.adb:
	Add recognition of new pragma Restrictions No_Dependence
	Recognize restriction No_Obsolescent_Features at parse time

	* bcheck.adb: Add circuitry for checking for consistency of
	No_Dependence restrictions.

	* lib-writ.ads, lib-writ.adb: Output new R lines for No_Dependence
	restrictions.

	* restrict.ads, restrict.adb: Add subprograms to deal with
	No_Dependence restrictions.

	* rtsfind.adb: Check that implicit with's do not violate No_Dependence
	restrictions.

	* sem_ch3.adb, sem_ch11.adb, sem_ch13.adb, lib-xref.adb,
	sem_attr.adb: Add check for new restriction No_Obsolescent_Features

	* scn.ads, prj-err.ads, prj-err.adb, ali-util.adb, gprep.adb: Add new
	dummy parameter to scng instantiation.
	Needed for new restriction No_Obsolescent_Features

	* scn.adb: (Obsolescent_Check): New procedure
	Needed for new restriction No_Obsolescent_Features

	* scng.ads, scng.adb: Always allow wide characters in Ada 2005 mode, as
	specified by AI-285, needed for implementation of AI-388 (adding greek
	pi to Ada.Numerics).
	Add new generic formal to scng, needed for new restriction
	No_Obsolescent_Features.

	* s-rident.ads: Add new restriction No_Obsolescent_Features.

	* ali.ads, ali.adb: Adjustments for reading new No_Dependence
	restrictions lines.
	(Scan_ALI): When finding an unexpected character on an R line, raise
	exception Bad_R_Line, instead of calling Fatal_Error, so that, when
	Ignore_Errors is True, default restrictions are set and scanning of the
	ALI file continues with the next line. Also, when Bad_R_Line is raised
	and Ignore_Errors is True, skip to the end of le line.

	* sem_ch10.adb: Check that explicit with's do not violate
	No_Dependence restrictions.
	(Install_Withed_Unit): Add code to implement AI-377 and diagnose
	illegal context clauses containing child units of instance.

	* sem_prag.adb: Processing and checking for new No_Dependence
	restrictions.
	(Analyze_Pragma, case Psect_Object): Call Check_Arg_Is_External_Name to
	analyze and check the External argument.

	* a-numeri.ads: Add greek letter pi as alternative spelling of Pi


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@92829 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 81 insertions, 0 deletions

diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index ae9a5cb0984..fa99d8bd1ad 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -2324,6 +2324,87 @@ package body Exp_Attr is
          Analyze_And_Resolve (N, Typ);
       end Mantissa;
 
+      ---------
+      -- Mod --
+      ---------
+
+      when Attribute_Mod => Mod_Case : declare
+         Arg  : constant Node_Id := Relocate_Node (First (Exprs));
+         Hi   : constant Node_Id := Type_High_Bound (Etype (Arg));
+         Modv : constant Uint    := Modulus (Btyp);
+
+      begin
+
+         --  This is not so simple. The issue is what type to use for the
+         --  computation of the modular value.
+
+         --  The easy case is when the modulus value is within the bounds
+         --  of the signed integer type of the argument. In this case we can
+         --  just do the computation in that signed integer type, and then
+         --  do an ordinary conversion to the target type.
+
+         if Modv <= Expr_Value (Hi) then
+            Rewrite (N,
+              Convert_To (Btyp,
+                Make_Op_Mod (Loc,
+                  Left_Opnd  => Arg,
+                  Right_Opnd => Make_Integer_Literal (Loc, Modv))));
+
+         --  Here we know that the modulus is larger than type'Last of the
+         --  integer type. There are three possible cases to consider:
+
+         --    a) The integer value is non-negative. In this case, it is
+         --    returned as the result (since it is less than the modulus).
+
+         --    b) The integer value is negative. In this case, we know that
+         --    the result is modulus + value, where the value might be as
+         --    small as -modulus. The trouble is what type do we use to do
+         --    this subtraction. No type will do, since modulus can be as
+         --    big as 2**64, and no integer type accomodates this value.
+         --    Let's do a bit of algebra
+
+         --         modulus + value
+         --      =  modulus - (-value)
+         --      =  (modulus - 1) - (-value - 1)
+
+         --    Now modulus - 1 is certainly in range of the modular type.
+         --    -value is in the range 1 .. modulus, so -value -1 is in the
+         --    range 0 .. modulus-1 which is in range of the modular type.
+         --    Furthermore, (-value - 1) can be expressed as -(value + 1)
+         --    which we can compute using the integer base type.
+
+         else
+            Rewrite (N,
+              Make_Conditional_Expression (Loc,
+                Expressions => New_List (
+                  Make_Op_Ge (Loc,
+                    Left_Opnd  => Duplicate_Subexpr (Arg),
+                    Right_Opnd => Make_Integer_Literal (Loc, 0)),
+
+                  Convert_To (Btyp,
+                    Duplicate_Subexpr_No_Checks (Arg)),
+
+                  Make_Op_Subtract (Loc,
+                    Left_Opnd =>
+                      Make_Integer_Literal (Loc,
+                        Intval => Modv - 1),
+                    Right_Opnd =>
+                      Convert_To (Btyp,
+                        Make_Op_Minus (Loc,
+                          Right_Opnd =>
+                            Make_Op_Add (Loc,
+                              Left_Opnd  => Duplicate_Subexpr_No_Checks (Arg),
+                              Right_Opnd =>
+                                Make_Integer_Literal (Loc,
+                                  Intval => 1))))))));
+
+
+
+         end if;
+
+         Analyze_And_Resolve (N, Btyp);
+      end Mod_Case;
+
       -----------
       -- Model --
       -----------