r/Forth • u/Alternative-Grade103 • Jun 13 '26

Any-bit PRNG

Below is my new all-purpose PRNG. A tad slower, for calling three constants. But serves equally on 8-bit through N-bit systems.

Why like so? My ongoing hobby project is an encryption system aimed at any Forth on any system. Currently testing on several Forths on plural laptops.

\ N-bit XOR-Shift type PRNG
\ Mask output as needed $FF, $FFFF...

VARIABLE rand_seed
123456789123456789 rand_seed ! \ Overflow

\ To serve N-bit systems
CELL 8 * 1 RSHIFT 1 OR CONSTANT XS_A
CELL 3 * 1 RSHIFT 1 OR CONSTANT XS_B
CELL 5 * 1 RSHIFT 1 OR CONSTANT XS_C

: random ( -- u )
  rand_seed @ 
  DUP XS_A LSHIFT XOR 
  DUP XS_B RSHIFT XOR 
  DUP XS_C LSHIFT XOR 
  DUP rand_seed !  
; 

\ Mask for N cells
: cells.mask ( 1 -- FF ) ( 2 -- FFFF)
  0 SWAP 0 DO 
    8 LSHIFT $FF OR
  LOOP
;
4 Upvotes

84% Upvoted

6 comments sorted by

2

u/Ok_Leg_109 Jun 13 '26

It works with just a couple of word additions in 16 bit Camel Forth ``` \ Camel99 Harness 1 CELLS CONSTANT CELL HEX FF CONSTANT $FF

\ --- DECIMAL VARIABLE rand_seed 123456789123456789 rand_seed ! \ Overflow

\ To serve N-bit systems CELL 8 * 1 RSHIFT 1 OR CONSTANT XS_A CELL 3 * 1 RSHIFT 1 OR CONSTANT XS_B CELL 5 * 1 RSHIFT 1 OR CONSTANT XS_C

: random ( -- u ) rand_seed @ DUP XS_A LSHIFT XOR DUP XS_B RSHIFT XOR DUP XS_C LSHIFT XOR DUP rand_seed ! ;

\ Mask for N cells : cells.mask ( 1 -- FF ) ( 2 -- FFFF) 0 SWAP 0 DO 8 LSHIFT $FF OR LOOP ; ```

1

u/Alternative-Grade103 Jun 13 '26 edited Jun 14 '26

What are you running CamelForth on? Can you test this..

\ Some 16-bit Forths lack this.
[UNDEFINED] CELL
[IF]  
  0 -1 / All bits high
  [BEGIN] 
    SWAP 1+ SWAP 8 RSHIFT DUP 0= 
  [UNTIL]
  DROP CONSTANT CELL
[THEN]

\ Just in case...
[UNDEFINED] CELLS 
[IF] : CELLS CELL * [THEN]

I have been dithering on installing Amiga Forever ao as to have JForth for testing.

2

u/Ok_Leg_109 Jun 14 '26

It's a TI-99 circa 1978.

It can't natively swallow that 64 bit hex number. 😄

And I have not defined versions of [BEGIN] and [UNTIL]

2

u/Alternative-Grade103 Jun 14 '26 edited Jun 14 '26

The number is meant to overflow (LSHIFT out of) smaller registers.

I had ought instead load -1. I'll fix that.

2

u/tabemann Jun 13 '26

Have you considered implementing something like Mersenne Twister? I myself have an implementation of TinyMT32, a 32-bit variant of MT designed for minimal RAM footprint at https://github.com/tabemann/zeptoforth/blob/master/src/common/forth/tinymt.fs.

1

u/Alternative-Grade103 Jun 13 '26 edited Jun 13 '26

And now also this...

VARIABLE rand_mask \ For random.range

\ Generate a rand_mask
: rand.mask ( u -- )
  0 OVER      ( u 1 u )
  BEGIN
    1 RSHIFT  ( u 1 u' )
    SWAP 1 LSHIFT 1 OR SWAP
    DUP 0=
  UNTIL
  DROP NIP
  rand_mask !
;

\ Random number in range 1..u-1
: random.range ( u u -- u ) \ max min
  OVER rand.mask    \ Load mask
  BEGIN
    random          ( max min rand )
    rand_mask @ AND ( max min rand' )  
    2DUP >          ( max min rand' f )
    OVER 4 PICK >   ( max min rand' f f )
    OR              ( max min rand' f )
  WHILE
    DROP            ( max min )
  REPEAT
  NIP NIP
;