field.c

/*
 * field.c - routines for dealing with fields and record parsing
 */

/*
 * Copyright (C) 1986, 1988, 1989, 1991-2023, 2025, 2026
 * 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, see <https://www.gnu.org/licenses/>.
 */

#include "awk.h"

/*
 * In case that the system doesn't have isblank().
 * Don't bother with autoconf ifdef junk, just force it.
 * See dfa.c and regex_internal.h and regcomp.c. Bleah.
 */
static int
is_blank(int c)
{
	return c == ' ' || c == '\t';
}

typedef void (* Setfunc)(long, char *, long, NODE *);

/* is the API currently overriding the default parsing mechanism? */
static bool api_parser_override = false;
typedef long (*parse_field_func_t)(long, char **, int, NODE *,
			     Regexp *, Setfunc, NODE *, NODE *, bool);
static parse_field_func_t parse_field;
/*
 * N.B. The normal_parse_field function pointer contains the parse_field value
 * that should be used except when API field parsing is overriding the default
 * field parsing mechanism.
 */
static parse_field_func_t normal_parse_field;
static long re_parse_field(long, char **, int, NODE *,
			     Regexp *, Setfunc, NODE *, NODE *, bool);
static long def_parse_field(long, char **, int, NODE *,
			      Regexp *, Setfunc, NODE *, NODE *, bool);
static long null_parse_field(long, char **, int, NODE *,
			     Regexp *, Setfunc, NODE *, NODE *, bool);
static long sc_parse_field(long, char **, int, NODE *,
			     Regexp *, Setfunc, NODE *, NODE *, bool);
static long fw_parse_field(long, char **, int, NODE *,
			     Regexp *, Setfunc, NODE *, NODE *, bool);
static long comma_parse_field(long, char **, int, NODE *,
			     Regexp *, Setfunc, NODE *, NODE *, bool);
static const awk_fieldwidth_info_t *api_fw = NULL;
static long fpat_parse_field(long, char **, int, NODE *,
			     Regexp *, Setfunc, NODE *, NODE *, bool);
static void set_element(long num, char * str, long len, NODE *arr);
static void grow_fields_arr(long num);
static void set_field(long num, char *str, long len, NODE *dummy);
static void set_comma_field(long num, char *str, long len, NODE *dummy);
static void purge_record(void);

static char *parse_extent;	/* marks where to restart parse of record */
static long parse_high_water = 0; /* field number that we have parsed so far */
static long nf_high_water = 0;	/* size of fields_arr */
static bool resave_fs;
static NODE *save_FS;		/* save current value of FS when line is read,
				 * to be used in deferred parsing
				 */
static NODE *save_FPAT;		/* save current value of FPAT when line is read,
				 * to be used in deferred parsing
				 */
static awk_fieldwidth_info_t *FIELDWIDTHS = NULL;

NODE **fields_arr;		/* array of pointers to the field nodes */
bool field0_valid;		/* $(>0) has not been changed yet */
static int default_FS;		/* true when FS == " " */
static Regexp *FS_re_yes_case = NULL;
static Regexp *FS_re_no_case = NULL;
static Regexp *FS_regexp = NULL;
static Regexp *FPAT_re_yes_case = NULL;
static Regexp *FPAT_re_no_case = NULL;
static Regexp *FPAT_regexp = NULL;
NODE *Null_field = NULL;

#define clear_mpfr(n) ((n)->flags &= ~(MPFN | MPZN | NUMCUR))

/* init_fields --- set up the fields array to start with */

void
init_fields()
{
	emalloc(fields_arr, NODE **, sizeof(NODE *));

	fields_arr[0] = make_string("", 0);
	fields_arr[0]->flags |= NULL_FIELD;

	parse_extent = fields_arr[0]->stptr;
	save_FS = dupnode(FS_node->var_value);

	Null_field = make_string("", 0);
	Null_field->flags = (STRCUR|STRING|NULL_FIELD); /* do not set MALLOC */

	field0_valid = true;
}

/* init_csv_fields --- set up to handle --csv */

void
init_csv_fields(void)
{
	if (do_csv)
		parse_field = comma_parse_field;
}

/*
 * CSV header support (the gawk --csv / -k extension).
 *
 * When CSV mode is active, the first record of each input file (FNR == 1) is
 * treated as a header line.  For every column we create an awk scalar
 * variable whose name is the column's header and whose value is the column's
 * 1-based number.  This lets a program refer to a column by name, e.g.
 * `$name', because evaluating `$name' uses the numeric value of `name' as the
 * field index.  The header record itself is left untouched and is still
 * presented to the program's rules.
 *
 * Header text that is not a valid awk identifier is sanitized (characters
 * that may not appear in an identifier become `_'; a name that is empty or
 * begins with a digit gets a leading `_') and a warning is issued.
 *
 * Two kinds of name clashes are resolved differently:
 *
 *   * Collision with an *existing* variable -- a -v assignment, a special
 *     variable, an array or a function -- would clobber data the user cares
 *     about.  We avoid it by prefixing the name with a single `_' (so `a'
 *     becomes `_a').  A name that was merely *referenced* in the program (and
 *     is therefore still undefined) is not a collision; that is what makes
 *     `gawk -k '{print $a}'` work.
 *
 *   * Duplicate header names within the same file get a trailing `_N' that
 *     counts up: for the header `a,b,b' the second `b' becomes `b_1', a third
 *     would become `b_2', and so on.  The same trailing-`_N' scheme breaks any
 *     residual tie, so a `_'-prefixed name that itself collides with an
 *     existing `_b' becomes `_b_1'.
 *
 * We remember every variable we install for the current file so that (a) the
 * trailing-`_N' duplicate logic can see them, and (b) they can be cleared when
 * the next file's header is processed (each file starts with a clean slate).
 */

static char **csv_header_vars = NULL;	/* names installed for the current file */
static long csv_header_count = 0;
static long csv_header_alloc = 0;

/* csv_header_is_ours --- true if NAME was installed for the current file */

static bool
csv_header_is_ours(const char *name)
{
	long i;

	for (i = 0; i < csv_header_count; i++)
		if (strcmp(csv_header_vars[i], name) == 0)
			return true;
	return false;
}

/* csv_header_remember --- record that we have installed variable NAME */

static void
csv_header_remember(const char *name)
{
	if (csv_header_is_ours(name))
		return;
	if (csv_header_count >= csv_header_alloc) {
		csv_header_alloc = (csv_header_alloc == 0) ? 8 : 2 * csv_header_alloc;
		erealloc(csv_header_vars, char **,
				csv_header_alloc * sizeof(char *));
	}
	emalloc(csv_header_vars[csv_header_count], char *, strlen(name) + 1);
	strcpy(csv_header_vars[csv_header_count], name);
	csv_header_count++;
}

/* csv_var_defined --- true if NAME is currently a variable with a value */

static bool
csv_var_defined(const char *name)
{
	NODE *r = lookup(name);

	if (r == NULL)
		return false;		/* not known at all */
	if (r->type == Node_var_new)
		return false;		/* referenced in the program but never set */
	if (r->type == Node_var && var_uninitialized(r))
		return false;		/* read at runtime but never assigned a value */
	return true;			/* assigned scalar, array, function, ... */
}

/* csv_script_var_exists --- true if NAME is a variable we did not create
 *
 * This is the "collision with an existing variable" test that triggers the
 * `_' prefix.  Variables we installed for the current header do not count.
 */

static bool
csv_script_var_exists(const char *name)
{
	return csv_var_defined(name) && ! csv_header_is_ours(name);
}

/* csv_name_taken --- true if NAME cannot be used as-is for a new column */

static bool
csv_name_taken(const char *name)
{
	return csv_header_is_ours(name) || csv_var_defined(name);
}

/* csv_clear_var --- reset variable NAME to the undefined state */

static void
csv_clear_var(const char *name)
{
	NODE *var = lookup(name);

	if (var != NULL && var->type == Node_var) {
		unref(var->var_value);
		var->var_value = dupnode(Nnull_string);
	}
}

/* csv_clear_previous_headers --- forget (and undefine) the prior file's columns */

static void
csv_clear_previous_headers(void)
{
	long i;

	for (i = 0; i < csv_header_count; i++) {
		csv_clear_var(csv_header_vars[i]);
		efree(csv_header_vars[i]);
	}
	csv_header_count = 0;
}

/* csv_sanitize_name --- turn header text into a valid awk identifier
 *
 * Returns a malloc'd NUL-terminated string the caller must efree().  The flag
 * out-parameters report why (if at all) the text had to be altered, so the
 * caller can warn about it.
 */

