archive/o/internal.c

   1
   2 /************************************************************************
   3  *
   4  *  Code is modified from the code for Gnuplot by Zou Maorong
   5  */
   6 /*
   7  *  G N U P L O T  --  internal.c
   8  *  Copyright (C) 1986, 1987  Thomas Williams, Colin Kelley
   9  *  You may use this code as you wish if credit is given and this message
  10  *  is retained.
  11  */
  12 /****************************************************************************/
  13
  14 #include <math.h>
  15 #include <stdio.h>
  16 #include "plot.h"
  17
  18
  19 extern BOOLEAN   undefined;
  20
  21 char             *strcpy();
  22 struct value     *pop(), *complex(), *integer();
  23 double           magnitude(), angle(), real();
  24 struct value     stack[STACK_DEPTH];
  25 int               s_p = -1;   /* stack pointer */
  26
  27 /*************************************************************/
  28
  29 reset_stack()
  30 {
  31   s_p = -1;
  32 }
  33
  34 /*************************************************************/
  35
  36 check_stack()   /* make sure stack's empty */
  37 {
  38   if (s_p != -1)
  39     (void)fprintf(STDERRR,"\nwarning:  internal error--stack not empty!\n");
  40 }
  41
  42 /*************************************************************/
  43
  44 struct value *pop(x)
  45      struct value *x;
  46 {
  47 #ifdef DEBUG
  48   if (s_p  < 0 )
  49     int_error("stack underflow",NO_CARET);
  50 #endif
  51   *x = stack[s_p--];
  52   return(x);
  53 }
  54
  55 /*************************************************************/
  56
  57 push(x)
  58      struct value *x;
  59 {
  60 #ifdef DEBUG
  61   if (s_p == STACK_DEPTH - 1)
  62     int_error("stack overflow",NO_CARET);
  63 #endif
  64   stack[++s_p] = *x;
  65 }
  66
  67 /*************************************************************/
  68
  69 #define ERR_VAR "undefined variable: "
  70 f_push(x)
  71      union argument *x;         /* contains pointer to value to push; */
  72 {
  73   static char err_str[sizeof(ERR_VAR) + MAX_ID_LEN] = ERR_VAR;
  74   struct udvt_entry *udv;
  75
  76   udv = x->udv_arg;
  77   if (udv->udv_undef)  /* undefined */
  78     {
  79       (void) strcpy(&err_str[sizeof(ERR_VAR) - 1], udv->udv_name);
  80       int_error(err_str,NO_CARET);
  81     }
  82   push(&(udv->udv_value));
  83 }
  84
  85 /*************************************************************/
  86
  87 f_pushc(x)
  88      union argument *x;
  89 {
  90   push(&(x->v_arg));
  91 }
  92
  93 /*************************************************************/
  94
  95 f_pushd0(x)
  96      union argument *x;
  97 {
  98   push(&(x->udf_arg->dummy_value));
  99 }
 100
 101 /*************************************************************/
 102
 103 f_pushd1(x)
 104      union argument *x;
 105 {
 106   push(&(x->udf_arg->dummy_value1));
 107 }
 108
 109 /*************************************************************/
 110
 111 f_pushd2(x)
 112      union argument *x;
 113 {
 114   push(&(x->udf_arg->dummy_value2));
 115 }
 116
 117 /*************************************************************/
 118
 119 f_pushd3(x)
 120      union argument *x;
 121 {
 122   push(&(x->udf_arg->dummy_value3));
 123 }
 124
 125 /*************************************************************/
 126
 127 #define ERR_FUN "undefined function: "
 128 f_call(x)  /* execute a udf */
 129      union argument *x;
 130 {
 131   static   char err_str[sizeof(ERR_FUN) + MAX_ID_LEN] = ERR_FUN;
 132   register struct udft_entry *udf;
 133
 134   udf = x->udf_arg;
 135   if (!udf->at)  /* undefined */
 136     {
 137       (void) strcpy(&err_str[sizeof(ERR_FUN) - 1],
 138                     udf->udf_name);
 139       int_error(err_str,NO_CARET);
 140     }
 141   if(udf->n_arg == 4)
 142     (void) pop(&(udf->dummy_value3));
 143   if(udf->n_arg >= 3)
 144     (void) pop(&(udf->dummy_value2));
 145   if(udf->n_arg >= 2)
 146     (void) pop(&(udf->dummy_value1));
 147   (void) pop(&(udf->dummy_value));
 148   execute_at(udf->at);
 149 }
 150
 151 /*************************************************************/
 152
 153 static int_check(v)
 154      struct value *v;
 155 {
 156   if (v->type != INT)
 157     int_error("non-integer passed to boolean operator",NO_CARET);
 158 }
 159
 160 /*************************************************************/
 161
 162 f_lnot()
 163 {
 164   struct value a;
 165   int_check(pop(&a));
 166   push(integer(&a,!a.v.int_val) );
 167 }
 168
 169 /*************************************************************/
 170
 171 f_bnot()
 172 {
 173   struct value a;
 174   int_check(pop(&a));
 175   push( integer(&a,~a.v.int_val) );
 176 }
 177
 178 /*************************************************************/
 179
 180 f_bool()
 181 {                       /* converts top-of-stack to boolean */
 182   int_check(&top_of_stack);
 183   top_of_stack.v.int_val = !!top_of_stack.v.int_val;
 184 }
 185
 186 /*************************************************************/
 187
 188 f_lor()
 189 {
 190   struct value a,b;
 191   int_check(pop(&b));
 192   int_check(pop(&a));
 193   push( integer(&a,a.v.int_val || b.v.int_val) );
 194 }
 195
 196 /*************************************************************/
 197
 198 f_land()
 199 {
 200   struct value a,b;
 201   int_check(pop(&b));
 202   int_check(pop(&a));
 203   push( integer(&a,a.v.int_val && b.v.int_val) );
 204 }
 205
 206 /*************************************************************/
 207
 208 f_bor()
 209 {
 210   struct value a,b;
 211   int_check(pop(&b));
 212   int_check(pop(&a));
 213   push( integer(&a,a.v.int_val | b.v.int_val) );
 214 }
 215
 216 /*************************************************************/
 217
 218 f_xor()
 219 {
 220   struct value a,b;
 221   int_check(pop(&b));
 222   int_check(pop(&a));
 223   push( integer(&a,a.v.int_val ^ b.v.int_val) );
 224 }
 225
 226 /*************************************************************/
 227
 228 f_band()
 229 {
 230   struct value a,b;
 231   int_check(pop(&b));
 232   int_check(pop(&a));
 233   push( integer(&a,a.v.int_val & b.v.int_val) );
 234 }
 235
 236 /*************************************************************/
 237
 238 f_uminus()
 239 {
 240   struct value a;
 241   (void) pop(&a);
 242   switch(a.type) {
 243   case INT:
 244     a.v.int_val = -a.v.int_val;
 245     break;
 246   case CMPLX:
 247     a.v.cmplx_val.real =
 248       -a.v.cmplx_val.real;
 249     a.v.cmplx_val.imag =
 250       -a.v.cmplx_val.imag;
 251   }
 252   push(&a);
 253 }
 254
 255 /*************************************************************/
 256
 257 f_eq() /* note: floating point equality is rare because of roundoff error! */
 258 {
 259   struct value a, b;
 260   register int result;
 261   (void) pop(&b);
 262   (void) pop(&a);
 263   switch(a.type)
 264     {
 265     case INT:
 266       switch (b.type) {
 267       case INT:
 268         result = (a.v.int_val ==
 269                   b.v.int_val);
 270         break;
 271       case CMPLX:
 272         result = (a.v.int_val ==
 273                   b.v.cmplx_val.real &&
 274                   b.v.cmplx_val.imag == 0.0);
 275       }
 276       break;
 277     case CMPLX:
 278       switch (b.type)
 279         {
 280         case INT:
 281           result = (b.v.int_val == a.v.cmplx_val.real &&
 282                     a.v.cmplx_val.imag == 0.0);
 283           break;
 284         case CMPLX:
 285           result = (a.v.cmplx_val.real==
 286                     b.v.cmplx_val.real &&
 287                     a.v.cmplx_val.imag==
 288                     b.v.cmplx_val.imag);
 289         }
 290     }
 291   push(integer(&a,result));
 292 }
 293
 294 /*************************************************************/
 295
 296 f_ne()
 297 {
 298   struct value a, b;
 299   register int result;
 300   (void) pop(&b);
 301   (void) pop(&a);
 302   switch(a.type)
 303     {
 304     case INT:
 305       switch (b.type)
 306         {
 307         case INT:
 308           result = (a.v.int_val !=
 309                     b.v.int_val);
 310           break;
 311         case CMPLX:
 312           result = (a.v.int_val !=
 313                     b.v.cmplx_val.real ||
 314                     b.v.cmplx_val.imag != 0.0);
 315         }
 316       break;
 317     case CMPLX:
 318       switch (b.type)
 319         {
 320         case INT:
 321           result = (b.v.int_val !=
 322                     a.v.cmplx_val.real ||
 323                     a.v.cmplx_val.imag != 0.0);
 324           break;
 325         case CMPLX:
 326           result = (a.v.cmplx_val.real !=
 327                     b.v.cmplx_val.real ||
 328                     a.v.cmplx_val.imag !=
 329                     b.v.cmplx_val.imag);
 330         }
 331     }
 332   push(integer(&a,result));
 333 }
 334
 335 /*************************************************************/
 336
 337 f_gt()
 338 {
 339   struct value a, b;
 340   register int result;
 341   (void) pop(&b);
 342   (void) pop(&a);
 343   switch(a.type)
 344     {
 345     case INT:
 346       switch (b.type)
 347         {
 348         case INT:
 349           result = (a.v.int_val >
 350                     b.v.int_val);
 351           break;
 352         case CMPLX:
 353           result = (a.v.int_val >
 354                     b.v.cmplx_val.real);
 355         }
 356       break;
 357     case CMPLX:
 358       switch (b.type)
 359         {
 360         case INT:
 361           result = (a.v.cmplx_val.real >
 362                     b.v.int_val);
 363           break;
 364         case CMPLX:
 365           result = (a.v.cmplx_val.real >
 366                     b.v.cmplx_val.real);
 367         }
 368     }
 369   push(integer(&a,result));
 370 }
 371
 372 /*************************************************************/
 373
 374 f_lt()
 375 {
 376   struct value a, b;
 377   register int result;
 378   (void) pop(&b);
 379   (void) pop(&a);
 380   switch(a.type)
 381     {
 382     case INT:
 383       switch (b.type)
 384         {
 385         case INT:
 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         }
 393       break;
 394     case CMPLX:
 395       switch (b.type)
 396         {
 397         case INT:
 398           result = (a.v.cmplx_val.real <
 399                     b.v.int_val);
 400           break;
 401         case CMPLX:
 402           result = (a.v.cmplx_val.real <
 403                     b.v.cmplx_val.real);
 404         }
 405     }
 406   push(integer(&a,result));
 407 }
 408
 409 /*************************************************************/
 410
 411 f_ge()
 412 {
 413   struct value a, b;
 414   register int result;
 415   (void) pop(&b);
 416   (void) pop(&a);
 417   switch(a.type)
 418     {
 419     case INT:
 420       switch (b.type)
 421         {
 422         case INT:
 423           result = (a.v.int_val >=
 424                     b.v.int_val);
 425           break;
 426         case CMPLX:
 427           result = (a.v.int_val >=
 428                     b.v.cmplx_val.real);
 429         }
 430       break;
 431     case CMPLX:
 432       switch (b.type)
 433         {
 434         case INT:
 435           result = (a.v.cmplx_val.real >=
 436                     b.v.int_val);
 437           break;
 438         case CMPLX:
 439           result = (a.v.cmplx_val.real >=
 440                     b.v.cmplx_val.real);
 441         }
 442     }
 443   push(integer(&a,result));
 444 }
 445
 446 /*************************************************************/
 447
 448 f_le()
 449 {
 450   struct value a, b;
 451   register int result;
 452   (void) pop(&b);
 453   (void) pop(&a);
 454   switch(a.type)
 455     {
 456     case INT:
 457       switch (b.type)
 458         {
 459         case INT:
 460           result = (a.v.int_val <=
 461                     b.v.int_val);
 462           break;
 463         case CMPLX:
 464           result = (a.v.int_val <=
 465                     b.v.cmplx_val.real);
 466         }
 467       break;
 468     case CMPLX:
 469       switch (b.type)
 470         {
 471         case INT:
 472           result = (a.v.cmplx_val.real <=
 473                     b.v.int_val);
 474           break;
 475         case CMPLX:
 476           result = (a.v.cmplx_val.real <=
 477                     b.v.cmplx_val.real);
 478         }
 479     }
 480   push(integer(&a,result));
 481 }
 482
 483 /*************************************************************/
 484
 485 f_plus()
 486 {
 487   struct value a, b, result;
 488   (void) pop(&b);
 489   (void) pop(&a);
 490   switch(a.type)
 491     {
 492     case INT:
 493       switch (b.type)
 494         {
 495         case INT:
 496           (void) integer(&result,a.v.int_val +
 497                          b.v.int_val);
 498           break;
 499         case CMPLX:
 500           (void) complex(&result,a.v.int_val +
 501                          b.v.cmplx_val.real,
 502                          b.v.cmplx_val.imag);
 503         }
 504       break;
 505     case CMPLX:
 506       switch (b.type)
 507         {
 508         case INT:
 509           (void) complex(&result,b.v.int_val +
 510                          a.v.cmplx_val.real,
 511                          a.v.cmplx_val.imag);
 512           break;
 513         case CMPLX:
 514           (void) complex(&result,a.v.cmplx_val.real+
 515                          b.v.cmplx_val.real,
 516                          a.v.cmplx_val.imag+
 517                          b.v.cmplx_val.imag);
 518         }
 519     }
 520   push(&result);
 521 }
 522
 523 /*************************************************************/
 524
 525 f_minus()
 526 {
 527   struct value a, b, result;
 528   (void) pop(&b);
 529   (void) pop(&a);               /* now do a - b */
 530   switch(a.type)
 531     {
 532     case INT:
 533       switch (b.type)
 534         {
 535         case INT:
 536           (void) integer(&result,a.v.int_val -
 537                          b.v.int_val);
 538           break;
 539         case CMPLX:
 540           (void) complex(&result,a.v.int_val -
 541                          b.v.cmplx_val.real,
 542                          -b.v.cmplx_val.imag);
 543         }
 544       break;
 545     case CMPLX:
 546       switch (b.type)
 547         {
 548         case INT:
 549           (void) complex(&result,a.v.cmplx_val.real -
 550                          b.v.int_val,
 551                          a.v.cmplx_val.imag);
 552           break;
 553         case CMPLX:
 554           (void) complex(&result,a.v.cmplx_val.real-
 555                          b.v.cmplx_val.real,
 556                          a.v.cmplx_val.imag-
 557                          b.v.cmplx_val.imag);
 558         }
 559     }
 560   push(&result);
 561 }
 562
 563 /************************************************************/
 564
 565 f_mult()
 566 {
 567   struct value a, b, result;
 568   (void) pop(&b);
 569   (void) pop(&a);       /* now do a*b */
 570
 571   switch(a.type)
 572     {
 573     case INT:
 574       switch (b.type)
 575         {
 576         case INT:
 577           (void) integer(&result,a.v.int_val *
 578                          b.v.int_val);
 579           break;
 580         case CMPLX:
 581           (void) complex(&result,a.v.int_val *
 582                          b.v.cmplx_val.real,
 583                          a.v.int_val *
 584                          b.v.cmplx_val.imag);
 585         }
 586       break;
 587     case CMPLX:
 588       switch (b.type)
 589         {
 590         case INT:
 591           (void) complex(&result,b.v.int_val *
 592                          a.v.cmplx_val.real,
 593                          b.v.int_val *
 594                          a.v.cmplx_val.imag);
 595           break;
 596         case CMPLX:
 597           (void) complex(&result,a.v.cmplx_val.real*
 598                          b.v.cmplx_val.real-
 599                          a.v.cmplx_val.imag*
 600                          b.v.cmplx_val.imag,
 601                          a.v.cmplx_val.real*
 602                          b.v.cmplx_val.imag+
 603                          a.v.cmplx_val.imag*
 604                          b.v.cmplx_val.real);
 605         }
 606     }
 607   push(&result);
 608 }
 609
 610 /************************************************************/
 611
 612 f_div()
 613 {
 614   struct value a, b, result;
 615   register double square;
 616   (void) pop(&b);
 617   (void) pop(&a);       /* now do a/b */
 618
 619   switch(a.type)
 620     {
 621     case INT:
 622       switch (b.type)
 623         {
 624         case INT:
 625           if (b.v.int_val)
 626             (void) integer(&result,a.v.int_val /
 627                            b.v.int_val);
 628           else
 629             {
 630               (void) integer(&result,0);
 631               undefined = TRUE;
 632             }
 633           break;
 634         case CMPLX:
 635           square = b.v.cmplx_val.real*
 636             b.v.cmplx_val.real +
 637               b.v.cmplx_val.imag*
 638                 b.v.cmplx_val.imag;
 639           if (square)
 640             (void) complex(&result,a.v.int_val*
 641                            b.v.cmplx_val.real/square,
 642                            -a.v.int_val*
 643                            b.v.cmplx_val.imag/square);
 644           else
 645             {
 646               (void) complex(&result,0.0,0.0);
 647               undefined = TRUE;
 648             }
 649         }
 650       break;
 651     case CMPLX:
 652       switch (b.type)
 653         {
 654         case INT:
 655           if (b.v.int_val)
 656
 657             (void) complex(&result,a.v.cmplx_val.real/
 658                            b.v.int_val,
 659                            a.v.cmplx_val.imag/
 660                            b.v.int_val);
 661           else
 662             {
 663               (void) complex(&result,0.0,0.0);
 664               undefined = TRUE;
 665             }
 666           break;
 667         case CMPLX:
 668           square = b.v.cmplx_val.real*
 669             b.v.cmplx_val.real +
 670               b.v.cmplx_val.imag*
 671                 b.v.cmplx_val.imag;
 672           if (square)
 673             (void) complex(&result,(a.v.cmplx_val.real*
 674                                     b.v.cmplx_val.real+
 675                                     a.v.cmplx_val.imag*
 676                                     b.v.cmplx_val.imag)/square,
 677                            (a.v.cmplx_val.imag*
 678                             b.v.cmplx_val.real-
 679                             a.v.cmplx_val.real*
 680                             b.v.cmplx_val.imag)/
 681                            square);
 682           else
 683             {
 684               (void) complex(&result,0.0,0.0);
 685               undefined = TRUE;
 686             }
 687         }
 688     }
 689   push(&result);
 690 }
 691
 692 /************************************************************/
 693
 694 f_mod()
 695 {
 696   struct value a, b;
 697   (void) pop(&b);
 698   (void) pop(&a);       /* now do a%b */
 699
 700   if (a.type != INT || b.type != INT)
 701     int_error("can only mod ints",NO_CARET);
 702   if (b.v.int_val)
 703     push(integer(&a,a.v.int_val % b.v.int_val));
 704   else {
 705     push(integer(&a,0));
 706     undefined = TRUE;
 707   }
 708 }
 709
 710 /************************************************************/
 711
 712 f_power()
 713 {
 714   struct value a, b, result;
 715   register int i, t, count;
 716   register double mag, ang;
 717   (void) pop(&b);
 718   (void) pop(&a);       /* now find a**b */
 719
 720   switch(a.type)
 721     {
 722     case INT:
 723       switch (b.type)
 724         {
 725         case INT:
 726           count = abs(b.v.int_val);
 727           t = 1;
 728           for(i = 0; i < count; i++)
 729             t *= a.v.int_val;
 730           if (b.v.int_val >= 0)
 731             (void) integer(&result,t);
 732           else
 733             (void) complex(&result,1.0/t,0.0);
 734           break;
 735         case CMPLX:
 736           mag =
 737             pow(magnitude(&a),fabs(b.v.cmplx_val.real));
 738           if (b.v.cmplx_val.real < 0.0)
 739             mag = 1.0/mag;
 740           ang = angle(&a)*b.v.cmplx_val.real+
 741             b.v.cmplx_val.imag;
 742           (void) complex(&result,mag*cos(ang),
 743                          mag*sin(ang));
 744         }
 745       break;
 746     case CMPLX:
 747       switch (b.type)
 748         {
 749         case INT:
 750           if (a.v.cmplx_val.imag == 0.0)
 751             {
 752               mag = pow(a.v.cmplx_val.real,(double)abs(b.v.int_val));
 753               if (b.v.int_val < 0)
 754                 mag = 1.0/mag;
 755               (void) complex(&result,mag,0.0);
 756             }
 757       else
 758         {
 759           /* not so good, but...! */
 760           mag = pow(magnitude(&a),(double)abs(b.v.int_val));
 761           if (b.v.int_val < 0)
 762             mag = 1.0/mag;
 763           ang = angle(&a)*b.v.int_val;
 764           (void) complex(&result,mag*cos(ang),
 765                          mag*sin(ang));
 766         }
 767           break;
 768         case CMPLX:
 769           mag = pow(magnitude(&a),fabs(b.v.cmplx_val.real));
 770           if (b.v.cmplx_val.real < 0.0)
 771             mag = 1.0/mag;
 772           ang = angle(&a)*b.v.cmplx_val.real+ b.v.cmplx_val.imag;
 773           (void) complex(&result,mag*cos(ang),
 774                          mag*sin(ang));
 775         }
 776     }
 777   push(&result);
 778 }
 779
 780 /************************************************************/
 781
 782 f_factorial()
 783 {
 784   struct value a;
 785   register int i;
 786   register double val;
 787
 788   (void) pop(&a);       /* find a! (factorial) */
 789
 790   switch (a.type)
 791     {
 792     case INT:
 793       val = 1.0;
 794       for (i = a.v.int_val; i > 1; i--)  /*fpe's should catch overflows*/
 795         val *= i;
 796       break;
 797     default:
 798       int_error("factorial (!) argument must be an integer",
 799                 NO_CARET);
 800     }
 801
 802   push(complex(&a,val,0.0));
 803 }
 804
 805 /************************************************************/
 806
 807 int   f_jump(x)
 808      union argument *x;
 809 {
 810   return(x->j_arg);
 811 }
 812
 813 /************************************************************/
 814
 815 int  f_jumpz(x)
 816      union argument *x;
 817 {
 818   struct value a;
 819   int_check(&top_of_stack);
 820   if (top_of_stack.v.int_val)   /* non-zero */
 821     {
 822       (void) pop(&a);
 823       return 1;                         /* no jump */
 824     }
 825   else
 826     return(x->j_arg);           /* leave the argument on TOS */
 827 }
 828
 829 /************************************************************/
 830
 831 int f_jumpnz(x)
 832      union argument *x;
 833 {
 834   struct value a;
 835   int_check(&top_of_stack);
 836   if (top_of_stack.v.int_val)   /* non-zero */
 837     return(x->j_arg);           /* leave the argument on TOS */
 838   else
 839     {
 840       (void) pop(&a);
 841       return 1;                         /* no jump */
 842     }
 843 }
 844
 845 /************************************************************/
 846
 847 int f_jtern(x)
 848      union argument *x;
 849 {
 850   struct value a;
 851
 852   int_check(pop(&a));
 853   if (a.v.int_val)
 854     return(1);                          /* no jump; fall through to TRUE code */
 855   else
 856     return(x->j_arg);           /* go jump to FALSE code */
 857 }
 858 /****************************************************************************/