This is num_arith.c in view mode; [Download] [Up]
/* (c) Copyright Taiichi Yuasa and Masami Hagiya, 1984. All rights reserved. Copying of this file is authorized to users who have executed the true and proper "License Agreement for Kyoto Common LISP" with SIGLISP. */ /* Arithmetic operations */ #include "include.h" #include "mp.h" #include "num_include.h" object bignum2(most, least) int most, least; { static long u [4] = {0x01010004 ,0x01010004, 0,0}; GEN w; int l; if(most) {setlgef(u,4),l=4;} else {l=3; setlgef(u,3);} MP_START_LOW(w,u,l); MP_NEXT_UP(w) = least; if (most) MP_NEXT_UP(w) = most; return make_integer(u); } object fixnum_times(i, j) int i, j; { MPOP(return,mulss,i,j); } object number_to_complex(x) object x; { object z; switch (type_of(x)) { case t_fixnum: case t_bignum: case t_ratio: case t_shortfloat: case t_longfloat: z = alloc_object(t_complex); z->cmp.cmp_real = x; z->cmp.cmp_imag = small_fixnum(0); return(z); case t_complex: return(x); default: FEwrong_type_argument(Snumber, x); } } object number_plus(x, y) object x, y; { int i, j, k; double dx, dy; object z, z1; vs_mark; switch (type_of(x)) { case t_fixnum: switch(type_of(y)) { case t_fixnum: MPOP(return, addss,fix(x),fix(y)); case t_bignum: MPOP(return, addsi,fix(x),MP(y)); case t_ratio: vs_push(number_times(x, y->rat.rat_den)); z = number_plus(vs_top[-1], y->rat.rat_num); vs_push(z); z = make_ratio(z, y->rat.rat_den); vs_reset; return(z); case t_shortfloat: dx = (double)(fix(x)); dy = (double)(sf(y)); goto SHORTFLOAT; case t_longfloat: dx = (double)(fix(x)); dy = lf(y); goto LONGFLOAT; case t_complex: goto COMPLEX; default: FEwrong_type_argument(Snumber, y); } case t_bignum: switch (type_of(y)) { case t_fixnum: MPOP(return,addsi,fix(y),MP(x)); case t_bignum: MPOP(return,addii,MP(y),MP(x)); case t_ratio: vs_push(number_times(x, y->rat.rat_den)); z = number_plus(vs_top[-1], y->rat.rat_num); vs_push(z); z = make_ratio(z, y->rat.rat_den); vs_reset; return(z); case t_shortfloat: dx = number_to_double(x); dy = (double)(sf(y)); goto SHORTFLOAT; case t_longfloat: dx = number_to_double(x); dy = lf(y); goto LONGFLOAT; case t_complex: goto COMPLEX; default: FEwrong_type_argument(Snumber, y); } case t_ratio: switch (type_of(y)) { case t_fixnum: case t_bignum: vs_push(number_times(x->rat.rat_den, y)); z = number_plus(x->rat.rat_num, vs_top[-1]); vs_push(z); z = make_ratio(z, x->rat.rat_den); vs_reset; return(z); case t_ratio: vs_push(number_times(x->rat.rat_num,y->rat.rat_den)); vs_push(number_times(x->rat.rat_den,y->rat.rat_num)); z = number_plus(vs_top[-2], vs_top[-1]); vs_push(z); vs_push(number_times(x->rat.rat_den,y->rat.rat_den)); z = make_ratio(z, vs_top[-1]); vs_reset; return(z); case t_shortfloat: dx = number_to_double(x); dy = (double)(sf(y)); goto SHORTFLOAT; case t_longfloat: dx = number_to_double(x); dy = lf(y); goto LONGFLOAT; case t_complex: goto COMPLEX; default: FEwrong_type_argument(Snumber, y); } case t_shortfloat: switch (type_of(y)) { case t_fixnum: dx = (double)(sf(x)); dy = (double)(fix(y)); goto SHORTFLOAT; case t_shortfloat: dx = (double)(sf(x)); dy = (double)(sf(y)); goto SHORTFLOAT; case t_longfloat: dx = (double)(sf(x)); dy = lf(y); goto LONGFLOAT; case t_complex: goto COMPLEX; default: dx = (double)(sf(x)); dy = number_to_double(y); goto SHORTFLOAT; } SHORTFLOAT: z = alloc_object(t_shortfloat); sf(z) = (shortfloat)(dx + dy); return(z); case t_longfloat: dx = lf(x); switch (type_of(y)) { case t_fixnum: dy = (double)(fix(y)); goto LONGFLOAT; case t_shortfloat: dy = (double)(sf(y)); goto LONGFLOAT; case t_longfloat: dy = lf(y); goto LONGFLOAT; case t_complex: goto COMPLEX; default: dy = number_to_double(y); goto LONGFLOAT; } LONGFLOAT: z = alloc_object(t_longfloat); lf(z) = dx + dy; return(z); case t_complex: COMPLEX: x = number_to_complex(x); vs_push(x); y = number_to_complex(y); vs_push(y); vs_push(number_plus(x->cmp.cmp_real, y->cmp.cmp_real)); vs_push(number_plus(x->cmp.cmp_imag, y->cmp.cmp_imag)); z = make_complex(vs_top[-2], vs_top[-1]); vs_reset; return(z); default: FEwrong_type_argument(Snumber, x); } } object one_plus(x) object x; { int i; double dx; object z, z1; vs_mark; switch (type_of(x)) { case t_fixnum: MPOP(return, addss,1,fix(x)); case t_bignum: MPOP(return, addsi,1,MP(x)); case t_ratio: z = number_plus(x->rat.rat_num, x->rat.rat_den); vs_push(z); z = make_ratio(z, x->rat.rat_den); vs_reset; return(z); case t_shortfloat: dx = (double)(sf(x)); z = alloc_object(t_shortfloat); sf(z) = (shortfloat)(dx + 1.0); return(z); case t_longfloat: dx = lf(x); z = alloc_object(t_longfloat); lf(z) = dx + 1.0; return(z); case t_complex: COMPLEX: vs_push(one_plus(x->cmp.cmp_real)); z = make_complex(vs_top[-1], x->cmp.cmp_imag); vs_reset; return(z); default: FEwrong_type_argument(Snumber, x); } } object number_minus(x, y) object x, y; { int i, j, k; double dx, dy; object z, z1; vs_mark; switch (type_of(x)) { case t_fixnum: switch(type_of(y)) { #define MOST_NEG_FIXNUM (1 << 31) case t_fixnum: MPOP(return,subss,fix(x),fix(y)); case t_bignum: MPOP(return, subsi,fix(x),MP(y)); case t_ratio: vs_push(number_times(x, y->rat.rat_den)); z = number_minus(vs_top[-1], y->rat.rat_num); vs_push(z); z = make_ratio(z, y->rat.rat_den); vs_reset; return(z); case t_shortfloat: dx = (double)(fix(x)); dy = (double)(sf(y)); goto SHORTFLOAT; case t_longfloat: dx = (double)(fix(x)); dy = lf(y); goto LONGFLOAT; case t_complex: goto COMPLEX; default: FEwrong_type_argument(Snumber, y); } case t_bignum: switch (type_of(y)) { case t_fixnum: MPOP(return,subis,MP(x),fix(y)); case t_bignum: MPOP(return,subii,MP(x),MP(y)); case t_ratio: vs_push(number_times(x, y->rat.rat_den)); z = number_minus(vs_top[-1], y->rat.rat_num); vs_push(z); z = make_ratio(z, y->rat.rat_den); vs_reset; return(z); case t_shortfloat: dx = number_to_double(x); dy = (double)(sf(y)); goto SHORTFLOAT; case t_longfloat: dx = number_to_double(x); dy = lf(y); goto LONGFLOAT; case t_complex: goto COMPLEX; default: FEwrong_type_argument(Snumber, y); } case t_ratio: switch (type_of(y)) { case t_fixnum: case t_bignum: vs_push(number_times(x->rat.rat_den, y)); z = number_minus(x->rat.rat_num, vs_top[-1]); vs_push(z); z = make_ratio(z, x->rat.rat_den); vs_reset; return(z); case t_ratio: vs_push(number_times(x->rat.rat_num,y->rat.rat_den)); vs_push(number_times(x->rat.rat_den,y->rat.rat_num)); z = number_minus(vs_top[-2], vs_top[-1]); vs_push(z); vs_push(number_times(x->rat.rat_den,y->rat.rat_den)); z = make_ratio(z, vs_top[-1]); vs_reset; return(z); case t_shortfloat: dx = number_to_double(x); dy = (double)(sf(y)); goto SHORTFLOAT; case t_longfloat: dx = number_to_double(x); dy = lf(y); goto LONGFLOAT; case t_complex: goto COMPLEX; default: FEwrong_type_argument(Snumber, y); } case t_shortfloat: switch (type_of(y)) { case t_fixnum: dx = (double)(sf(x)); dy = (double)(fix(y)); goto SHORTFLOAT; case t_shortfloat: dx = (double)(sf(x)); dy = (double)(sf(y)); goto SHORTFLOAT; case t_longfloat: dx = (double)(sf(x)); dy = lf(y); goto LONGFLOAT; case t_complex: goto COMPLEX; default: dx = (double)(sf(x)); dy = number_to_double(y); goto SHORTFLOAT; } SHORTFLOAT: z = alloc_object(t_shortfloat); sf(z) = (shortfloat)(dx - dy); return(z); case t_longfloat: dx = lf(x); switch (type_of(y)) { case t_fixnum: dy = (double)(fix(y)); goto LONGFLOAT; case t_shortfloat: dy = (double)(sf(y)); goto LONGFLOAT; case t_longfloat: dy = lf(y); goto LONGFLOAT; case t_complex: goto COMPLEX; default: dy = number_to_double(y); } LONGFLOAT: z = alloc_object(t_longfloat); lf(z) = dx - dy; return(z); case t_complex: COMPLEX: x = number_to_complex(x); vs_push(x); y = number_to_complex(y); vs_push(y); vs_push(number_minus(x->cmp.cmp_real, y->cmp.cmp_real)); vs_push(number_minus(x->cmp.cmp_imag, y->cmp.cmp_imag)); z = make_complex(vs_top[-2], vs_top[-1]); vs_reset; return(z); default: FEwrong_type_argument(Snumber, x); } } object one_minus(x) object x; { int i; double dx; object z, z1; vs_mark; switch (type_of(x)) { case t_fixnum: MPOP(return,addss,fix(x),-1); case t_bignum: MPOP(return,addsi,-1,MP(x)); case t_ratio: z = number_minus(x->rat.rat_num, x->rat.rat_den); vs_push(z); z = make_ratio(z, x->rat.rat_den); vs_reset; return(z); case t_shortfloat: dx = (double)(sf(x)); z = alloc_object(t_shortfloat); sf(z) = (shortfloat)(dx - 1.0); return(z); case t_longfloat: dx = lf(x); z = alloc_object(t_longfloat); lf(z) = dx - 1.0; return(z); case t_complex: COMPLEX: vs_push(one_minus(x->cmp.cmp_real)); z = make_complex(vs_top[-1], x->cmp.cmp_imag); vs_reset; return(z); default: FEwrong_type_argument(Snumber, x); } } object number_negate(x) object x; { object z, z1; vs_mark; switch (type_of(x)) { case t_fixnum: if(fix(x) == MOST_NEGATIVE_FIX) return make_bignum(ABS_MOST_NEGS); else return(make_fixnum(-fix(x))); case t_bignum: return big_minus(x); case t_ratio: z1 = number_negate(x->rat.rat_num); vs_push(z1); z = alloc_object(t_ratio); z->rat.rat_num = z1; z->rat.rat_den = x->rat.rat_den; vs_reset; return(z); case t_shortfloat: z = alloc_object(t_shortfloat); sf(z) = -sf(x); return(z); case t_longfloat: z = alloc_object(t_longfloat); lf(z) = -lf(x); return(z); case t_complex: vs_push(number_negate(x->cmp.cmp_real)); vs_push(number_negate(x->cmp.cmp_imag)); z = make_complex(vs_top[-2], vs_top[-1]); vs_reset; return(z); default: FEwrong_type_argument(Snumber, x); } } object number_times(x, y) object x, y; { object z; double dx, dy; vs_mark; switch (type_of(x)) { case t_fixnum: switch (type_of(y)) { case t_fixnum: MPOP(return,mulss,fix(x),fix(y)); case t_bignum: MPOP(return,mulsi,fix(x),MP(y)); case t_ratio: vs_push(number_times(x, y->rat.rat_num)); z = make_ratio(vs_top[-1], y->rat.rat_den); vs_reset; return(z); case t_shortfloat: dx = (double)(fix(x)); dy = (double)(sf(y)); goto SHORTFLOAT; case t_longfloat: dx = (double)(fix(x)); dy = lf(y); goto LONGFLOAT; case t_complex: goto COMPLEX; default: FEwrong_type_argument(Snumber, y); } case t_bignum: switch (type_of(y)) { case t_fixnum: MPOP(return,mulsi,fix(y),MP(x)); case t_bignum: MPOP(return,mulii,MP(y),MP(x)); case t_ratio: vs_push(number_times(x, y->rat.rat_num)); z = make_ratio(vs_top[-1], y->rat.rat_den); vs_reset; return(z); case t_shortfloat: dx = number_to_double(x); dy = (double)(sf(y)); goto SHORTFLOAT; case t_longfloat: dx = number_to_double(x); dy = lf(y); goto LONGFLOAT; case t_complex: goto COMPLEX; default: FEwrong_type_argument(Snumber, y); } case t_ratio: switch (type_of(y)) { case t_fixnum: case t_bignum: vs_push(number_times(x->rat.rat_num, y)); z = make_ratio(vs_top[-1], x->rat.rat_den); vs_reset; return(z); case t_ratio: vs_push(number_times(x->rat.rat_num,y->rat.rat_num)); vs_push(number_times(x->rat.rat_den,y->rat.rat_den)); z = make_ratio(vs_top[-2], vs_top[-1]); vs_reset; return(z); case t_shortfloat: dx = number_to_double(x); dy = (double)(sf(y)); goto SHORTFLOAT; case t_longfloat: dx = number_to_double(x); dy = lf(y); goto LONGFLOAT; case t_complex: goto COMPLEX; default: FEwrong_type_argument(Snumber, y); } case t_shortfloat: switch (type_of(y)) { case t_fixnum: dx = (double)(sf(x)); dy = (double)(fix(y)); goto SHORTFLOAT; case t_shortfloat: dx = (double)(sf(x)); dy = (double)(sf(y)); goto SHORTFLOAT; case t_longfloat: dx = (double)(sf(x)); dy = lf(y); goto LONGFLOAT; case t_complex: goto COMPLEX; default: dx = (double)(sf(x)); dy = number_to_double(y); break; } SHORTFLOAT: z = alloc_object(t_shortfloat); sf(z) = (shortfloat)(dx * dy); return(z); case t_longfloat: dx = lf(x); switch (type_of(y)) { case t_fixnum: dy = (double)(fix(y)); goto LONGFLOAT; case t_shortfloat: dy = (double)(sf(y)); goto LONGFLOAT; case t_longfloat: dy = lf(y); goto LONGFLOAT; case t_complex: goto COMPLEX; default: dy = number_to_double(y); } LONGFLOAT: z = alloc_object(t_longfloat); lf(z) = dx * dy; return(z); case t_complex: COMPLEX: { object z1, z2, z11, z12, z21, z22; x = number_to_complex(x); vs_push(x); y = number_to_complex(y); vs_push(y); z11 = number_times(x->cmp.cmp_real, y->cmp.cmp_real); vs_push(z11); z12 = number_times(x->cmp.cmp_imag, y->cmp.cmp_imag); vs_push(z12); z21 = number_times(x->cmp.cmp_imag, y->cmp.cmp_real); vs_push(z21); z22 = number_times(x->cmp.cmp_real, y->cmp.cmp_imag); vs_push(z22); z1 = number_minus(z11, z12); vs_push(z1); z2 = number_plus(z21, z22); vs_push(z2); z = make_complex(z1, z2); vs_reset; return(z); } default: FEwrong_type_argument(Snumber, x); } } object number_divide(x, y) object x, y; { object z; double dx, dy; vs_mark; switch (type_of(x)) { case t_fixnum: case t_bignum: switch (type_of(y)) { case t_fixnum: case t_bignum: if(number_zerop(y) == TRUE) zero_divisor(); if (number_minusp(y) == TRUE) { x = number_negate(x); vs_push(x); y = number_negate(y); vs_push(y); } z = make_ratio(x, y); vs_reset; return(z); case t_ratio: if(number_zerop(y->rat.rat_num)) zero_divisor(); vs_push(number_times(x, y->rat.rat_den)); z = make_ratio(vs_top[-1], y->rat.rat_num); vs_reset; return(z); case t_shortfloat: dx = number_to_double(x); dy = (double)(sf(y)); goto SHORTFLOAT; case t_longfloat: dx = number_to_double(x); dy = lf(y); goto LONGFLOAT; case t_complex: goto COMPLEX; default: FEwrong_type_argument(Snumber, y); } case t_ratio: switch (type_of(y)) { case t_fixnum: case t_bignum: if (number_zerop(y)) zero_divisor(); vs_push(number_times(x->rat.rat_den, y)); z = make_ratio(x->rat.rat_num, vs_top[-1]); vs_reset; return(z); case t_ratio: vs_push(number_times(x->rat.rat_num,y->rat.rat_den)); vs_push(number_times(x->rat.rat_den,y->rat.rat_num)); z = make_ratio(vs_top[-2], vs_top[-1]); vs_reset; return(z); case t_shortfloat: dx = number_to_double(x); dy = (double)(sf(y)); goto SHORTFLOAT; case t_longfloat: dx = number_to_double(x); dy = lf(y); goto LONGFLOAT; case t_complex: goto COMPLEX; default: FEwrong_type_argument(Snumber, y); } case t_shortfloat: switch (type_of(y)) { case t_fixnum: dx = (double)(sf(x)); dy = (double)(fix(y)); goto SHORTFLOAT; case t_shortfloat: dx = (double)(sf(x)); dy = (double)(sf(y)); goto SHORTFLOAT; case t_longfloat: dx = (double)(sf(x)); dy = lf(y); goto LONGFLOAT; case t_complex: goto COMPLEX; default: dx = (double)(sf(x)); dy = number_to_double(y); goto LONGFLOAT; } SHORTFLOAT: z = alloc_object(t_shortfloat); if (dy == 0.0) zero_divisor(); sf(z) = (shortfloat)(dx / dy); return(z); case t_longfloat: dx = lf(x); switch (type_of(y)) { case t_fixnum: dy = (double)(fix(y)); goto LONGFLOAT; case t_shortfloat: dy = (double)(sf(y)); goto LONGFLOAT; case t_longfloat: dy = lf(y); goto LONGFLOAT; case t_complex: goto COMPLEX; default: dy = number_to_double(y); } LONGFLOAT: z = alloc_object(t_longfloat); if (dy == 0.0) zero_divisor(); lf(z) = dx / dy; return(z); case t_complex: COMPLEX: { object z1, z2, z3; x = number_to_complex(x); vs_push(x); y = number_to_complex(y); vs_push(y); z1 = number_times(y->cmp.cmp_real, y->cmp.cmp_real); vs_push(z1); z2 = number_times(y->cmp.cmp_imag, y->cmp.cmp_imag); vs_push(z2); if (number_zerop(z3 = number_plus(z1, z2))) zero_divisor(); vs_push(z3); z1 = number_times(x->cmp.cmp_real, y->cmp.cmp_real); vs_push(z1); z2 = number_times(x->cmp.cmp_imag, y->cmp.cmp_imag); vs_push(z2); z1 = number_plus(z1, z2); vs_push(z1); z = number_times(x->cmp.cmp_imag, y->cmp.cmp_real); vs_push(z); z2 = number_times(x->cmp.cmp_real, y->cmp.cmp_imag); vs_push(z2); z2 = number_minus(z, z2); vs_push(z2); z1 = number_divide(z1, z3); vs_push(z1); z2 = number_divide(z2, z3); vs_push(z2); z = make_complex(z1, z2); vs_reset; return(z); } default: FEwrong_type_argument(Snumber, x); } } integer_quotient_remainder_1(x, y, qp, rp) object x, y; object *qp, *rp; { GEN res,quot,x0,y0; save_avma; if (type_of(x)==t_fixnum) x0 = stoi(fix(x)); else x0=MP(x); if (type_of(y)==t_fixnum) y0 = stoi(fix(y)); else y0=MP(y); res = dvmdii(x0,y0,"); restore_avma; *qp = make_integer(res); *rp = make_integer(quot); return; } /* old integer_quotient_remainder_1(x, y, qp, rp) object x, y; object *qp, *rp; { enum type tx, ty; int i, j, q, r; vs_mark; tx = type_of(x); ty = type_of(y); if (tx == t_fixnum) { if (ty == t_fixnum) { if (fix(y) == 0) zero_divisor(); if (fix(y) == MOST_NEGATIVE_FIX) if (fix(x) == MOST_NEGATIVE_FIX) { *qp = small_fixnum(1); *rp = small_fixnum(0); return; } else { *qp = small_fixnum(0); *rp = x; return; } if (fix(x) == MOST_NEGATIVE_FIX) { if (fix(y) == 1) { *qp = x; *rp = small_fixnum(0); return; } if (fix(y) == -1) { *qp = bignum2(1, 0); *rp = small_fixnum(0); return; } if (fix(y) > 0) { extended_div(fix(y), 1, 0, &q, &r); *qp = make_fixnum(-q); vs_push(*qp); *rp = make_fixnum(-r); vs_reset; return; } else { extended_div(-fix(y), 1, 0, &q, &r); *qp = make_fixnum(q); vs_push(*qp); *rp = make_fixnum(-r); vs_reset; return; } } *qp = make_fixnum(fix(x) / fix(y)); vs_push(*qp); *rp = make_fixnum(fix(x) % fix(y)); vs_reset; return; } if (ty == t_bignum) { if (fix(x) == MOST_NEGATIVE_FIX && MP(y)[2] == MOST_NEGATIVE_FIX && lgef(MP(y)) == 1 && signe(MP(y)) < 0) { *qp = small_fixnum(-1); *rp = small_fixnum(0); return; } *qp = small_fixnum(0); *rp = x; return; } else FEwrong_type_argument(Sinteger, y); } if (tx == t_bignum) { if (ty == t_fixnum) { MPOP(*qp = ,divis,MP(x),fix(y)); *rp = make_fixnum(hiremainder); return; } else if (ty == t_bignum) #define Dvmdii(a,b) dvmdii(a,b,&p1) {GEN p1; MPOP(*qp = ,dvmdii,MP(x),MP(y)); *rp = make_integer(p1); return;} else FEwrong_type_argument(Sinteger, y); } FEwrong_type_argument(Sinteger, x); } */ object integer_divide1(x, y) object x, y; { object q, r; integer_quotient_remainder_1(x, y, &q, &r); return(q); } object get_gcd(x, y) object x, y; { int i, j, k; object q, r; vs_mark; if (number_minusp(x)) x = number_negate(x); vs_push(x); if (number_minusp(y)) y = number_negate(y); vs_push(y); L: if (type_of(x) == t_fixnum && type_of(y) == t_fixnum) { i = fix(x); j = fix(y); LL: if (i < j) { k = i; i = j; j = k; } if (j == 0) { vs_reset; return(make_fixnum(i)); } k = i % j; i = j; j = k; goto LL; } if (number_compare(x, y) < 0) { r = x; x = y; y = r; } if (type_of(y) == t_fixnum && fix(y) == 0) { vs_reset; return(x); } integer_quotient_remainder_1(x, y, &q, &r); vs_top[-2] = x = y; vs_top[-1] = y = r; goto L; } /* (+ ) */ Lplus() { int i, j; j = vs_top - vs_base; if (j == 0) { vs_push(small_fixnum(0)); return; } for (i = 0; i < j; i++) check_type_number(&vs_base[i]); for (i = 1; i < j; i++) vs_base[0] = number_plus(vs_base[0], vs_base[i]); vs_top = vs_base+1; } Lminus() { int i, j; j = vs_top - vs_base; if (j == 0) too_few_arguments(); for (i = 0; i < j ; i++) check_type_number(&vs_base[i]); if (j == 1) { vs_base[0] = number_negate(vs_base[0]); return; } for (i = 1; i < j; i++) vs_base[0] = number_minus(vs_base[0], vs_base[i]); vs_top = vs_base+1; } Ltimes() { int i, j; j = vs_top - vs_base; if (j == 0) { vs_push(small_fixnum(1)); return; } for (i = 0; i < j; i++) check_type_number(&vs_base[i]); for (i = 1; i < j; i++) vs_base[0] = number_times(vs_base[0], vs_base[i]); vs_top = vs_base+1; } Ldivide() { int i, j; j = vs_top - vs_base; if (j == 0) too_few_arguments(); for(i = 0; i < j; i++) check_type_number(&vs_base[i]); if (j == 1) { vs_base[0] = number_divide(small_fixnum(1), vs_base[0]); return; } for (i = 1; i < j; i++) vs_base[0] = number_divide(vs_base[0], vs_base[i]); vs_top = vs_base+1; } Lone_plus() { object x; check_arg(1); check_type_number(&vs_base[0]); vs_base[0] = one_plus(vs_base[0]); } Lone_minus() { object x; check_arg(1); check_type_number(&vs_base[0]); vs_base[0] = one_minus(vs_base[0]); } Lconjugate() { object c, i; check_arg(1); check_type_number(&vs_base[0]); c = vs_base[0]; if (type_of(c) == t_complex) { i = number_negate(c->cmp.cmp_imag); vs_push(i); vs_base[0] = make_complex(c->cmp.cmp_real, i); vs_pop; } } Lgcd() { int i, narg; narg = vs_top - vs_base; if (narg == 0) { vs_push(small_fixnum(0)); return; } for (i = 0; i < narg; i++) check_type_integer(&vs_base[i]); if (narg == 1) { if (number_minusp(vs_base[0])) vs_base[0] = number_negate(vs_base[0]); return; } for (i = 1; i < narg; i++) vs_base[0] = get_gcd(vs_base[0], vs_base[i]); vs_top = vs_base+1; } Llcm() { object t, g; int i, narg; narg = vs_top - vs_base; if (narg == 0) too_few_arguments(); for (i = 0; i < narg; i++) check_type_integer(&vs_base[i]); if (narg == 1) { if (number_minusp(vs_base[0])) vs_base[0] = number_negate(vs_base[0]); return; } for (i = 1; i < narg; i++) { t = number_times(vs_base[0], vs_base[i]); vs_push(t); g = get_gcd(vs_base[0], vs_base[i]); vs_push(g); vs_base[0] = number_divide(t, g); vs_pop; vs_pop; } if (number_minusp(vs_base[0])) vs_base[0] = number_negate(vs_base[0]); vs_top = vs_base+1; } zero_divisor() { FEerror("Zero divisor.", 0); } init_num_arith() { make_function("+", Lplus); make_function("-", Lminus); make_function("*", Ltimes); make_function("/", Ldivide); make_function("1+", Lone_plus); make_function("1-", Lone_minus); make_function("CONJUGATE", Lconjugate); make_function("GCD", Lgcd); make_function("LCM", Llcm); }
These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.