xref: /dports/lang/gnu-cobol/gnucobol-3.1.2/cobc/field.c

/*
   Copyright (C) 2001-2020 Free Software Foundation, Inc.
   Written by Keisuke Nishida, Roger While, Simon Sobisch, Ron Norman,
   Edward Hart

   This file is part of GnuCOBOL.

   The GnuCOBOL compiler 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.

   GnuCOBOL 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 GnuCOBOL.  If not, see <https://www.gnu.org/licenses/>.
*/


#include <config.h>

#include <stdio.h>
#include <stdlib.h>
#include <stddef.h>
#include <string.h>
#include <ctype.h>
#include <limits.h>

#include "cobc.h"
#include "tree.h"

/* sanity checks */
#if COB_MAX_FIELD_SIZE > INT_MAX
#error COB_MAX_FIELD_SIZE is too big, must be less than INT_MAX
#endif
#if COB_MAX_UNBOUNDED_SIZE > INT_MAX
#error COB_MAX_UNBOUNDED_SIZE is too big, must be less than INT_MAX
#endif

/* Function prototypes */
static unsigned int	validate_field_1 (struct cb_field *f);

/* Global variables */

cb_tree			cb_depend_check = NULL;
size_t			cb_needs_01 = 0;

/* Local variables */

static struct cb_field	*last_real_field = NULL;
static int		occur_align_size = 0;
static const unsigned char	pic_digits[] = { 2, 4, 7, 9, 12, 14, 16, 18 };
#define CB_MAX_OPS	32
static int			op_pos = 1, op_val_pos;
static char			op_type	[CB_MAX_OPS+1];
static char			op_prec	[CB_MAX_OPS+1];
static cob_s64_t	op_val	[CB_MAX_OPS+1];
static int			op_scale[CB_MAX_OPS+1];

/* Is list of values really an expression */
static int
cb_is_expr (cb_tree ch)
{
	cb_tree			t, l;
	int				num;

	if (op_pos >= 0) {
		for (num=0; num < CB_MAX_OPS; num++) {
			op_type [num] = ' ';
			op_prec [num] = 0;
			op_val	[num] = 0;
		}
	}
	op_pos = op_val_pos = -1;
	num = 0;
	for (l = ch; l; l = CB_CHAIN (l)) {
		t = CB_VALUE (l);
		if (t && CB_LITERAL_P (t)) {
			if (++num > 1)
				return 1;
		}
	}
	return 0;
}

static void
cb_eval_op ( void )
{
	cob_s64_t	lval, rval, xval;
	int			lscale, rscale, xscale;

	if (op_pos >= 0
	 && op_val_pos > 0) {
		lval = op_val [op_val_pos-1];
		lscale = op_scale [op_val_pos-1];
		rval = op_val [op_val_pos];
		rscale = op_scale [op_val_pos];
		op_val_pos--;
		switch (op_type [op_pos]) {
		case '+':
		case '-':
			while (lscale > rscale) {
				rval = rval * 10;
				rscale++;
			}
			while (lscale < rscale) {
				lval = lval * 10;
				lscale++;
			}
			xscale = lscale;
			if (op_type [op_pos] == '+')
				xval = lval + rval;
			else
				xval = lval - rval;
			break;
		case '*':
			xscale = lscale + rscale;
			xval = lval * rval;
			break;
		case '/':
			while (rscale > 0) {
				lval = lval * 10;
				rscale--;
			}
			if (rval == 0) {
				xscale = 0;
				xval = 0;
				cb_error (_("constant expression has Divide by ZERO"));
			} else {
				xscale = lscale;
				xval = lval / rval;
			}
			break;
		case '^':
			while (rscale > 0) {	/* Only whole number exponents */
				rval = rval / 10;
				rscale--;
			}
			if (rval == 0 || lval == 1) {
				xval = 1;
				xscale = 0;
			} else {
				xval = lval;
				xscale = lscale;
				while(--rval > 0) {
					xscale = xscale + lscale;
					xval = xval * lval;
				}
			}
			break;
		case '&':
			xscale = 0;
			xval = (lval && rval);
			break;
		case '|':
			xscale = 0;
			xval = (lval || rval);
			break;
		case '>':
			xscale = 0;
			xval = (lval > rval);
			break;
		case '<':
			xscale = 0;
			xval = (lval < rval);
			break;
		case '=':
			xscale = 0;
			xval = (lval == rval);
			break;
		case ']':
			xscale = 0;
			xval = (lval >= rval);
			break;
		case '[':
			xscale = 0;
			xval = (lval <= rval);
			break;
		case '~':
			xscale = 0;
			xval = (lval != rval);
			break;
		case '(':
			cb_error (_("missing right parenthesis"));
			op_pos--;
			return;
		default:
			op_pos--;
			return;
		}
		op_pos--;
		while (xscale > 0
			&& (xval % 10) == 0) {
			xscale--;
			xval = xval / 10;
		}
		op_scale [op_val_pos] = xscale;
		op_val [op_val_pos] = xval;
	}
}

static void
cb_push_op ( char op, int prec )
{
	while (op_pos >= 0
	   &&  op_val_pos > 0
	   &&  prec > 0
	   &&  op_type [op_pos] != '('
	   &&  prec <= op_prec [op_pos]) {
		cb_eval_op ();
	}
	if (op_pos >= CB_MAX_OPS) {
		cb_error (_("expression stack overflow at %d entries for operation '%c'"), op_pos, op);
		return;
	}
	op_pos++;
	op_type [op_pos] = op;
	op_prec [op_pos] = (char) prec;
}

/* Evaluate expression and store as new Numeric Literal */
static cb_tree
cb_evaluate_expr (cb_tree ch, int normal_prec)
{
	cb_tree			t, l;
	cob_s64_t		xval;
	int				unop = 1, xscale, k;
	char			result[48];
	struct cb_literal	*lp;

	for (l = ch; l; l = CB_CHAIN (l)) {
		t = CB_VALUE (l);
		if (t && CB_LITERAL_P (t)) {
			lp = CB_LITERAL (t);
			if (CB_NUMERIC_LITERAL_P (t)) {
				xval = atoll((const char *)lp->data);
				xscale = lp->scale;
				if (unop) {
					if (lp->sign < 0)		/* Unary op, change sign */
						xval = -xval;
				} else {
					if (lp->sign < 0) {		/* Treat 'sign' as binary op */
						cb_push_op ('-', 4);
					} else if (lp->sign > 0) {
						cb_push_op ('+', 4);
					}
				}
				while (xscale > 0
					&& (xval % 10) == 0) {	/* Remove decimal zeros */
					xscale--;
					xval = xval / 10;
				}
				if (op_val_pos >= CB_MAX_OPS) {
					cb_error (_("expression stack overflow at %d entries"), op_val_pos);
					return cb_error_node;
				}
				op_val_pos++;
				op_val [op_val_pos] = xval;
				op_scale [op_val_pos] = xscale;
				unop = 0;
			} else {
				switch (lp->data[0]) {
				case '(':
					cb_push_op ('(', 0);
					unop = 1;
					break;
				case ')':
					unop = 0;
					for (k=op_pos; k > 0 && op_type[k] != '('; k--);
					if (op_type [k] != '(')
						cb_error (_("missing left parenthesis"));
					while (op_pos >= 0
					   &&  op_val_pos > 0) {
						if (op_type [op_pos] == '(') {
							break;
						}
						cb_eval_op ();
					}
					if (op_pos >= 0
					 && op_type [op_pos] == '(')
						op_pos--;
					break;
				case '+':
					cb_push_op ('+', 4);
					unop = 1;
					break;
				case '-':
					cb_push_op ('-', 4);
					unop = 1;
					break;
				case '*':
					cb_push_op ('*', normal_prec ? 6 : 4);
					unop = 1;
					break;
				case '/':
					cb_push_op ('/', normal_prec ? 6 : 4);
					unop = 1;
					break;
				case '&':
					cb_push_op ('&', normal_prec ? 8 : 4);
					unop = 1;
					break;
				case '|':
					cb_push_op ('|', normal_prec ? 8 : 4);
					unop = 1;
					break;
				case '^':
					cb_push_op ('^', normal_prec ? 7 : 4);
					unop = 1;
					break;
				default:
					cb_error (_("invalid operator '%s' in expression"),lp->data);
					break;
				}
			}
		}
	}
	while (op_pos >= 0
	   &&  op_val_pos > 0) {
		if (op_type [op_pos] == '(') {
			cb_error (_("missing right parenthesis"));
			op_pos--;
			continue;
		}
		cb_eval_op ();
	}
	if (op_pos >= 0) {
		if (op_type[op_pos] == '(') {
			cb_error (_("missing right parenthesis"));
		} else {
			cb_error (_("'%c' operator misplaced"), op_type [op_pos]);
		}
	}
	xval	= op_val [0];
	xscale	= op_scale [0];
	while (xscale > 0) {		/* Reduce to 'fixed point numeric' */
		xscale--;
		xval = xval / 10;
	}
	while (xscale < 0) {		/* Reduce to 'fixed point numeric' */
		xscale++;
		xval = xval * 10;
	}
	sprintf (result, CB_FMT_LLD, xval);
	return cb_build_numeric_literal (0, result, xscale);
}

int
cb_get_level (cb_tree x)
{
#if 1 /* level always contains a valid tree with valid numeric values only
         --> all validation is done in scanner.l */
	return atoi (CB_NAME (x));
#else
	const unsigned char	*p;
	const char		*name;
	int			level;

	if (CB_INVALID_TREE (x)) {
		return 0;
	}
	name = CB_NAME (x);
	level = 0;
	/* Get level */
	for (p = (const unsigned char *)name; *p; p++) {
		if (!isdigit ((int)(*p))) {
			goto level_error;
		}
		level = level * 10 + (*p - '0');
		if (level > 88) {
			goto level_error;
		}
	}

	/* Check level */
	switch (level) {
	case 66:
	case 77:
	case 78:
	case 88:
		break;
	default:
		if (level < 1 || level > 49) {
			goto level_error;
		}
		break;
	}

	return level;

level_error:
	cb_error_x (x, _("invalid level number '%s'"), name);
	return 0;
#endif
}

