/*
* f_range() handles both explicit calls to substr(string, beg, end)
* and the short form string[beg:end]. The calls to gp_strlen() and
* gp_strchrn() allow it to handle utf8 strings.
*/
void
f_range(union argument *arg)
{
struct value beg, end, full;
struct value substr;
(void) arg; /* avoid -Wunused warning */
(void) pop(&end);
(void) pop(&beg);
(void) pop(&full);
if (end.type != INTGR || beg.type != INTGR)
int_error(NO_CARET, "internal error: substring range specifiers must have integer values");
if (full.type != STRING)
int_error(NO_CARET, "internal error: substring range operator applied to non-STRING type");
FPRINTF((stderr,"f_range( \"%s\", %d, %d)\n", full.v.string_val, beg.v.int_val, end.v.int_val));
if (end.v.int_val > gp_strlen(full.v.string_val))
end.v.int_val = gp_strlen(full.v.string_val);
if (beg.v.int_val < 1)
beg.v.int_val = 1;
if (beg.v.int_val > end.v.int_val) {
push(Gstring(&substr, ""));
} else {
char *begp = gp_strchrn(full.v.string_val,beg.v.int_val-1);
char *endp = gp_strchrn(full.v.string_val,end.v.int_val);
*endp = '\0';
push(Gstring(&substr, begp));
}
gpfree_string(&full);
}
void
f_concatenate(union argument *arg)
{
struct value a, b, result;
(void) arg; /* avoid -Wunused warning */
(void) pop(&b);
(void) pop(&a);
if (b.type == INTGR) {
int i = b.v.int_val;
b.type = STRING;
b.v.string_val = (char *)gp_alloc(32,"str_const");
#ifdef HAVE_SNPRINTF
snprintf(b.v.string_val,32,"%d",i);
#else
sprintf(b.v.string_val,"%d",i);
#endif
}
if (a.type != STRING || b.type != STRING)
int_error(NO_CARET, "internal error : STRING operator applied to non-STRING type");
(void) Gstring(&result, gp_stradd(a.v.string_val, b.v.string_val));
gpfree_string(&a);
gpfree_string(&b);
push(&result);
gpfree_string(&result); /* free string allocated within gp_stradd() */
}
/* 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 */
}
/* Look for an iterate-over-plot construct, of the form
* {s}plot for [<var> = <start> : <end> { : <increment>}] ...
*/
void
check_for_iteration()
{
char *errormsg = "Expecting iterator \tfor [<var> = <start> : <end>]\n\t\t\tor\tfor [<var> in \"string of words\"]";
iteration_udv = NULL;
free(iteration_string);
iteration_string = NULL;
iteration_increment = 1;
iteration = 0;
if (!equals(c_token, "for"))
return;
c_token++;
if (!equals(c_token++, "[") || !isletter(c_token))
int_error(c_token-1, errormsg);
iteration_udv = add_udv(c_token++);
if (equals(c_token, "=")) {
c_token++;
iteration_start = int_expression();
if (!equals(c_token++, ":"))
int_error(c_token-1, errormsg);
iteration_end = int_expression();
if (equals(c_token,":")) {
c_token++;
iteration_increment = int_expression();
}
if (!equals(c_token++, "]"))
int_error(c_token-1, errormsg);
if (iteration_udv->udv_undef == FALSE)
gpfree_string(&iteration_udv->udv_value);
Ginteger(&(iteration_udv->udv_value), iteration_start);
iteration_udv->udv_undef = FALSE;
}
else if (equals(c_token++, "in")) {
iteration_string = try_to_get_string();
if (!iteration_string)
int_error(c_token-1, errormsg);
if (!equals(c_token++, "]"))
int_error(c_token-1, errormsg);
iteration_start = 1;
iteration_end = gp_words(iteration_string);
if (iteration_udv->udv_undef == FALSE)
gpfree_string(&iteration_udv->udv_value);
Gstring(&(iteration_udv->udv_value), gp_word(iteration_string, 1));
iteration_udv->udv_undef = FALSE;
}
else /* Neither [i=B:E] or [s in "foo"] */
int_error(c_token-1, errormsg);
iteration_current = iteration_start;
}
void
f_words(union argument *arg)
{
struct value a, b, result;
int nwords = 0;
int ntarget;
char *s;
(void) arg;
if (pop(&b)->type != INTGR)
int_error(NO_CARET, "internal error : non-INTGR argument");
ntarget = b.v.int_val;
if (pop(&a)->type != STRING)
int_error(NO_CARET, "internal error : non-STRING argument");
s = a.v.string_val;
Gstring(&result, "");
while (*s) {
while (isspace(*s)) s++;
if (!*s)
break;
nwords++;
if (nwords == ntarget) { /* Found the one we wanted */
Gstring(&result,s);
s = result.v.string_val;
}
while (*s && !isspace(*s)) s++;
if (nwords == ntarget) { /* Terminate this word cleanly */
*s = '\0';
break;
}
}
if (ntarget < 0)
/* words(s) = word(s,-1) = # of words in string */
Ginteger(&result, nwords);
push(&result);
gpfree_string(&a);
}
/* Output time given in seconds from year 2000 into string */
void
f_strftime(union argument *arg)
{
struct value fmt, val;
char *fmtstr, *buffer;
int fmtlen, buflen, length;
(void) arg; /* Avoid compiler warnings */
/* Retrieve parameters from top of stack */
pop(&val);
pop(&fmt);
if ( fmt.type != STRING )
int_error(NO_CARET,
"First parameter to strftime must be a format string");
/* Prepare format string.
* Make sure the resulting string not empty by adding a space.
* Otherwise, the return value of gstrftime doesn't give enough
* information.
*/
fmtlen = strlen(fmt.v.string_val) + 1;
fmtstr = gp_alloc(fmtlen + 1, "f_strftime: fmt");
strncpy(fmtstr, fmt.v.string_val, fmtlen);
strncat(fmtstr, " ", fmtlen);
buflen = 80 + 2*fmtlen;
buffer = gp_alloc(buflen, "f_strftime: buffer");
/* Get time_str */
length = gstrftime(buffer, buflen, fmtstr, real(&val));
if (length == 0 || length >= buflen)
int_error(NO_CARET, "Resulting string is too long");
/* Remove trailing space */
assert(buffer[length-1] == ' ');
buffer[length-1] = NUL;
buffer = gp_realloc(buffer, strlen(buffer)+1, "f_strftime");
FPRINTF((stderr," strftime result = \"%s\"\n",buffer));
gpfree_string(&val);
gpfree_string(&fmt);
free(fmtstr);
push(Gstring(&val, buffer));
}
/* EAM July 2004 - Gnuplot's own string formatting conventions.
* Currently this routine assumes base 10 representation, because
* it is not clear where it could be specified to be anything else.
*/
void
f_gprintf(union argument *arg)
{
struct value fmt, val, result;
char *buffer;
int length;
double base;
/* Retrieve parameters from top of stack */
pop(&val);
pop(&fmt);
#ifdef DEBUG
fprintf(stderr,"----------\nGot gprintf parameters\nfmt: ");
disp_value(stderr, &fmt, TRUE);
fprintf(stderr,"\nval: ");
disp_value(stderr, &val, TRUE);
fprintf(stderr,"\n----------\n");
#endif
/* Make sure parameters are of the correct type */
if (fmt.type != STRING)
int_error(NO_CARET,"First parameter to gprintf must be a format string");
/* EAM FIXME - I have no idea where we would learn another base is wanted */
base = 10.;
/* Make sure we have at least as much space in the output as the format itself */
length = 80 + strlen(fmt.v.string_val);
buffer = gp_alloc(length, "f_gprintf");
/* Call the old internal routine */
gprintf(buffer, length, fmt.v.string_val, base, real(&val));
FPRINTF((stderr," gprintf result = \"%s\"\n",buffer));
push(Gstring(&result, buffer));
gpfree_string(&fmt);
free(buffer);
}
/* EAM July 2004 (revised to dynamic buffer July 2005)
* There are probably an infinite number of things that can
* go wrong if the user mis-matches arguments and format strings
* in the call to sprintf, but I hope none will do worse than
* result in a garbage output string.
*/
void
f_sprintf(union argument *arg)
{
struct value a[10], *args;
struct value num_params;
struct value result;
char *buffer;
int bufsize;
char *next_start, *outpos, tempchar;
int next_length;
char *prev_start;
int prev_pos;
int i, remaining;
int nargs = 0;
enum DATA_TYPES spec_type;
/* Retrieve number of parameters from top of stack */
pop(&num_params);
nargs = num_params.v.int_val;
if (nargs > 10) { /* Fall back to slow but sure allocation */
args = gp_alloc(sizeof(struct value)*nargs, "sprintf args");
} else
args = a;
for (i=0; i<nargs; i++)
pop(&args[i]); /* pop next argument */
/* Make sure we got a format string of some sort */
if (args[nargs-1].type != STRING)
int_error(NO_CARET,"First parameter to sprintf must be a format string");
/* Allocate space for the output string. If this isn't */
/* long enough we can reallocate a larger space later. */
bufsize = 80 + strlen(args[nargs-1].v.string_val);
buffer = gp_alloc(bufsize, "f_sprintf");
/* Copy leading fragment of format into output buffer */
outpos = buffer;
next_start = args[nargs-1].v.string_val;
next_length = strcspn(next_start,"%");
strncpy(outpos, next_start, next_length);
next_start += next_length;
outpos += next_length;
/* Format the remaining sprintf() parameters one by one */
prev_start = next_start;
prev_pos = next_length;
remaining = nargs - 1;
/* If the user has set an explicit LC_NUMERIC locale, apply it */
/* to sprintf calls during expression evaluation. */
set_numeric_locale();
/* Each time we start this loop we are pointing to a % character */
while (remaining-->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<nargs; i++)
gpfree_string(&args[i]);
if (args != a)
free(args);
/* Return to C locale for internal use */
reset_numeric_locale();
}
/* create action code for 'sum' expressions */
static void
parse_sum_expression()
{
/* sum [<var>=<range>] <expr>
* - Pass a udf to f_sum (with action code (for <expr>) that is not added
* to the global action table).
* - f_sum uses a newly created udv (<var>) to pass the current value of
* <var> to <expr> (resp. its ac).
* - The original idea was to treat <expr> as function f(<var>), but there
* was the following problem: Consider 'g(x) = sum [k=1:4] f(k)'. There
* are two dummy variables 'x' and 'k' from different functions 'g' and
* 'f' which would require changing the parsing of dummy variables.
*/
char *errormsg = "Expecting 'sum [<var> = <start>:<end>] <expression>'\n";
char *varname = NULL;
union argument *arg;
struct udft_entry *udf;
struct at_type * save_at;
int save_at_size;
int i;
/* Caller already checked for string "sum [" so skip both tokens */
c_token += 2;
/* <var> */
if (!isletter(c_token))
int_error(c_token, errormsg);
/* create a user defined variable and pass it to f_sum via PUSHC, since the
* argument of f_sum is already used by the udf */
m_capture(&varname, c_token, c_token);
add_udv(c_token);
arg = add_action(PUSHC);
Gstring(&(arg->v_arg), varname);
c_token++;
if (!equals(c_token, "="))
int_error(c_token, errormsg);
c_token++;
/* <start> */
parse_expression();
if (!equals(c_token, ":"))
int_error(c_token, errormsg);
c_token++;
/* <end> */
parse_expression();
if (!equals(c_token, "]"))
int_error(c_token, errormsg);
c_token++;
/* parse <expr> and convert it to a new action table. */
/* modeled on code from temp_at(). */
/* 1. save environment to restart parsing */
save_at = at;
save_at_size = at_size;
at = NULL;
/* 2. save action table in a user defined function */
udf = (struct udft_entry *) gp_alloc(sizeof(struct udft_entry), "sum");
udf->next_udf = (struct udft_entry *) NULL;
udf->udf_name = NULL; /* TODO maybe add a name and definition */
udf->at = perm_at();
udf->definition = NULL;
udf->dummy_num = 0;
for (i = 0; i < MAX_NUM_VAR; i++)
(void) Ginteger(&(udf->dummy_values[i]), 0);
/* 3. restore environment */
at = save_at;
at_size = save_at_size;
/* pass the udf to f_sum using the argument */
add_action(SUM)->udf_arg = udf;
}
/* Set up next iteration.
* Return TRUE if there is one, FALSE if we're done
*/
TBOOLEAN
next_iteration(t_iterator *iter)
{
t_iterator *this_iter;
TBOOLEAN condition = FALSE;
if (!iter || iter->empty_iteration)
return FALSE;
/* Support for nested iteration:
* we start with the innermost loop. */
this_iter = iter->prev; /* linked to the last element of the list */
if (!this_iter)
return FALSE;
while (!iter->really_done && this_iter != iter && this_iter->done) {
this_iter->iteration_current = this_iter->iteration_start;
this_iter->done = FALSE;
if (this_iter->iteration_string) {
gpfree_string(&(this_iter->iteration_udv->udv_value));
Gstring(&(this_iter->iteration_udv->udv_value),
gp_word(this_iter->iteration_string, this_iter->iteration_current));
} else
this_iter->iteration_udv->udv_value.v.int_val = this_iter->iteration_current;
this_iter = this_iter->prev;
}
if (!this_iter->iteration_udv) {
this_iter->iteration = 0;
return FALSE;
}
iter->iteration++;
/* don't increment if we're at the last iteration */
if (!iter->really_done)
this_iter->iteration_current += this_iter->iteration_increment;
if (this_iter->iteration_string) {
gpfree_string(&(this_iter->iteration_udv->udv_value));
Gstring(&(this_iter->iteration_udv->udv_value),
gp_word(this_iter->iteration_string, this_iter->iteration_current));
} else
this_iter->iteration_udv->udv_value.v.int_val = this_iter->iteration_current;
/* Mar 2014 revised to avoid integer overflow */
if (this_iter->iteration_increment > 0
&& this_iter->iteration_end - this_iter->iteration_current < this_iter->iteration_increment)
this_iter->done = TRUE;
else if (this_iter->iteration_increment < 0
&& this_iter->iteration_end - this_iter->iteration_current > this_iter->iteration_increment)
this_iter->done = TRUE;
else
this_iter->done = FALSE;
/* We return false only if we're, um, really done */
this_iter = iter;
while (this_iter) {
condition = condition || (!this_iter->done);
this_iter = this_iter->next;
}
if (!condition) {
if (!iter->really_done) {
iter->really_done = TRUE;
condition = TRUE;
} else
condition = FALSE;
}
return condition;
}
/* Look for iterate-over-plot constructs, of the form
* for [<var> = <start> : <end> { : <increment>}] ...
* If one (or more) is found, an iterator structure is allocated and filled
* and a pointer to that structure is returned.
* The pointer is NULL if no "for" statements are found.
*/
t_iterator *
check_for_iteration()
{
char *errormsg = "Expecting iterator \tfor [<var> = <start> : <end> {: <incr>}]\n\t\t\tor\tfor [<var> in \"string of words\"]";
int nesting_depth = 0;
t_iterator *iter = NULL;
t_iterator *this_iter = NULL;
/* Now checking for iteration parameters */
/* Nested "for" statements are supported, each one corresponds to a node of the linked list */
while (equals(c_token, "for")) {
struct udvt_entry *iteration_udv = NULL;
char *iteration_string = NULL;
int iteration_start;
int iteration_end;
int iteration_increment = 1;
int iteration_current;
int iteration = 0;
TBOOLEAN empty_iteration;
TBOOLEAN just_once = FALSE;
c_token++;
if (!equals(c_token++, "[") || !isletter(c_token))
int_error(c_token-1, errormsg);
iteration_udv = add_udv(c_token++);
if (equals(c_token, "=")) {
c_token++;
iteration_start = int_expression();
if (!equals(c_token++, ":"))
int_error(c_token-1, errormsg);
iteration_end = int_expression();
if (equals(c_token,":")) {
c_token++;
iteration_increment = int_expression();
if (iteration_increment == 0)
int_error(c_token-1, errormsg);
}
if (!equals(c_token++, "]"))
int_error(c_token-1, errormsg);
if (iteration_udv->udv_undef == FALSE)
gpfree_string(&(iteration_udv->udv_value));
Ginteger(&(iteration_udv->udv_value), iteration_start);
iteration_udv->udv_undef = FALSE;
}
else if (equals(c_token++, "in")) {
iteration_string = try_to_get_string();
if (!iteration_string)
int_error(c_token-1, errormsg);
if (!equals(c_token++, "]"))
int_error(c_token-1, errormsg);
iteration_start = 1;
iteration_end = gp_words(iteration_string);
if (iteration_udv->udv_undef == FALSE)
gpfree_string(&(iteration_udv->udv_value));
Gstring(&(iteration_udv->udv_value), gp_word(iteration_string, 1));
iteration_udv->udv_undef = FALSE;
}
else /* Neither [i=B:E] or [s in "foo"] */
int_error(c_token-1, errormsg);
iteration_current = iteration_start;
empty_iteration = FALSE;
if ( (iteration_udv != NULL)
&& ((iteration_end > iteration_start && iteration_increment < 0)
|| (iteration_end < iteration_start && iteration_increment > 0))) {
empty_iteration = TRUE;
FPRINTF((stderr,"Empty iteration\n"));
}
/* Allocating a node of the linked list nested iterations. */
/* Iterating just once is the same as not iterating at all */
/* so we skip building the node in that case. */
if (iteration_start == iteration_end)
just_once = TRUE;
if (iteration_start < iteration_end && iteration_end < iteration_start + iteration_increment)
just_once = TRUE;
if (iteration_start > iteration_end && iteration_end > iteration_start + iteration_increment)
just_once = TRUE;
if (!just_once) {
this_iter = gp_alloc(sizeof(t_iterator), "iteration linked list");
this_iter->iteration_udv = iteration_udv;
this_iter->iteration_string = iteration_string;
this_iter->iteration_start = iteration_start;
this_iter->iteration_end = iteration_end;
this_iter->iteration_increment = iteration_increment;
this_iter->iteration_current = iteration_current;
this_iter->iteration = iteration;
this_iter->done = FALSE;
this_iter->really_done = FALSE;
this_iter->empty_iteration = empty_iteration;
this_iter->next = NULL;
this_iter->prev = NULL;
if (nesting_depth == 0) {
/* first "for" statement: this will be the listhead */
iter = this_iter;
}
else {
/* not the first "for" statement: attach the newly created node to the end of the list */
iter->prev->next = this_iter; /* iter->prev points to the last node of the list */
this_iter->prev = iter->prev;
}
iter->prev = this_iter; /* a shortcut: making the list circular */
/* if one iteration in the chain is empty, the subchain of nested iterations is too */
if (!iter->empty_iteration)
iter->empty_iteration = empty_iteration;
nesting_depth++;
}
}
return iter;
}
/* pop from load_file state stack
FALSE if stack was empty
called by load_file and load_file_error */
TBOOLEAN
lf_pop()
{
LFS *lf;
int argindex;
struct udvt_entry *udv;
if (lf_head == NULL)
return (FALSE);
lf = lf_head;
if (lf->fp == NULL || lf->fp == stdin)
/* Do not close stdin in the case that "-" is named as a load file */
;
#if defined(PIPES)
else if (lf->name != NULL && lf->name[0] == '<')
pclose(lf->fp);
#endif
else
fclose(lf->fp);
/* call arguments are not relevant when invoked from do_string_and_free */
if (lf->cmdline == NULL) {
for (argindex = 0; argindex < 10; argindex++) {
if (call_args[argindex])
free(call_args[argindex]);
call_args[argindex] = lf->call_args[argindex];
}
call_argc = lf->call_argc;
/* Restore ARGC and ARG0 ... ARG9 */
if ((udv = get_udv_by_name("ARGC"))) {
Ginteger(&(udv->udv_value), call_argc);
}
if ((udv = get_udv_by_name("ARG0"))) {
gpfree_string(&(udv->udv_value));
Gstring(&(udv->udv_value),
(lf->prev && lf->prev->name) ? gp_strdup(lf->prev->name) : gp_strdup(""));
}
for (argindex = 1; argindex <= 9; argindex++) {
if ((udv = get_udv_by_name(argname[argindex]))) {
gpfree_string(&(udv->udv_value));
Gstring(&(udv->udv_value), gp_strdup(call_args[argindex-1]));
if (!call_args[argindex-1])
udv->udv_undef = TRUE;
}
}
}
interactive = lf->interactive;
inline_num = lf->inline_num;
add_udv_by_name("GPVAL_LINENO")->udv_value.v.int_val = inline_num;
if_depth = lf->if_depth;
if_condition = lf->if_condition;
if_open_for_else = lf->if_open_for_else;
/* Restore saved input state and free the copy */
if (lf->tokens) {
num_tokens = lf->num_tokens;
c_token = lf->c_token;
assert(token_table_size >= lf->num_tokens+1);
memcpy(token, lf->tokens,
(lf->num_tokens+1) * sizeof(struct lexical_unit));
free(lf->tokens);
}
if (lf->input_line) {
strcpy(gp_input_line, lf->input_line);
free(lf->input_line);
}
free(lf->name);
free(lf->cmdline);
lf_head = lf->prev;
free(lf);
return (TRUE);
}
static void
prepare_call(int calltype)
{
struct udvt_entry *udv;
int argindex;
if (calltype == 2) {
call_argc = 0;
while (!END_OF_COMMAND && call_argc <= 9) {
call_args[call_argc] = try_to_get_string();
if (!call_args[call_argc]) {
int save_token = c_token;
/* This catches call "file" STRINGVAR (expression) */
if (type_udv(c_token) == STRING) {
call_args[call_argc] = gp_strdup(add_udv(c_token)->udv_value.v.string_val);
c_token++;
/* Evaluates a parenthesized expression and store the result in a string */
} else if (equals(c_token, "(")) {
char val_as_string[32];
struct value a;
const_express(&a);
switch(a.type) {
case CMPLX: /* FIXME: More precision? Some way to provide a format? */
sprintf(val_as_string, "%g", a.v.cmplx_val.real);
call_args[call_argc] = gp_strdup(val_as_string);
break;
default:
int_error(save_token, "Unrecognized argument type");
break;
case INTGR:
sprintf(val_as_string, "%d", a.v.int_val);
call_args[call_argc] = gp_strdup(val_as_string);
break;
}
/* old (pre version 5) style wrapping of bare tokens as strings */
/* is still useful for passing unquoted numbers */
} else {
m_capture(&call_args[call_argc], c_token, c_token);
c_token++;
}
}
call_argc++;
}
lf_head->c_token = c_token;
if (!END_OF_COMMAND)
int_error(++c_token, "too many arguments for 'call <file>'");
} else if (calltype == 5) {
/* lf_push() moved our call arguments from call_args[] to lf->call_args[] */
/* call_argc was determined at program entry */
for (argindex = 0; argindex < 10; argindex++) {
call_args[argindex] = lf_head->call_args[argindex];
lf_head->call_args[argindex] = NULL; /* just to be safe */
}
} else {
/* "load" command has no arguments */
call_argc = 0;
}
/* Old-style "call" arguments were referenced as $0 ... $9 and $# */
/* New-style has ARG0 = script-name, ARG1 ... ARG9 and ARGC */
/* FIXME: If we defined these on entry, we could use get_udv* here */
udv = add_udv_by_name("ARGC");
Ginteger(&(udv->udv_value), call_argc);
udv->udv_undef = FALSE;
udv = add_udv_by_name("ARG0");
gpfree_string(&(udv->udv_value));
Gstring(&(udv->udv_value), gp_strdup(lf_head->name));
udv->udv_undef = FALSE;
for (argindex = 1; argindex <= 9; argindex++) {
char *arg = gp_strdup(call_args[argindex-1]);
udv = add_udv_by_name(argname[argindex]);
gpfree_string(&(udv->udv_value));
Gstring(&(udv->udv_value), arg ? arg : gp_strdup(""));
udv->udv_undef = FALSE;
}
}
