2 * CDE - Common Desktop Environment
4 * Copyright (c) 1993-2012, The Open Group. All rights reserved.
6 * These libraries and programs are free software; you can
7 * redistribute them and/or modify them under the terms of the GNU
8 * Lesser General Public License as published by the Free Software
9 * Foundation; either version 2 of the License, or (at your option)
12 * These libraries and programs are distributed in the hope that
13 * they will be useful, but WITHOUT ANY WARRANTY; without even the
14 * implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
15 * PURPOSE. See the GNU Lesser General Public License for more
18 * You should have received a copy of the GNU Lesser General Public
19 * License along with these librararies and programs; if not, write
20 * to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
21 * Floor, Boston, MA 02110-1301 USA
23 /* $XConsortium: functions.c /main/6 1996/09/25 09:36:28 mustafa $ */
26 * Contains the many of the functions (i.e. do_*) which actually do *
27 * (at least start) the calculations. *
29 * (c) Copyright 1993, 1994 Hewlett-Packard Company *
30 * (c) Copyright 1993, 1994 International Business Machines Corp. *
31 * (c) Copyright 1993, 1994 Sun Microsystems, Inc. *
32 * (c) Copyright 1993, 1994 Novell, Inc. *
42 extern char *base_str[] ; /* Strings for each base value. */
43 extern char *dtype_str[] ; /* Strings for each display mode value. */
44 extern char *mode_str[] ; /* Strings for each mode value. */
45 extern char *ttype_str[] ; /* Strings for each trig type value. */
46 extern char *vstrs[] ; /* Various strings. */
48 extern struct button buttons[] ; /* Calculator button values. */
49 extern struct button mode_buttons[] ; /* Special "mode" buttons. */
50 extern struct menu_entry menu_entries[] ; /* All the menu strings. */
52 extern Vars v ; /* Calctool variables and options. */
54 double mods[] = { 1.0, 1.0e-1, 1.0e-2, 1.0e-3, 1.0e-4,
55 1.0e-5, 1.0e-6, 1.0e-7, 1.0e-8, 1.0e-9,
56 1.0e-10, 1.0e-11, 1.0e-12, 1.0e-13, 1.0e-14,
57 1.0e-15, 1.0e-16, 1.0e-17, 1.0e-18, 1.0e-19 };
61 do_accuracy() /* Set display accuracy. */
65 for (i = ACC_START; i <= ACC_END; i++)
66 if (v->current == menu_entries[i].val)
68 v->accuracy = char_val(v->current) ;
77 do_ascii() /* Convert ASCII value. */
86 do_base() /* Change the current base setting. */
88 if (v->current == BASE_BIN) v->base = BIN ;
89 else if (v->current == BASE_OCT) v->base = OCT ;
90 else if (v->current == BASE_DEC) v->base = DEC ;
91 else if (v->current == BASE_HEX) v->base = HEX ;
101 grey_buttons(v->base) ;
102 show_display(v->MPdisp_val) ;
103 set_option_menu((int) BASEITEM, (int)v->base);
105 if (v->rstate) make_registers(MEM) ;
106 if (v->frstate) make_registers(FIN) ;
110 do_business() /* Perform special business mode calculations. */
112 Boolean need_show = TRUE;
113 char *display_number = NULL;
114 int MPbv[MP_SIZE], MP1[MP_SIZE], MP2[MP_SIZE], MP3[MP_SIZE], MP4[MP_SIZE] ;
116 int i, len, val, val2, accSav ;
119 if (IS_KEY(v->current, KEY_CTRM))
121 /* Cterm - FMEM1 = int (periodic interest rate).
122 * FMEM2 = Pv (present value).
123 * FMEM4 = Fv (future value).
125 * RESULT = log(FMEM4 / FMEM2) / log(1 + FMEM1)
127 if(v->MPfvals[1] == 0.0 || v->MPfvals[2] == 0.0 || v->MPfvals[4] == 0.0)
129 char *errorMsg, *tmp;
131 /* want to undraw the button first */
132 draw_button(19, 0, 4, 3, FALSE);
133 errorMsg = GETMESSAGE(5, 7, "Can't calculate 'Compound Term'\nwithout a non zero interest rate,\na non zero Present value, and\na non zero Future value.\n");
134 tmp = XtNewString(errorMsg);
141 result = log(v->MPfvals[4] / v->MPfvals[2]) / log(1.0 + (v->MPfvals[1] / 1200));
144 mpcdm(&result, v->MPdisp_val) ;
145 make_registers(FIN) ;
150 else if (IS_KEY(v->current, KEY_DDB))
153 /* Ddb - MEM0 = cost (amount paid for asset).
154 * MEM1 = salvage (value of asset at end of its life).
155 * MEM2 = life (useful life of the asset).
156 * MEM3 = period (time period for depreciation allowance).
159 * for (i = 0; i < MEM3; i++)
161 * VAL = ((MEM0 - bv) * 2) / MEM2
169 mpcmi(v->MPmvals[3], &len) ;
170 for (i = 0; i < len; i++)
172 mpsub(v->MPmvals[0], MPbv, MP1) ;
174 mpmuli(MP1, &val, MP2) ;
175 mpdiv(MP2, v->MPmvals[2], v->MPdisp_val) ;
177 mpadd(MP1, v->MPdisp_val, MPbv) ;
180 else if (IS_KEY(v->current, KEY_FV))
183 /* Fv - FMEM3 = pmt (periodic payment).
184 * FMEM1 = int (periodic interest rate).
185 * FMEM2 = Pv (present value).
186 * FMEM0 = n (number of periods).
189 if(v->MPfvals[0] == 0.0 || v->MPfvals[1] == 0.0 ||
190 (v->MPfvals[2] == 0.0 && v->MPfvals[3] == 0.0) || v->funstate == 0)
195 doerr(GETMESSAGE(5, 2, "ERROR: No Solution"));
199 /* set FV register */
200 mpcmd(v->MPdisp_val, &(v->MPfvals[4]));
204 if ((w = 1.0 + v->MPfvals[1] / (v->MPfvals[5] * 100.0)) == 1.0)
205 result = -(v->MPfvals[2] + v->MPfvals[0] * v->MPfvals[3]);
207 result = -(v->MPfvals[2] * pow(w, v->MPfvals[0]) +
208 v->MPfvals[3] * (pow(w, v->MPfvals[0]) - 1.0) *
209 pow(w, 0.0) / (w - 1.0));
210 mpcdm(&result, v->MPdisp_val) ;
212 if(strcmp(v->display, GETMESSAGE(3, 364, "Error")) != 0)
213 mpcmd(v->MPdisp_val, &(v->MPfvals[4]));
214 make_registers(FIN) ;
217 else if (IS_KEY(v->current, KEY_PMT))
220 /* Pmt - FMEM0 = prin (principal).
221 * FMEM1 = int (periodic interest rate).
224 * RESULT = FMEM0 * (FMEM1 / (1 - pow(FMEM1 + 1, -1 * FMEM2)))
227 if(v->MPfvals[0] == 0.0 || v->MPfvals[1] == 0.0 ||
228 (v->MPfvals[2] == 0.0 && v->MPfvals[4] == 0.0) || v->funstate == 0)
233 doerr(GETMESSAGE(5, 2, "ERROR: No Solution"));
237 /* set Payment register */
238 mpcmd(v->MPdisp_val, &(v->MPfvals[3]));
243 if ((w = 1.0 + v->MPfvals[1] / (v->MPfvals[5] * 100.0)) == 1.0)
244 result = -(v->MPfvals[4] + v->MPfvals[2]) / v->MPfvals[0];
246 result = -(v->MPfvals[2] * pow(w, v->MPfvals[0]) +
247 v->MPfvals[4]) * (w - 1.0) /
248 ((pow(w, v->MPfvals[0]) - 1.0) * pow(w, 0.0));
249 mpcdm(&result, v->MPdisp_val) ;
251 if(strcmp(v->display, GETMESSAGE(3, 364, "Error")) != 0)
252 mpcmd(v->MPdisp_val, &(v->MPfvals[3]));
253 make_registers(FIN) ;
256 else if (IS_KEY(v->current, KEY_PV))
259 /* Pv - FMEM0 = pmt (periodic payment).
260 * FMEM1 = int (periodic interest rate).
263 * RESULT = FMEM0 * (1 - pow(1 + FMEM1, -1 * FMEM2)) / FMEM1
266 if(v->MPfvals[0] == 0.0 || v->MPfvals[1] == 0.0 || v->MPfvals[3] == 0.0 || v->funstate == 0)
271 doerr(GETMESSAGE(5, 2, "ERROR: No Solution"));
275 /* set PV register */
276 mpcmd(v->MPdisp_val, &(v->MPfvals[2]));
280 if ((w = 1.0 + v->MPfvals[1] / (v->MPfvals[5] * 100.0)) == 1.0)
281 result = -(v->MPfvals[4] + v->MPfvals[0] * v->MPfvals[3]);
283 result = -(v->MPfvals[4] / pow(w, v->MPfvals[0]) +
284 v->MPfvals[3] * (pow(w, v->MPfvals[0]) - 1.0) *
285 pow(w, 0.0 - v->MPfvals[0]) / (w - 1.0));
286 mpcdm(&result, v->MPdisp_val) ;
288 if(strcmp(v->display, GETMESSAGE(3, 364, "Error")) != 0)
289 mpcmd(v->MPdisp_val, &(v->MPfvals[2]));
290 make_registers(FIN) ;
293 else if (IS_KEY(v->current, KEY_RATE))
295 /* Rate - MEM0 = fv (future value).
296 * MEM1 = pv (present value).
299 * RESULT = pow(MEM0 / MEM1, 1 / MEM2) - 1
301 if(v->MPfvals[0] == 0.0 || (v->MPfvals[2] == 0.0 && v->MPfvals[3] == 0.0)
302 || (v->MPfvals[3] == 0.0 && v->MPfvals[4] == 0.0)
308 doerr(GETMESSAGE(5, 2, "ERROR: No Solution"));
313 accSav = v->accuracy;
315 display_number = make_number(v->MPdisp_val, FALSE);
316 MPstr_to_num(display_number, DEC, v->MPdisp_val);
317 /* set RATE register */
318 mpcmd(v->MPdisp_val, &(v->MPfvals[1]));
319 v->accuracy = accSav;
324 compute_i(&(v->MPfvals[1]));
325 mpcdm(&(v->MPfvals[1]), v->MPdisp_val);
326 accSav = v->accuracy;
328 display_number = make_number(v->MPdisp_val, FALSE);
329 MPstr_to_num(display_number, DEC, v->MPdisp_val);
330 v->accuracy = accSav;
334 make_registers(FIN) ;
337 STRCPY(v->display, display_number);
338 set_item(DISPLAYITEM, v->display);
341 else if (IS_KEY(v->current, KEY_SLN))
344 /* Sln - MEM0 = cost (cost of the asset).
345 * MEM1 = salvage (salvage value of the asset).
346 * MEM2 = life (useful life of the asset).
348 * RESULT = (MEM0 - MEM1) / MEM2
351 mpsub(v->MPmvals[0], v->MPmvals[1], MP1) ;
352 mpdiv(MP1, v->MPmvals[2], v->MPdisp_val) ;
354 else if (IS_KEY(v->current, KEY_SYD))
357 /* Syd - MEM0 = cost (cost of the asset).
358 * MEM1 = salvage (salvage value of the asset).
359 * MEM2 = life (useful life of the asset).
360 * MEM3 = period (period for which depreciation is computed).
362 * RESULT = ((MEM0 - MEM1) * (MEM2 - MEM3 + 1)) /
363 * (MEM2 * (MEM2 + 1) / 2)
366 mpsub(v->MPmvals[2], v->MPmvals[3], MP2) ;
368 mpaddi(MP2, &val, MP3) ;
369 mpaddi(v->MPmvals[2], &val, MP2) ;
370 mpmul(v->MPmvals[2], MP2, MP4) ;
373 mpdiv(MP4, MP2, MP1) ;
374 mpdiv(MP3, MP1, MP2) ;
375 mpsub(v->MPmvals[0], v->MPmvals[1], MP1) ;
376 mpmul(MP1, MP2, v->MPdisp_val) ;
378 else if (IS_KEY(v->current, KEY_TERM))
381 /* Term - FMEM0 = pmt (periodic payment).
382 * FMEM1 = fv (future value).
383 * FMEM2 = int (periodic interest rate).
385 * RESULT = log(1 + (FMEM1 * FMEM2 / FMEM0)) / log(1 + FMEM2)
388 if(v->MPfvals[1] == 0.0 || (v->MPfvals[2] == 0.0 && v->MPfvals[4] == 0)
389 || v->MPfvals[3] == 0.0 || v->funstate == 0)
394 doerr(GETMESSAGE(5, 2, "ERROR: No Solution"));
398 /* set Term register */
399 mpcmd(v->MPdisp_val, &(v->MPfvals[0]));
403 if ((w = 1.0 + v->MPfvals[1] / (v->MPfvals[5] * 100.0)) == 1.0)
404 result = -(v->MPfvals[4] + v->MPfvals[2]) / v->MPfvals[3];
407 double wdb = pow(w, 0.0);
409 result = log((v->MPfvals[3] * wdb / (w - 1.0) - v->MPfvals[4]) /
410 (v->MPfvals[2] * pow(w, 0.0) + v->MPfvals[3] * wdb /
411 (w - 1.0))) / log(w);
414 if(strcmp(v->display, GETMESSAGE(3, 364, "Error")) != 0)
415 mpcdm(&result, v->MPdisp_val) ;
417 if(strcmp(v->display, GETMESSAGE(3, 364, "Error")) != 0)
418 mpcmd(v->MPdisp_val, &(v->MPfvals[0]));
419 make_registers(FIN) ;
422 else if (IS_KEY(v->current, KEY_PYR))
424 mpcmd(v->MPdisp_val, &(v->MPfvals[5]));
425 result = do_round(v->MPfvals[5], 0);
429 v->MPfvals[5] = result;
430 make_registers(FIN) ;
433 else if (IS_KEY(v->current, KEY_FCLR))
439 /* clear Term register */
440 mpcmd(MP1, &(v->MPfvals[0])) ;
442 /* clear %/YR register */
443 mpcmd(MP1, &(v->MPfvals[1])) ;
445 /* clear PV register */
446 mpcmd(MP1, &(v->MPfvals[2])) ;
448 /* clear Payment register */
449 mpcmd(MP1, &(v->MPfvals[3])) ;
451 /* clear FV register */
452 mpcmd(MP1, &(v->MPfvals[4])) ;
456 mpcmd(MP1, &(v->MPfvals[5])) ;
461 if (need_show == TRUE)
462 show_display(v->MPdisp_val) ;
469 do_calc() /* Perform arithmetic calculation and display result. */
474 /* the financial state is false - last key was not a fin. key */
477 if (!(v->opsptr && !v->show_paren)) /* Don't do if processing parens. */
478 if (IS_KEY(v->current, KEY_EQ) && IS_KEY(v->old_cal_value, KEY_EQ))
480 mpstr(v->MPdisp_val, v->MPresult) ;
482 mpstr(v->MPlast_input, v->MPdisp_val) ;
484 if (!IS_KEY(v->current, KEY_EQ) && IS_KEY(v->old_cal_value, KEY_EQ))
487 if (IS_KEY(v->cur_op, KEY_COS) || /* Cos */
488 IS_KEY(v->cur_op, KEY_SIN) || /* Sin */
489 IS_KEY(v->cur_op, KEY_TAN) || /* Tan */
490 v->cur_op == '?') /* Undefined */
491 mpstr(v->MPdisp_val, v->MPresult) ;
493 else if (IS_KEY(v->cur_op, KEY_ADD)) /* Addition */
494 mpadd(v->MPresult, v->MPdisp_val, v->MPresult) ;
496 else if (IS_KEY(v->cur_op, KEY_SUB)) /* Subtraction. */
497 mpsub(v->MPresult, v->MPdisp_val, v->MPresult) ;
499 else if (v->cur_op == '*' ||
500 IS_KEY(v->cur_op, KEY_MUL)) /* Multiplication */
501 mpmul(v->MPresult, v->MPdisp_val, v->MPresult) ;
503 else if (IS_KEY(v->cur_op, KEY_DIV)) /* Division. */
504 mpdiv(v->MPresult, v->MPdisp_val, v->MPresult) ;
506 else if (IS_KEY(v->cur_op, KEY_PER)) /* % */
508 mpmul(v->MPresult, v->MPdisp_val, v->MPresult) ;
509 MPstr_to_num("0.01", DEC, MP1) ;
510 mpmul(v->MPresult, MP1, v->MPresult) ;
513 else if (IS_KEY(v->cur_op, KEY_YTOX)) /* y^x */
514 mppwr2(v->MPresult, v->MPdisp_val, v->MPresult) ;
516 else if (IS_KEY(v->cur_op, KEY_AND)) /* And */
518 mpcmd(v->MPresult, &dres) ;
519 mpcmd(v->MPdisp_val, &dval) ;
520 dres = setbool((BOOLEAN)(ibool(dres) & ibool(dval))) ;
521 mpcdm(&dres, v->MPresult) ;
524 else if (IS_KEY(v->cur_op, KEY_OR)) /* Or */
526 mpcmd(v->MPresult, &dres) ;
527 mpcmd(v->MPdisp_val, &dval) ;
528 dres = setbool((BOOLEAN)(ibool(dres) | ibool(dval))) ;
529 mpcdm(&dres, v->MPresult) ;
532 else if (IS_KEY(v->cur_op, KEY_XOR)) /* Xor */
534 mpcmd(v->MPresult, &dres) ;
535 mpcmd(v->MPdisp_val, &dval) ;
536 dres = setbool((BOOLEAN)(ibool(dres) ^ ibool(dval))) ;
537 mpcdm(&dres, v->MPresult) ;
540 else if (IS_KEY(v->cur_op, KEY_XNOR)) /* Xnor */
542 mpcmd(v->MPresult, &dres) ;
543 mpcmd(v->MPdisp_val, &dval) ;
544 dres = setbool((BOOLEAN)(~ibool(dres) ^ ibool(dval))) ;
545 mpcdm(&dres, v->MPresult) ;
548 else if (IS_KEY(v->cur_op, KEY_EQ)) /* do nothing. */ ; /* Equals */
550 show_display(v->MPresult) ;
552 if (!(IS_KEY(v->current, KEY_EQ) && IS_KEY(v->old_cal_value, KEY_EQ)))
553 mpstr(v->MPdisp_val, v->MPlast_input) ;
555 mpstr(v->MPresult, v->MPdisp_val) ;
557 v->cur_op = v->current ;
559 v->old_cal_value = v->current ;
560 v->new_input = v->key_exp = 0 ;
565 do_clear() /* Clear the calculator display and re-initialise. */
568 if (v->error) set_item(DISPLAYITEM, "") ;
576 if (v->current >= '0' && v->current <= '9')
578 mpstr(v->MPcon_vals[char_val(v->current)], v->MPdisp_val) ;
579 show_display(v->MPdisp_val) ;
585 do_delete() /* Remove the last numeric character typed. */
587 if (strlen(v->display))
588 v->display[strlen(v->display)-1] = '\0' ;
590 /* If we were entering a scientific number, and we have backspaced over
591 * the exponent sign, then this reverts to entering a fixed point number.
594 if (v->key_exp && !(strchr(v->display, '+')))
597 v->display[strlen(v->display)-1] = '\0' ;
598 set_item(OPITEM, "") ;
601 /* If we've backspaced over the numeric point, clear the pointed flag. */
603 if (v->pointed && !(strchr(v->display, '.'))) v->pointed = 0 ;
605 if(strcmp(v->display, "") == 0)
608 set_item(DISPLAYITEM, v->display) ;
609 MPstr_to_num(v->display, v->base, v->MPdisp_val) ;
614 do_exchange() /* Exchange display with memory register. */
616 int i, MPtemp[MP_SIZE] ;
618 for (i = MEM_START; i <= MEM_END; i++)
619 if (v->current == menu_entries[i].val)
621 mpstr(v->MPdisp_val, MPtemp) ;
622 mpstr(v->MPmvals[char_val(v->current)], v->MPdisp_val) ;
623 mpstr(MPtemp, v->MPmvals[char_val(v->current)]) ;
624 make_registers(MEM) ;
631 do_expno() /* Get exponential number. */
633 /* the financial state is false - last key was not a fin. key */
636 v->pointed = (strchr(v->display, '.') != NULL) ;
639 STRCPY(v->display, "1.0 +") ;
640 v->new_input = v->pointed = 1 ;
642 else if (!v->pointed)
644 STRNCAT(v->display, ". +", 3) ;
647 else if (!v->key_exp) STRNCAT(v->display, " +", 2) ;
650 v->exp_posn = strchr(v->display, '+') ;
651 set_item(DISPLAYITEM, v->display) ;
652 MPstr_to_num(v->display, v->base, v->MPdisp_val) ;
657 do_factorial(MPval, MPres) /* Calculate the factorial of MPval. */
661 int i, MPa[MP_SIZE], MP1[MP_SIZE], MP2[MP_SIZE] ;
663 /* NOTE: do_factorial, on each iteration of the loop, will attempt to
664 * convert the current result to a double. If v->error is set,
665 * then we've overflowed. This is to provide the same look&feel
668 * XXX: Needs to be improved. Shouldn't need to convert to a double in
669 * order to check this.
676 if (mpeq(MPval, MP1) && mpge(MPval, MP2)) /* Only positive integers. */
679 if (mpeq(MP1, MP2)) /* Special case for 0! */
686 if (!i) matherr((struct exception *) NULL) ;
690 mpmuli(MPa, &i, MPa) ;
692 if (v->error) break ;
696 else matherr((struct exception *) NULL) ;
702 do_frame() /* Exit dtcalc. */
708 do_function() /* Perform a user defined function. */
710 enum fcp_type scurwin ;
711 int fno, scolumn, srow ;
714 scolumn = v->column ;
715 scurwin = v->curwin ;
717 if (v->current >= '0' && v->current <= '9')
719 fno = char_val(v->current) ;
720 if(strcmp(v->fun_vals[fno], "") != 0)
721 process_str(v->fun_vals[fno], M_FUN) ;
723 v->curwin = scurwin ;
725 v->column = scolumn ;
733 int i, MP1[MP_SIZE], MP2[MP_SIZE] ;
735 /* the financial state is false - last key was not a fin. key */
738 if (IS_KEY(v->current, KEY_HYP)) /* Hyp */
740 v->hyperbolic = !v->hyperbolic ;
741 set_item(HYPITEM, (v->hyperbolic) ? vstrs[(int) V_HYP]
745 else if (IS_KEY(v->current, KEY_INV)) /* Inv */
747 v->inverse = !v->inverse ;
748 set_item(INVITEM, (v->inverse) ? vstrs[(int) V_INV]
752 else if (IS_KEY(v->current, KEY_32)) /* &32 */
754 mpcmd(v->MPdisp_val, &dval) ;
755 dval2 = ibool2(dval);
757 doerr(GETMESSAGE(5, 6, "ERR:Num too large for operation"));
760 dval = setbool((BOOLEAN)dval2) ;
761 mpcdm(&dval, v->MPdisp_val) ;
765 else if (IS_KEY(v->current, KEY_16)) /* &16 */
767 mpcmd(v->MPdisp_val, &dval) ;
768 dval2 = ibool2(dval);
770 doerr(GETMESSAGE(5, 6, "ERR:Num too large for operation"));
773 dval = setbool((BOOLEAN)(ibool(dval2) & 0xffff)) ;
774 mpcdm(&dval, v->MPdisp_val) ;
778 else if (IS_KEY(v->current, KEY_ETOX)) /* e^x */
780 mpstr(v->MPdisp_val, MP1) ;
781 mpexp(MP1, v->MPdisp_val) ;
784 else if (IS_KEY(v->current, KEY_TTOX)) /* 10^x */
788 mppwr2(MP1, v->MPdisp_val, v->MPdisp_val) ;
791 else if (IS_KEY(v->current, KEY_LN)) /* Ln */
793 mpstr(v->MPdisp_val, MP1) ;
794 mpln(MP1, v->MPdisp_val) ;
797 else if (IS_KEY(v->current, KEY_LOG)) /* Log */
799 mplog10(v->MPdisp_val, v->MPdisp_val) ;
802 else if (IS_KEY(v->current, KEY_RAND)) /* Rand */
805 mpcdm(&dval, v->MPdisp_val) ;
808 else if (IS_KEY(v->current, KEY_SQRT)) /* Sqrt */
810 mpstr(v->MPdisp_val, MP1) ;
811 mpsqrt(MP1, v->MPdisp_val) ;
814 else if (IS_KEY(v->current, KEY_NOT)) /* Not */
816 mpcmd(v->MPdisp_val, &dval) ;
817 dval = setbool((BOOLEAN)~ibool(dval)) ;
818 mpcdm(&dval, v->MPdisp_val) ;
821 else if (IS_KEY(v->current, KEY_REC)) /* 1/x */
825 mpstr(v->MPdisp_val, MP2) ;
826 mpdiv(MP1, MP2, v->MPdisp_val) ;
828 else if (IS_KEY(v->current, KEY_FACT)) /* x! */
830 do_factorial(v->MPdisp_val, MP1) ;
831 mpstr(MP1, v->MPdisp_val) ;
833 else if (IS_KEY(v->current, KEY_SQR)) /* x^2 */
835 mpstr(v->MPdisp_val, MP1) ;
836 mpmul(MP1, MP1, v->MPdisp_val) ;
839 else if (IS_KEY(v->current, KEY_CHS)) /* +/- */
843 if (*v->exp_posn == '+') *v->exp_posn = '-' ;
844 else *v->exp_posn = '+' ;
845 set_item(DISPLAYITEM, v->display) ;
846 MPstr_to_num(v->display, v->base, v->MPdisp_val) ;
851 mpneg(v->MPdisp_val, v->MPdisp_val) ;
852 mpstr(v->MPdisp_val, v->MPlast_input) ;
855 show_display(v->MPdisp_val) ;
860 do_keys() /* Display/undisplay the dtcalc key values. */
862 v->tstate = !v->tstate ;
867 do_mode() /* Set special calculator mode. */
869 if (v->current == MODE_FIN) v->modetype = FINANCIAL ;
870 else if (v->current == MODE_LOG) v->modetype = LOGICAL ;
871 else if (v->current == MODE_SCI) v->modetype = SCIENTIFIC ;
874 v->curwin = FCP_KEY ;
879 do_none() /* Null routine for empty buttons. */
889 static int maxvals[4] = { 1, 7, 9, 15 } ;
891 /* the financial state is false - last key was not a fin. key */
894 nextchar = v->current ;
895 n = v->current - '0' ;
896 if (v->base == HEX && v->current >= 'a' && v->current <= 'f')
898 nextchar -= 32 ; /* Convert to uppercase hex digit. */
899 n = v->current - 'a' + 10 ;
901 if (n > maxvals[(int) v->base])
909 SPRINTF(v->display, "%c", nextchar) ;
914 len = strlen(v->display) ;
915 if (len < MAX_DIGITS)
917 v->display[len] = nextchar ;
918 v->display[len+1] = '\0' ;
923 set_item(DISPLAYITEM, v->display) ;
924 MPstr_to_num(v->display, v->base, v->MPdisp_val) ;
930 do_numtype() /* Set number type (engineering, fixed or scientific). */
932 if (v->current == DISP_ENG) v->dtype = ENG ;
933 else if (v->current == DISP_FIX) v->dtype = FIX ;
934 else if (v->current == DISP_SCI) v->dtype = SCI ;
937 set_numtype(v->dtype);
941 enum num_type dtype ;
944 show_display(v->MPdisp_val) ;
945 set_option_menu((int) NUMITEM, (int)v->dtype);
946 if (v->rstate) make_registers(MEM) ;
947 if (v->frstate) make_registers(FIN) ;
956 /* the financial state is false - last key was not a fin. key */
959 /* Check to see if this is the first outstanding parenthesis. If so, and
960 * their is a current operation already defined, then add the current
961 * operation to the parenthesis expression being displayed.
962 * Increment parentheses count, and add the open paren to the expression.
965 if (IS_KEY(v->current, KEY_LPAR))
967 if (v->noparens == 0)
969 /* if not in default state, put the operand between the display
970 value and the paren, else just put the paren */
973 /* there is no paren, and there is no current operand ... Let's
974 make the current operand into a "x" */
981 /* if the current op is an '=' and the result in the display is
982 zero, we want to ignore the display */
985 mpcmd(v->MPdisp_val, &tmpdb);
989 STRCPY(v->display, "") ;
990 set_item(DISPLAYITEM, v->display) ;
997 paren_disp(v->cur_op) ;
1003 paren_disp(v->cur_op) ;
1008 STRCPY(v->display, "") ;
1009 set_item(DISPLAYITEM, v->display) ;
1014 int len = strlen(v->display);
1016 if(v->display[len - 1] >= '0' && v->display[len - 1] <= '9')
1017 paren_disp(v->cur_op) ;
1020 v->pending = v->current ;
1024 /* If we haven't had any left brackets yet, and this is a right bracket,
1025 * then just ignore it.
1026 * Decrement the bracket count. If the count is zero, then process the
1027 * parenthesis expression.
1030 else if (IS_KEY(v->current, KEY_RPAR))
1032 if (!v->noparens) return ;
1037 paren_disp(v->current) ;
1039 while (*ptr != '(') ptr++ ;
1040 while (*ptr != '\0') process_parens(*ptr++) ;
1044 paren_disp(v->current) ;
1051 /* the financial state is false - last key was not a fin. key */
1054 /* Certain pending operations which are half completed, force the numeric
1055 * keypad to be reshown (assuming they already aren't).
1057 * Con, Exch, Fun, Sto, Rcl and Acc show buttons 0 - 9.
1058 * < and > show buttons 0 - f.
1063 if (IS_KEY(v->current, KEY_CON) || /* Con. */
1064 IS_KEY(v->current, KEY_EXCH) || /* Exch. */
1065 IS_KEY(v->current, KEY_FUN) || /* Fun. */
1066 IS_KEY(v->current, KEY_STO) || /* Sto. */
1067 IS_KEY(v->current, KEY_RCL) || /* Rcl. */
1068 IS_KEY(v->current, KEY_ACC)) /* Acc. */
1070 if (IS_KEY(v->current, KEY_LSFT) ||
1071 IS_KEY(v->current, KEY_RSFT))
1075 if (IS_KEY(v->pending, KEY_BASE)) do_base() ; /* Base */
1076 else if (IS_KEY(v->pending, KEY_DISP)) do_numtype() ; /* Disp */
1077 else if (IS_KEY(v->pending, KEY_TRIG)) do_trigtype() ; /* Trig */
1078 else if (IS_KEY(v->pending, KEY_CON)) do_constant() ; /* Con */
1079 else if (IS_KEY(v->pending, KEY_EXCH)) do_exchange() ; /* Exch */
1080 else if (IS_KEY(v->pending, KEY_FUN)) do_function() ; /* Fun */
1081 else if (IS_KEY(v->pending, KEY_STO) || /* Sto */
1082 IS_KEY(v->pending, KEY_RCL)) /* Rcl */
1085 if (IS_KEY(v->pending_op, KEY_ADD) ||
1086 IS_KEY(v->pending_op, KEY_SUB) ||
1087 IS_KEY(v->pending_op, KEY_MUL) ||
1088 IS_KEY(v->pending_op, KEY_DIV)) return ;
1090 else if (IS_KEY(v->pending, KEY_LSFT) || /* < */
1091 IS_KEY(v->pending, KEY_RSFT)) do_shift() ; /* > */
1092 else if (IS_KEY(v->pending, KEY_ACC)) do_accuracy() ; /* Acc */
1093 else if (IS_KEY(v->pending, KEY_MODE)) do_mode() ; /* Mode */
1094 else if (IS_KEY(v->pending, KEY_LPAR)) /* ( */
1099 else if (!v->pending)
1101 save_pending_values(v->current) ;
1102 v->pending_op = KEY_EQ ;
1106 show_display(v->MPdisp_val) ;
1107 if (v->error) set_item(OPITEM, vstrs[(int) V_CLR]) ;
1108 else set_item(OPITEM, "") ; /* Redisplay pending op. (if any). */
1112 grey_buttons(v->base) ; /* Just show numeric keys for current base. */
1117 do_point() /* Handle numeric point. */
1119 /* the financial state is false - last key was not a fin. key */
1126 STRCPY(v->display, ".") ;
1129 else STRNCAT(v->display, ".", 1) ;
1134 set_item(DISPLAYITEM, v->display) ;
1135 MPstr_to_num(v->display, v->base, v->MPdisp_val) ;
1144 /* the financial state is false - last key was not a fin. key */
1147 if (IS_KEY(v->current, KEY_ABS)) /* Abs */
1149 mpstr(v->MPdisp_val, MP1) ;
1150 mpabs(MP1, v->MPdisp_val) ;
1152 else if (IS_KEY(v->current, KEY_FRAC)) /* Frac */
1154 mpstr(v->MPdisp_val, MP1) ;
1155 mpcmf(MP1, v->MPdisp_val) ;
1157 else if (IS_KEY(v->current, KEY_INT)) /* Int */
1159 mpstr(v->MPdisp_val, MP1) ;
1160 mpcmim(MP1, v->MPdisp_val) ;
1162 show_display(v->MPdisp_val) ;
1167 do_shift() /* Perform bitwise shift on display value. */
1169 int i, MPtemp[MP_SIZE], shift ;
1173 shift = char_val(v->current) ;
1174 if(strcmp(v->snum, v->display) != 0)
1176 MPstr_to_num(v->display, v->base, MPtemp) ;
1177 mpcmd(MPtemp, &dval) ;
1180 mpcmd(v->MPdisp_val, &dval) ;
1181 temp = ibool(dval) ;
1183 if (IS_KEY(v->pending, KEY_LSFT)) temp = temp << shift ;
1184 else if (IS_KEY(v->pending, KEY_RSFT)) temp = temp >> shift ;
1186 dval = setbool((BOOLEAN)temp) ;
1187 mpcdm(&dval, v->MPdisp_val) ;
1188 show_display(v->MPdisp_val) ;
1189 mpstr(v->MPdisp_val, v->MPlast_input) ;
1195 do_sto_rcl() /* Save/restore value to/from memory register. */
1197 int i, MPn[MP_SIZE], n ;
1199 for (i = MEM_START; i <= MEM_END; i++)
1200 if (v->current == menu_entries[i].val)
1202 if (IS_KEY(v->pending, KEY_RCL)) /* Rcl */
1204 mpstr(v->MPmvals[char_val(v->current)], v->MPdisp_val) ;
1207 else if (IS_KEY(v->pending, KEY_STO)) /* Sto */
1209 n = char_val(v->current) ;
1211 if (IS_KEY(v->pending_op, KEY_ADD)) /* + */
1213 mpstr(v->MPmvals[n], MPn) ;
1214 mpadd(MPn, v->MPdisp_val, v->MPmvals[n]) ;
1216 else if (IS_KEY(v->pending_op, KEY_SUB)) /* - */
1218 mpstr(v->MPmvals[n], MPn) ;
1219 mpsub(MPn, v->MPdisp_val, v->MPmvals[n]) ;
1221 else if (IS_KEY(v->pending_op, KEY_MUL)) /* x */
1223 mpstr(v->MPmvals[n], MPn) ;
1224 mpmul(MPn, v->MPdisp_val, v->MPmvals[n]) ;
1226 else if (IS_KEY(v->pending_op, KEY_DIV)) /* / */
1228 mpstr(v->MPmvals[n], MPn) ;
1229 mpdiv(MPn, v->MPdisp_val, v->MPmvals[n]) ;
1231 else mpstr(v->MPdisp_val, v->MPmvals[n]) ;
1234 make_registers(MEM) ;
1239 if (IS_KEY(v->current, KEY_ADD) || IS_KEY(v->current, KEY_SUB) ||
1240 IS_KEY(v->current, KEY_MUL) || IS_KEY(v->current, KEY_DIV))
1241 v->pending_op = v->current ;
1246 do_trig() /* Perform all trigonometric functions. */
1248 int i, MPtemp[MP_SIZE], MP1[MP_SIZE], MP2[MP_SIZE] ;
1250 int MPcos[MP_SIZE], MPsin[MP_SIZE] ;
1256 if (v->ttype == DEG)
1259 mpmul(v->MPdisp_val, MP1, MP2) ;
1262 mpdiv(MP2, MP1, MPtemp) ;
1264 else if (v->ttype == GRAD)
1267 mpmul(v->MPdisp_val, MP1, MP2) ;
1270 mpdiv(MP2, MP1, MPtemp) ;
1272 else mpstr(v->MPdisp_val, MPtemp) ;
1274 else mpstr(v->MPdisp_val, MPtemp) ;
1278 if (IS_KEY(v->current, KEY_COS)) /* Cos */
1279 mpcos(MPtemp, v->MPtresults[(int) RAD]) ;
1280 else if (IS_KEY(v->current, KEY_SIN)) /* Sin */
1281 mpsin(MPtemp, v->MPtresults[(int) RAD]) ;
1282 else if (IS_KEY(v->current, KEY_TAN)) /* Tan */
1284 mpsin(MPtemp, MPsin) ;
1285 mpcos(MPtemp, MPcos) ;
1286 mpcmd(MPcos, &cval) ;
1287 if (cval == 0.0) doerr(vstrs[(int) V_ERROR]) ;
1288 mpdiv(MPsin, MPcos, v->MPtresults[(int) RAD]) ;
1293 if (IS_KEY(v->current, KEY_COS)) /* Cosh */
1294 mpcosh(MPtemp, v->MPtresults[(int) RAD]) ;
1295 else if (IS_KEY(v->current, KEY_SIN)) /* Sinh */
1296 mpsinh(MPtemp, v->MPtresults[(int) RAD]) ;
1297 else if (IS_KEY(v->current, KEY_TAN)) /* Tanh */
1298 mptanh(MPtemp, v->MPtresults[(int) RAD]) ;
1301 mpstr(v->MPtresults[(int) RAD], v->MPtresults[(int) DEG]) ;
1302 mpstr(v->MPtresults[(int) RAD], v->MPtresults[(int) GRAD]) ;
1308 if (IS_KEY(v->current, KEY_COS)) /* Acos */
1309 mpacos(v->MPdisp_val, v->MPdisp_val) ;
1310 else if (IS_KEY(v->current, KEY_SIN)) /* Asin */
1311 mpasin(v->MPdisp_val, v->MPdisp_val) ;
1312 else if (IS_KEY(v->current, KEY_TAN)) /* Atan */
1313 mpatan(v->MPdisp_val, v->MPdisp_val) ;
1317 if (IS_KEY(v->current, KEY_COS)) /* Acosh */
1318 mpacosh(v->MPdisp_val, v->MPdisp_val) ;
1319 else if (IS_KEY(v->current, KEY_SIN)) /* Asinh */
1320 mpasinh(v->MPdisp_val, v->MPdisp_val) ;
1321 else if (IS_KEY(v->current, KEY_TAN)) /* Atanh */
1322 mpatanh(v->MPdisp_val, v->MPdisp_val) ;
1329 mpmul(v->MPdisp_val, MP1, MP2) ;
1331 mpdiv(MP2, MP1, v->MPtresults[(int) DEG]) ;
1335 mpmul(v->MPdisp_val, MP1, MP2) ;
1337 mpdiv(MP2, MP1, v->MPtresults[(int) GRAD]) ;
1341 mpstr(v->MPdisp_val, v->MPtresults[(int) DEG]) ;
1342 mpstr(v->MPdisp_val, v->MPtresults[(int) GRAD]) ;
1345 mpstr(v->MPdisp_val, v->MPtresults[(int) RAD]) ;
1348 show_display(v->MPtresults[(int) v->ttype]) ;
1349 mpstr(v->MPtresults[(int) v->ttype], v->MPdisp_val) ;
1355 do_trigtype() /* Change the current trigonometric type. */
1357 if (v->current == TRIG_DEG) v->ttype = DEG ;
1358 else if (v->current == TRIG_GRA) v->ttype = GRAD ;
1359 else if (v->current == TRIG_RAD) v->ttype = RAD ;
1362 if (IS_KEY(v->cur_op, KEY_COS) ||
1363 IS_KEY(v->cur_op, KEY_SIN) ||
1364 IS_KEY(v->cur_op, KEY_TAN))
1366 mpstr(v->MPtresults[(int) v->ttype], v->MPdisp_val) ;
1367 show_display(v->MPtresults[(int) v->ttype]) ;
1369 set_option_menu((int) TTYPEITEM, (int)v->ttype);
1380 if (x > 68719476736.00) return(0) ;
1381 else if (x < -68719476736.00) return(0) ;
1384 while (x < 0.0) x += 4294967296.00 ;
1385 while (x >= 4294967296.00) x -= 4294967296.00 ;
1397 if (x > 9007199254740991.00 || x < -9007199254740991.00)
1403 while (x < 0.0) x += 4294967296.00 ;
1404 while (x >= 4294967296.00) x -= 4294967296.00 ;
1411 /* The following MP routines were not in the Brent FORTRAN package. They are
1412 * derived here, in terms of the existing routines.
1415 /* MP precision arc cosine.
1417 * 1. If (x < -1.0 or x > 1.0) then report DOMAIN error and return 0.0.
1419 * 2. If (x = 0.0) then acos(x) = PI/2.
1421 * 3. If (x = 1.0) then acos(x) = 0.0
1423 * 4. If (x = -1.0) then acos(x) = PI.
1425 * 5. If (0.0 < x < 1.0) then acos(x) = atan(sqrt(1-(x**2)) / x)
1427 * 6. If (-1.0 < x < 0.0) then acos(x) = atan(sqrt(1-(x**2)) / x) + PI
1431 mpacos(MPx, MPretval)
1432 int *MPx, *MPretval ;
1434 int MP0[MP_SIZE], MP1[MP_SIZE], MP2[MP_SIZE] ;
1435 int MPn1[MP_SIZE], MPpi[MP_SIZE], MPy[MP_SIZE], val ;
1445 if (mpgt(MPx, MP1) || mplt(MPx, MPn1))
1447 doerr("acos DOMAIN error") ;
1448 mpstr(MP0, MPretval) ;
1450 else if (mpeq(MPx, MP0))
1453 mpdivi(MPpi, &val, MPretval) ;
1455 else if (mpeq(MPx, MP1)) mpstr(MP0, MPretval) ;
1456 else if (mpeq(MPx, MPn1)) mpstr(MPpi, MPretval) ;
1459 mpmul(MPx, MPx, MP2) ;
1460 mpsub(MP1, MP2, MP2) ;
1462 mpdiv(MP2, MPx, MP2) ;
1464 if (mpgt(MPx, MP0)) mpstr(MPy, MPretval) ;
1465 else mpadd(MPy, MPpi, MPretval) ;
1470 /* MP precision hyperbolic arc cosine.
1472 * 1. If (x < 1.0) then report DOMAIN error and return 0.0.
1474 * 2. acosh(x) = log(x + sqrt(x**2 - 1))
1478 mpacosh(MPx, MPretval)
1479 int *MPx, *MPretval ;
1481 int MP1[MP_SIZE], val ;
1487 doerr("acosh DOMAIN error") ;
1489 mpcim(&val, MPretval) ;
1493 mpmul(MPx, MPx, MP1) ;
1495 mpaddi(MP1, &val, MP1) ;
1497 mpadd(MPx, MP1, MP1) ;
1498 mpln(MP1, MPretval) ;
1503 /* MP precision hyperbolic arc sine.
1505 * 1. asinh(x) = log(x + sqrt(x**2 + 1))
1509 mpasinh(MPx, MPretval)
1510 int *MPx, *MPretval ;
1512 int MP1[MP_SIZE], val ;
1514 mpmul(MPx, MPx, MP1) ;
1516 mpaddi(MP1, &val, MP1) ;
1518 mpadd(MPx, MP1, MP1) ;
1519 mpln(MP1, MPretval) ;
1523 /* MP precision hyperbolic arc tangent.
1525 * 1. If (x <= -1.0 or x >= 1.0) then report a DOMAIn error and return 0.0.
1527 * 2. atanh(x) = 0.5 * log((1 + x) / (1 - x))
1531 mpatanh(MPx, MPretval)
1532 int *MPx, *MPretval ;
1534 int MP0[MP_SIZE], MP1[MP_SIZE], MP2[MP_SIZE] ;
1535 int MP3[MP_SIZE], MPn1[MP_SIZE], val ;
1544 if (mpge(MPx, MP1) || mple(MPx, MPn1))
1546 doerr("atanh DOMAIN error") ;
1547 mpstr(MP0, MPretval) ;
1551 mpadd(MP1, MPx, MP2) ;
1552 mpsub(MP1, MPx, MP3) ;
1553 mpdiv(MP2, MP3, MP3) ;
1555 MPstr_to_num("0.5", DEC, MP1) ;
1556 mpmul(MP1, MP3, MPretval) ;
1561 /* MP precision common log.
1563 * 1. log10(x) = log10(e) * log(x)
1567 mplog10(MPx, MPretval)
1568 int *MPx, *MPretval ;
1570 int MP1[MP_SIZE], MP2[MP_SIZE], n ;
1576 mpdiv(MP2, MP1, MPretval) ;
1581 process_parens(current)
1585 int last_lpar ; /* Position in stack of last left paren. */
1586 int last_num ; /* Position is numeric stack to start processing. */
1588 /* Check to see if this is the first outstanding parenthesis. If so, and
1589 * their is a current operation already defined, then push the current
1590 * result on the numeric stack, and note it on the op stack, with a -1,
1591 * which has this special significance.
1592 * Zeroise current display value (in case of invalid operands inside the
1594 * Add the current pending operation to the opstack.
1595 * Increment parentheses count.
1598 if (IS_KEY(current, KEY_LPAR))
1600 if (!v->noparens && v->cur_op != '?')
1602 push_num(v->MPresult) ;
1605 mpcim(&i, v->MPdisp_val) ;
1606 push_op(v->cur_op) ;
1608 v->noparens++ ; /* Count of left brackets outstanding. */
1609 save_pending_values(current) ;
1612 /* If we haven't had any left brackets yet, and this is a right bracket,
1613 * then just ignore it.
1614 * Decrement the bracket count.
1615 * Add a equals to the op stack, to force a calculation to be performed
1616 * for two op operands. This is ignored if the preceding element of the
1617 * op stack was an immediate operation.
1618 * Work out where the preceding left bracket is in the stack, and then
1619 * process the stack from that point until this end, pushing the result
1620 * on the numeric stack, and setting the new op stack pointer appropriately.
1621 * If there are no brackets left unmatched, then clear the pending flag,
1622 * clear the stack pointers and current operation, and show the display.
1625 else if (IS_KEY(current, KEY_RPAR))
1629 last_lpar = v->opsptr - 1 ;
1630 last_num = v->numsptr ;
1631 while (!IS_KEY(v->opstack[last_lpar], KEY_LPAR))
1633 if (v->opstack[last_lpar] == -1) last_num-- ;
1636 process_stack(last_lpar + 1, last_num, v->opsptr - last_lpar - 1) ;
1642 process_stack(0, 0, v->opsptr) ;
1644 v->pending = v->opsptr = v->numsptr = 0 ;
1646 set_item(OPITEM, "") ;
1649 set_item(DISPLAYITEM, vstrs[(int) V_ERROR]) ;
1650 set_item(OPITEM, vstrs[(int) V_CLR]) ;
1651 STRCPY(v->display, vstrs[(int) V_ERROR]) ;
1655 show_display(v->MPdisp_val) ;
1656 mpstr(v->MPdisp_val, v->MPlast_input) ;
1666 push_num(MPval) /* Try to push value onto the numeric stack. */
1669 if (v->numsptr < 0) return ;
1670 if (v->numsptr >= MAXSTACK)
1672 STRCPY(v->display, vstrs[(int) V_NUMSTACK]) ;
1673 set_item(DISPLAYITEM, v->display) ;
1676 set_item(OPITEM, vstrs[(int) V_CLR]) ;
1680 if (v->MPnumstack[v->numsptr] == NULL)
1681 v->MPnumstack[v->numsptr] =
1682 (int *) LINT_CAST(calloc(1, sizeof(int) * MP_SIZE)) ;
1683 mpstr(MPval, v->MPnumstack[v->numsptr++]) ;
1689 push_op(val) /* Try to push value onto the operand stack. */
1692 if (v->opsptr < 0) return ;
1693 if (v->opsptr >= MAXSTACK)
1695 STRCPY(v->display, vstrs[(int) V_OPSTACK]) ;
1696 set_item(DISPLAYITEM, v->display) ;
1698 set_item(OPITEM, vstrs[(int) V_CLR]) ;
1700 else v->opstack[v->opsptr++] = val ;
1705 save_pending_values(val)
1711 for (n = 0; n < TITEMS; n++)
1713 if (val == buttons[n].value)
1716 v->pending_win = v->curwin ;
1717 if (v->pending_win == FCP_MODE)
1718 v->pending_mode = v->modetype ;
1729 q = p & 0x80000000 ;
1732 if (q) val += 2147483648.0 ;
1737 do_round(result, ndigits)
1741 char buf2[40], buffer[100];
1744 if (isnan(result)) return result;
1745 #if defined(_AIX) || defined(__aix) || defined(__osf__)
1746 temp = finite(result);
1748 return (temp > 0) ? HUGE : -HUGE;
1750 #if defined(USL) || defined(__uxp__)
1751 temp = finite(result);
1753 return (temp > 0) ? HUGE : -HUGE;
1755 if (temp = isinf(result)) return (temp > 0) ? HUGE : -HUGE;
1756 #endif /* USL or __uxp__ */
1757 #endif /* _AIX or __osf__ */
1759 if (ndigits >= 0 && ndigits < MAX_DIGITS)
1761 result += 0.5 * (result > 0 ? mods[ndigits] : -mods[ndigits]);
1762 result -= fmod(result, mods[ndigits]);
1765 sprintf(buf2, "%%.%dlg", MAX_DIGITS);
1766 sprintf(buffer, buf2, result);
1767 return atof(buffer);
1771 try_compute_i(guess, result, method)
1776 double sum_pos, sum_pos_prime, sum_neg, sum_neg_prime, w = guess;
1782 double term, term_prime, f, f_prime, lsp, lsn;
1784 sum_pos = sum_pos_prime = sum_neg = sum_neg_prime = 0;
1786 if (v->MPfvals[2] != 0.0)
1791 term_prime = v->MPfvals[0];
1795 term = pow(w, v->MPfvals[0]);
1796 term_prime = (v->MPfvals[0]) * pow(w, v->MPfvals[0] - 1.0);
1798 if (v->MPfvals[2] > 0.0)
1800 sum_pos += v->MPfvals[2] * term;
1801 sum_pos_prime += v->MPfvals[2] * term_prime;
1805 sum_neg -= v->MPfvals[2] * term;
1806 sum_neg_prime -= v->MPfvals[2] * term_prime;
1809 if (v->MPfvals[3] != 0.0)
1813 term = v->MPfvals[0];
1815 term_prime = v->MPfvals[0] * (v->MPfvals[0] - 1) / 2.0 +
1816 v->MPfvals[0] * (0.0);
1820 double wn = pow(w, v->MPfvals[0]);
1821 double wdb = pow(w, 0.0);
1823 term = (wn - 1.0) * wdb / (w - 1.0);
1825 term_prime = (v->MPfvals[0] * pow(w,(0.0 + v->MPfvals[0] - .01))
1826 + (wn - 1.0) * (0.0) * pow(w, (0.0 - 1.0))) /
1827 (w - 1.0) - (wn - 1.0) * wdb /
1828 ((w - 1.0) * (w - 1.0));
1831 if (v->MPfvals[3] > 0.0)
1833 sum_pos += v->MPfvals[3] * term;
1834 sum_pos_prime += v->MPfvals[3] * term_prime;
1838 sum_neg -= v->MPfvals[3] * term;
1839 sum_neg_prime -= v->MPfvals[3] * term_prime;
1842 if (v->MPfvals[4] != 0.0)
1844 if (v->MPfvals[4] > 0.0) sum_pos += v->MPfvals[4];
1845 else sum_neg -= v->MPfvals[4];
1855 f_prime = sum_pos_prime / sum_pos - sum_neg_prime / sum_neg;
1858 f = lsp / lsn - 1.0;
1859 f_prime = (lsn * sum_pos_prime / sum_pos -
1860 lsp * sum_neg_prime / sum_neg) /
1865 new_w = w - f / f_prime;
1867 #if defined(_AIX) || defined(__aix) || defined (__osf__)
1868 if (!(!isnan(new_w) && finite(new_w)))
1871 #if defined(USL) || defined(__uxp__)
1872 if (!(!isnan(new_w) && finite(new_w)))
1875 if (!(!isnan(new_w) && !isinf(new_w)))
1878 #endif /* _AIX or __osf__ */
1880 if (new_w == w || w != 0.0 && fabs((new_w - w) / w) < FIN_EPSILON)
1885 if (niter++ >= MAX_FIN_ITER)
1889 *result = do_round((new_w - 1.0) * 100.0 * v->MPfvals[5], -1);
1897 double first_period, last_period;
1904 if (first_period < 0.0 || last_period < 0.0)
1906 doerr(GETMESSAGE(5, 5, "ERROR:Invalid odd period values"));
1910 p[0] = v->MPfvals[2] + (first_period == 0.0 ? v->MPfvals[3] : 0);
1911 p[1] = v->MPfvals[3];
1912 p[2] = v->MPfvals[4] + (last_period == 0.0 ? v->MPfvals[3] : 0);
1914 nsc = count_sign_changes(p, 3);
1918 int MP1[MP_SIZE], MP2[MP_SIZE], MP3[MP_SIZE], MP4[MP_SIZE];
1923 temp = v->MPfvals[4]/v->MPfvals[2];
1927 mpcdm(&(v->MPfvals[0]), MP4);
1928 mpdiv(MP2, MP4, MP3) ;
1929 mppwr2(MP1, MP3, MP5) ;
1931 mpaddi(MP5, &val, MP1) ;
1933 mpmuli(MP1, &val, v->MPdisp_val) ;
1934 mpcmd(v->MPdisp_val, target);
1939 doerr(GETMESSAGE(5, 3, "ERROR: Multiple Solutions"));
1942 else if (v->MPfvals[0] <= 0)
1944 doerr(GETMESSAGE(5, 4, "ERROR: Term <= 0"));
1948 success = try_compute_i((double)1.0, target, 1);
1949 success = success || try_compute_i((double)1.0e-12, target, 1);
1950 success = success || try_compute_i((double)1.0, target, 2);
1951 success = success || try_compute_i((double)1.0e-12, target, 2);
1954 doerr(GETMESSAGE(5, 1, "ERROR: Computation Failed"));
1958 count_sign_changes(cf, count)
1962 int i, curr_sign = 0, result = 0;
1964 for (i = 0; i < count; i++)
1966 if (cf[i] == 0.0) continue;
1970 if (cf[i] > 0.0) continue;
1974 else if (curr_sign == -1)
1976 if (cf[i] < 0.0) continue;
1982 if (cf[i] > 0.0) curr_sign = 1;
1983 else curr_sign = -1;