cb_tree
cb_build_field_tree (cb_tree level, cb_tree name, struct cb_field *last_field,
		     enum cb_storage storage, struct cb_file *fn,
		     const int expl_level)
{
	struct cb_reference	*r;
	struct cb_field		*f;
	struct cb_field		*p;
	struct cb_field		*field_fill;
	cb_tree			dummy_fill;
	cb_tree			l;
	cb_tree			x;
	int			lv;

	if (!expl_level) {
		/* note: the level number is always a valid tree here, but the
		   name may be a defined constant which leads to an error node */
		if (name == cb_error_node) {
			return cb_error_node;
		}
		/* Check the level number */
		lv = cb_get_level (level);
#if 0 /*level is always valid --> 01 thru 49, 77, 66, 78, 88 */
		if (!lv) {
			return cb_error_node;
		}
#endif
	} else {
		lv = expl_level;
	}

	/* Build the field */
	r = CB_REFERENCE (name);
	f = CB_FIELD (cb_build_field (name));
	f->storage = storage;
	last_real_field = last_field;
	if (lv == 78) {
		f->level = 01;
		f->flag_item_78 = 1;
		f->flag_constant = 0;
		return CB_TREE (f);
	} else {
		f->level = lv;
	}
	if (f->level == 01 && storage == CB_STORAGE_FILE && fn) {
		if (fn->flag_external) {
			f->flag_external = 1;
			current_program->flag_has_external = 1;
		} else if (fn->flag_global) {
			f->flag_is_global = 1;
		}
	}
	if (last_field) {
		if (last_field->level == 77 && f->level != 01 &&
			f->level != 77 && f->level != 66 && f->level != 88) {
			cb_error_x (name, _("level number must begin with 01 or 77"));
			return cb_error_node;
		}
	}

	/* Checks for redefinition */
	if (cb_warn_opt_val[cb_warn_redefinition]
	 && r->word->count > 1 && !r->flag_filler_ref) {
		if (f->level == 01 || f->level == 77) {
			redefinition_warning (name, NULL);
		} else {
			for (l = r->word->items; l; l = CB_CHAIN (l)) {
				x = CB_VALUE (l);
				if (!CB_FIELD_P (x) ||
				    CB_FIELD (x)->level == 01 ||
				    CB_FIELD (x)->level == 77 ||
				    (last_field && f->level == last_field->level &&
				     CB_FIELD (x)->parent == last_field->parent)) {
					redefinition_warning (name, x);
					break;
				}
			}
		}
	}

	if (last_field && last_field->level == 88) {
		last_field = last_field->parent;
	}

	/* Link the field into the tree */
	if (f->level == 01 || f->level == 77) {
		/* Top level */
		cb_needs_01 = 0;
		if (last_field) {
			cb_field_founder (last_field)->sister = f;
		}
	} else if (!last_field || cb_needs_01) {
		/* Invalid top level */
		cb_error_x (name, _("level number must begin with 01 or 77"));
		return cb_error_node;
	} else if (f->level == 66) {
		/* Level 66 */
		f->parent = cb_field_founder (last_field);
		for (p = f->parent->children; p && p->sister; p = p->sister) ;
		if (p) {
			p->sister = f;
		}
	} else if (f->level == 88) {
		/* Level 88 */
		f->parent = last_field;
		if (last_real_field && last_real_field->level == 88) {
			/* Level 88 sister */
			last_real_field->sister = f;
		} else {
			/* First Level 88 on this item */
			last_field->validation = f;
			last_field = f;
		}
	} else if (f->level > last_field->level) {
		/* Lower level */
		last_field->children = f;
		f->parent = last_field;
	} else if (f->level == last_field->level) {
		/* Same level */
same_level:
		last_field->sister = f;
		f->parent = last_field->parent;
	} else {
		/* Upper level */
		for (p = last_field->parent; p /* <- silence warnings */; p = p->parent) {
			if (p->level == f->level) {
				last_field = p;
				goto same_level;
			}
			if (cb_relax_level_hierarchy && p->level < f->level) {
				break;
			}
		}
		if (cb_relax_level_hierarchy
		 && p /* <- silence warnings */) {
			dummy_fill = cb_build_filler ();
			field_fill = CB_FIELD (cb_build_field (dummy_fill));
			cb_warning_x (COBC_WARN_FILLER, name,
				      _("no previous data item of level %02d"),
				      f->level);
			field_fill->level = f->level;
			field_fill->flag_filler = 1;
			field_fill->storage = storage;
			field_fill->children = p->children;
			field_fill->parent = p;
			for (p = p->children; p; p = p->sister) {
				p->parent = field_fill;
			}
			field_fill->parent->children = field_fill;
			field_fill->sister = f;
			f->parent = field_fill->parent;
			/* last_field = field_fill; */
		} else {
			cb_error_x (name,
				    _("no previous data item of level %02d"),
				    f->level);
			return cb_error_node;
		}
	}

	/* Inherit parents properties */
	if (f->parent) {
		struct cb_field *parent = f->parent;
		f->usage = parent->usage;
		f->indexes = parent->indexes;
		f->flag_sign_leading = parent->flag_sign_leading;
		f->flag_sign_separate = parent->flag_sign_separate;
		f->flag_is_global = parent->flag_is_global;
		if (f->level <= 66) {
			f->flag_volatile = parent->flag_volatile;
		}
	}

	return CB_TREE (f);
}

cb_tree
cb_build_full_field_reference (struct cb_field* field)
{
	cb_tree ret = NULL;
	cb_tree ref = NULL;
	cb_tree rchain = NULL;

	while (field) {
		if (field->flag_filler) continue;
		rchain = cb_build_reference (field->name);
		if (ref) {
			CB_REFERENCE (ref)->chain = rchain;
		} else {
			ret = rchain;
		}
		ref = rchain;
		field = field->parent;
	}

	return ret;
}

struct cb_field *
cb_resolve_redefines (struct cb_field *field, cb_tree redefines)
{
	struct cb_field		*f;
	struct cb_reference	*r;
	const char		*name;
	cb_tree			x;
	cb_tree			candidate;
	cb_tree			items;

	r = CB_REFERENCE (redefines);
	name = CB_NAME (redefines);
	x = CB_TREE (field);

	/* Check qualification */
	if (r->chain) {
		cb_error_x (x, _("'%s' cannot be qualified here"), name);
		return NULL;
	}

	/* Check subscripts */
	if (r->subs) {
		cb_error_x (x, _("'%s' cannot be subscripted here"), name);
		return NULL;
	}

	/* Resolve the name in the current group (if any) */
	if (field->parent && field->parent->children) {
		for (f = field->parent->children; f; f = f->sister) {
			if (strcasecmp (f->name, name) == 0) {
				break;
			}
		}
		if (f == NULL) {
			cb_error_x (x, _("'%s' is not defined in '%s'"), name, field->parent->name);
			return NULL;
		}
	} else {
		/* Get last defined name */
		candidate = NULL;
		items = r->word->items;
		for (; items; items = CB_CHAIN (items)) {
			if (CB_FIELD_P (CB_VALUE (items))) {
				candidate = CB_VALUE (items);
			}
		}
		if (!candidate) {
			undefined_error (redefines);
			return NULL;
		}
		f = CB_FIELD_PTR (candidate);
	}

	/* Check level number */
	if (f->level != field->level) {
		cb_error_x (x, _("level number of REDEFINES entries must be identical"));
		return NULL;
	}

	if (!cb_indirect_redefines && f->redefines) {
		cb_error_x (x, _("'%s' is not the original definition"), f->name);
		return NULL;
	}

	/* Return the original definition */
	while (f->redefines) {
		f = f->redefines;
	}
	return f;
}

static void copy_into_field_recursive (struct cb_field *, struct cb_field *, const int);

static void
copy_children (struct cb_field *child, struct cb_field *target,
	const int level, const int outer_indexes, const enum cb_storage storage)
{
	int level_child;
	cb_tree n, x;

	if (child->level > level) {
		level_child = child->level;
	} else {
		level_child = level + 1;
		if (level_child == 66 || level_child == 78 || level_child == 88) {
			level_child++;
		} else if (level_child == 77) {
			level_child = 79;
		}
	}

	if (child->name) {
		n = cb_build_reference (child->name);
	} else {
		n = cb_build_filler ();
	}
	x = cb_build_field_tree (NULL, n, target, storage, NULL, level_child);
	if (x != cb_error_node) {
		copy_into_field_recursive (child, CB_FIELD (x), outer_indexes);
	}
}

#define field_attribute_copy(attribute)	\
	if (source->attribute) target->attribute = source->attribute
#define field_attribute_override(attribute)	\
	target->attribute = source->attribute

static void
copy_into_field_recursive (struct cb_field *source, struct cb_field *target,
			const int outer_indexes)
{
	field_attribute_override (usage);

	/* checkme: how to handle DEPENDING and INDICES here ? */
	field_attribute_override (occurs_min);
	field_attribute_override (occurs_max);
	field_attribute_override (flag_occurs);
	if (CB_VALID_TREE (source->depending)) {
#if 0	/* TODO: check if DEPENDING field is part of the original TYPEDEF,
		   if yes then full-qualify the reference */
		struct cb_field *dep_field = CB_FIELD_PTR (source->depending);
		struct cb_field *field;
		target->depending = cb_build_reference (CB_NAME(source->depending));
		dep_field = dep_field->parent;
		if (dep_field) {
			for (field = target->parent; field; field = field->parent) {
				if (dep_field == field) {
					cb_tree rchain = cb_build_full_field_reference (field);
					CB_REFERENCE (target->depending)->chain = rchain;
					break;
				}
			}
		}
#else
		target->depending = cb_build_reference (CB_NAME (source->depending));
#endif
		CB_ADD_TO_CHAIN (target->depending, current_program->reference_list);
	}
	field_attribute_override (nkeys);
	if (source->keys) {
		cb_tree ref = NULL;
		cb_tree rchain = NULL;
		int	i;

		/* create reference chaing all the way up
		   as later fields may have same name */
		rchain = cb_build_full_field_reference (target);

		target->keys = cobc_parse_malloc (sizeof (struct cb_key) * target->nkeys);
		for (i = 0; i < target->nkeys; i++) {
			const struct cb_reference* r = CB_REFERENCE (source->keys[i].key);
			ref = cb_build_reference (r->word->name);
			CB_REFERENCE (ref)->chain = rchain;
			target->keys[i].key = ref;
			CB_ADD_TO_CHAIN (ref, current_program->reference_list);
			field_attribute_override (keys[i].dir);
		}
	}
	if (source->index_list) {
		cb_tree x;
		target->index_list = NULL;
		for (x = source->index_list; x; x = CB_CHAIN (x)) {
			cb_tree ind_ref = cb_build_reference (CB_FIELD_PTR (CB_VALUE (x))->name);
			cb_tree entry = cb_build_index (ind_ref, cb_int1, 1U, target);
			CB_FIELD_PTR (entry)->index_type = CB_STATIC_INT_INDEX;
			if (!target->index_list) {
				target->index_list = CB_LIST_INIT (entry);
			} else {
				target->index_list = cb_list_add (target->index_list, entry);
			}
		}
	}

	field_attribute_override (values);
	field_attribute_override (flag_blank_zero);
	field_attribute_override (flag_justified);
	field_attribute_override (flag_sign_clause);
	field_attribute_override (flag_sign_leading);
	field_attribute_override (flag_sign_separate);
	field_attribute_override (flag_synchronized);
	field_attribute_override (flag_item_based);
	field_attribute_override (flag_any_length);
	field_attribute_override (flag_any_numeric);
	field_attribute_override (flag_invalid);

	if (CB_VALID_TREE (source->redefines)) {
		cb_tree ref = cb_build_reference (source->redefines->name);
		target->redefines = cb_resolve_redefines (target, ref);
	}

	if (source->children) {
		copy_children (source->children, target, target->level, outer_indexes, target->storage);
	} else if (source->pic){
		target->pic = CB_PICTURE (cb_build_picture (source->pic->orig));
	}

	if (source->sister) {
		/* for children: all sister entries need to be copied */
		cb_tree n, x;
		if (source->sister->name) {
			n = cb_build_reference (source->sister->name);
		} else {
			n = cb_build_filler ();
		}
		x = cb_build_field_tree (NULL, n, target, target->storage, NULL, target->level);
		if (x != cb_error_node) {
			copy_into_field_recursive (source->sister, CB_FIELD (x), outer_indexes);
		}
	}
	/* special case: normally incremented during parse */
	target->indexes = source->indexes + outer_indexes;
	cb_validate_field (target);
}


/* note: same message in parser.y */
static int
duplicate_clause_message (cb_tree x, const char *clause)
{
	/* FIXME: replace by a new warning level that is set
	   to warn/error depending on cb_relaxed_syntax_checks */
	if (cb_relaxed_syntax_checks) {
		cb_warning_x (COBC_WARN_FILLER, x, _("duplicate %s clause"), clause);
		return 0;
	}

	cb_error_x (x, _("duplicate %s clause"), clause);
	return 1;
}

