~vcs-imports/gawk/master

/*

 * array.c - routines for awk arrays.

 */

/* 

 * Copyright (C) 1986, 1988, 1989, 1991-2014 the Free Software Foundation, Inc.

 * 

 * This file is part of GAWK, the GNU implementation of the

 * AWK Programming Language.

 * 

 * GAWK is free software; you can redistribute it and/or modify

 * it under the terms of the GNU General Public License as published by

 * the Free Software Foundation; either version 3 of the License, or

 * (at your option) any later version.

 * 

 * GAWK is distributed in the hope that it will be useful,

 * but WITHOUT ANY WARRANTY; without even the implied warranty of

 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

 * GNU General Public License for more details.

 * 

 * You should have received a copy of the GNU General Public License

 * along with this program; if not, write to the Free Software

 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA

 */

#include "awk.h"

extern FILE *output_fp;

extern NODE **fmt_list;          /* declared in eval.c */

static size_t SUBSEPlen;

static char *SUBSEP;

static char indent_char[] = "    ";

static NODE **null_lookup(NODE *symbol, NODE *subs);

static NODE **null_dump(NODE *symbol, NODE *subs);

static afunc_t null_array_func[] = {

	(afunc_t) 0,

	(afunc_t) 0,

	null_length,

	null_lookup,

	null_afunc,

	null_afunc,

	null_afunc,

	null_afunc,

	null_afunc,

	null_dump,

	(afunc_t) 0,

};

#define MAX_ATYPE 10

static afunc_t *array_types[MAX_ATYPE];

static int num_array_types = 0;

/* array func to index mapping */

#define AFUNC(F) (F ## _ind)

/* register_array_func --- add routines to handle arrays */

int

register_array_func(afunc_t *afunc)

{

	if (afunc && num_array_types < MAX_ATYPE) {

		if (afunc != str_array_func && ! afunc[AFUNC(atypeof)])

			return false;

		array_types[num_array_types++] = afunc;

		if (afunc[AFUNC(ainit)])	/* execute init routine if any */

			(void) (*afunc[AFUNC(ainit)])(NULL, NULL);

		return true;

	}

	return false;

}

/* array_init --- register all builtin array types */

void

array_init()

{

	(void) register_array_func(str_array_func);	/* the default */

	if (! do_mpfr) {

		(void) register_array_func(int_array_func);

		(void) register_array_func(cint_array_func);

	}

}

/* make_array --- create an array node */

NODE *

make_array()

{

	NODE *array;

	getnode(array);

	memset(array, '\0', sizeof(NODE));

	array->type = Node_var_array;

	array->array_funcs = null_array_func;

	/* vname, flags, and parent_array not set here */

	return array;

}		

/* null_array --- force symbol to be an empty typeless array */

void

null_array(NODE *symbol)

{

	symbol->type = Node_var_array;

	symbol->array_funcs = null_array_func;

	symbol->buckets = NULL;

	symbol->table_size = symbol->array_size = 0;

	symbol->array_capacity = 0;

	symbol->flags = 0;

	assert(symbol->xarray == NULL);

	/* vname, parent_array not (re)initialized */

}

/* null_lookup --- assign type to an empty array. */

static NODE **

null_lookup(NODE *symbol, NODE *subs)

{

	int i;

	afunc_t *afunc = NULL;

	assert(symbol->table_size == 0);

	/*

	 * Check which array type wants to accept this sub; traverse

	 * array type list in reverse order.

	 */

	for (i = num_array_types - 1; i >= 1; i--) {

		afunc = array_types[i];

		if (afunc[AFUNC(atypeof)](symbol, subs) != NULL)

			break;

	}

	if (i == 0 || afunc == NULL)

		afunc = array_types[0];	/* default is str_array_func */

	symbol->array_funcs = afunc;

	/* We have the right type of array; install the subscript */

	return symbol->alookup(symbol, subs);

}

