Blame array.c

Packit 575503
/*
Packit 575503
 * array.c - routines for awk arrays.
Packit 575503
 */
Packit 575503
Packit 575503
/*
Packit 575503
 * Copyright (C) 1986, 1988, 1989, 1991-2014, 2016, 2018,
Packit 575503
 * the Free Software Foundation, Inc.
Packit 575503
 *
Packit 575503
 * This file is part of GAWK, the GNU implementation of the
Packit 575503
 * AWK Programming Language.
Packit 575503
 *
Packit 575503
 * GAWK is free software; you can redistribute it and/or modify
Packit 575503
 * it under the terms of the GNU General Public License as published by
Packit 575503
 * the Free Software Foundation; either version 3 of the License, or
Packit 575503
 * (at your option) any later version.
Packit 575503
 *
Packit 575503
 * GAWK is distributed in the hope that it will be useful,
Packit 575503
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
Packit 575503
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
Packit 575503
 * GNU General Public License for more details.
Packit 575503
 *
Packit 575503
 * You should have received a copy of the GNU General Public License
Packit 575503
 * along with this program; if not, write to the Free Software
Packit 575503
 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA
Packit 575503
 */
Packit 575503
Packit 575503
#include "awk.h"
Packit 575503
Packit 575503
extern FILE *output_fp;
Packit 575503
extern NODE **fmt_list;          /* declared in eval.c */
Packit 575503
Packit 575503
NODE *success_node;
Packit 575503
Packit 575503
static size_t SUBSEPlen;
Packit 575503
static char *SUBSEP;
Packit 575503
static char indent_char[] = "    ";
Packit 575503
Packit 575503
static NODE **null_lookup(NODE *symbol, NODE *subs);
Packit 575503
static NODE **null_dump(NODE *symbol, NODE *subs);
Packit 575503
static afunc_t null_array_func[] = {
Packit 575503
	(afunc_t) 0,
Packit 575503
	(afunc_t) 0,
Packit 575503
	null_length,
Packit 575503
	null_lookup,
Packit 575503
	null_afunc,
Packit 575503
	null_afunc,
Packit 575503
	null_afunc,
Packit 575503
	null_afunc,
Packit 575503
	null_afunc,
Packit 575503
	null_dump,
Packit 575503
	(afunc_t) 0,
Packit 575503
};
Packit 575503
Packit 575503
#define MAX_ATYPE 10
Packit 575503
Packit 575503
static afunc_t *array_types[MAX_ATYPE];
Packit 575503
static int num_array_types = 0;
Packit 575503
Packit 575503
/* array func to index mapping */
Packit 575503
#define AFUNC(F) (F ## _ind)
Packit 575503
Packit 575503
/* register_array_func --- add routines to handle arrays */
Packit 575503
Packit 575503
int
Packit 575503
register_array_func(afunc_t *afunc)
Packit 575503
{
Packit 575503
	if (afunc && num_array_types < MAX_ATYPE) {
Packit 575503
		if (afunc != str_array_func && ! afunc[AFUNC(atypeof)])
Packit 575503
			return false;
Packit 575503
		array_types[num_array_types++] = afunc;
Packit 575503
		if (afunc[AFUNC(ainit)])	/* execute init routine if any */
Packit 575503
			(void) (*afunc[AFUNC(ainit)])(NULL, NULL);
Packit 575503
		return true;
Packit 575503
	}
Packit 575503
	return false;
Packit 575503
}
Packit 575503
Packit 575503
Packit 575503
/* array_init --- register all builtin array types */
Packit 575503
Packit 575503
void
Packit 575503
array_init()
Packit 575503
{
Packit 575503
	(void) register_array_func(str_array_func);	/* the default */
Packit 575503
	if (! do_mpfr) {
Packit 575503
		(void) register_array_func(int_array_func);
Packit 575503
		(void) register_array_func(cint_array_func);
Packit 575503
	}
Packit 575503
}
Packit 575503
Packit 575503
Packit 575503
/* make_array --- create an array node */
Packit 575503
Packit 575503
NODE *
Packit 575503
make_array()
Packit 575503
{
Packit 575503
	NODE *array;
Packit 575503
	getnode(array);
Packit 575503
	memset(array, '\0', sizeof(NODE));
Packit 575503
	array->type = Node_var_array;
Packit 575503
	array->array_funcs = null_array_func;
Packit 575503
	/* vname, flags, and parent_array not set here */
Packit 575503
Packit 575503
	return array;
Packit 575503
}
Packit 575503
Packit 575503
Packit 575503
/* null_array --- force symbol to be an empty typeless array */
Packit 575503
Packit 575503
void
Packit 575503
null_array(NODE *symbol)
Packit 575503
{
Packit 575503
	symbol->type = Node_var_array;
Packit 575503
	symbol->array_funcs = null_array_func;
Packit 575503
	symbol->buckets = NULL;
Packit 575503
	symbol->table_size = symbol->array_size = 0;
Packit 575503
	symbol->array_capacity = 0;
Packit 575503
	symbol->flags = 0;
Packit 575503
Packit 575503
	assert(symbol->xarray == NULL);
Packit 575503
Packit 575503
	/* vname, parent_array not (re)initialized */
Packit 575503
}
Packit 575503
Packit 575503
Packit 575503
/* null_lookup --- assign type to an empty array. */
Packit 575503
Packit 575503
static NODE **
Packit 575503
null_lookup(NODE *symbol, NODE *subs)
Packit 575503
{
Packit 575503
	int i;
Packit 575503
	afunc_t *afunc = NULL;
Packit 575503
Packit 575503
	assert(symbol->table_size == 0);
Packit 575503
Packit 575503
	/*
Packit 575503
	 * Check which array type wants to accept this sub; traverse
Packit 575503
	 * array type list in reverse order.
Packit 575503
	 */
Packit 575503
	for (i = num_array_types - 1; i >= 1; i--) {
Packit 575503
		afunc = array_types[i];
Packit 575503
		if (afunc[AFUNC(atypeof)](symbol, subs) != NULL)
Packit 575503
			break;
Packit 575503
	}
Packit 575503
	if (i == 0 || afunc == NULL)
Packit 575503
		afunc = array_types[0];	/* default is str_array_func */
Packit 575503
	symbol->array_funcs = afunc;
Packit 575503
Packit 575503
	/* We have the right type of array; install the subscript */
Packit 575503
	return symbol->alookup(symbol, subs);
Packit 575503
}
Packit 575503
Packit 575503
/* null_length --- default function for array length interface */
Packit 575503
Packit 575503
NODE **
Packit 575503
null_length(NODE *symbol, NODE *subs ATTRIBUTE_UNUSED)
Packit 575503
{
Packit 575503
	static NODE *tmp;
Packit 575503
	tmp = symbol;
Packit 575503
	return & tmp;
Packit 575503
}
Packit 575503
Packit 575503
/* null_afunc --- default function for array interface */
Packit 575503
Packit 575503
NODE **
Packit 575503
null_afunc(NODE *symbol ATTRIBUTE_UNUSED, NODE *subs ATTRIBUTE_UNUSED)
Packit 575503
{
Packit 575503
	return NULL;
Packit 575503
}
Packit 575503
Packit 575503
/* null_dump --- dump function for an empty array */
Packit 575503
Packit 575503
static NODE **
Packit 575503
null_dump(NODE *symbol, NODE *subs ATTRIBUTE_UNUSED)
Packit 575503
{
Packit 575503
	fprintf(output_fp, "array `%s' is empty\n", array_vname(symbol));
Packit 575503
	return NULL;
Packit 575503
}
Packit 575503
Packit 575503
Packit 575503
/* assoc_copy --- duplicate input array "symbol" */
Packit 575503
Packit 575503
NODE *
Packit 575503
assoc_copy(NODE *symbol, NODE *newsymb)
Packit 575503
{
Packit 575503
	assert(newsymb->vname != NULL);
Packit 575503
Packit 575503
	assoc_clear(newsymb);
Packit 575503
	(void) symbol->acopy(symbol, newsymb);
Packit 575503
	newsymb->array_funcs = symbol->array_funcs;
Packit 575503
	newsymb->flags = symbol->flags;
Packit 575503
	return newsymb;
Packit 575503
}
Packit 575503
Packit 575503
Packit 575503
/* assoc_dump --- dump array */
Packit 575503
Packit 575503
void
Packit 575503
assoc_dump(NODE *symbol, NODE *ndump)
Packit 575503
{
Packit 575503
	if (symbol->adump)
Packit 575503
		(void) symbol->adump(symbol, ndump);
Packit 575503
}
Packit 575503
Packit 575503
Packit 575503
/* make_aname --- construct a 'vname' for a (sub)array */
Packit 575503
Packit 575503
const char *
Packit 575503
make_aname(const NODE *symbol)
Packit 575503
{
Packit 575503
	static char *aname = NULL;
Packit 575503
	static size_t alen;
Packit 575503
	static size_t max_alen;
Packit 575503
#define SLEN 256
Packit 575503
Packit 575503
	if (symbol->parent_array != NULL) {
Packit 575503
		size_t slen;
Packit 575503
Packit 575503
		(void) make_aname(symbol->parent_array);
Packit 575503
		slen = strlen(symbol->vname);	/* subscript in parent array */
Packit 575503
		if (alen + slen + 4 > max_alen) {		/* sizeof("[\"\"]") = 4 */
Packit 575503
			max_alen = alen + slen + 4 + SLEN;
Packit 575503
			erealloc(aname, char *, (max_alen + 1) * sizeof(char *), "make_aname");
Packit 575503
		}
Packit 575503
		alen += sprintf(aname + alen, "[\"%s\"]", symbol->vname);
Packit 575503
	} else {
Packit 575503
		alen = strlen(symbol->vname);
Packit 575503
		if (aname == NULL) {
Packit 575503
			max_alen = alen + SLEN;
Packit 575503
			emalloc(aname, char *, (max_alen + 1) * sizeof(char *), "make_aname");
Packit 575503
		} else if (alen > max_alen) {
Packit 575503
			max_alen = alen + SLEN;
Packit 575503
			erealloc(aname, char *, (max_alen + 1) * sizeof(char *), "make_aname");
Packit 575503
		}
Packit 575503
		memcpy(aname, symbol->vname, alen + 1);
Packit 575503
	}
Packit 575503
	return aname;
Packit 575503
}
Packit 575503
#undef SLEN
Packit 575503
Packit 575503
Packit 575503
/*
Packit 575503
 * array_vname --- print the name of the array
Packit 575503
 *
Packit 575503
 * Returns a pointer to a statically maintained dynamically allocated string.
Packit 575503
 * It's appropriate for printing the name once; if the caller wants
Packit 575503
 * to save it, they have to make a copy.
Packit 575503
 */
