/* add action table entries for primary expressions, i.e. either a
* parenthesized expression, a variable name, a numeric constant, a
* function evaluation, a power operator or postfix '!' (factorial)
* expression */
static void
parse_primary_expression()
{
if (equals(c_token, "(")) {
c_token++;
parse_expression();
/* Expressions may be separated by a comma */
while (equals(c_token,",")) {
c_token++;
(void) add_action(POP);
parse_expression();
}
if (!equals(c_token, ")"))
int_error(c_token, "')' expected");
c_token++;
} else if (equals(c_token, "$")) {
struct value a;
c_token++;
if (equals(c_token,"N")) { /* $N == pseudocolumn -3 means "last column" */
c_token++;
Ginteger(&a, -3);
at_highest_column_used = -3;
} else if (!isanumber(c_token)) {
int_error(c_token, "Column number expected");
} else {
convert(&a, c_token++);
if (a.type != INTGR || a.v.int_val < 0)
int_error(c_token, "Positive integer expected");
if (at_highest_column_used < a.v.int_val)
at_highest_column_used = a.v.int_val;
}
add_action(DOLLARS)->v_arg = a;
} else if (isanumber(c_token)) {
/* work around HP 9000S/300 HP-UX 9.10 cc limitation ... */
/* HBB 20010724: use this code for all platforms, then */
union argument *foo = add_action(PUSHC);
convert(&(foo->v_arg), c_token);
c_token++;
} else if (isletter(c_token)) {
/* Found an identifier --- check whether its a function or a
* variable by looking for the parentheses of a function
* argument list */
if (equals(c_token + 1, "(")) {
enum operators whichfunc = is_builtin_function(c_token);
struct value num_params;
num_params.type = INTGR;
if (whichfunc) {
c_token += 2; /* skip fnc name and '(' */
parse_expression(); /* parse fnc argument */
num_params.v.int_val = 1;
while (equals(c_token, ",")) {
c_token++;
num_params.v.int_val++;
parse_expression();
}
if (!equals(c_token, ")"))
int_error(c_token, "')' expected");
c_token++;
/* So far sprintf is the only built-in function */
/* with a variable number of arguments. */
if (!strcmp(ft[whichfunc].f_name,"sprintf"))
add_action(PUSHC)->v_arg = num_params;
/* "words(s)" is implemented as "word(s,-1)" */
if (!strcmp(ft[whichfunc].f_name,"words")) {
num_params.v.int_val = -1;
add_action(PUSHC)->v_arg = num_params;
}
/* The column() function has side effects requiring special handling */
if (!strcmp(ft[whichfunc].f_name,"column")) {
set_up_columnheader_parsing( &(at->actions[at->a_count-1]) );
}
(void) add_action(whichfunc);
} else {
/* it's a call to a user-defined function */
enum operators call_type = (int) CALL;
int tok = c_token;
c_token += 2; /* skip func name and '(' */
parse_expression();
if (equals(c_token, ",")) { /* more than 1 argument? */
num_params.v.int_val = 1;
while (equals(c_token, ",")) {
num_params.v.int_val += 1;
c_token += 1;
parse_expression();
}
add_action(PUSHC)->v_arg = num_params;
call_type = (int) CALLN;
}
if (!equals(c_token, ")"))
int_error(c_token, "')' expected");
c_token++;
add_action(call_type)->udf_arg = add_udf(tok);
}
} else if (equals(c_token, "sum") && equals(c_token+1, "[")) {
parse_sum_expression();
/* dummy_func==NULL is a flag to say no dummy variables active */
} else if (dummy_func) {
if (equals(c_token, c_dummy_var[0])) {
c_token++;
add_action(PUSHD1)->udf_arg = dummy_func;
} else if (equals(c_token, c_dummy_var[1])) {
c_token++;
add_action(PUSHD2)->udf_arg = dummy_func;
} else {
int i, param = 0;
for (i = 2; i < MAX_NUM_VAR; i++) {
if (equals(c_token, c_dummy_var[i])) {
struct value num_params;
num_params.type = INTGR;
num_params.v.int_val = i;
param = 1;
c_token++;
add_action(PUSHC)->v_arg = num_params;
add_action(PUSHD)->udf_arg = dummy_func;
break;
}
}
if (!param) { /* defined variable */
add_action(PUSH)->udv_arg = add_udv(c_token);
c_token++;
}
}
/* its a variable, with no dummies active - div */
} else {
add_action(PUSH)->udv_arg = add_udv(c_token);
c_token++;
}
}
/* end if letter */
/* Maybe it's a string constant */
else if (isstring(c_token)) {
union argument *foo = add_action(PUSHC);
foo->v_arg.type = STRING;
foo->v_arg.v.string_val = NULL;
/* this dynamically allocated string will be freed by free_at() */
m_quote_capture(&(foo->v_arg.v.string_val), c_token, c_token);
c_token++;
} else
int_error(c_token, "invalid expression ");
/* add action code for ! (factorial) operator */
while (equals(c_token, "!")) {
c_token++;
(void) add_action(FACTORIAL);
}
/* add action code for ** operator */
if (equals(c_token, "**")) {
c_token++;
parse_unary_expression();
(void) add_action(POWER);
}
/* Parse and add actions for range specifier applying to previous entity.
* Currently only used to generate substrings, but could also be used to
* extract vector slices.
*/
if (equals(c_token, "[")) {
/* handle '*' or empty start of range */
if (equals(++c_token,"*") || equals(c_token,":")) {
union argument *empty = add_action(PUSHC);
empty->v_arg.type = INTGR;
empty->v_arg.v.int_val = 1;
if (equals(c_token,"*"))
c_token++;
} else
parse_expression();
if (!equals(c_token, ":"))
int_error(c_token, "':' expected");
/* handle '*' or empty end of range */
if (equals(++c_token,"*") || equals(c_token,"]")) {
union argument *empty = add_action(PUSHC);
empty->v_arg.type = INTGR;
empty->v_arg.v.int_val = 65535; /* should be INT_MAX */
if (equals(c_token,"*"))
c_token++;
} else
parse_expression();
if (!equals(c_token, "]"))
int_error(c_token, "']' expected");
c_token++;
(void) add_action(RANGE);
}
}
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;
}
}
/* 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>]\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;
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;
empty_iteration = iteration_udv
&& ((iteration_end - iteration_start) * iteration_increment < 0);
/* allocating a node of the linked list and initializing its fields */
/* iterating just once is the same as not iterating at all,
* so we skip building the node in that case */
if (iteration_increment
&& (iteration_start != iteration_end)
&& (abs(iteration_end - iteration_start) >= abs(iteration_increment))) {
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 = FALSE;
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 whole chain of iterations is empty, too */
if (!iter->empty_iteration)
iter->empty_iteration = empty_iteration;
nesting_depth++;
}
}
return iter;
}
/* 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;
}
