OpenCOBOL 1.1pre-rel
Functions | Variables
field.c File Reference
#include "config.h"
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <ctype.h>
#include "cobc.h"
#include "tree.h"
Include dependency graph for field.c:

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_fieldcb_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_fieldcb_validate_78_item (struct cb_field *f)
void cb_clear_real_field (void)

Variables

size_t cb_needs_01 = 0

Function Documentation

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);
}

Here is the call graph for this function:

void cb_clear_real_field ( void  )

Definition at line 1050 of file field.c.

{
        last_real_field = NULL;
}

Here is the caller graph for this function:

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;
}

Here is the call graph for this function:

Here is the caller graph for this function:

struct cb_field* cb_resolve_redefines ( struct cb_field field,
cb_tree  redefines 
) [read]

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;
}

Here is the call graph for this function:

struct cb_field* cb_validate_78_item ( struct cb_field f) [read]

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;
}

Here is the call graph for this function:

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");
        }
}

Here is the call graph for this function:

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;
}

Here is the caller graph for this function:


Variable Documentation

size_t cb_needs_01 = 0

Definition at line 33 of file field.c.

 All Classes Files Functions Variables Typedefs Enumerations Enumerator Defines