?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
[gcc/]
[official-gcc.git] / gcc / ada / s-rannum.adb
blobaf620d704206da46f36c5ae4912d412916fa95a2
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT RUN-TIME COMPONENTS --
4 -- --
5 -- S Y S T E M . R A N D O M _ N U M B E R S --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2007-2014, 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 ------------------------------------------------------------------------------
33 -- --
34 -- The implementation here is derived from a C-program for MT19937, with --
35 -- initialization improved 2002/1/26. As required, the following notice is --
36 -- copied from the original program. --
37 -- --
38 -- Copyright (C) 1997 - 2002, Makoto Matsumoto and Takuji Nishimura, --
39 -- All rights reserved. --
40 -- --
41 -- Redistribution and use in source and binary forms, with or without --
42 -- modification, are permitted provided that the following conditions --
43 -- are met: --
44 -- --
45 -- 1. Redistributions of source code must retain the above copyright --
46 -- notice, this list of conditions and the following disclaimer. --
47 -- --
48 -- 2. Redistributions in binary form must reproduce the above copyright --
49 -- notice, this list of conditions and the following disclaimer in the --
50 -- documentation and/or other materials provided with the distribution.--
51 -- --
52 -- 3. The names of its contributors may not be used to endorse or promote --
53 -- products derived from this software without specific prior written --
54 -- permission. --
55 -- --
56 -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS --
57 -- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT --
58 -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR --
59 -- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT --
60 -- OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, --
61 -- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED --
62 -- TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR --
63 -- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF --
64 -- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING --
65 -- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS --
66 -- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. --
67 -- --
68 ------------------------------------------------------------------------------
69
70 ------------------------------------------------------------------------------
71 -- --
72 -- This is an implementation of the Mersenne Twister, twisted generalized --
73 -- feedback shift register of rational normal form, with state-bit --
74 -- reflection and tempering. This version generates 32-bit integers with a --
75 -- period of 2**19937 - 1 (a Mersenne prime, hence the name). For --
76 -- applications requiring more than 32 bits (up to 64), we concatenate two --
77 -- 32-bit numbers. --
78 -- --
79 -- See http://www.math.sci.hiroshima-u.ac.jp/~m-mat/MT/emt.html for --
80 -- details. --
81 -- --
82 -- In contrast to the original code, we do not generate random numbers in --
83 -- batches of N. Measurement seems to show this has very little if any --
84 -- effect on performance, and it may be marginally better for real-time --
85 -- applications with hard deadlines. --
86 -- --
87 ------------------------------------------------------------------------------
88
89 with Ada.Unchecked_Conversion;
90
91 with System.Random_Seed;
92
93 with Interfaces; use Interfaces;
94
95 use Ada;
96
97 package body System.Random_Numbers is
98
99 Image_Numeral_Length : constant := Max_Image_Width / N;
100 subtype Image_String is String (1 .. Max_Image_Width);
101
102 ----------------------------
103 -- Algorithmic Parameters --
104 ----------------------------
105
106 Lower_Mask : constant := 2**31 - 1;
107 Upper_Mask : constant := 2**31;
108
109 Matrix_A : constant array (State_Val range 0 .. 1) of State_Val
110 := (0, 16#9908b0df#);
111 -- The twist transformation is represented by a matrix of the form
112 --
113 -- [ 0 I(31) ]
114 -- [ _a ]
115 --
116 -- where 0 is a 31x31 block of 0s, I(31) is the 31x31 identity matrix and
117 -- _a is a particular bit row-vector, represented here by a 32-bit integer.
118 -- If integer x represents a row vector of bits (with x(0), the units bit,
119 -- last), then
120 -- x * A = [0 x(31..1)] xor Matrix_A(x(0)).
121
122 U : constant := 11;
123 S : constant := 7;
124 B_Mask : constant := 16#9d2c5680#;
125 T : constant := 15;
126 C_Mask : constant := 16#efc60000#;
127 L : constant := 18;
128 -- The tempering shifts and bit masks, in the order applied
129
130 Seed0 : constant := 5489;
131 -- Default seed, used to initialize the state vector when Reset not called
132
133 Seed1 : constant := 19650218;
134 -- Seed used to initialize the state vector when calling Reset with an
135 -- initialization vector.
136
137 Mult0 : constant := 1812433253;
138 -- Multiplier for a modified linear congruential generator used to
139 -- initialize the state vector when calling Reset with a single integer
140 -- seed.
141
142 Mult1 : constant := 1664525;
143 Mult2 : constant := 1566083941;
144 -- Multipliers for two modified linear congruential generators used to
145 -- initialize the state vector when calling Reset with an initialization
146 -- vector.
147
148 -----------------------
149 -- Local Subprograms --
150 -----------------------
151
152 procedure Init (Gen : Generator; Initiator : Unsigned_32);
153 -- Perform a default initialization of the state of Gen. The resulting
154 -- state is identical for identical values of Initiator.
155
156 procedure Insert_Image
157 (S : in out Image_String;
158 Index : Integer;
159 V : State_Val);
160 -- Insert image of V into S, in the Index'th 11-character substring
161
162 function Extract_Value (S : String; Index : Integer) return State_Val;
163 -- Treat S as a sequence of 11-character decimal numerals and return
164 -- the result of converting numeral #Index (numbering from 0)
165
166 function To_Unsigned is
167 new Unchecked_Conversion (Integer_32, Unsigned_32);
168 function To_Unsigned is
169 new Unchecked_Conversion (Integer_64, Unsigned_64);
170
171 ------------
172 -- Random --
173 ------------
174
175 function Random (Gen : Generator) return Unsigned_32 is
176 G : Generator renames Gen.Writable.Self.all;
177 Y : State_Val;
178 I : Integer; -- should avoid use of identifier I ???
179
180 begin
181 I := G.I;
182
183 if I < N - M then
184 Y := (G.S (I) and Upper_Mask) or (G.S (I + 1) and Lower_Mask);
185 Y := G.S (I + M) xor Shift_Right (Y, 1) xor Matrix_A (Y and 1);
186 I := I + 1;
187
188 elsif I < N - 1 then
189 Y := (G.S (I) and Upper_Mask) or (G.S (I + 1) and Lower_Mask);
190 Y := G.S (I + (M - N))
191 xor Shift_Right (Y, 1)
192 xor Matrix_A (Y and 1);
193 I := I + 1;
194
195 elsif I = N - 1 then
196 Y := (G.S (I) and Upper_Mask) or (G.S (0) and Lower_Mask);
197 Y := G.S (M - 1) xor Shift_Right (Y, 1) xor Matrix_A (Y and 1);
198 I := 0;
199
200 else
201 Init (G, Seed0);
202 return Random (Gen);
203 end if;
204
205 G.S (G.I) := Y;
206 G.I := I;
207
208 Y := Y xor Shift_Right (Y, U);
209 Y := Y xor (Shift_Left (Y, S) and B_Mask);
210 Y := Y xor (Shift_Left (Y, T) and C_Mask);
211 Y := Y xor Shift_Right (Y, L);
212
213 return Y;
214 end Random;
215
216 generic
217 type Unsigned is mod <>;
218 type Real is digits <>;
219 with function Random (G : Generator) return Unsigned is <>;
220 function Random_Float_Template (Gen : Generator) return Real;
221 pragma Inline (Random_Float_Template);
222 -- Template for a random-number generator implementation that delivers
223 -- values of type Real in the range [0 .. 1], using values from Gen,
224 -- assuming that Unsigned is large enough to hold the bits of a mantissa
225 -- for type Real.
226
227 ---------------------------
228 -- Random_Float_Template --
229 ---------------------------
230
231 function Random_Float_Template (Gen : Generator) return Real is
232
233 pragma Compile_Time_Error
234 (Unsigned'Last <= 2**(Real'Machine_Mantissa - 1),
235 "insufficiently large modular type used to hold mantissa");
236
237 begin
238 -- This code generates random floating-point numbers from unsigned
239 -- integers. Assuming that Real'Machine_Radix = 2, it can deliver all
240 -- machine values of type Real (as implied by Real'Machine_Mantissa and
241 -- Real'Machine_Emin), which is not true of the standard method (to
242 -- which we fall back for non-binary radix): computing Real(<random
243 -- integer>) / (<max random integer>+1). To do so, we first extract an
244 -- (M-1)-bit significand (where M is Real'Machine_Mantissa), and then
245 -- decide on a normalized exponent by repeated coin flips, decrementing
246 -- from 0 as long as we flip heads (1 bits). This process yields the
247 -- proper geometric distribution for the exponent: in a uniformly
248 -- distributed set of floating-point numbers, 1/2 of them will be in
249 -- (0.5, 1], 1/4 will be in (0.25, 0.5], and so forth. It makes a
250 -- further adjustment at binade boundaries (see comments below) to give
251 -- the effect of selecting a uniformly distributed real deviate in
252 -- [0..1] and then rounding to the nearest representable floating-point
253 -- number. The algorithm attempts to be stingy with random integers. In
254 -- the worst case, it can consume roughly -Real'Machine_Emin/32 32-bit
255 -- integers, but this case occurs with probability around
256 -- 2**Machine_Emin, and the expected number of calls to integer-valued
257 -- Random is 1. For another discussion of the issues addressed by this
258 -- process, see Allen Downey's unpublished paper at
259 -- http://allendowney.com/research/rand/downey07randfloat.pdf.
260
261 if Real'Machine_Radix /= 2 then
262 return Real'Machine
263 (Real (Unsigned'(Random (Gen))) * 2.0**(-Unsigned'Size));
264
265 else
266 declare
267 type Bit_Count is range 0 .. 4;
268
269 subtype T is Real'Base;
270
271 Trailing_Ones : constant array (Unsigned_32 range 0 .. 15)
272 of Bit_Count :=
273 (2#00000# => 0, 2#00001# => 1, 2#00010# => 0, 2#00011# => 2,
274 2#00100# => 0, 2#00101# => 1, 2#00110# => 0, 2#00111# => 3,
275 2#01000# => 0, 2#01001# => 1, 2#01010# => 0, 2#01011# => 2,
276 2#01100# => 0, 2#01101# => 1, 2#01110# => 0, 2#01111# => 4);
277
278 Pow_Tab : constant array (Bit_Count range 0 .. 3) of Real
279 := (0 => 2.0**(0 - T'Machine_Mantissa),
280 1 => 2.0**(-1 - T'Machine_Mantissa),
281 2 => 2.0**(-2 - T'Machine_Mantissa),
282 3 => 2.0**(-3 - T'Machine_Mantissa));
283
284 Extra_Bits : constant Natural :=
285 (Unsigned'Size - T'Machine_Mantissa + 1);
286 -- Random bits left over after selecting mantissa
287
288 Mantissa : Unsigned;
289
290 X : Real; -- Scaled mantissa
291 R : Unsigned_32; -- Supply of random bits
292 R_Bits : Natural; -- Number of bits left in R
293 K : Bit_Count; -- Next decrement to exponent
294
295 begin
296 Mantissa := Random (Gen) / 2**Extra_Bits;
297 R := Unsigned_32 (Mantissa mod 2**Extra_Bits);
298 R_Bits := Extra_Bits;
299 X := Real (2**(T'Machine_Mantissa - 1) + Mantissa); -- Exact
300
301 if Extra_Bits < 4 and then R < 2 ** Extra_Bits - 1 then
302
303 -- We got lucky and got a zero in our few extra bits
304
305 K := Trailing_Ones (R);
306
307 else
308 Find_Zero : loop
309
310 -- R has R_Bits unprocessed random bits, a multiple of 4.
311 -- X needs to be halved for each trailing one bit. The
312 -- process stops as soon as a 0 bit is found. If R_Bits
313 -- becomes zero, reload R.
314
315 -- Process 4 bits at a time for speed: the two iterations
316 -- on average with three tests each was still too slow,
317 -- probably because the branches are not predictable.
318 -- This loop now will only execute once 94% of the cases,
319 -- doing more bits at a time will not help.
320
321 while R_Bits >= 4 loop
322 K := Trailing_Ones (R mod 16);
323
324 exit Find_Zero when K < 4; -- Exits 94% of the time
325
326 R_Bits := R_Bits - 4;
327 X := X / 16.0;
328 R := R / 16;
329 end loop;
330
331 -- Do not allow us to loop endlessly even in the (very
332 -- unlikely) case that Random (Gen) keeps yielding all ones.
333
334 exit Find_Zero when X = 0.0;
335 R := Random (Gen);
336 R_Bits := 32;
337 end loop Find_Zero;
338 end if;
339
340 -- K has the count of trailing ones not reflected yet in X. The
341 -- following multiplication takes care of that, as well as the
342 -- correction to move the radix point to the left of the mantissa.
343 -- Doing it at the end avoids repeated rounding errors in the
344 -- exceedingly unlikely case of ever having a subnormal result.
345
346 X := X * Pow_Tab (K);
347
348 -- The smallest value in each binade is rounded to by 0.75 of
349 -- the span of real numbers as its next larger neighbor, and
350 -- 1.0 is rounded to by half of the span of real numbers as its
351 -- next smaller neighbor. To account for this, when we encounter
352 -- the smallest number in a binade, we substitute the smallest
353 -- value in the next larger binade with probability 1/2.
354
355 if Mantissa = 0 and then Unsigned_32'(Random (Gen)) mod 2 = 0 then
356 X := 2.0 * X;
357 end if;
358
359 return X;
360 end;
361 end if;
362 end Random_Float_Template;
363
364 ------------
365 -- Random --
366 ------------
367
368 function Random (Gen : Generator) return Float is
369 function F is new Random_Float_Template (Unsigned_32, Float);
370 begin
371 return F (Gen);
372 end Random;
373
374 function Random (Gen : Generator) return Long_Float is
375 function F is new Random_Float_Template (Unsigned_64, Long_Float);
376 begin
377 return F (Gen);
378 end Random;
379
380 function Random (Gen : Generator) return Unsigned_64 is
381 begin
382 return Shift_Left (Unsigned_64 (Unsigned_32'(Random (Gen))), 32)
383 or Unsigned_64 (Unsigned_32'(Random (Gen)));
384 end Random;
385
386 ---------------------
387 -- Random_Discrete --
388 ---------------------
389
390 function Random_Discrete
391 (Gen : Generator;
392 Min : Result_Subtype := Default_Min;
393 Max : Result_Subtype := Result_Subtype'Last) return Result_Subtype
394 is
395 begin
396 if Max = Min then
397 return Max;
398
399 elsif Max < Min then
400 raise Constraint_Error;
401
402 elsif Result_Subtype'Base'Size > 32 then
403 declare
404 -- In the 64-bit case, we have to be careful, since not all 64-bit
405 -- unsigned values are representable in GNAT's root_integer type.
406 -- Ignore different-size warnings here since GNAT's handling
407 -- is correct.
408
409 pragma Warnings ("Z");
410 function Conv_To_Unsigned is
411 new Unchecked_Conversion (Result_Subtype'Base, Unsigned_64);
412 function Conv_To_Result is
413 new Unchecked_Conversion (Unsigned_64, Result_Subtype'Base);
414 pragma Warnings ("z");
415
416 N : constant Unsigned_64 :=
417 Conv_To_Unsigned (Max) - Conv_To_Unsigned (Min) + 1;
418
419 X, Slop : Unsigned_64;
420
421 begin
422 if N = 0 then
423 return Conv_To_Result (Conv_To_Unsigned (Min) + Random (Gen));
424
425 else
426 Slop := Unsigned_64'Last rem N + 1;
427
428 loop
429 X := Random (Gen);
430 exit when Slop = N or else X <= Unsigned_64'Last - Slop;
431 end loop;
432
433 return Conv_To_Result (Conv_To_Unsigned (Min) + X rem N);
434 end if;
435 end;
436
437 elsif Result_Subtype'Pos (Max) - Result_Subtype'Pos (Min) =
438 2 ** 32 - 1
439 then
440 return Result_Subtype'Val
441 (Result_Subtype'Pos (Min) + Unsigned_32'Pos (Random (Gen)));
442 else
443 declare
444 N : constant Unsigned_32 :=
445 Unsigned_32 (Result_Subtype'Pos (Max) -
446 Result_Subtype'Pos (Min) + 1);
447 Slop : constant Unsigned_32 := Unsigned_32'Last rem N + 1;
448 X : Unsigned_32;
449
450 begin
451 loop
452 X := Random (Gen);
453 exit when Slop = N or else X <= Unsigned_32'Last - Slop;
454 end loop;
455
456 return
457 Result_Subtype'Val
458 (Result_Subtype'Pos (Min) + Unsigned_32'Pos (X rem N));
459 end;
460 end if;
461 end Random_Discrete;
462
463 ------------------
464 -- Random_Float --
465 ------------------
466
467 function Random_Float (Gen : Generator) return Result_Subtype is
468 begin
469 if Result_Subtype'Base'Digits > Float'Digits then
470 return Result_Subtype'Machine (Result_Subtype
471 (Long_Float'(Random (Gen))));
472 else
473 return Result_Subtype'Machine (Result_Subtype
474 (Float'(Random (Gen))));
475 end if;
476 end Random_Float;
477
478 -----------
479 -- Reset --
480 -----------
481
482 procedure Reset (Gen : Generator) is
483 begin
484 Init (Gen, Unsigned_32'Mod (Random_Seed.Get_Seed));
485 end Reset;
486
487 procedure Reset (Gen : Generator; Initiator : Integer_32) is
488 begin
489 Init (Gen, To_Unsigned (Initiator));
490 end Reset;
491
492 procedure Reset (Gen : Generator; Initiator : Unsigned_32) is
493 begin
494 Init (Gen, Initiator);
495 end Reset;
496
497 procedure Reset (Gen : Generator; Initiator : Integer) is
498 begin
499 -- This is probably an unnecessary precaution against future change, but
500 -- since the test is a static expression, no extra code is involved.
501
502 if Integer'Size <= 32 then
503 Init (Gen, To_Unsigned (Integer_32 (Initiator)));
504
505 else
506 declare
507 Initiator1 : constant Unsigned_64 :=
508 To_Unsigned (Integer_64 (Initiator));
509 Init0 : constant Unsigned_32 :=
510 Unsigned_32 (Initiator1 mod 2 ** 32);
511 Init1 : constant Unsigned_32 :=
512 Unsigned_32 (Shift_Right (Initiator1, 32));
513 begin
514 Reset (Gen, Initialization_Vector'(Init0, Init1));
515 end;
516 end if;
517 end Reset;
518
519 procedure Reset (Gen : Generator; Initiator : Initialization_Vector) is
520 G : Generator renames Gen.Writable.Self.all;
521 I, J : Integer;
522
523 begin
524 Init (G, Seed1);
525 I := 1;
526 J := 0;
527
528 if Initiator'Length > 0 then
529 for K in reverse 1 .. Integer'Max (N, Initiator'Length) loop
530 G.S (I) :=
531 (G.S (I) xor ((G.S (I - 1)
532 xor Shift_Right (G.S (I - 1), 30)) * Mult1))
533 + Initiator (J + Initiator'First) + Unsigned_32 (J);
534
535 I := I + 1;
536 J := J + 1;
537
538 if I >= N then
539 G.S (0) := G.S (N - 1);
540 I := 1;
541 end if;
542
543 if J >= Initiator'Length then
544 J := 0;
545 end if;
546 end loop;
547 end if;
548
549 for K in reverse 1 .. N - 1 loop
550 G.S (I) :=
551 (G.S (I) xor ((G.S (I - 1)
552 xor Shift_Right (G.S (I - 1), 30)) * Mult2))
553 - Unsigned_32 (I);
554 I := I + 1;
555
556 if I >= N then
557 G.S (0) := G.S (N - 1);
558 I := 1;
559 end if;
560 end loop;
561
562 G.S (0) := Upper_Mask;
563 end Reset;
564
565 procedure Reset (Gen : Generator; From_State : Generator) is
566 G : Generator renames Gen.Writable.Self.all;
567 begin
568 G.S := From_State.S;
569 G.I := From_State.I;
570 end Reset;
571
572 procedure Reset (Gen : Generator; From_State : State) is
573 G : Generator renames Gen.Writable.Self.all;
574 begin
575 G.I := 0;
576 G.S := From_State;
577 end Reset;
578
579 procedure Reset (Gen : Generator; From_Image : String) is
580 G : Generator renames Gen.Writable.Self.all;
581 begin
582 G.I := 0;
583
584 for J in 0 .. N - 1 loop
585 G.S (J) := Extract_Value (From_Image, J);
586 end loop;
587 end Reset;
588
589 ----------
590 -- Save --
591 ----------
592
593 procedure Save (Gen : Generator; To_State : out State) is
594 Gen2 : Generator;
595
596 begin
597 if Gen.I = N then
598 Init (Gen2, 5489);
599 To_State := Gen2.S;
600
601 else
602 To_State (0 .. N - 1 - Gen.I) := Gen.S (Gen.I .. N - 1);
603 To_State (N - Gen.I .. N - 1) := Gen.S (0 .. Gen.I - 1);
604 end if;
605 end Save;
606
607 -----------
608 -- Image --
609 -----------
610
611 function Image (Of_State : State) return String is
612 Result : Image_String;
613
614 begin
615 Result := (others => ' ');
616
617 for J in Of_State'Range loop
618 Insert_Image (Result, J, Of_State (J));
619 end loop;
620
621 return Result;
622 end Image;
623
624 function Image (Gen : Generator) return String is
625 Result : Image_String;
626
627 begin
628 Result := (others => ' ');
629 for J in 0 .. N - 1 loop
630 Insert_Image (Result, J, Gen.S ((J + Gen.I) mod N));
631 end loop;
632
633 return Result;
634 end Image;
635
636 -----------
637 -- Value --
638 -----------
639
640 function Value (Coded_State : String) return State is
641 Gen : Generator;
642 S : State;
643 begin
644 Reset (Gen, Coded_State);
645 Save (Gen, S);
646 return S;
647 end Value;
648
649 ----------
650 -- Init --
651 ----------
652
653 procedure Init (Gen : Generator; Initiator : Unsigned_32) is
654 G : Generator renames Gen.Writable.Self.all;
655 begin
656 G.S (0) := Initiator;
657
658 for I in 1 .. N - 1 loop
659 G.S (I) :=
660 (G.S (I - 1) xor Shift_Right (G.S (I - 1), 30)) * Mult0
661 + Unsigned_32 (I);
662 end loop;
663
664 G.I := 0;
665 end Init;
666
667 ------------------
668 -- Insert_Image --
669 ------------------
670
671 procedure Insert_Image
672 (S : in out Image_String;
673 Index : Integer;
674 V : State_Val)
675 is
676 Value : constant String := State_Val'Image (V);
677 begin
678 S (Index * 11 + 1 .. Index * 11 + Value'Length) := Value;
679 end Insert_Image;
680
681 -------------------
682 -- Extract_Value --
683 -------------------
684
685 function Extract_Value (S : String; Index : Integer) return State_Val is
686 Start : constant Integer := S'First + Index * Image_Numeral_Length;
687 begin
688 return State_Val'Value (S (Start .. Start + Image_Numeral_Length - 1));
689 end Extract_Value;
690
691 end System.Random_Numbers;
Mirror of the offical gcc git repository hosted at gcc.gnu.org