static char *
csv_sanitize_name(const char *hdr, size_t len,
		bool *is_empty, bool *leading_digit, bool *has_special)
{
	char *buf;
	size_t i, j;
	bool need_underscore;

	*is_empty = (len == 0);
	*leading_digit = (len > 0 && hdr[0] >= '0' && hdr[0] <= '9');
	*has_special = false;

	/* an identifier must start with a letter or `_', never a digit */
	need_underscore = (*is_empty || *leading_digit);

	emalloc(buf, char *, len + 2);	/* +1 for a leading `_', +1 for NUL */
	j = 0;
	if (need_underscore)
		buf[j++] = '_';
	for (i = 0; i < len; i++) {
		unsigned char c = (unsigned char) hdr[i];

		if (is_identchar(c))
			buf[j++] = (char) c;
		else {
			buf[j++] = '_';
			*has_special = true;
		}
	}
	buf[j] = '\0';
	return buf;
}

/* csv_assign_var --- create or update scalar NAME with numeric value COLNUM */

static void
csv_assign_var(const char *name, long colnum)
{
	NODE *var;
	NODE **lhs;
	char *dupname;

	emalloc(dupname, char *, strlen(name) + 1);
	strcpy(dupname, name);

	/* variable() looks NAME up or installs it, and takes ownership of dupname */
	var = variable(0, dupname, Node_var_new);
	if (var == NULL)	/* should not happen for a valid identifier */
		return;

	lhs = r_get_lhs(var, false);	/* promotes a Node_var_new to Node_var */
	unref(*lhs);
	*lhs = make_number((double) colnum);
	if (var->type == Node_var && var->var_assign != NULL)
		var->var_assign();
}

/* csv_resolve_name --- pick the final variable name for one column
 *
 * BASE is the sanitized header.  Returns a malloc'd name the caller efree()s.
 * Applies the `_' prefix for a collision with an existing variable, then a
 * trailing `_N' for duplicate headers or any remaining clash, warning as it
 * goes.  COL is the column number and ORIG/ORIGLEN the raw header text, both
 * only used for the warning messages.
 */

static char *
csv_resolve_name(const char *base, long col, const char *orig, size_t origlen)
{
	char *candidate;
	char *final;
	long n;

	/* `_' prefix when BASE clashes with a variable we did not create */
	if (csv_script_var_exists(base)) {
		emalloc(candidate, char *, strlen(base) + 2);
		candidate[0] = '_';
		strcpy(candidate + 1, base);

		warning(_("csv: header `%.*s' (column %ld) collides with an "
			  "existing variable; using `%s'"),
			(int) origlen, orig, col, candidate);
	} else {
		emalloc(candidate, char *, strlen(base) + 1);
		strcpy(candidate, base);
	}

	/* trailing `_N' for a duplicate header or any leftover clash */
	emalloc(final, char *, strlen(candidate) + 1);
	strcpy(final, candidate);
	for (n = 1; csv_name_taken(final); n++) {
		efree(final);
		emalloc(final, char *, strlen(candidate) + 24);
		sprintf(final, "%s_%ld", candidate, n);
	}

	if (strcmp(final, candidate) != 0)
		warning(_("csv: duplicate header `%.*s' (column %ld); using `%s'"),
			(int) origlen, orig, col, final);

	efree(candidate);
	return final;
}

/* set_csv_headers --- assign column-name variables from the header record */

void
set_csv_headers(void)
{
	long col;

	/* a new file starts fresh: undefine the previous file's column vars */
	csv_clear_previous_headers();

	/* force the record to be split into fields, setting NF */
	(void) get_field(UNLIMITED - 1, NULL);

	for (col = 1; col <= NF; col++) {
		NODE *f = force_string(fields_arr[col]);
		bool is_empty, leading_digit, has_special;
		char *base;
		char *name;

		base = csv_sanitize_name(f->stptr, f->stlen,
				&is_empty, &leading_digit, &has_special);

		/* warn about headers that are not valid identifiers */
		if (is_empty)
			warning(_("csv: column %ld has an empty header; using `%s'"),
				col, base);
		else if (leading_digit)
			warning(_("csv: header `%.*s' (column %ld) starts with a "
				  "digit; using `%s'"),
				(int) f->stlen, f->stptr, col, base);
		else if (has_special)
			warning(_("csv: header `%.*s' (column %ld) contains "
				  "characters not allowed in a variable name; "
				  "using `%s'"),
				(int) f->stlen, f->stptr, col, base);

		name = csv_resolve_name(base, col, f->stptr, f->stlen);

		csv_assign_var(name, col);
		csv_header_remember(name);

		efree(name);
		efree(base);
	}
}

/* grow_fields --- acquire new fields as needed */

static void
grow_fields_arr(long num)
{
	int t;
	NODE *n;

	erealloc(fields_arr, NODE **, (num + 1) * sizeof(NODE *));
	for (t = nf_high_water + 1; t <= num; t++) {
		getnode(n);
		*n = *Null_field;
		fields_arr[t] = n;
	}
	nf_high_water = num;
}

/* set_field --- set the value of a particular field */

/*ARGSUSED*/
static void
set_field(long num,
	char *str,
	long len,
	NODE *dummy ATTRIBUTE_UNUSED)	/* just to make interface same as set_element */
{
	NODE *n;

	if (num > nf_high_water)
		grow_fields_arr(num);
	n = fields_arr[num];
	n->stptr = str;
	n->stlen = len;
	n->flags = (STRCUR|STRING|USER_INPUT);	/* do not set MALLOC */
}

/* set_comma_field --- set the value of a particular field, coming from CSV */

/*ARGSUSED*/
static void
set_comma_field(long num,
	char *str,
	long len,
	NODE *dummy ATTRIBUTE_UNUSED)	/* just to make interface same as set_element */
{
	NODE *n;
	NODE *val = make_string(str, len);

	if (num > nf_high_water)
		grow_fields_arr(num);
	n = fields_arr[num];
	n->stptr = val->stptr;
	n->stlen = val->stlen;
	n->flags = (STRCUR|STRING|USER_INPUT|MALLOC);
	freenode(val);
}

/* rebuild_record --- Someone assigned a value to $(something).
			Fix up $0 to be right */

void
rebuild_record()
{
	/*
	 * use explicit unsigned longs for lengths, in case
	 * a size_t isn't big enough.
	 */
	unsigned long tlen;
	NODE *tmp;
	char *ops;
	char *cops;
	long i;

	assert(NF != -1);

	tlen = 0;
	for (i = NF; i > 0; i--) {
		tmp = fields_arr[i];
		tmp = force_string(tmp);
		tlen += tmp->stlen;
	}
	tlen += (NF - 1) * OFSlen;
	if ((long) tlen < 0)
		tlen = 0;
	emalloc(ops, char *, tlen + 1);
	cops = ops;
	ops[0] = '\0';
	for (i = 1;  i <= NF; i++) {
		free_wstr(fields_arr[i]);
		tmp = fields_arr[i];
		/* copy field */
		if (tmp->stlen == 1)
			*cops++ = tmp->stptr[0];
		else if (tmp->stlen != 0) {
			memcpy(cops, tmp->stptr, tmp->stlen);
			cops += tmp->stlen;
		}
		/* copy OFS */
		if (i != NF) {
			if (OFSlen == 1)
				*cops++ = *OFS;
			else if (OFSlen != 0) {
				memcpy(cops, OFS, OFSlen);
				cops += OFSlen;
			}
		}
	}
	tmp = make_str_node(ops, tlen, ALREADY_MALLOCED);

	/*
	 * Since we are about to unref fields_arr[0], we want to find
	 * any fields that still point into it, and have them point
	 * into the new field zero.  This has to be done intelligently,
	 * so that unrefing a field doesn't try to unref into the old $0.
	 */
	for (cops = ops, i = 1; i <= NF; i++) {
		NODE *r = fields_arr[i];
		/*
		 * There is no reason to copy malloc'ed fields to point into
		 * the new $0 buffer, although that's how previous versions did
		 * it. It seems faster to leave the malloc'ed fields in place.
		 */
		if (r->stlen > 0 && (r->flags & MALLOC) == 0) {
			NODE *n;
			getnode(n);

			*n = *r;
			if (r->valref > 1) {
				/*
				 * This can and does happen.  It seems clear that
				 * we can't leave r's stptr pointing into the
				 * old $0 buffer that we are about to unref.
				 */
				emalloc(r->stptr, char *, r->stlen + 1);
				memcpy(r->stptr, cops, r->stlen);
				r->stptr[r->stlen] = '\0';
				r->flags |= MALLOC;

				n->valref = 1;	// reset in the new field to start it off correctly!
			}

			n->stptr = cops;
			clear_mpfr(n);
			unref(r);
			fields_arr[i] = n;
			assert((n->flags & WSTRCUR) == 0);
		}
		cops += fields_arr[i]->stlen + OFSlen;
	}

	assert((fields_arr[0]->flags & MALLOC) == 0
		? fields_arr[0]->valref == 1
		: true);

	unref(fields_arr[0]);

	fields_arr[0] = tmp;
	field0_valid = true;
}

