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