/* null_length --- default function for array length interface */ 

NODE **

null_length(NODE *symbol, NODE *subs ATTRIBUTE_UNUSED)

{

	static NODE *tmp;

	tmp = symbol;

	return & tmp;

}

/* null_afunc --- default function for array interface */

NODE **

null_afunc(NODE *symbol ATTRIBUTE_UNUSED, NODE *subs ATTRIBUTE_UNUSED)

{

	return NULL;

}

/* null_dump --- dump function for an empty array */

static NODE **

null_dump(NODE *symbol, NODE *subs ATTRIBUTE_UNUSED)

{

	fprintf(output_fp, "array `%s' is empty\n", array_vname(symbol));

	return NULL;

}

/* assoc_copy --- duplicate input array "symbol" */

NODE *

assoc_copy(NODE *symbol, NODE *newsymb)

{

	assert(newsymb->vname != NULL);

	assoc_clear(newsymb);

	(void) symbol->acopy(symbol, newsymb);

	newsymb->array_funcs = symbol->array_funcs;

	newsymb->flags = symbol->flags;

	return newsymb;

}

/* assoc_dump --- dump array */

void

assoc_dump(NODE *symbol, NODE *ndump)

{

	if (symbol->adump)	

		(void) symbol->adump(symbol, ndump);

}

/* make_aname --- construct a 'vname' for a (sub)array */

const char *

make_aname(const NODE *symbol)

{

	static char *aname = NULL;

	static size_t alen;

	static size_t max_alen;

#define SLEN 256

	if (symbol->parent_array != NULL) {

		size_t slen;

		(void) make_aname(symbol->parent_array);

		slen = strlen(symbol->vname);	/* subscript in parent array */

		if (alen + slen + 4 > max_alen) {		/* sizeof("[\"\"]") = 4 */

			max_alen = alen + slen + 4 + SLEN;

			erealloc(aname, char *, (max_alen + 1) * sizeof(char *), "make_aname");

		}

		alen += sprintf(aname + alen, "[\"%s\"]", symbol->vname);

	} else {

		alen = strlen(symbol->vname);

		if (aname == NULL) {

			max_alen = alen + SLEN;

			emalloc(aname, char *, (max_alen + 1) * sizeof(char *), "make_aname");

		} else if (alen > max_alen) {

			max_alen = alen + SLEN; 

			erealloc(aname, char *, (max_alen + 1) * sizeof(char *), "make_aname");

		}

		memcpy(aname, symbol->vname, alen + 1);

	}

	return aname;

}

#undef SLEN

/*

 * array_vname --- print the name of the array

 *

 * Returns a pointer to a statically maintained dynamically allocated string.

 * It's appropriate for printing the name once; if the caller wants

 * to save it, they have to make a copy.

 */

const char *

array_vname(const NODE *symbol)

{

	static char *message = NULL;

	static size_t msglen = 0;

	char *s;

	size_t len;

	int n;

	const NODE *save_symbol = symbol;

	const char *from = _("from %s");

	const char *aname;

	if (symbol->type != Node_array_ref

			|| symbol->orig_array->type != Node_var_array

	) {

		if (symbol->type != Node_var_array || symbol->parent_array == NULL)	

			return symbol->vname;

		return make_aname(symbol);

	}

	/* First, we have to compute the length of the string: */

	len = 2; /* " (" */

	n = 0;

	while (symbol->type == Node_array_ref) {

		len += strlen(symbol->vname);

		n++;

		symbol = symbol->prev_array;

	}

	/* Get the (sub)array name */

	if (symbol->parent_array == NULL)

		aname = symbol->vname;

	else

		aname = make_aname(symbol);

	len += strlen(aname);

	/*

	 * Each node contributes by strlen(from) minus the length

	 * of "%s" in the translation (which is at least 2)

	 * plus 2 for ", " or ")\0"; this adds up to strlen(from).

	 */

	len += n * strlen(from);

	/* (Re)allocate memory: */

	if (message == NULL) {

		emalloc(message, char *, len, "array_vname");

		msglen = len;

	} else if (len > msglen) {

		erealloc(message, char *, len, "array_vname");

		msglen = len;

	} /* else

		current buffer can hold new name */

	/* We're ready to print: */

	symbol = save_symbol;

	s = message;

	/*

	 * Ancient systems have sprintf() returning char *, not int.

	 * If you have one of those, use sprintf(..); s += strlen(s) instead.

	 */

	s += sprintf(s, "%s (", symbol->vname);

	for (;;) {

		symbol = symbol->prev_array;

		if (symbol->type != Node_array_ref)

			break;

		s += sprintf(s, from, symbol->vname);

		s += sprintf(s, ", ");

	}

	s += sprintf(s, from, aname);

	strcpy(s, ")");

	return message;

}