void
copy_into_field (struct cb_field *source, struct cb_field *target)
{
#if 0
	cb_tree	external_definition = target->external_definition;
#endif

	/* note: EXTERNAL is always applied from the typedef (if level (1/77),
			 but may be specified on the field */
	if (target->level == 1 || target->level == 77) {
		field_attribute_copy (flag_external);
	}
	target->usage = source->usage;
	if (source->values) {
		if (target->values) {
			duplicate_clause_message (target->values, "VALUE");
		} else {
			target->values = source->values;
		}
	}
	field_attribute_copy (flag_blank_zero);
	field_attribute_copy (flag_justified);
	field_attribute_copy (flag_sign_clause);
	field_attribute_copy (flag_sign_leading);
	field_attribute_copy (flag_sign_separate);
	field_attribute_copy (flag_synchronized);
	field_attribute_copy (flag_item_based);
	field_attribute_override (flag_any_length);
	field_attribute_override (flag_any_numeric);

	if (unlikely (!target->like_modifier)) {
		if (source->children) {
			copy_children (source->children, target, target->level, target->indexes, target->storage);
		} else if (source->pic) {
			target->pic = CB_PICTURE (cb_build_picture (source->pic->orig));
		}
	} else {
		struct cb_picture* new_pic = NULL;
		int modifier = cb_get_int (target->like_modifier);
		if (modifier) {
			switch (target->usage) {

			case CB_USAGE_COMP_X:
			case CB_USAGE_COMP_N:
				if (target->pic->category == CB_CATEGORY_ALPHANUMERIC) {
					char		pic[8];
					unsigned char		newsize;
					if (target->pic->size > 8) {
						newsize = 36;
					} else {
						newsize = pic_digits[target->pic->size - 1];
					}
					newsize += modifier;
					if (newsize > 36) {
						newsize = 36;
					}
					sprintf (pic, "9(%u)", newsize);
					new_pic = CB_PICTURE (cb_build_picture (pic));
					break;
				}

			case CB_USAGE_BINARY:
			case CB_USAGE_PACKED:
			case CB_USAGE_COMP_5:
			case CB_USAGE_COMP_6:
				if (target->pic->orig[0] == '9') {
					char		pic[38];
					/* only a prototype here,
					   TODO: add handling for S and friends... */
					if (modifier > 0) {
						sprintf (pic, "9(%d)", modifier);
						strcat (pic, target->pic->orig);
						new_pic = CB_PICTURE (cb_build_picture (pic));
					} else {
						CB_PENDING_X (CB_TREE (target), "LIKE ... negative-integer");
					}
				} else {
					cb_error_x (CB_TREE (target), _ ("%s clause not compatible with PIC %s"),
						"LIKE", target->pic->orig);
					target->flag_invalid = 1;
				}
				break;

			case CB_USAGE_DISPLAY:
			case CB_USAGE_NATIONAL:
				break;

			default:
				cb_error_x (CB_TREE (target), _("%s clause not compatible with USAGE %s"),
					"LIKE", cb_get_usage_string (target->usage));
				target->flag_invalid = 1;
			}

#if 0		/* TODO, also syntax-check for usage here */
			if (target->cat is_numeric) {
				sprintf (pic, "9(%d)", size_implied);
			} else {
				sprintf (pic, "X(%d)", size_implied);
			}
			new_pic = CB_PICTURE (cb_build_picture (pic));
#endif
		}
		if (new_pic) {
			target->pic = new_pic;
		} else if (target->pic) {
			target->pic = CB_PICTURE (cb_build_picture (target->pic->orig));
		}
	}

	/* adjust reference counter to allow "no codegen" if only used as type */
	source->count--;
#if 0
	target->count--;
	target->external_definition = external_definition;
#endif

	/* validate field to ensure applying its own attributes
	   in relation to its childs) */
	cb_validate_field (target);
}

static COB_INLINE COB_A_INLINE void
emit_incompatible_pic_and_usage_error (cb_tree item, const enum cb_usage usage)
{
	cb_error_x (item, _("%s clause not compatible with USAGE %s"),
		    "PICTURE", cb_get_usage_string (usage));
}

static COB_INLINE COB_A_INLINE int
is_numeric_usage (const enum cb_usage usage)
{
	switch (usage) {
	case CB_USAGE_DISPLAY:
	case CB_USAGE_NATIONAL:
	case CB_USAGE_OBJECT:
		return 0;
	/* case CB_USAGE_ERROR: assume numeric */
	default:
		return 1;
	}
}

/* create an implicit picture for items that miss it but need one,
   return 1 if not possible */
static unsigned int
create_implicit_picture (struct cb_field *f)
{
	cb_tree			x = CB_TREE (f);
	cb_tree			first_value;
	char			*pp;
	struct cb_literal	*lp;
	int			size_implied = 1;
	int			is_numeric = 0;
	int			ret;
	char			pic[24];

	if (f->values) {
		first_value = CB_VALUE (f->values);
		if (first_value == cb_error_node) {
			first_value = NULL;
		} else {
			if (CB_LITERAL_P (first_value)) {
				size_implied = (int)CB_LITERAL (first_value)->size;
				is_numeric = CB_NUMERIC_LITERAL_P (first_value);
			} else if (CB_CONST_P (first_value)) {
				size_implied = 1;
				if (first_value == cb_zero) {
					is_numeric = 1;
				} else {
					is_numeric = 0;
				}
			} else {
				cobc_err_msg (_("unexpected tree tag: %d"), (int)CB_TREE_TAG (x));
				COBC_ABORT ();	/* LCOV_EXCL_LINE */
			}
		}
	} else {
		first_value = NULL;
	}

	if (!first_value) {
		/* FIXME: ensure this in another place */
		if (f->flag_item_78) {
			level_require_error (x, "VALUE");
			return 1;
		}
		is_numeric = is_numeric_usage (f->usage);
	}

	if (f->storage == CB_STORAGE_SCREEN) {
		cb_tree impl_tree = f->screen_from ? f->screen_from : f->screen_to ? f->screen_to : NULL;
		if (impl_tree) {
			if (impl_tree == cb_error_node) {
				return 1;
			}
			if (!CB_CONST_P (impl_tree)) {
				size_implied = cb_field_size (impl_tree);
				is_numeric = CB_TREE_CATEGORY (impl_tree) == CB_CATEGORY_NUMERIC;
			} else {
				size_implied = FIELD_SIZE_UNKNOWN;
			}
		} else if (first_value) {
			/* done later*/
		} else {
			f->flag_no_field = 1;
			f->pic = CB_PICTURE (cb_build_picture ("X"));
			return 0;
		}

		if (size_implied == FIELD_SIZE_UNKNOWN) {
			cb_error_x (x, _("PICTURE clause required for '%s'"),
				    cb_name (x));
			return 1;
		}

		if (is_numeric) {
			sprintf (pic, "9(%d)", size_implied);
		} else {
			sprintf (pic, "X(%d)", size_implied);
		}
		f->pic = CB_PICTURE (cb_build_picture (pic));
		return 0;
	}

	if (f->storage == CB_STORAGE_REPORT) {
		if (first_value) {
			sprintf (pic, "X(%d)", size_implied);
		} else {
			/* CHECKME: Where do we want to generate a not-field in the C code?
			            instead of raising an error here? */
			f->flag_no_field = 1;
			strcpy (pic, "X");
		}
		f->pic = CB_PICTURE (cb_build_picture (pic));
		return 0;
	}

	if (f->flag_item_78 && first_value && CB_LITERAL_P (first_value)) {
#if 0	/* CHECKME: Do we need this here? */
		f->count++;
#endif
		lp = CB_LITERAL (first_value);
		if (CB_NUMERIC_LITERAL_P (first_value)) {
			memset (pic, 0, sizeof (pic));
			pp = pic;
			if (lp->sign) {
				*pp++ = 'S';
			}
			size_implied = (int)lp->size - lp->scale;
			if (size_implied) {
				pp += sprintf (pp, "9(%d)", size_implied);
			}
			if (lp->scale) {
				sprintf (pp, "V9(%d)", lp->scale);
			}
			if (lp->size < 10) {
				f->usage = CB_USAGE_COMP_5;
			} else {
				f->usage = CB_USAGE_DISPLAY;
			}
			f->pic = CB_PICTURE (cb_build_picture (pic));
			f->pic->category = CB_CATEGORY_NUMERIC;
		} else {
			sprintf (pic, "X(%d)", (int)lp->size);
			f->pic = CB_PICTURE (cb_build_picture (pic));
			f->pic->category = CB_CATEGORY_ALPHANUMERIC;
			f->usage = CB_USAGE_DISPLAY;
		}
		return 0;
	}

	ret = 0;

	if (f->level == 1 || f->level == 77 || !first_value) {
		cb_error_x (x, _("PICTURE clause required for '%s'"),
			    cb_name (x));
		ret = 1;
	}

	if (first_value && CB_NUMERIC_LITERAL_P (first_value)) {
		if (!is_numeric_usage(f->usage)) {
			cb_error_x (x, _("a non-numeric literal is expected for '%s'"),
					cb_name (x));
		}
		if (!ret) {
			cb_error_x (x, _("PICTURE clause required for '%s'"),
					cb_name (x));
			ret = 1;
		}
	}

	/* Checkme: should we raise an error for !cb_relaxed_syntax_checks? */
	if (!ret) {
		cb_warning_x (cb_warn_additional, x, _("defining implicit picture size %d for '%s'"),
			    size_implied, cb_name (x));
	}
	if (is_numeric) {
		sprintf (pic, "9(%d)", size_implied);
	} else {
		sprintf (pic, "X(%d)", size_implied);
	}
	f->pic = CB_PICTURE (cb_build_picture (pic));
	f->pic->category = CB_CATEGORY_ALPHANUMERIC;
	f->usage = CB_USAGE_DISPLAY;
	return ret;
}

static unsigned int
validate_any_length_item (struct cb_field *f)
{
	cb_tree	x = CB_TREE (f);

	if (f->storage != CB_STORAGE_LINKAGE) {
		cb_error_x (x, _("'%s' ANY LENGTH only allowed in LINKAGE"), cb_name (x));
		return 1;
	}
	if (f->level != 01) {
		cb_error_x (x, _("'%s' ANY LENGTH must be 01 level"), cb_name (x));
		return 1;
	}
	if (f->flag_item_based || f->flag_external) {
		cb_error_x (x, _("'%s' ANY LENGTH cannot be BASED/EXTERNAL"), cb_name (x));
		return 1;
	}
	if (f->flag_occurs || f->depending ||
	    f->children || f->values || f->flag_blank_zero) {
		cb_error_x (x, _("'%s' ANY LENGTH has invalid definition"), cb_name (x));
		return 1;
	}
	if (!f->pic) {
		if (f->flag_any_numeric) {
			f->pic = CB_PICTURE (cb_build_picture ("9"));
		} else {
			f->pic = CB_PICTURE (cb_build_picture ("X"));
		}
	} else if (f->flag_any_numeric) {
		if (f->pic->category != CB_CATEGORY_NUMERIC) {
			cb_error_x (x, _("'%s' ANY NUMERIC must be PIC 9"),
				  f->name);
		}
	} else if (f->pic->category != CB_CATEGORY_ALPHANUMERIC
			&& f->pic->category != CB_CATEGORY_NATIONAL
			&& f->pic->category != CB_CATEGORY_BOOLEAN) {
		cb_error_x (x, _("'%s' ANY LENGTH must be PIC X, PIC N or PIC 1"),
			  f->name);
	}
	/*
	  TO-DO: Replace pic->category check with f->usage == CB_USAGE_NATIONAL.
	  Currently NATIONAL items are marked as having USAGE DISPLAY.
	*/
	if (!((f->pic->size == 1 && f->usage == CB_USAGE_DISPLAY)
	      || (f->pic->size == 2 && f->pic->category == CB_CATEGORY_NATIONAL))) {
		if (f->flag_any_numeric) {
			cb_error_x (x, _("'%s' ANY NUMERIC has invalid definition"), cb_name (x));
		} else {
			cb_error_x (x, _("'%s' ANY LENGTH has invalid definition"), cb_name (x));
		}
		return 1;
	}

	/* CHECKME: Why do we increase the reference counter here
	            (to ensure the field is generated)?
	            Better would be to add the check for 'f->count != 0' to the place
	            where it possibly is missing... */
	f->count++;
	return 0;
}

static void
validate_external (const struct cb_field * const f)
{
	const cb_tree	x = CB_TREE (f);

	if (f->level != 01 && f->level != 77) {
		cb_error_x (x, _("'%s' EXTERNAL must be specified at 01/77 level"), cb_name (x));
	}
	if (f->storage != CB_STORAGE_WORKING &&
		f->storage != CB_STORAGE_FILE) {
		cb_error_x (x, _("'%s' EXTERNAL can only be specified in WORKING-STORAGE section"),
				cb_name (x));
	}
	if (f->flag_item_based) {
		cb_error_x (x, _("'%s' EXTERNAL and BASED are mutually exclusive"), cb_name (x));
	}
	if (f->redefines) {
		cb_error_x (x, _("'%s' EXTERNAL not allowed with REDEFINES"), cb_name (x));
	}
}

static void
validate_based (const struct cb_field * const f)
{
	const cb_tree	x = CB_TREE (f);

	if (f->storage != CB_STORAGE_WORKING &&
		f->storage != CB_STORAGE_LOCAL &&
		f->storage != CB_STORAGE_LINKAGE) {
		cb_error_x (x, _("'%s' BASED not allowed here"), cb_name (x));
	}
	if (f->redefines) {
		cb_error_x (x, _("'%s' BASED not allowed with REDEFINES"), cb_name (x));
	}
	if (f->level != 01 && f->level != 77) {
		cb_error_x (x, _("'%s' BASED only allowed at the 01 and 77 levels"), cb_name (x));
	}
}

