void
ambiguous_error (cb_tree x)
{
struct cb_word *w;
struct cb_field *p;
struct cb_label *l2;
cb_tree l;
cb_tree y;
w = CB_REFERENCE (x)->word;
if (w->error == 0) {
if (!errnamebuff) {
errnamebuff = cobc_malloc (COB_NORMAL_BUFF);
}
/* display error on the first time */
snprintf (errnamebuff, COB_NORMAL_MAX, "'%s'", CB_NAME (x));
for (l = CB_REFERENCE (x)->chain; l; l = CB_REFERENCE (l)->chain) {
strcat (errnamebuff, " in '");
strcat (errnamebuff, CB_NAME (l));
strcat (errnamebuff, "'");
}
cb_error_x (x, _("%s ambiguous; need qualification"), errnamebuff);
w->error = 1;
/* display all fields with the same name */
for (l = w->items; l; l = CB_CHAIN (l)) {
y = CB_VALUE (l);
snprintf (errnamebuff, COB_NORMAL_MAX, "'%s' ", w->name);
switch (CB_TREE_TAG (y)) {
case CB_TAG_FIELD:
for (p = CB_FIELD (y)->parent; p; p = p->parent) {
strcat (errnamebuff, "in '");
strcat (errnamebuff, p->name);
strcat (errnamebuff, "' ");
}
break;
case CB_TAG_LABEL:
l2 = CB_LABEL (y);
if (l2->section) {
strcat (errnamebuff, "in '");
strcat (errnamebuff, (const char *)(l2->section->name));
strcat (errnamebuff, "' ");
}
break;
default:
break;
}
strcat (errnamebuff, _("defined here"));
cb_error_x (y, errnamebuff);
}
}
}
void
undefined_error (cb_tree x)
{
struct cb_reference *r;
cb_tree c;
if (!errnamebuff) {
errnamebuff = cobc_malloc (COB_NORMAL_BUFF);
}
r = CB_REFERENCE (x);
snprintf (errnamebuff, COB_NORMAL_MAX, "'%s'", CB_NAME (x));
for (c = r->chain; c; c = CB_REFERENCE (c)->chain) {
strcat (errnamebuff, " in '");
strcat (errnamebuff, CB_NAME (c));
strcat (errnamebuff, "'");
}
cb_error_x (x, _("%s undefined"), errnamebuff);
}
int
cb_get_level (cb_tree x)
{
const char *p;
const char *name;
int level = 0;
name = CB_NAME (x);
/* get level */
for (p = name; *p; p++) {
if (!isdigit (*p)) {
goto level_error;
}
level = level * 10 + (*p - '0');
}
/* 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;
}
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;
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' undefined in '%s'"), name, field->parent->name);
return NULL;
}
} else {
if (cb_ref (redefines) == cb_error_node) {
return NULL;
}
f = cb_field (redefines);
}
/* check level number */
if (f->level != field->level) {
cb_error_x (x, _("Level number of REDEFINES entries must be identical"));
return NULL;
}
if (f->level == 66 || f->level == 88) {
cb_error_x (x, _("Level number of REDEFINES entry cannot be 66 or 88"));
return NULL;
}
if (!cb_indirect_redefines && f->redefines) {
cb_error_x (x, _("'%s' not the original definition"), f->name);
return NULL;
}
/* return the original definition */
while (f->redefines) {
f = f->redefines;
}
return f;
}
