GnuCOBOL  2.0
A free COBOL compiler
field.c
Go to the documentation of this file.
1 /*
2  Copyright (C) 2001-2012, 2014-2016 Free Software Foundation, Inc.
3  Written by Keisuke Nishida, Roger While, Simon Sobisch
4 
5  This file is part of GnuCOBOL.
6 
7  The GnuCOBOL compiler is free software: you can redistribute it
8  and/or modify it under the terms of the GNU General Public License
9  as published by the Free Software Foundation, either version 3 of the
10  License, or (at your option) any later version.
11 
12  GnuCOBOL is distributed in the hope that it will be useful,
13  but WITHOUT ANY WARRANTY; without even the implied warranty of
14  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15  GNU General Public License for more details.
16 
17  You should have received a copy of the GNU General Public License
18  along with GnuCOBOL. If not, see <http://www.gnu.org/licenses/>.
19 */
20 
21 
22 #include "config.h"
23 
24 #include <stdio.h>
25 #include <stdlib.h>
26 #include <stddef.h>
27 #include <string.h>
28 #include <ctype.h>
29 #include <limits.h>
30 
31 #include "cobc.h"
32 #include "tree.h"
33 
34 /* Global variables */
35 
37 size_t cb_needs_01 = 0;
38 
39 /* Local variables */
40 
41 static struct cb_field *last_real_field = NULL;
42 static int occur_align_size = 0;
43 static const int pic_digits[] = { 2, 4, 7, 9, 12, 14, 16, 18 };
44 
45 int
47 {
48  const unsigned char *p;
49  const char *name;
50  int level;
51 
52  if (CB_INVALID_TREE (x)) {
53  return 0;
54  }
55  name = CB_NAME (x);
56  level = 0;
57  /* Get level */
58  for (p = (const unsigned char *)name; *p; p++) {
59  if (!isdigit ((int)(*p))) {
60  goto level_error;
61  }
62  level = level * 10 + (*p - '0');
63  if (level > 88) {
64  goto level_error;
65  }
66  }
67 
68  /* Check level */
69  switch (level) {
70  case 66:
71  case 77:
72  case 78:
73  case 88:
74  break;
75  default:
76  if (level < 1 || level > 49) {
77  goto level_error;
78  }
79  break;
80  }
81 
82  return level;
83 
84 level_error:
85  cb_error_x (x, _("Invalid level number '%s'"), name);
86  return 0;
87 }
88 
89 cb_tree
91  enum cb_storage storage, struct cb_file *fn,
92  const int expl_level)
93 {
94  struct cb_reference *r;
95  struct cb_field *f;
96  struct cb_field *p;
97  struct cb_field *field_fill;
98  cb_tree dummy_fill;
99  cb_tree l;
100  cb_tree x;
101  int lv;
102 
103  if (!expl_level) {
104  if (level == cb_error_node || name == cb_error_node) {
105  return cb_error_node;
106  }
107  /* Check the level number */
108  lv = cb_get_level (level);
109  if (!lv) {
110  return cb_error_node;
111  }
112  } else {
113  lv = expl_level;
114  }
115 
116  /* Build the field */
117  r = CB_REFERENCE (name);
118  f = CB_FIELD (cb_build_field (name));
119  f->storage = storage;
120  last_real_field = last_field;
121  if (lv == 78) {
122  f->level = 01;
123  f->flag_item_78 = 1;
124  return CB_TREE (f);
125  } else {
126  f->level = lv;
127  }
128  if (f->level == 01 && storage == CB_STORAGE_FILE && fn) {
129  if (fn->flag_external) {
130  f->flag_external = 1;
132  } else if (fn->flag_global) {
133  f->flag_is_global = 1;
134  }
135  }
136  if (last_field) {
137  if (last_field->level == 77 && f->level != 01 &&
138  f->level != 77 && f->level != 66 && f->level != 88) {
139  cb_error_x (name, _("Level number must begin with 01 or 77"));
140  return cb_error_node;
141  }
142  }
143 
144  /* Checks for redefinition */
145  if (cb_warn_redefinition && r->word->count > 1 && !r->flag_filler_ref) {
146  if (f->level == 01 || f->level == 77) {
147  redefinition_warning (name, NULL);
148  } else {
149  for (l = r->word->items; l; l = CB_CHAIN (l)) {
150  x = CB_VALUE (l);
151  if (!CB_FIELD_P (x) ||
152  CB_FIELD (x)->level == 01 ||
153  CB_FIELD (x)->level == 77 ||
154  (last_field && f->level == last_field->level &&
155  CB_FIELD (x)->parent == last_field->parent)) {
156  redefinition_warning (name, x);
157  break;
158  }
159  }
160  }
161  }
162 
163  if (last_field && last_field->level == 88) {
164  last_field = last_field->parent;
165  }
166 
167  /* Link the field into the tree */
168  if (f->level == 01 || f->level == 77) {
169  /* Top level */
170  cb_needs_01 = 0;
171  if (last_field) {
172  cb_field_founder (last_field)->sister = f;
173  }
174  } else if (!last_field || cb_needs_01) {
175  /* Invalid top level */
176  cb_error_x (name, _("Level number must begin with 01 or 77"));
177  return cb_error_node;
178  } else if (f->level == 66) {
179  /* Level 66 */
180  f->parent = cb_field_founder (last_field);
181  for (p = f->parent->children; p && p->sister; p = p->sister) ;
182  if (p) {
183  p->sister = f;
184  }
185  } else if (f->level == 88) {
186  /* Level 88 */
187  f->parent = last_field;
188  } else if (f->level > last_field->level) {
189  /* Lower level */
190  last_field->children = f;
191  f->parent = last_field;
192  } else if (f->level == last_field->level) {
193  /* Same level */
194 same_level:
195  last_field->sister = f;
196  f->parent = last_field->parent;
197  } else {
198  /* Upper level */
199  for (p = last_field->parent; p /* <- silence warnings */; p = p->parent) {
200  if (p->level == f->level) {
201  last_field = p;
202  goto same_level;
203  }
204  if (cb_relax_level_hierarchy && p->level < f->level) {
205  break;
206  }
207  }
208  if (cb_relax_level_hierarchy
209  && p /* <- silence warnings */) {
210  dummy_fill = cb_build_filler ();
211  field_fill = CB_FIELD (cb_build_field (dummy_fill));
212  cb_warning_x (name,
213  _("No previous data item of level %02d"),
214  f->level);
215  field_fill->level = f->level;
216  field_fill->flag_filler = 1;
217  field_fill->storage = storage;
218  field_fill->children = p->children;
219  field_fill->parent = p;
220  for (p = p->children; p; p = p->sister) {
221  p->parent = field_fill;
222  }
223  field_fill->parent->children = field_fill;
224  field_fill->sister = f;
225  f->parent = field_fill->parent;
226  /* last_field = field_fill; */
227  } else {
228  cb_error_x (name,
229  _("No previous data item of level %02d"),
230  f->level);
231  return cb_error_node;
232  }
233  }
234 
235  /* Inherit parents properties */
236  if (f->parent) {
237  f->usage = f->parent->usage;
238  f->indexes = f->parent->indexes;
242  }
243  return CB_TREE (f);
244 }
245 
246 struct cb_field *
248 {
249  struct cb_field *f;
250  struct cb_reference *r;
251  const char *name;
252  cb_tree x;
253  cb_tree candidate;
254  cb_tree items;
255 
256  r = CB_REFERENCE (redefines);
257  name = CB_NAME (redefines);
258  x = CB_TREE (field);
259 
260  /* Check qualification */
261  if (r->chain) {
262  cb_error_x (x, _("'%s' cannot be qualified here"), name);
263  return NULL;
264  }
265 
266  /* Check subscripts */
267  if (r->subs) {
268  cb_error_x (x, _("'%s' cannot be subscripted here"), name);
269  return NULL;
270  }
271 
272  /* Resolve the name in the current group (if any) */
273  if (field->parent && field->parent->children) {
274  for (f = field->parent->children; f; f = f->sister) {
275  if (strcasecmp (f->name, name) == 0) {
276  break;
277  }
278  }
279  if (f == NULL) {
280  cb_error_x (x, _("'%s' is not defined in '%s'"), name, field->parent->name);
281  return NULL;
282  }
283  } else {
284  /* Get last defined name */
285  candidate = NULL;
286  items = r->word->items;
287  for (; items; items = CB_CHAIN (items)) {
288  if (CB_FIELD_P (CB_VALUE (items))) {
289  candidate = CB_VALUE (items);
290  }
291  }
292  if (!candidate) {
293  undefined_error (redefines);
294  return NULL;
295  }
296  f = CB_FIELD_PTR (candidate);
297  }
298 
299  /* Check level number */
300  if (f->level != field->level) {
301  cb_error_x (x, _("Level number of REDEFINES entries must be identical"));
302  return NULL;
303  }
304  if (f->level == 66 || f->level == 88) {
305  cb_error_x (x, _("Level number of REDEFINES entry cannot be 66 or 88"));
306  return NULL;
307  }
308 
309  if (!cb_indirect_redefines && f->redefines) {
310  cb_error_x (x, _("'%s' not the original definition"), f->name);
311  return NULL;
312  }
313 
314  /* Return the original definition */
315  while (f->redefines) {
316  f = f->redefines;
317  }
318  return f;
319 }
320 
321 static void
323 {
324  if (f->flag_blank_zero) {
325  cb_error_x (x, _("BLANK ZERO not compatible with USAGE"));
326  }
327  if (f->flag_sign_leading || f->flag_sign_separate) {
328  cb_error_x (x, _("SIGN clause not compatible with USAGE"));
329  }
330 }
331 
332 static unsigned int
334 {
335  char *pp;
336  struct cb_literal *lp;
337  int vorint;
338  char pic[24];
339 
340  if (f->storage == CB_STORAGE_SCREEN) {
341  /* RXWRXW Fixme - Corner cases */
342  if (f->values) {
343  sprintf (pic, "X(%d)", (int)CB_LITERAL(CB_VALUE(f->values))->size);
344  } else if (f->screen_from) {
345  sprintf (pic, "X(%d)", (int)CB_FIELD_PTR (f->screen_from)->size);
346  } else if (f->screen_to) {
347  sprintf (pic, "X(%d)", (int)CB_FIELD_PTR (f->screen_to)->size);
348  } else {
349  f->flag_no_field = 1;
350  strcpy (pic, "X(1)");
351  }
352  f->pic = CB_PICTURE (cb_build_picture (pic));
353  return 0;
354  }
355  if (f->flag_item_78) {
356  if (!f->values || CB_VALUE(f->values) == cb_error_node) {
357  level_require_error (x, "VALUE");
358  return 1;
359  }
360  f->count++;
361  lp = CB_LITERAL(CB_VALUE(f->values));
363  memset (pic, 0, sizeof (pic));
364  pp = pic;
365  if (lp->sign) {
366  *pp++ = 'S';
367  }
368  vorint = (int)lp->size - lp->scale;
369  if (vorint) {
370  pp += sprintf (pp, "9(%d)", vorint);
371  }
372  if (lp->scale) {
373  sprintf (pp, "V9(%d)", lp->scale);
374  }
375  if (lp->size < 10) {
376  f->usage = CB_USAGE_COMP_5;
377  } else {
378  f->usage = CB_USAGE_DISPLAY;
379  }
380  f->pic = CB_PICTURE (cb_build_picture (pic));
382  } else {
383  sprintf (pic, "X(%d)", (int)lp->size);
384  f->pic = CB_PICTURE (cb_build_picture (pic));
386  f->usage = CB_USAGE_DISPLAY;
387  }
388  return 0;
389  }
390  if (f->level == 1) {
391  cb_error_x (x, _("PICTURE clause required for '%s'"),
392  cb_name (x));
393  return 1;
394  }
395  if (!f->values || CB_VALUE(f->values) == cb_error_node) {
396  cb_error_x (x, _("PICTURE clause required for '%s'"),
397  cb_name (x));
398  return 1;
399  }
401  cb_error_x (x, _("A non-numeric literal is expected for '%s'"),
402  cb_name (x));
403  return 1;
404  }
405  vorint = (int)CB_LITERAL(CB_VALUE(f->values))->size;
406  if (warningopt) {
407  cb_warning_x (x, _("Defining implicit picture size %d for '%s'"),
408  vorint, cb_name (x));
409  }
410  sprintf (pic, "X(%d)", vorint);
411  f->pic = CB_PICTURE (cb_build_picture (pic));
413  f->usage = CB_USAGE_DISPLAY;
414  return 0;
415 }
416 
417 static unsigned int
419 {
420  cb_tree x;
421  cb_tree l;
422  struct cb_field *p;
423  unsigned char *pstr;
424  int vorint;
425  int n;
426  int need_picture;
427  unsigned int ret;
428 
429  if (f->flag_invalid) {
430  return 1;
431  }
432  x = CB_TREE (f);
433  if (f->flag_any_length) {
434  if (f->storage != CB_STORAGE_LINKAGE) {
435  cb_error_x (x, _("'%s' ANY LENGTH only allowed in LINKAGE"), cb_name (x));
436  return 1;
437  }
438  if (f->level != 01) {
439  cb_error_x (x, _("'%s' ANY LENGTH must be 01 level"), cb_name (x));
440  return 1;
441  }
442  if (f->flag_item_based || f->flag_external) {
443  cb_error_x (x, _("'%s' ANY LENGTH can not be BASED/EXTERNAL"), cb_name (x));
444  return 1;
445  }
446  if (f->flag_occurs || f->depending ||
447  f->children || f->values || f->flag_blank_zero) {
448  cb_error_x (x, _("'%s' ANY LENGTH has invalid definition"), cb_name (x));
449  return 1;
450  }
451  if (!f->pic) {
452  if (f->flag_any_numeric) {
453  f->pic = CB_PICTURE (cb_build_picture ("9"));
454  } else {
455  f->pic = CB_PICTURE (cb_build_picture ("X"));
456  }
457 #if 0 /* RXWRXW - ANY length */
458  cb_error_x (x, _("'%s' ANY LENGTH must have a PICTURE"), cb_name (x));
459  return 1;
460 #endif
461  }
462  if (f->pic->size != 1 || f->usage != CB_USAGE_DISPLAY) {
463  cb_error_x (x, _("'%s' ANY LENGTH has invalid definition"), cb_name (x));
464  return 1;
465  }
466  f->count++;
467  return 0;
468  }
469 
470  if (f->level == 77) {
471  if (f->storage != CB_STORAGE_WORKING &&
472  f->storage != CB_STORAGE_LOCAL &&
473  f->storage != CB_STORAGE_LINKAGE) {
474  cb_error_x (x, _("'%s' 77 level not allowed here"), cb_name (x));
475  }
476  }
477  if (f->flag_external) {
478  if (f->level != 01 && f->level != 77) {
479  cb_error_x (x, _("'%s' EXTERNAL must be specified at 01/77 level"), cb_name (x));
480  }
481  if (f->storage != CB_STORAGE_WORKING &&
482  f->storage != CB_STORAGE_FILE) {
483  cb_error_x (x, _("'%s' EXTERNAL can only be specified in WORKING-STORAGE section"),
484  cb_name (x));
485  }
486  if (f->flag_item_based) {
487  cb_error_x (x, _("'%s' EXTERNAL and BASED are mutually exclusive"), cb_name (x));
488  }
489  if (f->redefines) {
490  cb_error_x (x, _("'%s' EXTERNAL not allowed with REDEFINES"), cb_name (x));
491  }
492  }
493  if (f->flag_item_based) {
494  if (f->storage != CB_STORAGE_WORKING &&
495  f->storage != CB_STORAGE_LOCAL &&
496  f->storage != CB_STORAGE_LINKAGE) {
497  cb_error_x (x, _("'%s' BASED not allowed here"), cb_name (x));
498  }
499  if (f->redefines) {
500  cb_error_x (x, _("'%s' BASED not allowed with REDEFINES"), cb_name (x));
501  }
502  if (f->level != 01 && f->level != 77) {
503  cb_error_x (x, _("'%s' BASED only allowed at the 01 and 77 levels"), cb_name (x));
504  }
505  }
506  if (f->level == 66) {
507  if (!f->redefines) {
508  level_require_error (x, "RENAMES");
509  return 1;
510  }
511  if (f->flag_occurs) {
512  level_except_error (x, "RENAMES");
513  }
514  return 0;
515  }
516 
517  /* Validate OCCURS */
518  if (f->flag_occurs) {
519  if ((!cb_verify (cb_top_level_occurs_clause, "01/77 OCCURS") &&
520  (f->level == 01 || f->level == 77)) ||
521  (f->level == 66 || f->level == 88)) {
522  level_redundant_error (x, "OCCURS");
523  }
524  for (l = f->index_list; l; l = CB_CHAIN (l)) {
525  CB_FIELD_PTR (CB_VALUE (l))->flag_is_global = f->flag_is_global;
526  }
527  }
528 
529  /* Validate OCCURS DEPENDING */
530  if (f->depending) {
531  /* Cache field for later checking */
532  cb_depend_check = cb_list_add (cb_depend_check, x);
533 
534  if (!cb_complex_odo) {
535  /* The data item that contains a OCCURS DEPENDING clause shall not
536  be subordinate to a data item that has an OCCURS clause */
537  for (p = f->parent; p; p = p->parent) {
538  if (p->flag_occurs) {
539  cb_error_x (CB_TREE (p),
540  _("'%s' cannot have the OCCURS clause due to '%s'"),
541  cb_name (CB_TREE (p)),
542  cb_name (x));
543  break;
544  }
545  }
546  }
547  }
548 
549  /* Validate REDEFINES */
550  if (f->redefines) {
551  /* Check OCCURS */
552  if (f->redefines->flag_occurs) {
553  cb_warning_x (x, _("The original definition '%s' should not have OCCURS"),
554  f->redefines->name);
555  }
556 
557  /* Check definition */
558  for (p = f->redefines->sister; p && p != f; p = p->sister) {
559  if (!p->redefines) {
560  cb_error_x (x, _("REDEFINES must follow the original definition"));
561  break;
562  }
563  }
564 
565  /* Check variable occurrence */
566  if (f->depending || cb_field_variable_size (f)) {
567  cb_error_x (x, _("'%s' cannot be variable length"), f->name);
568  }
570  cb_error_x (x,
571  _("The original definition '%s' cannot be variable length"),
572  f->redefines->name);
573  }
574  }
575 
576  if (f->children) {
577  /* Group item */
578 
579  if (f->pic) {
580  group_error (x, "PICTURE");
581  }
582  if (f->flag_justified) {
583  group_error (x, "JUSTIFIED RIGHT");
584  }
585  if (f->flag_blank_zero) {
586  group_error (x, "BLANK WHEN ZERO");
587  }
588 
589  ret = 0;
590  if (f->storage == CB_STORAGE_SCREEN &&
591  (f->screen_from || f->screen_to || f->values || f->pic)) {
592  cb_error_x (x, _("SCREEN group item '%s' has invalid clause"),
593  cb_name (x));
594  ret = 1;
595  }
596  for (f = f->children; f; f = f->sister) {
597  ret |= validate_field_1 (f);
598  }
599  if (ret) {
600  return 1;
601  }
602  } else {
603  /* Elementary item */
604 
605  /* Validate PICTURE */
606  switch (f->usage) {
607  case CB_USAGE_INDEX:
608  case CB_USAGE_LENGTH:
609  case CB_USAGE_OBJECT:
610  case CB_USAGE_POINTER:
612  case CB_USAGE_FLOAT:
613  case CB_USAGE_DOUBLE:
615  case CB_USAGE_FP_BIN32:
616  case CB_USAGE_FP_BIN64:
617  case CB_USAGE_FP_BIN128:
618  case CB_USAGE_FP_DEC64:
619  case CB_USAGE_FP_DEC128:
622  case CB_USAGE_SIGNED_INT:
628  case CB_USAGE_PROGRAM:
629  need_picture = 0;
630  break;
631  default:
632  need_picture = 1;
633  break;
634  }
635 
636  if (f->pic == NULL && need_picture != 0) {
637  if (check_picture_item (x, f)) {
638  return 1;
639  }
640  }
641  if (f->pic != NULL && need_picture == 0) {
642  cb_error_x (x, _("'%s' cannot have PICTURE clause"),
643  cb_name (x));
644  }
645 
646  /* Validate USAGE */
647  switch (f->usage) {
648  case CB_USAGE_DISPLAY:
650  f->pic &&
652  !f->flag_sign_leading) {
653  f->flag_sign_separate = 1;
654  }
655  break;
657  f->usage = CB_USAGE_COMP_5;
658  f->pic = cb_build_binary_picture ("BINARY-CHAR", 2, 1);
659  f->flag_real_binary = 1;
660  validate_field_clauses (x, f);
661  break;
663  f->usage = CB_USAGE_COMP_5;
664  f->pic = cb_build_binary_picture ("BINARY-SHORT", 4, 1);
665  f->flag_real_binary = 1;
666  validate_field_clauses (x, f);
667  break;
668  case CB_USAGE_SIGNED_INT:
669  f->usage = CB_USAGE_COMP_5;
670  f->pic = cb_build_binary_picture ("BINARY-LONG", 9, 1);
671  f->flag_real_binary = 1;
672  validate_field_clauses (x, f);
673  break;
675  f->usage = CB_USAGE_COMP_5;
676  f->pic = cb_build_binary_picture ("BINARY-DOUBLE", 18, 1);
677  f->flag_real_binary = 1;
678  validate_field_clauses (x, f);
679  break;
681  f->usage = CB_USAGE_COMP_5;
682  f->pic = cb_build_binary_picture ("BINARY-CHAR", 2, 0);
683  f->flag_real_binary = 1;
684  validate_field_clauses (x, f);
685  break;
687  f->usage = CB_USAGE_COMP_5;
688  f->pic = cb_build_binary_picture ("BINARY-SHORT", 4, 0);
689  f->flag_real_binary = 1;
690  validate_field_clauses (x, f);
691  break;
693  f->usage = CB_USAGE_COMP_5;
694  f->pic = cb_build_binary_picture ("BINARY-LONG", 9, 0);
695  f->flag_real_binary = 1;
696  validate_field_clauses (x, f);
697  break;
699  f->usage = CB_USAGE_COMP_5;
700  f->pic = cb_build_binary_picture ("BINARY-DOUBLE", 18, 0);
701  f->flag_real_binary = 1;
702  validate_field_clauses (x, f);
703  break;
704  case CB_USAGE_BINARY:
705  case CB_USAGE_PACKED:
706  case CB_USAGE_BIT:
707  if (f->pic->category != CB_CATEGORY_NUMERIC) {
708  cb_error_x (x, _("'%s' PICTURE clause not compatible with USAGE"), cb_name (x));
709  }
710  validate_field_clauses (x, f);
711  break;
712  case CB_USAGE_COMP_6:
713  if (f->pic->category != CB_CATEGORY_NUMERIC) {
714  cb_error_x (x, _("'%s' PICTURE clause not compatible with USAGE"), cb_name (x));
715  }
716  if (f->pic->have_sign) {
717  cb_warning_x (x, _("'%s' COMP-6 with sign - Changing to COMP-3"), cb_name (x));
718  f->usage = CB_USAGE_PACKED;
719  }
720  validate_field_clauses (x, f);
721  break;
722  case CB_USAGE_COMP_5:
723  case CB_USAGE_COMP_X:
724  if (f->pic) {
725  if (f->pic->category != CB_CATEGORY_NUMERIC &&
727  cb_error_x (x, _("'%s' PICTURE clause not compatible with USAGE"), cb_name (x));
728  }
729  }
730  validate_field_clauses (x, f);
731  break;
732  case CB_USAGE_POINTER:
734  case CB_USAGE_PROGRAM:
735  case CB_USAGE_FLOAT:
736  case CB_USAGE_DOUBLE:
738  case CB_USAGE_FP_BIN32:
739  case CB_USAGE_FP_BIN64:
740  case CB_USAGE_FP_BIN128:
741  case CB_USAGE_FP_DEC64:
742  case CB_USAGE_FP_DEC128:
743  case CB_USAGE_INDEX:
744  validate_field_clauses (x, f);
745  break;
746  default:
747  break;
748  }
749 
750  /* Validate SIGN */
751 
752  /* Validate JUSTIFIED RIGHT */
753  if (f->flag_justified) {
754  switch (f->pic->category) {
757  break;
758  default:
759  cb_error_x (x, _("'%s' cannot have JUSTIFIED RIGHT"), cb_name (x));
760  break;
761  }
762  }
763 
764  /* Validate SYNCHRONIZED */
765 
766  /* Validate BLANK ZERO */
767  if (f->flag_blank_zero) {
768  switch (f->pic->category) {
769  case CB_CATEGORY_NUMERIC:
770  /* Reconstruct the picture string */
771  n = 0;
772  if (f->pic->scale > 0) {
773  /* Enough for genned string */
774  f->pic->str = cobc_parse_malloc ((size_t)32);
775  pstr = (unsigned char *)(f->pic->str);
776  if (f->pic->have_sign) {
777  *pstr++ = '+';
778  vorint = 1;
779  memcpy (pstr, (void *)&vorint, sizeof(int));
780  pstr += sizeof(int);
781  n = 5;
782  }
783  *pstr++ = '9';
784  vorint = (int)f->pic->digits - f->pic->scale;
785  memcpy (pstr, (void *)&vorint, sizeof(int));
786  pstr += sizeof(int);
787  *pstr++ = 'V';
788  vorint = 1;
789  memcpy (pstr, (void *)&vorint, sizeof(int));
790  pstr += sizeof(int);
791  *pstr++ = '9';
792  vorint = f->pic->scale;
793  memcpy (pstr, (void *)&vorint, sizeof(int));
794  f->pic->size++;
795  n += 15;
796  } else {
797  /* Enough for genned string */
798  f->pic->str = cobc_parse_malloc ((size_t)16);
799  pstr = (unsigned char *)(f->pic->str);
800  if (f->pic->have_sign) {
801  *pstr++ = '+';
802  vorint = 1;
803  memcpy (pstr, (void *)&vorint, sizeof(int));
804  pstr += sizeof(int);
805  n = 5;
806  }
807  *pstr++ = '9';
808  vorint = f->pic->digits;
809  memcpy (pstr, (void *)&vorint, sizeof(int));
810  n += 5;
811  }
812  f->pic->lenstr = n;
814  break;
816  break;
817  default:
818  cb_error_x (x, _("'%s' cannot have BLANK WHEN ZERO"), cb_name (x));
819  break;
820  }
821  }
822 
823  /* Validate VALUE */
824  if (f->values) {
825  if (CB_PAIR_P (CB_VALUE (f->values)) || CB_CHAIN (f->values)) {
826  cb_error_x (x, _("Only level 88 item may have multiple values"));
827  }
828 
829  /* ISO+IEC+1989-2002: 13.16.42.2-10 */
830  for (p = f; p; p = p->parent) {
831  if (p->redefines) {
832  cb_error_x (x, _("Entries under REDEFINES cannot have a VALUE clause"));
833  }
834  if (p->flag_external && cb_warn_external_val) {
835  cb_warning_x (x, _("Initial VALUE clause ignored for EXTERNAL item"));
836  }
837  }
838  }
839  }
840 
841  return 0;
842 }
843 
844 static void
846 {
847  unsigned int flag_local;
848  char pic[8];
849 
850  /* Determine the class */
851  if (f->children) {
852  /* Group field */
853  flag_local = f->flag_local;
854  for (f = f->children; f; f = f->sister) {
855  f->flag_local = !!flag_local;
856  setup_parameters (f);
857  }
858  } else {
859  /* Regular field */
860  switch (f->usage) {
861  case CB_USAGE_BINARY:
862 #ifndef WORDS_BIGENDIAN
863  if (cb_binary_byteorder == CB_BYTEORDER_BIG_ENDIAN) {
864  f->flag_binary_swap = 1;
865  }
866 #endif
867  break;
868 
869  case CB_USAGE_INDEX:
870  f->pic = CB_PICTURE (cb_build_picture ("S9(9)"));
871  break;
872 
873  case CB_USAGE_LENGTH:
874  f->pic = CB_PICTURE (cb_build_picture ("9(9)"));
875  break;
876 
877  case CB_USAGE_POINTER:
879  f->pic = CB_PICTURE (cb_build_picture ("9(10)"));
880  break;
881  case CB_USAGE_FLOAT:
882  f->pic = CB_PICTURE (cb_build_picture ("S9(7)V9(8)"));
883  break;
884  case CB_USAGE_DOUBLE:
885  f->pic = CB_PICTURE (cb_build_picture ("S9(17)V9(17)"));
886  break;
887  case CB_USAGE_FP_DEC64:
888  /* RXWRXW - Scale Fix me */
889  f->pic = CB_PICTURE (cb_build_picture ("S9(17)V9(16)"));
890  break;
891  case CB_USAGE_FP_DEC128:
892  /* RXWRXW - Scale Fix me */
893  f->pic = CB_PICTURE (cb_build_picture ("S999V9(34)"));
894  break;
895 
896  case CB_USAGE_COMP_5:
897  case CB_USAGE_COMP_X:
899  if (f->pic->size > 8) {
900  strcpy (pic, "9(36)");
901  } else {
902  sprintf (pic, "9(%d)", pic_digits[f->pic->size - 1]);
903  }
904  f->pic = CB_PICTURE (cb_build_picture (pic));
905  }
906 #ifndef WORDS_BIGENDIAN
907  if (f->usage == CB_USAGE_COMP_X &&
908  cb_binary_byteorder == CB_BYTEORDER_BIG_ENDIAN) {
909  f->flag_binary_swap = 1;
910  }
911 #endif
912  break;
913 
914  default:
915  break;
916  }
917  }
918 }
919 
920 static void
921 compute_binary_size (struct cb_field *f, const int size)
922 {
923  if (cb_binary_size == CB_BINARY_SIZE_1_2_4_8) {
924  f->size = ((size <= 2) ? 1 :
925  (size <= 4) ? 2 :
926  (size <= 9) ? 4 : (size <= 18) ? 8 : 16);
927  return;
928  }
929  if (cb_binary_size == CB_BINARY_SIZE_2_4_8) {
930  if (f->flag_real_binary && size <= 2) {
931  f->size = 1;
932  } else {
933  f->size = ((size <= 4) ? 2 :
934  (size <= 9) ? 4 : (size <= 18) ? 8 : 16);
935  }
936  return;
937  }
938  if (cb_binary_size != CB_BINARY_SIZE_1__8) {
939  f->size = size;
940  return;
941  }
942  if (f->pic->have_sign) {
943  switch (size) {
944  case 0:
945  case 1:
946  case 2:
947  f->size = 1;
948  return;
949  case 3:
950  case 4:
951  f->size = 2;
952  return;
953  case 5:
954  case 6:
955  f->size = 3;
956  return;
957  case 7:
958  case 8:
959  case 9:
960  f->size = 4;
961  return;
962  case 10:
963  case 11:
964  f->size = 5;
965  return;
966  case 12:
967  case 13:
968  case 14:
969  f->size = 6;
970  return;
971  case 15:
972  case 16:
973  f->size = 7;
974  return;
975  case 17:
976  case 18:
977  f->size = 8;
978  return;
979  case 19:
980  case 20:
981  case 21:
982  f->size = 9;
983  return;
984  case 22:
985  case 23:
986  f->size = 10;
987  return;
988  case 24:
989  case 25:
990  case 26:
991  f->size = 11;
992  return;
993  case 27:
994  case 28:
995  f->size = 12;
996  return;
997  case 29:
998  case 30:
999  case 31:
1000  f->size = 13;
1001  return;
1002  case 32:
1003  case 33:
1004  f->size = 14;
1005  return;
1006  case 34:
1007  case 35:
1008  f->size = 15;
1009  return;
1010  default:
1011  f->size = 16;
1012  return;
1013  }
1014  }
1015  switch (size) {
1016  case 0:
1017  case 1:
1018  case 2:
1019  f->size = 1;
1020  return;
1021  case 3:
1022  case 4:
1023  f->size = 2;
1024  return;
1025  case 5:
1026  case 6:
1027  case 7:
1028  f->size = 3;
1029  return;
1030  case 8:
1031  case 9:
1032  f->size = 4;
1033  return;
1034  case 10:
1035  case 11:
1036  case 12:
1037  f->size = 5;
1038  return;
1039  case 13:
1040  case 14:
1041  f->size = 6;
1042  return;
1043  case 15:
1044  case 16:
1045  f->size = 7;
1046  return;
1047  case 17:
1048  case 18:
1049  case 19:
1050  f->size = 8;
1051  return;
1052  case 20:
1053  case 21:
1054  f->size = 9;
1055  return;
1056  case 22:
1057  case 23:
1058  case 24:
1059  f->size = 10;
1060  return;
1061  case 25:
1062  case 26:
1063  f->size = 11;
1064  return;
1065  case 27:
1066  case 28:
1067  f->size = 12;
1068  return;
1069  case 29:
1070  case 30:
1071  case 31:
1072  f->size = 13;
1073  return;
1074  case 32:
1075  case 33:
1076  f->size = 14;
1077  return;
1078  case 34:
1079  case 35:
1080  case 36:
1081  f->size = 15;
1082  return;
1083  default:
1084  f->size = 16;
1085  return;
1086  }
1087 }
1088 
1089 static int
1091 {
1092  struct cb_field *c;
1093  int size;
1094  cob_u64_t size_check;
1095  int align_size;
1096  int pad;
1097 
1098  int maxsz;
1099  struct cb_field *c0;
1100 
1101  if (f->level == 66) {
1102  /* Rename */
1103  if (f->rename_thru) {
1104  f->size = f->rename_thru->offset + f->rename_thru->size -
1105  f->redefines->offset;
1106  } else {
1107  f->size = f->redefines->size;
1108  }
1109  return f->size;
1110  }
1111 
1112  if (f->children) {
1113  /* Groups */
1114  if (f->flag_synchronized && warningopt) {
1115  cb_warning_x (CB_TREE(f), _("Ignoring SYNCHRONIZED for group item '%s'"),
1116  cb_name (CB_TREE (f)));
1117  }
1118  size_check = 0;
1119  occur_align_size = 1;
1120  for (c = f->children; c; c = c->sister) {
1121  if (c->redefines) {
1122  c->offset = c->redefines->offset;
1123  compute_size (c);
1124  /* Increase the size if redefinition is larger */
1125  if (c->level != 66 &&
1126  c->size * c->occurs_max >
1127  c->redefines->size * c->redefines->occurs_max) {
1128  if (cb_larger_redefines_ok) {
1129  cb_warning_x (CB_TREE (c),
1130  _("Size of '%s' larger than size of '%s'"),
1131  c->name, c->redefines->name);
1132  maxsz = c->redefines->size * c->redefines->occurs_max;
1133  for (c0 = c->redefines->sister; c0 != c; c0 = c0->sister) {
1134  if (c0->size * c0->occurs_max > maxsz) {
1135  maxsz = c0->size * c0->occurs_max;
1136  }
1137  }
1138  if (c->size * c->occurs_max > maxsz) {
1139  size_check += (c->size * c->occurs_max) - maxsz;
1140  }
1141  } else {
1142  cb_error_x (CB_TREE (c),
1143  _("Size of '%s' larger than size of '%s'"),
1144  c->name, c->redefines->name);
1145  }
1146  }
1147  } else {
1148  c->offset = f->offset + (int) size_check;
1149  size_check += compute_size (c) * c->occurs_max;
1150 
1151  /* Word alignment */
1152  if (c->flag_synchronized &&
1153  cb_verify (cb_synchronized_clause, "SYNC")) {
1154  align_size = 1;
1155  switch (c->usage) {
1156  case CB_USAGE_BINARY:
1157  case CB_USAGE_COMP_5:
1158  case CB_USAGE_COMP_X:
1159  case CB_USAGE_FLOAT:
1160  case CB_USAGE_DOUBLE:
1161  case CB_USAGE_LONG_DOUBLE:
1162  case CB_USAGE_FP_BIN32:
1163  case CB_USAGE_FP_BIN64:
1164  case CB_USAGE_FP_BIN128:
1165  case CB_USAGE_FP_DEC64:
1166  case CB_USAGE_FP_DEC128:
1167  if (c->size == 2 ||
1168  c->size == 4 ||
1169  c->size == 8 ||
1170  c->size == 16) {
1171  align_size = c->size;
1172  }
1173  break;
1174  case CB_USAGE_INDEX:
1175  case CB_USAGE_LENGTH:
1176  align_size = sizeof (int);
1177  break;
1178  case CB_USAGE_OBJECT:
1179  case CB_USAGE_POINTER:
1181  case CB_USAGE_PROGRAM:
1182  align_size = sizeof (void *);
1183  break;
1184  default:
1185  break;
1186  }
1187  if (c->offset % align_size != 0) {
1188  pad = align_size - (c->offset % align_size);
1189  c->offset += pad;
1190  size_check += pad;
1191  }
1192  if (align_size > occur_align_size) {
1193  occur_align_size = align_size;
1194  }
1195  }
1196  }
1197  }
1198  if (f->occurs_max > 1 && (size_check % occur_align_size) != 0) {
1199  pad = occur_align_size - (size_check % occur_align_size);
1200  size_check += pad;
1201  f->offset += pad;
1202  }
1203  /* size check for group items */
1204  if (size_check > COB_MAX_FIELD_SIZE) {
1205  cb_error_x (CB_TREE (f),
1206  _("'%s' cannot be larger than %d bytes"),
1207  f->name, COB_MAX_FIELD_SIZE);
1208  }
1209  f->size = (int) size_check;
1210  } else {
1211  /* Elementary item */
1212  switch (f->usage) {
1213  case CB_USAGE_COMP_X:
1214  if (f->pic->category == CB_CATEGORY_ALPHANUMERIC) {
1215  break;
1216  }
1217  size = f->pic->size;
1218  f->size = ((size <= 2) ? 1 : (size <= 4) ? 2 :
1219  (size <= 7) ? 3 : (size <= 9) ? 4 :
1220  (size <= 12) ? 5 : (size <= 14) ? 6 :
1221  (size <= 16) ? 7 : (size <= 19) ? 8 :
1222  (size <= 21) ? 9 : (size <= 24) ? 10 :
1223  (size <= 26) ? 11 : (size <= 28) ? 12 :
1224  (size <= 31) ? 13 : (size <= 33) ? 14 :
1225  (size <= 36) ? 15 : 16);
1226  break;
1227  case CB_USAGE_BINARY:
1228  case CB_USAGE_COMP_5:
1229  size = f->pic->size;
1230 #if 0 /* RXWRXW - Max binary */
1231  if (size > COB_MAX_BINARY) {
1232  f->flag_binary_swap = 0;
1233  size = 38;
1234  cb_error_x (CB_TREE (f),
1235  _("'%s' binary field cannot be larger than %d digits"),
1236  f->name, COB_MAX_BINARY);
1237  }
1238 #else
1239  if (size > 18) {
1240  f->flag_binary_swap = 0;
1241  size = 18;
1242  cb_error_x (CB_TREE (f),
1243  _("'%s' binary field cannot be larger than %d digits"),
1244  f->name, 18);
1245  }
1246 #endif
1247  compute_binary_size (f, size);
1248  break;
1249  case CB_USAGE_DISPLAY:
1250  f->size = f->pic->size;
1251  /* size check for single items */
1252  if (f->size > COB_MAX_FIELD_SIZE) {
1253  cb_error_x (CB_TREE (f),
1254  _("'%s' cannot be larger than %d bytes"),
1255  f->name, COB_MAX_FIELD_SIZE);
1256  }
1257  if (f->pic->have_sign && f->flag_sign_separate) {
1258  f->size++;
1259  }
1260  break;
1261  case CB_USAGE_PACKED:
1262  f->size = f->pic->size / 2 + 1;
1263  break;
1264  case CB_USAGE_COMP_6:
1265  f->size = (f->pic->size + 1) / 2;
1266  break;
1267  case CB_USAGE_INDEX:
1268  case CB_USAGE_LENGTH:
1269  f->size = sizeof (int);
1270  break;
1271  case CB_USAGE_FLOAT:
1272  f->size = sizeof (float);
1273  break;
1274  case CB_USAGE_DOUBLE:
1275  f->size = sizeof (double);
1276  break;
1277  case CB_USAGE_LONG_DOUBLE:
1278  f->size = 16;
1279  break;
1280  case CB_USAGE_FP_BIN32:
1281  f->size = 4;
1282  break;
1283  case CB_USAGE_FP_BIN64:
1284  case CB_USAGE_FP_DEC64:
1285  f->size = 8;
1286  break;
1287  case CB_USAGE_FP_BIN128:
1288  case CB_USAGE_FP_DEC128:
1289  f->size = 16;
1290  break;
1291  case CB_USAGE_OBJECT:
1292  case CB_USAGE_POINTER:
1294  case CB_USAGE_PROGRAM:
1295  f->size = sizeof (void *);
1296  break;
1297  default:
1298  cobc_abort_pr (_("Unexpected USAGE - %d"),
1299  (int)f->usage);
1300  COBC_ABORT ();
1301  }
1302  }
1303 
1304  /* The size of redefining field should not be larger than
1305  the size of redefined field unless the redefined field
1306  is level 01 and non-external */
1307  if (f->redefines && f->redefines->flag_external &&
1308  (f->size * f->occurs_max > f->redefines->size * f->redefines->occurs_max)) {
1309  if (cb_larger_redefines_ok) {
1310  cb_warning_x (CB_TREE (f), _("Size of '%s' larger than size of '%s'"),
1311  f->name, f->redefines->name);
1312  } else {
1313  cb_error_x (CB_TREE (f), _("Size of '%s' larger than size of '%s'"),
1314  f->name, f->redefines->name);
1315  }
1316  }
1317 
1318  return f->size;
1319 }
1320 
1321 static int
1323 {
1324  if (f->values) {
1325  validate_move (CB_VALUE (f->values), CB_TREE (f), 1);
1326  }
1327 
1328  if (f->children) {
1329  for (f = f->children; f; f = f->sister) {
1331  }
1332  }
1333 
1334  return 0;
1335 }
1336 
1337 void
1339 {
1340  struct cb_field *c;
1341 
1342  if (f->flag_is_verified) {
1343  return;
1344  }
1345  if (validate_field_1 (f) != 0) {
1346  f->flag_invalid = 1;
1347  return;
1348  }
1349  if (f->flag_item_78) {
1350  f->flag_is_verified = 1;
1351  return;
1352  }
1353 
1354  /* Set up parameters */
1355  if (f->storage == CB_STORAGE_LOCAL ||
1356  f->storage == CB_STORAGE_LINKAGE ||
1357  f->flag_item_based) {
1358  f->flag_local = 1;
1359  }
1360  if (f->storage == CB_STORAGE_LINKAGE || f->flag_item_based) {
1361  f->flag_base = 1;
1362  }
1363  setup_parameters (f);
1364 
1365  /* Compute size */
1366  occur_align_size = 1;
1367  compute_size (f);
1368  if (!f->redefines) {
1369  f->memory_size = f->size * f->occurs_max;
1370  } else if (f->redefines->memory_size < f->size * f->occurs_max) {
1371  f->redefines->memory_size = f->size * f->occurs_max;
1372  }
1373 
1375  if (f->flag_is_global) {
1376  f->count++;
1377  for (c = f->children; c; c = c->sister) {
1378  c->flag_is_global = 1;
1379  c->count++;
1380  }
1381  }
1382  f->flag_is_verified = 1;
1383 }
1384 
1385 void
1387 {
1388  cb_tree x;
1389  cb_tree l;
1390  cb_tree t;
1391 
1392  x = CB_TREE (f);
1393  if (!f->values) {
1394  level_require_error (x, "VALUE");
1395  return;
1396  }
1397 
1398  if (f->pic || f->flag_occurs) {
1399  level_except_error (x, "VALUE");
1400  return;
1401  }
1402  if (CB_VALID_TREE(f->parent) &&
1404  for (l = f->values; l; l = CB_CHAIN (l)) {
1405  t = CB_VALUE (l);
1406  if (t == cb_space || t == cb_low ||
1407  t == cb_high || t == cb_quote) {
1408  cb_error_x (x, _("Literal type does not match data type"));
1409  }
1410  }
1411  }
1412 }
1413 
1414 struct cb_field *
1415 cb_validate_78_item (struct cb_field *f, const cob_u32_t no78add)
1416 {
1417  cb_tree x;
1418  cob_u32_t noadd;
1419 
1420  x = CB_TREE (f);
1421  noadd = no78add;
1422  if (CB_INVALID_TREE(f->values) ||
1424  level_require_error (x, "VALUE");
1425  noadd = 1;
1426  }
1427 
1428  if (f->pic || f->flag_occurs) {
1429  level_except_error (x, "VALUE");
1430  noadd = 1;
1431  }
1432  if (!noadd) {
1433  cb_add_78 (f);
1434  }
1435  return last_real_field;
1436 }
1437 
1438 void
1440 {
1441  last_real_field = NULL;
1442 }
1443 
1444 struct cb_field *
1446 {
1447  return last_real_field;
1448 }
unsigned int flag_justified
Definition: tree.h:706
int indexes
Definition: tree.h:678
static void compute_binary_size(struct cb_field *f, const int size)
Definition: field.c:921
const char * name
Definition: tree.h:645
#define CB_NUMERIC_LITERAL_P(x)
Definition: tree.h:603
int occurs_max
Definition: tree.h:677
unsigned int flag_real_binary
Definition: tree.h:708
#define CB_TREE(x)
Definition: tree.h:440
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
#define CB_PAIR_P(x)
Definition: tree.h:1204
short sign
Definition: tree.h:597
void cobc_abort_pr(const char *fmt,...)
Definition: cobc.c:587
int size
Definition: tree.h:622
size_t cb_needs_01
Definition: field.c:37
#define cob_u32_t
Definition: common.h:31
unsigned int flag_filler
Definition: tree.h:714
cb_tree cb_build_filler(void)
Definition: tree.c:2591
int scale
Definition: tree.h:626
#define CB_VALID_TREE(x)
Definition: tree.h:445
unsigned int flag_any_length
Definition: tree.h:712
void * cobc_parse_malloc(const size_t size)
Definition: cobc.c:809
unsigned int flag_global
Definition: tree.h:853
int lenstr
Definition: tree.h:623
void cb_warning_x(cb_tree x, const char *fmt,...)
Definition: error.c:222
struct cb_field * sister
Definition: tree.h:653
#define COB_MAX_FIELD_SIZE
Definition: common.h:568
struct cb_field * children
Definition: tree.h:652
#define CB_LITERAL(x)
Definition: tree.h:601
char * str
Definition: tree.h:621
#define CB_FIELD_PTR(x)
Definition: tree.h:745
unsigned int flag_filler_ref
Definition: tree.h:897
cb_tree screen_from
Definition: tree.h:665
unsigned int flag_synchronized
Definition: tree.h:715
int warningopt
Definition: cobc.c:176
unsigned int cb_verify(const enum cb_support, const char *)
Definition: error.c:246
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)
Definition: field.c:90
char * cb_name(cb_tree x)
Definition: tree.c:735
cb_tree cb_build_field(cb_tree name)
Definition: tree.c:2159
struct cb_picture * pic
Definition: tree.h:659
cob_u32_t digits
Definition: tree.h:625
#define CB_PICTURE(x)
Definition: tree.h:631
struct cb_field * cb_resolve_redefines(struct cb_field *field, cb_tree redefines)
Definition: field.c:247
struct cb_field * cb_field_variable_size(const struct cb_field *f)
Definition: tree.c:2239
static int compute_size(struct cb_field *f)
Definition: field.c:1090
int level
Definition: tree.h:673
unsigned char flag_is_global
Definition: tree.h:699
unsigned char flag_base
Definition: tree.h:696
cb_tree cb_quote
Definition: tree.c:132
cb_tree cb_space
Definition: tree.c:127
void redefinition_warning(cb_tree x, cb_tree y)
Definition: error.c:297
static int occur_align_size
Definition: field.c:42
cb_tree cb_build_picture(const char *str)
Definition: tree.c:1800
unsigned int flag_no_field
Definition: tree.h:735
void level_except_error(cb_tree x, const char *clause)
Definition: error.c:441
#define CB_VALUE(x)
Definition: tree.h:1193
static unsigned int validate_field_1(struct cb_field *f)
Definition: field.c:418
#define CB_TREE_CLASS(x)
Definition: tree.h:442
int count
Definition: tree.h:867
unsigned int flag_item_78
Definition: tree.h:711
cb_tree depending
Definition: tree.h:647
static void validate_field_clauses(cb_tree x, struct cb_field *f)
Definition: field.c:322
cb_tree chain
Definition: tree.h:875
int offset
Definition: tree.h:675
#define CB_FIELD_P(x)
Definition: tree.h:741
unsigned int flag_is_verified
Definition: tree.h:722
enum cb_category category
Definition: tree.h:624
unsigned int flag_sign_leading
Definition: tree.h:704
#define _(s)
Definition: cobcrun.c:59
#define CB_BINARY_SIZE_2_4_8
Definition: cobc.h:88
Definition: tree.h:643
static struct cb_field * last_real_field
Definition: field.c:41
#define CB_CHAIN(x)
Definition: tree.h:1194
int scale
Definition: tree.h:595
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
#define CB_BYTEORDER_BIG_ENDIAN
Definition: cobc.h:82
unsigned int flag_external
Definition: tree.h:850
static unsigned int check_picture_item(cb_tree x, struct cb_field *f)
Definition: field.c:333
#define COBC_ABORT()
Definition: cobc.h:61
#define CB_NAME(x)
Definition: tree.h:904
struct cb_field * cb_validate_78_item(struct cb_field *f, const cob_u32_t no78add)
Definition: field.c:1415
int count
Definition: tree.h:680
int validate_move(cb_tree, cb_tree, const unsigned int)
Definition: typeck.c:6167
unsigned int flag_occurs
Definition: tree.h:702
unsigned int flag_invalid
Definition: tree.h:716
#define CB_REFERENCE(x)
Definition: tree.h:901
unsigned int flag_binary_swap
Definition: tree.h:707
void undefined_error(cb_tree x)
Definition: error.c:317
static int validate_field_value(struct cb_field *f)
Definition: field.c:1322
cb_tree items
Definition: tree.h:866
void cb_add_78(struct cb_field *f)
Definition: scanner.c:4810
int size
Definition: tree.h:672
Definition: tree.h:818
int cb_get_level(cb_tree x)
Definition: field.c:46
unsigned int flag_any_numeric
Definition: tree.h:736
struct cb_field * rename_thru
Definition: tree.h:655
void cb_validate_88_item(struct cb_field *f)
Definition: field.c:1386
cb_tree cb_error_node
Definition: tree.c:140
cb_tree screen_to
Definition: tree.h:666
struct cb_field * parent
Definition: tree.h:651
#define CB_BINARY_SIZE_1_2_4_8
Definition: cobc.h:86
unsigned int flag_blank_zero
Definition: tree.h:705
cb_tree index_list
Definition: tree.h:650
struct cb_picture * cb_build_binary_picture(const char *str, const cob_u32_t size, const cob_u32_t sign)
Definition: tree.c:1783
struct cb_field * cb_get_real_field(void)
Definition: field.c:1445
#define CB_INVALID_TREE(x)
Definition: tree.h:446
cb_storage
Definition: tree.h:243
struct cb_program * current_program
Definition: parser.c:168
cob_u32_t have_sign
Definition: tree.h:627
void group_error(cb_tree x, const char *clause)
Definition: error.c:398
unsigned int flag_sign_separate
Definition: tree.h:703
cb_tree cb_high
Definition: tree.c:129
static void setup_parameters(struct cb_field *f)
Definition: field.c:845
void level_require_error(cb_tree x, const char *clause)
Definition: error.c:423
cb_tree subs
Definition: tree.h:877
#define CB_BINARY_SIZE_1__8
Definition: cobc.h:87
unsigned int flag_trailing_separate
Definition: tree.h:1318
int memory_size
Definition: tree.h:674
unsigned int flag_local
Definition: tree.h:701
cb_tree cb_depend_check
Definition: field.c:36
void cb_validate_field(struct cb_field *f)
Definition: field.c:1338
struct cb_field * redefines
Definition: tree.h:654
cb_tree values
Definition: tree.h:648
#define cob_u64_t
Definition: common.h:52
#define COB_MAX_BINARY
Definition: common.h:565
void level_redundant_error(cb_tree x, const char *clause)
Definition: error.c:405
cob_u32_t size
Definition: tree.h:594
static const int pic_digits[]
Definition: field.c:43
unsigned int flag_has_external
Definition: tree.h:1316
void cb_clear_real_field(void)
Definition: field.c:1439
enum cb_usage usage
Definition: tree.h:693
enum cb_storage storage
Definition: tree.h:692
cb_tree cb_low
Definition: tree.c:128
struct cb_field * cb_field_founder(const struct cb_field *f)
Definition: tree.c:2227
#define CB_FIELD(x)
Definition: tree.h:740
unsigned char flag_external
Definition: tree.h:697
struct cb_word * word
Definition: tree.h:881
cb_tree cb_list_add(cb_tree l, cb_tree x)
Definition: tree.c:1315
unsigned int flag_item_based
Definition: tree.h:713