static void
validate_occurs (const struct cb_field * const f)
{
	const cb_tree		x = CB_TREE (f);
	const struct cb_field	*p;

	if ((f->level == 01 || f->level == 77)
	 && !cb_verify_x (x, cb_top_level_occurs_clause, "01/77 OCCURS")) {
		cb_error_x (x, _("level %02d item '%s' cannot have a %s clause"),
			f->level, cb_name (x), "OCCURS");
	}

	/* Validate OCCURS DEPENDING */
	if (f->depending) {
		/* Cache field for later checking */
		cb_depend_check = cb_list_add (cb_depend_check, x);

		if (!cb_complex_odo) {
			/* The data item that contains a OCCURS DEPENDING clause shall not
			   be subordinate to a data item that has an OCCURS clause */
			for (p = f->parent; p; p = p->parent) {
				if (p->flag_occurs) {
					cb_error_x (CB_TREE (p),
						    _("'%s' cannot have the OCCURS clause due to '%s'"),
						    cb_name (CB_TREE (p)),
						    cb_name (x));
					break;
				}
			}
		}
	}
}

static void
validate_redefines (const struct cb_field * const f)
{
	const cb_tree		x = CB_TREE (f);
	const struct cb_field	*p;

	/* Check OCCURS */
	if (f->redefines->flag_occurs) {
		cb_warning_x (COBC_WARN_FILLER, x,
			      _("the original definition '%s' should not have OCCURS clause"),
			      f->redefines->name);
	}

	/* Check definition */
	for (p = f->redefines->sister; p && p != f; p = p->sister) {
		if (!p->redefines) {
			cb_error_x (x, _("REDEFINES must follow the original definition"));
			break;
		}
	}

	/* Check variable occurrence */
	if (f->depending || cb_field_variable_size (f)) {
		cb_error_x (x, _("'%s' cannot be variable length"), f->name);
	}
	if (cb_field_variable_size (f->redefines)) {
		cb_error_x (x, _("the original definition '%s' cannot be variable length"),
			    f->redefines->name);
	}
}

/* Perform group-specific validation of f. */
static unsigned int
validate_group (struct cb_field *f)
{
	cb_tree		x = CB_TREE (f);
	unsigned int	ret = 0;

	if (f->pic) {
		group_error (x, "PICTURE");
	}
	if (f->flag_justified) {
		group_error (x, "JUSTIFIED RIGHT");
	}
	if (f->flag_blank_zero) {
		group_error (x, "BLANK WHEN ZERO");
	}

	if (f->storage == CB_STORAGE_SCREEN &&
	    (f->screen_from || f->screen_to || f->values || f->pic)) {
		cb_error_x (x, _("SCREEN group item '%s' has invalid clause"),
			    cb_name (x));
		ret = 1;
	}

	for (f = f->children; f; f = f->sister) {
		ret |= validate_field_1 (f);
	}

	return ret;
}

static unsigned int
validate_pic (struct cb_field *f)
{
	int	need_picture;
	cb_tree	x = CB_TREE (f);

	switch (f->usage) {
	case CB_USAGE_INDEX:
	case CB_USAGE_HNDL:
	case CB_USAGE_HNDL_WINDOW:
	case CB_USAGE_HNDL_SUBWINDOW:
	case CB_USAGE_HNDL_FONT:
	case CB_USAGE_HNDL_THREAD:
	case CB_USAGE_HNDL_MENU:
	case CB_USAGE_HNDL_VARIANT:
	case CB_USAGE_HNDL_LM:
	case CB_USAGE_LENGTH:
	case CB_USAGE_OBJECT:
	case CB_USAGE_POINTER:
	case CB_USAGE_PROGRAM_POINTER:
	case CB_USAGE_FLOAT:
	case CB_USAGE_DOUBLE:
	case CB_USAGE_LONG_DOUBLE:
	case CB_USAGE_FP_BIN32:
	case CB_USAGE_FP_BIN64:
	case CB_USAGE_FP_BIN128:
	case CB_USAGE_FP_DEC64:
	case CB_USAGE_FP_DEC128:
	case CB_USAGE_SIGNED_CHAR:
	case CB_USAGE_SIGNED_SHORT:
	case CB_USAGE_SIGNED_INT:
	case CB_USAGE_SIGNED_LONG:
	case CB_USAGE_UNSIGNED_CHAR:
	case CB_USAGE_UNSIGNED_SHORT:
	case CB_USAGE_UNSIGNED_INT:
	case CB_USAGE_UNSIGNED_LONG:
		need_picture = 0;
		break;
	case CB_USAGE_ERROR:
		return 1;
	default:
		need_picture = !f->flag_is_external_form;
		break;
	}

	if (f->pic == NULL && need_picture) {
		/* try to built an implicit picture, stop if not possible */
		if (create_implicit_picture (f)) {
			return 1;
		}
	}

	/* ACUCOBOL/RM-COBOL-style COMP-1 ignores the PICTURE clause. */
	if (f->flag_comp_1 && cb_binary_comp_1) {
		return 0;
	}

	/* if picture is not needed it is an error to specify it
	   note: we may have set the picture internal */
	if (f->pic != NULL && !f->pic->flag_is_calculated && !need_picture) {
		cb_error_x (x, _("'%s' cannot have PICTURE clause"),
			    cb_name (x));
	}

	return 0;
}

static int
validate_usage (struct cb_field * const f)
{
	cb_tree	x = CB_TREE (f);

	if ((f->storage == CB_STORAGE_SCREEN
	  || f->storage == CB_STORAGE_REPORT)
	 &&  f->usage   != CB_USAGE_DISPLAY
	 &&  f->usage   != CB_USAGE_NATIONAL) {
		cb_error_x (CB_TREE(f),
			_("%s item '%s' should be USAGE DISPLAY"),
			enum_explain_storage (f->storage), cb_name (x));
		return 1;
	}

	switch (f->usage) {
	case CB_USAGE_BINARY:
	case CB_USAGE_PACKED:
	case CB_USAGE_BIT:
		if (f->pic
		 && f->pic->category != CB_CATEGORY_NUMERIC) {
			emit_incompatible_pic_and_usage_error (x, f->usage);
			return 1;
		}
		break;
	case CB_USAGE_COMP_6:
		if (f->pic
		 && f->pic->category != CB_CATEGORY_NUMERIC) {
			emit_incompatible_pic_and_usage_error (x, f->usage);
			return 1;
		}
		if (f->pic
		 && f->pic->have_sign) {
			cb_warning_x (COBC_WARN_FILLER, x, _("'%s' COMP-6 with sign - changing to COMP-3"), cb_name (x));
			f->usage = CB_USAGE_PACKED;
		}
		break;
	case CB_USAGE_COMP_5:
	case CB_USAGE_COMP_X:
	case CB_USAGE_COMP_N:
		if (f->pic
		 && f->pic->category != CB_CATEGORY_NUMERIC
		 && f->pic->category != CB_CATEGORY_ALPHANUMERIC) {
			emit_incompatible_pic_and_usage_error (x, f->usage);
			return 1;
		}
		break;
	default:
		break;
	}
	return 0;
}

static void
validate_sign (const struct cb_field * const f)
{
	const cb_tree	x = CB_TREE (f);

	if (!(f->pic && f->pic->have_sign)) {
		cb_error_x (x, _("elementary items with SIGN clause must have S in PICTURE"));
	} else if (f->usage != CB_USAGE_DISPLAY
			&& f->usage != CB_USAGE_NATIONAL) {
		cb_error_x (x, _("elementary items with SIGN clause must be USAGE DISPLAY or NATIONAL"));
	}
}

static void
validate_justified_right (const struct cb_field * const f)
{
	const cb_tree	x = CB_TREE (f);

	/* TO-DO: Error if no PIC? */

	if (f->flag_justified
	    && f->pic
	    && f->pic->category != CB_CATEGORY_ALPHABETIC
	    && f->pic->category != CB_CATEGORY_ALPHANUMERIC
	    && f->pic->category != CB_CATEGORY_BOOLEAN
	    && f->pic->category != CB_CATEGORY_NATIONAL) {
		cb_error_x (x, _("'%s' cannot have JUSTIFIED RIGHT"), cb_name (x));
	}
}

static void
validate_blank_when_zero (const struct cb_field * const f)
{
	const cb_tree	x = CB_TREE (f);
	int		i;

	if (f->pic
	    && f->pic->have_sign
	    && f->pic->category != CB_CATEGORY_NUMERIC_EDITED) {
		cb_error_x (x, _("'%s' cannot have S in PICTURE string and BLANK WHEN ZERO"),
			    cb_name (x));
	}

	if (f->usage != CB_USAGE_DISPLAY && f->usage != CB_USAGE_NATIONAL) {
		cb_error_x (x, _("'%s' cannot have BLANK WHEN ZERO without being USAGE DISPLAY or NATIONAL"),
			    cb_name (x));
	}

	if (f->pic) {
		switch (f->pic->category) {
		case CB_CATEGORY_NUMERIC:
			break;
		case CB_CATEGORY_NUMERIC_EDITED:
			for (i = 0; f->pic->str[i].symbol != '\0'; ++i) {
				if (f->pic->str[i].symbol == '*') {
					cb_error_x (x, _("'%s' cannot have * in PICTURE string and BLANK WHEN ZERO"),
						    cb_name (x));
					break;
				}
			}
			break;
		default:
			cb_error_x (x, _("'%s' is not numeric, so cannot have BLANK WHEN ZERO"), cb_name (x));
			break;
		}
	}
}

static void
validate_elem_value (const struct cb_field * const f)
{
	const cb_tree		x = CB_TREE (f);
	const struct cb_field	*p;

	if (CB_PAIR_P (CB_VALUE (f->values)) || CB_CHAIN (f->values)) {
		cb_error_x (x, _("only level 88 items may have multiple values"));
	}

	/* ISO+IEC+1989-2002: 13.16.42.2-10 */
	if (cb_warn_opt_val[cb_warn_ignored_initial_val] != COBC_WARN_DISABLED) {
		for (p = f; p; p = p->parent) {
			if (p->flag_external) {
				cb_warning_x (cb_warn_ignored_initial_val, x,
					      _("initial VALUE clause ignored for %s item '%s'"),
					      "EXTERNAL", cb_name (CB_TREE(f)));
			} else if (p->redefines) {
				cb_warning_x (cb_warn_ignored_initial_val, x,
					      _("initial VALUE clause ignored for %s item '%s'"),
					      "REDEFINES", cb_name (CB_TREE(f)));
			}
		}
	}
}

static void
warn_full_on_numeric_items_is_useless (const struct cb_field * const f)
{
	if ((f->screen_flag & COB_SCREEN_FULL)
	    && f->pic && f->pic->category == CB_CATEGORY_NUMERIC) {
		cb_warning_x (cb_warn_additional, CB_TREE (f),
			      _("FULL has no effect on numeric items; you may want REQUIRED or PIC Z"));
	}
}

static int
has_std_needed_screen_clause (const struct cb_field * const f)
{
	return (f->pic && (f->screen_from
			   || f->screen_to
			   || (f->values && CB_NUMERIC_LITERAL_P (CB_VALUE (f->values)))))
		|| (f->values
		    && (CB_LITERAL_P (CB_VALUE (f->values))
			|| CB_CONST_P (CB_VALUE (f->values)))
		    && (CB_TREE_CATEGORY (CB_VALUE (f->values)) == CB_CATEGORY_ALPHANUMERIC
			|| CB_TREE_CATEGORY (CB_VALUE (f->values)) == CB_CATEGORY_BOOLEAN
			|| CB_TREE_CATEGORY (CB_VALUE (f->values)) == CB_CATEGORY_NATIONAL))
		|| f->screen_flag & COB_SCREEN_BELL
		|| f->screen_flag & COB_SCREEN_BLANK_LINE
		|| f->screen_flag & COB_SCREEN_BLANK_SCREEN
		|| f->screen_flag & COB_SCREEN_ERASE_EOL
		|| f->screen_flag & COB_SCREEN_ERASE_EOS;
}

static void
error_value_figurative_constant(const struct cb_field * const f)
{
	if (f->values
	    && cb_is_figurative_constant (CB_VALUE (f->values))) {
		cb_error_x (CB_TREE (f), _("VALUE may not contain a figurative constant"));
	}
}

static void
error_both_full_and_justified (const struct cb_field * const f)
{
	if ((f->screen_flag & COB_SCREEN_FULL) && f->flag_justified) {
		cb_error_x (CB_TREE (f), _("cannot specify both FULL and JUSTIFIED"));
	}
}

