chiark / gitweb /
rand/rand-x86ish.S: Hoist argument register allocation outside.
[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 -------------------------------------------------*/