OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [g-rannum.adb] - Blame information for rev 706

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 706 jeremybenn
------------------------------------------------------------------------------
2
--                                                                          --
3
--                         GNAT RUN-TIME COMPONENTS                         --
4
--                                                                          --
5
--                  G N A T . R A N D O M _ N U M B E R S                   --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--      Copyright (C) 2007-2009  Free Software Foundation, Inc.             --
10
--                                                                          --
11
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
12
-- terms of the  GNU General Public License as published  by the Free Soft- --
13
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
14
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
15
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
16
-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
17
--                                                                          --
18
-- As a special exception under Section 7 of GPL version 3, you are granted --
19
-- additional permissions described in the GCC Runtime Library Exception,   --
20
-- version 3.1, as published by the Free Software Foundation.               --
21
--                                                                          --
22
-- You should have received a copy of the GNU General Public License and    --
23
-- a copy of the GCC Runtime Library Exception along with this program;     --
24
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
25
-- <http://www.gnu.org/licenses/>.                                          --
26
--                                                                          --
27
-- GNAT was originally developed  by the GNAT team at  New York University. --
28
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
29
--                                                                          --
30
------------------------------------------------------------------------------
31
 
32
with Ada.Numerics.Long_Elementary_Functions;
33
use Ada.Numerics.Long_Elementary_Functions;
34
with Ada.Unchecked_Conversion;
35
with System.Random_Numbers; use System.Random_Numbers;
36
 
37
package body GNAT.Random_Numbers is
38
 
39
   Sys_Max_Image_Width : constant := System.Random_Numbers.Max_Image_Width;
40
 
41
   subtype Image_String is String (1 .. Max_Image_Width);
42
 
43
   --  Utility function declarations
44
 
45
   procedure Insert_Image
46
     (S     : in out Image_String;
47
      Index : Integer;
48
      V     : Integer_64);
49
   --  Insert string representation of V in S starting at position Index
50
 
51
   ---------------
52
   -- To_Signed --
53
   ---------------
54
 
55
   function To_Signed is
56
     new Ada.Unchecked_Conversion (Unsigned_32, Integer_32);
57
   function To_Signed is
58
     new Ada.Unchecked_Conversion (Unsigned_64, Integer_64);
59
 
60
   ------------------
61
   -- Insert_Image --
62
   ------------------
63
 
64
   procedure Insert_Image
65
     (S     : in out Image_String;
66
      Index : Integer;
67
      V     : Integer_64)
68
   is
69
      Image : constant String := Integer_64'Image (V);
70
   begin
