source: project/release/4/numbers/trunk/numbers-c.h @ 31411

Last change on this file since 31411 was 31411, checked in by sjamaan, 7 years ago

numbers: Convert quotient fully to core naming conventions

File size: 12.1 KB
Line 
1/* numbers-c.h */
2
3#include <limits.h>
4
5#define FIX    0
6#define FLO    1
7#define BIG    2
8#define RAT    3
9#define COMP   4
10#define NONE   5
11
12#define BIG_TAG       0
13#define RAT_TAG       1
14#define COMP_TAG      2
15
16enum bignum_comparison
17{
18  bignum_comparison_equal = 0,
19  bignum_comparison_less = -1,
20  bignum_comparison_greater = 1
21};
22
23typedef void * bignum_type;
24typedef C_word bignum_digit_type;
25typedef C_word bignum_length_type;
26
27/* Internal bignum interface */
28static bignum_type bignum_allocate(bignum_length_type, int);
29static bignum_type shorten_bignum(bignum_type, bignum_length_type);
30static bignum_type bignum_trim(bignum_type);
31static void bignum_destructive_copy(bignum_type, bignum_type);
32static bignum_type bignum_new_sign(bignum_type, int);
33static void bignum_divide_unsigned_large_denominator(bignum_type, bignum_type,
34                                                     bignum_type *,
35                                                     bignum_type *, int, int);
36static void bignum_divide_unsigned_normalized(bignum_type, bignum_type,
37                                              bignum_type);
38static bignum_digit_type bignum_divide_subtract(bignum_digit_type *,
39                                                bignum_digit_type *,
40                                                bignum_digit_type,
41                                                bignum_digit_type *);
42static void bignum_divide_unsigned_medium_denominator(bignum_type,
43                                                      bignum_digit_type,
44                                                      bignum_type *,
45                                                      bignum_type *,
46                                                      int, int);
47static void bignum_destructive_normalization(bignum_type, bignum_type, int);
48static bignum_type bignum_destructive_unnormalization(bignum_type, int);
49static bignum_digit_type bignum_digit_divide(bignum_digit_type,
50                                             bignum_digit_type,
51                                             bignum_digit_type,
52                                             bignum_digit_type *);
53static bignum_digit_type bignum_digit_divide_subtract(bignum_digit_type,
54                                                      bignum_digit_type,
55                                                      bignum_digit_type,
56                                                      bignum_digit_type *);
57static void bignum_divide_unsigned_small_denominator(bignum_type,
58                                                     bignum_digit_type,
59                                                     bignum_type *,
60                                                     bignum_type *,
61                                                     int, int);
62static bignum_digit_type bignum_destructive_scale_down(bignum_type,
63                                                       bignum_digit_type);
64static bignum_type bignum_remainder_unsigned_small_denominator(bignum_type,
65                                                               bignum_digit_type,
66                                                               int);
67static enum bignum_comparison bignum_compare_unsigned(bignum_type, bignum_type);
68
69#define BIGNUM_OUT_OF_BAND NULL
70
71/* BIGNUM_TO_POINTER casts a bignum object to a digit array pointer. */
72#define BIGNUM_TO_POINTER(bignum) ((bignum_digit_type *) (bignum))
73
74/* BIGNUM_REDUCE_LENGTH allows the memory system to reclaim some
75   space when a bignum's length is reduced from its original value. */
76#define BIGNUM_REDUCE_LENGTH(target, source, length)                    \
77     target = shorten_bignum(source, length)
78
79#define BIGNUM_DEALLOCATE(b) (C_free((void *)b))
80
81/* CHAR_BIT is from <limits.h>, and it equals the number of bits in a char */
82#define BIGNUM_DIGIT_LENGTH (((sizeof (bignum_digit_type)) * CHAR_BIT) - 2)
83#define BIGNUM_HALF_DIGIT_LENGTH (BIGNUM_DIGIT_LENGTH / 2)
84/* Radix = highest bit of header word: 1 if number negative, 0 if positive */
85#define BIGNUM_RADIX (((C_uword) 1) << BIGNUM_DIGIT_LENGTH)
86#define BIGNUM_RADIX_ROOT (((C_uword) 1) << BIGNUM_HALF_DIGIT_LENGTH)
87#define BIGNUM_DIGIT_MASK        (BIGNUM_RADIX - 1)
88#define BIGNUM_HALF_DIGIT_MASK   (BIGNUM_RADIX_ROOT - 1)
89
90#define BIGNUM_START_PTR(bignum)                                        \
91  ((BIGNUM_TO_POINTER (bignum)) + 1)
92
93#define BIGNUM_SET_HEADER(bignum, length, negative_p)                   \
94  (* (BIGNUM_TO_POINTER (bignum))) =                                    \
95    ((length) | ((negative_p) ? BIGNUM_RADIX : 0))
96
97#define BIGNUM_LENGTH(bignum)                                           \
98  ((* (BIGNUM_TO_POINTER (bignum))) & ((bignum_length_type) BIGNUM_DIGIT_MASK))
99
100#define BIGNUM_NEGATIVE_P(bignum)                                       \
101  (((* (BIGNUM_TO_POINTER (bignum))) & BIGNUM_RADIX) != 0)
102
103#define BIGNUM_REF(bignum, index)                                       \
104  (* ((BIGNUM_START_PTR (bignum)) + (index)))
105
106
107/* These definitions are here to facilitate caching of the constants
108   0, 1, and -1. */
109/*
110 * We don't cache because it complicates the conversion to fixnum code
111 * since it would need additional checks before freeing the bignum.
112 * Most cases where BIGNUM_ONE/ZERO are returned are removed anyway.
113 */
114#define BIGNUM_ZERO() (bignum_digit_to_bignum(0, 0))
115#define BIGNUM_ONE(neg_p) (bignum_digit_to_bignum(1, neg_p))
116
117#define HD_LOW(digit) ((digit) & BIGNUM_HALF_DIGIT_MASK)
118#define HD_HIGH(digit) ((digit) >> BIGNUM_HALF_DIGIT_LENGTH)
119#define HD_CONS(high, low) (((high) << BIGNUM_HALF_DIGIT_LENGTH) | (low))
120
121
122/**
123 * Below is a duplication of the above, as port of a refactoring to
124 * fit CHICKEN naming conventions and general C style.  This should
125 * bring additional performance (eventually) and make it easier to
126 * integrate into core, if that day will ever arrive...
127 */
128#define C_SIZEOF_STRUCTURE(n)           ((n)+2) /* missing from chicken.h */
129#define C_SIZEOF_CLOSURE(n)             ((n)+1) /* missing from chicken.h */
130/* The "internal"/"external" bignum distinction should die */
131#define C_SIZEOF_INTERNAL_BIGNUM(n)     (C_SIZEOF_VECTOR((n)+1))
132#define C_internal_bignum(b)            (C_block_item(b,1))
133
134#define C_SIZEOF_BIGNUM(n)              (C_SIZEOF_INTERNAL_BIGNUM(n)+C_SIZEOF_STRUCTURE(2))
135/* This is convenience so you won't forget a fixnum may need 2 digits! */
136#define C_SIZEOF_FIX_BIGNUM             C_SIZEOF_BIGNUM(2)
137
138/* CHAR_BIT is from <limits.h>, and it equals the number of bits in a char */
139#define C_bytestobits(n)           ((n) * CHAR_BIT)
140
141#ifdef C_SIXTY_FOUR
142# define C_BIGNUM_DIGIT_LENGTH      62
143# define C_BIGNUM_HEADER_SIGN_BIT   0x4000000000000000L
144# define C_BIGNUM_HEADER_SIZE_MASK  0x3fffffffffffffffL
145# define C_BIGNUM_DIGIT_MASK        0x3fffffffffffffffL
146# define C_BIGNUM_HALF_DIGIT_MASK   0x000000007fffffffL
147# define C_BIGNUM_HALF_DIGIT_LENGTH 31
148#else
149# define C_BIGNUM_DIGIT_LENGTH      30
150# define C_BIGNUM_HEADER_SIGN_BIT   0x40000000
151# define C_BIGNUM_HEADER_SIZE_MASK  0x3fffffff
152# define C_BIGNUM_DIGIT_MASK        0x3fffffff
153# define C_BIGNUM_HALF_DIGIT_MASK   0x00007fff
154# define C_BIGNUM_HALF_DIGIT_LENGTH 15
155#endif
156
157#define C_BIGNUM_BITS_TO_DIGITS(n) \
158        (((n) + (BIGNUM_DIGIT_LENGTH - 1)) / BIGNUM_DIGIT_LENGTH)
159
160#define C_BIGNUM_DIGIT_LO_HALF(d)       ((d) & C_BIGNUM_HALF_DIGIT_MASK)
161#define C_BIGNUM_DIGIT_HI_HALF(d)       ((d) >> C_BIGNUM_HALF_DIGIT_LENGTH)
162#define C_BIGNUM_DIGIT_COMBINE(h,l)     ((h) << C_BIGNUM_HALF_DIGIT_LENGTH|(l))
163
164#define C_fitsinbignumdigitp(n)         ((C_uword)(n) == ((C_uword)(n) & C_BIGNUM_DIGIT_MASK))
165#define C_fitsinbignumhalfdigitp(n)     ((C_uword)(n) == ((C_uword)(n) & C_BIGNUM_HALF_DIGIT_MASK))
166#define C_bignum_header(b)              (*(C_word *)C_data_pointer(C_internal_bignum(b)))
167#define C_bignum_digits(b)              (((C_word *)C_data_pointer(C_internal_bignum(b)))+1)
168#define C_bignum_negativep(b)           ((C_bignum_header(b) & C_BIGNUM_HEADER_SIGN_BIT) != 0)
169#define C_u_i_bignum_negativep(b)       C_mk_bool(C_bignum_negativep(b))
170#define C_u_i_bignum_oddp(b)            C_mk_bool(C_bignum_digits(b)[0] & 1)
171/* The bytes->words conversion should be killed, but that can only be
172 * done when the representation is made part of core (otherwise the GC
173 * will trip on the vector's contents not being proper Scheme objects:
174 * it skips objects marked with C_BYTEBLOCK_BIT).  We could set
175 * SPECIALBLOCK_BIT, but that would disable the number-syntax hack.
176 * So, for now we'll live with back and forth byte<->word conversion.
177 */
178#define C_bignum_size(b)                (C_bytestowords(C_header_size(C_internal_bignum(b)))-1)
179
180void C_ccall C_allocate_bignum(C_word c, C_word self, C_word k, C_word size, C_word negp, C_word initp);
181void C_ccall C_bignum_destructive_trim(C_word big);
182C_word C_ccall C_bignum_normalize(C_word big);
183
184C_word C_ccall C_u_i_2_fixnum_gcd(C_word x, C_word y);
185C_word C_ccall C_a_u_i_2_flonum_gcd(C_word **p, C_word n, C_word x, C_word y);
186void C_ccall C_u_fixnum_neg(C_word c, C_word self, C_word k, C_word x);
187void C_ccall C_u_bignum_negate(C_word c, C_word self, C_word k, C_word x);
188
189void C_ccall C_u_2_fixnum_plus(C_word c, C_word self, C_word k, C_word x, C_word y);
190void C_ccall C_u_fixnum_plus_bignum(C_word c, C_word self, C_word k, C_word x, C_word y);
191void C_ccall C_u_2_bignum_plus(C_word c, C_word self, C_word k, C_word x, C_word y);
192
193void C_ccall C_u_2_fixnum_times(C_word c, C_word self, C_word k, C_word x, C_word y);
194void C_ccall C_u_fixnum_times_bignum(C_word c, C_word self, C_word k, C_word x, C_word y);
195void C_ccall C_u_2_bignum_times(C_word c, C_word self, C_word k, C_word x, C_word y);
196
197void C_ccall C_u_bignum_quotient_fixnum(C_word c, C_word self, C_word k, C_word x, C_word y);
198void C_ccall C_u_bignum_quotient_bignum(C_word c, C_word self, C_word k, C_word x, C_word y);
199
200void C_ccall C_u_fixnum_minus_bignum(C_word c, C_word self, C_word k, C_word x, C_word y);
201void C_ccall C_u_bignum_minus_fixnum(C_word c, C_word self, C_word k, C_word x, C_word y);
202void C_ccall C_u_2_bignum_minus(C_word c, C_word self, C_word k, C_word x, C_word y);
203C_word C_u_i_bignum_cmp(C_word x, C_word y);
204void C_ccall C_u_bignum_abs(C_word c, C_word self, C_word k, C_word big);
205C_word C_ccall C_u_i_bignum_randomize(C_word bignum);
206void C_ccall C_u_bignum_random(C_word c, C_word self, C_word k, C_word max);
207
208void C_ccall C_digits_to_integer(C_word c, C_word self, C_word k, C_word n, C_word start, C_word end, C_word radix, C_word negp);
209void C_ccall C_u_bignum_to_digits(C_word c, C_word self, C_word k, C_word value, C_word radix);
210C_word C_a_u_i_big_to_flo(C_word **p, C_word n, C_word bignum);
211void C_ccall C_u_flo_to_int(C_word c, C_word self, C_word k, C_word x);
212C_word C_u_i_int_length(C_word x);
213
214void C_ccall C_u_int_shift_fix(C_word c, C_word self, C_word k, C_word x, C_word y);
215void C_ccall C_u_2_integer_bitwise_op(C_word c, C_word self, C_word k, C_word op, C_word x, C_word y);
216
217
218C_inline C_word C_bignum1(C_word **ptr, int negp, C_uword d1)
219{
220  C_word *p = *ptr, p0 = (C_word)p;
221
222  /* TODO: Rewrite to fit into the bit representation, get rid of
223   * structure wrapper and tag vector.  Also, remove the unnecessary
224   * extra length slot if possible...
225   */
226  C_word tagvec = CHICKEN_gc_root_ref(tags);
227
228  /* Not using C_a_i_vector2, to make it easier to rewrite later */
229  *(p++) = C_STRING_TYPE | C_wordstobytes(2);
230  *(p++) = negp ? C_BIGNUM_HEADER_SIGN_BIT | 1 : 1;
231  *(p++) = d1;
232  *ptr = p;
233
234  /* TODO: Maybe add C_a_i_structureN, like C_a_i_vectorN? */
235  return C_structure(ptr, 2, C_block_item(tagvec, BIG_TAG), p0);
236}
237
238/* TODO: d1/d2 low to high, or high to low? (ie, big or little endian?) */
239C_inline C_word C_bignum2(C_word **ptr, int negp, C_uword d1, C_uword d2)
240{
241  C_word *p = *ptr, p0 = (C_word)p;
242
243  C_word tagvec = CHICKEN_gc_root_ref(tags);
244
245  /* Not using C_a_i_vector2, to make it easier to rewrite later */
246  *(p++) = C_STRING_TYPE | C_wordstobytes(3);
247  *(p++) = negp ? C_BIGNUM_HEADER_SIGN_BIT | 2 : 2;
248  *(p++) = d1;
249  *(p++) = d2;
250  *ptr = p;
251
252  /* TODO: Maybe add C_a_i_structureN, like C_a_i_vectorN? */
253  return C_structure(ptr, 2, C_block_item(tagvec, BIG_TAG), p0);
254}
255
256C_inline C_word C_a_u_i_fix_to_big(C_word **ptr, C_word x)
257{
258  x = C_unfix(x);
259  if (x == C_MOST_NEGATIVE_FIXNUM)
260    return C_bignum2(ptr, 1, 0, 1);
261  else if (x < 0)
262    return C_bignum1(ptr, 1, -x);
263  else
264    return C_bignum1(ptr, 0, x);
265}
Note: See TracBrowser for help on using the repository browser.