/*
 * set_record:
 * setup $0, but defer parsing rest of line until reference is made to $(>0)
 * or to NF.  At that point, parse only as much as necessary.
 *
 * Manage a private buffer for the contents of $0.  Doing so keeps us safe
 * if `getline var' decides to rearrange the contents of the IOBUF that
 * $0 might have been pointing into.  The cost is the copying of the buffer;
 * but better correct than fast.
 */
void
set_record(const char *buf, size_t cnt, const awk_fieldwidth_info_t *fw)
{
	NODE *n;
	static char *databuf;
	static size_t databuf_size;
#define INITIAL_SIZE	512
#define MAX_SIZE	((size_t) ~0)	/* maximally portable ... */

	purge_record();

	/* buffer management: */
	if (databuf_size == 0) {	/* first time */
		ezalloc(databuf, char *, INITIAL_SIZE);
		databuf_size = INITIAL_SIZE;
	}
	/*
	 * Make sure there's enough room. Since we sometimes need
	 * to place a sentinel at the end, we make sure
	 * databuf_size is > cnt after allocation.
	 */
	if (cnt >= databuf_size) {
		do {
			if (databuf_size > MAX_SIZE/2)
				fatal(_("input record too large"));
			databuf_size *= 2;
		} while (cnt >= databuf_size);
		erealloc(databuf, char *, databuf_size);
		memset(databuf, '\0', databuf_size);
	}
	/* copy the data */
	if (cnt != 0) {
		memcpy(databuf, buf, cnt);
	}

	/*
	 * Add terminating '\0' so that C library routines
	 * will know when to stop.
	 */
	databuf[cnt] = '\0';

	/* manage field 0: */
	assert((fields_arr[0]->flags & MALLOC) == 0
		? fields_arr[0]->valref == 1
		: true);

	unref(fields_arr[0]);
	getnode(n);
	memset(n, '\0', sizeof(NODE));
	n->stptr = databuf;
	n->stlen = cnt;
	n->valref = 1;
	n->type = Node_val;
	n->stfmt = STFMT_UNUSED;
#ifdef HAVE_MPFR
	n->strndmode = MPFR_round_mode;
#endif
	n->flags = (STRING|STRCUR|USER_INPUT);	/* do not set MALLOC */
	fields_arr[0] = n;
	if (fw != api_fw) {
		if ((api_fw = fw) != NULL) {
			if (! api_parser_override) {
				api_parser_override = true;
				parse_field = fw_parse_field;
				update_PROCINFO_str("FS", "API");
			}
		} else if (api_parser_override) {
			api_parser_override = false;
			parse_field = normal_parse_field;
			update_PROCINFO_str("FS", current_field_sep_str());
		}
	}

#undef INITIAL_SIZE
#undef MAX_SIZE
}

/* reset_record --- start over again with current $0 */

void
reset_record()
{
	fields_arr[0] = force_string(fields_arr[0]);
	purge_record();
	if (api_parser_override) {
		api_parser_override = false;
		parse_field = normal_parse_field;
		update_PROCINFO_str("FS", current_field_sep_str());
	}
}

/*
 * purge_record --- throw away the fields, make sure that
 * 	individual nodes remain valid.
 */

static void
purge_record()
{
	int i;

	NF = -1;
	for (i = 1; i <= parse_high_water; i++) {
		NODE *n;
		NODE *r = fields_arr[i];
		if ((r->flags & MALLOC) == 0 && r->valref > 1) {
			/* This can and does happen. We must copy the string! */
			const char *save = r->stptr;
			emalloc(r->stptr, char *, r->stlen + 1);
			memcpy(r->stptr, save, r->stlen);
			r->stptr[r->stlen] = '\0';
			r->flags |= MALLOC;
		}
		unref(r);
		getnode(n);
		*n = *Null_field;
		fields_arr[i] = n;
	}

	parse_high_water = 0;
	/*
	 * $0 = $0 should resplit using the current value of FS.
	 */
	if (resave_fs) {
		resave_fs = false;
		unref(save_FS);
		save_FS = dupnode(FS_node->var_value);
	}

	field0_valid = true;
}

/* set_NF --- handle what happens to $0 and fields when NF is changed */

void
set_NF()
{
	int i;
	long nf;
	NODE *n;

	assert(NF != -1);

	(void) force_number(NF_node->var_value);
	nf = get_number_si(NF_node->var_value);
	if (nf < 0)
		fatal(_("NF set to negative value"));

	static bool warned = false;
	if (do_lint && NF > nf && ! warned) {
		warned = true;
		lintwarn(_("decrementing NF is not portable to many awk versions"));
	}

	NF = nf;

	if (NF > nf_high_water)
		grow_fields_arr(NF);
	if (parse_high_water < NF) {
		for (i = parse_high_water + 1; i >= 0 && i <= NF; i++) {
			unref(fields_arr[i]);
			getnode(n);
			*n = *Null_field;
			fields_arr[i] = n;
		}
		parse_high_water = NF;
	} else if (parse_high_water > 0) {
		for (i = NF + 1; i >= 0 && i <= parse_high_water; i++) {
			unref(fields_arr[i]);
			getnode(n);
			*n = *Null_field;
			fields_arr[i] = n;
		}
		parse_high_water = NF;
	}
	field0_valid = false;
}

/*
 * re_parse_field --- parse fields using a regexp.
 *
 * This is called both from get_field() and from do_split()
 * via (*parse_field)().  This variation is for when FS is a regular
 * expression -- either user-defined or because RS=="" and FS==" "
 */
static long
re_parse_field(long up_to,	/* parse only up to this field number */
	char **buf,	/* on input: string to parse; on output: point to start next */
	int len,
	NODE *fs ATTRIBUTE_UNUSED,
	Regexp *rp,
	Setfunc set,	/* routine to set the value of the parsed field */
	NODE *n,
	NODE *sep_arr,  /* array of field separators (maybe NULL) */
	bool in_middle)
{
	char *scan = *buf;
	long nf = parse_high_water;
	char *field;
	char *end = scan + len;
	int regex_flags = RE_NEED_START;
	char *sep;
	size_t mbclen = 0;
	mbstate_t mbs;

	memset(&mbs, 0, sizeof(mbstate_t));

	if (in_middle)
		regex_flags |= RE_NO_BOL;

	if (up_to == UNLIMITED)
		nf = 0;
	if (len == 0)
		return nf;

	bool default_field_splitting = (RS_is_null && default_FS);

	if (default_field_splitting) {
		sep = scan;
		while (scan < end && (*scan == ' ' || *scan == '\t' || *scan == '\n'))
			scan++;
		if (sep_arr != NULL && sep < scan)
			set_element(nf, sep, (long)(scan - sep), sep_arr);
	}

	if (rp == NULL) /* use FS */
		rp = FS_regexp;

	field = scan;
	while (scan < end
	       && research(rp, scan, 0, (end - scan), regex_flags) != -1
	       && nf < up_to) {
		regex_flags |= RE_NO_BOL;
		if (REEND(rp, scan) == RESTART(rp, scan)) {   /* null match */
			if (gawk_mb_cur_max > 1)	{
				mbclen = mbrlen(scan, end-scan, &mbs);
				if ((mbclen == 1) || (mbclen == (size_t) -1)
					|| (mbclen == (size_t) -2) || (mbclen == 0)) {
					/* We treat it as a singlebyte character.  */
					mbclen = 1;
				}
				scan += mbclen;
			} else
				scan++;
			if (scan == end) {
				(*set)(++nf, field, (long)(scan - field), n);
				up_to = nf;
				break;
			}
			continue;
		}
		(*set)(++nf, field,
		       (long)(scan + RESTART(rp, scan) - field), n);
		if (sep_arr != NULL)
	    		set_element(nf, scan + RESTART(rp, scan),
           			(long) (REEND(rp, scan) - RESTART(rp, scan)), sep_arr);
		scan += REEND(rp, scan);
		field = scan;
		if (scan == end && ! default_field_splitting)	/* FS at end of record */
			(*set)(++nf, field, 0L, n);
	}
	if (nf != up_to && scan < end) {
		(*set)(++nf, scan, (long)(end - scan), n);
		scan = end;
	}
	*buf = scan;
	return nf;
}

