summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--gcc/ada/ChangeLog31
-rw-r--r--gcc/ada/exp_ch6.adb7
-rw-r--r--gcc/ada/makeusg.adb4
-rw-r--r--gcc/ada/sem_ch5.adb12
-rw-r--r--gcc/ada/types.ads5
-rw-r--r--gcc/ada/uintp.adb79
-rw-r--r--gcc/ada/uintp.ads13
-rw-r--r--gcc/ada/vms_data.ads14
8 files changed, 84 insertions, 81 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 4a3d5ef4d7c..3bb621317f7 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,34 @@
+2010-06-22 Gary Dismukes <dismukes@adacore.com>
+
+ * sem_ch5.adb (Analyze_Assignment): Revise test for illegal assignment
+ to abstract targets to check that the type is tagged and comes from
+ source, rather than only testing for targets of interface types. Remove
+ premature return.
+
+2010-06-22 Vincent Celier <celier@adacore.com>
+
+ * vms_data.ads: Modify the declarations of qualifiers
+ /UNCHECKED_SHARED_LIB_IMPORTS to allow the generation of gnat.hlp
+ without error.
+
+2010-06-22 Ed Schonberg <schonberg@adacore.com>
+
+ * exp_ch6.adb (Is_Build_In_Place_Function): Predicate is false if
+ expansion is disabled.
+
+2010-06-22 Robert Dewar <dewar@adacore.com>
+
+ * makeusg.adb: Minor reformatting.
+
+2010-06-22 Robert Dewar <dewar@adacore.com>
+
+ * types.ads: (Dint): Removed, no longer used anywhere.
+ * uintp.adb (UI_From_CC): Use UI_From_Int, range is sufficient.
+ (UI_Mul): Avoid use of UI_From_Dint.
+ (UI_From_Dint): Removed, not used.
+ * uintp.ads (UI_From_Dint): Removed, not used.
+ (Uint_Min/Max_Simple_Mul): New constants.
+
2010-06-22 Vincent Celier <celier@adacore.com>
* clean.adb (Parse_Cmd_Line): Recognize switch
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 351d18e2bb0..61a180f55b2 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -4764,6 +4764,13 @@ package body Exp_Ch6 is
function Is_Build_In_Place_Function (E : Entity_Id) return Boolean is
begin
+ -- This function is called in some rare cases when expansion is off.
+ -- In those cases the build_in_place expansion will not take place.
+
+ if not Expander_Active then
+ return False;
+ end if;
+
-- For now we test whether E denotes a function or access-to-function
-- type whose result subtype is inherently limited. Later this test may
-- be revised to allow composite nonlimited types. Functions with a
diff --git a/gcc/ada/makeusg.adb b/gcc/ada/makeusg.adb
index acacba9fdae..7f8ddb6163d 100644
--- a/gcc/ada/makeusg.adb
+++ b/gcc/ada/makeusg.adb
@@ -24,8 +24,8 @@
------------------------------------------------------------------------------
with Makeutl;
-with Osint; use Osint;
-with Output; use Output;
+with Osint; use Osint;
+with Output; use Output;
with Usage;
procedure Makeusg is
diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index 22897a35e2b..bd34a6ea250 100644
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -448,14 +448,14 @@ package body Sem_Ch5 is
end if;
return;
- -- Enforce RM 3.9.3 (8): left-hand side cannot be abstract
+ -- Enforce RM 3.9.3 (8): the target of an assignment operation cannot be
+ -- abstract. This is only checked when the assignment Comes_From_Source,
+ -- because in some cases the expander generates such assignments (such
+ -- in the _assign operation for an abstract type).
- elsif Is_Interface (T1)
- and then not Is_Class_Wide_Type (T1)
- then
+ elsif Is_Abstract_Type (T1) and then Comes_From_Source (N) then
Error_Msg_N
- ("target of assignment operation may not be abstract", Lhs);
- return;
+ ("target of assignment operation must not be abstract", Lhs);
end if;
-- Resolution may have updated the subtype, in case the left-hand
diff --git a/gcc/ada/types.ads b/gcc/ada/types.ads
index 42004ae2654..bb3c62d23e3 100644
--- a/gcc/ada/types.ads
+++ b/gcc/ada/types.ads
@@ -59,9 +59,6 @@ package Types is
type Int is range -2 ** 31 .. +2 ** 31 - 1;
-- Signed 32-bit integer
- type Dint is range -2 ** 63 .. +2 ** 63 - 1;
- -- Double length (64-bit) integer
-
subtype Nat is Int range 0 .. Int'Last;
-- Non-negative Int values
@@ -506,7 +503,7 @@ package Types is
-- The type Char is used for character data internally in the compiler, but
-- character codes in the source are represented by the Char_Code type.
-- Each character literal in the source is interpreted as being one of the
- -- 16#8000_0000 possible Wide_Wide_Character codes, and a unique Integer
+ -- 16#7FFF_FFFF possible Wide_Wide_Character codes, and a unique Integer
-- Value is assigned, corresponding to the UTF_32 value, which also
-- corresponds to the POS value in the Wide_Wide_Character type, and also
-- corresponds to the POS value in the Wide_Character and Character types
diff --git a/gcc/ada/uintp.adb b/gcc/ada/uintp.adb
index a3ed817d6d2..29ffe235aad 100644
--- a/gcc/ada/uintp.adb
+++ b/gcc/ada/uintp.adb
@@ -168,13 +168,15 @@ package body Uintp is
(Left, Right : Uint;
Quotient : out Uint;
Remainder : out Uint;
- Discard_Quotient : Boolean;
- Discard_Remainder : Boolean);
- -- Compute Euclidean division of Left by Right, and return Quotient and
- -- signed Remainder (Left rem Right).
+ Discard_Quotient : Boolean := False;
+ Discard_Remainder : Boolean := False);
+ -- Compute Euclidean division of Left by Right. If Discard_Quotient is
+ -- False then the quotient is returned in Quotient (otherwise Quotient is
+ -- set to No_Uint). If Discard_Remainder is False, then the remainder is
+ -- returned in Remainder (otherwise Remainder is set to No_Uint).
--
- -- If Discard_Quotient is True, Quotient is left unchanged.
- -- If Discard_Remainder is True, Remainder is left unchanged.
+ -- If Discard_Quotient is True, Quotient is set to No_Uint
+ -- If Discard_Remainder is True, Remainder is set to No_Uint
function Vector_To_Uint
(In_Vec : UI_Vector;
@@ -1253,7 +1255,6 @@ package body Uintp is
UI_Div_Rem
(Left, Right,
Quotient, Remainder,
- Discard_Quotient => False,
Discard_Remainder => True);
return Quotient;
end UI_Div;
@@ -1266,14 +1267,17 @@ package body Uintp is
(Left, Right : Uint;
Quotient : out Uint;
Remainder : out Uint;
- Discard_Quotient : Boolean;
- Discard_Remainder : Boolean)
+ Discard_Quotient : Boolean := False;
+ Discard_Remainder : Boolean := False)
is
pragma Warnings (Off, Quotient);
pragma Warnings (Off, Remainder);
begin
pragma Assert (Right /= Uint_0);
+ Quotient := No_Uint;
+ Remainder := No_Uint;
+
-- Cases where both operands are represented directly
if Direct (Left) and then Direct (Right) then
@@ -1682,43 +1686,9 @@ package body Uintp is
function UI_From_CC (Input : Char_Code) return Uint is
begin
- return UI_From_Dint (Dint (Input));
+ return UI_From_Int (Int (Input));
end UI_From_CC;
- ------------------
- -- UI_From_Dint --
- ------------------
-
- function UI_From_Dint (Input : Dint) return Uint is
- begin
-
- if Dint (Min_Direct) <= Input and then Input <= Dint (Max_Direct) then
- return Uint (Dint (Uint_Direct_Bias) + Input);
-
- -- For values of larger magnitude, compute digits into a vector and call
- -- Vector_To_Uint.
-
- else
- declare
- Max_For_Dint : constant := 5;
- -- Base is defined so that 5 Uint digits is sufficient to hold the
- -- largest possible Dint value.
-
- V : UI_Vector (1 .. Max_For_Dint);
-
- Temp_Integer : Dint := Input;
-
- begin
- for J in reverse V'Range loop
- V (J) := Int (abs (Temp_Integer rem Dint (Base)));
- Temp_Integer := Temp_Integer / Dint (Base);
- end loop;
-
- return Vector_To_Uint (V, Input < Dint'(0));
- end;
- end if;
- end UI_From_Dint;
-
-----------------
-- UI_From_Int --
-----------------
@@ -2191,11 +2161,7 @@ package body Uintp is
Y := Uint_0;
loop
- UI_Div_Rem
- (U, V,
- Quotient => Q, Remainder => R,
- Discard_Quotient => False,
- Discard_Remainder => False);
+ UI_Div_Rem (U, V, Quotient => Q, Remainder => R);
U := V;
V := R;
@@ -2232,12 +2198,15 @@ package body Uintp is
function UI_Mul (Left : Uint; Right : Uint) return Uint is
begin
- -- Simple case of single length operands
+ -- Case where product fits in the range of a 32-bit integer
- if Direct (Left) and then Direct (Right) then
+ if Int (Left) <= Int (Uint_Max_Simple_Mul)
+ and then
+ Int (Right) <= Int (Uint_Max_Simple_Mul)
+ then
return
- UI_From_Dint
- (Dint (Direct_Val (Left)) * Dint (Direct_Val (Right)));
+ UI_From_Int
+ (Int (Direct_Val (Left)) * Int (Direct_Val (Right)));
end if;
-- Otherwise we have the general case (Algorithm M in Knuth)
@@ -2560,9 +2529,7 @@ package body Uintp is
pragma Warnings (Off, Quotient);
begin
UI_Div_Rem
- (Left, Right, Quotient, Remainder,
- Discard_Quotient => True,
- Discard_Remainder => False);
+ (Left, Right, Quotient, Remainder, Discard_Quotient => True);
return Remainder;
end;
end UI_Rem;
diff --git a/gcc/ada/uintp.ads b/gcc/ada/uintp.ads
index 492498d6cf2..d222c52c12f 100644
--- a/gcc/ada/uintp.ads
+++ b/gcc/ada/uintp.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2010, 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- --
@@ -233,9 +233,6 @@ package Uintp is
-- given Modulo (uses Euclid's algorithm). Note: the call is considered
-- to be erroneous (and the behavior is undefined) if n is not invertible.
- function UI_From_Dint (Input : Dint) return Uint;
- -- Converts Dint value to universal integer form
-
function UI_From_Int (Input : Int) return Uint;
-- Converts Int value to universal integer form
@@ -404,7 +401,8 @@ private
-- Base is defined to allow efficient execution of the primitive operations
-- (a0, b0, c0) defined in the section "The Classical Algorithms"
-- (sec. 4.3.1) of Donald Knuth's "The Art of Computer Programming",
- -- Vol. 2. These algorithms are used in this package.
+ -- Vol. 2. These algorithms are used in this package. In particular,
+ -- the product of two single digits in this base fits in a 32-bit integer.
Base_Bits : constant := 15;
-- Number of bits in base value
@@ -470,6 +468,11 @@ private
Uint_Minus_80 : constant Uint := Uint (Uint_Direct_Bias - 80);
Uint_Minus_128 : constant Uint := Uint (Uint_Direct_Bias - 128);
+ Uint_Max_Simple_Mul : constant := Uint_Direct_Bias + 2 ** 15;
+ -- If two values are directly represented and less than or equal to this
+ -- value, then we know the product fits in a 32-bit integer. This allows
+ -- UI_Mul to efficiently compute the product in this case.
+
type Save_Mark is record
Save_Uint : Uint;
Save_Udigit : Int;
diff --git a/gcc/ada/vms_data.ads b/gcc/ada/vms_data.ads
index fdfe19dd59a..5e81a28140c 100644
--- a/gcc/ada/vms_data.ads
+++ b/gcc/ada/vms_data.ads
@@ -1154,9 +1154,8 @@ package VMS_Data is
-- of the directory specified in the project file. If the subdirectory
-- does not exist, it is created automatically.
- S_Clean_Unc_Shared_Libs : aliased constant S :=
- "/UNCHECKED_SHARED_LIB_IMPORTS " &
- "--unchecked-shared-lib-imports";
+ S_Clean_USL : aliased constant S := "/UNCHECKED_SHARED_LIB_IMPORTS " &
+ "--unchecked-shared-lib-imports";
-- /NOUNCHECKED_SHARED_LIB_IMPORTS (D)
-- /UNCHECKED_SHARED_LIB_IMPORTS
--
@@ -1188,7 +1187,7 @@ package VMS_Data is
S_Clean_Search 'Access,
S_Clean_Subdirs'Access,
S_Clean_Verbose'Access,
- S_Clean_Unc_Shared_Libs'Access);
+ S_Clean_USL 'Access);
-------------------------------
-- Switches for GNAT COMPILE --
@@ -4869,9 +4868,8 @@ package VMS_Data is
-- For example, -O -O2 is different than -O2 -O, but -g -O is equivalent
-- to -O -g.
- S_Make_Unc_Shared_Libs : aliased constant S :=
- "/UNCHECKED_SHARED_LIB_IMPORTS " &
- "--unchecked-shared-lib-imports";
+ S_Make_USL : aliased constant S := "/UNCHECKED_SHARED_LIB_IMPORTS " &
+ "--unchecked-shared-lib-imports";
-- /NOUNCHECKED_SHARED_LIB_IMPORTS (D)
-- /UNCHECKED_SHARED_LIB_IMPORTS
--
@@ -4954,7 +4952,7 @@ package VMS_Data is
S_Make_Stand 'Access,
S_Make_Subdirs 'Access,
S_Make_Switch 'Access,
- S_Make_Unc_Shared_Libs'Access,
+ S_Make_USL 'Access,
S_Make_Unique 'Access,
S_Make_Use_Map 'Access,
S_Make_Verbose 'Access);
View Lorry Controller Status