1 /* GNUPLOT - eval.c */
2
3 /*[
4 * Copyright 1986 - 1993, 1998, 2004 Thomas Williams, Colin Kelley
5 *
6 * Permission to use, copy, and distribute this software and its
7 * documentation for any purpose with or without fee is hereby granted,
8 * provided that the above copyright notice appear in all copies and
9 * that both that copyright notice and this permission notice appear
10 * in supporting documentation.
11 *
12 * Permission to modify the software is granted, but not the right to
13 * distribute the complete modified source code. Modifications are to
14 * be distributed as patches to the released version. Permission to
15 * distribute binaries produced by compiling modified sources is granted,
16 * provided you
17 * 1. distribute the corresponding source modifications from the
18 * released version in the form of a patch file along with the binaries,
19 * 2. add special version identification to distinguish your version
20 * in addition to the base release version number,
21 * 3. provide your name and address as the primary contact for the
22 * support of your modified version, and
23 * 4. retain our contact information in regard to use of the base
24 * software.
25 * Permission to distribute the released version of the source code along
26 * with corresponding source modifications in the form of a patch file is
27 * granted with same provisions 2 through 4 for binary distributions.
28 *
29 * This software is provided "as is" without express or implied warranty
30 * to the extent permitted by applicable law.
31 ]*/
32
33 #include "eval.h"
34
35 #include "syscfg.h"
36 #include "alloc.h"
37 #include "datafile.h"
38 #include "datablock.h"
39 #include "external.h" /* for f_calle */
40 #include "internal.h"
41 #include "libcerf.h"
42 #include "specfun.h"
43 #include "standard.h"
44 #include "util.h"
45 #include "version.h"
46 #include "term_api.h"
47 #include "voxelgrid.h"
48
49 #include <signal.h>
50 #include <setjmp.h>
51
52 /* Internal prototypes */
53 static RETSIGTYPE fpe(int an_int);
54
55 /* Global variables exported by this module */
56 struct udvt_entry udv_pi = { NULL, "pi", {INTGR, {0} } };
57 struct udvt_entry *udv_NaN;
58 /* first in linked list */
59 struct udvt_entry *first_udv = &udv_pi;
60 struct udft_entry *first_udf = NULL;
61 /* pointer to first udv users can delete */
62 struct udvt_entry **udv_user_head;
63
64 /* Various abnormal conditions during evaluation of an action table
65 * (the stored form of an expression) are signalled by setting
66 * undefined = TRUE.
67 * NB: A test for "if (undefined)" is only valid immediately
68 * following a call to evaluate_at() or eval_link_function().
69 */
70 TBOOLEAN undefined;
71
72 enum int64_overflow overflow_handling = INT64_OVERFLOW_TO_FLOAT;
73
74 /* The stack this operates on */
75 static struct value stack[STACK_DEPTH];
76 static int s_p = -1; /* stack pointer */
77 #define top_of_stack stack[s_p]
78
79 static int jump_offset; /* to be modified by 'jump' operators */
80
81 /* The table of built-in functions */
82 /* These must strictly parallel enum operators in eval.h */
83 const struct ft_entry ft[] =
84 {
85 /* internal functions: */
86 {"push", f_push},
87 {"pushc", f_pushc},
88 {"pushd1", f_pushd1},
89 {"pushd2", f_pushd2},
90 {"pushd", f_pushd},
91 {"pop", f_pop},
92 {"call", f_call},
93 {"calln", f_calln},
94 {"sum", f_sum},
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 {"leftshift", f_leftshift},
110 {"rightshift", f_rightshift},
111 {"plus", f_plus},
112 {"minus", f_minus},
113 {"mult", f_mult},
114 {"div", f_div},
115 {"mod", f_mod},
116 {"power", f_power},
117 {"factorial", f_factorial},
118 {"bool", f_bool},
119 {"dollars", f_dollars}, /* for usespec */
120 {"concatenate", f_concatenate}, /* for string variables only */
121 {"eqs", f_eqs}, /* for string variables only */
122 {"nes", f_nes}, /* for string variables only */
123 {"[]", f_range}, /* for string variables only */
124 {"[]", f_index}, /* for array variables only */
125 {"||", f_cardinality}, /* for array variables only */
126 {"assign", f_assign}, /* assignment operator '=' */
127 {"jump", f_jump},
128 {"jumpz", f_jumpz},
129 {"jumpnz", f_jumpnz},
130 {"jtern", f_jtern},
131
132 /* Placeholder for SF_START */
133 {"", NULL},
134
135 #ifdef HAVE_EXTERNAL_FUNCTIONS
136 {"", f_calle},
137 #endif
138
139 /* legal in using spec only */
140 {"column", f_column},
141 {"stringcolumn", f_stringcolumn}, /* for using specs */
142 {"strcol", f_stringcolumn}, /* shorthand form */
143 {"columnhead", f_columnhead},
144 {"columnheader", f_columnhead},
145 {"valid", f_valid},
146 {"timecolumn", f_timecolumn},
147
148 /* standard functions: */
149 {"real", f_real},
150 {"imag", f_imag},
151 {"arg", f_arg},
152 {"conjg", f_conjg},
153 {"sin", f_sin},
154 {"cos", f_cos},
155 {"tan", f_tan},
156 {"asin", f_asin},
157 {"acos", f_acos},
158 {"atan", f_atan},
159 {"atan2", f_atan2},
160 {"sinh", f_sinh},
161 {"cosh", f_cosh},
162 {"tanh", f_tanh},
163 {"EllipticK", f_ellip_first},
164 {"EllipticE", f_ellip_second},
165 {"EllipticPi", f_ellip_third},
166 {"int", f_int},
167 {"abs", f_abs},
168 {"sgn", f_sgn},
169 {"sqrt", f_sqrt},
170 {"exp", f_exp},
171 {"log10", f_log10},
172 {"log", f_log},
173 {"besi0", f_besi0},
174 {"besi1", f_besi1},
175 {"besj0", f_besj0},
176 {"besj1", f_besj1},
177 {"besjn", f_besjn},
178 {"besy0", f_besy0},
179 {"besy1", f_besy1},
180 {"besyn", f_besyn},
181 {"erf", f_erf},
182 {"erfc", f_erfc},
183 {"gamma", f_gamma},
184 {"lgamma", f_lgamma},
185 {"ibeta", f_ibeta},
186 {"voigt", f_voigt},
187 {"igamma", f_igamma},
188 {"rand", f_rand},
189 {"floor", f_floor},
190 {"ceil", f_ceil},
191
192 {"norm", f_normal}, /* XXX-JG */
193 {"inverf", f_inverse_erf}, /* XXX-JG */
194 {"invnorm", f_inverse_normal}, /* XXX-JG */
195 {"asinh", f_asinh},
196 {"acosh", f_acosh},
197 {"atanh", f_atanh},
198 {"lambertw", f_lambertw}, /* HBB, from G.Kuhnle 20001107 */
199 {"airy", f_airy}, /* janert, 20090905 */
200 {"expint", f_expint}, /* Jim Van Zandt, 20101010 */
201 {"besin", f_besin},
202
203 #ifdef HAVE_LIBCERF
204 {"cerf", f_cerf}, /* complex error function */
205 {"cdawson", f_cdawson}, /* complex Dawson's integral */
206 {"erfi", f_erfi}, /* imaginary error function */
207 {"VP", f_voigtp}, /* Voigt profile */
208 {"faddeeva", f_faddeeva}, /* Faddeeva rescaled complex error function "w_of_z" */
209 #endif
210
211 {"tm_sec", f_tmsec}, /* for timeseries */
212 {"tm_min", f_tmmin}, /* for timeseries */
213 {"tm_hour", f_tmhour}, /* for timeseries */
214 {"tm_mday", f_tmmday}, /* for timeseries */
215 {"tm_mon", f_tmmon}, /* for timeseries */
216 {"tm_year", f_tmyear}, /* for timeseries */
217 {"tm_wday", f_tmwday}, /* for timeseries */
218 {"tm_yday", f_tmyday}, /* for timeseries */
219
220 {"sprintf", f_sprintf}, /* for string variables only */
221 {"gprintf", f_gprintf}, /* for string variables only */
222 {"strlen", f_strlen}, /* for string variables only */
223 {"strstrt", f_strstrt}, /* for string variables only */
224 {"substr", f_range}, /* for string variables only */
225 {"trim", f_trim}, /* for string variables only */
226 {"word", f_word}, /* for string variables only */
227 {"words", f_words}, /* implemented as word(s,-1) */
228 {"strftime", f_strftime}, /* time to string */
229 {"strptime", f_strptime}, /* string to time */
230 {"time", f_time}, /* get current time */
231 {"system", f_system}, /* "dynamic backtics" */
232 {"exist", f_exists}, /* exists("foo") replaces defined(foo) */
233 {"exists", f_exists}, /* exists("foo") replaces defined(foo) */
234 {"value", f_value}, /* retrieve value of variable known by name */
235
236 {"hsv2rgb", f_hsv2rgb}, /* color conversion */
237 {"palette", f_palette}, /* palette color lookup */
238
239 #ifdef VOXEL_GRID_SUPPORT
240 {"voxel", f_voxel}, /* extract value of single voxel */
241 #endif
242
243 {NULL, NULL}
244 };
245
246 /* Module-local variables: */
247
248 static JMP_BUF fpe_env;
249
250 /* Internal helper functions: */
251
252 static RETSIGTYPE
fpe(int an_int)253 fpe(int an_int)
254 {
255 #if defined(MSDOS) && !defined(__EMX__) && !defined(DJGPP)
256 /* thanks to lotto@wjh12.UUCP for telling us about this */
257 _fpreset();
258 #endif
259
260 (void) an_int; /* avoid -Wunused warning */
261 (void) signal(SIGFPE, (sigfunc) fpe);
262 undefined = TRUE;
263 LONGJMP(fpe_env, TRUE);
264 }
265
266 /* Exported functions */
267
268 /* First, some functions that help other modules use 'struct value' ---
269 * these might justify a separate module, but I'll stick with this,
270 * for now */
271
272 /* returns the real part of val */
273 double
real(struct value * val)274 real(struct value *val)
275 {
276 switch (val->type) {
277 case INTGR:
278 return ((double) val->v.int_val);
279 case CMPLX:
280 return (val->v.cmplx_val.real);
281 case STRING: /* is this ever used? */
282 return (atof(val->v.string_val));
283 case NOTDEFINED:
284 return not_a_number();
285 default:
286 int_error(NO_CARET, "unknown type in real()");
287 }
288 /* NOTREACHED */
289 return ((double) 0.0);
290 }
291
292
293 /* returns the imag part of val */
294 double
imag(struct value * val)295 imag(struct value *val)
296 {
297 switch (val->type) {
298 case INTGR:
299 return (0.0);
300 case CMPLX:
301 return (val->v.cmplx_val.imag);
302 case STRING:
303 /* This is where we end up if the user tries: */
304 /* x = 2; plot sprintf(format,x) */
305 int_warn(NO_CARET, "encountered a string when expecting a number");
306 int_error(NO_CARET, "Did you try to generate a file name using dummy variable x or y?");
307 case NOTDEFINED:
308 return not_a_number();
309 default:
310 int_error(NO_CARET, "unknown type in imag()");
311 }
312 /* NOTREACHED */
313 return ((double) 0.0);
314 }
315
316
317
318 /* returns the magnitude of val */
319 double
magnitude(struct value * val)320 magnitude(struct value *val)
321 {
322 switch (val->type) {
323 case INTGR:
324 return (fabs((double)val->v.int_val));
325 case CMPLX:
326 {
327 /* The straightforward implementation sqrt(r*r+i*i)
328 * over-/underflows if either r or i is very large or very
329 * small. This implementation avoids over-/underflows from
330 * squaring large/small numbers whenever possible. It
331 * only over-/underflows if the correct result would, too.
332 * CAVEAT: sqrt(1+x*x) can still have accuracy
333 * problems. */
334 double abs_r = fabs(val->v.cmplx_val.real);
335 double abs_i = fabs(val->v.cmplx_val.imag);
336 double quotient;
337
338 if (abs_i == 0)
339 return abs_r;
340 if (abs_r > abs_i) {
341 quotient = abs_i / abs_r;
342 return abs_r * sqrt(1 + quotient*quotient);
343 } else {
344 quotient = abs_r / abs_i;
345 return abs_i * sqrt(1 + quotient*quotient);
346 }
347 }
348 default:
349 int_error(NO_CARET, "unknown type in magnitude()");
350 }
351 /* NOTREACHED */
352 return ((double) 0.0);
353 }
354
355
356
357 /* returns the angle of val */
358 double
angle(struct value * val)359 angle(struct value *val)
360 {
361 switch (val->type) {
362 case INTGR:
363 return ((val->v.int_val >= 0) ? 0.0 : M_PI);
364 case CMPLX:
365 if (val->v.cmplx_val.imag == 0.0) {
366 if (val->v.cmplx_val.real >= 0.0)
367 return (0.0);
368 else
369 return (M_PI);
370 }
371 return (atan2(val->v.cmplx_val.imag,
372 val->v.cmplx_val.real));
373 default:
374 int_error(NO_CARET, "unknown type in angle()");
375 }
376 /* NOTREACHED */
377 return ((double) 0.0);
378 }
379
380
381 struct value *
Gcomplex(struct value * a,double realpart,double imagpart)382 Gcomplex(struct value *a, double realpart, double imagpart)
383 {
384 a->type = CMPLX;
385 a->v.cmplx_val.real = realpart;
386 a->v.cmplx_val.imag = imagpart;
387 return (a);
388 }
389
390
391 struct value *
Ginteger(struct value * a,intgr_t i)392 Ginteger(struct value *a, intgr_t i)
393 {
394 a->type = INTGR;
395 a->v.int_val = i;
396 return (a);
397 }
398
399 struct value *
Gstring(struct value * a,char * s)400 Gstring(struct value *a, char *s)
401 {
402 a->type = STRING;
403 a->v.string_val = s ? s : strdup("");
404 return (a);
405 }
406
407 /* Common interface for freeing data structures attached to a struct value.
408 * Each of the type-specific routines will ignore values of other types.
409 */
410 void
free_value(struct value * a)411 free_value(struct value *a)
412 {
413 gpfree_string(a);
414 gpfree_datablock(a);
415 gpfree_array(a);
416 }
417
418 /* It is always safe to call gpfree_string with a->type is INTGR or CMPLX.
419 * However it would be fatal to call it with a->type = STRING if a->string_val
420 * was not obtained by a previous call to gp_alloc(), or has already been freed.
421 * Thus 'a->type' is set to NOTDEFINED afterwards to make subsequent calls safe.
422 */
423 void
gpfree_string(struct value * a)424 gpfree_string(struct value *a)
425 {
426 if (a->type == STRING) {
427 free(a->v.string_val);
428 a->type = NOTDEFINED;
429 }
430 }
431
432 void
gpfree_array(struct value * a)433 gpfree_array(struct value *a)
434 {
435 int i;
436 int size;
437
438 if (a->type == ARRAY) {
439 size = a->v.value_array[0].v.int_val;
440 for (i=1; i<=size; i++)
441 gpfree_string(&(a->v.value_array[i]));
442 free(a->v.value_array);
443 a->type = NOTDEFINED;
444 }
445 }
446
447 /* some machines have trouble with exp(-x) for large x
448 * if E_MINEXP is defined at compile time, use gp_exp(x) instead,
449 * which returns 0 for exp(x) with x < E_MINEXP
450 * exp(x) will already have been defined as gp_exp(x) in plot.h
451 */
452
453 double
gp_exp(double x)454 gp_exp(double x)
455 {
456 #ifdef E_MINEXP
457 return (x < (E_MINEXP)) ? 0.0 : exp(x);
458 #else /* E_MINEXP */
459 int old_errno = errno;
460 double result = exp(x);
461
462 /* exp(-large) quite uselessly raises ERANGE --- stop that */
463 if (result == 0.0)
464 errno = old_errno;
465 return result;
466 #endif /* E_MINEXP */
467 }
468
469 void
reset_stack()470 reset_stack()
471 {
472 s_p = -1;
473 }
474
475
476 void
check_stack()477 check_stack()
478 { /* make sure stack's empty */
479 if (s_p != -1)
480 fprintf(stderr, "\n\
481 warning: internal error--stack not empty!\n\
482 (function called with too many parameters?)\n");
483 }
484
485 TBOOLEAN
more_on_stack()486 more_on_stack()
487 {
488 return (s_p >= 0);
489 }
490
491 struct value *
pop(struct value * x)492 pop(struct value *x)
493 {
494 if (s_p < 0)
495 int_error(NO_CARET, "stack underflow (function call with missing parameters?)");
496 *x = stack[s_p--];
497 return (x);
498 }
499
500 /*
501 * Allow autoconversion of string variables to floats if they
502 * are dereferenced in a numeric context.
503 */
504 struct value *
pop_or_convert_from_string(struct value * v)505 pop_or_convert_from_string(struct value *v)
506 {
507 (void) pop(v);
508
509 /* FIXME: Test for INVALID_VALUE? Other corner cases? */
510 if (v->type == INVALID_NAME)
511 int_error(NO_CARET, "invalid dummy variable name");
512
513 if (v->type == STRING) {
514 char *eov;
515
516 if (*(v->v.string_val)
517 && strspn(v->v.string_val,"0123456789 ") == strlen(v->v.string_val)) {
518 long long li = atoll(v->v.string_val);
519 gpfree_string(v);
520 Ginteger(v, li);
521 } else {
522 double d = strtod(v->v.string_val,&eov);
523 if (v->v.string_val == eov) {
524 gpfree_string(v);
525 int_error(NO_CARET,"Non-numeric string found where a numeric expression was expected");
526 /* Note: This also catches syntax errors like "set term ''*0 " */
527 }
528 gpfree_string(v);
529 Gcomplex(v, d, 0.);
530 FPRINTF((stderr,"converted string to CMPLX value %g\n",real(v)));
531 }
532 }
533 return(v);
534 }
535
536 void
push(struct value * x)537 push(struct value *x)
538 {
539 if (s_p == STACK_DEPTH - 1)
540 int_error(NO_CARET, "stack overflow");
541 stack[++s_p] = *x;
542
543 /* WARNING - This is a memory leak if the string is not later freed */
544 if (x->type == STRING && x->v.string_val)
545 stack[s_p].v.string_val = gp_strdup(x->v.string_val);
546 }
547
548
549 void
int_check(struct value * v)550 int_check(struct value *v)
551 {
552 if (v->type != INTGR)
553 int_error(NO_CARET, "non-integer passed to boolean operator");
554 }
555
556
557
558 /* Internal operators of the stack-machine, not directly represented
559 * by any user-visible operator, or using private status variables
560 * directly */
561
562 /* converts top-of-stack to boolean */
563 void
f_bool(union argument * x)564 f_bool(union argument *x)
565 {
566 (void) x; /* avoid -Wunused warning */
567
568 int_check(&top_of_stack);
569 top_of_stack.v.int_val = !!top_of_stack.v.int_val;
570 }
571
572
573 void
f_jump(union argument * x)574 f_jump(union argument *x)
575 {
576 (void) x; /* avoid -Wunused warning */
577 jump_offset = x->j_arg;
578 }
579
580
581 void
f_jumpz(union argument * x)582 f_jumpz(union argument *x)
583 {
584 struct value a;
585
586 (void) x; /* avoid -Wunused warning */
587 int_check(&top_of_stack);
588 if (top_of_stack.v.int_val) { /* non-zero --> no jump*/
589 (void) pop(&a);
590 } else
591 jump_offset = x->j_arg; /* leave the argument on TOS */
592 }
593
594
595 void
f_jumpnz(union argument * x)596 f_jumpnz(union argument *x)
597 {
598 struct value a;
599
600 (void) x; /* avoid -Wunused warning */
601 int_check(&top_of_stack);
602 if (top_of_stack.v.int_val) /* non-zero */
603 jump_offset = x->j_arg; /* leave the argument on TOS */
604 else {
605 (void) pop(&a);
606 }
607 }
608
609 void
f_jtern(union argument * x)610 f_jtern(union argument *x)
611 {
612 struct value a;
613
614 (void) x; /* avoid -Wunused warning */
615 int_check(pop(&a));
616 if (! a.v.int_val)
617 jump_offset = x->j_arg; /* go jump to FALSE code */
618 }
619
620 /* This is the heart of the expression evaluation module: the stack
621 program execution loop.
622
623 'ft' is a table containing C functions within this program.
624
625 An 'action_table' contains pointers to these functions and
626 arguments to be passed to them.
627
628 at_ptr is a pointer to the action table which must be executed
629 (evaluated).
630
631 so the iterated line executes the function indexed by the at_ptr
632 and passes the address of the argument which is pointed to by the
633 arg_ptr
634
635 */
636
637 void
execute_at(struct at_type * at_ptr)638 execute_at(struct at_type *at_ptr)
639 {
640 int instruction_index, operator, count;
641 int saved_jump_offset = jump_offset;
642
643 count = at_ptr->a_count;
644 for (instruction_index = 0; instruction_index < count;) {
645 operator = (int) at_ptr->actions[instruction_index].index;
646 jump_offset = 1; /* jump operators can modify this */
647 (*ft[operator].func) (&(at_ptr->actions[instruction_index].arg));
648 assert(is_jump(operator) || (jump_offset == 1));
649 instruction_index += jump_offset;
650 }
651
652 jump_offset = saved_jump_offset;
653 }
654
655 /* As of May 2013 input of Inf/NaN values through evaluation is treated */
656 /* equivalently to direct input of a formatted value. See imageNaN.dem. */
657 void
evaluate_at(struct at_type * at_ptr,struct value * val_ptr)658 evaluate_at(struct at_type *at_ptr, struct value *val_ptr)
659 {
660 /* A test for if (undefined) is allowed only immediately following
661 * evalute_at() or eval_link_function(). Both must clear it on entry
662 * so that the value on return reflects what really happened.
663 */
664 undefined = FALSE;
665
666 errno = 0;
667 reset_stack();
668
669 if (!evaluate_inside_using || !df_nofpe_trap) {
670 if (SETJMP(fpe_env, 1))
671 return;
672 (void) signal(SIGFPE, (sigfunc) fpe);
673 }
674
675 execute_at(at_ptr);
676
677 if (!evaluate_inside_using || !df_nofpe_trap)
678 (void) signal(SIGFPE, SIG_DFL);
679
680 if (errno == EDOM || errno == ERANGE)
681 undefined = TRUE;
682 else if (!undefined) {
683 (void) pop(val_ptr);
684 check_stack();
685 }
686
687 if (!undefined && val_ptr->type == ARRAY) {
688 /* Aug 2016: error rather than warning because too many places
689 * cannot deal with UNDEFINED or NaN where they were expecting a number
690 * E.g. load_one_range()
691 */
692 val_ptr->type = NOTDEFINED;
693 if (!string_result_only)
694 int_error(NO_CARET, "evaluate_at: unsupported array operation");
695 }
696 }
697
698 void
real_free_at(struct at_type * at_ptr)699 real_free_at(struct at_type *at_ptr)
700 {
701 int i;
702 /* All string constants belonging to this action table have to be
703 * freed before destruction. */
704 if (!at_ptr)
705 return;
706 for (i=0; i<at_ptr->a_count; i++) {
707 struct at_entry *a = &(at_ptr->actions[i]);
708 /* if union a->arg is used as a->arg.v_arg free potential string */
709 if ( a->index == PUSHC || a->index == DOLLARS )
710 gpfree_string(&(a->arg.v_arg));
711 /* a summation contains its own action table wrapped in a private udf */
712 if (a->index == SUM) {
713 real_free_at(a->arg.udf_arg->at);
714 free(a->arg.udf_arg);
715 }
716 #ifdef HAVE_EXTERNAL_FUNCTIONS
717 /* external function calls contain a parameter list */
718 if (a->index == CALLE)
719 free(a->arg.exf_arg);
720 #endif
721 }
722 free(at_ptr);
723 }
724
725 /* EAM July 2003 - Return pointer to udv with this name; if the key does not
726 * match any existing udv names, create a new one and return a pointer to it.
727 */
728 struct udvt_entry *
add_udv_by_name(char * key)729 add_udv_by_name(char *key)
730 {
731 struct udvt_entry **udv_ptr = &first_udv;
732
733 /* check if it's already in the table... */
734
735 while (*udv_ptr) {
736 if (!strcmp(key, (*udv_ptr)->udv_name))
737 return (*udv_ptr);
738 udv_ptr = &((*udv_ptr)->next_udv);
739 }
740
741 *udv_ptr = (struct udvt_entry *)
742 gp_alloc(sizeof(struct udvt_entry), "value");
743 (*udv_ptr)->next_udv = NULL;
744 (*udv_ptr)->udv_name = gp_strdup(key);
745 (*udv_ptr)->udv_value.type = NOTDEFINED;
746 return (*udv_ptr);
747 }
748
749 struct udvt_entry *
get_udv_by_name(char * key)750 get_udv_by_name(char *key)
751 {
752 struct udvt_entry *udv = first_udv;
753
754 while (udv) {
755 if (!strcmp(key, udv->udv_name))
756 return udv;
757
758 udv = udv->next_udv;
759 }
760
761 return NULL;
762 }
763
764 /* This doesn't really delete, it just marks the udv as undefined */
765 void
del_udv_by_name(char * key,TBOOLEAN wildcard)766 del_udv_by_name(char *key, TBOOLEAN wildcard)
767 {
768 struct udvt_entry *udv_ptr = *udv_user_head;
769
770 while (udv_ptr) {
771 /* Forbidden to delete GPVAL_* */
772 if (!strncmp(udv_ptr->udv_name,"GPVAL",5))
773 ;
774 else if (!strncmp(udv_ptr->udv_name,"GNUTERM",7))
775 ;
776
777 /* exact match */
778 else if (!wildcard && !strcmp(key, udv_ptr->udv_name)) {
779 gpfree_vgrid(udv_ptr);
780 free_value(&(udv_ptr->udv_value));
781 udv_ptr->udv_value.type = NOTDEFINED;
782 break;
783 }
784
785 /* wildcard match: prefix matches */
786 else if ( wildcard && !strncmp(key, udv_ptr->udv_name, strlen(key)) ) {
787 gpfree_vgrid(udv_ptr);
788 free_value(&(udv_ptr->udv_value));
789 udv_ptr->udv_value.type = NOTDEFINED;
790 /* no break - keep looking! */
791 }
792
793 udv_ptr = udv_ptr->next_udv;
794 }
795 }
796
797 /* Clear (delete) all user defined functions */
798 void
clear_udf_list()799 clear_udf_list()
800 {
801 struct udft_entry *udf_ptr = first_udf;
802 struct udft_entry *udf_next;
803
804 while (udf_ptr) {
805 free(udf_ptr->udf_name);
806 free(udf_ptr->definition);
807 free_at(udf_ptr->at);
808 udf_next = udf_ptr->next_udf;
809 free(udf_ptr);
810 udf_ptr = udf_next;
811 }
812 first_udf = NULL;
813 }
814
815 static void update_plot_bounds(void);
816 static void fill_gpval_axis(AXIS_INDEX axis);
817 static void fill_gpval_sysinfo(void);
818 static void set_gpval_axis_sth_double(const char *prefix, AXIS_INDEX axis, const char *suffix, double value);
819
820 static void
set_gpval_axis_sth_double(const char * prefix,AXIS_INDEX axis,const char * suffix,double value)821 set_gpval_axis_sth_double(const char *prefix, AXIS_INDEX axis, const char *suffix, double value)
822 {
823 struct udvt_entry *v;
824 char *cc, s[24];
825 sprintf(s, "%s_%s_%s", prefix, axis_name(axis), suffix);
826 for (cc=s; *cc; cc++)
827 *cc = toupper((unsigned char)*cc); /* make the name uppercase */
828 v = add_udv_by_name(s);
829 if (!v)
830 return; /* should not happen */
831 Gcomplex(&v->udv_value, value, 0);
832 }
833
834 static void
fill_gpval_axis(AXIS_INDEX axis)835 fill_gpval_axis(AXIS_INDEX axis)
836 {
837 const char *prefix = "GPVAL";
838 AXIS *ap = &axis_array[axis];
839 set_gpval_axis_sth_double(prefix, axis, "MIN", ap->min);
840 set_gpval_axis_sth_double(prefix, axis, "MAX", ap->max);
841 set_gpval_axis_sth_double(prefix, axis, "LOG", ap->base);
842
843 if (axis < POLAR_AXIS) {
844 set_gpval_axis_sth_double("GPVAL_DATA", axis, "MIN", ap->data_min);
845 set_gpval_axis_sth_double("GPVAL_DATA", axis, "MAX", ap->data_max);
846 }
847 }
848
849 /* Fill variable "var" visible by "show var" or "show var all" ("GPVAL_*")
850 * by the given value (string, integer, float, complex).
851 */
852 void
fill_gpval_string(char * var,const char * stringvalue)853 fill_gpval_string(char *var, const char *stringvalue)
854 {
855 struct udvt_entry *v = add_udv_by_name(var);
856 if (!v)
857 return;
858 if (v->udv_value.type == STRING && !strcmp(v->udv_value.v.string_val, stringvalue))
859 return;
860 else
861 gpfree_string(&v->udv_value);
862 Gstring(&v->udv_value, gp_strdup(stringvalue));
863 }
864
865 void
fill_gpval_integer(char * var,intgr_t value)866 fill_gpval_integer(char *var, intgr_t value)
867 {
868 struct udvt_entry *v = add_udv_by_name(var);
869 if (!v)
870 return;
871 Ginteger(&v->udv_value, value);
872 }
873
874 void
fill_gpval_float(char * var,double value)875 fill_gpval_float(char *var, double value)
876 {
877 struct udvt_entry *v = add_udv_by_name(var);
878 if (!v)
879 return;
880 Gcomplex(&v->udv_value, value, 0);
881 }
882
883 void
fill_gpval_complex(char * var,double areal,double aimag)884 fill_gpval_complex(char *var, double areal, double aimag)
885 {
886 struct udvt_entry *v = add_udv_by_name(var);
887 if (!v)
888 return;
889 Gcomplex(&v->udv_value, areal, aimag);
890 }
891
892 /*
893 * Export axis bounds in terminal coordinates from previous plot.
894 * This allows offline mapping of pixel coordinates onto plot coordinates.
895 */
896 static void
update_plot_bounds(void)897 update_plot_bounds(void)
898 {
899 fill_gpval_integer("GPVAL_TERM_XMIN", axis_array[FIRST_X_AXIS].term_lower / term->tscale);
900 fill_gpval_integer("GPVAL_TERM_XMAX", axis_array[FIRST_X_AXIS].term_upper / term->tscale);
901 fill_gpval_integer("GPVAL_TERM_YMIN", axis_array[FIRST_Y_AXIS].term_lower / term->tscale);
902 fill_gpval_integer("GPVAL_TERM_YMAX", axis_array[FIRST_Y_AXIS].term_upper / term->tscale);
903 fill_gpval_integer("GPVAL_TERM_XSIZE", canvas.xright+1);
904 fill_gpval_integer("GPVAL_TERM_YSIZE", canvas.ytop+1);
905 fill_gpval_integer("GPVAL_TERM_SCALE", term->tscale);
906 /* May be useful for debugging font problems */
907 fill_gpval_integer("GPVAL_TERM_HCHAR", term->h_char);
908 fill_gpval_integer("GPVAL_TERM_VCHAR", term->v_char);
909 }
910
911 /*
912 * Put all the handling for GPVAL_* variables in this one routine.
913 * We call it from one of several contexts:
914 * 0: following a successful set/unset command
915 * 1: following a successful plot/splot
916 * 2: following an unsuccessful command (int_error)
917 * 3: program entry
918 * 4: explicit reset of error status
919 * 5: directory changed
920 * 6: X11 Window ID changed
921 */
922 void
update_gpval_variables(int context)923 update_gpval_variables(int context)
924 {
925 /* These values may change during a plot command due to auto range */
926 if (context == 1) {
927 fill_gpval_axis(FIRST_X_AXIS);
928 fill_gpval_axis(FIRST_Y_AXIS);
929 fill_gpval_axis(SECOND_X_AXIS);
930 fill_gpval_axis(SECOND_Y_AXIS);
931 fill_gpval_axis(FIRST_Z_AXIS);
932 fill_gpval_axis(COLOR_AXIS);
933 fill_gpval_axis(T_AXIS);
934 fill_gpval_axis(U_AXIS);
935 fill_gpval_axis(V_AXIS);
936 fill_gpval_float("GPVAL_R_MIN", R_AXIS.min);
937 fill_gpval_float("GPVAL_R_MAX", R_AXIS.max);
938 fill_gpval_float("GPVAL_R_LOG", R_AXIS.base);
939 update_plot_bounds();
940 fill_gpval_integer("GPVAL_PLOT", is_3d_plot ? 0:1);
941 fill_gpval_integer("GPVAL_SPLOT", is_3d_plot ? 1:0);
942 fill_gpval_integer("GPVAL_VIEW_MAP", splot_map ? 1:0);
943 fill_gpval_float("GPVAL_VIEW_ROT_X", surface_rot_x);
944 fill_gpval_float("GPVAL_VIEW_ROT_Z", surface_rot_z);
945 fill_gpval_float("GPVAL_VIEW_SCALE", surface_scale);
946 fill_gpval_float("GPVAL_VIEW_ZSCALE", surface_zscale);
947 fill_gpval_float("GPVAL_VIEW_AZIMUTH", azimuth);
948
949 /* Screen coordinates of 3D rotational center and radius of the sphere */
950 /* in which x/y axes are drawn after 'set view equal xy[z]' */
951 fill_gpval_float("GPVAL_VIEW_XCENT",
952 (double)(canvas.xright+1 - xmiddle)/(double)(canvas.xright+1));
953 fill_gpval_float("GPVAL_VIEW_YCENT",
954 1.0 - (double)(canvas.ytop+1 - ymiddle)/(double)(canvas.ytop+1));
955 fill_gpval_float("GPVAL_VIEW_RADIUS",
956 0.5 * surface_scale * xscaler/(double)(canvas.xright+1));
957
958 return;
959 }
960
961 /* These are set after every "set" command, which is kind of silly */
962 /* because they only change after 'set term' 'set output' ... */
963 if (context == 0 || context == 2 || context == 3) {
964 /* This prevents a segfault if term==NULL, which can */
965 /* happen if set_terminal() exits via int_error(). */
966 if (!term)
967 fill_gpval_string("GPVAL_TERM", "unknown");
968 else
969 fill_gpval_string("GPVAL_TERM", (char *)(term->name));
970
971 fill_gpval_string("GPVAL_TERMOPTIONS", term_options);
972 fill_gpval_string("GPVAL_OUTPUT", (outstr) ? outstr : "");
973 fill_gpval_string("GPVAL_ENCODING", encoding_names[encoding]);
974 fill_gpval_string("GPVAL_MINUS_SIGN", minus_sign ? minus_sign : "-");
975 fill_gpval_string("GPVAL_MICRO", micro ? micro : "u");
976 fill_gpval_string("GPVAL_DEGREE_SIGN", degree_sign);
977 }
978
979 /* If we are called from int_error() then set the error state */
980 if (context == 2)
981 fill_gpval_integer("GPVAL_ERRNO", 1);
982
983 /* These initializations need only be done once, on program entry */
984 if (context == 3) {
985 struct udvt_entry *v = add_udv_by_name("GPVAL_VERSION");
986 char *tmp;
987 if (v && v->udv_value.type == NOTDEFINED)
988 Gcomplex(&v->udv_value, atof(gnuplot_version), 0);
989 v = add_udv_by_name("GPVAL_PATCHLEVEL");
990 if (v && v->udv_value.type == NOTDEFINED)
991 fill_gpval_string("GPVAL_PATCHLEVEL", gnuplot_patchlevel);
992 v = add_udv_by_name("GPVAL_COMPILE_OPTIONS");
993 if (v && v->udv_value.type == NOTDEFINED)
994 fill_gpval_string("GPVAL_COMPILE_OPTIONS", compile_options);
995
996 /* Start-up values */
997 fill_gpval_integer("GPVAL_MULTIPLOT", 0);
998 fill_gpval_integer("GPVAL_PLOT", 0);
999 fill_gpval_integer("GPVAL_SPLOT", 0);
1000
1001 tmp = get_terminals_names();
1002 fill_gpval_string("GPVAL_TERMINALS", tmp);
1003 free(tmp);
1004
1005 fill_gpval_string("GPVAL_ENCODING", encoding_names[encoding]);
1006
1007 /* Permanent copy of user-clobberable variables pi and NaN */
1008 fill_gpval_float("GPVAL_pi", M_PI);
1009 fill_gpval_float("GPVAL_NaN", not_a_number());
1010
1011 /* System information */
1012 fill_gpval_sysinfo();
1013 }
1014
1015 if (context == 3 || context == 4) {
1016 fill_gpval_integer("GPVAL_ERRNO", 0);
1017 fill_gpval_string("GPVAL_ERRMSG","");
1018 fill_gpval_integer("GPVAL_SYSTEM_ERRNO", 0);
1019 fill_gpval_string("GPVAL_SYSTEM_ERRMSG","");
1020 }
1021
1022 /* GPVAL_PWD is unreliable. If the current directory becomes invalid,
1023 * GPVAL_PWD does not reflect this. If this matters, the user can
1024 * instead do something like MY_PWD = "`pwd`"
1025 */
1026 if (context == 3 || context == 5) {
1027 char *save_file = gp_alloc(PATH_MAX, "GPVAL_PWD");
1028 int ierror = (GP_GETCWD(save_file, PATH_MAX) == NULL);
1029 fill_gpval_string("GPVAL_PWD", ierror ? "" : save_file);
1030 free(save_file);
1031 }
1032
1033 if (context == 6) {
1034 fill_gpval_integer("GPVAL_TERM_WINDOWID", current_x11_windowid);
1035 }
1036 }
1037
1038 /* System information is stored in GPVAL_BITS GPVAL_MACHINE GPVAL_SYSNAME */
1039 #ifdef HAVE_UNAME
1040 # include <sys/utsname.h>
1041 #elif defined(_WIN32)
1042 # include <windows.h>
1043 #endif
1044
1045 void
fill_gpval_sysinfo()1046 fill_gpval_sysinfo()
1047 {
1048 /* For linux/posix systems with uname */
1049 #ifdef HAVE_UNAME
1050 struct utsname uts;
1051
1052 if (uname(&uts) < 0)
1053 return;
1054 fill_gpval_string("GPVAL_SYSNAME", uts.sysname);
1055 fill_gpval_string("GPVAL_MACHINE", uts.machine);
1056
1057 /* For Windows systems */
1058 #elif defined(_WIN32)
1059 SYSTEM_INFO stInfo;
1060 OSVERSIONINFO osvi;
1061 char s[30];
1062
1063 ZeroMemory(&osvi, sizeof(OSVERSIONINFO));
1064 osvi.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
1065 GetVersionEx(&osvi);
1066 snprintf(s, 30, "Windows_NT-%ld.%ld", osvi.dwMajorVersion, osvi.dwMinorVersion);
1067 fill_gpval_string("GPVAL_SYSNAME", s);
1068
1069 GetSystemInfo(&stInfo);
1070 switch (stInfo.wProcessorArchitecture)
1071 {
1072 case PROCESSOR_ARCHITECTURE_INTEL:
1073 fill_gpval_string("GPVAL_MACHINE", "x86");
1074 break;
1075 case PROCESSOR_ARCHITECTURE_IA64:
1076 fill_gpval_string("GPVAL_MACHINE", "ia64");
1077 break;
1078 case PROCESSOR_ARCHITECTURE_AMD64:
1079 fill_gpval_string("GPVAL_MACHINE", "x86_64");
1080 break;
1081 default:
1082 fill_gpval_string("GPVAL_MACHINE", "unknown");
1083 }
1084 #endif
1085
1086 /* For all systems */
1087 fill_gpval_integer("GPVAL_BITS", 8 * sizeof(void *));
1088 }
1089
1090 /* Callable wrapper for the words() internal function */
1091 int
gp_words(char * string)1092 gp_words(char *string)
1093 {
1094 struct value a;
1095
1096 push(Gstring(&a, string));
1097 f_words((union argument *)NULL);
1098 pop(&a);
1099
1100 return a.v.int_val;
1101 }
1102
1103 /* Callable wrapper for the word() internal function */
1104 char *
gp_word(char * string,int i)1105 gp_word(char *string, int i)
1106 {
1107 struct value a;
1108
1109 push(Gstring(&a, string));
1110 push(Ginteger(&a, (intgr_t)i));
1111 f_word((union argument *)NULL);
1112 pop(&a);
1113
1114 return a.v.string_val;
1115 }
1116
1117