1 /* file: "bignums.c" */
4 * Copyright 2004-2009 by Marc Feeley and Vincent St-Amour, All Rights Reserved.
7 #include "picobit-vm.h"
9 #ifdef INFINITE_PRECISION_BIGNUMS
11 integer
make_integer (digit lo
, integer hi
) {
12 return alloc_ram_cell_init (BIGNUM_FIELD0
| (hi
>> 8), hi
, lo
>> 8, lo
);
15 integer
integer_hi (integer x
) {
17 return ram_get_car (x
);
19 return rom_get_car (x
);
20 else if (x
< (MIN_FIXNUM_ENCODING
- MIN_FIXNUM
))
21 return NEG1
; /* negative fixnum */
23 return ZERO
; /* nonnegative fixnum */
26 digit
integer_lo (integer x
) {
28 return (((digit
)ram_get_field2 (x
)) << 8) + ram_get_field3 (x
);
30 return (((digit
)rom_get_field2 (x
)) << 8) + rom_get_field3 (x
);
32 return DECODE_FIXNUM(x
);
35 integer
norm (obj prefix
, integer n
) {
36 /* norm(prefix,n) returns a normalized integer whose value is the
37 integer n prefixed with the digits in prefix (a list of digits) */
39 while (prefix
!= NIL
) {
40 digit d
= integer_lo (prefix
);
43 prefix
= integer_hi (temp
);
45 if (obj_eq (n
, ZERO
)) {
46 if (d
<= MAX_FIXNUM
) {
47 n
= ENCODE_FIXNUM ((uint8
)d
);
48 continue; // TODO with cast to unsigned, will it work for negative numbers ? or is it only handled in the next branch ?
51 else if (obj_eq (n
, NEG1
)) {
52 if (d
>= (1<<digit_width
) + MIN_FIXNUM
) {
53 n
= ENCODE_FIXNUM (d
- (1<<digit_width
)); // TODO had a cast, origianlly to int8, changed to uint8 which didn't work (obviously, we use -1 here), is a cast necessary at all ?
58 integer_hi_set (temp
, n
);
65 uint8
negp (integer x
) {
66 /* negp(x) returns true iff x is negative */
70 if (obj_eq (x
, ZERO
)) return false;
71 } while (!obj_eq (x
, NEG1
));
76 int8
cmp (integer x
, integer y
) {
77 /* cmp(x,y) return -1 when x<y, 1 when x>y, and 0 when x=y */
84 if (obj_eq (x
, ZERO
) || obj_eq (x
, NEG1
)) {
86 { if (negp (y
)) result
= 1; else result
= -1; }
90 if (obj_eq (y
, ZERO
) || obj_eq (y
, NEG1
)) {
91 if (negp (x
)) result
= -1; else result
= 1;
100 { if (xlo
< ylo
) result
= -1; else result
= 1; }
105 uint16
integer_length (integer x
) {
106 /* integer_length(x) returns the number of bits in the binary
107 representation of the nonnegative integer x */
113 while (!obj_eq ((next
= integer_hi (x
)), ZERO
)) {
114 result
+= digit_width
;
128 integer
shr (integer x
) { // TODO have shift_right
129 /* shr(x) returns the integer x shifted one bit to the right */
135 if (obj_eq (x
, ZERO
) || obj_eq (x
, NEG1
)) {
136 result
= norm (result
, x
);
142 result
= make_integer ((d
>> 1) |
143 ((integer_lo (x
) & 1) ? (1<<(digit_width
-1)) : 0),
150 integer
negative_carry (integer carry
) {
157 integer
shl (integer x
) {
158 /* shl(x) returns the integer x shifted one bit to the left */
160 integer negc
= ZERO
; /* negative carry */
166 if (obj_eq (x
, negc
)) {
167 result
= norm (result
, x
);
174 negc
= negative_carry (d
& (1<<(digit_width
-1))); // TODO right side is constant, and sixpic has no constant folding
175 result
= make_integer ((d
<< 1) | obj_eq (temp
, NEG1
), result
);
181 integer
shift_left (integer x
, uint16 n
) { // TODO have the primitves been changed for this and right ?
182 /* shift_left(x,n) returns the integer x shifted n bits to the left */
184 if (obj_eq (x
, ZERO
))
187 while (n
& (digit_width
-1)) {
193 x
= make_integer (0, x
);
200 integer
add (integer x
, integer y
) {
201 /* add(x,y) returns the sum of the integers x and y */
203 integer negc
= ZERO
; /* negative carry */
204 obj result
= NIL
; /* nil terminated for the norm function */
209 if (obj_eq (x
, negc
)) {
210 result
= norm (result
, y
);
214 if (obj_eq (y
, negc
)) {
215 result
= norm (result
, x
);
221 dx
= dx
+ dy
; /* may wrap around */
223 if (obj_eq (negc
, ZERO
))
224 negc
= negative_carry (dx
< dy
);
226 dx
++; /* may wrap around */
227 negc
= negative_carry (dx
<= dy
);
233 result
= make_integer (dx
, result
);
239 integer
invert (integer x
) {
240 if (obj_eq (x
, ZERO
))
246 integer
sub (integer x
, integer y
) {
247 /* sub(x,y) returns the difference of the integers x and y */
248 integer negc
= NEG1
; /* negative carry */
254 if (obj_eq (x
, negc
) && (obj_eq (y
, ZERO
) || obj_eq (y
, NEG1
))) {
255 result
= norm (result
, invert (y
));
259 if (obj_eq (y
, invert (negc
))) {
260 result
= norm (result
, x
);
265 dy
= ~integer_lo (y
);
266 dx
= dx
+ dy
; /* may wrap around */
268 if (obj_eq (negc
, ZERO
))
269 negc
= negative_carry (dx
< dy
);
271 dx
++; /* may wrap around */
272 negc
= negative_carry (dx
<= dy
);
278 result
= make_integer (dx
, result
);
284 integer
neg (integer x
) {
285 /* neg(x) returns the integer -x */
287 return sub (ZERO
, x
);
290 integer
scale (digit n
, integer x
) {
291 /* scale(n,x) returns the integer n*x */
297 if ((n
== 0) || obj_eq (x
, ZERO
))
307 if (obj_eq (x
, ZERO
)){
308 if (carry
<= MAX_FIXNUM
)
309 result
= norm (result
, ENCODE_FIXNUM ((uint8
)carry
));
311 result
= norm (result
, make_integer (carry
, ZERO
));
315 if (obj_eq (x
, NEG1
)) {
317 if (carry
>= ((1<<digit_width
) + MIN_FIXNUM
))
318 result
= norm (result
, ENCODE_FIXNUM ((uint8
)carry
));
320 result
= norm (result
, make_integer (carry
, NEG1
));
324 m
= (two_digit
)integer_lo (x
) * n
+ carry
;
327 carry
= m
>> digit_width
;
328 result
= make_integer ((digit
)m
, result
);
334 integer
mulnonneg (integer x
, integer y
) {
335 /* mulnonneg(x,y) returns the product of the integers x and y
336 where x is nonnegative */
339 integer s
= scale (integer_lo (x
), y
);
342 result
= make_integer (integer_lo (s
), result
);
346 if (obj_eq (x
, ZERO
))
349 s
= add (s
, scale (integer_lo (x
), y
));
352 return norm (result
, s
);
355 // TODO have functions mul and div that handle negative arguments ? currently, the logic is in prim_mul and prim_div
356 integer
divnonneg (integer x
, integer y
) {
357 /* divnonneg(x,y) returns the quotient and remainder of
358 the integers x and y where x and y are nonnegative */
360 integer result
= ZERO
;
361 uint16 lx
= integer_length (x
);
362 uint16 ly
= integer_length (y
);
367 y
= shift_left (y
, lx
);
370 result
= shl (result
);
371 if (cmp (x
, y
) >= 0) {
373 result
= add (POS1
, result
);
382 integer
bitwise_ior (integer x
, integer y
) {
383 /* returns the bitwise inclusive or of x and y */
389 return norm(result
, y
);
391 return norm(result
, x
);
392 result
= make_integer(integer_lo(x
) | integer_lo(y
),
399 integer
bitwise_xor (integer x
, integer y
) { // TODO similar to ior (only diff is the test), abstract ?
400 /* returns the bitwise inclusive or of x and y */
406 return norm(result
, y
);
408 return norm(result
, x
);
409 result
= make_integer(integer_lo(x
) ^ integer_lo(y
),
416 // used only in primitives that use small numbers only
417 // for example, vector primitives
418 int16
decode_int (obj o
) {
420 if (o
< MIN_FIXNUM_ENCODING
)
421 TYPE_ERROR("decode_int.0", "integer");
423 if (o
<= (MIN_FIXNUM_ENCODING
+ (MAX_FIXNUM
- MIN_FIXNUM
)))
424 return DECODE_FIXNUM(o
);
428 TYPE_ERROR("decode_int.1", "integer");
429 return ram_get_field3 (o
);
431 else if (IN_ROM(o
)) {
433 TYPE_ERROR("decode_int.2", "integer");
434 return rom_get_field3 (o
);
437 TYPE_ERROR("decode_int.3", "integer");
440 // same purpose as decode_int
441 obj
encode_int (int16 n
) {
442 if (n
>= MIN_FIXNUM
&& n
<= MAX_FIXNUM
) {
443 return ENCODE_FIXNUM(n
);
446 return alloc_ram_cell_init (BIGNUM_FIELD0
, ENCODE_FIXNUM(0), n
>> 8, n
);
451 // regular (finite, 24 bits) bignums
453 int16
decode_int (obj o
) {
458 if (o
< MIN_FIXNUM_ENCODING
)
459 TYPE_ERROR("decode_int.0", "integer");
461 if (o
<= (MIN_FIXNUM_ENCODING
+ (MAX_FIXNUM
- MIN_FIXNUM
)))
462 return DECODE_FIXNUM(o
);
466 TYPE_ERROR("decode_int.1", "integer");
468 u
= ram_get_field1 (o
);
469 h
= ram_get_field2 (o
);
470 l
= ram_get_field3 (o
);
472 else if (IN_ROM(o
)) {
474 TYPE_ERROR("decode_int.2", "integer");
476 u
= rom_get_field1 (o
);
477 h
= rom_get_field2 (o
);
478 l
= rom_get_field3 (o
);
481 TYPE_ERROR("decode_int.3", "integer");
483 if (u
>= 128) // negative
484 return ((int32
)((((int16
)u
- 256) << 8) + h
) << 8) + l
;
486 return ((int32
)(((int16
)u
<< 8) + h
) << 8) + l
;
489 obj
encode_int (int32 n
) {
490 if (n
>= MIN_FIXNUM
&& n
<= MAX_FIXNUM
)
491 return ENCODE_FIXNUM(n
);
493 return alloc_ram_cell_init (BIGNUM_FIELD0
, n
>> 16, n
>> 8, n
);
498 // useful for some primitives
499 void decode_2_int_args () {
500 a1
= decode_int (arg1
);
501 a2
= decode_int (arg2
);