/*

 *  force_array --- proceed to the actual Node_var_array,

 *	change Node_var_new to an array.

 *	If canfatal and type isn't good, die fatally,

 *	otherwise return the final actual value.

 */

NODE *

force_array(NODE *symbol, bool canfatal)

{

	NODE *save_symbol = symbol;

	bool isparam = false;

	if (symbol->type == Node_param_list) {

		save_symbol = symbol = GET_PARAM(symbol->param_cnt);

		isparam = true;

		if (symbol->type == Node_array_ref)

			symbol = symbol->orig_array;

	}

	switch (symbol->type) {

	case Node_var_new:

		symbol->xarray = NULL;	/* make sure union is as it should be */

		null_array(symbol);

		symbol->parent_array = NULL;	/* main array has no parent */

		/* fall through */

	case Node_var_array:

		break;

	case Node_array_ref:

	default:

		/* notably Node_var but catches also e.g. a[1] = "x"; a[1][1] = "y" */

		if (canfatal) {

			if (symbol->type == Node_val)

				fatal(_("attempt to use a scalar value as array"));

			if (isparam)

				fatal(_("attempt to use scalar parameter `%s' as an array"),

					save_symbol->vname);

			else

				fatal(_("attempt to use scalar `%s' as an array"),

					save_symbol->vname);

		} else

			break;

	}

	return symbol;

}

/* set_SUBSEP --- update SUBSEP related variables when SUBSEP assigned to */

void

set_SUBSEP()

{

	SUBSEP_node->var_value = force_string(SUBSEP_node->var_value);

	SUBSEP = SUBSEP_node->var_value->stptr;

	SUBSEPlen = SUBSEP_node->var_value->stlen;

}

/* concat_exp --- concatenate expression list into a single string */

NODE *

concat_exp(int nargs, bool do_subsep)

{

	/* do_subsep is false for Op_concat */

	NODE *r;

	char *str;

	char *s;

	size_t len;

	size_t subseplen = 0;

	int i;

	extern NODE **args_array;

	if (nargs == 1)

		return POP_STRING();

	if (do_subsep)

		subseplen = SUBSEPlen;

	len = 0;

	for (i = 1; i <= nargs; i++) {

		r = TOP();

		if (r->type == Node_var_array) {

			while (--i > 0)

				DEREF(args_array[i]);	/* avoid memory leak */

			fatal(_("attempt to use array `%s' in a scalar context"), array_vname(r));

		}

		r = POP_STRING();

		args_array[i] = r;

		len += r->stlen;

	}

	len += (nargs - 1) * subseplen;

	emalloc(str, char *, len + 2, "concat_exp");

	r = args_array[nargs];

	memcpy(str, r->stptr, r->stlen);

	s = str + r->stlen;

	DEREF(r);

	for (i = nargs - 1; i > 0; i--) {

		if (subseplen == 1)

			*s++ = *SUBSEP;

		else if (subseplen > 0) {

			memcpy(s, SUBSEP, subseplen);

			s += subseplen;

		}

		r = args_array[i];

		memcpy(s, r->stptr, r->stlen);

		s += r->stlen;

		DEREF(r);

	}

	return make_str_node(str, len, ALREADY_MALLOCED);

}

