Contact
CoCalc Logo Icon
StoreFeaturesDocsShareSupport News AboutSign UpSign In
| Download

GAP 4.8.9 installation with standard packages -- copy to your CoCalc project to get it

Path: gap4r8 / src / gmpints.c
Views: 415069
1
/****************************************************************************
2
**
3
*W gmpints.c GAP source John McDermott
4
**
5
**
6
**
7
**
8
*Y Copyright (C) 1996, Lehrstuhl D für Mathematik, RWTH Aachen, Germany
9
*Y (C) 1998 School Math and Comp. Sci., University of St Andrews, Scotland
10
*Y Copyright (C) 2002 The GAP Group
11
**
12
** This file implements the functions handling GMP integers.
13
**
14
*/
15
#include "system.h" /* Ints, UInts */
16
17
#include "gasman.h" /* garbage collector */
18
#include "objects.h" /* objects */
19
#include "scanner.h" /* scanner */
20
21
#include "gvars.h" /* global variables */
22
23
#include "calls.h" /* generic call mechanism */
24
#include "opers.h" /* generic operations */
25
26
#include "ariths.h" /* basic arithmetic */
27
28
#include "bool.h" /* booleans */
29
30
#include "gap.h" /* error handling, initialisation */
31
#include "code.h" /* needed by stats.h */
32
#include "stats.h" /* for TakeInterrupt */
33
34
#include "records.h" /* generic records */
35
#include "precord.h" /* plain records */
36
37
#include "lists.h" /* generic lists */
38
#include "string.h" /* strings */
39
40
#include "saveload.h" /* saving and loading */
41
42
#include "intfuncs.h"
43
44
#include <stdio.h>
45
46
#ifdef HAVE_MATH_H
47
#include <math.h>
48
#endif
49
50
#include <stdlib.h>
51
52
#include <assert.h>
53
#include <string.h>
54
#include <ctype.h>
55
56
57
#ifdef USE_GMP
58
59
/* TODO: Remove after Ward2 */
60
#ifndef WARD_ENABLED
61
62
// GMP must be included outside of 'extern C'
63
#ifdef GAP_IN_EXTERN_C
64
}
65
#endif
66
#include <gmp.h>
67
#ifdef GAP_IN_EXTERN_C
68
extern "C" {
69
#endif
70
71
#include "gmpints.h" /* GMP integers */
72
73
#ifdef SYS_IS_64_BIT
74
#define SaveLimb SaveUInt8
75
#define LoadLimb LoadUInt8
76
#else
77
#define SaveLimb SaveUInt4
78
#define LoadLimb LoadUInt4
79
#endif
80
81
#define INTBASE (1L << (GMP_LIMB_BITS/2))
82
83
84
/* macros to save typing later :) */
85
#define VAL_LIMB0(obj) ( *(TypLimb *)ADDR_OBJ(obj) )
86
#define SET_VAL_LIMB0(obj,val) ( *(TypLimb *)ADDR_OBJ(obj) = val )
87
#define IS_INTPOS(obj) ( TNUM_OBJ(obj) == T_INTPOS )
88
#define IS_INTNEG(obj) ( TNUM_OBJ(obj) == T_INTNEG )
89
#define IS_LARGEINT(obj) ( ( TNUM_OBJ(obj) == T_INTPOS ) || \
90
( TNUM_OBJ(obj) == T_INTNEG ) )
91
92
/* for fallbacks to library */
93
Obj String;
94
95
96
/****************************************************************************
97
**
98
*F TypeInt(<gmp>) . . . . . . . . . . . . . . . . . . . type of integer
99
**
100
** 'TypeInt' returns the type of the integer <gmp>.
101
**
102
** 'TypeInt' is the function in 'TypeObjFuncs' for integers.
103
*/
104
Obj TYPE_INT_SMALL_ZERO;
105
Obj TYPE_INT_SMALL_POS;
106
Obj TYPE_INT_SMALL_NEG;
107
Obj TYPE_INT_LARGE_POS;
108
Obj TYPE_INT_LARGE_NEG;
109
110
Obj TypeIntSmall (
111
Obj val )
112
{
113
if ( 0 == INT_INTOBJ(val) ) {
114
return TYPE_INT_SMALL_ZERO;
115
}
116
else if ( 0 < INT_INTOBJ(val) ) {
117
return TYPE_INT_SMALL_POS;
118
}
119
else {
120
return TYPE_INT_SMALL_NEG;
121
}
122
}
123
124
Obj TypeIntLargePos ( Obj val )
125
{
126
return TYPE_INT_LARGE_POS;
127
}
128
129
Obj TypeIntLargeNeg ( Obj val )
130
{
131
return TYPE_INT_LARGE_NEG;
132
}
133
134
135
/****************************************************************************
136
**
137
*F FuncIS_INT( <self>, <val> ) . . . . . . . . . . internal function 'IsInt'
138
**
139
** 'FuncIS_INT' implements the internal filter 'IsInt'.
140
**
141
** 'IsInt( <val> )'
142
**
143
** 'IsInt' returns 'true' if the value <val> is an small integer or a
144
** large int, and 'false' otherwise.
145
*/
146
Obj IsIntFilt;
147
148
Obj FuncIS_INT ( Obj self, Obj val )
149
{
150
if ( TNUM_OBJ(val) == T_INT
151
|| TNUM_OBJ(val) == T_INTPOS
152
|| TNUM_OBJ(val) == T_INTNEG ) {
153
return True;
154
}
155
else if ( TNUM_OBJ(val) < FIRST_EXTERNAL_TNUM ) {
156
return False;
157
}
158
else {
159
return DoFilter( self, val );
160
}
161
}
162
163
164
/****************************************************************************
165
**
166
*F SaveInt( <gmp> )
167
**
168
**
169
*/
170
void SaveInt( Obj gmp )
171
{
172
TypLimb *ptr;
173
UInt i;
174
ptr = (TypLimb *)ADDR_INT(gmp);
175
for (i = 0; i < SIZE_INT(gmp); i++)
176
SaveLimb(*ptr++);
177
return;
178
}
179
180
181
/****************************************************************************
182
**
183
*F LoadInt( <gmp> )
184
**
185
**
186
*/
187
void LoadInt( Obj gmp )
188
{
189
TypLimb *ptr;
190
UInt i;
191
ptr = (TypLimb *)ADDR_INT(gmp);
192
for (i = 0; i < SIZE_INT(gmp); i++)
193
*ptr++ = LoadLimb();
194
return;
195
}
196
197
198
/****************************************************************************
199
**
200
*F NEW_INT( <gmp> )
201
**
202
**
203
*/
204
static inline Obj NEW_INT( Obj gmp )
205
{
206
Obj new;
207
208
new = NewBag( TNUM_OBJ(gmp), SIZE_OBJ(gmp) );
209
memcpy( ADDR_INT(new), ADDR_INT(gmp), SIZE_OBJ(gmp) );
210
211
return new;
212
}
213
214
215
/****************************************************************************
216
**
217
*F NEW_INTPOS( <gmp> )
218
**
219
**
220
*/
221
static inline Obj NEW_INTPOS( Obj gmp )
222
{
223
Obj new;
224
225
new = NewBag( T_INTPOS, SIZE_OBJ(gmp) );
226
memcpy( ADDR_INT(new), ADDR_INT(gmp), SIZE_OBJ(gmp) );
227
228
return new;
229
}
230
231
232
/****************************************************************************
233
**
234
*F NEW_INTNEG( <gmp> )
235
**
236
**
237
**
238
static inline Obj NEW_INTNEG( Obj gmp )
239
{
240
Obj new;
241
242
new = NewBag( T_INTNEG, SIZE_OBJ(gmp) );
243
memcpy( ADDR_INT(new), ADDR_INT(gmp), SIZE_OBJ(gmp) );
244
245
return new;
246
}
247
*/
248
249
/****************************************************************************
250
**
251
*F GMP_NORMALIZE( <gmp> ) . . . . . . . remove leading zeros from a GMP bag
252
**
253
** 'GMP_NORMALIZE' removes any leading zeros from a <GMP> and returns a
254
** small int or resizes the bag if possible.
255
**
256
*/
257
Obj FuncGMP_NORMALIZE( Obj self, Obj gmp )
258
{
259
if ( !IS_LARGEINT(gmp) ) return Fail;
260
return GMP_NORMALIZE( gmp );
261
}
262
263
Obj GMP_NORMALIZE ( Obj gmp )
264
{
265
TypGMPSize size;
266
if IS_INTOBJ( gmp ) {
267
return gmp;
268
}
269
for ( size = SIZE_INT(gmp); size != (TypGMPSize)1; size-- ) {
270
if ( ADDR_INT(gmp)[(size - 1)] != (TypLimb)0 ) {
271
break;
272
}
273
}
274
if ( size < SIZE_INT(gmp) ) {
275
ResizeBag( gmp, size*sizeof(TypLimb) );
276
}
277
return gmp;
278
}
279
280
Obj FuncGMP_REDUCE( Obj self, Obj gmp )
281
{
282
if ( !IS_LARGEINT(gmp) ) return Fail;
283
return GMP_REDUCE( gmp );
284
}
285
286
Obj GMP_REDUCE( Obj gmp )
287
{
288
if IS_INTOBJ( gmp ) {
289
return gmp;
290
}
291
if ( SIZE_INT(gmp) == 1){
292
if ( ( VAL_LIMB0(gmp) < (TypLimb)((1L<<NR_SMALL_INT_BITS)) ) ||
293
( IS_INTNEG(gmp) &&
294
( VAL_LIMB0(gmp) == (TypLimb)(1L<<NR_SMALL_INT_BITS) ) ) ) {
295
if ( IS_INTNEG(gmp) ) {
296
return INTOBJ_INT( -(Int)VAL_LIMB0(gmp) );
297
}
298
else {
299
return INTOBJ_INT( (Int)VAL_LIMB0(gmp) );
300
}
301
}
302
}
303
return gmp;
304
}
305
306
307
/****************************************************************************
308
**
309
*F FuncGMP_INTOBJ(<gmp>) . . . . . . . . . . . . . . . . . . . . conversion
310
**
311
*/
312
Obj FuncGMP_INTOBJ( Obj self, Obj i )
313
{
314
Obj gmp;
315
Int j;
316
317
if ( !IS_INTOBJ(i) ) {
318
return Fail;
319
}
320
else {
321
j = INT_INTOBJ( i );
322
if ( j < 0 ) {
323
gmp = NewBag( T_INTNEG, sizeof(TypLimb) );
324
j = -j;
325
}
326
else {
327
gmp = NewBag( T_INTPOS, sizeof(TypLimb) );
328
}
329
}
330
memcpy( ADDR_INT(gmp), &j, sizeof(Int) );
331
return gmp;
332
}
333
334
335
/****************************************************************************
336
**
337
*F GMPorINTOBJ_INT( <cint> ) . . . . . . . . convert c int to gmp or intobj
338
**
339
** 'GMPorINTOBJ_INT' takes the C integer <cint> and returns the equivalent
340
** GMP obj or int obj, according to the value of <cint>.
341
**
342
*/
343
Obj GMPorINTOBJ_INT( Int i )
344
{
345
Obj gmp;
346
347
if ( (-(1L<<NR_SMALL_INT_BITS) <= i) && (i < 1L<<NR_SMALL_INT_BITS )) {
348
return INTOBJ_INT(i);
349
}
350
else if (i < 0 ) {
351
gmp = NewBag( T_INTNEG, sizeof(TypLimb) );
352
}
353
else {
354
gmp = NewBag( T_INTPOS, sizeof(TypLimb) );
355
}
356
SET_VAL_LIMB0( gmp, i );
357
return gmp;
358
}
359
360
Obj ObjInt_Int( Int i )
361
{
362
return GMPorINTOBJ_INT( i );
363
}
364
365
Obj ObjInt_UInt( UInt i )
366
{
367
Obj gmp;
368
UInt bound = 1UL << NR_SMALL_INT_BITS;
369
370
if (i < bound) {
371
return INTOBJ_INT(i);
372
}
373
else {
374
gmp = NewBag( T_INTPOS, sizeof(TypLimb) );
375
SET_VAL_LIMB0( gmp, i );
376
return gmp;
377
}
378
}
379
380
381
/****************************************************************************
382
**
383
*F PrintInt( <gmp> ) . . . . . . . . . . . . . . . . print a GMP constant
384
**
385
** 'PrintInt' prints the GMP integer <gmp> in the usual decimal
386
** notation.
387
**
388
** cf PrintInt in integer.c
389
*/
390
void PrintInt ( Obj op )
391
{
392
Char buf[20000];
393
UInt signlength;
394
Obj str;
395
/* print a small integer */
396
if ( IS_INTOBJ(op) ) {
397
Pr( "%>%d%<", INT_INTOBJ(op), 0L );
398
}
399
400
/* print a large integer */
401
else if ( SIZE_INT(op) < 1000 ) {
402
/* use gmp func to print int to buffer */
403
if (!IS_INTPOS(op)) {
404
buf[0] ='-';
405
signlength = 1;
406
} else {
407
signlength = 0;
408
}
409
gmp_snprintf((char *)(buf+signlength),20000-signlength,
410
"%Nd", (TypLimb *)ADDR_INT(op),
411
(TypGMPSize)SIZE_INT(op));
412
413
/* print the buffer, %> means insert '\' before a linebreak */
414
Pr("%>%s%<",(Int)buf, 0);
415
}
416
else {
417
str = CALL_1ARGS( String, op );
418
Pr("%>%s%<",(Int)(CHARS_STRING(str)), 0);
419
/* for a long time Print of large ints did not follow the general idea
420
* that Print should produce something that can be read back into GAP:
421
Pr("<<an integer too large to be printed>>",0L,0L); */
422
}
423
}
424
425
426
/****************************************************************************
427
**
428
*F FuncHexStringInt( <self>, <gmp> ) . . . . . . . . hex string for gmp int
429
*F FuncIntHexString( <self>, <string> ) . . . . . . gmp int from hex string
430
**
431
** The function `FuncHexStringInt' constructs from a gmp integer the
432
** corresponding string in hexadecimal notation. It has a leading '-'
433
** for negative numbers and the digits 10..15 are written as A..F.
434
**
435
** The function `FuncIntHexString' does the converse, but here the
436
** letters a..f are also allowed in <string> instead of A..F.
437
**
438
*/
439
Obj FuncHexStringInt( Obj self, Obj integer )
440
{
441
size_t alloc_size, str_size;
442
Int i, j, n; /* len */
443
UInt nf;
444
/* TypLimb d, f; */
445
UInt1 *p, a, *s;
446
Obj res;
447
448
/* immediate integers */
449
if (IS_INTOBJ(integer)) {
450
n = INT_INTOBJ(integer);
451
/* 0 is special */
452
if (n == 0) {
453
res = NEW_STRING(1);
454
CHARS_STRING(res)[0] = '0';
455
return res;
456
}
457
458
/* else we create a string big enough for any immediate integer */
459
res = NEW_STRING(2 * INTEGER_UNIT_SIZE + 1);
460
p = CHARS_STRING(res);
461
/* handle sign */
462
if (n<0) {
463
p[0] = '-';
464
n = -n;
465
p++;
466
}
467
else
468
SET_LEN_STRING(res, GET_LEN_STRING(res)-1);
469
/* collect digits, skipping leading zeros */
470
j = 0;
471
nf = ((UInt)15) << (4*(2*INTEGER_UNIT_SIZE-1));
472
for (i = 2*INTEGER_UNIT_SIZE; i; i-- ) {
473
a = ((UInt)n & nf) >> (4*(i-1));
474
if (j==0 && a==0) SET_LEN_STRING(res, GET_LEN_STRING(res)-1);
475
else if (a<10) p[j++] = a + '0';
476
else p[j++] = a - 10 + 'A';
477
nf = nf >> 4;
478
}
479
/* final null character */
480
p[j] = 0;
481
return res;
482
}
483
484
else if ( IS_LARGEINT(integer) ) {
485
alloc_size = SIZE_INT(integer)*sizeof(TypLimb)*2+1;
486
alloc_size += IS_INTNEG(integer);
487
488
res = NEW_STRING( alloc_size );
489
s = CHARS_STRING( res );
490
491
if ( IS_INTNEG(integer) )
492
*s++ = '-';
493
494
str_size = mpn_get_str( s, 16, ADDR_INT(integer), SIZE_INT(integer) );
495
assert ( str_size <= alloc_size - ( IS_INTNEG(integer) ) );
496
497
for (j = 0; j < str_size-1; j++)
498
if (s[j] != 0)
499
break;
500
501
502
for ( i = 0; i < str_size-j; i++ )
503
s[i] = "0123456789ABCDEF"[s[i+j]];
504
505
assert ( str_size - j == 1 || *s != '0' );
506
507
/* findme - this fails: */
508
/* assert ( strlen( CSTR_STRING(res) ) == alloc_size ); */
509
/* adjust length in case of trailing \0 characters */
510
/* [Is there a way to get it right from the beginning? FL] */
511
/* while (s[alloc_size-1] == '\0')
512
alloc_size--; */
513
SET_LEN_STRING(res, str_size-j + (IS_INTNEG(integer)));
514
/* assert ( strlen( CSTR_STRING(res) ) == GET_LEN_STRING(res) ); */
515
return res;
516
}
517
518
else
519
ErrorReturnObj("HexStringInt: argument must be a int, (not a %s)",
520
(Int)TNAM_OBJ(integer), 0L,
521
"");
522
/* please picky cc */
523
return (Obj) 0L;
524
525
}
526
527
528
Obj FuncIntHexString( Obj self, Obj str )
529
{
530
Obj res;
531
Int i, j, len, sign, nd;
532
UInt n;
533
UInt1 *p, a;
534
UChar c;
535
536
if (! IsStringConv(str))
537
ErrorReturnObj("IntHexString: argument must be string (not a %s)",
538
(Int)TNAM_OBJ(str), 0L,
539
"");
540
541
len = GET_LEN_STRING(str);
542
if (len == 0) {
543
res = INTOBJ_INT(0);
544
return res;
545
}
546
if (*(CHARS_STRING(str)) == '-') {
547
sign = -1;
548
i = 1;
549
}
550
else {
551
sign = 1;
552
i = 0;
553
}
554
555
while ((CHARS_STRING(str))[i] == '0' && i < len)
556
i++;
557
558
559
if ((len-i)*4 <= NR_SMALL_INT_BITS) {
560
n = 0;
561
p = CHARS_STRING(str);
562
for (; i<len; i++) {
563
a = p[i];
564
if (a>96)
565
a -= 87;
566
else if (a>64)
567
a -= 55;
568
else
569
a -= 48;
570
if (a > 15)
571
ErrorReturnObj("IntHexString: non-valid character in hex-string",
572
0L, 0L, "");
573
n = (n << 4) + a;
574
}
575
res = INTOBJ_INT(sign * n);
576
return res;
577
}
578
579
else {
580
nd = (len-i)/INTEGER_UNIT_SIZE;
581
if (nd * INTEGER_UNIT_SIZE < (len-i)) nd++;
582
/* nd += ((3*nd) % 4); */
583
if (sign == 1)
584
res = NewBag( T_INTPOS, nd*sizeof(TypLimb) );
585
else
586
res = NewBag( T_INTNEG, nd*sizeof(TypLimb) );
587
588
p = CHARS_STRING(str)+i;
589
590
/* findme */
591
/* the following destroys the supplied string - document this */
592
for (j=0;j<len-i;j++){
593
c=p[j];
594
if (IsDigit(c))
595
p[j] = c - '0';
596
else if (islower((unsigned int)c))
597
p[j] = c - 'a' + 10;
598
else if (isupper((unsigned int)c))
599
p[j] = c - 'A' + 10;
600
else
601
ErrorReturnObj("IntHexString: non-valid character in hex-string",
602
0L, 0L, "");
603
if (p[j] >= 16)
604
ErrorReturnObj("IntHexString: non-valid character in hex-string",
605
0L, 0L, "");
606
}
607
608
mpn_set_str(ADDR_INT(res),p,len-i,16);
609
res = GMP_NORMALIZE(res);
610
return res;
611
}
612
}
613
614
/****************************************************************************
615
**
616
** Implementation of Log2Int for C integers.
617
*/
618
619
Int CLog2Int(Int a)
620
{
621
Int res, mask;
622
if (a < 0) a = -a;
623
if (a < 1) return -1;
624
if (a < 65536) {
625
for(mask = 2, res = 0; ;mask *= 2, res += 1) {
626
if(a < mask) return res;
627
}
628
}
629
for(mask = 65536, res = 15; ;mask *= 2, res += 1) {
630
if(a < mask) return res;
631
}
632
}
633
634
/****************************************************************************
635
**
636
*F FuncLog2Int( <self>, <gmp> ) . . . . . . . . . . nr of bits of a GMP - 1
637
**
638
** Given to GAP-Level as "Log2Int".
639
*/
640
Obj FuncLog2Int( Obj self, Obj integer)
641
{
642
Int d;
643
Int a, len;
644
TypLimb dmask;
645
646
/* case of small ints */
647
if (IS_INTOBJ(integer)) {
648
return INTOBJ_INT(CLog2Int(INT_INTOBJ(integer)));
649
}
650
651
/* case of long ints */
652
if ( IS_LARGEINT(integer) ) {
653
for (len = SIZE_INT(integer); ADDR_INT(integer)[len-1] == 0; len--);
654
/* Instead of computing
655
res = len * GMP_LIMB_BITS - d;
656
we keep len and d separate, because on 32 bit systems res may
657
not fit into an Int (and not into an immediate integer). */
658
d = 1;
659
a = (TypLimb)(ADDR_INT(integer)[len-1]);
660
for(dmask = (TypLimb)1 << (GMP_LIMB_BITS - 1);
661
(dmask & a) == 0 && dmask != (TypLimb)0;
662
dmask = dmask >> 1, d++);
663
return DiffInt(ProdInt(INTOBJ_INT(len), INTOBJ_INT(GMP_LIMB_BITS)),
664
INTOBJ_INT(d));
665
}
666
else {
667
ErrorReturnObj("Log2Int: argument must be a int, (not a %s)",
668
(Int)TNAM_OBJ(integer), 0L,
669
"");
670
/* please picky cc */
671
return (Obj) 0L;
672
}
673
}
674
675
/****************************************************************************
676
**
677
*F FuncSTRING_INT( <self>, <gmp> ) . . . . . . . . convert a GMP to a string
678
**
679
** `FuncSTRING_INT' returns an immutable string representing the integer
680
** <gmp>
681
**
682
*/
683
Obj FuncSTRING_INT( Obj self, Obj integer )
684
{
685
Int x;
686
Obj str;
687
Int len;
688
Int i;
689
Char c;
690
Int neg;
691
692
693
/* handle a small integer */
694
if ( IS_INTOBJ(integer) ) {
695
x = INT_INTOBJ(integer);
696
str = NEW_STRING( (NR_SMALL_INT_BITS+5)/3 );
697
RetypeBag(str, T_STRING+IMMUTABLE);
698
len = 0;
699
/* Case of zero */
700
if (x == 0)
701
{
702
CHARS_STRING(str)[0] = '0';
703
CHARS_STRING(str)[1] = '\0';
704
ResizeBag(str, SIZEBAG_STRINGLEN(1));
705
SET_LEN_STRING(str, 1);
706
707
return str;
708
}
709
/* Negative numbers */
710
if (x < 0)
711
{
712
CHARS_STRING(str)[len++] = '-';
713
x = -x;
714
neg = 1;
715
}
716
else
717
neg = 0;
718
719
/* Now the main case */
720
while (x != 0)
721
{
722
CHARS_STRING(str)[len++] = '0'+ x % 10;
723
x /= 10;
724
}
725
CHARS_STRING(str)[len] = '\0';
726
727
/* finally, reverse the digits in place */
728
for (i = neg; i < (neg+len)/2; i++)
729
{
730
c = CHARS_STRING(str)[neg+len-1-i];
731
CHARS_STRING(str)[neg+len-1-i] = CHARS_STRING(str)[i];
732
CHARS_STRING(str)[i] = c;
733
}
734
735
ResizeBag(str, SIZEBAG_STRINGLEN(len));
736
SET_LEN_STRING(str, len);
737
return str;
738
}
739
740
/* handle a large integer */
741
else if ( SIZE_INT(integer) < 1000 ) {
742
743
/* findme - enough space for a 1000 limb gmp int on a 64 bit machine */
744
/* change when 128 bit comes along! */
745
Char buf[20000];
746
747
if IS_INTNEG(integer) {
748
len = gmp_snprintf( buf, sizeof(buf)-1, "-%Ni", (TypLimb *)ADDR_INT(integer),
749
(TypGMPSize)SIZE_INT(integer) );
750
}
751
else {
752
len = gmp_snprintf( buf, sizeof(buf)-1, "%Ni", (TypLimb *)ADDR_INT(integer),
753
(TypGMPSize)SIZE_INT(integer) );
754
}
755
756
assert(len < sizeof(buf));
757
C_NEW_STRING( str, (TypGMPSize)len, buf );
758
759
return str;
760
761
}
762
763
else {
764
765
/* Very large integer, fall back on the GAP function */
766
return CALL_1ARGS( String, integer);
767
}
768
}
769
770
771
/****************************************************************************
772
**
773
*F EqInt( <gmpL>, <gmpR> ) . . . . . . . . . test if two integers are equal
774
**
775
**
776
** 'EqInt' returns 1 if the two integer arguments <intL> and <intR> are
777
** equal and 0 otherwise.
778
*/
779
780
/* findme - For comparisons, do we first normalize and, if possible,
781
reduce? Or (for one small, one gmp int) make the small int into a
782
1-limb gmp to compare to the gmp. Or should we assume that gmp ints
783
cannot be 'small'? */
784
785
Int EqInt ( Obj gmpL, Obj gmpR )
786
{
787
Obj opL;
788
Obj opR;
789
790
/* compare two small integers */
791
if ( ARE_INTOBJS( gmpL, gmpR ) ) {
792
if ( INT_INTOBJ(gmpL) == INT_INTOBJ(gmpR) ) return 1L;
793
else return 0L;
794
}
795
796
/* small ints fit into one limb of a GMP */
797
if IS_INTOBJ(gmpL) {
798
if ( ( INT_INTOBJ(gmpL) < 0 && IS_INTPOS(gmpR) ) ||
799
( 0 <= INT_INTOBJ(gmpL) && IS_INTNEG(gmpR) ) ||
800
( SIZE_INT(gmpR) > (TypGMPSize)1 ) ) return 0L;
801
opL = FuncGMP_INTOBJ( (Obj)0, gmpL );
802
}
803
else {
804
opL = gmpL;
805
}
806
807
if IS_INTOBJ(gmpR) {
808
if ( ( INT_INTOBJ(gmpR) < 0 && IS_INTPOS(gmpL) ) ||
809
( 0 <= INT_INTOBJ(gmpR) && IS_INTNEG(gmpL) ) ||
810
( SIZE_INT(gmpL) > (TypGMPSize)1 ) ) return 0L;
811
opR = FuncGMP_INTOBJ( (Obj)0, gmpR );
812
}
813
else {
814
opR = gmpR;
815
}
816
817
/* compare the sign and size */
818
if ( TNUM_OBJ(opL) != TNUM_OBJ(opR)
819
|| SIZE_INT(opL) != SIZE_INT(opR) )
820
return 0L;
821
822
if ( mpn_cmp( ADDR_INT(opL), ADDR_INT(opR), SIZE_INT(opL) ) == 0 )
823
return 1L;
824
else
825
return 0L;
826
}
827
828
/****************************************************************************
829
**
830
*F LtInt( <gmpL>, <gmpR> ) . . . . . . . . . . test whether <gmpL> < <gmpR>
831
**
832
*/
833
Int LtInt ( Obj gmpL, Obj gmpR )
834
{
835
Obj opL;
836
Obj opR;
837
838
/* compare two small integers */
839
if ( ARE_INTOBJS( gmpL, gmpR ) ) {
840
if ( INT_INTOBJ(gmpL) < INT_INTOBJ(gmpR) ) return 1L;
841
else return 0L;
842
}
843
844
/* compare a small and a large integer */
845
if ( IS_INTOBJ(gmpL) ) {
846
if ( SIZE_INT(gmpR) > (TypGMPSize)1 ) {
847
if ( IS_INTPOS(gmpR) ) return 1L;
848
else return 0L;
849
}
850
else opL = FuncGMP_INTOBJ( (Obj)0, gmpL );
851
}
852
else {
853
opL = gmpL;
854
}
855
856
if ( IS_INTOBJ(gmpR) ) {
857
if ( SIZE_INT(gmpL) > (TypGMPSize)1 ) {
858
if ( IS_INTNEG(gmpL) ) return 1L;
859
else return 0L;
860
}
861
else opR = FuncGMP_INTOBJ( (Obj)0, gmpR );
862
}
863
else {
864
opR = gmpR;
865
}
866
867
/* compare two large integers */
868
if ( IS_INTNEG(opL) && IS_INTPOS(opR) )
869
return 1L;
870
else if ( IS_INTPOS(opL) && IS_INTNEG(opR) )
871
return 0L;
872
else if ( ( IS_INTPOS(opR) && SIZE_INT(opL) < SIZE_INT(opR) ) ||
873
( IS_INTNEG(opR) && SIZE_INT(opL) > SIZE_INT(opR) ) )
874
return 1L;
875
else if ( ( IS_INTPOS(opL) && SIZE_INT(opL) > SIZE_INT(opR) ) ||
876
( IS_INTNEG(opL) && SIZE_INT(opL) < SIZE_INT(opR) ) )
877
return 0L;
878
else if ( IS_INTPOS(opL) ) {
879
if ( mpn_cmp( ADDR_INT(opL), ADDR_INT(opR), SIZE_INT(opL) ) < 0 )
880
return 1L;
881
else
882
return 0L;
883
}
884
else {
885
if ( mpn_cmp( ADDR_INT(opL), ADDR_INT(opR), SIZE_INT(opL) ) > 0 )
886
return 1L;
887
else
888
return 0L;
889
}
890
}
891
892
893
/****************************************************************************
894
**
895
*F SumInt( <gmpL>, <gmpR> ) . . . . . . . . . . . . sum of two GMP integers
896
**
897
*/
898
Obj SumInt ( Obj gmpL, Obj gmpR )
899
{
900
Obj sum;
901
902
sum = SumOrDiffInt( gmpL, gmpR, +1 );
903
904
return sum;
905
906
}
907
908
909
/****************************************************************************
910
**
911
*F DiffInt( <gmpL>, <gmpR> ) . . . . . . . . difference of two GMP integers
912
**
913
*/
914
Obj DiffInt ( Obj gmpL, Obj gmpR )
915
{
916
Obj dif;
917
918
dif = SumOrDiffInt( gmpL, gmpR, -1 );
919
920
return dif;
921
}
922
923
924
/****************************************************************************
925
**
926
*F SumOrDiffInt( <gmpL>, <gmpR> ) . . . . . sum or diff of two Int integers
927
**
928
** 'SumOrDiffInt' returns the sum or difference of the two GMP int arguments
929
** <gmpL> and <gmpR>. 'SumOrDiffInt' handles operands of type 'T_INT',
930
** 'T_INTPOS' and 'T_INTNEG'.
931
**
932
** 'SumOrDiffInt' is a little bit tricky since there are many different
933
** cases to handle, each operand can be positive or negative, small or large
934
** integer.
935
*/
936
Obj SumOrDiffInt ( Obj gmpL, Obj gmpR, Int sign )
937
{
938
Obj res; /* handle of result bag */
939
Int twosmall; /* sum of two smalls */
940
Int onesmall; /* set to 1 if one of args is a small int, 0 otherwise */
941
Int swapped; /* set to 1 if args were swapped, 0 otherwise */
942
Int resneg; /* set to 1 if result will be negative */
943
TypLimb carry; /* hold any carry or borrow */
944
945
twosmall = 0;
946
onesmall = 0;
947
swapped = 0;
948
resneg = 0;
949
950
/* findme - later change to put the non-overflow versions of these small
951
int adds/subs into the caller funcs SumInt, DiffInt. Then remove check of
952
SUM or DIFF _INTOBJS and document (at least in code) that this should not
953
be called directly */
954
955
if ( sign != 1 && sign != -1 ) {
956
ErrorReturnObj(
957
"SumOrDiffInt: <sign> must be +1 or -1. \nDo not call this function directly.",
958
0L, 0L,
959
"" );
960
}
961
962
/* adding two small integers */
963
if ( ARE_INTOBJS( gmpL, gmpR ) ) {
964
965
/* add or subtract two small integers with a small sum */
966
if (sign == 1) {
967
if ( SUM_INTOBJS( res, gmpL, gmpR ) ) {
968
return res;
969
}
970
else {
971
twosmall = INT_INTOBJ(gmpL) + INT_INTOBJ(gmpR);
972
}
973
}
974
else if (sign == -1) {
975
if ( DIFF_INTOBJS( res, gmpL, gmpR ) ) {
976
return res;
977
}
978
else {
979
twosmall = INT_INTOBJ(gmpL) - INT_INTOBJ(gmpR);
980
}
981
}
982
983
/* if two small integers have a large sum or difference form the gmp int*/
984
if ( 0 < twosmall ) {
985
res = NewBag( T_INTPOS, sizeof(TypLimb) );
986
SET_VAL_LIMB0( res, (TypLimb)twosmall );
987
}
988
else {
989
res = NewBag( T_INTNEG, sizeof(TypLimb) );
990
SET_VAL_LIMB0( res, (TypLimb)(-twosmall) );
991
}
992
993
return res;
994
}
995
996
/* findme - we repeat some of this work in the 'add' part later on.
997
Can we recycle some code? */
998
999
/* the case of one small integer and one large */
1000
else if ( IS_INTOBJ( gmpL ) || IS_INTOBJ( gmpR ) ) {
1001
onesmall = 1;
1002
if ( IS_INTOBJ( gmpL ) ) {
1003
/* findme - do we need to normalize here? */
1004
gmpR = GMP_NORMALIZE( gmpR );
1005
gmpR = GMP_REDUCE( gmpR );
1006
if ( IS_INTOBJ(gmpR) ) {
1007
return INTOBJ_INT( INT_INTOBJ(gmpL) + sign*INT_INTOBJ(gmpR) );
1008
}
1009
res = gmpL; gmpL = gmpR; gmpR = res;
1010
swapped = 1;
1011
}
1012
else {
1013
gmpL = GMP_NORMALIZE( gmpL );
1014
gmpL = GMP_REDUCE( gmpL );
1015
if ( IS_INTOBJ(gmpL) ) {
1016
return INTOBJ_INT( INT_INTOBJ(gmpL) + sign*INT_INTOBJ(gmpR) );
1017
}
1018
}
1019
}
1020
1021
/* two large ints */
1022
else if ( SIZE_INT( gmpL ) < SIZE_INT( gmpR ) ) {
1023
/* swap gmpL and gmpR */
1024
res = gmpL; gmpL = gmpR; gmpR = res;
1025
swapped = 1;
1026
}
1027
1028
if ( ( ( sign == +1 ) &&
1029
( ( ( onesmall ) &&
1030
( (IS_INTNEG(gmpL) && 0 <= INT_INTOBJ(gmpR)) ||
1031
(IS_INTPOS(gmpL) && 0 > INT_INTOBJ(gmpR)) ) ) ||
1032
( !( onesmall ) &&
1033
( (IS_INTPOS(gmpL) && IS_INTNEG(gmpR)) ||
1034
(IS_INTNEG(gmpL) && IS_INTPOS(gmpR)) ) ) ) ) ||
1035
( ( sign == -1 ) &&
1036
( ( ( onesmall ) &&
1037
( (IS_INTNEG(gmpL) && 0 > INT_INTOBJ(gmpR)) ||
1038
(IS_INTPOS(gmpL) && 0 <= INT_INTOBJ(gmpR)) ) ) ||
1039
( !( onesmall ) &&
1040
( (IS_INTPOS(gmpL) && IS_INTPOS(gmpR)) ||
1041
(IS_INTNEG(gmpL) && IS_INTNEG(gmpR)) ) ) ) ) ) {
1042
1043
/* the args have different sign (or same sign and this is a subtraction)
1044
- compare to see which to subtract */
1045
if ( onesmall ) {
1046
if ( ( ( ( swapped == 1 && sign == +1 ) || swapped == 0 )
1047
&& IS_INTNEG(gmpL) ) ||
1048
( swapped == 1 && sign == -1 && IS_INTPOS(gmpL) ) ) {
1049
res = NewBag( T_INTNEG, SIZE_OBJ(gmpL) );
1050
}
1051
else {
1052
res = NewBag( T_INTPOS, SIZE_OBJ(gmpL) );
1053
}
1054
gmpR = FuncGMP_INTOBJ( (Obj)0, gmpR );
1055
carry = mpn_sub_1( ADDR_INT(res),
1056
ADDR_INT(gmpL), SIZE_INT(gmpL),
1057
*ADDR_INT(gmpR) );
1058
}
1059
/* this test correct since size(gmpL) >= size(gmpR) */
1060
else if ( SIZE_INT(gmpL) != SIZE_INT(gmpR) ) {
1061
if ( ( ( ( swapped == 1 && sign == +1 ) || swapped == 0 )
1062
&& IS_INTNEG(gmpL) ) ||
1063
( swapped == 1 && sign == -1 && IS_INTPOS(gmpL) ) ) {
1064
res = NewBag( T_INTNEG, SIZE_OBJ(gmpL) );
1065
}
1066
else {
1067
res = NewBag( T_INTPOS, SIZE_OBJ(gmpL) );
1068
}
1069
carry = mpn_sub( ADDR_INT(res),
1070
ADDR_INT(gmpL), SIZE_INT(gmpL),
1071
ADDR_INT(gmpR), SIZE_INT(gmpR) );
1072
}
1073
/* ok, so they're the same size in limbs - which is the bigger number? */
1074
else if ( mpn_cmp( ADDR_INT(gmpL),
1075
ADDR_INT(gmpR), SIZE_INT(gmpL) ) < 0 ) {
1076
if ( IS_INTPOS(gmpL) ) {
1077
res = NewBag( T_INTNEG, SIZE_OBJ(gmpL) );
1078
}
1079
else {
1080
res = NewBag( T_INTPOS, SIZE_OBJ(gmpL) );
1081
}
1082
carry = mpn_sub_n( ADDR_INT(res),
1083
ADDR_INT(gmpR),
1084
ADDR_INT(gmpL), SIZE_INT(gmpR) );
1085
}
1086
1087
else {
1088
if ( IS_INTNEG(gmpL) ) {
1089
res = NewBag( T_INTNEG, SIZE_OBJ(gmpL) );
1090
}
1091
else {
1092
res = NewBag( T_INTPOS, SIZE_OBJ(gmpL) );
1093
}
1094
carry = mpn_sub_n( ADDR_INT(res),
1095
ADDR_INT(gmpL),
1096
ADDR_INT(gmpR), SIZE_INT(gmpL) );
1097
}
1098
1099
res = GMP_NORMALIZE( res );
1100
res = GMP_REDUCE( res );
1101
return res;
1102
}
1103
1104
else {
1105
/* The args have the same sign (or opp sign and this is a subtraction)
1106
- so add them. At this stage, we are dealing with a large and a
1107
small, or two large integers */
1108
1109
/* Will the result be negative? */
1110
if ( ( sign == 1 && IS_INTNEG(gmpL) ) ||
1111
( sign == -1 &&
1112
( ( swapped == 0 && IS_INTNEG(gmpL) ) ||
1113
( swapped == 1 && IS_INTPOS(gmpL) ) ) ) ) {
1114
resneg = 1;
1115
}
1116
/* ( ( onesmall && IS_INTNEG(gmpL) ) ||
1117
( IS_INTNEG(gmpL) && IS_INTNEG(gmpR) ) ||
1118
( SIZE_INT(gmpL) > SIZE_INT(gmpR) && IS_INTNEG(gmpL) ) ) ) ||
1119
if ( resneg == 0 && sign == 1 && SIZE_INT(gmpL) == SIZE_INT(gmpR) ) {
1120
compare = mpn_cmp( ADDR_INT(gmpL), ADDR_INT(gmpR), SIZE_INT(gmpL) );
1121
if ( ( compare >= 0 && IS_INTNEG(gmpL) ) ||
1122
( compare < 0 && IS_INTNEG(gmpR) ) ) {
1123
resneg = 1;
1124
}
1125
}
1126
*/
1127
if ( onesmall ) {
1128
if ( resneg == 0 ) {
1129
res = NewBag( T_INTPOS, SIZE_OBJ(gmpL) + sizeof(TypLimb) );
1130
}
1131
else {
1132
res = NewBag( T_INTNEG, SIZE_OBJ(gmpL) + sizeof(TypLimb) );
1133
}
1134
gmpR = FuncGMP_INTOBJ( (Obj)0, gmpR );
1135
carry = mpn_add_1( ADDR_INT(res),
1136
ADDR_INT(gmpL),SIZE_INT(gmpL),
1137
*ADDR_INT(gmpR) );
1138
if ( carry == (TypLimb)0 ) {
1139
ResizeBag( res, SIZE_OBJ(gmpL) );
1140
}
1141
else {
1142
( ADDR_INT(res) )[ SIZE_INT(gmpL) ] = (TypLimb)1; /* = carry ? */
1143
}
1144
/* findme - debugging 231107
1145
res = GMP_NORMALIZE( res );
1146
res = GMP_REDUCE( res ); */
1147
}
1148
1149
else {
1150
/* put the smaller one (in limbs) to the right */
1151
if ( SIZE_INT(gmpL) < SIZE_INT(gmpR) ) {
1152
res = gmpR; gmpR = gmpL; gmpL = res;
1153
}
1154
1155
/* allocate result bag */
1156
if ( resneg == 0 ) {
1157
res = NewBag( T_INTPOS, ( SIZE_OBJ(gmpL) + sizeof(TypLimb) ) );
1158
}
1159
else {
1160
res = NewBag( T_INTNEG, ( SIZE_OBJ(gmpL) + sizeof(TypLimb) ) );
1161
}
1162
1163
/* mpn_lshift is faster still than mpn_add_n for adding a TypLimb
1164
number to itself */
1165
if ( gmpL == gmpR ) {
1166
carry = mpn_lshift( ADDR_INT(res),
1167
ADDR_INT(gmpL), SIZE_INT(gmpL),
1168
1 );
1169
}
1170
else {
1171
carry = mpn_add( ADDR_INT(res),
1172
ADDR_INT(gmpL), SIZE_INT(gmpL),
1173
ADDR_INT(gmpR), SIZE_INT(gmpR) );
1174
}
1175
if ( carry == (TypLimb)0 ){
1176
ResizeBag( res, SIZE_OBJ(gmpL) );
1177
}
1178
else{
1179
( ADDR_INT(res) )[ SIZE_INT(gmpL) ] = (TypLimb)1;
1180
}
1181
/* findme - don't need this after carry ? */
1182
/* res = GMP_NORMALIZE( res );
1183
res = GMP_REDUCE( res ); */
1184
}
1185
1186
return res;
1187
}
1188
1189
}
1190
1191
1192
/****************************************************************************
1193
**
1194
*F ZeroInt(<gmp>) . . . . . . . . . . . . . . . . . . . . zero of integers
1195
*/
1196
Obj ZeroInt ( Obj op )
1197
{
1198
return INTOBJ_INT( (Int)0 );
1199
}
1200
1201
1202
/****************************************************************************
1203
**
1204
*F AInvInt(<gmp>) . . . . . . . . . . . . . . additive inverse of an integer
1205
*/
1206
Obj AInvInt ( Obj gmp )
1207
{
1208
Obj inv;
1209
1210
/* handle small integer */
1211
if ( IS_INTOBJ( gmp ) ) {
1212
1213
/* special case (ugh) */
1214
if ( gmp == INTOBJ_INT( -(1L<<NR_SMALL_INT_BITS) ) ) {
1215
inv = NewBag( T_INTPOS, sizeof(TypLimb) );
1216
SET_VAL_LIMB0( inv, 1L<<NR_SMALL_INT_BITS );
1217
}
1218
1219
/* general case */
1220
else {
1221
inv = INTOBJ_INT( - INT_INTOBJ( gmp ) );
1222
}
1223
1224
}
1225
1226
else {
1227
if ( IS_INTPOS(gmp) ) {
1228
/* special case */
1229
if ( ( SIZE_INT(gmp) == 1 )
1230
&& ( VAL_LIMB0(gmp) == (TypLimb) (1L<<NR_SMALL_INT_BITS) ) ) {
1231
return INTOBJ_INT( -(Int) (1L<<NR_SMALL_INT_BITS) );
1232
}
1233
else {
1234
inv = NewBag( T_INTNEG, SIZE_OBJ(gmp) );
1235
}
1236
}
1237
1238
else {
1239
inv = NewBag( T_INTPOS, SIZE_OBJ(gmp) );
1240
}
1241
1242
memcpy( ADDR_INT(inv), ADDR_INT(gmp), SIZE_OBJ(gmp) );
1243
}
1244
1245
/* return the inverse */
1246
return inv;
1247
1248
}
1249
1250
Obj AbsInt( Obj gmp )
1251
{
1252
Obj a;
1253
if (IS_INTOBJ(gmp)) {
1254
if (((Int)gmp) > 0)
1255
return gmp;
1256
else if (gmp == INTOBJ_INT(-(1L << NR_SMALL_INT_BITS)))
1257
return AInvInt(gmp);
1258
else
1259
return (Obj)(2-(Int)gmp);
1260
}
1261
if (TNUM_OBJ(gmp) == T_INTPOS)
1262
return gmp;
1263
a = NewBag(T_INTPOS, SIZE_OBJ(gmp));
1264
memcpy( ADDR_INT(a), ADDR_INT(gmp), SIZE_OBJ(gmp) );
1265
return a;
1266
}
1267
1268
Obj FuncABS_INT(Obj self, Obj gmp)
1269
{
1270
return AbsInt(gmp);
1271
}
1272
1273
1274
/****************************************************************************
1275
**
1276
*F ProdInt( <intL>, <intR> ) . . . . . . . . . . . . product of two integers
1277
**
1278
** 'ProdInt' returns the product of the two integer arguments <intL> and
1279
** <intR>. 'ProdInt' handles operands of type 'T_INT', 'T_INTPOS' and
1280
** 'T_INTNEG'.
1281
**
1282
** It can also be used in the cases that both operands are small integers
1283
** and the result is a small integer too, i.e., that no overflow occurs.
1284
** This case is usually already handled in 'EvalProd' for a better efficiency.
1285
**
1286
** Is called from the 'EvalProd' binop so both operands are already evaluated.
1287
**
1288
** The only difficulty about this function is the fact that is has to handle
1289
** 3 different situations, depending on how many arguments are small ints.
1290
*/
1291
Obj ProdInt ( Obj gmpL, Obj gmpR )
1292
{
1293
Obj prd; /* handle of the result bag */
1294
Int i; /* hold small int value */
1295
Int k; /* hold small int value */
1296
TypLimb carry; /* most significant limb */
1297
TypLimb tmp1, tmp2;
1298
1299
/* multiplying two small integers */
1300
if ( ARE_INTOBJS( gmpL, gmpR ) ) {
1301
1302
/* multiply two small integers with a small product */
1303
/* multiply and divide back to check that no overflow occured */
1304
if ( PROD_INTOBJS( prd, gmpL, gmpR ) ) {
1305
return prd;
1306
}
1307
1308
/* get the integer values */
1309
i = INT_INTOBJ(gmpL);
1310
k = INT_INTOBJ(gmpR);
1311
1312
/* allocate the product bag */
1313
if ( (0 < i && 0 < k) || (i < 0 && k < 0) )
1314
prd = NewBag( T_INTPOS, 2*sizeof(TypLimb) );
1315
else
1316
prd = NewBag( T_INTNEG, 2*sizeof(TypLimb) );
1317
1318
/* make both operands positive */
1319
if ( i < 0 ) i = -i;
1320
if ( k < 0 ) k = -k;
1321
1322
/* multiply */
1323
tmp1 = (TypLimb)i;
1324
tmp2 = (TypLimb)k;
1325
mpn_mul_n( ADDR_INT( prd ), &tmp1, &tmp2, 1 );
1326
}
1327
1328
/* multiply a small and a large integer */
1329
else if ( IS_INTOBJ(gmpL) || IS_INTOBJ(gmpR) ) {
1330
1331
/* make the right operand the small one */
1332
if ( IS_INTOBJ(gmpL) ) {
1333
k = INT_INTOBJ(gmpL); gmpL = gmpR;
1334
}
1335
else {
1336
k = INT_INTOBJ(gmpR);
1337
}
1338
1339
/* handle trivial cases first */
1340
if ( k == 0 )
1341
return INTOBJ_INT(0);
1342
if ( k == 1 )
1343
return gmpL;
1344
1345
/* eg: for 32 bit systems, the large integer 1<<28 times -1 is the small
1346
integer -(1<<28) */
1347
if ( ( k == -1 ) && (SIZE_INT(gmpL)==1)
1348
&& ( VAL_LIMB0(gmpL) == (TypLimb)(1L<<NR_SMALL_INT_BITS) ) )
1349
return INTOBJ_INT(-(Int)(1L<<NR_SMALL_INT_BITS));
1350
1351
/* multiplication by -1 is easy, just switch the sign and copy */
1352
if ( k == -1 ) {
1353
if ( TNUM_OBJ(gmpL) == T_INTPOS ) {
1354
prd = NewBag( T_INTNEG, SIZE_OBJ(gmpL) );
1355
}
1356
else {
1357
prd = NewBag( T_INTPOS, SIZE_OBJ(gmpL) );
1358
}
1359
memcpy( ADDR_OBJ(prd), ADDR_OBJ(gmpL), SIZE_OBJ(gmpL) );
1360
return prd;
1361
}
1362
1363
/* allocate a bag for the result */
1364
if ( (0 < k && TNUM_OBJ(gmpL) == T_INTPOS)
1365
|| (k < 0 && TNUM_OBJ(gmpL) == T_INTNEG) ) {
1366
prd = NewBag( T_INTPOS, (SIZE_INT(gmpL)+1)*sizeof(TypLimb) );
1367
}
1368
else {
1369
prd = NewBag( T_INTNEG, (SIZE_INT(gmpL)+1)*sizeof(TypLimb) );
1370
}
1371
1372
if ( k < 0 ) k = -k;
1373
1374
/* multiply */
1375
carry = mpn_mul_1( ADDR_INT(prd), ADDR_INT(gmpL),
1376
SIZE_INT(gmpL), (TypLimb)k );
1377
if ( carry == (TypLimb)0 ) {
1378
ResizeBag( prd, SIZE_OBJ(gmpL) );
1379
}
1380
else {
1381
( ADDR_INT(prd) )[ SIZE_INT(gmpL) ] = carry;
1382
}
1383
}
1384
1385
/* multiply two large integers */
1386
else {
1387
1388
/* make the right operand the smaller one, for the mpn function */
1389
if ( SIZE_INT(gmpL) < SIZE_INT(gmpR) ) {
1390
prd = gmpR; gmpR = gmpL; gmpL = prd;
1391
}
1392
1393
/* allocate a bag for the result */
1394
if ( TNUM_OBJ(gmpL) == TNUM_OBJ(gmpR) )
1395
prd = NewBag( T_INTPOS, SIZE_OBJ(gmpL)+SIZE_OBJ(gmpR) );
1396
else
1397
prd = NewBag( T_INTNEG, SIZE_OBJ(gmpL)+SIZE_OBJ(gmpR) );
1398
1399
/* multiply */
1400
mpn_mul( ADDR_INT(prd),
1401
ADDR_INT(gmpL), SIZE_INT(gmpL),
1402
ADDR_INT(gmpR), SIZE_INT(gmpR) );
1403
}
1404
1405
/* normalize and return the product */
1406
prd = GMP_NORMALIZE( prd );
1407
prd = GMP_REDUCE( prd );
1408
return prd;
1409
}
1410
1411
1412
/****************************************************************************
1413
**
1414
*F ProdIntObj(<n>,<op>) . . . . . . . . product of an integer and an object
1415
*/
1416
Obj ProdIntObj ( Obj n, Obj op )
1417
{
1418
Obj res = 0; /* result */
1419
UInt i, k; /* loop variables */
1420
TypLimb l; /* loop variable */
1421
1422
/* if the integer is zero, return the neutral element of the operand */
1423
if ( TNUM_OBJ(n) == T_INT && INT_INTOBJ(n) == 0 ) {
1424
res = ZERO( op );
1425
}
1426
1427
/* if the integer is one, return the object if immutable -
1428
if mutable, add the object to its ZeroSameMutability to
1429
ensure correct mutability propagation */
1430
else if ( TNUM_OBJ(n) == T_INT && INT_INTOBJ(n) == 1 ) {
1431
if (IS_MUTABLE_OBJ(op))
1432
res = SUM(ZERO(op),op);
1433
else
1434
res = op;
1435
}
1436
1437
/* if the integer is minus one, return the inverse of the operand */
1438
else if ( TNUM_OBJ(n) == T_INT && INT_INTOBJ(n) == -1 ) {
1439
res = AINV( op );
1440
}
1441
1442
/* if the integer is negative, invert the operand and the integer */
1443
else if ( ( TNUM_OBJ(n) == T_INT && INT_INTOBJ(n) < -1 )
1444
|| IS_INTNEG(n) ) {
1445
res = AINV( op );
1446
if ( res == Fail ) {
1447
return ErrorReturnObj(
1448
"Operations: <obj> must have an additive inverse",
1449
0L, 0L,
1450
"you can supply an inverse <inv> for <obj> via 'return <inv>;'" );
1451
}
1452
res = PROD( AINV( n ), res );
1453
}
1454
1455
/* if the integer is small, compute the product by repeated doubling */
1456
/* the loop invariant is <result> = <k>*<res> + <l>*<op>, <l> < <k> */
1457
/* <res> = 0 means that <res> is the neutral element */
1458
else if ( TNUM_OBJ(n) == T_INT && INT_INTOBJ(n) > 1 ) {
1459
res = 0;
1460
k = 1L << (NR_SMALL_INT_BITS+1);
1461
l = INT_INTOBJ(n);
1462
while ( 1 < k ) {
1463
res = (res == 0 ? res : SUM( res, res ));
1464
k = k / 2;
1465
if ( k <= l ) {
1466
res = (res == 0 ? op : SUM( res, op ));
1467
l = l - k;
1468
}
1469
}
1470
}
1471
1472
/* if the integer is large, compute the product by repeated doubling */
1473
else if ( TNUM_OBJ(n) == T_INTPOS ) {
1474
res = 0;
1475
for ( i = SIZE_INT(n); 0 < i; i-- ) {
1476
k = 8*sizeof(TypLimb);
1477
l = ((TypLimb*) ADDR_INT(n))[i-1];
1478
while ( 0 < k ) {
1479
res = (res == 0 ? res : SUM( res, res ));
1480
k--;
1481
if ( (l >> k) & 1 ) {
1482
res = (res == 0 ? op : SUM( res, op ));
1483
}
1484
}
1485
}
1486
}
1487
1488
/* return the result */
1489
return res;
1490
}
1491
1492
Obj ProdIntObjFunc;
1493
1494
Obj FuncPROD_INT_OBJ ( Obj self, Obj opL, Obj opR )
1495
{
1496
return ProdIntObj( opL, opR );
1497
}
1498
1499
1500
/****************************************************************************
1501
**
1502
*F OneInt(<gmp>) . . . . . . . . . . . . . . . . . . . . . one of an integer
1503
*/
1504
static Obj OneAttr;
1505
1506
Obj OneInt ( Obj op )
1507
{
1508
return INTOBJ_INT( 1 );
1509
}
1510
1511
1512
/****************************************************************************
1513
**
1514
*F PowInt( <intL>, <intR> ) . . . . . . . . . . . . . . power of an integer
1515
**
1516
** 'PowInt' returns the <intR>-th (an integer) power of the integer <intL>.
1517
** 'PowInt' handles operands of type 'T_INT', 'T_INTPOS' and 'T_INTNEG'.
1518
**
1519
** It can also be used in the cases that both operands are small integers
1520
** and the result is a small integer too, i.e., that no overflow occurs.
1521
** This case is usually already handled in 'EvalPow' for a better efficiency.
1522
**
1523
** Is called from the 'EvalPow' binop so both operands are already evaluated.
1524
*/
1525
Obj PowInt ( Obj gmpL, Obj gmpR )
1526
{
1527
Int i;
1528
Obj pow;
1529
1530
/* power with a large exponent */
1531
if ( ! IS_INTOBJ(gmpR) ) {
1532
if ( gmpL == INTOBJ_INT(0) )
1533
pow = INTOBJ_INT(0);
1534
else if ( gmpL == INTOBJ_INT(1) )
1535
pow = INTOBJ_INT(1);
1536
else if ( gmpL == INTOBJ_INT(-1) && ADDR_INT(gmpR)[0] % 2 == 0 )
1537
pow = INTOBJ_INT(1);
1538
else if ( gmpL == INTOBJ_INT(-1) && ADDR_INT(gmpR)[0] % 2 != 0 )
1539
pow = INTOBJ_INT(-1);
1540
else {
1541
gmpR = ErrorReturnObj(
1542
"Integer operands: <exponent> is too large",
1543
0L, 0L,
1544
"you can replace the integer <exponent> via 'return <exponent>;'" );
1545
return POW( gmpL, gmpR );
1546
}
1547
}
1548
1549
/* power with a negative exponent */
1550
else if ( INT_INTOBJ(gmpR) < 0 ) {
1551
if ( gmpL == INTOBJ_INT(0) ) {
1552
gmpL = ErrorReturnObj(
1553
"Integer operands: <base> must not be zero",
1554
0L, 0L,
1555
"you can replace the integer <base> via 'return <base>;'" );
1556
return POW( gmpL, gmpR );
1557
}
1558
else if ( gmpL == INTOBJ_INT(1) )
1559
pow = INTOBJ_INT(1);
1560
else if ( gmpL == INTOBJ_INT(-1) && INT_INTOBJ(gmpR) % 2 == 0 )
1561
pow = INTOBJ_INT(1);
1562
else if ( gmpL == INTOBJ_INT(-1) && INT_INTOBJ(gmpR) % 2 != 0 )
1563
pow = INTOBJ_INT(-1);
1564
else
1565
pow = QUO( INTOBJ_INT(1),
1566
PowInt( gmpL, INTOBJ_INT( -INT_INTOBJ(gmpR)) ) );
1567
}
1568
1569
/* findme - can we use the gmp function mpz_n_pow_ui? */
1570
1571
/* power with a small positive exponent, do it by a repeated squaring */
1572
else {
1573
pow = INTOBJ_INT(1);
1574
i = INT_INTOBJ(gmpR);
1575
while ( i != 0 ) {
1576
if ( i % 2 == 1 ) pow = ProdInt( pow, gmpL );
1577
if ( i > 1 ) gmpL = ProdInt( gmpL, gmpL );
1578
TakeInterrupt();
1579
i = i / 2;
1580
}
1581
}
1582
1583
/* return the power */
1584
return pow;
1585
}
1586
1587
1588
/****************************************************************************
1589
**
1590
*F PowObjInt(<op>,<n>) . . . . . . . . . . power of an object and an integer
1591
*/
1592
Obj PowObjInt ( Obj op, Obj n )
1593
{
1594
Obj res = 0; /* result */
1595
UInt i, k; /* loop variables */
1596
TypLimb l; /* loop variable */
1597
1598
/* if the integer is zero, return the neutral element of the operand */
1599
if ( TNUM_OBJ(n) == T_INT && INT_INTOBJ(n) == 0 ) {
1600
return ONE_MUT( op );
1601
}
1602
1603
/* if the integer is one, return a copy of the operand */
1604
else if ( TNUM_OBJ(n) == T_INT && INT_INTOBJ(n) == 1 ) {
1605
res = CopyObj( op, 1 );
1606
}
1607
1608
/* if the integer is minus one, return the inverse of the operand */
1609
else if ( TNUM_OBJ(n) == T_INT && INT_INTOBJ(n) == -1 ) {
1610
res = INV_MUT( op );
1611
}
1612
1613
/* if the integer is negative, invert the operand and the integer */
1614
else if ( TNUM_OBJ(n) == T_INT && INT_INTOBJ(n) < 0 ) {
1615
res = INV_MUT( op );
1616
if ( res == Fail ) {
1617
return ErrorReturnObj(
1618
"Operations: <obj> must have an inverse",
1619
0L, 0L,
1620
"you can supply an inverse <inv> for <obj> via 'return <inv>;'" );
1621
}
1622
res = POW( res, AINV( n ) );
1623
}
1624
1625
/* if the integer is negative, invert the operand and the integer */
1626
else if ( TNUM_OBJ(n) == T_INTNEG ) {
1627
res = INV_MUT( op );
1628
if ( res == Fail ) {
1629
return ErrorReturnObj(
1630
"Operations: <obj> must have an inverse",
1631
0L, 0L,
1632
"you can supply an inverse <inv> for <obj> via 'return <inv>;'" );
1633
}
1634
res = POW( res, AINV( n ) );
1635
}
1636
1637
/* if the integer is small, compute the power by repeated squaring */
1638
/* the loop invariant is <result> = <res>^<k> * <op>^<l>, <l> < <k> */
1639
/* <res> = 0 means that <res> is the neutral element */
1640
else if ( TNUM_OBJ(n) == T_INT && INT_INTOBJ(n) > 0 ) {
1641
res = 0;
1642
k = 1L << (NR_SMALL_INT_BITS+1);
1643
l = INT_INTOBJ(n);
1644
while ( 1 < k ) {
1645
res = (res == 0 ? res : PROD( res, res ));
1646
k = k / 2;
1647
if ( k <= l ) {
1648
res = (res == 0 ? op : PROD( res, op ));
1649
l = l - k;
1650
}
1651
}
1652
}
1653
1654
/* if the integer is large, compute the power by repeated squaring */
1655
else if ( TNUM_OBJ(n) == T_INTPOS ) {
1656
res = 0;
1657
for ( i = SIZE_INT(n); 0 < i; i-- ) {
1658
k = 8*sizeof(TypLimb);
1659
l = ((TypLimb*) ADDR_INT(n))[i-1];
1660
while ( 0 < k ) {
1661
res = (res == 0 ? res : PROD( res, res ));
1662
k--;
1663
if ( (l>>k) & 1 ) {
1664
res = (res == 0 ? op : PROD( res, op ));
1665
}
1666
}
1667
}
1668
}
1669
1670
/* return the result */
1671
return res;
1672
}
1673
1674
Obj PowObjIntFunc;
1675
1676
Obj FuncPOW_OBJ_INT ( Obj self, Obj opL, Obj opR )
1677
{
1678
return PowObjInt( opL, opR );
1679
}
1680
1681
1682
/****************************************************************************
1683
**
1684
*F ModInt( <intL>, <intR> ) . representative of residue class of an integer
1685
**
1686
** 'ModInt' returns the smallest positive representant of the residue class
1687
** of the integer <intL> modulo the integer <intR>. 'ModInt' handles
1688
** operands of type 'T_INT', 'T_INTPOS', 'T_INTNEG'.
1689
**
1690
** It can also be used in the cases that both operands are small integers
1691
** and the result is a small integer too, i.e., that no overflow occurs.
1692
** This case is usually already handled in 'EvalMod' for a better efficiency.
1693
p**
1694
** Is called from the 'EvalMod' binop so both operands are already evaluated.
1695
*/
1696
Obj ModInt ( Obj opL, Obj opR )
1697
{
1698
Int i; /* loop count, value for small int */
1699
Int k; /* loop count, value for small int */
1700
UInt c; /* product of two digits */
1701
Obj mod; /* handle of the remainder bag */
1702
Obj quo; /* handle of the quotient bag */
1703
1704
/* compute the remainder of two small integers */
1705
if ( ARE_INTOBJS( opL, opR ) ) {
1706
1707
/* pathological case first */
1708
if ( opR == INTOBJ_INT(0) ) {
1709
opR = ErrorReturnObj(
1710
"Integer operations: <divisor> must be nonzero",
1711
0L, 0L,
1712
"you can replace the integer <divisor> via 'return <divisor>;'" );
1713
return MOD( opL, opR );
1714
}
1715
1716
/* get the integer values */
1717
i = INT_INTOBJ(opL);
1718
k = INT_INTOBJ(opR);
1719
1720
/* compute the remainder, make sure we divide only positive numbers */
1721
if ( 0 <= i && 0 <= k ) i = ( i % k );
1722
else if ( 0 <= i && k < 0 ) i = ( i % -k );
1723
else if ( i < 0 && 0 <= k ) i = ( k - ( -i % k )) % k;
1724
else if ( i < 0 && k < 0 ) i = (-k - ( -i % -k )) % k;
1725
mod = INTOBJ_INT( i );
1726
1727
}
1728
1729
/* compute the remainder of a small integer by a large integer */
1730
else if ( IS_INTOBJ(opL) ) {
1731
1732
/* the small int -(1<<28) mod the large int (1<<28) is 0 */
1733
if ( opL == INTOBJ_INT(-(Int)(1L<<NR_SMALL_INT_BITS) )
1734
&& ( TNUM_OBJ(opR) == T_INTPOS )
1735
&& ( SIZE_INT(opR) == 1 )
1736
&& ( VAL_LIMB0(opR) == (TypLimb)(1L<<NR_SMALL_INT_BITS) ) )
1737
mod = INTOBJ_INT(0);
1738
1739
/* in all other cases the remainder is equal the left operand */
1740
else if ( 0 <= INT_INTOBJ(opL) )
1741
mod = opL;
1742
else if ( TNUM_OBJ(opR) == T_INTPOS )
1743
mod = SumOrDiffInt( opL, opR, 1 );
1744
else
1745
mod = SumOrDiffInt( opL, opR, -1 );
1746
}
1747
1748
/* compute the remainder of a large integer by a small integer */
1749
else if ( IS_INTOBJ(opR) ) {
1750
1751
/* pathological case first */
1752
if ( opR == INTOBJ_INT(0) ) {
1753
opR = ErrorReturnObj(
1754
"Integer operations: <divisor> must be nonzero",
1755
0L, 0L,
1756
"you can replace the integer <divisor> via 'return <divisor>;'" );
1757
return MOD( opL, opR );
1758
}
1759
1760
/* get the integer value, make positive */
1761
i = INT_INTOBJ(opR); if ( i < 0 ) i = -i;
1762
1763
/* maybe it's trivial */
1764
if ( INTBASE % i == 0 ) {
1765
c = ADDR_INT(opL)[0] % i;
1766
}
1767
1768
/* otherwise use the gmp function to divide */
1769
else {
1770
c = mpn_mod_1( ADDR_INT(opL), SIZE_INT(opL), (TypLimb)i );
1771
}
1772
1773
/* now c is the result, it has the same sign as the left operand */
1774
if ( TNUM_OBJ(opL) == T_INTPOS )
1775
mod = INTOBJ_INT( c );
1776
else if ( c == 0 )
1777
mod = INTOBJ_INT( c );
1778
else if ( 0 <= INT_INTOBJ(opR) )
1779
mod = SumOrDiffInt( INTOBJ_INT( -(Int)c ), opR, 1 );
1780
else
1781
mod = SumOrDiffInt( INTOBJ_INT( -(Int)c ), opR, -1 );
1782
1783
}
1784
1785
/* compute the remainder of a large integer modulo a large integer */
1786
else {
1787
1788
/* trivial case first */
1789
if ( SIZE_INT(opL) < SIZE_INT(opR) ) {
1790
if ( TNUM_OBJ(opL) == T_INTPOS )
1791
return opL;
1792
else if ( TNUM_OBJ(opR) == T_INTPOS )
1793
mod = SumOrDiffInt( opL, opR, 1 );
1794
else
1795
mod = SumOrDiffInt( opL, opR, -1 );
1796
if IS_INTNEG(mod) return NEW_INTPOS(mod);
1797
else return mod;
1798
}
1799
1800
mod = NewBag( TNUM_OBJ(opL), (SIZE_INT(opL)+1)*sizeof(TypLimb) );
1801
1802
quo = NewBag( T_INTPOS,
1803
(SIZE_INT(opL)-SIZE_INT(opR)+1)*sizeof(TypLimb) );
1804
1805
/* and let gmp do the work */
1806
mpn_tdiv_qr( ADDR_INT(quo), ADDR_INT(mod), 0,
1807
ADDR_INT(opL), SIZE_INT(opL),
1808
ADDR_INT(opR), SIZE_INT(opR) );
1809
1810
/* reduce to small integer if possible, otherwise shrink bag */
1811
mod = GMP_NORMALIZE( mod );
1812
mod = GMP_REDUCE( mod );
1813
1814
/* make the representative positive */
1815
if ( (TNUM_OBJ(mod) == T_INT && INT_INTOBJ(mod) < 0)
1816
|| TNUM_OBJ(mod) == T_INTNEG ) {
1817
if ( TNUM_OBJ(opR) == T_INTPOS )
1818
mod = SumOrDiffInt( mod, opR, 1 );
1819
else
1820
mod = SumOrDiffInt( mod, opR, -1 );
1821
}
1822
1823
}
1824
1825
/* return the result */
1826
if IS_INTNEG(mod)
1827
return NEW_INTPOS(mod);
1828
else if ( IS_INTOBJ(mod) && 0 > INT_INTOBJ(mod) )
1829
return INTOBJ_INT(-INT_INTOBJ(mod));
1830
else
1831
return mod;
1832
}
1833
1834
1835
/****************************************************************************
1836
**
1837
*F QuoInt( <intL>, <intR> ) . . . . . . . . . . . quotient of two integers
1838
**
1839
** 'QuoInt' returns the integer part of the two integers <intL> and <intR>.
1840
** 'QuoInt' handles operands of type 'T_INT', 'T_INTPOS' and 'T_INTNEG'.
1841
**
1842
** It can also be used in the cases that both operands are small integers
1843
** and the result is a small integer too, i.e., that no overflow occurs.
1844
**
1845
** Note that this routine is not called from 'EvalQuo', the division of two
1846
** integers yields a rational and is therefor performed in 'QuoRat'.
1847
** This operation is however available through the internal function 'Quo'.
1848
*/
1849
Obj QuoInt ( Obj opL, Obj opR )
1850
{
1851
Int i; /* loop count, value for small int */
1852
Int k; /* loop count, value for small int */
1853
Obj quo; /* handle of the result bag */
1854
Obj rem; /* handle of the remainder bag */
1855
1856
/* divide two small integers */
1857
if ( ARE_INTOBJS( opL, opR ) ) {
1858
1859
/* pathological case first */
1860
if ( opR == INTOBJ_INT(0) ) {
1861
opR = ErrorReturnObj(
1862
"Integer operations: <divisor> must be nonzero",
1863
0L, 0L,
1864
"you can replace the integer <divisor> via 'return <divisor>;'" );
1865
return QUO( opL, opR );
1866
}
1867
1868
/* the small int -(1<<28) divided by -1 is the large int (1<<28) */
1869
if ( opL == INTOBJ_INT(-(Int)(1L<<NR_SMALL_INT_BITS))
1870
&& opR == INTOBJ_INT(-1) ) {
1871
quo = NewBag( T_INTPOS, sizeof(TypLimb) );
1872
SET_VAL_LIMB0( quo, 1L<<NR_SMALL_INT_BITS );
1873
return quo;
1874
}
1875
1876
/* get the integer values */
1877
i = INT_INTOBJ(opL);
1878
k = INT_INTOBJ(opR);
1879
1880
/* divide, make sure we divide only positive numbers */
1881
if ( 0 <= i && 0 <= k ) i = ( i / k );
1882
else if ( 0 <= i && k < 0 ) i = - ( i / -k );
1883
else if ( i < 0 && 0 <= k ) i = - ( -i / k );
1884
else if ( i < 0 && k < 0 ) i = ( -i / -k );
1885
quo = INTOBJ_INT( i );
1886
1887
}
1888
1889
/* divide a small integer by a large one */
1890
else if ( IS_INTOBJ(opL) ) {
1891
1892
/* the small int -(1<<28) divided by the large int (1<<28) is -1 */
1893
1894
if ( opL == INTOBJ_INT(-(Int)(1L<<NR_SMALL_INT_BITS))
1895
&& TNUM_OBJ(opR) == T_INTPOS && SIZE_INT(opR) == 1
1896
&& VAL_LIMB0(opR) == 1L<<NR_SMALL_INT_BITS )
1897
quo = INTOBJ_INT(-1);
1898
1899
/* in all other cases the quotient is of course zero */
1900
else
1901
quo = INTOBJ_INT(0);
1902
1903
}
1904
1905
/* divide a large integer by a small integer */
1906
else if ( IS_INTOBJ(opR) ) {
1907
1908
/* pathological case first */
1909
if ( opR == INTOBJ_INT(0) ) {
1910
opR = ErrorReturnObj(
1911
"Integer operations: <divisor> must be nonzero",
1912
0L, 0L,
1913
"you can replace the integer <divisor> via 'return <divisor>;'" );
1914
return QUO( opL, opR );
1915
}
1916
1917
/* allocate a bag for the result and set up the pointers */
1918
if ( (TNUM_OBJ(opL)==T_INTPOS && 0 < INT_INTOBJ(opR))
1919
|| (TNUM_OBJ(opL)==T_INTNEG && INT_INTOBJ(opR) < 0) )
1920
quo = NewBag( T_INTPOS, SIZE_OBJ(opL) );
1921
else
1922
quo = NewBag( T_INTNEG, SIZE_OBJ(opL) );
1923
1924
opR = FuncGMP_INTOBJ( (Obj)0, opR );
1925
1926
/* use gmp function for dividing by a 1-limb number */
1927
mpn_divrem_1( ADDR_INT(quo), 0,
1928
ADDR_INT(opL), SIZE_INT(opL),
1929
*ADDR_INT(opR) );
1930
}
1931
1932
/* divide a large integer by a large integer */
1933
else {
1934
1935
/* trivial case first */
1936
if ( SIZE_INT(opL) < SIZE_INT(opR) )
1937
return INTOBJ_INT(0);
1938
1939
/* create a new bag for the remainder */
1940
rem = NewBag( TNUM_OBJ(opL), (SIZE_INT(opL)+1)*sizeof(TypLimb) );
1941
1942
/* allocate a bag for the quotient */
1943
if ( TNUM_OBJ(opL) == TNUM_OBJ(opR) )
1944
quo = NewBag( T_INTPOS,
1945
(SIZE_INT(opL)-SIZE_INT(opR)+1)*sizeof(TypLimb) );
1946
else
1947
quo = NewBag( T_INTNEG,
1948
(SIZE_INT(opL)-SIZE_INT(opR)+1)*sizeof(TypLimb) );
1949
1950
mpn_tdiv_qr( ADDR_INT(quo), ADDR_INT(rem), 0,
1951
ADDR_INT(opL), SIZE_INT(opL),
1952
ADDR_INT(opR), SIZE_INT(opR) );
1953
}
1954
1955
/* normalize and return the result */
1956
quo = GMP_NORMALIZE(quo);
1957
quo = GMP_REDUCE( quo );
1958
return quo;
1959
}
1960
1961
1962
/****************************************************************************
1963
**
1964
*F FuncQUO_INT(<self>,<opL>,<opR>) . . . . . . . internal function 'QuoInt'
1965
**
1966
** 'FuncQUO_INT' implements the internal function 'QuoInt'.
1967
**
1968
** 'QuoInt( <i>, <k> )'
1969
**
1970
** 'Quo' returns the integer part of the quotient of its integer operands.
1971
** If <i> and <k> are positive 'Quo( <i>, <k> )' is the largest positive
1972
** integer <q> such that '<q> * <k> \<= <i>'. If <i> or <k> or both are
1973
** negative we define 'Abs( Quo(<i>,<k>) ) = Quo( Abs(<i>), Abs(<k>) )' and
1974
** 'Sign( Quo(<i>,<k>) ) = Sign(<i>) * Sign(<k>)'. Dividing by 0 causes an
1975
** error. 'Rem' (see "Rem") can be used to compute the remainder.
1976
*/
1977
Obj FuncQUO_INT ( Obj self, Obj opL, Obj opR )
1978
{
1979
/* check the arguments */
1980
while ( TNUM_OBJ(opL) != T_INT
1981
&& TNUM_OBJ(opL) != T_INTPOS
1982
&& TNUM_OBJ(opL) != T_INTNEG ) {
1983
opL = ErrorReturnObj(
1984
"QuoInt: <left> must be a int (not a %s)",
1985
(Int)TNAM_OBJ(opL), 0L,
1986
"you can replace <left> via 'return <left>;'" );
1987
}
1988
while ( TNUM_OBJ(opR) != T_INT
1989
&& TNUM_OBJ(opR) != T_INTPOS
1990
&& TNUM_OBJ(opR) != T_INTNEG ) {
1991
opR = ErrorReturnObj(
1992
"QuoInt: <right> must be a int (not a %s)",
1993
(Int)TNAM_OBJ(opR), 0L,
1994
"you can replace <right> via 'return <right>;'" );
1995
}
1996
1997
/* return the quotient */
1998
return QuoInt( opL, opR );
1999
}
2000
2001
2002
/****************************************************************************
2003
**
2004
*F RemInt( <intL>, <intR> ) . . . . . . . . . . . remainder of two integers
2005
**
2006
** 'RemInt' returns the remainder of the quotient of the integers <intL>
2007
** and <intR>. 'RemInt' handles operands of type 'T_INT', 'T_INTPOS' and
2008
** 'T_INTNEG'.
2009
**
2010
** Note that the remainder is different from the value returned by the 'mod'
2011
** operator which is always positive.
2012
*/
2013
Obj RemInt ( Obj opL, Obj opR )
2014
{
2015
Int i; /* loop count, value for small int */
2016
Int k; /* loop count, value for small int */
2017
UInt c; /* product of two digits */
2018
Obj rem; /* handle of the remainder bag */
2019
Obj quo; /* handle of the quotient bag */
2020
2021
/* compute the remainder of two small integers */
2022
if ( ARE_INTOBJS( opL, opR ) ) {
2023
2024
/* pathological case first */
2025
if ( opR == INTOBJ_INT(0) ) {
2026
opR = ErrorReturnObj(
2027
"Integer operations: <divisor> must be nonzero",
2028
0L, 0L,
2029
"you can replace the integer <divisor> via 'return <divisor>;'" );
2030
return QUO( opL, opR );
2031
}
2032
2033
/* get the integer values */
2034
i = INT_INTOBJ(opL);
2035
k = INT_INTOBJ(opR);
2036
2037
/* compute the remainder, make sure we divide only positive numbers */
2038
if ( 0 <= i && 0 <= k ) i = ( i % k );
2039
else if ( 0 <= i && k < 0 ) i = ( i % -k );
2040
else if ( i < 0 && 0 <= k ) i = - ( -i % k );
2041
else if ( i < 0 && k < 0 ) i = - ( -i % -k );
2042
rem = INTOBJ_INT( i );
2043
2044
}
2045
2046
/* compute the remainder of a small integer by a large integer */
2047
else if ( IS_INTOBJ(opL) ) {
2048
2049
/* the small int -(1<<28) rem the large int (1<<28) is 0 */
2050
if ( opL == INTOBJ_INT(-(Int)(1L<<NR_SMALL_INT_BITS))
2051
&& TNUM_OBJ(opR) == T_INTPOS && SIZE_INT(opR) == 1
2052
&& VAL_LIMB0(opR) == 1L<<NR_SMALL_INT_BITS )
2053
rem = INTOBJ_INT(0);
2054
2055
/* in all other cases the remainder is equal the left operand */
2056
else
2057
rem = opL;
2058
}
2059
2060
/* compute the remainder of a large integer by a small integer */
2061
else if ( IS_INTOBJ(opR) ) {
2062
2063
/* pathological case first */
2064
if ( opR == INTOBJ_INT(0) ) {
2065
opR = ErrorReturnObj(
2066
"Integer operations: <divisor> must be nonzero",
2067
0L, 0L,
2068
"you can replace the integer <divisor> via 'return <divisor>;'" );
2069
return QUO( opL, opR );
2070
}
2071
2072
/* maybe it's trivial */
2073
if ( INTBASE % INT_INTOBJ(AbsInt(opR)) == 0 ) {
2074
c = ADDR_INT(opL)[0] % INT_INTOBJ(AbsInt(opR));
2075
}
2076
2077
/* otherwise run through the left operand and divide digitwise */
2078
else {
2079
opR = FuncGMP_INTOBJ( (Obj)0, opR );
2080
c = mpn_mod_1( ADDR_INT(opL), SIZE_INT(opL), *ADDR_INT(opR) );
2081
}
2082
2083
/* now c is the result, it has the same sign as the left operand */
2084
if ( TNUM_OBJ(opL) == T_INTPOS )
2085
rem = INTOBJ_INT( c );
2086
else
2087
rem = INTOBJ_INT( -(Int)c );
2088
2089
}
2090
2091
/* compute the remainder of a large integer modulo a large integer */
2092
else {
2093
2094
/* trivial case first */
2095
if ( SIZE_INT(opL) < SIZE_INT(opR) )
2096
return opL;
2097
2098
rem = NewBag( TNUM_OBJ(opL), (SIZE_INT(opL)+1)*sizeof(TypLimb) );
2099
2100
quo = NewBag( T_INTPOS,
2101
(SIZE_INT(opL)-SIZE_INT(opR)+1)*sizeof(TypLimb) );
2102
2103
/* and let gmp do the work */
2104
mpn_tdiv_qr( ADDR_INT(quo), ADDR_INT(rem), 0,
2105
ADDR_INT(opL), SIZE_INT(opL),
2106
ADDR_INT(opR), SIZE_INT(opR) );
2107
2108
/* reduce to small integer if possible, otherwise shrink bag */
2109
rem = GMP_NORMALIZE( rem );
2110
rem = GMP_REDUCE( rem );
2111
2112
}
2113
2114
/* return the result */
2115
return rem;
2116
}
2117
2118
2119
/****************************************************************************
2120
**
2121
*F FuncREM_INT(<self>,<opL>,<opR>) . . . . . . . internal function 'RemInt'
2122
**
2123
** 'FuncREM_INT' implements the internal function 'RemInt'.
2124
**
2125
** 'RemInt( <i>, <k> )'
2126
**
2127
** 'Rem' returns the remainder of its two integer operands, i.e., if <k> is
2128
** not equal to zero 'Rem( <i>, <k> ) = <i> - <k> * Quo( <i>, <k> )'. Note
2129
** that the rules given for 'Quo' (see "Quo") imply that 'Rem( <i>, <k> )'
2130
** has the same sign as <i> and its absolute value is strictly less than the
2131
** absolute value of <k>. Dividing by 0 causes an error.
2132
*/
2133
Obj FuncREM_INT ( Obj self, Obj opL, Obj opR )
2134
{
2135
/* check the arguments */
2136
while ( TNUM_OBJ(opL) != T_INT
2137
&& TNUM_OBJ(opL) != T_INTPOS
2138
&& TNUM_OBJ(opL) != T_INTNEG ) {
2139
opL = ErrorReturnObj(
2140
"RemInt: <left> must be an integer (not a %s)",
2141
(Int)TNAM_OBJ(opL), 0L,
2142
"you can replace <left> via 'return <left>;'" );
2143
}
2144
while ( TNUM_OBJ(opR) != T_INT
2145
&& TNUM_OBJ(opR) != T_INTPOS
2146
&& TNUM_OBJ(opR) != T_INTNEG ) {
2147
opR = ErrorReturnObj(
2148
"RemInt: <right> must be an integer (not a %s)",
2149
(Int)TNAM_OBJ(opR), 0L,
2150
"you can replace <right> via 'return <right>;'" );
2151
}
2152
2153
/* return the remainder */
2154
return RemInt( opL, opR );
2155
}
2156
2157
2158
/****************************************************************************
2159
**
2160
*F GcdInt( <opL>, <opR> ) . . . . . . . . . . . gcd of two GMP integers
2161
**
2162
** 'GcdInt' returns the gcd of the two integers <opL> and <opR>.
2163
**
2164
** It is called from 'FuncGCD_INT' and from the rational package.
2165
*/
2166
Obj GcdInt ( Obj opL, Obj opR )
2167
{
2168
Int i; /* loop count, value for small int */
2169
Int k; /* loop count, value for small int */
2170
UInt c; /* product of two digits */
2171
Obj gmpL; /* copy of the first arg */
2172
Obj gmpR; /* copy of the second arg */
2173
Obj gcd; /* handle of the result */
2174
TypLimb gcdsize; /* number of limbs mpn_gcd returns */
2175
Int p,q; /* number of zero limbs per arg */
2176
Int r,s; /* number of zero bits per arg */
2177
TypLimb bmask; /* bit mask */
2178
UInt plimbs; /* zero limbs to shift by */
2179
UInt prest; /* and remaining zero bits */
2180
UInt overflow; /* possible overflow from most
2181
significant word */
2182
2183
/* compute the gcd of two small integers */
2184
if ( ARE_INTOBJS( opL, opR ) ) {
2185
2186
/* get the integer values, make them positive */
2187
i = INT_INTOBJ(opL); if ( i < 0 ) i = -i;
2188
k = INT_INTOBJ(opR); if ( k < 0 ) k = -k;
2189
2190
/* compute the gcd using Euclids algorithm */
2191
while ( k != 0 ) {
2192
c = k;
2193
k = i % k;
2194
i = c;
2195
}
2196
2197
/* now i is the result */
2198
gcd = GMPorINTOBJ_INT( (Int)i );
2199
return gcd;
2200
}
2201
2202
/* compute the gcd of a small and a large integer */
2203
else if ( IS_INTOBJ(opL) || IS_INTOBJ(opR) ) {
2204
2205
/* make the right operand the small one */
2206
if ( IS_INTOBJ(opL) ) {
2207
gcd = opL; opL = opR; opR = gcd;
2208
}
2209
2210
/* maybe it's trivial */
2211
if ( opR == INTOBJ_INT(0) ) {
2212
if( TNUM_OBJ( opL ) == T_INTNEG ) {
2213
/* If opL is negative, change the sign. We do this by
2214
copying opL into a bag of type T_INTPOS. Note that
2215
opL is a large negative number, so it cannot be the
2216
the negative of 1 << NR_SMALL_INT_BITS. */
2217
gcd = NEW_INTPOS( opL );
2218
return gcd;
2219
}
2220
else return opL;
2221
}
2222
2223
/* compute the gcd */
2224
opR = FuncGMP_INTOBJ( (Obj)0, opR );
2225
i = mpn_gcd_1( ADDR_INT(opL), SIZE_INT(opL), *ADDR_INT(opR) );
2226
gcd = GMPorINTOBJ_INT( (Int)i );
2227
return gcd;
2228
}
2229
2230
/* compute the gcd of two large integers */
2231
else {
2232
if ( EqInt(opL,opR) ) {
2233
if IS_INTNEG(opL) {
2234
return NEW_INTPOS(opL);
2235
}
2236
else {
2237
return opL;
2238
}
2239
}
2240
gmpL = NEW_INT(opL); gmpR = NEW_INT(opR);
2241
2242
/* find highest power of 2 dividing gmpL and divide out by this */
2243
for ( p = 0 ; ADDR_INT(gmpL)[p] == (TypLimb)0; p++ ) {
2244
for ( i = 0 ; i < mp_bits_per_limb ; i++ ) {
2245
}
2246
}
2247
for ( bmask = (TypLimb)1, r = 0 ;
2248
( (bmask & ADDR_INT(gmpL)[p]) == 0 ) && bmask != (TypLimb)0 ;
2249
bmask = bmask << 1, r++ ) {
2250
}
2251
p = p*mp_bits_per_limb+r;
2252
for ( i = 0 ; i < p ; i++ ){
2253
mpn_rshift( ADDR_INT(gmpL), ADDR_INT(gmpL),
2254
SIZE_INT(gmpL), (UInt)1 );
2255
}
2256
gmpL = GMP_NORMALIZE(gmpL);
2257
2258
/* find highest power of 2 dividing gmpR and divide out by this */
2259
for ( q = 0 ; ADDR_INT(gmpR)[q] == (TypLimb)0; q++ ) {
2260
for ( i = 0 ; i < mp_bits_per_limb ; i++ ) {
2261
}
2262
}
2263
for ( bmask = (TypLimb)1, s = 0 ;
2264
( (bmask & ADDR_INT(gmpR)[q]) == 0 ) && bmask != (TypLimb)0 ;
2265
bmask=bmask << 1, s++ ) {
2266
}
2267
q = q*mp_bits_per_limb+s;
2268
for (i=0;i<q;i++){
2269
mpn_rshift( ADDR_INT(gmpR), ADDR_INT(gmpR),
2270
SIZE_INT(gmpR), (UInt)1 );
2271
}
2272
gmpR = GMP_NORMALIZE(gmpR);
2273
2274
/* put smaller object to right */
2275
if ( SIZE_INT(gmpL) < SIZE_INT(gmpR) ||
2276
( SIZE_INT(gmpL) == SIZE_INT(gmpR) &&
2277
mpn_cmp( ADDR_INT(gmpL), ADDR_INT(gmpR), SIZE_INT(gmpL) ) < 0 ) ) {
2278
gcd = gmpR; gmpR = gmpL; gmpL = gcd;
2279
}
2280
2281
/* get gcd of odd numbers gmpL, gmpR - put it in a bag as big as one
2282
of the original args, which will be big enough for the gcd */
2283
gcd = NewBag( T_INTPOS, SIZE_OBJ(opR) );
2284
2285
/* choose smaller of p,q and make it p
2286
we are going to multiply back in by 2 to that power */
2287
if ( p > q ) p = q;
2288
plimbs = p/mp_bits_per_limb;
2289
prest = p - plimbs*mp_bits_per_limb;
2290
2291
/* We deal with most of the power of two by placing some
2292
0 limbs below the least significant limb of the GCD */
2293
for (i = 0; i < plimbs; i++)
2294
ADDR_INT(gcd)[i] = 0;
2295
2296
/* Now we do the GCD -- gcdsize tells us the number of
2297
limbs used for the result */
2298
2299
gcdsize = mpn_gcd( plimbs + ADDR_INT(gcd),
2300
ADDR_INT(gmpL), SIZE_INT(gmpL),
2301
ADDR_INT(gmpR), SIZE_INT(gmpR) );
2302
2303
/* Now we do the rest of the power of two */
2304
if (prest != 0)
2305
{
2306
overflow = mpn_lshift( plimbs + ADDR_INT(gcd), plimbs + ADDR_INT(gcd),
2307
gcdsize, (UInt)prest );
2308
2309
/* which might extend the GCD to one more limb */
2310
if (overflow != 0)
2311
{
2312
ADDR_INT(gcd)[gcdsize + plimbs] = overflow;
2313
gcdsize++;
2314
}
2315
}
2316
2317
/* if the bag is too big, reduce it (stuff in extra space may not be 0) */
2318
if ( gcdsize+plimbs != SIZE_INT(opR) ) {
2319
ResizeBag( gcd, (gcdsize+plimbs)*sizeof(TypLimb) );
2320
}
2321
2322
}
2323
gcd = GMP_NORMALIZE(gcd);
2324
gcd = GMP_REDUCE(gcd);
2325
2326
/* return the result */
2327
return gcd;
2328
}
2329
2330
/****************************************************************************
2331
**
2332
*F FuncGCD_INT(<self>,<opL>,<opR>) . . . . . . . internal function 'GcdInt'
2333
**
2334
** 'FuncGCD_INT' implements the internal function 'GcdInt'.
2335
**
2336
** 'GcdInt( <i>, <k> )'
2337
**
2338
** 'Gcd' returns the greatest common divisor of the two integers <m> and
2339
** <n>, i.e., the greatest integer that divides both <m> and <n>. The
2340
** greatest common divisor is never negative, even if the arguments are. We
2341
** define $gcd( m, 0 ) = gcd( 0, m ) = abs( m )$ and $gcd( 0, 0 ) = 0$.
2342
*/
2343
Obj FuncGCD_INT ( Obj self, Obj opL, Obj opR )
2344
{
2345
/* check the arguments */
2346
while ( TNUM_OBJ(opL) != T_INT
2347
&& TNUM_OBJ(opL) != T_INTPOS
2348
&& TNUM_OBJ(opL) != T_INTNEG ) {
2349
opL = ErrorReturnObj(
2350
"GcdInt: <left> must be an integer (not a %s)",
2351
(Int)TNAM_OBJ(opL), 0L,
2352
"you can replace <left> via 'return <left>;'" );
2353
}
2354
while ( TNUM_OBJ(opR) != T_INT
2355
&& TNUM_OBJ(opR) != T_INTPOS
2356
&& TNUM_OBJ(opR) != T_INTNEG ) {
2357
opR = ErrorReturnObj(
2358
"GcdInt: <right> must be an integer (not a %s)",
2359
(Int)TNAM_OBJ(opR), 0L,
2360
"you can replace <right> via 'return <right>;'" );
2361
}
2362
2363
/* return the gcd */
2364
return GcdInt( opL, opR );
2365
}
2366
2367
2368
2369
2370
2371
2372
/****************************************************************************
2373
**
2374
** * * * * * * * "Mersenne twister" random numbers * * * * * * * * * * * * *
2375
**
2376
** Part of this code for fast generation of 32 bit pseudo random numbers with
2377
** a period of length 2^19937-1 and a 623-dimensional equidistribution is
2378
** taken from:
2379
** http://www.math.sci.hiroshima-u.ac.jp/~m-mat/MT/emt.html
2380
** (Also look in Wikipedia for "Mersenne twister".)
2381
*/
2382
2383
/****************************************************************************
2384
**
2385
*F RandomIntegerMT( <mtstr>, <nrbits> )
2386
**
2387
** Returns an integer with at most <nrbits> bits in uniform distribution.
2388
** <nrbits> must be a small integer. <mtstr> is a string as returned by
2389
** InitRandomMT.
2390
**
2391
** Implementation details are a bit tricky to obtain the same random
2392
** integers on 32 bit and 64 bit machines (which have different long
2393
** integer digit lengths and different ranges of small integers).
2394
**
2395
*/
2396
/* for comparison in case result is small int */
2397
Obj SMALLEST_INTPOS = NULL;
2398
2399
Obj FuncRandomIntegerMT(Obj self, Obj mtstr, Obj nrbits)
2400
{
2401
Obj res;
2402
Int i, n, q, r, qoff, len;
2403
UInt4 *mt, rand;
2404
UInt4 *pt;
2405
while (! IsStringConv(mtstr)) {
2406
mtstr = ErrorReturnObj(
2407
"<mtstr> must be a string, not a %s)",
2408
(Int)TNAM_OBJ(mtstr), 0L,
2409
"you can replace <mtstr> via 'return <mtstr>;'" );
2410
}
2411
while ((! IsStringConv(mtstr)) || GET_LEN_STRING(mtstr) < 2500) {
2412
mtstr = ErrorReturnObj(
2413
"<mtstr> must be a string with at least 2500 characters, ",
2414
0L, 0L,
2415
"you can replace <mtstr> via 'return <mtstr>;'" );
2416
}
2417
while ((! IS_INTOBJ(nrbits)) || INT_INTOBJ(nrbits) < 0) {
2418
nrbits = ErrorReturnObj(
2419
"<nrbits> must be a small non-negative integer, not a %s)",
2420
(Int)TNAM_OBJ(nrbits), 0L,
2421
"you can replace <mtstr> via 'return <mtstr>;'" );
2422
}
2423
n = INT_INTOBJ(nrbits);
2424
2425
/* small int case */
2426
if (n <= NR_SMALL_INT_BITS) {
2427
mt = (UInt4*) CHARS_STRING(mtstr);
2428
#ifdef SYS_IS_64_BIT
2429
if (n <= 32) {
2430
res = INTOBJ_INT((Int)(nextrandMT_int32(mt) & ((UInt4) -1L >> (32-n))));
2431
}
2432
else {
2433
unsigned long rd;
2434
rd = nextrandMT_int32(mt);
2435
rd += (unsigned long) ((UInt4) nextrandMT_int32(mt) &
2436
((UInt4) -1L >> (64-n))) << 32;
2437
res = INTOBJ_INT((Int)rd);
2438
}
2439
#else
2440
res = INTOBJ_INT((Int)(nextrandMT_int32(mt) & ((UInt4) -1L >> (32-n))));
2441
#endif
2442
}
2443
else {
2444
/* large int case */
2445
q = n / 32;
2446
r = n - q * 32;
2447
/* qoff = number of 32 bit words we need */
2448
qoff = q + (r==0 ? 0:1);
2449
/* len = number of limbs we need (limbs currently are either 32 or 64 bit wide) */
2450
len = (qoff*4 + sizeof(TypLimb) - 1) / sizeof(TypLimb);
2451
res = NewBag( T_INTPOS, len*sizeof(TypLimb) );
2452
pt = (UInt4*) ADDR_INT(res);
2453
mt = (UInt4*) CHARS_STRING(mtstr);
2454
for (i = 0; i < qoff; i++, pt++) {
2455
rand = (UInt4) nextrandMT_int32(mt);
2456
*pt = rand;
2457
}
2458
if (r != 0) {
2459
/* we generated too many random bits -- chop of the extra bits */
2460
pt = (UInt4*) ADDR_INT(res);
2461
pt[qoff-1] = pt[qoff-1] & ((UInt4)(-1) >> (32-r));
2462
}
2463
/* shrink bag if necessary */
2464
res = GMP_NORMALIZE(res);
2465
/* convert result if small int */
2466
res = GMP_REDUCE(res);
2467
}
2468
2469
return res;
2470
}
2471
2472
/****************************************************************************
2473
**
2474
*F * * * * * * * * * * * * * initialize package * * * * * * * * * * * * * * *
2475
*/
2476
2477
/****************************************************************************
2478
**
2479
*V GVarFilts . . . . . . . . . . . . . . . . . . . list of filters to export
2480
*/
2481
static StructGVarFilt GVarFilts [] = {
2482
2483
{ "IS_INT", "obj", &IsIntFilt,
2484
FuncIS_INT, "src/gmpints.c:IS_INT" },
2485
2486
{ 0 }
2487
2488
};
2489
2490
2491
/****************************************************************************
2492
**
2493
*V GVarFuncs . . . . . . . . . . . . . . . . . . list of functions to export
2494
*/
2495
static StructGVarFunc GVarFuncs [] = {
2496
2497
{ "QUO_INT", 2, "gmp1, gmp2",
2498
FuncQUO_INT, "src/gmpints.c:QUO_INT" },
2499
2500
{ "ABS_INT", 1, "x",
2501
FuncABS_INT, "src/gmpints.c:ABS_INT" },
2502
2503
{ "REM_INT", 2, "gmp1, gmp2",
2504
FuncREM_INT, "src/gmpints.c:REM_INT" },
2505
2506
{ "GCD_INT", 2, "gmp1, gmp2",
2507
FuncGCD_INT, "src/gmpints.c:GCD_INT" },
2508
2509
{ "PROD_INT_OBJ", 2, "gmp, obj",
2510
FuncPROD_INT_OBJ, "src/gmpints.c:PROD_INT_OBJ" },
2511
2512
{ "POW_OBJ_INT", 2, "obj, gmp",
2513
FuncPOW_OBJ_INT, "src/gmpints.c:POW_OBJ_INT" },
2514
2515
{ "GMP_REDUCE", 1, "obj",
2516
FuncGMP_REDUCE, "src/gmpints.c:GMP_REDUCE" },
2517
2518
{ "GMP_NORMALIZE", 1, "obj",
2519
FuncGMP_NORMALIZE, "src/gmpints.c:GMP_NORMALIZE" },
2520
2521
{ "HexStringInt", 1, "gmp",
2522
FuncHexStringInt, "src/gmpints.c:HexStringInt" },
2523
2524
{ "IntHexString", 1, "string",
2525
FuncIntHexString, "src/gmpints.c:IntHexString" },
2526
2527
{ "Log2Int", 1, "gmp",
2528
FuncLog2Int, "src/gmpints.c:Log2Int" },
2529
2530
{ "STRING_INT", 1, "gmp",
2531
FuncSTRING_INT, "src/gmpints.c:STRING_INT" },
2532
2533
{ "RandomIntegerMT", 2, "mtstr, nrbits",
2534
FuncRandomIntegerMT, "src/gmpints.c:RandomIntegerMT" },
2535
2536
2537
{ 0 }
2538
2539
};
2540
2541
2542
/****************************************************************************
2543
**
2544
*F InitKernel( <module> ) . . . . . . . . initialise kernel data structures
2545
*/
2546
static Int InitKernel ( StructInitInfo * module )
2547
{
2548
UInt t1, t2;
2549
2550
if (mp_bits_per_limb != GMP_LIMB_BITS) {
2551
FPUTS_TO_STDERR("Panic, GMP limb size mismatch\n");
2552
SyExit( 1 );
2553
}
2554
2555
/* init filters and functions */
2556
InitHdlrFiltsFromTable( GVarFilts );
2557
InitHdlrFuncsFromTable( GVarFuncs );
2558
2559
/* install the marking functions */
2560
InfoBags[ T_INT ].name = "integer";
2561
#ifdef SYS_IS_64_BIT
2562
InfoBags[ T_INTPOS ].name = "integer (>= 2^60)";
2563
InfoBags[ T_INTNEG ].name = "integer (< -2^60)";
2564
#else
2565
InfoBags[ T_INTPOS ].name = "integer (>= 2^28)";
2566
InfoBags[ T_INTNEG ].name = "integer (< -2^28)";
2567
#endif
2568
InitMarkFuncBags( T_INTPOS, MarkNoSubBags );
2569
InitMarkFuncBags( T_INTNEG, MarkNoSubBags );
2570
2571
/* Install the saving methods */
2572
SaveObjFuncs [ T_INTPOS ] = SaveInt;
2573
SaveObjFuncs [ T_INTNEG ] = SaveInt;
2574
LoadObjFuncs [ T_INTPOS ] = LoadInt;
2575
LoadObjFuncs [ T_INTNEG ] = LoadInt;
2576
2577
/* install the printing functions */
2578
PrintObjFuncs[ T_INT ] = PrintInt;
2579
PrintObjFuncs[ T_INTPOS ] = PrintInt;
2580
PrintObjFuncs[ T_INTNEG ] = PrintInt;
2581
2582
/* install the comparison methods */
2583
for ( t1 = T_INT; t1 <= T_INTNEG; t1++ ) {
2584
for ( t2 = T_INT; t2 <= T_INTNEG; t2++ ) {
2585
EqFuncs [ t1 ][ t2 ] = EqInt;
2586
LtFuncs [ t1 ][ t2 ] = LtInt;
2587
}
2588
}
2589
2590
/* install the unary arithmetic methods */
2591
for ( t1 = T_INT; t1 <= T_INTNEG; t1++ ) {
2592
ZeroFuncs[ t1 ] = ZeroInt;
2593
ZeroMutFuncs[ t1 ] = ZeroInt;
2594
AInvFuncs[ t1 ] = AInvInt;
2595
AInvMutFuncs[ t1 ] = AInvInt;
2596
OneFuncs [ t1 ] = OneInt;
2597
OneMutFuncs [ t1 ] = OneInt;
2598
}
2599
2600
/* install the default product and power methods */
2601
for ( t1 = T_INT; t1 <= T_INTNEG; t1++ ) {
2602
for ( t2 = FIRST_CONSTANT_TNUM; t2 <= LAST_CONSTANT_TNUM; t2++ ) {
2603
ProdFuncs[ t1 ][ t2 ] = ProdIntObj;
2604
PowFuncs [ t2 ][ t1 ] = PowObjInt;
2605
}
2606
for ( t2 = FIRST_RECORD_TNUM; t2 <= LAST_RECORD_TNUM; t2++ ) {
2607
ProdFuncs[ t1 ][ t2 ] = ProdIntObj;
2608
PowFuncs [ t2 ][ t1 ] = PowObjInt;
2609
}
2610
for ( t2 = FIRST_LIST_TNUM; t2 <= LAST_LIST_TNUM; t2++ ) {
2611
ProdFuncs[ t1 ][ t2 ] = ProdIntObj;
2612
PowFuncs [ t2 ][ t1 ] = PowObjInt;
2613
}
2614
}
2615
2616
/* install the binary arithmetic methods */
2617
for ( t1 = T_INT; t1 <= T_INTNEG; t1++ ) {
2618
for ( t2 = T_INT; t2 <= T_INTNEG; t2++ ) {
2619
EqFuncs [ t1 ][ t2 ] = EqInt;
2620
LtFuncs [ t1 ][ t2 ] = LtInt;
2621
SumFuncs [ t1 ][ t2 ] = SumInt;
2622
DiffFuncs[ t1 ][ t2 ] = DiffInt;
2623
ProdFuncs[ t1 ][ t2 ] = ProdInt;
2624
PowFuncs [ t1 ][ t2 ] = PowInt;
2625
ModFuncs [ t1 ][ t2 ] = ModInt;
2626
}
2627
}
2628
2629
/* gvars to import from the library */
2630
ImportGVarFromLibrary( "TYPE_INT_SMALL_ZERO", &TYPE_INT_SMALL_ZERO );
2631
ImportGVarFromLibrary( "TYPE_INT_SMALL_POS", &TYPE_INT_SMALL_POS );
2632
ImportGVarFromLibrary( "TYPE_INT_SMALL_NEG", &TYPE_INT_SMALL_NEG );
2633
ImportGVarFromLibrary( "TYPE_INT_LARGE_POS", &TYPE_INT_LARGE_POS );
2634
ImportGVarFromLibrary( "TYPE_INT_LARGE_NEG", &TYPE_INT_LARGE_NEG );
2635
ImportGVarFromLibrary( "SMALLEST_INTPOS", &SMALLEST_INTPOS );
2636
2637
ImportFuncFromLibrary( "String", &String );
2638
ImportFuncFromLibrary( "One", &OneAttr);
2639
2640
/* install the type functions */
2641
TypeObjFuncs[ T_INT ] = TypeIntSmall;
2642
TypeObjFuncs[ T_INTPOS ] = TypeIntLargePos;
2643
TypeObjFuncs[ T_INTNEG ] = TypeIntLargeNeg;
2644
2645
MakeBagTypePublic( T_INTPOS );
2646
MakeBagTypePublic( T_INTNEG );
2647
2648
/* return success */
2649
return 0;
2650
}
2651
2652
2653
/****************************************************************************
2654
**
2655
*F InitLibrary( <module> ) . . . . . . . initialise library data structures
2656
*/
2657
static Int InitLibrary ( StructInitInfo * module )
2658
{
2659
UInt gvar;
2660
2661
/* init filters and functions */
2662
InitGVarFiltsFromTable( GVarFilts );
2663
InitGVarFuncsFromTable( GVarFuncs );
2664
2665
SMALLEST_INTPOS = NewBag( T_INTPOS, sizeof(TypLimb) );
2666
SET_VAL_LIMB0(SMALLEST_INTPOS, (1L<<NR_SMALL_INT_BITS));
2667
gvar = GVarName("SMALLEST_INTPOS");
2668
MakeReadWriteGVar( gvar );
2669
AssGVar( gvar, SMALLEST_INTPOS );
2670
MakeReadOnlyGVar(gvar);
2671
2672
/* return success */
2673
return 0;
2674
}
2675
2676
2677
/****************************************************************************
2678
**
2679
*F InitInfoInt() . . . . . . . . . . . . . . . . . . table of init functions
2680
*/
2681
static StructInitInfo module = {
2682
MODULE_BUILTIN, /* type */
2683
"gmpints", /* name */
2684
0, /* revision entry of c file */
2685
0, /* revision entry of h file */
2686
0, /* version */
2687
0, /* crc */
2688
InitKernel, /* initKernel */
2689
InitLibrary, /* initLibrary */
2690
0, /* checkInit */
2691
0, /* preSave */
2692
0, /* postSave */
2693
0 /* postRestore */
2694
};
2695
2696
StructInitInfo * InitInfoInt ( void )
2697
{
2698
return &module;
2699
}
2700
2701
#endif /* ! WARD_ENABLED */
2702
#endif /* USE_GMP */
2703
2704
/****************************************************************************
2705
**
2706
*E gmpints.c . . . . . . . . . . . . . . . . . . . . . . . . . . . ends here
2707
*/
2708
2709