/*
 * def_parse_field --- default field parsing.
 *
 * This is called both from get_field() and from do_split()
 * via (*parse_field)().  This variation is for when FS is a single space
 * character.
 */

static long
def_parse_field(long up_to,	/* parse only up to this field number */
	char **buf,	/* on input: string to parse; on output: point to start next */
	int len,
	NODE *fs,
	Regexp *rp ATTRIBUTE_UNUSED,
	Setfunc set,	/* routine to set the value of the parsed field */
	NODE *n,
	NODE *sep_arr,  /* array of field separators (maybe NULL) */
	bool in_middle ATTRIBUTE_UNUSED)
{
	char *scan = *buf;
	long nf = parse_high_water;
	char *field;
	char *end = scan + len;
	char sav;
	char *sep;

	if (up_to == UNLIMITED)
		nf = 0;
	if (len == 0)
		return nf;

	/*
	 * Nasty special case. If FS set to "", return whole record
	 * as first field. This is not worth a separate function.
	 */
	if (fs->stlen == 0) {
		(*set)(++nf, *buf, len, n);
		*buf += len;
		return nf;
	}

	/* before doing anything save the char at *end */
	sav = *end;
	/* because it will be destroyed now: */

	*end = ' ';	/* sentinel character */
	sep = scan;
	for (; nf < up_to; scan++) {
		/*
		 * special case:  fs is single space, strip leading whitespace
		 */
		while (scan < end && (*scan == ' ' || *scan == '\t' || *scan == '\n'))
			scan++;

		if (sep_arr != NULL && scan > sep)
			set_element(nf, sep, (long) (scan - sep), sep_arr);

		if (scan >= end)
			break;

		field = scan;

		while (*scan != ' ' && *scan != '\t' && *scan != '\n')
			scan++;

		(*set)(++nf, field, (long)(scan - field), n);

		if (scan == end)
			break;

		sep = scan;
	}

	/* everything done, restore original char at *end */
	*end = sav;

	*buf = scan;
	return nf;
}

/*
 * null_parse_field --- each character is a separate field
 *
 * This is called both from get_field() and from do_split()
 * via (*parse_field)().  This variation is for when FS is the null string.
 */
static long
null_parse_field(long up_to,	/* parse only up to this field number */
	char **buf,	/* on input: string to parse; on output: point to start next */
	int len,
	NODE *fs ATTRIBUTE_UNUSED,
	Regexp *rp ATTRIBUTE_UNUSED,
	Setfunc set,	/* routine to set the value of the parsed field */
	NODE *n,
	NODE *sep_arr,  /* array of field separators (maybe NULL) */
	bool in_middle ATTRIBUTE_UNUSED)
{
	char *scan = *buf;
	long nf = parse_high_water;
	char *end = scan + len;

	if (up_to == UNLIMITED)
		nf = 0;
	if (len == 0)
		return nf;

	if (gawk_mb_cur_max > 1) {
		mbstate_t mbs;
		memset(&mbs, 0, sizeof(mbstate_t));
		for (; nf < up_to && scan < end;) {
			size_t mbclen = mbrlen(scan, end-scan, &mbs);
			if ((mbclen == 1) || (mbclen == (size_t) -1)
				|| (mbclen == (size_t) -2) || (mbclen == 0)) {
				/* We treat it as a singlebyte character.  */
				mbclen = 1;
			}
			if (sep_arr != NULL && nf > 0)
				set_element(nf, scan, 0L, sep_arr);
			(*set)(++nf, scan, mbclen, n);
			scan += mbclen;
		}
	} else {
		for (; nf < up_to && scan < end; scan++) {
			if (sep_arr != NULL && nf > 0)
				set_element(nf, scan, 0L, sep_arr);
			(*set)(++nf, scan, 1L, n);
		}
	}

	*buf = scan;
	return nf;
}

/*
 * sc_parse_field --- single character field separator
 *
 * This is called both from get_field() and from do_split()
 * via (*parse_field)().  This variation is for when FS is a single character
 * other than space.
 */
static long
sc_parse_field(long up_to,	/* parse only up to this field number */
	char **buf,	/* on input: string to parse; on output: point to start next */
	int len,
	NODE *fs,
	Regexp *rp ATTRIBUTE_UNUSED,
	Setfunc set,	/* routine to set the value of the parsed field */
	NODE *n,
	NODE *sep_arr,  /* array of field separators (maybe NULL) */
	bool in_middle ATTRIBUTE_UNUSED)
{
	char *scan = *buf;
	char fschar;
	long nf = parse_high_water;
	char *field;
	char *end = scan + len;
	char sav;
	size_t mbclen = 0;
	mbstate_t mbs;

	memset(&mbs, 0, sizeof(mbstate_t));

	if (up_to == UNLIMITED)
		nf = 0;
	if (len == 0)
		return nf;

	if (RS_is_null && fs->stlen == 0)
		fschar = '\n';
	else
		fschar = fs->stptr[0];

	/* before doing anything save the char at *end */
	sav = *end;
	/* because it will be destroyed now: */
	*end = fschar;	/* sentinel character */

	for (; nf < up_to;) {
		field = scan;
		if (gawk_mb_cur_max > 1) {
			while (*scan != fschar) {
				mbclen = mbrlen(scan, end-scan, &mbs);
				if ((mbclen == 1) || (mbclen == (size_t) -1)
					|| (mbclen == (size_t) -2) || (mbclen == 0)) {
					/* We treat it as a singlebyte character.  */
					mbclen = 1;
				}
				scan += mbclen;
			}
		} else {
			while (*scan != fschar)
				scan++;
		}
		(*set)(++nf, field, (long)(scan - field), n);
		if (scan == end)
			break;
		if (sep_arr != NULL)
			set_element(nf, scan, 1L, sep_arr);
		scan++;
		if (scan == end) {	/* FS at end of record */
			(*set)(++nf, field, 0L, n);
			break;
		}
	}

	/* everything done, restore original char at *end */
	*end = sav;

	*buf = scan;
	return nf;
}

/*
 * comma_parse_field --- CSV parsing same as BWK awk.
 *
 * This is called both from get_field() and from do_split()
 * via (*parse_field)().  This does very basic CSV parsing, the same as
 * BWK awk.  The field delimiter defaults to a comma but, as a gawk
 * extension, it can be changed to any single character via FS, so that
 * semicolon- or tab-separated files (etc.) can also be parsed in CSV mode.
 * A default (single space) FS keeps the RFC-compliant comma; a value that
 * is not a single character cannot be a CSV delimiter and is rejected with
 * a warning, falling back to a comma.
 */

static long
comma_parse_field(long up_to,	/* parse only up to this field number */
	char **buf,	/* on input: string to parse; on output: point to start next */
	int len,
	NODE *fs,
	Regexp *rp ATTRIBUTE_UNUSED,
	Setfunc set,	/* routine to set the value of the parsed field */
	NODE *n,
	NODE *sep_arr,  /* array of field separators (maybe NULL) */
	bool in_middle ATTRIBUTE_UNUSED)
{
	char *scan = *buf;
	char comma = ',';	/* the CSV delimiter; comma unless FS says otherwise */
	long nf = parse_high_water;
	char *end = scan + len;

	static char *newfield = NULL;
	static size_t buflen = 0;

	/*
	 * Derive the delimiter from FS.  A single non-space character is used
	 * as-is; the default (a single space) keeps the comma; anything else
	 * (the empty string, a multi-character string, or a regexp) cannot be
	 * a CSV delimiter, so warn once and keep the comma.
	 */
	if (fs != NULL && fs->stlen == 1 && (fs->flags & REGEX) == 0) {
		if (fs->stptr[0] != ' ')
			comma = fs->stptr[0];
	} else if (fs != NULL && (fs->stlen > 1 || (fs->flags & REGEX) != 0)) {
		static bool warned = false;

		if (! warned) {
			warned = true;
			warning(_("--csv: FS must be a single character; "
				  "ignoring `%.*s' and using a comma"),
				(int) fs->stlen, fs->stptr);
		}
	}

	if (newfield == NULL) {
		emalloc(newfield, char *, BUFSIZ);
		buflen = BUFSIZ;
	}

	if (set == set_field)	// not an array element
		set = set_comma_field;

	if (up_to == UNLIMITED)
		nf = 0;

	if (len == 0) {
		// Don't set the field.
		//	echo | gawk --csv '{ print NF }'
		// should print 0.
		return nf;
	}

	for (; nf < up_to;) {
		char *new_end = newfield;
		memset(newfield, '\0', buflen);

		while (*scan != comma && scan < end) {
			if (*scan == '"') {
				for (scan++; scan < end;) {
					// grow buffer if needed
					if (new_end >= newfield + buflen) {
						size_t offset = buflen;

						buflen *= 2;
						erealloc(newfield, char *, buflen);
						new_end = newfield + offset;
					}

					if (*scan == '"' && scan[1] == '"') {	// "" -> "
						*new_end++ = '"';
						scan += 2;
					} else if (*scan == '"' && (scan == end-1 || scan[1] == comma)) {
						// close of quoted string
						scan++;
						break;
					} else {
						*new_end++ = *scan++;
					}
				}
			} else {
				// unquoted field
				while (*scan != comma && scan < end) {
					// grow buffer if needed
					if (new_end >= newfield + buflen) {
						size_t offset = buflen;

						buflen *= 2;
						erealloc(newfield, char *, buflen);
						new_end = newfield + offset;
					}
					*new_end++ = *scan++;
				}
			}
		}

		(*set)(++nf, newfield, (long)(new_end - newfield), n);

		if (scan == end)
			break;

		if (scan == *buf) {
			scan++;
			continue;
		}

		scan++;
		if (scan == end) {	/* FS at end of record */
			(*set)(++nf, newfield, 0L, n);
			break;
		}
	}

	*buf = scan;
	return nf;
}

