newlib/prng.ajla

   1 {*
   2  * Copyright (C) 2024 Mikulas Patocka
   3  *
   4  * This file is part of Ajla.
   5  *
   6  * Ajla is free software: you can redistribute it and/or modify it under the
   7  * terms of the GNU General Public License as published by the Free Software
   8  * Foundation, either version 3 of the License, or (at your option) any later
   9  * version.
  10  *
  11  * Ajla is distributed in the hope that it will be useful, but WITHOUT ANY
  12  * WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  13  * A PARTICULAR PURPOSE. See the GNU General Public License for more details.
  14  *
  15  * You should have received a copy of the GNU General Public License along with
  16  * Ajla. If not, see <https://www.gnu.org/licenses/>.
  17  *}
  18
  19 unit prng;
  20
  21 type prng_state;
  22
  23 fn prng_init(seed : int) : prng_state;
  24 fn prng_get_uint32(state : prng_state) : (prng_state, uint32);
  25 fn prng_get_int(state : prng_state, bits : int) : (prng_state, int);
  26
  27 implementation
  28
  29 // https://arxiv.org/abs/1704.00358
  30
  31 record prng_state [
  32         x w : uint64;
  33 ]
  34
  35 const s : uint64 := #b5ad4eceda1ce2a9;
  36
  37 fn prng_init(seed : int) : prng_state
  38 [
  39         var x : uint64 := seed and #ffffffff;
  40         var w : uint64 := seed shr 32 and #ffffffffffffffff;
  41         x *= s;
  42         w *= s;
  43         return prng_state.[
  44                 x : x,
  45                 w : w,
  46         ];
  47 ]
  48
  49 fn prng_get_uint32(state : prng_state) : (prng_state, uint32)
  50 [
  51         var x := state.x;
  52         var w := state.w;
  53         x *= x;
  54         w += s;
  55         x += w;
  56         x := x shr 32 or x shl 32;
  57         state.x := x;
  58         state.w := w;
  59         return state, x and #ffffffff;
  60 ]
  61
  62 fn prng_get_int(implicit state : prng_state, bits : int) : (prng_state, int)
  63 [
  64         var r := 0;
  65         var bit := 0;
  66         while bit + 32 <= bits do [
  67                 var p : int := prng_get_uint32();
  68                 r or= p shl bit;
  69                 bit += 32;
  70         ]
  71         if bit < bits then [
  72                 var p : int := prng_get_uint32();
  73                 p and= (1 shl bits - bit) - 1;
  74                 r or= p shl bit;
  75         ]
  76         return r;
  77 ]