mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-15 09:00:29 +08:00
Code Issues Packages Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2010-06-22  Robert Dewar  <dewar@adacore.com>

	* errout.adb (Finalize): Set Prev pointers.
	(Finalize): Delete continuations for deletion by warnings off(str).
	* erroutc.ads: Add Prev pointer to error message structure.

2010-06-22  Ed Schonberg  <schonberg@adacore.com>

	* sem.adb (Do_Unit_And_Dependents): If the spec of the main unit is a
	child unit, examine context of parent units to locate instantiated
	generics whose bodies may be needed. 
	* sem_ch12.adb: (Mark_Context): if the enclosing unit does not have a
	with_clause for the instantiated generic, examine the context of its
	parents, to set Withed_Body flag, so that it can be visited earlier.
	* exp_ch4.adb (Expand_N_Op_Not): If this is a VMS operator applied to
	an unsigned type, use a type of the proper size for the intermediate
	value, to prevent alignment problems on unchecked conversion.

2010-06-22  Geert Bosch  <bosch@adacore.com>

	* s-rannum.ads Change Generator type to be self-referential to allow
	Random to update its argument. Use "in" mode for the generator in the
	Reset procedures to allow them to be called from the Ada.Numerics
	packages without tricks.
	* s-rannum.adb: Use the self-referencing argument to get write access
	to the internal state of the random generator.
	* a-nudira.ads: Make Generator a derived type of
	System.Random_Numbers.Generator.
	* a-nudira.adb: Remove use of 'Unrestricted_Access.
	Put subprograms in alpha order and add headers.
	* g-mbdira.ads: Change Generator type to be self-referential.
	* g-mbdira.adb: Remove use of 'Unrestricted_Access.

From-SVN: r161215
This commit is contained in:
Arnaud Charlet 2010-06-22 19:29:41 +02:00
parent 545cb5be91
commit 9bebf0e989
14 changed files with 287 additions and 217 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
gcc/ada/ChangeLog
View File

@ -1,3 +1,36 @@
2010-06-22 Robert Dewar <dewar@adacore.com>
* errout.adb (Finalize): Set Prev pointers.
(Finalize): Delete continuations for deletion by warnings off(str).
* erroutc.ads: Add Prev pointer to error message structure.
2010-06-22 Ed Schonberg <schonberg@adacore.com>
* sem.adb (Do_Unit_And_Dependents): If the spec of the main unit is a
child unit, examine context of parent units to locate instantiated
generics whose bodies may be needed.
* sem_ch12.adb: (Mark_Context): if the enclosing unit does not have a
with_clause for the instantiated generic, examine the context of its
parents, to set Withed_Body flag, so that it can be visited earlier.
* exp_ch4.adb (Expand_N_Op_Not): If this is a VMS operator applied to
an unsigned type, use a type of the proper size for the intermediate
value, to prevent alignment problems on unchecked conversion.
2010-06-22 Geert Bosch <bosch@adacore.com>
* s-rannum.ads Change Generator type to be self-referential to allow
Random to update its argument. Use "in" mode for the generator in the
Reset procedures to allow them to be called from the Ada.Numerics
packages without tricks.
* s-rannum.adb: Use the self-referencing argument to get write access
to the internal state of the random generator.
* a-nudira.ads: Make Generator a derived type of
System.Random_Numbers.Generator.
* a-nudira.adb: Remove use of 'Unrestricted_Access.
Put subprograms in alpha order and add headers.
* g-mbdira.ads: Change Generator type to be self-referential.
* g-mbdira.adb: Remove use of 'Unrestricted_Access.
2010-06-22 Robert Dewar <dewar@adacore.com>
* freeze.adb: Minor reformatting

118
gcc/ada/a-nudira.adb
View File