/*

 * adjust_fcall_stack: remove subarray(s) of symbol[] from

 *	function call stack.

 */

static void

adjust_fcall_stack(NODE *symbol, int nsubs)

{

	NODE *func, *r, *n;

	NODE **sp;

	int pcount;

	/*

	 * Solve the nasty problem of disappearing subarray arguments:

	 *

	 *  function f(c, d) { delete c; .. use non-existent array d .. }

	 *  BEGIN { a[0][0] = 1; f(a, a[0]); .. }

	 *

	 * The fix is to convert 'd' to a local empty array; This has

	 * to be done before clearing the parent array to avoid referring to

	 * already free-ed memory.

	 *

	 * Similar situations exist for builtins accepting more than

	 * one array argument: split, patsplit, asort and asorti. For example:

	 *

	 *  BEGIN { a[0][0] = 1; split("abc", a, "", a[0]) }

	 *

	 * These cases do not involve the function call stack, and are

	 * handled individually in their respective routines.

	 */

	func = frame_ptr->func_node;

	if (func == NULL)	/* in main */

		return;

	pcount = func->param_cnt;

	sp = frame_ptr->stack;

	for (; pcount > 0; pcount--) {

		r = *sp++;

		if (r->type != Node_array_ref

				|| r->orig_array->type != Node_var_array)

			continue;

		n = r->orig_array;

		/* Case 1 */

		if (n == symbol

			&& symbol->parent_array != NULL

			&& nsubs > 0

		) {

			/*

			 * 'symbol' is a subarray, and 'r' is the same subarray:

			 *

			 *   function f(c, d) { delete c[0]; .. }

			 *   BEGIN { a[0][0] = 1; f(a, a[0]); .. }

			 *

			 * But excludes cases like (nsubs = 0):

			 *

			 *   function f(c, d) { delete c; ..}

			 *   BEGIN { a[0][0] = 1; f(a[0], a[0]); ...}  

			 */

			null_array(r);

			r->parent_array = NULL;

			continue;

		}			

		/* Case 2 */

		for (n = n->parent_array; n != NULL; n = n->parent_array) {

			assert(n->type == Node_var_array);

			if (n == symbol) {

				/*

				 * 'r' is a subarray of 'symbol':

				 *

				 *    function f(c, d) { delete c; .. use d as array .. }

				 *    BEGIN { a[0][0] = 1; f(a, a[0]); .. }

				 *	OR

				 *    BEGIN { a[0][0][0][0] = 1; f(a[0], a[0][0][0]); .. }

				 *

				 */

				null_array(r);

				r->parent_array = NULL;

				break;

			}

		}

	}

}

/* do_delete --- perform `delete array[s]' */

/*

 * `symbol' is array

 * `nsubs' is no of subscripts

 */

void

do_delete(NODE *symbol, int nsubs)