/*
 * calc_mbslen --- calculate the length in bytes of a multi-byte string
 * containing len characters.
 */

static size_t
calc_mbslen(char *scan, char *end, size_t len, mbstate_t *mbs)
{

	size_t mbclen;
	char *mbscan = scan;

	while (len-- > 0 && mbscan < end) {
		mbclen = mbrlen(mbscan, end - mbscan, mbs);
		if (!(mbclen > 0 && mbclen <= (size_t)(end - mbscan)))
			/*
			 * We treat it as a singlebyte character. This should
			 * catch error codes 0, (size_t) -1, and (size_t) -2.
			 */
			mbclen = 1;
		mbscan += mbclen;
	}
	return mbscan - scan;
}

/*
 * fw_parse_field --- field parsing using FIELDWIDTHS spec
 *
 * This is called from get_field() via (*parse_field)().
 * This variation is for fields are fixed widths.
 */
static long
fw_parse_field(long up_to,	/* parse only up to this field number */
	char **buf,	/* on input: string to parse; on output: point to start next */
	int len,
	NODE *fs ATTRIBUTE_UNUSED,
	Regexp *rp ATTRIBUTE_UNUSED,
	Setfunc set,	/* routine to set the value of the parsed field */
	NODE *n,
	NODE *dummy ATTRIBUTE_UNUSED, /* sep_arr not needed here: hence dummy */
	bool in_middle ATTRIBUTE_UNUSED)
{
	char *scan = *buf;
	long nf = parse_high_water;
	char *end = scan + len;
	const awk_fieldwidth_info_t *fw;
	mbstate_t mbs;
	size_t skiplen;
	size_t flen;

	fw = (api_parser_override ? api_fw : FIELDWIDTHS);

	if (up_to == UNLIMITED)
		nf = 0;
	if (len == 0)
		return nf;
	if (gawk_mb_cur_max > 1 && fw->use_chars) {
		/*
		 * Reset the shift state. Arguably, the shift state should
		 * be part of the file state and carried forward at all times,
		 * but nobody has complained so far, so this may not matter
		 * in practice.
		 */
		memset(&mbs, 0, sizeof(mbstate_t));
		while (nf < up_to && scan < end) {
			if (nf >= fw->nf) {
				*buf = end;
				return nf;
			}
			scan += calc_mbslen(scan, end, fw->fields[nf].skip, &mbs);
			flen = calc_mbslen(scan, end, fw->fields[nf].len, &mbs);
			(*set)(++nf, scan, (long) flen, n);
			scan += flen;
		}
	} else {
		while (nf < up_to && scan < end) {
			if (nf >= fw->nf) {
				*buf = end;
				return nf;
			}
			skiplen = fw->fields[nf].skip;
			if (skiplen > end - scan)
				skiplen = end - scan;
			scan += skiplen;
			flen = fw->fields[nf].len;
			if (flen > end - scan)
				flen = end - scan;
			(*set)(++nf, scan, (long) flen, n);
			scan += flen;
		}
	}
	*buf = scan;
	return nf;
}

/* invalidate_field0 --- $0 needs reconstruction */

static void
invalidate_field0()
{
	field0_valid = false;
}

/* get_field --- return a particular $n */

/* assign is not NULL if this field is on the LHS of an assign */

NODE **
get_field(long requested, Func_ptr *assign)
{
	bool in_middle = false;
	static bool warned = false;
	extern int currule;
	NODE *saved_fs;
	Regexp *fs_regexp;

	if (do_lint && currule == END && ! warned) {
		warned = true;
		lintwarn(_("accessing fields from an END rule may not be portable"));
	}

	/*
	 * if requesting whole line but some other field has been altered,
	 * then the whole line must be rebuilt
	 */
	if (requested == 0) {
		if (! field0_valid) {
			/* first, parse remainder of input record */
			if (NF == -1) {
				in_middle = (parse_high_water != 0);
				if (current_field_sep() == Using_FPAT) {
					saved_fs = save_FPAT;
					fs_regexp = FPAT_regexp;
				} else {
					saved_fs = save_FS;
					fs_regexp = FS_regexp;
				}
				NF = (*parse_field)(UNLIMITED - 1, &parse_extent,
		    			fields_arr[0]->stlen -
					(parse_extent - fields_arr[0]->stptr),
					saved_fs, fs_regexp, set_field,
					(NODE *) NULL,
					(NODE *) NULL,
					in_middle);
				parse_high_water = NF;
			}
			rebuild_record();
		}
		if (assign != NULL)
			*assign = reset_record;
		return &fields_arr[0];
	}

	/* assert(requested > 0); */

#if 0
	if (assign != NULL)
		field0_valid = false;		/* $0 needs reconstruction */
#else
	/*
	 * Keep things uniform. Also, mere intention of assigning something
	 * to $n should not make $0 invalid. Makes sense to invalidate $0
	 * after the actual assignment is performed. Not a real issue in
	 * the interpreter otherwise, but causes problem in the
	 * debugger when watching or printing fields.
	 */

	if (assign != NULL)
		*assign = invalidate_field0;	/* $0 needs reconstruction */
#endif

	if (requested <= parse_high_water)	/* already parsed this field */
		return &fields_arr[requested];

	if (NF == -1) {	/* have not yet parsed to end of record */
		/*
		 * parse up to requested fields, calling set_field() for each,
		 * saving in parse_extent the point where the parse left off
		 */
		if (parse_high_water == 0)	/* starting at the beginning */
			parse_extent = fields_arr[0]->stptr;
		else
			in_middle = true;
		parse_high_water = (*parse_field)(requested, &parse_extent,
		     fields_arr[0]->stlen - (parse_extent - fields_arr[0]->stptr),
		     save_FS, NULL, set_field, (NODE *) NULL, (NODE *) NULL, in_middle);

		/*
		 * if we reached the end of the record, set NF to the number of
		 * fields so far.  Note that requested might actually refer to
		 * a field that is beyond the end of the record, but we won't
		 * set NF to that value at this point, since this is only a
		 * reference to the field and NF only gets set if the field
		 * is assigned to -- this case is handled below
		 */
		if (parse_extent == fields_arr[0]->stptr + fields_arr[0]->stlen)
			NF = parse_high_water;
		if (requested == UNLIMITED - 1)	/* UNLIMITED-1 means set NF */
			requested = parse_high_water;
	}
	if (parse_high_water < requested) { /* requested beyond end of record */
		if (assign != NULL) {	/* expand record */
			if (requested > nf_high_water)
				grow_fields_arr(requested);

			NF = requested;
			parse_high_water = requested;
		} else
			return &Null_field;
	}

	return &fields_arr[requested];
}

/* set_element --- set an array element, used by do_split() */

static void
set_element(long num, char *s, long len, NODE *n)
{
	NODE *it;
	NODE *sub;

	it = make_string(s, len);
	it->flags |= USER_INPUT;
	sub = make_number(num);
	assoc_set(n, sub, it);
}

/* do_split --- implement split(), semantics are same as for field splitting */

