![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to internal.c CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib / gnuplot|
Return to internal.c CVS log | Up to [local] / OpenXM_contrib / gnuplot |
1.1 maekawa 1: #ifndef lint
2: static char *RCSid = "$Id: internal.c,v 1.23 1998/04/14 00:15:44 drd Exp $";
3: #endif
4:
5: /* GNUPLOT - internal.c */
6:
7: /*[
8: * Copyright 1986 - 1993, 1998 Thomas Williams, Colin Kelley
9: *
10: * Permission to use, copy, and distribute this software and its
11: * documentation for any purpose with or without fee is hereby granted,
12: * provided that the above copyright notice appear in all copies and
13: * that both that copyright notice and this permission notice appear
14: * in supporting documentation.
15: *
16: * Permission to modify the software is granted, but not the right to
17: * distribute the complete modified source code. Modifications are to
18: * be distributed as patches to the released version. Permission to
19: * distribute binaries produced by compiling modified sources is granted,
20: * provided you
21: * 1. distribute the corresponding source modifications from the
22: * released version in the form of a patch file along with the binaries,
23: * 2. add special version identification to distinguish your version
24: * in addition to the base release version number,
25: * 3. provide your name and address as the primary contact for the
26: * support of your modified version, and
27: * 4. retain our contact information in regard to use of the base
28: * software.
29: * Permission to distribute the released version of the source code along
30: * with corresponding source modifications in the form of a patch file is
31: * granted with same provisions 2 through 4 for binary distributions.
32: *
33: * This software is provided "as is" without express or implied warranty
34: * to the extent permitted by applicable law.
35: ]*/
36:
37:
38: #include "plot.h"
39: #include "fnproto.h"
40:
41: /* some machines have trouble with exp(-x) for large x
42: * if MINEXP is defined at compile time, use gp_exp(x) instead,
43: * which returns 0 for exp(x) with x < MINEXP
44: * exp(x) will already have been defined as gp_exp(x) in plot.h
45: */
46:
47: #ifdef MINEXP
48: double gp_exp(x)
49: double x;
50: {
51: return (x < (MINEXP)) ? 0.0 : exp(x);
52: }
53: #endif
54:
55: TBOOLEAN undefined;
56:
57: static void int_check __PROTO((struct value * v));
58:
59: struct value stack[STACK_DEPTH];
60:
61: int s_p = -1; /* stack pointer */
62:
63:
64: /*
65: * System V and MSC 4.0 call this when they wants to print an error message.
66: * Don't!
67: */
68: #ifndef _CRAY
69: # ifdef AMIGA_SC_6_1
70: # define matherr __matherr
71: # define exception __exception
72: # endif /* AMIGA_SC_6_1 */
73: # if defined(__BORLANDC__) && __BORLANDC__ >= 0x450
74: # define matherr _matherr
75: # endif /* __BORLANDC__ >= 0x450 */
76: # if (defined(MSDOS) || defined(DOS386)) && defined(__TURBOC__) || defined(VMS)
77: int matherr()
78: #else
79: int matherr(x)
80: struct exception *x;
81: # endif /* (MSDOS || DOS386) && __TURBOC__ */
82: {
83: return (undefined = TRUE); /* don't print error message */
84: }
85: #endif /* not _CRAY */
86:
87:
88: void reset_stack()
89: {
90: s_p = -1;
91: }
92:
93:
94: void check_stack()
95: { /* make sure stack's empty */
96: if (s_p != -1)
97: fprintf(stderr, "\n\
98: warning: internal error--stack not empty!\n\
99: (function called with too many parameters?)\n");
100: }
101:
102: #define BAD_DEFAULT default: int_error("interal error : type neither INT or CMPLX", NO_CARET); return;
103:
104: struct value *pop(x)
105: struct value *x;
106: {
107: if (s_p < 0)
108: int_error("stack underflow (function call with missing parameters?)", NO_CARET);
109: *x = stack[s_p--];
110: return (x);
111: }
112:
113:
114: void push(x)
115: struct value *x;
116: {
117: if (s_p == STACK_DEPTH - 1)
118: int_error("stack overflow", NO_CARET);
119: stack[++s_p] = *x;
120: }
121:
122:
123: #define ERR_VAR "undefined variable: "
124:
125: void f_push(x)
126: union argument *x; /* contains pointer to value to push; */
127: {
128: static char err_str[sizeof(ERR_VAR) + MAX_ID_LEN] = ERR_VAR;
129: struct udvt_entry *udv;
130:
131: udv = x->udv_arg;
132: if (udv->udv_undef) { /* undefined */
133: (void) strcpy(&err_str[sizeof(ERR_VAR) - 1], udv->udv_name);
134: int_error(err_str, NO_CARET);
135: }
136: push(&(udv->udv_value));
137: }
138:
139:
140: void f_pushc(x)
141: union argument *x;
142: {
143: push(&(x->v_arg));
144: }
145:
146:
147: void f_pushd1(x)
148: union argument *x;
149: {
150: push(&(x->udf_arg->dummy_values[0]));
151: }
152:
153:
154: void f_pushd2(x)
155: union argument *x;
156: {
157: push(&(x->udf_arg->dummy_values[1]));
158: }
159:
160:
161: void f_pushd(x)
162: union argument *x;
163: {
164: struct value param;
165: (void) pop(¶m);
166: push(&(x->udf_arg->dummy_values[param.v.int_val]));
167: }
168:
169:
170: #define ERR_FUN "undefined function: "
171:
172: void f_call(x) /* execute a udf */
173: union argument *x;
174: {
175: static char err_str[sizeof(ERR_FUN) + MAX_ID_LEN] = ERR_FUN;
176: register struct udft_entry *udf;
177: struct value save_dummy;
178:
179: udf = x->udf_arg;
180: if (!udf->at) { /* undefined */
181: (void) strcpy(&err_str[sizeof(ERR_FUN) - 1],
182: udf->udf_name);
183: int_error(err_str, NO_CARET);
184: }
185: save_dummy = udf->dummy_values[0];
186: (void) pop(&(udf->dummy_values[0]));
187:
188: execute_at(udf->at);
189: udf->dummy_values[0] = save_dummy;
190: }
191:
192:
193: void f_calln(x) /* execute a udf of n variables */
194: union argument *x;
195: {
196: static char err_str[sizeof(ERR_FUN) + MAX_ID_LEN] = ERR_FUN;
197: register struct udft_entry *udf;
198: struct value save_dummy[MAX_NUM_VAR];
199:
200: int i;
201: int num_pop;
202: struct value num_params;
203:
204: udf = x->udf_arg;
205: if (!udf->at) { /* undefined */
206: (void) strcpy(&err_str[sizeof(ERR_FUN) - 1],
207: udf->udf_name);
208: int_error(err_str, NO_CARET);
209: }
210: for (i = 0; i < MAX_NUM_VAR; i++)
211: save_dummy[i] = udf->dummy_values[i];
212:
213: /* if there are more parameters than the function is expecting */
214: /* simply ignore the excess */
215: (void) pop(&num_params);
216:
217: if (num_params.v.int_val > MAX_NUM_VAR) {
218: /* pop the dummies that there is no room for */
219: num_pop = num_params.v.int_val - MAX_NUM_VAR;
220: for (i = 0; i < num_pop; i++)
221: (void) pop(&(udf->dummy_values[i]));
222:
223: num_pop = MAX_NUM_VAR;
224: } else {
225: num_pop = num_params.v.int_val;
226: }
227:
228: /* pop parameters we can use */
229: for (i = num_pop - 1; i >= 0; i--)
230: (void) pop(&(udf->dummy_values[i]));
231:
232: execute_at(udf->at);
233: for (i = 0; i < MAX_NUM_VAR; i++)
234: udf->dummy_values[i] = save_dummy[i];
235: }
236:
237:
238: static void int_check(v)
239: struct value *v;
240: {
241: if (v->type != INTGR)
242: int_error("non-integer passed to boolean operator", NO_CARET);
243: }
244:
245:
246: void f_lnot()
247: {
248: struct value a;
249: int_check(pop(&a));
250: push(Ginteger(&a, !a.v.int_val));
251: }
252:
253:
254: void f_bnot()
255: {
256: struct value a;
257: int_check(pop(&a));
258: push(Ginteger(&a, ~a.v.int_val));
259: }
260:
261:
262: void f_bool()
263: { /* converts top-of-stack to boolean */
264: int_check(&top_of_stack);
265: top_of_stack.v.int_val = !!top_of_stack.v.int_val;
266: }
267:
268:
269: void f_lor()
270: {
271: struct value a, b;
272: int_check(pop(&b));
273: int_check(pop(&a));
274: push(Ginteger(&a, a.v.int_val || b.v.int_val));
275: }
276:
277: void f_land()
278: {
279: struct value a, b;
280: int_check(pop(&b));
281: int_check(pop(&a));
282: push(Ginteger(&a, a.v.int_val && b.v.int_val));
283: }
284:
285:
286: void f_bor()
287: {
288: struct value a, b;
289: int_check(pop(&b));
290: int_check(pop(&a));
291: push(Ginteger(&a, a.v.int_val | b.v.int_val));
292: }
293:
294:
295: void f_xor()
296: {
297: struct value a, b;
298: int_check(pop(&b));
299: int_check(pop(&a));
300: push(Ginteger(&a, a.v.int_val ^ b.v.int_val));
301: }
302:
303:
304: void f_band()
305: {
306: struct value a, b;
307: int_check(pop(&b));
308: int_check(pop(&a));
309: push(Ginteger(&a, a.v.int_val & b.v.int_val));
310: }
311:
312:
313: void f_uminus()
314: {
315: struct value a;
316: (void) pop(&a);
317: switch (a.type) {
318: case INTGR:
319: a.v.int_val = -a.v.int_val;
320: break;
321: case CMPLX:
322: a.v.cmplx_val.real =
323: -a.v.cmplx_val.real;
324: a.v.cmplx_val.imag =
325: -a.v.cmplx_val.imag;
326: break;
327: BAD_DEFAULT
328: }
329: push(&a);
330: }
331:
332:
333: void f_eq()
334: {
335: /* note: floating point equality is rare because of roundoff error! */
336: struct value a, b;
337: register int result = 0;
338: (void) pop(&b);
339: (void) pop(&a);
340: switch (a.type) {
341: case INTGR:
342: switch (b.type) {
343: case INTGR:
344: result = (a.v.int_val ==
345: b.v.int_val);
346: break;
347: case CMPLX:
348: result = (a.v.int_val ==
349: b.v.cmplx_val.real &&
350: b.v.cmplx_val.imag == 0.0);
351: break;
352: BAD_DEFAULT
353: }
354: break;
355: case CMPLX:
356: switch (b.type) {
357: case INTGR:
358: result = (b.v.int_val == a.v.cmplx_val.real &&
359: a.v.cmplx_val.imag == 0.0);
360: break;
361: case CMPLX:
362: result = (a.v.cmplx_val.real ==
363: b.v.cmplx_val.real &&
364: a.v.cmplx_val.imag ==
365: b.v.cmplx_val.imag);
366: break;
367: BAD_DEFAULT
368: }
369: break;
370: BAD_DEFAULT
371: }
372: push(Ginteger(&a, result));
373: }
374:
375:
376: void f_ne()
377: {
378: struct value a, b;
379: register int result = 0;
380: (void) pop(&b);
381: (void) pop(&a);
382: switch (a.type) {
383: case INTGR:
384: switch (b.type) {
385: case INTGR:
386: result = (a.v.int_val !=
387: b.v.int_val);
388: break;
389: case CMPLX:
390: result = (a.v.int_val !=
391: b.v.cmplx_val.real ||
392: b.v.cmplx_val.imag != 0.0);
393: break;
394: BAD_DEFAULT
395: }
396: break;
397: case CMPLX:
398: switch (b.type) {
399: case INTGR:
400: result = (b.v.int_val !=
401: a.v.cmplx_val.real ||
402: a.v.cmplx_val.imag != 0.0);
403: break;
404: case CMPLX:
405: result = (a.v.cmplx_val.real !=
406: b.v.cmplx_val.real ||
407: a.v.cmplx_val.imag !=
408: b.v.cmplx_val.imag);
409: break;
410: BAD_DEFAULT
411: }
412: break;
413: BAD_DEFAULT
414: }
415: push(Ginteger(&a, result));
416: }
417:
418:
419: void f_gt()
420: {
421: struct value a, b;
422: register int result = 0;
423: (void) pop(&b);
424: (void) pop(&a);
425: switch (a.type) {
426: case INTGR:
427: switch (b.type) {
428: case INTGR:
429: result = (a.v.int_val >
430: b.v.int_val);
431: break;
432: case CMPLX:
433: result = (a.v.int_val >
434: b.v.cmplx_val.real);
435: break;
436: BAD_DEFAULT
437: }
438: break;
439: case CMPLX:
440: switch (b.type) {
441: case INTGR:
442: result = (a.v.cmplx_val.real >
443: b.v.int_val);
444: break;
445: case CMPLX:
446: result = (a.v.cmplx_val.real >
447: b.v.cmplx_val.real);
448: break;
449: BAD_DEFAULT
450: }
451: break;
452: BAD_DEFAULT
453: }
454: push(Ginteger(&a, result));
455: }
456:
457:
458: void f_lt()
459: {
460: struct value a, b;
461: register int result = 0;
462: (void) pop(&b);
463: (void) pop(&a);
464: switch (a.type) {
465: case INTGR:
466: switch (b.type) {
467: case INTGR:
468: result = (a.v.int_val <
469: b.v.int_val);
470: break;
471: case CMPLX:
472: result = (a.v.int_val <
473: b.v.cmplx_val.real);
474: break;
475: BAD_DEFAULT
476: }
477: break;
478: case CMPLX:
479: switch (b.type) {
480: case INTGR:
481: result = (a.v.cmplx_val.real <
482: b.v.int_val);
483: break;
484: case CMPLX:
485: result = (a.v.cmplx_val.real <
486: b.v.cmplx_val.real);
487: break;
488: BAD_DEFAULT
489: }
490: break;
491: BAD_DEFAULT
492: }
493: push(Ginteger(&a, result));
494: }
495:
496:
497: void f_ge()
498: {
499: struct value a, b;
500: register int result = 0;
501: (void) pop(&b);
502: (void) pop(&a);
503: switch (a.type) {
504: case INTGR:
505: switch (b.type) {
506: case INTGR:
507: result = (a.v.int_val >=
508: b.v.int_val);
509: break;
510: case CMPLX:
511: result = (a.v.int_val >=
512: b.v.cmplx_val.real);
513: break;
514: BAD_DEFAULT
515: }
516: break;
517: case CMPLX:
518: switch (b.type) {
519: case INTGR:
520: result = (a.v.cmplx_val.real >=
521: b.v.int_val);
522: break;
523: case CMPLX:
524: result = (a.v.cmplx_val.real >=
525: b.v.cmplx_val.real);
526: break;
527: BAD_DEFAULT
528: }
529: break;
530: BAD_DEFAULT
531: }
532: push(Ginteger(&a, result));
533: }
534:
535:
536: void f_le()
537: {
538: struct value a, b;
539: register int result = 0;
540: (void) pop(&b);
541: (void) pop(&a);
542: switch (a.type) {
543: case INTGR:
544: switch (b.type) {
545: case INTGR:
546: result = (a.v.int_val <=
547: b.v.int_val);
548: break;
549: case CMPLX:
550: result = (a.v.int_val <=
551: b.v.cmplx_val.real);
552: break;
553: BAD_DEFAULT
554: }
555: break;
556: case CMPLX:
557: switch (b.type) {
558: case INTGR:
559: result = (a.v.cmplx_val.real <=
560: b.v.int_val);
561: break;
562: case CMPLX:
563: result = (a.v.cmplx_val.real <=
564: b.v.cmplx_val.real);
565: break;
566: BAD_DEFAULT
567: }
568: break;
569: BAD_DEFAULT
570: }
571: push(Ginteger(&a, result));
572: }
573:
574:
575: void f_plus()
576: {
577: struct value a, b, result;
578: (void) pop(&b);
579: (void) pop(&a);
580: switch (a.type) {
581: case INTGR:
582: switch (b.type) {
583: case INTGR:
584: (void) Ginteger(&result, a.v.int_val +
585: b.v.int_val);
586: break;
587: case CMPLX:
588: (void) Gcomplex(&result, a.v.int_val +
589: b.v.cmplx_val.real,
590: b.v.cmplx_val.imag);
591: break;
592: BAD_DEFAULT
593: }
594: break;
595: case CMPLX:
596: switch (b.type) {
597: case INTGR:
598: (void) Gcomplex(&result, b.v.int_val +
599: a.v.cmplx_val.real,
600: a.v.cmplx_val.imag);
601: break;
602: case CMPLX:
603: (void) Gcomplex(&result, a.v.cmplx_val.real +
604: b.v.cmplx_val.real,
605: a.v.cmplx_val.imag +
606: b.v.cmplx_val.imag);
607: break;
608: BAD_DEFAULT
609: }
610: break;
611: BAD_DEFAULT
612: }
613: push(&result);
614: }
615:
616:
617: void f_minus()
618: {
619: struct value a, b, result;
620: (void) pop(&b);
621: (void) pop(&a); /* now do a - b */
622: switch (a.type) {
623: case INTGR:
624: switch (b.type) {
625: case INTGR:
626: (void) Ginteger(&result, a.v.int_val -
627: b.v.int_val);
628: break;
629: case CMPLX:
630: (void) Gcomplex(&result, a.v.int_val -
631: b.v.cmplx_val.real,
632: -b.v.cmplx_val.imag);
633: break;
634: BAD_DEFAULT
635: }
636: break;
637: case CMPLX:
638: switch (b.type) {
639: case INTGR:
640: (void) Gcomplex(&result, a.v.cmplx_val.real -
641: b.v.int_val,
642: a.v.cmplx_val.imag);
643: break;
644: case CMPLX:
645: (void) Gcomplex(&result, a.v.cmplx_val.real -
646: b.v.cmplx_val.real,
647: a.v.cmplx_val.imag -
648: b.v.cmplx_val.imag);
649: break;
650: BAD_DEFAULT
651: }
652: break;
653: BAD_DEFAULT
654: }
655: push(&result);
656: }
657:
658:
659: void f_mult()
660: {
661: struct value a, b, result;
662: (void) pop(&b);
663: (void) pop(&a); /* now do a*b */
664:
665: switch (a.type) {
666: case INTGR:
667: switch (b.type) {
668: case INTGR:
669: (void) Ginteger(&result, a.v.int_val *
670: b.v.int_val);
671: break;
672: case CMPLX:
673: (void) Gcomplex(&result, a.v.int_val *
674: b.v.cmplx_val.real,
675: a.v.int_val *
676: b.v.cmplx_val.imag);
677: break;
678: BAD_DEFAULT
679: }
680: break;
681: case CMPLX:
682: switch (b.type) {
683: case INTGR:
684: (void) Gcomplex(&result, b.v.int_val *
685: a.v.cmplx_val.real,
686: b.v.int_val *
687: a.v.cmplx_val.imag);
688: break;
689: case CMPLX:
690: (void) Gcomplex(&result, a.v.cmplx_val.real *
691: b.v.cmplx_val.real -
692: a.v.cmplx_val.imag *
693: b.v.cmplx_val.imag,
694: a.v.cmplx_val.real *
695: b.v.cmplx_val.imag +
696: a.v.cmplx_val.imag *
697: b.v.cmplx_val.real);
698: break;
699: BAD_DEFAULT
700: }
701: break;
702: BAD_DEFAULT
703: }
704: push(&result);
705: }
706:
707:
708: void f_div()
709: {
710: struct value a, b, result;
711: register double square;
712: (void) pop(&b);
713: (void) pop(&a); /* now do a/b */
714:
715: switch (a.type) {
716: case INTGR:
717: switch (b.type) {
718: case INTGR:
719: if (b.v.int_val)
720: (void) Ginteger(&result, a.v.int_val /
721: b.v.int_val);
722: else {
723: (void) Ginteger(&result, 0);
724: undefined = TRUE;
725: }
726: break;
727: case CMPLX:
728: square = b.v.cmplx_val.real *
729: b.v.cmplx_val.real +
730: b.v.cmplx_val.imag *
731: b.v.cmplx_val.imag;
732: if (square)
733: (void) Gcomplex(&result, a.v.int_val *
734: b.v.cmplx_val.real / square,
735: -a.v.int_val *
736: b.v.cmplx_val.imag / square);
737: else {
738: (void) Gcomplex(&result, 0.0, 0.0);
739: undefined = TRUE;
740: }
741: break;
742: BAD_DEFAULT
743: }
744: break;
745: case CMPLX:
746: switch (b.type) {
747: case INTGR:
748: if (b.v.int_val)
749: (void) Gcomplex(&result, a.v.cmplx_val.real /
750: b.v.int_val,
751: a.v.cmplx_val.imag /
752: b.v.int_val);
753: else {
754: (void) Gcomplex(&result, 0.0, 0.0);
755: undefined = TRUE;
756: }
757: break;
758: case CMPLX:
759: square = b.v.cmplx_val.real *
760: b.v.cmplx_val.real +
761: b.v.cmplx_val.imag *
762: b.v.cmplx_val.imag;
763: if (square)
764: (void) Gcomplex(&result, (a.v.cmplx_val.real *
765: b.v.cmplx_val.real +
766: a.v.cmplx_val.imag *
767: b.v.cmplx_val.imag) / square,
768: (a.v.cmplx_val.imag *
769: b.v.cmplx_val.real -
770: a.v.cmplx_val.real *
771: b.v.cmplx_val.imag) /
772: square);
773: else {
774: (void) Gcomplex(&result, 0.0, 0.0);
775: undefined = TRUE;
776: }
777: break;
778: BAD_DEFAULT
779: }
780: break;
781: BAD_DEFAULT
782: }
783: push(&result);
784: }
785:
786:
787: void f_mod()
788: {
789: struct value a, b;
790: (void) pop(&b);
791: (void) pop(&a); /* now do a%b */
792:
793: if (a.type != INTGR || b.type != INTGR)
794: int_error("can only mod ints", NO_CARET);
795: if (b.v.int_val)
796: push(Ginteger(&a, a.v.int_val % b.v.int_val));
797: else {
798: push(Ginteger(&a, 0));
799: undefined = TRUE;
800: }
801: }
802:
803:
804: void f_power()
805: {
806: struct value a, b, result;
807: register int i, t, count;
808: register double mag, ang;
809: (void) pop(&b);
810: (void) pop(&a); /* now find a**b */
811:
812: switch (a.type) {
813: case INTGR:
814: switch (b.type) {
815: case INTGR:
816: count = abs(b.v.int_val);
817: t = 1;
818: /* this ought to use bit-masks and squares, etc */
819: for (i = 0; i < count; i++)
820: t *= a.v.int_val;
821: if (b.v.int_val >= 0)
822: (void) Ginteger(&result, t);
823: else if (t != 0)
824: (void) Gcomplex(&result, 1.0 / t, 0.0);
825: else {
826: undefined = TRUE;
827: (void) Gcomplex(&result, 0.0, 0.0);
828: }
829: break;
830: case CMPLX:
831: if (a.v.int_val == 0) {
832: if (b.v.cmplx_val.imag != 0 || b.v.cmplx_val.real < 0) {
833: undefined = TRUE;
834: }
835: /* return 1.0 for 0**0 */
836: Gcomplex(&result, b.v.cmplx_val.real == 0 ? 1.0 : 0.0, 0.0);
837: } else {
838: mag =
839: pow(magnitude(&a), fabs(b.v.cmplx_val.real));
840: if (b.v.cmplx_val.real < 0.0) {
841: if (mag != 0.0)
842: mag = 1.0 / mag;
843: else
844: undefined = TRUE;
845: }
846: mag *= gp_exp(-b.v.cmplx_val.imag * angle(&a));
847: ang = b.v.cmplx_val.real * angle(&a) +
848: b.v.cmplx_val.imag * log(magnitude(&a));
849: (void) Gcomplex(&result, mag * cos(ang),
850: mag * sin(ang));
851: }
852: break;
853: BAD_DEFAULT
854: }
855: break;
856: case CMPLX:
857: switch (b.type) {
858: case INTGR:
859: if (a.v.cmplx_val.imag == 0.0) {
860: mag = pow(a.v.cmplx_val.real, (double) abs(b.v.int_val));
861: if (b.v.int_val < 0) {
862: if (mag != 0.0)
863: mag = 1.0 / mag;
864: else
865: undefined = TRUE;
866: }
867: (void) Gcomplex(&result, mag, 0.0);
868: } else {
869: /* not so good, but...! */
870: mag = pow(magnitude(&a), (double) abs(b.v.int_val));
871: if (b.v.int_val < 0) {
872: if (mag != 0.0)
873: mag = 1.0 / mag;
874: else
875: undefined = TRUE;
876: }
877: ang = angle(&a) * b.v.int_val;
878: (void) Gcomplex(&result, mag * cos(ang),
879: mag * sin(ang));
880: }
881: break;
882: case CMPLX:
883: if (a.v.cmplx_val.real == 0 && a.v.cmplx_val.imag == 0) {
884: if (b.v.cmplx_val.imag != 0 || b.v.cmplx_val.real < 0) {
885: undefined = TRUE;
886: }
887: /* return 1.0 for 0**0 */
888: Gcomplex(&result, b.v.cmplx_val.real == 0 ? 1.0 : 0.0, 0.0);
889: } else {
890: mag = pow(magnitude(&a), fabs(b.v.cmplx_val.real));
891: if (b.v.cmplx_val.real < 0.0) {
892: if (mag != 0.0)
893: mag = 1.0 / mag;
894: else
895: undefined = TRUE;
896: }
897: mag *= gp_exp(-b.v.cmplx_val.imag * angle(&a));
898: ang = b.v.cmplx_val.real * angle(&a) +
899: b.v.cmplx_val.imag * log(magnitude(&a));
900: (void) Gcomplex(&result, mag * cos(ang),
901: mag * sin(ang));
902: }
903: break;
904: BAD_DEFAULT
905: }
906: break;
907: BAD_DEFAULT
908: }
909: push(&result);
910: }
911:
912:
913: void f_factorial()
914: {
915: struct value a;
916: register int i;
917: register double val = 0.0;
918:
919: (void) pop(&a); /* find a! (factorial) */
920:
921: switch (a.type) {
922: case INTGR:
923: val = 1.0;
924: for (i = a.v.int_val; i > 1; i--) /*fpe's should catch overflows */
925: val *= i;
926: break;
927: default:
928: int_error("factorial (!) argument must be an integer", NO_CARET);
929: return; /* avoid gcc -Wall warning about val */
930: }
931:
932: push(Gcomplex(&a, val, 0.0));
933:
934: }
935:
936:
937: int f_jump(x)
938: union argument *x;
939: {
940: return (x->j_arg);
941: }
942:
943:
944: int f_jumpz(x)
945: union argument *x;
946: {
947: struct value a;
948: int_check(&top_of_stack);
949: if (top_of_stack.v.int_val) { /* non-zero */
950: (void) pop(&a);
951: return 1; /* no jump */
952: } else
953: return (x->j_arg); /* leave the argument on TOS */
954: }
955:
956:
957: int f_jumpnz(x)
958: union argument *x;
959: {
960: struct value a;
961: int_check(&top_of_stack);
962: if (top_of_stack.v.int_val) /* non-zero */
963: return (x->j_arg); /* leave the argument on TOS */
964: else {
965: (void) pop(&a);
966: return 1; /* no jump */
967: }
968: }
969:
970:
971: int f_jtern(x)
972: union argument *x;
973: {
974: struct value a;
975:
976: int_check(pop(&a));
977: if (a.v.int_val)
978: return (1); /* no jump; fall through to TRUE code */
979: else
980: return (x->j_arg); /* go jump to FALSE code */
981: }