progs/perftest.c: Use from Glibc syscall numbers.
[catacomb] / math / pgen.c
1 /* -*-c-*-
2 *
3 * Prime generation glue
4 *
5 * (c) 1999 Straylight/Edgeware
6 */
7
8 /*----- Licensing notice --------------------------------------------------*
9 *
10 * This file is part of Catacomb.
11 *
12 * Catacomb is free software; you can redistribute it and/or modify
13 * it under the terms of the GNU Library General Public License as
14 * published by the Free Software Foundation; either version 2 of the
15 * License, or (at your option) any later version.
16 *
17 * Catacomb is distributed in the hope that it will be useful,
18 * but WITHOUT ANY WARRANTY; without even the implied warranty of
19 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 * GNU Library General Public License for more details.
21 *
22 * You should have received a copy of the GNU Library General Public
23 * License along with Catacomb; if not, write to the Free
24 * Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
25 * MA 02111-1307, USA.
26 */
27
28 /*----- Header files ------------------------------------------------------*/
29
30 #include <assert.h>
31 #include <stdio.h>
32 #include <stdlib.h>
33 #include <string.h>
34
35 #include "fibrand.h"
36 #include "grand.h"
37 #include "mp.h"
38 #include "mprand.h"
39 #include "pgen.h"
40 #include "pfilt.h"
41 #include "rabin.h"
42
43 /*----- Standard prime filter ---------------------------------------------*/
44
45 /* --- @pgen_filter@ --- */
46
47 int pgen_filter(int rq, pgen_event *ev, void *p)
48 {
49 pgen_filterctx *f = p;
50 int rc = PGEN_FAIL;
51
52 switch (rq) {
53 case PGEN_BEGIN:
54 rc = pfilt_create(&f->f, ev->m);
55 mp_drop(ev->m);
56 break;
57 case PGEN_TRY:
58 mp_drop(ev->m);
59 break;
60 case PGEN_DONE:
61 pfilt_destroy(&f->f);
62 return (PGEN_DONE);
63 default:
64 rc = PGEN_ABORT;
65 break;
66 }
67
68 if (rc == PGEN_FAIL && !((f->step | f->f.m->v[0]) & 1))
69 rc = pfilt_step(&f->f, 1);
70 while (rc == PGEN_FAIL)
71 rc = pfilt_step(&f->f, f->step);
72 ev->m = MP_COPY(f->f.m);
73 return (rc);
74 }
75
76 /* --- @pgen_jump@ --- *
77 *
78 * Similar to the standard @pgen_filter@, but jumps in large steps rather
79 * than small ones.
80 */
81
82 int pgen_jump(int rq, pgen_event *ev, void *p)
83 {
84 pgen_jumpctx *f = p;
85 int rc = PGEN_ABORT;
86
87 switch (rq) {
88 case PGEN_BEGIN: {
89 mp *g = MP_NEW;
90 mp_gcd(&g, 0, 0, ev->m, f->j->m);
91 if (MP_CMP(g, >, MP_ONE)) {
92 mp_drop(g);
93 return (PGEN_ABORT);
94 }
95 mp_drop(g);
96 rc = pfilt_create(&f->f, ev->m);
97 mp_drop(ev->m);
98 } break;
99 case PGEN_TRY:
100 mp_drop(ev->m);
101 rc = pfilt_jump(&f->f, f->j);
102 break;
103 case PGEN_DONE:
104 pfilt_destroy(&f->f);
105 return (PGEN_DONE);
106 }
107
108 while (rc == PGEN_FAIL)
109 rc = pfilt_jump(&f->f, f->j);
110 ev->m = MP_COPY(f->f.m);
111 return (rc);
112 }
113
114 /*----- Standard prime test -----------------------------------------------*/
115
116 /* --- @pgen_test@ --- */
117
118 int pgen_test(int rq, pgen_event *ev, void *p)
119 {
120 rabin *r = p;
121 int rc = PGEN_ABORT;
122
123 switch (rq) {
124 case PGEN_BEGIN:
125 rabin_create(r, ev->m);
126 rc = PGEN_TRY;
127 break;
128 case PGEN_TRY:
129 if (!ev->tests)
130 rc = rabin_rtest(r, MP_TWO);
131 else {
132 mp *a = mprand_range(MP_NEW, ev->m, ev->r, 0);
133 rc = rabin_rtest(r, a);
134 mp_drop(a);
135 }
136 break;
137 case PGEN_DONE:
138 rabin_destroy(r);
139 rc = PGEN_DONE;
140 break;
141 }
142
143 return (rc);
144 }
145
146 /*----- The main driver ---------------------------------------------------*/
147
148 /* --- @pgen@ --- *
149 *
150 * Arguments: @const char *name@ = name of the value being searched for
151 * @mp *d@ = destination for the result integer
152 * @mp *m@ = start value to pass to stepper
153 * @pgen_proc *event@ = event handler function
154 * @void *ectx@ = context argument for event andler
155 * @unsigned steps@ = number of steps to take in search
156 * @pgen_proc *step@ = stepper function to use
157 * @void *sctx@ = context argument for stepper
158 * @unsigned tests@ = number of tests to make
159 * @pgen_proc *test@ = tester function to use
160 * @void *tctx@ = context argument for tester
161 *
162 * Returns: Pointer to final result, or null.
163 *
164 * Use: A generalized prime-number search skeleton. Yes, that's a
165 * scary number of arguments.
166 */
167
168 mp *pgen(const char *name, mp *d, mp *m, pgen_proc *event, void *ectx,
169 unsigned steps, pgen_proc *step, void *sctx,
170 unsigned tests, pgen_proc *test, void *tctx)
171 {
172 pgen_event ev;
173 int rq, rc;
174 pgen_proc *proc;
175 void *ctx;
176 int p;
177
178 enum { P_STEP, P_TEST };
179
180 /* --- Set up the initial event block --- */
181
182 ev.name = name;
183 if (m)
184 ev.m = MP_COPY(m);
185 else
186 ev.m = 0;
187 ev.steps = 0;
188 ev.tests = 0;
189 ev.r = fibrand_create(0);
190
191 /* --- Tell the event handler we're under way --- */
192
193 if (event && event(PGEN_BEGIN, &ev, ectx) == PGEN_ABORT) {
194 ev.r->ops->destroy(ev.r);
195 return (0);
196 }
197
198 /* --- Set up for the initial call --- */
199
200 proc = step; ctx = sctx; p = P_STEP; rq = PGEN_BEGIN;
201
202 /* --- Enter the great maelstrom of state transitions --- */
203
204 for (;;) {
205 unsigned act = 0;
206
207 #define A_STEP 1u
208 #define A_TEST 2u
209 #define A_EVENT 4u
210 #define A_ENDTEST 8u
211 #define A_ENDSTEP 16u
212 #define A_DONE 32u
213
214 /* --- Call the procedure and decide what to do next --- */
215
216 rc = proc(rq, &ev, ctx);
217 switch (rc) {
218 case PGEN_TRY:
219 if (p == P_TEST)
220 rq = PGEN_TRY;
221 else {
222 act |= A_EVENT;
223 proc = test; ctx = tctx; p = P_TEST;
224 rq = PGEN_BEGIN;
225 }
226 break;
227 case PGEN_PASS:
228 act |= A_TEST | A_EVENT;
229 if (p == P_TEST)
230 rq = PGEN_TRY;
231 else {
232 proc = test; ctx = tctx; p = P_TEST;
233 rq = PGEN_BEGIN;
234 }
235 break;
236 case PGEN_FAIL:
237 act |= A_STEP;
238 if (p == P_TEST) {
239 act |= A_ENDTEST | A_EVENT;
240 proc = step; ctx = sctx; p = P_STEP;
241 }
242 rq = PGEN_TRY;
243 break;
244 case PGEN_DONE:
245 act |= A_EVENT | A_DONE | A_ENDSTEP;
246 if (p == P_TEST)
247 act |= A_ENDTEST;
248 break;
249 case PGEN_ABORT:
250 act |= A_EVENT | A_DONE;
251 if (p == P_TEST || rq == PGEN_TRY)
252 act |= A_ENDSTEP;
253 if (p == P_TEST && rq != PGEN_BEGIN)
254 act |= A_ENDTEST;
255 break;
256 default:
257 assert(((void)"Invalid response from function", 0));
258 break;
259 }
260
261 /* --- If decrementing counters is requested, do that --- */
262
263 if ((act & A_STEP) && steps) {
264 ev.steps++;
265 if (ev.steps == steps) {
266 act |= A_EVENT | A_ENDSTEP | A_DONE;
267 rc = PGEN_ABORT;
268 }
269 ev.tests = 0;
270 }
271
272 if ((act & A_TEST) && tests) {
273 ev.tests++;
274 if (ev.tests == tests) {
275 act |= A_ENDTEST | A_ENDSTEP | A_DONE;
276 rc = PGEN_DONE;
277 }
278 }
279
280 /* --- Report an event if so directed --- */
281
282 if ((act & A_EVENT) && event && event(rc, &ev, ectx) == PGEN_ABORT) {
283 rc = PGEN_ABORT;
284 if (!(act & A_DONE)) {
285 act |= A_ENDSTEP | A_DONE;
286 if (p == P_TEST && rq != PGEN_BEGIN)
287 act |= A_ENDTEST;
288 }
289 }
290
291 /* --- Close down tester and stepper functions --- */
292
293 if (act & A_ENDTEST)
294 test(PGEN_DONE, &ev, tctx);
295 if (act & A_ENDSTEP)
296 step(PGEN_DONE, &ev, sctx);
297
298 /* --- Stop the entire test if necessary --- */
299
300 if (act & A_DONE)
301 break;
302 }
303
304 /* --- Tidy up and return --- */
305
306 if (rc == PGEN_ABORT) {
307 mp_drop(ev.m);
308 ev.m = 0;
309 }
310 ev.r->ops->destroy(ev.r);
311 mp_drop(d);
312
313 return (ev.m);
314 }
315
316 /* --- @pgen_primep@ --- *
317 *
318 * Arguments: @mp *p@ = a number to check
319 * @grand *gr@ = a random number source
320 *
321 * Returns: Nonzero if @p@ is really prime.
322 *
323 * Use: Checks the primality of @p@. If @p@ is prime, then this
324 * function returns nonzero; if @p@ is really composite then it
325 * %%\emph{probably}%% returns zero, but might not.
326 *
327 * Currently, this function uses the Baillie--PSW test, which
328 * combines a single Miller--Rabin test with witness 2 with a
329 * single Frobenius test with parameters chosen using
330 * Selfridge's `Method A'. No composites are known which pass
331 * this test, though it's conjectured that infinitely many
332 * exist.
333 */
334
335 int pgen_primep(mp *p, grand *gr)
336 {
337 rabin r;
338 int rc;
339
340 if (MP_NEGP(p)) return (0);
341 switch (pfilt_smallfactor(p)) {
342 case PGEN_DONE: return (1);
343 case PGEN_FAIL: return (0);
344 }
345 rabin_create(&r, p); rc = rabin_test(&r, MP_TWO); rabin_destroy(&r);
346 if (rc == PGEN_FAIL) return (0);
347 rc = pgen_granfrob(p, 0, 0); if (rc == PGEN_FAIL) return (0);
348 return (1);
349 }
350
351 /*----- Test rig ----------------------------------------------------------*/
352
353 #ifdef TEST_RIG
354
355 #include <mLib/testrig.h>
356
357 static int t_primep(dstr *v)
358 {
359 mp *m = *(mp **)v[0].buf;
360 int e = *(int *)v[1].buf;
361 int r;
362 grand *rng;
363 int ok = 1;
364
365 rng = fibrand_create(0);
366 r = pgen_primep(m, rng);
367 GR_DESTROY(rng);
368 if (e != r) {
369 fputs("\n*** primep failed", stderr);
370 fputs("\nm = ", stderr); mp_writefile(m, stderr, 10);
371 fprintf(stderr, "\nexpected %d", e);
372 fprintf(stderr, "\nreported %d", r);
373 fputc('\n', stderr);
374 ok = 0;
375 }
376
377 mp_drop(m);
378 assert(mparena_count(MPARENA_GLOBAL) == 0);
379 return (ok);
380 }
381
382 static int verify(dstr *v)
383 {
384 mp *m = *(mp **)v[0].buf;
385 mp *q = *(mp **)v[1].buf;
386 mp *p;
387 int ok = 1;
388
389 pgen_filterctx pf;
390 rabin r;
391
392 pf.step = 2;
393 p = pgen("p", MP_NEW, m, pgen_evspin, 0, 0, pgen_filter, &pf,
394 rabin_iters(mp_bits(m)), pgen_test, &r);
395 if (!p || !MP_EQ(p, q)) {
396 fputs("\n*** pgen failed", stderr);
397 fputs("\nm = ", stderr); mp_writefile(m, stderr, 10);
398 fputs("\np = ", stderr); mp_writefile(p, stderr, 10);
399 fputs("\nq = ", stderr); mp_writefile(q, stderr, 10);
400 fputc('\n', stderr);
401 ok = 0;
402 }
403
404 mp_drop(m);
405 mp_drop(q);
406 mp_drop(p);
407 assert(mparena_count(MPARENA_GLOBAL) == 0);
408 return (ok);
409 }
410
411 static test_chunk tests[] = {
412 { "pgen", verify, { &type_mp, &type_mp, 0 } },
413 { "primep", t_primep, { &type_mp, &type_int, 0 } },
414 { 0, 0, { 0 } }
415 };
416
417 int main(int argc, char *argv[])
418 {
419 sub_init();
420 test_run(argc, argv, tests, SRCDIR "/t/pgen");
421 return (0);
422 }
423 #endif
424
425 /*----- That's all, folks -------------------------------------------------*/