static int
warn_from_to_using_without_pic (const struct cb_field * const f)
{
	const cb_tree	x = CB_TREE (f);

	if ((f->screen_from || f->screen_to) && !f->pic) {
		/* TO-DO: Change to dialect option */
		cb_warning_x (cb_warn_additional, x,
			      _("'%s' has FROM, TO or USING without PIC; PIC will be implied"),
			      cb_name (x));
		/* TO-DO: Add setting of PIC below here or move warnings to the code which sets the PIC */
		return 1;
	} else {
		return 0;
	}
}

static int
warn_pic_for_numeric_value_implied (const struct cb_field * const f)
{
	if (f->values && CB_NUMERIC_LITERAL_P (CB_VALUE (f->values))) {
		cb_warning_x (cb_warn_additional, CB_TREE (f),
			      _("'%s' has numeric VALUE without PIC; PIC will be implied"),
			      cb_name (CB_TREE (f)));
		return 1;
	} else {
		return 0;
	}
}

static void
validate_elem_screen_clauses_std (struct cb_field * const f)
{
	const cb_tree	x = CB_TREE (f);

	if (!has_std_needed_screen_clause (f)) {
		if (f->pic) {
			cb_error_x (x, _("'%s' cannot have PIC without FROM, TO, USING or numeric VALUE"),
				    cb_name (x));
		} else if (warn_from_to_using_without_pic (f)) {
			/*
			  The above rule is not explicitly stated, but the general rules of FROM,
			  TO and USING assume the item has a PICTURE clause.
			*/
			;
		} else if (warn_pic_for_numeric_value_implied (f)) {
			;
			/* TO-DO: Add setting of PIC below here or move warnings to the code which sets the PIC */
		} else {
			cb_error_x (x, _("'%s' needs a PIC, FROM, TO, USING, VALUE, BELL, BLANK or ERASE clause"),
				    cb_name (x));
		}
	}

	error_both_full_and_justified (f);

	error_value_figurative_constant (f);
}

static void
error_both_pic_and_value (const struct cb_field * const f)
{
	if (f->pic && f->values) {
		cb_error_x (CB_TREE (f), _("cannot specify both PIC and VALUE"));
	}
}

static void
error_pic_without_from_to_using (const struct cb_field * const f)
{
	if (f->pic && !(f->screen_from || f->screen_to)) {
		cb_error_x (CB_TREE (f), _("cannot have PIC without FROM, TO or USING"));
	}
}

static void
error_from_to_using_without_pic (const struct cb_field * const f)
{
	/* TO-DO: Replace warning, like in validate_elem_screen_clauses_std? */
	if ((f->screen_from || f->screen_to) && !f->pic) {
		cb_error_x (CB_TREE (f), _("cannot have FROM, TO or USING without PIC"));
	}
}

static void
error_value_numeric (const struct cb_field * const f)
{
	if (f->values
	    && CB_TREE_CATEGORY (CB_VALUE (f->values)) == CB_CATEGORY_NUMERIC) {
		cb_error_x (CB_TREE (f), _("VALUE item may not be numeric"));
	}
}

static void
error_no_screen_clause_needed_by_xopen (const struct cb_field * const f)
{
	const cb_tree	x = CB_TREE (f);

	if (!(f->pic
	      || f->screen_column
	      || f->screen_flag & COB_SCREEN_BELL
	      || f->screen_flag & COB_SCREEN_BLANK_LINE
	      || f->screen_flag & COB_SCREEN_BLANK_SCREEN
	      || f->screen_line
	      || f->values)) {
		cb_error_x (x, _("'%s' needs a PIC, COL, LINE, VALUE, BELL or BLANK clause"),
			    cb_name (x));
	}
}

static void
validate_elem_screen_clauses_mf (const struct cb_field * const f)
{
	const cb_tree	x = CB_TREE (f);

	error_no_screen_clause_needed_by_xopen (f);

	error_both_pic_and_value (f);
	error_pic_without_from_to_using (f);

	/*
	  The below rule isn't explicitly stated, but it follows from the
	  PICTURE's general rule which says the PIC character string determines
	  the length and category of the item.
	*/
	warn_from_to_using_without_pic (f);

	error_value_figurative_constant (f);
	error_value_numeric (f);

	if (!f->screen_to
	    && ((f->screen_flag & COB_SCREEN_AUTO)
		|| (f->screen_flag & COB_SCREEN_FULL)
		|| (f->screen_flag & COB_SCREEN_PROMPT)
		|| (f->screen_flag & COB_SCREEN_REQUIRED)
		|| (f->screen_flag & COB_SCREEN_SECURE))) {
		cb_error_x (x, _("cannot use AUTO, FULL, PROMPT, REQUIRED or SECURE on elementary item without TO or USING"));
	}
	if (!f->screen_from && !f->screen_to
	    && (f->flag_blank_zero
		|| f->flag_justified
		|| f->flag_occurs
		|| f->flag_sign_clause)) {
		cb_error_x (x, _("cannot use BLANK WHEN ZERO, JUSTIFIED, OCCURS or SIGN on item without FROM, TO or USING"));
	}
}

static void
validate_elem_screen_clauses_rm (struct cb_field *f)
{
	const cb_tree	x = CB_TREE (f);

	error_both_pic_and_value (f);
	error_pic_without_from_to_using (f);
	error_from_to_using_without_pic (f);

	error_value_numeric (f);

	if (!f->pic) {
		if ((f->screen_flag & COB_SCREEN_AUTO)
		    || (f->screen_flag & COB_SCREEN_FULL)
		    || (f->screen_flag & COB_SCREEN_REQUIRED)
		    || (f->screen_flag & COB_SCREEN_SECURE)) {
			cb_error_x (x, _("cannot use AUTO, FULL, REQUIRED or SECURE on elementary item without FROM, TO or USING"));
		}
		if (f->flag_blank_zero
		    || f->flag_justified
		    || f->flag_sign_clause) {
			cb_error_x (x, _("cannot use BLANK WHEN ZERO, JUSTIFIED or SIGN without FROM, TO or USING"));
		}
	}
}

static void
validate_elem_screen_clauses_acu (struct cb_field *f)
{
	const cb_tree	x = CB_TREE (f);

	error_both_pic_and_value (f);
	error_pic_without_from_to_using (f);

	error_value_numeric (f);

	warn_from_to_using_without_pic (f);
	if (!f->pic) {
		if (f->flag_blank_zero) {
			cb_error_x (x, _("cannot have BLANK WHEN ZERO without PIC"));
		}
		if (f->flag_justified) {
			cb_error_x (x, _("cannot have JUSTIFIED without PIC"));
		}
	}
}

static void
validate_elem_screen_clauses_xopen (struct cb_field *f)
{
	const cb_tree	x = CB_TREE (f);

	error_no_screen_clause_needed_by_xopen (f);

	error_both_pic_and_value (f);
	error_pic_without_from_to_using (f);
	error_from_to_using_without_pic (f);

	error_value_numeric (f);

	if (!f->screen_to && !f->screen_from
	    && (f->screen_flag & COB_SCREEN_AUTO)) {
		cb_error_x (x, _("cannot have AUTO without FROM, TO or USING"));
	}
	if (!f->screen_to
	    && ((f->screen_flag & COB_SCREEN_FULL)
		|| (f->screen_flag & COB_SCREEN_REQUIRED))) {
		cb_error_x (x, _("cannot use FULL or REQUIRED on item without TO or USING"));
	}

	error_both_full_and_justified (f);

	if ((f->screen_flag & COB_SCREEN_SECURE)) {
		if (f->screen_from) {
			cb_error_x (x, _("SECURE can be used with TO only"));
		} else if (!f->screen_to) {
			cb_error_x (x, _("SECURE must be used with TO"));
		}
	}
}

static void
warn_has_no_useful_clause (const struct cb_field * const f)
{
	if (!(  f->screen_column
	     || f->screen_flag & COB_SCREEN_BELL
	     || f->screen_flag & COB_SCREEN_BLANK_LINE
	     || f->screen_flag & COB_SCREEN_BLANK_SCREEN
	     || f->screen_flag & COB_SCREEN_ERASE_EOL
	     || f->screen_flag & COB_SCREEN_ERASE_EOS
	     || f->screen_from
	     || f->screen_line
	     || f->screen_to
	     || f->values)) {
		cb_warning_x (COBC_WARN_FILLER, CB_TREE (f),
			      _("'%s' does nothing"), cb_name (CB_TREE (f)));
	}
}

static void
validate_elem_screen_clauses_gc (const struct cb_field * const f)
{
	/* We aim for the least restrictive rules possible. */
	warn_has_no_useful_clause (f);
	warn_from_to_using_without_pic (f);
	warn_pic_for_numeric_value_implied (f);
}

static void
validate_elem_screen (struct cb_field *f)
{
	switch (cb_screen_section_clauses) {
	case CB_STD_SCREEN_RULES:
		validate_elem_screen_clauses_std (f);
		break;
	case CB_MF_SCREEN_RULES:
		validate_elem_screen_clauses_mf (f);
		break;
	case CB_ACU_SCREEN_RULES:
		validate_elem_screen_clauses_acu (f);
		break;
	case CB_RM_SCREEN_RULES:
		validate_elem_screen_clauses_rm (f);
		break;
	case CB_XOPEN_SCREEN_RULES:
		validate_elem_screen_clauses_xopen (f);
		break;
	case CB_GC_SCREEN_RULES:
		validate_elem_screen_clauses_gc (f);
		break;
	}

	warn_full_on_numeric_items_is_useless (f);
}

/* Perform validation of a non-66-or-88-level elementary item. */
static unsigned int
validate_elementary_item (struct cb_field *f)
{
	unsigned int	ret;

	ret = validate_usage (f);
	if (f->flag_sign_clause) {
		validate_sign (f);
	}
	validate_justified_right (f);

	if (f->flag_blank_zero) {
		validate_blank_when_zero (f);
	}

	if (f->values) {
		validate_elem_value (f);
	}
	if (!ret && f->storage == CB_STORAGE_SCREEN) {
		validate_elem_screen (f);
	}

	/* Validate PICTURE */
	ret |= validate_pic (f);

	/* TO-DO: This is not validation and should be elsewhere. */
	switch (f->usage) {
	case CB_USAGE_DISPLAY:
		if (current_program
		 && current_program->flag_trailing_separate
		 && f->pic
		 && f->pic->category == CB_CATEGORY_NUMERIC
		 && !f->flag_sign_leading) {
			f->flag_sign_separate = 1;
		}
		break;
	case CB_USAGE_SIGNED_CHAR:
		f->usage = CB_USAGE_COMP_5;
		f->pic = cb_build_binary_picture ("BINARY-CHAR", 2, 1);
		f->flag_real_binary = 1;
		break;
	case CB_USAGE_SIGNED_SHORT:
		f->usage = CB_USAGE_COMP_5;
		f->pic = cb_build_binary_picture ("BINARY-SHORT", 4, 1);
		f->flag_real_binary = 1;
		break;
	case CB_USAGE_SIGNED_INT:
		f->usage = CB_USAGE_COMP_5;
		f->pic = cb_build_binary_picture ("BINARY-LONG", 9, 1);
		f->flag_real_binary = 1;
		break;
	case CB_USAGE_SIGNED_LONG:
		f->usage = CB_USAGE_COMP_5;
		f->pic = cb_build_binary_picture ("BINARY-DOUBLE", 18, 1);
		f->flag_real_binary = 1;
		break;
	case CB_USAGE_UNSIGNED_CHAR:
		f->usage = CB_USAGE_COMP_5;
		f->pic = cb_build_binary_picture ("BINARY-CHAR", 2, 0);
		f->flag_real_binary = 1;
		break;
	case CB_USAGE_UNSIGNED_SHORT:
		f->usage = CB_USAGE_COMP_5;
		f->pic = cb_build_binary_picture ("BINARY-SHORT", 4, 0);
		f->flag_real_binary = 1;
		break;
	case CB_USAGE_UNSIGNED_INT:
		f->usage = CB_USAGE_COMP_5;
		f->pic = cb_build_binary_picture ("BINARY-LONG", 9, 0);
		f->flag_real_binary = 1;
		break;
	case CB_USAGE_POINTER:
		if (cb_numeric_pointer) {
			f->pic = cb_build_binary_picture ("BINARY-DOUBLE", 18, 0);
			f->flag_real_binary = 1;
		}
		break;
	case CB_USAGE_UNSIGNED_LONG:
		f->usage = CB_USAGE_COMP_5;
		f->pic = cb_build_binary_picture ("BINARY-DOUBLE", 18, 0);
		f->flag_real_binary = 1;
		break;
	case CB_USAGE_COMP_5:
		f->flag_real_binary = 1;
		break;
	default:
		break;
	}

	/* TO-DO: Also move, this is not validation */
	if (f->flag_blank_zero
	 && f->pic
	 && f->pic->category == CB_CATEGORY_NUMERIC) {
		cob_pic_symbol	*pstr;
		int		n;
		/* Reconstruct the picture string */
		if (f->pic->scale > 0) {
			/* Size for genned string */
			if (f->pic->have_sign) {
				n = 4;
			} else {
				n = 3;
			}
			f->pic->str = cobc_parse_malloc ((size_t)n * sizeof (cob_pic_symbol));
			pstr = f->pic->str;
			if (f->pic->have_sign) {
				pstr->symbol = '+';
				pstr->times_repeated = 1;
				++pstr;
			}
			pstr->symbol = '9';
			pstr->times_repeated = (int)f->pic->digits - f->pic->scale;
			++pstr;
			pstr->symbol = 'V';
			pstr->times_repeated = 1;
			++pstr;

			pstr->symbol = '9';
			pstr->times_repeated = f->pic->scale;
			++pstr;

			f->pic->size++;
		} else {
			/* Size for genned string */
			if (f->pic->have_sign) {
				n = 2;
			} else {
				n = 1;
			}
			f->pic->str = cobc_parse_malloc ((size_t)n * sizeof(cob_pic_symbol));
			pstr = f->pic->str;
			if (f->pic->have_sign) {
				pstr->symbol = '+';
				pstr->times_repeated = 1;
				++pstr;
			}
			pstr->symbol = '9';
			pstr->times_repeated = f->pic->digits;
		}
		f->pic->lenstr = n;
		f->pic->category = CB_CATEGORY_NUMERIC_EDITED;
	}

	return ret;
}

