OberonCore

typedef struct {
    uint32_t x;
} Lcg32State;

static inline uint64_t get_bits_raw(void *state)
{
    Lcg32State *obj = state;
    uint16_t x_lo = (uint16_t) (obj->x & 0xFFFF);
    uint16_t x_hi = (uint16_t) (obj->x >> 16);
//    obj->x = (uint32_t)63885 * x_lo + x_hi;
//  Causes a glitch in GCC 10 (some UB during optimization?)
    obj->x = 63885 * x_lo + x_hi;
    return obj->x;
}

(**
 * 1. https://doi.org/10.1214/aoap/1177005878
 * 2. https://groups.google.com/g/comp.lang.fortran/c/5Bi8cFoYwPE
 *)
MODULE xkiss;
IMPORT SYSTEM, Out;

TYPE XkissArState = RECORD
    x : INTEGER;
    a0, a1, c : INTEGER;
END;

PROCEDURE XkissArInit(VAR obj : XkissArState; x, a0, a1 : INTEGER);
BEGIN
    obj.x := x;
    obj.a0 := a0 MOD 67108863; (* 2^26 - 1 *)
    obj.a1 := a1 MOD 67108863; (* 2^26 - 1 *)
    obj.c  := 1;
    IF obj.x = 0  THEN obj.x  := 123456 END;
    IF obj.a0 < 0 THEN obj.a0 := 0 END;
    IF obj.a1 < 0 THEN obj.a1 := 0 END
END XkissArInit;

PROCEDURE XkissArNext(VAR obj : XkissArState) : INTEGER;
CONST
    mask26 = 03FFFFFFH;
    mask31 = 07FFFFFFFH;
VAR
    t: INTEGER;
BEGIN
    (* LFSR part *)
    obj.x := SYSTEM.VAL(INTEGER, (* x ^= x << 1 *)
        SYSTEM.VAL(SET, obj.x) / SYSTEM.VAL(SET, LSL(obj.x, 1))
    );
    obj.x := SYSTEM.VAL(INTEGER, (* x ^= rotl32(x, 9) ^ rotl32(x, 27) *)
        SYSTEM.VAL(SET, obj.x) / SYSTEM.VAL(SET, ROR(obj.x, 23)) /
        SYSTEM.VAL(SET, ROR(obj.x, 5))
    );
    (* AWC part *)
    t := obj.a0 + obj.a1 + obj.c;
    obj.a1 := obj.a0;
    obj.c  := ASR(t, 26);
    obj.a0 := SYSTEM.VAL(INTEGER,
        SYSTEM.VAL(SET, t) * SYSTEM.VAL(SET, mask26)
    );
    (* Output function *)
    RETURN SYSTEM.VAL(INTEGER, SYSTEM.VAL(SET, mask31) * (
        SYSTEM.VAL(SET, obj.x) / SYSTEM.VAL(SET, LSL(obj.a0, 6)) /
        SYSTEM.VAL(SET, obj.a1 * 29)
    ))
END XkissArNext;

PROCEDURE XkissArTest() : BOOLEAN;
CONST
    uref = 0453EFE6EH;
VAR
    prng : XkissArState;
    i, u : INTEGER;
BEGIN
    u := 0;
    XkissArInit(prng, 12345678, 3, 2);
    FOR i := 1 TO 1000000 DO
        u := XkissArNext(prng)
    END;
    Out.String("Output:    "); Out.Int(u, 10); Out.Ln();
    Out.String("Reference: "); Out.Int(uref, 10); Out.Ln();
    FOR i := 1 TO 10 DO
        Out.Int(XkissArNext(prng), 5);
        Out.Ln()
    END;
    RETURN u = uref
END XkissArTest;

BEGIN
    IF XkissArTest() THEN
        Out.String("Passed")
    ELSE
        Out.String("Failed")
    END
END xkiss.

PROCEDURE (VAR ctx: Context) GenU32* [no_overflow_checks, no_zero_locals] (): INTEGER, NEW;
VAR
  oldstate: LONGINT;
  xorshifted, rot: INTEGER;
BEGIN
  oldstate := ctx.state;
  // it doesn't matter if we'll use `*` or `UMUL` here, but for clarity...
  ctx.state := UMUL(oldstate, LONG(04C957F2DH, 05851F42DH)) + ctx.inc;
  xorshifted := SHR(LONG_XOR(SHR(oldstate, 18), oldstate), 27).lo;
  rot := SHR(oldstate, 59).lo;
  RETURN ROR(xorshifted, rot MOD 32);
END GenU32;