/* GNUPLOT - eval.c */
/*[
* Copyright 1986 - 1993, 1998, 2004 Thomas Williams, Colin Kelley
*
* Permission to use, copy, and distribute this software and its
* documentation for any purpose with or without fee is hereby granted,
* provided that the above copyright notice appear in all copies and
* that both that copyright notice and this permission notice appear
* in supporting documentation.
*
* Permission to modify the software is granted, but not the right to
* distribute the complete modified source code. Modifications are to
* be distributed as patches to the released version. Permission to
* distribute binaries produced by compiling modified sources is granted,
* provided you
* 1. distribute the corresponding source modifications from the
* released version in the form of a patch file along with the binaries,
* 2. add special version identification to distinguish your version
* in addition to the base release version number,
* 3. provide your name and address as the primary contact for the
* support of your modified version, and
* 4. retain our contact information in regard to use of the base
* software.
* Permission to distribute the released version of the source code along
* with corresponding source modifications in the form of a patch file is
* granted with same provisions 2 through 4 for binary distributions.
*
* This software is provided "as is" without express or implied warranty
* to the extent permitted by applicable law.
]*/
#include "eval.h"
#include "syscfg.h"
#include "alloc.h"
#include "amos_airy.h" /* Airy functions from AMOS */
#include "complexfun.h"
#include "datafile.h"
#include "datablock.h"
#include "external.h" /* for f_calle */
#include "internal.h"
#include "libcerf.h"
#include "misc.h" /* for called_from() */
#include "specfun.h"
#include "standard.h"
#include "util.h"
#include "version.h"
#include "term_api.h"
#include "voxelgrid.h"
#include
#include
/* Internal prototypes */
static RETSIGTYPE fpe(int an_int);
/* Global variables exported by this module */
struct udvt_entry udv_pi = { NULL, "pi", {INTGR, {0} } };
struct udvt_entry *udv_I;
struct udvt_entry *udv_NaN;
/* first in linked list */
struct udvt_entry *first_udv = &udv_pi;
struct udft_entry *first_udf = NULL;
/* pointer to first udv users can delete */
struct udvt_entry **udv_user_head;
/* Various abnormal conditions during evaluation of an action table
* (the stored form of an expression) are signalled by setting
* undefined = TRUE.
* NB: A test for "if (undefined)" is only valid immediately
* following a call to evaluate_at() or eval_link_function().
*/
TBOOLEAN undefined;
enum int64_overflow overflow_handling = INT64_OVERFLOW_TO_FLOAT;
/* The stack this operates on */
static struct value stack[STACK_DEPTH];
static int s_p = -1; /* stack pointer */
#define top_of_stack stack[s_p]
static int jump_offset; /* to be modified by 'jump' operators */
/* The table of built-in functions */
/* These must strictly parallel enum operators in eval.h */
const struct ft_entry ft[] =
{
/* internal functions: */
{"push", f_push},
{"pushc", f_pushc},
{"pushd1", f_pushd1},
{"pushd2", f_pushd2},
{"pushd", f_pushd},
{"pop", f_pop},
{"call", f_call},
{"calln", f_calln},
{"sum", f_sum},
{"lnot", f_lnot},
{"bnot", f_bnot},
{"uminus", f_uminus},
{"nop", f_nop},
{"lor", f_lor},
{"land", f_land},
{"bor", f_bor},
{"xor", f_xor},
{"band", f_band},
{"eq", f_eq},
{"ne", f_ne},
{"gt", f_gt},
{"lt", f_lt},
{"ge", f_ge},
{"le", f_le},
{"leftshift", f_leftshift},
{"rightshift", f_rightshift},
{"plus", f_plus},
{"minus", f_minus},
{"mult", f_mult},
{"div", f_div},
{"mod", f_mod},
{"power", f_power},
{"factorial", f_factorial},
{"bool", f_bool},
{"dollars", f_dollars}, /* for usespec */
{"concatenate", f_concatenate}, /* for string variables only */
{"eqs", f_eqs}, /* for string variables only */
{"nes", f_nes}, /* for string variables only */
{"[]", f_range}, /* substring or array slice */
{"[]", f_index}, /* for array variables only */
{"||", f_cardinality}, /* for array variables only */
{"assign", f_assign}, /* assignment operator '=' */
{"eval", f_eval}, /* function block */
{"jump", f_jump},
{"jumpz", f_jumpz},
{"jumpnz", f_jumpnz},
{"jtern", f_jtern},
/* Placeholder for SF_START */
{"", NULL},
#ifdef HAVE_EXTERNAL_FUNCTIONS
{"", f_calle},
#endif
/* legal in using spec only */
{"column", f_column},
{"stringcolumn", f_stringcolumn}, /* for using specs */
{"strcol", f_stringcolumn}, /* shorthand form */
{"columnhead", f_columnhead},
{"columnheader", f_columnhead},
{"valid", f_valid},
{"timecolumn", f_timecolumn},
/* standard functions: */
{"real", f_real},
{"imag", f_imag},
{"arg", f_arg},
{"conj", f_conjg},
{"conjg", f_conjg},
{"sin", f_sin},
{"cos", f_cos},
{"tan", f_tan},
{"asin", f_asin},
{"acos", f_acos},
{"atan", f_atan},
{"atan2", f_atan2},
{"sinh", f_sinh},
{"cosh", f_cosh},
{"tanh", f_tanh},
{"EllipticK", f_ellip_first},
{"EllipticE", f_ellip_second},
{"EllipticPi", f_ellip_third},
{"int", f_int},
{"round", f_round},
{"abs", f_abs},
{"sgn", f_sgn},
{"sqrt", f_sqrt},
{"cbrt", f_cbrt},
{"exp", f_exp},
{"log10", f_log10},
{"log", f_log},
{"besi0", f_besi0},
{"besi1", f_besi1},
{"besin", f_besin},
{"besj0", f_besj0},
{"besj1", f_besj1},
{"besjn", f_besjn},
{"besy0", f_besy0},
{"besy1", f_besy1},
{"besyn", f_besyn},
{"erf", f_erf},
{"erfc", f_erfc},
{"gamma", f_gamma},
{"lgamma", f_lgamma},
{"ibeta", f_ibeta},
{"voigt", f_voigt},
{"rand", f_rand},
{"floor", f_floor},
{"ceil", f_ceil},
{"norm", f_normal},
{"inverf", f_inverse_erf},
{"invnorm", f_inverse_normal},
{"invigamma", f_inverse_igamma},
{"invibeta", f_inverse_ibeta},
{"asinh", f_asinh},
{"acosh", f_acosh},
{"atanh", f_atanh},
{"lambertw", f_lambertw}, /* HBB, from G.Kuhnle 20001107 */
{"airy", f_airy}, /* cephes library version */
#ifdef HAVE_AMOS
{"Ai", f_amos_Ai}, /* Amos version from libopenspecfun */
{"Bi", f_amos_Bi}, /* Amos version from libopenspecfun */
{"BesselI", f_amos_BesselI},/* Amos version from libopenspecfun */
{"BesselJ", f_amos_BesselJ},/* Amos version from libopenspecfun */
{"BesselK", f_amos_BesselK},/* Amos version from libopenspecfun */
{"BesselY", f_amos_BesselY},/* Amos version from libopenspecfun */
{"Hankel1", f_Hankel1}, /* Amos version from libopenspecfun */
{"Hankel2", f_Hankel2}, /* Amos version from libopenspecfun */
#endif
#ifdef HAVE_CEXINT
{"expint", f_amos_cexint}, /* Amos algorithm 683 from libamos */
#else
{"expint", f_expint}, /* Jim Van Zandt, 20101010 */
#endif
#ifdef HAVE_COMPLEX_FUNCS
{"igamma", f_Igamma}, /* Complex igamma(a,z) */
{"LambertW", f_LambertW}, /* Complex W(z,k) */
{"lnGamma", f_lnGamma}, /* Complex lnGamma(z) */
{"Sign", f_Sign}, /* Complex sign function */
{"zeta", f_zeta}, /* Riemann zeta function */
#else
{"igamma", f_igamma}, /* Jos van der Woude 1992 */
#endif
{"uigamma", f_uigamma}, /* upper incomplete gamma */
#ifdef HAVE_LIBCERF
{"cerf", f_cerf}, /* complex error function */
{"cdawson", f_cdawson}, /* complex Dawson's integral */
{"erfi", f_erfi}, /* imaginary error function */
{"VP", f_voigtp}, /* Voigt profile */
{"VP_fwhm", f_VP_fwhm}, /* Voigt profile full width at half maximum */
{"faddeeva", f_faddeeva}, /* Faddeeva rescaled complex error function "w_of_z" */
{"FresnelC", f_FresnelC}, /* Fresnel integral cosine term calculated from cerf */
{"FresnelS", f_FresnelS}, /* Fresnel integral sine term calculated from cerf */
#endif
{"SynchrotronF", f_SynchrotronF}, /* Synchrotron F */
{"tm_sec", f_tmsec}, /* time function */
{"tm_min", f_tmmin}, /* time function */
{"tm_hour", f_tmhour}, /* time function */
{"tm_mday", f_tmmday}, /* time function */
{"tm_mon", f_tmmon}, /* time function */
{"tm_year", f_tmyear}, /* time function */
{"tm_wday", f_tmwday}, /* time function */
{"tm_yday", f_tmyday}, /* time function */
{"tm_week", f_tmweek}, /* time function */
{"weekdate_iso", f_weekdate_iso},
{"weekdate_cdc", f_weekdate_cdc},
{"join", f_join}, /* create string from array */
{"sprintf", f_sprintf}, /* for string variables only */
{"gprintf", f_gprintf}, /* for string variables only */
{"strlen", f_strlen}, /* for string variables only */
{"strstrt", f_strstrt}, /* for string variables only */
{"substr", f_range}, /* for string variables only */
{"split", f_split}, /* for string variables only */
{"trim", f_trim}, /* for string variables only */
{"word", f_word}, /* for string variables only */
{"words", f_words}, /* implemented as word(s,-1) */
{"strftime", f_strftime}, /* time to string */
{"strptime", f_strptime}, /* string to time */
{"time", f_time}, /* get current time */
{"system", f_system}, /* "dynamic backtics" */
{"exist", f_exists}, /* exists("foo") replaces defined(foo) */
{"exists", f_exists}, /* exists("foo") replaces defined(foo) */
{"value", f_value}, /* retrieve value of variable known by name */
{"index", f_lookup}, /* retrieve index of array entry with known value */
{"hsv2rgb", f_hsv2rgb}, /* color conversion */
{"palette", f_palette}, /* palette color lookup */
{"rgbcolor", f_rgbcolor}, /* 32bit ARGB color lookup by name or string */
#ifdef VOXEL_GRID_SUPPORT
{"voxel", f_voxel}, /* extract value of single voxel */
#endif
{NULL, NULL}
};
/* Module-local variables: */
static JMP_BUF fpe_env;
/* Internal helper functions: */
static RETSIGTYPE
fpe(int an_int)
{
#if defined(MSDOS) && !defined(DJGPP)
/* thanks to lotto@wjh12.UUCP for telling us about this */
_fpreset();
#endif
(void) an_int; /* avoid -Wunused warning */
(void) signal(SIGFPE, (sigfunc) fpe);
undefined = TRUE;
LONGJMP(fpe_env, TRUE);
}
/* Exported functions */
/* First, some functions that help other modules use 'struct value' ---
* these might justify a separate module, but I'll stick with this,
* for now */
/* returns the real part of val */
double
real(struct value *val)
{
switch (val->type) {
case INTGR:
return ((double) val->v.int_val);
case CMPLX:
return (val->v.cmplx_val.real);
case STRING:
return (atof(val->v.string_val));
case NOTDEFINED:
return not_a_number();
default:
int_error(NO_CARET, "unknown type in real()");
}
/* NOTREACHED */
return ((double) 0.0);
}
/* returns the imag part of val */
double
imag(struct value *val)
{
switch (val->type) {
case INTGR:
return (0.0);
case CMPLX:
return (val->v.cmplx_val.imag);
case STRING:
/* This is where we end up if the user tries: */
/* x = 2; plot sprintf(format,x) */
int_warn(NO_CARET, "encountered a string when expecting a number");
int_error(NO_CARET, "Did you try to generate a file name using dummy variable x or y?");
case NOTDEFINED:
return not_a_number();
default:
int_error(NO_CARET, "unknown type in imag()");
}
/* NOTREACHED */
return ((double) 0.0);
}
/* returns the magnitude of val */
double
magnitude(struct value *val)
{
switch (val->type) {
case INTGR:
return (fabs((double)val->v.int_val));
case CMPLX:
{
/* The straightforward implementation sqrt(r*r+i*i)
* over-/underflows if either r or i is very large or very
* small. This implementation avoids over-/underflows from
* squaring large/small numbers whenever possible. It
* only over-/underflows if the correct result would, too.
* CAVEAT: sqrt(1+x*x) can still have accuracy
* problems. */
double abs_r = fabs(val->v.cmplx_val.real);
double abs_i = fabs(val->v.cmplx_val.imag);
double quotient;
if (abs_i == 0)
return abs_r;
if (abs_r > abs_i) {
quotient = abs_i / abs_r;
return abs_r * sqrt(1 + quotient*quotient);
} else {
quotient = abs_r / abs_i;
return abs_i * sqrt(1 + quotient*quotient);
}
}
default:
int_error(NO_CARET, "unknown type in magnitude()");
}
/* NOTREACHED */
return ((double) 0.0);
}
/* returns the angle of val */
double
angle(struct value *val)
{
switch (val->type) {
case INTGR:
return ((val->v.int_val >= 0) ? 0.0 : M_PI);
case CMPLX:
if (val->v.cmplx_val.imag == 0.0) {
if (val->v.cmplx_val.real >= 0.0)
return (0.0);
else
return (M_PI);
}
return (atan2(val->v.cmplx_val.imag,
val->v.cmplx_val.real));
default:
int_error(NO_CARET, "unknown type in angle()");
}
/* NOTREACHED */
return ((double) 0.0);
}
struct value *
Gcomplex(struct value *a, double realpart, double imagpart)
{
a->type = CMPLX;
a->v.cmplx_val.real = realpart;
a->v.cmplx_val.imag = imagpart;
return (a);
}
struct value *
Ginteger(struct value *a, intgr_t i)
{
a->type = INTGR;
a->v.int_val = i;
return (a);
}
struct value *
Gstring(struct value *a, char *s)
{
a->type = STRING;
a->v.string_val = s ? s : strdup("");
return (a);
}
/* The rationale for introducing this routine was that multiple call sites
* wanted to write a new value to a variable that might already have one.
* free_value() was intended to consider all possible previous value types
* and free attached memory for types that had any.
*
* Caveat: When freeing values popped from the evaluation stack,
* datablocks and permanent arrays must not be freed because these are
* calls by reference to a continuing global variable.
* So the caller must clear the type field before calling free_value.
*/
void
free_value(struct value *a)
{
switch (a->type) {
case INTGR:
case CMPLX:
break;
case STRING:
gpfree_string(a);
break;
case ARRAY:
gpfree_array(a);
break;
case DATABLOCK:
gpfree_datablock(a);
break;
case FUNCTIONBLOCK:
gpfree_functionblock(a);
break;
case VOXELGRID: /* Should not happen! */
default: /* INVALID_VALUE INVALID_NAME */
break;
}
a->type = NOTDEFINED;
}
/* It would be fatal to call gpfree_string with a->type = STRING if
* a->string_val has already been freed.
* Setting 'a->type' to NOTDEFINED makes subsequent calls safe.
*/
void
gpfree_string(struct value *a)
{
if (a->type == STRING) {
free(a->v.string_val);
a->type = NOTDEFINED;
}
}
void
gpfree_array(struct value *a)
{
int i;
int size;
if (a->type == ARRAY) {
size = a->v.value_array[0].v.int_val;
for (i=1; iv.value_array[i]));
free(a->v.value_array);
a->type = NOTDEFINED;
}
}
void
init_array( struct udvt_entry *array, int size )
{
struct value *A;
int i;
free_value(&array->udv_value);
array->udv_value.v.value_array = gp_alloc((size+1) * sizeof(t_value), "init_array");
array->udv_value.type = ARRAY;
A = array->udv_value.v.value_array;
A[0].v.int_val = size;
for (i = 0; i udv_name))
return (*udv_ptr);
udv_ptr = &((*udv_ptr)->next_udv);
}
*udv_ptr = (struct udvt_entry *)
gp_alloc(sizeof(struct udvt_entry), "value");
(*udv_ptr)->next_udv = NULL;
(*udv_ptr)->udv_name = gp_strdup(key);
(*udv_ptr)->udv_value.type = NOTDEFINED;
return (*udv_ptr);
}
struct udvt_entry *
get_udv_by_name(char *key)
{
struct udvt_entry *udv = first_udv;
while (udv) {
if (!strcmp(key, udv->udv_name))
return udv;
udv = udv->next_udv;
}
return NULL;
}
/* This doesn't really delete, it just marks the udv as undefined */
void
del_udv_by_name(char *key, TBOOLEAN wildcard)
{
struct udvt_entry *udv_ptr = *udv_user_head;
while (udv_ptr) {
/* Forbidden to delete GPVAL_* */
if (!strncmp(udv_ptr->udv_name,"GPVAL",5))
;
else if (!strncmp(udv_ptr->udv_name,"GNUTERM",7))
;
/* exact match */
else if (!wildcard && !strcmp(key, udv_ptr->udv_name)) {
if (called_from(udv_ptr->udv_name)) {
FPRINTF((stderr, "cannot self-delete %s", udv_ptr->udv_name));
break;
}
gpfree_vgrid(udv_ptr);
free_value(&(udv_ptr->udv_value));
udv_ptr->udv_value.type = NOTDEFINED;
break;
}
/* wildcard match: prefix matches */
else if ( wildcard && !strncmp(key, udv_ptr->udv_name, strlen(key)) ) {
if (called_from(udv_ptr->udv_name)) {
FPRINTF((stderr, "cannot self-delete %s", udv_ptr->udv_name));
break;
}
gpfree_vgrid(udv_ptr);
free_value(&(udv_ptr->udv_value));
udv_ptr->udv_value.type = NOTDEFINED;
/* no break - keep looking! */
}
udv_ptr = udv_ptr->next_udv;
}
}
#ifdef USE_WATCHPOINTS
struct udft_entry *
get_udf_by_token(int t_num)
{
struct udft_entry **udf_ptr = &first_udf;
while (*udf_ptr) {
if (equals(t_num, (*udf_ptr)->udf_name))
return *udf_ptr;
udf_ptr = &((*udf_ptr)->next_udf);
}
return NULL;
}
#endif
/* Clear (delete) all user defined functions */
void
clear_udf_list()
{
struct udft_entry *udf_ptr = first_udf;
struct udft_entry *udf_next;
while (udf_ptr) {
free(udf_ptr->udf_name);
free(udf_ptr->definition);
free_at(udf_ptr->at);
udf_next = udf_ptr->next_udf;
free(udf_ptr);
udf_ptr = udf_next;
}
first_udf = NULL;
}
static void update_plot_bounds(void);
static void fill_gpval_axis(AXIS_INDEX axis);
static void fill_gpval_sysinfo(void);
static void set_gpval_axis_sth_double(const char *prefix, AXIS_INDEX axis, const char *suffix, double value);
static void
set_gpval_axis_sth_double(const char *prefix, AXIS_INDEX axis, const char *suffix, double value)
{
struct udvt_entry *v;
char *cc, s[24];
sprintf(s, "%s_%s_%s", prefix, axis_name(axis), suffix);
for (cc=s; *cc; cc++)
*cc = toupper((unsigned char)*cc); /* make the name uppercase */
v = add_udv_by_name(s);
if (!v)
return; /* should not happen */
Gcomplex(&v->udv_value, value, 0);
}
static void
fill_gpval_axis(AXIS_INDEX axis)
{
const char *prefix = "GPVAL";
AXIS *ap = &axis_array[axis];
set_gpval_axis_sth_double(prefix, axis, "MIN", ap->min);
set_gpval_axis_sth_double(prefix, axis, "MAX", ap->max);
set_gpval_axis_sth_double(prefix, axis, "LOG", ap->base);
if (axis < POLAR_AXIS) {
set_gpval_axis_sth_double("GPVAL_DATA", axis, "MIN", ap->data_min);
set_gpval_axis_sth_double("GPVAL_DATA", axis, "MAX", ap->data_max);
}
}
/* Fill variable "var" visible by "show var" or "show var all" ("GPVAL_*")
* by the given value (string, integer, float, complex).
*/
void
fill_gpval_string(char *var, const char *stringvalue)
{
struct udvt_entry *v = add_udv_by_name(var);
if (!v)
return;
if (v->udv_value.type == STRING && !strcmp(v->udv_value.v.string_val, stringvalue))
return;
else
gpfree_string(&v->udv_value);
Gstring(&v->udv_value, gp_strdup(stringvalue));
}
void
fill_gpval_integer(char *var, intgr_t value)
{
struct udvt_entry *v = add_udv_by_name(var);
if (!v)
return;
Ginteger(&v->udv_value, value);
}
void
fill_gpval_float(char *var, double value)
{
struct udvt_entry *v = add_udv_by_name(var);
if (!v)
return;
Gcomplex(&v->udv_value, value, 0);
}
void
fill_gpval_complex(char *var, double areal, double aimag)
{
struct udvt_entry *v = add_udv_by_name(var);
if (!v)
return;
Gcomplex(&v->udv_value, areal, aimag);
}
/*
* Export axis bounds in terminal coordinates from previous plot.
* This allows offline mapping of pixel coordinates onto plot coordinates.
*/
static void
update_plot_bounds(void)
{
fill_gpval_float("GPVAL_TERM_XMIN", (double)axis_array[FIRST_X_AXIS].term_lower / term->tscale);
fill_gpval_float("GPVAL_TERM_XMAX", (double)axis_array[FIRST_X_AXIS].term_upper / term->tscale);
fill_gpval_float("GPVAL_TERM_YMIN", (double)axis_array[FIRST_Y_AXIS].term_lower / term->tscale);
fill_gpval_float("GPVAL_TERM_YMAX", (double)axis_array[FIRST_Y_AXIS].term_upper / term->tscale);
fill_gpval_integer("GPVAL_TERM_XSIZE", canvas.xright+1);
fill_gpval_integer("GPVAL_TERM_YSIZE", canvas.ytop+1);
fill_gpval_integer("GPVAL_TERM_SCALE", term->tscale);
/* May be useful for debugging font problems */
fill_gpval_integer("GPVAL_TERM_HCHAR", term->h_char);
fill_gpval_integer("GPVAL_TERM_VCHAR", term->v_char);
}
/*
* Put all the handling for GPVAL_* variables in this one routine.
* We call it from one of several contexts:
* 0: following a successful set/unset command
* 1: following a successful plot/splot
* 2: following an unsuccessful command (int_error)
* 3: program entry
* 4: explicit reset of error status
* 5: directory changed
* 6: X11 Window ID changed
*/
void
update_gpval_variables(int context)
{
/* These values may change during a plot command due to auto range */
if (context == 1) {
fill_gpval_axis(FIRST_X_AXIS);
fill_gpval_axis(FIRST_Y_AXIS);
fill_gpval_axis(SECOND_X_AXIS);
fill_gpval_axis(SECOND_Y_AXIS);
fill_gpval_axis(FIRST_Z_AXIS);
fill_gpval_axis(COLOR_AXIS);
fill_gpval_axis(T_AXIS);
fill_gpval_axis(U_AXIS);
fill_gpval_axis(V_AXIS);
fill_gpval_float("GPVAL_R_MIN", R_AXIS.min);
fill_gpval_float("GPVAL_R_MAX", R_AXIS.max);
fill_gpval_float("GPVAL_R_LOG", R_AXIS.base);
update_plot_bounds();
fill_gpval_integer("GPVAL_PLOT", is_3d_plot ? 0:1);
fill_gpval_integer("GPVAL_SPLOT", is_3d_plot ? 1:0);
fill_gpval_integer("GPVAL_VIEW_MAP", splot_map ? 1:0);
fill_gpval_float("GPVAL_VIEW_ROT_X", surface_rot_x);
fill_gpval_float("GPVAL_VIEW_ROT_Z", surface_rot_z);
fill_gpval_float("GPVAL_VIEW_SCALE", surface_scale);
fill_gpval_float("GPVAL_VIEW_ZSCALE", surface_zscale);
fill_gpval_float("GPVAL_VIEW_AZIMUTH", azimuth);
/* Screen coordinates of 3D rotational center and radius of the sphere */
/* in which x/y axes are drawn after 'set view equal xy[z]' */
fill_gpval_float("GPVAL_VIEW_XCENT",
(double)(canvas.xright+1 - xmiddle)/(double)(canvas.xright+1));
fill_gpval_float("GPVAL_VIEW_YCENT",
1.0 - (double)(canvas.ytop+1 - ymiddle)/(double)(canvas.ytop+1));
fill_gpval_float("GPVAL_VIEW_RADIUS",
0.5 * surface_scale * xscaler/(double)(canvas.xright+1));
return;
}
/* These are set after every "set" command, which is kind of silly */
/* because they only change after 'set term' 'set output' ... */
if (context == 0 || context == 2 || context == 3) {
/* This prevents a segfault if term==NULL, which can */
/* happen if set_terminal() exits via int_error(). */
if (!term)
fill_gpval_string("GPVAL_TERM", "unknown");
else
fill_gpval_string("GPVAL_TERM", (char *)(term->name));
fill_gpval_string("GPVAL_TERMOPTIONS", term_options);
fill_gpval_string("GPVAL_OUTPUT", (outstr) ? outstr : "");
fill_gpval_string("GPVAL_ENCODING", encoding_names[encoding]);
fill_gpval_string("GPVAL_MINUS_SIGN", minus_sign ? minus_sign : "-");
fill_gpval_string("GPVAL_MICRO", micro ? micro : "u");
fill_gpval_string("GPVAL_DEGREE_SIGN", degree_sign);
}
/* If we are called from int_error() then set the error state */
if (context == 2)
fill_gpval_integer("GPVAL_ERRNO", 1);
/* These initializations need only be done once, on program entry */
if (context == 3) {
struct udvt_entry *v = add_udv_by_name("GPVAL_VERSION");
char *tmp;
if (v && v->udv_value.type == NOTDEFINED)
Gcomplex(&v->udv_value, atof(gnuplot_version), 0);
v = add_udv_by_name("GPVAL_PATCHLEVEL");
if (v && v->udv_value.type == NOTDEFINED)
fill_gpval_string("GPVAL_PATCHLEVEL", gnuplot_patchlevel);
v = add_udv_by_name("GPVAL_COMPILE_OPTIONS");
if (v && v->udv_value.type == NOTDEFINED)
fill_gpval_string("GPVAL_COMPILE_OPTIONS", compile_options);
/* Start-up values */
fill_gpval_integer("GPVAL_MULTIPLOT", 0);
fill_gpval_integer("GPVAL_PLOT", 0);
fill_gpval_integer("GPVAL_SPLOT", 0);
tmp = get_terminals_names();
fill_gpval_string("GPVAL_TERMINALS", tmp);
free(tmp);
fill_gpval_string("GPVAL_ENCODING", encoding_names[encoding]);
/* Permanent copy of user-clobberable variables pi and NaN */
fill_gpval_float("GPVAL_pi", M_PI);
fill_gpval_float("GPVAL_NaN", not_a_number());
/* System information */
fill_gpval_sysinfo();
}
if (context == 3 || context == 4) {
fill_gpval_integer("GPVAL_ERRNO", 0);
fill_gpval_string("GPVAL_ERRMSG","");
fill_gpval_integer("GPVAL_SYSTEM_ERRNO", 0);
fill_gpval_string("GPVAL_SYSTEM_ERRMSG","");
}
/* GPVAL_PWD is unreliable. If the current directory becomes invalid,
* GPVAL_PWD does not reflect this. If this matters, the user can
* instead do something like MY_PWD = "`pwd`"
*/
if (context == 3 || context == 5) {
char *save_file = gp_alloc(PATH_MAX, "GPVAL_PWD");
int ierror = (GP_GETCWD(save_file, PATH_MAX) == NULL);
fill_gpval_string("GPVAL_PWD", ierror ? "" : save_file);
free(save_file);
}
if (context == 6) {
fill_gpval_integer("GPVAL_TERM_WINDOWID", current_x11_windowid);
}
}
/* System information is stored in GPVAL_BITS GPVAL_MACHINE GPVAL_SYSNAME */
#ifdef HAVE_UNAME
# include
#elif defined(_WIN32)
# include
#endif
void
fill_gpval_sysinfo()
{
/* For linux/posix systems with uname */
#ifdef HAVE_UNAME
struct utsname uts;
if (uname(&uts) < 0)
return;
fill_gpval_string("GPVAL_SYSNAME", uts.sysname);
fill_gpval_string("GPVAL_MACHINE", uts.machine);
/* For Windows systems */
#elif defined(_WIN32)
SYSTEM_INFO stInfo;
OSVERSIONINFO osvi;
char s[30];
ZeroMemory(&osvi, sizeof(OSVERSIONINFO));
osvi.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
GetVersionEx(&osvi);
snprintf(s, 30, "Windows_NT-%ld.%ld", osvi.dwMajorVersion, osvi.dwMinorVersion);
fill_gpval_string("GPVAL_SYSNAME", s);
GetSystemInfo(&stInfo);
switch (stInfo.wProcessorArchitecture)
{
case PROCESSOR_ARCHITECTURE_INTEL:
fill_gpval_string("GPVAL_MACHINE", "x86");
break;
case PROCESSOR_ARCHITECTURE_IA64:
fill_gpval_string("GPVAL_MACHINE", "ia64");
break;
case PROCESSOR_ARCHITECTURE_AMD64:
fill_gpval_string("GPVAL_MACHINE", "x86_64");
break;
default:
fill_gpval_string("GPVAL_MACHINE", "unknown");
}
#endif
/* For all systems */
fill_gpval_integer("GPVAL_BITS", 8 * sizeof(void *));
}
/* Callable wrapper for the words() internal function */
int
gp_words(char *string)
{
struct value a;
push(Gstring(&a, string));
f_words((union argument *)NULL);
pop(&a);
return a.v.int_val;
}
/* Callable wrapper for the word() internal function */
char *
gp_word(char *string, int i)
{
struct value a;
push(Gstring(&a, string));
push(Ginteger(&a, (intgr_t)i));
f_word((union argument *)NULL);
pop(&a);
return a.v.string_val;
}
/* New (version 5.5)
* The evaluation stack can now return an ARRAY value, but in order to do so
* without memory leaks or corruption it must make sure that the allocated
* content is distinct from the original content.
* I.e. {array A = ["foo"]; B = A; A = 0;} must leave a valid copy of "foo" in B[1].
*/
void
make_array_permanent(struct value *array)
{
struct value *copy;
int i, size;
/* If this array was generated by the evaluation stack it is safe to use
* but the temporary flag must be cleared.
*/
if (array->v.value_array[0].type == TEMP_ARRAY) {
array->v.value_array[0].type = NOTDEFINED;
return;
}
/* If it was a pre-existing array (no temporary flag) then we must make
* a clean copy of the whole thing.
*/
size = array->v.value_array[0].v.int_val;
copy = gp_alloc( (size+1) * sizeof(struct value), "array copy");
memcpy( copy, array->v.value_array, (size+1) * sizeof(struct value) );
for (i=0; iv.value_array = copy;
}
/* Extract a portion of the array full[N] into a new array slice[M]
* where M v.value_array;
struct value *slice;
int i,j;
/* Sanity checks */
if (beg < 1)
beg = 1;
if (end > array[0].v.int_val)
end = array[0].v.int_val;
if (end < beg)
beg = 1, end = 0;
slice = gp_alloc( (2 + end - beg) * sizeof(struct value), "array slice" );
slice[0].type = TEMP_ARRAY;
slice[0].v.int_val = 1 + end - beg;
for (i = beg, j = 1; i