static unsigned int
validate_field_1 (struct cb_field *f)
{
	cb_tree		x;

#if 0
	/* LCOV_EXCL_START */
	if (unlikely (!f)) {	/* checked to keep the analyzer happy */
		cobc_err_msg (_("call to %s with NULL pointer"), "validate_field_1");
		COBC_ABORT();
	}
	/* LCOV_EXCL_STOP */
#endif

	if (f->flag_invalid) {
		return 1;
	}

	if (f->flag_any_length) {
		return validate_any_length_item (f);
	}

	x = CB_TREE (f);
	if (f->level == 77) {
		if (f->storage != CB_STORAGE_WORKING &&
		    f->storage != CB_STORAGE_LOCAL &&
		    f->storage != CB_STORAGE_LINKAGE) {
			cb_error_x (x, _("'%s' 77 level is not allowed here"), cb_name (x));
		}
	}

	if (f->flag_external) {
		validate_external (f);
	} else
	if (f->flag_item_based) {
		validate_based (f);
	}

	if (f->flag_occurs) {
		/* TO-DO: Not validation, so should not be in this function! */
		cb_tree		l;
		for (l = f->index_list; l; l = CB_CHAIN (l)) {
			CB_FIELD_PTR (CB_VALUE (l))->flag_is_global = f->flag_is_global;
		}
		/* END: Not validation */
		validate_occurs (f);
	}

	if (f->level == 66) {
		/* no check for redefines here */
		return 0;
	}
	if (f->redefines) {
		/* CHECKME - seems to be missing:
		   COBOL 202x doesn't allow REDEFINES in SCREEN/REPORT */
		validate_redefines (f);
	}

	if (f->children) {
		return validate_group (f);
	} else {
		return validate_elementary_item (f);
	}
}

static void
setup_parameters (struct cb_field *f)
{
	if (f->children) {
		/* Group field */
		unsigned int	flag_local = !!f->flag_local;
		for (f = f->children; f; f = f->sister) {
			f->flag_local = flag_local;
			setup_parameters (f);
		}
		return;
	}

	/* Regular field */
	/* Determine the class */
	switch (f->usage) {
	case CB_USAGE_BINARY:
#ifndef WORDS_BIGENDIAN
		if (cb_binary_byteorder == CB_BYTEORDER_BIG_ENDIAN) {
			f->flag_binary_swap = 1;
		}
#endif
		break;

	case CB_USAGE_INDEX:
	case CB_USAGE_HNDL:
	case CB_USAGE_HNDL_WINDOW:
	case CB_USAGE_HNDL_SUBWINDOW:
	case CB_USAGE_HNDL_FONT:
	case CB_USAGE_HNDL_THREAD:
	case CB_USAGE_HNDL_MENU:
	case CB_USAGE_HNDL_VARIANT:
	case CB_USAGE_HNDL_LM:
		f->pic = CB_PICTURE (cb_build_picture ("S9(9)"));
		f->pic->flag_is_calculated = 1;
#if 0
		/* REMIND: The category should be set, but doing so causes
		 * other problems as more checks need to be added to
		 * accept a category of CB_CATEGORY_INDEX so this change
		 * is deferred until a later time
		 * RJN: Nov 2017
		*/
		f->pic->category = CB_CATEGORY_INDEX;
#endif
		break;

	case CB_USAGE_LENGTH:
		f->pic = CB_PICTURE (cb_build_picture ("9(9)"));
		f->pic->flag_is_calculated = 1;
		break;

	case CB_USAGE_POINTER:
	case CB_USAGE_PROGRAM_POINTER:
#ifdef COB_64_BIT_POINTER
		f->pic = CB_PICTURE (cb_build_picture ("9(17)"));
#else
		f->pic = CB_PICTURE (cb_build_picture ("9(10)"));
#endif
		f->pic->flag_is_calculated = 1;
		break;
	case CB_USAGE_FLOAT:
		f->pic = CB_PICTURE (cb_build_picture ("S9(7)V9(8)"));
		f->pic->flag_is_calculated = 1;
		break;
	case CB_USAGE_DOUBLE:
		f->pic = CB_PICTURE (cb_build_picture ("S9(17)V9(17)"));
		f->pic->flag_is_calculated = 1;
		break;
	case CB_USAGE_FP_DEC64:
		/* RXWRXW - Scale Fix me */
		f->pic = CB_PICTURE (cb_build_picture ("S9(17)V9(16)"));
		f->pic->flag_is_calculated = 1;
		break;
	case CB_USAGE_FP_DEC128:
		/* RXWRXW - Scale Fix me */
		f->pic = CB_PICTURE (cb_build_picture ("S999V9(34)"));
		f->pic->flag_is_calculated = 1;
		break;

	case CB_USAGE_COMP_5:
		f->flag_real_binary = 1;
		/* Fall-through */
	case CB_USAGE_COMP_X:
	case CB_USAGE_COMP_N:
		if (f->pic->category == CB_CATEGORY_ALPHANUMERIC) {
			if (f->pic->size > 8) {
				f->pic = CB_PICTURE (cb_build_picture ("9(36)"));
			} else {
				char		pic[8];
				sprintf (pic, "9(%u)", pic_digits[f->pic->size - 1]);
				f->pic = CB_PICTURE (cb_build_picture (pic));
			}
		}
#ifndef WORDS_BIGENDIAN
		if (f->usage == CB_USAGE_COMP_X &&
			cb_binary_byteorder == CB_BYTEORDER_BIG_ENDIAN) {
			f->flag_binary_swap = 1;
		}
		if (f->usage == CB_USAGE_COMP_N) {
			f->flag_binary_swap = 1;
		}
#endif
		break;

	case CB_USAGE_DISPLAY:
		/* in case of usage display we often don't have the category
		   setup correctly, work around this explicit resolving it here */
		cb_tree_category (CB_TREE (f));
		break;

	default:
		break;
	}
}

static void
compute_binary_size (struct cb_field *f, const int size)
{
	switch (cb_binary_size) {
	case CB_BINARY_SIZE_1_2_4_8:
		f->size = ((size <= 2) ? 1 :
			   (size <= 4) ? 2 :
			   (size <= 9) ? 4 : (size <= 18) ? 8 : 16);
		return;
	case CB_BINARY_SIZE_2_4_8:
		if (f->flag_real_binary && size <= 2) {
			f->size = 1;
		} else {
			f->size = ((size <= 4) ? 2 :
				   (size <= 9) ? 4 : (size <= 18) ? 8 : 16);
		}
		return;
	case CB_BINARY_SIZE_1__8:
		if (f->pic->have_sign) {
			switch (size) {
			case 0:
			case 1:
			case 2:
				f->size = 1;
				return;
			case 3:
			case 4:
				f->size = 2;
				return;
			case 5:
			case 6:
				f->size = 3;
				return;
			case 7:
			case 8:
			case 9:
				f->size = 4;
				return;
			case 10:
			case 11:
				f->size = 5;
				return;
			case 12:
			case 13:
			case 14:
				f->size = 6;
				return;
			case 15:
			case 16:
				f->size = 7;
				return;
			case 17:
			case 18:
				f->size = 8;
				return;
			case 19:
			case 20:
			case 21:
				f->size = 9;
				return;
			case 22:
			case 23:
				f->size = 10;
				return;
			case 24:
			case 25:
			case 26:
				f->size = 11;
				return;
			case 27:
			case 28:
				f->size = 12;
				return;
			case 29:
			case 30:
			case 31:
				f->size = 13;
				return;
			case 32:
			case 33:
				f->size = 14;
				return;
			case 34:
			case 35:
				f->size = 15;
				return;
			default:
				f->size = 16;
				return;
			}
		}
		switch (size) {
		case 0:
		case 1:
		case 2:
			f->size = 1;
			return;
		case 3:
		case 4:
			f->size = 2;
			return;
		case 5:
		case 6:
		case 7:
			f->size = 3;
			return;
		case 8:
		case 9:
			f->size = 4;
			return;
		case 10:
		case 11:
		case 12:
			f->size = 5;
			return;
		case 13:
		case 14:
			f->size = 6;
			return;
		case 15:
		case 16:
			f->size = 7;
			return;
		case 17:
		case 18:
		case 19:
			f->size = 8;
			return;
		case 20:
		case 21:
			f->size = 9;
			return;
		case 22:
		case 23:
		case 24:
			f->size = 10;
			return;
		case 25:
		case 26:
			f->size = 11;
			return;
		case 27:
		case 28:
			f->size = 12;
			return;
		case 29:
		case 30:
		case 31:
			f->size = 13;
			return;
		case 32:
		case 33:
			f->size = 14;
			return;
		case 34:
		case 35:
		case 36:
			f->size = 15;
			return;
		default:
			f->size = 16;
			return;
		}
		return;
#if 0	/* how should this happen ... */
	default:
		f->size = size;
		return;
#endif
	}
}

static struct cb_field *
get_last_child (struct cb_field *f)
{
	do {
		f = f->children;
		while (f->sister) {
			f = f->sister;
		}
	} while (f->children);

	return f;
}

static void
set_report_field_offset (struct cb_field *f)
{
	struct cb_field *pp;

#if 0 /* That would be a bad error as this function is only called for report_column > 0 */
	if (f->storage != CB_STORAGE_REPORT) {
		return;
	}
#endif
	if (!(f->report_flag & COB_REPORT_COLUMN_PLUS)) {
		f->offset = f->report_column - 1;		/* offset based on COLUMN value */
		return;
	}
	pp = f->parent;
	if (pp) {
		if (pp->children == f) {
			f->offset = f->report_column - 1;	/* First in line */
		} else {
			struct cb_field *c;
			for (c = pp->children; c; c = c->sister) {	/* Find previous field */
				if (c->sister == f) {
					if (c->occurs_max > 1) {
					 	f->offset = c->offset + c->size * c->occurs_max + f->report_column;
					}
					else {
						f->offset = c->offset + c->size + f->report_column;
					}
					break;
				}
			}
		}
	}
}

