|
OpenCOBOL 1.1pre-rel
|
#include "config.h"#include <stdio.h>#include <stdlib.h>#include <string.h>#include <ctype.h>#include "cobc.h"#include "tree.h"
Go to the source code of this file.
Functions | |
| int | cb_get_level (cb_tree x) |
| 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) |
| struct cb_field * | cb_resolve_redefines (struct cb_field *field, cb_tree redefines) |
| void | cb_validate_field (struct cb_field *f) |
| void | cb_validate_88_item (struct cb_field *f) |
| struct cb_field * | cb_validate_78_item (struct cb_field *f) |
| void | cb_clear_real_field (void) |
Variables | |
| size_t | cb_needs_01 = 0 |
| 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 | ||
| ) |
Definition at line 78 of file field.c.
{
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 (level == cb_error_node || name == cb_error_node) {
return cb_error_node;
}
/* check the level number */
lv = cb_get_level (level);
if (!lv) {
return cb_error_node;
}
/* 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;
return CB_TREE (f);
} else {
f->level = lv;
}
if (f->level == 01 && storage == CB_STORAGE_FILE) {
if (fn->external) {
f->flag_external = 1;
has_external = 1;
} else if (fn->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_redefinition) {
if (r->word->count > 1) {
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
|| (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_add (cb_field_founder (last_field), f);
*/
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;
} 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; 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) {
dummy_fill = cb_build_filler ();
field_fill = CB_FIELD (cb_build_field (dummy_fill));
cb_warning_x (name, _("No previous data item of level %02d"), f->level);
field_fill->level = f->level;
field_fill->storage = storage;
field_fill->children = p->children;
field_fill->parent = p;
for (p = p->children; p != NULL; 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 parent's properties */
if (f->parent) {
f->usage = f->parent->usage;
f->indexes = f->parent->indexes;
f->flag_sign_leading = f->parent->flag_sign_leading;
f->flag_sign_separate = f->parent->flag_sign_separate;
f->flag_is_global = f->parent->flag_is_global;
}
return CB_TREE (f);
}

| void cb_clear_real_field | ( | void | ) |
| int cb_get_level | ( | cb_tree | x | ) |
Definition at line 41 of file field.c.
{
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;
}


Definition at line 231 of file field.c.
{
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;
}

Definition at line 1033 of file field.c.
{
cb_tree x;
x = CB_TREE (f);
if (!f->values) {
level_require_error (x, "VALUE");
}
if (f->pic || f->flag_occurs) {
level_except_error (x, "VALUE");
}
cb_add_78 (f);
return last_real_field;
}

| void cb_validate_88_item | ( | struct cb_field * | f | ) |
Definition at line 1018 of file field.c.
{
cb_tree x;
x = CB_TREE (f);
if (!f->values) {
level_require_error (x, "VALUE");
}
if (f->pic || f->flag_occurs) {
level_except_error (x, "VALUE");
}
}

| void cb_validate_field | ( | struct cb_field * | f | ) |
Definition at line 973 of file field.c.
{
struct cb_field *c;
if (validate_field_1 (f) != 0) {
f->flag_invalid = 1;
return;
}
/* RXW - Remove */
if (f->flag_item_78) {
f->flag_is_verified = 1;
return;
}
/* setup 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 */
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) {
f->count++;
for (c = f->children; c; c = c->sister) {
c->flag_is_global = 1;
c->count++;
}
}
f->flag_is_verified = 1;
}

| size_t cb_needs_01 = 0 |
1.7.4