From 729baa89351abdf774ef441b0c59f079498f4a5c Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Thu, 4 Nov 2010 23:40:11 +0100 Subject: [PATCH] Split +,-,*,/ into separate files with a slightly more compact dispatch --- msvc/c/Makefile | 4 + src/c/Makefile.in | 1 + src/c/num_arith.d | 665 ------------------------------------ src/c/numbers/divide.d | 174 ++++++++++ src/c/numbers/minus.d | 337 ++++++++++++++++++ src/c/numbers/plus.d | 333 ++++++++++++++++++ src/c/numbers/times.d | 187 ++++++++++ src/h/impl/math_dispatch2.h | 139 ++++++++ 8 files changed, 1175 insertions(+), 665 deletions(-) create mode 100644 src/c/numbers/divide.d create mode 100644 src/c/numbers/minus.d create mode 100644 src/c/numbers/plus.d create mode 100644 src/c/numbers/times.d create mode 100644 src/h/impl/math_dispatch2.h diff --git a/msvc/c/Makefile b/msvc/c/Makefile index 2d3d7c37e..9bf43bb12 100755 --- a/msvc/c/Makefile +++ b/msvc/c/Makefile @@ -80,6 +80,10 @@ OBJS = main.obj symbol.obj package.obj list.obj\ numbers/cosh.o numbers/sinh.o numbers/tanh.o \ numbers/exp.o numbers/expt.o numbers/log.o \ numbers/sqrt.o numbers/abs.o \ + numbers/zerop.o numbers/plusp.o numbers/minusp.o \ + numbers/negate.o numbers/conjugate.o \ + numbers/one_plus.o numbers/one_minus.o \ + numbers/plus.o numbers/minus.o numbers/times.o numbers/divide.o \ predicate.obj big.obj number.obj\ num_pred.obj num_comp.obj num_arith.obj num_sfun.obj num_co.obj\ num_log.obj num_rand.obj array.obj sequence.obj cmpaux.obj\ diff --git a/src/c/Makefile.in b/src/c/Makefile.in index f5c2dd0ed..041b614b9 100644 --- a/src/c/Makefile.in +++ b/src/c/Makefile.in @@ -56,6 +56,7 @@ OBJS = main.o symbol.o package.o list.o\ numbers/zerop.o numbers/plusp.o numbers/minusp.o \ numbers/negate.o numbers/conjugate.o \ numbers/one_plus.o numbers/one_minus.o \ + numbers/plus.o numbers/minus.o numbers/times.o numbers/divide.o \ typespec.o assignment.o \ predicate.o number.o\ num_pred.o num_comp.o num_arith.o num_co.o\ diff --git a/src/c/num_arith.d b/src/c/num_arith.d index fdd0e6f74..e93a0b266 100644 --- a/src/c/num_arith.d +++ b/src/c/num_arith.d @@ -18,671 +18,6 @@ #include #include -#pragma fenv_access on - -/* (* ) */ - -@(defun * (&rest nums) - cl_object prod = MAKE_FIXNUM(1); -@ - /* INV: type check in ecl_times() */ - while (narg--) - prod = ecl_times(prod, cl_va_arg(nums)); - @(return prod) -@) - -cl_object -ecl_times(cl_object x, cl_object y) -{ - cl_object z, z1; - - switch (type_of(x)) { - case t_fixnum: - switch (type_of(y)) { - case t_fixnum: - return _ecl_fix_times_fix(fix(x),fix(y)); - case t_bignum: - return _ecl_big_times_fix(y, fix(x)); - case t_ratio: - z = ecl_times(x, y->ratio.num); - return ecl_make_ratio(z, y->ratio.den); - case t_singlefloat: - return ecl_make_singlefloat(fix(x) * sf(y)); - case t_doublefloat: - return ecl_make_doublefloat(fix(x) * df(y)); -#ifdef ECL_LONG_FLOAT - case t_longfloat: - return ecl_make_longfloat(fix(x) * ecl_long_float(y)); -#endif - case t_complex: - goto COMPLEX; - default: - FEwrong_type_nth_arg(@[*], 2, y, @[number]); - } - case t_bignum: - switch (type_of(y)) { - case t_fixnum: - return _ecl_big_times_fix(x, fix(y)); - case t_bignum: - return _ecl_big_times_big(x, y); - case t_ratio: - z = ecl_times(x, y->ratio.num); - return ecl_make_ratio(z, y->ratio.den); - case t_singlefloat: - return ecl_make_singlefloat(ecl_to_double(x) * sf(y)); - case t_doublefloat: - return ecl_make_doublefloat(ecl_to_double(x) * df(y)); -#ifdef ECL_LONG_FLOAT - case t_longfloat: - return ecl_make_longfloat(ecl_to_double(x) * ecl_long_float(y)); -#endif - case t_complex: - goto COMPLEX; - default: - FEwrong_type_nth_arg(@[*], 2, y, @[number]); - } - case t_ratio: - switch (type_of(y)) { - case t_fixnum: - case t_bignum: - z = ecl_times(x->ratio.num, y); - return ecl_make_ratio(z, x->ratio.den); - case t_ratio: - z = ecl_times(x->ratio.num,y->ratio.num); - z1 = ecl_times(x->ratio.den,y->ratio.den); - return ecl_make_ratio(z, z1); - case t_singlefloat: - return ecl_make_singlefloat(ecl_to_double(x) * sf(y)); - case t_doublefloat: - return ecl_make_doublefloat(ecl_to_double(x) * df(y)); -#ifdef ECL_LONG_FLOAT - case t_longfloat: - return ecl_make_longfloat(ecl_to_double(x) * ecl_long_float(y)); -#endif - case t_complex: - goto COMPLEX; - default: - FEwrong_type_nth_arg(@[*], 2, y, @[number]); - } - case t_singlefloat: { - float fx = sf(x); - switch (type_of(y)) { - case t_fixnum: - return ecl_make_singlefloat(fx * fix(y)); - case t_bignum: - case t_ratio: - return ecl_make_singlefloat(fx * ecl_to_double(y)); - case t_singlefloat: - return ecl_make_singlefloat(fx * sf(y)); - case t_doublefloat: - return ecl_make_doublefloat(fx * df(y)); -#ifdef ECL_LONG_FLOAT - case t_longfloat: - return ecl_make_longfloat(fx * ecl_long_float(y)); -#endif - case t_complex: - goto COMPLEX; - default: - FEwrong_type_nth_arg(@[*], 2, y, @[number]); - } - } - case t_doublefloat: { - switch (type_of(y)) { - case t_fixnum: - return ecl_make_doublefloat(df(x) * fix(y)); - case t_bignum: - case t_ratio: - return ecl_make_doublefloat(df(x) * ecl_to_double(y)); - case t_singlefloat: - return ecl_make_doublefloat(df(x) * sf(y)); - case t_doublefloat: - return ecl_make_doublefloat(df(x) * df(y)); -#ifdef ECL_LONG_FLOAT - case t_longfloat: - return ecl_make_longfloat(df(x) * ecl_long_float(y)); -#endif - case t_complex: { - COMPLEX: /* INV: x is real, y is complex */ - return ecl_make_complex(ecl_times(x, y->complex.real), - ecl_times(x, y->complex.imag)); - } - default: - FEwrong_type_nth_arg(@[*], 2, y, @[number]); - } - } -#ifdef ECL_LONG_FLOAT - case t_longfloat: { - long double lx = ecl_long_float(x); - switch (type_of(y)) { - case t_fixnum: - return ecl_make_longfloat(lx * fix(y)); - case t_bignum: - case t_ratio: - return ecl_make_longfloat(lx * ecl_to_double(y)); - case t_singlefloat: - return ecl_make_longfloat(lx * sf(y)); - case t_doublefloat: - return ecl_make_longfloat(lx * df(y)); - case t_longfloat: - return ecl_make_longfloat(lx * ecl_long_float(y)); - case t_complex: - goto COMPLEX; - default: - FEwrong_type_nth_arg(@[*], 2, y, @[number]); - } - } -#endif - case t_complex: - { - cl_object z11, z12, z21, z22; - - if (type_of(y) != t_complex) { - cl_object aux = x; - x = y; y = aux; - goto COMPLEX; - } - z11 = ecl_times(x->complex.real, y->complex.real); - z12 = ecl_times(x->complex.imag, y->complex.imag); - z21 = ecl_times(x->complex.imag, y->complex.real); - z22 = ecl_times(x->complex.real, y->complex.imag); - return ecl_make_complex(ecl_minus(z11, z12), ecl_plus(z21, z22)); - } - default: - FEwrong_type_nth_arg(@[*], 1, x, @[number]); - } -} - - /* (+ ) */ -@(defun + (&rest nums) - cl_object sum = MAKE_FIXNUM(0); -@ - /* INV: type check is in ecl_plus() */ - while (narg--) - sum = ecl_plus(sum, cl_va_arg(nums)); - @(return sum) -@) - -cl_object -ecl_plus(cl_object x, cl_object y) -{ - cl_fixnum i, j; - cl_object z, z1; - - switch (type_of(x)) { - case t_fixnum: - switch (type_of(y)) { - case t_fixnum: - return ecl_make_integer(fix(x) + fix(y)); - case t_bignum: - return _ecl_big_plus_fix(y, fix(x)); - case t_ratio: - z = ecl_times(x, y->ratio.den); - z = ecl_plus(z, y->ratio.num); - return ecl_make_ratio(z, y->ratio.den); - case t_singlefloat: - return ecl_make_singlefloat(fix(x) + sf(y)); - case t_doublefloat: - return ecl_make_doublefloat(fix(x) + df(y)); -#ifdef ECL_LONG_FLOAT - case t_longfloat: - return ecl_make_longfloat(fix(x) + ecl_long_float(y)); -#endif - case t_complex: - COMPLEX: /* INV: x is real, y is complex */ - return ecl_make_complex(ecl_plus(x, y->complex.real), - y->complex.imag); - default: - FEwrong_type_nth_arg(@[+], 2, y, @[number]); - } - case t_bignum: - switch (type_of(y)) { - case t_fixnum: - return _ecl_big_plus_fix(x, fix(y)); - case t_bignum: - return _ecl_big_plus_big(x, y); - case t_ratio: - z = ecl_times(x, y->ratio.den); - z = ecl_plus(z, y->ratio.num); - return ecl_make_ratio(z, y->ratio.den); - case t_singlefloat: - return ecl_make_singlefloat(ecl_to_double(x) + sf(y)); - case t_doublefloat: - return ecl_make_doublefloat(ecl_to_double(x) + df(y)); -#ifdef ECL_LONG_FLOAT - case t_longfloat: - return ecl_make_longfloat(ecl_to_double(x) + ecl_long_float(y)); -#endif - case t_complex: - goto COMPLEX; - default: - FEwrong_type_nth_arg(@[+], 2, y, @[number]); - } - case t_ratio: - switch (type_of(y)) { - case t_fixnum: - case t_bignum: - z = ecl_times(x->ratio.den, y); - z = ecl_plus(x->ratio.num, z); - return ecl_make_ratio(z, x->ratio.den); - case t_ratio: - z1 = ecl_times(x->ratio.num,y->ratio.den); - z = ecl_times(x->ratio.den,y->ratio.num); - z = ecl_plus(z1, z); - z1 = ecl_times(x->ratio.den,y->ratio.den); - return ecl_make_ratio(z, z1); - case t_singlefloat: - return ecl_make_singlefloat(ecl_to_double(x) + sf(y)); - case t_doublefloat: - return ecl_make_doublefloat(ecl_to_double(x) + df(y)); -#ifdef ECL_LONG_FLOAT - case t_longfloat: - return ecl_make_longfloat(ecl_to_double(x) + ecl_long_float(y)); -#endif - case t_complex: - goto COMPLEX; - default: - FEwrong_type_nth_arg(@[+], 2, y, @[number]); - } - case t_singlefloat: - switch (type_of(y)) { - case t_fixnum: - return ecl_make_singlefloat(sf(x) + fix(y)); - case t_bignum: - case t_ratio: - return ecl_make_singlefloat(sf(x) + ecl_to_double(y)); - case t_singlefloat: - return ecl_make_singlefloat(sf(x) + sf(y)); - case t_doublefloat: - return ecl_make_doublefloat(sf(x) + df(y)); -#ifdef ECL_LONG_FLOAT - case t_longfloat: - return ecl_make_longfloat(sf(x) + ecl_long_float(y)); -#endif - case t_complex: - goto COMPLEX; - default: - FEwrong_type_nth_arg(@[+], 2, y, @[number]); - } - case t_doublefloat: - switch (type_of(y)) { - case t_fixnum: - return ecl_make_doublefloat(df(x) + fix(y)); - case t_bignum: - case t_ratio: - return ecl_make_doublefloat(df(x) + ecl_to_double(y)); - case t_singlefloat: - return ecl_make_doublefloat(df(x) + sf(y)); - case t_doublefloat: - return ecl_make_doublefloat(df(x) + df(y)); -#ifdef ECL_LONG_FLOAT - case t_longfloat: - return ecl_make_longfloat(df(x) + ecl_long_float(y)); -#endif - case t_complex: - goto COMPLEX; - default: - FEwrong_type_nth_arg(@[+], 2, y, @[number]); - } -#ifdef ECL_LONG_FLOAT - case t_longfloat: - switch (type_of(y)) { - case t_fixnum: - return ecl_make_longfloat(ecl_long_float(x) + fix(y)); - case t_bignum: - case t_ratio: - return ecl_make_longfloat(ecl_long_float(x) + ecl_to_double(y)); - case t_singlefloat: - return ecl_make_longfloat(ecl_long_float(x) + sf(y)); - case t_doublefloat: - return ecl_make_longfloat(ecl_long_float(x) + df(y)); - case t_longfloat: - return ecl_make_longfloat(ecl_long_float(x) + ecl_long_float(y)); - case t_complex: - goto COMPLEX; - default: - FEwrong_type_nth_arg(@[+], 2, y, @[number]); - } -#endif - case t_complex: - if (type_of(y) != t_complex) { - cl_object aux = x; - x = y; y = aux; - goto COMPLEX; - } - z = ecl_plus(x->complex.real, y->complex.real); - z1 = ecl_plus(x->complex.imag, y->complex.imag); - return ecl_make_complex(z, z1); - default: - FEwrong_type_nth_arg(@[+], 1, x, @[number]); - } -} - -/* (- ) */ -@(defun - (num &rest nums) - cl_object diff; -@ - /* INV: argument type check in number_{negate,minus}() */ - if (narg == 1) - @(return ecl_negate(num)) - for (diff = num; --narg; ) - diff = ecl_minus(diff, cl_va_arg(nums)); - @(return diff) -@) - -cl_object -ecl_minus(cl_object x, cl_object y) -{ - cl_fixnum i, j, k; - cl_object z, z1; - - switch (type_of(x)) { - case t_fixnum: - switch(type_of(y)) { - case t_fixnum: - return ecl_make_integer(fix(x) - fix(y)); - case t_bignum: - return _ecl_fix_minus_big(fix(x), y); - case t_ratio: - z = ecl_times(x, y->ratio.den); - z = ecl_minus(z, y->ratio.num); - return ecl_make_ratio(z, y->ratio.den); - case t_singlefloat: - return ecl_make_singlefloat(fix(x) - sf(y)); - case t_doublefloat: - return ecl_make_doublefloat(fix(x) - df(y)); -#ifdef ECL_LONG_FLOAT - case t_longfloat: - return ecl_make_longfloat(fix(x) - ecl_long_float(y)); -#endif - case t_complex: - goto COMPLEX; - default: - FEwrong_type_nth_arg(@[-], 2, y, @[number]); - } - case t_bignum: - switch (type_of(y)) { - case t_fixnum: - return _ecl_big_plus_fix(x, -fix(y)); - case t_bignum: - return _ecl_big_minus_big(x, y); - case t_ratio: - z = ecl_times(x, y->ratio.den); - z = ecl_minus(z, y->ratio.num); - return ecl_make_ratio(z, y->ratio.den); - case t_singlefloat: - return ecl_make_singlefloat(ecl_to_double(x) - sf(y)); - case t_doublefloat: - return ecl_make_doublefloat(ecl_to_double(x) - df(y)); -#ifdef ECL_LONG_FLOAT - case t_longfloat: - return ecl_make_longfloat(ecl_to_double(x) - ecl_long_float(y)); -#endif - case t_complex: - goto COMPLEX; - default: - FEwrong_type_nth_arg(@[-], 2, y, @[number]); - } - case t_ratio: - switch (type_of(y)) { - case t_fixnum: - case t_bignum: - z = ecl_times(x->ratio.den, y); - z = ecl_minus(x->ratio.num, z); - return ecl_make_ratio(z, x->ratio.den); - case t_ratio: - z = ecl_times(x->ratio.num,y->ratio.den); - z1 = ecl_times(x->ratio.den,y->ratio.num); - z = ecl_minus(z, z1); - z1 = ecl_times(x->ratio.den,y->ratio.den); - return ecl_make_ratio(z, z1); - case t_singlefloat: - return ecl_make_singlefloat(ecl_to_double(x) - sf(y)); - case t_doublefloat: - return ecl_make_doublefloat(ecl_to_double(x) - df(y)); -#ifdef ECL_LONG_FLOAT - case t_longfloat: - return ecl_make_longfloat(ecl_to_double(x) - ecl_long_float(y)); -#endif - case t_complex: - goto COMPLEX; - default: - FEwrong_type_nth_arg(@[-], 2, y, @[number]); - } - case t_singlefloat: - switch (type_of(y)) { - case t_fixnum: - return ecl_make_singlefloat(sf(x) - fix(y)); - case t_bignum: - case t_ratio: - return ecl_make_singlefloat(sf(x) - ecl_to_double(y)); - case t_singlefloat: - return ecl_make_singlefloat(sf(x) - sf(y)); - case t_doublefloat: - return ecl_make_doublefloat(sf(x) - df(y)); -#ifdef ECL_LONG_FLOAT - case t_longfloat: - return ecl_make_longfloat(sf(x) - ecl_long_float(y)); -#endif - case t_complex: - goto COMPLEX; - default: - FEwrong_type_nth_arg(@[-], 2, y, @[number]); - } - case t_doublefloat: - switch (type_of(y)) { - case t_fixnum: - return ecl_make_doublefloat(df(x) - fix(y)); - case t_bignum: - case t_ratio: - return ecl_make_doublefloat(df(x) - ecl_to_double(y)); - case t_singlefloat: - return ecl_make_doublefloat(df(x) - sf(y)); - case t_doublefloat: - return ecl_make_doublefloat(df(x) - df(y)); -#ifdef ECL_LONG_FLOAT - case t_longfloat: - return ecl_make_longfloat(df(x) - ecl_long_float(y)); -#endif - case t_complex: - goto COMPLEX; - default: - FEwrong_type_nth_arg(@[-], 2, y, @[number]); - } -#ifdef ECL_LONG_FLOAT - case t_longfloat: - switch (type_of(y)) { - case t_fixnum: - return ecl_make_longfloat(ecl_long_float(x) - fix(y)); - case t_bignum: - case t_ratio: - return ecl_make_longfloat(ecl_long_float(x) - ecl_to_double(y)); - case t_singlefloat: - return ecl_make_longfloat(ecl_long_float(x) - sf(y)); - case t_doublefloat: - return ecl_make_longfloat(ecl_long_float(x) - df(y)); - case t_longfloat: - return ecl_make_longfloat(ecl_long_float(x) - ecl_long_float(y)); - case t_complex: - goto COMPLEX; - default: - FEwrong_type_nth_arg(@[-], 2, y, @[number]); - } -#endif - COMPLEX: - return ecl_make_complex(ecl_minus(x, y->complex.real), - ecl_negate(y->complex.imag)); - case t_complex: - if (type_of(y) != t_complex) { - z = ecl_minus(x->complex.real, y); - z1 = x->complex.imag; - } else { - z = ecl_minus(x->complex.real, y->complex.real); - z1 = ecl_minus(x->complex.imag, y->complex.imag); - } - return ecl_make_complex(z, z1); - default: - FEwrong_type_nth_arg(@[-], 1, x, @[number]); - } -} - -/* (/ ) */ -@(defun / (num &rest nums) -@ - /* INV: type check is in ecl_divide() */ - if (narg == 0) - FEwrong_num_arguments(@[/]); - if (narg == 1) - @(return ecl_divide(MAKE_FIXNUM(1), num)) - while (--narg) - num = ecl_divide(num, cl_va_arg(nums)); - @(return num) -@) - -cl_object -ecl_divide(cl_object x, cl_object y) -{ - cl_object z, z1, z2; - - switch (type_of(x)) { - case t_fixnum: - case t_bignum: - switch (type_of(y)) { - case t_fixnum: - if (y == MAKE_FIXNUM(0)) - FEdivision_by_zero(x, y); - case t_bignum: - if (ecl_minusp(y) == TRUE) { - x = ecl_negate(x); - y = ecl_negate(y); - } - return ecl_make_ratio(x, y); - case t_ratio: - z = ecl_times(x, y->ratio.den); - return ecl_make_ratio(z, y->ratio.num); - case t_singlefloat: - return ecl_make_singlefloat(ecl_to_double(x) / sf(y)); - case t_doublefloat: - return ecl_make_doublefloat(ecl_to_double(x) / df(y)); -#ifdef ECL_LONG_FLOAT - case t_longfloat: - return ecl_make_longfloat(ecl_to_double(x) / ecl_long_float(y)); -#endif - case t_complex: - goto COMPLEX; - default: - FEwrong_type_nth_arg(@[/], 2, y, @[number]); - } - case t_ratio: - switch (type_of(y)) { - case t_fixnum: - if (y == MAKE_FIXNUM(0)) - FEdivision_by_zero(x, y); - case t_bignum: - z = ecl_times(x->ratio.den, y); - return ecl_make_ratio(x->ratio.num, z); - case t_ratio: - z = ecl_times(x->ratio.num,y->ratio.den); - z1 = ecl_times(x->ratio.den,y->ratio.num); - return ecl_make_ratio(z, z1); - case t_singlefloat: - return ecl_make_singlefloat(ecl_to_double(x) / sf(y)); - case t_doublefloat: - return ecl_make_doublefloat(ecl_to_double(x) / df(y)); -#ifdef ECL_LONG_FLOAT - case t_longfloat: - return ecl_make_longfloat(ecl_to_double(x) / ecl_long_float(y)); -#endif - case t_complex: - goto COMPLEX; - default: - FEwrong_type_nth_arg(@[/], 2, y, @[number]); - } - case t_singlefloat: - switch (type_of(y)) { - case t_fixnum: - return ecl_make_singlefloat(sf(x) / fix(y)); - case t_bignum: - case t_ratio: - return ecl_make_singlefloat(sf(x) / ecl_to_double(y)); - case t_singlefloat: - return ecl_make_singlefloat(sf(x) / sf(y)); - case t_doublefloat: - return ecl_make_doublefloat(sf(x) / df(y)); -#ifdef ECL_LONG_FLOAT - case t_longfloat: - return ecl_make_longfloat(sf(x) / ecl_long_float(y)); -#endif - case t_complex: - goto COMPLEX; - default: - FEwrong_type_nth_arg(@[/], 2, y, @[number]); - } - case t_doublefloat: - switch (type_of(y)) { - case t_fixnum: - return ecl_make_doublefloat(df(x) / fix(y)); - case t_bignum: - case t_ratio: - return ecl_make_doublefloat(df(x) / ecl_to_double(y)); - case t_singlefloat: - return ecl_make_doublefloat(df(x) / sf(y)); - case t_doublefloat: - return ecl_make_doublefloat(df(x) / df(y)); -#ifdef ECL_LONG_FLOAT - case t_longfloat: - return ecl_make_longfloat(df(x) / ecl_long_float(y)); -#endif - case t_complex: - goto COMPLEX; - default: - FEwrong_type_nth_arg(@[/], 2, y, @[number]); - } -#ifdef ECL_LONG_FLOAT - case t_longfloat: - switch (type_of(y)) { - case t_fixnum: - return ecl_make_longfloat(ecl_long_float(x) / fix(y)); - case t_bignum: - case t_ratio: - return ecl_make_longfloat(ecl_long_float(x) / ecl_to_double(y)); - case t_singlefloat: - return ecl_make_longfloat(ecl_long_float(x) / sf(y)); - case t_doublefloat: - return ecl_make_longfloat(ecl_long_float(x) / df(y)); - case t_longfloat: - return ecl_make_longfloat(ecl_long_float(x) / ecl_long_float(y)); - case t_complex: - goto COMPLEX; - default: - FEwrong_type_nth_arg(@[/], 2, y, @[number]); - } -#endif - case t_complex: - if (type_of(y) != t_complex) { - z1 = ecl_divide(x->complex.real, y); - z2 = ecl_divide(x->complex.imag, y); - return ecl_make_complex(z1, z2); - } else if (1) { - /* #C(z1 z2) = #C(xr xi) * #C(yr -yi) */ - z1 = ecl_plus(ecl_times(x->complex.real, y->complex.real), - ecl_times(x->complex.imag, y->complex.imag)); - z2 = ecl_minus(ecl_times(x->complex.imag, y->complex.real), - ecl_times(x->complex.real, y->complex.imag)); - } else { - COMPLEX: /* INV: x is real, y is complex */ - /* #C(z1 z2) = x * #C(yr -yi) */ - z1 = ecl_times(x, y->complex.real); - z2 = ecl_negate(ecl_times(x, y->complex.imag)); - } - z = ecl_plus(ecl_times(y->complex.real, y->complex.real), - ecl_times(y->complex.imag, y->complex.imag)); - z = ecl_make_complex(ecl_divide(z1, z), ecl_divide(z2, z)); - return(z); - default: - FEwrong_type_nth_arg(@[/], 1, x, @[number]); - } -} - cl_object ecl_integer_divide(cl_object x, cl_object y) { diff --git a/src/c/numbers/divide.d b/src/c/numbers/divide.d new file mode 100644 index 000000000..471cb2dda --- /dev/null +++ b/src/c/numbers/divide.d @@ -0,0 +1,174 @@ +/* -*- mode: c; c-basic-offset: 8 -*- */ +/* + divde.d -- Implementation of CL:/ +*/ +/* + Copyright (c) 2010, Juan Jose Garcia Ripoll. + + ECL is free software; you can redistribute it and/or + modify it under the terms of the GNU Library General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + See file '../../Copyright' for full details. +*/ + +#include +#include + +@(defun / (num &rest nums) +@ + /* INV: type check is in ecl_divide() */ + if (narg == 0) + FEwrong_num_arguments(@[/]); + if (narg == 1) + @(return ecl_divide(MAKE_FIXNUM(1), num)) + while (--narg) + num = ecl_divide(num, cl_va_arg(nums)); + @(return num) +@) + +cl_object +ecl_divide(cl_object x, cl_object y) +{ + cl_object z, z1, z2; + + switch (type_of(x)) { + case t_fixnum: + case t_bignum: + switch (type_of(y)) { + case t_fixnum: + if (y == MAKE_FIXNUM(0)) + FEdivision_by_zero(x, y); + case t_bignum: + if (ecl_minusp(y) == TRUE) { + x = ecl_negate(x); + y = ecl_negate(y); + } + return ecl_make_ratio(x, y); + case t_ratio: + z = ecl_times(x, y->ratio.den); + return ecl_make_ratio(z, y->ratio.num); + case t_singlefloat: + return ecl_make_singlefloat(ecl_to_double(x) / sf(y)); + case t_doublefloat: + return ecl_make_doublefloat(ecl_to_double(x) / df(y)); +#ifdef ECL_LONG_FLOAT + case t_longfloat: + return ecl_make_longfloat(ecl_to_double(x) / ecl_long_float(y)); +#endif + case t_complex: + goto COMPLEX; + default: + FEwrong_type_nth_arg(@[/], 2, y, @[number]); + } + case t_ratio: + switch (type_of(y)) { + case t_fixnum: + if (y == MAKE_FIXNUM(0)) + FEdivision_by_zero(x, y); + case t_bignum: + z = ecl_times(x->ratio.den, y); + return ecl_make_ratio(x->ratio.num, z); + case t_ratio: + z = ecl_times(x->ratio.num,y->ratio.den); + z1 = ecl_times(x->ratio.den,y->ratio.num); + return ecl_make_ratio(z, z1); + case t_singlefloat: + return ecl_make_singlefloat(ecl_to_double(x) / sf(y)); + case t_doublefloat: + return ecl_make_doublefloat(ecl_to_double(x) / df(y)); +#ifdef ECL_LONG_FLOAT + case t_longfloat: + return ecl_make_longfloat(ecl_to_double(x) / ecl_long_float(y)); +#endif + case t_complex: + goto COMPLEX; + default: + FEwrong_type_nth_arg(@[/], 2, y, @[number]); + } + case t_singlefloat: + switch (type_of(y)) { + case t_fixnum: + return ecl_make_singlefloat(sf(x) / fix(y)); + case t_bignum: + case t_ratio: + return ecl_make_singlefloat(sf(x) / ecl_to_double(y)); + case t_singlefloat: + return ecl_make_singlefloat(sf(x) / sf(y)); + case t_doublefloat: + return ecl_make_doublefloat(sf(x) / df(y)); +#ifdef ECL_LONG_FLOAT + case t_longfloat: + return ecl_make_longfloat(sf(x) / ecl_long_float(y)); +#endif + case t_complex: + goto COMPLEX; + default: + FEwrong_type_nth_arg(@[/], 2, y, @[number]); + } + case t_doublefloat: + switch (type_of(y)) { + case t_fixnum: + return ecl_make_doublefloat(df(x) / fix(y)); + case t_bignum: + case t_ratio: + return ecl_make_doublefloat(df(x) / ecl_to_double(y)); + case t_singlefloat: + return ecl_make_doublefloat(df(x) / sf(y)); + case t_doublefloat: + return ecl_make_doublefloat(df(x) / df(y)); +#ifdef ECL_LONG_FLOAT + case t_longfloat: + return ecl_make_longfloat(df(x) / ecl_long_float(y)); +#endif + case t_complex: + goto COMPLEX; + default: + FEwrong_type_nth_arg(@[/], 2, y, @[number]); + } +#ifdef ECL_LONG_FLOAT + case t_longfloat: + switch (type_of(y)) { + case t_fixnum: + return ecl_make_longfloat(ecl_long_float(x) / fix(y)); + case t_bignum: + case t_ratio: + return ecl_make_longfloat(ecl_long_float(x) / ecl_to_double(y)); + case t_singlefloat: + return ecl_make_longfloat(ecl_long_float(x) / sf(y)); + case t_doublefloat: + return ecl_make_longfloat(ecl_long_float(x) / df(y)); + case t_longfloat: + return ecl_make_longfloat(ecl_long_float(x) / ecl_long_float(y)); + case t_complex: + goto COMPLEX; + default: + FEwrong_type_nth_arg(@[/], 2, y, @[number]); + } +#endif + case t_complex: + if (type_of(y) != t_complex) { + z1 = ecl_divide(x->complex.real, y); + z2 = ecl_divide(x->complex.imag, y); + return ecl_make_complex(z1, z2); + } else if (1) { + /* #C(z1 z2) = #C(xr xi) * #C(yr -yi) */ + z1 = ecl_plus(ecl_times(x->complex.real, y->complex.real), + ecl_times(x->complex.imag, y->complex.imag)); + z2 = ecl_minus(ecl_times(x->complex.imag, y->complex.real), + ecl_times(x->complex.real, y->complex.imag)); + } else { + COMPLEX: /* INV: x is real, y is complex */ + /* #C(z1 z2) = x * #C(yr -yi) */ + z1 = ecl_times(x, y->complex.real); + z2 = ecl_negate(ecl_times(x, y->complex.imag)); + } + z = ecl_plus(ecl_times(y->complex.real, y->complex.real), + ecl_times(y->complex.imag, y->complex.imag)); + z = ecl_make_complex(ecl_divide(z1, z), ecl_divide(z2, z)); + return(z); + default: + FEwrong_type_nth_arg(@[/], 1, x, @[number]); + } +} diff --git a/src/c/numbers/minus.d b/src/c/numbers/minus.d new file mode 100644 index 000000000..12ba1e1f7 --- /dev/null +++ b/src/c/numbers/minus.d @@ -0,0 +1,337 @@ +/* -*- mode: c; c-basic-offset: 8 -*- */ +/* + minus.d -- Implementation of CL:- +*/ +/* + Copyright (c) 2010, Juan Jose Garcia Ripoll. + + ECL is free software; you can redistribute it and/or + modify it under the terms of the GNU Library General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + See file '../../Copyright' for full details. +*/ + +#include +#include + +@(defun - (num &rest nums) + cl_object diff; +@ + /* INV: argument type check in number_{negate,minus}() */ + if (narg == 1) + @(return ecl_negate(num)) + for (diff = num; --narg; ) + diff = ecl_minus(diff, cl_va_arg(nums)); + @(return diff) +@) + +#if 1 + +cl_object +ecl_minus(cl_object x, cl_object y) +{ +MATH_DISPATCH2_BEGIN(x,y) +{ + CASE_FIXNUM_FIXNUM { + return ecl_make_integer(fix(x) - fix(y)); + } + CASE_FIXNUM_BIGNUM { + return _ecl_fix_minus_big(fix(x), y); + } + CASE_FIXNUM_RATIO; + CASE_BIGNUM_RATIO { + cl_object z = ecl_times(x, y->ratio.den); + z = ecl_minus(z, y->ratio.num); + return ecl_make_ratio(z, y->ratio.den); + } + CASE_FIXNUM_SINGLE_FLOAT { + return ecl_make_singlefloat(fix(x) - ecl_single_float(y)); + } + CASE_FIXNUM_DOUBLE_FLOAT { + return ecl_make_doublefloat(fix(x) - ecl_double_float(y)); + } + CASE_BIGNUM_FIXNUM { + return _ecl_big_plus_fix(x, -fix(y)); + } + CASE_BIGNUM_BIGNUM { + return _ecl_big_minus_big(x, y); + } + CASE_BIGNUM_SINGLE_FLOAT { + return ecl_make_singlefloat(ecl_to_float(x) - ecl_single_float(y)); + } + CASE_BIGNUM_DOUBLE_FLOAT { + return ecl_make_doublefloat(ecl_to_double(x) - ecl_double_float(y)); + } + CASE_RATIO_FIXNUM; + CASE_RATIO_BIGNUM { + cl_object z = ecl_times(x->ratio.den, y); + z = ecl_minus(x->ratio.num, z); + return ecl_make_ratio(z, x->ratio.den); + } + CASE_RATIO_RATIO { + cl_object z1 = ecl_times(x->ratio.num,y->ratio.den); + cl_object z = ecl_times(x->ratio.den,y->ratio.num); + z = ecl_minus(z1, z); + z1 = ecl_times(x->ratio.den,y->ratio.den); + return ecl_make_ratio(z, z1); + } + CASE_RATIO_SINGLE_FLOAT { + return ecl_make_singlefloat(ecl_to_float(x) - ecl_single_float(y)); + } + CASE_RATIO_DOUBLE_FLOAT { + return ecl_make_doublefloat(ecl_to_double(x) - ecl_double_float(y)); + } + CASE_SINGLE_FLOAT_FIXNUM { + return ecl_make_singlefloat(ecl_single_float(x) - fix(y)); + } + CASE_SINGLE_FLOAT_BIGNUM; + CASE_SINGLE_FLOAT_RATIO { + return ecl_make_singlefloat(ecl_single_float(x) - ecl_to_float(y)); + } + CASE_SINGLE_FLOAT_SINGLE_FLOAT { + return ecl_make_singlefloat(ecl_single_float(x) - ecl_single_float(y)); + } + CASE_SINGLE_FLOAT_DOUBLE_FLOAT { + return ecl_make_doublefloat(ecl_single_float(x) - ecl_double_float(y)); + } + CASE_DOUBLE_FLOAT_FIXNUM { + return ecl_make_doublefloat(ecl_double_float(x) - fix(y)); + } + CASE_DOUBLE_FLOAT_BIGNUM; + CASE_DOUBLE_FLOAT_RATIO { + return ecl_make_doublefloat(ecl_double_float(x) - ecl_to_double(y)); + } + CASE_DOUBLE_FLOAT_SINGLE_FLOAT { + return ecl_make_doublefloat(ecl_double_float(x) - ecl_single_float(y)); + } + CASE_DOUBLE_FLOAT_DOUBLE_FLOAT { + return ecl_make_doublefloat(ecl_double_float(x) - ecl_double_float(y)); + } +#ifdef ECL_LONG_FLOAT + CASE_FIXNUM_LONG_FLOAT { + return ecl_make_longfloat(fix(x) - ecl_long_float(y)); + } + CASE_BIGNUM_LONG_FLOAT { + return ecl_make_longfloat(ecl_to_long_double(x) - ecl_long_float(y)); + } + CASE_RATIO_LONG_FLOAT { + return ecl_make_longfloat(ecl_to_long_double(x) - ecl_long_float(y)); + } + CASE_SINGLE_FLOAT_LONG_FLOAT { + return ecl_make_longfloat(ecl_single_float(x) - ecl_long_float(y)); + } + CASE_DOUBLE_FLOAT_LONG_FLOAT { + return ecl_make_longfloat(ecl_double_float(x) - ecl_long_float(y)); + } + CASE_LONG_FLOAT_FIXNUM { + return ecl_make_longfloat(ecl_long_float(x) - fix(y)); + } + CASE_LONG_FLOAT_BIGNUM; + CASE_LONG_FLOAT_RATIO { + return ecl_make_longfloat(ecl_long_float(x) - ecl_to_double(y)); + } + CASE_LONG_FLOAT_SINGLE_FLOAT { + return ecl_make_longfloat(ecl_long_float(x) - ecl_single_float(y)); + } + CASE_LONG_FLOAT_DOUBLE_FLOAT { + return ecl_make_longfloat(ecl_long_float(x) - ecl_double_float(y)); + } + CASE_LONG_FLOAT_LONG_FLOAT { + return ecl_make_longfloat(ecl_long_float(x) - ecl_long_float(y)); + } + CASE_LONG_FLOAT_COMPLEX { + goto COMPLEX_Y; + } + CASE_COMPLEX_LONG_FLOAT; { + goto COMPLEX_X; + } +#endif + CASE_COMPLEX_FIXNUM; + CASE_COMPLEX_BIGNUM; + CASE_COMPLEX_RATIO; + CASE_COMPLEX_SINGLE_FLOAT; + CASE_COMPLEX_DOUBLE_FLOAT { + COMPLEX_X: + return ecl_make_complex(ecl_minus(x->complex.real, y), + x->complex.imag); + } + CASE_BIGNUM_COMPLEX; + CASE_RATIO_COMPLEX; + CASE_SINGLE_FLOAT_COMPLEX; + CASE_DOUBLE_FLOAT_COMPLEX; + CASE_FIXNUM_COMPLEX { + COMPLEX_Y: + return ecl_make_complex(ecl_minus(x, y->complex.real), + ecl_negate(y->complex.imag)); + } + CASE_COMPLEX_COMPLEX { + cl_object z = ecl_minus(x->complex.real, y->complex.real); + cl_object z1 = ecl_minus(x->complex.imag, y->complex.imag); + return ecl_make_complex(z, z1); + } + CASE_UNKNOWN(@[-],x,y,@[number]); +} +MATH_DISPATCH2_END; +} + +#else + +cl_object +ecl_minus(cl_object x, cl_object y) +{ + cl_fixnum i, j, k; + cl_object z, z1; + + switch (type_of(x)) { + case t_fixnum: + switch(type_of(y)) { + case t_fixnum: + return ecl_make_integer(fix(x) - fix(y)); + case t_bignum: + return _ecl_fix_minus_big(fix(x), y); + case t_ratio: + z = ecl_times(x, y->ratio.den); + z = ecl_minus(z, y->ratio.num); + return ecl_make_ratio(z, y->ratio.den); + case t_singlefloat: + return ecl_make_singlefloat(fix(x) - sf(y)); + case t_doublefloat: + return ecl_make_doublefloat(fix(x) - df(y)); +#ifdef ECL_LONG_FLOAT + case t_longfloat: + return ecl_make_longfloat(fix(x) - ecl_long_float(y)); +#endif + case t_complex: + goto COMPLEX; + default: + FEwrong_type_nth_arg(@[-], 2, y, @[number]); + } + case t_bignum: + switch (type_of(y)) { + case t_fixnum: + return _ecl_big_plus_fix(x, -fix(y)); + case t_bignum: + return _ecl_big_minus_big(x, y); + case t_ratio: + z = ecl_times(x, y->ratio.den); + z = ecl_minus(z, y->ratio.num); + return ecl_make_ratio(z, y->ratio.den); + case t_singlefloat: + return ecl_make_singlefloat(ecl_to_double(x) - sf(y)); + case t_doublefloat: + return ecl_make_doublefloat(ecl_to_double(x) - df(y)); +#ifdef ECL_LONG_FLOAT + case t_longfloat: + return ecl_make_longfloat(ecl_to_double(x) - ecl_long_float(y)); +#endif + case t_complex: + goto COMPLEX; + default: + FEwrong_type_nth_arg(@[-], 2, y, @[number]); + } + case t_ratio: + switch (type_of(y)) { + case t_fixnum: + case t_bignum: + z = ecl_times(x->ratio.den, y); + z = ecl_minus(x->ratio.num, z); + return ecl_make_ratio(z, x->ratio.den); + case t_ratio: + z = ecl_times(x->ratio.num,y->ratio.den); + z1 = ecl_times(x->ratio.den,y->ratio.num); + z = ecl_minus(z, z1); + z1 = ecl_times(x->ratio.den,y->ratio.den); + return ecl_make_ratio(z, z1); + case t_singlefloat: + return ecl_make_singlefloat(ecl_to_double(x) - sf(y)); + case t_doublefloat: + return ecl_make_doublefloat(ecl_to_double(x) - df(y)); +#ifdef ECL_LONG_FLOAT + case t_longfloat: + return ecl_make_longfloat(ecl_to_double(x) - ecl_long_float(y)); +#endif + case t_complex: + goto COMPLEX; + default: + FEwrong_type_nth_arg(@[-], 2, y, @[number]); + } + case t_singlefloat: + switch (type_of(y)) { + case t_fixnum: + return ecl_make_singlefloat(sf(x) - fix(y)); + case t_bignum: + case t_ratio: + return ecl_make_singlefloat(sf(x) - ecl_to_double(y)); + case t_singlefloat: + return ecl_make_singlefloat(sf(x) - sf(y)); + case t_doublefloat: + return ecl_make_doublefloat(sf(x) - df(y)); +#ifdef ECL_LONG_FLOAT + case t_longfloat: + return ecl_make_longfloat(sf(x) - ecl_long_float(y)); +#endif + case t_complex: + goto COMPLEX; + default: + FEwrong_type_nth_arg(@[-], 2, y, @[number]); + } + case t_doublefloat: + switch (type_of(y)) { + case t_fixnum: + return ecl_make_doublefloat(df(x) - fix(y)); + case t_bignum: + case t_ratio: + return ecl_make_doublefloat(df(x) - ecl_to_double(y)); + case t_singlefloat: + return ecl_make_doublefloat(df(x) - sf(y)); + case t_doublefloat: + return ecl_make_doublefloat(df(x) - df(y)); +#ifdef ECL_LONG_FLOAT + case t_longfloat: + return ecl_make_longfloat(df(x) - ecl_long_float(y)); +#endif + case t_complex: + goto COMPLEX; + default: + FEwrong_type_nth_arg(@[-], 2, y, @[number]); + } +#ifdef ECL_LONG_FLOAT + case t_longfloat: + switch (type_of(y)) { + case t_fixnum: + return ecl_make_longfloat(ecl_long_float(x) - fix(y)); + case t_bignum: + case t_ratio: + return ecl_make_longfloat(ecl_long_float(x) - ecl_to_double(y)); + case t_singlefloat: + return ecl_make_longfloat(ecl_long_float(x) - sf(y)); + case t_doublefloat: + return ecl_make_longfloat(ecl_long_float(x) - df(y)); + case t_longfloat: + return ecl_make_longfloat(ecl_long_float(x) - ecl_long_float(y)); + case t_complex: + goto COMPLEX; + default: + FEwrong_type_nth_arg(@[-], 2, y, @[number]); + } +#endif + COMPLEX: + return ecl_make_complex(ecl_minus(x, y->complex.real), + ecl_negate(y->complex.imag)); + case t_complex: + if (type_of(y) != t_complex) { + z = ecl_minus(x->complex.real, y); + z1 = x->complex.imag; + } else { + z = ecl_minus(x->complex.real, y->complex.real); + z1 = ecl_minus(x->complex.imag, y->complex.imag); + } + return ecl_make_complex(z, z1); + default: + FEwrong_type_nth_arg(@[-], 1, x, @[number]); + } +} + +#endif diff --git a/src/c/numbers/plus.d b/src/c/numbers/plus.d new file mode 100644 index 000000000..d23c13994 --- /dev/null +++ b/src/c/numbers/plus.d @@ -0,0 +1,333 @@ +/* -*- mode: c; c-basic-offset: 8 -*- */ +/* + plus.d -- Implementation of CL:+ +*/ +/* + Copyright (c) 2010, Juan Jose Garcia Ripoll. + + ECL is free software; you can redistribute it and/or + modify it under the terms of the GNU Library General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + See file '../../Copyright' for full details. +*/ + +#include +#include + +@(defun + (&rest nums) + cl_object sum = MAKE_FIXNUM(0); +@ + /* INV: type check is in ecl_plus() */ + while (narg--) + sum = ecl_plus(sum, cl_va_arg(nums)); + @(return sum) +@) + +#if 1 + +cl_object +ecl_plus(cl_object x, cl_object y) +{ +MATH_DISPATCH2_BEGIN(x,y) +{ + CASE_FIXNUM_FIXNUM { + return ecl_make_integer(fix(x) + fix(y)); + } + CASE_FIXNUM_BIGNUM { + return _ecl_big_plus_fix(y, fix(x)); + } + CASE_FIXNUM_RATIO; + CASE_BIGNUM_RATIO { + cl_object z = ecl_times(x, y->ratio.den); + z = ecl_plus(z, y->ratio.num); + return ecl_make_ratio(z, y->ratio.den); + } + CASE_FIXNUM_SINGLE_FLOAT { + return ecl_make_singlefloat(fix(x) + ecl_single_float(y)); + } + CASE_FIXNUM_DOUBLE_FLOAT { + return ecl_make_doublefloat(fix(x) + ecl_double_float(y)); + } + CASE_BIGNUM_FIXNUM { + return _ecl_big_plus_fix(x, fix(y)); + } + CASE_BIGNUM_BIGNUM { + return _ecl_big_plus_big(x, y); + } + CASE_BIGNUM_SINGLE_FLOAT { + return ecl_make_singlefloat(ecl_to_float(x) + ecl_single_float(y)); + } + CASE_BIGNUM_DOUBLE_FLOAT { + return ecl_make_doublefloat(ecl_to_double(x) + ecl_double_float(y)); + } + CASE_RATIO_FIXNUM; + CASE_RATIO_BIGNUM { + cl_object z = ecl_times(x->ratio.den, y); + z = ecl_plus(x->ratio.num, z); + return ecl_make_ratio(z, x->ratio.den); + } + CASE_RATIO_RATIO { + cl_object z1 = ecl_times(x->ratio.num,y->ratio.den); + cl_object z = ecl_times(x->ratio.den,y->ratio.num); + z = ecl_plus(z1, z); + z1 = ecl_times(x->ratio.den,y->ratio.den); + return ecl_make_ratio(z, z1); + } + CASE_RATIO_SINGLE_FLOAT { + return ecl_make_singlefloat(ecl_to_float(x) + ecl_single_float(y)); + } + CASE_RATIO_DOUBLE_FLOAT { + return ecl_make_doublefloat(ecl_to_double(x) + ecl_double_float(y)); + } + CASE_SINGLE_FLOAT_FIXNUM { + return ecl_make_singlefloat(ecl_single_float(x) + fix(y)); + } + CASE_SINGLE_FLOAT_BIGNUM; + CASE_SINGLE_FLOAT_RATIO { + return ecl_make_singlefloat(ecl_single_float(x) + ecl_to_float(y)); + } + CASE_SINGLE_FLOAT_SINGLE_FLOAT { + return ecl_make_singlefloat(ecl_single_float(x) + ecl_single_float(y)); + } + CASE_SINGLE_FLOAT_DOUBLE_FLOAT { + return ecl_make_doublefloat(ecl_single_float(x) + ecl_double_float(y)); + } + CASE_DOUBLE_FLOAT_FIXNUM { + return ecl_make_doublefloat(ecl_double_float(x) + fix(y)); + } + CASE_DOUBLE_FLOAT_BIGNUM; + CASE_DOUBLE_FLOAT_RATIO { + return ecl_make_doublefloat(ecl_double_float(x) + ecl_to_double(y)); + } + CASE_DOUBLE_FLOAT_SINGLE_FLOAT { + return ecl_make_doublefloat(ecl_double_float(x) + ecl_single_float(y)); + } + CASE_DOUBLE_FLOAT_DOUBLE_FLOAT { + return ecl_make_doublefloat(ecl_double_float(x) + ecl_double_float(y)); + } +#ifdef ECL_LONG_FLOAT + CASE_FIXNUM_LONG_FLOAT { + return ecl_make_longfloat(fix(x) + ecl_long_float(y)); + } + CASE_BIGNUM_LONG_FLOAT { + return ecl_make_longfloat(ecl_to_long_double(x) + ecl_long_float(y)); + } + CASE_RATIO_LONG_FLOAT { + return ecl_make_longfloat(ecl_to_long_double(x) + ecl_long_float(y)); + } + CASE_SINGLE_FLOAT_LONG_FLOAT { + return ecl_make_longfloat(ecl_single_float(x) + ecl_long_float(y)); + } + CASE_DOUBLE_FLOAT_LONG_FLOAT { + return ecl_make_longfloat(ecl_double_float(x) + ecl_long_float(y)); + } + CASE_LONG_FLOAT_FIXNUM { + return ecl_make_longfloat(ecl_long_float(x) + fix(y)); + } + CASE_LONG_FLOAT_BIGNUM; + CASE_LONG_FLOAT_RATIO { + return ecl_make_longfloat(ecl_long_float(x) + ecl_to_double(y)); + } + CASE_LONG_FLOAT_SINGLE_FLOAT { + return ecl_make_longfloat(ecl_long_float(x) + ecl_single_float(y)); + } + CASE_LONG_FLOAT_DOUBLE_FLOAT { + return ecl_make_longfloat(ecl_long_float(x) + ecl_double_float(y)); + } + CASE_LONG_FLOAT_LONG_FLOAT { + return ecl_make_longfloat(ecl_long_float(x) + ecl_long_float(y)); + } + CASE_LONG_FLOAT_COMPLEX { + goto COMPLEX_Y; + } + CASE_COMPLEX_LONG_FLOAT; { + goto COMPLEX_X; + } +#endif + CASE_COMPLEX_FIXNUM; + CASE_COMPLEX_BIGNUM; + CASE_COMPLEX_RATIO; + CASE_COMPLEX_SINGLE_FLOAT; + CASE_COMPLEX_DOUBLE_FLOAT; COMPLEX_X: { + cl_object aux = x; + x = y; y = aux; + goto COMPLEX_Y; + } + CASE_BIGNUM_COMPLEX; + CASE_RATIO_COMPLEX; + CASE_SINGLE_FLOAT_COMPLEX; + CASE_DOUBLE_FLOAT_COMPLEX; + CASE_FIXNUM_COMPLEX { + COMPLEX_Y: + return ecl_make_complex(ecl_plus(x, y->complex.real), + y->complex.imag); + } + CASE_COMPLEX_COMPLEX { + cl_object z = ecl_plus(x->complex.real, y->complex.real); + cl_object z1 = ecl_plus(x->complex.imag, y->complex.imag); + return ecl_make_complex(z, z1); + } + CASE_UNKNOWN(@[+],x,y,@[number]); +} +MATH_DISPATCH2_END; +} + +#else + +cl_object +ecl_plus(cl_object x, cl_object y) +{ + cl_fixnum i, j; + cl_object z, z1; + + switch (type_of(x)) { + case t_fixnum: + switch (type_of(y)) { + case t_fixnum: + return ecl_make_integer(fix(x) + fix(y)); + case t_bignum: + return _ecl_big_plus_fix(y, fix(x)); + case t_ratio: + z = ecl_times(x, y->ratio.den); + z = ecl_plus(z, y->ratio.num); + return ecl_make_ratio(z, y->ratio.den); + case t_singlefloat: + return ecl_make_singlefloat(fix(x) + sf(y)); + case t_doublefloat: + return ecl_make_doublefloat(fix(x) + df(y)); +#ifdef ECL_LONG_FLOAT + case t_longfloat: + return ecl_make_longfloat(fix(x) + ecl_long_float(y)); +#endif + case t_complex: + COMPLEX: /* INV: x is real, y is complex */ + return ecl_make_complex(ecl_plus(x, y->complex.real), + y->complex.imag); + default: + FEwrong_type_nth_arg(@[+], 2, y, @[number]); + } + case t_bignum: + switch (type_of(y)) { + case t_fixnum: + return _ecl_big_plus_fix(x, fix(y)); + case t_bignum: + return _ecl_big_plus_big(x, y); + case t_ratio: + z = ecl_times(x, y->ratio.den); + z = ecl_plus(z, y->ratio.num); + return ecl_make_ratio(z, y->ratio.den); + case t_singlefloat: + return ecl_make_singlefloat(ecl_to_double(x) + sf(y)); + case t_doublefloat: + return ecl_make_doublefloat(ecl_to_double(x) + df(y)); +#ifdef ECL_LONG_FLOAT + case t_longfloat: + return ecl_make_longfloat(ecl_to_double(x) + ecl_long_float(y)); +#endif + case t_complex: + goto COMPLEX; + default: + FEwrong_type_nth_arg(@[+], 2, y, @[number]); + } + case t_ratio: + switch (type_of(y)) { + case t_fixnum: + case t_bignum: + z = ecl_times(x->ratio.den, y); + z = ecl_plus(x->ratio.num, z); + return ecl_make_ratio(z, x->ratio.den); + case t_ratio: + z1 = ecl_times(x->ratio.num,y->ratio.den); + z = ecl_times(x->ratio.den,y->ratio.num); + z = ecl_plus(z1, z); + z1 = ecl_times(x->ratio.den,y->ratio.den); + return ecl_make_ratio(z, z1); + case t_singlefloat: + return ecl_make_singlefloat(ecl_to_double(x) + sf(y)); + case t_doublefloat: + return ecl_make_doublefloat(ecl_to_double(x) + df(y)); +#ifdef ECL_LONG_FLOAT + case t_longfloat: + return ecl_make_longfloat(ecl_to_double(x) + ecl_long_float(y)); +#endif + case t_complex: + goto COMPLEX; + default: + FEwrong_type_nth_arg(@[+], 2, y, @[number]); + } + case t_singlefloat: + switch (type_of(y)) { + case t_fixnum: + return ecl_make_singlefloat(sf(x) + fix(y)); + case t_bignum: + case t_ratio: + return ecl_make_singlefloat(sf(x) + ecl_to_double(y)); + case t_singlefloat: + return ecl_make_singlefloat(sf(x) + sf(y)); + case t_doublefloat: + return ecl_make_doublefloat(sf(x) + df(y)); +#ifdef ECL_LONG_FLOAT + case t_longfloat: + return ecl_make_longfloat(sf(x) + ecl_long_float(y)); +#endif + case t_complex: + goto COMPLEX; + default: + FEwrong_type_nth_arg(@[+], 2, y, @[number]); + } + case t_doublefloat: + switch (type_of(y)) { + case t_fixnum: + return ecl_make_doublefloat(df(x) + fix(y)); + case t_bignum: + case t_ratio: + return ecl_make_doublefloat(df(x) + ecl_to_double(y)); + case t_singlefloat: + return ecl_make_doublefloat(df(x) + sf(y)); + case t_doublefloat: + return ecl_make_doublefloat(df(x) + df(y)); +#ifdef ECL_LONG_FLOAT + case t_longfloat: + return ecl_make_longfloat(df(x) + ecl_long_float(y)); +#endif + case t_complex: + goto COMPLEX; + default: + FEwrong_type_nth_arg(@[+], 2, y, @[number]); + } +#ifdef ECL_LONG_FLOAT + case t_longfloat: + switch (type_of(y)) { + case t_fixnum: + return ecl_make_longfloat(ecl_long_float(x) + fix(y)); + case t_bignum: + case t_ratio: + return ecl_make_longfloat(ecl_long_float(x) + ecl_to_double(y)); + case t_singlefloat: + return ecl_make_longfloat(ecl_long_float(x) + sf(y)); + case t_doublefloat: + return ecl_make_longfloat(ecl_long_float(x) + df(y)); + case t_longfloat: + return ecl_make_longfloat(ecl_long_float(x) + ecl_long_float(y)); + case t_complex: + goto COMPLEX; + default: + FEwrong_type_nth_arg(@[+], 2, y, @[number]); + } +#endif + case t_complex: + if (type_of(y) != t_complex) { + cl_object aux = x; + x = y; y = aux; + goto COMPLEX; + } + z = ecl_plus(x->complex.real, y->complex.real); + z1 = ecl_plus(x->complex.imag, y->complex.imag); + return ecl_make_complex(z, z1); + default: + FEwrong_type_nth_arg(@[+], 1, x, @[number]); + } +} +#endif diff --git a/src/c/numbers/times.d b/src/c/numbers/times.d new file mode 100644 index 000000000..d4040ff3b --- /dev/null +++ b/src/c/numbers/times.d @@ -0,0 +1,187 @@ +/* -*- mode: c; c-basic-offset: 8 -*- */ +/* + times.d -- Implementation of CL:* +*/ +/* + Copyright (c) 2010, Juan Jose Garcia Ripoll. + + ECL is free software; you can redistribute it and/or + modify it under the terms of the GNU Library General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + See file '../../Copyright' for full details. +*/ + +#include +#include + +@(defun * (&rest nums) + cl_object prod = MAKE_FIXNUM(1); +@ + /* INV: type check in ecl_times() */ + while (narg--) + prod = ecl_times(prod, cl_va_arg(nums)); + @(return prod) +@) + +cl_object +ecl_times(cl_object x, cl_object y) +{ + cl_object z, z1; + + switch (type_of(x)) { + case t_fixnum: + switch (type_of(y)) { + case t_fixnum: + return _ecl_fix_times_fix(fix(x),fix(y)); + case t_bignum: + return _ecl_big_times_fix(y, fix(x)); + case t_ratio: + z = ecl_times(x, y->ratio.num); + return ecl_make_ratio(z, y->ratio.den); + case t_singlefloat: + return ecl_make_singlefloat(fix(x) * sf(y)); + case t_doublefloat: + return ecl_make_doublefloat(fix(x) * df(y)); +#ifdef ECL_LONG_FLOAT + case t_longfloat: + return ecl_make_longfloat(fix(x) * ecl_long_float(y)); +#endif + case t_complex: + goto COMPLEX; + default: + FEwrong_type_nth_arg(@[*], 2, y, @[number]); + } + case t_bignum: + switch (type_of(y)) { + case t_fixnum: + return _ecl_big_times_fix(x, fix(y)); + case t_bignum: + return _ecl_big_times_big(x, y); + case t_ratio: + z = ecl_times(x, y->ratio.num); + return ecl_make_ratio(z, y->ratio.den); + case t_singlefloat: + return ecl_make_singlefloat(ecl_to_double(x) * sf(y)); + case t_doublefloat: + return ecl_make_doublefloat(ecl_to_double(x) * df(y)); +#ifdef ECL_LONG_FLOAT + case t_longfloat: + return ecl_make_longfloat(ecl_to_double(x) * ecl_long_float(y)); +#endif + case t_complex: + goto COMPLEX; + default: + FEwrong_type_nth_arg(@[*], 2, y, @[number]); + } + case t_ratio: + switch (type_of(y)) { + case t_fixnum: + case t_bignum: + z = ecl_times(x->ratio.num, y); + return ecl_make_ratio(z, x->ratio.den); + case t_ratio: + z = ecl_times(x->ratio.num,y->ratio.num); + z1 = ecl_times(x->ratio.den,y->ratio.den); + return ecl_make_ratio(z, z1); + case t_singlefloat: + return ecl_make_singlefloat(ecl_to_double(x) * sf(y)); + case t_doublefloat: + return ecl_make_doublefloat(ecl_to_double(x) * df(y)); +#ifdef ECL_LONG_FLOAT + case t_longfloat: + return ecl_make_longfloat(ecl_to_double(x) * ecl_long_float(y)); +#endif + case t_complex: + goto COMPLEX; + default: + FEwrong_type_nth_arg(@[*], 2, y, @[number]); + } + case t_singlefloat: { + float fx = sf(x); + switch (type_of(y)) { + case t_fixnum: + return ecl_make_singlefloat(fx * fix(y)); + case t_bignum: + case t_ratio: + return ecl_make_singlefloat(fx * ecl_to_double(y)); + case t_singlefloat: + return ecl_make_singlefloat(fx * sf(y)); + case t_doublefloat: + return ecl_make_doublefloat(fx * df(y)); +#ifdef ECL_LONG_FLOAT + case t_longfloat: + return ecl_make_longfloat(fx * ecl_long_float(y)); +#endif + case t_complex: + goto COMPLEX; + default: + FEwrong_type_nth_arg(@[*], 2, y, @[number]); + } + } + case t_doublefloat: { + switch (type_of(y)) { + case t_fixnum: + return ecl_make_doublefloat(df(x) * fix(y)); + case t_bignum: + case t_ratio: + return ecl_make_doublefloat(df(x) * ecl_to_double(y)); + case t_singlefloat: + return ecl_make_doublefloat(df(x) * sf(y)); + case t_doublefloat: + return ecl_make_doublefloat(df(x) * df(y)); +#ifdef ECL_LONG_FLOAT + case t_longfloat: + return ecl_make_longfloat(df(x) * ecl_long_float(y)); +#endif + case t_complex: { + COMPLEX: /* INV: x is real, y is complex */ + return ecl_make_complex(ecl_times(x, y->complex.real), + ecl_times(x, y->complex.imag)); + } + default: + FEwrong_type_nth_arg(@[*], 2, y, @[number]); + } + } +#ifdef ECL_LONG_FLOAT + case t_longfloat: { + long double lx = ecl_long_float(x); + switch (type_of(y)) { + case t_fixnum: + return ecl_make_longfloat(lx * fix(y)); + case t_bignum: + case t_ratio: + return ecl_make_longfloat(lx * ecl_to_double(y)); + case t_singlefloat: + return ecl_make_longfloat(lx * sf(y)); + case t_doublefloat: + return ecl_make_longfloat(lx * df(y)); + case t_longfloat: + return ecl_make_longfloat(lx * ecl_long_float(y)); + case t_complex: + goto COMPLEX; + default: + FEwrong_type_nth_arg(@[*], 2, y, @[number]); + } + } +#endif + case t_complex: + { + cl_object z11, z12, z21, z22; + + if (type_of(y) != t_complex) { + cl_object aux = x; + x = y; y = aux; + goto COMPLEX; + } + z11 = ecl_times(x->complex.real, y->complex.real); + z12 = ecl_times(x->complex.imag, y->complex.imag); + z21 = ecl_times(x->complex.imag, y->complex.real); + z22 = ecl_times(x->complex.real, y->complex.imag); + return ecl_make_complex(ecl_minus(z11, z12), ecl_plus(z21, z22)); + } + default: + FEwrong_type_nth_arg(@[*], 1, x, @[number]); + } +} diff --git a/src/h/impl/math_dispatch2.h b/src/h/impl/math_dispatch2.h new file mode 100644 index 000000000..af5cf0dac --- /dev/null +++ b/src/h/impl/math_dispatch2.h @@ -0,0 +1,139 @@ +/* -*- mode: c; c-basic-offset: 4 -*- */ +/* + math_dispatch.h -- fast dispatch for math functions +*/ +/* + Copyright (c) 2010, Juan Jose Garcia Ripoll. + + ECL is free software; you can redistribute it and/or + modify it under the terms of the GNU Library General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + See file '../Copyright' for full details. +*/ + +#ifndef ECL_MATH_DISPATCH2_H +#define ECL_MATH_DISPATCH2_H + +#include /* for unlikely_if */ + +#define MATH_DISPATCH2_LABEL(t1,t2) case ((t1)*(t_complex+1)+(t2)): +#define MATH_DISPATCH2_BEGIN(x,y) { \ + int tx = type_of(x), ty = type_of(y); \ + unlikely_if (ty > t_complex) { goto DISPATCH2_ERROR; } \ + switch (tx * (t_complex+1) + ty) +#define MATH_DISPATCH2_END } (void)0 + +#define CASE_COMPLEX_FIXNUM \ + MATH_DISPATCH2_LABEL(t_complex,t_fixnum) +#define CASE_COMPLEX_BIGNUM \ + MATH_DISPATCH2_LABEL(t_complex,t_bignum) +#define CASE_COMPLEX_RATIO \ + MATH_DISPATCH2_LABEL(t_complex,t_ratio) +#define CASE_COMPLEX_SINGLE_FLOAT \ + MATH_DISPATCH2_LABEL(t_complex,t_singlefloat) +#define CASE_COMPLEX_DOUBLE_FLOAT \ + MATH_DISPATCH2_LABEL(t_complex,t_doublefloat) +#define CASE_COMPLEX_LONG_FLOAT \ + MATH_DISPATCH2_LABEL(t_complex,t_longfloat) +#define CASE_COMPLEX_COMPLEX \ + MATH_DISPATCH2_LABEL(t_complex,t_complex) + +#define CASE_LONG_FLOAT_FIXNUM \ + MATH_DISPATCH2_LABEL(t_longfloat,t_fixnum) +#define CASE_LONG_FLOAT_BIGNUM \ + MATH_DISPATCH2_LABEL(t_longfloat,t_bignum) +#define CASE_LONG_FLOAT_RATIO \ + MATH_DISPATCH2_LABEL(t_longfloat,t_ratio) +#define CASE_LONG_FLOAT_SINGLE_FLOAT \ + MATH_DISPATCH2_LABEL(t_longfloat,t_singlefloat) +#define CASE_LONG_FLOAT_DOUBLE_FLOAT \ + MATH_DISPATCH2_LABEL(t_longfloat,t_doublefloat) +#define CASE_LONG_FLOAT_LONG_FLOAT \ + MATH_DISPATCH2_LABEL(t_longfloat,t_longfloat) +#define CASE_LONG_FLOAT_COMPLEX \ + MATH_DISPATCH2_LABEL(t_longfloat,t_complex) + +#define CASE_DOUBLE_FLOAT_FIXNUM \ + MATH_DISPATCH2_LABEL(t_doublefloat,t_fixnum) +#define CASE_DOUBLE_FLOAT_BIGNUM \ + MATH_DISPATCH2_LABEL(t_doublefloat,t_bignum) +#define CASE_DOUBLE_FLOAT_RATIO \ + MATH_DISPATCH2_LABEL(t_doublefloat,t_ratio) +#define CASE_DOUBLE_FLOAT_SINGLE_FLOAT \ + MATH_DISPATCH2_LABEL(t_doublefloat,t_singlefloat) +#define CASE_DOUBLE_FLOAT_DOUBLE_FLOAT \ + MATH_DISPATCH2_LABEL(t_doublefloat,t_doublefloat) +#define CASE_DOUBLE_FLOAT_LONG_FLOAT \ + MATH_DISPATCH2_LABEL(t_doublefloat,t_longfloat) +#define CASE_DOUBLE_FLOAT_COMPLEX \ + MATH_DISPATCH2_LABEL(t_doublefloat,t_complex) + +#define CASE_SINGLE_FLOAT_FIXNUM \ + MATH_DISPATCH2_LABEL(t_singlefloat,t_fixnum) +#define CASE_SINGLE_FLOAT_BIGNUM \ + MATH_DISPATCH2_LABEL(t_singlefloat,t_bignum) +#define CASE_SINGLE_FLOAT_RATIO \ + MATH_DISPATCH2_LABEL(t_singlefloat,t_ratio) +#define CASE_SINGLE_FLOAT_SINGLE_FLOAT \ + MATH_DISPATCH2_LABEL(t_singlefloat,t_singlefloat) +#define CASE_SINGLE_FLOAT_DOUBLE_FLOAT \ + MATH_DISPATCH2_LABEL(t_singlefloat,t_doublefloat) +#define CASE_SINGLE_FLOAT_LONG_FLOAT \ + MATH_DISPATCH2_LABEL(t_singlefloat,t_longfloat) +#define CASE_SINGLE_FLOAT_COMPLEX \ + MATH_DISPATCH2_LABEL(t_singlefloat,t_complex) + +#define CASE_RATIO_FIXNUM \ + MATH_DISPATCH2_LABEL(t_ratio,t_fixnum) +#define CASE_RATIO_BIGNUM \ + MATH_DISPATCH2_LABEL(t_ratio,t_bignum) +#define CASE_RATIO_RATIO \ + MATH_DISPATCH2_LABEL(t_ratio,t_ratio) +#define CASE_RATIO_SINGLE_FLOAT \ + MATH_DISPATCH2_LABEL(t_ratio,t_singlefloat) +#define CASE_RATIO_DOUBLE_FLOAT \ + MATH_DISPATCH2_LABEL(t_ratio,t_doublefloat) +#define CASE_RATIO_LONG_FLOAT \ + MATH_DISPATCH2_LABEL(t_ratio,t_longfloat) +#define CASE_RATIO_COMPLEX \ + MATH_DISPATCH2_LABEL(t_ratio,t_complex) + +#define CASE_BIGNUM_FIXNUM \ + MATH_DISPATCH2_LABEL(t_bignum,t_fixnum) +#define CASE_BIGNUM_BIGNUM \ + MATH_DISPATCH2_LABEL(t_bignum,t_bignum) +#define CASE_BIGNUM_RATIO \ + MATH_DISPATCH2_LABEL(t_bignum,t_ratio) +#define CASE_BIGNUM_SINGLE_FLOAT \ + MATH_DISPATCH2_LABEL(t_bignum,t_singlefloat) +#define CASE_BIGNUM_DOUBLE_FLOAT \ + MATH_DISPATCH2_LABEL(t_bignum,t_doublefloat) +#define CASE_BIGNUM_LONG_FLOAT \ + MATH_DISPATCH2_LABEL(t_bignum,t_longfloat) +#define CASE_BIGNUM_COMPLEX \ + MATH_DISPATCH2_LABEL(t_bignum,t_complex) + +#define CASE_FIXNUM_FIXNUM \ + MATH_DISPATCH2_LABEL(t_fixnum,t_fixnum) +#define CASE_FIXNUM_BIGNUM \ + MATH_DISPATCH2_LABEL(t_fixnum,t_bignum) +#define CASE_FIXNUM_RATIO \ + MATH_DISPATCH2_LABEL(t_fixnum,t_ratio) +#define CASE_FIXNUM_SINGLE_FLOAT \ + MATH_DISPATCH2_LABEL(t_fixnum,t_singlefloat) +#define CASE_FIXNUM_DOUBLE_FLOAT \ + MATH_DISPATCH2_LABEL(t_fixnum,t_doublefloat) +#define CASE_FIXNUM_LONG_FLOAT \ + MATH_DISPATCH2_LABEL(t_fixnum,t_longfloat) +#define CASE_FIXNUM_COMPLEX \ + MATH_DISPATCH2_LABEL(t_fixnum,t_complex) +#define CASE_UNKNOWN(routine,x,y,type) \ + default: DISPATCH2_ERROR: \ + if (!ecl_numberp(x)) \ + FEwrong_type_nth_arg(routine, 1, x, type); \ + else \ + FEwrong_type_nth_arg(routine, 2, y, type) + +#endif /* ECL_MATH_DISPATCH2_H */