Packit 575503
Packit 575503
const char *
Packit 575503
array_vname(const NODE *symbol)
Packit 575503
{
Packit 575503
	static char *message = NULL;
Packit 575503
	static size_t msglen = 0;
Packit 575503
	char *s;
Packit 575503
	size_t len;
Packit 575503
	int n;
Packit 575503
	const NODE *save_symbol = symbol;
Packit 575503
	const char *from = _("from %s");
Packit 575503
	const char *aname;
Packit 575503
Packit 575503
	if (symbol->type != Node_array_ref
Packit 575503
			|| symbol->orig_array->type != Node_var_array
Packit 575503
	) {
Packit 575503
		if (symbol->type != Node_var_array || symbol->parent_array == NULL)
Packit 575503
			return symbol->vname;
Packit 575503
		return make_aname(symbol);
Packit 575503
	}
Packit 575503
Packit 575503
	/* First, we have to compute the length of the string: */
Packit 575503
Packit 575503
	len = 2; /* " (" */
Packit 575503
	n = 0;
Packit 575503
	while (symbol->type == Node_array_ref) {
Packit 575503
		len += strlen(symbol->vname);
Packit 575503
		n++;
Packit 575503
		symbol = symbol->prev_array;
Packit 575503
	}
Packit 575503
Packit 575503
	/* Get the (sub)array name */
Packit 575503
	if (symbol->parent_array == NULL)
Packit 575503
		aname = symbol->vname;
Packit 575503
	else
Packit 575503
		aname = make_aname(symbol);
Packit 575503
	len += strlen(aname);
Packit 575503
	/*
Packit 575503
	 * Each node contributes by strlen(from) minus the length
Packit 575503
	 * of "%s" in the translation (which is at least 2)
Packit 575503
	 * plus 2 for ", " or ")\0"; this adds up to strlen(from).
Packit 575503
	 */
Packit 575503
	len += n * strlen(from);
Packit 575503
Packit 575503
	/* (Re)allocate memory: */
Packit 575503
	if (message == NULL) {
Packit 575503
		emalloc(message, char *, len, "array_vname");
Packit 575503
		msglen = len;
Packit 575503
	} else if (len > msglen) {
Packit 575503
		erealloc(message, char *, len, "array_vname");
Packit 575503
		msglen = len;
Packit 575503
	} /* else
Packit 575503
		current buffer can hold new name */
Packit 575503
Packit 575503
	/* We're ready to print: */
Packit 575503
	symbol = save_symbol;
Packit 575503
	s = message;
Packit 575503
	/*
Packit 575503
	 * Ancient systems have sprintf() returning char *, not int.
Packit 575503
	 * If you have one of those, use sprintf(..); s += strlen(s) instead.
Packit 575503
	 */
Packit 575503
Packit 575503
	s += sprintf(s, "%s (", symbol->vname);
Packit 575503
	for (;;) {
Packit 575503
		symbol = symbol->prev_array;
Packit 575503
		if (symbol->type != Node_array_ref)
Packit 575503
			break;
Packit 575503
		s += sprintf(s, from, symbol->vname);
Packit 575503
		s += sprintf(s, ", ");
Packit 575503
	}
Packit 575503
	s += sprintf(s, from, aname);
Packit 575503
	strcpy(s, ")");
Packit 575503
Packit 575503
	return message;
Packit 575503
}
Packit 575503
Packit 575503
Packit 575503
/*
Packit 575503
 *  force_array --- proceed to the actual Node_var_array,
Packit 575503
 *	change Node_var_new to an array.
Packit 575503
 *	If canfatal and type isn't good, die fatally,
Packit 575503
 *	otherwise return the final actual value.
Packit 575503
 */
