[BACK]Return to internal.c CVS log [TXT][DIR] Up to [local] / OpenXM_contrib / gnuplot

Annotation of OpenXM_contrib/gnuplot/internal.c, Revision 1.1.1.2

1.1       maekawa     1: #ifndef lint
1.1.1.2 ! maekawa     2: static char *RCSid = "$Id: internal.c,v 1.7 1998/12/07 22:10:32 lhecking Exp $";
1.1       maekawa     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(&param);
                    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: }

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>