/* * arccosh(x) == log [ x + sqrt(x^2 - 1) ] * * x >= 1.0 */ void m_apm_arccosh(M_APM rr, int places, M_APM aa) { M_APM tmp1, tmp2; int ii; ii = m_apm_compare(aa, MM_One); if (ii == -1) /* x < 1 */ { M_apm_log_error_msg(M_APM_RETURN, "\'m_apm_arccosh\', Argument < 1"); M_set_to_zero(rr); return; } tmp1 = M_get_stack_var(); tmp2 = M_get_stack_var(); m_apm_multiply(tmp1, aa, aa); m_apm_subtract(tmp2, tmp1, MM_One); m_apm_sqrt(tmp1, (places + 6), tmp2); m_apm_add(tmp2, aa, tmp1); m_apm_log(rr, places, tmp2); M_restore_stack(2); }
void M_apm_round_fixpt(M_APM btmp, int places, M_APM atmp) { int xp, ii; xp = atmp->m_apm_exponent; ii = xp + places - 1; M_set_to_zero(btmp); /* assume number is too small so the net result is 0 */ if (ii >= 0) { m_apm_round(btmp, ii, atmp); } else { if (ii == -1) /* next digit is significant which may round up */ { if (atmp->m_apm_data[0] >= 50) /* digit >= 5, round up */ { m_apm_copy(btmp, atmp); btmp->m_apm_data[0] = 10; btmp->m_apm_exponent += 1; btmp->m_apm_datalength = 1; M_apm_normalize(btmp); } } } }
void m_apm_integer_divide(M_APM rr, M_APM aa, M_APM bb) { /* * we must use this divide function since the * faster divide function using the reciprocal * will round the result (possibly changing * nnm.999999... --> nn(m+1).0000 which would * invalidate the 'integer_divide' goal). */ if (aa->m_apm_error || bb->m_apm_error) { M_set_to_error(rr); return; } M_apm_sdivide(rr, 4, aa, bb); if (rr->m_apm_exponent <= 0) /* result is 0 */ { M_set_to_zero(rr); } else { if (rr->m_apm_datalength > rr->m_apm_exponent) { rr->m_apm_datalength = rr->m_apm_exponent; M_apm_normalize(rr); } } }
/* Calculate arctan using the identity : x arctan (x) == arcsin [ --------------- ] sqrt(1 + x^2) */ void m_apm_arctan(M_APM rr, int places, M_APM xx) { M_APM tmp8, tmp9; if (xx->m_apm_sign == 0) /* input == 0 ?? */ { M_set_to_zero(rr); return; } if (xx->m_apm_exponent <= -4) /* input close to 0 ?? */ { M_arctan_near_0(rr, places, xx); return; } if (xx->m_apm_exponent >= 4) /* large input */ { M_arctan_large_input(rr, places, xx); return; } tmp8 = M_get_stack_var(); tmp9 = M_get_stack_var(); m_apm_multiply(tmp9, xx, xx); m_apm_add(tmp8, tmp9, MM_One); m_apm_sqrt(tmp9, (places + 6), tmp8); m_apm_divide(tmp8, (places + 6), xx, tmp9); m_apm_arcsin(rr, places, tmp8); M_restore_stack(2); }
/* * arctanh(x) == 0.5 * log [ (1 + x) / (1 - x) ] * * |x| < 1.0 */ void m_apm_arctanh(M_APM rr, int places, M_APM aa) { M_APM tmp1, tmp2, tmp3; int ii, local_precision; tmp1 = M_get_stack_var(); m_apm_absolute_value(tmp1, aa); ii = m_apm_compare(tmp1, MM_One); if (ii >= 0) /* |x| >= 1.0 */ { M_apm_log_error_msg(M_APM_RETURN, "\'m_apm_arctanh\', |Argument| >= 1"); M_set_to_zero(rr); M_restore_stack(1); return; } tmp2 = M_get_stack_var(); tmp3 = M_get_stack_var(); local_precision = places + 8; m_apm_add(tmp1, MM_One, aa); m_apm_subtract(tmp2, MM_One, aa); m_apm_divide(tmp3, local_precision, tmp1, tmp2); m_apm_log(tmp2, local_precision, tmp3); m_apm_multiply(tmp1, tmp2, MM_0_5); m_apm_round(rr, places, tmp1); M_restore_stack(3); }
/* * arcsinh(x) == log [ x + sqrt(x^2 + 1) ] * * also, use arcsinh(-x) == -arcsinh(x) */ void m_apm_arcsinh(M_APM rr, int places, M_APM aa) { M_APM tmp0, tmp1, tmp2; /* result is 0 if input is 0 */ if (aa->m_apm_sign == 0) { M_set_to_zero(rr); return; } tmp0 = M_get_stack_var(); tmp1 = M_get_stack_var(); tmp2 = M_get_stack_var(); m_apm_absolute_value(tmp0, aa); m_apm_multiply(tmp1, tmp0, tmp0); m_apm_add(tmp2, tmp1, MM_One); m_apm_sqrt(tmp1, (places + 6), tmp2); m_apm_add(tmp2, tmp0, tmp1); m_apm_log(rr, places, tmp2); rr->m_apm_sign = aa->m_apm_sign; /* fix final sign */ M_restore_stack(3); }
void m_apm_divide(M_APM rr, int places, M_APM aa, M_APM bb) { M_APM tmp0, tmp1; int sn, nexp, dplaces; sn = aa->m_apm_sign * bb->m_apm_sign; if (sn == 0) /* one number is zero, result is zero */ { if (bb->m_apm_sign == 0) { M_apm_log_error_msg(M_APM_RETURN, "Warning! ... \'m_apm_divide\', Divide by 0"); } M_set_to_zero(rr); return; } /* * Use the original 'Knuth' method for smaller divides. On the * author's system, this was the *approx* break even point before * the reciprocal method used below became faster. */ if (places < 250) { M_apm_sdivide(rr, places, aa, bb); return; } /* mimic the decimal place behavior of the original divide */ nexp = aa->m_apm_exponent - bb->m_apm_exponent; if (nexp > 0) dplaces = nexp + places; else dplaces = places; tmp0 = M_get_stack_var(); tmp1 = M_get_stack_var(); m_apm_reciprocal(tmp0, (dplaces + 8), bb); m_apm_multiply(tmp1, tmp0, aa); m_apm_round(rr, dplaces, tmp1); M_restore_stack(2); }
/* * return the nearest integer <= input */ void m_apm_floor(M_APM bb, M_APM aa) { M_APM mtmp; m_apm_copy(bb, aa); if (m_apm_is_integer(bb)) /* if integer, we're done */ return; if (bb->m_apm_exponent <= 0) /* if |bb| < 1, result is -1 or 0 */ { if (bb->m_apm_sign < 0) m_apm_negate(bb, MM_One); else M_set_to_zero(bb); return; } if (bb->m_apm_sign < 0) { mtmp = M_get_stack_var(); m_apm_negate(mtmp, bb); mtmp->m_apm_datalength = mtmp->m_apm_exponent; M_apm_normalize(mtmp); m_apm_add(bb, mtmp, MM_One); bb->m_apm_sign = -1; M_restore_stack(1); } else { bb->m_apm_datalength = bb->m_apm_exponent; M_apm_normalize(bb); } }
void m_apm_reciprocal(M_APM rr, int places, M_APM aa) { M_APM last_x, guess, tmpN, tmp1, tmp2; int ii, bflag, dplaces, nexp, tolerance; if (aa->m_apm_sign == 0) { M_apm_log_error_msg(M_APM_RETURN, "Warning! ... \'m_apm_reciprocal\', Input = 0"); M_set_to_zero(rr); return; } last_x = M_get_stack_var(); guess = M_get_stack_var(); tmpN = M_get_stack_var(); tmp1 = M_get_stack_var(); tmp2 = M_get_stack_var(); m_apm_absolute_value(tmpN, aa); /* normalize the input number (make the exponent 0) so the 'guess' below will not over/under flow on large magnitude exponents. */ nexp = aa->m_apm_exponent; tmpN->m_apm_exponent -= nexp; m_apm_set_double(guess, (1.0 / m_apm_get_double(tmpN))); tolerance = places + 4; dplaces = places + 16; bflag = FALSE; m_apm_negate(last_x, MM_Ten); /* Use the following iteration to calculate the reciprocal : X = X * [ 2 - N * X ] n+1 */ ii = 0; while (TRUE) { m_apm_multiply(tmp1, tmpN, guess); m_apm_subtract(tmp2, MM_Two, tmp1); m_apm_multiply(tmp1, tmp2, guess); if (bflag) break; m_apm_round(guess, dplaces, tmp1); /* force at least 2 iterations so 'last_x' has valid data */ if (ii != 0) { m_apm_subtract(tmp2, guess, last_x); if (tmp2->m_apm_sign == 0) break; /* * if we are within a factor of 4 on the error term, * we will be accurate enough after the *next* iteration * is complete. */ if ((-4 * tmp2->m_apm_exponent) > tolerance) bflag = TRUE; } m_apm_copy(last_x, guess); ii++; } m_apm_round(rr, places, tmp1); rr->m_apm_exponent -= nexp; rr->m_apm_sign = aa->m_apm_sign; M_restore_stack(5); }
void m_apm_arccos(M_APM r, int places, M_APM x) { M_APM tmp0, tmp1, tmp2, tmp3, current_x; int ii, maxiter, maxp, tolerance, local_precision; current_x = M_get_stack_var(); tmp0 = M_get_stack_var(); tmp1 = M_get_stack_var(); tmp2 = M_get_stack_var(); tmp3 = M_get_stack_var(); m_apm_absolute_value(tmp0, x); ii = m_apm_compare(tmp0, MM_One); if (ii == 1) /* |x| > 1 */ { M_apm_log_error_msg(M_APM_RETURN, "\'m_apm_arccos\', |Argument| > 1"); M_set_to_zero(r); M_restore_stack(5); return; } if (ii == 0) /* |x| == 1, arccos = 0, PI */ { if (x->m_apm_sign == 1) { M_set_to_zero(r); } else { M_check_PI_places(places); m_apm_round(r, places, MM_lc_PI); } M_restore_stack(5); return; } if (m_apm_compare(tmp0, MM_0_85) == 1) /* check if > 0.85 */ { M_cos_to_sin(tmp2, (places + 4), x); if (x->m_apm_sign == 1) { m_apm_arcsin(r, places, tmp2); } else { M_check_PI_places(places); m_apm_arcsin(tmp3, (places + 4), tmp2); m_apm_subtract(tmp1, MM_lc_PI, tmp3); m_apm_round(r, places, tmp1); } M_restore_stack(5); return; } if (x->m_apm_sign == 0) /* input == 0 ?? */ { M_check_PI_places(places); m_apm_round(r, places, MM_lc_HALF_PI); M_restore_stack(5); return; } if (x->m_apm_exponent <= -4) /* input close to 0 ?? */ { M_arccos_near_0(r, places, x); M_restore_stack(5); return; } tolerance = -(places + 4); maxp = places + 8; local_precision = 18; /* * compute the maximum number of iterations * that should be needed to calculate to * the desired accuracy. [ constant below ~= 1 / log(2) ] */ maxiter = (int)(log((double)(places + 2)) * 1.442695) + 3; if (maxiter < 5) maxiter = 5; M_get_acos_guess(current_x, x); /* Use the following iteration to solve for arc-cos : cos(X) - N X = X + ------------ n+1 sin(X) */ ii = 0; while (TRUE) { M_4x_cos(tmp1, local_precision, current_x); M_cos_to_sin(tmp2, local_precision, tmp1); if (tmp2->m_apm_sign != 0) tmp2->m_apm_sign = current_x->m_apm_sign; m_apm_subtract(tmp3, tmp1, x); m_apm_divide(tmp0, local_precision, tmp3, tmp2); m_apm_add(tmp2, current_x, tmp0); m_apm_copy(current_x, tmp2); if (ii != 0) { if (((2 * tmp0->m_apm_exponent) < tolerance) || (tmp0->m_apm_sign == 0)) break; } if (++ii == maxiter) { M_apm_log_error_msg(M_APM_RETURN, "\'m_apm_arccos\', max iteration count reached"); break; } local_precision *= 2; if (local_precision > maxp) local_precision = maxp; } m_apm_round(r, places, current_x); M_restore_stack(5); }
void M_apm_sdivide(M_APM r, int places, M_APM a, M_APM b) { int j, k, m, b0, sign, nexp, indexr, icompare, iterations; long trial_numer; void *vp; if (M_div_firsttime) { M_div_firsttime = FALSE; M_div_worka = m_apm_init(); M_div_workb = m_apm_init(); M_div_tmp7 = m_apm_init(); M_div_tmp8 = m_apm_init(); M_div_tmp9 = m_apm_init(); } sign = a->m_apm_sign * b->m_apm_sign; if (sign == 0) /* one number is zero, result is zero */ { if (b->m_apm_sign == 0) { M_apm_log_error_msg(M_APM_RETURN, "\'M_apm_sdivide\', Divide by 0"); } M_set_to_zero(r); return; } /* * Knuth step D1. Since base = 100, base / 2 = 50. * (also make the working copies positive) */ if (b->m_apm_data[0] >= 50) { m_apm_absolute_value(M_div_worka, a); m_apm_absolute_value(M_div_workb, b); } else /* 'normal' step D1 */ { k = 100 / (b->m_apm_data[0] + 1); m_apm_set_long(M_div_tmp9, (long)k); m_apm_multiply(M_div_worka, M_div_tmp9, a); m_apm_multiply(M_div_workb, M_div_tmp9, b); M_div_worka->m_apm_sign = 1; M_div_workb->m_apm_sign = 1; } /* setup trial denominator for step D3 */ b0 = 100 * (int)M_div_workb->m_apm_data[0]; if (M_div_workb->m_apm_datalength >= 3) b0 += M_div_workb->m_apm_data[1]; nexp = M_div_worka->m_apm_exponent - M_div_workb->m_apm_exponent; if (nexp > 0) iterations = nexp + places + 1; else iterations = places + 1; k = (iterations + 1) >> 1; /* required size of result, in bytes */ if (k > r->m_apm_malloclength) { if ((vp = MAPM_REALLOC(r->m_apm_data, (k + 32))) == NULL) { /* fatal, this does not return */ M_apm_log_error_msg(M_APM_FATAL, "\'M_apm_sdivide\', Out of memory"); } r->m_apm_malloclength = k + 28; r->m_apm_data = (UCHAR *)vp; } /* clear the exponent in the working copies */ M_div_worka->m_apm_exponent = 0; M_div_workb->m_apm_exponent = 0; /* if numbers are equal, ratio == 1.00000... */ if ((icompare = m_apm_compare(M_div_worka, M_div_workb)) == 0) { iterations = 1; r->m_apm_data[0] = 10; nexp++; } else /* ratio not 1, do the real division */ { if (icompare == 1) /* numerator > denominator */ { nexp++; /* to adjust the final exponent */ M_div_worka->m_apm_exponent += 1; /* multiply numerator by 10 */ } else /* numerator < denominator */ { M_div_worka->m_apm_exponent += 2; /* multiply numerator by 100 */ } indexr = 0; m = 0; while (TRUE) { /* * Knuth step D3. Only use the 3rd -> 6th digits if the number * actually has that many digits. */ trial_numer = 10000L * (long)M_div_worka->m_apm_data[0]; if (M_div_worka->m_apm_datalength >= 5) { trial_numer += 100 * M_div_worka->m_apm_data[1] + M_div_worka->m_apm_data[2]; } else { if (M_div_worka->m_apm_datalength >= 3) trial_numer += 100 * M_div_worka->m_apm_data[1]; } j = (int)(trial_numer / b0); /* * Since the library 'normalizes' all the results, we need * to look at the exponent of the number to decide if we * have a lead in 0n or 00. */ if ((k = 2 - M_div_worka->m_apm_exponent) > 0) { while (TRUE) { j /= 10; if (--k == 0) break; } } if (j == 100) /* qhat == base ?? */ j = 99; /* if so, decrease by 1 */ m_apm_set_long(M_div_tmp8, (long)j); m_apm_multiply(M_div_tmp7, M_div_tmp8, M_div_workb); /* * Compare our q-hat (j) against the desired number. * j is either correct, 1 too large, or 2 too large * per Theorem B on pg 272 of Art of Compter Programming, * Volume 2, 3rd Edition. * * The above statement is only true if using the 2 leading * digits of the numerator and the leading digit of the * denominator. Since we are using the (3) leading digits * of the numerator and the (2) leading digits of the * denominator, we eliminate the case where our q-hat is * 2 too large, (and q-hat being 1 too large is quite remote). */ if (m_apm_compare(M_div_tmp7, M_div_worka) == 1) { j--; m_apm_subtract(M_div_tmp8, M_div_tmp7, M_div_workb); m_apm_copy(M_div_tmp7, M_div_tmp8); } /* * Since we know q-hat is correct, step D6 is unnecessary. * * Store q-hat, step D5. Since D6 is unnecessary, we can * do D5 before D4 and decide if we are done. */ r->m_apm_data[indexr++] = (UCHAR)j; /* j == 'qhat' */ m += 2; if (m >= iterations) break; /* step D4 */ m_apm_subtract(M_div_tmp9, M_div_worka, M_div_tmp7); /* * if the subtraction yields zero, the division is exact * and we are done early. */ if (M_div_tmp9->m_apm_sign == 0) { iterations = m; break; } /* multiply by 100 and re-save */ M_div_tmp9->m_apm_exponent += 2; m_apm_copy(M_div_worka, M_div_tmp9); } } r->m_apm_sign = sign; r->m_apm_exponent = nexp; r->m_apm_datalength = iterations; M_apm_normalize(r); }
void m_apm_arctan2(M_APM rr, int places, M_APM yy, M_APM xx) { M_APM tmp5, tmp6, tmp7; int ix, iy; iy = yy->m_apm_sign; ix = xx->m_apm_sign; if (ix == 0) /* x == 0 */ { if (iy == 0) /* y == 0 */ { M_apm_log_error_msg(M_APM_RETURN, "\'m_apm_arctan2\', Both Inputs = 0"); M_set_to_zero(rr); return; } M_check_PI_places(places); m_apm_round(rr, places, MM_lc_HALF_PI); rr->m_apm_sign = iy; return; } if (iy == 0) { if (ix == 1) { M_set_to_zero(rr); } else { M_check_PI_places(places); m_apm_round(rr, places, MM_lc_PI); } return; } /* * the special cases have been handled, now do the real work */ tmp5 = M_get_stack_var(); tmp6 = M_get_stack_var(); tmp7 = M_get_stack_var(); m_apm_divide(tmp6, (places + 6), yy, xx); m_apm_arctan(tmp5, (places + 6), tmp6); if (ix == 1) /* 'x' is positive */ { m_apm_round(rr, places, tmp5); } else /* 'x' is negative */ { M_check_PI_places(places); if (iy == 1) /* 'y' is positive */ { m_apm_add(tmp7, tmp5, MM_lc_PI); m_apm_round(rr, places, tmp7); } else /* 'y' is negative */ { m_apm_subtract(tmp7, tmp5, MM_lc_PI); m_apm_round(rr, places, tmp7); } } M_restore_stack(3); }
/* * From Knuth, The Art of Computer Programming: * * This is the binary GCD algorithm as described * in the book (Algorithm B) */ void m_apm_gcd(M_APM r, M_APM u, M_APM v) { M_APM tmpM, tmpN, tmpT, tmpU, tmpV; int kk, kr, mm; long pow_2; /* 'is_integer' will return 0 || 1 */ if ((m_apm_is_integer(u) + m_apm_is_integer(v)) != 2) { M_apm_log_error_msg(M_APM_RETURN, "Warning! \'m_apm_gcd\', Non-integer input"); M_set_to_zero(r); return; } if (u->m_apm_sign == 0) { m_apm_absolute_value(r, v); return; } if (v->m_apm_sign == 0) { m_apm_absolute_value(r, u); return; } tmpM = M_get_stack_var(); tmpN = M_get_stack_var(); tmpT = M_get_stack_var(); tmpU = M_get_stack_var(); tmpV = M_get_stack_var(); m_apm_absolute_value(tmpU, u); m_apm_absolute_value(tmpV, v); /* Step B1 */ kk = 0; while (TRUE) { mm = 1; if (m_apm_is_odd(tmpU)) break; mm = 0; if (m_apm_is_odd(tmpV)) break; m_apm_multiply(tmpN, MM_0_5, tmpU); m_apm_copy(tmpU, tmpN); m_apm_multiply(tmpN, MM_0_5, tmpV); m_apm_copy(tmpV, tmpN); kk++; } /* Step B2 */ if (mm) { m_apm_negate(tmpT, tmpV); goto B4; } m_apm_copy(tmpT, tmpU); /* Step: */ B3: m_apm_multiply(tmpN, MM_0_5, tmpT); m_apm_copy(tmpT, tmpN); /* Step: */ B4: if (m_apm_is_even(tmpT)) goto B3; /* Step B5 */ if (tmpT->m_apm_sign == 1) m_apm_copy(tmpU, tmpT); else m_apm_negate(tmpV, tmpT); /* Step B6 */ m_apm_subtract(tmpT, tmpU, tmpV); if (tmpT->m_apm_sign != 0) goto B3; /* * result = U * 2 ^ kk */ if (kk == 0) m_apm_copy(r, tmpU); else { if (kk == 1) m_apm_multiply(r, tmpU, MM_Two); if (kk == 2) m_apm_multiply(r, tmpU, MM_Four); if (kk >= 3) { mm = kk / 28; kr = kk % 28; pow_2 = 1L << kr; if (mm == 0) { m_apm_set_long(tmpN, pow_2); m_apm_multiply(r, tmpU, tmpN); } else { m_apm_copy(tmpN, MM_One); m_apm_set_long(tmpM, 0x10000000L); /* 2 ^ 28 */ while (TRUE) { m_apm_multiply(tmpT, tmpN, tmpM); m_apm_copy(tmpN, tmpT); if (--mm == 0) break; } if (kr == 0) { m_apm_multiply(r, tmpU, tmpN); } else { m_apm_set_long(tmpM, pow_2); m_apm_multiply(tmpT, tmpN, tmpM); m_apm_multiply(r, tmpU, tmpT); } } } } M_restore_stack(5); }
void m_apm_sqrt(M_APM rr, int places, M_APM aa) { M_APM last_x, guess, tmpN, tmp7, tmp8, tmp9; int ii, bflag, nexp, tolerance, dplaces; if (aa->m_apm_sign <= 0) { if (aa->m_apm_sign == -1) { M_apm_log_error_msg(M_APM_RETURN, "\'m_apm_sqrt\', Negative argument"); } M_set_to_zero(rr); return; } last_x = M_get_stack_var(); guess = M_get_stack_var(); tmpN = M_get_stack_var(); tmp7 = M_get_stack_var(); tmp8 = M_get_stack_var(); tmp9 = M_get_stack_var(); m_apm_copy(tmpN, aa); /* normalize the input number (make the exponent near 0) so the 'guess' function will not over/under flow on large magnitude exponents. */ nexp = aa->m_apm_exponent / 2; tmpN->m_apm_exponent -= 2 * nexp; M_get_sqrt_guess(guess, tmpN); /* actually gets 1/sqrt guess */ tolerance = places + 4; dplaces = places + 16; bflag = FALSE; m_apm_negate(last_x, MM_Ten); /* Use the following iteration to calculate 1 / sqrt(N) : X = 0.5 * X * [ 3 - N * X^2 ] n+1 */ ii = 0; while (TRUE) { m_apm_multiply(tmp9, tmpN, guess); m_apm_multiply(tmp8, tmp9, guess); m_apm_round(tmp7, dplaces, tmp8); m_apm_subtract(tmp9, MM_Three, tmp7); m_apm_multiply(tmp8, tmp9, guess); m_apm_multiply(tmp9, tmp8, MM_0_5); if (bflag) break; m_apm_round(guess, dplaces, tmp9); /* force at least 2 iterations so 'last_x' has valid data */ if (ii != 0) { m_apm_subtract(tmp7, guess, last_x); if (tmp7->m_apm_sign == 0) break; /* * if we are within a factor of 4 on the error term, * we will be accurate enough after the *next* iteration * is complete. (note that the sign of the exponent on * the error term will be a negative number). */ if ((-4 * tmp7->m_apm_exponent) > tolerance) bflag = TRUE; } m_apm_copy(last_x, guess); ii++; } /* * multiply by the starting number to get the final * sqrt and then adjust the exponent since we found * the sqrt of the normalized number. */ m_apm_multiply(tmp8, tmp9, tmpN); m_apm_round(rr, places, tmp8); rr->m_apm_exponent += nexp; M_restore_stack(6); }
void m_apm_exp(M_APM r, int places, M_APM x) { M_APM tmp7, tmp8, tmp9; int dplaces, nn, ii; if (MM_firsttime1) { MM_firsttime1 = FALSE; MM_exp_log2R = m_apm_init(); MM_exp_512R = m_apm_init(); m_apm_set_string(MM_exp_log2R, "1.44269504089"); /* ~ 1 / log(2) */ m_apm_set_string(MM_exp_512R, "1.953125E-3"); /* 1 / 512 */ } tmp7 = M_get_stack_var(); tmp8 = M_get_stack_var(); tmp9 = M_get_stack_var(); if (x->m_apm_sign == 0) /* if input == 0, return '1' */ { m_apm_copy(r, MM_One); M_restore_stack(3); return; } if (x->m_apm_exponent <= -3) /* already small enough so call _raw directly */ { M_raw_exp(tmp9, (places + 6), x); m_apm_round(r, places, tmp9); M_restore_stack(3); return; } /* From David H. Bailey's MPFUN Fortran package : exp (t) = (1 + r + r^2 / 2! + r^3 / 3! + r^4 / 4! ...) ^ q * 2 ^ n where q = 256, r = t' / q, t' = t - n Log(2) and where n is chosen so that -0.5 Log(2) < t' <= 0.5 Log(2). Reducing t mod Log(2) and dividing by 256 insures that -0.001 < r <= 0.001, which accelerates convergence in the above series. I use q = 512 and also limit how small 'r' can become. The 'r' used here is limited in magnitude from 1.95E-4 < |r| < 1.35E-3. Forcing 'r' into a narrow range keeps the algorithm 'well behaved'. ( the range is [0.1 / 512] to [log(2) / 512] ) */ if (M_exp_compute_nn(&nn, tmp7, x) != 0) { M_apm_log_error_msg(M_APM_RETURN, "\'m_apm_exp\', Input too large, Overflow"); M_set_to_zero(r); M_restore_stack(3); return; } dplaces = places + 8; /* check to make sure our log(2) is accurate enough */ M_check_log_places(dplaces); m_apm_multiply(tmp8, tmp7, MM_lc_log2); m_apm_subtract(tmp7, x, tmp8); /* * guarantee that |tmp7| is between 0.1 and 0.9999999.... * (in practice, the upper limit only reaches log(2), 0.693... ) */ while (TRUE) { if (tmp7->m_apm_sign != 0) { if (tmp7->m_apm_exponent == 0) break; } if (tmp7->m_apm_sign >= 0) { nn++; m_apm_subtract(tmp8, tmp7, MM_lc_log2); m_apm_copy(tmp7, tmp8); } else { nn--; m_apm_add(tmp8, tmp7, MM_lc_log2); m_apm_copy(tmp7, tmp8); } } m_apm_multiply(tmp9, tmp7, MM_exp_512R); /* perform the series expansion ... */ M_raw_exp(tmp8, dplaces, tmp9); /* * raise result to the 512 power * * note : x ^ 512 = (((x ^ 2) ^ 2) ^ 2) ... 9 times */ ii = 9; while (TRUE) { m_apm_multiply(tmp9, tmp8, tmp8); m_apm_round(tmp8, dplaces, tmp9); if (--ii == 0) break; } /* now compute 2 ^ N */ m_apm_integer_pow(tmp7, dplaces, MM_Two, nn); m_apm_multiply(tmp9, tmp7, tmp8); m_apm_round(r, places, tmp9); M_restore_stack(3); /* restore the 3 locals we used here */ }
void m_apm_multiply(M_APM r, M_APM a, M_APM b) { int ai, itmp, sign, nexp, ii, jj, indexa, indexb, index0, numdigits; UCHAR *cp, *cpr, *cp_div, *cp_rem; void *vp; sign = a->m_apm_sign * b->m_apm_sign; nexp = a->m_apm_exponent + b->m_apm_exponent; if (sign == 0) /* one number is zero, result is zero */ { M_set_to_zero(r); return; } numdigits = a->m_apm_datalength + b->m_apm_datalength; indexa = (a->m_apm_datalength + 1) >> 1; indexb = (b->m_apm_datalength + 1) >> 1; /* * If we are multiplying 2 'big' numbers, use the fast algorithm. * * This is a **very** approx break even point between this algorithm * and the FFT multiply. Note that different CPU's, operating systems, * and compiler's may yield a different break even point. This point * (~96 decimal digits) is how the test came out on the author's system. */ if (indexa >= 48 && indexb >= 48) { M_fast_multiply(r, a, b); return; } ii = (numdigits + 1) >> 1; /* required size of result, in bytes */ if (ii > r->m_apm_malloclength) { if ((vp = MAPM_REALLOC(r->m_apm_data, (ii + 32))) == NULL) { /* fatal, this does not return */ M_apm_log_error_msg(M_APM_FATAL, "\'m_apm_multiply\', Out of memory"); } r->m_apm_malloclength = ii + 28; r->m_apm_data = (UCHAR *)vp; } M_get_div_rem_addr(&cp_div, &cp_rem); index0 = indexa + indexb; cp = r->m_apm_data; memset(cp, 0, index0); ii = indexa; while (TRUE) { index0--; cpr = cp + index0; jj = indexb; ai = (int)a->m_apm_data[--ii]; while (TRUE) { itmp = ai * b->m_apm_data[--jj]; *(cpr-1) += cp_div[itmp]; *cpr += cp_rem[itmp]; if (*cpr >= 100) { *cpr -= 100; *(cpr-1) += 1; } cpr--; if (*cpr >= 100) { *cpr -= 100; *(cpr-1) += 1; } if (jj == 0) break; } if (ii == 0) break; } r->m_apm_sign = sign; r->m_apm_exponent = nexp; r->m_apm_datalength = numdigits; M_apm_normalize(r); }
void m_apm_log(M_APM r, int places, M_APM a) { M_APM tmp0, tmp1, tmp2; int mexp, dplaces; if (a->m_apm_sign <= 0) { M_apm_log_error_msg(M_APM_RETURN, "Warning! ... \'m_apm_log\', Negative argument"); M_set_to_zero(r); return; } tmp0 = M_get_stack_var(); tmp1 = M_get_stack_var(); tmp2 = M_get_stack_var(); dplaces = places + 8; /* * if the input is real close to 1, use the series expansion * to compute the log. * * 0.9999 < a < 1.0001 */ m_apm_subtract(tmp0, a, MM_One); if (tmp0->m_apm_sign == 0) /* is input exactly 1 ?? */ { /* if so, result is 0 */ M_set_to_zero(r); M_restore_stack(3); return; } if (tmp0->m_apm_exponent <= -4) { M_log_near_1(r, places, tmp0); M_restore_stack(3); return; } /* make sure our log(10) is accurate enough for this calculation */ /* (and log(2) which is called from M_log_basic_iteration) */ M_check_log_places(dplaces + 25); mexp = a->m_apm_exponent; if (mexp >= -4 && mexp <= 4) { M_log_basic_iteration(r, places, a); } else { /* * use log (x * y) = log(x) + log(y) * * here we use y = exponent of our base 10 number. * * let 'C' = log(10) = 2.3025850929940.... * * then log(x * y) = log(x) + ( C * base_10_exponent ) */ m_apm_copy(tmp2, a); mexp = tmp2->m_apm_exponent - 2; tmp2->m_apm_exponent = 2; /* force number between 10 & 100 */ M_log_basic_iteration(tmp0, dplaces, tmp2); m_apm_set_long(tmp1, (long)mexp); m_apm_multiply(tmp2, tmp1, MM_lc_log10); m_apm_add(tmp1, tmp2, tmp0); m_apm_round(r, places, tmp1); } M_restore_stack(3); /* restore the 3 locals we used here */ }
void m_apm_integer_pow(M_APM rr, int places, M_APM aa, int mexp) { M_APM tmp0, tmpy, tmpz; int nexp, ii, signflag, local_precision; if (mexp == 0) { m_apm_copy(rr, MM_One); return; } else { if (mexp > 0) { signflag = 0; nexp = mexp; } else { signflag = 1; nexp = -mexp; } } if (aa->m_apm_sign == 0) { M_set_to_zero(rr); return; } tmp0 = M_get_stack_var(); tmpy = M_get_stack_var(); tmpz = M_get_stack_var(); local_precision = places + 8; m_apm_copy(tmpy, MM_One); m_apm_copy(tmpz, aa); while (TRUE) { ii = nexp & 1; nexp = nexp >> 1; if (ii != 0) /* exponent -was- odd */ { m_apm_multiply(tmp0, tmpy, tmpz); m_apm_round(tmpy, local_precision, tmp0); if (nexp == 0) break; } m_apm_multiply(tmp0, tmpz, tmpz); m_apm_round(tmpz, local_precision, tmp0); } if (signflag) { m_apm_reciprocal(rr, places, tmpy); } else { m_apm_round(rr, places, tmpy); } M_restore_stack(3); }
void m_apm_integer_pow_nr(M_APM rr, M_APM aa, int mexp) { M_APM tmp0, tmpy, tmpz; int nexp, ii; if (mexp == 0) { m_apm_copy(rr, MM_One); return; } else { if (mexp < 0) { M_apm_log_error_msg(M_APM_RETURN, "Warning! ... \'m_apm_integer_pow_nr\', Negative exponent"); M_set_to_zero(rr); return; } } if (mexp == 1) { m_apm_copy(rr, aa); return; } if (mexp == 2) { m_apm_multiply(rr, aa, aa); return; } nexp = mexp; if (aa->m_apm_sign == 0) { M_set_to_zero(rr); return; } tmp0 = M_get_stack_var(); tmpy = M_get_stack_var(); tmpz = M_get_stack_var(); m_apm_copy(tmpy, MM_One); m_apm_copy(tmpz, aa); while (TRUE) { ii = nexp & 1; nexp = nexp >> 1; if (ii != 0) /* exponent -was- odd */ { m_apm_multiply(tmp0, tmpy, tmpz); if (nexp == 0) break; m_apm_copy(tmpy, tmp0); } m_apm_multiply(tmp0, tmpz, tmpz); m_apm_copy(tmpz, tmp0); } m_apm_copy(rr, tmp0); M_restore_stack(3); }
/* Calculate the POW function by calling EXP : Y A X = e where A = Y * log(X) */ void m_apm_pow(M_APM rr, int places, M_APM xx, M_APM yy) { int iflag, pflag; char sbuf[64]; M_APM tmp8, tmp9; /* if yy == 0, return 1 */ if (yy->m_apm_sign == 0) { m_apm_copy(rr, MM_One); return; } /* if xx == 0, return 0 */ if (xx->m_apm_sign == 0) { M_set_to_zero(rr); return; } if (M_size_flag == 0) /* init locals on first call */ { M_size_flag = M_get_sizeof_int(); M_last_log_digits = 0; M_last_xx_input = m_apm_init(); M_last_xx_log = m_apm_init(); } /* * if 'yy' is a small enough integer, call the more * efficient _integer_pow function. */ if (m_apm_is_integer(yy)) { iflag = FALSE; if (M_size_flag == 2) /* 16 bit compilers */ { if (yy->m_apm_exponent <= 4) iflag = TRUE; } else /* >= 32 bit compilers */ { if (yy->m_apm_exponent <= 7) iflag = TRUE; } if (iflag) { m_apm_to_integer_string(sbuf, yy); m_apm_integer_pow(rr, places, xx, atoi(sbuf)); return; } } tmp8 = M_get_stack_var(); tmp9 = M_get_stack_var(); /* * If parameter 'X' is the same this call as it * was the previous call, re-use the saved log * calculation from last time. */ pflag = FALSE; if (M_last_log_digits >= places) { if (m_apm_compare(xx, M_last_xx_input) == 0) pflag = TRUE; } if (pflag) { m_apm_round(tmp9, (places + 8), M_last_xx_log); } else { m_apm_log(tmp9, (places + 8), xx); M_last_log_digits = places + 2; /* save the 'X' input value and the log calculation */ m_apm_copy(M_last_xx_input, xx); m_apm_copy(M_last_xx_log, tmp9); } m_apm_multiply(tmp8, tmp9, yy); m_apm_exp(rr, places, tmp8); M_restore_stack(2); /* restore the 2 locals we used here */ }