git.maemo.org Git - gnuplot/blob - src/eval.c

   1 #ifndef lint
   2 static char *RCSid() { return RCSid("$Id: eval.c,v 1.51.2.6 2009/02/05 17:17:25 sfeam Exp $"); }
   3 #endif
   4
   5 /* GNUPLOT - eval.c */
   6
   7 /*[
   8  * Copyright 1986 - 1993, 1998, 2004   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 /* HBB 20010724: I moved several variables and functions from parse.c
  38  * to here, because they're involved with *evaluating* functions, not
  39  * with parsing them: evaluate_at(), fpe(), the APOLLO signal handling
  40  * stuff, and fpe_env */
  41
  42 #include "eval.h"
  43
  44 #include "syscfg.h"
  45 #include "alloc.h"
  46 #include "datafile.h"
  47 #include "internal.h"
  48 #include "specfun.h"
  49 #include "standard.h"
  50 #include "util.h"
  51 #include "version.h"
  52
  53 #include <signal.h>
  54 #include <setjmp.h>
  55
  56 /* Internal prototypes */
  57 static RETSIGTYPE fpe __PROTO((int an_int));
  58 #ifdef APOLLO
  59 static pfm_$fh_func_val_t apollo_sigfpe(pfm_$fault_rec_t & fault_rec)
  60 #endif
  61
  62 /* Global variables exported by this module */
  63 struct udvt_entry udv_pi = { NULL, "pi", FALSE, {INTGR, {0} } };
  64 struct udvt_entry *udv_NaN;
  65 /* first in linked list */
  66 struct udvt_entry *first_udv = &udv_pi;
  67 struct udft_entry *first_udf = NULL;
  68
  69 TBOOLEAN undefined;
  70
  71 /* The stack this operates on */
  72 static struct value stack[STACK_DEPTH];
  73 static int s_p = -1;            /* stack pointer */
  74 #define top_of_stack stack[s_p]
  75
  76 static int jump_offset;         /* to be modified by 'jump' operators */
  77
  78 /* The table of built-in functions */
  79 /* HBB 20010725: I've removed all the casts to type (FUNC_PTR) ---
  80  * According to ANSI/ISO C Standards it causes undefined behaviouf if
  81  * you cast a function pointer to any other type, including a function
  82  * pointer with a different set of arguments, and then call the
  83  * function.  Instead, I made all these functions adhere to the common
  84  * type, directly */
  85 const struct ft_entry GPFAR ft[] =
  86 {
  87     /* internal functions: */
  88     {"push",  f_push},
  89     {"pushc",  f_pushc},
  90     {"pushd1",  f_pushd1},
  91     {"pushd2",  f_pushd2},
  92     {"pushd",  f_pushd},
  93     {"call",  f_call},
  94     {"calln",  f_calln},
  95     {"lnot",  f_lnot},
  96     {"bnot",  f_bnot},
  97     {"uminus",  f_uminus},
  98     {"lor",  f_lor},
  99     {"land",  f_land},
 100     {"bor",  f_bor},
 101     {"xor",  f_xor},
 102     {"band",  f_band},
 103     {"eq",  f_eq},
 104     {"ne",  f_ne},
 105     {"gt",  f_gt},
 106     {"lt",  f_lt},
 107     {"ge",  f_ge},
 108     {"le",  f_le},
 109     {"plus",  f_plus},
 110     {"minus",  f_minus},
 111     {"mult",  f_mult},
 112     {"div",  f_div},
 113     {"mod",  f_mod},
 114     {"power",  f_power},
 115     {"factorial",  f_factorial},
 116     {"bool",  f_bool},
 117     {"dollars",  f_dollars},    /* for using extension */
 118 #ifdef GP_STRING_VARS
 119     {"concatenate",  f_concatenate},    /* for string variables only */
 120     {"eqs",  f_eqs},                    /* for string variables only */
 121     {"nes",  f_nes},                    /* for string variables only */
 122     {"[]",  f_range},                   /* for string variables only */
 123 #endif
 124     {"jump",  f_jump},
 125     {"jumpz",  f_jumpz},
 126     {"jumpnz",  f_jumpnz},
 127     {"jtern",  f_jtern},
 128
 129 /* standard functions: */
 130     {"real",  f_real},
 131     {"imag",  f_imag},
 132     {"arg",  f_arg},
 133     {"conjg",  f_conjg},
 134     {"sin",  f_sin},
 135     {"cos",  f_cos},
 136     {"tan",  f_tan},
 137     {"asin",  f_asin},
 138     {"acos",  f_acos},
 139     {"atan",  f_atan},
 140     {"atan2",  f_atan2},
 141     {"sinh",  f_sinh},
 142     {"cosh",  f_cosh},
 143     {"tanh",  f_tanh},
 144     {"int",  f_int},
 145     {"abs",  f_abs},
 146     {"sgn",  f_sgn},
 147     {"sqrt",  f_sqrt},
 148     {"exp",  f_exp},
 149     {"log10",  f_log10},
 150     {"log",  f_log},
 151     {"besj0",  f_besj0},
 152     {"besj1",  f_besj1},
 153     {"besy0",  f_besy0},
 154     {"besy1",  f_besy1},
 155     {"erf",  f_erf},
 156     {"erfc",  f_erfc},
 157     {"gamma",  f_gamma},
 158     {"lgamma",  f_lgamma},
 159     {"ibeta",  f_ibeta},
 160     {"igamma",  f_igamma},
 161     {"rand",  f_rand},
 162     {"floor",  f_floor},
 163     {"ceil",  f_ceil},
 164 #ifdef BACKWARDS_COMPATIBLE
 165     {"defined",  f_exists},       /* deprecated syntax defined(foo) */
 166 #endif
 167
 168     {"norm",  f_normal},        /* XXX-JG */
 169     {"inverf",  f_inverse_erf}, /* XXX-JG */
 170     {"invnorm",  f_inverse_normal},     /* XXX-JG */
 171     {"asinh",  f_asinh},
 172     {"acosh",  f_acosh},
 173     {"atanh",  f_atanh},
 174     {"lambertw",  f_lambertw}, /* HBB, from G.Kuhnle 20001107 */
 175
 176     {"column",  f_column},      /* for using */
 177     {"valid",  f_valid},        /* for using */
 178     {"timecolumn",  f_timecolumn},      /* for using */
 179
 180     {"tm_sec",  f_tmsec},       /* for timeseries */
 181     {"tm_min",  f_tmmin},       /* for timeseries */
 182     {"tm_hour",  f_tmhour},     /* for timeseries */
 183     {"tm_mday",  f_tmmday},     /* for timeseries */
 184     {"tm_mon",  f_tmmon},       /* for timeseries */
 185     {"tm_year",  f_tmyear},     /* for timeseries */
 186     {"tm_wday",  f_tmwday},     /* for timeseries */
 187     {"tm_yday",  f_tmyday},     /* for timeseries */
 188
 189 #ifdef GP_STRING_VARS
 190     {"stringcolumn",  f_stringcolumn},  /* for using */
 191     {"strcol",  f_stringcolumn},        /* shorthand form */
 192     {"sprintf",  f_sprintf},    /* for string variables only */
 193     {"gprintf",  f_gprintf},    /* for string variables only */
 194     {"strlen",  f_strlen},      /* for string variables only */
 195     {"strstrt",  f_strstrt},    /* for string variables only */
 196     {"substr",  f_range},       /* for string variables only */
 197     {"word", f_words},          /* for string variables only */
 198     {"words", f_words},         /* implemented as word(s,-1) */
 199     {"strftime",  f_strftime},  /* time to string */
 200     {"strptime",  f_strptime},  /* string to time */
 201     {"system", f_system},       /* "dynamic backtics" */
 202     {"exist", f_exists},        /* exists("foo") replaces defined(foo) */
 203     {"exists", f_exists},       /* exists("foo") replaces defined(foo) */
 204 #endif
 205
 206     {NULL, NULL}
 207 };
 208
 209 /* Module-local variables: */
 210
 211 #if defined(_Windows) && !defined(WIN32)
 212 static JMP_BUF far fpe_env;
 213 #else
 214 static JMP_BUF fpe_env;
 215 #endif
 216
 217 /* Internal helper functions: */
 218
 219 static RETSIGTYPE
 220 fpe(int an_int)
 221 {
 222 #if defined(MSDOS) && !defined(__EMX__) && !defined(DJGPP) && !defined(_Windows) || defined(DOS386)
 223     /* thanks to lotto@wjh12.UUCP for telling us about this  */
 224     _fpreset();
 225 #endif
 226
 227     (void) an_int;              /* avoid -Wunused warning */
 228     (void) signal(SIGFPE, (sigfunc) fpe);
 229     undefined = TRUE;
 230     LONGJMP(fpe_env, TRUE);
 231 }
 232
 233 /* FIXME HBB 20010724: do we really want this in *here*? Maybe it
 234  * should be in syscfg.c or somewhere similar. */
 235 #ifdef APOLLO
 236 # include <apollo/base.h>
 237 # include <apollo/pfm.h>
 238 # include <apollo/fault.h>
 239
 240 /*
 241  * On an Apollo, the OS can signal a couple errors that are not mapped into
 242  * SIGFPE, namely signalling NaN and branch on an unordered comparison.  I
 243  * suppose there are others, but none of these are documented, so I handle
 244  * them as they arise.
 245  *
 246  * Anyway, we need to catch these faults and signal SIGFPE.
 247  */
 248
 249 static pfm_$fh_func_val_t
 250 apollo_sigfpe(pfm_$fault_rec_t & fault_rec)
 251 {
 252     kill(getpid(), SIGFPE);
 253     return pfm_$continue_fault_handling;
 254 }
 255
 256 /* This is called from main(), if the platform is an APOLLO */
 257 void
 258 apollo_pfm_catch()
 259 {
 260     status_$t status;
 261     pfm_$establish_fault_handler(fault_$fp_bsun, pfm_$fh_backstop,
 262                                  apollo_sigfpe, &status);
 263     pfm_$establish_fault_handler(fault_$fp_sig_nan, pfm_$fh_backstop,
 264                                  apollo_sigfpe, &status);
 265 }
 266 #endif /* APOLLO */
 267
 268 /* Exported functions */
 269
 270 /* First, some functions tha help other modules use 'struct value' ---
 271  * these might justify a separate module, but I'll stick with this,
 272  * for now */
 273
 274 /* returns the real part of val */
 275 double
 276 real(struct value *val)
 277 {
 278     switch (val->type) {
 279     case INTGR:
 280         return ((double) val->v.int_val);
 281     case CMPLX:
 282         return (val->v.cmplx_val.real);
 283 #ifdef GP_STRING_VARS
 284     case STRING:              /* is this ever used? */
 285         return (atof(val->v.string_val));
 286 #endif
 287     default:
 288         int_error(NO_CARET, "unknown type in real()");
 289     }
 290     /* NOTREACHED */
 291     return ((double) 0.0);
 292 }
 293
 294
 295 /* returns the imag part of val */
 296 double
 297 imag(struct value *val)
 298 {
 299     switch (val->type) {
 300     case INTGR:
 301         return (0.0);
 302     case CMPLX:
 303         return (val->v.cmplx_val.imag);
 304 #ifdef GP_STRING_VARS
 305     case STRING:
 306         /* This is where we end up if the user tries: */
 307         /*     x = 2;  plot sprintf(format,x)         */
 308         int_warn(NO_CARET, "encountered a string when expecting a number");
 309         int_error(NO_CARET, "Did you try to generate a file name using dummy variable x or y?");
 310 #endif
 311     default:
 312         int_error(NO_CARET, "unknown type in imag()");
 313     }
 314     /* NOTREACHED */
 315     return ((double) 0.0);
 316 }
 317
 318
 319
 320 /* returns the magnitude of val */
 321 double
 322 magnitude(struct value *val)
 323 {
 324     switch (val->type) {
 325     case INTGR:
 326         return ((double) abs(val->v.int_val));
 327     case CMPLX:
 328         return (sqrt(val->v.cmplx_val.real *
 329                      val->v.cmplx_val.real +
 330                      val->v.cmplx_val.imag *
 331                      val->v.cmplx_val.imag));
 332     default:
 333         int_error(NO_CARET, "unknown type in magnitude()");
 334     }
 335     /* NOTREACHED */
 336     return ((double) 0.0);
 337 }
 338
 339
 340
 341 /* returns the angle of val */
 342 double
 343 angle(struct value *val)
 344 {
 345     switch (val->type) {
 346     case INTGR:
 347         return ((val->v.int_val >= 0) ? 0.0 : M_PI);
 348     case CMPLX:
 349         if (val->v.cmplx_val.imag == 0.0) {
 350             if (val->v.cmplx_val.real >= 0.0)
 351                 return (0.0);
 352             else
 353                 return (M_PI);
 354         }
 355         return (atan2(val->v.cmplx_val.imag,
 356                       val->v.cmplx_val.real));
 357     default:
 358         int_error(NO_CARET, "unknown type in angle()");
 359     }
 360     /* NOTREACHED */
 361     return ((double) 0.0);
 362 }
 363
 364
 365 struct value *
 366 Gcomplex(struct value *a, double realpart, double imagpart)
 367 {
 368     a->type = CMPLX;
 369     a->v.cmplx_val.real = realpart;
 370     a->v.cmplx_val.imag = imagpart;
 371     return (a);
 372 }
 373
 374
 375 struct value *
 376 Ginteger(struct value *a, int i)
 377 {
 378     a->type = INTGR;
 379     a->v.int_val = i;
 380     return (a);
 381 }
 382
 383 #ifdef GP_STRING_VARS
 384 struct value *
 385 Gstring(struct value *a, char *s)
 386 {
 387     a->type = STRING;
 388     a->v.string_val = s;
 389     return (a);
 390 }
 391 #endif
 392
 393 /* It is always safe to call gpfree_string with a->type is INTGR or CMPLX.
 394  * However it would be fatal to call it with a->type = STRING if a->string_val
 395  * was not obtained by a previous call to gp_alloc(), or has already been freed.
 396  * Thus 'a->type' is set to INTGR afterwards to make subsequent calls safe.
 397  */
 398 struct value *
 399 gpfree_string(struct value *a)
 400 {
 401 #ifdef GP_STRING_VARS
 402     if (a->type == STRING) {
 403         free(a->v.string_val);
 404         /* I would have set it to INVALID if such a type existed */
 405         a->type = INTGR;
 406     }
 407 #endif
 408     return a;
 409 }
 410
 411 /* some machines have trouble with exp(-x) for large x
 412  * if E_MINEXP is defined at compile time, use gp_exp(x) instead,
 413  * which returns 0 for exp(x) with x < E_MINEXP
 414  * exp(x) will already have been defined as gp_exp(x) in plot.h
 415  */
 416
 417 double
 418 gp_exp(double x)
 419 {
 420 #ifdef E_MINEXP
 421     return (x < (E_MINEXP)) ? 0.0 : exp(x);
 422 #else  /* E_MINEXP */
 423     int old_errno = errno;
 424     double result = exp(x);
 425
 426     /* exp(-large) quite uselessly raises ERANGE --- stop that */
 427     if (result == 0.0)
 428         errno = old_errno;
 429     return result;
 430 #endif /* E_MINEXP */
 431 }
 432
 433 void
 434 reset_stack()
 435 {
 436     s_p = -1;
 437 }
 438
 439
 440 void
 441 check_stack()
 442 {                               /* make sure stack's empty */
 443     if (s_p != -1)
 444         fprintf(stderr, "\n\
 445 warning:  internal error--stack not empty!\n\
 446           (function called with too many parameters?)\n");
 447 }
 448
 449 TBOOLEAN
 450 more_on_stack()
 451 {
 452     return (s_p >= 0);
 453 }
 454
 455 struct value *
 456 pop(struct value *x)
 457 {
 458     if (s_p < 0)
 459         int_error(NO_CARET, "stack underflow (function call with missing parameters?)");
 460     *x = stack[s_p--];
 461     return (x);
 462 }
 463
 464 #if (GP_STRING_VARS > 1)
 465 /*
 466  * Allow autoconversion of string variables to floats if they
 467  * are dereferenced in a numeric context.
 468  */
 469 struct value *
 470 pop_or_convert_from_string(struct value *v)
 471 {
 472     (void) pop(v);
 473     if (v->type == STRING) {
 474         double d = atof(v->v.string_val);
 475         gpfree_string(v);
 476         Gcomplex(v, d, 0.);
 477         FPRINTF((stderr,"converted string to CMPLX value %g\n",real(v)));
 478     }
 479     return(v);
 480 }
 481 #endif
 482
 483 void
 484 push(struct value *x)
 485 {
 486     if (s_p == STACK_DEPTH - 1)
 487         int_error(NO_CARET, "stack overflow");
 488     stack[++s_p] = *x;
 489 #ifdef GP_STRING_VARS
 490     /* WARNING - This is a memory leak if the string is not later freed */
 491     if (x->type == STRING && x->v.string_val)
 492         stack[s_p].v.string_val = gp_strdup(x->v.string_val);
 493 #endif
 494 }
 495
 496
 497 void
 498 int_check(struct value *v)
 499 {
 500     if (v->type != INTGR)
 501         int_error(NO_CARET, "non-integer passed to boolean operator");
 502 }
 503
 504
 505
 506 /* Internal operators of the stack-machine, not directly represented
 507  * by any user-visible operator, or using private status variables
 508  * directly */
 509
 510 /* converts top-of-stack to boolean */
 511 void
 512 f_bool(union argument *x)
 513 {
 514     (void) x;                   /* avoid -Wunused warning */
 515
 516     int_check(&top_of_stack);
 517     top_of_stack.v.int_val = !!top_of_stack.v.int_val;
 518 }
 519
 520
 521 void
 522 f_jump(union argument *x)
 523 {
 524     (void) x;                   /* avoid -Wunused warning */
 525     jump_offset = x->j_arg;
 526 }
 527
 528
 529 void
 530 f_jumpz(union argument *x)
 531 {
 532     struct value a;
 533
 534     (void) x;                   /* avoid -Wunused warning */
 535     int_check(&top_of_stack);
 536     if (top_of_stack.v.int_val) {       /* non-zero --> no jump*/
 537         (void) pop(&a);
 538     } else
 539         jump_offset = x->j_arg; /* leave the argument on TOS */
 540 }
 541
 542
 543 void
 544 f_jumpnz(union argument *x)
 545 {
 546     struct value a;
 547
 548     (void) x;                   /* avoid -Wunused warning */
 549     int_check(&top_of_stack);
 550     if (top_of_stack.v.int_val) /* non-zero */
 551         jump_offset = x->j_arg; /* leave the argument on TOS */
 552     else {
 553         (void) pop(&a);
 554     }
 555 }
 556
 557 void
 558 f_jtern(union argument *x)
 559 {
 560     struct value a;
 561
 562     (void) x;                   /* avoid -Wunused warning */
 563     int_check(pop(&a));
 564     if (! a.v.int_val)
 565         jump_offset = x->j_arg; /* go jump to FALSE code */
 566 }
 567
 568 /* This is the heart of the expression evaluation module: the stack
 569    program execution loop.
 570
 571   'ft' is a table containing C functions within this program.
 572
 573    An 'action_table' contains pointers to these functions and
 574    arguments to be passed to them.
 575
 576    at_ptr is a pointer to the action table which must be executed
 577    (evaluated).
 578
 579    so the iterated line exectues the function indexed by the at_ptr
 580    and passes the address of the argument which is pointed to by the
 581    arg_ptr
 582
 583 */
 584
 585 void
 586 execute_at(struct at_type *at_ptr)
 587 {
 588     int instruction_index, operator, count;
 589     int saved_jump_offset = jump_offset;
 590
 591     count = at_ptr->a_count;
 592     for (instruction_index = 0; instruction_index < count;) {
 593         operator = (int) at_ptr->actions[instruction_index].index;
 594         jump_offset = 1;        /* jump operators can modify this */
 595         (*ft[operator].func) (&(at_ptr->actions[instruction_index].arg));
 596         assert(is_jump(operator) || (jump_offset == 1));
 597         instruction_index += jump_offset;
 598     }
 599
 600     jump_offset = saved_jump_offset;
 601 }
 602
 603 /* 20010724: moved here from parse.c, where it didn't belong */
 604 void
 605 evaluate_at(struct at_type *at_ptr, struct value *val_ptr)
 606 {
 607     double temp = 0;
 608
 609     undefined = FALSE;
 610     errno = 0;
 611     reset_stack();
 612
 613 #ifndef DOSX286
 614     if (SETJMP(fpe_env, 1))
 615         return;                 /* just bail out */
 616     (void) signal(SIGFPE, (sigfunc) fpe);
 617 #endif
 618
 619     execute_at(at_ptr);
 620
 621 #ifndef DOSX286
 622     (void) signal(SIGFPE, SIG_DFL);
 623 #endif
 624
 625     if (errno == EDOM || errno == ERANGE) {
 626         undefined = TRUE;
 627     } else if (!undefined) {    /* undefined (but not errno) may have been set by matherr */
 628         (void) pop(val_ptr);
 629         check_stack();
 630         /* At least one machine (ATT 3b1) computes Inf without a SIGFPE */
 631 #if (GP_STRING_VARS > 1)
 632         if (val_ptr->type != STRING)
 633 #endif
 634         temp = real(val_ptr);
 635         if (temp > VERYLARGE || temp < -VERYLARGE) {
 636             undefined = TRUE;
 637         }
 638     }
 639 #if defined(NeXT) || defined(ultrix)
 640     /*
 641      * linux was able to fit curves which NeXT gave up on -- traced it to
 642      * silently returning NaN for the undefined cases and plowing ahead
 643      * I can force that behavior this way.  (0.0/0.0 generates NaN)
 644      */
 645     if (undefined && (errno == EDOM || errno == ERANGE)) {      /* corey@cac */
 646         undefined = FALSE;
 647         errno = 0;
 648         Gcomplex(val_ptr, 0.0 / 0.0, 0.0 / 0.0);
 649     }
 650 #endif /* NeXT || ultrix */
 651
 652 }
 653
 654 void
 655 free_at(struct at_type *at_ptr)
 656 {
 657 #ifdef GP_STRING_VARS
 658     int i;
 659     /* All string constants belonging to this action table have to be
 660      * freed before destruction. */
 661     if (!at_ptr)
 662         return;
 663     for(i=0; i<at_ptr->a_count; i++) {
 664         struct at_entry *a = &(at_ptr->actions[i]);
 665         /* if union a->arg is used as a->arg.v_arg free potential string */
 666         if ( a->index == PUSHC || a->index == DOLLARS )
 667             gpfree_string(&(a->arg.v_arg));
 668     }
 669 #endif
 670     free(at_ptr);
 671 }
 672
 673 /* EAM July 2003 - Return pointer to udv with this name; if the key does not
 674  * match any existing udv names, create a new one and return a pointer to it.
 675  */
 676 struct udvt_entry *
 677 add_udv_by_name(char *key)
 678 {
 679     struct udvt_entry **udv_ptr = &first_udv;
 680
 681     /* check if it's already in the table... */
 682
 683     while (*udv_ptr) {
 684         if (!strcmp(key, (*udv_ptr)->udv_name))
 685             return (*udv_ptr);
 686         udv_ptr = &((*udv_ptr)->next_udv);
 687     }
 688
 689     *udv_ptr = (struct udvt_entry *)
 690         gp_alloc(sizeof(struct udvt_entry), "value");
 691     (*udv_ptr)->next_udv = NULL;
 692     (*udv_ptr)->udv_name = gp_strdup(key);
 693     (*udv_ptr)->udv_undef = TRUE;
 694     (*udv_ptr)->udv_value.type = 0;
 695     return (*udv_ptr);
 696 }
 697
 698
 699 static void fill_gpval_axis __PROTO((AXIS_INDEX axis));
 700 static void set_gpval_axis_sth_double __PROTO((const char *prefix, AXIS_INDEX axis, const char *suffix, double value, int is_int));
 701 static void fill_gpval_string __PROTO((char *var, const char *value));
 702
 703 static void
 704 set_gpval_axis_sth_double(const char *prefix, AXIS_INDEX axis, const char *suffix, double value, int is_int)
 705 {
 706     struct udvt_entry *v;
 707     char *cc, s[24];
 708     sprintf(s, "%s_%s_%s", prefix, axis_defaults[axis].name, suffix);
 709     for (cc=s; *cc; cc++) *cc = toupper(*cc); /* make the name uppercase */
 710     v = add_udv_by_name(s);
 711     if (!v) return; /* should not happen */
 712     v->udv_undef = FALSE;
 713     if (is_int)
 714         Ginteger(&v->udv_value, (int)(value+0.5));
 715     else
 716         Gcomplex(&v->udv_value, value, 0);
 717 }
 718
 719 static void
 720 fill_gpval_axis(AXIS_INDEX axis)
 721 {
 722     const char *prefix = "GPVAL";
 723 #define A axis_array[axis]
 724     double a = AXIS_DE_LOG_VALUE(axis, A.min); /* FIXME GPVAL: This should be replaced by  a = A.real_min  and */
 725     double b = AXIS_DE_LOG_VALUE(axis, A.max); /* FIXME GPVAL: b = A.real_max  when true (delogged) min/max range values are implemented in the axis structure */
 726     set_gpval_axis_sth_double(prefix, axis, "MIN", ((a < b) ? a : b), 0);
 727     set_gpval_axis_sth_double(prefix, axis, "MAX", ((a < b) ? b : a), 0);
 728     set_gpval_axis_sth_double(prefix, axis, "REVERSE", (A.range_flags & RANGE_REVERSE), 1);
 729     set_gpval_axis_sth_double(prefix, axis, "LOG", A.base, 0);
 730
 731     if (axis < R_AXIS) {
 732         if (axis == T_AXIS) axis = COLOR_AXIS; /* T axis is never drawn; colorbar is. */
 733         set_gpval_axis_sth_double("GPVAL_DATA", axis, "MIN", AXIS_DE_LOG_VALUE(axis, A.data_min), 0);
 734         set_gpval_axis_sth_double("GPVAL_DATA", axis, "MAX", AXIS_DE_LOG_VALUE(axis, A.data_max), 0);
 735     }
 736 #undef A
 737 }
 738
 739 static void
 740 fill_gpval_string(char *var, const char *stringvalue)
 741 {
 742 #ifdef GP_STRING_VARS
 743     struct udvt_entry *v = add_udv_by_name(var);
 744     if (!v)
 745         return;
 746     if (v->udv_undef == FALSE && !strcmp(v->udv_value.v.string_val, stringvalue))
 747         return;
 748     if (v->udv_undef)
 749         v->udv_undef = FALSE;
 750     else
 751         gpfree_string(&v->udv_value);
 752     Gstring(&v->udv_value, gp_strdup(stringvalue));
 753 #endif
 754 }
 755
 756 /*
 757  * Put all the handling for GPVAL_* variables in this one routine.
 758  * We call it from one of several contexts:
 759  * 0: following a successful set/unset command
 760  * 1: following a successful plot/splot
 761  * 2: following an unsuccessful command (int_error)
 762  * 3: program entry
 763  */
 764 void
 765 update_gpval_variables(int context)
 766 {
 767
 768     /* These values may change during a plot command due to auto range */
 769     if (context == 1) {
 770         fill_gpval_axis(FIRST_X_AXIS);
 771         fill_gpval_axis(FIRST_Y_AXIS);
 772         fill_gpval_axis(SECOND_X_AXIS);
 773         fill_gpval_axis(SECOND_Y_AXIS);
 774         fill_gpval_axis(FIRST_Z_AXIS);
 775         fill_gpval_axis(COLOR_AXIS);
 776         fill_gpval_axis(T_AXIS);
 777         fill_gpval_axis(U_AXIS);
 778         fill_gpval_axis(V_AXIS);
 779         return;
 780     }
 781
 782     /* These are set every time, which is kind of silly because they */
 783     /* only change after 'set term' 'set output' ...                 */
 784     else {
 785         /* FIXME! This preventa a segfault if term==NULL, which can */
 786         /* happen if set_terminal() exits via int_error().          */
 787         if (!term)
 788             fill_gpval_string("GPVAL_TERM", "unknown");
 789         else
 790             fill_gpval_string("GPVAL_TERM", (char *)(term->name));
 791
 792         fill_gpval_string("GPVAL_TERMOPTIONS", term_options);
 793         fill_gpval_string("GPVAL_OUTPUT", (outstr) ? outstr : "");
 794     }
 795
 796     /* These initializations need only be done once, on program entry */
 797     if (context == 3) {
 798         struct udvt_entry *v = add_udv_by_name("GPVAL_VERSION");
 799         if (v && v->udv_undef == TRUE) {
 800             v->udv_undef = FALSE;
 801             Gcomplex(&v->udv_value, atof(gnuplot_version), 0);
 802         }
 803         v = add_udv_by_name("GPVAL_PATCHLEVEL");
 804         if (v && v->udv_undef == TRUE) {
 805 #ifdef GP_STRING_VARS
 806             fill_gpval_string("GPVAL_PATCHLEVEL", gnuplot_patchlevel);
 807 #else
 808             v->udv_undef = FALSE;
 809             Ginteger(&v->udv_value, atoi(gnuplot_patchlevel));
 810 #endif
 811         }
 812         v = add_udv_by_name("GPVAL_COMPILE_OPTIONS");
 813         if (v && v->udv_undef == TRUE)
 814             fill_gpval_string("GPVAL_COMPILE_OPTIONS", compile_options);
 815
 816         /* Permanent copy of user-clobberable variables pi and NaN */
 817         v = add_udv_by_name("GPVAL_pi");
 818         v->udv_undef = FALSE;
 819         Gcomplex(&v->udv_value, M_PI, 0);
 820 #ifdef HAVE_ISNAN
 821         v = add_udv_by_name("GPVAL_NaN");
 822         v->udv_undef = FALSE;
 823         Gcomplex(&v->udv_value, atof("NaN"), 0);
 824 #endif
 825     }
 826
 827 }
 828