Packit 575503
Packit 575503
NODE *
Packit 575503
force_array(NODE *symbol, bool canfatal)
Packit 575503
{
Packit 575503
	NODE *save_symbol = symbol;
Packit 575503
	bool isparam = false;
Packit 575503
Packit 575503
	if (symbol->type == Node_param_list) {
Packit 575503
		save_symbol = symbol = GET_PARAM(symbol->param_cnt);
Packit 575503
		isparam = true;
Packit 575503
		if (symbol->type == Node_array_ref)
Packit 575503
			symbol = symbol->orig_array;
Packit 575503
	}
Packit 575503
Packit 575503
	switch (symbol->type) {
Packit 575503
	case Node_var_new:
Packit 575503
		symbol->xarray = NULL;	/* make sure union is as it should be */
Packit 575503
		null_array(symbol);
Packit 575503
		symbol->parent_array = NULL;	/* main array has no parent */
Packit 575503
		/* fall through */
Packit 575503
	case Node_var_array:
Packit 575503
		break;
Packit 575503
Packit 575503
	case Node_array_ref:
Packit 575503
	default:
Packit 575503
		/* notably Node_var but catches also e.g. a[1] = "x"; a[1][1] = "y" */
Packit 575503
		if (canfatal) {
Packit 575503
			if (symbol->type == Node_val)
Packit 575503
				fatal(_("attempt to use a scalar value as array"));
Packit 575503
			if (isparam)
Packit 575503
				fatal(_("attempt to use scalar parameter `%s' as an array"),
Packit 575503
					save_symbol->vname);
Packit 575503
			else
Packit 575503
				fatal(_("attempt to use scalar `%s' as an array"),
Packit 575503
					save_symbol->vname);
Packit 575503
		} else
Packit 575503
			break;
Packit 575503
	}
Packit 575503
Packit 575503
	return symbol;
Packit 575503
}
Packit 575503
Packit 575503
Packit 575503
/* set_SUBSEP --- update SUBSEP related variables when SUBSEP assigned to */
Packit 575503
Packit 575503
void
Packit 575503
set_SUBSEP()
Packit 575503
{
Packit 575503
	SUBSEP_node->var_value = force_string(SUBSEP_node->var_value);
Packit 575503
	SUBSEP = SUBSEP_node->var_value->stptr;
Packit 575503
	SUBSEPlen = SUBSEP_node->var_value->stlen;
Packit 575503
}
Packit 575503
Packit 575503
Packit 575503
/* concat_exp --- concatenate expression list into a single string */
Packit 575503
Packit 575503
NODE *
Packit 575503
concat_exp(int nargs, bool do_subsep)
Packit 575503
{
Packit 575503
	/* do_subsep is false for Op_concat */
Packit 575503
	NODE *r;
Packit 575503
	char *str;
Packit 575503
	char *s;
Packit 575503
	size_t len;
Packit 575503
	size_t subseplen = 0;
Packit 575503
	int i;
Packit 575503
	extern NODE **args_array;
Packit 575503
Packit 575503
	if (nargs == 1)
Packit 575503
		return POP_STRING();
Packit 575503
Packit 575503
	if (do_subsep)
Packit 575503
		subseplen = SUBSEPlen;
Packit 575503
Packit 575503
	len = 0;
Packit 575503
	for (i = 1; i <= nargs; i++) {
Packit 575503
		r = TOP();
Packit 575503
		if (r->type == Node_var_array) {
Packit 575503
			while (--i > 0)
Packit 575503
				DEREF(args_array[i]);	/* avoid memory leak */
Packit 575503
			fatal(_("attempt to use array `%s' in a scalar context"), array_vname(r));
Packit 575503
		}
Packit 575503
		r = POP_STRING();
Packit 575503
		args_array[i] = r;
Packit 575503
		len += r->stlen;
Packit 575503
	}
Packit 575503
	len += (nargs - 1) * subseplen;
Packit 575503
Packit 575503
	emalloc(str, char *, len + 1, "concat_exp");
Packit 575503
Packit 575503
	r = args_array[nargs];
Packit 575503
	memcpy(str, r->stptr, r->stlen);
Packit 575503
	s = str + r->stlen;
Packit 575503
	DEREF(r);
Packit 575503
	for (i = nargs - 1; i > 0; i--) {
Packit 575503
		if (subseplen == 1)
Packit 575503
			*s++ = *SUBSEP;
Packit 575503
		else if (subseplen > 0) {
Packit 575503
			memcpy(s, SUBSEP, subseplen);
Packit 575503
			s += subseplen;
Packit 575503
		}
Packit 575503
		r = args_array[i];
Packit 575503
		memcpy(s, r->stptr, r->stlen);
Packit 575503
		s += r->stlen;
Packit 575503
		DEREF(r);
Packit 575503
	}
Packit 575503
Packit 575503
	return make_str_node(str, len, ALREADY_MALLOCED);
Packit 575503
}
Packit 575503
Packit 575503
Packit 575503
/*
Packit 575503
 * adjust_fcall_stack: remove subarray(s) of symbol[] from
Packit 575503
 *	function call stack.
Packit 575503
 */
Packit 575503
Packit 575503
static void
Packit 575503
adjust_fcall_stack(NODE *symbol, int nsubs)
Packit 575503
{
Packit 575503
	NODE *func, *r, *n;
Packit 575503
	NODE **sp;
Packit 575503
	int pcount;
Packit 575503
Packit 575503
	/*
Packit 575503
	 * Solve the nasty problem of disappearing subarray arguments:
Packit 575503
	 *
Packit 575503
	 *  function f(c, d) { delete c; .. use non-existent array d .. }
Packit 575503
	 *  BEGIN { a[0][0] = 1; f(a, a[0]); .. }
Packit 575503
	 *
Packit 575503
	 * The fix is to convert 'd' to a local empty array; This has
Packit 575503
	 * to be done before clearing the parent array to avoid referring to
Packit 575503
	 * already free-ed memory.
Packit 575503
	 *
Packit 575503
	 * Similar situations exist for builtins accepting more than
Packit 575503
	 * one array argument: split, patsplit, asort and asorti. For example:
Packit 575503
	 *
Packit 575503
	 *  BEGIN { a[0][0] = 1; split("abc", a, "", a[0]) }
Packit 575503
	 *
Packit 575503
	 * These cases do not involve the function call stack, and are
Packit 575503
	 * handled individually in their respective routines.
Packit 575503
	 */
Packit 575503
Packit 575503
	func = frame_ptr->func_node;
Packit 575503
	if (func == NULL)	/* in main */
Packit 575503
		return;
Packit 575503
	pcount = func->param_cnt;
Packit 575503
	sp = frame_ptr->stack;
Packit 575503
Packit 575503
	for (; pcount > 0; pcount--) {
Packit 575503
		r = *sp++;
Packit 575503
		if (r->type != Node_array_ref
Packit 575503
				|| r->orig_array->type != Node_var_array)
Packit 575503
			continue;
Packit 575503
		n = r->orig_array;
Packit 575503
Packit 575503
		/* Case 1 */
Packit 575503
		if (n == symbol
Packit 575503
			&& symbol->parent_array != NULL
Packit 575503
			&& nsubs > 0
Packit 575503
		) {
Packit 575503
			/*
Packit 575503
			 * 'symbol' is a subarray, and 'r' is the same subarray:
Packit 575503
			 *
Packit 575503
			 *   function f(c, d) { delete c[0]; .. }
Packit 575503
			 *   BEGIN { a[0][0] = 1; f(a, a[0]); .. }
Packit 575503
			 *
Packit 575503
			 * But excludes cases like (nsubs = 0):
Packit 575503
			 *
Packit 575503
			 *   function f(c, d) { delete c; ..}
Packit 575503
			 *   BEGIN { a[0][0] = 1; f(a[0], a[0]); ...}
Packit 575503
			 */
Packit 575503
Packit 575503
			null_array(r);
Packit 575503
			r->parent_array = NULL;
Packit 575503
			continue;
Packit 575503
		}
Packit 575503
Packit 575503
		/* Case 2 */
Packit 575503
		for (n = n->parent_array; n != NULL; n = n->parent_array) {
Packit 575503
			assert(n->type == Node_var_array);
Packit 575503
			if (n == symbol) {
Packit 575503
				/*
Packit 575503
				 * 'r' is a subarray of 'symbol':
Packit 575503
				 *
Packit 575503
				 *    function f(c, d) { delete c; .. use d as array .. }
Packit 575503
				 *    BEGIN { a[0][0] = 1; f(a, a[0]); .. }
Packit 575503
				 *	OR
Packit 575503
				 *    BEGIN { a[0][0][0][0] = 1; f(a[0], a[0][0][0]); .. }
Packit 575503
				 *
Packit 575503
				 */
Packit 575503
				null_array(r);
Packit 575503
				r->parent_array = NULL;
Packit 575503
				break;
Packit 575503
			}
Packit 575503
		}
Packit 575503
	}
Packit 575503
}
Packit 575503
Packit 575503
Packit 575503
/* do_delete --- perform `delete array[s]' */
Packit 575503
Packit 575503
/*
Packit 575503
 * `symbol' is array
Packit 575503
 * `nsubs' is no of subscripts
Packit 575503
 */
