1 /********************************************************************/
2 /* */
3 /* s7 Seed7 interpreter */
4 /* Copyright (C) 1990 - 2019 Thomas Mertes */
5 /* */
6 /* This program is free software; you can redistribute it and/or */
7 /* modify it under the terms of the GNU General Public License as */
8 /* published by the Free Software Foundation; either version 2 of */
9 /* the License, or (at your option) any later version. */
10 /* */
11 /* This program is distributed in the hope that it will be useful, */
12 /* but WITHOUT ANY WARRANTY; without even the implied warranty of */
13 /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
14 /* GNU General Public License for more details. */
15 /* */
16 /* You should have received a copy of the GNU General Public */
17 /* License along with this program; if not, write to the */
18 /* Free Software Foundation, Inc., 51 Franklin Street, */
19 /* Fifth Floor, Boston, MA 02110-1301, USA. */
20 /* */
21 /* Module: Library */
22 /* File: seed7/src/biglib.c */
23 /* Changes: 2005, 2006, 2013 - 2018 Thomas Mertes */
24 /* Content: All primitive actions for the bigInteger type. */
25 /* */
26 /********************************************************************/
27
28 #define LOG_FUNCTIONS 0
29 #define VERBOSE_EXCEPTIONS 0
30
31 #include "version.h"
32
33 #include "stdlib.h"
34 #include "stdio.h"
35 #include "string.h"
36
37 #include "common.h"
38 #include "data.h"
39 #include "heaputl.h"
40 #include "syvarutl.h"
41 #include "executl.h"
42 #include "objutl.h"
43 #include "runerr.h"
44 #include "big_drv.h"
45
46 #undef EXTERN
47 #define EXTERN
48 #include "biglib.h"
49
50
51
52 /**
53 * Compute the absolute value of a 'bigInteger' number.
54 * @return the absolute value.
55 */
big_abs(listType arguments)56 objectType big_abs (listType arguments)
57
58 { /* big_abs */
59 isit_bigint(arg_1(arguments));
60 return bld_bigint_temp(
61 bigAbs(take_bigint(arg_1(arguments))));
62 } /* big_abs */
63
64
65
66 /**
67 * Add two 'bigInteger' numbers.
68 * The function sorts the two values by size. This way there is a
69 * loop up to the shorter size and a second loop up to the longer size.
70 * @return the sum of the two numbers.
71 */
big_add(listType arguments)72 objectType big_add (listType arguments)
73
74 { /* big_add */
75 isit_bigint(arg_1(arguments));
76 isit_bigint(arg_3(arguments));
77 return bld_bigint_temp(
78 bigAdd(take_bigint(arg_1(arguments)), take_bigint(arg_3(arguments))));
79 } /* big_add */
80
81
82
83 /**
84 * Increment a 'bigInteger' variable by a delta.
85 */
big_add_assign(listType arguments)86 objectType big_add_assign (listType arguments)
87
88 { /* big_add_assign */
89 isit_bigint(arg_1(arguments));
90 isit_bigint(arg_3(arguments));
91 is_variable(arg_1(arguments));
92 bigAddAssign(&take_bigint(arg_1(arguments)), take_bigint(arg_3(arguments)));
93 return SYS_EMPTY_OBJECT;
94 } /* big_add_assign */
95
96
97
98 /**
99 * Number of bits in the minimal two's-complement representation.
100 * The high bits equivalent to the sign bit are not part of the
101 * minimal two's-complement representation.
102 * @return the number of bits.
103 * @exception RANGE_ERROR The result does not fit into an integer.
104 */
big_bit_length(listType arguments)105 objectType big_bit_length (listType arguments)
106
107 { /* big_bit_length */
108 isit_bigint(arg_1(arguments));
109 return bld_int_temp(
110 bigBitLength(take_bigint(arg_1(arguments))));
111 } /* big_bit_length */
112
113
114
115 /**
116 * Compare two 'bigInteger' numbers.
117 * @return -1, 0 or 1 if the first argument is considered to be
118 * respectively less than, equal to, or greater than the
119 * second.
120 */
big_cmp(listType arguments)121 objectType big_cmp (listType arguments)
122
123 { /* big_cmp */
124 isit_bigint(arg_1(arguments));
125 isit_bigint(arg_2(arguments));
126 return bld_int_temp(
127 bigCmp(take_bigint(arg_1(arguments)), take_bigint(arg_2(arguments))));
128 } /* big_cmp */
129
130
131
132 /**
133 * Convert a 'bigInteger' to 'bigInteger'.
134 * @return the unchanged 'bigInteger' number.
135 * @exception MEMORY_ERROR Not enough memory to represent the result.
136 */
big_conv(listType arguments)137 objectType big_conv (listType arguments)
138
139 {
140 bigIntType arg;
141 bigIntType result;
142
143 /* big_conv */
144 isit_bigint(arg_3(arguments));
145 arg = take_bigint(arg_3(arguments));
146 if (TEMP_OBJECT(arg_3(arguments))) {
147 result = arg;
148 arg_3(arguments)->value.bigIntValue = NULL;
149 } else {
150 result = bigCreate(arg);
151 } /* if */
152 return bld_bigint_temp(result);
153 } /* big_conv */
154
155
156
157 /**
158 * Assign source/arg_3 to dest/arg_1.
159 * A copy function assumes that dest/arg_1 contains a legal value.
160 */
big_cpy(listType arguments)161 objectType big_cpy (listType arguments)
162
163 {
164 objectType dest;
165 objectType source;
166
167 /* big_cpy */
168 dest = arg_1(arguments);
169 source = arg_3(arguments);
170 isit_bigint(dest);
171 isit_bigint(source);
172 is_variable(dest);
173 if (TEMP_OBJECT(source)) {
174 bigDestr(take_bigint(dest));
175 dest->value.bigIntValue = take_bigint(source);
176 source->value.bigIntValue = NULL;
177 } else {
178 bigCpy(&dest->value.bigIntValue, take_bigint(source));
179 } /* if */
180 return SYS_EMPTY_OBJECT;
181 } /* big_cpy */
182
183
184
185 /**
186 * Initialize dest/arg_1 and assign source/arg_3 to it.
187 * A create function assumes that the contents of dest/arg_1
188 * is undefined. Create functions can be used to initialize
189 * constants.
190 */
big_create(listType arguments)191 objectType big_create (listType arguments)
192
193 {
194 objectType dest;
195 objectType source;
196
197 /* big_create */
198 dest = arg_1(arguments);
199 source = arg_3(arguments);
200 isit_bigint(source);
201 SET_CATEGORY_OF_OBJ(dest, BIGINTOBJECT);
202 if (TEMP_OBJECT(source)) {
203 dest->value.bigIntValue = take_bigint(source);
204 source->value.bigIntValue = NULL;
205 } else {
206 dest->value.bigIntValue = bigCreate(take_bigint(source));
207 } /* if */
208 return SYS_EMPTY_OBJECT;
209 } /* big_create */
210
211
212
213 /**
214 * Decrement a 'bigInteger' variable.
215 * Decrements the number by 1.
216 */
big_decr(listType arguments)217 objectType big_decr (listType arguments)
218
219 {
220 objectType big_variable;
221
222 /* big_decr */
223 big_variable = arg_1(arguments);
224 isit_bigint(big_variable);
225 is_variable(big_variable);
226 bigDecr(&take_bigint(big_variable));
227 return SYS_EMPTY_OBJECT;
228 } /* big_decr */
229
230
231
232 /**
233 * Free the memory referred by 'old_bigint/arg_1'.
234 * After big_destr is left 'old_bigint/arg_1' is NULL.
235 * The memory where 'old_bigint/arg_1' is stored can be freed afterwards.
236 */
big_destr(listType arguments)237 objectType big_destr (listType arguments)
238
239 { /* big_destr */
240 isit_bigint(arg_1(arguments));
241 bigDestr(take_bigint(arg_1(arguments)));
242 arg_1(arguments)->value.bigIntValue = NULL;
243 SET_UNUSED_FLAG(arg_1(arguments));
244 return SYS_EMPTY_OBJECT;
245 } /* big_destr */
246
247
248
249 /**
250 * Integer division truncated towards zero.
251 * The remainder of this division is computed with big_rem.
252 * @return the quotient of the integer division.
253 * @exception NUMERIC_ERROR If a division by zero occurs.
254 */
big_div(listType arguments)255 objectType big_div (listType arguments)
256
257 { /* big_div */
258 isit_bigint(arg_1(arguments));
259 isit_bigint(arg_3(arguments));
260 return bld_bigint_temp(
261 bigDiv(take_bigint(arg_1(arguments)), take_bigint(arg_3(arguments))));
262 } /* big_div */
263
264
265
266 /**
267 * Quotient and remainder of integer division truncated towards zero.
268 * Compute quotient and remainder of the integer division ''div''.
269 * @return quotRem with quotient and remainder of the integer division.
270 * @exception NUMERIC_ERROR If a division by zero occurs.
271 */
big_div_rem(listType arguments)272 objectType big_div_rem (listType arguments)
273
274 {
275 objectType valueObj;
276 structType quotRem;
277
278 /* big_div_rem */
279 isit_bigint(arg_1(arguments));
280 isit_bigint(arg_3(arguments));
281 valueObj = getValue(curr_exec_object->type_of->result_type->match_obj);
282 if (!ALLOC_STRUCT(quotRem, 2)) {
283 return raise_exception(SYS_MEM_EXCEPTION);
284 } else {
285 quotRem->usage_count = 1;
286 quotRem->size = 2;
287 quotRem->stru[0].value.bigIntValue = bigDivRem(
288 take_bigint(arg_1(arguments)), take_bigint(arg_3(arguments)),
289 "Rem->stru[1].value.bigIntValue);
290 quotRem->stru[0].type_of = SYS_BIGINT_TYPE->value.typeValue;
291 quotRem->stru[0].descriptor.property = take_struct(valueObj)->stru[0].descriptor.property;
292 INIT_CATEGORY_OF_VAR("Rem->stru[0], BIGINTOBJECT);
293 quotRem->stru[1].type_of = SYS_BIGINT_TYPE->value.typeValue;
294 quotRem->stru[1].descriptor.property = take_struct(valueObj)->stru[1].descriptor.property;
295 INIT_CATEGORY_OF_VAR("Rem->stru[1], BIGINTOBJECT);
296 return bld_struct_temp(quotRem);
297 } /* if */
298 } /* big_div_rem */
299
300
301
302 /**
303 * Check if two 'bigInteger' numbers are equal.
304 * @return TRUE if both numbers are equal,
305 * FALSE otherwise.
306 */
big_eq(listType arguments)307 objectType big_eq (listType arguments)
308
309 { /* big_eq */
310 isit_bigint(arg_1(arguments));
311 isit_bigint(arg_3(arguments));
312 if (bigEq(take_bigint(arg_1(arguments)),
313 take_bigint(arg_3(arguments)))) {
314 return SYS_TRUE_OBJECT;
315 } else {
316 return SYS_FALSE_OBJECT;
317 } /* if */
318 } /* big_eq */
319
320
321
322 /**
323 * Convert a bstring (interpreted as big-endian) to a bigInteger.
324 * @param bstri/arg_1 Bstring to be converted. The bytes are interpreted
325 * as binary big-endian representation with a base of 256.
326 * @param isSigned/arg_2 Defines if 'bstri' is interpreted as signed value.
327 * If 'isSigned' is TRUE the twos-complement representation
328 * is used. In this case the result is negative if the most
329 * significant byte (the first byte) has an ordinal > BYTE_MAX (=127).
330 * @return a bigInteger created from the big-endian bytes.
331 */
big_from_bstri_be(listType arguments)332 objectType big_from_bstri_be (listType arguments)
333
334 { /* big_from_bstri_be */
335 isit_bstri(arg_1(arguments));
336 isit_bool(arg_2(arguments));
337 return bld_bigint_temp(
338 bigFromBStriBe(take_bstri(arg_1(arguments)),
339 take_bool(arg_2(arguments)) == SYS_TRUE_OBJECT));
340 } /* big_from_bstri_be */
341
342
343
344 /**
345 * Convert a bstring (interpreted as little-endian) to a bigInteger.
346 * @param bstri/arg_1 Bstring to be converted. The bytes are interpreted
347 * as binary little-endian representation with a base of 256.
348 * @param isSigned/arg_2 Defines if 'bstri' is interpreted as signed value.
349 * If 'isSigned' is TRUE the twos-complement representation
350 * is used. In this case the result is negative if the most
351 * significant byte (the last byte) has an ordinal > BYTE_MAX (=127).
352 * @return a bigInteger created from the little-endian bytes.
353 */
big_from_bstri_le(listType arguments)354 objectType big_from_bstri_le (listType arguments)
355
356 { /* big_from_bstri_le */
357 isit_bstri(arg_1(arguments));
358 isit_bool(arg_2(arguments));
359 return bld_bigint_temp(
360 bigFromBStriLe(take_bstri(arg_1(arguments)),
361 take_bool(arg_2(arguments)) == SYS_TRUE_OBJECT));
362 } /* big_from_bstri_le */
363
364
365
366 /**
367 * Compute the greatest common divisor of two 'bigInteger' numbers.
368 * @return the greatest common divisor of the two numbers.
369 */
big_gcd(listType arguments)370 objectType big_gcd (listType arguments)
371
372 { /* big_gcd */
373 isit_bigint(arg_1(arguments));
374 isit_bigint(arg_2(arguments));
375 return bld_bigint_temp(
376 bigGcd(take_bigint(arg_1(arguments)), take_bigint(arg_2(arguments))));
377 } /* big_gcd */
378
379
380
381 /**
382 * Check if number1 is greater than or equal to number2.
383 * @return TRUE if number1 is greater than or equal to number2,
384 * FALSE otherwise.
385 */
big_ge(listType arguments)386 objectType big_ge (listType arguments)
387
388 { /* big_ge */
389 isit_bigint(arg_1(arguments));
390 isit_bigint(arg_3(arguments));
391 if (bigCmp(take_bigint(arg_1(arguments)),
392 take_bigint(arg_3(arguments))) >= 0) {
393 return SYS_TRUE_OBJECT;
394 } else {
395 return SYS_FALSE_OBJECT;
396 } /* if */
397 } /* big_ge */
398
399
400
401 /**
402 * Check if number1 is greater than number2.
403 * @return TRUE if number1 is greater than number2,
404 * FALSE otherwise.
405 */
big_gt(listType arguments)406 objectType big_gt (listType arguments)
407
408 { /* big_gt */
409 isit_bigint(arg_1(arguments));
410 isit_bigint(arg_3(arguments));
411 if (bigCmp(take_bigint(arg_1(arguments)),
412 take_bigint(arg_3(arguments))) > 0) {
413 return SYS_TRUE_OBJECT;
414 } else {
415 return SYS_FALSE_OBJECT;
416 } /* if */
417 } /* big_gt */
418
419
420
421 /**
422 * Compute the hash value of a 'bigInteger' number.
423 * @return the hash value.
424 */
big_hashcode(listType arguments)425 objectType big_hashcode (listType arguments)
426
427 { /* big_hashcode */
428 isit_bigint(arg_1(arguments));
429 return bld_int_temp(
430 bigHashCode(take_bigint(arg_1(arguments))));
431 } /* big_hashcode */
432
433
434
435 /**
436 * Convert an integer number to 'bigInteger'.
437 * @return the bigInteger result of the conversion.
438 * @exception MEMORY_ERROR Not enough memory to represent the result.
439 */
big_iconv1(listType arguments)440 objectType big_iconv1 (listType arguments)
441
442 { /* big_iconv1 */
443 isit_int(arg_1(arguments));
444 return bld_bigint_temp(
445 bigIConv(take_int(arg_1(arguments))));
446 } /* big_iconv1 */
447
448
449
450 /**
451 * Convert an integer number to 'bigInteger'.
452 * @return the bigInteger result of the conversion.
453 * @exception MEMORY_ERROR Not enough memory to represent the result.
454 */
big_iconv3(listType arguments)455 objectType big_iconv3 (listType arguments)
456
457 { /* big_iconv3 */
458 isit_int(arg_3(arguments));
459 return bld_bigint_temp(
460 bigIConv(take_int(arg_3(arguments))));
461 } /* big_iconv3 */
462
463
464
465 /**
466 * Increment a 'bigInteger' variable.
467 * Increments the number by 1.
468 */
big_incr(listType arguments)469 objectType big_incr (listType arguments)
470
471 {
472 objectType big_variable;
473
474 /* big_incr */
475 big_variable = arg_1(arguments);
476 isit_bigint(big_variable);
477 is_variable(big_variable);
478 bigIncr(&take_bigint(big_variable));
479 return SYS_EMPTY_OBJECT;
480 } /* big_incr */
481
482
483
484 /**
485 * Compute the exponentiation of a 'bigInteger' base with an integer exponent.
486 * @return the result of the exponentiation.
487 * @exception NUMERIC_ERROR If the exponent is negative.
488 */
big_ipow(listType arguments)489 objectType big_ipow (listType arguments)
490
491 { /* big_ipow */
492 isit_bigint(arg_1(arguments));
493 isit_int(arg_3(arguments));
494 return bld_bigint_temp(
495 bigIPow(take_bigint(arg_1(arguments)), take_int(arg_3(arguments))));
496 } /* big_ipow */
497
498
499
500 /**
501 * Check if number1 is less than or equal to number2.
502 * @return TRUE if number1 is less than or equal to number2,
503 * FALSE otherwise.
504 */
big_le(listType arguments)505 objectType big_le (listType arguments)
506
507 { /* big_le */
508 isit_bigint(arg_1(arguments));
509 isit_bigint(arg_3(arguments));
510 if (bigCmp(take_bigint(arg_1(arguments)),
511 take_bigint(arg_3(arguments))) <= 0) {
512 return SYS_TRUE_OBJECT;
513 } else {
514 return SYS_FALSE_OBJECT;
515 } /* if */
516 } /* big_le */
517
518
519
520 /**
521 * Compute the truncated base 10 logarithm of a 'bigInteger' number.
522 * The definition of 'log10' is extended by defining log10(0) = -1_.
523 * @return the truncated base 10 logarithm.
524 * @exception NUMERIC_ERROR The number is negative.
525 */
big_log10(listType arguments)526 objectType big_log10 (listType arguments)
527
528 { /* big_log10 */
529 isit_bigint(arg_1(arguments));
530 return bld_bigint_temp(
531 bigLog10(take_bigint(arg_1(arguments))));
532 } /* big_log10 */
533
534
535
536 /**
537 * Compute the truncated base 2 logarithm of a 'bigInteger' number.
538 * The definition of 'log2' is extended by defining log2(0) = -1_.
539 * @return the truncated base 2 logarithm.
540 * @exception NUMERIC_ERROR The number is negative.
541 */
big_log2(listType arguments)542 objectType big_log2 (listType arguments)
543
544 { /* big_log2 */
545 isit_bigint(arg_1(arguments));
546 return bld_bigint_temp(
547 bigLog2(take_bigint(arg_1(arguments))));
548 } /* big_log2 */
549
550
551
552 /**
553 * Index of the lowest-order one bit.
554 * For A <> 0 this is equal to the number of lowest-order zero bits.
555 * @return the number of lowest-order zero bits or -1 for lowestSetBit(0).
556 */
big_lowest_set_bit(listType arguments)557 objectType big_lowest_set_bit (listType arguments)
558
559 { /* big_lowest_set_bit */
560 isit_bigint(arg_1(arguments));
561 return bld_int_temp(
562 bigLowestSetBit(take_bigint(arg_1(arguments))));
563 } /* big_lowest_set_bit */
564
565
566
567 /**
568 * Shift a 'bigInteger' number left by lshift bits.
569 * If lshift is negative a right shift is done instead.
570 * A << B is equivalent to A * 2_ ** B if B >= 0 holds.
571 * A << B is equivalent to A mdiv 2_ ** -B if B < 0 holds.
572 * @return the left shifted number.
573 */
big_lshift(listType arguments)574 objectType big_lshift (listType arguments)
575
576 { /* big_lshift */
577 isit_bigint(arg_1(arguments));
578 isit_int(arg_3(arguments));
579 return bld_bigint_temp(
580 bigLShift(take_bigint(arg_1(arguments)), take_int(arg_3(arguments))));
581 } /* big_lshift */
582
583
584
585 /**
586 * Shift a number left by lshift bits and assign the result back to number.
587 * If lshift is negative a right shift is done instead.
588 */
big_lshift_assign(listType arguments)589 objectType big_lshift_assign (listType arguments)
590
591 { /* big_lshift_assign */
592 isit_bigint(arg_1(arguments));
593 isit_int(arg_3(arguments));
594 is_variable(arg_1(arguments));
595 bigLShiftAssign(&take_bigint(arg_1(arguments)), take_int(arg_3(arguments)));
596 return SYS_EMPTY_OBJECT;
597 } /* big_lshift_assign */
598
599
600
601 /**
602 * Check if number1 is less than number2.
603 * @return TRUE if number1 is less than number2,
604 * FALSE otherwise.
605 */
big_lt(listType arguments)606 objectType big_lt (listType arguments)
607
608 { /* big_lt */
609 isit_bigint(arg_1(arguments));
610 isit_bigint(arg_3(arguments));
611 if (bigCmp(take_bigint(arg_1(arguments)),
612 take_bigint(arg_3(arguments))) < 0) {
613 return SYS_TRUE_OBJECT;
614 } else {
615 return SYS_FALSE_OBJECT;
616 } /* if */
617 } /* big_lt */
618
619
620
621 /**
622 * Integer division truncated towards negative infinity.
623 * The modulo (remainder) of this division is computed with big_mod.
624 * Therefore this division is called modulo division (mdiv).
625 * @return the quotient of the integer division.
626 * @exception NUMERIC_ERROR If a division by zero occurs.
627 */
big_mdiv(listType arguments)628 objectType big_mdiv (listType arguments)
629
630 { /* big_mdiv */
631 isit_bigint(arg_1(arguments));
632 isit_bigint(arg_3(arguments));
633 return bld_bigint_temp(
634 bigMDiv(take_bigint(arg_1(arguments)), take_bigint(arg_3(arguments))));
635 } /* big_mdiv */
636
637
638
639 /**
640 * Compute the modulo (remainder) of the integer division big_mdiv.
641 * The modulo has the same sign as the divisor.
642 * @return the modulo of the integer division.
643 * @exception NUMERIC_ERROR If a division by zero occurs.
644 */
big_mod(listType arguments)645 objectType big_mod (listType arguments)
646
647 { /* big_mod */
648 isit_bigint(arg_1(arguments));
649 isit_bigint(arg_3(arguments));
650 return bld_bigint_temp(
651 bigMod(take_bigint(arg_1(arguments)), take_bigint(arg_3(arguments))));
652 } /* big_mod */
653
654
655
656 /**
657 * Multiply two 'bigInteger' numbers.
658 * @return the product of the two numbers.
659 */
big_mult(listType arguments)660 objectType big_mult (listType arguments)
661
662 { /* big_mult */
663 isit_bigint(arg_1(arguments));
664 isit_bigint(arg_3(arguments));
665 return bld_bigint_temp(
666 bigMult(take_bigint(arg_1(arguments)), take_bigint(arg_3(arguments))));
667 } /* big_mult */
668
669
670
671 /**
672 * Multiply a 'bigInteger' number by a factor and assign the result back to number.
673 */
big_mult_assign(listType arguments)674 objectType big_mult_assign (listType arguments)
675
676 { /* big_mult_assign */
677 isit_bigint(arg_1(arguments));
678 isit_bigint(arg_3(arguments));
679 is_variable(arg_1(arguments));
680 bigMultAssign(&take_bigint(arg_1(arguments)), take_bigint(arg_3(arguments)));
681 return SYS_EMPTY_OBJECT;
682 } /* big_mult_assign */
683
684
685
686 /**
687 * Check if two 'bigInteger' numbers are not equal.
688 * @return FALSE if both numbers are equal,
689 * TRUE otherwise.
690 */
big_ne(listType arguments)691 objectType big_ne (listType arguments)
692
693 { /* big_ne */
694 isit_bigint(arg_1(arguments));
695 isit_bigint(arg_3(arguments));
696 if (bigEq(take_bigint(arg_1(arguments)),
697 take_bigint(arg_3(arguments)))) {
698 return SYS_FALSE_OBJECT;
699 } else {
700 return SYS_TRUE_OBJECT;
701 } /* if */
702 } /* big_ne */
703
704
705
706 /**
707 * Minus sign, negate a 'bigInteger' number.
708 * @return the negated value of the number.
709 */
big_negate(listType arguments)710 objectType big_negate (listType arguments)
711
712 { /* big_negate */
713 isit_bigint(arg_2(arguments));
714 return bld_bigint_temp(
715 bigNegate(take_bigint(arg_2(arguments))));
716 } /* big_negate */
717
718
719
720 /**
721 * Determine if a 'bigInteger' number is odd.
722 * @return TRUE if the number is odd,
723 * FALSE otherwise.
724 */
big_odd(listType arguments)725 objectType big_odd (listType arguments)
726
727 { /* big_odd */
728 isit_bigint(arg_1(arguments));
729 if (bigOdd(take_bigint(arg_1(arguments)))) {
730 return SYS_TRUE_OBJECT;
731 } else {
732 return SYS_FALSE_OBJECT;
733 } /* if */
734 } /* big_odd */
735
736
737
738 /**
739 * Convert a 'bigInteger' number to integer.
740 * @return the integer result of the conversion.
741 * @exception RANGE_ERROR The result does not fit into an integer.
742 */
big_ord(listType arguments)743 objectType big_ord (listType arguments)
744
745 { /* big_ord */
746 isit_bigint(arg_1(arguments));
747 return bld_int_temp(
748 bigOrd(take_bigint(arg_1(arguments))));
749 } /* big_ord */
750
751
752
753 /**
754 * Convert a string to a 'bigInteger' number.
755 * The string must contain an integer literal consisting of an
756 * optional + or - sign, followed by a sequence of digits. Other
757 * characters as well as leading or trailing whitespace characters are
758 * not allowed. The sequence of digits is taken to be decimal.
759 * @return the 'bigInteger' result of the conversion.
760 * @exception RANGE_ERROR If the string is empty or does not contain
761 * an integer literal.
762 * @exception MEMORY_ERROR Not enough memory to represent the result.
763 */
big_parse1(listType arguments)764 objectType big_parse1 (listType arguments)
765
766 { /* big_parse1 */
767 isit_stri(arg_1(arguments));
768 return bld_bigint_temp(
769 bigParse(take_stri(arg_1(arguments))));
770 } /* big_parse1 */
771
772
773
774 /**
775 * Convert a numeric string, with a specified radix, to a 'bigInteger'.
776 * The numeric string must contain the representation of an integer
777 * in the specified radix. It consists of an optional + or - sign,
778 * followed by a sequence of digits in the specified radix. Digit values
779 * from 10 upward can be encoded with upper or lower case letters.
780 * E.g.: 10 can be encoded with A or a, 11 with B or b, etc. Other
781 * characters as well as leading or trailing whitespace characters
782 * are not allowed.
783 * @return the 'bigInteger' result of the conversion.
784 * @exception RANGE_ERROR If base < 2 or base > 36 holds or
785 * the string is empty or it does not contain an integer
786 * literal with the specified base.
787 * @exception MEMORY_ERROR Not enough memory to represent the result.
788 */
big_parse_based(listType arguments)789 objectType big_parse_based (listType arguments)
790
791 { /* big_parse_based */
792 isit_stri(arg_1(arguments));
793 isit_int(arg_2(arguments));
794 return bld_bigint_temp(
795 bigParseBased(take_stri(arg_1(arguments)), take_int(arg_2(arguments))));
796 } /* big_parse_based */
797
798
799
800 /**
801 * Plus sign for 'bigInteger' numbers.
802 * @return its operand unchanged.
803 */
big_plus(listType arguments)804 objectType big_plus (listType arguments)
805
806 {
807 bigIntType result;
808
809 /* big_plus */
810 isit_bigint(arg_2(arguments));
811 if (TEMP_OBJECT(arg_2(arguments))) {
812 result = take_bigint(arg_2(arguments));
813 arg_2(arguments)->value.bigIntValue = NULL;
814 } else {
815 result = bigCreate(take_bigint(arg_2(arguments)));
816 } /* if */
817 return bld_bigint_temp(result);
818 } /* big_plus */
819
820
821
822 /**
823 * Predecessor of a 'bigInteger' number.
824 * pred(A) is equivalent to A-1 .
825 * @return number - 1 .
826 */
big_pred(listType arguments)827 objectType big_pred (listType arguments)
828
829 { /* big_pred */
830 isit_bigint(arg_1(arguments));
831 return bld_bigint_temp(
832 bigPred(take_bigint(arg_1(arguments))));
833 } /* big_pred */
834
835
836
837 /**
838 * Convert a big integer number to a string using a radix.
839 * The conversion uses the numeral system with the given base.
840 * Digit values from 10 upward are encoded with lower case letters.
841 * E.g.: 10 is encoded with a, 11 with b, etc.
842 * For negative numbers a minus sign is prepended.
843 * @return the string result of the conversion.
844 * @exception RANGE_ERROR If base < 2 or base > 36 holds.
845 * @exception MEMORY_ERROR Not enough memory to represent the result.
846 */
big_radix(listType arguments)847 objectType big_radix (listType arguments)
848
849 { /* big_radix */
850 isit_bigint(arg_1(arguments));
851 isit_int(arg_3(arguments));
852 return bld_stri_temp(
853 bigRadix(take_bigint(arg_1(arguments)), take_int(arg_3(arguments)), FALSE));
854 } /* big_radix */
855
856
857
858 /**
859 * Convert a big integer number to a string using a radix.
860 * The conversion uses the numeral system with the given base.
861 * Digit values from 10 upward are encoded with upper case letters.
862 * E.g.: 10 is encoded with A, 11 with B, etc.
863 * For negative numbers a minus sign is prepended.
864 * @return the string result of the conversion.
865 * @exception RANGE_ERROR If base < 2 or base > 36 holds.
866 * @exception MEMORY_ERROR Not enough memory to represent the result.
867 */
big_RADIX(listType arguments)868 objectType big_RADIX (listType arguments)
869
870 { /* big_RADIX */
871 isit_bigint(arg_1(arguments));
872 isit_int(arg_3(arguments));
873 return bld_stri_temp(
874 bigRadix(take_bigint(arg_1(arguments)), take_int(arg_3(arguments)), TRUE));
875 } /* big_RADIX */
876
877
878
879 /**
880 * Compute pseudo-random number in the range [low, high].
881 * The random values are uniform distributed.
882 * @return a random number such that low <= rand(low, high) and
883 * rand(low, high) <= high holds.
884 * @exception RANGE_ERROR The range is empty (low > high holds).
885 */
big_rand(listType arguments)886 objectType big_rand (listType arguments)
887
888 { /* big_rand */
889 isit_bigint(arg_1(arguments));
890 isit_bigint(arg_2(arguments));
891 return bld_bigint_temp(
892 bigRand(take_bigint(arg_1(arguments)), take_bigint(arg_2(arguments))));
893 } /* big_rand */
894
895
896
897 /**
898 * Compute the remainder of the integer division big_div.
899 * The remainder has the same sign as the dividend.
900 * @return the remainder of the integer division.
901 * @exception NUMERIC_ERROR If a division by zero occurs.
902 */
big_rem(listType arguments)903 objectType big_rem (listType arguments)
904
905 { /* big_rem */
906 isit_bigint(arg_1(arguments));
907 isit_bigint(arg_3(arguments));
908 return bld_bigint_temp(
909 bigRem(take_bigint(arg_1(arguments)), take_bigint(arg_3(arguments))));
910 } /* big_rem */
911
912
913
914 /**
915 * Shift a 'bigInteger' number right by rshift bits.
916 * If rshift is negative a left shift is done instead.
917 * A >> B is equivalent to A mdiv 2_ ** B if B >= 0 holds.
918 * A >> B is equivalent to A * 2_ ** -B if B < 0 holds.
919 * @return the right shifted number.
920 */
big_rshift(listType arguments)921 objectType big_rshift (listType arguments)
922
923 { /* big_rshift */
924 isit_bigint(arg_1(arguments));
925 isit_int(arg_3(arguments));
926 return bld_bigint_temp(
927 bigRShift(take_bigint(arg_1(arguments)), take_int(arg_3(arguments))));
928 } /* big_rshift */
929
930
931
932 /**
933 * Shift a number right by rshift bits and assign the result back to number.
934 * If rshift is negative a left shift is done instead.
935 */
big_rshift_assign(listType arguments)936 objectType big_rshift_assign (listType arguments)
937
938 { /* big_rshift_assign */
939 isit_bigint(arg_1(arguments));
940 isit_int(arg_3(arguments));
941 is_variable(arg_1(arguments));
942 bigRShiftAssign(&take_bigint(arg_1(arguments)), take_int(arg_3(arguments)));
943 return SYS_EMPTY_OBJECT;
944 } /* big_rshift_assign */
945
946
947
948 /**
949 * Compute the subtraction of two 'bigInteger' numbers.
950 * @return the difference of the two numbers.
951 */
big_sbtr(listType arguments)952 objectType big_sbtr (listType arguments)
953
954 { /* big_sbtr */
955 isit_bigint(arg_1(arguments));
956 isit_bigint(arg_3(arguments));
957 return bld_bigint_temp(
958 bigSbtr(take_bigint(arg_1(arguments)), take_bigint(arg_3(arguments))));
959 } /* big_sbtr */
960
961
962
963 /**
964 * Decrement a 'bigInteger' variable by a delta.
965 */
big_sbtr_assign(listType arguments)966 objectType big_sbtr_assign (listType arguments)
967
968 { /* big_sbtr_assign */
969 isit_bigint(arg_1(arguments));
970 isit_bigint(arg_3(arguments));
971 is_variable(arg_1(arguments));
972 bigSbtrAssign(&take_bigint(arg_1(arguments)), take_bigint(arg_3(arguments)));
973 return SYS_EMPTY_OBJECT;
974 } /* big_sbtr_assign */
975
976
977
978 /**
979 * Convert a 'bigInteger' number to a string.
980 * The number is converted to a string with decimal representation.
981 * For negative numbers a minus sign is prepended.
982 * @return the string result of the conversion.
983 * @exception MEMORY_ERROR Not enough memory to represent the result.
984 */
big_str(listType arguments)985 objectType big_str (listType arguments)
986
987 { /* big_str */
988 isit_bigint(arg_1(arguments));
989 return bld_stri_temp(
990 bigStr(take_bigint(arg_1(arguments))));
991 } /* big_str */
992
993
994
995 /**
996 * Successor of a 'bigInteger' number.
997 * succ(A) is equivalent to A+1 .
998 * @return number + 1 .
999 */
big_succ(listType arguments)1000 objectType big_succ (listType arguments)
1001
1002 { /* big_succ */
1003 isit_bigint(arg_1(arguments));
1004 return bld_bigint_temp(
1005 bigSucc(take_bigint(arg_1(arguments))));
1006 } /* big_succ */
1007
1008
1009
1010 /**
1011 * Convert a 'bigInteger' into a big-endian 'bstring'.
1012 * The result uses binary representation with a base of 256.
1013 * @param big1/arg_1 BigInteger number to be converted.
1014 * @param isSigned/arg_2 Determines the signedness of the result.
1015 * If 'isSigned' is TRUE the result is encoded with the
1016 * twos-complement representation. In this case a negative
1017 * 'big1' is converted to a result where the most significant
1018 * byte (the first byte) has an ordinal > BYTE_MAX (=127).
1019 * @return a bstring with the big-endian representation.
1020 * @exception RANGE_ERROR If 'isSigned' is FALSE and 'big1' is negative.
1021 * @exception MEMORY_ERROR Not enough memory to represent the result.
1022 */
big_to_bstri_be(listType arguments)1023 objectType big_to_bstri_be (listType arguments)
1024
1025 { /* big_to_bstri_be */
1026 isit_bigint(arg_1(arguments));
1027 isit_bool(arg_2(arguments));
1028 return bld_bstri_temp(
1029 bigToBStriBe(take_bigint(arg_1(arguments)),
1030 take_bool(arg_2(arguments)) == SYS_TRUE_OBJECT));
1031 } /* big_to_bstri_be */
1032
1033
1034
1035 /**
1036 * Convert a 'bigInteger' into a little-endian 'bstring'.
1037 * The result uses binary representation with a base of 256.
1038 * @param big1/arg_1 BigInteger number to be converted.
1039 * @param isSigned/arg_2 Determines the signedness of the result.
1040 * If 'isSigned' is TRUE the result is encoded with the
1041 * twos-complement representation. In this case a negative
1042 * 'big1' is converted to a result where the most significant
1043 * byte (the last byte) has an ordinal > BYTE_MAX (=127).
1044 * @return a bstring with the little-endian representation.
1045 * @exception RANGE_ERROR If 'isSigned' is FALSE and 'big1' is negative.
1046 * @exception MEMORY_ERROR Not enough memory to represent the result.
1047 */
big_to_bstri_le(listType arguments)1048 objectType big_to_bstri_le (listType arguments)
1049
1050 { /* big_to_bstri_le */
1051 isit_bigint(arg_1(arguments));
1052 isit_bool(arg_2(arguments));
1053 return bld_bstri_temp(
1054 bigToBStriLe(take_bigint(arg_1(arguments)),
1055 take_bool(arg_2(arguments)) == SYS_TRUE_OBJECT));
1056 } /* big_to_bstri_le */
1057
1058
1059
1060 /**
1061 * Get 'bigInteger' value of the object referenced by 'aReference/arg_1'.
1062 * @return the 'bigInteger' value of the referenced object.
1063 * @exception RANGE_ERROR If 'aReference/arg_1' is NIL or
1064 * category(aReference) <> BIGINTOBJECT holds.
1065 */
big_value(listType arguments)1066 objectType big_value (listType arguments)
1067
1068 {
1069 objectType aReference;
1070
1071 /* big_value */
1072 isit_reference(arg_1(arguments));
1073 aReference = take_reference(arg_1(arguments));
1074 if (unlikely(aReference == NULL ||
1075 CATEGORY_OF_OBJ(aReference) != BIGINTOBJECT)) {
1076 logError(printf("big_value(");
1077 trace1(aReference);
1078 printf("): Category is not BIGINTOBJECT.\n"););
1079 return raise_exception(SYS_RNG_EXCEPTION);
1080 } else {
1081 return bld_bigint_temp(bigCreate(take_bigint(aReference)));
1082 } /* if */
1083 } /* big_value */
1084