raw
ffa_ch19_peh_tuni...    1 (----------------------------------------------------------------------------)
ffa_ch19_peh_tuni... 2 (----------------------------------------------------------------------------)
ffa_ch19_peh_tuni... 3 (- Demo Tape for 'Peh'; produces a random probable-prime of the given form. -)
ffa_ch19_peh_tuni... 4 (- -)
ffa_ch19_peh_tuni... 5 (- (C) 2019 Stanislav Datskovskiy ( www.loper-os.org ) -)
ffa_ch19_peh_tuni... 6 (- http://wot.deedbot.org/17215D118B7239507FAFED98B98228A001ABFFC7.html -)
ffa_ch19_peh_tuni... 7 (- -)
ffa_ch19_peh_tuni... 8 (- You do not have, nor can you ever acquire the right to use, copy or -)
ffa_ch19_peh_tuni... 9 (- distribute this software ; Should you use this software for any purpose, -)
ffa_ch19_peh_tuni... 10 (- or copy and distribute it to anyone or in any manner, you are breaking -)
ffa_ch19_peh_tuni... 11 (- the laws of whatever soi-disant jurisdiction, and you promise to -)
ffa_ch19_peh_tuni... 12 (- continue doing so for the indefinite future. In any case, please -)
ffa_ch19_peh_tuni... 13 (- always : read and understand any software ; verify any PGP signatures -)
ffa_ch19_peh_tuni... 14 (- that you use - for any purpose. -)
ffa_ch19_peh_tuni... 15 (- -)
ffa_ch19_peh_tuni... 16 (- See also http://trilema.com/2015/a-new-software-licensing-paradigm . -)
ffa_ch19_peh_tuni... 17 (----------------------------------------------------------------------------)
ffa_ch19_peh_tuni... 18 (----------------------------------------------------------------------------)
ffa_ch19_peh_tuni... 19
ffa_ch19_peh_tuni... 20 (----------------------------------------------------------------------------)
ffa_ch19_peh_tuni... 21
ffa_ch19_peh_tuni... 22 ( Largest Primorial which fits in a 2048-bit FZ : )
ffa_ch19_peh_tuni... 23
ffa_ch19_peh_tuni... 24 @Primorial@ ( Regs : none )
ffa_ch19_peh_tuni... 25 .48CB4F7B0A023C393C0A4F253FFE4D1905DEFDF482D0C7754B59B612E3B741995
ffa_ch19_peh_tuni... 26 87DC933268A053E59F021733C80D558BF9CBBAD3A38E2FB5D4BA3157227E8ACA0
ffa_ch19_peh_tuni... 27 ACF379238AFA8DB31110AF0C566DC5DBC5C8E783E1566B3B44A4E35FFC2BFE481
ffa_ch19_peh_tuni... 28 C533A1609E99A1C9AF81C8F634F7400FBD1355D091FAB7B9AFF302AAC9D60C15C
ffa_ch19_peh_tuni... 29 29E3396A18523E177B1DA3898FF1F8BF74A2CC40032736A65B25B5908950863A8
ffa_ch19_peh_tuni... 30 019065A073EBF20164F14EA4338530C2818F208BAEEB2A810A9862A09B8ADE3BE
ffa_ch19_peh_tuni... 31 BDD7CF7DC88ECB1722F7ED2DAD24FE5C4851F7D6681CA2B97306BAC70E37D177C
ffa_ch19_peh_tuni... 32 139E2688AF33E5CCEF102A2AE35276983DDCABA3720E5C165EB88C0FE
ffa_ch19_peh_tuni... 33 ;
ffa_ch19_peh_tuni... 34
ffa_ch19_peh_tuni... 35 (----------------------------------------------------------------------------)
ffa_ch19_peh_tuni... 36
ffa_ch19_peh_tuni... 37 ( Number of 'passing' M-R shots required before we will say that a candidate
ffa_ch19_peh_tuni... 38 integer is a 'probable prime': 32. Can change this if you dare. )
ffa_ch19_peh_tuni... 39
ffa_ch19_peh_tuni... 40 @MR-Shots@ ( Regs : none )
ffa_ch19_peh_tuni... 41 .20
ffa_ch19_peh_tuni... 42 ;
ffa_ch19_peh_tuni... 43
ffa_ch19_peh_tuni... 44 (----------------------------------------------------------------------------)
ffa_ch19_peh_tuni... 45
ffa_ch19_peh_tuni... 46 ( Bitmask imposed, via logical OR, on the randomly-generated candidates.
ffa_ch19_peh_tuni... 47 Consists of a 1 in the uppermost position for the current FZ width,
ffa_ch19_peh_tuni... 48 and a 1 in the lowermost position, to give ODD integers of desired width. )
ffa_ch19_peh_tuni... 49
ffa_ch19_peh_tuni... 50 @Candidate-Bitmask@ ( Regs : none )
ffa_ch19_peh_tuni... 51 .1
ffa_ch19_peh_tuni... 52 .0 ~ W
ffa_ch19_peh_tuni... 53 .1 -
ffa_ch19_peh_tuni... 54 LS
ffa_ch19_peh_tuni... 55 .1
ffa_ch19_peh_tuni... 56 |
ffa_ch19_peh_tuni... 57 ;
ffa_ch19_peh_tuni... 58
ffa_ch19_peh_tuni... 59 (----------------------------------------------------------------------------)
ffa_ch19_peh_tuni... 60
ffa_ch19_peh_tuni... 61 ( Take an integer N from stack.
ffa_ch19_peh_tuni... 62 N MUST BE > 1; assumed to be true, given that the Candidate Bitmask is > 1.
ffa_ch19_peh_tuni... 63 if N is Relatively Prime vs. Primorial:
ffa_ch19_peh_tuni... 64 Return 0;
ffa_ch19_peh_tuni... 65 else:
ffa_ch19_peh_tuni... 66 return 1. )
ffa_ch19_peh_tuni... 67
ffa_ch19_peh_tuni... 68 @Primorial-Litmus@ ( Regs : none )
ffa_ch19_peh_tuni... 69
ffa_ch19_peh_tuni... 70 ( N is on the stack already. Now find GCD(N, Primorial) : )
ffa_ch19_peh_tuni... 71 @Primorial! G
ffa_ch19_peh_tuni... 72
ffa_ch19_peh_tuni... 73 ( Was the GCD equal to 1 ? )
ffa_ch19_peh_tuni... 74 .1 =
ffa_ch19_peh_tuni... 75
ffa_ch19_peh_tuni... 76 ( Invert the answer; i.e. a 'fail' will result in 1, a 'pass' -- 0 : )
ffa_ch19_peh_tuni... 77 .1 ^
ffa_ch19_peh_tuni... 78 ;
ffa_ch19_peh_tuni... 79
ffa_ch19_peh_tuni... 80 (----------------------------------------------------------------------------)
ffa_ch19_peh_tuni... 81
ffa_ch19_peh_tuni... 82 ( Take a Bitmask specifying the bits that must be set to 1, from the stack.
ffa_ch19_peh_tuni... 83 Generate RANDOM integers, until obtains one that, when OR'd with Bitmask,
ffa_ch19_peh_tuni... 84 passes the Primorial Litmus. )
ffa_ch19_peh_tuni... 85
ffa_ch19_peh_tuni... 86 @Make-Candidate@ ( Regs : u, m, z )
ffa_ch19_peh_tuni... 87
ffa_ch19_peh_tuni... 88 ( Get the Bitmask from the stack, and assign to m : )
ffa_ch19_peh_tuni... 89 $m
ffa_ch19_peh_tuni... 90
ffa_ch19_peh_tuni... 91 ( Begin a loop: )
ffa_ch19_peh_tuni... 92 :
ffa_ch19_peh_tuni... 93
ffa_ch19_peh_tuni... 94 ( u := u + 1 , i.e. increment the 'RNG shots' counter: )
ffa_ch19_peh_tuni... 95 u .1 + $u
ffa_ch19_peh_tuni... 96
ffa_ch19_peh_tuni... 97 ( Generate a random FZ of the current FZ width : )
ffa_ch19_peh_tuni... 98 ?
ffa_ch19_peh_tuni... 99
ffa_ch19_peh_tuni... 100 ( Take the mandatory-ones Bitmask, and OR it into
ffa_ch19_peh_tuni... 101 the random FZ from above, then store this to z: )
ffa_ch19_peh_tuni... 102 m | $z
ffa_ch19_peh_tuni... 103
ffa_ch19_peh_tuni... 104 ( Run z through the Primorial Litmus: )
ffa_ch19_peh_tuni... 105 z @Primorial-Litmus!
ffa_ch19_peh_tuni... 106
ffa_ch19_peh_tuni... 107 ( If 1, i.e. Litmus failed, cycle the loop; otherwise we're done: )
ffa_ch19_peh_tuni... 108 ,
ffa_ch19_peh_tuni... 109
ffa_ch19_peh_tuni... 110 ( Return the z which passed the Primorial Litmus: )
ffa_ch19_peh_tuni... 111 z
ffa_ch19_peh_tuni... 112 ;
ffa_ch19_peh_tuni... 113
ffa_ch19_peh_tuni... 114 (----------------------------------------------------------------------------)
ffa_ch19_peh_tuni... 115
ffa_ch19_peh_tuni... 116 ( Take integers N and I from stack (I is on the top of stack, followed by N) ;
ffa_ch19_peh_tuni... 117 Fire up to I shots of Miller-Rabin Test on N, each with a RANDOM witness;
ffa_ch19_peh_tuni... 118
ffa_ch19_peh_tuni... 119 If ALL I shots PASSED, i.e. M-R did NOT 'find composite' in any of them :
ffa_ch19_peh_tuni... 120 Return 0;
ffa_ch19_peh_tuni... 121 else (i.e. if any shot FAILED) :
ffa_ch19_peh_tuni... 122 Return 1 IMMEDIATELY. )
ffa_ch19_peh_tuni... 123
ffa_ch19_peh_tuni... 124 @Iterated-MR-Test@ ( Regs : i, n, r )
ffa_ch19_peh_tuni... 125 ( i := Maximum number of Miller-Rabin shots that we will perform : )
ffa_ch19_peh_tuni... 126 $i
ffa_ch19_peh_tuni... 127
ffa_ch19_peh_tuni... 128 ( n := N, i.e. store a copy of N: )
ffa_ch19_peh_tuni... 129 $n
ffa_ch19_peh_tuni... 130
ffa_ch19_peh_tuni... 131 ( Begin a loop: )
ffa_ch19_peh_tuni... 132 :
ffa_ch19_peh_tuni... 133
ffa_ch19_peh_tuni... 134 ( Put n on the stack: )
ffa_ch19_peh_tuni... 135 n
ffa_ch19_peh_tuni... 136
ffa_ch19_peh_tuni... 137 ( Generate a random Witness for this shot: )
ffa_ch19_peh_tuni... 138 ?
ffa_ch19_peh_tuni... 139 ( Recall that it will always be brought into the valid range,
ffa_ch19_peh_tuni... 140 automatically, in constant time. See also Ch. 16A. )
ffa_ch19_peh_tuni... 141
ffa_ch19_peh_tuni... 142 ( Run a M-R test; outputs 1 if FOUND composite, and 0 if NOT: )
ffa_ch19_peh_tuni... 143 P
ffa_ch19_peh_tuni... 144
ffa_ch19_peh_tuni... 145 ( r := result )
ffa_ch19_peh_tuni... 146 $r
ffa_ch19_peh_tuni... 147
ffa_ch19_peh_tuni... 148 ( i := i - 1 , i.e. decrement the shots counter: )
ffa_ch19_peh_tuni... 149 i .1 - $i
ffa_ch19_peh_tuni... 150
ffa_ch19_peh_tuni... 151 ( If any shots still remain... )
ffa_ch19_peh_tuni... 152 i .0 >
ffa_ch19_peh_tuni... 153
ffa_ch19_peh_tuni... 154 ( Invert the M-R result: if 'NOT found composite', give a 1 : )
ffa_ch19_peh_tuni... 155 r .1 ^
ffa_ch19_peh_tuni... 156
ffa_ch19_peh_tuni... 157 ( ...shots remain, AND current one did not 'find composite' : )
ffa_ch19_peh_tuni... 158 &
ffa_ch19_peh_tuni... 159
ffa_ch19_peh_tuni... 160 ( ... then have a 1, and we cycle the loop, for the next shot;
ffa_ch19_peh_tuni... 161 Otherwise, we're done: )
ffa_ch19_peh_tuni... 162 ,
ffa_ch19_peh_tuni... 163
ffa_ch19_peh_tuni... 164 ( At this point, N has failed a M-R shot, or passed all of the shots;
ffa_ch19_peh_tuni... 165 In either case, we return r,
ffa_ch19_peh_tuni... 166 which will be 0 IFF all shots passed, and otherwise 1 : )
ffa_ch19_peh_tuni... 167 r
ffa_ch19_peh_tuni... 168 ;
ffa_ch19_peh_tuni... 169
ffa_ch19_peh_tuni... 170 (------------------------------ Main Program : ------------------------------)
ffa_ch19_peh_tuni... 171
ffa_ch19_peh_tuni... 172 ( Regs: u, t, k, x )
ffa_ch19_peh_tuni... 173
ffa_ch19_peh_tuni... 174 ( Initialize u, 'RNG' counter, i.e. how many random FZ were needed : )
ffa_ch19_peh_tuni... 175 .0 $u
ffa_ch19_peh_tuni... 176
ffa_ch19_peh_tuni... 177 ( Initialize t, 'tries' counter, i.e. how many GCD-filtered candidates tried: )
ffa_ch19_peh_tuni... 178 .0 $t
ffa_ch19_peh_tuni... 179
ffa_ch19_peh_tuni... 180 ( Initialize k to the Bitmask that is to be imposed on candidates : )
ffa_ch19_peh_tuni... 181 @Candidate-Bitmask! $k
ffa_ch19_peh_tuni... 182
ffa_ch19_peh_tuni... 183 ( Begin the main loop: )
ffa_ch19_peh_tuni... 184 :
ffa_ch19_peh_tuni... 185
ffa_ch19_peh_tuni... 186 ( t := t + 1 , i.e. increment the 'tries' counter: )
ffa_ch19_peh_tuni... 187 t .1 + $t
ffa_ch19_peh_tuni... 188
ffa_ch19_peh_tuni... 189 ( Get a candidate x, using Bitmask k, which passes Primorial Litmus: )
ffa_ch19_peh_tuni... 190 k @Make-Candidate! $x
ffa_ch19_peh_tuni... 191
ffa_ch19_peh_tuni... 192 ( Perform MR-Shots of the Miller-Rabin Test: )
ffa_ch19_peh_tuni... 193 x @MR-Shots! @Iterated-MR-Test!
ffa_ch19_peh_tuni... 194
ffa_ch19_peh_tuni... 195 ( If not yet found a candidate which passed both the initial Primorial Litmus
ffa_ch19_peh_tuni... 196 and then the full number of M-R shots, then cycle the loop : )
ffa_ch19_peh_tuni... 197 ,
ffa_ch19_peh_tuni... 198
ffa_ch19_peh_tuni... 199 ( At this point, we have found a 'probable prime' candidate, and will print: )
ffa_ch19_peh_tuni... 200
ffa_ch19_peh_tuni... 201 ( ... the Bitmask used : )
ffa_ch19_peh_tuni... 202 [Bitmask Imposed on Candidates : ] k #
ffa_ch19_peh_tuni... 203
ffa_ch19_peh_tuni... 204 ( ... the number of 'passing' M-R shots required for termination : )
ffa_ch19_peh_tuni... 205 [Number of Mandated M-R Shots : ] @MR-Shots! #
ffa_ch19_peh_tuni... 206
ffa_ch19_peh_tuni... 207 ( ... the 'RNG shots' counter : )
ffa_ch19_peh_tuni... 208 [Total Number of Random FZ Used : ] u #
ffa_ch19_peh_tuni... 209
ffa_ch19_peh_tuni... 210 ( ... the 'tries' counter, i.e. how many passed Primorial Litmus : )
ffa_ch19_peh_tuni... 211 [GCD-Filtered Candidates Tested : ] t #
ffa_ch19_peh_tuni... 212
ffa_ch19_peh_tuni... 213 ( ... finally, the candidate which passed all of the requested tests : )
ffa_ch19_peh_tuni... 214 [Probable Prime Integer : ] x #
ffa_ch19_peh_tuni... 215
ffa_ch19_peh_tuni... 216 ( Now, terminate with a 'Yes' Verdict, as we have succeeded : )
ffa_ch19_peh_tuni... 217 QY
ffa_ch19_peh_tuni... 218
ffa_ch19_peh_tuni... 219 (--------------------------------~~The End~~---------------------------------)