static int
compute_size (struct cb_field *f)
{
	struct cb_field	*c;
	int		size = 0;
	int		size_check = 0;
	int		align_size;
	int		pad;
	int		unbounded_items = 0;
	int		unbounded_parts = 1;

	int		maxsz;
	struct cb_field *c0;

	if (f->storage == CB_STORAGE_REPORT) {
		if (f->report_num_col > 1) {
			if (f->flag_occurs) {
				/* FIXME: this is no size calculation and likely not reachable (if it is: move) */
				cb_error_x (CB_TREE (f), _("OCCURS and multi COLUMNs is not allowed"));
			} else {
				f->occurs_max = f->occurs_min = f->report_num_col;
				f->flag_occurs = 1;
				f->indexes = 1;
			}
		}
	}
	if (f->level == 66) {
		/* Rename */
		if (f->rename_thru) {
			f->size = f->rename_thru->offset + f->rename_thru->size -
				  f->redefines->offset;
		} else {
			f->size = f->redefines->size;
		}
		return f->size;
	}
	if (f->storage == CB_STORAGE_REPORT
	 && (f->report_flag & COB_REPORT_LINE)
	 && !(f->report_flag & COB_REPORT_LINE_PLUS)
	 && f->parent
	 && f->parent->children != f) {
		for(c = f->parent->children; c && c != f; c = c->sister) {
			if ((c->report_flag & COB_REPORT_LINE)
			 && !(c->report_flag & COB_REPORT_LINE_PLUS)
			 && c->report_line == f->report_line) {
				cb_warning_x (cb_warn_additional, CB_TREE (f),
					_("duplicate LINE %d ignored"), f->report_line);
				f->report_line = 0;
				f->report_flag &= ~COB_REPORT_LINE;
			}
		}
	}

	if (f->children) {
		if (f->storage == CB_STORAGE_REPORT
		 && (f->report_flag & COB_REPORT_LINE) ) {
			f->offset = 0;
		}

		/* Groups */
		if (f->flag_synchronized) {
			cb_warning_x (cb_warn_additional, CB_TREE (f),
				_("ignoring SYNCHRONIZED for group item '%s'"),
				cb_name (CB_TREE (f)));
		}
unbounded_again:
		size_check = 0;
		occur_align_size = 1;
		for (c = f->children; c; c = c->sister) {
			if (c->redefines) {
				c->offset = c->redefines->offset;
				compute_size (c);
				/* Increase the size if redefinition is larger */
				if (c->level != 66 &&
				    c->size * c->occurs_max >
				    c->redefines->size * c->redefines->occurs_max) {
					if (cb_larger_redefines_ok) {
						cb_warning_x (cb_warn_additional, CB_TREE (c),
							_("size of '%s' larger than size of '%s'"),
							c->name, c->redefines->name);
						maxsz = c->redefines->size * c->redefines->occurs_max;
						for (c0 = c->redefines->sister; c0 != c; c0 = c0->sister) {
							if (c0->size * c0->occurs_max > maxsz) {
								maxsz = c0->size * c0->occurs_max;
							}
						}
						if (c->size * c->occurs_max > maxsz) {
							size_check += (c->size * c->occurs_max) - maxsz;
						}
					} else {
						cb_error_x (CB_TREE (c),
							    _("size of '%s' larger than size of '%s'"),
							    c->name, c->redefines->name);
					}
				}
			} else {
				c->offset = f->offset + (int) size_check;
				compute_size (c);
				if (c->flag_unbounded) {
					unbounded_items++;
					c->occurs_max = (COB_MAX_UNBOUNDED_SIZE / c->size / unbounded_parts) - 1;
				}
				size_check += c->size * c->occurs_max;

				if (c->report_column > 0) { 		/* offset based on COLUMN value */
					set_report_field_offset(c);
				}

				/* Word alignment */
				if (c->flag_synchronized) {
					align_size = 1;
					switch (c->usage) {
					case CB_USAGE_BINARY:
					case CB_USAGE_COMP_5:
					case CB_USAGE_COMP_X:
					case CB_USAGE_COMP_N:
					case CB_USAGE_FLOAT:
					case CB_USAGE_DOUBLE:
					case CB_USAGE_LONG_DOUBLE:
					case CB_USAGE_FP_BIN32:
					case CB_USAGE_FP_BIN64:
					case CB_USAGE_FP_BIN128:
					case CB_USAGE_FP_DEC64:
					case CB_USAGE_FP_DEC128:
						if (c->size == 2 ||
						    c->size == 4 ||
						    c->size == 8 ||
						    c->size == 16) {
							align_size = c->size;
						}
						break;
					case CB_USAGE_INDEX:
					case CB_USAGE_HNDL:
					case CB_USAGE_HNDL_WINDOW:
					case CB_USAGE_HNDL_SUBWINDOW:
					case CB_USAGE_HNDL_FONT:
					case CB_USAGE_HNDL_THREAD:
					case CB_USAGE_HNDL_MENU:
					case CB_USAGE_HNDL_VARIANT:
					case CB_USAGE_HNDL_LM:
					case CB_USAGE_LENGTH:
						align_size = sizeof (int);
						break;
					case CB_USAGE_OBJECT:
					case CB_USAGE_POINTER:
					case CB_USAGE_PROGRAM_POINTER:
						align_size = sizeof (void *);
						break;
					default:
						break;
					}
					if (c->offset % align_size != 0) {
						pad = align_size - (c->offset % align_size);
						c->offset += pad;
						size_check += pad;
					}
					if (align_size > occur_align_size) {
						occur_align_size = align_size;
					}
				}
			}

			if (c->sister == NULL
			 && c->storage == CB_STORAGE_REPORT) {	/* To set parent size */
				if((c->offset + c->size) > size_check)
					size_check = (c->offset + c->size);
			}
		}
		/* Ensure items within OCCURS are aligned correctly. */
		if (f->occurs_max > 1 && (size_check % occur_align_size) != 0) {
			pad = occur_align_size - (size_check % occur_align_size);
			size_check += pad;
			/*
			  Add padding to last item, which will be (partly)
			  responsible for misalignment. If the item is not SYNC,
			  we have no problem. If it is SYNC, then it has been
			  aligned on a smaller boundary than occur_align_size: a
			  2-, 4- or 8-byte boundary. The needed padding will
			  be a multiple of 2, 4 or 8 bytes, so adding extra
			  padding will not break its alignment.
			*/
			if (f->children) {
				get_last_child (f)->offset += pad;
			} else {
				/* ToDo: add appropriate message (untranslated) */
				COBC_ABORT ();	/* LCOV_EXCL_LINE */
			}
		}
		/* size check for group items */
		if (unbounded_items) {
			if (size_check > COB_MAX_UNBOUNDED_SIZE) {
				/* Hack: run again for finding the correct max_occurs for unbounded items */
				if (unbounded_parts == 1 && unbounded_items != 1) {
					unbounded_parts = unbounded_items;
				} else {
					unbounded_parts++;
				}
				goto unbounded_again;
			}
		} else if (size_check > COB_MAX_FIELD_SIZE) {
			cb_error_x (CB_TREE (f),
					_("'%s' cannot be larger than %d bytes"),
					f->name, COB_MAX_FIELD_SIZE);
		}
		f->size = (int) size_check;
	} else if (!f->flag_is_external_form) {
		/* Elementary item */
		if (f->report_column > 0) { 		/* offset based on COLUMN value */
			set_report_field_offset (f);
		}

		switch (f->usage) {
		case CB_USAGE_COMP_X:
		case CB_USAGE_COMP_N:
			if (f->pic->category == CB_CATEGORY_ALPHANUMERIC) {
				break;
			}
			size = f->pic->size;
			f->size = ((size <= 2) ? 1 : (size <= 4) ? 2 :
				   (size <= 7) ? 3 : (size <= 9) ? 4 :
				   (size <= 12) ? 5 : (size <= 14) ? 6 :
				   (size <= 16) ? 7 : (size <= 19) ? 8 :
				   (size <= 21) ? 9 : (size <= 24) ? 10 :
				   (size <= 26) ? 11 : (size <= 28) ? 12 :
				   (size <= 31) ? 13 : (size <= 33) ? 14 :
				   (size <= 36) ? 15 : 16);
			break;
		case CB_USAGE_BINARY:
		case CB_USAGE_COMP_5:
			size = f->pic->size;
#if	0	/* RXWRXW - Max binary */
			if (size > COB_MAX_BINARY) {
				f->flag_binary_swap = 0;
				size = 38;
				cb_error_x (CB_TREE (f),
					    _("'%s' binary field cannot be larger than %d digits"),
					    f->name, COB_MAX_BINARY);
			}
#else
			if (size > 18) {
				f->flag_binary_swap = 0;
				size = 18;
				cb_error_x (CB_TREE (f),
					    _("'%s' binary field cannot be larger than %d digits"),
					    f->name, 18);
			}
#endif
			compute_binary_size (f, size);
			break;
		case CB_USAGE_DISPLAY:
			/* boolean items without USAGE BIT */
			if (f->pic->category == CB_CATEGORY_BOOLEAN) {
				f->size = f->pic->size / 8;
				if (f->pic->size % 8 != 0) {
					f->size++;
				}
				break;
			}
			f->size = f->pic->size;
			/* size check for single items */
			if (f->size > COB_MAX_FIELD_SIZE) {
				cb_error_x (CB_TREE (f),
						_("'%s' cannot be larger than %d bytes"),
						f->name, COB_MAX_FIELD_SIZE);
			}
			if (f->pic->have_sign && f->flag_sign_separate) {
				f->size++;
			}
			break;
		case CB_USAGE_PACKED:
			f->size = f->pic->size / 2 + 1;
			break;
		case CB_USAGE_COMP_6:
			f->size = (f->pic->size + 1) / 2;
			break;
		case CB_USAGE_INDEX:
		case CB_USAGE_HNDL:
		case CB_USAGE_HNDL_WINDOW:
		case CB_USAGE_HNDL_SUBWINDOW:
		case CB_USAGE_HNDL_FONT:
		case CB_USAGE_HNDL_THREAD:
		case CB_USAGE_HNDL_MENU:
		case CB_USAGE_HNDL_VARIANT:
		case CB_USAGE_HNDL_LM:
		case CB_USAGE_LENGTH:
			f->size = sizeof (int);
			break;
		case CB_USAGE_FLOAT:
			f->size = sizeof (float);
			break;
		case CB_USAGE_DOUBLE:
			f->size = sizeof (double);
			break;
		case CB_USAGE_LONG_DOUBLE:
			f->size = 16;
			break;
		case CB_USAGE_FP_BIN32:
			f->size = 4;
			break;
		case CB_USAGE_FP_BIN64:
		case CB_USAGE_FP_DEC64:
			f->size = 8;
			break;
		case CB_USAGE_FP_BIN128:
		case CB_USAGE_FP_DEC128:
			f->size = 16;
			break;
		case CB_USAGE_OBJECT:
		case CB_USAGE_POINTER:
		case CB_USAGE_PROGRAM_POINTER:
			f->size = sizeof (void *);
			break;
		case CB_USAGE_BIT:
			/* note: similar is found in DISPLAY */
			f->size = f->pic->size / 8;
			if (f->pic->size % 8 != 0) {
				f->size++;
			}
			break;
		/* LCOV_EXCL_START */
		default:
			cobc_err_msg (_("unexpected USAGE: %d"),
					(int)f->usage);
			COBC_ABORT ();
		/* LCOV_EXCL_STOP */
		}
	}

	/* The size of redefining field should not be larger than
	   the size of redefined field unless the redefined field
	   is level 01 and non-external */
	if (f->redefines && f->redefines->flag_external &&
	    (f->size * f->occurs_max > f->redefines->size * f->redefines->occurs_max)) {
		if (cb_larger_redefines_ok) {
			cb_warning_x (cb_warn_additional, CB_TREE (f),
				_("size of '%s' larger than size of '%s'"),
				f->name, f->redefines->name);
		} else {
			cb_error_x (CB_TREE (f), _("size of '%s' larger than size of '%s'"),
				f->name, f->redefines->name);
		}
	}

	return f->size;
}

static int
validate_field_value (struct cb_field *f)
{
	if (f->values) {
		validate_move (CB_VALUE (f->values), CB_TREE (f), 1, NULL);
	}

	if (f->children) {
		for (f = f->children; f; f = f->sister) {
			validate_field_value (f);
		}
	}

	return 0;
}

