From c5ec810687e0ef35a4809c0af0487775d97b003a Mon Sep 17 00:00:00 2001 From: jjgarcia Date: Tue, 9 Dec 2003 09:34:33 +0000 Subject: [PATCH] Division by integer 0 signal a DIVIDE-BY-ZERO error. (- (- MOST-NEGATIVE-FIXNUM)) now works. Fixed CEILING and FLOOR with arguments MOST-NEGATIVE-FIXNUM (- MOST-NEGATIVE-FIXNUM). (EXPT x y) now returns 1 coerced to the right type when (ZEROP y)=>T. --- src/c/error.d | 6 ++++++ src/c/num_arith.d | 17 ++++++++++++++--- src/c/num_co.d | 38 ++++++++++++++++++++++++-------------- src/c/num_sfun.d | 15 ++++++++------- src/c/number.d | 9 ++++----- src/c/symbols_list.h | 2 ++ src/h/external.h | 1 + src/h/object.h | 2 ++ 8 files changed, 61 insertions(+), 29 deletions(-) diff --git a/src/c/error.d b/src/c/error.d index 6d3658404..3b3ab471f 100644 --- a/src/c/error.d +++ b/src/c/error.d @@ -228,6 +228,12 @@ FEtype_error_symbol(cl_object obj) FEwrong_type_argument(@'symbol', obj); } +void +FEdivision_by_zero(void) +{ + cl_error(3, @'division-by-zero', @':operation', @'/'); +} + /************************************* * Errors generated by the C library * *************************************/ diff --git a/src/c/num_arith.d b/src/c/num_arith.d index fccc4f75e..a3b841563 100644 --- a/src/c/num_arith.d +++ b/src/c/num_arith.d @@ -519,7 +519,7 @@ cl_conjugate(cl_object c) cl_object number_negate(cl_object x) { - cl_object z, z1; + cl_object z, z1; switch (type_of(x)) { case t_fixnum: { @@ -536,7 +536,7 @@ number_negate(cl_object x) case t_bignum: z = big_register0_get(); mpz_neg(z->big.big_num, x->big.big_num); - return(big_register_copy(z)); + return big_register_normalize(z); case t_ratio: z1 = number_negate(x->ratio.num); @@ -589,6 +589,8 @@ number_divide(cl_object x, cl_object y) case t_bignum: switch (type_of(y)) { case t_fixnum: + if (y == MAKE_FIXNUM(0)) + FEdivision_by_zero(); case t_bignum: if (number_minusp(y) == TRUE) { x = number_negate(x); @@ -612,6 +614,8 @@ number_divide(cl_object x, cl_object y) case t_ratio: switch (type_of(y)) { case t_fixnum: + if (y == MAKE_FIXNUM(0)) + FEdivision_by_zero(); case t_bignum: z = number_times(x->ratio.den, y); z = make_ratio(x->ratio.num, z); @@ -633,6 +637,8 @@ number_divide(cl_object x, cl_object y) case t_shortfloat: switch (type_of(y)) { case t_fixnum: + if (y == MAKE_FIXNUM(0)) + FEdivision_by_zero(); return make_shortfloat(sf(x) / fix(y)); case t_bignum: case t_ratio: @@ -649,6 +655,8 @@ number_divide(cl_object x, cl_object y) case t_longfloat: switch (type_of(y)) { case t_fixnum: + if (y == MAKE_FIXNUM(0)) + FEdivision_by_zero(); return make_longfloat(lf(x) / fix(y)); case t_bignum: case t_ratio: @@ -696,8 +704,11 @@ integer_divide(cl_object x, cl_object y) tx = type_of(x); ty = type_of(y); if (tx == t_fixnum) { - if (ty == t_fixnum) + if (ty == t_fixnum) { + if (y == MAKE_FIXNUM(0)) + FEdivision_by_zero(); return MAKE_FIXNUM(fix(x) / fix(y)); + } if (ty == t_bignum) { /* The only number "x" which can be a bignum and be * as large as "-x" is -MOST_NEGATIVE_FIXNUM. However diff --git a/src/c/num_co.d b/src/c/num_co.d index 6384ae45e..bb84b21ee 100644 --- a/src/c/num_co.d +++ b/src/c/num_co.d @@ -206,13 +206,18 @@ floor2(cl_object x, cl_object y) break; } case t_bignum: { /* FIX / BIG */ - if (number_plusp(x) != number_plusp(y)) { - VALUES(0) = MAKE_FIXNUM(-1); - VALUES(1) = number_plus(y, x); - } else { - VALUES(0) = MAKE_FIXNUM(0); - VALUES(1) = x; - } + /* We must perform the division because there is the + * pathological case + * x = MOST_NEGATIVE_FIXNUM + * y = - MOST_NEGATIVE_FIXNUM + */ + cl_object q = big_register0_get(); + cl_object r = big_register1_get(); + cl_object j = big_register2_get(); + mpz_set_si(j->big.big_num, fix(x)); + mpz_fdiv_qr(q->big.big_num, r->big.big_num, y->big.big_num, j->big.big_num); + VALUES(0) = big_register_normalize(q); + VALUES(1) = big_register_normalize(r); break; } case t_ratio: /* FIX / RAT */ @@ -380,13 +385,18 @@ ceiling2(cl_object x, cl_object y) break; } case t_bignum: { /* FIX / BIG */ - if (number_plusp(x) != number_plusp(y)) { - VALUES(0) = MAKE_FIXNUM(0); - VALUES(1) = x; - } else { - VALUES(0) = MAKE_FIXNUM(1); - VALUES(1) = number_minus(x, y); - } + /* We must perform the division because there is the + * pathological case + * x = MOST_NEGATIVE_FIXNUM + * y = - MOST_NEGATIVE_FIXNUM + */ + cl_object q = big_register0_get(); + cl_object r = big_register1_get(); + cl_object j = big_register2_get(); + mpz_set_si(j->big.big_num, fix(x)); + mpz_cdiv_qr(q->big.big_num, r->big.big_num, y->big.big_num, j->big.big_num); + VALUES(0) = big_register_normalize(q); + VALUES(1) = big_register_normalize(r); break; } case t_ratio: /* FIX / RAT */ diff --git a/src/c/num_sfun.d b/src/c/num_sfun.d index 3c5275eab..2003a51ac 100644 --- a/src/c/num_sfun.d +++ b/src/c/num_sfun.d @@ -93,21 +93,22 @@ cl_expt(cl_object x, cl_object y) cl_object z; if (number_zerop(y)) { - switch (type_of(y)) { - case t_fixnum: case t_bignum: case t_ratio: + /* INV: The most specific numeric types come first. */ + cl_type tx = type_of(x); + ty = type_of(y); + switch ((ty > tx)? ty : tx) { + case t_fixnum: + case t_bignum: + case t_ratio: return1(MAKE_FIXNUM(1)); - case t_shortfloat: return1(make_shortfloat(1.0)); - case t_longfloat: return1(make_longfloat(1.0)); - case t_complex: - z = cl_expt(x->complex.real, y); + z = cl_float(2, MAKE_FIXNUM(1), x->complex.real); z = make_complex(z, MAKE_FIXNUM(0)); return1(z); - default: FEtype_error_number(x); } diff --git a/src/c/number.d b/src/c/number.d index 88f732dc6..4cbeece9c 100644 --- a/src/c/number.d +++ b/src/c/number.d @@ -86,11 +86,10 @@ make_ratio(cl_object num, cl_object den) { cl_object g, r; - if (number_zerop(den)) - FEerror("Zero denominator.", 0); - if (number_zerop(num)) - return(MAKE_FIXNUM(0)); - if (den == MAKE_FIXNUM(1)) + /* INV: the arguments NUM & DEN are integers */ + if (den == MAKE_FIXNUM(0)) + FEdivision_by_zero(); + if (num == MAKE_FIXNUM(0) || den == MAKE_FIXNUM(1)) return(num); if (number_minusp(den)) { num = number_negate(num); diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h index 5e370b4d4..2d937f8b2 100644 --- a/src/c/symbols_list.h +++ b/src/c/symbols_list.h @@ -1378,6 +1378,8 @@ cl_symbols[] = { {SYS_ "STEPPER", SI_ORDINARY, OBJNULL, -1, OBJNULL}, {SYS_ "COERCE-TO-FILENAME", SI_ORDINARY, si_coerce_to_filename, 1, OBJNULL}, +{KEY_ "OPERATION", KEYWORD, NULL, -1, OBJNULL}, + /* Tag for end of list */ {NULL, CL_ORDINARY, NULL, -1, OBJNULL}}; diff --git a/src/h/external.h b/src/h/external.h index 2c15fc30a..01ec0d272 100644 --- a/src/h/external.h +++ b/src/h/external.h @@ -1396,6 +1396,7 @@ extern void FEtype_error_stream(cl_object x) __attribute__((noreturn)); extern void FEcircular_list(cl_object x) __attribute__((noreturn)); extern void FEtype_error_index(cl_object seq, cl_object ndx) __attribute__((noreturn)); extern void FEtype_error_string(cl_object x) __attribute__((noreturn)); +extern void FEdivision_by_zero(void) __attribute__((noreturn)); /* unixfsys.c */ diff --git a/src/h/object.h b/src/h/object.h index b4d11d3c3..acb11424b 100644 --- a/src/h/object.h +++ b/src/h/object.h @@ -485,6 +485,8 @@ union cl_lispunion { typedef enum { t_cons = 0, t_start = 0, + /* The most specific numeric types come first. Assumed by + some routines, like cl_expt */ t_fixnum, /* 1 immediate fixnum */ t_character, /* 2 immediate character */ t_bignum = 4, /* 4 */