source: git/ntl/src/c_lip_impl.h @ 33a041

fieker-DuValspielwiese
Last change on this file since 33a041 was 09da99, checked in by Hans Schönemann <hannes@…>, 21 years ago
*hannes: NTL- 5.3.1 git-svn-id: file:///usr/local/Singular/svn/trunk@6910 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 149.4 KB
Line 
1
2#include <NTL/lip.h>
3
4#include <NTL/ctools.h>
5
6
7#include <stdlib.h>
8#include <stdio.h>
9#include <math.h>
10
11
12
13
14
15
16#define MustAlloc(c, len)  (!(c) || ((c)[-1] >> 1) < (len))
17   /* Fast test to determine if allocation is necessary */
18
19
20static 
21void zhalt(char *c)
22{
23   fprintf(stderr,"fatal error:\n   %s\nexit...\n",c);
24   fflush(stderr);
25   abort();
26}
27
28
29
30#define NTL_GMP_MUL_CROSS (4)
31#define NTL_GMP_SQR_CROSS (4)
32#define NTL_GMP_DIV_CROSS (4)
33#define NTL_GMP_REM_CROSS (4)
34#define NTL_GMP_QREM_CROSS (4)
35#define NTL_GMP_SQRT_CROSS (2)
36#define NTL_GMP_GCD_CROSS (1)
37#define NTL_GMP_XGCD_CROSS (1)
38#define NTL_GMP_INVMOD_CROSS (1)
39
40#ifdef NTL_GMP_HACK
41
42/* using GMP */
43
44#ifdef NTL_SINGLE_MUL
45#error "sorry...not implemented"
46#endif
47
48#if (NTL_NBITS != NTL_NBITS_MAX)
49#error "sorry...not implemented"
50#endif
51
52int _ntl_gmp_hack = 1;
53
54
55#include <gmp.h>
56
57
58static mp_limb_t *gspace_data = 0;
59static long gspace_size = 0;
60
61
62static void alloc_gspace(long n)
63{
64   if (n <= gspace_size) return;
65   
66   if (n <= gspace_size*1.1)
67      n = ((long) (gspace_size*1.1)) + 10;
68
69   if (gspace_data)
70      gspace_data = 
71         (mp_limb_t *) NTL_REALLOC(gspace_data, n, sizeof(mp_limb_t), 0);   
72   else
73      gspace_data = (mp_limb_t *) NTL_MALLOC(n, sizeof(mp_limb_t), 0);
74
75   if (!gspace_data) zhalt("alloc_gspace: out of memory");
76
77   gspace_size = n;
78}
79
80
81#define NTL_GSPACE(n) \
82{ long _n = (n);  if (_n > gspace_size) alloc_gspace(_n); }
83
84
85static mpz_t gt_1, gt_2, gt_3, gt_4, gt_5;
86static long gt_init = 0;
87
88static
89void do_gt_init()
90{
91   gt_init = 1;
92   mpz_init(gt_1);
93   mpz_init(gt_2);
94   mpz_init(gt_3);
95   mpz_init(gt_4);
96   mpz_init(gt_5);
97}
98
99#define GT_INIT { if (!gt_init) do_gt_init(); }
100
101#include "lip_gmp_aux_impl.h"
102
103
104/* Check that we really have it...otherwise, some compilers
105 * only issue warnings for missing functions.
106 */
107
108
109#ifndef HAVE_LIP_GMP_AUX
110
111#error "do not have lip_gmp_aux.h"
112
113#endif
114
115static
116void lip_to_mpz(const long *x, mpz_t y)
117{
118   long sx;
119   long neg;
120   long gsx;
121
122   if (!x || (x[0] == 1 && x[1] == 0)) {
123      mpz_set_ui(y, 0);
124      return;
125   }
126
127   sx = x[0];
128   if (sx < 0) {
129      neg = 1;
130      sx = -sx;
131   }
132   else
133      neg = 0;
134
135   gsx = L_TO_G(sx);
136
137   if (gsx > y->_mp_alloc) _mpz_realloc(y, gsx);
138   lip_to_gmp(x+1, y->_mp_d, sx);
139   while (y->_mp_d[gsx-1] == 0) gsx--;
140   if (neg) gsx = -gsx;
141   y->_mp_size = gsx;
142}
143
144static
145void mpz_to_lip(long **x, mpz_t y)
146{
147   long gsy;
148   long neg;
149   long sx;
150   long *xp;
151
152   gsy = y->_mp_size;
153
154   if (gsy == 0) {
155      _ntl_zzero(x);
156      return;
157   }
158
159   if (gsy < 0) {
160      neg = 1;
161      gsy = -gsy;
162   }
163   else
164      neg = 0;
165
166   sx = G_TO_L(gsy);
167
168   xp = *x;
169   if (MustAlloc(xp, sx)) { 
170      _ntl_zsetlength(x, sx); 
171      xp = *x;
172   }
173
174   gmp_to_lip1(xp+1, y->_mp_d, sx);
175
176   while (xp[sx] == 0) sx--;
177   if (neg) sx = -sx;
178   xp[0] = sx; 
179}
180
181
182void _ntl_gmp_powermod(long **x, long *a, long *e, long *n)
183{
184   long neg = 0;
185
186   GT_INIT
187
188
189   lip_to_mpz(a, gt_2);
190   lip_to_mpz(e, gt_3);
191   lip_to_mpz(n, gt_4);
192
193   if (mpz_sgn(gt_3) < 0) {
194      mpz_neg(gt_3, gt_3);
195      neg = 1;
196   }
197
198   mpz_powm(gt_1, gt_2, gt_3, gt_4);
199
200   /* This fixes a bug in GMP 3.0.1 */
201   if (mpz_cmp(gt_1, gt_4) >= 0) 
202      mpz_sub(gt_1, gt_1, gt_4);
203
204   if (neg) {
205      if (!mpz_invert(gt_1, gt_1, gt_4))
206         zhalt("Modular inverse not defined");
207   }
208
209   mpz_to_lip(x, gt_1);
210}
211
212
213#else
214
215/* not using GMP */
216
217int _ntl_gmp_hack = 0;
218
219
220#endif
221
222
223
224#define DENORMALIZE  NTL_FDOUBLE_PRECISION
225
226
227#define MIN_SETL        (4)
228   /* _ntl_zsetlength allocates a multiple of MIN_SETL digits */
229
230
231
232#if (defined(NTL_SINGLE_MUL) && !defined(NTL_FAST_INT_MUL))
233#define MulLo(rres,a,b) \
234{ \
235   double _x = ((double) a) * ((double) b) + (DENORMALIZE); \
236   unsigned long _x_lo; \
237   NTL_FetchLo(_x_lo, _x); \
238   rres =  _x_lo; \
239}
240#else
241#define MulLo(rres,a,b) rres = (a)*(b)
242#endif
243
244
245
246
247
248
249/*
250 * definitions of zaddmulp, zxmulp, zaddmulpsq for the various
251 * long integer arithmentic implementation options.
252 */
253
254
255#if (defined(NTL_SINGLE_MUL))
256
257#define zaddmulp(a,b,d,t) \
258{ \
259   long _a = (a), _b = (b), _d = (d), _t = (t); \
260   unsigned long  __lhi, __llo;\
261   double __lx = ((double) ((_a) + (_t))) + ((double) _b)*((double) _d); \
262  __lx += (DENORMALIZE); \
263   NTL_FetchHiLo(__lhi,__llo,__lx);\
264   __lhi = ((__lhi<<6)|(__llo>>26)) & 0x3FFFFFF; \
265   __llo &= 0x3FFFFFF; \
266   (a) = __llo;\
267   (t) = __lhi;\
268}
269
270#define zxmulp(a,b,d,t) \
271{ \
272   long _b = (b), _d = (d), _t = (t); \
273   unsigned long  __lhi, __llo;\
274   double __lx = ((double) ((_t))) + ((double) _b)*((double) _d); \
275  __lx += (DENORMALIZE); \
276   NTL_FetchHiLo(__lhi,__llo,__lx);\
277   __lhi = ((__lhi<<6)|(__llo>>26)) & 0x3FFFFFF; \
278   __llo &= 0x3FFFFFF; \
279   (a) = __llo;\
280   (t) = __lhi;\
281}
282
283#define zaddmulpsq(a,b,t) \
284{ \
285   long _a = (a), _b = (b); \
286   unsigned long  __lhi, __llo; \
287   double __lx = ((double) (_a)) + ((double) _b)*((double) _b); \
288   __lx += (DENORMALIZE); \
289   NTL_FetchHiLo(__lhi,__llo,__lx);\
290   __lhi = ((__lhi<<6)|(__llo>>26)) & 0x3FFFFFF; \
291   __llo &= 0x3FFFFFF; \
292   (a) =  __llo;\
293   (t) =  __lhi;\
294}
295
296#elif (defined(NTL_LONG_LONG))
297
298#ifndef NTL_LONG_LONG_TYPE
299#define NTL_LONG_LONG_TYPE long long
300#endif
301
302#if (!defined(NTL_CLEAN_INT))
303
304/*
305 * One might get slightly better code with this version.
306 */
307
308#define zaddmulp(a, b, d, t) { \
309   NTL_LONG_LONG_TYPE _pp = ((NTL_LONG_LONG_TYPE) (b)) * ((NTL_LONG_LONG_TYPE) (d)) + ((t)+(a)); \
310   (a) = ((long)(_pp)) & NTL_RADIXM; \
311   (t) = (long) (_pp >> NTL_NBITS); \
312}
313
314
315#define zxmulp(a, b, d, t) { \
316   NTL_LONG_LONG_TYPE _pp = ((NTL_LONG_LONG_TYPE) (b)) * ((NTL_LONG_LONG_TYPE) (d)) + (t); \
317   (a) = ((long)(_pp)) & NTL_RADIXM; \
318   (t) = (long) (_pp >> NTL_NBITS); \
319}
320
321#define zaddmulpsq(a,b,t) { \
322   NTL_LONG_LONG_TYPE _pp = ((NTL_LONG_LONG_TYPE) (b)) * ((NTL_LONG_LONG_TYPE) (b)) + (a); \
323   (a) = ((long)(_pp)) & NTL_RADIXM; \
324   (t) = (long) (_pp >> NTL_NBITS); \
325}
326
327#else
328
329/*
330 * This version conforms to the language standard when d is non-negative.
331 * Some compilers may emit sub-optimal code, though.
332 */
333
334
335
336#define zaddmulp(a, b, d, t) { \
337   NTL_LONG_LONG_TYPE _pp = ((NTL_LONG_LONG_TYPE) (b)) * ((NTL_LONG_LONG_TYPE) (d)) + ((t)+(a)); \
338   (a) = (long) (_pp & NTL_RADIXM); \
339   (t) = (long) (_pp >> NTL_NBITS); \
340}
341
342
343#define zxmulp(a, b, d, t) { \
344   NTL_LONG_LONG_TYPE _pp = ((NTL_LONG_LONG_TYPE) (b)) * ((NTL_LONG_LONG_TYPE) (d)) + (t); \
345   (a) = (long) (_pp & NTL_RADIXM); \
346   (t) = (long) (_pp >> NTL_NBITS); \
347}
348
349#define zaddmulpsq(a,b,t) { \
350   NTL_LONG_LONG_TYPE _pp = ((NTL_LONG_LONG_TYPE) (b)) * ((NTL_LONG_LONG_TYPE) (b)) + (a); \
351   (a) = (long) (_pp & NTL_RADIXM); \
352   (t) = (long) (_pp >> NTL_NBITS); \
353}
354
355
356#endif
357
358
359#elif (defined(NTL_AVOID_FLOAT))
360   
361
362#define zaddmulp(  a,  b,  d,  t) { \
363        unsigned long _b1 = b & NTL_RADIXROOTM; \
364        unsigned long _d1 = d & NTL_RADIXROOTM; \
365        unsigned long _bd,_b1d1,_m,_aa= (a) + (t); \
366        unsigned long _ld = (d>>NTL_NBITSH); \
367        unsigned long _lb = (b>>NTL_NBITSH); \
368 \
369        _bd=_lb*_ld; \
370        _b1d1=_b1*_d1; \
371        _m=(_lb+_b1)*(_ld+_d1) - _bd - _b1d1; \
372        _aa += ( _b1d1+ ((_m&NTL_RADIXROOTM)<<NTL_NBITSH)); \
373        (t) = (_aa >> NTL_NBITS) + _bd + (_m>>NTL_NBITSH); \
374        (a) = _aa & NTL_RADIXM; \
375}
376
377
378
379
380
381#define zxmulp(  a,  b,  d,  t) { \
382        unsigned long _b1 = b & NTL_RADIXROOTM; \
383        unsigned long _d1 = d & NTL_RADIXROOTM; \
384        unsigned long _bd,_b1d1,_m,_aa= (t); \
385        unsigned long _ld = (d>>NTL_NBITSH); \
386        unsigned long _lb = (b>>NTL_NBITSH); \
387 \
388        _bd=_lb*_ld; \
389        _b1d1=_b1*_d1; \
390        _m=(_lb+_b1)*(_ld+_d1) - _bd - _b1d1; \
391        _aa += ( _b1d1+ ((_m&NTL_RADIXROOTM)<<NTL_NBITSH)); \
392        (t) = (_aa >> NTL_NBITS) + _bd + (_m>>NTL_NBITSH); \
393        (a) = _aa & NTL_RADIXM; \
394}
395
396
397#define zaddmulpsq(_a, _b, _t) \
398{ \
399        long _lb = (_b); \
400        long _b1 = (_b) & NTL_RADIXROOTM; \
401        long _aa = (_a) + _b1 * _b1; \
402 \
403        _b1 = (_b1 * (_lb >>= NTL_NBITSH) << 1) + (_aa >> NTL_NBITSH); \
404        _aa = (_aa & NTL_RADIXROOTM) + ((_b1 & NTL_RADIXROOTM) << NTL_NBITSH); \
405        (_t) = _lb * _lb + (_b1 >> NTL_NBITSH) + (_aa >> NTL_NBITS); \
406        (_a) = (_aa & NTL_RADIXM); \
407}
408
409
410
411#else
412
413/* default long integer arithemtic */
414/* various "software pipelining" routines are also defined */
415
416
417/*
418 * The macros CARRY_TYPE and CARRY_CONV are only used in the submul
419 * logic.
420 */
421
422
423#if (defined(NTL_CLEAN_INT))
424
425#define CARRY_TYPE unsigned long
426#define CARRY_CONV(x) (-((long)(-x)))
427
428#else
429
430#define CARRY_TYPE long
431#define CARRY_CONV(x) (x)
432
433#endif
434
435
436#if (NTL_BITS_PER_LONG <= NTL_NBITS + 2)
437
438#if (NTL_ARITH_RIGHT_SHIFT && !defined(NTL_CLEAN_INT))
439/* value right-shifted is -1..1 */
440#define zaddmulp(a, b, d, t) \
441{ \
442   long _a = (a), _b = (b), _d = (d), _t = (t); \
443   long _t1 =  _b*_d; \
444   long _t2 = (long) ( ((double) _b)*(((double) _d)*NTL_FRADIX_INV) ); \
445   _t2 = _t2 + ((_t1 - (_t2 << NTL_NBITS)) >> NTL_NBITS); \
446   _t1 = (_t1 & NTL_RADIXM) + _a +_t; \
447   (t) = _t2 + (((unsigned long)_t1) >> NTL_NBITS); \
448   (a) = _t1 & NTL_RADIXM; \
449}
450
451
452#define zxmulp(a, b, d, t) \
453{ \
454   long _b = (b), _d = (d), _t = (t); \
455   long _t1 =  _b*_d + _t; \
456   long _t2 = (long) ( ((double) _b)*(((double) _d)*NTL_FRADIX_INV) ) - 1; \
457   (t) = _t2 + (((unsigned long)(_t1 - (_t2 << NTL_NBITS))) >> NTL_NBITS); \
458   (a) = _t1 & NTL_RADIXM; \
459}
460
461/* value shifted is -1..1 */
462#define zaddmulpsq(a, b, t) \
463{ \
464   long _a = (a), _b = (b); \
465   long _t1 = _b*_b; \
466   long _t2 = (long) ( ((double) _b)*(((double) _b)*NTL_FRADIX_INV) ); \
467   _t2 = _t2 + ((_t1 - (_t2 << NTL_NBITS)) >> NTL_NBITS); \
468   _t1 = (_t1 & NTL_RADIXM) + _a; \
469   (t) = _t2 + (((unsigned long)_t1) >> NTL_NBITS); \
470   (a) = _t1 & NTL_RADIXM; \
471}
472
473/*
474 * In the following definition of zam_init, the value _ds is computed so that
475 * it is slightly bigger than s*NTL_RADIX_INV.  This has the consequence that
476 * the value _hi is equal to floor(_b*_s/NTL_RADIX) or
477 * floor(_b*_s/NTL_RADIX) + 1, assuming only that (1) conversion of "small"
478 * integer to doubles is exact, (2) multiplication by powers of 2 is exact, and
479 * (3) multiplication of two general doubles yields a result with relative
480 * error 1/2^{NTL_DOUBLE_PRECISION-1}.  These assumptions are very
481 * conservative, and in fact, the IEEE floating point standard would guarantee
482 * this result *without* making _ds slightly bigger.
483 */
484
485#define zam_decl double _ds; long _hi, _lo, _s;
486
487#define zam_init(b,s) \
488{ \
489   long _b = (b); \
490   _s = (s); \
491   _ds = ((_s << 1)+1)*(NTL_FRADIX_INV/2.0); \
492   _lo = _b*_s; \
493   _hi = (long) (((double) _b)*_ds); \
494}
495
496/* value shifted is 0..3 */
497#define zam_loop(a,t,nb) \
498{ \
499   long _a = (a), _t = (t), _nb = (nb); \
500   long _vv; \
501   double _yy; \
502   _vv = _nb*_s; \
503   _yy = ((double) _nb)*_ds; \
504   _lo = _lo + _a + _t; \
505   _hi--; \
506   (t) = _hi + (((unsigned long)(_lo - (_hi<<NTL_NBITS))) >> NTL_NBITS); \
507   (a) = _lo & NTL_RADIXM; \
508   _lo = _vv; \
509   _hi = (long) _yy; \
510}
511
512/* shift is -1..+1 */
513#define zsx_loop(a,t,nb) \
514{ \
515   long  _t = (t), _nb = (nb); \
516   long _vv; \
517   double _yy; \
518   _vv = _nb*_s; \
519   _yy = ((double) _nb)*_ds; \
520   _lo = _lo + _t; \
521   (t) = _hi + ((_lo - (_hi<<NTL_NBITS)) >> NTL_NBITS); \
522   (a) = _lo & NTL_RADIXM; \
523   _lo = _vv; \
524   _hi = (long) _yy; \
525}
526
527
528/* value shifted is -2..+1 */
529#define zam_subloop(a,t,nb) \
530{ \
531   long _a = (a), _t = (t), _nb = (nb); \
532   long _vv; \
533   double _yy; \
534   _vv = _nb*_s; \
535   _yy = ((double) _nb)*_ds; \
536   _lo = _a + _t - _lo; \
537   (t) = ((_lo + (_hi<<NTL_NBITS)) >> NTL_NBITS) - _hi; \
538   (a) = _lo & NTL_RADIXM; \
539   _lo = _vv; \
540   _hi = (long) _yy; \
541}
542
543/* value shifted is 0..3 */
544#define zam_finish(a,t) \
545{ \
546   long _a = (a), _t = (t); \
547   _lo = _lo + _a + _t; \
548   _hi--; \
549   (t) = _hi + (((unsigned long)(_lo - (_hi<<NTL_NBITS))) >> NTL_NBITS); \
550   (a) = _lo & NTL_RADIXM; \
551}
552
553/* value shifted is -1..+1 */
554#define zsx_finish(a,t) \
555{ \
556   long _t = (t); \
557   _lo = _lo + _t; \
558   (t) = _hi + ((_lo - (_hi<<NTL_NBITS)) >> NTL_NBITS); \
559   (a) = _lo & NTL_RADIXM; \
560}
561
562/* value shifted is -2..+1 */
563#define zam_subfinish(a,t) \
564{ \
565   long _a = (a), _t = (t); \
566   _lo = _a + _t - _lo; \
567   (t) = ((_lo + (_hi<<NTL_NBITS)) >> NTL_NBITS) - _hi; \
568   (a) = _lo & NTL_RADIXM; \
569}
570
571#elif (!defined(NTL_CLEAN_INT))
572
573/* right shift is not arithmetic */
574
575/* value right-shifted is 0..2 */
576#define zaddmulp(a, b, d, t) \
577{ \
578   long _a = (a), _b = (b), _d = (d), _t = (t); \
579   long _t1 =  _b*_d; \
580   long _t2 = (long) ( ((double) _b)*(((double) _d)*NTL_FRADIX_INV) ) - 1; \
581   _t2 = _t2 + ( ((unsigned long) (_t1 - (_t2 << NTL_NBITS))) >> NTL_NBITS ); \
582   _t1 = (_t1 & NTL_RADIXM) + _a +_t; \
583   (t) = _t2 + (((unsigned long)_t1) >> NTL_NBITS); \
584   (a) = _t1 & NTL_RADIXM; \
585}
586
587
588#define zxmulp(a, b, d, t) \
589{ \
590   long _b = (b), _d = (d), _t = (t); \
591   long _t1 =  _b*_d + _t; \
592   long _t2 = (long) ( ((double) _b)*(((double) _d)*NTL_FRADIX_INV) ) - 1; \
593   (t) = _t2 + (((unsigned long)(_t1 - (_t2 << NTL_NBITS))) >> NTL_NBITS); \
594   (a) = _t1 & NTL_RADIXM; \
595}
596
597/* value shifted is 0..2 */
598#define zaddmulpsq(a, b, t) \
599{ \
600   long _a = (a), _b = (b); \
601   long _t1 = _b*_b; \
602   long _t2 = (long) ( ((double) _b)*(((double) _b)*NTL_FRADIX_INV) ) - 1; \
603   _t2 = _t2 + ( ((unsigned long) (_t1 - (_t2 << NTL_NBITS))) >> NTL_NBITS ); \
604   _t1 = (_t1 & NTL_RADIXM) + _a; \
605   (t) = _t2 + (((unsigned long)_t1) >> NTL_NBITS); \
606   (a) = _t1 & NTL_RADIXM; \
607}
608
609#define zam_decl double _ds; long _hi, _lo, _s;
610
611#define zam_init(b,s) \
612{ \
613   long _b = (b); \
614   _s = (s); \
615   _ds = ((_s << 1)+1)*(NTL_FRADIX_INV/2.0); \
616   _lo = _b*_s; \
617   _hi = (long) (((double) _b)*_ds); \
618}
619
620/* value shifted is 0..3 */
621#define zam_loop(a,t,nb) \
622{ \
623   long _a = (a), _t = (t), _nb = (nb); \
624   long _vv; \
625   double _yy; \
626   _vv = _nb*_s; \
627   _yy = ((double) _nb)*_ds; \
628   _lo = _lo + _a + _t; \
629   _hi--; \
630   (t) = _hi + (((unsigned long)(_lo - (_hi<<NTL_NBITS))) >> NTL_NBITS); \
631   (a) = _lo & NTL_RADIXM; \
632   _lo = _vv; \
633   _hi = (long) _yy; \
634}
635
636/* value shifted is 0..2 */
637#define zsx_loop(a,t,nb) \
638{ \
639   long _t = (t), _nb = (nb); \
640   long _vv; \
641   double _yy; \
642   _vv = _nb*_s; \
643   _yy = ((double) _nb)*_ds; \
644   _lo = _lo + _t; \
645   _hi--; \
646   (t) = _hi + (((unsigned long)(_lo - (_hi<<NTL_NBITS))) >> NTL_NBITS); \
647   (a) = _lo & NTL_RADIXM; \
648   _lo = _vv; \
649   _hi = (long) _yy; \
650}
651
652/* value shifted is 0..3 */
653#define zam_subloop(a,t,nb) \
654{ \
655   long _a = (a), _t = (t), _nb = (nb); \
656   long _vv; \
657   double _yy; \
658   _vv = _nb*_s; \
659   _yy = ((double) _nb)*_ds; \
660   _hi += 2; \
661   _lo = _a + _t - _lo; \
662   (t) = (((unsigned long)(_lo + (_hi<<NTL_NBITS))) >> NTL_NBITS) - _hi; \
663   (a) = _lo & NTL_RADIXM; \
664   _lo = _vv; \
665   _hi = (long) _yy; \
666}
667
668/* value shifted is 0..3 */
669#define zam_finish(a,t) \
670{ \
671   long _a = (a), _t = (t); \
672   _lo = _lo + _a + _t; \
673   _hi--; \
674   (t) = _hi + (((unsigned long)(_lo - (_hi<<NTL_NBITS))) >> NTL_NBITS); \
675   (a) = _lo & NTL_RADIXM; \
676}
677
678/* value shifted is 0..2 */
679#define zsx_finish(a,t) \
680{ \
681   long _a = (a), _t = (t); \
682   _lo = _lo + _t; \
683   _hi--; \
684   (t) = _hi + (((unsigned long)(_lo - (_hi<<NTL_NBITS))) >> NTL_NBITS); \
685   (a) = _lo & NTL_RADIXM; \
686}
687
688/* value shifted is 0..3 */
689#define zam_subfinish(a,t) \
690{ \
691   long _a = (a), _t = (t); \
692   _hi += 2; \
693   _lo = _a + _t - _lo; \
694   (t) = (((unsigned long)(_lo + (_hi<<NTL_NBITS))) >> NTL_NBITS) - _hi; \
695   (a) = _lo & NTL_RADIXM; \
696}
697
698#else
699/* clean int version */
700
701/* value right-shifted is 0..2 */
702#define zaddmulp(a, b, d, t) \
703{ \
704   long _a = (a), _b = (b), _d = (d), _t = (t); \
705   unsigned long _t1 = ((unsigned long) _b)*((unsigned long) _d); \
706   unsigned long _t2 = (long) ( ((double) _b)*(((double) _d)*NTL_FRADIX_INV) ) - 1; \
707   _t2 = _t2 + ( (_t1 - (_t2 << NTL_NBITS)) >> NTL_NBITS ); \
708   _t1 = (_t1 & NTL_RADIXM) + ((unsigned long) _a) + ((unsigned long) _t); \
709   (t) = (long) (_t2 + (_t1 >> NTL_NBITS)); \
710   (a) = (long) (_t1 & NTL_RADIXM); \
711}
712
713
714#define zxmulp(a, b, d, t) \
715{ \
716   long _b = (b), _d = (d), _t = (t); \
717   unsigned long _t1 =  ((unsigned long) _b)*((unsigned long) _d) + ((unsigned long) _t); \
718   unsigned long _t2 = (long) ( ((double) _b)*(((double) _d)*NTL_FRADIX_INV) ) - 1; \
719   (t) = (long) (_t2 + ((_t1 - (_t2 << NTL_NBITS)) >> NTL_NBITS)); \
720   (a) = (long) (_t1 & NTL_RADIXM); \
721}
722
723/* value shifted is 0..2 */
724#define zaddmulpsq(a, b, t) \
725{ \
726   long _a = (a), _b = (b); \
727   unsigned long _t1 = ((unsigned long) _b)*((unsigned long) _b); \
728   unsigned long _t2 = (long) ( ((double) _b)*(((double) _b)*NTL_FRADIX_INV) ) - 1; \
729   _t2 = _t2 + ( (_t1 - (_t2 << NTL_NBITS)) >> NTL_NBITS ); \
730   _t1 = (_t1 & NTL_RADIXM) + ((unsigned long) _a); \
731   (t) = (long) (_t2 + (_t1 >> NTL_NBITS)); \
732   (a) = (long) (_t1 & NTL_RADIXM); \
733}
734
735#define zam_decl double _ds; long _s; unsigned long _hi, _lo;
736
737#define zam_init(b,s) \
738{ \
739   long _b = (b); \
740   _s = (s); \
741   _ds = ((_s << 1)+1)*(NTL_FRADIX_INV/2.0); \
742   _lo = ((unsigned long) _b)*((unsigned long) _s); \
743   _hi = (long) (((double) _b)*_ds); \
744}
745
746/* value shifted is 0..3 */
747#define zam_loop(a,t,nb) \
748{ \
749   long _a = (a), _t = (t), _nb = (nb); \
750   unsigned long _vv; \
751   double _yy; \
752   _vv = ((unsigned long) _nb)*((unsigned long)_s); \
753   _yy = ((double) _nb)*_ds; \
754   _lo = _lo + ((unsigned long) _a) + ((unsigned long) _t); \
755   _hi--; \
756   (t) = (long) (_hi + ((_lo - (_hi<<NTL_NBITS)) >> NTL_NBITS)); \
757   (a) = (long) (_lo & NTL_RADIXM); \
758   _lo = _vv; \
759   _hi = (long) _yy; \
760}
761
762/* value shifted is 0..2 */
763#define zsx_loop(a,t,nb) \
764{ \
765   long _t = (t), _nb = (nb); \
766   unsigned long _vv; \
767   double _yy; \
768   _vv = ((unsigned long) _nb)*((unsigned long) _s); \
769   _yy = ((double) _nb)*_ds; \
770   _lo = _lo + ((unsigned long) _t); \
771   _hi--; \
772   (t) = (long) (_hi + ((_lo - (_hi<<NTL_NBITS)) >> NTL_NBITS)); \
773   (a) = (long) (_lo & NTL_RADIXM); \
774   _lo = _vv; \
775   _hi = (long) _yy; \
776}
777
778/* value shifted is 0..3 */
779#define zam_subloop(a,t,nb) \
780{ \
781   long _a = (a); unsigned long _t = (t); long _nb = (nb); \
782   unsigned long _vv; \
783   double _yy; \
784   _vv = ((unsigned long) _nb)*((unsigned long) _s); \
785   _yy = ((double) _nb)*_ds; \
786   _hi += 2; \
787   _lo = ((unsigned long) _a) + _t - _lo; \
788   (t) = ((_lo + (_hi<<NTL_NBITS)) >> NTL_NBITS) - _hi; \
789   (a) = (long) (_lo & NTL_RADIXM); \
790   _lo = _vv; \
791   _hi = (long) _yy; \
792}
793
794/* value shifted is 0..3 */
795#define zam_finish(a,t) \
796{ \
797   long _a = (a), _t = (t); \
798   _lo = _lo + ((unsigned long) _a) + ((unsigned long) _t); \
799   _hi--; \
800   (t) = (long) (_hi + ((_lo - (_hi<<NTL_NBITS)) >> NTL_NBITS)); \
801   (a) = (long) (_lo & NTL_RADIXM); \
802}
803
804/* value shifted is 0..2 */
805#define zsx_finish(a,t) \
806{ \
807   long _a = (a), _t = (t); \
808   _lo = _lo + ((unsigned long) _t); \
809   _hi--; \
810   (t) = (long) (_hi + ((_lo - (_hi<<NTL_NBITS)) >> NTL_NBITS)); \
811   (a) = (long) (_lo & NTL_RADIXM); \
812}
813
814/* value shifted is 0..3 */
815#define zam_subfinish(a,t) \
816{ \
817   long _a = (a); unsigned long _t = (t); \
818   _hi += 2; \
819   _lo = ((unsigned long) _a) + _t - _lo; \
820   (t) = ((_lo + (_hi<<NTL_NBITS)) >> NTL_NBITS) - _hi; \
821   (a) = (long) (_lo & NTL_RADIXM); \
822}
823
824#endif
825/* end of arithmemtic-right-shift if-then else */
826   
827#else
828/*  NTL_BITS_PER_LONG > NTL_NBITS + 2, and certain optimizations can be
829    made.  Useful on 64-bit machines.  */
830
831#if (NTL_ARITH_RIGHT_SHIFT && !defined(NTL_CLEAN_INT))
832/* shift is -1..+3 */
833#define zaddmulp(a, b, d, t) \
834{ \
835   long _a = (a), _b = (b), _d = (d), _t = (t); \
836   long _t1 =  _b*_d + _a + _t; \
837   long _t2 = (long) ( ((double) _b)*(((double) _d)*NTL_FRADIX_INV) ); \
838   (t) = _t2 + ((_t1 - (_t2 << NTL_NBITS)) >> NTL_NBITS); \
839   (a) = _t1 & NTL_RADIXM; \
840}
841
842#define zxmulp(a, b, d, t) \
843{ \
844   long _b = (b), _d = (d), _t = (t); \
845   long _t1 =  _b*_d + _t; \
846   long _t2 = (long) ( ((double) _b)*(((double) _d)*NTL_FRADIX_INV) ); \
847   (t) = _t2 + ((_t1 - (_t2 << NTL_NBITS)) >> NTL_NBITS); \
848   (a) = _t1 & NTL_RADIXM; \
849}
850
851/* shift is -1..+2 */
852#define zaddmulpsq(a, b, t) \
853{ \
854   long _a = (a), _b = (b), _t = (t); \
855   long _t1 = _b*_b + _a; \
856   long _t2 = (long) ( ((double) _b)*(((double) _b)*NTL_FRADIX_INV) ); \
857   (t) = _t2 + ((_t1 - (_t2 << NTL_NBITS)) >> NTL_NBITS); \
858   (a) = _t1 & NTL_RADIXM; \
859}
860
861#define zam_decl double _ds; long _hi, _lo, _s;
862
863#define zam_init(b,s) \
864{ \
865   long _b = (b); \
866   _s = (s); \
867   _ds = _s*NTL_FRADIX_INV; \
868   _lo = _b*_s; \
869   _hi = (long) (((double) _b)*_ds); \
870}
871
872/* shift is -1..+3 */
873#define zam_loop(a,t,nb) \
874{ \
875   long _a = (a), _t = (t), _nb = (nb); \
876   long _vv; \
877   double _yy; \
878   _vv = _nb*_s; \
879   _yy = ((double) _nb)*_ds; \
880   _lo = _lo + _a + _t; \
881   (t) = _hi + ((_lo - (_hi<<NTL_NBITS)) >> NTL_NBITS); \
882   (a) = _lo & NTL_RADIXM; \
883   _lo = _vv; \
884   _hi = (long) _yy; \
885}
886
887/* shift is -1..+2 */
888#define zsx_loop(a,t,nb) \
889{ \
890   long _t = (t), _nb = (nb); \
891   long _vv; \
892   double _yy; \
893   _vv = _nb*_s; \
894   _yy = ((double) _nb)*_ds; \
895   _lo = _lo + _t; \
896   (t) = _hi + ((_lo - (_hi<<NTL_NBITS)) >> NTL_NBITS); \
897   (a) = _lo & NTL_RADIXM; \
898   _lo = _vv; \
899   _hi = (long) _yy; \
900}
901
902/* shift is -3..+1 */
903#define zam_subloop(a,t,nb) \
904{ \
905   long _a = (a), _t = (t), _nb = (nb); \
906   long _vv; \
907   double _yy; \
908   _vv = _nb*_s; \
909   _yy = ((double) _nb)*_ds; \
910   _lo = _a + _t - _lo; \
911   (t) = ((_lo + (_hi<<NTL_NBITS)) >> NTL_NBITS) - _hi; \
912   (a) = _lo & NTL_RADIXM; \
913   _lo = _vv; \
914   _hi = (long) _yy; \
915}
916
917/* shift is -1..+3 */
918#define zam_finish(a,t) \
919{ \
920   long _a = (a), _t = (t); \
921   _lo = _lo + _a + _t; \
922   (t) = _hi + ((_lo - (_hi<<NTL_NBITS)) >> NTL_NBITS); \
923   (a) = _lo & NTL_RADIXM; \
924}
925
926/* shift is -1..+2 */
927#define zsx_finish(a,t) \
928{ \
929   long _t = (t); \
930   _lo = _lo + _t; \
931   (t) = _hi + ((_lo - (_hi<<NTL_NBITS)) >> NTL_NBITS); \
932   (a) = _lo & NTL_RADIXM; \
933}
934
935/* shift is -3..+1 */
936#define zam_subfinish(a,t) \
937{ \
938   long _a = (a), _t = (t); \
939   _lo = _a + _t - _lo; \
940   (t) = ((_lo + (_hi<<NTL_NBITS)) >> NTL_NBITS) - _hi; \
941   (a) = _lo & NTL_RADIXM; \
942}
943
944#elif (!defined(NTL_CLEAN_INT))
945/* right shift is not arithmetic */
946
947/* shift is 0..4 */
948#define zaddmulp(a, b, d, t) \
949{ \
950   long _a = (a), _b = (b), _d = (d), _t = (t); \
951   long _t1 =  _b*_d + _a + _t; \
952   long _t2 = (long) ( ((double) _b)*(((double) _d)*NTL_FRADIX_INV) ) - 1; \
953   (t) = _t2 + (((unsigned long)(_t1 - (_t2 << NTL_NBITS))) >> NTL_NBITS); \
954   (a) = _t1 & NTL_RADIXM; \
955}
956
957#define zxmulp(a, b, d, t) \
958{ \
959   long _b = (b), _d = (d), _t = (t); \
960   long _t1 =  _b*_d + _t; \
961   long _t2 = (long) ( ((double) _b)*(((double) _d)*NTL_FRADIX_INV) ) - 1; \
962   (t) = _t2 + (((unsigned long)(_t1 - (_t2 << NTL_NBITS))) >> NTL_NBITS); \
963   (a) = _t1 & NTL_RADIXM; \
964}
965
966/* shift is 0..3 */
967#define zaddmulpsq(a, b, t) \
968{ \
969   long _a = (a), _b = (b), _t = (t); \
970   long _t1 = _b*_b + _a; \
971   long _t2 = (long) ( ((double) _b)*(((double) _b)*NTL_FRADIX_INV) ) - 1; \
972   (t) = _t2 + (((unsigned long)(_t1 - (_t2 << NTL_NBITS))) >> NTL_NBITS); \
973   (a) = _t1 & NTL_RADIXM; \
974}
975
976#define zam_decl double _ds; long _hi, _lo, _s;
977
978#define zam_init(b,s) \
979{ \
980   long _b = (b); \
981   _s = (s); \
982   _ds = _s*NTL_FRADIX_INV; \
983   _lo = _b*_s; \
984   _hi = (long) (((double) _b)*_ds); \
985}
986
987/* shift is 0..4 */
988#define zam_loop(a,t,nb) \
989{ \
990   long _a = (a), _t = (t), _nb = (nb); \
991   long _vv; \
992   double _yy; \
993   _vv = _nb*_s; \
994   _yy = ((double) _nb)*_ds; \
995   _hi--; \
996   _lo = _lo + _a + _t; \
997   (t) = _hi + (((unsigned long)(_lo - (_hi<<NTL_NBITS))) >> NTL_NBITS); \
998   (a) = _lo & NTL_RADIXM; \
999   _lo = _vv; \
1000   _hi = (long) _yy; \
1001}
1002
1003/* shift is 0..3 */
1004#define zsx_loop(a,t,nb) \
1005{ \
1006   long _t = (t), _nb = (nb); \
1007   long _vv; \
1008   double _yy; \
1009   _vv = _nb*_s; \
1010   _yy = ((double) _nb)*_ds; \
1011   _hi--; \
1012   _lo = _lo + _t; \
1013   (t) = _hi + (((unsigned long)(_lo - (_hi<<NTL_NBITS))) >> NTL_NBITS); \
1014   (a) = _lo & NTL_RADIXM; \
1015   _lo = _vv; \
1016   _hi = (long) _yy; \
1017}
1018
1019/* shift is 0..4 */
1020#define zam_subloop(a,t,nb) \
1021{ \
1022   long _a = (a), _t = (t), _nb = (nb); \
1023   long _vv; \
1024   double _yy; \
1025   _vv = _nb*_s; \
1026   _yy = ((double) _nb)*_ds; \
1027   _hi += 3; \
1028   _lo = _a + _t - _lo; \
1029   (t) = (((unsigned long)(_lo + (_hi<<NTL_NBITS))) >> NTL_NBITS) - _hi; \
1030   (a) = _lo & NTL_RADIXM; \
1031   _lo = _vv; \
1032   _hi = (long) _yy; \
1033}
1034
1035/* shift is 0..4 */
1036#define zam_finish(a,t) \
1037{ \
1038   long _a = (a), _t = (t); \
1039   _lo = _lo + _a + _t; \
1040   _hi--; \
1041   (t) = _hi + (((unsigned long)(_lo - (_hi<<NTL_NBITS))) >> NTL_NBITS); \
1042   (a) = _lo & NTL_RADIXM; \
1043}
1044
1045/* shift is 0..3 */
1046#define zsx_finish(a,t) \
1047{ \
1048   long _t = (t); \
1049   _lo = _lo + _t; \
1050   _hi--; \
1051   (t) = _hi + (((unsigned long)(_lo - (_hi<<NTL_NBITS))) >> NTL_NBITS); \
1052   (a) = _lo & NTL_RADIXM; \
1053}
1054
1055/* shift is 0..4 */
1056#define zam_subfinish(a,t) \
1057{ \
1058   long _a = (a), _t = (t); \
1059   _hi += 3; \
1060   _lo = _a + _t - _lo; \
1061   (t) = (((unsigned long)(_lo + (_hi<<NTL_NBITS))) >> NTL_NBITS) - _hi; \
1062   (a) = _lo & NTL_RADIXM; \
1063}
1064#else
1065
1066/* clean int version */
1067
1068/* shift is 0..4 */
1069#define zaddmulp(a, b, d, t) \
1070{ \
1071   long _a = (a), _b = (b), _d = (d), _t = (t); \
1072   unsigned long _t1 =  ((unsigned long) _b)*((unsigned long) _d) + ((unsigned long) _a) + ((unsigned long) _t); \
1073   unsigned long _t2 = (long) ( ((double) _b)*(((double) _d)*NTL_FRADIX_INV) ) - 1; \
1074   (t) = (long) (_t2 + ((_t1 - (_t2 << NTL_NBITS)) >> NTL_NBITS)); \
1075   (a) = (long) (_t1 & NTL_RADIXM); \
1076}
1077
1078#define zxmulp(a, b, d, t) \
1079{ \
1080   long _b = (b), _d = (d), _t = (t); \
1081   unsigned long _t1 =  ((unsigned long) _b)*((unsigned long) _d) + ((unsigned long) _t); \
1082   unsigned long _t2 = (long) ( ((double) _b)*(((double) _d)*NTL_FRADIX_INV) ) - 1; \
1083   (t) = (long) (_t2 + ((_t1 - (_t2 << NTL_NBITS)) >> NTL_NBITS)); \
1084   (a) = (long) (_t1 & NTL_RADIXM); \
1085}
1086
1087/* shift is 0..3 */
1088#define zaddmulpsq(a, b, t) \
1089{ \
1090   long _a = (a), _b = (b), _t = (t); \
1091   unsigned long _t1 = ((unsigned long) _b)*((unsigned long) _b) + ((unsigned long) _a); \
1092   unsigned long _t2 = (long) ( ((double) _b)*(((double) _b)*NTL_FRADIX_INV) ) - 1; \
1093   (t) = (long) (_t2 + ((_t1 - (_t2 << NTL_NBITS)) >> NTL_NBITS)); \
1094   (a) = (long) (_t1 & NTL_RADIXM); \
1095}
1096
1097#define zam_decl double _ds; long _s; unsigned long _hi, _lo;
1098
1099#define zam_init(b,s) \
1100{ \
1101   long _b = (b); \
1102   _s = (s); \
1103   _ds = _s*NTL_FRADIX_INV; \
1104   _lo = ((unsigned long) _b)*((unsigned long) _s); \
1105   _hi = (long) (((double) _b)*_ds); \
1106}
1107
1108/* shift is 0..4 */
1109#define zam_loop(a,t,nb) \
1110{ \
1111   long _a = (a), _t = (t), _nb = (nb); \
1112   unsigned long _vv; \
1113   double _yy; \
1114   _vv = ((unsigned long) _nb)*((unsigned long) _s); \
1115   _yy = ((double) _nb)*_ds; \
1116   _hi--; \
1117   _lo = _lo + ((unsigned long) _a) + ((unsigned long) _t); \
1118   (t) = (long) (_hi + ((_lo - (_hi<<NTL_NBITS)) >> NTL_NBITS)); \
1119   (a) = (long) (_lo & NTL_RADIXM); \
1120   _lo = _vv; \
1121   _hi = (long) _yy; \
1122}
1123
1124/* shift is 0..3 */
1125#define zsx_loop(a,t,nb) \
1126{ \
1127   long _t = (t), _nb = (nb); \
1128   unsigned long _vv; \
1129   double _yy; \
1130   _vv = ((unsigned long) _nb)*((unsigned long) _s); \
1131   _yy = ((double) _nb)*_ds; \
1132   _hi--; \
1133   _lo = _lo + ((unsigned long) _t); \
1134   (t) = (long) (_hi + ((_lo - (_hi<<NTL_NBITS)) >> NTL_NBITS)); \
1135   (a) = (long) (_lo & NTL_RADIXM); \
1136   _lo = _vv; \
1137   _hi = (long) _yy; \
1138}
1139
1140/* shift is 0..4 */
1141#define zam_subloop(a,t,nb) \
1142{ \
1143   long _a = (a); unsigned long _t = (t); long _nb = (nb); \
1144   unsigned long _vv; \
1145   double _yy; \
1146   _vv = ((unsigned long) _nb)*((unsigned long) _s); \
1147   _yy = ((double) _nb)*_ds; \
1148   _hi += 3; \
1149   _lo = ((unsigned long) _a) + _t - _lo; \
1150   (t) = ((_lo + (_hi<<NTL_NBITS)) >> NTL_NBITS) - _hi; \
1151   (a) = (long) (_lo & NTL_RADIXM); \
1152   _lo = _vv; \
1153   _hi = (long) _yy; \
1154}
1155
1156/* shift is 0..4 */
1157#define zam_finish(a,t) \
1158{ \
1159   long _a = (a), _t = (t); \
1160   _lo = _lo + ((unsigned long) _a) + ((unsigned long) _t); \
1161   _hi--; \
1162   (t) = (long) (_hi + ((_lo - (_hi<<NTL_NBITS)) >> NTL_NBITS)); \
1163   (a) = _lo & NTL_RADIXM; \
1164}
1165
1166/* shift is 0..3 */
1167#define zsx_finish(a,t) \
1168{ \
1169   long _t = (t); \
1170   _lo = _lo + ((unsigned long) _t); \
1171   _hi--; \
1172   (t) = (long) (_hi + ((_lo - (_hi<<NTL_NBITS)) >> NTL_NBITS)); \
1173   (a) = (long) (_lo & NTL_RADIXM); \
1174}
1175
1176/* shift is 0..4 */
1177#define zam_subfinish(a,t) \
1178{ \
1179   long _a = (a); unsigned long _t = (t); \
1180   _hi += 3; \
1181   _lo = ((unsigned long) _a) + _t - _lo; \
1182   (t) = ((_lo + (_hi<<NTL_NBITS)) >> NTL_NBITS) - _hi; \
1183   (a) = (long) (_lo & NTL_RADIXM); \
1184}
1185
1186#endif
1187/* end of arithmetic-right-shift if-then-else */
1188
1189#endif
1190/* end of "NTL_BITS_PER_LONG <= NTL_NBITS + 2" if-then-else */
1191
1192#endif
1193/* end of long-integer-implementation if-then-else */
1194
1195
1196
1197
1198
1199
1200static
1201void zaddmulone(long *lama, long *lamb)
1202{ 
1203   long lami; 
1204   long lams = 0; 
1205 
1206   lams = 0; 
1207   for (lami = (*lamb++); lami > 0; lami--) { 
1208      lams += (*lama + *lamb++); 
1209      *lama++ = lams & NTL_RADIXM; 
1210      lams >>= NTL_NBITS; 
1211   } 
1212   *lama += lams; 
1213}
1214
1215#if (NTL_ARITH_RIGHT_SHIFT && !defined(NTL_CLEAN_INT))
1216
1217static
1218void zsubmulone(long *lama, long *lamb)
1219{ 
1220   long lami; 
1221   long lams = 0; 
1222 
1223   lams = 0; 
1224   for (lami = (*lamb++); lami > 0; lami--) { 
1225      lams += (*lama - *lamb++); 
1226      *lama++ = lams & NTL_RADIXM; 
1227      lams >>= NTL_NBITS; 
1228   } 
1229   *lama += lams; 
1230}
1231
1232
1233#else
1234
1235
1236static
1237void zsubmulone(long *lama, long *lamb)
1238{ 
1239   long lami; 
1240   long lams = 0; 
1241 
1242   lams = 0; 
1243   for (lami = (*lamb++); lami > 0; lami--) { 
1244      lams = *lama - *lamb++ - lams; 
1245      *lama++ = lams & NTL_RADIXM; 
1246      lams = (lams < 0);
1247   } 
1248   *lama -= lams; 
1249}
1250
1251#endif
1252
1253
1254/*
1255 * definitions of zaddmul, zsxmul, zaddmulsq for the various
1256 * long integer implementation options.
1257 */
1258
1259
1260#if (defined(NTL_SINGLE_MUL))
1261
1262static
1263void zaddmul(long ams, long *ama, long *amb) 
1264{ 
1265   long carry = 0; 
1266   long i = (*amb++);
1267   double dams = (double) ams;
1268   double xx;
1269   double yy;
1270   unsigned long lo_wd, lo;
1271   unsigned long hi_wd, hi;
1272
1273   xx  =  ((double) (*amb++))*dams + DENORMALIZE;
1274   for (; i > 1; i--) { 
1275      yy =  ((double) (*amb++))*dams +DENORMALIZE;
1276      NTL_FetchHiLo(hi_wd, lo_wd, xx);
1277      lo = lo_wd & 0x3FFFFFF;
1278      hi = ((hi_wd<<6)|(lo_wd>>26)) & 0x3FFFFFF;
1279      lo = lo + (*ama) + carry;
1280      *ama = lo & 0x3FFFFFF;
1281      carry = hi + (lo >> 26);
1282      ama++; 
1283      xx = yy;
1284   } 
1285
1286   NTL_FetchHiLo(hi_wd, lo_wd, xx);
1287   lo = lo_wd & 0x3FFFFFF;
1288   hi = ((hi_wd<<6)|(lo_wd>>26)) & 0x3FFFFFF;
1289   lo = lo + (*ama) + carry;
1290   *ama = lo & 0x3FFFFFF;
1291   carry = hi + (lo >> 26);
1292   ama++; 
1293   *ama += carry; 
1294}
1295
1296static
1297void zsxmul(long ams, long *ama, long *amb) 
1298{ 
1299   long carry = 0; 
1300   long i = (*amb++);
1301   double dams = (double) ams;
1302   double xx;
1303   double yy;
1304   unsigned long lo_wd, lo;
1305   unsigned long hi_wd, hi;
1306
1307   xx  =  ((double) (*amb++))*dams + DENORMALIZE;
1308   for (; i > 1; i--) { 
1309      yy =  ((double) (*amb++))*dams +DENORMALIZE;
1310      NTL_FetchHiLo(hi_wd, lo_wd, xx);
1311      lo = lo_wd & 0x3FFFFFF;
1312      hi = ((hi_wd<<6)|(lo_wd>>26)) & 0x3FFFFFF;
1313      lo = lo + carry;
1314      *ama = lo & 0x3FFFFFF;
1315      carry = hi + (lo >> 26);
1316      ama++; 
1317      xx = yy;
1318   } 
1319
1320   NTL_FetchHiLo(hi_wd, lo_wd, xx);
1321   lo = lo_wd & 0x3FFFFFF;
1322   hi = ((hi_wd<<6)|(lo_wd>>26)) & 0x3FFFFFF;
1323   lo = lo + carry;
1324   *ama = lo & 0x3FFFFFF;
1325   carry = hi + (lo >> 26);
1326   ama++; 
1327   *ama = carry; 
1328}
1329
1330static
1331void zaddmulsq(long ams, long *ama, long *amb) 
1332{ 
1333   long carry = 0; 
1334   long i = ams;
1335   double dams = (double) (*amb++);
1336   double xx;
1337   double yy;
1338   unsigned long lo, lo_wd;
1339   unsigned long hi, hi_wd;
1340
1341   xx =  ((double) (*amb++))*dams + DENORMALIZE;
1342   for (; i > 1; i--) { 
1343      yy =  ((double) (*amb++))*dams + DENORMALIZE;
1344      NTL_FetchHiLo(hi_wd, lo_wd, xx);
1345      lo = lo_wd & 0x3FFFFFF;
1346      hi = ((hi_wd<<6)|(lo_wd>>26)) & 0x3FFFFFF;
1347      lo = lo + (*ama) + carry;
1348      *ama = lo & 0x3FFFFFF;
1349      carry = hi + (lo >> 26);
1350      ama++; 
1351      xx = yy;
1352   } 
1353   if (i==1) {
1354      NTL_FetchHiLo(hi_wd, lo_wd, xx);
1355      lo = lo_wd & 0x3FFFFFF;
1356      hi = ((hi_wd<<6)|(lo_wd>>26)) & 0x3FFFFFF;
1357      lo = lo + (*ama) + carry;
1358      *ama = lo & 0x3FFFFFF;
1359      carry = hi + (lo >> 26);
1360      ama++; 
1361   }
1362   *ama += carry; 
1363}
1364
1365#elif (defined(NTL_AVOID_FLOAT) || defined(NTL_LONG_LONG))
1366
1367static
1368void zaddmul(long lams, long *lama, long *lamb)
1369{
1370        long lami;
1371        long lamcarry = 0;
1372
1373        for (lami = (*lamb++); lami > 0; lami--)
1374        {
1375                zaddmulp(*lama, *lamb, lams, lamcarry);
1376                lama++;
1377                lamb++;
1378        }
1379        *lama += lamcarry;
1380}
1381
1382static
1383void zsxmul(long lams, long *lama, long *lamb)
1384{
1385        long lami;
1386        long lamcarry = 0;
1387
1388        for (lami = (*lamb++); lami > 0; lami--)
1389        {
1390                zxmulp(*lama, *lamb, lams, lamcarry);
1391                lama++;
1392                lamb++;
1393        }
1394        *lama = lamcarry;
1395}
1396
1397static
1398void zaddmulsq(long lsqi, long *lsqa, long *lsqb)
1399{
1400        long lsqs = *(lsqb);
1401        long lsqcarry = 0;
1402
1403        lsqb++;
1404        for (; lsqi > 0; lsqi--)
1405        {
1406                zaddmulp(*lsqa, *lsqb, lsqs, lsqcarry);
1407                lsqa++;
1408                lsqb++;
1409        }
1410        *lsqa += lsqcarry;
1411}
1412
1413
1414#else
1415/* default long integer arithmetic */
1416
1417static
1418void zaddmul(long lams, long *lama, long *lamb)
1419{ 
1420   long lami = (*lamb++)-1; 
1421   long lamcarry = 0; 
1422   zam_decl;
1423
1424   zam_init(*lamb, lams);
1425   lamb++;
1426
1427 
1428   for (; lami > 0; lami--) { 
1429      zam_loop(*lama, lamcarry, *lamb);
1430      lama++; 
1431      lamb++; 
1432   } 
1433   zam_finish(*lama, lamcarry);
1434   lama++;
1435   *lama += lamcarry; 
1436}
1437
1438
1439
1440static
1441void zsxmul(long lams, long *lama, long *lamb)
1442{ 
1443   long lami = (*lamb++)-1; 
1444   long lamcarry = 0; 
1445   zam_decl;
1446
1447   zam_init(*lamb, lams);
1448   lamb++;
1449
1450 
1451   for (; lami > 0; lami--) { 
1452      zsx_loop(*lama, lamcarry, *lamb);
1453      lama++; 
1454      lamb++; 
1455   } 
1456   zsx_finish(*lama, lamcarry);
1457   lama++;
1458   *lama = lamcarry; 
1459}
1460
1461
1462
1463static
1464void zaddmulsq(long lsqi, long *lsqa, long *lsqb)
1465{ 
1466   long lsqs; 
1467   long lsqcarry; 
1468   zam_decl
1469
1470   if (lsqi <= 0) return;
1471
1472   lsqs = *lsqb;
1473   lsqcarry = 0;
1474
1475   lsqb++; 
1476   zam_init(*lsqb, lsqs);
1477   lsqb++;
1478   lsqi--;
1479   for (; lsqi > 0; lsqi--) { 
1480      zam_loop(*lsqa, lsqcarry, *lsqb);
1481      lsqa++; 
1482      lsqb++; 
1483   } 
1484   zam_finish(*lsqa, lsqcarry);
1485   lsqa++;
1486   *lsqa += lsqcarry; 
1487}
1488
1489
1490#endif
1491
1492
1493
1494
1495
1496
1497
1498/*
1499 * definition of zsubmul for the various long integer implementation options.
1500 * Note that zsubmul is only called with a positive first argument.
1501 */
1502
1503
1504
1505#if (defined(NTL_SINGLE_MUL))
1506
1507#if (NTL_ARITH_RIGHT_SHIFT)
1508
1509static
1510void zsubmul(long ams, long *ama, long *amb) 
1511{ 
1512   long carry = 0; 
1513   long i = (*amb++);
1514   double dams = (double) ams;
1515   double xx;
1516   double yy;
1517   unsigned long lo_wd, lo;
1518   unsigned long hi_wd, hi;
1519
1520   xx  =  ((double) (*amb++))*dams + DENORMALIZE;
1521   for (; i > 1; i--) { 
1522      yy =  ((double) (*amb++))*dams +DENORMALIZE;
1523      NTL_FetchHiLo(hi_wd, lo_wd, xx);
1524      lo = lo_wd & 0x3FFFFFF;
1525      hi = ((hi_wd<<6)|(lo_wd>>26)) & 0x3FFFFFF;
1526      lo = (*ama) + carry - lo;
1527      *ama = lo & 0x3FFFFFF;
1528      carry = (((long)lo) >> 26) - hi;
1529      ama++; 
1530      xx = yy;
1531   } 
1532
1533   NTL_FetchHiLo(hi_wd, lo_wd, xx);
1534   lo = lo_wd & 0x3FFFFFF;
1535   hi = ((hi_wd<<6)|(lo_wd>>26)) & 0x3FFFFFF;
1536   lo = (*ama) + carry - lo;
1537   *ama = lo & 0x3FFFFFF;
1538   carry = (((long)lo) >> 26) - hi;
1539   ama++; 
1540   *ama += carry; 
1541}
1542
1543#else
1544
1545static
1546void zsubmul(long ams, long *ama, long *amb) 
1547{ 
1548   long carry = 0; 
1549   long i = (*amb++);
1550   double dams = (double) ams;
1551   double xx;
1552   double yy;
1553   unsigned long lo_wd, lo;
1554   unsigned long hi_wd, hi;
1555
1556   xx  =  ((double) (*amb++))*dams + DENORMALIZE;
1557   for (; i > 1; i--) { 
1558      yy =  ((double) (*amb++))*dams +DENORMALIZE;
1559      NTL_FetchHiLo(hi_wd, lo_wd, xx);
1560      lo = lo_wd & 0x3FFFFFF;
1561      hi = ((hi_wd<<6)|(lo_wd>>26)) & 0x3FFFFFF;
1562      lo = (*ama) + carry - lo;
1563      *ama = lo & 0x3FFFFFF;
1564      carry = ((lo + (1L << 27)) >> 26) - hi - 2;
1565      ama++; 
1566      xx = yy;
1567   } 
1568
1569   NTL_FetchHiLo(hi_wd, lo_wd, xx);
1570   lo = lo_wd & 0x3FFFFFF;
1571   hi = ((hi_wd<<6)|(lo_wd>>26)) & 0x3FFFFFF;
1572   lo = (*ama) + carry - lo;
1573   *ama = lo & 0x3FFFFFF;
1574   carry = ((lo + (1L << 27)) >> 26) - hi - 2;
1575   ama++; 
1576   *ama += carry; 
1577}
1578
1579#endif
1580
1581
1582
1583#elif (defined(NTL_AVOID_FLOAT) || (defined(NTL_LONG_LONG) && defined(NTL_CLEAN_INT)))
1584
1585static void
1586zsubmul(
1587        long r,
1588        _ntl_verylong a,
1589        _ntl_verylong b
1590        )
1591{
1592        long rd = NTL_RADIX - r;
1593        long i;
1594        long carry = NTL_RADIX;
1595
1596        for (i = (*b++); i > 0; i--)
1597        {
1598                zaddmulp(*a, *b, rd, carry);
1599                a++;
1600                carry += NTL_RADIXM - (*b++);
1601        }
1602        *a += carry - NTL_RADIX; /* unnormalized */
1603}
1604
1605#elif (defined(NTL_LONG_LONG))
1606
1607/*
1608 * NOTE: the implementation of zaddmulp for the NTL_LONG_LONG option
1609 * will work on most machines even when the single-precision
1610 * multiplicand is negative;  however, the C language standard does
1611 * not guarantee correct behaviour in this case, which is why the above
1612 * implementation is used when NTL_CLEAN_INT is set.
1613 */
1614
1615static
1616void zsubmul(long lams, long *lama, long *lamb)
1617{
1618        long lami;
1619        long lamcarry = 0;
1620
1621        lams = -lams;
1622
1623        for (lami = (*lamb++); lami > 0; lami--)
1624        {
1625                zaddmulp(*lama, *lamb, lams, lamcarry);
1626                lama++;
1627                lamb++;
1628        }
1629        *lama += lamcarry;
1630}
1631
1632
1633#else
1634/* default long integer arithmetic */
1635
1636static
1637void zsubmul(long lams, long *lama, long *lamb)
1638{ 
1639   long lami = (*lamb++)-1; 
1640   CARRY_TYPE lamcarry = 0; 
1641   zam_decl;
1642
1643   zam_init(*lamb, lams);
1644   lamb++;
1645
1646 
1647   for (; lami > 0; lami--) { 
1648      zam_subloop(*lama, lamcarry, *lamb);
1649      lama++; 
1650      lamb++; 
1651   } 
1652   zam_subfinish(*lama, lamcarry);
1653   lama++;
1654   *lama += CARRY_CONV(lamcarry); 
1655}
1656
1657#endif
1658
1659
1660
1661
1662
1663/*
1664 *
1665 * zdiv21 returns quot, numhigh so
1666 *
1667 * quot = (numhigh*NTL_RADIX + numlow)/denom;
1668 * numhigh  = (numhigh*NTL_RADIX + numlow)%denom;
1669 * Assumes 0 <= numhigh < denom < NTL_RADIX and 0 <= numlow < NTL_RADIX.
1670 */
1671
1672
1673#if (defined(NTL_CLEAN_INT))
1674
1675/*
1676 * This "clean" version relies on the guaranteed semantics of
1677 * unsigned integer arithmetic.
1678 */
1679
1680#define zdiv21(numhigh, numlow, denom, deninv, quot) \
1681{ \
1682   unsigned long udenom = denom; \
1683   unsigned long lq21 = (long) (((NTL_FRADIX * (double) (numhigh)) + \
1684                        (double) (numlow)) * (deninv)); \
1685   unsigned long lr21 = (((unsigned long) numhigh) << NTL_NBITS) + \
1686                        ((unsigned long) numlow)  - udenom*lq21 ; \
1687 \
1688   if (lr21 >> (NTL_BITS_PER_LONG-1)) { \
1689      lq21--; \
1690      lr21 += udenom; \
1691   } \
1692   else if (lr21 >= udenom) { \
1693      lr21 -= udenom; \
1694      lq21++; \
1695   } \
1696   quot = (long) lq21; \
1697   numhigh = (long) lr21; \
1698}
1699
1700
1701#else
1702
1703/*
1704 * This "less clean" version relies on wrap-around semantics for
1705 * signed integer arithmetic.
1706 */
1707
1708#define zdiv21(numhigh, numlow, denom, deninv, quot) \
1709{ \
1710   long lr21; \
1711   long lq21 = (long) (((NTL_FRADIX * (double) (numhigh)) \
1712          + (double) (numlow)) * (deninv)); \
1713   long lp21; \
1714   MulLo(lp21, lq21, denom); \
1715   lr21 = (numhigh << NTL_NBITS) + numlow - lp21; \
1716   if (lr21 < 0) { \
1717      lq21--; \
1718      lr21 += denom; \
1719   } \
1720   else if (lr21 >= denom) { \
1721      lr21 -= denom; \
1722      lq21++; \
1723   } \
1724   quot = lq21; \
1725   numhigh = lr21; \
1726}
1727
1728#endif
1729
1730
1731
1732
1733/*
1734 * zrem21 behaves just like zdiv21, except the only the remainder is computed.
1735 */
1736
1737
1738#if (defined(NTL_CLEAN_INT))
1739
1740#define zrem21(numhigh, numlow, denom, deninv) \
1741{ \
1742   unsigned long udenom = denom; \
1743   unsigned long lq21 = (long) (((NTL_FRADIX * (double) (numhigh)) + \
1744                        (double) (numlow)) * (deninv)); \
1745   unsigned long lr21 = (((unsigned long) numhigh) << NTL_NBITS) + \
1746                        ((unsigned long) numlow)  - udenom*lq21 ; \
1747 \
1748   if (lr21 >> (NTL_BITS_PER_LONG-1)) { \
1749      lr21 += udenom; \
1750   } \
1751   else if (lr21 >= udenom) { \
1752      lr21 -= udenom; \
1753   } \
1754   numhigh = (long) lr21; \
1755}
1756
1757
1758#elif (NTL_ARITH_RIGHT_SHIFT && defined(NTL_AVOID_BRANCHING))
1759
1760#define zrem21(numhigh, numlow, denom, deninv) \
1761{ \
1762   long lr21; \
1763   long lq21 = (long) (((NTL_FRADIX * (double) (numhigh)) \
1764          + (double) (numlow)) * (deninv)); \
1765   long lp21; \
1766   MulLo(lp21, lq21, denom); \
1767   lr21 = (numhigh << NTL_NBITS) + numlow - lp21; \
1768   lr21 += (lr21 >> (NTL_BITS_PER_LONG-1)) & denom; \
1769   lr21 -= denom; \
1770   lr21 += (lr21 >> (NTL_BITS_PER_LONG-1)) & denom; \
1771   numhigh = lr21; \
1772}
1773
1774#else
1775
1776#define zrem21(numhigh, numlow, denom, deninv) \
1777{ \
1778   long lr21; \
1779   long lq21 = (long) (((NTL_FRADIX * (double) (numhigh)) \
1780      + (double) (numlow)) * (deninv)); \
1781   long lp21; \
1782   MulLo(lp21, lq21, denom); \
1783   lr21 = (numhigh << NTL_NBITS) + numlow - lp21; \
1784   if (lr21 < 0) lr21 += denom; \
1785   else if (lr21 >= denom) lr21 -= denom; \
1786   numhigh = lr21; \
1787}
1788
1789#endif
1790
1791
1792
1793void _ntl_zsetlength(_ntl_verylong *v, long len)
1794{
1795   _ntl_verylong x = *v;
1796
1797   if (len < 0)
1798      zhalt("negative size allocation in _ntl_zsetlength");
1799
1800   if (NTL_OVERFLOW(len, NTL_NBITS, 0))
1801      zhalt("size too big in _ntl_zsetlength");
1802
1803#ifdef L_TO_G_CHECK_LEN
1804   /* this makes sure that numbers don't get too big for GMP */
1805   if (len >= (1L << (NTL_BITS_PER_INT-4)))
1806      zhalt("size too big for GMP");
1807#endif
1808
1809   if (x) {
1810      long oldlen = x[-1];
1811      long fixed = oldlen & 1;
1812
1813      oldlen = oldlen >> 1;
1814
1815      if (fixed) {
1816         if (len > oldlen) 
1817            zhalt("internal error: can't grow this _ntl_verylong");
1818         else
1819            return;
1820      }
1821
1822      if (len <= oldlen) return;
1823
1824      len++;  /* always allocate at least one more than requested */
1825
1826      oldlen = (long) (oldlen * 1.2); /* always increase by at least 20% */
1827      if (len < oldlen)
1828         len = oldlen;
1829
1830      /* round up to multiple of MIN_SETL */
1831      len = ((len+(MIN_SETL-1))/MIN_SETL)*MIN_SETL; 
1832
1833      /* test len again */
1834      if (NTL_OVERFLOW(len, NTL_NBITS, 0))
1835         zhalt("size too big in _ntl_zsetlength");
1836
1837      x[-1] = len << 1;
1838      if (!(x = (_ntl_verylong)NTL_REALLOC(&(x[-1]), 
1839                  len, sizeof(long), 2*sizeof(long)))) {
1840         zhalt("reallocation failed in _ntl_zsetlength");
1841      }
1842   }
1843   else {
1844      len++;
1845      len = ((len+(MIN_SETL-1))/MIN_SETL)*MIN_SETL;
1846
1847      /* test len again */
1848      if (NTL_OVERFLOW(len, NTL_NBITS, 0))
1849         zhalt("size too big in _ntl_zsetlength");
1850
1851
1852      if (!(x = (_ntl_verylong)NTL_MALLOC(len, 
1853                  sizeof(long), 2*sizeof(long)))) {
1854         zhalt("allocation failed in _ntl_zsetlength");
1855      }
1856      x[0] = len << 1;
1857      x[1] = 1;
1858      x[2] = 0;
1859   }
1860
1861   *v = x+1;
1862}
1863
1864void _ntl_zfree(_ntl_verylong *x)
1865{
1866   _ntl_verylong y;
1867
1868   if (!(*x))
1869      return;
1870
1871   if ((*x)[-1] & 1)
1872      zhalt("Internal error: can't free this _ntl_verylong");
1873
1874   y = (*x - 1);
1875   free((void*)y);
1876   *x = 0;
1877}
1878
1879
1880
1881
1882
1883
1884long _ntl_zround_correction(_ntl_verylong a, long k, long residual)
1885{
1886   long direction;
1887   long p;
1888   long sgn;
1889   long bl;
1890   long wh;
1891   long i;
1892
1893   if (a[0] > 0)
1894      sgn = 1;
1895   else
1896      sgn = -1;
1897
1898   p = k - 1;
1899   bl = (p/NTL_NBITS);
1900   wh = 1L << (p - NTL_NBITS*bl);
1901   bl++;
1902
1903   if (a[bl] & wh) {
1904      /* bit is 1...we have to see if lower bits are all 0
1905         in order to implement "round to even" */
1906
1907      if (a[bl] & (wh - 1)) 
1908         direction = 1;
1909      else {
1910         i = bl - 1;
1911         while (i > 0 && a[i] == 0) i--;
1912         if (i > 0)
1913            direction = 1;
1914         else
1915            direction = 0;
1916      }
1917
1918      /* use residual to break ties */
1919
1920      if (direction == 0 && residual != 0) {
1921         if (residual == sgn)
1922            direction = 1;
1923         else 
1924            direction = -1;
1925      }
1926
1927      if (direction == 0) {
1928         /* round to even */
1929
1930         wh = wh << 1;
1931         if (wh == NTL_RADIX) {
1932            wh = 1;
1933            bl++;
1934         }
1935
1936         if (a[bl] & wh)
1937            direction = 1;
1938         else
1939            direction = -1;
1940      }
1941   }
1942   else
1943      direction = -1;
1944
1945   if (direction == 1)
1946      return sgn;
1947
1948   return 0;
1949}
1950
1951
1952
1953double _ntl_zdoub_aux(_ntl_verylong n)
1954{
1955   double res;
1956   long i;
1957
1958   if (!n)
1959      return ((double) 0);
1960   if ((i = n[0]) < 0)
1961      i = -i;
1962   res = (double) (n[i--]);
1963   for (; i; i--)
1964      res = res * NTL_FRADIX + (double) (n[i]);
1965   if (n[0] > 0)
1966      return (res);
1967   return (-res);
1968}
1969
1970
1971
1972double _ntl_zdoub(_ntl_verylong n)
1973{
1974   static _ntl_verylong tmp = 0;
1975
1976   long s;
1977   long shamt;
1978   long correction;
1979   double x;
1980
1981   s = _ntl_z2log(n);
1982   shamt = s - NTL_DOUBLE_PRECISION;
1983
1984   if (shamt <= 0)
1985      return _ntl_zdoub_aux(n);
1986
1987   _ntl_zrshift(n, shamt, &tmp);
1988
1989   correction = _ntl_zround_correction(n, shamt, 0);
1990
1991   if (correction) _ntl_zsadd(tmp, correction, &tmp);
1992
1993   x = _ntl_zdoub_aux(tmp);
1994
1995   x = _ntl_ldexp(x, shamt);
1996
1997   return x;
1998}
1999
2000
2001double _ntl_zlog(_ntl_verylong n)
2002{
2003   static _ntl_verylong tmp = 0;
2004
2005   static double log_2;
2006   static long init = 0;
2007
2008   long s;
2009   long shamt;
2010   long correction;
2011   double x;
2012
2013   if (!init) {
2014      log_2 = log(2.0);
2015      init = 1;
2016   }
2017
2018   if (_ntl_zsign(n) <= 0)
2019      zhalt("log argument <= 0");
2020
2021   s = _ntl_z2log(n);
2022   shamt = s - NTL_DOUBLE_PRECISION;
2023
2024   if (shamt <= 0)
2025      return log(_ntl_zdoub_aux(n));
2026
2027   _ntl_zrshift(n, shamt, &tmp);
2028
2029   correction = _ntl_zround_correction(n, shamt, 0);
2030
2031   if (correction) _ntl_zsadd(tmp, correction, &tmp);
2032
2033   x = _ntl_zdoub_aux(tmp);
2034
2035   return log(x) + shamt*log_2;
2036}
2037
2038
2039
2040void _ntl_zdoubtoz(double a, _ntl_verylong *xx)
2041{
2042   _ntl_verylong x;
2043   long neg, i, t, sz;
2044
2045
2046   a = floor(a);
2047
2048   if (!_ntl_IsFinite(&a))
2049      zhalt("_ntl_zdoubtoz: attempt to convert non-finite value");
2050
2051
2052   if (a < 0) {
2053      a = -a;
2054      neg = 1;
2055   }
2056   else
2057      neg = 0;
2058
2059   if (a == 0) {
2060      _ntl_zzero(xx);
2061      return;
2062   }
2063
2064   sz = 1;
2065   a = a*NTL_FRADIX_INV;
2066
2067   while (a >= 1) {
2068      a = a*NTL_FRADIX_INV;
2069      sz++;
2070   }
2071         
2072   x = *xx;
2073   if (MustAlloc(x, sz)) {
2074      _ntl_zsetlength(&x, sz);
2075      *xx = x;
2076   }
2077
2078   for (i = sz; i > 0; i--) {
2079      a = a*NTL_FRADIX;
2080      t = (long) a;
2081      x[i] = t;
2082      a = a - t;
2083   }
2084
2085   x[0] = (neg ? -sz : sz);
2086}
2087
2088void _ntl_zzero(_ntl_verylong *aa)
2089{
2090   if (!(*aa)) _ntl_zsetlength(aa, 1);
2091   (*aa)[0] =  1;
2092   (*aa)[1] =  0;
2093}
2094
2095/* same as _ntl_zzero, except does not unnecessarily allocate space */
2096
2097void _ntl_zzero1(_ntl_verylong *aa)
2098{
2099   if (!(*aa)) return;
2100   (*aa)[0] =  1;
2101   (*aa)[1] =  0;
2102}
2103
2104void _ntl_zone(_ntl_verylong *aa)
2105{
2106   if (!(*aa)) _ntl_zsetlength(aa, 1);
2107   (*aa)[0] =  1;
2108   (*aa)[1] =  1;
2109}
2110
2111void _ntl_zcopy(_ntl_verylong a, _ntl_verylong *bb)
2112{
2113   long i;
2114   _ntl_verylong b = *bb;
2115
2116   if (!a) {
2117      _ntl_zzero(bb);
2118      return;
2119   }
2120   if (a != b) {
2121      if ((i = *a) < 0)
2122         i = (-i);
2123      if (MustAlloc(b, i)) {
2124         _ntl_zsetlength(&b, i);
2125         *bb = b;
2126      }
2127      for (; i >= 0; i--)
2128         *b++ = *a++;
2129   }
2130}
2131
2132/* same as _ntl_zcopy, but does not unnecessarily allocate space */
2133
2134void _ntl_zcopy1(_ntl_verylong a, _ntl_verylong *bb)
2135{
2136   long i;
2137   _ntl_verylong b = *bb;
2138
2139   if (!a) {
2140      _ntl_zzero1(bb);
2141      return;
2142   }
2143   if (a != b) {
2144      if ((i = *a) < 0)
2145         i = (-i);
2146      if (MustAlloc(b, i)) {
2147         _ntl_zsetlength(&b, i);
2148         *bb = b;
2149      }
2150      for (; i >= 0; i--)
2151         *b++ = *a++;
2152   }
2153}
2154
2155void _ntl_zintoz(long d, _ntl_verylong *aa)
2156{
2157   long i;
2158   long anegative;
2159   unsigned long d1, d2;
2160   _ntl_verylong a = *aa;
2161
2162   anegative = 0;
2163   if (d < 0) {
2164      anegative = 1;
2165      d1 = - ((unsigned long) d);  /* careful: avoid overflow */
2166   }
2167   else
2168      d1 = d;
2169
2170   i = 0;
2171   d2 = d1;
2172   do {
2173      d2 >>= NTL_NBITS;
2174      i++;
2175   }
2176   while (d2 > 0);
2177
2178   if (MustAlloc(a, i)) {
2179      _ntl_zsetlength(&a, i);
2180      *aa = a;
2181   }
2182
2183   i = 0;
2184   a[1] = 0;
2185   while (d1 > 0) {
2186      a[++i] = d1 & NTL_RADIXM;
2187      d1 >>= NTL_NBITS;
2188   }
2189   if (i > 0)
2190      a[0] = i;
2191   else
2192      a[0] = 1;
2193
2194   if (anegative)
2195      a[0] = (-a[0]);
2196}
2197
2198
2199/* same as _ntl_zintoz, but does not unnecessarily allocate space */
2200
2201void _ntl_zintoz1(long d, _ntl_verylong *aa)
2202{
2203   long i;
2204   long anegative;
2205   unsigned long d1, d2;
2206   _ntl_verylong a = *aa;
2207
2208   if (!d && !a) return;
2209
2210   anegative = 0;
2211   if (d < 0) {
2212      anegative = 1;
2213      d1 = - ((unsigned long) d);  /* careful: avoid overlow */
2214   }
2215   else
2216      d1 = d;
2217
2218   i = 0;
2219   d2 = d1;
2220   do {
2221      d2 >>= NTL_NBITS;
2222      i++;
2223   }
2224   while (d2 > 0);
2225
2226   if (MustAlloc(a, i)) {
2227      _ntl_zsetlength(&a, i);
2228      *aa = a;
2229   }
2230
2231   i = 0;
2232   a[1] = 0;
2233   while (d1 > 0) {
2234      a[++i] = d1 & NTL_RADIXM;
2235      d1 >>= NTL_NBITS;
2236   }
2237   if (i > 0)
2238      a[0] = i;
2239   else
2240      a[0] = 1;
2241
2242   if (anegative)
2243      a[0] = (-a[0]);
2244}
2245
2246
2247void _ntl_zuintoz(unsigned long d, _ntl_verylong *aa)
2248{
2249   long i;
2250   unsigned long d1, d2;
2251   _ntl_verylong a = *aa;
2252
2253   d1 = d;
2254   i = 0;
2255   d2 = d1;
2256   do {
2257      d2 >>= NTL_NBITS;
2258      i++;
2259   }
2260   while (d2 > 0);
2261
2262   if (MustAlloc(a, i)) {
2263      _ntl_zsetlength(&a, i);
2264      *aa = a;
2265   }
2266
2267   i = 0;
2268   a[1] = 0;
2269   while (d1 > 0) {
2270      a[++i] = d1 & NTL_RADIXM;
2271      d1 >>= NTL_NBITS;
2272   }
2273   if (i > 0)
2274      a[0] = i;
2275   else
2276      a[0] = 1;
2277}
2278
2279
2280unsigned long _ntl_ztouint(_ntl_verylong a)
2281{
2282   unsigned long d;
2283   long sa;
2284
2285   if (!a)
2286      return (0);
2287
2288   if ((sa = *a) < 0)
2289      sa = -sa;
2290
2291   d = (unsigned long) (*(a += sa));
2292   while (--sa) {
2293      d <<= NTL_NBITS;
2294      d += (unsigned long) (*(--a));
2295   }
2296
2297   if ((*(--a)) < 0)
2298      return (-d);
2299   return (d);
2300}
2301
2302
2303long _ntl_ztoint(_ntl_verylong a)
2304{
2305   unsigned long res = _ntl_ztouint(a);
2306   return NTL_ULONG_TO_LONG(res);
2307}
2308
2309
2310
2311long _ntl_zcompare(_ntl_verylong a, _ntl_verylong b)
2312{
2313   long sa;
2314   long sb;
2315
2316   if (!a) {
2317      if (!b)
2318         return (0);
2319      if (b[0] < 0)
2320         return (1);
2321      if (b[0] > 1)
2322         return (-1);
2323      if (b[1])
2324         return (-1);
2325      return (0);
2326   }
2327   if (!b) {
2328      if (a[0] < 0)
2329         return (-1);
2330      if (a[0] > 1)
2331         return (1);
2332      if (a[1])
2333         return (1);
2334      return (0);
2335   }
2336
2337   if ((sa = *a) > (sb = *b))
2338      return (1);
2339   if (sa < sb)
2340      return (-1);
2341   if (sa < 0)
2342      sa = (-sa);
2343   a += sa;
2344   b += sa;
2345   for (; sa; sa--) {
2346      long diff = *a - *b;
2347
2348      if (diff > 0) {
2349         if (sb < 0)
2350            return (-1);
2351         return (1);
2352      }
2353      if (diff < 0) {
2354         if (sb < 0)
2355            return (1);
2356         return (-1);
2357      }
2358
2359      a--;
2360      b--;
2361   }
2362   return (0);
2363}
2364
2365void _ntl_znegate(_ntl_verylong *aa)
2366{
2367   _ntl_verylong a = *aa;
2368
2369   if (!a)
2370      return;
2371   if (a[1] || a[0] != 1)
2372      a[0] = (-a[0]);
2373}
2374
2375void _ntl_zsadd(_ntl_verylong a, long d, _ntl_verylong *b)
2376{
2377   static _ntl_verylong x = 0;
2378
2379   _ntl_zintoz(d, &x);
2380   _ntl_zadd(a, x, b);
2381}
2382
2383
2384void
2385_ntl_zadd(_ntl_verylong a, _ntl_verylong b, _ntl_verylong *cc)
2386{
2387   long sa;
2388   long sb;
2389   long anegative;
2390   _ntl_verylong c;
2391   long a_alias, b_alias;
2392
2393   if (!a) {
2394      if (b)
2395         _ntl_zcopy(b, cc);
2396      else
2397         _ntl_zzero(cc);
2398      return;
2399   }
2400
2401   if (!b) {
2402      _ntl_zcopy(a, cc);
2403      return;
2404   }
2405
2406   c = *cc;
2407   a_alias = (a == c);
2408   b_alias = (b == c);
2409
2410   if ((anegative = ((sa = a[0]) < 0)) == ((sb = b[0]) < 0)) {
2411      /* signs a and b are the same */
2412      _ntl_verylong pc;
2413      long carry;
2414      long i;
2415      long maxab;
2416
2417      if (anegative) {
2418         sa = -sa;
2419         sb = -sb;
2420      }
2421
2422      if (sa < sb) {
2423         i = sa;
2424         maxab = sb;
2425      }
2426      else {
2427         i = sb;
2428         maxab = sa;
2429      }
2430
2431      if (MustAlloc(c, maxab+1)) {
2432         _ntl_zsetlength(&c, maxab + 1);
2433         if (a_alias) a = c; 
2434         if (b_alias) b = c; 
2435         *cc = c;
2436      }
2437
2438      pc = c;
2439      carry = 0;
2440
2441      do {
2442         long t = (*(++a)) + (*(++b)) + carry;
2443         carry = t >> NTL_NBITS;
2444         *(++pc) = t & NTL_RADIXM;
2445         i--;
2446      } while (i);
2447
2448      i = sa-sb;
2449      if (!i) goto i_exit;
2450
2451      if (i < 0) {
2452         i = -i;
2453         a = b;
2454      }
2455
2456      if (!carry) goto carry_exit;
2457
2458      for (;;) {
2459         long t = (*(++a)) + 1;
2460         carry = t >> NTL_NBITS;
2461         *(++pc) = t & NTL_RADIXM;
2462         i--;
2463         if (!i) goto i_exit;
2464         if (!carry) goto carry_exit;
2465      }
2466
2467      i_exit:
2468      if (carry) {
2469         *(++pc) = 1;
2470         maxab++;
2471      }
2472      *c = anegative ? -maxab : maxab;
2473      return;
2474
2475      carry_exit:
2476      if (pc != a) {
2477         do {
2478            *(++pc) = *(++a);
2479            i--;
2480         } while (i);
2481      }
2482      *c = anegative ? -maxab : maxab;
2483   }
2484   else {
2485      /* signs a and b are different...use _ntl_zsub */
2486
2487      if (anegative) {
2488         a[0] = -sa;
2489         _ntl_zsub(b, a, cc);
2490         if (!a_alias) a[0] = sa;
2491      }
2492      else {
2493         b[0] = -sb;
2494         _ntl_zsub(a, b, cc);
2495         if (!b_alias) b[0] = sb;
2496      }
2497   }
2498}
2499
2500void
2501_ntl_zsub(_ntl_verylong a, _ntl_verylong b, _ntl_verylong *cc)
2502{
2503   long sa;
2504   long sb;
2505   long anegative;
2506   long a_alias, b_alias;
2507   _ntl_verylong c;
2508
2509   if (!b) {
2510      if (a)
2511         _ntl_zcopy(a, cc);
2512      else
2513         _ntl_zzero(cc);
2514      return;
2515   }
2516
2517   if (!a) {
2518      _ntl_zcopy(b, cc);
2519      _ntl_znegate(cc);
2520      return;
2521   }
2522
2523   c = *cc;
2524   a_alias = (a == c);
2525   b_alias = (b == c);
2526
2527   if ((anegative = ((sa = a[0]) < 0)) == ((sb = b[0]) < 0)) {
2528      /* signs agree */
2529
2530      long i, carry, *pc;
2531
2532      if (anegative) {
2533         sa = -sa;
2534         sb = -sb;
2535      }
2536
2537      carry = sa - sb;
2538      if (!carry) {
2539         long *aa = a + sa;
2540         long *bb = b + sa;
2541         
2542         i = sa;
2543         while (i && !(carry = (*aa - *bb))) {
2544            aa--; bb--; i--;
2545         }
2546      }
2547
2548      if (!carry) {
2549         _ntl_zzero(cc);
2550         return;
2551      }
2552
2553      if (carry < 0) {
2554         { long t = sa; sa = sb; sb = t; }
2555         { long t = a_alias; a_alias = b_alias; b_alias = t; }
2556         { long *t = a; a = b; b = t; }
2557         anegative = !anegative;
2558      }
2559
2560      if (MustAlloc(c, sa)) {
2561         _ntl_zsetlength(&c, sa);
2562         /* must have !a_alias */
2563         if (b_alias) b = c;
2564         *cc = c;
2565      }
2566
2567      i = sb;
2568      carry = 0;
2569      pc = c;
2570
2571      do {
2572#if (!NTL_ARITH_RIGHT_SHIFT || defined(NTL_CLEAN_INT))
2573         long t = (*(++a)) - (*(++b)) - carry;
2574         carry = (t < 0);
2575#else
2576         long t = (*(++a)) - (*(++b)) + carry;
2577         carry = t >> NTL_NBITS;
2578#endif
2579         *(++pc) = t & NTL_RADIXM;
2580         i--;
2581      } while (i);
2582
2583      i = sa-sb;
2584      while (carry) {
2585         long t = (*(++a)) - 1;
2586#if (!NTL_ARITH_RIGHT_SHIFT || defined(NTL_CLEAN_INT))
2587         carry = (t < 0);
2588#else
2589         carry = t >> NTL_NBITS;
2590#endif
2591         *(++pc) = t & NTL_RADIXM;
2592         i--;
2593      }
2594
2595      if (i) {
2596         if (pc != a) {
2597            do {
2598               *(++pc) = *(++a);
2599               i--;
2600            } while (i);
2601         }
2602      }
2603      else {
2604         while (sa > 1 && *pc == 0) { sa--; pc--; } 
2605      }
2606
2607      if (anegative) sa = -sa;
2608      *c = sa;
2609   }
2610   else {
2611      /* signs of a and b are different...use _ntl_zadd */
2612
2613      if (anegative) {
2614         a[0] = -sa;
2615         _ntl_zadd(a, b, cc);
2616         if (!a_alias) a[0] = sa;
2617         c = *cc;
2618         c[0] = -c[0];
2619      }
2620      else {
2621         b[0] = -sb;
2622         _ntl_zadd(a, b, cc);
2623         if (!b_alias) b[0] = sb;
2624      }
2625   }
2626}
2627
2628
2629void
2630_ntl_zsmul(_ntl_verylong a, long d, _ntl_verylong *bb)
2631{
2632   long sa;
2633   long anegative, bnegative;
2634   _ntl_verylong b;
2635   long a_alias;
2636
2637
2638   if (d == 2) {
2639      _ntl_z2mul(a, bb);
2640      return;
2641   }
2642
2643
2644   if ((d >= NTL_RADIX) || (d <= -NTL_RADIX)) {
2645      static _ntl_verylong x = 0;
2646      _ntl_zintoz(d,&x);
2647      _ntl_zmul(a, x, bb);
2648      return;
2649   }
2650
2651   if (!a || (a[0] == 1 && a[1] == 0)) {
2652      _ntl_zzero(bb);
2653      return;
2654   }
2655
2656   if (!d) {
2657      _ntl_zzero(bb);
2658      return;
2659   }
2660
2661   /* both inputs non-zero */
2662
2663   anegative = 0;
2664   bnegative = 0;
2665
2666   if ((sa = a[0]) < 0) {
2667      anegative = 1;
2668      a[0] = sa = (-sa);
2669      if (d < 0)
2670         d = (-d);
2671      else
2672         bnegative = 1;
2673   }
2674   else if (bnegative = (d < 0))
2675      d = (-d);
2676
2677   b = *bb;
2678   a_alias = (a == b);
2679
2680   if (MustAlloc(b, sa + 1)) {
2681      _ntl_zsetlength(&b, sa + 1);
2682      if (a_alias) a = b;
2683      *bb = b;
2684   }
2685
2686   zsxmul(d, b+1, a);
2687
2688   sa++;
2689   while ((sa > 1) && (!(b[sa])))
2690      sa--;
2691   b[0] = sa;
2692
2693   if (bnegative)
2694      b[0] = (-b[0]);
2695
2696   if (anegative && !a_alias)
2697      a[0] = -a[0];
2698}
2699
2700void _ntl_zsubpos(_ntl_verylong a, _ntl_verylong b, _ntl_verylong *cc)
2701{
2702   long sa;
2703   long sb;
2704
2705   long *c, *pc;
2706   long i, carry;
2707
2708   long b_alias;
2709
2710   if (!b) {
2711      if (a)
2712         _ntl_zcopy(a, cc);
2713      else
2714         _ntl_zzero(cc);
2715      return;
2716   }
2717
2718   if (!a) {
2719      _ntl_zzero(cc);
2720      return;
2721   }
2722
2723   sa = a[0];
2724   sb = b[0];
2725
2726   c = *cc;
2727   b_alias = (b == c);
2728
2729   if (MustAlloc(c, sa)) {
2730      _ntl_zsetlength(&c, sa);
2731      if (b_alias) b = c;
2732      *cc = c;
2733   }
2734
2735   i = sb;
2736   carry = 0;
2737   pc = c;
2738
2739   while (i) {
2740#if (!NTL_ARITH_RIGHT_SHIFT || defined(NTL_CLEAN_INT))
2741      long t = (*(++a)) - (*(++b)) - carry;
2742      carry = (t < 0);
2743#else
2744      long t = (*(++a)) - (*(++b)) + carry;
2745      carry = t >> NTL_NBITS;
2746#endif
2747      *(++pc) = t & NTL_RADIXM;
2748      i--;
2749   }
2750
2751   i = sa-sb;
2752   while (carry) {
2753      long t = (*(++a)) - 1;
2754#if (!NTL_ARITH_RIGHT_SHIFT || defined(NTL_CLEAN_INT))
2755      carry = (t < 0);
2756#else
2757      carry = t >> NTL_NBITS;
2758#endif
2759      *(++pc) = t & NTL_RADIXM;
2760      i--;
2761   }
2762
2763   if (i) {
2764      if (pc != a) {
2765         do {
2766            *(++pc) = *(++a);
2767            i--;
2768         } while (i);
2769      }
2770   }
2771   else {
2772      while (sa > 1 && *pc == 0) { sa--; pc--; } 
2773   }
2774
2775   *c = sa;
2776}
2777
2778
2779
2780
2781
2782static long *kmem = 0;     /* globals for Karatsuba */
2783static long max_kmem = 0;
2784
2785
2786/* These cross-over points were estimated using
2787   a Sparc-10, a Sparc-20, and a Pentium-90. */
2788
2789#if (defined(NTL_SINGLE_MUL))
2790#define KARX (18)
2791#else
2792#define KARX (16)
2793#endif
2794
2795/* Auxilliary routines for Karatsuba */
2796
2797
2798static
2799void kar_fold(long *T, long *b, long hsa)
2800{
2801   long sb, *p2, *p3, i, carry;
2802
2803   sb = *b;
2804   p2 = b + hsa;
2805   p3 = T;
2806   carry = 0;
2807
2808   for (i = sb-hsa; i>0; i--) {
2809      long t = (*(++b)) + (*(++p2)) + carry;
2810      carry = t >> NTL_NBITS;
2811      *(++p3) = t & NTL_RADIXM;
2812   }
2813
2814   for (i = (hsa << 1) - sb; i>0; i--) {
2815      long t = (*(++b)) + carry;
2816      carry = t >> NTL_NBITS;
2817      *(++p3) = t & NTL_RADIXM;
2818   }
2819
2820   if (carry) {
2821      *(++p3) = carry;
2822      *T = hsa + 1;
2823   }
2824   else
2825      *T = hsa;
2826}
2827
2828static
2829void kar_sub(long *T, long *c)
2830{
2831   long i, carry;
2832
2833   i = *c;
2834   carry = 0;
2835
2836   while (i>0) {
2837#if (!NTL_ARITH_RIGHT_SHIFT || defined(NTL_CLEAN_INT))
2838      long t = (*(++T)) - (*(++c)) - carry;
2839      carry = (t < 0);
2840#else
2841      long t = (*(++T)) - (*(++c)) + carry;
2842      carry = t >> NTL_NBITS;
2843#endif
2844      *T = t & NTL_RADIXM;
2845      i--;
2846   }
2847
2848   while (carry) {
2849      long t = (*(++T)) - 1;
2850#if (!NTL_ARITH_RIGHT_SHIFT || defined(NTL_CLEAN_INT))
2851      carry = (t < 0);
2852#else
2853      carry = t >> NTL_NBITS;
2854#endif
2855      *T = t & NTL_RADIXM;
2856   }
2857}
2858
2859
2860static
2861void kar_add(long *c, long *T, long hsa)
2862{
2863   long i, carry;
2864
2865   c += hsa;
2866   i = *T;
2867   while (T[i] == 0 && i > 0) i--;
2868   carry = 0;
2869
2870   while (i>0) {
2871      long t = (*(++c)) + (*(++T)) + carry;
2872      carry = t >> NTL_NBITS;
2873      *c = t & NTL_RADIXM;
2874      i--;
2875   }
2876
2877   while (carry) {
2878      long t = (*(++c)) + 1;
2879      carry = t >> NTL_NBITS;
2880      *c = t & NTL_RADIXM;
2881   }
2882}
2883
2884static
2885void kar_fix(long *c, long *T, long hsa)
2886{
2887   long i, carry, s;
2888
2889   s = *T;
2890
2891   i = hsa;
2892   while (i>0) {
2893      *(++c) = *(++T);
2894      i--;
2895   }
2896
2897
2898   i = s - hsa;
2899   carry = 0;
2900
2901   while (i > 0) {
2902      long t = (*(++c)) + (*(++T)) + carry;
2903      carry = t >> NTL_NBITS;
2904      *c = t & NTL_RADIXM;
2905      i--;
2906   }
2907
2908   while (carry) {
2909      long t = (*(++c)) + 1;
2910      carry = t >> NTL_NBITS;
2911      *c = t & NTL_RADIXM;
2912   }
2913}
2914     
2915   
2916
2917static
2918void kar_mul(long *c, long *a, long *b, long *stk)
2919{
2920   long sa, sb, sc;
2921
2922   if (*a < *b) { long *t = a; a = b; b = t; }
2923
2924   sa = *a;
2925   sb = *b;
2926   sc = sa + sb;
2927
2928   if (sb < KARX) {
2929      /* classic algorithm */
2930
2931      long *pc, i, *pb;
2932
2933      pc = c;
2934      for (i = sc; i; i--) {
2935         pc++;
2936         *pc = 0;
2937      }
2938   
2939      pc = c;
2940      pb = b;
2941      for (i = sb; i; i--) {
2942         pb++;
2943         pc++;
2944         zaddmul(*pb, pc, a);
2945      }
2946   }
2947   else {
2948      long hsa = (sa + 1) >> 1;
2949
2950      if (hsa < sb) {
2951         /* normal case */
2952
2953         long *T1, *T2, *T3;
2954
2955         /* allocate space */
2956
2957         T1 = stk;  stk += hsa + 2;
2958         T2 = stk;  stk += hsa + 2;
2959         T3 = stk;  stk += (hsa << 1) + 3;
2960
2961         if (stk-kmem > max_kmem) zhalt("internal error: kmem overflow");
2962
2963         /* compute T1 = a_lo + a_hi */
2964
2965         kar_fold(T1, a, hsa);
2966
2967         /* compute T2 = b_lo + b_hi */
2968
2969         kar_fold(T2, b, hsa);
2970         
2971         /* recursively compute T3 = T1 * T2 */
2972
2973         kar_mul(T3, T1, T2, stk);
2974
2975         /* recursively compute a_hi * b_hi into high part of c */
2976         /* and subtract from T3 */
2977
2978         {
2979            long olda, oldb;
2980
2981            olda = a[hsa];  a[hsa] = sa-hsa;
2982            oldb = b[hsa];  b[hsa] = sb-hsa;
2983
2984            kar_mul(c + (hsa << 1), a + hsa, b + hsa, stk);
2985            kar_sub(T3, c + (hsa << 1));
2986
2987            a[hsa] = olda;
2988            b[hsa] = oldb;
2989         }
2990
2991         /* recursively compute a_lo*b_lo into low part of c */
2992         /* and subtract from T3 */
2993
2994         *a = hsa;
2995         *b = hsa;
2996
2997         kar_mul(c, a, b, stk);
2998         kar_sub(T3, c);
2999
3000         *a = sa;
3001         *b = sb;
3002
3003         /* finally, add T3 * NTL_RADIX^{hsa} to c */
3004
3005         kar_add(c, T3, hsa);
3006      }
3007      else {
3008         /* degenerate case */
3009
3010         long *T;
3011         
3012         T = stk;  stk += sb + hsa + 1;
3013
3014         if (stk-kmem > max_kmem) zhalt("internal error: kmem overflow");
3015
3016         /* recursively compute b*a_hi into high part of c */
3017         {
3018            long olda;
3019
3020            olda = a[hsa];  a[hsa] = sa-hsa;
3021            kar_mul(c + hsa, a + hsa, b, stk);
3022            a[hsa] = olda;
3023         }
3024
3025         /* recursively compute b*a_lo into T */
3026
3027         *a = hsa;
3028         kar_mul(T, a, b, stk);
3029         *a = sa;
3030
3031         /* fix-up result */
3032
3033         kar_fix(c, T, hsa);
3034      }
3035   }
3036
3037   /* normalize result */
3038
3039   while (c[sc] == 0 && sc > 1) sc--;
3040   *c = sc;
3041}
3042
3043
3044
3045#if (defined(NTL_SINGLE_MUL))
3046#define KARSX (36)
3047#else
3048#define KARSX (32)
3049#endif
3050
3051static
3052void kar_sq(long *c, long *a, long *stk)
3053{
3054   long sa, sc;
3055
3056   sa = *a;
3057   sc = sa << 1;
3058
3059   if (sa < KARSX) {
3060      /* classic algorithm */
3061
3062      long carry, i, j, *pc;
3063
3064      pc = c;
3065      for (i = sc; i; i--) {
3066         pc++;
3067         *pc = 0;
3068      }
3069
3070      carry = 0;
3071      i = 0;
3072      for (j = 1; j <= sa; j++) {
3073         unsigned long uncar;
3074         long t;
3075
3076         i += 2;
3077         uncar = ((unsigned long) carry) + (((unsigned long) c[i-1]) << 1);
3078         t = uncar & NTL_RADIXM;
3079         zaddmulpsq(t, a[j], carry);
3080         c[i-1] = t;
3081         zaddmulsq(sa-j, c+i, a+j);
3082         uncar =  (uncar >> NTL_NBITS) + (((unsigned long) c[i]) << 1);
3083         uncar += ((unsigned long) carry);
3084         carry = uncar >> NTL_NBITS;
3085         c[i] = uncar & NTL_RADIXM;
3086      }
3087   }
3088   else {
3089      long hsa = (sa + 1) >> 1;
3090      long *T1, *T2, olda;
3091
3092      T1 = stk;  stk += hsa + 2;
3093      T2 = stk;  stk += (hsa << 1) + 3;
3094
3095      if (stk-kmem > max_kmem) zhalt("internal error: kmem overflow");
3096
3097      kar_fold(T1, a, hsa);
3098      kar_sq(T2, T1, stk);
3099
3100      olda = a[hsa];  a[hsa] = sa - hsa;
3101      kar_sq(c + (hsa << 1), a + hsa, stk);
3102      kar_sub(T2, c + (hsa << 1));
3103      a[hsa] = olda;
3104
3105      *a = hsa;
3106      kar_sq(c, a, stk);
3107      kar_sub(T2, c);
3108      *a = sa;
3109
3110      kar_add(c, T2, hsa);
3111   }
3112
3113   while (c[sc] == 0 && sc > 1) sc--;
3114   *c = sc;
3115}
3116
3117
3118void _ntl_zmul(_ntl_verylong a, _ntl_verylong b, _ntl_verylong *cc)
3119{
3120   static _ntl_verylong mem = 0;
3121   _ntl_verylong c = *cc;
3122
3123   if (!a || (a[0] == 1 && a[1] == 0) || !b || (b[0] == 1 && b[1] == 0)) {
3124      _ntl_zzero(cc);
3125      return;
3126   }
3127
3128   if (a == b) {
3129      if (a == c) {
3130         _ntl_zcopy(a, &mem);
3131         a = mem;
3132      }
3133
3134      _ntl_zsq(a, cc);
3135   }
3136   else {
3137      long aneg, bneg, sa, sb, sc;
3138
3139      if (a == c) {
3140         _ntl_zcopy(a, &mem);
3141         a = mem;
3142      }
3143      else if (b == c) {
3144         _ntl_zcopy(b, &mem);
3145         b = mem;
3146      }
3147
3148      sa = *a;
3149      if (sa < 0) {
3150         *a = sa = -sa;
3151         aneg = 1;
3152      }
3153      else
3154         aneg = 0;
3155
3156      sb = *b;
3157      if (*b < 0) {
3158         *b = sb =  -sb;
3159         bneg = 1;
3160      }
3161      else
3162         bneg = 0;
3163
3164      sc = sa + sb;
3165      if (MustAlloc(c, sc)) {
3166         _ntl_zsetlength(&c, sc);
3167         *cc = c;
3168      }
3169
3170      /* we optimize for *very* small numbers,
3171       * avoiding all function calls and loops */
3172
3173      if (sa <= 3 && sb <= 3) {
3174         long carry, d;
3175
3176         switch (sa) {
3177         case 1:
3178            switch (sb) {
3179            case 1:
3180               carry = 0;
3181               zxmulp(c[1], a[1], b[1], carry);
3182               c[2] = carry;
3183               break;
3184            case 2:
3185               carry = 0;
3186               d = a[1];
3187               zxmulp(c[1], b[1], d, carry);
3188               zxmulp(c[2], b[2], d, carry);
3189               c[3] = carry;
3190               break;
3191            case 3:
3192               carry = 0;
3193               d = a[1];
3194               zxmulp(c[1], b[1], d, carry);
3195               zxmulp(c[2], b[2], d, carry);
3196               zxmulp(c[3], b[3], d, carry);
3197               c[4] = carry;
3198               break;
3199            }
3200            break;
3201
3202         case 2:
3203            switch (sb) {
3204            case 1:
3205               carry = 0;
3206               d = b[1];
3207               zxmulp(c[1], a[1], d, carry);
3208               zxmulp(c[2], a[2], d, carry);
3209               c[3] = carry;
3210               break;
3211            case 2:
3212               carry = 0;
3213               d = b[1];
3214               zxmulp(c[1], a[1], d, carry);
3215               zxmulp(c[2], a[2], d, carry);
3216               c[3] = carry;
3217               carry = 0;
3218               d = b[2];
3219               zaddmulp(c[2], a[1], d, carry);
3220               zaddmulp(c[3], a[2], d, carry);
3221               c[4] = carry;
3222               break;
3223             case 3:
3224               carry = 0;
3225               d = a[1];
3226               zxmulp(c[1], b[1], d, carry);
3227               zxmulp(c[2], b[2], d, carry);
3228               zxmulp(c[3], b[3], d, carry);
3229               c[4] = carry;
3230               carry = 0;
3231               d = a[2];
3232               zaddmulp(c[2], b[1], d, carry);
3233               zaddmulp(c[3], b[2], d, carry);
3234               zaddmulp(c[4], b[3], d, carry);
3235               c[5] = carry;
3236               break;
3237            }
3238            break;
3239
3240         case 3:
3241            switch (sb) {
3242            case 1:
3243               carry = 0;
3244               d = b[1];
3245               zxmulp(c[1], a[1], d, carry);
3246               zxmulp(c[2], a[2], d, carry);
3247               zxmulp(c[3], a[3], d, carry);
3248               c[4] = carry;
3249               break;
3250            case 2:
3251               carry = 0;
3252               d = b[1];
3253               zxmulp(c[1], a[1], d, carry);
3254               zxmulp(c[2], a[2], d, carry);
3255               zxmulp(c[3], a[3], d, carry);
3256               c[4] = carry;
3257               carry = 0;
3258               d = b[2];
3259               zaddmulp(c[2], a[1], d, carry);
3260               zaddmulp(c[3], a[2], d, carry);
3261               zaddmulp(c[4], a[3], d, carry);
3262               c[5] = carry;
3263               break;
3264            case 3:
3265               carry = 0;
3266               d = b[1];
3267               zxmulp(c[1], a[1], d, carry);
3268               zxmulp(c[2], a[2], d, carry);
3269               zxmulp(c[3], a[3], d, carry);
3270               c[4] = carry;
3271               carry = 0;
3272               d = b[2];
3273               zaddmulp(c[2], a[1], d, carry);
3274               zaddmulp(c[3], a[2], d, carry);
3275               zaddmulp(c[4], a[3], d, carry);
3276               c[5] = carry;
3277               carry = 0;
3278               d = b[3];
3279               zaddmulp(c[3], a[1], d, carry);
3280               zaddmulp(c[4], a[2], d, carry);
3281               zaddmulp(c[5], a[3], d, carry);
3282               c[6] = carry;
3283               break;
3284            }
3285         }
3286
3287         if (c[sc] == 0) sc--;
3288         if (aneg != bneg) sc = -sc;
3289         *c = sc;
3290         if (aneg) *a = -sa;
3291         if (bneg) *b = -sb;
3292
3293         return;
3294         
3295      }
3296
3297
3298#ifdef NTL_GMP_HACK
3299
3300      if (_ntl_gmp_hack && sa >= NTL_GMP_MUL_CROSS && sb >= NTL_GMP_MUL_CROSS) {
3301         long gsa = L_TO_G(sa); 
3302         long gsb = L_TO_G(sb);
3303
3304         mp_limb_t *a_p, *b_p, *c_p, *end_p;
3305
3306         NTL_GSPACE((gsa + gsb) << 1);
3307         a_p = gspace_data;
3308         b_p = a_p + gsa;
3309         c_p = b_p + gsb;
3310         end_p = c_p + (gsa + gsb);
3311
3312         lip_to_gmp(a+1, a_p, sa);
3313         lip_to_gmp(b+1, b_p, sb); 
3314
3315         if (!a_p[gsa-1]) gsa--;
3316         if (!b_p[gsb-1]) gsb--;
3317         end_p[-1] = 0;
3318         end_p[-2] = 0;
3319
3320         if (gsa >= gsb)
3321            mpn_mul(c_p, a_p, gsa, b_p, gsb);
3322         else
3323            mpn_mul(c_p, b_p, gsb, a_p, gsa);
3324
3325         gmp_to_lip(c+1, c_p, sc);
3326
3327         if (!c[sc]) sc--; 
3328         if (aneg != bneg) sc = -sc;
3329         c[0] = sc;
3330         if (aneg) *a = - *a;
3331         if (bneg) *b = - *b;
3332         return;
3333      }
3334
3335
3336
3337#endif
3338
3339      if (*a < KARX || *b < KARX) {
3340         /* classic algorithm */
3341
3342         long i, *pc;
3343
3344         pc = c;
3345         for (i = sc; i; i--) {
3346            pc++;
3347            *pc = 0;
3348         }
3349   
3350         pc = c;
3351   
3352         if (*a >= *b) {
3353            long *pb = b;
3354            for (i = *pb; i; i--) {
3355               pb++;
3356               pc++;
3357               zaddmul(*pb, pc, a);
3358            }
3359         }
3360         else {
3361            long *pa = a;
3362            for (i = *pa; i; i--) {
3363               pa++; 
3364               pc++;
3365               zaddmul(*pa, pc, b);
3366            }
3367         }
3368
3369         while (c[sc] == 0 && sc > 1) sc--;
3370         if (aneg != bneg) sc = -sc;
3371         c[0] = sc;
3372         if (aneg) *a = - *a;
3373         if (bneg) *b = - *b;
3374      }
3375      else {
3376         /* karatsuba */
3377
3378         long n, hn, sp;
3379
3380         if (*a < *b)
3381            n = *b;
3382         else
3383            n = *a;
3384
3385         sp = 0;
3386         do {
3387            hn = (n + 1) >> 1;
3388            sp += (hn << 2) + 7;
3389            n = hn+1;
3390         } while (n >= KARX);
3391
3392         if (sp > max_kmem) {
3393            if (max_kmem == 0) 
3394               kmem = (long *) NTL_MALLOC(sp, sizeof(long), 0);
3395            else
3396               kmem = (long *) NTL_REALLOC(kmem, sp, sizeof(long), 0);
3397
3398            max_kmem = sp;
3399            if (!kmem) zhalt("out of memory in karatsuba");
3400         }
3401
3402         kar_mul(c, a, b, kmem);
3403         if (aneg != bneg) *c = - *c;
3404         if (aneg) *a = - *a;
3405         if (bneg) *b = - *b;
3406      }
3407   }
3408}
3409
3410
3411void _ntl_zsq(_ntl_verylong a, _ntl_verylong *cc)
3412{
3413   static _ntl_verylong mem = 0;
3414   _ntl_verylong c = *cc;
3415   long sa, aneg, sc;
3416
3417   if (!a || (a[0] == 1 && a[1] == 0)) {
3418      _ntl_zzero(cc);
3419      return;
3420   }
3421
3422   if (a == c) {
3423      _ntl_zcopy(a, &mem);
3424      a = mem;
3425   }
3426
3427   sa = *a;
3428
3429   if (*a < 0) {
3430      *a = sa = -sa;
3431      aneg = 1;
3432   }
3433   else
3434      aneg = 0;
3435
3436   sc = (sa) << 1;
3437   if (MustAlloc(c, sc)) {
3438      _ntl_zsetlength(&c, sc);
3439      *cc = c;
3440   }
3441
3442   if (sa <= 3) {
3443      long carry, d;
3444
3445      switch (sa) {
3446      case 1:
3447         carry = 0;
3448         zxmulp(c[1], a[1], a[1], carry);
3449         c[2] = carry;
3450         break;
3451
3452      case 2:
3453         carry = 0;
3454         d = a[1];
3455         zxmulp(c[1], a[1], d, carry);
3456         zxmulp(c[2], a[2], d, carry);
3457         c[3] = carry;
3458         carry = 0;
3459         d = a[2];
3460         zaddmulp(c[2], a[1], d, carry);
3461         zaddmulp(c[3], a[2], d, carry);
3462         c[4] = carry;
3463         break;
3464
3465      case 3:
3466         carry = 0;
3467         d = a[1];
3468         zxmulp(c[1], a[1], d, carry);
3469         zxmulp(c[2], a[2], d, carry);
3470         zxmulp(c[3], a[3], d, carry);
3471         c[4] = carry;
3472         carry = 0;
3473         d = a[2];
3474         zaddmulp(c[2], a[1], d, carry);
3475         zaddmulp(c[3], a[2], d, carry);
3476         zaddmulp(c[4], a[3], d, carry);
3477         c[5] = carry;
3478         carry = 0;
3479         d = a[3];
3480         zaddmulp(c[3], a[1], d, carry);
3481         zaddmulp(c[4], a[2], d, carry);
3482         zaddmulp(c[5], a[3], d, carry);
3483         c[6] = carry;
3484         break;
3485      }
3486
3487      if (c[sc] == 0) sc--;
3488      *c = sc;
3489      if (aneg) *a = -sa;
3490
3491      return;
3492   }
3493
3494#ifdef NTL_GMP_HACK
3495
3496      if (_ntl_gmp_hack && sa >= NTL_GMP_SQR_CROSS) {
3497         long gsa = L_TO_G(sa); 
3498
3499         mp_limb_t *a_p, *c_p, *end_p;;
3500
3501         NTL_GSPACE(gsa + gsa + gsa);
3502         a_p = gspace_data;
3503         c_p = a_p + gsa;
3504         end_p = c_p + (gsa + gsa);
3505
3506         lip_to_gmp(a+1, a_p, sa);
3507
3508         if (!a_p[gsa-1]) gsa--;
3509         end_p[-1] = 0;
3510         end_p[-2] = 0;
3511
3512         mpn_mul(c_p, a_p, gsa, a_p, gsa);
3513
3514         gmp_to_lip(c+1, c_p, sc);
3515
3516         if (!c[sc]) sc--; 
3517         c[0] = sc;
3518         if (aneg) *a = - *a;
3519         return;
3520      }
3521
3522
3523#endif
3524
3525   if (sa < KARSX) {
3526      /* classic algorithm */
3527
3528      long carry, i, j, *pc;
3529
3530      pc = c;
3531      for (i = sc; i; i--) {
3532         pc++;
3533         *pc = 0;
3534      }
3535
3536      carry = 0;
3537      i = 0;
3538      for (j = 1; j <= sa; j++) {
3539         unsigned long uncar;
3540         long t;
3541
3542         i += 2;
3543         uncar = ((unsigned long) carry) + (((unsigned long) c[i-1]) << 1);
3544         t = uncar & NTL_RADIXM;
3545         zaddmulpsq(t, a[j], carry);
3546         c[i-1] = t;
3547         zaddmulsq(sa-j, c+i, a+j);
3548         uncar =  (uncar >> NTL_NBITS) + (((unsigned long) c[i]) << 1);
3549         uncar += ((unsigned long) carry);
3550         carry = uncar >> NTL_NBITS;
3551         c[i] = uncar & NTL_RADIXM;
3552      }
3553
3554
3555      while (c[sc] == 0 && sc > 1) sc--;
3556      c[0] = sc;
3557      if (aneg) *a = - *a;
3558   }
3559   else {
3560      /* karatsuba */
3561
3562      long n, hn, sp;
3563
3564      n = *a;
3565
3566      sp = 0;
3567      do {
3568         hn = (n + 1) >> 1;
3569         sp += hn + hn + hn + 5;
3570         n = hn+1;
3571      } while (n >= KARSX);
3572
3573      if (sp > max_kmem) {
3574         if (max_kmem == 0) 
3575            kmem = (long *) NTL_MALLOC(sp, sizeof(long), 0);
3576         else
3577            kmem = (long *) NTL_REALLOC(kmem, sp, sizeof(long), 0);
3578
3579         max_kmem = sp;
3580         if (!kmem) zhalt("out of memory in karatsuba");
3581      }
3582
3583      kar_sq(c, a, kmem);
3584      if (aneg) *a = - *a;
3585   }
3586}
3587
3588
3589
3590
3591long _ntl_zsdiv(_ntl_verylong a, long d, _ntl_verylong *bb)
3592{
3593   long sa;
3594   _ntl_verylong b = *bb;
3595
3596   if (!d) {
3597      zhalt("division by zero in _ntl_zsdiv");
3598   }
3599
3600   if (!a) {
3601      _ntl_zzero(bb);
3602      return (0);
3603   }
3604
3605
3606   if (d == 2) {
3607      long is_odd = a[1] & 1;
3608      long fix = (a[0] < 0) & is_odd;
3609      _ntl_zrshift(a, 1, bb);
3610      if (fix) _ntl_zsadd(*bb, -1, bb);
3611      return is_odd;
3612   } 
3613
3614
3615   if ((sa = a[0]) < 0)
3616      sa = (-sa);
3617
3618   /* if b aliases a, then b won't move */
3619   _ntl_zsetlength(&b, sa);
3620   *bb = b;
3621
3622   if ((d >= NTL_RADIX) || (d <= -NTL_RADIX)) {
3623      static _ntl_verylong zd = 0;
3624      static _ntl_verylong zb = 0;
3625
3626      _ntl_zintoz(d, &zb);
3627      _ntl_zdiv(a, zb, &b, &zd);
3628      *bb = b;
3629      return (_ntl_ztoint(zd));
3630   }
3631   else {
3632      long den = d;
3633      double deninv;
3634      long carry = 0;
3635      long i;
3636      long flag = (*a < 0 ? 2 : 0) | (den < 0 ? 1 : 0);
3637
3638      if (den < 0)
3639         den = -den;
3640      deninv = 1.0 / ((double) den);
3641
3642      if (a[sa] < den && sa > 1)
3643         carry = a[sa--];
3644
3645      for (i = sa; i; i--) {
3646         zdiv21(carry, a[i], den, deninv, b[i]);
3647      }
3648
3649      while ((sa > 1) && (!(b[sa])))
3650         sa--;
3651      b[0] = sa;
3652
3653      if (flag) {
3654         if (flag <= 2) {
3655            if (!carry)
3656               _ntl_znegate(&b);
3657            else {
3658               _ntl_zsadd(b, 1, &b);
3659               b[0] = -b[0];
3660               if (flag == 1)
3661                  carry = carry - den;
3662               else
3663                  carry = den - carry;
3664               *bb = b;
3665            }
3666         }
3667         else
3668            carry = -carry;
3669      }
3670
3671      return (carry);
3672   }
3673}
3674
3675long _ntl_zsmod(_ntl_verylong a, long d)
3676{
3677   long sa;
3678
3679   if (!a) {
3680      return (0);
3681   }
3682
3683   if (d == 2) return (a[1] & 1);
3684
3685   if (!d) {
3686      zhalt("division by zero in _ntl_zsdiv");
3687   }
3688
3689   if ((sa = a[0]) < 0)
3690      sa = (-sa);
3691
3692   if ((d >= NTL_RADIX) || (d <= -NTL_RADIX)) {
3693      static _ntl_verylong zd = 0;
3694      static _ntl_verylong zb = 0;
3695
3696      _ntl_zintoz(d, &zb);
3697      _ntl_zmod(a, zb, &zd);
3698      return (_ntl_ztoint(zd));
3699   }
3700   else {
3701      long den = d;
3702      double deninv;
3703      long carry = 0;
3704      long i;
3705      long flag = (*a < 0 ? 2 : 0) | (den < 0 ? 1 : 0);
3706
3707      if (den < 0)
3708         den = -den;
3709      deninv = 1.0 / ((double) den);
3710
3711      if (a[sa] < den && sa > 1)
3712         carry = a[sa--];
3713
3714      for (i = sa; i; i--) {
3715         zrem21(carry, a[i], den, deninv);
3716      }
3717
3718      if (flag) {
3719         if (flag <= 2) {
3720            if (carry) {
3721               if (flag == 1)
3722                  carry = carry - den;
3723               else
3724                  carry = den - carry;
3725            }
3726         }
3727         else
3728            carry = -carry;
3729      }
3730
3731      return (carry);
3732   }
3733}
3734
3735void _ntl_zmultirem(_ntl_verylong a, long n, long* dd, long *rr)
3736{
3737   long j;
3738   long sa;
3739
3740   if (!a || (a[0] == 1 && a[1] == 0)) {
3741      for (j = 0; j < n; j++) rr[j] = 0;
3742      return;
3743   }
3744
3745   sa = a[0];
3746
3747   for (j = 0; j < n; j++) {
3748      long den = dd[j];
3749      double deninv;
3750      long carry = 0;
3751      long i;
3752      long lsa = sa;
3753
3754      deninv = 1.0 / ((double) den);
3755
3756      if (a[lsa] < den && lsa > 1)
3757         carry = a[lsa--];
3758
3759      for (i = lsa; i; i--) {
3760         zrem21(carry, a[i], den, deninv);
3761      }
3762
3763      rr[j] = carry;
3764   }
3765}
3766
3767
3768
3769
3770#if (defined(NTL_SINGLE_MUL))
3771
3772#define REDUCE_CROSS 8
3773
3774void _ntl_zmultirem2(_ntl_verylong a, long n, long* dd, double **ttbl, long *rr)
3775
3776{
3777   long d; 
3778   double *tbl;
3779   long ac0, ac1, ac2;
3780   long *ap; 
3781   double *tp;
3782   long sa, i, j, k;
3783   unsigned long pc0, pc1, lo_wd, hi_wd;
3784   long carry;
3785   double xx, yy, dinv;
3786
3787   if (!a ||  a[0] < REDUCE_CROSS || a[0] >= NTL_RADIX) {
3788      _ntl_zmultirem(a, n, dd, rr);
3789      return;
3790   }
3791
3792   sa = a[0];
3793
3794   for (i = 0; i < n; i++) {
3795      d = dd[i];
3796      tbl = ttbl[i];
3797
3798      ac0 = a[1];
3799      ac1 = 0;
3800      ac2 = 0;
3801
3802      ap = &a[2];
3803      tp = &tbl[1];
3804
3805      k = sa-1;
3806      while (k) {
3807         j = k;
3808         if (j > 64) j = 64;
3809         k -= j;
3810
3811         pc0 = 0;
3812         pc1 = 0;
3813
3814         xx =  ((double) (*ap++))* (*tp++) + DENORMALIZE;
3815         for (; j > 1; j--) {
3816            yy =  ((double) (*ap++))*(*tp++) 
3817                  + DENORMALIZE;
3818            NTL_FetchHiLo(hi_wd, lo_wd, xx);
3819            pc0 +=  lo_wd & 0x3FFFFFF;
3820            pc1 += ((hi_wd<<6)|(lo_wd>>26)) & 0x3FFFFFF;
3821            xx = yy;
3822         }
3823         NTL_FetchHiLo(hi_wd, lo_wd, xx);
3824         pc0 +=  lo_wd & 0x3FFFFFF;
3825         pc1 += ((hi_wd<<6)|(lo_wd>>26)) & 0x3FFFFFF;
3826         pc1 += (pc0 >> 26);
3827
3828         ac0 += (pc0 & 0x3FFFFFF);
3829         if (ac0 > NTL_RADIX) {
3830            ac0 -= NTL_RADIX;
3831            carry = 1;
3832         }
3833         else
3834            carry = 0;
3835
3836         ac1 += carry + (pc1 & 0x3FFFFFF);
3837         if (ac1 > NTL_RADIX) {
3838            ac1 -= NTL_RADIX;
3839            carry = 1;
3840         }
3841         else
3842            carry = 0;
3843
3844         ac2 += carry + (pc1 >> 26);
3845      }
3846
3847      carry = 0;
3848      dinv = ((double) 1)/((double) d);
3849      if (ac2 >= d) {
3850         zrem21(carry, ac2, d, dinv);
3851      }
3852      else
3853         carry = ac2;
3854
3855      zrem21(carry, ac1, d, dinv);
3856      zrem21(carry, ac0, d, dinv);
3857
3858      rr[i] = carry;
3859   }
3860}
3861
3862
3863#elif (defined(NTL_TBL_REM))
3864
3865void _ntl_zmultirem3(_ntl_verylong a, long n, long* dd, long **ttbl, long *rr)
3866{
3867   long sa, i, d, *tbl, ac0, ac1, ac2, *ap, *tp, k, t, carry;
3868   double dinv;
3869
3870   if (!a || a[0] < 8 || a[0] >= NTL_RADIX) {
3871      _ntl_zmultirem(a, n, dd, rr);
3872      return;
3873   }
3874
3875   sa = a[0];
3876 
3877   for (i = 0; i < n; i++) {
3878      d = dd[i];
3879      tbl = ttbl[i];
3880      ac0 = a[1];
3881      ac1 = 0;
3882      ac2 = 0;
3883      ap = &a[2];
3884      tp = &tbl[1];
3885      k = sa-1;
3886     
3887      while (k) {
3888         zxmulp(t, *ap, *tp, ac0);
3889         ac1 += ac0;
3890         ac2 += ac1 >> NTL_NBITS;
3891         ac1 &= NTL_RADIXM;
3892         ac0 = t;
3893         k--;
3894         ap++;
3895         tp++;
3896      }
3897
3898      carry = 0;
3899      dinv = ((double) 1)/((double) d);
3900      if (ac2 >= d) {
3901         zrem21(carry, ac2, d, dinv);
3902      }
3903      else
3904         carry = ac2;
3905
3906      zrem21(carry, ac1, d, dinv);
3907      zrem21(carry, ac0, d, dinv);
3908
3909      rr[i] = carry;
3910   }
3911}
3912
3913#endif
3914
3915
3916
3917
3918long _ntl_zsfastrem(_ntl_verylong a, long d)
3919/* assumes a >= 0, and 0 < d < NTL_RADIX */
3920/* computes a % d */
3921
3922{
3923   long sa;
3924
3925   if (!a || (a[0] == 1 && a[1] == 0)) {
3926      return 0;
3927   }
3928
3929   sa = a[0];
3930
3931   {
3932      long den = d;
3933      double deninv = ((double)1)/((double)den);
3934      long carry = 0;
3935      long i;
3936      long lsa = sa;
3937
3938      if (a[lsa] < den && lsa > 1)
3939         carry = a[lsa--];
3940      for (i = lsa; i; i--) {
3941         zrem21(carry, a[i], den, deninv);
3942      }
3943      return carry;
3944   }
3945}
3946
3947
3948
3949void _ntl_zdiv(_ntl_verylong a, _ntl_verylong b, _ntl_verylong *qq, _ntl_verylong *rr)
3950{
3951   long sa, sb, sq, i;
3952   long sign;
3953   long q1;
3954   long *rp;
3955   double btopinv, aux;
3956   static _ntl_verylong q=0, r=0;
3957
3958   if (!b || (((sb=b[0]) == 1) && (!b[1]))) {
3959      zhalt("division by zero in _ntl_zdiv");
3960   }
3961
3962   if (!a || (((sa=a[0]) == 1) && (!a[1]))) {
3963      _ntl_zzero(qq);
3964      if (rr) _ntl_zzero(rr);
3965      return;
3966   }
3967
3968
3969   if (sb == 1) {
3970      long t1 = _ntl_zsdiv(a, b[1], qq);
3971      if (rr) _ntl_zintoz(t1, rr);
3972      return;
3973   }
3974
3975   if (sb == -1) {
3976      long t1 = _ntl_zsdiv(a, -b[1], qq);
3977      if (rr) _ntl_zintoz(t1, rr);
3978      return;
3979   }
3980
3981   sign = 0;
3982   if (sa < 0) {
3983      a[0] = sa = -sa;
3984      sign = 2;
3985   }
3986
3987   if (sb < 0) {
3988      b[0] = sb = -sb;
3989      sign |= 1;
3990   }
3991
3992
3993   sq = sa-sb+1;
3994
3995   if (sq <= 0) {
3996      _ntl_zcopy(a, &r);
3997      _ntl_zzero(&q);
3998      goto done;
3999   }
4000
4001#ifdef NTL_GMP_HACK
4002   if (_ntl_gmp_hack && sb >= NTL_GMP_DIV_CROSS && sq >= NTL_GMP_DIV_CROSS) {
4003      GT_INIT
4004
4005      lip_to_mpz(a, gt_1);
4006      lip_to_mpz(b, gt_2);
4007      mpz_fdiv_qr(gt_3, gt_4, gt_1, gt_2);
4008      mpz_to_lip(&q, gt_3);
4009      mpz_to_lip(&r, gt_4);
4010
4011      goto done;
4012   }
4013#endif
4014
4015   _ntl_zsetlength(&q, sq);
4016   _ntl_zsetlength(&r, sa+1);
4017 
4018   _ntl_zcopy(a, &r);
4019   rp = &r[sa+1];
4020   *rp = 0;
4021
4022   r[0] = 0; /* this streamlines the last evaluation of aux */
4023
4024   btopinv = b[sb]*NTL_FRADIX + b[sb-1];
4025   if (sb > 2) 
4026      btopinv = NTL_FRADIX / (btopinv*NTL_FRADIX + b[sb-2]);
4027   else
4028      btopinv = 1.0 / btopinv;
4029
4030   
4031   aux = btopinv*(rp[-1]*NTL_FRADIX + rp[-2]);
4032   if (aux >= NTL_FRADIX)
4033      aux = NTL_FRADIX-1;
4034
4035   for (i = sq; i >= 1; i--, rp--) {
4036      q1 = (long) aux;
4037      if (q1) {
4038         zsubmul(q1, &r[i], b);
4039      }
4040
4041      while (rp[0] < 0) {
4042         zaddmulone(&r[i], b);
4043         q1--;
4044      }
4045
4046      while (rp[0] > 0) {
4047         zsubmulone(&r[i], b);
4048         q1++;
4049      }
4050
4051      aux = btopinv*((rp[-1]*NTL_FRADIX + rp[-2])*NTL_FRADIX + rp[-3]);
4052      while (aux > NTL_FRADIX - 16) {
4053         /* q1 might be too small */
4054         if (aux >= NTL_FRADIX)
4055            aux = NTL_FRADIX-1;
4056
4057
4058         zsubmulone(&r[i], b);
4059         if (rp[0] < 0) {
4060            /* oops...false alarm! */
4061            zaddmulone(&r[i], b);
4062            break;
4063         }
4064         else {
4065            q1++;
4066            aux = btopinv*((rp[-1]*NTL_FRADIX + rp[-2])*NTL_FRADIX + rp[-3]);
4067         }
4068      }
4069
4070      q[i] = q1;
4071   }
4072
4073   while (sq > 1 && q[sq] == 0) sq--;
4074   q[0] = sq;
4075
4076   i = sb;
4077   while (i > 1 && r[i] == 0) i--;
4078   r[0] = i;
4079
4080done:
4081   if (sign)
4082   {
4083      if (sign <= 2)
4084      {
4085         if (!(r[1]) && (r[0] == 1))
4086            _ntl_znegate(&q);
4087         else
4088         {
4089            _ntl_zsadd(q, 1, &q);
4090            _ntl_znegate(&q);
4091            if (sign == 1)
4092               _ntl_zsub(r, b, &r);
4093            else
4094               _ntl_zsub(b, r, &r);
4095         }
4096      }
4097      else
4098         _ntl_znegate(&r);
4099
4100      if (sign & 2)
4101         a[0] = -sa;
4102
4103      if (sign & 1)
4104         b[0] = -sb;
4105   }
4106
4107   _ntl_zcopy(q, qq);
4108   if (rr) _ntl_zcopy(r, rr);
4109}
4110
4111void
4112_ntl_zmod(_ntl_verylong a, _ntl_verylong b, _ntl_verylong *rr)
4113{
4114   long sa, sb, sq, i;
4115   long sign;
4116   long q1;
4117   long *rp;
4118   double btopinv, aux;
4119   static _ntl_verylong r=0;
4120
4121   if (!b || (((sb=b[0]) == 1) && (!b[1]))) {
4122      zhalt("division by zero in _ntl_zdiv");
4123   }
4124
4125   if (!a || (((sa=a[0]) == 1) && (!a[1]))) {
4126      _ntl_zzero(rr);
4127      return;
4128   }
4129
4130
4131   if (sb == 1) {
4132      _ntl_zintoz(_ntl_zsmod(a, b[1]), rr);
4133      return;
4134   }
4135
4136   if (sb == -1) {
4137      _ntl_zintoz(_ntl_zsmod(a, -b[1]), rr);
4138      return;
4139   }
4140
4141   sign = 0;
4142   if (sa < 0) {
4143      a[0] = sa = -sa;
4144      sign = 2;
4145   }
4146
4147   if (sb < 0) {
4148      b[0] = sb = -sb;
4149      sign |= 1;
4150   }
4151
4152
4153   sq = sa-sb+1;
4154
4155   if (sq <= 0) {
4156      _ntl_zcopy(a, &r);
4157      goto done;
4158   }
4159
4160#ifdef NTL_GMP_HACK
4161   if (_ntl_gmp_hack && sb >= NTL_GMP_REM_CROSS && sq >= NTL_GMP_REM_CROSS) {
4162      GT_INIT
4163
4164      lip_to_mpz(a, gt_1);
4165      lip_to_mpz(b, gt_2);
4166      mpz_fdiv_r(gt_4, gt_1, gt_2);
4167      mpz_to_lip(&r, gt_4);
4168
4169      goto done;
4170   }
4171#endif
4172
4173   _ntl_zsetlength(&r, sa+1);
4174 
4175   _ntl_zcopy(a, &r);
4176   rp = &r[sa+1];
4177   *rp = 0;
4178
4179   r[0] = 0; /* this streamlines the last evaluation of aux */
4180
4181   btopinv = b[sb]*NTL_FRADIX + b[sb-1];
4182   if (sb > 2) 
4183      btopinv = NTL_FRADIX / (btopinv*NTL_FRADIX + b[sb-2]);
4184   else
4185      btopinv = 1.0 / btopinv;
4186
4187   
4188   aux = btopinv*(rp[-1]*NTL_FRADIX + rp[-2]);
4189   if (aux >= NTL_FRADIX)
4190      aux = NTL_FRADIX-1;
4191
4192   for (i = sq; i >= 1; i--, rp--) {
4193      q1 = (long) aux;
4194      if (q1) {
4195         zsubmul(q1, &r[i], b);
4196      }
4197
4198      while (rp[0] < 0) {
4199         zaddmulone(&r[i], b);
4200      }
4201
4202      while (rp[0] > 0) {
4203         zsubmulone(&r[i], b);
4204      }
4205
4206      aux = btopinv*((rp[-1]*NTL_FRADIX + rp[-2])*NTL_FRADIX + rp[-3]);
4207      while (aux > NTL_FRADIX - 16) {
4208         /* q1 might be too small */
4209         if (aux >= NTL_FRADIX)
4210            aux = NTL_FRADIX-1;
4211
4212
4213         zsubmulone(&r[i], b);
4214         if (rp[0] < 0) {
4215            /* oops...false alarm! */
4216            zaddmulone(&r[i], b);
4217            break;
4218         }
4219         else {
4220            aux = btopinv*((rp[-1]*NTL_FRADIX + rp[-2])*NTL_FRADIX + rp[-3]);
4221         }
4222      }
4223   }
4224
4225   i = sb;
4226   while (i > 1 && r[i] == 0) i--;
4227   r[0] = i;
4228
4229done:
4230   if (sign)
4231   {
4232      if (sign <= 2)
4233      {
4234         if (!(r[1]) && (r[0] == 1))
4235            /* no op */;
4236         else
4237         {
4238            if (sign == 1)
4239               _ntl_zsub(r, b, &r);
4240            else
4241               _ntl_zsub(b, r, &r);
4242         }
4243      }
4244      else
4245         _ntl_znegate(&r);
4246
4247      if (sign & 2)
4248         a[0] = -sa;
4249
4250      if (sign & 1)
4251         b[0] = -sb;
4252   }
4253
4254   _ntl_zcopy(r, rr);
4255}
4256
4257void
4258_ntl_zquickmod(_ntl_verylong *rr, _ntl_verylong b)
4259{
4260   long sa, sb, sq, i;
4261   long q1;
4262   long *rp;
4263   double btopinv, aux;
4264   _ntl_verylong r;
4265
4266   sb = b[0];
4267
4268   r = *rr;
4269
4270   if (!r || (((sa=r[0]) == 1) && (!r[1]))) {
4271      _ntl_zzero(rr);
4272      return;
4273   }
4274
4275
4276   if (sb == 1) {
4277      _ntl_zintoz(_ntl_zsmod(r, b[1]), rr);
4278      return;
4279   }
4280
4281   sq = sa-sb+1;
4282
4283   if (sq <= 0) {
4284      return;
4285   } 
4286
4287#ifdef NTL_GMP_HACK
4288   if (_ntl_gmp_hack && sb >= NTL_GMP_QREM_CROSS && sq >= NTL_GMP_QREM_CROSS) {
4289      GT_INIT
4290
4291      lip_to_mpz(r, gt_1);
4292      lip_to_mpz(b, gt_2);
4293      mpz_fdiv_r(gt_4, gt_1, gt_2);
4294      mpz_to_lip(rr, gt_4);
4295      return;
4296   }
4297#endif
4298
4299   _ntl_zsetlength(rr, sa+1);
4300   r = *rr;
4301 
4302   rp = &r[sa+1];
4303   *rp = 0;
4304
4305   r[0] = 0; /* this streamlines the last evaluation of aux */
4306
4307   btopinv = b[sb]*NTL_FRADIX + b[sb-1];
4308   if (sb > 2) 
4309      btopinv = NTL_FRADIX / (btopinv*NTL_FRADIX + b[sb-2]);
4310   else
4311      btopinv = 1.0 / btopinv;
4312
4313   
4314   aux = btopinv*(rp[-1]*NTL_FRADIX + rp[-2]);
4315   if (aux >= NTL_FRADIX)
4316      aux = NTL_FRADIX-1;
4317
4318   for (i = sq; i >= 1; i--, rp--) {
4319      q1 = (long) aux;
4320      if (q1) {
4321         zsubmul(q1, &r[i], b);
4322      }
4323
4324      while (rp[0] < 0) {
4325         zaddmulone(&r[i], b);
4326      }
4327
4328      while (rp[0] > 0) {
4329         zsubmulone(&r[i], b);
4330      }
4331
4332      aux = btopinv*((rp[-1]*NTL_FRADIX + rp[-2])*NTL_FRADIX + rp[-3]);
4333      while (aux > NTL_FRADIX - 16) {
4334         /* q1 might be too small */
4335         if (aux >= NTL_FRADIX)
4336            aux = NTL_FRADIX-1;
4337
4338
4339         zsubmulone(&r[i], b);
4340         if (rp[0] < 0) {
4341            /* oops...false alarm! */
4342            zaddmulone(&r[i], b);
4343            break;
4344         }
4345         else {
4346            aux = btopinv*((rp[-1]*NTL_FRADIX + rp[-2])*NTL_FRADIX + rp[-3]);
4347         }
4348      }
4349   }
4350
4351   i = sb;
4352   while (i > 1 && r[i] == 0) i--;
4353   r[0] = i;
4354}
4355
4356
4357void
4358_ntl_zaddmod(
4359        _ntl_verylong a,
4360        _ntl_verylong b,
4361        _ntl_verylong n,
4362        _ntl_verylong *c
4363        )
4364{
4365        if (*c != n) {
4366                _ntl_zadd(a, b, c);
4367                if (_ntl_zcompare(*c, n) >= 0)
4368                        _ntl_zsubpos(*c, n, c);
4369        }
4370        else {
4371                static _ntl_verylong mem = 0;
4372
4373                _ntl_zadd(a, b, &mem);
4374                if (_ntl_zcompare(mem, n) >= 0)
4375                        _ntl_zsubpos(mem, n, c);
4376                else
4377                        _ntl_zcopy(mem, c);
4378        }
4379}
4380
4381void
4382_ntl_zsubmod(
4383        _ntl_verylong a,
4384        _ntl_verylong b,
4385        _ntl_verylong n,
4386        _ntl_verylong *c
4387        )
4388{
4389        static _ntl_verylong mem = 0;
4390        long cmp;
4391
4392        if ((cmp=_ntl_zcompare(a, b)) < 0) {
4393                _ntl_zadd(n, a, &mem);
4394                _ntl_zsubpos(mem, b, c);
4395        } else if (!cmp) 
4396                _ntl_zzero(c);
4397        else 
4398                _ntl_zsubpos(a, b, c);
4399}
4400
4401void
4402_ntl_zsmulmod(
4403        _ntl_verylong a,
4404        long d,
4405        _ntl_verylong n,
4406        _ntl_verylong *c
4407        )
4408{
4409        static _ntl_verylong mem = 0;
4410
4411        _ntl_zsmul(a, d, &mem);
4412        _ntl_zquickmod(&mem, n);
4413        _ntl_zcopy(mem, c);
4414}
4415
4416
4417
4418
4419void
4420_ntl_zmulmod(
4421        _ntl_verylong a,
4422        _ntl_verylong b,
4423        _ntl_verylong n,
4424        _ntl_verylong *c
4425        )
4426{
4427        static _ntl_verylong mem = 0;
4428
4429        _ntl_zmul(a, b, &mem);
4430        _ntl_zquickmod(&mem, n);
4431        _ntl_zcopy(mem, c);
4432}
4433
4434void
4435_ntl_zsqmod(
4436        _ntl_verylong a,
4437        _ntl_verylong n,
4438        _ntl_verylong *c
4439        )
4440{
4441        static _ntl_verylong mem = 0;
4442
4443        _ntl_zsq(a, &mem);
4444        _ntl_zquickmod(&mem, n);
4445        _ntl_zcopy(mem, c);
4446}
4447
4448
4449void
4450_ntl_zinvmod(
4451        _ntl_verylong a,
4452        _ntl_verylong n,
4453        _ntl_verylong *c
4454        )
4455{
4456        if (_ntl_zinv(a, n, c))
4457                zhalt("undefined inverse in _ntl_zinvmod");
4458}
4459
4460
4461static long 
4462zxxeucl(
4463   _ntl_verylong ain,
4464   _ntl_verylong nin,
4465   _ntl_verylong *invv,
4466   _ntl_verylong *uu
4467   )
4468{
4469   static _ntl_verylong a = 0;
4470   static _ntl_verylong n = 0;
4471   static _ntl_verylong q = 0;
4472   static _ntl_verylong w = 0;
4473   static _ntl_verylong x = 0;
4474   static _ntl_verylong y = 0;
4475   static _ntl_verylong z = 0;
4476   _ntl_verylong inv = *invv;
4477   _ntl_verylong u = *uu;
4478   long diff;
4479   long ilo;
4480   long sa;
4481   long sn;
4482   long temp;
4483   long e;
4484   long fast;
4485   long parity;
4486   long gotthem;
4487   _ntl_verylong pin;
4488   _ntl_verylong p;
4489   long i;
4490   long try11;
4491   long try12;
4492   long try21;
4493   long try22;
4494   long got11;
4495   long got12;
4496   long got21;
4497   long got22;
4498   double hi;
4499   double lo;
4500   double dt;
4501   double fhi, fhi1;
4502   double flo, flo1;
4503   double num;
4504   double den;
4505   double dirt;
4506
4507
4508   _ntl_zsetlength(&a, (e = (ain[0] > nin[0] ? ain[0] : nin[0])));
4509   _ntl_zsetlength(&n, e);
4510   _ntl_zsetlength(&q, e);
4511   _ntl_zsetlength(&w, e);
4512   _ntl_zsetlength(&x, e);
4513   _ntl_zsetlength(&y, e);
4514   _ntl_zsetlength(&z, e);
4515   _ntl_zsetlength(&inv, e);
4516   *invv = inv;
4517   _ntl_zsetlength(&u, e);
4518   *uu = u;
4519
4520   fhi1 = 1.0 + ((double) 32.0)/NTL_FDOUBLE_PRECISION;
4521   flo1 = 1.0 - ((double) 32.0)/NTL_FDOUBLE_PRECISION;
4522
4523   fhi = 1.0 + ((double) 8.0)/NTL_FDOUBLE_PRECISION;
4524   flo = 1.0 - ((double) 8.0)/NTL_FDOUBLE_PRECISION;
4525
4526   pin = &ain[0];
4527   p = &a[0];
4528   for (i = (*pin); i >= 0; i--)
4529      *p++ = *pin++;
4530   pin = &nin[0];
4531   p = &n[0];
4532   for (i = (*pin); i >= 0; i--)
4533      *p++ = *pin++;
4534   inv[0] = 1;
4535   inv[1] = 1;
4536   w[0] = 1;
4537   w[1] = 0;
4538   while (n[0] > 1 || n[1] > 0)
4539   {
4540      gotthem = 0;
4541      sa = a[0];
4542      sn = n[0];
4543      diff = sa - sn;
4544      if (!diff || diff == 1)
4545      {
4546         sa = a[0];
4547         p = &a[sa];
4548         num = ((double) (*p)) * NTL_FRADIX;
4549         if (sa > 1)
4550            num += (*(--p));
4551         num *= NTL_FRADIX;
4552         if (sa > 2)
4553            num += (*(p - 1));
4554         sn = n[0];
4555         p = &n[sn];
4556         den = (double) (*p) * NTL_FRADIX;
4557         if (sn > 1)
4558            den += (*(--p));
4559         den *= NTL_FRADIX;
4560         if (sn > 2)
4561            den += (*(p - 1));
4562         hi = fhi1 * (num + 1.0) / den;
4563         lo = flo1 * num / (den + 1.0);
4564         if (diff > 0)
4565         {
4566            hi *= NTL_FRADIX;
4567            lo *= NTL_FRADIX;
4568         }
4569         try11 = 1;
4570         try12 = 0;
4571         try21 = 0;
4572         try22 = 1;
4573         parity = 1;
4574         fast = 1; 
4575         while (fast > 0)
4576         {
4577            parity = 1 - parity;
4578            if (hi >= NTL_FRADIX)
4579               fast = 0;
4580            else
4581            {
4582               ilo = (long)lo;
4583               dirt = hi - ilo;
4584               if (dirt < 1.0/NTL_FDOUBLE_PRECISION || !ilo || ilo < (long)hi)
4585                  fast = 0;
4586               else
4587               {
4588                  dt = lo-ilo;
4589                  lo = flo / dirt;
4590                  if (dt > 1.0/NTL_FDOUBLE_PRECISION)
4591                     hi = fhi / dt;
4592                  else
4593                     hi = NTL_FRADIX;
4594                  temp = try11;
4595                  try11 = try21;
4596                  if ((NTL_RADIX - temp) / ilo < try21)
4597                     fast = 0;
4598                  else
4599                     try21 = temp + ilo * try21;
4600                  temp = try12;
4601                  try12 = try22;
4602                  if ((NTL_RADIX - temp) / ilo < try22)
4603                     fast = 0;
4604                  else
4605                     try22 = temp + ilo * try22;
4606                  if ((fast > 0) && (parity > 0))
4607                  {
4608                     gotthem = 1;
4609                     got11 = try11;
4610                     got12 = try12;
4611                     got21 = try21;
4612                     got22 = try22;
4613                  }
4614               }
4615            }
4616         }
4617      }
4618      if (gotthem)
4619      {
4620         _ntl_zsmul(inv, got11, &x);
4621         _ntl_zsmul(w, got12, &y);
4622         _ntl_zsmul(inv, got21, &z);
4623         _ntl_zsmul(w, got22, &w);
4624         _ntl_zadd(x, y, &inv);
4625         _ntl_zadd(z, w, &w);
4626         _ntl_zsmul(a, got11, &x);
4627         _ntl_zsmul(n, got12, &y);
4628         _ntl_zsmul(a, got21, &z);
4629         _ntl_zsmul(n, got22, &n);
4630         _ntl_zsub(x, y, &a);
4631         _ntl_zsub(n, z, &n);
4632      }
4633      else
4634      {
4635         _ntl_zdiv(a, n, &q, &a);
4636         _ntl_zmul(q, w, &x);
4637         _ntl_zadd(inv, x, &inv);
4638         if (a[0] > 1 || a[1] > 0)
4639         {
4640            _ntl_zdiv(n, a, &q, &n);
4641            _ntl_zmul(q, inv, &x);
4642            _ntl_zadd(w, x, &w);
4643         }
4644         else
4645         {
4646            p = &a[0];
4647            pin = &n[0];
4648            for (i = (*pin); i >= 0; i--)
4649               *p++ = *pin++;
4650            n[0] = 1;
4651            n[1] = 0;
4652            _ntl_zcopy(w, &inv);
4653            _ntl_znegate(&inv);
4654         }
4655      }
4656   }
4657
4658   if ((a[0] == 1) && (a[1] == 1))
4659      e = 0;
4660   else 
4661      e = 1;
4662
4663   p = &u[0];
4664   pin = &a[0];
4665   for (i = (*pin); i >= 0; i--)
4666      *p++ = *pin++;
4667   *invv = inv;
4668   *uu = u;
4669
4670   return (e);
4671}
4672
4673long 
4674_ntl_zinv(
4675        _ntl_verylong ain,
4676        _ntl_verylong nin,
4677        _ntl_verylong *invv
4678        )
4679{
4680        static _ntl_verylong u = 0;
4681        static _ntl_verylong v = 0;
4682        long sgn;
4683
4684
4685        if (_ntl_zscompare(nin, 1) <= 0) {
4686                zhalt("InvMod: second input <= 1");
4687        }
4688
4689        sgn = _ntl_zsign(ain);
4690        if (sgn < 0) {
4691                zhalt("InvMod: first input negative");
4692        }
4693
4694        if (_ntl_zcompare(ain, nin) >= 0) {
4695                zhalt("InvMod: first input too big");
4696        }
4697
4698
4699        if (sgn == 0) {
4700                _ntl_zcopy(nin, invv);
4701                return 1;
4702        }
4703
4704#ifdef NTL_GMP_HACK
4705#if (__GNU_MP_VERSION >= 3)
4706/* versions of gmp prior to version 3 have really bad xgcd */
4707        if (_ntl_gmp_hack && nin[0] >= NTL_GMP_INVMOD_CROSS) {
4708                GT_INIT
4709
4710                lip_to_mpz(ain, gt_1);
4711                lip_to_mpz(nin, gt_2);
4712                mpz_gcdext(gt_3, gt_4, 0, gt_1, gt_2);
4713                mpz_to_lip(&u, gt_3);
4714                mpz_to_lip(&v, gt_4);
4715
4716                if (u && u[0] == 1 && u[1] == 1) {
4717
4718                        /*
4719                         * We make sure v is in range 0..n-1,
4720                         * just in case GMP is sloppy.
4721                         */
4722
4723                        while (_ntl_zsign(v) < 0) 
4724                                _ntl_zadd(v, nin, &v);
4725
4726                        while (_ntl_zcompare(v, nin) >= 0)
4727                                _ntl_zsub(v, nin, &v);
4728
4729                        _ntl_zcopy(v, invv);
4730                        return 0;
4731                }
4732                else {
4733                        _ntl_zcopy(u, invv);
4734                        return 1;
4735                }
4736        }
4737#endif
4738#endif
4739
4740        if (!(zxxeucl(ain, nin, &v, &u))) {
4741                if (_ntl_zsign(v) < 0) _ntl_zadd(v, nin, &v);
4742                _ntl_zcopy(v, invv);
4743                return 0;
4744        }
4745
4746        _ntl_zcopy(u, invv);
4747        return 1;
4748}
4749
4750void
4751_ntl_zexteucl(
4752        _ntl_verylong aa,
4753        _ntl_verylong *xa,
4754        _ntl_verylong bb,
4755        _ntl_verylong *xb,
4756        _ntl_verylong *d
4757        )
4758{
4759        static _ntl_verylong modcon = 0;
4760        static _ntl_verylong a=0, b=0;
4761        long anegative = 0;
4762        long bnegative = 0;
4763
4764        _ntl_zcopy(aa, &a);
4765        _ntl_zcopy(bb, &b);
4766
4767        if (anegative = (a[0] < 0))
4768                a[0] = -a[0];
4769        if (bnegative = (b[0] < 0))
4770                b[0] = -b[0];
4771
4772        if (!b[1] && (b[0] == 1))
4773        {
4774                _ntl_zone(xa);
4775                _ntl_zzero(xb);
4776                _ntl_zcopy(a, d);
4777                goto done;
4778        }
4779
4780        if (!a[1] && (a[0] == 1))
4781        {
4782                _ntl_zzero(xa);
4783                _ntl_zone(xb);
4784                _ntl_zcopy(b, d);
4785                goto done;
4786        }
4787
4788#ifdef NTL_GMP_HACK
4789#if (__GNU_MP_VERSION >= 3)
4790/* versions of gmp prior to version 3 have really bad xgcd */
4791   if (_ntl_gmp_hack && 
4792       a[0] >= NTL_GMP_XGCD_CROSS && b[0] >= NTL_GMP_XGCD_CROSS) {
4793      GT_INIT
4794
4795      lip_to_mpz(aa, gt_1);
4796      lip_to_mpz(bb, gt_2);
4797      mpz_gcdext(gt_3, gt_4, gt_5, gt_1, gt_2);
4798      mpz_to_lip(&a, gt_3);
4799      mpz_to_lip(&b, gt_4);
4800      mpz_to_lip(&modcon, gt_5);
4801      _ntl_zcopy(a, d);
4802      _ntl_zcopy(b, xa);
4803      _ntl_zcopy(modcon, xb);
4804      return;
4805   }
4806#endif
4807#endif
4808
4809
4810        zxxeucl(a, b, xa, d);
4811        _ntl_zmul(a, *xa, xb);
4812        _ntl_zsub(*d, *xb, xb);
4813        _ntl_zdiv(*xb, b, xb, &modcon);
4814
4815        if ((modcon[1]) || (modcon[0] != 1))
4816        {
4817                zhalt("non-zero remainder in _ntl_zexteucl   BUG");
4818        }
4819done:
4820        if (anegative)
4821        {
4822                _ntl_znegate(xa);
4823        }
4824        if (bnegative)
4825        {
4826                _ntl_znegate(xb);
4827        }
4828}
4829
4830
4831
4832/* I've adapted LIP's extended euclidean algorithm to
4833 * do rational reconstruction.  -- VJS.
4834 */
4835
4836
4837long 
4838_ntl_zxxratrecon(
4839   _ntl_verylong ain,
4840   _ntl_verylong nin,
4841   _ntl_verylong num_bound,
4842   _ntl_verylong den_bound,
4843   _ntl_verylong *num_out,
4844   _ntl_verylong *den_out
4845   )
4846{
4847   static _ntl_verylong a = 0;
4848   static _ntl_verylong n = 0;
4849   static _ntl_verylong q = 0;
4850   static _ntl_verylong w = 0;
4851   static _ntl_verylong x = 0;
4852   static _ntl_verylong y = 0;
4853   static _ntl_verylong z = 0;
4854   static _ntl_verylong inv = 0;
4855   static _ntl_verylong u = 0;
4856   static _ntl_verylong a_bak = 0;
4857   static _ntl_verylong n_bak = 0;
4858   static _ntl_verylong inv_bak = 0;
4859   static _ntl_verylong w_bak = 0;
4860
4861   _ntl_verylong p;
4862
4863   long diff;
4864   long ilo;
4865   long sa;
4866   long sn;
4867   long snum;
4868   long sden;
4869   long e;
4870   long fast;
4871   long temp;
4872   long parity;
4873   long gotthem;
4874   long try11;
4875   long try12;
4876   long try21;
4877   long try22;
4878   long got11;
4879   long got12;
4880   long got21;
4881   long got22;
4882
4883   double hi;
4884   double lo;
4885   double dt;
4886   double fhi, fhi1;
4887   double flo, flo1;
4888   double num;
4889   double den;
4890   double dirt;
4891
4892   if (_ntl_zsign(num_bound) < 0)
4893      zhalt("rational reconstruction: bad numerator bound");
4894
4895   if (!num_bound)
4896      snum = 1;
4897   else
4898      snum = num_bound[0];
4899
4900   if (_ntl_zsign(den_bound) <= 0)
4901      zhalt("rational reconstruction: bad denominator bound");
4902
4903   sden = den_bound[0];
4904
4905   if (_ntl_zsign(nin) <= 0)
4906      zhalt("rational reconstruction: bad modulus");
4907
4908   if (_ntl_zsign(ain) < 0 || _ntl_zcompare(ain, nin) >= 0)
4909      zhalt("rational reconstruction: bad residue");
4910
4911     
4912   e = nin[0];
4913   _ntl_zsetlength(&a, e);
4914   _ntl_zsetlength(&n, e);
4915   _ntl_zsetlength(&q, e);
4916   _ntl_zsetlength(&w, e);
4917   _ntl_zsetlength(&x, e);
4918   _ntl_zsetlength(&y, e);
4919   _ntl_zsetlength(&z, e);
4920   _ntl_zsetlength(&inv, e);
4921   _ntl_zsetlength(&u, e);
4922   _ntl_zsetlength(&a_bak, e);
4923   _ntl_zsetlength(&n_bak, e);
4924   _ntl_zsetlength(&inv_bak, e);
4925   _ntl_zsetlength(&w_bak, e);
4926
4927   fhi1 = 1.0 + ((double) 32.0)/NTL_FDOUBLE_PRECISION;
4928   flo1 = 1.0 - ((double) 32.0)/NTL_FDOUBLE_PRECISION;
4929
4930   fhi = 1.0 + ((double) 8.0)/NTL_FDOUBLE_PRECISION;
4931   flo = 1.0 - ((double) 8.0)/NTL_FDOUBLE_PRECISION;
4932
4933   _ntl_zcopy(ain, &a);
4934   _ntl_zcopy(nin, &n);
4935
4936   _ntl_zone(&inv);
4937   _ntl_zzero(&w);
4938
4939   while (1)
4940   {
4941      if (w[0] >= sden && _ntl_zcompare(w, den_bound) > 0) break;
4942      if (n[0] <= snum && _ntl_zcompare(n, num_bound) <= 0) break;
4943
4944      _ntl_zcopy(a, &a_bak);
4945      _ntl_zcopy(n, &n_bak);
4946      _ntl_zcopy(w, &w_bak);
4947      _ntl_zcopy(inv, &inv_bak);
4948
4949      gotthem = 0;
4950      sa = a[0];
4951      sn = n[0];
4952      diff = sa - sn;
4953      if (!diff || diff == 1)
4954      {
4955         sa = a[0];
4956         p = &a[sa];
4957         num = (double) (*p) * NTL_FRADIX;
4958         if (sa > 1)
4959            num += (*(--p));
4960         num *= NTL_FRADIX;
4961         if (sa > 2)
4962            num += (*(p - 1));
4963         sn = n[0];
4964         p = &n[sn];
4965         den = (double) (*p) * NTL_FRADIX;
4966         if (sn > 1)
4967            den += (*(--p));
4968         den *= NTL_FRADIX;
4969         if (sn > 2)
4970            den += (*(p - 1));
4971         hi = fhi1 * (num + 1.0) / den;
4972         lo = flo1 * num / (den + 1.0);
4973         if (diff > 0)
4974         {
4975            hi *= NTL_FRADIX;
4976            lo *= NTL_FRADIX;
4977         }
4978         try11 = 1;
4979         try12 = 0;
4980         try21 = 0;
4981         try22 = 1;
4982         parity = 1;
4983         fast = 1; 
4984         while (fast > 0)
4985         {
4986            parity = 1 - parity;
4987            if (hi >= NTL_FRADIX)
4988               fast = 0;
4989            else
4990            {
4991               ilo = (long)lo;
4992               dirt = hi - ilo;
4993               if (dirt < 1.0/NTL_FDOUBLE_PRECISION || !ilo || ilo < (long)hi)
4994                  fast = 0;
4995               else
4996               {
4997                  dt = lo-ilo;
4998                  lo = flo / dirt;
4999                  if (dt > 1.0/NTL_FDOUBLE_PRECISION)
5000                     hi = fhi / dt;
5001                  else
5002                     hi = NTL_FRADIX;
5003                  temp = try11;
5004                  try11 = try21;
5005                  if ((NTL_RADIX - temp) / ilo < try21)
5006                     fast = 0;
5007                  else
5008                     try21 = temp + ilo * try21;
5009                  temp = try12;
5010                  try12 = try22;
5011                  if ((NTL_RADIX - temp) / ilo < try22)
5012                     fast = 0;
5013                  else
5014                     try22 = temp + ilo * try22;
5015                  if ((fast > 0) && (parity > 0))
5016                  {
5017                     gotthem = 1;
5018                     got11 = try11;
5019                     got12 = try12;
5020                     got21 = try21;
5021                     got22 = try22;
5022                  }
5023               }
5024            }
5025         }
5026      }
5027      if (gotthem)
5028      {
5029         _ntl_zsmul(inv, got11, &x);
5030         _ntl_zsmul(w, got12, &y);
5031         _ntl_zsmul(inv, got21, &z);
5032         _ntl_zsmul(w, got22, &w);
5033         _ntl_zadd(x, y, &inv);
5034         _ntl_zadd(z, w, &w);
5035         _ntl_zsmul(a, got11, &x);
5036         _ntl_zsmul(n, got12, &y);
5037         _ntl_zsmul(a, got21, &z);
5038         _ntl_zsmul(n, got22, &n);
5039         _ntl_zsub(x, y, &a);
5040         _ntl_zsub(n, z, &n);
5041      }
5042      else
5043      {
5044         _ntl_zdiv(a, n, &q, &a);
5045         _ntl_zmul(q, w, &x);
5046         _ntl_zadd(inv, x, &inv);
5047         if (a[0] > 1 || a[1] > 0)
5048         {
5049            _ntl_zdiv(n, a, &q, &n);
5050            _ntl_zmul(q, inv, &x);
5051            _ntl_zadd(w, x, &w);
5052         }
5053         else
5054         {
5055            break;
5056         }
5057      }
5058   }
5059
5060   _ntl_zcopy(a_bak, &a);
5061   _ntl_zcopy(n_bak, &n);
5062   _ntl_zcopy(w_bak, &w);
5063   _ntl_zcopy(inv_bak, &inv);
5064
5065   _ntl_znegate(&w);
5066
5067   while (1)
5068   {
5069      sa = w[0];
5070      if (sa < 0) w[0] = -sa;
5071      if (w[0] >= sden && _ntl_zcompare(w, den_bound) > 0) return 0;
5072      w[0] = sa;
5073
5074      if (n[0] <= snum && _ntl_zcompare(n, num_bound) <= 0) break;
5075     
5076      fast = 0;
5077      sa = a[0];
5078      sn = n[0];
5079      diff = sa - sn;
5080      if (!diff || diff == 1)
5081      {
5082         sa = a[0];
5083         p = &a[sa];
5084         num = (double) (*p) * NTL_FRADIX;
5085         if (sa > 1)
5086            num += (*(--p));
5087         num *= NTL_FRADIX;
5088         if (sa > 2)
5089            num += (*(p - 1));
5090         sn = n[0];
5091         p = &n[sn];
5092         den = (double) (*p) * NTL_FRADIX;
5093         if (sn > 1)
5094            den += (*(--p));
5095         den *= NTL_FRADIX;
5096         if (sn > 2)
5097            den += (*(p - 1));
5098         hi = fhi1 * (num + 1.0) / den;
5099         lo = flo1 * num / (den + 1.0);
5100         if (diff > 0)
5101         {
5102            hi *= NTL_FRADIX;
5103            lo *= NTL_FRADIX;
5104         }
5105         if (hi < NTL_FRADIX)
5106         {
5107            ilo = (long)lo;
5108            if (ilo == (long)hi)
5109               fast = 1;
5110         }
5111      }
5112
5113      if (fast) 
5114      {
5115         if (ilo != 0) {
5116            if (ilo == 1) {
5117               _ntl_zsub(inv, w, &inv);
5118               _ntl_zsubpos(a, n, &a);
5119            }
5120            else if (ilo == 2) {
5121               _ntl_z2mul(w, &x);
5122               _ntl_zsub(inv, x, &inv);
5123               _ntl_z2mul(n, &x);
5124               _ntl_zsubpos(a, x, &a);
5125            }
5126            else if (ilo ==3) {
5127               _ntl_z2mul(w, &x);
5128               _ntl_zadd(w, x, &x);
5129               _ntl_zsub(inv, x, &inv);
5130               _ntl_z2mul(n, &x);
5131               _ntl_zadd(n, x, &x);
5132               _ntl_zsubpos(a, x, &a);
5133            }
5134            else if (ilo == 4) {
5135               _ntl_zlshift(w, 2, &x);
5136               _ntl_zsub(inv, x, &inv);
5137               _ntl_zlshift(n, 2, &x);
5138               _ntl_zsubpos(a, x, &a);
5139            }
5140            else {
5141               _ntl_zsmul(w, ilo, &x);
5142               _ntl_zsub(inv, x, &inv);
5143               _ntl_zsmul(n, ilo, &x);
5144               _ntl_zsubpos(a, x, &a);
5145            }
5146         }
5147      }
5148      else {
5149         _ntl_zdiv(a, n, &q, &a);
5150         _ntl_zmul(q, w, &x);
5151         _ntl_zsub(inv, x, &inv);
5152      }
5153
5154      _ntl_zswap(&a, &n);
5155      _ntl_zswap(&inv, &w);
5156   }
5157
5158   if (_ntl_zsign(w) < 0) {
5159      _ntl_znegate(&w);
5160      _ntl_znegate(&n);
5161   }
5162
5163   _ntl_zcopy(n, num_out);
5164   _ntl_zcopy(w, den_out);
5165
5166   return 1;
5167}
5168
5169
5170
5171static
5172long OptWinSize(long n)
5173/* finds k that minimizes n/(k+1) + 2^{k-1} */
5174
5175{
5176   long k;
5177   double v, v_new;
5178
5179
5180   v = n/2.0 + 1.0;
5181   k = 1;
5182
5183   for (;;) {
5184      v_new = n/((double)(k+2)) + ((double)(1L << k));
5185      if (v_new >= v) break;
5186      v = v_new;
5187      k++;
5188   }
5189
5190   return k;
5191}
5192
5193     
5194
5195static
5196void _ntl_zsppowermod(long a, _ntl_verylong e, _ntl_verylong n, 
5197                      _ntl_verylong *x)
5198{
5199   _ntl_verylong res;
5200   long i, k;
5201
5202   if (_ntl_ziszero(e)) {
5203      _ntl_zone(x);
5204      return;
5205   }
5206
5207   res = 0;
5208   _ntl_zsetlength(&res, n[0]);
5209   _ntl_zone(&res);
5210
5211   k = _ntl_z2log(e);
5212
5213   for (i = k - 1; i >= 0; i--) {
5214      _ntl_zsqmod(res, n, &res);
5215      if (_ntl_zbit(e, i))
5216         _ntl_zsmulmod(res, a, n, &res);
5217   }
5218
5219   if (_ntl_zsign(e) < 0) _ntl_zinvmod(res, n, &res);
5220
5221   _ntl_zcopy(res, x);
5222   _ntl_zfree(&res);
5223}
5224
5225
5226
5227static
5228void _ntl_ztwopowermod( _ntl_verylong e, _ntl_verylong n, 
5229                      _ntl_verylong *x)
5230{
5231   _ntl_verylong res;
5232   long i, k;
5233
5234   if (_ntl_ziszero(e)) {
5235      _ntl_zone(x);
5236      return;
5237   }
5238
5239   res = 0;
5240   _ntl_zsetlength(&res, n[0]);
5241   _ntl_zone(&res);
5242
5243   k = _ntl_z2log(e);
5244
5245   for (i = k - 1; i >= 0; i--) {
5246      _ntl_zsqmod(res, n, &res);
5247      if (_ntl_zbit(e, i))
5248         _ntl_zaddmod(res, res, n, &res);
5249   }
5250
5251   if (_ntl_zsign(e) < 0) _ntl_zinvmod(res, n, &res);
5252
5253   _ntl_zcopy(res, x);
5254   _ntl_zfree(&res);
5255}
5256
5257
5258void _ntl_zpowermod(_ntl_verylong g, _ntl_verylong e, _ntl_verylong F,
5259                    _ntl_verylong *h)
5260
5261/* h = g^e mod f using "sliding window" algorithm
5262
5263   remark: the notation (h, g, e, F) is strange, because I
5264   copied the code from BB.c.
5265*/
5266
5267{
5268   _ntl_verylong res, *v, t;
5269   long n, i, k, val, cnt, m;
5270
5271   if (_ntl_zsign(g) < 0 || _ntl_zcompare(g, F) >= 0 || 
5272       _ntl_zscompare(F, 1) <= 0) 
5273      zhalt("PowerMod: bad args");
5274
5275#ifdef NTL_GMP_HACK
5276
5277   if (_ntl_gmp_hack) {
5278      res = 0;
5279      _ntl_gmp_powermod(&res, g, e, F);
5280
5281      /* careful...don't compute directly into h, as it could lead
5282       * to an allocation error in some cases.
5283       */
5284
5285      _ntl_zcopy(res, h);
5286      _ntl_zfree(&res);
5287      return;
5288   }
5289
5290#endif
5291
5292   if (!g || g[0] == 1 || g[0] == -1) {
5293      long gg = _ntl_ztoint(g);
5294      if (gg == 2)
5295         _ntl_ztwopowermod(e, F, h);
5296      else
5297         _ntl_zsppowermod(gg, e, F, h);
5298      return;
5299   }
5300
5301   if (_ntl_zscompare(e, 0) == 0) {
5302      _ntl_zone(h);
5303      return;
5304   }
5305
5306   if (_ntl_zscompare(e, 1) == 0) {
5307      _ntl_zcopy(g, h);
5308      return;
5309   }
5310
5311   if (_ntl_zscompare(e, -1) == 0) {
5312      _ntl_zinvmod(g, F, h);
5313      return;
5314   }
5315
5316   if (_ntl_zscompare(e, 2) == 0) {
5317      _ntl_zsqmod(g, F, h);
5318      return;
5319   }
5320
5321   if (_ntl_zscompare(e, -2) == 0) {
5322      res = 0;
5323      _ntl_zsqmod(g, F, &res);
5324      _ntl_zinvmod(res, F, h);
5325      _ntl_zfree(&res);
5326      return;
5327   }
5328
5329   n = _ntl_z2log(e);
5330
5331   res = 0;
5332   _ntl_zone(&res);
5333
5334   if (n < 16) {
5335      /* plain square-and-multiply algorithm */
5336
5337      for (i = n - 1; i >= 0; i--) {
5338         _ntl_zsqmod(res, F, &res);
5339         if (_ntl_zbit(e, i))
5340            _ntl_zmulmod(res, g, F, &res);
5341      }
5342
5343      if (_ntl_zsign(e) < 0) _ntl_zinvmod(res, F, &res);
5344
5345      _ntl_zcopy(res, h);
5346      _ntl_zfree(&res);
5347      return;
5348   }
5349
5350   k = OptWinSize(n);
5351
5352   if (k > 5) k = 5;
5353
5354   v = (_ntl_verylong *) NTL_MALLOC(1L << (k-1), sizeof(_ntl_verylong), 0);
5355   if (!v) zhalt("out of memory");
5356   for (i = 0; i < (1L << (k-1)); i++)
5357      v[i] = 0; 
5358
5359   _ntl_zcopy(g, &v[0]);
5360 
5361   if (k > 1) {
5362      t = 0;
5363      _ntl_zsqmod(g, F, &t);
5364
5365      for (i = 1; i < (1L << (k-1)); i++)
5366         _ntl_zmulmod(v[i-1], t, F, &v[i]);
5367
5368      _ntl_zfree(&t);
5369   }
5370
5371
5372   val = 0;
5373   for (i = n-1; i >= 0; i--) {
5374      val = (val << 1) | _ntl_zbit(e, i); 
5375      if (val == 0)
5376         _ntl_zsqmod(res, F, &res);
5377      else if (val >= (1L << (k-1)) || i == 0) {
5378         cnt = 0;
5379         while ((val & 1) == 0) {
5380            val = val >> 1;
5381            cnt++;
5382         }
5383
5384         m = val;
5385         while (m > 0) {
5386            _ntl_zsqmod(res, F, &res);
5387            m = m >> 1;
5388         }
5389
5390         _ntl_zmulmod(res, v[val >> 1], F, &res);
5391
5392         while (cnt > 0) {
5393            _ntl_zsqmod(res, F, &res);
5394            cnt--;
5395         }
5396
5397         val = 0;
5398      }
5399   }
5400
5401   if (_ntl_zsign(e) < 0) _ntl_zinvmod(res, F, &res);
5402
5403   _ntl_zcopy(res, h);
5404
5405   _ntl_zfree(&res);
5406   for (i = 0; i < (1L << (k-1)); i++)
5407      _ntl_zfree(&v[i]);
5408   free(v);
5409}
5410
5411
5412
5413
5414
5415
5416void
5417_ntl_zexp(
5418        _ntl_verylong a,
5419        long e,
5420        _ntl_verylong *bb
5421        )
5422{
5423        long k;
5424        long len_a;
5425        long sa;
5426        static _ntl_verylong res = 0;
5427
5428        if (!a)
5429                sa = 0;
5430        else {
5431                sa = a[0];
5432                if (sa < 0) sa = -sa;
5433        }
5434
5435        if (sa <= 1) {
5436                _ntl_zexps(_ntl_ztoint(a), e, bb);
5437                return;
5438        }
5439
5440
5441        if (!e)
5442        {
5443                _ntl_zone(bb);
5444                return;
5445        }
5446
5447        if (e < 0)
5448                zhalt("negative exponent in _ntl_zexp");
5449
5450        if (_ntl_ziszero(a))
5451        {
5452                _ntl_zzero(bb);
5453                return;
5454        }
5455
5456        len_a = _ntl_z2log(a);
5457        if (len_a > (NTL_MAX_LONG-(NTL_NBITS-1))/e)
5458                zhalt("overflow in _ntl_zexp");
5459
5460        _ntl_zsetlength(&res, (len_a*e+NTL_NBITS-1)/NTL_NBITS);
5461
5462        _ntl_zcopy(a, &res);
5463        k = 1;
5464        while ((k << 1) <= e)
5465                k <<= 1;
5466        while (k >>= 1) {
5467                _ntl_zsq(res, &res);
5468                if (e & k)
5469                        _ntl_zmul(a, res, &res);
5470        }
5471
5472        _ntl_zcopy(res, bb);
5473}
5474
5475void
5476_ntl_zexps(
5477        long a,
5478        long e,
5479        _ntl_verylong *bb
5480        )
5481{
5482        long k;
5483        long len_a;
5484        static _ntl_verylong res = 0;
5485
5486        if (!e)
5487        {
5488                _ntl_zone(bb);
5489                return;
5490        }
5491
5492        if (e < 0)
5493                zhalt("negative exponent in _ntl_zexps");
5494
5495        if (!a)
5496        {
5497                _ntl_zzero(bb);
5498                return;
5499        }
5500
5501        if (a >= NTL_RADIX || a <= -NTL_RADIX) {
5502                _ntl_zintoz(a, &res);
5503                _ntl_zexp(res, e, &res);
5504                return;
5505        }
5506
5507        len_a = _ntl_z2logs(a);
5508        if (len_a > (NTL_MAX_LONG-(NTL_NBITS-1))/e)
5509                zhalt("overflow in _ntl_zexps");
5510
5511        _ntl_zsetlength(&res, (len_a*e+NTL_NBITS-1)/NTL_NBITS);
5512
5513        _ntl_zintoz(a, &res);
5514        k = 1;
5515        while ((k << 1) <= e)
5516                k <<= 1;
5517        while (k >>= 1) {
5518                _ntl_zsq(res, &res);
5519                if (e & k)
5520                        _ntl_zsmul(res, a, &res);
5521        }
5522
5523        _ntl_zcopy(res, bb);
5524}
5525
5526
5527void
5528_ntl_z2mul(
5529        _ntl_verylong n,
5530        _ntl_verylong *rres
5531        )
5532{
5533        long sn;
5534        long i;
5535        long n_alias;
5536        long carry;
5537        _ntl_verylong res;
5538
5539        if (!n)
5540        {
5541                _ntl_zzero(rres);
5542                return;
5543        }
5544
5545
5546        if ((!n[1]) && (n[0] == 1))
5547        {
5548                _ntl_zzero(rres);
5549                return;
5550        }
5551
5552        if ((sn = n[0]) < 0)
5553                sn = -sn;
5554
5555        res = *rres;
5556        n_alias = (n == res);
5557
5558        _ntl_zsetlength(&res, sn + 1);
5559        if (n_alias) n = res;
5560        *rres = res;
5561
5562        carry = 0;
5563
5564        for (i = 1; i <= sn; i++)
5565        {
5566                if ((res[i] = (n[i] << 1) + carry) >= NTL_RADIX)
5567                {
5568                        res[i] -= NTL_RADIX;
5569                        carry = 1;
5570                }
5571                else
5572                        carry = 0;
5573        }
5574
5575        if (carry)
5576                res[++sn] = 1;
5577
5578        if (n[0] < 0)
5579                res[0] = -sn;
5580        else
5581                res[0] = sn;
5582}
5583
5584
5585long 
5586_ntl_z2div(
5587        _ntl_verylong n,
5588        _ntl_verylong *rres
5589        )
5590{
5591        long sn;
5592        long i;
5593        long result;
5594        _ntl_verylong res = *rres;
5595
5596        if ((!n) || ((!n[1]) && (n[0] == 1)))
5597        {
5598                _ntl_zzero(rres);
5599                return (0);
5600        }
5601
5602        if ((sn = n[0]) < 0)
5603                sn = -sn;
5604
5605        /* n won't move if res aliases n */
5606        _ntl_zsetlength(&res, sn);
5607        *rres = res;
5608
5609        result = n[1] & 1;
5610        for (i = 1; i < sn; i++)
5611        {
5612                res[i] = (n[i] >> 1);
5613                if (n[i + 1] & 1)
5614                        res[i] += (NTL_RADIX >> 1);
5615        }
5616
5617        if (res[sn] = (n[sn] >> 1))
5618                res[0] = n[0];
5619        else if (sn == 1)
5620        {
5621                res[0] = 1;
5622        }
5623        else if (n[0] < 0)
5624                res[0] = -sn + 1;
5625        else
5626                res[0] = sn - 1;
5627
5628        return (result);
5629}
5630
5631
5632void
5633_ntl_zlshift(
5634        _ntl_verylong n,
5635        long k,
5636        _ntl_verylong *rres
5637        )
5638{
5639        long big;
5640        long small;
5641        long sn;
5642        long i;
5643        long cosmall;
5644        long n_alias;
5645        _ntl_verylong res;
5646
5647
5648        if (!n)
5649        {
5650                _ntl_zzero(rres);
5651                return;
5652        }
5653
5654        if ((!n[1]) && (n[0] == 1))
5655        {
5656                _ntl_zzero(rres);
5657                return;
5658        }
5659
5660        res = *rres;
5661        n_alias = (n == res);
5662       
5663
5664        if (!k)
5665        {
5666                if (!n_alias)
5667                        _ntl_zcopy(n, rres);
5668                return;
5669        }
5670
5671        if (k < 0)
5672        {
5673                if (k < -NTL_MAX_LONG) 
5674                        _ntl_zzero(rres); 
5675                else
5676                        _ntl_zrshift(n, -k, rres);
5677                return;
5678        }
5679        if (k == 1)
5680        {
5681                _ntl_z2mul(n, rres);
5682                return;
5683        }
5684
5685        if ((sn = n[0]) < 0)
5686                sn = -sn;
5687
5688        i = sn + (big = k / NTL_NBITS);
5689        if (small = k - big * NTL_NBITS)
5690        {
5691                _ntl_zsetlength(&res, i + 1);
5692                if (n_alias) n = res;
5693                *rres = res;
5694
5695                res[i + 1] = n[sn] >> (cosmall = NTL_NBITS - small);
5696                for (i = sn; i > 1; i--)
5697                        res[i + big] = ((((unsigned long) n[i]) << small) & NTL_RADIXM) + (n[i - 1] >> cosmall);
5698                res[big + 1] = (((unsigned long) n[1]) << small) & NTL_RADIXM;
5699                for (i = big; i; i--)
5700                        res[i] = 0;
5701                if (res[sn + big + 1])
5702                        big++;
5703        }
5704        else
5705        {
5706                _ntl_zsetlength(&res, i);
5707                if (n_alias) n = res;
5708                *rres = res;
5709
5710                for (i = sn; i; i--)
5711                        res[i + big] = n[i];
5712                for (i = big; i; i--)
5713                        res[i] = 0;
5714        }
5715        if (n[0] > 0)
5716                res[0] = n[0] + big;
5717        else
5718                res[0] = n[0] - big;
5719}
5720
5721
5722void
5723_ntl_zrshift(
5724        _ntl_verylong n,
5725        long k,
5726        _ntl_verylong *rres
5727        )
5728{
5729        long big;
5730        long small;
5731        long sn;
5732        long i;
5733        long cosmall;
5734        _ntl_verylong res;
5735
5736        if (!n)
5737        {
5738                _ntl_zzero(rres);
5739                return;
5740        }
5741
5742        if ((!n[1]) && (n[0] == 1))
5743        {
5744                _ntl_zzero(rres);
5745                return;
5746        }
5747
5748        res = *rres;
5749
5750        if (!k)
5751        {
5752                if (n != res)
5753                        _ntl_zcopy(n, rres);
5754                return;
5755        }
5756
5757        if (k < 0)
5758        {
5759                if (k < -NTL_MAX_LONG) zhalt("overflow in _ntl_zrshift");
5760                _ntl_zlshift(n, -k, rres);
5761                return;
5762        }
5763
5764        if (k == 1)
5765        {
5766                _ntl_z2div(n, rres);
5767                return;
5768        }
5769
5770        big = k / NTL_NBITS;
5771        small = k - big * NTL_NBITS;
5772
5773        if ((sn = n[0]) < 0)
5774                sn = -sn;
5775
5776        if ((big >= sn) || 
5777            ((big == sn - 1) && small && (!(n[sn] >> small))))
5778        /* The microsoft optimizer generates bad code without
5779           the above test for small != 0 */
5780        {
5781                _ntl_zzero(rres);
5782                return;
5783        }
5784
5785        sn -= big;
5786
5787        /* n won't move if res aliases n */
5788        _ntl_zsetlength(&res, sn);
5789        *rres = res;
5790
5791        if (small)
5792        {
5793                cosmall = NTL_NBITS - small;
5794                for (i = 1; i < sn; i++)
5795                        res[i] = (n[i + big] >> small) +
5796                                ((((unsigned long) n[i + big + 1]) << cosmall) & NTL_RADIXM);
5797                if (!(res[sn] = (n[sn + big] >> small)))
5798                        sn--;
5799        }
5800        else
5801                for (i = 1; i <= sn; i++)
5802                        res[i] = n[i + big];
5803        if (n[0] > 0)
5804                res[0] = sn;
5805        else
5806                res[0] = -sn;
5807}
5808
5809
5810long 
5811_ntl_zmakeodd(
5812        _ntl_verylong *nn
5813        )
5814{
5815        _ntl_verylong n = *nn;
5816        long i;
5817        long shift = 1;
5818
5819        if (!n || (!n[1] && (n[0] == 1)))
5820                return (0);
5821        while (!(n[shift]))
5822                shift++;
5823        i = n[shift];
5824        shift = NTL_NBITS * (shift - 1);
5825        while (!(i & 1))
5826        {
5827                shift++;
5828                i >>= 1;
5829        }
5830        _ntl_zrshift(n, shift, &n);
5831        return (shift);
5832}
5833
5834
5835long 
5836_ntl_znumtwos(
5837        _ntl_verylong n
5838        )
5839{
5840        long i;
5841        long shift = 1;
5842
5843        if (!n || (!n[1] && (n[0] == 1)))
5844                return (0);
5845        while (!(n[shift]))
5846                shift++;
5847        i = n[shift];
5848        shift = NTL_NBITS * (shift - 1);
5849        while (!(i & 1))
5850        {
5851                shift++;
5852                i >>= 1;
5853        }
5854        return (shift);
5855}
5856
5857
5858long 
5859_ntl_zsqrts(
5860        long n
5861        )
5862{
5863        long a;
5864        long ndiva;
5865        long newa;
5866        static _ntl_verylong ln=0;
5867        static _ntl_verylong rr=0;
5868
5869        if (n < 0) 
5870                zhalt("_ntl_zsqrts: negative argument");
5871
5872        if (n <= 0)
5873                return (0);
5874        if (n <= 3)
5875                return (1);
5876        if (n <= 8)
5877                return (2);
5878        if (n >= NTL_RADIX)
5879        {
5880                _ntl_zintoz(n,&ln);
5881                _ntl_zsqrt(ln,&rr);
5882                return(_ntl_ztoint(rr));
5883        }
5884        newa = 3L << (2 * (NTL_NBITSH - 1));
5885        a = 1L << NTL_NBITSH;
5886        while (!(n & newa))
5887        {
5888                newa >>= 2;
5889                a >>= 1;
5890        }
5891        while (1)
5892        {
5893                newa = ((ndiva = n / a) + a) / 2;
5894                if (newa - ndiva <= 1)
5895                {
5896                        if (newa * newa <= n)
5897                                return (newa);
5898                        else
5899                                return (ndiva);
5900                }
5901                a = newa;
5902        }
5903}
5904
5905
5906void _ntl_zsqrt(_ntl_verylong n, _ntl_verylong *rr)
5907{
5908        static _ntl_verylong a = 0;
5909        static _ntl_verylong ndiva = 0;
5910        static _ntl_verylong diff = 0;
5911        static _ntl_verylong r = 0;
5912        long i;
5913
5914        if (!n) {
5915                _ntl_zzero(rr);
5916                return;
5917        }
5918
5919        if ((i = n[0]) < 0)
5920                zhalt("negative argument in _ntl_zsqrt");
5921
5922        if (i == 1) {
5923                _ntl_zintoz(_ntl_zsqrts(n[1]), rr);
5924                return;
5925        }
5926
5927#ifdef NTL_GMP_HACK
5928   if (_ntl_gmp_hack && i >= NTL_GMP_SQRT_CROSS) {
5929      GT_INIT
5930
5931      lip_to_mpz(n, gt_1);
5932      mpz_sqrt(gt_2, gt_1);
5933      mpz_to_lip(&r, gt_2);
5934      _ntl_zcopy(r, rr);
5935      return;
5936   }
5937#endif
5938
5939        _ntl_zsetlength(&a, i);
5940        _ntl_zsetlength(&ndiva, i);
5941        _ntl_zsetlength(&diff, i);
5942
5943        a[(a[0] = (i + 1) / 2)] = _ntl_zsqrts(n[i]) + 1;
5944        if (!(i & 1))
5945                a[a[0]] <<= NTL_NBITSH;
5946
5947        if (a[a[0]] & NTL_RADIX) {
5948                a[a[0]] = 0;
5949                a[0]++;
5950                a[a[0]] = 1;
5951        }
5952
5953        for (i = a[0] - 1; i; i--)
5954                a[i] = 0;
5955
5956        while (1) {
5957                _ntl_zdiv(n, a, &ndiva, &r);
5958                _ntl_zadd(a, ndiva, &r);
5959                _ntl_zrshift(r, 1, &r);
5960                if (_ntl_zcompare(r, ndiva) <= 0) 
5961                        goto done;
5962
5963                _ntl_zsubpos(r, ndiva, &diff);
5964                if ((diff[0] == 1) && (diff[1] <= 1)) {
5965                        _ntl_zsq(r, &diff);
5966                        if (_ntl_zcompare(diff, n) > 0)
5967                                _ntl_zcopy(ndiva, &r);
5968
5969                        goto done;
5970                }
5971                _ntl_zcopy(r, &a);
5972        }
5973done:
5974        _ntl_zcopy(r, rr);
5975}
5976
5977
5978
5979void
5980_ntl_zgcd(
5981        _ntl_verylong mm1,
5982        _ntl_verylong mm2,
5983        _ntl_verylong *rres
5984        )
5985{
5986        long agrb;
5987        long shibl;
5988        static _ntl_verylong aa = 0;
5989        static _ntl_verylong bb = 0;
5990        static _ntl_verylong cc = 0;
5991        _ntl_verylong a;
5992        _ntl_verylong b;
5993        _ntl_verylong c;
5994        _ntl_verylong d;
5995        long m1negative;
5996        long m2negative;
5997
5998        /* _ntl_ziszero is necessary here and below to fix an
5999           an aliasing bug in LIP */
6000
6001        if (_ntl_ziszero(mm1))
6002        {
6003                if (mm2 != *rres)
6004                        _ntl_zcopy(mm2,rres);
6005                _ntl_zabs(rres);
6006                return;
6007        }
6008
6009        if (_ntl_ziszero(mm2))
6010        {
6011                if (mm1 != *rres)
6012                        _ntl_zcopy(mm1,rres);
6013                _ntl_zabs(rres);
6014                return;
6015        }
6016
6017        if (mm1 == mm2)
6018        {
6019                if (mm1 != *rres)
6020                        _ntl_zcopy(mm1, rres);
6021                _ntl_zabs(rres);
6022                return;
6023        }
6024
6025#ifdef NTL_GMP_HACK
6026   {
6027      long s1 = mm1[0];
6028      long s2 = mm2[0];
6029
6030      if (s1 < 0) s1 = -s1;
6031      if (s2 < 0) s2 = -s2;
6032
6033      if (_ntl_gmp_hack && s1 >= NTL_GMP_GCD_CROSS && s2 >= NTL_GMP_GCD_CROSS) {
6034         GT_INIT
6035
6036         lip_to_mpz(mm1, gt_1);
6037         lip_to_mpz(mm2, gt_2);
6038         mpz_gcd(gt_3, gt_1, gt_2);
6039         mpz_to_lip(&aa, gt_3);
6040         _ntl_zcopy(aa, rres);
6041         return;
6042      }
6043   }
6044#endif
6045
6046        if (m1negative = (mm1[0] < 0))
6047                mm1[0] = -mm1[0];
6048        if (m2negative = (mm2[0] < 0))
6049                mm2[0] = -mm2[0];
6050
6051        if ((agrb = mm1[0]) < mm2[0])
6052                agrb = mm2[0];
6053
6054        _ntl_zsetlength(&aa, agrb+1); 
6055        _ntl_zsetlength(&bb, agrb+1);
6056        _ntl_zsetlength(&cc, agrb+1);
6057
6058        if (mm1[0] != mm2[0])
6059        {
6060                if (mm1[0] > mm2[0])
6061                {
6062                        _ntl_zcopy(mm2, &aa);
6063                        _ntl_zmod(mm1, aa, &bb);
6064                }
6065                else
6066                {
6067                        _ntl_zcopy(mm1, &aa);
6068                        _ntl_zmod(mm2, aa, &bb);
6069                }
6070                if (!(bb[1]) && (bb[0] == 1))
6071                {
6072                        a = aa;
6073                        goto done;
6074                }
6075        }
6076        else
6077        {
6078                _ntl_zcopy(mm1, &aa);
6079                _ntl_zcopy(mm2, &bb);
6080        }
6081        if ((agrb = _ntl_zmakeodd(&aa)) < (shibl = _ntl_zmakeodd(&bb)))
6082                shibl = agrb;
6083        if (!(agrb = _ntl_zcompare(aa, bb)))
6084        {
6085                a = aa;
6086                goto endshift;
6087        }
6088        else if (agrb < 0)
6089        {
6090                a = bb;
6091                b = aa;
6092        }
6093        else
6094        {
6095                a = aa;
6096                b = bb;
6097        }
6098        c = cc;
6099        _ntl_zsubpos(a, b, &c);
6100        do
6101        {
6102                _ntl_zmakeodd(&c);
6103                if (!(agrb = _ntl_zcompare(b, c)))
6104                {
6105                        a = b;
6106                        goto endshift;
6107                }
6108                else if (agrb > 0)
6109                {
6110                        a = b;
6111                        b = c;
6112                        c = a;
6113                }
6114                else
6115                {
6116                        d = a;
6117                        a = c;
6118                        c = d;
6119                }
6120                _ntl_zsubpos(a, b, &c);
6121        } while (c[1] || c[0] != 1);
6122endshift:
6123        _ntl_zlshift(a, shibl, &a);
6124done:
6125        if (m1negative)
6126                mm1[0] = -mm1[0];
6127        if (m2negative)
6128                mm2[0] = -mm2[0];
6129        _ntl_zcopy(a, rres);
6130}
6131
6132
6133long _ntl_zsign(_ntl_verylong a)
6134{
6135        if (!a)
6136        {
6137                return (0);
6138        }
6139        if (a[0] < 0)
6140                return (-1);
6141        if (a[0] > 1)
6142                return (1);
6143        if (a[1])
6144                return (1);
6145        return (0);
6146}
6147
6148void _ntl_zabs(_ntl_verylong *pa)
6149{
6150        _ntl_verylong a = *pa;
6151
6152        if (!a)
6153                return;
6154        if (a[0] < 0)
6155                a[0] = (-a[0]);
6156}
6157
6158long 
6159_ntl_z2logs(
6160        long aa
6161        )
6162{
6163        long i = 0;
6164        unsigned long a;
6165
6166        if (aa < 0)
6167                a = - ((unsigned long) aa);
6168        else
6169                a = aa;
6170
6171        while (a>=256)
6172                i += 8, a >>= 8;
6173        if (a >=16)
6174                i += 4, a >>= 4;
6175        if (a >= 4)
6176                i += 2, a >>= 2;
6177        if (a >= 2)
6178                i += 2;
6179        else if (a >= 1)
6180                i++;
6181        return (i);
6182}
6183
6184long 
6185_ntl_z2log(
6186        _ntl_verylong a
6187        )
6188{
6189        long la;
6190
6191        if (!a)
6192                return (0);
6193        la = (a[0] > 0 ? a[0] : -a[0]);
6194        return ( NTL_NBITS * (la - 1) + _ntl_z2logs(a[la]) );
6195}
6196
6197
6198
6199long
6200_ntl_zscompare(
6201        _ntl_verylong a,
6202        long b
6203        )
6204{
6205        if (!b) 
6206                return _ntl_zsign(a);
6207        else {
6208                static _ntl_verylong c = 0;
6209                _ntl_zintoz(b, &c);
6210                return (_ntl_zcompare(a, c));
6211        }
6212}
6213
6214void
6215_ntl_zswap(
6216        _ntl_verylong *a,
6217        _ntl_verylong *b
6218        )
6219{
6220        _ntl_verylong c;
6221
6222        if ((*a && ((*a)[-1] & 1)) || (*b && ((*b)[-1] & 1))) {
6223                static _ntl_verylong t = 0; 
6224                _ntl_zcopy(*a, &t);
6225                _ntl_zcopy(*b, a);
6226                _ntl_zcopy(t, b);
6227                return;
6228        }
6229
6230        c = *a;
6231        *a = *b;
6232        *b = c;
6233}
6234
6235long
6236_ntl_ziszero(
6237        _ntl_verylong a
6238        )
6239{
6240        if (!a) return (1);
6241        if (a[1]) return (0);
6242        if (a[0]==1) return (1);
6243        return (0);
6244}
6245
6246long
6247_ntl_zodd(
6248        _ntl_verylong a
6249        )
6250{
6251        if (!a) return (0);
6252        return (a[1]&1);
6253}
6254
6255
6256long
6257_ntl_zbit(
6258        _ntl_verylong a,
6259        long p
6260        )
6261{
6262        long bl;
6263        long wh;
6264        long sa;
6265
6266        if (p < 0 || !a) return 0;
6267        bl = (p/NTL_NBITS);
6268        wh = 1L << (p - NTL_NBITS*bl);
6269        bl ++;
6270        sa = a[0];
6271        if (sa < 0) sa = -sa;
6272        if (sa < bl) return (0);
6273        if (a[bl] & wh) return (1);
6274        return (0);
6275}
6276
6277
6278void
6279_ntl_zlowbits(
6280        _ntl_verylong a,
6281        long b,
6282        _ntl_verylong *cc
6283        )
6284{
6285        _ntl_verylong c;
6286        long bl;
6287        long wh;
6288        long sa;
6289
6290        if (_ntl_ziszero(a) || (b<=0)) {
6291                _ntl_zzero(cc);
6292                return;
6293        }
6294
6295
6296        bl = b/NTL_NBITS;
6297        wh = b - NTL_NBITS*bl;
6298        if (wh != 0) 
6299                bl++;
6300        else
6301                wh = NTL_NBITS;
6302
6303        sa = a[0];
6304        if (sa < 0) sa = -sa;
6305
6306        if (sa < bl) {
6307                _ntl_zcopy(a,cc);
6308                _ntl_zabs(cc);
6309                return;
6310        }
6311
6312        c = *cc;
6313
6314        /* a won't move if c aliases a */
6315        _ntl_zsetlength(&c, bl);
6316        *cc = c;
6317
6318        for (sa=1; sa<bl; sa++)
6319                c[sa] = a[sa];
6320        c[bl] = a[bl]&((1L<<wh)-1);
6321        while ((bl>1) && (!c[bl]))
6322                bl --;
6323        c[0] = bl;
6324}
6325
6326
6327long _ntl_zslowbits(_ntl_verylong a, long p)
6328{
6329   static _ntl_verylong x = 0;
6330
6331   if (p > NTL_BITS_PER_LONG)
6332      p = NTL_BITS_PER_LONG;
6333
6334   _ntl_zlowbits(a, p, &x);
6335
6336   return _ntl_ztoint(x);
6337}
6338
6339
6340
6341
6342long
6343_ntl_zweights(
6344        long aa
6345        )
6346{
6347        unsigned long a;
6348        long res = 0;
6349
6350        if (aa < 0) 
6351                a = - ((unsigned long) aa);
6352        else
6353                a = aa;
6354   
6355        while (a) {
6356                if (a & 1) res ++;
6357                a >>= 1;
6358        }
6359        return (res);
6360}
6361
6362long
6363_ntl_zweight(
6364        _ntl_verylong a
6365        )
6366{
6367        long i;
6368        long res = 0;
6369
6370        if (!a) return (0);
6371        i = a[0];
6372        if (i<0) i = -i;
6373        for (;i;i--)
6374                res += _ntl_zweights(a[i]);
6375        return (res);
6376}
6377
6378
6379
6380void
6381_ntl_zand(
6382        _ntl_verylong a,
6383        _ntl_verylong b,
6384        _ntl_verylong *cc
6385        )
6386
6387{
6388        _ntl_verylong c;
6389        long sa;
6390        long sb;
6391        long sm;
6392        long a_alias;
6393        long b_alias;
6394
6395        if (_ntl_ziszero(a) || _ntl_ziszero(b)) {
6396                _ntl_zzero(cc);
6397                return;
6398        }
6399
6400        c = *cc;
6401        a_alias = (a == c);
6402        b_alias = (b == c);
6403
6404        sa = a[0];
6405        if (sa < 0) sa = -sa;
6406
6407        sb = b[0];
6408        if (sb < 0) sb = -sb;
6409
6410        sm = (sa > sb ? sb : sa );
6411
6412        _ntl_zsetlength(&c, sm);
6413        if (a_alias) a = c;
6414        if (b_alias) b = c;
6415        *cc = c;
6416
6417        for (sa = 1; sa <= sm; sa ++) 
6418                c[sa] = a[sa] & b[sa];
6419
6420        while ((sm > 1) && (!(c[sm])))
6421                sm --;
6422        c[0] = sm;
6423}
6424
6425void
6426_ntl_zxor(
6427        _ntl_verylong a,
6428        _ntl_verylong b,
6429        _ntl_verylong *cc
6430        )
6431{
6432        _ntl_verylong c;
6433        long sa;
6434        long sb;
6435        long sm;
6436        long la;
6437        long i;
6438        long a_alias;
6439        long b_alias;
6440
6441        if (_ntl_ziszero(a)) {
6442                _ntl_zcopy(b,cc);
6443                _ntl_zabs(cc);
6444                return;
6445        }
6446
6447        if (_ntl_ziszero(b)) {
6448                _ntl_zcopy(a,cc);
6449                _ntl_zabs(cc);
6450                return;
6451        }
6452
6453        c = *cc;
6454        a_alias = (a == c);
6455        b_alias = (b == c);
6456
6457        sa = a[0];
6458        if (sa < 0) sa = -sa;
6459
6460        sb = b[0];
6461        if (sb < 0) sb = -sb;
6462
6463        if (sa > sb) {
6464                la = sa;
6465                sm = sb;
6466        } else {
6467                la = sb;
6468                sm = sa;
6469        }
6470
6471        _ntl_zsetlength(&c, la);
6472        if (a_alias) a = c;
6473        if (b_alias) b = c;
6474        *cc = c;
6475
6476        for (i = 1; i <= sm; i ++)
6477                c[i] = a[i] ^ b[i];
6478
6479        if (sa > sb)
6480                for (;i <= la; i++) c[i] = a[i];
6481        else
6482                for (;i <= la; i++) c[i] = b[i];
6483
6484        while ((la > 1) && (!(c[la])))
6485                la --;
6486        c[0] = la;
6487}
6488
6489void
6490_ntl_zor(
6491        _ntl_verylong a,
6492        _ntl_verylong b,
6493        _ntl_verylong *cc
6494        )
6495{
6496        _ntl_verylong c;
6497        long sa;
6498        long sb;
6499        long sm;
6500        long la;
6501        long i;
6502        long a_alias;
6503        long b_alias;
6504
6505        if (_ntl_ziszero(a)) {
6506                _ntl_zcopy(b,cc);
6507                _ntl_zabs(cc);
6508                return;
6509        }
6510
6511        if (_ntl_ziszero(b)) {
6512                _ntl_zcopy(a,cc);
6513                _ntl_zabs(cc);
6514                return;
6515        }
6516
6517        c = *cc;
6518        a_alias = (a == c);
6519        b_alias = (b == c);
6520
6521        sa = a[0];
6522        if (sa < 0) sa = -sa;
6523
6524        sb = b[0];
6525        if (sb < 0) sb = -sb;
6526
6527        if (sa > sb) {
6528                la = sa;
6529                sm = sb;
6530        } else {
6531                la = sb;
6532                sm = sa;
6533        }
6534
6535        _ntl_zsetlength(&c, la);
6536        if (a_alias) a = c;
6537        if (b_alias) b = c;
6538        *cc = c;
6539
6540        for (i = 1; i <= sm; i ++)
6541                c[i] = a[i] | b[i];
6542
6543        if (sa > sb)
6544                for (;i <= la; i++) c[i] = a[i];
6545        else
6546                for (;i <= la; i++) c[i] = b[i];
6547
6548        c[0] = la;
6549}
6550
6551long
6552_ntl_zsetbit(
6553        _ntl_verylong *a,
6554        long b
6555        )
6556{
6557        long bl;
6558        long wh;
6559        long sa;
6560
6561        if (b<0) zhalt("_ntl_zsetbit: negative index");
6562
6563        if (_ntl_ziszero(*a)) {
6564                _ntl_zintoz(1,a);
6565                _ntl_zlshift(*a,b,a);
6566                return (0);
6567        }
6568
6569        bl = (b/NTL_NBITS);
6570        wh = 1L << (b - NTL_NBITS*bl);
6571        bl ++;
6572        sa = (*a)[0];
6573        if (sa<0) sa = -sa;
6574        if (sa >= bl) {
6575                sa = (*a)[bl] & wh;
6576                (*a)[bl] |= wh;
6577                if (sa) return (1);
6578                return (0);
6579        } else {
6580                _ntl_zsetlength(a,bl);
6581                sa ++;
6582                for (;sa<=bl;sa++) (*a)[sa]=0;
6583                if ((*a)[0] < 0)
6584                        (*a)[0] = -bl;
6585                else (*a)[0] = bl;
6586                (*a)[bl] |= wh;
6587                return (0);
6588        }
6589}
6590
6591long
6592_ntl_zswitchbit(
6593        _ntl_verylong *a,
6594        long p
6595        )
6596{
6597        long bl;
6598        long wh;
6599        long sa;
6600
6601        if (p < 0) zhalt("_ntl_zswitchbit: negative index");
6602
6603        if (_ntl_ziszero(*a)) {
6604                _ntl_zintoz(1,a);
6605                _ntl_zlshift(*a,p,a);
6606                return (0);
6607        }
6608
6609        bl = (p/NTL_NBITS);
6610        wh = 1L << (p - NTL_NBITS*bl);
6611        bl ++;
6612        sa = (*a)[0];
6613        if (sa < 0) sa = -sa;
6614        if ((sa < bl) || (!((*a)[bl] & wh))) {
6615                _ntl_zsetbit(a,p);
6616                return (0);
6617        }
6618        (*a)[bl] ^= wh;
6619        while ((sa>1) && (!(*a)[sa]))
6620                sa --;
6621        if ((*a)[0] > 0) (*a)[0] = sa;
6622        else (*a)[0] = -sa;
6623        return (1);
6624}
6625
6626
6627long _ntl_zsize(_ntl_verylong rep)
6628{
6629   if (!rep || (rep[0] == 1 && rep[1] == 0))
6630      return 0;
6631   else if (rep[0] < 0)
6632      return -rep[0];
6633   else
6634      return rep[0];
6635}
6636
6637
6638long _ntl_zdigit(_ntl_verylong rep, long i) 
6639{
6640   long sa;
6641   if (i < 0 || !rep) return 0;
6642
6643   sa = rep[0];
6644   if (sa < 0) sa = -sa;
6645   if (i >= sa) return 0;
6646   return rep[i+1];
6647}
6648
6649long _ntl_zisone(_ntl_verylong rep)
6650{
6651   return rep != 0 && rep[0] == 1 && rep[1] == 1;
6652}
6653
6654long _ntl_zsptest(_ntl_verylong rep)
6655{
6656   return !rep || rep[0] == 1 || rep[0] == -1;
6657}
6658
6659long _ntl_zwsptest(_ntl_verylong rep)
6660{
6661   return !rep || rep[0] == 1 || rep[0] == -1;
6662}
6663
6664long _ntl_zcrtinrange(_ntl_verylong g, _ntl_verylong a)
6665{
6666   long sa, sg, carry, i, diff;
6667
6668   if (!a || a[0] < 0 || (a[0] == 1 && a[1] == 0)) return 0;
6669
6670   sa = a[0];
6671
6672   if (!g) return 1;
6673
6674   sg = g[0];
6675
6676   if (sg == 1 && g[1] == 0) return 1;
6677
6678   if (sg < 0) sg = -sg;
6679
6680   if (sa-sg > 1) return 1;
6681
6682   if (sa-sg < 0) return 0;
6683
6684   carry=0;
6685
6686   if (sa-sg == 1) {
6687      if (a[sa] > 1) return 1;
6688      carry = 1;
6689   }
6690
6691   i = sg;
6692   diff = 0;
6693   while (i > 0 && diff == 0) {
6694      diff = (carry << (NTL_NBITS-1)) + (a[i] >> 1) - g[i];
6695      carry = (a[i] & 1);
6696      i--;
6697   }
6698
6699   if (diff == 0) {
6700      if (carry) return 1;
6701      return (g[0] > 0);
6702   }
6703   else
6704      return (diff > 0);
6705}
6706
6707
6708
6709void _ntl_zfrombytes(_ntl_verylong *x, const unsigned char *p, long n)
6710{
6711   long sz;
6712   long i;
6713   _ntl_verylong a;
6714   long bitpos, wordpos, bitoffset, diff;
6715
6716   if (n <= 0) {
6717      _ntl_zzero(x);
6718      return;
6719   }
6720
6721   if (n > (NTL_MAX_LONG-(NTL_NBITS-1))/8)
6722      zhalt("ZZFromBytes: excessive length");
6723
6724   sz = (n*8 + NTL_NBITS-1)/NTL_NBITS;
6725
6726   _ntl_zsetlength(x, sz);
6727
6728   a = *x;
6729
6730   for (i = 1; i <= sz; i++)
6731      a[i] = 0;
6732
6733   for (i = 0; i < n; i++) {
6734      bitpos = i*8;
6735      wordpos = bitpos/NTL_NBITS;
6736      bitoffset = bitpos - wordpos*NTL_NBITS;
6737      diff = NTL_NBITS-bitoffset;
6738
6739      if (diff < 8) {
6740         a[wordpos+1] |= 
6741            ((( ((unsigned long)(p[i])) & 255UL ) << bitoffset) & NTL_RADIXM);
6742         a[wordpos+2] = ( ((long)(p[i])) & 255 ) >> diff;
6743      }
6744      else {
6745         a[wordpos+1] |= (( ((long)(p[i])) & 255 ) << bitoffset);
6746      }
6747   }
6748
6749   while (sz > 1 && a[sz] == 0) sz--;
6750   a[0] = sz;
6751}
6752
6753
6754void _ntl_zbytesfromz(unsigned char *p, _ntl_verylong a, long nn)
6755{
6756   long k = _ntl_z2log(a);
6757   long n = (k+7)/8;
6758   long sz = _ntl_zsize(a);
6759   long min_n =  ((n < nn) ? n : nn);
6760
6761   long i;
6762
6763   for (i = 0; i < min_n; i++) {
6764      long bitpos = i*8;
6765      long wordpos = bitpos/NTL_NBITS;
6766      long bitoffset = bitpos - wordpos*NTL_NBITS;
6767      long diff;
6768
6769      p[i] = (a[wordpos+1] >> bitoffset) & 255;
6770
6771      diff = NTL_NBITS - bitoffset;
6772
6773      if (diff < 8 && wordpos < sz-1) {
6774         long msk = (1L << (8-diff))-1;
6775         p[i] |= ((a[wordpos+2] & msk) << diff);
6776      }
6777   }
6778
6779   for (i = min_n; i < nn; i++)
6780      p[i] = 0;
6781}
6782
6783
6784
6785long _ntl_zblock_construct_alloc(_ntl_verylong *x, long d, long n)
6786{
6787   long nwords, nbytes, AllocAmt, m, *p, *q, j;
6788
6789
6790   /* check n value */
6791
6792   if (n <= 0)
6793      zhalt("block construct: n must be positive");
6794
6795   /* check d value */
6796
6797   if (d <= 0) 
6798      zhalt("block construct: d must be positive");
6799
6800   if (NTL_OVERFLOW(d, NTL_NBITS, NTL_NBITS) || 
6801       NTL_OVERFLOW(d, sizeof(long), 3*sizeof(long)))
6802      zhalt("block construct: d too large");
6803
6804#ifdef L_TO_G_CHECK_LEN
6805   /* this makes sure that numbers don't get too big for GMP */
6806   if (d >= (1L << (NTL_BITS_PER_INT-4)))
6807      zhalt("size too big for GMP");
6808#endif
6809
6810   nwords = d + 3;
6811   nbytes = nwords*sizeof(long);
6812   
6813   AllocAmt = (NTL_MAX_ALLOC_BLOCK - sizeof(long)) / nbytes;
6814   if (AllocAmt == 0) AllocAmt = 1;
6815
6816   if (AllocAmt < n)
6817      m = AllocAmt;
6818   else
6819      m = n;
6820
6821   p = (long *) NTL_MALLOC(m, nbytes, sizeof(long));
6822   if (!p) zhalt("out of memory in block construct");
6823
6824   *p = m;
6825
6826   q = p+2;
6827   *x = q;
6828   
6829   for (j = 0; j < m; j++) {
6830      q[-1] = ((d+1) << 1) | 1;
6831      q[0] = 1;
6832      q[1] = 0;
6833      q += nwords;
6834   }
6835
6836   return m;
6837}
6838
6839void _ntl_zblock_construct_set(_ntl_verylong x, _ntl_verylong *y, long i)
6840{
6841   long d, size;
6842
6843   d = (x[-1] >> 1) - 1;
6844   size = d + 3;
6845
6846   *y = x + i*size;
6847}
6848
6849
6850long _ntl_zblock_destroy(_ntl_verylong x)
6851{
6852   long m, *p;
6853
6854   p = x - 2;
6855   m = *p;
6856   free(p);
6857   return m;
6858}
6859
6860
6861long _ntl_zblock_storage(long d)
6862{
6863   long size = d+3;
6864   return size * (sizeof (long)) + sizeof(_ntl_verylong);
6865}
6866
6867
6868
6869
6870/* The following routines provide special support for ZZ_pX
6871 * arithmetic. */
6872
6873
6874
6875/* this is a generic single-precision mul mod that will work
6876 * on any platform */
6877
6878
6879#define SP_MUL_MOD(r, a, b, n)  \
6880{  \
6881   long l__a = (a);  \
6882   long l__b = (b);  \
6883   long l__n = (n);  \
6884   long l__q;  \
6885   unsigned long l__res;  \
6886  \
6887   l__q  = (long) ((((double) l__a) * ((double) l__b)) / ((double) l__n));  \
6888   l__res = ((unsigned long) l__a)*((unsigned long) l__b) - \
6889            ((unsigned long) l__q)*((unsigned long) l__n);  \
6890   if (l__res >> (NTL_BITS_PER_LONG-1))  \
6891      l__res += l__n;  \
6892   else if (((long) l__res) >= l__n)  \
6893      l__res -= l__n;  \
6894  \
6895   r = (long) l__res;  \
6896}
6897
6898
6899
6900
6901static
6902void sp_ext_eucl(long *dd, long *ss, long *tt, long a, long b)
6903{
6904   long  u, v, u0, v0, u1, v1, u2, v2, q, r;
6905
6906   long aneg = 0, bneg = 0;
6907
6908   if (a < 0) {
6909      if (a < -NTL_MAX_LONG) zhalt("integer overflow");
6910      a = -a;
6911      aneg = 1;
6912   }
6913
6914   if (b < 0) {
6915      if (b < -NTL_MAX_LONG) zhalt("integer overflow");
6916      b = -b;
6917      bneg = 1;
6918   }
6919
6920   u1=1; v1=0;
6921   u2=0; v2=1;
6922   u = a; v = b;
6923
6924   while (v != 0) {
6925      q = u / v;
6926      r = u % v;
6927      u = v;
6928      v = r;
6929      u0 = u2;
6930      v0 = v2;
6931      u2 =  u1 - q*u2;
6932      v2 = v1- q*v2;
6933      u1 = u0;
6934      v1 = v0;
6935   }
6936
6937   if (aneg)
6938      u1 = -u1;
6939
6940   if (bneg)
6941      v1 = -v1;
6942
6943   *dd = u;
6944   *ss = u1;
6945   *tt = v1;
6946}
6947
6948
6949static
6950long sp_inv_mod(long a, long n)
6951{
6952   long d, s, t;
6953
6954   sp_ext_eucl(&d, &s, &t, a, n);
6955   if (d != 1) zhalt("inverse undefined");
6956   if (s < 0)
6957      return s + n;
6958   else
6959      return s;
6960}
6961
6962
6963/* Data structures and algorithms for fast Chinese Remaindering */
6964
6965
6966struct crt_body_lip {
6967   _ntl_verylong *v;
6968   long sbuf;
6969   long n;
6970};
6971
6972#ifdef NTL_GMP_HACK
6973
6974struct crt_body_gmp {
6975   MP_INT *v;
6976   long sbuf;
6977   long n;
6978   mpz_t buf;
6979};
6980
6981struct crt_body_gmp1 {
6982   long n;
6983   long levels;
6984   long *primes;
6985   long *inv_vec;
6986   long *val_vec;
6987   long *index_vec;
6988   MP_INT *prod_vec;
6989   MP_INT *rem_vec;
6990   MP_INT *coeff_vec;
6991   MP_INT temps[2];
6992   mpz_t modulus;
6993};
6994
6995#endif
6996
6997
6998struct crt_body {
6999   long strategy;
7000
7001   union {
7002      struct crt_body_lip L;
7003
7004#ifdef NTL_GMP_HACK
7005      struct crt_body_gmp G;
7006      struct crt_body_gmp1 G1;
7007#endif
7008   } U;
7009};
7010
7011
7012long _ntl_crt_struct_special(void *crt_struct)
7013{
7014   struct crt_body *c = (struct crt_body *) crt_struct;
7015   return (c->strategy == 2);
7016}
7017
7018
7019void _ntl_crt_struct_init(void **crt_struct, long n, _ntl_verylong p,
7020                          const long *primes)
7021{
7022   struct crt_body *c;
7023
7024   c = (struct crt_body *) NTL_MALLOC(1, sizeof(struct crt_body), 0);
7025   if (!c) zhalt("out of memory");
7026
7027
7028#ifdef NTL_GMP_HACK
7029   if (_ntl_gmp_hack && n >= 600) {
7030      struct crt_body_gmp1 *C = &c->U.G1;
7031      long *q;
7032      long i, j;
7033      long levels, vec_len;
7034      long *val_vec, *inv_vec;
7035      long *index_vec;
7036      MP_INT *prod_vec, *rem_vec, *coeff_vec;
7037      MP_INT *temps;
7038
7039      mpz_init(C->modulus);
7040      lip_to_mpz(p, C->modulus);
7041
7042      temps = &C->temps[0];
7043
7044      mpz_init(&temps[0]);
7045      mpz_init(&temps[1]);
7046   
7047      q = (long *) NTL_MALLOC(n, sizeof(long), 0);
7048      if (!q) zhalt("out of memory");
7049
7050      val_vec = (long *) NTL_MALLOC(n, sizeof(long), 0);
7051      if (!val_vec) zhalt("out of memory");
7052
7053      inv_vec = (long *) NTL_MALLOC(n, sizeof(long), 0);
7054      if (!inv_vec) zhalt("out of memory");
7055
7056      for (i = 0; i < n; i++)
7057         q[i] = primes[i];
7058
7059      levels = 0;
7060      while ((n >> levels) >= 16) levels++;
7061
7062      vec_len = (1L << levels) - 1;
7063
7064      index_vec = (long *) NTL_MALLOC((vec_len+1), sizeof(long), 0);
7065      if (!index_vec) zhalt("out of memory");
7066
7067      prod_vec = (MP_INT *) NTL_MALLOC(vec_len, sizeof(MP_INT), 0);
7068      if (!prod_vec) zhalt("out of memory");
7069
7070      rem_vec = (MP_INT *) NTL_MALLOC(vec_len, sizeof(MP_INT), 0);
7071      if (!rem_vec) zhalt("out of memory");
7072
7073      coeff_vec = (MP_INT *) NTL_MALLOC(n, sizeof(MP_INT), 0);
7074      if (!coeff_vec) zhalt("out of memory");
7075
7076      for (i = 0; i < vec_len; i++)
7077         mpz_init(&prod_vec[i]);
7078
7079      for (i = 0; i < vec_len; i++)
7080         mpz_init(&rem_vec[i]);
7081
7082      for (i = 0; i < n; i++)
7083         mpz_init(&coeff_vec[i]);
7084
7085      index_vec[0] = 0;
7086      index_vec[1] = n;
7087
7088      for (i = 0; i <= levels-2; i++) {
7089         long start = (1L << i) - 1;
7090         long finish = (1L << (i+1)) - 2;
7091         for (j = finish; j >= start; j--) {
7092            index_vec[2*j+2] = index_vec[j] + (index_vec[j+1] - index_vec[j])/2;
7093            index_vec[2*j+1] = index_vec[j];
7094         }
7095         index_vec[2*finish+3] = n;
7096      }
7097
7098      for (i = (1L << (levels-1)) - 1; i < vec_len; i++) {
7099         /* multiply primes index_vec[i]..index_vec[i+1]-1 into
7100          * prod_vec[i]
7101          */
7102
7103         mpz_set_ui(&prod_vec[i], 1);
7104         for (j = index_vec[i]; j < index_vec[i+1]; j++)
7105            mpz_mul_ui(&prod_vec[i], &prod_vec[i], q[j]);
7106      }
7107
7108      for (i = (1L << (levels-1)) - 1; i < vec_len; i++) {
7109         for (j = index_vec[i]; j < index_vec[i+1]; j++)
7110            mpz_fdiv_q_ui(&coeff_vec[j], &prod_vec[i], q[j]);
7111      }
7112
7113      for (i = (1L << (levels-1)) - 2; i >= 0; i--)
7114         mpz_mul(&prod_vec[i], &prod_vec[2*i+1], &prod_vec[2*i+2]);
7115
7116
7117      /* the following is asymptotically the bottleneck...but it
7118       * it probably doesn't matter. */
7119
7120      for (i = 0; i < n; i++) {
7121         long tt;
7122         mpz_fdiv_q_ui(&temps[0], &prod_vec[0], q[i]);
7123         tt = mpn_mod_1(temps[0]._mp_d, temps[0]._mp_size, q[i]);
7124         inv_vec[i] = sp_inv_mod(tt, q[i]);
7125      }
7126
7127      c->strategy = 2;
7128      C->n = n;
7129      C->primes = q;
7130      C->val_vec = val_vec;
7131      C->inv_vec = inv_vec;
7132      C->levels = levels;
7133      C->index_vec = index_vec;
7134      C->prod_vec = prod_vec;
7135      C->rem_vec = rem_vec;
7136      C->coeff_vec = coeff_vec;
7137
7138      *crt_struct = (void *) c;
7139      return;
7140   }
7141
7142   if (_ntl_gmp_hack) {
7143      struct crt_body_gmp *C = &c->U.G;
7144      long i;
7145      c->strategy = 1;
7146
7147      C->n = n;
7148      C->v = (MP_INT *) NTL_MALLOC(n, sizeof(MP_INT), 0);
7149      if (!C->v) zhalt("out of memory");
7150
7151      for (i = 0; i < n; i++)
7152         mpz_init(&C->v[i]);
7153
7154      C->sbuf = L_TO_G(p[0])+2;
7155
7156      mpz_init(C->buf);
7157      _mpz_realloc(C->buf, C->sbuf);
7158
7159      *crt_struct = (void *) c;
7160      return;
7161   }
7162   
7163#endif
7164
7165   {
7166      struct crt_body_lip *C = &c->U.L;
7167      long i;
7168      c->strategy = 0;
7169   
7170      C->n = n;
7171   
7172      C->v = (_ntl_verylong *) NTL_MALLOC(n, sizeof(_ntl_verylong), 0);
7173      if (!C->v) zhalt("out of memory");
7174   
7175      for (i = 0; i < n; i++) 
7176         C->v[i] = 0;
7177   
7178      C->sbuf = p[0]+3;
7179   
7180      *crt_struct = (void *) c;
7181   }
7182}
7183
7184void _ntl_crt_struct_insert(void *crt_struct, long i, _ntl_verylong m)
7185{
7186   struct crt_body *c = (struct crt_body *) crt_struct;
7187
7188   switch (c->strategy) {
7189
7190   case 0: {
7191      _ntl_zcopy(m, &c->U.L.v[i]);
7192      break;
7193   }
7194
7195#ifdef NTL_GMP_HACK
7196   case 1: {
7197      lip_to_mpz(m, &c->U.G.v[i]);
7198      break;
7199   }
7200#endif
7201
7202   default:
7203      zhalt("_ntl_crt_struct_insert: inconsistent strategy");
7204     
7205   } /* end switch */
7206}
7207
7208void _ntl_crt_struct_free(void *crt_struct)
7209{
7210   struct crt_body *c = (struct crt_body *) crt_struct;
7211
7212   switch (c->strategy) {
7213
7214   case 0: {
7215      struct crt_body_lip *C = &c->U.L;
7216      long i, n;
7217
7218      n = C->n;
7219   
7220      for (i = 0; i < n; i++) 
7221         _ntl_zfree(&C->v[i]);
7222
7223      free(C->v);
7224   
7225      free(c);
7226
7227      break;
7228   }
7229
7230#ifdef NTL_GMP_HACK
7231
7232   case 1: {
7233      struct crt_body_gmp *C = &c->U.G;
7234      long i, n;
7235
7236      n = C->n;
7237   
7238      for (i = 0; i < n; i++) 
7239         mpz_clear(&C->v[i]);
7240
7241      mpz_clear(C->buf);
7242
7243      free(C->v);
7244   
7245      free(c);
7246      break;
7247   }
7248
7249   case 2: { 
7250      struct crt_body_gmp1 *C = &c->U.G1;
7251      long n = C->n;
7252      long levels = C->levels;
7253      long *primes = C->primes;
7254      long *inv_vec = C->inv_vec;
7255      long *val_vec = C->val_vec;
7256      long *index_vec = C->index_vec;
7257      MP_INT *prod_vec = C->prod_vec;
7258      MP_INT *rem_vec = C->rem_vec;
7259      MP_INT *coeff_vec = C->coeff_vec;
7260      MP_INT *temps = C->temps;
7261      MP_INT *modulus = C->modulus;
7262      long vec_len = (1L << levels) - 1;
7263
7264      long i;
7265
7266      for (i = 0; i < vec_len; i++)
7267         mpz_clear(&prod_vec[i]);
7268
7269      for (i = 0; i < vec_len; i++)
7270         mpz_clear(&rem_vec[i]);
7271
7272      for (i = 0; i < n; i++)
7273         mpz_clear(&coeff_vec[i]);
7274
7275      mpz_clear(&temps[0]);
7276      mpz_clear(&temps[1]);
7277
7278      mpz_clear(modulus);
7279
7280      free(primes);
7281      free(inv_vec);
7282      free(val_vec);
7283      free(index_vec);
7284      free(prod_vec);
7285      free(rem_vec);
7286      free(coeff_vec);
7287
7288      free(c);
7289      break;
7290   }
7291
7292#endif
7293
7294   default:
7295
7296      zhalt("_ntl_crt_struct_free: inconsistent strategy");
7297
7298   } /* end case */
7299}
7300
7301
7302
7303#ifdef NTL_GMP_HACK
7304
7305
7306static
7307void mpz_add_mul_many(MP_INT *res, MP_INT *a, long *b, 
7308                      long n, long sz)
7309
7310{
7311   mp_limb_t *xx, *yy; 
7312   long i, sx;
7313   long sy;
7314   mp_limb_t carry;
7315
7316   sx = sz + 2;
7317   if (sx > res->_mp_alloc)
7318      _mpz_realloc(res, sx);
7319
7320   xx = res->_mp_d;
7321
7322   for (i = 0; i < sx; i++)
7323      xx[i] = 0;
7324
7325   for (i = 0; i < n; i++) {
7326      yy = a[i]._mp_d;
7327      sy = a[i]._mp_size; 
7328
7329      if (!sy || !b[i]) continue;
7330
7331      carry = mpn_addmul_1(xx, yy, sy, b[i]);
7332      yy = xx + sy;
7333      *yy += carry;
7334
7335      if (*yy < carry) { /* unsigned comparison! */
7336         do {
7337            yy++;
7338            *yy += 1;
7339         } while (*yy == 0);
7340      }
7341   }
7342
7343   while (sx > 0 && xx[sx-1] == 0) sx--;
7344   res->_mp_size = sx;
7345}
7346
7347#endif
7348
7349void _ntl_crt_struct_eval(void *crt_struct, _ntl_verylong *x, const long *b)
7350{
7351   struct crt_body *c = (struct crt_body *) crt_struct;
7352
7353   switch (c->strategy) {
7354
7355   case 0: {
7356      struct crt_body_lip *C = &c->U.L;
7357
7358      _ntl_verylong xx, yy, *a;
7359      long i, sx, n;
7360   
7361      n = C->n;
7362      sx = C->sbuf;
7363   
7364      _ntl_zsetlength(x, sx);
7365      xx = *x;
7366   
7367      a = C->v;
7368   
7369   
7370      for (i = 1; i <= sx; i++)
7371         xx[i] = 0;
7372   
7373      xx++;
7374   
7375      for (i = 0; i < n; i++) {
7376         yy = a[i];
7377   
7378         if (!yy || !b[i]) continue;
7379   
7380         zaddmul(b[i], xx, yy);
7381         yy = xx + yy[0];
7382     
7383         if ((*yy) >= NTL_RADIX) {
7384            (*yy) -= NTL_RADIX;
7385            yy++;
7386            while ((*yy) == NTL_RADIX-1) {
7387               *yy = 0;
7388               yy++;
7389            }
7390            (*yy)++;
7391         }
7392      }
7393   
7394      xx--;
7395      while (sx > 1 && xx[sx] == 0) sx--;
7396      xx[0] = sx;
7397
7398      break;
7399   }
7400
7401#ifdef NTL_GMP_HACK
7402
7403   case 1: {
7404      struct crt_body_gmp *C = &c->U.G;
7405
7406      mp_limb_t *xx, *yy; 
7407      MP_INT *a;
7408      long i, sx, n;
7409      long sy;
7410      mp_limb_t carry;
7411   
7412      n = C->n;
7413      sx = C->sbuf;
7414   
7415      xx = C->buf->_mp_d;
7416
7417      for (i = 0; i < sx; i++)
7418         xx[i] = 0;
7419   
7420      a = C->v;
7421   
7422      for (i = 0; i < n; i++) {
7423         yy = a[i]._mp_d;
7424         sy = a[i]._mp_size; 
7425   
7426         if (!sy || !b[i]) continue;
7427   
7428         carry = mpn_addmul_1(xx, yy, sy, b[i]);
7429         yy = xx + sy;
7430         *yy += carry;
7431
7432         if (*yy < carry) { /* unsigned comparison! */
7433            do {
7434               yy++;
7435               *yy += 1;
7436            } while (*yy == 0);
7437         }
7438      }
7439   
7440      while (sx > 0 && xx[sx-1] == 0) sx--;
7441      C->buf->_mp_size = sx;
7442      mpz_to_lip(x, C->buf);
7443      break;
7444   }
7445
7446   case 2: {
7447      struct crt_body_gmp1 *C = &c->U.G1;
7448
7449      long n = C->n;
7450      long levels = C->levels;
7451      long *primes = C->primes;
7452      long *inv_vec = C->inv_vec;
7453      long *val_vec = C->val_vec;
7454      long *index_vec = C->index_vec;
7455      MP_INT *prod_vec = C->prod_vec;
7456      MP_INT *rem_vec = C->rem_vec;
7457      MP_INT *coeff_vec = C->coeff_vec;
7458      MP_INT *temps = C->temps;
7459      long vec_len = (1L << levels) - 1;
7460
7461      long i, j;
7462
7463      for (i = 0; i < n; i++) {
7464         SP_MUL_MOD(val_vec[i], b[i], inv_vec[i], primes[i]);
7465      }
7466
7467      for (i = (1L << (levels-1)) - 1; i < vec_len; i++) {
7468         long j1 = index_vec[i];
7469         long j2 = index_vec[i+1];
7470         mpz_add_mul_many(&rem_vec[i], &coeff_vec[j1], &val_vec[j1], j2-j1, 
7471                          prod_vec[i]._mp_size);
7472      }
7473
7474      for (i = (1L << (levels-1)) - 2; i >= 0; i--) {
7475         mpz_mul(&temps[0], &prod_vec[2*i+1], &rem_vec[2*i+2]);
7476         mpz_mul(&temps[1], &rem_vec[2*i+1], &prod_vec[2*i+2]);
7477         mpz_add(&rem_vec[i], &temps[0], &temps[1]);
7478      }
7479
7480      /* temps[0] = rem_vec[0] mod prod_vec[0] (least absolute residue) */
7481      mpz_fdiv_r(&temps[0], &rem_vec[0], &prod_vec[0]);
7482      mpz_sub(&temps[1], &temps[0], &prod_vec[0]);
7483      if (mpz_cmpabs(&temps[0], &temps[1]) > 0)
7484         mpz_set(&temps[0], &temps[1]);
7485
7486      mpz_fdiv_r(&temps[1], &temps[0], C->modulus);
7487      mpz_to_lip(x, &temps[1]);
7488
7489      break;
7490   }
7491#endif
7492
7493   default:
7494
7495      zhalt("_crt_struct_eval: inconsistent strategy");
7496
7497   } /* end case */
7498}
7499
7500
7501
7502
7503
7504
7505/* Data structures and algorithms for multi-modulus remaindering */
7506
7507
7508struct rem_body_lip {
7509   long n;
7510   long *primes;
7511};
7512
7513#ifdef NTL_GMP_HACK
7514
7515struct rem_body_gmp {
7516   long n;
7517   long levels;
7518   long *primes;
7519   long *index_vec;
7520   MP_INT *prod_vec;
7521   MP_INT *rem_vec;
7522};
7523
7524#endif
7525
7526
7527
7528#ifdef NTL_SINGLE_MUL
7529
7530struct rem_body_sm {
7531   long n;
7532   long *primes;
7533   double **tbl;
7534};
7535
7536#endif
7537
7538
7539#if (defined(NTL_TBL_REM) && !defined(NTL_SINGLE_MUL))
7540
7541struct rem_body_tbl {
7542   long n;
7543   long *primes;
7544   long **tbl;
7545};
7546
7547#endif
7548
7549struct rem_body {
7550   long strategy;
7551
7552   union {
7553      struct rem_body_lip L;
7554#ifdef NTL_GMP_HACK
7555      struct rem_body_gmp G;
7556#endif
7557#ifdef NTL_SINGLE_MUL
7558      struct rem_body_sm S;
7559#endif
7560#if (defined(NTL_TBL_REM) && !defined(NTL_SINGLE_MUL))
7561      struct rem_body_tbl T;
7562#endif
7563   } U;
7564};
7565
7566
7567
7568void _ntl_rem_struct_init(void **rem_struct, long n, _ntl_verylong modulus, 
7569                          const long *p)
7570{
7571   struct rem_body *r;
7572
7573   r = (struct rem_body *) NTL_MALLOC(1, sizeof(struct rem_body), 0);
7574   if (!r) zhalt("out of memory");
7575   
7576#ifdef NTL_GMP_HACK
7577   if (_ntl_gmp_hack && n >= 32) {
7578      struct rem_body_gmp *R = &r->U.G;
7579
7580      long *q;
7581      long i, j;
7582      long levels, vec_len;
7583      long *index_vec;
7584      MP_INT *prod_vec, *rem_vec;
7585   
7586      q = (long *) NTL_MALLOC(n, sizeof(long), 0);
7587      if (!q) zhalt("out of memory");
7588   
7589      for (i = 0; i < n; i++)
7590         q[i] = p[i];
7591
7592      levels = 0;
7593      while ((n >> levels) >= 4) levels++;
7594
7595      vec_len = (1L << levels) - 1;
7596
7597      index_vec = (long *) NTL_MALLOC((vec_len+1), sizeof(long), 0);
7598      if (!index_vec) zhalt("out of memory");
7599
7600      prod_vec = (MP_INT *) NTL_MALLOC(vec_len, sizeof(MP_INT), 0);
7601      if (!prod_vec) zhalt("out of memory");
7602
7603      rem_vec = (MP_INT *) NTL_MALLOC(vec_len, sizeof(MP_INT), 0);
7604      if (!rem_vec) zhalt("out of memory");
7605
7606      for (i = 0; i < vec_len; i++)
7607         mpz_init(&prod_vec[i]);
7608
7609      for (i = 0; i < vec_len; i++)
7610         mpz_init(&rem_vec[i]);
7611
7612      index_vec[0] = 0;
7613      index_vec[1] = n;
7614
7615      for (i = 0; i <= levels-2; i++) {
7616         long start = (1L << i) - 1;
7617         long finish = (1L << (i+1)) - 2;
7618         for (j = finish; j >= start; j--) {
7619            index_vec[2*j+2] = index_vec[j] + (index_vec[j+1] - index_vec[j])/2;
7620            index_vec[2*j+1] = index_vec[j];
7621         }
7622         index_vec[2*finish+3] = n;
7623      }
7624
7625      for (i = (1L << (levels-1)) - 1; i < vec_len; i++) {
7626         /* multiply primes index_vec[i]..index_vec[i+1]-1 into
7627          * prod_vec[i]
7628          */
7629
7630         mpz_set_ui(&prod_vec[i], 1);
7631         for (j = index_vec[i]; j < index_vec[i+1]; j++)
7632            mpz_mul_ui(&prod_vec[i], &prod_vec[i], q[j]);
7633      }
7634
7635      for (i = (1L << (levels-1)) - 2; i >= 3; i--)
7636         mpz_mul(&prod_vec[i], &prod_vec[2*i+1], &prod_vec[2*i+2]);
7637
7638      r->strategy = 1;
7639      R->n = n;
7640      R->primes = q;
7641      R->levels = levels;
7642      R->index_vec = index_vec;
7643      R->prod_vec = prod_vec;
7644      R->rem_vec = rem_vec;
7645
7646      *rem_struct = (void *) r;
7647
7648      return;
7649   }
7650#endif
7651
7652#ifdef NTL_SINGLE_MUL
7653   {
7654      struct rem_body_sm *R = &r->U.S;
7655
7656      long *qq;
7657      long i;
7658      double **tbl;
7659      long t, t1, j, q;
7660      long sz = modulus[0];
7661   
7662      r->strategy = 2;
7663      R->n = n;
7664      qq = (long *) NTL_MALLOC(n, sizeof(long), 0);
7665      if (!qq) zhalt("out of memory");
7666      R->primes = qq;
7667   
7668      for (i = 0; i < n; i++)
7669         qq[i] = p[i];
7670
7671      tbl = (double **) NTL_MALLOC(n, sizeof(double *), 0);
7672      if (!tbl) zhalt("out of space");
7673
7674      for (i = 0; i < n; i++) {
7675         tbl[i] = (double *) NTL_MALLOC(sz, sizeof(double), 0);
7676         if (!tbl[i]) zhalt("out of space");
7677      }
7678      R->tbl = tbl;
7679   
7680   
7681      for (i = 0; i < n; i++) {
7682         q = qq[i];
7683         t = (((long)1) << NTL_NBITS) % q;
7684         t1 = 1;
7685         tbl[i][0] = (double) 1;
7686         for (j = 1; j < sz; j++) {
7687            SP_MUL_MOD(t1, t1, t, q);
7688            tbl[i][j] = (double) t1;
7689         }
7690      }
7691     
7692      *rem_struct = (void *) r;
7693      return;
7694   }
7695
7696#endif
7697
7698#if (defined(NTL_TBL_REM) && !defined(NTL_SINGLE_MUL))
7699
7700   {
7701      struct rem_body_tbl *R = &r->U.T;
7702
7703      long *qq;
7704      long i;
7705      long **tbl;
7706      long t, t1, j, q;
7707      long sz = modulus[0];
7708   
7709      r->strategy = 3;
7710      R->n = n;
7711      qq = (long *) NTL_MALLOC(n, sizeof(long), 0);
7712      if (!qq) zhalt("out of memory");
7713      R->primes = qq;
7714   
7715      for (i = 0; i < n; i++)
7716         qq[i] = p[i];
7717
7718      tbl = (long **) NTL_MALLOC(n, sizeof(long *), 0);
7719      if (!tbl) zhalt("out of space");
7720
7721      for (i = 0; i < n; i++) {
7722         tbl[i] = (long *) NTL_MALLOC(sz, sizeof(long), 0);
7723         if (!tbl[i]) zhalt("out of space");
7724      }
7725      R->tbl = tbl;
7726   
7727   
7728      for (i = 0; i < n; i++) {
7729         q = qq[i];
7730         t = (((long)1) << NTL_NBITS) % q;
7731         t1 = 1;
7732         tbl[i][0] = 1;
7733         for (j = 1; j < sz; j++) {
7734            SP_MUL_MOD(t1, t1, t, q);
7735            tbl[i][j] = t1;
7736         }
7737      }
7738     
7739      *rem_struct = (void *) r;
7740      return;
7741   }
7742
7743#endif
7744
7745
7746   {
7747      struct rem_body_lip *R = &r->U.L;
7748
7749      long *q;
7750      long i;
7751   
7752      r->strategy = 0;
7753      R->n = n;
7754      q = (long *) NTL_MALLOC(n, sizeof(long), 0);
7755      if (!q) zhalt("out of memory");
7756      R->primes = q;
7757   
7758      for (i = 0; i < n; i++)
7759         q[i] = p[i];
7760   
7761      *rem_struct = (void *) r;
7762   }
7763}
7764
7765void _ntl_rem_struct_free(void *rem_struct)
7766{
7767   struct rem_body *r = (struct rem_body *) rem_struct;
7768
7769   switch (r->strategy) {
7770
7771   case 0: {
7772      free(r->U.L.primes);
7773      free(r);
7774      break;
7775   }
7776
7777#ifdef NTL_GMP_HACK
7778
7779   case 1: {
7780      struct rem_body_gmp *R = &r->U.G;
7781
7782      long levels = R->levels;
7783      long vec_len = (1L << levels) - 1;
7784      long i;
7785
7786      for (i = 0; i < vec_len; i++) 
7787         mpz_clear(&R->prod_vec[i]);
7788
7789      for (i = 0; i < vec_len; i++) 
7790         mpz_clear(&R->rem_vec[i]);
7791
7792      free(R->primes);
7793      free(R->index_vec);
7794      free(R->prod_vec);
7795      free(R->rem_vec);
7796      free(r);
7797      break;
7798   }
7799
7800#endif
7801
7802
7803#ifdef NTL_SINGLE_MUL
7804
7805   case 2: {
7806      struct rem_body_sm *R = &r->U.S;
7807
7808      long n = R->n;
7809      double **tbl = R->tbl;
7810      long i;
7811
7812      for (i = 0; i < n; i++)
7813         free(tbl[i]);
7814
7815      free(tbl);
7816
7817      free(R->primes);
7818      free(r);
7819      break;
7820   }
7821
7822#endif
7823
7824
7825#if (defined(NTL_TBL_REM) && !defined(NTL_SINGLE_MUL))
7826   
7827   case 3: {
7828      struct rem_body_tbl *R = &r->U.T;
7829
7830      long n = R->n;
7831      long **tbl = R->tbl;
7832      long i;
7833
7834      for (i = 0; i < n; i++)
7835         free(tbl[i]);
7836
7837      free(tbl);
7838
7839      free(R->primes);
7840      free(r);
7841      break;
7842   }
7843
7844
7845#endif
7846
7847   default:
7848      zhalt("_ntl_rem_struct_free: inconsistent strategy");
7849
7850   } /* end switch */
7851
7852}
7853
7854
7855void _ntl_rem_struct_eval(void *rem_struct, long *x, _ntl_verylong a)
7856{
7857   struct rem_body *r = (struct rem_body *) rem_struct;
7858
7859   switch (r->strategy) {
7860
7861   case 0: {
7862      struct rem_body_lip *R = &r->U.L;
7863
7864      _ntl_zmultirem(a, R->n, R->primes, x);
7865      return;
7866   }
7867
7868#ifdef NTL_GMP_HACK
7869
7870   case 1: {
7871      struct rem_body_gmp *R = &r->U.G;
7872
7873      long n = R->n;
7874      long levels = R->levels;
7875      long *q = R->primes;
7876      long *index_vec = R->index_vec;
7877      MP_INT *prod_vec = R->prod_vec;
7878      MP_INT *rem_vec = R->rem_vec;
7879      long vec_len = (1L << levels) - 1;
7880
7881      long i, j;
7882
7883      lip_to_mpz(a, &rem_vec[1]);
7884      mpz_set(&rem_vec[2], &rem_vec[1]);
7885
7886      for (i = 1; i < (1L << (levels-1)) - 1; i++) {
7887         mpz_mod(&rem_vec[2*i+1], &rem_vec[i], &prod_vec[2*i+1]);
7888         mpz_mod(&rem_vec[2*i+2], &rem_vec[i], &prod_vec[2*i+2]);
7889      }
7890
7891      for (i = (1L << (levels-1)) - 1; i < vec_len; i++) {
7892         long lo = index_vec[i];
7893         long hi = index_vec[i+1];
7894         mp_limb_t *s1p = rem_vec[i]._mp_d;
7895         long s1size = rem_vec[i]._mp_size;
7896         if (s1size == 0) {
7897            for (j = lo; j <hi; j++)
7898               x[j] = 0;
7899         }
7900         else {
7901            for (j = lo; j < hi; j++)
7902               x[j] = mpn_mod_1(s1p, s1size, q[j]);
7903         }
7904      }
7905
7906      break;
7907   }
7908
7909#endif
7910
7911
7912#ifdef NTL_SINGLE_MUL
7913
7914   case 2: {
7915      struct rem_body_sm *R = &r->U.S;
7916
7917      _ntl_zmultirem2(a, R->n, R->primes, R->tbl, x);
7918      break;
7919   }
7920
7921#endif
7922
7923#if (defined(NTL_TBL_REM) && !defined(NTL_SINGLE_MUL))
7924
7925   case 3: {
7926      struct rem_body_tbl *R = &r->U.T;
7927
7928      _ntl_zmultirem3(a, R->n, R->primes, R->tbl, x);
7929      break;
7930   }
7931
7932#endif
7933
7934   default:
7935      zhalt("_ntl_rem_struct_eval: inconsistent strategy");
7936
7937
7938   } /* end switch */
7939}
7940
Note: See TracBrowser for help on using the repository browser.