#ifndef lint
static char *RCSid() { return RCSid("$Id: internal.c,v 1.51 2008/09/25 18:33:50 sfeam Exp $"); }
#endif
/* GNUPLOT - internal.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 "internal.h"
#include "stdfn.h"
#include "alloc.h"
#include "util.h" /* for int_error() */
# include "gp_time.h" /* for str(p|f)time */
#include "command.h" /* for do_system_func */
#include "variable.h" /* For locale handling */
#include
/*
* Excerpt from the Solaris man page for matherr():
*
* The The System V Interface Definition, Third Edition (SVID3)
* specifies that certain libm functions call matherr() when
* exceptions are detected. Users may define their own mechan-
* isms for handling exceptions, by including a function named
* matherr() in their programs.
*/
static enum DATA_TYPES sprintf_specifier __PROTO((const char *format));
int
GP_MATHERR( STRUCT_EXCEPTION_P_X )
{
return (undefined = TRUE); /* don't print error message */
}
#define BAD_DEFAULT default: int_error(NO_CARET, "internal error : type neither INT or CMPLX"); return;
void
f_push(union argument *x)
{
struct udvt_entry *udv;
udv = x->udv_arg;
if (udv->udv_undef) { /* undefined */
int_error(NO_CARET, "undefined variable: %s", udv->udv_name);
}
push(&(udv->udv_value));
}
void
f_pushc(union argument *x)
{
push(&(x->v_arg));
}
void
f_pushd1(union argument *x)
{
push(&(x->udf_arg->dummy_values[0]));
}
void
f_pop(union argument *x)
{
struct value dummy;
pop(&dummy);
gpfree_string(&dummy);
}
void
f_pushd2(union argument *x)
{
push(&(x->udf_arg->dummy_values[1]));
}
void
f_pushd(union argument *x)
{
struct value param;
(void) pop(¶m);
push(&(x->udf_arg->dummy_values[param.v.int_val]));
}
/* execute a udf */
void
f_call(union argument *x)
{
struct udft_entry *udf;
struct value save_dummy;
udf = x->udf_arg;
if (!udf->at) { /* undefined */
int_error(NO_CARET, "undefined function: %s", udf->udf_name);
}
save_dummy = udf->dummy_values[0];
(void) pop(&(udf->dummy_values[0]));
if (udf->dummy_num != 1)
int_error(NO_CARET, "function %s requires %d variables", udf->udf_name, udf->dummy_num);
execute_at(udf->at);
gpfree_string(&udf->dummy_values[0]);
udf->dummy_values[0] = save_dummy;
}
/* execute a udf of n variables */
void
f_calln(union argument *x)
{
struct udft_entry *udf;
struct value save_dummy[MAX_NUM_VAR];
int i;
int num_pop;
struct value num_params;
udf = x->udf_arg;
if (!udf->at) /* undefined */
int_error(NO_CARET, "undefined function: %s", udf->udf_name);
for (i = 0; i < MAX_NUM_VAR; i++)
save_dummy[i] = udf->dummy_values[i];
(void) pop(&num_params);
if (num_params.v.int_val != udf->dummy_num)
int_error(NO_CARET, "function %s requires %d variable%c",
udf->udf_name, udf->dummy_num, (udf->dummy_num == 1)?'\0':'s');
/* if there are more parameters than the function is expecting */
/* simply ignore the excess */
if (num_params.v.int_val > MAX_NUM_VAR) {
/* pop and discard the dummies that there is no room for */
num_pop = num_params.v.int_val - MAX_NUM_VAR;
for (i = 0; i < num_pop; i++)
(void) pop(&(udf->dummy_values[0]));
num_pop = MAX_NUM_VAR;
} else {
num_pop = num_params.v.int_val;
}
/* pop parameters we can use */
for (i = num_pop - 1; i >= 0; i--)
(void) pop(&(udf->dummy_values[i]));
execute_at(udf->at);
for (i = 0; i < MAX_NUM_VAR; i++) {
gpfree_string(&udf->dummy_values[i]);
udf->dummy_values[i] = save_dummy[i];
}
}
void
f_lnot(union argument *arg)
{
struct value a;
(void) arg; /* avoid -Wunused warning */
int_check(pop(&a));
push(Ginteger(&a, !a.v.int_val));
}
void
f_bnot(union argument *arg)
{
struct value a;
(void) arg; /* avoid -Wunused warning */
int_check(pop(&a));
push(Ginteger(&a, ~a.v.int_val));
}
void
f_lor(union argument *arg)
{
struct value a, b;
(void) arg; /* avoid -Wunused warning */
int_check(pop(&b));
int_check(pop(&a));
push(Ginteger(&a, a.v.int_val || b.v.int_val));
}
void
f_land(union argument *arg)
{
struct value a, b;
(void) arg; /* avoid -Wunused warning */
int_check(pop(&b));
int_check(pop(&a));
push(Ginteger(&a, a.v.int_val && b.v.int_val));
}
void
f_bor(union argument *arg)
{
struct value a, b;
(void) arg; /* avoid -Wunused warning */
int_check(pop(&b));
int_check(pop(&a));
push(Ginteger(&a, a.v.int_val | b.v.int_val));
}
void
f_xor(union argument *arg)
{
struct value a, b;
(void) arg; /* avoid -Wunused warning */
int_check(pop(&b));
int_check(pop(&a));
push(Ginteger(&a, a.v.int_val ^ b.v.int_val));
}
void
f_band(union argument *arg)
{
struct value a, b;
(void) arg; /* avoid -Wunused warning */
int_check(pop(&b));
int_check(pop(&a));
push(Ginteger(&a, a.v.int_val & b.v.int_val));
}
/*
* Make all the following internal routines perform autoconversion
* from string to numeric value.
*/
#define pop(x) pop_or_convert_from_string(x)
void
f_uminus(union argument *arg)
{
struct value a;
(void) arg; /* avoid -Wunused warning */
(void) pop(&a);
switch (a.type) {
case INTGR:
a.v.int_val = -a.v.int_val;
break;
case CMPLX:
a.v.cmplx_val.real =
-a.v.cmplx_val.real;
a.v.cmplx_val.imag =
-a.v.cmplx_val.imag;
break;
BAD_DEFAULT
}
push(&a);
}
void
f_eq(union argument *arg)
{
/* note: floating point equality is rare because of roundoff error! */
struct value a, b;
int result = 0;
(void) arg; /* avoid -Wunused warning */
(void) pop(&b);
(void) pop(&a);
switch (a.type) {
case INTGR:
switch (b.type) {
case INTGR:
result = (a.v.int_val ==
b.v.int_val);
break;
case CMPLX:
result = (a.v.int_val ==
b.v.cmplx_val.real &&
b.v.cmplx_val.imag == 0.0);
break;
BAD_DEFAULT
}
break;
case CMPLX:
switch (b.type) {
case INTGR:
result = (b.v.int_val == a.v.cmplx_val.real &&
a.v.cmplx_val.imag == 0.0);
break;
case CMPLX:
result = (a.v.cmplx_val.real ==
b.v.cmplx_val.real &&
a.v.cmplx_val.imag ==
b.v.cmplx_val.imag);
break;
BAD_DEFAULT
}
break;
BAD_DEFAULT
}
push(Ginteger(&a, result));
}
void
f_ne(union argument *arg)
{
struct value a, b;
int result = 0;
(void) arg; /* avoid -Wunused warning */
(void) pop(&b);
(void) pop(&a);
switch (a.type) {
case INTGR:
switch (b.type) {
case INTGR:
result = (a.v.int_val !=
b.v.int_val);
break;
case CMPLX:
result = (a.v.int_val !=
b.v.cmplx_val.real ||
b.v.cmplx_val.imag != 0.0);
break;
BAD_DEFAULT
}
break;
case CMPLX:
switch (b.type) {
case INTGR:
result = (b.v.int_val !=
a.v.cmplx_val.real ||
a.v.cmplx_val.imag != 0.0);
break;
case CMPLX:
result = (a.v.cmplx_val.real !=
b.v.cmplx_val.real ||
a.v.cmplx_val.imag !=
b.v.cmplx_val.imag);
break;
BAD_DEFAULT
}
break;
BAD_DEFAULT
}
push(Ginteger(&a, result));
}
void
f_gt(union argument *arg)
{
struct value a, b;
int result = 0;
(void) arg; /* avoid -Wunused warning */
(void) pop(&b);
(void) pop(&a);
switch (a.type) {
case INTGR:
switch (b.type) {
case INTGR:
result = (a.v.int_val >
b.v.int_val);
break;
case CMPLX:
result = (a.v.int_val >
b.v.cmplx_val.real);
break;
BAD_DEFAULT
}
break;
case CMPLX:
switch (b.type) {
case INTGR:
result = (a.v.cmplx_val.real >
b.v.int_val);
break;
case CMPLX:
result = (a.v.cmplx_val.real >
b.v.cmplx_val.real);
break;
BAD_DEFAULT
}
break;
BAD_DEFAULT
}
push(Ginteger(&a, result));
}
void
f_lt(union argument *arg)
{
struct value a, b;
int result = 0;
(void) arg; /* avoid -Wunused warning */
(void) pop(&b);
(void) pop(&a);
switch (a.type) {
case INTGR:
switch (b.type) {
case INTGR:
result = (a.v.int_val <
b.v.int_val);
break;
case CMPLX:
result = (a.v.int_val <
b.v.cmplx_val.real);
break;
BAD_DEFAULT
}
break;
case CMPLX:
switch (b.type) {
case INTGR:
result = (a.v.cmplx_val.real <
b.v.int_val);
break;
case CMPLX:
result = (a.v.cmplx_val.real <
b.v.cmplx_val.real);
break;
BAD_DEFAULT
}
break;
BAD_DEFAULT
}
push(Ginteger(&a, result));
}
void
f_ge(union argument *arg)
{
struct value a, b;
int result = 0;
(void) arg; /* avoid -Wunused warning */
(void) pop(&b);
(void) pop(&a);
switch (a.type) {
case INTGR:
switch (b.type) {
case INTGR:
result = (a.v.int_val >=
b.v.int_val);
break;
case CMPLX:
result = (a.v.int_val >=
b.v.cmplx_val.real);
break;
BAD_DEFAULT
}
break;
case CMPLX:
switch (b.type) {
case INTGR:
result = (a.v.cmplx_val.real >=
b.v.int_val);
break;
case CMPLX:
result = (a.v.cmplx_val.real >=
b.v.cmplx_val.real);
break;
BAD_DEFAULT
}
break;
BAD_DEFAULT
}
push(Ginteger(&a, result));
}
void
f_le(union argument *arg)
{
struct value a, b;
int result = 0;
(void) arg; /* avoid -Wunused warning */
(void) pop(&b);
(void) pop(&a);
switch (a.type) {
case INTGR:
switch (b.type) {
case INTGR:
result = (a.v.int_val 0 && next_start[0] && next_start[1]) {
struct value *next_param = &args[remaining];
/* Check for %%; print as literal and don't consume a parameter */
if (!strncmp(next_start,"%%",2)) {
next_start++;
do {
*outpos++ = *next_start++;
} while(*next_start && *next_start != '%');
remaining++;
continue;
}
next_length = strcspn(next_start+1,"%") + 1;
tempchar = next_start[next_length];
next_start[next_length] = '\0';
spec_type = sprintf_specifier(next_start);
/* string value numerical value check */
if ( spec_type == STRING && next_param->type != STRING )
int_error(NO_CARET,"f_sprintf: attempt to print numeric value with string format");
if ( spec_type != STRING && next_param->type == STRING )
int_error(NO_CARET,"f_sprintf: attempt to print string value with numeric format");
#ifdef HAVE_SNPRINTF
/* Use the format to print next arg */
switch(spec_type) {
case INTGR:
snprintf(outpos,bufsize-(outpos-buffer),
next_start, (int)real(next_param));
break;
case CMPLX:
snprintf(outpos,bufsize-(outpos-buffer),
next_start, real(next_param));
break;
case STRING:
snprintf(outpos,bufsize-(outpos-buffer),
next_start, next_param->v.string_val);
break;
default:
int_error(NO_CARET,"internal error: invalid spec_type");
}
#else
/* FIXME - this is bad; we should dummy up an snprintf equivalent */
switch(spec_type) {
case INTGR:
sprintf(outpos, next_start, (int)real(next_param));
break;
case CMPLX:
sprintf(outpos, next_start, real(next_param));
break;
case STRING:
sprintf(outpos, next_start, next_param->v.string_val);
break;
default:
int_error(NO_CARET,"internal error: invalid spec_type");
}
#endif
next_start[next_length] = tempchar;
next_start += next_length;
outpos = &buffer[strlen(buffer)];
/* Check whether previous parameter output hit the end of the buffer */
/* If so, reallocate a larger buffer, go back and try it again. */
if (strlen(buffer) >= bufsize-2) {
bufsize *= 2;
buffer = gp_realloc(buffer, bufsize, "f_sprintf");
next_start = prev_start;
outpos = buffer + prev_pos;
remaining++;
continue;
} else {
prev_start = next_start;
prev_pos = outpos - buffer;
}
}
/* Copy the trailing portion of the format, if any */
/* We could just call snprintf(), but it doesn't check for */
/* whether there really are more variables to handle. */
i = bufsize - (outpos-buffer);
while (*next_start && --i > 0) {
if (*next_start == '%' && *(next_start+1) == '%')
next_start++;
*outpos++ = *next_start++;
}
*outpos = '\0';
FPRINTF((stderr," snprintf result = \"%s\"\n",buffer));
push(Gstring(&result, buffer));
free(buffer);
/* Free any strings from parameters we have now used */
for (i=0; i= buflen)
int_error(NO_CARET, "Resulting string is too long");
/* Remove trailing space */
assert(buffer[length-1] == ' ');
buffer[length-1] = NUL;
gpfree_string(&val);
gpfree_string(&fmt);
free(fmtstr);
push(Gstring(&val, buffer));
free(buffer);
}
/* Convert string into seconds from year 2000 */
void
f_strptime(union argument *arg)
{
struct value fmt, val;
struct tm time_tm;
double result;
(void) arg; /* Avoid compiler warnings */
pop(&val);
pop(&fmt);
if ( fmt.type != STRING || val.type != STRING )
int_error(NO_CARET,
"Both parameters to strptime must be strings");
if ( !fmt.v.string_val || !val.v.string_val )
int_error(NO_CARET, "Internal error: string not allocated");
/* string -> time_tm */
gstrptime(val.v.string_val, fmt.v.string_val, &time_tm);
/* time_tm -> result */
result = gtimegm(&time_tm);
FPRINTF((stderr," strptime result = %g seconds \n", result));
gpfree_string(&val);
gpfree_string(&fmt);
push(Gcomplex(&val, result, 0.0));
}
/* Return which argument type sprintf will need for this format string:
* char* STRING
* int INTGR
* double CMPLX
* Should call int_err for any other type.
* format is expected to start with '%'
*/
static enum DATA_TYPES
sprintf_specifier(const char* format)
{
const char string_spec[] = "s";
const char real_spec[] = "aAeEfFgG";
const char int_spec[] = "cdiouxX";
/* The following characters are used for use of invalid types */
const char illegal_spec[] = "hlLqjzZtCSpn";
int string_pos, real_pos, int_pos, illegal_pos;
/* check if really format specifier */
if (format[0] != '%')
int_error(NO_CARET,
"internal error: sprintf_specifier called without '%'\n");
string_pos = strcspn(format, string_spec);
real_pos = strcspn(format, real_spec);
int_pos = strcspn(format, int_spec);
illegal_pos = strcspn(format, illegal_spec);
if ( illegal_pos < int_pos && illegal_pos < real_pos
&& illegal_pos < string_pos )
int_error(NO_CARET,
"sprintf_specifier: used with invalid format specifier\n");
else if ( string_pos < real_pos && string_pos < int_pos )
return STRING;
else if ( real_pos < int_pos )
return CMPLX;
else if ( int_pos < strlen(format) )
return INTGR;
else
int_error(NO_CARET,
"sprintf_specifier: no format specifier\n");
return INTGR; /* Can't happen, but the compiler doesn't realize that */
}
/* execute a system call and return stream from STDOUT */
void
f_system(union argument *arg)
{
struct value val, result;
struct udvt_entry *errno_var;
char *output;
int output_len, ierr;
/* Retrieve parameters from top of stack */
pop(&val);
/* Make sure parameters are of the correct type */
if (val.type != STRING)
int_error(NO_CARET, "non-string argument to system()");
FPRINTF((stderr," f_system input = \"%s\"\n", val.v.string_val));
ierr = do_system_func(val.v.string_val, &output);
if ((errno_var = add_udv_by_name("ERRNO"))) {
errno_var->udv_undef = FALSE;
Ginteger(&errno_var->udv_value, ierr);
}
output_len = strlen(output);
/* chomp result */
if ( output_len > 0 && output[output_len-1] == '\n' )
output[output_len-1] = NUL;
FPRINTF((stderr," f_system result = \"%s\"\n", output));
push(Gstring(&result, output));
gpfree_string(&result); /* free output */
gpfree_string(&val); /* free command string */
}
/* Variable assignment operator */
void
f_assign(union argument *arg)
{
struct value a, b;
(void) arg;
(void) pop(&b); /* new value */
(void) pop(&a); /* name of variable */
if (a.type == STRING) {
struct udvt_entry *udv;
if (!strncmp(a.v.string_val,"GPVAL_",6) || !strncmp(a.v.string_val,"MOUSE_",6))
int_error(NO_CARET,"Attempt to assign to a read-only variable");
udv = add_udv_by_name(a.v.string_val);
gpfree_string(&a);
if (!udv->udv_undef)
gpfree_string(&(udv->udv_value));
udv->udv_value = b;
udv->udv_undef = FALSE;
push(&b);
} else {
int_error(NO_CARET, "attempt to assign to something other than a named variable");
}
}