[multiple changes]

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.

From-SVN: r161187
This commit is contained in:
Arnaud Charlet 2010-06-22 15:53:46 +02:00
parent eeb41f0134
commit b0256cb6d2
8 changed files with 84 additions and 81 deletions

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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;

View File

@ -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;

View File

@ -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);