71
      S (Index .. Index + Image'Length - 1) := Image;
72
   end Insert_Image;
73
 
74
   ---------------------
75
   -- Random_Discrete --
76
   ---------------------
77
 
78
   function Random_Discrete
79
     (Gen   : Generator;
80
      Min   : Result_Subtype := Default_Min;
81
      Max   : Result_Subtype := Result_Subtype'Last) return Result_Subtype
82
   is
83
      function F is
84
        new System.Random_Numbers.Random_Discrete
85
              (Result_Subtype, Default_Min);
86
   begin
87
      return F (Gen.Rep, Min, Max);
88
   end Random_Discrete;
89
 
90
   ------------
91
   -- Random --
92
   ------------
93
 
94
   function Random (Gen : Generator) return Float is
95
   begin
96
      return Random (Gen.Rep);
97
   end Random;
98
 
99
   function Random (Gen : Generator) return Long_Float is
100
   begin
101
      return Random (Gen.Rep);
102
   end Random;
103
 
104
   function Random (Gen : Generator) return Interfaces.Unsigned_32 is
105
   begin
106
      return Random (Gen.Rep);
107
   end Random;
108
 
109
   function Random (Gen : Generator) return Interfaces.Unsigned_64 is
110
   begin
111
      return Random (Gen.Rep);
112
   end Random;
113
 
114
   function Random (Gen : Generator) return Integer_64 is
115
   begin
116
      return To_Signed (Unsigned_64'(Random (Gen)));
117
   end Random;
118
 
119
   function Random (Gen : Generator) return Integer_32 is
120
   begin
121
      return To_Signed (Unsigned_32'(Random (Gen)));
122
   end Random;
123
 
124
   function Random (Gen : Generator) return Long_Integer is
125
      function Random_Long_Integer is new Random_Discrete (Long_Integer);
126
   begin
127
      return Random_Long_Integer (Gen);
128
   end Random;
129
 
130
   function Random (Gen : Generator) return Integer is
131
      function Random_Integer is new Random_Discrete (Integer);
132
   begin
133
      return Random_Integer (Gen);
134
   end Random;
135
 
136
   ------------------
137
   -- Random_Float --
138
   ------------------
139
 
140
   function Random_Float (Gen   : Generator) return Result_Subtype is
141
      function F is new System.Random_Numbers.Random_Float (Result_Subtype);
142
   begin
143
      return F (Gen.Rep);
144
   end Random_Float;
145
 
146
   ---------------------
147
   -- Random_Gaussian --
148
   ---------------------
149
 
150
   --  Generates pairs of normally distributed values using the polar method of
151
   --  G. E. P. Box, M. E. Muller, and G. Marsaglia. See Donald E. Knuth, The
152
   --  Art of Computer Programming, Vol 2: Seminumerical Algorithms, section
153
   --  3.4.1, subsection C, algorithm P. Returns half of the pair on each call,
154
   --  using the Next_Gaussian field of Gen to hold the second member on
155
   --  even-numbered calls.
156
 
157
   function Random_Gaussian (Gen : Generator) return Long_Float is
158
      G : Generator renames Gen'Unrestricted_Access.all;
159
 
160
      V1, V2, Rad2, Mult : Long_Float;
161
 
162
   begin
163
      if G.Have_Gaussian then
164
         G.Have_Gaussian := False;
165
         return G.Next_Gaussian;
166
 
167
      else
168
         loop
169
            V1 := 2.0 * Random (G) - 1.0;
170
            V2 := 2.0 * Random (G) - 1.0;
171
            Rad2 := V1 ** 2 + V2 ** 2;
172
            exit when Rad2 < 1.0 and then Rad2 /= 0.0;
173
         end loop;
174
 
175
         --  Now V1 and V2 are coordinates in the unit circle
176
 
177
         Mult := Sqrt (-2.0 * Log (Rad2) / Rad2);
178
         G.Next_Gaussian := V2 * Mult;
179
         G.Have_Gaussian := True;
180
         return Long_Float'Machine (V1 * Mult);
181
      end if;
182
   end Random_Gaussian;
183
 
184
   function Random_Gaussian (Gen : Generator) return Float is
185
      V : constant Long_Float := Random_Gaussian (Gen);
186
   begin
187
      return Float'Machine (Float (V));
188
   end Random_Gaussian;
189
 
190
   -----------
191
   -- Reset --
192
   -----------
193
 
194
   procedure Reset (Gen : out Generator) is
195
   begin
196
      Reset (Gen.Rep);
197
      Gen.Have_Gaussian := False;
198
   end Reset;
199
 
200
   procedure Reset
201
     (Gen       : out Generator;
202
      Initiator : Initialization_Vector)
203
   is
204
   begin
205
      Reset (Gen.Rep, Initiator);
206
      Gen.Have_Gaussian := False;
207
   end Reset;
208
 
209
   procedure Reset
210
     (Gen       : out Generator;
211
      Initiator : Interfaces.Integer_32)
212
   is
213
   begin
214
      Reset (Gen.Rep, Initiator);
215
      Gen.Have_Gaussian := False;
216
   end Reset;
217
 
218
   procedure Reset
219
     (Gen       : out Generator;
220
      Initiator : Interfaces.Unsigned_32)
221
   is
222
   begin
223
      Reset (Gen.Rep, Initiator);
224
      Gen.Have_Gaussian := False;
225
   end Reset;
226
 
227
   procedure Reset
228
     (Gen       : out Generator;
229
      Initiator : Integer)
230
   is
231
   begin
232
      Reset (Gen.Rep, Initiator);
233
      Gen.Have_Gaussian := False;
234
   end Reset;
235
 
236
   procedure Reset
237
     (Gen        : out Generator;
238
      From_State : Generator)
239
   is
240
   begin
241
      Reset (Gen.Rep, From_State.Rep);
242
      Gen.Have_Gaussian := From_State.Have_Gaussian;
243
      Gen.Next_Gaussian := From_State.Next_Gaussian;
244
   end Reset;
245
 
246
   Frac_Scale : constant Long_Float :=
247
                  Long_Float
248
                    (Long_Float'Machine_Radix) ** Long_Float'Machine_Mantissa;
249
 
250
   function Val64 (Image : String) return Integer_64;
251
   --  Renames Integer64'Value
252
   --  We cannot use a 'renames Integer64'Value' since for some strange
253
   --  reason, this requires a dependency on s-auxdec.ads which not all
254
   --  run-times support ???
255
 
256
   function Val64 (Image : String) return Integer_64 is
257
   begin
258
      return Integer_64'Value (Image);
259
   end Val64;
260
 
261
   procedure Reset
262
     (Gen        : out Generator;
263
      From_Image : String)
264
   is
265
      F0 : constant Integer := From_Image'First;
266
      T0 : constant Integer := From_Image'First + Sys_Max_Image_Width;
267
 
268
   begin
269
      Reset (Gen.Rep, From_Image (F0 .. F0 + Sys_Max_Image_Width));
270
 
271
      if From_Image (T0 + 1) = '1' then
272
         Gen.Have_Gaussian := True;
273
         Gen.Next_Gaussian :=
274
           Long_Float (Val64 (From_Image (T0 + 3 .. T0 + 23))) / Frac_Scale
275
           * Long_Float (Long_Float'Machine_Radix)
276
           ** Integer (Val64 (From_Image (T0 + 25 .. From_Image'Last)));
277
      else
278
         Gen.Have_Gaussian := False;
279
      end if;
280
   end Reset;
281
 
282
   -----------
283
   -- Image --
284
   -----------
285
 
286
   function Image (Gen : Generator) return String is
287
      Result : Image_String;
288
 
289
   begin
290
      Result := (others => ' ');
291
      Result (1 .. Sys_Max_Image_Width) := Image (Gen.Rep);
292
 
293
      if Gen.Have_Gaussian then
294
         Result (Sys_Max_Image_Width + 2) := '1';
295
         Insert_Image (Result, Sys_Max_Image_Width + 4,
296
                       Integer_64 (Long_Float'Fraction (Gen.Next_Gaussian)
297
                                   * Frac_Scale));
298
         Insert_Image (Result, Sys_Max_Image_Width + 24,
299
                       Integer_64 (Long_Float'Exponent (Gen.Next_Gaussian)));
300
 
301
      else
302
         Result (Sys_Max_Image_Width + 2) := '0';
303
      end if;
304
 
305
      return Result;
306
   end Image;
307
 
308
end GNAT.Random_Numbers;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.