(----------------------------------------------------------------------------)
(----------------------------------------------------------------------------)
(- Demo Tape for 'Peh'; produces a random probable-prime of the given form. -)
(-                                                                          -)
(- (C) 2019 Stanislav Datskovskiy ( www.loper-os.org )                      -)
(- http://wot.deedbot.org/17215D118B7239507FAFED98B98228A001ABFFC7.html     -)
(-                                                                          -)
(- You do not have, nor can you ever acquire the right to use, copy or      -)
(- distribute this software ; Should you use this software for any purpose, -)
(- or copy and distribute it to anyone or in any manner, you are breaking   -)
(- the laws of whatever soi-disant jurisdiction, and you promise to         -)
(- continue doing so for the indefinite future. In any case, please         -)
(- always : read and understand any software ; verify any PGP signatures    -)
(- that you use - for any purpose.                                          -)
(-                                                                          -)
(- See also http://trilema.com/2015/a-new-software-licensing-paradigm .     -)
(----------------------------------------------------------------------------)
(----------------------------------------------------------------------------)

(----------------------------------------------------------------------------)

( Largest Primorial which fits in a 2048-bit FZ : )

@Primorial@ ( Regs : none )
        .48CB4F7B0A023C393C0A4F253FFE4D1905DEFDF482D0C7754B59B612E3B741995
         87DC933268A053E59F021733C80D558BF9CBBAD3A38E2FB5D4BA3157227E8ACA0
         ACF379238AFA8DB31110AF0C566DC5DBC5C8E783E1566B3B44A4E35FFC2BFE481
         C533A1609E99A1C9AF81C8F634F7400FBD1355D091FAB7B9AFF302AAC9D60C15C
         29E3396A18523E177B1DA3898FF1F8BF74A2CC40032736A65B25B5908950863A8
         019065A073EBF20164F14EA4338530C2818F208BAEEB2A810A9862A09B8ADE3BE
         BDD7CF7DC88ECB1722F7ED2DAD24FE5C4851F7D6681CA2B97306BAC70E37D177C
         139E2688AF33E5CCEF102A2AE35276983DDCABA3720E5C165EB88C0FE
;

(----------------------------------------------------------------------------)

( Number of 'passing' M-R shots required before we will say that a candidate
  integer is a 'probable prime': 32. Can change this if you dare. )

@MR-Shots@ ( Regs : none )
        .20
;

(----------------------------------------------------------------------------)

( Bitmask imposed, via logical OR, on the randomly-generated candidates.
  Consists of a 1 in the uppermost position for the current FZ width,
  and a 1 in the lowermost position, to give ODD integers of desired width. )

@Candidate-Bitmask@ ( Regs : none )
        .1
           .0 ~ W
           .1 -
        LS
        .1
        |
;

(----------------------------------------------------------------------------)

( Take an integer N from stack.
  N MUST BE > 1; assumed to be true, given that the Candidate Bitmask is > 1.
  if N is Relatively Prime vs. Primorial:
     Return 0;
  else:
     return 1. )

@Primorial-Litmus@ ( Regs : none )

        ( N is on the stack already. Now find GCD(N, Primorial) : )
        @Primorial! G

        ( Was the GCD equal to 1 ? )
        .1 =

        ( Invert the answer; i.e. a 'fail' will result in 1, a 'pass' -- 0 : )
        .1 ^
;

(----------------------------------------------------------------------------)

( Take a Bitmask specifying the bits that must be set to 1, from the stack.
  Generate RANDOM integers, until obtains one that, when OR'd with Bitmask,
  passes the Primorial Litmus. )

@Make-Candidate@ ( Regs : u, m, z )

        ( Get the Bitmask from the stack, and assign to m : )
        $m

        ( Begin a loop: )
        :

                ( u := u + 1 , i.e. increment the 'RNG shots' counter: )
                u .1 + $u

                ( Generate a random FZ of the current FZ width : )
                ?
                
                ( Take the mandatory-ones Bitmask, and OR it into
                  the random FZ from above, then store this to z: )
                m | $z
                
                ( Run z through the Primorial Litmus: )
                z @Primorial-Litmus!

        ( If 1, i.e. Litmus failed, cycle the loop; otherwise we're done: )
        ,

        ( Return the z which passed the Primorial Litmus: )
        z
;

(----------------------------------------------------------------------------)

( Take integers N and I from stack (I is on the top of stack, followed by N) ;
  Fire up to I shots of Miller-Rabin Test on N, each with a RANDOM witness;

  If ALL I shots PASSED, i.e. M-R did NOT 'find composite' in any of them :
     Return 0;
  else (i.e. if any shot FAILED) :
     Return 1 IMMEDIATELY. )

@Iterated-MR-Test@ ( Regs : i, n, r )
        ( i := Maximum number of Miller-Rabin shots that we will perform : )
        $i
        
        ( n := N, i.e. store a copy of N: )
        $n
        
        ( Begin a loop: )
        :

                ( Put n on the stack: )
                n

                ( Generate a random Witness for this shot: )
                ?
                ( Recall that it will always be brought into the valid range,
                  automatically, in constant time. See also Ch. 16A. )

                ( Run a M-R test; outputs 1 if FOUND composite, and 0 if NOT: )
                P

                ( r := result )
                $r
                
                ( i := i - 1 , i.e. decrement the shots counter: )
                i .1 - $i

                ( If any shots still remain... )
                i .0 >

                ( Invert the M-R result: if 'NOT found composite', give a 1 : )
                r .1 ^
                
                ( ...shots remain, AND current one did not 'find composite' : )
                &

        ( ... then have a 1, and we cycle the loop, for the next shot;
          Otherwise, we're done: )
        ,

        ( At this point, N has failed a M-R shot, or passed all of the shots;
          In either case, we return r,
          which will be 0 IFF all shots passed, and otherwise 1 : )
        r
;

(------------------------------ Main Program : ------------------------------)

( Regs: u, t, k, x )

( Initialize u, 'RNG' counter, i.e. how many random FZ were needed : )
.0 $u

( Initialize t, 'tries' counter, i.e. how many GCD-filtered candidates tried: )
.0 $t

( Initialize k to the Bitmask that is to be imposed on candidates : )
@Candidate-Bitmask! $k

( Begin the main loop: )
:

        ( t := t + 1 , i.e. increment the 'tries' counter: )
        t .1 + $t

        ( Get a candidate x, using Bitmask k, which passes Primorial Litmus: )
        k @Make-Candidate! $x
        
        ( Perform MR-Shots of the Miller-Rabin Test: )
        x @MR-Shots! @Iterated-MR-Test!
        
( If not yet found a candidate which passed both the initial Primorial Litmus
  and then the full number of M-R shots, then cycle the loop : )
,

( At this point, we have found a 'probable prime' candidate, and will print: )

( ... the Bitmask used  : )
[Bitmask Imposed on Candidates  : ] k #

( ... the number of 'passing' M-R shots required for termination : )
[Number of Mandated M-R Shots   : ] @MR-Shots! #

( ... the 'RNG shots' counter : )
[Total Number of Random FZ Used : ] u #

( ... the 'tries' counter, i.e. how many passed Primorial Litmus : )
[GCD-Filtered Candidates Tested : ] t #

( ... finally, the candidate which passed all of the requested tests : )
[Probable Prime Integer         : ] x #

( Now, terminate with a 'Yes' Verdict, as we have succeeded : )
QY

(--------------------------------~~The End~~---------------------------------)