NODE *
do_split(int nargs)
{
	NODE *src, *arr, *sep, *fs, *tmp, *sep_arr = NULL;
	char *s;
	long (*parseit)(long, char **, int, NODE *,
			 Regexp *, Setfunc, NODE *, NODE *, bool);
	Regexp *rp = NULL;

	check_args_min_max(nargs, "split", 3, 4);

	if (nargs == 4) {
		static bool warned = false;

		if (do_traditional) {
			fatal(_("split: fourth argument is a gawk extension"));
		}
		sep_arr = POP_PARAM();
		if (sep_arr->type != Node_var_array)
			fatal(_("split: fourth argument is not an array"));
		check_symtab_functab(sep_arr, "split",
				_("%s: cannot use %s as fourth argument"));
		if (do_lint_extensions && ! warned) {
			warned = true;
			lintwarn(_("split: fourth argument is a gawk extension"));
		}
	}

	sep = POP();
	arr = POP_PARAM();
	if (arr->type != Node_var_array)
		fatal(_("split: second argument is not an array"));
	check_symtab_functab(arr, "split",
			_("%s: cannot use %s as second argument"));

	// Someone passed an array element to be turned into
	// a subarray, so let's warn about it.
	static bool warned = false;
	if (do_lint_extensions && ! warned && arr->parent_array != NULL) {
		warned = true;
		lintwarn(_("multidimensional arrays are a gawk extension"));
	}

	if (sep_arr != NULL) {
		if (sep_arr == arr)
			fatal(_("split: cannot use the same array for second and fourth args"));

		/* This checks need to be done before clearing any of the arrays */
		for (tmp = sep_arr->parent_array; tmp != NULL; tmp = tmp->parent_array)
			if (tmp == arr)
				fatal(_("split: cannot use a subarray of second arg for fourth arg"));
		for (tmp = arr->parent_array; tmp != NULL; tmp = tmp->parent_array)
			if (tmp == sep_arr)
				fatal(_("split: cannot use a subarray of fourth arg for second arg"));
		assoc_clear(sep_arr);
	}
	assoc_clear(arr);

	src = TOP_STRING();
	if (src->stlen == 0) {
		/*
		 * Skip the work if first arg is the null string.
		 */
		tmp = POP_SCALAR();
		DEREF(tmp);
		return make_number(0.0);
	}

	if ((sep->flags & REGEX) != 0)
		sep = sep->typed_re;

	if (do_csv && (sep->re_flags & FS_DFLT) != 0 && nargs == 3) {
		fs = NULL;
		parseit = comma_parse_field;
	} else if ((sep->re_flags & FS_DFLT) != 0
	    && current_field_sep() == Using_FS
	    && ! RS_is_null) {
		parseit = parse_field;
		fs = force_string(FS_node->var_value);
		rp = FS_regexp;
	} else {
		/*
		 * 4/2026: Things start to get a little hairy here.
		 *
		 * When the third argument is a regex constant, then splitting needs to
		 * happen via the regex matcher.  That introduces some issues, discussed
		 * further below.
		 *
		 * When the third argument is a string, then the same rules as for FS apply:
		 * 	* A single space		-->	Default fields splitting
		 * 	* Any other single character	-->	That character splits
		 * 	* Longer than one character	-->	Regex splitting
		 *
		 * Both // and "" split on each character.
		 */
		fs = sep->re_exp;

		if (fs->stlen == 0) {
			static bool warned = false;

			parseit = null_parse_field;

			if (do_lint && ! warned) {
				warned = true;
				lintwarn(_("split: null string for third arg is a non-standard extension"));
			}
		} else if ((sep->re_flags & CONSTANT) != 0 || fs->stlen > 1) {
			// regex constant OR length > 1
			parseit = re_parse_field;
			rp = re_update(sep);
		} else if (fs->stlen == 1) {
			if ((sep->re_flags & CONSTANT) == 0 && fs->stptr[0] == ' ') {
				// " " ---> default parsing
				parseit = def_parse_field;
			} else
				parseit = sc_parse_field;	// single char parsing
		}
	}

	/*
	 * 4/2026: Hairiness continued:
	 *
	 * The final argument to (*parsit)() is "in_middle", indicating that
	 * we're starting from the middle of the string.  Typically, that should
	 * be false.  However, in the case of single character regexps (such as /^/),
	 * it needs to be true, so that we don't lop off the first character of
	 * the input data. (See the splitwht2 and splitany tests.)
	 * 
	 * The check for do_csv prevents dereferencing fs which is NULL if do_csv.
	 */
	s = src->stptr;
	tmp = make_number((double) (*parseit)(UNLIMITED, &s, (int) src->stlen,
					     fs, rp, set_element, arr, sep_arr,
					     ! do_csv && fs->stlen == 1));

	src = POP_SCALAR();	/* really pop off stack */
	DEREF(src);
	return tmp;
}

/*
 * do_patsplit --- implement patsplit(), semantics are same as for field
 *		   splitting with FPAT.
 */

NODE *
do_patsplit(int nargs)
{
	NODE *src, *arr, *sep, *fpat, *tmp, *sep_arr = NULL;
	char *s;
	Regexp *rp = NULL;

	check_args_min_max(nargs, "patsplit", 3, 4);

	if (nargs == 4) {
		sep_arr = POP_PARAM();
		if (sep_arr->type != Node_var_array)
			fatal(_("patsplit: fourth argument is not an array"));
		check_symtab_functab(sep_arr, "patsplit",
				_("%s: cannot use %s as fourth argument"));
	}
	sep = POP();
	arr = POP_PARAM();
	if (arr->type != Node_var_array)
		fatal(_("patsplit: second argument is not an array"));
	check_symtab_functab(arr, "patsplit",
			_("%s: cannot use %s as second argument"));

	// Someone passed an array element to be turned into
	// a subarray, so let's warn about it.
	static bool warned = false;
	if (do_lint_extensions && ! warned && arr->parent_array != NULL) {
		warned = true;
		lintwarn(_("multidimensional arrays are a gawk extension"));
	}

	src = POP_SCALAR();
	if (src->type == Node_param_list) {
		src = GET_PARAM(src->param_cnt);
		if (src->type == Node_array_ref)
			src = src->orig_array;
		if (src->type == Node_var_new || src->type == Node_elem_new) {
			if (src->type == Node_elem_new)
				elem_new_reset(src);
			src->type = Node_var;
			src->valref = 1;
			src->var_value = dupnode(Nnull_string);
		}
	}

	if ((sep->flags & REGEX) != 0)
		sep = sep->typed_re;

	fpat = sep->re_exp;
	if (fpat->stlen == 0)
		fatal(_("patsplit: third argument must be non-null"));

	if (sep_arr != NULL) {
		if (sep_arr == arr)
			fatal(_("patsplit: cannot use the same array for second and fourth args"));

		/* These checks need to be done before clearing any of the arrays */
		for (tmp = sep_arr->parent_array; tmp != NULL; tmp = tmp->parent_array)
			if (tmp == arr)
				fatal(_("patsplit: cannot use a subarray of second arg for fourth arg"));
		for (tmp = arr->parent_array; tmp != NULL; tmp = tmp->parent_array)
			if (tmp == sep_arr)
				fatal(_("patsplit: cannot use a subarray of fourth arg for second arg"));
		assoc_clear(sep_arr);
	}
	assoc_clear(arr);

	if (src->stlen == 0) {
		/*
		 * Skip the work if first arg is the null string.
		 */
		tmp = make_number(0.0);
	} else {
		rp = re_update(sep);
		s = src->stptr;
		tmp = make_number((double) fpat_parse_field(UNLIMITED, &s,
				(int) src->stlen, fpat, rp,
				set_element, arr, sep_arr, false));
	}

	DEREF(src);
	return tmp;
}

/* set_parser --- update the current (non-API) parser */

static void
set_parser(parse_field_func_t func)
{
	/*
	 * In CSV mode the parser is always comma_parse_field; the actual
	 * delimiter is taken from FS at parse time (see comma_parse_field),
	 * so an assignment to FS is honored and must not switch the parser.
	 * FIELDWIDTHS and FPAT, however, still have no effect.  Don't warn on
	 * the first call, which happens at initialization.
	 */
	static bool first_time = true;
	static bool warned = false;

	if (! first_time && do_csv) {
		if ((func == fw_parse_field || func == fpat_parse_field)
		    && ! warned) {
			warned = true;
			warning(_("assignment to FIELDWIDTHS/FPAT has no effect when using --csv"));
		}
		return;
	}

	normal_parse_field = func;
	if (! api_parser_override && parse_field != func) {
		parse_field = func;
	        update_PROCINFO_str("FS", current_field_sep_str());
	}

	if (first_time)
		first_time = false;
}

/* set_FIELDWIDTHS --- handle an assignment to FIELDWIDTHS */

