Raymond Toy pushed to branch issue-294-xoroshiro-lisp-assem-routine at cmucl / cmucl

Commits:

3 changed files:

Changes:

  • src/assembly/x86/arith.lisp
    ... ... @@ -412,15 +412,41 @@
    412 412 
       (inst pop k)
    413 413 
       (inst ret))
    414 414
    415 
    -
    416 
    -#+(and random-xoroshiro assembler)
    415 
    +;;; Support for the xoroshiro128** generator.  See
    416 
    +;;; https://prng.di.unimi.it/xoroshiro128starstar.c for the official
    417 
    +;;; code.
    418 
    +;;;
    419 
    +;;; This is what we're implementing, where s[] is our state vector.
    420 
    +;;;
    421 
    +;;; static uint64_t s[2];
    422 
    +;;; static inline uint64_t rotl(const uint64_t x, int k) {
    423 
    +;;;   return (x << k) | (x >> (64 - k));
    424 
    +;;; }
    425 
    +;;;
    426 
    +;;; uint64_t next(void) {
    427 
    +;;;   const uint64_t s0 = s[0];
    428 
    +;;; 	 uint64_t s1 = s[1];
    429 
    +;;; 	 const uint64_t result = rotl(s0 * 5, 7) * 9;
    430 
    +;;;
    431 
    +;;; 	 s1 ^= s0;
    432 
    +;;; 	 s[0] = rotl(s0, 24) ^ s1 ^ (s1 << 16); // a, b
    433 
    +;;; 	 s[1] = rotl(s1, 37); // c
    434 
    +;;;
    435 
    +;;; 	 return result;
    436 
    +;;; }
    437 
    +;;;
    438 
    +;;; A VOP is also generated to call this assembly routine.  This
    439 
    +;;; routine computes a new 64-bit random number and also updates the
    440 
    +;;; state, which is (simple-array (double-float) (2)).
    441 
    +#+random-xoroshiro
    417 442 
     (define-assembly-routine
    418 443 
       (xoroshiro-update
    419 
    -   (:translate kernel::xoroshiro-update)
    444 
    +   (:translate kernel::random-xoroshiro-update)
    420 445 
        (:return-style :raw)
    421 446 
        (:cost 30)
    422 
    -   (:policy :safe)
    423 
    -   (:save-p t))
    447 
    +   (:policy :fast-safe)
    448 
    +   (:arg-types simple-array-double-float)
    449 
    +   (:result-types unsigned-num unsigned-num))
    424 450 
       ((:arg state descriptor-reg eax-offset)
    425 451 
        (:res r1 unsigned-reg edx-offset)
    426 452 
        (:res r0 unsigned-reg ebx-offset)
    ... ... @@ -428,26 +454,6 @@
    428 454 
        (:temp s1 double-reg xmm1-offset)
    429 455 
        (:temp t0 double-reg xmm2-offset)
    430 456 
        (:temp t1 double-reg xmm3-offset))
    431 
    -  ;; See https://prng.di.unimi.it/xoroshiro128starstar.c for the official code.
    432 
    -  ;;
    433 
    -  ;; This is what we're implementing, where s[] is our state vector.
    434 
    -  ;;
    435 
    -  ;; static uint64_t s[2];
    436 
    -  ;; static inline uint64_t rotl(const uint64_t x, int k) {
    437 
    -  ;;   return (x << k) | (x >> (64 - k));
    438 
    -  ;; }
    439 
    -  ;;
    440 
    -  ;; uint64_t next(void) {
    441 
    -  ;;   const uint64_t s0 = s[0];
    442 
    -  ;; 	 uint64_t s1 = s[1];
    443 
    -  ;; 	 const uint64_t result = rotl(s0 * 5, 7) * 9;
    444 
    -  ;;
    445 
    -  ;; 	 s1 ^= s0;
    446 
    -  ;; 	 s[0] = rotl(s0, 24) ^ s1 ^ (s1 << 16); // a, b
    447 
    -  ;; 	 s[1] = rotl(s1, 37); // c
    448 
    -  ;;
    449 
    -  ;; 	 return result;
    450 
    -  ;; }
    451 457
    452 458 
       ;; s0 = state[0]
    453 459 
       (inst movsd s0 (make-ea :dword :base state
    ... ... @@ -522,5 +528,4 @@
    522 528 
     					     vm:word-bytes)
    523 529 
     				          (* 8 1))
    524 530 
     				       vm:other-pointer-type))
    525 
    -        s1)
    526 
    -  (inst ret))
    531 
    +        s1))

  • src/assembly/x86/support.lisp
    ... ... @@ -39,7 +39,7 @@
    39 39 
     (def-vm-support-routine generate-return-sequence (style)
    40 40 
       (ecase style
    41 41 
         (:raw
    42 
    -     `(inst ret))
    42 
    +     `((inst ret)))
    43 43 
         (:full-call
    44 44 
          `(
    45 45 
            (inst pop eax-tn)

  • src/compiler/x86/arith.lisp
    ... ... @@ -1812,34 +1812,6 @@
    1812 1812 
     )
    1813 1813
    1814 1814 
     #+random-xoroshiro
    1815 
    -(progn
    1816 1815 
     (defknown kernel::random-xoroshiro-update ((simple-array double-float (2)))
    1817 1816 
       (values (unsigned-byte 32) (unsigned-byte 32))
    1818 1817 
       (movable))
    1819 
    -
    1820 
    -
    1821 
    -(define-vop (random-xoroshiro-update)
    1822 
    -  (:policy :fast-safe)
    1823 
    -  (:translate kernel::random-xoroshiro-update)
    1824 
    -  (:args (state :scs (descriptor-reg) :target state-arg))
    1825 
    -  (:arg-types simple-array-double-float)
    1826 
    -  (:results (hi :scs (unsigned-reg))
    1827 
    -            (lo :scs (unsigned-reg)))
    1828 
    -  (:result-types unsigned-num unsigned-num)
    1829 
    -  (:temporary (:sc descriptor-reg :offset eax-offset) state-arg)
    1830 
    -  (:temporary (:sc double-reg :offset xmm0-offset) s0)
    1831 
    -  (:temporary (:sc double-reg :offset xmm1-offset) s1)
    1832 
    -  (:temporary (:sc double-reg :offset xmm2-offset) t0)
    1833 
    -  (:temporary (:sc double-reg :offset xmm3-offset) t1)
    1834 
    -  (:temporary (:sc unsigned-reg :offset edx-offset :target hi) r1)
    1835 
    -  (:temporary (:sc unsigned-reg :offset ebx-offset :target lo) r0)
    1836 
    -  (:generator 50
    1837 
    -    (move state-arg state)
    1838 
    -    (move s0 s0)
    1839 
    -    (move s1 s1)
    1840 
    -    (move t0 t0)
    1841 
    -    (move t1 t1)
    1842 
    -    (inst call (make-fixup 'vm::xoroshiro-update :assembly-routine))
    1843 
    -    (move hi r1)
    1844 
    -    (move lo r0)))
    1845 
    -)

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.common-lisp.net. Manage all notifications · Help