5 cell bignum_maybe_to_fixnum(bignum* bn) {
8 fixnum len = BIGNUM_LENGTH(bn);
9 bignum_digit_type *digits = BIGNUM_START_PTR(bn);
10 if (len == 1 && digits[0] >= fixnum_min && digits[0] <= fixnum_max) {
11 return tag_fixnum(bignum_to_fixnum(bn));
13 return tag<bignum>(bn);
16 void factor_vm::primitive_bignum_to_fixnum() {
17 ctx->replace(tag_fixnum(bignum_to_fixnum(untag<bignum>(ctx->peek()))));
20 void factor_vm::primitive_bignum_to_fixnum_strict() {
21 ctx->replace(tag_fixnum(bignum_to_fixnum_strict(untag<bignum>(ctx->peek()))));
24 void factor_vm::primitive_float_to_fixnum() {
25 ctx->replace(tag_fixnum(float_to_fixnum(ctx->peek())));
28 /* does not allocate, even though from_signed_cell can allocate */
29 /* Division can only overflow when we are dividing the most negative fixnum
31 void factor_vm::primitive_fixnum_divint() {
32 fixnum y = untag_fixnum(ctx->pop());
33 fixnum x = untag_fixnum(ctx->peek());
34 fixnum result = x / y;
35 if (result == -fixnum_min)
36 /* Does not allocate */
37 ctx->replace(from_signed_cell(-fixnum_min));
39 ctx->replace(tag_fixnum(result));
42 /* does not allocate, even though from_signed_cell can allocate */
43 void factor_vm::primitive_fixnum_divmod() {
44 cell* s0 = (cell*)(ctx->datastack);
45 cell* s1 = (cell*)(ctx->datastack - sizeof(cell));
46 fixnum y = untag_fixnum(*s0);
47 fixnum x = untag_fixnum(*s1);
48 if (y == -1 && x == fixnum_min) {
49 /* Does not allocate */
50 *s1 = from_signed_cell(-fixnum_min);
53 *s1 = tag_fixnum(x / y);
54 *s0 = tag_fixnum(x % y);
59 * If we're shifting right by n bits, we won't overflow as long as none of the
60 * high WORD_SIZE-TAG_BITS-n bits are set.
62 inline fixnum factor_vm::sign_mask(fixnum x) {
63 return x >> (WORD_SIZE - 1);
66 inline fixnum factor_vm::branchless_max(fixnum x, fixnum y) {
67 return (x - ((x - y) & sign_mask(x - y)));
70 inline fixnum factor_vm::branchless_abs(fixnum x) {
71 return (x ^ sign_mask(x)) - sign_mask(x);
74 /* Allocates memory */
75 void factor_vm::primitive_fixnum_shift() {
76 fixnum y = untag_fixnum(ctx->pop());
77 fixnum x = untag_fixnum(ctx->peek());
82 y = branchless_max(y, -WORD_SIZE + 1);
83 ctx->replace(tag_fixnum(x >> -y));
85 } else if (y < WORD_SIZE - TAG_BITS) {
86 fixnum mask = -((fixnum)1 << (WORD_SIZE - 1 - TAG_BITS - y));
87 if (!(branchless_abs(x) & mask)) {
88 ctx->replace(tag_fixnum(x << y));
93 ctx->replace(tag<bignum>(bignum_arithmetic_shift(fixnum_to_bignum(x), y)));
96 /* Allocates memory */
97 void factor_vm::primitive_fixnum_to_bignum() {
98 ctx->replace(tag<bignum>(fixnum_to_bignum(untag_fixnum(ctx->peek()))));
101 /* Allocates memory */
102 void factor_vm::primitive_float_to_bignum() {
103 ctx->replace(tag<bignum>(float_to_bignum(ctx->peek())));
106 #define POP_BIGNUMS(x, y) \
107 bignum* y = untag<bignum>(ctx->pop()); \
108 bignum* x = untag<bignum>(ctx->peek());
110 void factor_vm::primitive_bignum_eq() {
112 ctx->replace(tag_boolean(bignum_equal_p(x, y)));
115 /* Allocates memory */
116 void factor_vm::primitive_bignum_add() {
118 ctx->replace(tag<bignum>(bignum_add(x, y)));
121 /* Allocates memory */
122 void factor_vm::primitive_bignum_subtract() {
124 ctx->replace(tag<bignum>(bignum_subtract(x, y)));
127 /* Allocates memory */
128 void factor_vm::primitive_bignum_multiply() {
130 ctx->replace(tag<bignum>(bignum_multiply(x, y)));
133 /* Allocates memory */
134 void factor_vm::primitive_bignum_divint() {
136 ctx->replace(tag<bignum>(bignum_quotient(x, y)));
139 /* Allocates memory */
140 void factor_vm::primitive_bignum_divmod() {
141 cell* s0 = (cell*)(ctx->datastack);
142 cell* s1 = (cell*)(ctx->datastack - sizeof(cell));
143 bignum* y = untag<bignum>(*s0);
144 bignum* x = untag<bignum>(*s1);
146 bignum_divide(x, y, &q, &r);
147 *s1 = tag<bignum>(q);
148 *s0 = bignum_maybe_to_fixnum(r);
151 void factor_vm::primitive_bignum_mod() {
153 cell val = bignum_maybe_to_fixnum(bignum_remainder(x, y));
157 void factor_vm::primitive_bignum_gcd() {
159 ctx->replace(tag<bignum>(bignum_gcd(x, y)));
162 void factor_vm::primitive_bignum_and() {
164 ctx->replace(tag<bignum>(bignum_bitwise_and(x, y)));
167 void factor_vm::primitive_bignum_or() {
169 ctx->replace(tag<bignum>(bignum_bitwise_ior(x, y)));
172 void factor_vm::primitive_bignum_xor() {
174 ctx->replace(tag<bignum>(bignum_bitwise_xor(x, y)));
177 /* Allocates memory */
178 void factor_vm::primitive_bignum_shift() {
179 fixnum y = untag_fixnum(ctx->pop());
180 bignum* x = untag<bignum>(ctx->peek());
181 ctx->replace(tag<bignum>(bignum_arithmetic_shift(x, y)));
184 void factor_vm::primitive_bignum_less() {
186 ctx->replace(tag_boolean(bignum_compare(x, y) == bignum_comparison_less));
189 void factor_vm::primitive_bignum_lesseq() {
191 ctx->replace(tag_boolean(bignum_compare(x, y) != bignum_comparison_greater));
194 void factor_vm::primitive_bignum_greater() {
196 ctx->replace(tag_boolean(bignum_compare(x, y) == bignum_comparison_greater));
199 void factor_vm::primitive_bignum_greatereq() {
201 ctx->replace(tag_boolean(bignum_compare(x, y) != bignum_comparison_less));
204 void factor_vm::primitive_bignum_not() {
205 ctx->replace(tag<bignum>(bignum_bitwise_not(untag<bignum>(ctx->peek()))));
208 void factor_vm::primitive_bignum_bitp() {
209 int bit = (int)to_fixnum(ctx->pop());
210 bignum* x = untag<bignum>(ctx->peek());
211 ctx->replace(tag_boolean(bignum_logbitp(bit, x)));
214 void factor_vm::primitive_bignum_log2() {
215 ctx->replace(tag<bignum>(bignum_integer_length(untag<bignum>(ctx->peek()))));
218 /* Allocates memory */
219 void factor_vm::primitive_fixnum_to_float() {
220 ctx->replace(allot_float(fixnum_to_float(ctx->peek())));
223 /* Allocates memory */
224 void factor_vm::primitive_format_float() {
225 byte_array* array = allot_byte_array(100);
226 char* format = alien_offset(ctx->pop());
227 double value = untag_float_check(ctx->peek());
228 SNPRINTF(array->data<char>(), 99, format, value);
229 ctx->replace(tag<byte_array>(array));
232 #define POP_FLOATS(x, y) \
233 double y = untag_float(ctx->pop()); \
234 double x = untag_float(ctx->peek());
236 void factor_vm::primitive_float_eq() {
238 ctx->replace(tag_boolean(x == y));
241 /* Allocates memory */
242 void factor_vm::primitive_float_add() {
244 ctx->replace(allot_float(x + y));
247 /* Allocates memory */
248 void factor_vm::primitive_float_subtract() {
250 ctx->replace(allot_float(x - y));
253 /* Allocates memory */
254 void factor_vm::primitive_float_multiply() {
256 ctx->replace(allot_float(x * y));
259 /* Allocates memory */
260 void factor_vm::primitive_float_divfloat() {
262 ctx->replace(allot_float(x / y));
265 void factor_vm::primitive_float_less() {
267 ctx->replace(tag_boolean(x < y));
270 void factor_vm::primitive_float_lesseq() {
272 ctx->replace(tag_boolean(x <= y));
275 void factor_vm::primitive_float_greater() {
277 ctx->replace(tag_boolean(x > y));
280 void factor_vm::primitive_float_greatereq() {
282 ctx->replace(tag_boolean(x >= y));
285 /* Allocates memory */
286 void factor_vm::primitive_float_bits() {
288 from_unsigned_cell(float_bits((float)untag_float_check(ctx->peek()))));
291 /* Allocates memory */
292 void factor_vm::primitive_bits_float() {
293 ctx->replace(allot_float(bits_float((uint32_t)to_cell(ctx->peek()))));
296 void factor_vm::primitive_double_bits() {
297 ctx->replace(from_unsigned_8(double_bits(untag_float_check(ctx->peek()))));
300 /* Allocates memory */
301 void factor_vm::primitive_bits_double() {
302 ctx->replace(allot_float(bits_double(to_unsigned_8(ctx->peek()))));
305 /* Cannot allocate. */
306 #define CELL_TO_FOO(name, type, converter) \
307 type factor_vm::name(cell tagged) { \
308 switch (TAG(tagged)) { \
310 return (type)untag_fixnum(tagged); \
312 return converter(untag<bignum>(tagged)); \
314 type_error(FIXNUM_TYPE, tagged); \
315 return 0; /* can't happen */ \
318 VM_C_API type name(cell tagged, factor_vm* parent) { \
319 return parent->name(tagged); \
322 CELL_TO_FOO(to_fixnum, fixnum, bignum_to_fixnum)
323 CELL_TO_FOO(to_fixnum_strict, fixnum, bignum_to_fixnum_strict)
324 CELL_TO_FOO(to_cell, cell, bignum_to_cell)
325 CELL_TO_FOO(to_signed_8, int64_t, bignum_to_long_long)
326 CELL_TO_FOO(to_unsigned_8, uint64_t, bignum_to_ulong_long)
328 /* Allocates memory */
329 VM_C_API cell from_signed_cell(fixnum integer, factor_vm* parent) {
330 return parent->from_signed_cell(integer);
333 /* Allocates memory */
334 VM_C_API cell from_unsigned_cell(cell integer, factor_vm* parent) {
335 return parent->from_unsigned_cell(integer);
338 /* Allocates memory */
339 cell factor_vm::from_signed_8(int64_t n) {
340 if (n < fixnum_min || n > fixnum_max)
341 return tag<bignum>(long_long_to_bignum(n));
343 return tag_fixnum((fixnum)n);
346 VM_C_API cell from_signed_8(int64_t n, factor_vm* parent) {
347 return parent->from_signed_8(n);
350 /* Allocates memory */
351 cell factor_vm::from_unsigned_8(uint64_t n) {
352 if (n > (uint64_t)fixnum_max)
353 return tag<bignum>(ulong_long_to_bignum(n));
355 return tag_fixnum((fixnum)n);
358 VM_C_API cell from_unsigned_8(uint64_t n, factor_vm* parent) {
359 return parent->from_unsigned_8(n);
362 /* Cannot allocate */
363 float factor_vm::to_float(cell value) {
364 return (float)untag_float_check(value);
367 /* Cannot allocate */
368 double factor_vm::to_double(cell value) { return untag_float_check(value); }
370 /* The fixnum+, fixnum- and fixnum* primitives are defined in cpu_*.S. On
371 overflow, they call these functions. */
372 /* Allocates memory */
373 inline void factor_vm::overflow_fixnum_add(fixnum x, fixnum y) {
375 tag<bignum>(fixnum_to_bignum(untag_fixnum(x) + untag_fixnum(y))));
378 VM_C_API void overflow_fixnum_add(fixnum x, fixnum y, factor_vm* parent) {
379 parent->overflow_fixnum_add(x, y);
382 /* Allocates memory */
383 inline void factor_vm::overflow_fixnum_subtract(fixnum x, fixnum y) {
385 tag<bignum>(fixnum_to_bignum(untag_fixnum(x) - untag_fixnum(y))));
388 VM_C_API void overflow_fixnum_subtract(fixnum x, fixnum y, factor_vm* parent) {
389 parent->overflow_fixnum_subtract(x, y);
392 /* Allocates memory */
393 inline void factor_vm::overflow_fixnum_multiply(fixnum x, fixnum y) {
394 data_root<bignum> bx(fixnum_to_bignum(x), this);
395 data_root<bignum> by(fixnum_to_bignum(y), this);
396 cell ret = tag<bignum>(bignum_multiply(bx.untagged(), by.untagged()));
400 VM_C_API void overflow_fixnum_multiply(fixnum x, fixnum y, factor_vm* parent) {
401 parent->overflow_fixnum_multiply(x, y);