void
set_FIELDWIDTHS()
{
	char *scan;
	char *end;
	int i;
	static int fw_alloc = 4;
	static bool warned = false;
	bool fatal_error = false;
	NODE *tmp;

	if (do_lint_extensions && ! warned) {
		warned = true;
		lintwarn(_("`FIELDWIDTHS' is a gawk extension"));
	}
	if (do_traditional)	/* quick and dirty, does the trick */
		return;

	/*
	 * If changing the way fields are split, obey least-surprise
	 * semantics, and force $0 to be split totally.
	 */
	if (fields_arr != NULL)
		(void) get_field(UNLIMITED - 1, 0);

	set_parser(fw_parse_field);
	tmp = force_string(FIELDWIDTHS_node->var_value);
	scan = tmp->stptr;

	if (FIELDWIDTHS == NULL) {
		emalloc(FIELDWIDTHS, awk_fieldwidth_info_t *, awk_fieldwidth_info_size(fw_alloc));
		FIELDWIDTHS->use_chars = awk_true;
	}
	FIELDWIDTHS->nf = 0;
	for (i = 0; ; i++) {
		unsigned long int tmp;
		if (i >= fw_alloc) {
			fw_alloc *= 2;
			erealloc(FIELDWIDTHS, awk_fieldwidth_info_t *, awk_fieldwidth_info_size(fw_alloc));
		}
		/* Ensure that there is no leading `-' sign.  Otherwise,
		   strtoul would accept it and return a bogus result.  */
		while (is_blank(*scan)) {
			++scan;
		}
		if (*scan == '-') {
			fatal_error = true;
			break;
		}
		if (*scan == '\0')
			break;

		// Look for skip value. We allow N:M and N:*.
		/*
		 * Detect an invalid base-10 integer, a valid value that
		 * is followed by something other than a blank or '\0',
		 * or a value that is not in the range [1..UINT_MAX].
		 */
		errno = 0;
		tmp = strtoul(scan, &end, 10);
		if (errno == 0 && *end == ':' && (0 < tmp && tmp <= UINT_MAX)) {
			FIELDWIDTHS->fields[i].skip = tmp;
			scan = end + 1;
			if (*scan == '-' || is_blank(*scan)) {
				fatal_error = true;
				break;
			}
			// try scanning for field width
			tmp = strtoul(scan, &end, 10);
		}
		else
			FIELDWIDTHS->fields[i].skip = 0;

		if (errno != 0
		    	|| (*end != '\0' && ! is_blank(*end))
				|| !(0 < tmp && tmp <= UINT_MAX)
		) {
			if (*scan == '*') {
				for (scan++; is_blank(*scan); scan++)
					continue;

				if (*scan != '\0')
					fatal(_("`*' must be the last designator in FIELDWIDTHS"));

				FIELDWIDTHS->fields[i].len = UINT_MAX;
				FIELDWIDTHS->nf = i+1;
			}
			else
				fatal_error = true;
			break;
		}
		FIELDWIDTHS->fields[i].len = tmp;
		FIELDWIDTHS->nf = i+1;
		scan = end;
		/* Skip past any trailing blanks.  */
		while (is_blank(*scan)) {
			++scan;
		}
		if (*scan == '\0')
			break;
	}

	if (fatal_error)
		fatal(_("invalid FIELDWIDTHS value, for field %d, near `%s'"),
			      i + 1, scan);
}

/* set_FS --- handle things when FS is assigned to */

void
set_FS()
{
	char buf[10];
	NODE *fs;
	static NODE *save_fs = NULL;
	static NODE *save_rs = NULL;
	bool remake_re = true;

	/*
	 * If changing the way fields are split, obey least-surprise
	 * semantics, and force $0 to be split totally.
	 */
	if (fields_arr != NULL)
		(void) get_field(UNLIMITED - 1, 0);

	/* It's possible that only IGNORECASE changed, or FS = FS */
	/*
	 * This comparison can't use cmp_nodes(), which pays attention
	 * to IGNORECASE, and that's not what we want.
	 */
	if (save_fs
		&& FS_node->var_value->stlen == save_fs->stlen
		&& memcmp(FS_node->var_value->stptr, save_fs->stptr, save_fs->stlen) == 0
		&& save_rs
		&& RS_node->var_value->stlen == save_rs->stlen
		&& memcmp(RS_node->var_value->stptr, save_rs->stptr, save_rs->stlen) == 0) {
		if (FS_regexp != NULL)
			FS_regexp = (IGNORECASE ? FS_re_no_case : FS_re_yes_case);

		/* FS = FS */
		if (current_field_sep() == Using_FS) {
			return;
		} else {
			remake_re = false;
			goto choose_fs_function;
		}
	}

	unref(save_fs);
	save_fs = dupnode(FS_node->var_value);
	unref(save_rs);
	save_rs = dupnode(RS_node->var_value);
	resave_fs = true;

	/*
	 * If FS_re_no_case assignment is fatal (make_regexp in remake_re)
	 * FS_regexp will be NULL with a non-null FS_re_yes_case.
	 * refree() handles null argument; no need for `if (FS_regexp != NULL)' below.
	 * Please do not remerge.
	 */
	refree(FS_re_yes_case);
	refree(FS_re_no_case);
	FS_re_yes_case = FS_re_no_case = FS_regexp = NULL;


choose_fs_function:
	buf[0] = '\0';
	default_FS = false;
	fs = force_string(FS_node->var_value);

	if (! do_traditional && fs->stlen == 0) {
		static bool warned = false;

		set_parser(null_parse_field);

		if (do_lint_extensions && ! warned) {
			warned = true;
			lintwarn(_("null string for `FS' is a gawk extension"));
		}
	} else if (fs->stlen > 1 || (fs->flags & REGEX) != 0) {
		set_parser(re_parse_field);
	} else if (RS_is_null) {
		/* we know that fs->stlen <= 1 */
		set_parser(sc_parse_field);
		if (fs->stlen == 1) {
			if (fs->stptr[0] == ' ') {
				default_FS = true;
				strcpy(buf, "[ \t\n]+");
			} else if (fs->stptr[0] == '\\') {
				/* yet another special case */
				strcpy(buf, "[\\\\\n]");
			} else if (fs->stptr[0] == '\0') {
				/* and yet another special case */
				strcpy(buf, "[\\000\n]");
			} else if (fs->stptr[0] != '\n') {
				sprintf(buf, "[%c\n]", fs->stptr[0]);
			}
		}
	} else {
		set_parser(def_parse_field);

		if (fs->stlen == 1) {
			if (fs->stptr[0] == ' ')
				default_FS = true;
			else if (fs->stptr[0] == '\\')
				/* same special case */
				strcpy(buf, "[\\\\]");
			else
				set_parser(sc_parse_field);
		}
	}
	if (remake_re) {
		refree(FS_re_yes_case);
		refree(FS_re_no_case);
		FS_re_yes_case = FS_re_no_case = FS_regexp = NULL;

		if (buf[0] != '\0') {
			FS_re_yes_case = make_regexp(buf, strlen(buf), false, true, true);
			FS_re_no_case = make_regexp(buf, strlen(buf), true, true, true);
			FS_regexp = (IGNORECASE ? FS_re_no_case : FS_re_yes_case);
			set_parser(re_parse_field);
		} else if (parse_field == re_parse_field) {
			FS_re_yes_case = make_regexp(fs->stptr, fs->stlen, false, true, true);
			FS_re_no_case = make_regexp(fs->stptr, fs->stlen, true, true, true);
			FS_regexp = (IGNORECASE ? FS_re_no_case : FS_re_yes_case);
		} else
			FS_re_yes_case = FS_re_no_case = FS_regexp = NULL;
	}

	/*
	 * For FS = "c", we don't use IGNORECASE. But we must use
	 * re_parse_field to get the character and the newline as
	 * field separators.
	 */
	if (fs->stlen == 1 && parse_field == re_parse_field)
		FS_regexp = FS_re_yes_case;
}

/* current_field_sep --- return the field separator type */

field_sep_type
current_field_sep()
{
	if (api_parser_override)
		return Using_API;
	else if (parse_field == fw_parse_field)
		return Using_FIELDWIDTHS;
	else if (parse_field == fpat_parse_field)
		return Using_FPAT;
	else
		return Using_FS;
}

/* current_field_sep_str --- return the field separator type as a string */

const char *
current_field_sep_str()
{
	if (api_parser_override)
		return "API";
	else if (parse_field == fw_parse_field)
		return "FIELDWIDTHS";
	else if (parse_field == fpat_parse_field)
		return "FPAT";
	else
		return "FS";
}

/* update_PROCINFO_str --- update PROCINFO[sub] with string value */