Packit 575503
Packit 575503
void
Packit 575503
do_delete(NODE *symbol, int nsubs)
Packit 575503
{
Packit 575503
	NODE *val, *subs;
Packit 575503
	int i;
Packit 575503
Packit 575503
	assert(symbol->type == Node_var_array);
Packit 575503
	subs = val = NULL;	/* silence the compiler */
Packit 575503
Packit 575503
	/*
Packit 575503
	 * The force_string() call is needed to make sure that
Packit 575503
	 * the string subscript is reasonable.  For example, with it:
Packit 575503
	 *
Packit 575503
	 * $ ./gawk --posix 'BEGIN { CONVFMT="%ld"; delete a[1.233]}'
Packit 575503
	 * gawk: cmd. line:1: fatal: `%l' is not permitted in POSIX awk formats
Packit 575503
	 *
Packit 575503
	 * Without it, the code does not fail.
Packit 575503
	 */
Packit 575503
Packit 575503
#define free_subs(n)    do {                                    \
Packit 575503
    NODE *s = PEEK(n - 1);                                      \
Packit 575503
    if (s->type == Node_val) {                                  \
Packit 575503
        (void) force_string(s);	/* may have side effects. */    \
Packit 575503
        DEREF(s);                                               \
Packit 575503
    }                                                           \
Packit 575503
} while (--n > 0)
Packit 575503
Packit 575503
	if (nsubs == 0) {
Packit 575503
		/* delete array */
Packit 575503
Packit 575503
		adjust_fcall_stack(symbol, 0);	/* fix function call stack; See above. */
Packit 575503
		assoc_clear(symbol);
Packit 575503
		return;
Packit 575503
	}
Packit 575503
Packit 575503
	/* NB: subscripts are in reverse order on stack */
Packit 575503
Packit 575503
	for (i = nsubs; i > 0; i--) {
Packit 575503
		subs = PEEK(i - 1);
Packit 575503
		if (subs->type != Node_val) {
Packit 575503
			free_subs(i);
Packit 575503
			fatal(_("attempt to use array `%s' in a scalar context"), array_vname(subs));
Packit 575503
		}
Packit 575503
Packit 575503
		val = in_array(symbol, subs);
Packit 575503
		if (val == NULL) {
Packit 575503
			if (do_lint) {
Packit 575503
				subs = force_string(subs);
Packit 575503
				lintwarn(_("delete: index `%.*s' not in array `%s'"),
Packit 575503
					(int) subs->stlen, subs->stptr, array_vname(symbol));
Packit 575503
			}
Packit 575503
			/* avoid memory leak, free all subs */
Packit 575503
			free_subs(i);
Packit 575503
			return;
Packit 575503
		}
Packit 575503
Packit 575503
		if (i > 1) {
Packit 575503
			if (val->type != Node_var_array) {
Packit 575503
				/* e.g.: a[1] = 1; delete a[1][1] */
Packit 575503
Packit 575503
				free_subs(i);
Packit 575503
				subs = force_string(subs);
Packit 575503
				fatal(_("attempt to use scalar `%s[\"%.*s\"]' as an array"),
Packit 575503
					array_vname(symbol),
Packit 575503
					(int) subs->stlen,
Packit 575503
					subs->stptr);
Packit 575503
			}
Packit 575503
			symbol = val;
Packit 575503
			DEREF(subs);
Packit 575503
		}
Packit 575503
	}
Packit 575503
Packit 575503
	if (val->type == Node_var_array) {
Packit 575503
		adjust_fcall_stack(val, nsubs);  /* fix function call stack; See above. */
Packit 575503
		assoc_clear(val);
Packit 575503
		/* cleared a sub-array, free Node_var_array */
Packit 575503
		efree(val->vname);
Packit 575503
		freenode(val);
Packit 575503
	} else
Packit 575503
		unref(val);
Packit 575503
Packit 575503
	(void) assoc_remove(symbol, subs);
Packit 575503
	DEREF(subs);
Packit 575503
Packit 575503
#undef free_subs
Packit 575503
}
Packit 575503
Packit 575503
Packit 575503
/* do_delete_loop --- simulate ``for (iggy in foo) delete foo[iggy]'' */
Packit 575503
Packit 575503
/*
Packit 575503
 * The primary hassle here is that `iggy' needs to have some arbitrary
Packit 575503
 * array index put in it before we can clear the array, we can't
Packit 575503
 * just replace the loop with `delete foo'.
Packit 575503
 */