{

	NODE *val, *subs;

	int i;

	assert(symbol->type == Node_var_array);

	subs = val = NULL;	/* silence the compiler */

	/*

	 * The force_string() call is needed to make sure that

	 * the string subscript is reasonable.  For example, with it:

	 *

	 * $ ./gawk --posix 'BEGIN { CONVFMT="%ld"; delete a[1.233]}'

	 * gawk: cmd. line:1: fatal: `%l' is not permitted in POSIX awk formats

	 *

	 * Without it, the code does not fail.

	 */

#define free_subs(n)    do {                                    \

    NODE *s = PEEK(n - 1);                                      \

    if (s->type == Node_val) {                                  \

        (void) force_string(s);	/* may have side effects. */    \

        DEREF(s);                                               \

    }                                                           \

} while (--n > 0)

	if (nsubs == 0) {

		/* delete array */

		adjust_fcall_stack(symbol, 0);	/* fix function call stack; See above. */

		assoc_clear(symbol);

		return;

	}

	/* NB: subscripts are in reverse order on stack */

	for (i = nsubs; i > 0; i--) {

		subs = PEEK(i - 1);

		if (subs->type != Node_val) {

			free_subs(i);

			fatal(_("attempt to use array `%s' in a scalar context"), array_vname(subs));

		}

		val = in_array(symbol, subs);

		if (val == NULL) {

			if (do_lint) {

				subs = force_string(subs);

				lintwarn(_("delete: index `%s' not in array `%s'"),

					subs->stptr, array_vname(symbol));

			}

			/* avoid memory leak, free all subs */

			free_subs(i);

			return;

		}

		if (i > 1) {

			if (val->type != Node_var_array) {

				/* e.g.: a[1] = 1; delete a[1][1] */

				free_subs(i);

				subs = force_string(subs);

				fatal(_("attempt to use scalar `%s[\"%.*s\"]' as an array"),

					array_vname(symbol),

					(int) subs->stlen,

					subs->stptr);

			}

			symbol = val;

			DEREF(subs);

		}

	}

	if (val->type == Node_var_array) {

		adjust_fcall_stack(val, nsubs);  /* fix function call stack; See above. */

		assoc_clear(val);

		/* cleared a sub-array, free Node_var_array */

		efree(val->vname);

		freenode(val);

	} else

		unref(val);

	(void) assoc_remove(symbol, subs);

	DEREF(subs);

#undef free_subs

}

/* do_delete_loop --- simulate ``for (iggy in foo) delete foo[iggy]'' */

/*

 * The primary hassle here is that `iggy' needs to have some arbitrary

 * array index put in it before we can clear the array, we can't

 * just replace the loop with `delete foo'.

 */

void

do_delete_loop(NODE *symbol, NODE **lhs)

{

	NODE **list;

	NODE akind;

	akind.flags = AINDEX|ADELETE;	/* need a single index */

	list = symbol->alist(symbol, & akind);

	if (assoc_empty(symbol))

		return;

	unref(*lhs);

	*lhs = list[0];

	efree(list);

	/* blast the array in one shot */

	adjust_fcall_stack(symbol, 0);	

	assoc_clear(symbol);

}

/* value_info --- print scalar node info */

static void

value_info(NODE *n)

{

#define PREC_NUM -1

#define PREC_STR -1

	if (n == Nnull_string || n == Null_field) {

		fprintf(output_fp, "<(null)>");

		return;

	}

	if ((n->flags & (STRING|STRCUR)) != 0) {

		fprintf(output_fp, "<");

		fprintf(output_fp, "\"%.*s\"", PREC_STR, n->stptr);

		if ((n->flags & (NUMBER|NUMCUR)) != 0) {

#ifdef HAVE_MPFR

			if (is_mpg_float(n))

				fprintf(output_fp, ":%s",

					mpg_fmt("%.*R*g", PREC_NUM, ROUND_MODE, n->mpg_numbr));

			else if (is_mpg_integer(n))

				fprintf(output_fp, ":%s", mpg_fmt("%Zd", n->mpg_i));

			else

#endif

			fprintf(output_fp, ":%.*g", PREC_NUM, n->numbr);

		}

		fprintf(output_fp, ">");

	} else {

#ifdef HAVE_MPFR

		if (is_mpg_float(n))

			fprintf(output_fp, "<%s>",

				mpg_fmt("%.*R*g", PREC_NUM, ROUND_MODE, n->mpg_numbr));

		else if (is_mpg_integer(n))

			fprintf(output_fp, "<%s>", mpg_fmt("%Zd", n->mpg_i));

		else

#endif

		fprintf(output_fp, "<%.*g>", PREC_NUM, n->numbr);

	}

	fprintf(output_fp, ":%s", flags2str(n->flags));

	if ((n->flags & FIELD) == 0)