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 |