Packit 575503
Packit 575503
void
Packit 575503
do_delete_loop(NODE *symbol, NODE **lhs)
Packit 575503
{
Packit 575503
	NODE **list;
Packit 575503
	NODE akind;
Packit 575503
Packit 575503
	akind.flags = AINDEX|ADELETE;	/* need a single index */
Packit 575503
	list = symbol->alist(symbol, & akind);
Packit 575503
Packit 575503
	if (assoc_empty(symbol))
Packit 575503
		return;
Packit 575503
Packit 575503
	unref(*lhs);
Packit 575503
	*lhs = list[0];
Packit 575503
	efree(list);
Packit 575503
Packit 575503
	/* blast the array in one shot */
Packit 575503
	adjust_fcall_stack(symbol, 0);
Packit 575503
	assoc_clear(symbol);
Packit 575503
}
Packit 575503
Packit 575503
Packit 575503
/* value_info --- print scalar node info */
Packit 575503
Packit 575503
static void
Packit 575503
value_info(NODE *n)
Packit 575503
{
Packit 575503
Packit 575503
#define PREC_NUM -1
Packit 575503
Packit 575503
	if (n == Nnull_string || n == Null_field) {
Packit 575503
		fprintf(output_fp, "<(null)>");
Packit 575503
		return;
Packit 575503
	}
Packit 575503
Packit 575503
	if ((n->flags & (STRING|STRCUR)) != 0) {
Packit 575503
		fprintf(output_fp, "<");
Packit 575503
		fprintf(output_fp, "\"%.*s\"", (int) n->stlen, n->stptr);
Packit 575503
		if ((n->flags & (NUMBER|NUMCUR)) != 0) {
Packit 575503
#ifdef HAVE_MPFR
Packit 575503
			if (is_mpg_float(n))
Packit 575503
				fprintf(output_fp, ":%s",
Packit 575503
					mpg_fmt("%.*R*g", PREC_NUM, ROUND_MODE, n->mpg_numbr));
Packit 575503
			else if (is_mpg_integer(n))
Packit 575503
				fprintf(output_fp, ":%s", mpg_fmt("%Zd", n->mpg_i));
Packit 575503
			else
Packit 575503
#endif
Packit 575503
			fprintf(output_fp, ":%.*g", PREC_NUM, n->numbr);
Packit 575503
		}
Packit 575503
		fprintf(output_fp, ">");
Packit 575503
	} else {
Packit 575503
#ifdef HAVE_MPFR
Packit 575503
		if (is_mpg_float(n))
Packit 575503
			fprintf(output_fp, "<%s>",
Packit 575503
				mpg_fmt("%.*R*g", PREC_NUM, ROUND_MODE, n->mpg_numbr));
Packit 575503
		else if (is_mpg_integer(n))
Packit 575503
			fprintf(output_fp, "<%s>", mpg_fmt("%Zd", n->mpg_i));
Packit 575503
		else
Packit 575503
#endif
Packit 575503
		fprintf(output_fp, "<%.*g>", PREC_NUM, n->numbr);
Packit 575503
	}
Packit 575503
Packit 575503
	fprintf(output_fp, ":%s", flags2str(n->flags));
Packit 575503
Packit 575503
	if ((n->flags & MALLOC) != 0)
Packit 575503
		fprintf(output_fp, ":%ld", n->valref);
Packit 575503
	else
Packit 575503
		fprintf(output_fp, ":");
Packit 575503
Packit 575503
	if ((n->flags & (STRING|STRCUR)) == STRCUR) {
Packit 575503
		size_t len;
Packit 575503
Packit 575503
		fprintf(output_fp, "][");
Packit 575503
		fprintf(output_fp, "stfmt=%d, ", n->stfmt);
Packit 575503
		/*
Packit 575503
		 * If not STFMT_UNUSED, could be CONVFMT or OFMT if last
Packit 575503
		 * used in a print statement. If immutable, could be that it
Packit 575503
		 * was originally set as a string, or it's a number that has
Packit 575503
		 * an integer value.
Packit 575503
		 */
Packit 575503
		len = fmt_list[n->stfmt]->stlen;
Packit 575503
		fmt_list[n->stfmt]->stptr[len] = '\0';
Packit 575503
		fprintf(output_fp, "FMT=\"%s\"",
Packit 575503
					n->stfmt == STFMT_UNUSED ? "<unused>"
Packit 575503
					: fmt_list[n->stfmt]->stptr);
Packit 575503
#ifdef HAVE_MPFR
Packit 575503
		fprintf(output_fp, ", RNDMODE=\"%c\"", n->strndmode);
Packit 575503
#endif
Packit 575503
	}
Packit 575503
Packit 575503
#undef PREC_NUM
Packit 575503
}
Packit 575503
Packit 575503
Packit 575503
void
Packit 575503
indent(int indent_level)
Packit 575503
{
Packit 575503
	int i;
Packit 575503
	for (i = 0; i < indent_level; i++)
Packit 575503
		fprintf(output_fp, "%s", indent_char);
Packit 575503
}
Packit 575503
Packit 575503
/* assoc_info --- print index, value info */
Packit 575503
Packit 575503
void
Packit 575503
assoc_info(NODE *subs, NODE *val, NODE *ndump, const char *aname)
Packit 575503
{
Packit 575503
	int indent_level = ndump->alevel;
Packit 575503
Packit 575503
	indent_level++;
Packit 575503
	indent(indent_level);
Packit 575503
	fprintf(output_fp, "I: [%s:", aname);
Packit 575503
	if ((subs->flags & (MPFN|MPZN|INTIND)) == INTIND)
Packit 575503
		fprintf(output_fp, "<%ld>", (long) subs->numbr);
Packit 575503
	else
Packit 575503
		value_info(subs);
Packit 575503
	fprintf(output_fp, "]\n");
Packit 575503
Packit 575503
	indent(indent_level);
Packit 575503
	if (val->type == Node_val) {
Packit 575503
		fprintf(output_fp, "V: [scalar: ");
Packit 575503
		value_info(val);
Packit 575503
	} else {
Packit 575503
		fprintf(output_fp, "V: [");
Packit 575503
		ndump->alevel++;
Packit 575503
		ndump->adepth--;
Packit 575503
		assoc_dump(val, ndump);
Packit 575503
		ndump->adepth++;
Packit 575503
		ndump->alevel--;
Packit 575503
		indent(indent_level);
Packit 575503
	}
Packit 575503
	fprintf(output_fp, "]\n");
Packit 575503
}
Packit 575503
Packit 575503
Packit 575503
/* do_adump --- dump an array: interface to assoc_dump */
Packit 575503
Packit 575503
NODE *
Packit 575503
do_adump(int nargs)
Packit 575503
{
Packit 575503
	NODE *symbol, *tmp;
Packit 575503
	static NODE ndump;
Packit 575503
	long depth = 0;
Packit 575503
Packit 575503
	/*
Packit 575503
	 * depth < 0, no index and value info.
Packit 575503
	 *       = 0, main array index and value info; does not descend into sub-arrays.
Packit 575503
	 *       > 0, descends into 'depth' sub-arrays, and prints index and value info.
Packit 575503
	 */
Packit 575503
Packit 575503
	if (nargs == 2) {
Packit 575503
		tmp = POP_NUMBER();
Packit 575503
		depth = get_number_si(tmp);
Packit 575503
		DEREF(tmp);
Packit 575503
	}
Packit 575503
	symbol = POP_PARAM();
Packit 575503
	if (symbol->type != Node_var_array)
Packit 575503
		fatal(_("adump: first argument not an array"));
Packit 575503
Packit 575503
	ndump.type = Node_dump_array;
Packit 575503
	ndump.adepth = depth;
Packit 575503
	ndump.alevel = 0;
Packit 575503
	assoc_dump(symbol, & ndump);
Packit 575503
	return make_number((AWKNUM) 0);
Packit 575503
}
Packit 575503
Packit 575503
Packit 575503
/* asort_actual --- do the actual work to sort the input array */
Packit 575503
Packit 575503
static NODE *
Packit 575503
asort_actual(int nargs, sort_context_t ctxt)
Packit 575503
{
Packit 575503
	NODE *array, *dest = NULL, *result;
Packit 575503
	NODE *r, *subs, *s;
Packit 575503
	NODE **list = NULL, **ptr, **lhs;
Packit 575503
	unsigned long num_elems, i;
Packit 575503
	const char *sort_str;
Packit 575503
	char save;
Packit 575503
Packit 575503
	if (nargs == 3)  /* 3rd optional arg */
Packit 575503
		s = POP_STRING();
Packit 575503
	else
Packit 575503
		s = dupnode(Nnull_string);	/* "" => default sorting */
Packit 575503
Packit 575503
	s = force_string(s);
Packit 575503
	sort_str = s->stptr;
Packit 575503
	save = s->stptr[s->stlen];
Packit 575503
	s->stptr[s->stlen] = '\0';
Packit 575503
	if (s->stlen == 0) {		/* default sorting */
Packit 575503
		if (ctxt == ASORT)
Packit 575503
			sort_str = "@val_type_asc";
Packit 575503
		else
Packit 575503
			sort_str = "@ind_str_asc";
Packit 575503
	}
Packit 575503
Packit 575503
	if (nargs >= 2) {  /* 2nd optional arg */
Packit 575503
		dest = POP_PARAM();
Packit 575503
		if (dest->type != Node_var_array) {
Packit 575503
			fatal(ctxt == ASORT ?
Packit 575503
				_("asort: second argument not an array") :
Packit 575503
				_("asorti: second argument not an array"));
Packit 575503
		}
Packit 575503
	}
Packit 575503
Packit 575503
	array = POP_PARAM();
Packit 575503
	if (array->type != Node_var_array) {
Packit 575503
		fatal(ctxt == ASORT ?
Packit 575503
			_("asort: first argument not an array") :
Packit 575503
			_("asorti: first argument not an array"));
Packit 575503
	}
Packit 575503
Packit 575503
	if (dest != NULL) {
Packit 575503
		for (r = dest->parent_array; r != NULL; r = r->parent_array) {
Packit 575503
			if (r == array)
Packit 575503
				fatal(ctxt == ASORT ?
Packit 575503
					_("asort: cannot use a subarray of first arg for second arg") :
Packit 575503
					_("asorti: cannot use a subarray of first arg for second arg"));
Packit 575503
		}
Packit 575503
		for (r = array->parent_array; r != NULL; r = r->parent_array) {
Packit 575503
			if (r == dest)
Packit 575503
				fatal(ctxt == ASORT ?
Packit 575503
					_("asort: cannot use a subarray of second arg for first arg") :
Packit 575503
					_("asorti: cannot use a subarray of second arg for first arg"));
Packit 575503
		}
Packit 575503
	}
Packit 575503
Packit 575503
	/* sorting happens inside assoc_list */
Packit 575503
	list = assoc_list(array, sort_str, ctxt);
Packit 575503
	s->stptr[s->stlen] = save;
Packit 575503
	DEREF(s);
Packit 575503
Packit 575503
	num_elems = assoc_length(array);
Packit 575503
	if (num_elems == 0 || list == NULL) {
Packit 575503
 		/* source array is empty */
Packit 575503
 		if (dest != NULL && dest != array)
Packit 575503
 			assoc_clear(dest);
Packit 575503
		if (list != NULL)
Packit 575503
			efree(list);
Packit 575503
 		return make_number((AWKNUM) 0);
Packit 575503
 	}
Packit 575503
Packit 575503
	/*
Packit 575503
	 * Must not assoc_clear() the source array before constructing
Packit 575503
	 * the output array. assoc_list() does not duplicate array values
Packit 575503
	 * which are needed for asort().
Packit 575503
	 */
Packit 575503
Packit 575503
	if (dest != NULL && dest != array) {
Packit 575503
		assoc_clear(dest);
Packit 575503
		result = dest;
Packit 575503
	} else {
Packit 575503
		/* use 'result' as a temporary destination array */
Packit 575503
		result = make_array();
Packit 575503
		result->vname = array->vname;
Packit 575503
		result->parent_array = array->parent_array;
Packit 575503
	}
Packit 575503
Packit 575503
	if (ctxt == ASORTI) {
Packit 575503
		/* We want the indices of the source array. */
Packit 575503
Packit 575503
		for (i = 1, ptr = list; i <= num_elems; i++, ptr += 2) {
Packit 575503
			subs = make_number(i);
Packit 575503
			lhs = assoc_lookup(result, subs);
Packit 575503
			unref(*lhs);
Packit 575503
			*lhs = *ptr;
Packit 575503
			if (result->astore != NULL)
Packit 575503
				(*result->astore)(result, subs);
Packit 575503
			unref(subs);
Packit 575503
		}
Packit 575503
	} else {
Packit 575503
		/* We want the values of the source array. */
Packit 575503
Packit 575503
		for (i = 1, ptr = list; i <= num_elems; i++) {
Packit 575503
			subs = make_number(i);
Packit 575503
Packit 575503
			/* free index node */
Packit 575503
			r = *ptr++;
Packit 575503
			unref(r);
Packit 575503
Packit 575503
			/* value node */
Packit 575503
			r = *ptr++;
Packit 575503
Packit 575503
			if (r->type == Node_val) {
Packit 575503
				lhs = assoc_lookup(result, subs);
Packit 575503
				unref(*lhs);
Packit 575503
				*lhs = dupnode(r);
Packit 575503
			} else {
Packit 575503
				NODE *arr;
Packit 575503
				arr = make_array();
Packit 575503
				subs = force_string(subs);
Packit 575503
				arr->vname = subs->stptr;
Packit 575503
				arr->vname[subs->stlen] = '\0';
Packit 575503
				subs->stptr = NULL;
Packit 575503
				subs->flags &= ~STRCUR;
Packit 575503
				arr->parent_array = array; /* actual parent, not the temporary one. */
Packit 575503
				lhs = assoc_lookup(result, subs);
Packit 575503
				unref(*lhs);
Packit 575503
				*lhs = assoc_copy(r, arr);
Packit 575503
			}
Packit 575503
			if (result->astore != NULL)
Packit 575503
				(*result->astore)(result, subs);
Packit 575503
			unref(subs);
Packit 575503
		}
Packit 575503
	}
Packit 575503
Packit 575503
	efree(list);
Packit 575503
Packit 575503
	if (result != dest) {
Packit 575503
		/* dest == NULL or dest == array */
Packit 575503
		assoc_clear(array);
Packit 575503
		*array = *result;	/* copy result into array */
Packit 575503
		freenode(result);
Packit 575503
	} /* else
Packit 575503
		result == dest
Packit 575503
		dest != NULL and dest != array */
Packit 575503
Packit 575503
	return make_number((AWKNUM) num_elems);
Packit 575503
}
Packit 575503
Packit 575503
/* do_asort --- sort array by value */
Packit 575503
Packit 575503
NODE *
Packit 575503
do_asort(int nargs)
Packit 575503
{
Packit 575503
	return asort_actual(nargs, ASORT);
Packit 575503
}
Packit 575503
Packit 575503
/* do_asorti --- sort array by index */
Packit 575503
Packit 575503
NODE *
Packit 575503
do_asorti(int nargs)
Packit 575503
{
Packit 575503
	return asort_actual(nargs, ASORTI);
Packit 575503
}
Packit 575503
Packit 575503
Packit 575503
/*
Packit 575503
 * cmp_strings --- compare two strings; logic similar to cmp_nodes() in eval.c
Packit 575503
 *	except the extra case-sensitive comparison when the case-insensitive
Packit 575503
 *	result is a match.
Packit 575503
 */