void
cb_validate_field (struct cb_field *f)
{
	if (f->flag_is_verified) {
		return;
	}
	if (validate_field_1 (f) != 0) {
		f->flag_invalid = 1;
		return;
	}
	if (f->flag_item_78) {
		f->flag_is_verified = 1;
		return;
	}

	/* Set up parameters */
	if (f->storage == CB_STORAGE_LOCAL ||
	    f->storage == CB_STORAGE_LINKAGE ||
	    f->flag_item_based) {
		f->flag_local = 1;
	}
	if (f->storage == CB_STORAGE_LINKAGE || f->flag_item_based) {
		f->flag_base = 1;
	}
	setup_parameters (f);

	/* Compute size */
	occur_align_size = 1;
	compute_size (f);
	if (!f->redefines) {
		f->memory_size = f->size * f->occurs_max;
	} else if (f->redefines->memory_size < f->size * f->occurs_max) {
		f->redefines->memory_size = f->size * f->occurs_max;
	}

	validate_field_value (f);
	if (f->flag_is_global) {
		struct cb_field		*c;
#if 0 /* CHECKME: Why should we adjust the field count here? */
		f->count++;
		for (c = f->children; c; c = c->sister) {
			c->flag_is_global = 1;
			c->count++;
		}
#else
		for (c = f->children; c; c = c->sister) {
			c->flag_is_global = 1;
		}
#endif
	}

	f->flag_is_verified = 1;
}

void
cb_validate_88_item (struct cb_field *f)
{
	cb_tree x = CB_TREE (f);
	cb_tree l;
	cb_tree t;

	if (CB_VALID_TREE (f->parent) &&
	    CB_TREE_CLASS (f->parent) == CB_CLASS_NUMERIC) {
		for (l = f->values; l; l = CB_CHAIN (l)) {
			t = CB_VALUE (l);
			if (t == cb_space || t == cb_low ||
			    t == cb_high || t == cb_quote) {
				cb_error_x (x, _("literal type does not match numeric data type"));
			}
		}
	}
}

struct cb_field *
cb_validate_78_item (struct cb_field *f, const cob_u32_t no78add)
{
	cb_tree			x;
	cob_u32_t		noadd, prec;

	if (!f) {
		return last_real_field;
	}
	if (f->flag_internal_constant) {	/* Keep all internal CONSTANTs */
		prec = 1;
	} else if (f->flag_constant) {		/* 01 CONSTANT is verified in parser.y */
		prec = 1;
	} else {
		cb_verify (cb_constant_78, "78 VALUE");
		prec = 0;
	}

	if (cb_is_expr (f->values) ) {
		f->values = CB_LIST_INIT(cb_evaluate_expr (f->values, prec));
	}

	x = CB_TREE (f);
	noadd = no78add;
	if (CB_INVALID_TREE (f->values)) {
		level_require_error (x, "VALUE");
		noadd = 1;
	} else if (CB_INVALID_TREE (CB_VALUE (f->values))) {
		noadd = 1;
	}

	if (!noadd) {
		cb_add_78 (f);
	}
	return last_real_field;
}

static struct cb_field *
get_next_record_field (const struct cb_field *f)
{
	if (f->children) {
		return f->children;
	}

	while (f) {
		if (f->sister) {
			return f->sister;
		} else {
			f = f->parent;
		}
	}

	return NULL;
}

static int
error_if_rename_thru_is_before_redefines (const struct cb_field * const item)
{
	struct cb_field	*f = cb_field_founder (item->redefines);

	/*
	  Perform depth-first search on the record containing the RENAMES items.
	*/
	while (f) {
		/* Error if we find rename_thru before redefines */
		if (f == item->rename_thru) {
			cb_error_x (CB_TREE (item),
				    _("THRU item '%s' may not come before '%s'"),
				    cb_name (CB_TREE (item->rename_thru)),
				    cb_name (CB_TREE (item->redefines)));
			return 1;
		} else if (f == item->redefines) {
			return 0;
		}

		f = get_next_record_field (f);
	}

	return 0;
}

static int
error_if_is_or_in_occurs (const struct cb_field * const field,
			  const struct cb_field * const referring_field)
{
	struct cb_field *parent;
	int	ret = 0;

	if (field->flag_occurs) {
		cb_error_x (CB_TREE (referring_field),
			    _("RENAMES cannot start/end at the OCCURS item '%s'"),
			    cb_name (CB_TREE (field)));
		ret = 1;
	}

	for (parent = field->parent; parent; parent = parent->parent) {
		if (parent->flag_occurs) {
			cb_error_x (CB_TREE (referring_field),
				    _("cannot use RENAMES on part of the table '%s'"),
				    cb_name (CB_TREE (parent)));
			ret = 1;
		}
	}

	return ret;
}

static int
error_if_invalid_type_in_renames_range (const struct cb_field * const item)
{
	const struct cb_field	*end;
	const struct cb_field	*f = item->redefines;
	enum cb_category	category;
	int ret = 0;

	/* Find last item in RENAMES range */
	if (item->rename_thru) {
		if (item->rename_thru->children) {
			end = get_last_child (item->rename_thru);
		} else {
			end = item->rename_thru;
		}
	} else {
		end = item->redefines;
	}

	/*
	  Check all items are not pointers, object references or OCCURS
	  DEPENDING tables.
	*/
	while (f) {
		category = cb_tree_category (CB_TREE (f));
		if (category == CB_CATEGORY_OBJECT_REFERENCE
		    || category == CB_CATEGORY_DATA_POINTER
		    || category == CB_CATEGORY_PROGRAM_POINTER) {
			cb_error_x (CB_TREE (item),
				    _("RENAMES may not contain '%s' as it is a pointer or object reference"),
				    cb_name (CB_TREE (f)));
			ret = 1;
		} else if (f->depending) {
			cb_error_x (CB_TREE (item),
				    _("RENAMES may not contain '%s' as it is an OCCURS DEPENDING table"),
				    cb_name (CB_TREE (f)));
			ret = 1;
		}

		if (f == end) {
			break;
		} else {
			f = get_next_record_field (f);
		}
	}
	return ret;
}

static int
error_if_invalid_level_for_renames (struct cb_field const *field, cb_tree ref)
{
	int	level = field->level;

	if (level == 1 || level == 66 || level == 77) {
		/* don't pass error here as this should not invalidate the field */
		cb_verify_x (ref, cb_renames_uncommon_levels,
			_("RENAMES of 01-, 66- and 77-level items"));
	} else if (level == 88) {
		cb_error_x (ref, _("RENAMES may not reference a level 88"));
		return 1;
	}
	return 0;
}

int
cb_validate_renames_item (struct cb_field *item,
	cb_tree ref_renames, cb_tree ref_thru)
{
	const cb_tree	item_tree = CB_TREE (item);
	const char	*redefines_name = cb_name (CB_TREE (item->redefines));
	const char	*rename_thru_name = cb_name (CB_TREE (item->rename_thru));
	struct cb_field *founder;
	struct cb_field *f;
	int ret = 0;

	if (error_if_invalid_level_for_renames (item->redefines, ref_renames)) {
		return 1;
	}

	founder = cb_field_founder (item->redefines);
	if (item->parent != founder) {
		cb_error_x (item_tree,
			    _("'%s' must immediately follow the record '%s'"),
			    cb_name (item_tree),
			    cb_name (CB_TREE (founder)));
		ret = 1;
	}

	if (item->redefines == item->rename_thru) {
		cb_error_x (item_tree,
			    _("THRU item must be different to '%s'"),
			    redefines_name);
		ret = 1;
	} else if (item->rename_thru) {
		if (founder != cb_field_founder (item->rename_thru)) {
			cb_error_x (item_tree,
					_("'%s' and '%s' must be in the same record"),
					redefines_name, rename_thru_name);
			return 1;
		}
		if (error_if_rename_thru_is_before_redefines (item)
		 || error_if_invalid_level_for_renames (item->rename_thru, ref_thru)) {
			return 1;
		}
		for (f = item->rename_thru; f; f = f->parent) {
			if (f->parent == item->redefines) {
				cb_error_x (item_tree,
						_("THRU item '%s' may not be subordinate to '%s'"),
						rename_thru_name, redefines_name);
				return 1;
			}
		}
	}
	ret |= error_if_invalid_type_in_renames_range (item);

	if (!error_if_is_or_in_occurs (item->redefines, item)
	 && item->rename_thru) {
		ret |= error_if_is_or_in_occurs (item->rename_thru, item);
	}

	return ret;
}

void
cb_clear_real_field (void)
{
	last_real_field = NULL;
}

struct cb_field *
cb_get_real_field (void)
{
	return last_real_field;
}

const char *
cb_get_usage_string (const enum cb_usage usage)
{
	switch (usage) {
	case CB_USAGE_BINARY:
		return "COMP";
	case CB_USAGE_BIT:
		return "BIT";
	case CB_USAGE_COMP_5:
		return "COMP-5";
	case CB_USAGE_COMP_X:
		return "COMP-X";
	case CB_USAGE_COMP_N:
		return "COMP-N";
	case CB_USAGE_DISPLAY:
		return "DISPLAY";
	case CB_USAGE_FLOAT:
		return "COMP-1";
		/* return "FLOAT-SHORT"; */
	case CB_USAGE_DOUBLE:
		return "COMP-2";
		/* return "FLOAT-LONG"; */
	case CB_USAGE_INDEX:
		return "INDEX";
	case CB_USAGE_NATIONAL:
		return "NATIONAL";
	case CB_USAGE_OBJECT:
		return "OBJECT REFERENCE";
	case CB_USAGE_PACKED:
		return "COMP-3";
		/* return "PACKED-DECIMAL"; */
	case CB_USAGE_POINTER:
		return "POINTER";
	case CB_USAGE_LENGTH:
		/* Probably---generates a cob_u32_t item.*/
		return "BINARY-LONG";
	case CB_USAGE_PROGRAM_POINTER:
		return "PROGRAM-POINTER";
	case CB_USAGE_UNSIGNED_CHAR:
		return "UNSIGNED-CHAR";
	case CB_USAGE_SIGNED_CHAR:
		return "SIGNED-CHAR";
	case CB_USAGE_UNSIGNED_SHORT:
		return "UNSIGNED-SHORT";
	case CB_USAGE_SIGNED_SHORT:
		return "SIGNED-SHORT";
	case CB_USAGE_UNSIGNED_INT:
		return "UNSIGNED-INT";
	case CB_USAGE_SIGNED_INT:
		return "SIGNED-INT";
	case CB_USAGE_UNSIGNED_LONG:
		return "UNSIGNED-LONG";
	case CB_USAGE_SIGNED_LONG:
		return "SIGNED-LONG";
	case CB_USAGE_COMP_6:
		return "COMP-6";
	case CB_USAGE_FP_DEC64:
		return "FLOAT-DECIMAL-16";
	case CB_USAGE_FP_DEC128:
		return "FLOAT-DECIMAL-34";
	case CB_USAGE_FP_BIN32:
		return "FLOAT-BINARY-32";
	case CB_USAGE_FP_BIN64:
		return "FLOAT-BINARY-64";
	case CB_USAGE_FP_BIN128:
		return "FLOAT-BINARY-128";
	case CB_USAGE_LONG_DOUBLE:
		return "FLOAT-EXTENDED";
	case CB_USAGE_HNDL:
		return "HANDLE";
	case CB_USAGE_HNDL_WINDOW:
		return "HANDLE OF WINDOW";
	case CB_USAGE_HNDL_SUBWINDOW:
		return "HANDLE OF SUBWINDOW";
	case CB_USAGE_HNDL_FONT:
		return "HANDLE OF FONT";
	case CB_USAGE_HNDL_THREAD:
		return "HANDLE OF THREAD";
	case CB_USAGE_HNDL_MENU:
		return "HANDLE OF MENU";
	case CB_USAGE_HNDL_VARIANT:
		return "VARIANT";
	case CB_USAGE_HNDL_LM:
		return "HANDLE OF LAYOUT-MANAGER";
	/* LCOV_EXCL_START */
	default:
		cb_error (_("unexpected USAGE: %d"), usage);
		COBC_ABORT ();
	/* LCOV_EXCL_STOP */
	}
}

int
cb_is_figurative_constant (const cb_tree x)
{
	return x == cb_null
		|| x == cb_zero
		|| x == cb_space
		|| x == cb_low
		|| x == cb_norm_low
		|| x == cb_high
		|| x == cb_norm_high
		|| x == cb_quote
		|| (CB_REFERENCE_P (x)
		    && CB_REFERENCE (x)->flag_all);
}

int
cb_field_is_ignored_in_ml_gen (struct cb_field * const f)
{
	return f->flag_filler || f->redefines || f->rename_thru;
}