int is_error_in_args(int argc, char **argv)
{
int i;
i = 1;
if (argc < 2)
return (-1);
while (i < argc)
{
if (is_options(argv[i]))
{
if ((is_numbers(argv[i + 1])) == -1 && my_strcmp(argv[i], "-d") != 0)
return (-1);
i += 2;
}
else
{
if (is_file_dot_cor(argv[i]) == -1)
return (-1);
i += 1;
}
}
if (is_one_file_cor(argc, argv) == -1)
return (-1);
return (0);
}
static Lisp_Object Lrealpart(Lisp_Object nil, Lisp_Object a)
{
CSL_IGNORE(nil);
if (!is_number(a)) return aerror1("realpart", a);
if (is_numbers(a) && is_complex(a))
return onevalue(real_part(a));
else return onevalue(a);
}
static Lisp_Object Lnumerator(Lisp_Object nil, Lisp_Object a)
{
CSL_IGNORE(nil);
if (!is_number(a)) return aerror1("numerator", a);
if (is_numbers(a) && is_ratio(a))
return onevalue(numerator(a));
else return onevalue(a);
}
static Lisp_Object Ldenominator(Lisp_Object nil, Lisp_Object a)
{
CSL_IGNORE(nil);
if (!is_number(a)) return aerror1("denominator", a);
if (is_numbers(a) && is_ratio(a))
return onevalue(denominator(a));
else return onevalue(fixnum_of_int(1));
}
static Lisp_Object Limagpart(Lisp_Object nil, Lisp_Object a)
{
CSL_IGNORE(nil);
if (!is_number(a)) return aerror1("imagpart", a);
if (is_numbers(a) && is_complex(a))
return onevalue(imag_part(a));
/* /* the 0.0 returned here ought to be the same type as a has */
else return onevalue(fixnum_of_int(0));
}
void validate_number(char *s, Lisp_Object a, Lisp_Object b, Lisp_Object c)
{
int32_t la, w, msd;
if (!is_numbers(a)) return;
la = (length_of_header(numhdr(a))-CELL-4)/4;
if (la < 0)
{ trace_printf("%s: number with no digits (%.8x)\n", s, numhdr(a));
if (is_number(b)) prin_to_trace(b), trace_printf("\n");
if (is_number(c)) prin_to_trace(c), trace_printf("\n");
my_exit(EXIT_FAILURE);
}
if (la == 0)
{ msd = bignum_digits(a)[0];
w = msd & fix_mask;
if (w == 0 || w == fix_mask)
{ trace_printf("%s: %.8x should be fixnum\n", s, msd);
if (is_number(b)) prin_to_trace(b), trace_printf("\n");
if (is_number(c)) prin_to_trace(c), trace_printf("\n");
my_exit(EXIT_FAILURE);
}
if (signed_overflow(msd))
{ trace_printf("%s: %.8x should be two-word\n", s, msd);
if (is_number(b)) prin_to_trace(b), trace_printf("\n");
if (is_number(c)) prin_to_trace(c), trace_printf("\n");
my_exit(EXIT_FAILURE);
}
return;
}
msd = bignum_digits(a)[la];
if (signed_overflow(msd))
{ trace_printf("%s: %.8x should be longer\n", s, msd);
if (is_number(b)) prin_to_trace(b), trace_printf("\n");
if (is_number(c)) prin_to_trace(c), trace_printf("\n");
my_exit(EXIT_FAILURE);
}
if (msd == 0 && ((msd = bignum_digits(a)[la-1]) & 0x40000000) == 0)
{ trace_printf("%s: 0: %.8x should be shorter\n", s, msd);
if (is_number(b)) prin_to_trace(b), trace_printf("\n");
if (is_number(c)) prin_to_trace(c), trace_printf("\n");
my_exit(EXIT_FAILURE);
}
if (msd == -1 && ((msd = bignum_digits(a)[la-1]) & 0x40000000) != 0)
{ trace_printf("%s: -1: %.8x should be shorter\n", s, msd);
if (is_number(b)) prin_to_trace(b), trace_printf("\n");
if (is_number(c)) prin_to_trace(c), trace_printf("\n");
my_exit(EXIT_FAILURE);
}
}
static Lisp_Object Lconjugate(Lisp_Object nil, Lisp_Object a)
{
if (!is_number(a)) return aerror1("conjugate", a);
if (is_numbers(a) && is_complex(a))
{ Lisp_Object r = real_part(a),
i = imag_part(a);
push(r);
i = negate(i);
pop(r);
errexit();
a = make_complex(r, i);
errexit();
return onevalue(a);
}
else return onevalue(a);
}
static CSLbool numeqsr(Lisp_Object a, Lisp_Object b)
/*
* Here I will rely somewhat on the use of IEEE floating point values
* (an in particular the weaker supposition that I have floating point
* with a binary radix). Then for equality the denominator of b must
* be a power of 2, which I can test for and then account for.
*/
{
Lisp_Object nb = numerator(b), db = denominator(b);
double d = float_of_number(a), d1;
int x;
int32_t dx, w, len;
uint32_t u, bit;
/*
* first I will check that db (which will be positive) is a power of 2,
* and set dx to indicate what power of two it is.
* Note that db != 0 and that one of the top two words of a bignum
* must be nonzero (for normalisation) so I end up with a nonzero
* value in the variable 'bit'
*/
if (is_fixnum(db))
{ bit = int_of_fixnum(db);
w = bit;
if (w != (w & (-w))) return NO; /* not a power of 2 */
dx = 0;
}
else if (is_numbers(db) && is_bignum(db))
{ int32_t lenb = (bignum_length(db)-CELL-4)/4;
bit = bignum_digits(db)[lenb];
/*
* I need to cope with bignums where the leading digits is zero because
* the 0x80000000 bit of the next word down is 1. To do this I treat
* the number as having one fewer digits.
*/
if (bit == 0) bit = bignum_digits(db)[--lenb];
w = bit;
if (w != (w & (-w))) return NO; /* not a power of 2 */
dx = 31*lenb;
while (--lenb >= 0) /* check that the rest of db is zero */
if (bignum_digits(db)[lenb] != 0) return NO;
}
else return NO; /* Odd - what type IS db here? Maybe error. */
if ((bit & 0xffffU) == 0) dx += 16, bit = bit >> 16;
if ((bit & 0xff) == 0) dx += 8, bit = bit >> 8;
if ((bit & 0xf) == 0) dx += 4, bit = bit >> 4;
if ((bit & 0x3) == 0) dx += 2, bit = bit >> 2;
if ((bit & 0x1) == 0) dx += 1;
if (is_fixnum(nb))
{ double d1 = (double)int_of_fixnum(nb);
/*
* The ldexp on the next line could potentially underflow. In that case C
* defines that the result 0.0 be returned. To avoid trouble I put in a
* special test the relies on that fact that a value represented as a rational
* would not have been zero.
*/
if (dx > 10000) return NO; /* Avoid gross underflow */
d1 = ldexp(d1, (int)-dx);
return (d == d1 && d != 0.0);
}
len = (bignum_length(nb)-CELL-4)/4;
if (len == 0) /* One word bignums can be treated specially */
{ int32_t v = bignum_digits(nb)[0];
double d1;
if (dx > 10000) return NO; /* Avoid gross underflow */
d1 = ldexp((double)v, (int)-dx);
return (d == d1 && d != 0.0);
}
d1 = frexp(d, &x); /* separate exponent from mantissa */
if (d1 == 1.0) d1 = 0.5, x++; /* For Zortech */
dx += x; /* adjust to allow for the denominator */
d1 = ldexp(d1, (int)(dx % 31));
/* can neither underflow nor overflow here */
/*
* At most 3 words in the bignum may contain nonzero data - I subtract
* the (double) value of those bits off and check that (a) the floating
* result left is zero and (b) there are no more bits left.
*/
dx = dx / 31;
if (dx != len) return NO;
w = bignum_digits(nb)[len];
d1 = (d1 - (double)w) * TWO_31;
u = bignum_digits(nb)[--len];
d1 = (d1 - (double)u) * TWO_31;
if (len > 0)
{ u = bignum_digits(nb)[--len];
d1 = d1 - (double)u;
}
if (d1 != 0.0) return NO;
while (--len >= 0)
if (bignum_digits(nb)[len] != 0) return NO;
return YES;
}
