1 /* Basic functions for working with integers */
2
3 /* conversion routines digit-sequence-part <--> longword:
4 get_32_Dptr(ptr)
5 fetches the next 32 bits from the 32/intDsize digits starting at ptr.
6 set_32_Dptr(ptr,value);
7 stores value (32 bits) in the 32/intDsize digits starting at ptr.
8 get_max32_Dptr(count,ptr)
9 fetches the next count bits from the ceiling(count/intDsize) digits at ptr.
10 set_max32_Dptr(count,ptr,value)
11 stores value (count bits) in the ceiling(count/intDsize) digits at ptr.
12 each time: ptr a variable of type uintD*,
13 value a variable of type uint32,
14 count a variable or constant-expression with value >=0, <=32. */
15 #if (intDsize==32)
16 #define get_32_Dptr(ptr) ((uint32)((ptr)[0]))
17 #define set_32_Dptr(ptr,value) ((ptr)[0] = (uintD)(value))
18 #define get_max32_Dptr(count,ptr) \
19 ((count)==0 ? 0 : (uint32)((ptr)[0]))
20 #define set_max32_Dptr(count,ptr,value) \
21 do { if ((count) != 0) (ptr)[0] = (uintD)(value);} while(0)
22 #endif
23 #if (intDsize==16)
24 /* #define get_32_Dptr(ptr) (((uint32)((ptr)[0])<<16) | ((uint32)((ptr)[1]))) */
25 #define get_32_Dptr(ptr) highlow32_at(ptr)
26 /* #define set_32_Dptr(ptr,value) ((ptr)[0] = (uintD)((value)>>16), (ptr)[1] = (uintD)(value)) */
27 #define set_32_Dptr(ptr,value) set_highlow32_at(ptr,value)
28 #define get_max32_Dptr(count,ptr) \
29 ((count)==0 ? 0 : \
30 (count)<=16 ? (uint32)((ptr)[0]) : highlow32_at(ptr))
31 #define set_max32_Dptr(count,ptr,value) \
32 do { if ((count) != 0) { \
33 if ((count)<=16) (ptr)[0] = (uintD)(value); \
34 else set_highlow32_at(ptr,value); \
35 }} while(0)
36 #endif
37
38 /* conversion routines digit-sequence-part <--> longword:
39 get_maxV_Dptr(count,ptr)
40 fetches the next count bits from the ceiling(count/intDsize) digits at ptr.
41 ptr a variable of type uintD*,
42 value a variable of type uintV,
43 count a variable or constant-expression with value >=0, <=intVsize. */
44 #if (intVsize==32)
45 #define get_maxV_Dptr get_max32_Dptr
46 #else
47 #if (intDsize==32)
48 #define get_maxV_Dptr(count,ptr) \
49 ((count)==0 ? 0 : \
50 (count)<=32 ? (uint64)((ptr)[0]) : \
51 (( (uint64)((ptr)[0]) <<32) | (uint64)((ptr)[1])))
52 #endif
53 #if (intDsize==16)
54 #define get_maxV_Dptr(count,ptr) \
55 ((count)==0 ? 0 : \
56 (count)<=16 ? (uint64)((ptr)[0]) : \
57 (count)<=32 ? (( (uint64)((ptr)[0]) <<16) | (uint64)((ptr)[1])) : \
58 (count)<=48 ? (((( (uint64)((ptr)[0]) <<16) | (uint64)((ptr)[1])) <<16) | (uint64)((ptr)[2])) : \
59 (((((( (uint64)((ptr)[0]) <<16) | (uint64)((ptr)[1])) <<16) | (uint64)((ptr)[2])) <<16) | (uint64)((ptr)[3])))
60 #endif
61 #endif
62
63 /* get_uint1D_Dptr(ptr) fetches 1 digit (unsigned) at ptr
64 get_uint2D_Dptr(ptr) fetches 2 digits (unsigned) at ptr
65 get_uint3D_Dptr(ptr) fetches 3 digits (unsigned) at ptr
66 get_uint4D_Dptr(ptr) fetches 4 digits (unsigned) at ptr
67 get_sint1D_Dptr(ptr) fetches 1 digit (signed) at ptr
68 get_sint2D_Dptr(ptr) fetches 2 digits (signed) at ptr
69 get_sint3D_Dptr(ptr) fetches 3 digits (signed) at ptr
70 get_sint4D_Dptr(ptr) fetches 4 digits (signed) at ptr
71 Each time: ptr a variable of type uintD*. */
72 #define get_uint1D_Dptr(ptr) ((uint32)((ptr)[0]))
73 #define get_uint2D_Dptr(ptr) (((uint32)((ptr)[0]) << intDsize) | (uint32)((ptr)[1]))
74 #define get_uint3D_Dptr(ptr) (((((uint32)((ptr)[0]) << intDsize) | (uint32)((ptr)[1])) << intDsize) | (uint32)((ptr)[2]))
75 #define get_uint4D_Dptr(ptr) (((((((uint32)((ptr)[0]) << intDsize) | (uint32)((ptr)[1])) << intDsize) | (uint32)((ptr)[2])) << intDsize) | (uint32)((ptr)[3]))
76 #define get_sint1D_Dptr(ptr) ((sint32)(sintD)((ptr)[0]))
77 #define get_sint2D_Dptr(ptr) (((sint32)(sintD)((ptr)[0]) << intDsize) | (uint32)((ptr)[1]))
78 #define get_sint3D_Dptr(ptr) (((((sint32)(sintD)((ptr)[0]) << intDsize) | (uint32)((ptr)[1])) << intDsize) | (uint32)((ptr)[2]))
79 #define get_sint4D_Dptr(ptr) (((((((sint32)(sintD)((ptr)[0]) << intDsize) | (uint32)((ptr)[1])) << intDsize) | (uint32)((ptr)[2])) << intDsize) | (uint32)((ptr)[3]))
80 #if (intDsize==16)
81 #undef get_uint3D_Dptr
82 #undef get_uint4D_Dptr
83 #undef get_sint3D_Dptr
84 #undef get_sint4D_Dptr
85 #define get_uint3D_Dptr(ptr) get_uint2D_Dptr(&(ptr)[1])
86 #define get_uint4D_Dptr(ptr) get_uint2D_Dptr(&(ptr)[2])
87 #define get_sint3D_Dptr get_uint3D_Dptr
88 #define get_sint4D_Dptr get_uint4D_Dptr
89 #endif
90 #if (intDsize==32)
91 #undef get_uint2D_Dptr
92 #undef get_uint3D_Dptr
93 #undef get_uint4D_Dptr
94 #undef get_sint2D_Dptr
95 #undef get_sint3D_Dptr
96 #undef get_sint4D_Dptr
97 #define get_uint2D_Dptr(ptr) get_uint1D_Dptr(&(ptr)[1])
98 #define get_uint3D_Dptr(ptr) get_uint1D_Dptr(&(ptr)[2])
99 #define get_uint4D_Dptr(ptr) get_uint1D_Dptr(&(ptr)[3])
100 #define get_sint2D_Dptr get_uint2D_Dptr
101 #define get_sint3D_Dptr get_uint3D_Dptr
102 #define get_sint4D_Dptr get_uint4D_Dptr
103 #endif
104
105 /* conversion routines integer <--> longword: */
106
107 /* converts fixnum into longword.
108 FN_to_V(obj)
109 > obj: a fixnum
110 < result: the value of the fixnum as intVsize-bit-number. */
111 local sintV FN_to_V (object obj);
112 #if 1
113 #define FN_to_V(obj) fixnum_to_V(obj)
114 #else
FN_to_V(object obj)115 local sintV FN_to_V (object obj)
116 {
117 if (R_minusp(obj)) /* negative: fill with 1-bits */
118 return (as_oint(obj) >> oint_data_shift) | ~ (FN_value_mask >> oint_data_shift);
119 else /* >=0: fill with 0-bits */
120 return (as_oint(obj) >> oint_data_shift) & (FN_value_mask >> oint_data_shift);
121 }
122 #endif
123
124 /* FN_V_zerop(x,x_) determines, if x = 0 .
125 x is a fixnum and x_ = FN_to_V(x). */
126 #if (oint_data_len<intVsize)
127 #define FN_V_zerop(x,x_) (x_==0)
128 #else
129 #define FN_V_zerop(x,x_) (eq(x,Fixnum_0))
130 #endif
131
132 /* FN_V_minusp(x,x_) determines, if x < 0 .
133 x is a fixnum and x_ = FN_to_V(x). */
134 #if (oint_data_len<intVsize)
135 #define FN_V_minusp(x,x_) (x_<0)
136 #else
137 #define FN_V_minusp(x,x_) (R_minusp(x))
138 #endif
139
140 #ifdef intQsize
141 /* converts fixnum into quadword.
142 FN_to_Q(obj)
143 > obj: a fixnum
144 < result: the value of the fixnum as 64-bit-number. */
145 local sint64 FN_to_Q (object obj);
146 #define FN_to_Q(obj) fixnum_to_Q(obj)
147 #endif
148
149 /* converts integer >=0 into unsigned longword.
150 I_to_UL(obj)
151 > obj: an object, should be an integer >=0, <2^32
152 < result: the value of the integer as 32-bit-number. */
I_to_UL(object obj)153 modexp uint32 I_to_UL (object obj)
154 {
155 #ifdef TYPECODES
156 switch (typecode(obj))
157 #else
158 if (posfixnump(obj))
159 goto case_posfixnum;
160 else if (posbignump(obj))
161 goto case_posbignum;
162 else
163 switch (0)
164 #endif
165 {
166 case_posfixnum: /* fixnum >=0 */
167 #if (intVsize>intLsize)
168 if (posfixnum_to_V(obj) >= vbitm(intLsize)) goto bad;
169 #endif
170 return posfixnum_to_V(obj);
171 case_posbignum: { /* bignum >0 */
172 var Bignum bn = TheBignum(obj);
173 var uintC len = bignum_length(bn);
174 #define IF_LENGTH(i,get_udelta) \
175 if (bn_minlength <= i) /* exactly i digits possible at all? */ \
176 if (len == i) { /* exactly i digits? */ \
177 /* 2^((i-1)*intDsize-1) <= obj < 2^(i*intDsize-1) */ \
178 if ( (i*intDsize-1 > 32) \
179 && ( ((i-1)*intDsize-1 >= 32) \
180 || (bn->data[0] >= (uintD)bitc(32-(i-1)*intDsize)))) \
181 goto bad; \
182 else return get_udelta; \
183 }
184 IF_LENGTH(1, get_uint1D_Dptr(bn->data))
185 IF_LENGTH(2, get_uint2D_Dptr(bn->data))
186 IF_LENGTH(3, get_uint3D_Dptr(bn->data))
187 IF_LENGTH(4, get_uint4D_Dptr(bn->data))
188 IF_LENGTH(5, get_uint4D_Dptr(&bn->data[1]))
189 #undef IF_LENGTH
190 }
191 default:
192 bad: /* unsuitable object */
193 pushSTACK(obj); /* TYPE-ERROR slot DATUM */
194 pushSTACK(O(type_uint32)); /* TYPE-ERROR slot EXPECTED-TYPE */
195 pushSTACK(obj);
196 error(type_error,GETTEXT("not a 32-bit integer: ~S"));
197 }
198 }
199
200 /* converts integer into signed longword.
201 I_to_L(obj)
202 > obj: an object, should be an integer >=-2^31, <2^31
203 < result: the value of the integer as 32-bit-number. */
I_to_L(object obj)204 modexp sint32 I_to_L (object obj)
205 {
206 #ifdef TYPECODES
207 switch (typecode(obj))
208 #else
209 if (fixnump(obj)) {
210 if (FN_positivep(obj))
211 goto case_posfixnum;
212 else
213 goto case_negfixnum;
214 } else if (bignump(obj)) {
215 if (BN_positivep(obj))
216 goto case_posbignum;
217 else
218 goto case_negbignum;
219 } else
220 switch (0)
221 #endif
222 {
223 case_posfixnum: { /* fixnum >=0 */
224 var sintV value = posfixnum_to_V(obj);
225 #if (intVsize>intLsize)
226 if ((uintV)value >= vbit(intLsize-1)) goto bad;
227 #else
228 if ((oint_data_len+1 > intLsize) && (value < 0)) goto bad;
229 #endif
230 return value;
231 }
232 case_posbignum: { /* bignum >0 */
233 var Bignum bn = TheBignum(obj);
234 var uintC len = bignum_length(bn);
235 #define IF_LENGTH(i,get_udelta) \
236 if (bn_minlength <= i) /* exactly i digits possible at all? */ \
237 if (len == i) { /* exactly i digits? */ \
238 /* 2^((i-1)*intDsize-1) <= obj < 2^(i*intDsize-1) */ \
239 if ( (i*intDsize > 32) \
240 && ( ((i-1)*intDsize >= 32) \
241 || (bn->data[0] >= (uintD)bitc(31-(i-1)*intDsize)))) \
242 goto bad; \
243 else return get_udelta; \
244 }
245 IF_LENGTH(1, get_uint1D_Dptr(bn->data))
246 IF_LENGTH(2, get_uint2D_Dptr(bn->data))
247 IF_LENGTH(3, get_uint3D_Dptr(bn->data))
248 IF_LENGTH(4, get_uint4D_Dptr(bn->data))
249 #undef IF_LENGTH
250 goto bad;
251 }
252 case_negfixnum: { /* fixnum <0 */
253 var sintV value = negfixnum_to_V(obj);
254 #if (intVsize>intLsize)
255 if ((uintV)value < (uintV)minus_vbit(intLsize-1)) goto bad;
256 #else
257 if ((oint_data_len+1 > intLsize) && (value >= 0)) goto bad;
258 #endif
259 return value;
260 }
261 case_negbignum: { /* bignum <0 */
262 var Bignum bn = TheBignum(obj);
263 var uintC len = bignum_length(bn);
264 #define IF_LENGTH(i,get_udelta) \
265 if (bn_minlength <= i) /* exactly i digits possible at all? */ \
266 if (len == i) { /* exactly i digits? */ \
267 /* - 2^(i*intDsize-1) <= obj < - 2^((i-1)*intDsize-1) */ \
268 if ( (i*intDsize > 32) \
269 && ( ((i-1)*intDsize >= 32) \
270 || (bn->data[0] < (uintD)(-bitc(31-(i-1)*intDsize))))) \
271 goto bad; \
272 else return get_udelta; \
273 }
274 IF_LENGTH(1, get_sint1D_Dptr(bn->data))
275 IF_LENGTH(2, get_sint2D_Dptr(bn->data))
276 IF_LENGTH(3, get_sint3D_Dptr(bn->data))
277 IF_LENGTH(4, get_sint4D_Dptr(bn->data))
278 #undef IF_LENGTH
279 goto bad;
280 }
281 default:
282 bad: /* unsuitable object */
283 pushSTACK(obj); /* TYPE-ERROR slot DATUM */
284 pushSTACK(O(type_sint32)); /* TYPE-ERROR slot EXPECTED-TYPE */
285 pushSTACK(obj);
286 error(type_error,GETTEXT("not a 32-bit integer: ~S"));
287 }
288 }
289
290 #if defined(HAVE_LONG_LONG_INT)
291
292 /* converts integer >=0 into unsigned quadword.
293 I_to_UQ(obj)
294 > obj: an object, should be an integer >=0, <2^64
295 < result: the value of the integer as 64-bit-number. */
I_to_UQ(object obj)296 modexp uint64 I_to_UQ (object obj)
297 {
298 #ifdef TYPECODES
299 switch (typecode(obj))
300 #else
301 if (posfixnump(obj))
302 goto case_posfixnum;
303 else if (posbignump(obj))
304 goto case_posbignum;
305 else
306 switch (0)
307 #endif
308 {
309 case_posfixnum: /* fixnum >=0 */
310 return (uint64)posfixnum_to_V(obj);
311 case_posbignum: { /* bignum >0 */
312 var Bignum bn = TheBignum(obj);
313 var uintC len = bignum_length(bn);
314 #define IF_LENGTH(i,get_udelta) \
315 if (bn_minlength <= i) /* exactly i digits possible at all? */ \
316 if (len == i) { /* exactly i digits? */ \
317 /* 2^((i-1)*intDsize-1) <= obj < 2^(i*intDsize-1) */ \
318 if ( (i*intDsize-1 > 64) \
319 && ( ((i-1)*intDsize-1 >= 64) \
320 || (bn->data[0] >= (uintD)bitc(64-(i-1)*intDsize)))) \
321 goto bad; \
322 else return get_udelta; \
323 }
324 #if (intDsize==32)
325 IF_LENGTH(1, (uint64)get_uint1D_Dptr(bn->data))
326 IF_LENGTH(2, ((uint64)get_uint1D_Dptr(bn->data) << 32) | (uint64)get_uint1D_Dptr(&bn->data[1]))
327 IF_LENGTH(3, ((uint64)get_uint1D_Dptr(&bn->data[1]) << 32) | (uint64)get_uint1D_Dptr(&bn->data[2]))
328 #endif
329 #if (intDsize==16)
330 IF_LENGTH(1, (uint64)get_uint1D_Dptr(bn->data))
331 IF_LENGTH(2, (uint64)get_uint2D_Dptr(bn->data))
332 IF_LENGTH(3, ((uint64)get_uint1D_Dptr(bn->data) << 32) | (uint64)get_uint2D_Dptr(&bn->data[1]))
333 IF_LENGTH(4, ((uint64)get_uint2D_Dptr(bn->data) << 32) | (uint64)get_uint2D_Dptr(&bn->data[2]))
334 IF_LENGTH(5, ((uint64)get_uint2D_Dptr(&bn->data[1]) << 32) | (uint64)get_uint2D_Dptr(&bn->data[3]))
335 #endif
336 #undef IF_LENGTH
337 }
338 default:
339 bad: /* unsuitable object */
340 pushSTACK(obj); /* TYPE-ERROR slot DATUM */
341 pushSTACK(O(type_uint64)); /* TYPE-ERROR slot EXPECTED-TYPE */
342 pushSTACK(obj);
343 error(type_error,GETTEXT("not a 64-bit integer: ~S"));
344 }
345 }
346
347 #endif
348
349 #if defined(HAVE_LONG_LONG_INT)
350
351 /* converts integer into signed quadword.
352 I_to_Q(obj)
353 > obj: an object, should be an integer >=-2^63, <2^63
354 < result: the value of the integer as 64-bit-number. */
I_to_Q(object obj)355 modexp sint64 I_to_Q (object obj)
356 {
357 #ifdef TYPECODES
358 switch (typecode(obj))
359 #else
360 if (fixnump(obj)) {
361 if (FN_positivep(obj))
362 goto case_posfixnum;
363 else
364 goto case_negfixnum;
365 } else if (bignump(obj)) {
366 if (BN_positivep(obj))
367 goto case_posbignum;
368 else
369 goto case_negbignum;
370 } else
371 switch (0)
372 #endif
373 {
374 case_posfixnum: /* Fixnum >=0 */
375 return (uint64)posfixnum_to_V(obj);
376 case_posbignum: { /* Bignum >0 */
377 var Bignum bn = TheBignum(obj);
378 var uintC len = bignum_length(bn);
379 #define IF_LENGTH(i,get_udelta) \
380 if (bn_minlength <= i) /* exactly i digits possible at all? */ \
381 if (len == i) { /* exactly i digits? */ \
382 /* 2^((i-1)*intDsize-1) <= obj < 2^(i*intDsize-1) */ \
383 if ( (i*intDsize > 64) \
384 && ( ((i-1)*intDsize >= 64) \
385 || (bn->data[0] >= (uintD)bitc(63-(i-1)*intDsize)))) \
386 goto bad; \
387 else return get_udelta; \
388 }
389 #if (intDsize==32)
390 IF_LENGTH(1, (uint64)get_uint1D_Dptr(bn->data))
391 IF_LENGTH(2, ((uint64)get_uint1D_Dptr(bn->data) << 32) | (uint64)get_uint1D_Dptr(&bn->data[1]))
392 #endif
393 #if (intDsize==16)
394 IF_LENGTH(1, (uint64)get_uint1D_Dptr(bn->data))
395 IF_LENGTH(2, (uint64)get_uint2D_Dptr(bn->data))
396 IF_LENGTH(3, ((uint64)get_uint1D_Dptr(bn->data) << 32) | (uint64)get_uint2D_Dptr(&bn->data[1]))
397 IF_LENGTH(4, ((uint64)get_uint2D_Dptr(bn->data) << 32) | (uint64)get_uint2D_Dptr(&bn->data[2]))
398 #endif
399 #undef IF_LENGTH
400 goto bad;
401 }
402 case_negfixnum: /* Fixnum <0 */
403 return (uint64)negfixnum_to_V(obj) | (-wbitm(intVsize));
404 case_negbignum: { /* Bignum <0 */
405 var Bignum bn = TheBignum(obj);
406 var uintC len = bignum_length(bn);
407 #define IF_LENGTH(i,get_udelta) \
408 if (bn_minlength <= i) /* exactly i digits possible at all? */ \
409 if (len == i) { /* exactly i digits? */ \
410 /* - 2^(i*intDsize-1) <= obj < - 2^((i-1)*intDsize-1) */ \
411 if ( (i*intDsize > 64) \
412 && ( ((i-1)*intDsize >= 64) \
413 || (bn->data[0] < (uintD)(-bitc(63-(i-1)*intDsize))))) \
414 goto bad; \
415 else return get_udelta; \
416 }
417 #if (intDsize==32)
418 IF_LENGTH(1, (sint64)get_sint1D_Dptr(bn->data))
419 IF_LENGTH(2, ((sint64)get_sint1D_Dptr(bn->data) << 32) | (uint64)get_uint1D_Dptr(&bn->data[1]))
420 #endif
421 #if (intDsize==16)
422 IF_LENGTH(1, (sint64)get_sint1D_Dptr(bn->data))
423 IF_LENGTH(2, (sint64)get_sint2D_Dptr(bn->data))
424 IF_LENGTH(3, ((sint64)get_sint1D_Dptr(bn->data) << 32) | (uint64)get_uint2D_Dptr(&bn->data[1]))
425 IF_LENGTH(4, ((sint64)get_sint2D_Dptr(bn->data) << 32) | (uint64)get_uint2D_Dptr(&bn->data[2]))
426 #endif
427 #undef IF_LENGTH
428 goto bad;
429 }
430 default:
431 bad: /* unsuitable object */
432 pushSTACK(obj); /* TYPE-ERROR slot DATUM */
433 pushSTACK(O(type_sint64)); /* TYPE-ERROR slot EXPECTED-TYPE */
434 pushSTACK(obj);
435 error(type_error,GETTEXT("not a 64-bit integer: ~S"));
436 }
437 }
438
439 #endif
440
441 /* converts longword into fixnum.
442 L_to_FN(value)
443 > value: value of the fixnum, a signed 32-bit-integer
444 >= -2^oint_data_len, < 2^oint_data_len
445 < result: fixnum with this value.
446 value should be a variable. */
447 #if (oint_data_shift <= sign_bit_o)
448 #define L_to_FN(value) \
449 as_object((( (soint)(sint32)(value) \
450 & (FN_value_vz_mask>>oint_data_shift) /* mask the unneeded */ \
451 ) << oint_data_shift) \
452 | ((oint)fixnum_type<<oint_type_shift)) /* store typeinfo instead */
453 #else /* (oint_data_shift > sign_bit_o) */
454 #define L_to_FN(value) \
455 as_object((( (soint)(sint32)(value) << oint_data_shift ) \
456 & FN_value_mask /* mask the unneeded */) \
457 | ((soint)(sint32)sign_of_sint32((sint32)(value)) & bit(sign_bit_o)) \
458 | ((oint)fixnum_type<<oint_type_shift)) /* store typeinfo instead */
459 #endif
460
461 /* converts longword into integer.
462 L_to_I(value)
463 > value: value of the integer, a signed 32-bit-integer.
464 < result: integer with this value.
465 can trigger GC */
466 modexp maygc object L_to_I (sint32 value);
467 #if (oint_data_len+1 >= intLsize)
L_to_I(sint32 value)468 modexp maygc object L_to_I (sint32 value)
469 { return L_to_FN(value); }
470 #define L_to_I(value) L_to_FN(value)
471 #else
L_to_I(sint32 value)472 modexp maygc object L_to_I (sint32 value)
473 {
474 {
475 var uint32 test = value & (uint32)(~(FN_value_mask >> oint_data_shift));
476 /* test contains the bits, that do not fit into the Fixnum-value. */
477 if (test == (uint32)0) /* all =0 ? */
478 return as_object(((oint)fixnum_type<<oint_type_shift) | ((oint)value<<oint_data_shift));
479 if (test == (uint32)(~(FN_value_mask >> oint_data_shift))) /* alle =1 ? */
480 return as_object(((((oint)fixnum_vz_type<<oint_type_shift)+FN_value_mask) & ((oint)value<<oint_data_shift))
481 |(((oint)fixnum_vz_type<<oint_type_shift) & (wbit(oint_data_shift)-1)));
482 }
483 /* create bignum:
484 (its length bn_minlength <= n <= ceiling(32/intDsize) ) */
485 if (bn_minlength == ceiling(32,intDsize)) {
486 #if (intDsize==16)
487 if (value >= 0) goto pos2; else goto neg2; /* bignum with 32/intDsize = 2 digits */
488 #endif
489 #if (intDsize==32)
490 if (value >= 0) goto pos1; else goto neg1; /* bignum with 32/intDsize = 1 digit */
491 #endif
492 } else {
493 #define FILL_1_DIGIT(from) \
494 *ptr-- = (uintD)from;
495 #define FILL_2_DIGITS(from) \
496 *ptr-- = (uintD)from; from = from >> intDsize; \
497 *ptr-- = (uintD)from;
498 #define FILL_1 FILL_1_DIGIT(value);
499 #define FILL_2 FILL_2_DIGITS(value);
500 #define OK return newnum;
501 if (value >= 0) {
502 #define ALLOC(i) \
503 var object newnum = allocate_bignum(i,0); \
504 var uintD* ptr = &TheBignum(newnum)->data[i-1];
505 #define IF_LENGTH(i) \
506 if ((bn_minlength <= i) && (i*intDsize <= 32)) \
507 if (!((i+1)*intDsize <= 32) \
508 || ((uint32)value < (uint32)bitc(i*intDsize-1)))
509 #if (intDsize <= 32)
510 IF_LENGTH(1)
511 pos1: { ALLOC(1); FILL_1; OK; } /* bignum with 1 digit */
512 #if (intDsize <= 16)
513 IF_LENGTH(2)
514 pos2: { ALLOC(2); FILL_2; OK; } /* bignum with 2 digits */
515 #endif
516 #endif
517 #undef IF_LENGTH
518 #undef ALLOC
519 } else {
520 #define ALLOC(i) \
521 var object newnum = allocate_bignum(i,-1); \
522 var uintD* ptr = &TheBignum(newnum)->data[i-1];
523 #define IF_LENGTH(i) \
524 if ((bn_minlength <= i) && (i*intDsize <= 32)) \
525 if (!((i+1)*intDsize <= 32) \
526 || ((uint32)value >= (uint32)(-bitc(i*intDsize-1))) \
527 )
528 #if (intDsize <= 32)
529 IF_LENGTH(1)
530 neg1: { ALLOC(1); FILL_1; OK; } /* bignum with 1 digit */
531 #if (intDsize <= 16)
532 IF_LENGTH(2)
533 neg2: { ALLOC(2); FILL_2; OK; } /* bignum with 2 digits */
534 #endif
535 #endif
536 #undef IF_LENGTH
537 #undef ALLOC
538 }
539 #undef OK
540 #undef FILL_2
541 #undef FILL_1
542 #undef FILL_2_DIGITS
543 #undef FILL_1_DIGIT
544 }
545 }
546 #endif
547
548 /* converts unsigned longword in integer >=0 .
549 UL_to_I(value)
550 > value: value of the integer, an unsigned 32-bit-integer.
551 < result: integer with this value.
552 can trigger GC */
553 #if !(intLsize<=oint_data_len) /* if not already defined in lispbibl.d */
UL_to_I(uint32 value)554 modexp maygc object UL_to_I (uint32 value)
555 {
556 if ((value & ~ (FN_value_mask >> oint_data_shift)) == 0)
557 /* all bits, that do not fit into the fixnum-value, =0 ? */
558 return as_object(((oint)fixnum_type<<oint_type_shift) | (value<<oint_data_shift));
559 /* create bignum:
560 (its length bn_minlength <= n <= ceiling((32+1)/intDsize) ) */
561 #define UL_maxlength ceiling(32+1,intDsize)
562 #if (bn_minlength <= 1) && (UL_maxlength >= 1)
563 if ((1*intDsize-1 < 32)
564 ? (value <= (uint32)(bitc(1*intDsize-1)-1))
565 : true) { /* bignum with 1 digit */
566 var object newnum = allocate_bignum(1,0);
567 TheBignum(newnum)->data[0] = (uintD)value;
568 return newnum;
569 }
570 #endif
571 #if (bn_minlength <= 2) && (UL_maxlength >= 2)
572 if ((2*intDsize-1 < 32)
573 ? (value <= (uint32)(bitc(2*intDsize-1)-1))
574 : true) { /* bignum with 2 digits */
575 var object newnum = allocate_bignum(2,0);
576 var uintD* ptr = &TheBignum(newnum)->data[1];
577 *ptr-- = (uintD)value;
578 #if (intDsize>=32)
579 *ptr = 0;
580 #else
581 value = value >> intDsize; *ptr = (uintD)value;
582 #endif
583 return newnum;
584 }
585 #endif
586 #if (bn_minlength <= 3) && (UL_maxlength >= 3)
587 if (true) { /* bignum with 3 digits */
588 var object newnum = allocate_bignum(3,0);
589 var uintD* ptr = &TheBignum(newnum)->data[2];
590 *ptr-- = (uintD)value; value = value >> intDsize;
591 *ptr-- = (uintD)value;
592 #if (2*intDsize>=32)
593 *ptr = 0;
594 #else
595 value = value >> intDsize; *ptr = (uintD)value;
596 #endif
597 return newnum;
598 }
599 #endif
600 }
601 #endif
602
603 /* converts double-longword in integer.
604 L2_to_I(value_hi,value_lo)
605 > value_hi|value_lo: value of the integer, a signed 64-bit-integer.
606 < result: integer with this value.
607 can trigger GC */
608 #if !(intVsize>32) /* if not already defined in lispbibl.d */
L2_to_I(sint32 value_hi,uint32 value_lo)609 modexp maygc object L2_to_I (sint32 value_hi, uint32 value_lo)
610 {
611 if (value_hi == 0) {
612 if ((value_lo & (uint32)(~(FN_value_mask >> oint_data_shift))) /* bits of value_lo, that do not fit into the fixnum-value */
613 == (uint32)0) /* all =0 ? */
614 return as_object(((oint)fixnum_type<<oint_type_shift) | ((oint)value_lo<<oint_data_shift));
615 } else if (value_hi == ~(uintL)0) {
616 if ((value_lo & (uint32)(~(FN_value_mask >> oint_data_shift))) /* bits of value_lo, that do not fit into the fixnum-value */
617 == (uint32)(~(FN_value_mask >> oint_data_shift))) /* all =1 ? */
618 #ifndef WIDE
619 return as_object(((((oint)fixnum_vz_type<<oint_type_shift)+FN_value_mask) & (value_lo<<oint_data_shift))
620 |(((oint)fixnum_vz_type<<oint_type_shift) & (wbit(oint_data_shift)-1)));
621 #else
622 return as_object(((oint)fixnum_vz_type<<oint_type_shift) | ((oint)(value_lo & (uint32)(FN_value_mask >> oint_data_shift)) << oint_data_shift));
623 #endif
624 }
625 /* create bignum:
626 (its length bn_minlength <= n <= ceiling(64/intDsize) ) */
627 #define FILL_1_DIGIT(from) \
628 *ptr-- = (uintD)from;
629 #define FILL_2_DIGITS(from) \
630 *ptr-- = (uintD)from; from = from >> intDsize; \
631 *ptr-- = (uintD)from;
632 #define FILL_3_DIGITS(from) \
633 *ptr-- = (uintD)from; from = from >> intDsize; \
634 *ptr-- = (uintD)from; from = from >> intDsize; \
635 *ptr-- = (uintD)from;
636 #define FILL_4_DIGITS(from) \
637 *ptr-- = (uintD)from; from = from >> intDsize; \
638 *ptr-- = (uintD)from; from = from >> intDsize; \
639 *ptr-- = (uintD)from; from = from >> intDsize; \
640 *ptr-- = (uintD)from;
641 #if (32/intDsize==1)
642 #define FILL_1 FILL_1_DIGIT(value_lo);
643 #define FILL_2 FILL_1_DIGIT(value_lo); FILL_1_DIGIT(value_hi);
644 #define FILL_3
645 #define FILL_4
646 #endif
647 #if (32/intDsize==2)
648 #define FILL_1 FILL_1_DIGIT(value_lo);
649 #define FILL_2 FILL_2_DIGITS(value_lo);
650 #define FILL_3 FILL_2_DIGITS(value_lo); FILL_1_DIGIT(value_hi);
651 #define FILL_4 FILL_2_DIGITS(value_lo); FILL_2_DIGITS(value_hi);
652 #endif
653 #define OK return newnum;
654 if (value_hi >= 0) {
655 #define ALLOC(i) \
656 var object newnum = allocate_bignum(i,0); \
657 var uintD* ptr = &TheBignum(newnum)->data[i-1];
658 #define IF_LENGTH(i) \
659 if ((bn_minlength <= i) && (i*intDsize <= 64)) \
660 if (!((i+1)*intDsize <= 64) \
661 || (i*intDsize-1 < 32 \
662 ? ((value_hi == 0) && (value_lo < (uint32)bitc(i*intDsize-1))) \
663 : ((uint32)value_hi < (uint32)bitc(i*intDsize-1-32))))
664 IF_LENGTH(1)
665 { ALLOC(1); FILL_1; OK; } /* bignum with 1 digit */
666 IF_LENGTH(2)
667 { ALLOC(2); FILL_2; OK; } /* bignum with 2 digits */
668 IF_LENGTH(3)
669 { ALLOC(3); FILL_3; OK; } /* bignum with 3 digits */
670 IF_LENGTH(4)
671 { ALLOC(4); FILL_4; OK; } /* bignum with 4 digits */
672 #undef IF_LENGTH
673 #undef ALLOC
674 } else {
675 #define ALLOC(i) \
676 var object newnum = allocate_bignum(i,-1); \
677 var uintD* ptr = &TheBignum(newnum)->data[i-1];
678 #define IF_LENGTH(i) \
679 if ((bn_minlength <= i) && (i*intDsize <= 64)) \
680 if (!((i+1)*intDsize <= 64) \
681 || (i*intDsize-1 < 32 \
682 ? ((value_hi == ~(uint32)0) && (value_lo >= (uint32)(-bitc(i*intDsize-1)))) \
683 : ((uint32)value_hi >= (uint32)(-bitc(i*intDsize-1-32)))))
684 IF_LENGTH(1)
685 { ALLOC(1); FILL_1; OK; } /* bignum with 1 digit */
686 IF_LENGTH(2)
687 { ALLOC(2); FILL_2; OK; } /* bignum with 2 digits */
688 IF_LENGTH(3)
689 { ALLOC(3); FILL_3; OK; } /* bignum with 3 digits */
690 IF_LENGTH(4)
691 { ALLOC(4); FILL_4; OK; } /* bignum with 4 digits */
692 #undef IF_LENGTH
693 #undef ALLOC
694 }
695 #undef OK
696 #undef FILL_4
697 #undef FILL_3
698 #undef FILL_2
699 #undef FILL_1
700 #undef FILL_4_DIGITS
701 #undef FILL_3_DIGITS
702 #undef FILL_2_DIGITS
703 #undef FILL_1_DIGIT
704 }
705 #endif
706
707 /* converts an unsigned doppel-longword into an integer.
708 UL2_to_I(value_hi,value_lo)
709 > value_hi|value_lo: value of the integer, an unsigned 64-bit-integer.
710 < result: integer with this value.
711 can trigger GC */
712 #if !(intVsize>32) /* if not already defined in lispbibl.d */
UL2_to_I(uint32 value_hi,uint32 value_lo)713 modexp maygc object UL2_to_I (uint32 value_hi, uint32 value_lo)
714 {
715 if ((value_hi == 0)
716 && ((value_lo & (uint32)(~(FN_value_mask >> oint_data_shift))) /* bits of value_lo, that do not fit into the fixnum-value */
717 == (uint32)0)) /* all =0 ? */
718 return as_object(((oint)fixnum_type<<oint_type_shift) | ((oint)value_lo<<oint_data_shift));
719 /* create bignum:
720 (its length bn_minlength <= n <= ceiling((64+1)/intDsize) ) */
721 #define UL2_maxlength ceiling(64+1,intDsize)
722 #define FILL_1_DIGIT(from) \
723 *ptr-- = (uintD)from;
724 #define FILL_2_DIGITS(from) \
725 *ptr-- = (uintD)from; from = from >> intDsize; \
726 *ptr-- = (uintD)from;
727 #define FILL_3_DIGITS(from) \
728 *ptr-- = (uintD)from; from = from >> intDsize; \
729 *ptr-- = (uintD)from; from = from >> intDsize; \
730 *ptr-- = (uintD)from;
731 #define FILL_4_DIGITS(from) \
732 *ptr-- = (uintD)from; from = from >> intDsize; \
733 *ptr-- = (uintD)from; from = from >> intDsize; \
734 *ptr-- = (uintD)from; from = from >> intDsize; \
735 *ptr-- = (uintD)from;
736 #if (32/intDsize==1)
737 #define FILL_1 FILL_1_DIGIT(value_lo);
738 #define FILL_2 FILL_1_DIGIT(value_lo); FILL_1_DIGIT(value_hi);
739 #define FILL_3 FILL_2 *ptr-- = 0;
740 #define FILL_4
741 #define FILL_5
742 #endif
743 #if (32/intDsize==2)
744 #define FILL_1 FILL_1_DIGIT(value_lo);
745 #define FILL_2 FILL_2_DIGITS(value_lo);
746 #define FILL_3 FILL_2_DIGITS(value_lo); FILL_1_DIGIT(value_hi);
747 #define FILL_4 FILL_2_DIGITS(value_lo); FILL_2_DIGITS(value_hi);
748 #define FILL_5 FILL_4 *ptr-- = 0;
749 #endif
750 #define OK return newnum;
751 #define ALLOC(i) \
752 var object newnum = allocate_bignum(i,0); \
753 var uintD* ptr = &TheBignum(newnum)->data[i-1];
754 #define IF_LENGTH(i) \
755 if ((bn_minlength <= i) && (UL2_maxlength >= i)) \
756 if ((i*intDsize >= 64+1) \
757 || (i*intDsize-1 < 32 \
758 ? ((value_hi == 0) && (value_lo < (uint32)bitc(i*intDsize-1))) \
759 : (value_hi < (uint32)bitc(i*intDsize-1-32))))
760 IF_LENGTH(1)
761 { ALLOC(1); FILL_1; OK; } /* bignum with 1 digit */
762 IF_LENGTH(2)
763 { ALLOC(2); FILL_2; OK; } /* bignum with 2 digits */
764 IF_LENGTH(3)
765 { ALLOC(3); FILL_3; OK; } /* bignum with 3 digits */
766 IF_LENGTH(4)
767 { ALLOC(4); FILL_4; OK; } /* bignum with 4 digits */
768 IF_LENGTH(5)
769 { ALLOC(5); FILL_5; OK; } /* bignum with 5 digits */
770 #undef IF_LENGTH
771 #undef ALLOC
772 #undef OK
773 #undef FILL_5
774 #undef FILL_4
775 #undef FILL_3
776 #undef FILL_2
777 #undef FILL_1
778 #undef FILL_4_DIGITS
779 #undef FILL_3_DIGITS
780 #undef FILL_2_DIGITS
781 #undef FILL_1_DIGIT
782 }
783 #endif
784
785 #if defined(intQsize) || (intVsize>32)
786 /* converts quadword into integer.
787 Q_to_I(value)
788 > value: value of the integer, a signed 64-bit-integer.
789 < result: integer with this value.
790 can trigger GC */
Q_to_I(sint64 value)791 modexp maygc object Q_to_I (sint64 value)
792 {
793 {
794 var uint64 test = value & ~(uint64)(FN_value_mask >> oint_data_shift);
795 /* test contains the bits, that do not fit into the fixnum-value. */
796 if (test == (uint64)0) /* all =0 ? */
797 return as_object(((oint)fixnum_type<<oint_type_shift) | ((oint)value<<oint_data_shift));
798 if (test == ~(uint64)(FN_value_mask >> oint_data_shift)) /* all =1 ? */
799 return as_object(((((oint)fixnum_vz_type<<oint_type_shift)+FN_value_mask) & ((oint)value<<oint_data_shift))
800 |(((oint)fixnum_vz_type<<oint_type_shift) & (wbit(oint_data_shift)-1)));
801 }
802 /* create bignum:
803 (its length bn_minlength <= n <= ceiling(64/intDsize) = 2 ) */
804 #define FILL_1_DIGIT(from) \
805 *ptr-- = (uintD)from;
806 #define FILL_2_DIGITS(from) \
807 *ptr-- = (uintD)from; from = from >> intDsize; \
808 *ptr-- = (uintD)from;
809 #define FILL_1 FILL_1_DIGIT(value);
810 #define FILL_2 FILL_2_DIGITS(value);
811 #define OK return newnum;
812 if (value >= 0) {
813 #define ALLOC(i) \
814 var object newnum = allocate_bignum(i,0); \
815 var uintD* ptr = &TheBignum(newnum)->data[i-1];
816 #define IF_LENGTH(i) \
817 if ((bn_minlength <= i) && (i*intDsize <= 64)) \
818 if (!((i+1)*intDsize <= 64) \
819 || ((uint64)value < (uint64)wbitc(i*intDsize-1)) \
820 )
821 IF_LENGTH(1)
822 { ALLOC(1); FILL_1; OK; } /* bignum with 1 digit */
823 IF_LENGTH(2)
824 { ALLOC(2); FILL_2; OK; } /* bignum with 2 digits */
825 #undef IF_LENGTH
826 #undef ALLOC
827 } else {
828 #define ALLOC(i) \
829 var object newnum = allocate_bignum(i,-1); \
830 var uintD* ptr = &TheBignum(newnum)->data[i-1];
831 #define IF_LENGTH(i) \
832 if ((bn_minlength <= i) && (i*intDsize <= 64)) \
833 if (!((i+1)*intDsize <= 64) \
834 || ((uint64)value >= -(uint64)wbitc(i*intDsize-1)) \
835 )
836 IF_LENGTH(1)
837 { ALLOC(1); FILL_1; OK; } /* bignum with 1 digit */
838 IF_LENGTH(2)
839 { ALLOC(2); FILL_2; OK; } /* bignum with 2 digits */
840 #undef IF_LENGTH
841 #undef ALLOC
842 }
843 #undef OK
844 #undef FILL_2
845 #undef FILL_1
846 #undef FILL_2_DIGITS
847 #undef FILL_1_DIGIT
848 }
849 #endif
850
851 #if defined(intQsize) || (intVsize>32) || defined(WIDE_HARD) || (SIZEOF_OFF_T > 4) || (SIZEOF_INO_T > 4)
852 /* converts unsigned quadword into integer >=0 .
853 UQ_to_I(value)
854 > value: value of the integer, an unsigned 64-bit-integer.
855 < result: integer with this value.
856 can trigger GC */
UQ_to_I(uint64 value)857 modexp maygc object UQ_to_I (uint64 value)
858 {
859 if ((value & ~(uint64)(FN_value_mask >> oint_data_shift)) == 0)
860 /* all bits, that do not fit into the fixnum-value, =0 ? */
861 return as_object(((oint)fixnum_type<<oint_type_shift) | (oint)(value<<oint_data_shift));
862 /* create bignum:
863 (its length bn_minlength <= n <= ceiling((64+1)/intDsize) ) */
864 #define UQ_maxlength ceiling(64+1,intDsize)
865 #if (bn_minlength <= 1) && (UQ_maxlength >= 1)
866 if ((1*intDsize-1 < 64)
867 ? (value <= (uint64)(wbitc(1*intDsize-1)-1))
868 : true) { /* bignum with 1 digit */
869 var object newnum = allocate_bignum(1,0);
870 TheBignum(newnum)->data[0] = (uintD)value;
871 return newnum;
872 }
873 #endif
874 #if (bn_minlength <= 2) && (UQ_maxlength >= 2)
875 if ((2*intDsize-1 < 64)
876 ? (value <= (uint64)(wbitc(2*intDsize-1)-1))
877 : true) { /* bignum with 2 digits */
878 var object newnum = allocate_bignum(2,0);
879 var uintD* ptr = &TheBignum(newnum)->data[1];
880 *ptr-- = (uintD)value;
881 #if (intDsize>=64)
882 *ptr = 0;
883 #else
884 value = value >> intDsize; *ptr = (uintD)value;
885 #endif
886 return newnum;
887 }
888 #endif
889 #if (bn_minlength <= 3) && (UQ_maxlength >= 3)
890 if ((3*intDsize-1 < 64)
891 ? (value <= (uint64)(wbitc(3*intDsize-1)-1))
892 : true) { /* bignum with 3 digits */
893 var object newnum = allocate_bignum(3,0);
894 var uintD* ptr = &TheBignum(newnum)->data[2];
895 *ptr-- = (uintD)value; value = value >> intDsize;
896 *ptr-- = (uintD)value;
897 #if (2*intDsize>=64)
898 *ptr = 0;
899 #else
900 value = value >> intDsize; *ptr = (uintD)value;
901 #endif
902 return newnum;
903 }
904 #endif
905 #if (bn_minlength <= 4) && (UQ_maxlength >= 4)
906 if ((4*intDsize-1 < 64)
907 ? (value <= (uint64)(wbitc(4*intDsize-1)-1))
908 : true) { /* bignum with 4 digits */
909 var object newnum = allocate_bignum(4,0);
910 var uintD* ptr = &TheBignum(newnum)->data[3];
911 *ptr-- = (uintD)value; value = value >> intDsize;
912 *ptr-- = (uintD)value; value = value >> intDsize;
913 *ptr-- = (uintD)value;
914 #if (3*intDsize>=64)
915 *ptr = 0;
916 #else
917 value = value >> intDsize; *ptr = (uintD)value;
918 #endif
919 return newnum;
920 }
921 #endif
922 #if (bn_minlength <= 5) && (UQ_maxlength >= 5)
923 if (true) { /* bignum with 5 digits */
924 var object newnum = allocate_bignum(5,0);
925 var uintD* ptr = &TheBignum(newnum)->data[4];
926 *ptr-- = (uintD)value; value = value >> intDsize;
927 *ptr-- = (uintD)value; value = value >> intDsize;
928 *ptr-- = (uintD)value; value = value >> intDsize;
929 *ptr-- = (uintD)value;
930 #if (4*intDsize>=64)
931 *ptr = 0;
932 #else
933 value = value >> intDsize; *ptr = (uintD)value;
934 #endif
935 return newnum;
936 }
937 #endif
938 }
939 #endif
940
941 /* returns the differenz x-y of two unsigned longwords x,y as integer.
942 UL_UL_minus_I(x,y) */
943 local maygc object UL_UL_minus_I (object x, object y);
944 #ifdef intQsize
945 #define UL_UL_minus_I(x,y) Q_to_I((sintQ)(uintQ)(x)-(sintQ)(uintQ)(y))
946 #else
947 #define UL_UL_minus_I(x,y) L2_to_I( ((x)<(y) ? -1L : 0), (x)-(y) )
948 #endif
949
950 /* conversion routines digit sequence --> integer: */
951
952 /* Normalized Digit sequence to Integer
953 NDS_to_I(MSDptr,len)
954 convert digit sequence MSDptr/len/.. in integer.
955 can trigger GC */
NDS_to_I(const uintD * MSDptr,uintC len)956 local maygc object NDS_to_I (const uintD* MSDptr, uintC len)
957 {
958 /* more than bn_minlength digits -> bignum.
959 less than bn_minlength digits -> fixnum.
960 exactly bn_minlength Digits -> bignum or fixnum. */
961 if (len < bn_minlength) {
962 /* 0..bn_minlength-1 digits, fits into a fixnum: */
963 if (bn_minlength>1 ? (len==0) : true)
964 /* 0 digits */
965 return Fixnum_0;
966 #if !(defined(intQsize) || (intVsize>32))
967 var sint32 value;
968 if (bn_minlength>2 ? (len==1) : true) { /* 1 digit */
969 len_1: value = get_sint1D_Dptr(MSDptr);
970 } else if (bn_minlength>3 ? (len==2) : true) { /* 2 digits */
971 len_2: value = get_sint2D_Dptr(MSDptr);
972 } else if (bn_minlength>4 ? (len==3) : true) { /* 3 digits */
973 len_3: value = get_sint3D_Dptr(MSDptr);
974 } else if (true) { /* 4 digits */
975 len_4: value = get_sint4D_Dptr(MSDptr);
976 } else if (false) { /* 5 digits */
977 len_5: value = get_sint4D_Dptr(&MSDptr[1]); }
978 #else /* (defined(intQsize) || (intVsize>32)) && (intDsize==32) */
979 var sint64 value;
980 if (true) { /* 1 digit */
981 len_1: value = (sint64)(sintD)MSDptr[0];
982 } else if (true) { /* 2 digits */
983 len_2:
984 value = ((sint64)(sintD)MSDptr[0] << intDsize) | (uint64)(uintD)MSDptr[1];
985 }
986 #endif
987 return
988 #if (oint_data_shift <= sign_bit_o) && ((oint_data_len+1 <= intLsize) || defined(intQsize))
989 as_object((( (soint)value
990 & (FN_value_vz_mask>>oint_data_shift) /* mask the unneeded */
991 ) << oint_data_shift
992 )
993 | ((oint)fixnum_type<<oint_type_shift) /* store typeinfo instead */
994 )
995 #else
996 /* if (oint_data_shift > sign_bit_o) or if the sign bit is not in value */
997 as_object((( (soint)value << oint_data_shift )
998 & FN_value_mask /* mask the unneeded */
999 )
1000 | ((soint)(sint32)sign_of_sintD(MSDptr[0]) & wbit(sign_bit_o))
1001 | ((oint)fixnum_type<<oint_type_shift) /* store typeinfo instead */
1002 )
1003 #endif
1004 ;
1005 }
1006 if (len == bn_minlength) {
1007 /* bn_minlength digits, i.e. between (bn_minlength-1)*intDsize+1
1008 and bn_minlength*intDsize bits (incl. sign).
1009 at most oint_data_len+1 bits -> fits into a fixnum: */
1010 if ( (MSDptr[0] <= (uintD)(bit(oint_data_len-(bn_minlength-1)*intDsize)-1)) /* fixnum >=0 ? */
1011 ||(MSDptr[0] >= (uintD)(-bit(oint_data_len-(bn_minlength-1)*intDsize)))) /* fixnum <0 ? */
1012 #if (bn_minlength==1)
1013 goto len_1;
1014 #endif
1015 #if (bn_minlength==2)
1016 goto len_2;
1017 #endif
1018 #if (bn_minlength==3)
1019 goto len_3;
1020 #endif
1021 #if (bn_minlength==4)
1022 goto len_4;
1023 #endif
1024 #if (bn_minlength==5)
1025 goto len_5;
1026 #endif
1027 }
1028 /* at least bn_minlength digits, create a bignum */
1029 var object newnum = allocate_bignum(len,(sintB)sign_of_sintD(MSDptr[0]));
1030 /* fill new bignum with the content of the NDS: */
1031 copy_loop_up(MSDptr,&TheBignum(newnum)->data[0],len);
1032 return newnum;
1033 }
1034
1035 /* report Bignum-overflow: */
BN_ueberlauf(void)1036 local _Noreturn void BN_ueberlauf (void) {
1037 pushSTACK(TheSubr(subr_self)->name); /* slot :OPERATION */
1038 pushSTACK(NIL); /* slot :OPERANDS not available */
1039 error(arithmetic_error,GETTEXT("bignum overflow"));
1040 }
1041
1042 /* Normalized Unsigned Digit Sequence to Integer
1043 NUDS_to_I(MSDptr,len)
1044 convert Normalized UDS MSDptr/len/.. into Integer >=0 .
1045 there must be room for 1 digit below of MSDptr.
1046 can trigger GC */
NUDS_to_I(uintD * MSDptr,uintC len)1047 local maygc object NUDS_to_I (uintD* MSDptr, uintC len)
1048 {
1049 if ((len!=0) && ((sintD)MSDptr[0] < 0)) {
1050 /* if the length is >0 and the most significant bit is = 1 ,
1051 extend the digit sequence by one zero-digit: */
1052 *--MSDptr = 0;
1053 len++;
1054 if (uintWCoverflow(len)) /* overflow of the length? */
1055 BN_ueberlauf();
1056 }
1057 return NDS_to_I(MSDptr,len);
1058 }
1059
1060 /* Unsigned Digit Sequence to Integer
1061 UDS_to_I(MSDptr,len)
1062 convert UDS MSDptr/len/.. into Integer >=0 .
1063 there must be room for 1 digit below of MSDptr.
1064 can trigger GC */
UDS_to_I(uintD * MSDptr,uintC len)1065 modexp maygc object UDS_to_I (uintD* MSDptr, uintC len)
1066 {
1067 while ( (len!=0) && (MSDptr[0]==0) ) { /* so long as len>0 and MSD = 0, */
1068 MSDptr++; len--; /* discard null-digit */
1069 }
1070 /* Then proceed like in NUDS_to_I : */
1071 if ((len!=0) && ((sintD)MSDptr[0] < 0)) {
1072 /* if the length is >0 and the most significant bit is = 1 ,
1073 extend the digit sequence by one null digit: */
1074 *--MSDptr = 0;
1075 len++;
1076 if (uintWCoverflow(len)) /* overflow of the length? */
1077 BN_ueberlauf();
1078 }
1079 return NDS_to_I(MSDptr,len);
1080 }
1081
1082 /* Digit Sequence to Integer
1083 DS_to_I(MSDptr,len)
1084 convert DS MSDptr/len/.. into Integer.
1085 can trigger GC */
DS_to_I(const uintD * MSDptr,uintC len)1086 modexp maygc object DS_to_I (const uintD* MSDptr, uintC len)
1087 {
1088 /* first normalize. poss. increase MSDptr and decrease len: */
1089 if (len!=0) { /* empty DS is normalized */
1090 var uintC count = len-1;
1091 if ((sintD)MSDptr[0] >= 0) { /* number >= 0 */
1092 /* try to discard at most len-1 leading null-digits: */
1093 while (!(count==0) && (MSDptr[0]==0) && ((sintD)MSDptr[1]>=0)) {
1094 MSDptr++; len--; count--; /* discard nulldigit */
1095 }
1096 } else { /* number < 0 */
1097 /* try to discard at most len-1 leading one-digits: */
1098 while (!(count==0) && ((sintD)MSDptr[0]==-1) && ((sintD)MSDptr[1]<0)) {
1099 MSDptr++; len--; count--; /* discard one-digit */
1100 }
1101 }
1102 }
1103 /* possibly, len is exceptionally =1 at the DS 0,
1104 but NDS_to_I will cope with it. */
1105 return NDS_to_I(MSDptr,len);
1106 }
1107
1108 /* conversion routines Integer --> Digit sequence: */
1109
1110 /* subdivision of a fixnum in digits:
1111 intDsize=8 -> MSD=LSD3,LSD2,LSD1,LSD0, should be FN_maxlength=4 .
1112 intDsize=16 -> MSD=LSD1,LSD0, should be FN_maxlength=2 .
1113 intDsize=32 -> MSD=LSD0, should be FN_maxlength=1 .
1114 WIDE -> likewise, except that FN_maxlength is bigger by one. */
1115
1116 #if FN_maxlength>1
1117 #define FN_LSD0(obj) ((uintD)(as_oint(obj)>>oint_data_shift))
1118 #elif FN_maxlength==1
1119 #define FN_LSD0 FN_MSD
1120 #endif
1121 #if FN_maxlength>2
1122 #define FN_LSD1(obj) ((uintD)(as_oint(obj)>>(oint_data_shift+intDsize)))
1123 #elif FN_maxlength==2
1124 #define FN_LSD1 FN_MSD
1125 #else /* FN_maxlength<2 */
1126 #define FN_LSD1(obj) 0; NOTREACHED /* should not be called! */
1127 #endif
1128 #if FN_maxlength>3
1129 #define FN_LSD2(obj) ((uintD)(as_oint(obj)>>(oint_data_shift+2*intDsize)))
1130 #elif FN_maxlength==3
1131 #define FN_LSD2 FN_MSD
1132 #else /* FN_maxlength<3 */
1133 #define FN_LSD2(obj) 0; NOTREACHED /* should not be called! */
1134 #endif
1135 #if FN_maxlength>4
1136 #define FN_LSD3(obj) ((uintD)(as_oint(obj)>>(oint_data_shift+3*intDsize)))
1137 #elif FN_maxlength==4
1138 #define FN_LSD3 FN_MSD
1139 #else /* FN_maxlength<4 */
1140 #define FN_LSD3(obj) 0; NOTREACHED /* should not be called! */
1141 #endif
1142 #if FN_maxlength==5
1143 #define FN_LSD4 FN_MSD
1144 #else /* FN_maxlength<5 */
1145 #define FN_LSD4(obj) 0; NOTREACHED /* should not be called! */
1146 #endif
1147 /* FN_MSD: must be shifted by (FN_maxlength-1)*intDsize+oint_data_shift bits
1148 to the right, altogether. */
1149 #if defined(WIDE) && defined(TYPECODES) && ((oint_data_len%intDsize)==0)
1150 #define FN_MSD(obj) \
1151 ((uintD)( (sintD)(typecode(obj) << (intDsize-1-sign_bit_t)) >> (intDsize-1)))
1152 #elif (sign_bit_o == oint_data_len+oint_data_shift) || ((oint_data_len==(FN_maxlength-1)*intDsize) && (sign_bit_o >= intDsize-1))
1153 #if (sign_bit_o >= intDsize)
1154 #define FN_MSD(obj) \
1155 ((sintD)(as_oint(obj) >> (sign_bit_o-(intDsize-1))) >> (oint_data_shift-sign_bit_o+FN_maxlength*intDsize-1))
1156 #else
1157 #define FN_MSD(obj) \
1158 (((sintD)as_oint(obj) << (intDsize-1-sign_bit_o)) >> (FN_maxlength*intDsize-1-sign_bit_o+oint_data_shift))
1159 #endif
1160 #else
1161 /* signD_of_sintD(x,k) returns the sign of x as sintD; the rear
1162 k bits are irrelevant. */
1163 #if HAVE_DD
1164 #define signD_of_sintD(x,k) ((sintDD)(sintD)(x)>>intDsize)
1165 #else
1166 #define signD_of_sintD(x,k) ((sintD)(x)>>(intDsize-1-(k)))
1167 #endif
1168 #if (sign_bit_o >= intDsize)
1169 #define FN_MSD(obj) \
1170 ( ((sintD)(as_oint(obj)>>(oint_data_shift+(FN_maxlength-1)*intDsize))&(bit(oint_data_len-(FN_maxlength-1)*intDsize)-1)) \
1171 |((sintD)signD_of_sintD(as_oint(obj)>>(sign_bit_o-(intDsize-1)),oint_data_len-(FN_maxlength-1)*intDsize)&(-bit(oint_data_len-(FN_maxlength-1)*intDsize))) \
1172 )
1173 #else /* (sign_bit_o < intDsize) */
1174 #define FN_MSD(obj) \
1175 ( ((sintD)(as_oint(obj)>>(oint_data_shift+(FN_maxlength-1)*intDsize))&(bit(oint_data_len-(FN_maxlength-1)*intDsize)-1)) \
1176 |((sintD)signD_of_sintD(as_oint(obj)<<((intDsize-1)-sign_bit_o),oint_data_len-(FN_maxlength-1)*intDsize)&(-bit(oint_data_len-(FN_maxlength-1)*intDsize))) \
1177 )
1178 #endif
1179 #endif
1180
1181 /* Fixnum to Normalized Digit sequence
1182 { FN_to_NDS_nocopy(obj, MSDptr=,len=,LSDptr=); ... }
1183 > obj: a fixnum
1184 < MSDptr/len/LSDptr: normalized digit sequence, in machine stack */
1185 #define FN_to_NDS_nocopy(obj,MSDptr_assignment,len_assignment,LSDptr_assignment) \
1186 var uintD CONCAT(FN_to_NDS_room_,__LINE__)[FN_maxlength]; \
1187 FN_to_NDS_nocopy_(obj,CONCAT(FN_to_NDS_room_,__LINE__),_EMA_ MSDptr_assignment,len_assignment,_EMA_ LSDptr_assignment)
1188
1189 /* Fixnum to Normalized Digit sequence
1190 FN_to_NDS(obj, MSDptr=,len=,LSDptr=);
1191 > obj: a fixnum
1192 < MSDptr/len/LSDptr: normalized digit sequence, may be modified.
1193 num_stack is decreased. */
1194 #define FN_to_NDS(obj,MSDptr_assignment,len_assignment,LSDptr_assignment) \
1195 FN_to_NDS_(copy,obj,_EMA_ MSDptr_assignment,len_assignment,_EMA_ LSDptr_assignment)
1196 #define alloc_FNDS_copy num_stack_need
1197
1198 /* Fixnum to Normalized Digit sequence
1199 FN_to_NDS_1(obj, MSDptr=,len=,LSDptr=);
1200 > obj: a fixnum
1201 < MSDptr/len/LSDptr: normalized digit sequence, may be modified.
1202 below MSDptr, there is still room for one 1 digit.
1203 num_stack is decreased. */
1204 #define FN_to_NDS_1(obj,MSDptr_assignment,len_assignment,LSDptr_assignment) \
1205 FN_to_NDS_(copy_1,obj,_EMA_ MSDptr_assignment,len_assignment,_EMA_ LSDptr_assignment)
1206 #define alloc_FNDS_copy_1 num_stack_need_1
1207
1208 /* only needed, when FN_maxlength >= 2, i.e. intDsize-1 < oint_data_len */
1209 #define FN_MSD1_mask \
1210 (FN_value_vz_mask & ~((oint)(bitc(intDsize-1)-1)<<oint_data_shift))
1211 /* only needed, when FN_maxlength >= 3, i.e. 2*intDsize-1 < oint_data_len */
1212 #define FN_MSD2_mask \
1213 (FN_value_vz_mask & ~((oint)(bitc(2*intDsize-1)-1)<<oint_data_shift))
1214 /* only needed, when FN_maxlength >= 4, i.e. 3*intDsize-1 < oint_data_len */
1215 #define FN_MSD3_mask \
1216 (FN_value_vz_mask & ~((oint)(bitc(3*intDsize-1)-1)<<oint_data_shift))
1217 /* only needed, when FN_maxlength >= 5, i.e. 4*intDsize-1 < oint_data_len */
1218 #define FN_MSD4_mask \
1219 (FN_value_vz_mask & ~((oint)(bitc(4*intDsize-1)-1)<<oint_data_shift))
1220 #define FN_to_NDS_(option, obj, MSDptr_assignment,len_assignment,LSDptr_assignment) \
1221 do { var oint fix_from_FN_to_NDS = as_oint(obj); \
1222 var uintC len_from_FN_to_NDS; \
1223 var uintD* ptr_from_FN_to_NDS; \
1224 /* determine length of the NDS: */ \
1225 if (eq(as_object(fix_from_FN_to_NDS),Fixnum_0)) { /* need at least 1 digit? */ \
1226 len_from_FN_to_NDS=0; \
1227 } else { \
1228 var oint testMSD; /* fore bits of fix_from_FN_to_NDS */ \
1229 if ((FN_maxlength<=1) || \
1230 (((testMSD = fix_from_FN_to_NDS & FN_MSD1_mask) == 0) \
1231 || (testMSD == FN_MSD1_mask))) { \
1232 len_from_FN_to_NDS=1; /* only one digit to store */ \
1233 } else if ((FN_maxlength<=2) || \
1234 (((testMSD = fix_from_FN_to_NDS & FN_MSD2_mask) == 0) \
1235 || (testMSD == FN_MSD2_mask))) { \
1236 len_from_FN_to_NDS=2; /* two digits to store */ \
1237 } else if ((FN_maxlength<=3) || \
1238 (((testMSD = fix_from_FN_to_NDS & FN_MSD3_mask) == 0) \
1239 || (testMSD == FN_MSD3_mask))) { \
1240 len_from_FN_to_NDS=3; /* thre digits to store */ \
1241 } else if ((FN_maxlength<=4) || \
1242 (((testMSD = fix_from_FN_to_NDS & FN_MSD4_mask) == 0) \
1243 || (testMSD == FN_MSD4_mask))) { \
1244 len_from_FN_to_NDS=4; /* four digits to store */ \
1245 } else { \
1246 len_from_FN_to_NDS=5; /* five digits to store */ \
1247 } \
1248 } \
1249 len_assignment len_from_FN_to_NDS; \
1250 /* allocate space: */ \
1251 CONCAT(alloc_FNDS_,option) \
1252 (len_from_FN_to_NDS, MSDptr_assignment ptr_from_FN_to_NDS =,_EMA_ LSDptr_assignment); \
1253 /* fill space: */ \
1254 if (len_from_FN_to_NDS > 0) { \
1255 if ((FN_maxlength>1) && (len_from_FN_to_NDS > 1)) { \
1256 if ((FN_maxlength>2) && (len_from_FN_to_NDS > 2)) { \
1257 if ((FN_maxlength>3) && (len_from_FN_to_NDS > 3)) { \
1258 if ((FN_maxlength>4) && (len_from_FN_to_NDS > 4)) { \
1259 /* five digits to store: */ \
1260 *ptr_from_FN_to_NDS++ = FN_LSD4(as_object(fix_from_FN_to_NDS)); \
1261 } \
1262 /* still four digits to store abzulegen: */ \
1263 *ptr_from_FN_to_NDS++ = FN_LSD3(as_object(fix_from_FN_to_NDS)); \
1264 } \
1265 /* still three digits to store: */ \
1266 *ptr_from_FN_to_NDS++ = FN_LSD2(as_object(fix_from_FN_to_NDS)); \
1267 } \
1268 /* still two digits to store: */ \
1269 *ptr_from_FN_to_NDS++ = FN_LSD1(as_object(fix_from_FN_to_NDS)); \
1270 } \
1271 /* still one digit to store: */ \
1272 *ptr_from_FN_to_NDS = FN_LSD0(as_object(fix_from_FN_to_NDS)); \
1273 } \
1274 } while(0)
1275 #define FN_to_NDS_nocopy_(obj, room, MSDptr_assignment,len_assignment,LSDptr_assignment) \
1276 do { var oint fix_from_FN_to_NDS = as_oint(obj); \
1277 var uintC len_from_FN_to_NDS; \
1278 /* determine the length of the NDS and fill space: */ \
1279 if (eq(as_object(fix_from_FN_to_NDS),Fixnum_0)) { /* need at least 1 digit? */ \
1280 len_from_FN_to_NDS=0; \
1281 } else { \
1282 var oint testMSD; /* fore bits of fix_from_FN_to_NDS */ \
1283 var uintD* ptr_from_FN_to_NDS = room; \
1284 if ((FN_maxlength<=1) || \
1285 (((testMSD = fix_from_FN_to_NDS & FN_MSD1_mask) == 0) \
1286 || (testMSD == FN_MSD1_mask))) { \
1287 len_from_FN_to_NDS=1; /* only one digit to store */ \
1288 } else { \
1289 if ((FN_maxlength<=2) || \
1290 (((testMSD = fix_from_FN_to_NDS & FN_MSD2_mask) == 0) \
1291 || (testMSD == FN_MSD2_mask))) { \
1292 len_from_FN_to_NDS=2; /* two digits to store */ \
1293 } else { \
1294 if ((FN_maxlength<=3) || \
1295 (((testMSD = fix_from_FN_to_NDS & FN_MSD3_mask) == 0) \
1296 || (testMSD == FN_MSD3_mask))) { \
1297 len_from_FN_to_NDS=3; /* three digits to store */ \
1298 } else { \
1299 if ((FN_maxlength<=4) || \
1300 (((testMSD = fix_from_FN_to_NDS & FN_MSD4_mask) == 0) \
1301 || (testMSD == FN_MSD4_mask))) { \
1302 len_from_FN_to_NDS=4; /* four digits to store */ \
1303 } else { \
1304 len_from_FN_to_NDS=5; /* five digits to store */ \
1305 *ptr_from_FN_to_NDS++ = FN_LSD4(as_object(fix_from_FN_to_NDS)); \
1306 } \
1307 *ptr_from_FN_to_NDS++ = FN_LSD3(as_object(fix_from_FN_to_NDS)); \
1308 } \
1309 *ptr_from_FN_to_NDS++ = FN_LSD2(as_object(fix_from_FN_to_NDS)); \
1310 } \
1311 *ptr_from_FN_to_NDS++ = FN_LSD1(as_object(fix_from_FN_to_NDS)); \
1312 } \
1313 *ptr_from_FN_to_NDS = FN_LSD0(as_object(fix_from_FN_to_NDS)); \
1314 } \
1315 len_assignment len_from_FN_to_NDS; \
1316 unused (LSDptr_assignment (MSDptr_assignment room) + len_from_FN_to_NDS); \
1317 } while(0)
1318
1319 /* Bignum to Normalized Digit sequence, copying unnecessary
1320 BN_to_NDS_nocopy(obj, MSDptr=,len=,LSDptr=);
1321 > obj: a Bignum
1322 < MSDptr/len/LSDptr: Normalized Digit sequence */
1323 #define BN_to_NDS_nocopy(obj, MSDptr_assignment,len_assignment,LSDptr_assignment) \
1324 do { var Bignum bn_from_BN_to_NDS_nocopy = TheBignum(obj); \
1325 unused (MSDptr_assignment &bn_from_BN_to_NDS_nocopy->data[0]); \
1326 unused (LSDptr_assignment &bn_from_BN_to_NDS_nocopy->data[(uintP)( \
1327 len_assignment bignum_length(bn_from_BN_to_NDS_nocopy) )]); \
1328 } while(0)
1329
1330 /* Bignum to Normalized Digit sequence
1331 BN_to_NDS(obj, MSDptr=,len=,LSDptr=);
1332 > obj: a Bignum
1333 < MSDptr/len/LSDptr: Normalized Digit sequence, may be modified.
1334 num_stack is decreased. */
1335 #define BN_to_NDS(obj, MSDptr_assignment,len_assignment,LSDptr_assignment) \
1336 do { var object obj_from_BN_to_NDS = (obj); \
1337 var uintD* MSDptr_from_BN_to_NDS; \
1338 var uintC len_from_BN_to_NDS; \
1339 len_assignment len_from_BN_to_NDS = Bignum_length(obj_from_BN_to_NDS); \
1340 num_stack_need(len_from_BN_to_NDS, MSDptr_assignment MSDptr_from_BN_to_NDS = ,_EMA_ LSDptr_assignment); \
1341 copy_loop_up(&TheBignum(obj_from_BN_to_NDS)->data[0],MSDptr_from_BN_to_NDS,len_from_BN_to_NDS); \
1342 } while(0)
1343
1344 /* Bignum to Normalized Digit sequence
1345 BN_to_NDS_1(obj, MSDptr=,len=,LSDptr=);
1346 > obj: a Bignum
1347 < MSDptr/len/LSDptr: Normalized Digit sequence, may be modified.
1348 below MSDptr, there is still room for one 1 digit.
1349 num_stack is decreased. */
1350 #define BN_to_NDS_1(obj, MSDptr_assignment,len_assignment,LSDptr_assignment) \
1351 do { var object obj_from_BN_to_NDS = (obj); \
1352 var uintD* MSDptr_from_BN_to_NDS; \
1353 var uintC len_from_BN_to_NDS; \
1354 len_assignment len_from_BN_to_NDS = Bignum_length(obj_from_BN_to_NDS); \
1355 num_stack_need_1(len_from_BN_to_NDS, MSDptr_assignment MSDptr_from_BN_to_NDS = ,_EMA_ LSDptr_assignment); \
1356 copy_loop_up(&TheBignum(obj_from_BN_to_NDS)->data[0],MSDptr_from_BN_to_NDS,len_from_BN_to_NDS); \
1357 } while(0)
1358
1359 /* Integer to Normalized Digit sequence, copying unnecessary.
1360 { I_to_NDS_nocopy(obj, MSDptr=,len=,LSDptr=); ... }
1361 > obj: an Integer
1362 < MSDptr/len/LSDptr: Normalized Digit sequence */
1363 #define I_to_NDS_nocopy(obj, MSDptr_assignment,len_assignment,LSDptr_assignment) \
1364 var uintD CONCAT(I_to_NDS_room_,__LINE__)[FN_maxlength]; do { \
1365 var object obj_from_I_to_NDS_nocopy = (obj); \
1366 if (I_fixnump(obj_from_I_to_NDS_nocopy)) \
1367 FN_to_NDS_nocopy_(obj_from_I_to_NDS_nocopy,CONCAT(I_to_NDS_room_,__LINE__),_EMA_ MSDptr_assignment,len_assignment,_EMA_ LSDptr_assignment); \
1368 else \
1369 BN_to_NDS_nocopy(obj_from_I_to_NDS_nocopy,_EMA_ MSDptr_assignment,len_assignment,_EMA_ LSDptr_assignment); \
1370 } while(0)
1371
1372 /* Integer to Normalized Digit sequence
1373 I_to_NDS(obj, MSDptr=,len=,LSDptr=);
1374 > obj: an Integer
1375 < MSDptr/len/LSDptr: Normalized Digit sequence, may be modified.
1376 num_stack is decreased. */
1377 #define I_to_NDS(obj, MSDptr_assignment,len_assignment,LSDptr_assignment) \
1378 do { var object obj_from_I_to_NDS = (obj); \
1379 if (I_fixnump(obj_from_I_to_NDS)) \
1380 FN_to_NDS(obj_from_I_to_NDS,_EMA_ MSDptr_assignment,len_assignment,_EMA_ LSDptr_assignment); \
1381 else \
1382 BN_to_NDS(obj_from_I_to_NDS,_EMA_ MSDptr_assignment,len_assignment,_EMA_ LSDptr_assignment); \
1383 } while(0)
1384
1385 /* Integer to Normalized Digit sequence
1386 I_to_NDS_1(obj, MSDptr=,len=,LSDptr=);
1387 > obj: an Integer
1388 < MSDptr/len/LSDptr: Normalized Digit sequence, may be modified.
1389 below MSDptr, there is still room for one 1 digit.
1390 num_stack is decreased. */
1391 #define I_to_NDS_1(obj, MSDptr_assignment,len_assignment,LSDptr_assignment) \
1392 do { var object obj_from_I_to_NDS = (obj); \
1393 if (I_fixnump(obj_from_I_to_NDS)) \
1394 FN_to_NDS_1(obj_from_I_to_NDS,_EMA_ MSDptr_assignment,len_assignment,_EMA_ LSDptr_assignment); \
1395 else \
1396 BN_to_NDS_1(obj_from_I_to_NDS,_EMA_ MSDptr_assignment,len_assignment,_EMA_ LSDptr_assignment); \
1397 } while(0)
1398
1399 /* Fetches the next pFN_maxlength digits into a uintV:
1400 _ptr is of type uintD*. */
1401 #if (pFN_maxlength==1)
1402 #define pFN_maxlength_digits_at(_ptr) \
1403 (uintV)(_ptr[0])
1404 #elif (pFN_maxlength==2) && (intDsize==16)
1405 #define pFN_maxlength_digits_at(_ptr) \
1406 highlow32_at(_ptr)
1407 #elif (pFN_maxlength==2)
1408 #define pFN_maxlength_digits_at(_ptr) \
1409 (((uintV)(_ptr[0])<<intDsize)| \
1410 (uintV)(_ptr[1]))
1411 #elif (pFN_maxlength==3)
1412 #define pFN_maxlength_digits_at(_ptr) \
1413 (((((uintV)(_ptr[0])<<intDsize)| \
1414 (uintV)(_ptr[1]))<<intDsize)| \
1415 (uintV)(_ptr[2]))
1416 #elif (pFN_maxlength==4)
1417 #define pFN_maxlength_digits_at(_ptr) \
1418 (((((((uintV)(_ptr[0])<<intDsize)| \
1419 (uintV)(_ptr[1]))<<intDsize)| \
1420 (uintV)(_ptr[2]))<<intDsize)| \
1421 (uintV)(_ptr[3]))
1422 #endif
1423
1424 /* writes a uint32 into the next pFN_maxlength digits:
1425 _ptr is of type uintD*, _value of type uintV. */
1426 #if (pFN_maxlength==1)
1427 #define set_pFN_maxlength_digits_at(_ptr,_value) \
1428 (_ptr[0] = (uintD)_value)
1429 #elif (pFN_maxlength==2) && (intDsize==16)
1430 #define set_pFN_maxlength_digits_at(_ptr,_value) \
1431 set_highlow32_at(_ptr,_value)
1432 #elif (pFN_maxlength==2)
1433 #define set_pFN_maxlength_digits_at(_ptr,_value) \
1434 (_ptr[0] = (uintD)(_value>>intDsize), \
1435 _ptr[1] = (uintD)(_value))
1436 #elif (pFN_maxlength==3)
1437 #define set_pFN_maxlength_digits_at(_ptr,_value) \
1438 (_ptr[0] = (uintD)(_value>>(2*intDsize)), \
1439 _ptr[1] = (uintD)(_value>>intDsize), \
1440 _ptr[2] = (uintD)(_value))
1441 #elif (pFN_maxlength==4)
1442 #define set_pFN_maxlength_digits_at(_ptr,_value) \
1443 (_ptr[0] = (uintD)(_value>>(3*intDsize)), \
1444 _ptr[1] = (uintD)(_value>>(2*intDsize)), \
1445 _ptr[2] = (uintD)(_value>>intDsize), \
1446 _ptr[3] = (uintD)(_value))
1447 #endif
1448