@ -29,80 +29,66 @@
-- --
------------------------------------------------------------------------------
with System.Random_Numbers; use System.Random_Numbers;
package body Ada.Numerics.Discrete_Random is
-------------------------
-- Implementation Note --
-------------------------
package SRN renames System.Random_Numbers;
use SRN;
-- The design of this spec is a bit awkward, as a result of Ada 95 not
-- permitting in-out parameters for function formals (most naturally
-- Generator values would be passed this way). In pure Ada 95, the only
-- solution would be to add a self-referential component to the generator
-- allowing access to the generator object from inside the function. This
-- would work because the generator is limited, which prevents any copy.
-----------
-- Image --
-----------
-- This is a bit heavy, so what we do is to use Unrestricted_Access to
-- get a pointer to the state in the passed Generator. This works because
-- Generator is a limited type and will thus always be passed by reference.
subtype Rep_Generator is System.Random_Numbers.Generator;
subtype Rep_State is System.Random_Numbers.State;
function Rep_Random is
new Random_Discrete (Result_Subtype, Result_Subtype'First);
function Random (Gen : Generator) return Result_Subtype is
function Image (Of_State : State) return String is
begin
return Rep_Random (Gen.Rep);
end Random;
procedure Reset
(Gen : Generator;
Initiator : Integer)
is
G : Rep_Generator renames Gen.Rep'Unrestricted_Access.all;
begin
Reset (G, Initiator);
end Reset;
procedure Reset (Gen : Generator) is
G : Rep_Generator renames Gen.Rep'Unrestricted_Access.all;
begin
Reset (G);
end Reset;
procedure Save
(Gen : Generator;
To_State : out State)
is
begin
Save (Gen.Rep, State (To_State));
end Save;
procedure Reset
(Gen : Generator;
From_State : State)
is
G : Rep_Generator renames Gen.Rep'Unrestricted_Access.all;
begin
Reset (G, From_State);
end Reset;
function Image (Of_State : State) return String is
begin
return Image (Rep_State (Of_State));
return Image (SRN.State (Of_State));
end Image;
function Value (Coded_State : String) return State is
G : Generator;
S : Rep_State;
------------
-- Random --
------------
function Random (Gen : Generator) return Result_Subtype is
function Random is
new SRN.Random_Discrete (Result_Subtype, Result_Subtype'First);
begin
Reset (G.Rep, Coded_State);
System.Random_Numbers.Save (G.Rep, S);
return State (S);
return Random (SRN.Generator (Gen));
end Random;
-----------
-- Reset --
-----------
procedure Reset (Gen : Generator) is
begin
Reset (SRN.Generator (Gen));
end Reset;
procedure Reset (Gen : Generator; Initiator : Integer) is
begin
Reset (SRN.Generator (Gen), Initiator);
end Reset;
procedure Reset (Gen : Generator; From_State : State) is
begin
Reset (SRN.Generator (Gen), SRN.State (From_State));
end Reset;
----------
-- Save --
----------
procedure Save (Gen : Generator; To_State : out State) is
begin
Save (SRN.Generator (Gen), SRN.State (To_State));
end Save;
-----------
-- Value --
-----------
function Value (Coded_State : String) return State is
begin
return State (SRN.State'(Value (Coded_State)));
end Value;
end Ada.Numerics.Discrete_Random;

4
gcc/ada/a-nudira.ads
View File

@ -66,9 +66,7 @@ package Ada.Numerics.Discrete_Random is
private
type Generator is limited record
Rep : System.Random_Numbers.Generator;
end record;
type Generator is new System.Random_Numbers.Generator;
type State is new System.Random_Numbers.State;

70
gcc/ada/a-nuflra.adb
View File

@ -29,29 +29,19 @@
-- --
------------------------------------------------------------------------------
with Interfaces; use Interfaces;
with System.Random_Numbers; use System.Random_Numbers;
package body Ada.Numerics.Float_Random is
-------------------------
-- Implementation Note --
-------------------------
package SRN renames System.Random_Numbers;
use SRN;
-- The design of this spec is a bit awkward, as a result of Ada 95 not
-- permitting in-out parameters for function formals (most naturally
-- Generator values would be passed this way). In pure Ada 95, the only
-- solution would be to add a self-referential component to the generator
-- allowing access to the generator object from inside the function. This
-- would work because the generator is limited, which prevents any copy.
-----------
-- Image --
-----------
-- This is a bit heavy, so what we do is to use Unrestricted_Access to
-- get a pointer to the state in the passed Generator. This works because
-- Generator is a limited type and will thus always be passed by reference.
subtype Rep_Generator is System.Random_Numbers.Generator;
subtype Rep_State is System.Random_Numbers.State;
function Image (Of_State : State) return String is
begin
return Image (SRN.State (Of_State));
end Image;
------------
-- Random --
@ -59,35 +49,32 @@ package body Ada.Numerics.Float_Random is
function Random (Gen : Generator) return Uniformly_Distributed is
begin
return Random (Gen.Rep);
return Random (SRN.Generator (Gen));
end Random;
-----------
-- Reset --
-----------
-- Version that works from given initiator value
procedure Reset (Gen : Generator; Initiator : Integer) is
G : Rep_Generator renames Gen.Rep'Unrestricted_Access.all;
begin
Reset (G, Integer_32 (Initiator));
end Reset;
-- Version that works from calendar
procedure Reset (Gen : Generator) is
G : Rep_Generator renames Gen.Rep'Unrestricted_Access.all;
begin
Reset (G);
Reset (SRN.Generator (Gen));
end Reset;
-- Version that works from given initiator value
procedure Reset (Gen : Generator; Initiator : Integer) is
begin
Reset (SRN.Generator (Gen), Initiator);
end Reset;
-- Version that works from specific saved state
procedure Reset (Gen : Generator; From_State : State) is
G : Rep_Generator renames Gen.Rep'Unrestricted_Access.all;
begin
Reset (G, From_State);
Reset (SRN.Generator (Gen), From_State);
end Reset;
----------
@ -96,28 +83,19 @@ package body Ada.Numerics.Float_Random is
procedure Save (Gen : Generator; To_State : out State) is
begin
Save (Gen.Rep, State (To_State));
Save (SRN.Generator (Gen), To_State);
end Save;
-----------
-- Image --
-----------
function Image (Of_State : State) return String is
begin
return Image (Rep_State (Of_State));
end Image;
-----------
-- Value --
-----------
function Value (Coded_State : String) return State is
G : Generator;
S : Rep_State;
G : SRN.Generator;
S : SRN.State;
begin
Reset (G.Rep, Coded_State);
System.Random_Numbers.Save (G.Rep, S);
Reset (G, Coded_State);
Save (G, S);
return State (S);
end Value;

4
gcc/ada/a-nuflra.ads
View File

@ -65,9 +65,7 @@ package Ada.Numerics.Float_Random is
private
type Generator is limited record
Rep : System.Random_Numbers.Generator;
end record;
type Generator is new System.Random_Numbers.Generator;
type State is new System.Random_Numbers.State;

32
gcc/ada/errout.adb
View File

@ -881,6 +881,7 @@ package body Errout is
Errors.Append
((Text => new String'(Msg_Buffer (1 .. Msglen)),
Next => No_Error_Msg,
Prev => No_Error_Msg,
Sptr => Sptr,
Optr => Optr,
Sfile => Get_Source_File_Index (Sptr),
@ -1215,6 +1216,16 @@ package body Errout is
F : Error_Msg_Id;
begin
-- Set Prev pointers
Cur := First_Error_Msg;
while Cur /= No_Error_Msg loop
Nxt := Errors.Table (Cur).Next;
exit when Nxt = No_Error_Msg;
Errors.Table (Nxt).Prev := Cur;
Cur := Nxt;
end loop;
-- Eliminate any duplicated error messages from the list. This is
-- done after the fact to avoid problems with Change_Error_Text.
@ -1239,11 +1250,28 @@ package body Errout is
while Cur /= No_Error_Msg loop
if not Errors.Table (Cur).Deleted
and then Warning_Specifically_Suppressed
(Errors.Table (Cur).Sptr,
Errors.Table (Cur).Text)
(Errors.Table (Cur).Sptr, Errors.Table (Cur).Text)
then
Errors.Table (Cur).Deleted := True;
Warnings_Detected := Warnings_Detected - 1;
-- If this is a continuation, delete previous messages
F := Cur;
while Errors.Table (F).Msg_Cont loop
F := Errors.Table (F).Prev;
Errors.Table (F).Deleted := True;
end loop;
-- Delete any following continuations
F := Cur;
loop
F := Errors.Table (F).Next;
exit when F = No_Error_Msg;
exit when not Errors.Table (F).Msg_Cont;
Errors.Table (F).Deleted := True;
end loop;
end if;
Cur := Errors.Table (Cur).Next;

7
gcc/ada/erroutc.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2008, 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- --
@ -147,6 +147,11 @@ package Erroutc is
-- Pointer to next message in error chain. A value of No_Error_Msg
-- indicates the end of the chain.
Prev : Error_Msg_Id;
-- Pointer to previous message in error chain. Only set during the
-- Finalize procedure. A value of No_Error_Msg indicates the first
-- message in the chain.
Sfile : Source_File_Index;
-- Source table index of source file. In the case of an error that
-- refers to a template, always references the original template

33
gcc/ada/exp_ch4.adb
View File

@ -6905,12 +6905,39 @@ package body Exp_Ch4 is
if Is_VMS_Operator (Entity (N)) then
declare
LI : constant Entity_Id := RTE (RE_Unsigned_64);
Rtyp : Entity_Id;
Utyp : Entity_Id;
begin
-- If this is a derived type, retrieve original VMS type so that
-- the proper sized type is used for intermediate values.
if Is_Derived_Type (Typ) then
Rtyp := First_Subtype (Etype (Typ));
else
Rtyp := Typ;
end if;
-- The proper unsigned type must have a size compatible with
-- the operand, to prevent misalignment..
if RM_Size (Rtyp) <= 8 then
Utyp := RTE (RE_Unsigned_8);
elsif RM_Size (Rtyp) <= 16 then
Utyp := RTE (RE_Unsigned_16);
elsif RM_Size (Rtyp) = RM_Size (Standard_Unsigned) then
Utyp := Typ;
else
Utyp := RTE (RE_Long_Long_Unsigned);
end if;
Rewrite (N,
Unchecked_Convert_To (Typ,
(Make_Op_Not (Loc,
Right_Opnd => Unchecked_Convert_To (LI, Right_Opnd (N))))));
Make_Op_Not (Loc,
Unchecked_Convert_To (Utyp, Right_Opnd (N)))));
Analyze_And_Resolve (N, Typ);
return;
end;

42
gcc/ada/g-mbdira.adb
View File

@ -35,25 +35,8 @@ with Interfaces; use Interfaces;
package body GNAT.MBBS_Discrete_Random is
-------------------------
-- Implementation Note --
-------------------------
-- The design of this spec is a bit awkward, as a result of Ada 95 not
-- permitting in-out parameters for function formals (most naturally
-- Generator values would be passed this way). In pure Ada 95, the only
-- solution would be to add a self-referential component to the generator
-- allowing access to the generator object from inside the function. This
-- would work because the generator is limited, which prevents any copy.
-- This is a bit heavy, so what we do is to use Unrestricted_Access to
-- get a pointer to the state in the passed Generator. This works because
-- Generator is a limited type and will thus always be passed by reference.
package Calendar renames Ada.Calendar;
type Pointer is access all State;
Fits_In_32_Bits : constant Boolean :=
Rst'Size < 31
or else (Rst'Size = 31
@ -109,7 +92,7 @@ package body GNAT.MBBS_Discrete_Random is
------------
function Random (Gen : Generator) return Rst is
Genp : constant Pointer := Gen.Gen_State'Unrestricted_Access;
S : State renames Gen.Writable.Self.Gen_State;
Temp : Int;
TF : Flt;
@ -124,21 +107,21 @@ package body GNAT.MBBS_Discrete_Random is
-- Continue with computation if non-flat range
Genp.X1 := Square_Mod_N (Genp.X1, Genp.P);
Genp.X2 := Square_Mod_N (Genp.X2, Genp.Q);
Temp := Genp.X2 - Genp.X1;
S.X1 := Square_Mod_N (S.X1, S.P);
S.X2 := Square_Mod_N (S.X2, S.Q);
Temp := S.X2 - S.X1;
-- Following duplication is not an error, it is a loop unwinding!
if Temp < 0 then
Temp := Temp + Genp.Q;
Temp := Temp + S.Q;
end if;
if Temp < 0 then
Temp := Temp + Genp.Q;
Temp := Temp + S.Q;
end if;
TF := Offs + (Flt (Temp) * Flt (Genp.P) + Flt (Genp.X1)) * Genp.Scl;
TF := Offs + (Flt (Temp) * Flt (S.P) + Flt (S.X1)) * S.Scl;
-- Pathological, but there do exist cases where the rounding implicit
-- in calculating the scale factor will cause rounding to 'Last + 1.
@ -160,7 +143,7 @@ package body GNAT.MBBS_Discrete_Random is
-----------
procedure Reset (Gen : Generator; Initiator : Integer) is
Genp : constant Pointer := Gen.Gen_State'Unrestricted_Access;
S : State renames Gen.Writable.Self.Gen_State;
X1, X2 : Int;
begin
@ -174,7 +157,7 @@ package body GNAT.MBBS_Discrete_Random is
-- Eliminate effects of small Initiators
Genp.all :=
S :=
(X1 => X1,
X2 => X2,
P => K1,
@ -188,7 +171,7 @@ package body GNAT.MBBS_Discrete_Random is
-----------
procedure Reset (Gen : Generator) is
Genp : constant Pointer := Gen.Gen_State'Unrestricted_Access;
S : State renames Gen.Writable.Self.Gen_State;
Now : constant Calendar.Time := Calendar.Clock;
X1 : Int;
X2 : Int;
@ -210,7 +193,7 @@ package body GNAT.MBBS_Discrete_Random is
X2 := Square_Mod_N (X2, K2);
end loop;
Genp.all :=
S :=
(X1 => X1,
X2 => X2,
P => K1,
@ -225,9 +208,8 @@ package body GNAT.MBBS_Discrete_Random is
-----------
procedure Reset (Gen : Generator; From_State : State) is
Genp : constant Pointer := Gen.Gen_State'Unrestricted_Access;
begin
Genp.all := From_State;
Gen.Writable.Self.Gen_State := From_State;
end Reset;
----------

5
gcc/ada/g-mbdira.ads
View File

@ -111,7 +111,12 @@ private
Scl : Flt := Scal;
end record;
type Writable_Access (Self : access Generator) is limited null record;
-- Auxiliary type to make Generator a self-referential type
type Generator is limited record
Writable : Writable_Access (Generator'Access);
-- This self reference allows functions to modify Generator arguments
Gen_State : State;
end record;

86
gcc/ada/s-rannum.adb
View File

@ -95,21 +95,6 @@ use Ada;
package body System.Random_Numbers is
-------------------------
-- Implementation Note --
-------------------------
-- The design of this spec is a bit awkward, as a result of Ada 95 not
-- permitting in-out parameters for function formals (most naturally
-- Generator values would be passed this way). In pure Ada 95, the only
-- solution would be to add a self-referential component to the generator
-- allowing access to the generator object from inside the function. This
-- would work because the generator is limited, which prevents any copy.
-- This is a bit heavy, so what we do is to use Unrestricted_Access to
-- get a pointer to the state in the passed Generator. This works because
-- Generator is a limited type and will thus always be passed by reference.
Y2K : constant Calendar.Time :=
Calendar.Time_Of
(Year => 2000, Month => 1, Day => 1, Seconds => 0.0);
@ -168,7 +153,7 @@ package body System.Random_Numbers is
-- Local Subprograms --
-----------------------
procedure Init (Gen : out Generator; Initiator : Unsigned_32);
procedure Init (Gen : Generator; Initiator : Unsigned_32);
-- Perform a default initialization of the state of Gen. The resulting
-- state is identical for identical values of Initiator.
@ -192,7 +177,7 @@ package body System.Random_Numbers is
------------
function Random (Gen : Generator) return Unsigned_32 is
G : Generator renames Gen'Unrestricted_Access.all;
G : Generator renames Gen.Writable.Self.all;
Y : State_Val;
I : Integer; -- should avoid use of identifier I ???
@ -498,23 +483,23 @@ package body System.Random_Numbers is
-- Reset --
-----------
procedure Reset (Gen : out Generator) is
procedure Reset (Gen : Generator) is
X : constant Unsigned_32 := Unsigned_32 ((Calendar.Clock - Y2K) * 64.0);
begin
Init (Gen, X);
end Reset;
procedure Reset (Gen : out Generator; Initiator : Integer_32) is
procedure Reset (Gen : Generator; Initiator : Integer_32) is
begin
Init (Gen, To_Unsigned (Initiator));
end Reset;
procedure Reset (Gen : out Generator; Initiator : Unsigned_32) is
procedure Reset (Gen : Generator; Initiator : Unsigned_32) is
begin
Init (Gen, Initiator);
end Reset;
procedure Reset (Gen : out Generator; Initiator : Integer) is
procedure Reset (Gen : Generator; Initiator : Integer) is
begin
pragma Warnings (Off, "condition is always *");
-- This is probably an unnecessary precaution against future change, but
@ -539,27 +524,27 @@ package body System.Random_Numbers is
pragma Warnings (On, "condition is always *");
end Reset;
procedure Reset (Gen : out Generator; Initiator : Initialization_Vector) is
procedure Reset (Gen : Generator; Initiator : Initialization_Vector) is
G : Generator renames Gen.Writable.Self.all;
I, J : Integer;
begin
Init (Gen, Seed1);
Init (G, Seed1);
I := 1;
J := 0;
if Initiator'Length > 0 then
for K in reverse 1 .. Integer'Max (N, Initiator'Length) loop
Gen.S (I) :=
(Gen.S (I)
xor ((Gen.S (I - 1) xor Shift_Right (Gen.S (I - 1), 30))
* Mult1))
G.S (I) :=
(G.S (I) xor ((G.S (I - 1)
xor Shift_Right (G.S (I - 1), 30)) * Mult1))
+ Initiator (J + Initiator'First) + Unsigned_32 (J);
I := I + 1;
J := J + 1;
if I >= N then
Gen.S (0) := Gen.S (N - 1);
G.S (0) := G.S (N - 1);
I := 1;
end if;
@ -570,39 +555,42 @@ package body System.Random_Numbers is
end if;
for K in reverse 1 .. N - 1 loop
Gen.S (I) :=
(Gen.S (I) xor ((Gen.S (I - 1)
xor Shift_Right (Gen.S (I - 1), 30)) * Mult2))
G.S (I) :=
(G.S (I) xor ((G.S (I - 1)
xor Shift_Right (G.S (I - 1), 30)) * Mult2))
- Unsigned_32 (I);
I := I + 1;
if I >= N then
Gen.S (0) := Gen.S (N - 1);
G.S (0) := G.S (N - 1);
I := 1;
end if;
end loop;
Gen.S (0) := Upper_Mask;
G.S (0) := Upper_Mask;
end Reset;
procedure Reset (Gen : out Generator; From_State : Generator) is
procedure Reset (Gen : Generator; From_State : Generator) is
G : Generator renames Gen.Writable.Self.all;
begin
Gen.S := From_State.S;
Gen.I := From_State.I;
G.S := From_State.S;
G.I := From_State.I;
end Reset;
procedure Reset (Gen : out Generator; From_State : State) is
procedure Reset (Gen : Generator; From_State : State) is
G : Generator renames Gen.Writable.Self.all;
begin
Gen.I := 0;
Gen.S := From_State;
G.I := 0;
G.S := From_State;
end Reset;
procedure Reset (Gen : out Generator; From_Image : String) is
procedure Reset (Gen : Generator; From_Image : String) is
G : Generator renames Gen.Writable.Self.all;
begin
Gen.I := 0;
G.I := 0;
for J in 0 .. N - 1 loop
Gen.S (J) := Extract_Value (From_Image, J);
G.S (J) := Extract_Value (From_Image, J);
end loop;
end Reset;
@ -670,17 +658,18 @@ package body System.Random_Numbers is
-- Init --
----------
procedure Init (Gen : out Generator; Initiator : Unsigned_32) is
procedure Init (Gen : Generator; Initiator : Unsigned_32) is
G : Generator renames Gen.Writable.Self.all;
begin
Gen.S (0) := Initiator;
G.S (0) := Initiator;
for I in 1 .. N - 1 loop
Gen.S (I) :=
Mult0 * (Gen.S (I - 1) xor Shift_Right (Gen.S (I - 1), 30)) +
Unsigned_32 (I);
G.S (I) :=
(G.S (I - 1) xor Shift_Right (G.S (I - 1), 30)) * Mult0
+ Unsigned_32 (I);
end loop;
Gen.I := 0;
G.I := 0;
end Init;
------------------
@ -706,5 +695,4 @@ package body System.Random_Numbers is
begin
return State_Val'Value (S (Start .. Start + Image_Numeral_Length - 1));
end Extract_Value;
end System.Random_Numbers;

28
gcc/ada/s-rannum.ads
View File

@ -88,27 +88,27 @@ package System.Random_Numbers is
-- in Reset). In general, there is little point in providing more than
-- a certain number of values (currently 624).
procedure Reset (Gen : out Generator);
procedure Reset (Gen : Generator);
-- Re-initialize the state of Gen from the time of day
procedure Reset (Gen : out Generator; Initiator : Initialization_Vector);
procedure Reset (Gen : out Generator; Initiator : Interfaces.Integer_32);
procedure Reset (Gen : out Generator; Initiator : Interfaces.Unsigned_32);
procedure Reset (Gen : out Generator; Initiator : Integer);
procedure Reset (Gen : Generator; Initiator : Initialization_Vector);
procedure Reset (Gen : Generator; Initiator : Interfaces.Integer_32);
procedure Reset (Gen : Generator; Initiator : Interfaces.Unsigned_32);
procedure Reset (Gen : Generator; Initiator : Integer);
-- Re-initialize Gen based on the Initiator in various ways. Identical
-- values of Initiator cause identical sequences of values.
procedure Reset (Gen : out Generator; From_State : Generator);
procedure Reset (Gen : Generator; From_State : Generator);
-- Causes the state of Gen to be identical to that of From_State; Gen
-- and From_State will produce identical sequences of values subsequently.
procedure Reset (Gen : out Generator; From_State : State);
procedure Reset (Gen : Generator; From_State : State);
procedure Save (Gen : Generator; To_State : out State);
-- The sequence
-- Save (Gen2, S); Reset (Gen1, S)
-- has the same effect as Reset (Gen2, Gen1).
procedure Reset (Gen : out Generator; From_Image : String);
procedure Reset (Gen : Generator; From_Image : String);
function Image (Gen : Generator) return String;
-- The call
-- Reset (Gen2, Image (Gen1))
@ -135,11 +135,15 @@ private
subtype State_Val is Interfaces.Unsigned_32;
type State is array (0 .. N - 1) of State_Val;
type Generator is limited record
S : State := (others => 0);
-- The shift register, a circular buffer
type Writable_Access (Self : access Generator) is limited null record;
-- Auxiliary type to make Generator a self-referential type
I : Integer := N;
type Generator is limited record
Writable : Writable_Access (Generator'Access);
-- This self reference allows functions to modify Generator arguments
S : State := (others => 0);
-- The shift register, a circular buffer
I : Integer := N;
-- Current starting position in shift register S (N means uninitialized)
end record;

18
gcc/ada/sem.adb
View File

@ -1728,7 +1728,9 @@ package body Sem is
procedure Do_Unit_And_Dependents (CU : Node_Id; Item : Node_Id) is
Unit_Num : constant Unit_Number_Type :=
Get_Cunit_Unit_Number (CU);
Get_Cunit_Unit_Number (CU);
Child : Node_Id;
Parent_CU : Node_Id;
procedure Do_Withed_Units is new Walk_Withs (Do_Withed_Unit);
@ -1758,6 +1760,20 @@ package body Sem is
if CU = Library_Unit (Main_CU) then
Process_Bodies_In_Context (CU);
-- If main is a child unit, examine context of parent
-- units to see if they include instantiated units.
if Is_Child_Unit (Cunit_Entity (Main_Unit)) then
Child := Cunit_Entity (Main_Unit);
while Is_Child_Unit (Child) loop
Parent_CU :=
Cunit
(Get_Cunit_Entity_Unit_Number (Scope (Child)));
Process_Bodies_In_Context (Parent_CU);
Child := Scope (Child);
end loop;
end if;
end if;
Do_Action (CU, Item);

24
gcc/ada/sem_ch12.adb
View File

@ -2598,7 +2598,7 @@ package body Sem_Ch12 is
then
Error_Msg_N ("premature usage of incomplete type", Def);
elsif Is_Internal (Designated_Type (T)) then
elsif not Is_Entity_Name (Subtype_Indication (Def)) then
Error_Msg_N
("only a subtype mark is allowed in a formal", Def);
end if;
@ -10396,6 +10396,7 @@ package body Sem_Ch12 is
procedure Mark_Context (Inst_Decl : Node_Id; Gen_Decl : Node_Id) is
Inst_CU : constant Unit_Number_Type := Get_Code_Unit (Inst_Decl);
Gen_CU : constant Unit_Number_Type := Get_Source_Unit (Gen_Decl);
Inst : Entity_Id := Cunit_Entity (Inst_CU);
Clause : Node_Id;
begin
@ -10410,10 +10411,31 @@ package body Sem_Ch12 is
and then Library_Unit (Clause) = Cunit (Gen_CU)
then
Set_Withed_Body (Clause, Cunit (Gen_CU));
return;
end if;
Next (Clause);
end loop;
-- If the with-clause for the generic unit was not found, it must
-- appear in some ancestor of the current unit.
while Is_Child_Unit (Inst) loop
Inst := Scope (Inst);
Clause :=
First (Context_Items (Parent (Unit_Declaration_Node (Inst))));
while Present (Clause) loop
if Nkind (Clause) = N_With_Clause
and then Library_Unit (Clause) = Cunit (Gen_CU)
then
Set_Withed_Body (Clause, Cunit (Gen_CU));
return;
end if;
Next (Clause);
end loop;
end loop;
end Mark_Context;
---------------------