Packit 575503
Packit 575503
static int
Packit 575503
cmp_strings(const NODE *n1, const NODE *n2)
Packit 575503
{
Packit 575503
	char *s1, *s2;
Packit 575503
	size_t len1, len2;
Packit 575503
	int ret;
Packit 575503
	size_t lmin;
Packit 575503
Packit 575503
	s1 = n1->stptr;
Packit 575503
	len1 = n1->stlen;
Packit 575503
	s2 =  n2->stptr;
Packit 575503
	len2 = n2->stlen;
Packit 575503
Packit 575503
	if (len1 == 0)
Packit 575503
		return len2 == 0 ? 0 : -1;
Packit 575503
	if (len2 == 0)
Packit 575503
		return 1;
Packit 575503
Packit 575503
	/* len1 > 0 && len2 > 0 */
Packit 575503
	lmin = len1 < len2 ? len1 : len2;
Packit 575503
Packit 575503
	if (IGNORECASE) {
Packit 575503
		const unsigned char *cp1 = (const unsigned char *) s1;
Packit 575503
		const unsigned char *cp2 = (const unsigned char *) s2;
Packit 575503
Packit 575503
		if (gawk_mb_cur_max > 1) {
Packit 575503
			ret = strncasecmpmbs((const unsigned char *) cp1,
Packit 575503
					     (const unsigned char *) cp2, lmin);
Packit 575503
		} else {
Packit 575503
			for (ret = 0; lmin-- > 0 && ret == 0; cp1++, cp2++)
Packit 575503
				ret = casetable[*cp1] - casetable[*cp2];
Packit 575503
		}
Packit 575503
		if (ret != 0)
Packit 575503
			return ret;
Packit 575503
		/*
Packit 575503
		 * If case insensitive result is "they're the same",
Packit 575503
		 * use case sensitive comparison to force distinct order.
Packit 575503
		 */
Packit 575503
	}
Packit 575503
Packit 575503
	ret = memcmp(s1, s2, lmin);
Packit 575503
	if (ret != 0 || len1 == len2)
Packit 575503
		return ret;
Packit 575503
	return (len1 < len2) ? -1 : 1;
Packit 575503
}
Packit 575503
Packit 575503
/* sort_up_index_string --- qsort comparison function; ascending index strings. */
Packit 575503
Packit 575503
static int
Packit 575503
sort_up_index_string(const void *p1, const void *p2)
Packit 575503
{
Packit 575503
	const NODE *t1, *t2;
Packit 575503
Packit 575503
	/* Array indices are strings */
Packit 575503
	t1 = *((const NODE *const *) p1);
Packit 575503
	t2 = *((const NODE *const *) p2);
Packit 575503
	return cmp_strings(t1, t2);
Packit 575503
}
Packit 575503
Packit 575503
Packit 575503
/* sort_down_index_str --- qsort comparison function; descending index strings. */
Packit 575503
Packit 575503
static int
Packit 575503
sort_down_index_string(const void *p1, const void *p2)
Packit 575503
{
Packit 575503
	/*
Packit 575503
	 * Negation versus transposed arguments:  when all keys are
Packit 575503
	 * distinct, as with array indices here, either method will
Packit 575503
	 * transform an ascending sort into a descending one.  But if
Packit 575503
	 * there are equal keys--such as when IGNORECASE is honored--
Packit 575503
	 * that get disambiguated into a determisitc order, negation
Packit 575503
	 * will reverse those but transposed arguments would retain
Packit 575503
	 * their relative order within the rest of the reversed sort.
Packit 575503
	 */
Packit 575503
	return -sort_up_index_string(p1, p2);
Packit 575503
}
Packit 575503
Packit 575503
Packit 575503
/* sort_up_index_number --- qsort comparison function; ascending index numbers. */
Packit 575503
Packit 575503
static int
Packit 575503
sort_up_index_number(const void *p1, const void *p2)
Packit 575503
{
Packit 575503
	const NODE *t1, *t2;
Packit 575503
	int ret;
Packit 575503
Packit 575503
	t1 = *((const NODE *const *) p1);
Packit 575503
	t2 = *((const NODE *const *) p2);
Packit 575503
Packit 575503
	ret = cmp_numbers(t1, t2);
Packit 575503
	if (ret != 0)
Packit 575503
		return ret;
Packit 575503
Packit 575503
	/* break a tie with the index string itself */
Packit 575503
	t1 = force_string((NODE *) t1);
Packit 575503
	t2 = force_string((NODE *) t2);
Packit 575503
	return cmp_strings(t1, t2);
Packit 575503
}
Packit 575503
Packit 575503
/* sort_down_index_number --- qsort comparison function; descending index numbers */
Packit 575503
Packit 575503
static int
Packit 575503
sort_down_index_number(const void *p1, const void *p2)
Packit 575503
{
Packit 575503
	return -sort_up_index_number(p1, p2);
Packit 575503
}
Packit 575503
Packit 575503
Packit 575503
/* sort_up_value_string --- qsort comparison function; ascending value string */
Packit 575503
Packit 575503
static int
Packit 575503
sort_up_value_string(const void *p1, const void *p2)
Packit 575503
{
Packit 575503
	const NODE *t1, *t2;
Packit 575503
Packit 575503
	t1 = *((const NODE *const *) p1 + 1);
Packit 575503
	t2 = *((const NODE *const *) p2 + 1);
Packit 575503
Packit 575503
	if (t1->type == Node_var_array) {
Packit 575503
		/* return 0 if t2 is a sub-array too, else return 1 */
Packit 575503
		return (t2->type != Node_var_array);
Packit 575503
	}
Packit 575503
	if (t2->type == Node_var_array)
Packit 575503
		return -1;		/* t1 (scalar) < t2 (sub-array) */
Packit 575503
Packit 575503
	/* t1 and t2 both have string values */
Packit 575503
	return cmp_strings(t1, t2);
Packit 575503
}
Packit 575503
Packit 575503
Packit 575503
/* sort_down_value_string --- qsort comparison function; descending value string */
Packit 575503
Packit 575503
static int
Packit 575503
sort_down_value_string(const void *p1, const void *p2)
Packit 575503
{
Packit 575503
	return -sort_up_value_string(p1, p2);
Packit 575503
}
Packit 575503
Packit 575503
Packit 575503
/* sort_up_value_number --- qsort comparison function; ascending value number */
Packit 575503
Packit 575503
static int
Packit 575503
sort_up_value_number(const void *p1, const void *p2)
Packit 575503
{
Packit 575503
	NODE *t1, *t2;
Packit 575503
	int ret;
Packit 575503
Packit 575503
	t1 = *((NODE *const *) p1 + 1);
Packit 575503
	t2 = *((NODE *const *) p2 + 1);
Packit 575503
Packit 575503
	if (t1->type == Node_var_array) {
Packit 575503
		/* return 0 if t2 is a sub-array too, else return 1 */
Packit 575503
		return (t2->type != Node_var_array);
Packit 575503
	}
Packit 575503
	if (t2->type == Node_var_array)
Packit 575503
		return -1;		/* t1 (scalar) < t2 (sub-array) */
Packit 575503
Packit 575503
	ret = cmp_numbers(t1, t2);
Packit 575503
	if (ret != 0)
Packit 575503
		return ret;
Packit 575503
Packit 575503
	/*
Packit 575503
	 * Use string value to guarantee same sort order on all
Packit 575503
	 * versions of qsort().
Packit 575503
	 */
Packit 575503
	t1 = force_string(t1);
Packit 575503
	t2 = force_string(t2);
Packit 575503
	return cmp_strings(t1, t2);
Packit 575503
}
Packit 575503
Packit 575503
Packit 575503
/* sort_down_value_number --- qsort comparison function; descending value number */
Packit 575503
Packit 575503
static int
Packit 575503
sort_down_value_number(const void *p1, const void *p2)
Packit 575503
{
Packit 575503
	return -sort_up_value_number(p1, p2);
Packit 575503
}
Packit 575503
Packit 575503
Packit 575503
/* sort_up_value_type --- qsort comparison function; ascending value type */
Packit 575503
Packit 575503
static int
Packit 575503
sort_up_value_type(const void *p1, const void *p2)
Packit 575503
{
Packit 575503
	NODE *n1, *n2;
Packit 575503
Packit 575503
	/* we want to compare the element values */
Packit 575503
	n1 = *((NODE *const *) p1 + 1);
Packit 575503
	n2 = *((NODE *const *) p2 + 1);
Packit 575503
Packit 575503
	/* 1. Arrays vs. scalar, scalar is less than array */
Packit 575503
	if (n1->type == Node_var_array) {
Packit 575503
		/* return 0 if n2 is a sub-array too, else return 1 */
Packit 575503
		return (n2->type != Node_var_array);
Packit 575503
	}
Packit 575503
	if (n2->type == Node_var_array) {
Packit 575503
		return -1;		/* n1 (scalar) < n2 (sub-array) */
Packit 575503
	}
Packit 575503
Packit 575503
	/* two scalars */
Packit 575503
	(void) fixtype(n1);
Packit 575503
	(void) fixtype(n2);
Packit 575503
Packit 575503
	if ((n1->flags & NUMBER) != 0 && (n2->flags & NUMBER) != 0) {
Packit 575503
		return cmp_numbers(n1, n2);
Packit 575503
	}
Packit 575503
Packit 575503
	/* 3. All numbers are less than all strings. This is aribitrary. */
Packit 575503
	if ((n1->flags & NUMBER) != 0 && (n2->flags & STRING) != 0) {
Packit 575503
		return -1;
Packit 575503
	} else if ((n1->flags & STRING) != 0 && (n2->flags & NUMBER) != 0) {
Packit 575503
		return 1;
Packit 575503
	}
Packit 575503
Packit 575503
	/* 4. Two strings */
Packit 575503
	return cmp_strings(n1, n2);
Packit 575503
}
Packit 575503
Packit 575503
/* sort_down_value_type --- qsort comparison function; descending value type */
Packit 575503
Packit 575503
static int
Packit 575503
sort_down_value_type(const void *p1, const void *p2)
Packit 575503
{
Packit 575503
	return -sort_up_value_type(p1, p2);
Packit 575503
}
Packit 575503
Packit 575503
/* sort_user_func --- user defined qsort comparison function */
Packit 575503
Packit 575503
static int
Packit 575503
sort_user_func(const void *p1, const void *p2)
Packit 575503
{
Packit 575503
	NODE *idx1, *idx2, *val1, *val2, *r;
Packit 575503
	int ret;
Packit 575503
	INSTRUCTION *code;
Packit 575503
Packit 575503
	idx1 = *((NODE *const *) p1);
Packit 575503
	idx2 = *((NODE *const *) p2);
Packit 575503
	val1 = *((NODE *const *) p1 + 1);
Packit 575503
	val2 = *((NODE *const *) p2 + 1);
Packit 575503
Packit 575503
	code = TOP()->code_ptr;	/* comparison function call instructions */
Packit 575503
Packit 575503
	/* setup 4 arguments to comp_func() */
Packit 575503
	UPREF(idx1);
Packit 575503
	PUSH(idx1);
Packit 575503
	if (val1->type == Node_val)
Packit 575503
		UPREF(val1);
Packit 575503
	PUSH(val1);
Packit 575503
Packit 575503
	UPREF(idx2);
Packit 575503
	PUSH(idx2);
Packit 575503
	if (val2->type == Node_val)
Packit 575503
		UPREF(val2);
Packit 575503
	PUSH(val2);
Packit 575503
Packit 575503
	/* execute the comparison function */
Packit 575503
	(void) (*interpret)(code);
Packit 575503
Packit 575503
	/* return value of the comparison function */
Packit 575503
	r = POP_NUMBER();
Packit 575503
#ifdef HAVE_MPFR
Packit 575503
	/*
Packit 575503
	 * mpfr_sgn(mpz_sgn): Returns a positive value if op > 0,
Packit 575503
	 * zero if op = 0, and a negative value if op < 0.
Packit 575503
	 */
Packit 575503
	if (is_mpg_float(r))
Packit 575503
		ret = mpfr_sgn(r->mpg_numbr);
Packit 575503
	else if (is_mpg_integer(r))
Packit 575503
		ret = mpz_sgn(r->mpg_i);
Packit 575503
	else
Packit 575503
#endif
Packit 575503
		ret = (r->numbr < 0.0) ? -1 : (r->numbr > 0.0);
Packit 575503
	DEREF(r);
Packit 575503
	return ret;
Packit 575503
}
Packit 575503
Packit 575503
Packit 575503
/* assoc_list -- construct, and optionally sort, a list of array elements */
Packit 575503
Packit 575503
NODE **
Packit 575503
assoc_list(NODE *symbol, const char *sort_str, sort_context_t sort_ctxt)
Packit 575503
{
Packit 575503
	typedef int (*qsort_compfunc)(const void *, const void *);
Packit 575503
Packit 575503
	static const struct qsort_funcs {
Packit 575503
		const char *name;
Packit 575503
		qsort_compfunc comp_func;
Packit 575503
		assoc_kind_t kind;
Packit 575503
	} sort_funcs[] = {
Packit 575503
{ "@ind_str_asc",	sort_up_index_string,	AINDEX|AISTR|AASC },
Packit 575503
{ "@ind_num_asc",	sort_up_index_number,	AINDEX|AINUM|AASC },
Packit 575503
{ "@val_str_asc",	sort_up_value_string,	AVALUE|AVSTR|AASC },
Packit 575503
{ "@val_num_asc",	sort_up_value_number,	AVALUE|AVNUM|AASC },
Packit 575503
{ "@ind_str_desc",	sort_down_index_string,	AINDEX|AISTR|ADESC },
Packit 575503
{ "@ind_num_desc",	sort_down_index_number,	AINDEX|AINUM|ADESC },
Packit 575503
{ "@val_str_desc",	sort_down_value_string,	AVALUE|AVSTR|ADESC },
Packit 575503
{ "@val_num_desc",	sort_down_value_number,	AVALUE|AVNUM|ADESC },
Packit 575503
{ "@val_type_asc",	sort_up_value_type,	AVALUE|AASC },
Packit 575503
{ "@val_type_desc",	sort_down_value_type,	AVALUE|ADESC },
Packit 575503
{ "@unsorted",		0,			AINDEX },
Packit 575503
};
Packit 575503
Packit 575503
	/*
Packit 575503
	 * N.B.: AASC and ADESC are hints to the specific array types.
Packit 575503
	 *	See cint_list() in cint_array.c.
Packit 575503
	 */
Packit 575503
Packit 575503
	NODE **list;
Packit 575503
	NODE akind;
Packit 575503
	unsigned long num_elems, j;
Packit 575503
	int elem_size, qi;
Packit 575503
	qsort_compfunc cmp_func = 0;
Packit 575503
	INSTRUCTION *code = NULL;
Packit 575503
	extern int currule;
Packit 575503
	int save_rule = 0;
Packit 575503
	assoc_kind_t assoc_kind = ANONE;
Packit 575503
Packit 575503
	elem_size = 1;
Packit 575503
Packit 575503
	for (qi = 0, j = sizeof(sort_funcs)/sizeof(sort_funcs[0]); qi < j; qi++) {
Packit 575503
		if (strcmp(sort_funcs[qi].name, sort_str) == 0)
Packit 575503
			break;
Packit 575503
	}
Packit 575503
Packit 575503
	if (qi < j) {
Packit 575503
		cmp_func = sort_funcs[qi].comp_func;
Packit 575503
		assoc_kind = sort_funcs[qi].kind;
Packit 575503
Packit 575503
		if (symbol->array_funcs != cint_array_func)
Packit 575503
			assoc_kind &= ~(AASC|ADESC);
Packit 575503
Packit 575503
		if (sort_ctxt != SORTED_IN || (assoc_kind & AVALUE) != 0) {
Packit 575503
			/* need index and value pair in the list */
Packit 575503
Packit 575503
			assoc_kind |= (AINDEX|AVALUE);
Packit 575503
			elem_size = 2;
Packit 575503
		}
Packit 575503
Packit 575503
	} else {	/* unrecognized */
Packit 575503
		NODE *f;
Packit 575503
		const char *sp;
Packit 575503
Packit 575503
		for (sp = sort_str; *sp != '\0' && ! isspace((unsigned char) *sp); sp++)
Packit 575503
			continue;
Packit 575503
Packit 575503
		/* empty string or string with space(s) not valid as function name */
Packit 575503
		if (sp == sort_str || *sp != '\0')
Packit 575503
			fatal(_("`%s' is invalid as a function name"), sort_str);
Packit 575503
Packit 575503
		f = lookup(sort_str);
Packit 575503
		if (f == NULL || f->type != Node_func)
Packit 575503
			fatal(_("sort comparison function `%s' is not defined"), sort_str);
Packit 575503
Packit 575503
		cmp_func = sort_user_func;
Packit 575503
Packit 575503
		/* need index and value pair in the list */
Packit 575503
		assoc_kind |= (AVALUE|AINDEX);
Packit 575503
		elem_size = 2;
Packit 575503
Packit 575503
		/* make function call instructions */
Packit 575503
		code = bcalloc(Op_func_call, 2, 0);
Packit 575503
		code->func_body = f;
Packit 575503
		code->func_name = NULL;		/* not needed, func_body already assigned */
Packit 575503
		(code + 1)->expr_count = 4;	/* function takes 4 arguments */
Packit 575503
		code->nexti = bcalloc(Op_stop, 1, 0);
Packit 575503
Packit 575503
		/*
Packit 575503
		 * make non-redirected getline, exit, `next' and `nextfile' fatal in
Packit 575503
		 * callback function by setting currule in interpret()
Packit 575503
		 * to undefined (0).
Packit 575503
		 */
Packit 575503
Packit 575503
		save_rule = currule;	/* save current rule */
Packit 575503
		currule = 0;
Packit 575503
Packit 575503
		PUSH_CODE(code);
Packit 575503
	}
Packit 575503
Packit 575503
	akind.flags = (unsigned int) assoc_kind;	/* kludge */
Packit 575503
	list = symbol->alist(symbol, & akind);
Packit 575503
	assoc_kind = (assoc_kind_t) akind.flags;	/* symbol->alist can modify it */
Packit 575503
Packit 575503
	/* check for empty list or unsorted, or list already sorted */
Packit 575503
	if (list != NULL && cmp_func != NULL && (assoc_kind & (AASC|ADESC)) == 0) {
Packit 575503
		num_elems = assoc_length(symbol);
Packit 575503
Packit 575503
		qsort(list, num_elems, elem_size * sizeof(NODE *), cmp_func); /* shazzam! */
Packit 575503
Packit 575503
		if (sort_ctxt == SORTED_IN && (assoc_kind & (AINDEX|AVALUE)) == (AINDEX|AVALUE)) {
Packit 575503
			/* relocate all index nodes to the first half of the list. */
Packit 575503
			for (j = 1; j < num_elems; j++)
Packit 575503
				list[j] = list[2 * j];
Packit 575503
Packit 575503
			/* give back extra memory */
Packit 575503
Packit 575503
			erealloc(list, NODE **, num_elems * sizeof(NODE *), "assoc_list");
Packit 575503
		}
Packit 575503
	}
Packit 575503
Packit 575503
	if (cmp_func == sort_user_func) {
Packit 575503
		code = POP_CODE();
Packit 575503
		currule = save_rule;            /* restore current rule */
Packit 575503
		bcfree(code->nexti);            /* Op_stop */
Packit 575503
		bcfree(code);                   /* Op_func_call */
Packit 575503
	}
Packit 575503
Packit 575503
	return list;
Packit 575503
}