void
update_PROCINFO_str(const char *subscript, const char *str)
{
	NODE *tmp;

	if (PROCINFO_node == NULL)
		return;
	tmp = make_string(subscript, strlen(subscript));
	assoc_set(PROCINFO_node, tmp, make_string(str, strlen(str)));
}

/* update_PROCINFO_num --- update PROCINFO[sub] with numeric value */

void
update_PROCINFO_num(const char *subscript, double val)
{
	NODE *tmp;

	if (PROCINFO_node == NULL)
		return;
	tmp = make_string(subscript, strlen(subscript));
	assoc_set(PROCINFO_node, tmp, make_number(val));
}

/* set_FPAT --- handle an assignment to FPAT */

void
set_FPAT()
{
	static bool warned = false;
	bool remake_re = true;
	NODE *fpat;

	if (do_lint_extensions && ! warned) {
		warned = true;
		lintwarn(_("FPAT is a gawk extension"));
	}
	if (do_traditional)	/* quick and dirty, does the trick */
		return;

	/*
	 * If changing the way fields are split, obey least-suprise
	 * semantics, and force $0 to be split totally.
	 */
	if (fields_arr != NULL)
		(void) get_field(UNLIMITED - 1, 0);

	/* It's possible that only IGNORECASE changed, or FPAT = FPAT */
	/*
	 * This comparison can't use cmp_nodes(), which pays attention
	 * to IGNORECASE, and that's not what we want.
	 */
	if (save_FPAT
		&& FPAT_node->var_value->stlen == save_FPAT->stlen
		&& memcmp(FPAT_node->var_value->stptr, save_FPAT->stptr, save_FPAT->stlen) == 0) {
		if (FPAT_regexp != NULL)
			FPAT_regexp = (IGNORECASE ? FPAT_re_no_case : FPAT_re_yes_case);

		/* FPAT = FPAT */
		if (current_field_sep() == Using_FPAT) {
			return;
		} else {
			remake_re = false;
			goto set_fpat_function;
		}
	}

	unref(save_FPAT);
	save_FPAT = dupnode(FPAT_node->var_value);
	refree(FPAT_re_yes_case);
	refree(FPAT_re_no_case);
	FPAT_re_yes_case = FPAT_re_no_case = FPAT_regexp = NULL;

set_fpat_function:
	fpat = force_string(FPAT_node->var_value);
	set_parser(fpat_parse_field);

	if (remake_re) {
		refree(FPAT_re_yes_case);
		refree(FPAT_re_no_case);
		FPAT_re_yes_case = FPAT_re_no_case = FPAT_regexp = NULL;

		FPAT_re_yes_case = make_regexp(fpat->stptr, fpat->stlen, false, true, true);
		FPAT_re_no_case = make_regexp(fpat->stptr, fpat->stlen, true, true, true);
		FPAT_regexp = (IGNORECASE ? FPAT_re_no_case : FPAT_re_yes_case);
	}
}

/*
 * increment_scan --- macro to move scan pointer ahead by one character.
 * 			Implementation varies if doing MBS or not.
 */

#define increment_scan(scanp, len) incr_scan(scanp, len, & mbs)

/* incr_scan --- MBS version of increment_scan() */

static void
incr_scan(char **scanp, size_t len, mbstate_t *mbs)
{
	size_t mbclen = 0;

	if (gawk_mb_cur_max > 1) {
		mbclen = mbrlen(*scanp, len, mbs);
		if (   (mbclen == 1)
		    || (mbclen == (size_t) -1)
		    || (mbclen == (size_t) -2)
		    || (mbclen == 0)) {
			/* We treat it as a singlebyte character.  */
			mbclen = 1;
		}
		*scanp += mbclen;
	} else
		(*scanp)++;
}

/*
 * fpat_parse_field --- parse fields using a regexp.
 *
 * This is called both from get_field() and from do_patsplit()
 * via (*parse_field)().  This variation is for when FPAT is a regular
 * expression -- use the value to find field contents.
 *
 * The FPAT parsing logic is a bit difficult to specify. In particular
 * to allow null fields at certain locations. To make the code as robust
 * as possible, an awk reference implementation was written and tested
 * as a first step, and later recoded in C, preserving its structure as
 * much as possible.
 *
 * # Reference implementation of the FPAT record parsing.
 * #
 * # Each loop iteration identifies a (separator[n-1],field[n]) pair.
 * # Each loop iteration must consume some characters, except for the first field.
 * # So a null field is only valid as a first field or after a non-null separator.
 * # A null record has no fields (not a single null field).
 *
 * function refpatsplit(string, fields, pattern, seps,
 *         parse_start, sep_start, field_start, field_length, field_found, nf) # locals
 * {
 *     # Local state variables:
 *     # - parse_start: pointer to the first not yet consumed character
 *     # - sep_start: pointer to the beginning of the parsed separator
 *     # - field start: pointer to the beginning of the parsed field
 *     # - field length: length of the parsed field
 *     # - field_found: flag for succesful field match
 *     # - nf: Number of fields found so far
 *
 *     # Prepare for parsing
 *     parse_start = 1   # first not yet parsed char
 *     nf = 0            # fields found so far
 *     delete fields
 *     delete seps
 *
 *     # Loop that consumes the whole record
 *     while (parse_start <= length(string)) {  # still something to parse
 *
 *         # first attempt to match the next field
 *         sep_start = parse_start
 *         field_found = match(substr(string, parse_start), pattern)
 *
 *         # check for an invalid null field and retry one character away
 *         if (nf > 0 && field_found && RSTART == 1 && RLENGTH == 0) {
 *             parse_start++
 *             field_found = match(substr(string, parse_start), pattern)
 *         }
 *
 *         # store the (sep[n-1],field[n]) pair
 *         if (field_found) {
 *             field_start = parse_start + RSTART - 1
 *             field_length = RLENGTH
 *             seps[nf] = substr(string, sep_start, field_start-sep_start)
 *             fields[++nf] = substr(string, field_start, field_length)
 *             parse_start = field_start + field_length
 *
 *         # store the final extra sep after the last field
 *         } else {
 *             seps[nf] = substr(string, sep_start)
 *             parse_start = length(string) + 1
 *         }
 *     }
 *
 *     return nf
 * }
 */
static long
fpat_parse_field(long up_to,	/* parse only up to this field number */
	char **buf,	/* on input: string to parse; on output: point to start next */
	int len,
	NODE *fs ATTRIBUTE_UNUSED,
	Regexp *rp,
	Setfunc set,	/* routine to set the value of the parsed field */
	NODE *n,
	NODE *sep_arr,  /* array of field separators (may be NULL) */
	bool in_middle)
{
	char *scan = *buf;
	long nf = parse_high_water;
	char *start;
	char *end = scan + len;
	int regex_flags = RE_NEED_START;
	mbstate_t mbs;
	char* field_start;
	bool field_found = false;

	memset(&mbs, 0, sizeof(mbstate_t));

	if (up_to == UNLIMITED)
		nf = 0;

	if (len == 0)
		return nf;

	if (rp == NULL) /* use FPAT */
		rp = FPAT_regexp;

	while (scan < end && nf < up_to) {  /* still something to parse */

		/* first attempt to match the next field */
		start = scan;
		field_found = research(rp, scan, 0, (end - scan), regex_flags) != -1;

		/* check for an invalid null field and retry one character away */
		if (nf > 0 && field_found && REEND(rp, scan) == 0) { /* invalid null field */
			increment_scan(& scan, end - scan);
			field_found = research(rp, scan, 0, (end - scan), regex_flags) != -1;
		}

		/* store the (sep[n-1],field[n]) pair */
		if (field_found) {
			field_start = scan + RESTART(rp, scan);
			if (sep_arr != NULL) { /* store the separator */
				if (field_start == start) /* match at front */
					set_element(nf, start, 0L, sep_arr);
				else
					set_element(nf,
						start,
						(long) (field_start - start),
						sep_arr);
			}
			/* field is text that matched */
			(*set)(++nf,
				field_start,
				(long)(REEND(rp, scan) - RESTART(rp, scan)),
				n);
			scan += REEND(rp, scan);

		} else {
			/*
			 * No match, store the final extra separator after
			 * the last field.
			 */
			if (sep_arr != NULL)
				set_element(nf, start, (long) (end - start), sep_arr);
			scan = end;
		}
	}

	/*
	 * If the last field extends up to the end of the record, generate
	 * a null trailing separator
	 */
	if (sep_arr != NULL && scan == end && field_found)
		set_element(nf, scan, 0L, sep_arr);

	*buf = scan;
	return nf;
}