GnuCOBOL  2.0
A free COBOL compiler
tree.c File Reference
#include "config.h"
#include <stdio.h>
#include <stdlib.h>
#include <stddef.h>
#include <string.h>
#include <ctype.h>
#include <limits.h>
#include "cobc.h"
#include "tree.h"
Include dependency graph for tree.c:

Go to the source code of this file.

Data Structures

struct  int_node
 

Macros

#define PIC_ALPHABETIC   0x01
 
#define PIC_NUMERIC   0x02
 
#define PIC_NATIONAL   0x04
 
#define PIC_EDITED   0x08
 
#define PIC_ALPHANUMERIC   (PIC_ALPHABETIC | PIC_NUMERIC)
 
#define PIC_ALPHABETIC_EDITED   (PIC_ALPHABETIC | PIC_EDITED)
 
#define PIC_ALPHANUMERIC_EDITED   (PIC_ALPHANUMERIC | PIC_EDITED)
 
#define PIC_NUMERIC_EDITED   (PIC_NUMERIC | PIC_EDITED)
 
#define PIC_NATIONAL_EDITED   (PIC_NATIONAL | PIC_EDITED)
 
#define CB_FILE_ERR_REQUIRED   1
 
#define CB_FILE_ERR_INVALID_FT   2
 
#define CB_FILE_ERR_INVALID   3
 
#define ERR_MSG   _("Cannot find the UTC offset on this system")
 

Functions

static size_t hash (const unsigned char *s)
 
static void lookup_word (struct cb_reference *p, const char *name)
 
static void file_error (cb_tree name, const char *clause, const char errtype)
 
static void * make_tree (const enum cb_tag tag, const enum cb_category category, const size_t size)
 
static cb_tree make_constant (const enum cb_category category, const char *val)
 
static cb_tree make_constant_label (const char *name)
 
static size_t cb_name_1 (char *s, cb_tree x)
 
static cb_tree make_intrinsic (cb_tree name, struct cb_intrinsic_table *cbp, cb_tree args, cb_tree field, cb_tree refmod, const int isuser)
 
static cb_tree global_check (struct cb_reference *r, cb_tree items, size_t *ambiguous)
 
static int iso_8601_func (const enum cb_intr_enum intr)
 
static int valid_format (const enum cb_intr_enum intr, const char *format)
 
static const char * try_get_constant_data (cb_tree val)
 
static int valid_const_date_time_args (const cb_tree tree, const struct cb_intrinsic_table *intr, cb_tree args)
 
static cb_tree get_last_elt (cb_tree l)
 
static void warn_cannot_get_utc (const cb_tree tree, const enum cb_intr_enum intr, cb_tree args)
 
static int get_data_from_const (cb_tree const_val, unsigned char **data)
 
static int get_data_and_size_from_lit (cb_tree x, unsigned char **data, size_t *size)
 
static struct cb_literalconcat_literals (const cb_tree left, const cb_tree right)
 
char * cb_to_cname (const char *s)
 
struct cb_literalbuild_literal (const enum cb_category category, const void *data, const size_t size)
 
char * cb_name (cb_tree x)
 
enum cb_category cb_tree_category (cb_tree x)
 
enum cb_class cb_tree_class (cb_tree x)
 
int cb_category_is_alpha (cb_tree x)
 
int cb_tree_type (const cb_tree x, const struct cb_field *f)
 
int cb_fits_int (const cb_tree x)
 
int cb_fits_long_long (const cb_tree x)
 
static void error_numeric_literal (const char *literal)
 
static void check_lit_length (const int size, const char *lit)
 
int cb_get_int (const cb_tree x)
 
cob_s64_t cb_get_long_long (const cb_tree x)
 
cob_u64_t cb_get_u_long_long (const cb_tree x)
 
void cb_init_constants (void)
 
cb_tree cb_build_list (cb_tree purpose, cb_tree value, cb_tree chain)
 
cb_tree cb_list_append (cb_tree l1, cb_tree l2)
 
cb_tree cb_list_add (cb_tree l, cb_tree x)
 
cb_tree cb_pair_add (cb_tree l, cb_tree x, cb_tree y)
 
cb_tree cb_list_reverse (cb_tree l)
 
int cb_list_length (cb_tree l)
 
void cb_list_map (cb_tree(*func)(cb_tree x), cb_tree l)
 
const char * cb_define (cb_tree name, cb_tree val)
 
static struct nested_listadd_contained_prog (struct nested_list *parent_list, struct cb_program *child_prog)
 
struct cb_programcb_build_program (struct cb_program *last_program, const int nest_level)
 
void cb_add_common_prog (struct cb_program *prog)
 
void cb_insert_common_prog (struct cb_program *prog, struct cb_program *comprog)
 
cb_tree cb_int (const int n)
 
cb_tree cb_int_hex (const int n)
 
cb_tree cb_build_string (const void *data, const size_t size)
 
cb_tree cb_build_comment (const char *str)
 
cb_tree cb_build_direct (const char *str, const unsigned int flagnl)
 
cb_tree cb_build_debug (const cb_tree target, const char *str, const cb_tree fld)
 
cb_tree cb_build_debug_call (struct cb_label *target)
 
cb_tree cb_build_alphabet_name (cb_tree name)
 
cb_tree cb_build_class_name (cb_tree name, cb_tree list)
 
cb_tree cb_build_locale_name (cb_tree name, cb_tree list)
 
cb_tree cb_build_system_name (const enum cb_system_name_category category, const int token)
 
cb_tree cb_build_numeric_literal (const int sign, const void *data, const int scale)
 
cb_tree cb_build_numsize_literal (const void *data, const size_t size, const int sign)
 
cb_tree cb_build_alphanumeric_literal (const void *data, const size_t size)
 
cb_tree cb_concat_literals (const cb_tree x1, const cb_tree x2)
 
cb_tree cb_build_decimal (const int id)
 
struct cb_picturecb_build_binary_picture (const char *str, const cob_u32_t size, const cob_u32_t sign)
 
cb_tree cb_build_picture (const char *str)
 
cb_tree cb_build_field (cb_tree name)
 
cb_tree cb_build_implicit_field (cb_tree name, const int len)
 
cb_tree cb_build_constant (cb_tree name, cb_tree value)
 
struct cb_fieldcb_field_add (struct cb_field *f, struct cb_field *p)
 
struct cb_fieldcb_field_founder (const struct cb_field *f)
 
struct cb_fieldcb_field_variable_size (const struct cb_field *f)
 
unsigned int cb_field_variable_address (const struct cb_field *fld)
 
int cb_field_subordinate (const struct cb_field *pfld, const struct cb_field *f)
 
void cb_build_symbolic_chars (const cb_tree sym_list, const cb_tree alphabet)
 
struct cb_reportbuild_report (cb_tree name)
 
struct cb_filebuild_file (cb_tree name)
 
void validate_file (struct cb_file *f, cb_tree name)
 
void finalize_file (struct cb_file *f, struct cb_field *records)
 
cb_tree cb_build_reference (const char *name)
 
cb_tree cb_build_filler (void)
 
cb_tree cb_build_field_reference (struct cb_field *f, cb_tree ref)
 
static void cb_define_system_name (const char *name)
 
void cb_set_system_names (void)
 
cb_tree cb_ref (cb_tree x)
 
cb_tree cb_build_binary_op (cb_tree x, const int op, cb_tree y)
 
cb_tree cb_build_binary_list (cb_tree l, const int op)
 
cb_tree cb_build_funcall (const char *name, const int argc, const cb_tree a1, const cb_tree a2, const cb_tree a3, const cb_tree a4, const cb_tree a5, const cb_tree a6, const cb_tree a7, const cb_tree a8, const cb_tree a9, const cb_tree a10, const cb_tree a11)
 
cb_tree cb_build_cast (const enum cb_cast_type type, const cb_tree val)
 
cb_tree cb_build_cast_int (const cb_tree val)
 
cb_tree cb_build_cast_llint (const cb_tree val)
 
cb_tree cb_build_label (cb_tree name, struct cb_label *section)
 
cb_tree cb_build_assign (const cb_tree var, const cb_tree val)
 
cb_tree cb_build_initialize (const cb_tree var, const cb_tree val, const cb_tree rep, const unsigned int def, const unsigned int is_statement, const unsigned int no_filler_init)
 
cb_tree cb_build_search (const int flag_all, const cb_tree table, const cb_tree var, const cb_tree end_stmt, const cb_tree whens)
 
cb_tree cb_build_call (const cb_tree name, const cb_tree args, const cb_tree stmt1, const cb_tree stmt2, const cb_tree returning, const cob_u32_t is_system_call, const int convention)
 
cb_tree cb_build_cancel (const cb_tree target)
 
cb_tree cb_build_alter (const cb_tree source, const cb_tree target)
 
cb_tree cb_build_goto (const cb_tree target, const cb_tree depending)
 
cb_tree cb_build_if (const cb_tree test, const cb_tree stmt1, const cb_tree stmt2, const unsigned int is_if)
 
cb_tree cb_build_perform (const enum cb_perform_type type)
 
cb_tree cb_build_perform_varying (cb_tree name, cb_tree from, cb_tree by, cb_tree until)
 
struct cb_statementcb_build_statement (const char *name)
 
cb_tree cb_build_continue (void)
 
cb_tree cb_build_set_attribute (const struct cb_field *fld, const int val_on, const int val_off)
 
static void check_prototype_seen (const struct cb_func_prototype *fp)
 
cb_tree cb_build_func_prototype (const cb_tree prototype_name, const cb_tree ext_name)
 
cb_tree cb_build_any_intrinsic (cb_tree args)
 
cb_tree cb_build_intrinsic (cb_tree name, cb_tree args, cb_tree refmod, const int isuser)
 

Variables

static enum cb_class category_to_class_table []
 
static int category_is_alphanumeric []
 
static struct int_nodeint_node_table = ((void*)0)
 
static char * scratch_buff = ((void*)0)
 
static char * pic_buff = ((void*)0)
 
static int filler_id = 1
 
static int class_id = 0
 
static int toplev_count
 
static char err_msg [COB_MINI_BUFF]
 
static struct cb_programcontainer_progs [64]
 
static const char *const cb_const_subs []
 
static struct cb_intrinsic_table userbp
 
cb_tree cb_any
 
cb_tree cb_true
 
cb_tree cb_false
 
cb_tree cb_null
 
cb_tree cb_zero
 
cb_tree cb_one
 
cb_tree cb_space
 
cb_tree cb_low
 
cb_tree cb_high
 
cb_tree cb_norm_low
 
cb_tree cb_norm_high
 
cb_tree cb_quote
 
cb_tree cb_int0
 
cb_tree cb_int1
 
cb_tree cb_int2
 
cb_tree cb_int3
 
cb_tree cb_int4
 
cb_tree cb_int5
 
cb_tree cb_i [16]
 
cb_tree cb_error_node
 
cb_tree cb_intr_whencomp = ((void*)0)
 
cb_tree cb_standard_error_handler = ((void*)0)
 
unsigned int gen_screen_ptr = 0
 

Macro Definition Documentation

#define CB_FILE_ERR_INVALID   3

Definition at line 203 of file tree.c.

Referenced by file_error(), and validate_file().

#define CB_FILE_ERR_INVALID_FT   2

Definition at line 202 of file tree.c.

Referenced by file_error(), and validate_file().

#define CB_FILE_ERR_REQUIRED   1

Definition at line 201 of file tree.c.

Referenced by file_error(), and validate_file().

#define ERR_MSG   _("Cannot find the UTC offset on this system")

Referenced by warn_cannot_get_utc().

#define PIC_ALPHABETIC   0x01

Definition at line 34 of file tree.c.

Referenced by cb_build_picture().

#define PIC_ALPHABETIC_EDITED   (PIC_ALPHABETIC | PIC_EDITED)

Definition at line 39 of file tree.c.

Referenced by cb_build_picture().

#define PIC_ALPHANUMERIC   (PIC_ALPHABETIC | PIC_NUMERIC)

Definition at line 38 of file tree.c.

Referenced by cb_build_picture().

#define PIC_ALPHANUMERIC_EDITED   (PIC_ALPHANUMERIC | PIC_EDITED)

Definition at line 40 of file tree.c.

Referenced by cb_build_picture().

#define PIC_EDITED   0x08

Definition at line 37 of file tree.c.

Referenced by cb_build_picture().

#define PIC_NATIONAL   0x04

Definition at line 36 of file tree.c.

Referenced by cb_build_picture().

#define PIC_NATIONAL_EDITED   (PIC_NATIONAL | PIC_EDITED)

Definition at line 42 of file tree.c.

Referenced by cb_build_picture().

#define PIC_NUMERIC   0x02

Definition at line 35 of file tree.c.

Referenced by cb_build_picture().

#define PIC_NUMERIC_EDITED   (PIC_NUMERIC | PIC_EDITED)

Definition at line 41 of file tree.c.

Referenced by cb_build_picture().

Function Documentation

static struct nested_list* add_contained_prog ( struct nested_list parent_list,
struct cb_program child_prog 
)
static

Definition at line 1383 of file tree.c.

References cobc_parse_malloc(), nested_list::nested_prog, and nested_list::next.

Referenced by cb_add_common_prog(), cb_build_program(), and cb_insert_common_prog().

1384 {
1385  struct nested_list *nlp;
1386 
1387  /* Check for reuse */
1388  for (nlp = parent_list; nlp; nlp = nlp->next) {
1389  if (nlp->nested_prog == child_prog) {
1390  return parent_list;
1391  }
1392  }
1393  nlp = cobc_parse_malloc (sizeof (struct nested_list));
1394  nlp->next = parent_list;
1395  nlp->nested_prog = child_prog;
1396  return nlp;
1397 }
void * cobc_parse_malloc(const size_t size)
Definition: cobc.c:809
struct nested_list * next
Definition: tree.h:1234
struct cb_program * nested_prog
Definition: tree.h:1235

Here is the call graph for this function:

Here is the caller graph for this function:

struct cb_file* build_file ( cb_tree  name)

Definition at line 2344 of file tree.c.

References cb_file::access_mode, CB_CATEGORY_UNKNOWN, cb_define(), CB_LABEL, CB_TAG_FILE, cb_to_cname(), CB_TREE, cb_file::cname, COB_ACCESS_SEQUENTIAL, COB_ORG_SEQUENTIAL, current_program, cb_file::handler, cb_file::handler_prog, make_tree(), cb_file::name, and cb_file::organization.

Referenced by yyparse().

2345 {
2346  struct cb_file *p;
2347 
2348  p = make_tree (CB_TAG_FILE, CB_CATEGORY_UNKNOWN, sizeof (struct cb_file));
2349  p->name = cb_define (name, CB_TREE (p));
2350  p->cname = cb_to_cname (p->name);
2351 
2356  return p;
2357 }
#define CB_TREE(x)
Definition: tree.h:440
#define CB_LABEL(x)
Definition: tree.h:801
const char * name
Definition: tree.h:820
char * cb_to_cname(const char *s)
Definition: tree.c:705
struct cb_program * handler_prog
Definition: tree.h:838
static void * make_tree(const enum cb_tag tag, const enum cb_category category, const size_t size)
Definition: tree.c:227
#define COB_ORG_SEQUENTIAL
Definition: common.h:742
struct cb_label * handler
Definition: tree.h:837
cb_tree cb_standard_error_handler
Definition: tree.c:144
#define COB_ACCESS_SEQUENTIAL
Definition: common.h:751
Definition: tree.h:818
int access_mode
Definition: tree.h:845
struct cb_program * current_program
Definition: parser.c:168
char * cname
Definition: tree.h:821
int organization
Definition: tree.h:844
const char * cb_define(cb_tree name, cb_tree val)
Definition: tree.c:1367

Here is the call graph for this function:

Here is the caller graph for this function:

struct cb_literal* build_literal ( const enum cb_category  category,
const void *  data,
const size_t  size 
)

Definition at line 722 of file tree.c.

References CB_TAG_LITERAL, cobc_parse_malloc(), cb_literal::data, make_tree(), and cb_literal::size.

Referenced by cb_build_alphanumeric_literal(), cb_build_numeric_literal(), cb_build_numsize_literal(), and cb_validate_program_data().

724 {
725  struct cb_literal *p;
726 
727  p = make_tree (CB_TAG_LITERAL, category, sizeof (struct cb_literal));
728  p->data = cobc_parse_malloc (size + 1U);
729  p->size = size;
730  memcpy (p->data, data, size);
731  return p;
732 }
void * cobc_parse_malloc(const size_t size)
Definition: cobc.c:809
static void * make_tree(const enum cb_tag tag, const enum cb_category category, const size_t size)
Definition: tree.c:227
unsigned char * data
Definition: tree.h:593
cob_u32_t size
Definition: tree.h:594

Here is the call graph for this function:

Here is the caller graph for this function:

struct cb_report* build_report ( cb_tree  name)

Definition at line 2324 of file tree.c.

References CB_CATEGORY_UNKNOWN, cb_define(), CB_LABEL, CB_TAG_REPORT, cb_to_cname(), CB_TREE, cb_report::cname, COB_ACCESS_SEQUENTIAL, COB_ORG_SEQUENTIAL, current_program, make_tree(), and cb_report::name.

Referenced by yyparse().

2325 {
2326  struct cb_report *p;
2327 
2328  p = make_tree (CB_TAG_REPORT, CB_CATEGORY_UNKNOWN, sizeof (struct cb_report));
2329  p->name = cb_define (name, CB_TREE (p));
2330  p->cname = cb_to_cname (p->name);
2331 
2332 #if 0 /* RXWRXW RP */
2333  p->organization = COB_ORG_SEQUENTIAL;
2334  p->access_mode = COB_ACCESS_SEQUENTIAL;
2335  p->handler = CB_LABEL (cb_standard_error_handler);
2336  p->handler_prog = current_program;
2337 #endif
2338  return p;
2339 }
#define CB_TREE(x)
Definition: tree.h:440
#define CB_LABEL(x)
Definition: tree.h:801
char * cname
Definition: tree.h:1213
char * cb_to_cname(const char *s)
Definition: tree.c:705
static void * make_tree(const enum cb_tag tag, const enum cb_category category, const size_t size)
Definition: tree.c:227
#define COB_ORG_SEQUENTIAL
Definition: common.h:742
cb_tree cb_standard_error_handler
Definition: tree.c:144
#define COB_ACCESS_SEQUENTIAL
Definition: common.h:751
struct cb_program * current_program
Definition: parser.c:168
const char * name
Definition: tree.h:1212
const char * cb_define(cb_tree name, cb_tree val)
Definition: tree.c:1367

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_add_common_prog ( struct cb_program prog)

Definition at line 1469 of file tree.c.

References add_contained_prog(), cb_program::common_prog_list, and cb_program::nested_level.

Referenced by yyparse().

1470 {
1471  struct cb_program *q;
1472 
1473  /* Here we are sure that nested >= 1 */
1474  q = container_progs[prog->nested_level - 1];
1476 }
static struct cb_program * container_progs[64]
Definition: tree.c:91
static struct nested_list * add_contained_prog(struct nested_list *parent_list, struct cb_program *child_prog)
Definition: tree.c:1383
int nested_level
Definition: tree.h:1295
struct nested_list * common_prog_list
Definition: tree.h:1250

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_alphabet_name ( cb_tree  name)

Definition at line 1605 of file tree.c.

References CB_CATEGORY_UNKNOWN, cb_define(), CB_TAG_ALPHABET_NAME, cb_to_cname(), CB_TREE, cb_alphabet_name::cname, make_tree(), cb_alphabet_name::name, and NULL.

Referenced by yyparse().

1606 {
1607  struct cb_alphabet_name *p;
1608 
1609  if (!name || name == cb_error_node) {
1610  return NULL;
1611  }
1613  sizeof (struct cb_alphabet_name));
1614  p->name = cb_define (name, CB_TREE (p));
1615  p->cname = cb_to_cname (p->name);
1616  return CB_TREE (p);
1617 }
#define CB_TREE(x)
Definition: tree.h:440
char * cname
Definition: tree.h:541
const char * name
Definition: tree.h:540
char * cb_to_cname(const char *s)
Definition: tree.c:705
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
static void * make_tree(const enum cb_tag tag, const enum cb_category category, const size_t size)
Definition: tree.c:227
cb_tree cb_error_node
Definition: tree.c:140
const char * cb_define(cb_tree name, cb_tree val)
Definition: tree.c:1367

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_alphanumeric_literal ( const void *  data,
const size_t  size 
)

Definition at line 1716 of file tree.c.

References build_literal(), CB_CATEGORY_ALPHANUMERIC, cb_source_file, cb_source_line, CB_TREE, cb_tree_common::source_file, and cb_tree_common::source_line.

Referenced by cb_build_assignment_name(), cb_build_registers(), cb_build_symbolic_chars(), cb_validate_collating(), finalize_file(), read_literal(), scan_define_options(), scan_x(), scan_z(), yylex(), and yyparse().

1717 {
1718  cb_tree l;
1719 
1720  l = CB_TREE (build_literal (CB_CATEGORY_ALPHANUMERIC, data, size));
1721 
1724 
1725  return l;
1726 }
struct cb_literal * build_literal(const enum cb_category category, const void *data, const size_t size)
Definition: tree.c:722
#define CB_TREE(x)
Definition: tree.h:440
const char * cb_source_file
Definition: cobc.c:145
const char * source_file
Definition: tree.h:431
int source_line
Definition: tree.h:432
int cb_source_line
Definition: cobc.c:178

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_alter ( const cb_tree  source,
const cb_tree  target 
)

Definition at line 3101 of file tree.c.

References cb_program::alter_list, CB_BUILD_PAIR, CB_CATEGORY_UNKNOWN, cb_list_append(), CB_TAG_ALTER, CB_TREE, current_program, make_tree(), cb_alter::source, and cb_alter::target.

Referenced by cb_emit_alter().

3102 {
3103  struct cb_alter *p;
3104 
3106  sizeof (struct cb_alter));
3107  p->source = source;
3108  p->target = target;
3111  CB_BUILD_PAIR (source, target));
3112  return CB_TREE (p);
3113 }
#define CB_TREE(x)
Definition: tree.h:440
cb_tree cb_list_append(cb_tree l1, cb_tree l2)
Definition: tree.c:1305
cb_tree alter_list
Definition: tree.h:1263
static void * make_tree(const enum cb_tag tag, const enum cb_category category, const size_t size)
Definition: tree.c:227
cb_tree source
Definition: tree.h:1064
struct cb_program * current_program
Definition: parser.c:168
#define CB_BUILD_PAIR(x, y)
Definition: tree.h:1853
cb_tree target
Definition: tree.h:1065

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_any_intrinsic ( cb_tree  args)

Definition at line 3295 of file tree.c.

References lookup_intrinsic(), make_intrinsic(), and NULL.

Referenced by cb_build_length().

3296 {
3297  struct cb_intrinsic_table *cbp;
3298 
3299  cbp = lookup_intrinsic ("LENGTH", 0, 0);
3300  return make_intrinsic (NULL, cbp, args, NULL, NULL, 0);
3301 }
static cb_tree make_intrinsic(cb_tree name, struct cb_intrinsic_table *cbp, cb_tree args, cb_tree field, cb_tree refmod, const int isuser)
Definition: tree.c:413
struct cb_intrinsic_table * lookup_intrinsic(const char *name, const int checkres, const int checkimpl)
Definition: reserved.c:2976
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_assign ( const cb_tree  var,
const cb_tree  val 
)

Definition at line 3014 of file tree.c.

References CB_CATEGORY_UNKNOWN, CB_TAG_ASSIGN, CB_TREE, make_tree(), cb_assign::val, and cb_assign::var.

Referenced by cb_build_length(), cb_build_move(), cb_build_move_literal(), cb_build_move_num_zero(), cb_build_optim_add(), and cb_build_optim_sub().

3015 {
3016  struct cb_assign *p;
3017 
3019  sizeof (struct cb_assign));
3020  p->var = var;
3021  p->val = val;
3022  return CB_TREE (p);
3023 }
#define CB_TREE(x)
Definition: tree.h:440
cb_tree val
Definition: tree.h:970
static void * make_tree(const enum cb_tag tag, const enum cb_category category, const size_t size)
Definition: tree.c:227
cb_tree var
Definition: tree.h:969

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_binary_list ( cb_tree  l,
const int  op 
)

Definition at line 2902 of file tree.c.

References cb_build_binary_op(), CB_CHAIN, and CB_VALUE.

Referenced by yyparse().

2903 {
2904  cb_tree e;
2905 
2906  e = CB_VALUE (l);
2907  for (l = CB_CHAIN (l); l; l = CB_CHAIN (l)) {
2908  e = cb_build_binary_op (e, op, CB_VALUE (l));
2909  }
2910  return e;
2911 }
#define CB_VALUE(x)
Definition: tree.h:1193
#define CB_CHAIN(x)
Definition: tree.h:1194
cb_tree cb_build_binary_op(cb_tree x, const int op, cb_tree y)
Definition: tree.c:2827

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_binary_op ( cb_tree  x,
const int  op,
cb_tree  y 
)

Definition at line 2827 of file tree.c.

References _, CB_CATEGORY_BOOLEAN, CB_CATEGORY_DATA_POINTER, CB_CATEGORY_NUMERIC, CB_CATEGORY_UNKNOWN, cb_check_numeric_value(), CB_CLASS_BOOLEAN, CB_CLASS_POINTER, cb_error_node, cb_error_x(), CB_FIELD, cb_ref(), CB_REF_OR_FIELD_P, CB_TAG_BINARY_OP, CB_TREE, CB_TREE_CATEGORY, CB_TREE_CLASS, COBC_ABORT, cobc_abort_pr(), make_tree(), cb_binary_op::op, cb_binary_op::x, and cb_binary_op::y.

Referenced by build_cond_88(), build_evaluate(), cb_build_add(), cb_build_binary_list(), cb_build_cond(), cb_build_div(), cb_build_length_1(), cb_build_mul(), cb_build_optim_add(), cb_build_optim_sub(), cb_build_search_all(), cb_build_sub(), cb_build_write_advancing_lines(), cb_expr_shift(), cb_expr_shift_sign(), evaluate_test(), expr_reduce(), and yyparse().

2828 {
2829  struct cb_binary_op *p;
2830  enum cb_category category = CB_CATEGORY_UNKNOWN;
2831 
2832  switch (op) {
2833  case '+':
2834  case '-':
2835  case '*':
2836  case '/':
2837  case '^':
2838  /* Arithmetic operators */
2839  if (CB_TREE_CLASS (x) == CB_CLASS_POINTER ||
2841  category = CB_CATEGORY_DATA_POINTER;
2842  break;
2843  }
2844  x = cb_check_numeric_value (x);
2845  y = cb_check_numeric_value (y);
2846  if (x == cb_error_node || y == cb_error_node) {
2847  return cb_error_node;
2848  }
2849  category = CB_CATEGORY_NUMERIC;
2850  break;
2851 
2852  case '=':
2853  case '~':
2854  case '<':
2855  case '>':
2856  case '[':
2857  case ']':
2858  /* Relational operators */
2859  if ((CB_REF_OR_FIELD_P (x)) &&
2860  CB_FIELD (cb_ref (x))->level == 88) {
2861  cb_error_x (x, _("Invalid expression"));
2862  return cb_error_node;
2863  }
2864  if ((CB_REF_OR_FIELD_P (y)) &&
2865  CB_FIELD (cb_ref (y))->level == 88) {
2866  cb_error_x (y, _("Invalid expression"));
2867  return cb_error_node;
2868  }
2869  category = CB_CATEGORY_BOOLEAN;
2870  break;
2871 
2872  case '!':
2873  case '&':
2874  case '|':
2875  /* Logical operators */
2876  if (CB_TREE_CLASS (x) != CB_CLASS_BOOLEAN ||
2877  (y && CB_TREE_CLASS (y) != CB_CLASS_BOOLEAN)) {
2878  cb_error_x (x, _("Invalid expression"));
2879  return cb_error_node;
2880  }
2881  category = CB_CATEGORY_BOOLEAN;
2882  break;
2883 
2884  case '@':
2885  /* Parentheses */
2886  category = CB_TREE_CATEGORY (x);
2887  break;
2888 
2889  default:
2890  cobc_abort_pr (_("Unexpected operator -> %d"), op);
2891  COBC_ABORT ();
2892  }
2893 
2894  p = make_tree (CB_TAG_BINARY_OP, category, sizeof (struct cb_binary_op));
2895  p->op = op;
2896  p->x = x;
2897  p->y = y;
2898  return CB_TREE (p);
2899 }
#define CB_TREE(x)
Definition: tree.h:440
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
#define CB_TREE_CATEGORY(x)
Definition: tree.h:443
void cobc_abort_pr(const char *fmt,...)
Definition: cobc.c:587
cb_tree cb_ref(cb_tree x)
Definition: tree.c:2653
cb_category
Definition: tree.h:226
#define CB_TREE_CLASS(x)
Definition: tree.h:442
#define _(s)
Definition: cobcrun.c:59
cb_tree cb_check_numeric_value(cb_tree)
Definition: typeck.c:651
int op
Definition: tree.h:932
static void * make_tree(const enum cb_tag tag, const enum cb_category category, const size_t size)
Definition: tree.c:227
#define COBC_ABORT()
Definition: cobc.h:61
cb_tree cb_error_node
Definition: tree.c:140
cb_tree y
Definition: tree.h:931
cb_tree x
Definition: tree.h:930
#define CB_REF_OR_FIELD_P(x)
Definition: tree.h:743
#define CB_FIELD(x)
Definition: tree.h:740

Here is the call graph for this function:

Here is the caller graph for this function:

struct cb_picture* cb_build_binary_picture ( const char *  str,
const cob_u32_t  size,
const cob_u32_t  sign 
)

Definition at line 1783 of file tree.c.

References cb_picture::category, CB_CATEGORY_NUMERIC, CB_TAG_PICTURE, cobc_check_string(), cb_picture::digits, cb_picture::have_sign, make_tree(), cb_picture::orig, cb_picture::scale, sign, and cb_picture::size.

Referenced by validate_field_1().

1785 {
1786  struct cb_picture *pic;
1787 
1789  sizeof (struct cb_picture));
1790  pic->orig = cobc_check_string (str);
1791  pic->size = size;
1792  pic->digits = size;
1793  pic->scale = 0;
1794  pic->have_sign = sign;
1796  return pic;
1797 }
int size
Definition: tree.h:622
int scale
Definition: tree.h:626
char * str
Definition: tree.h:621
cob_u32_t digits
Definition: tree.h:625
void * cobc_check_string(const char *dupstr)
Definition: cobc.c:951
char * orig
Definition: tree.h:620
enum cb_category category
Definition: tree.h:624
static void * make_tree(const enum cb_tag tag, const enum cb_category category, const size_t size)
Definition: tree.c:227
if sign
Definition: flag.def:42
cob_u32_t have_sign
Definition: tree.h:627

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_call ( const cb_tree  name,
const cb_tree  args,
const cb_tree  stmt1,
const cb_tree  stmt2,
const cb_tree  returning,
const cob_u32_t  is_system_call,
const int  convention 
)

Definition at line 3067 of file tree.c.

References cb_call::args, cb_call::call_returning, CB_CATEGORY_UNKNOWN, CB_TAG_CALL, CB_TREE, cb_call::convention, cb_call::is_system, make_tree(), cb_call::name, cb_call::stmt1, and cb_call::stmt2.

Referenced by cb_emit_call().

3070 {
3071  struct cb_call *p;
3072 
3074  sizeof (struct cb_call));
3075  p->name = name;
3076  p->args = args;
3077  p->stmt1 = stmt1;
3078  p->stmt2 = stmt2;
3079  p->call_returning = returning;
3080  p->is_system = is_system_call;
3081  p->convention = convention;
3082  return CB_TREE (p);
3083 }
Definition: tree.h:1036
int convention
Definition: tree.h:1044
#define CB_TREE(x)
Definition: tree.h:440
cb_tree stmt2
Definition: tree.h:1041
cob_u32_t is_system
Definition: tree.h:1043
cb_tree call_returning
Definition: tree.h:1042
cb_tree name
Definition: tree.h:1038
cb_tree stmt1
Definition: tree.h:1040
static void * make_tree(const enum cb_tag tag, const enum cb_category category, const size_t size)
Definition: tree.c:227
cb_tree args
Definition: tree.h:1039

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_cancel ( const cb_tree  target)

Definition at line 3088 of file tree.c.

References CB_CATEGORY_UNKNOWN, CB_TAG_CANCEL, CB_TREE, make_tree(), and cb_cancel::target.

Referenced by cb_emit_cancel().

3089 {
3090  struct cb_cancel *p;
3091 
3093  sizeof (struct cb_cancel));
3094  p->target = target;
3095  return CB_TREE (p);
3096 }
#define CB_TREE(x)
Definition: tree.h:440
static void * make_tree(const enum cb_tag tag, const enum cb_category category, const size_t size)
Definition: tree.c:227
cb_tree target
Definition: tree.h:1054

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_cast ( const enum cb_cast_type  type,
const cb_tree  val 
)

Definition at line 2947 of file tree.c.

References cb_cast::cast_type, CB_CAST_INTEGER, CB_CATEGORY_NUMERIC, CB_CATEGORY_UNKNOWN, CB_TAG_CAST, CB_TREE, make_tree(), and cb_cast::val.

2948 {
2949  struct cb_cast *p;
2950  enum cb_category category;
2951 
2952  if (type == CB_CAST_INTEGER) {
2953  category = CB_CATEGORY_NUMERIC;
2954  } else {
2955  category = CB_CATEGORY_UNKNOWN;
2956  }
2957  p = make_tree (CB_TAG_CAST, category, sizeof (struct cb_cast));
2958  p->cast_type = type;
2959  p->val = val;
2960  return CB_TREE (p);
2961 }
#define CB_TREE(x)
Definition: tree.h:440
cb_category
Definition: tree.h:226
static void * make_tree(const enum cb_tag tag, const enum cb_category category, const size_t size)
Definition: tree.c:227
Definition: tree.h:956
enum cb_cast_type cast_type
Definition: tree.h:959
cb_tree val
Definition: tree.h:958

Here is the call graph for this function:

cb_tree cb_build_cast_int ( const cb_tree  val)

Definition at line 2964 of file tree.c.

References cb_cast::cast_type, CB_CAST_INTEGER, CB_CATEGORY_NUMERIC, CB_TAG_CAST, CB_TREE, make_tree(), and cb_cast::val.

Referenced by cb_build_identifier(), cb_build_move(), cb_build_optim_add(), cb_build_optim_cond(), cb_build_optim_sub(), cb_build_write_advancing_lines(), cb_emit_sort_init(), cb_emit_stop_run(), and output_goto().

2965 {
2966  struct cb_cast *p;
2967 
2968  p = make_tree (CB_TAG_CAST, CB_CATEGORY_NUMERIC, sizeof (struct cb_cast));
2970  p->val = val;
2971  return CB_TREE (p);
2972 }
#define CB_TREE(x)
Definition: tree.h:440
static void * make_tree(const enum cb_tag tag, const enum cb_category category, const size_t size)
Definition: tree.c:227
Definition: tree.h:956
enum cb_cast_type cast_type
Definition: tree.h:959
cb_tree val
Definition: tree.h:958

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_cast_llint ( const cb_tree  val)

Definition at line 2975 of file tree.c.

References cb_cast::cast_type, CB_CAST_LONG_INT, CB_CATEGORY_NUMERIC, CB_TAG_CAST, CB_TREE, make_tree(), and cb_cast::val.

Referenced by cb_build_move_literal(), cb_build_optim_cond(), decimal_expand(), and output_perform().

2976 {
2977  struct cb_cast *p;
2978 
2979  p = make_tree (CB_TAG_CAST, CB_CATEGORY_NUMERIC, sizeof (struct cb_cast));
2981  p->val = val;
2982  return CB_TREE (p);
2983 }
#define CB_TREE(x)
Definition: tree.h:440
static void * make_tree(const enum cb_tag tag, const enum cb_category category, const size_t size)
Definition: tree.c:227
Definition: tree.h:956
enum cb_cast_type cast_type
Definition: tree.h:959
cb_tree val
Definition: tree.h:958

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_class_name ( cb_tree  name,
cb_tree  list 
)

Definition at line 1622 of file tree.c.

References CB_CATEGORY_BOOLEAN, cb_define(), CB_TAG_CLASS_NAME, cb_to_cname(), CB_TREE, class_id, cb_class_name::cname, COB_MINI_BUFF, COB_MINI_MAX, cobc_main_malloc(), cobc_parse_strdup(), cb_class_name::list, make_tree(), cb_class_name::name, NULL, and scratch_buff.

Referenced by yyparse().

1623 {
1624  struct cb_class_name *p;
1625 
1626  if (!name || name == cb_error_node) {
1627  return NULL;
1628  }
1630  sizeof (struct cb_class_name));
1631  p->name = cb_define (name, CB_TREE (p));
1632  if (!scratch_buff) {
1634  }
1635  snprintf (scratch_buff, (size_t)COB_MINI_MAX, "cob_is_%s_%d",
1636  cb_to_cname (p->name), class_id++);
1638  p->list = list;
1639  return CB_TREE (p);
1640 }
#define CB_TREE(x)
Definition: tree.h:440
void * cobc_main_malloc(const size_t size)
Definition: cobc.c:702
static int class_id
Definition: tree.c:88
#define COB_MINI_BUFF
Definition: common.h:539
void * cobc_parse_strdup(const char *dupstr)
Definition: cobc.c:827
char * cb_to_cname(const char *s)
Definition: tree.c:705
char * cname
Definition: tree.h:558
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
static void * make_tree(const enum cb_tag tag, const enum cb_category category, const size_t size)
Definition: tree.c:227
static char * scratch_buff
Definition: tree.c:85
cb_tree cb_error_node
Definition: tree.c:140
const char * name
Definition: tree.h:557
const char * cb_define(cb_tree name, cb_tree val)
Definition: tree.c:1367
#define COB_MINI_MAX
Definition: common.h:545
cb_tree list
Definition: tree.h:559

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_comment ( const char *  str)

Definition at line 1540 of file tree.c.

References CB_CATEGORY_ALPHANUMERIC, cb_source_file, cb_source_line, CB_TAG_DIRECT, CB_TREE, cb_direct::line, and make_tree().

Referenced by build_evaluate(), cb_build_direct(), cb_emit_evaluate(), yylex(), and yyparse().

1541 {
1542  struct cb_direct *p;
1543 
1545  sizeof (struct cb_direct));
1546  p->line = str;
1547  CB_TREE (p)->source_file = cb_source_file;
1548  CB_TREE (p)->source_line = cb_source_line;
1549  return CB_TREE (p);
1550 }
#define CB_TREE(x)
Definition: tree.h:440
const char * cb_source_file
Definition: cobc.c:145
static void * make_tree(const enum cb_tag tag, const enum cb_category category, const size_t size)
Definition: tree.c:227
const char * line
Definition: tree.h:483
int cb_source_line
Definition: cobc.c:178

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_constant ( cb_tree  name,
cb_tree  value 
)

Definition at line 2189 of file tree.c.

References cb_tree_common::category, cb_build_field(), CB_FIELD, CB_LIST_INIT, CB_STORAGE_CONSTANT, and cb_tree_category().

Referenced by build_nested_special(), cb_add_const_var(), cb_build_registers(), cb_build_symbolic_chars(), cb_define_switch_name(), and yyparse().

2190 {
2191  cb_tree x;
2192 
2193  x = cb_build_field (name);
2194  x->category = cb_tree_category (value);
2195  CB_FIELD (x)->storage = CB_STORAGE_CONSTANT;
2196  CB_FIELD (x)->values = CB_LIST_INIT (value);
2197  return x;
2198 }
cb_tree cb_build_field(cb_tree name)
Definition: tree.c:2159
enum cb_category cb_tree_category(cb_tree x)
Definition: tree.c:745
enum cb_category category
Definition: tree.h:430
#define CB_LIST_INIT(x)
Definition: tree.h:1851
#define CB_FIELD(x)
Definition: tree.h:740

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_continue ( void  )

Definition at line 3214 of file tree.c.

References CB_CATEGORY_UNKNOWN, CB_TAG_CONTINUE, CB_TREE, and make_tree().

Referenced by cb_emit_continue().

3215 {
3216  struct cb_continue *p;
3217 
3219  sizeof (struct cb_continue));
3220  return CB_TREE (p);
3221 }
#define CB_TREE(x)
Definition: tree.h:440
static void * make_tree(const enum cb_tag tag, const enum cb_category category, const size_t size)
Definition: tree.c:227

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_debug ( const cb_tree  target,
const char *  str,
const cb_tree  fld 
)

Definition at line 1566 of file tree.c.

References CB_CATEGORY_ALPHANUMERIC, CB_FIELD_PTR, cb_source_file, cb_source_line, CB_TAG_DEBUG, CB_TREE, cobc_parse_strdup(), cb_debug::fld, make_tree(), NULL, cb_debug::size, cb_debug::target, and cb_debug::value.

Referenced by cb_build_perform_varying(), cb_check_field_debug(), cb_emit_close(), cb_emit_open(), cb_emit_perform(), cb_emit_read(), cb_emit_rewrite(), cb_emit_sort_input(), cb_emit_sort_output(), cb_emit_write(), emit_entry(), output_alter(), output_cond_debug(), output_file_error(), output_funcall_debug(), output_goto(), output_goto_1(), output_perform(), output_perform_call(), output_perform_until(), output_stmt(), and yyparse().

1567 {
1568  struct cb_debug *p;
1569 
1571  sizeof (struct cb_debug));
1572  p->target = target;
1573  if (str) {
1574  p->value = cobc_parse_strdup (str);
1575  p->fld = NULL;
1576  p->size = strlen (str);
1577  } else {
1578  p->value = NULL;
1579  p->fld = fld;
1580  p->size = (size_t)CB_FIELD_PTR (fld)->size;
1581  }
1582  CB_TREE (p)->source_file = cb_source_file;
1583  CB_TREE (p)->source_line = cb_source_line;
1584  return CB_TREE (p);
1585 }
#define CB_TREE(x)
Definition: tree.h:440
cb_tree fld
Definition: tree.h:497
const char * cb_source_file
Definition: cobc.c:145
const char * value
Definition: tree.h:496
#define CB_FIELD_PTR(x)
Definition: tree.h:745
Definition: tree.h:493
void * cobc_parse_strdup(const char *dupstr)
Definition: cobc.c:827
size_t size
Definition: tree.h:498
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
static void * make_tree(const enum cb_tag tag, const enum cb_category category, const size_t size)
Definition: tree.c:227
cb_tree target
Definition: tree.h:495
int cb_source_line
Definition: cobc.c:178

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_debug_call ( struct cb_label target)

Definition at line 1590 of file tree.c.

References CB_CATEGORY_ALPHANUMERIC, cb_source_file, cb_source_line, CB_TAG_DEBUG_CALL, CB_TREE, make_tree(), and cb_debug_call::target.

Referenced by cb_build_perform_varying(), cb_check_field_debug(), cb_emit_close(), cb_emit_open(), cb_emit_read(), cb_emit_rewrite(), and cb_emit_write().

1591 {
1592  struct cb_debug_call *p;
1593 
1595  sizeof (struct cb_debug_call));
1596  p->target = target;
1597  CB_TREE (p)->source_file = cb_source_file;
1598  CB_TREE (p)->source_line = cb_source_line;
1599  return CB_TREE (p);
1600 }
#define CB_TREE(x)
Definition: tree.h:440
const char * cb_source_file
Definition: cobc.c:145
static void * make_tree(const enum cb_tag tag, const enum cb_category category, const size_t size)
Definition: tree.c:227
struct cb_label * target
Definition: tree.h:508
int cb_source_line
Definition: cobc.c:178

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_decimal ( const int  id)

Definition at line 1770 of file tree.c.

References CB_CATEGORY_NUMERIC, CB_TAG_DECIMAL, CB_TREE, cb_decimal::id, and make_tree().

Referenced by decimal_alloc().

1771 {
1772  struct cb_decimal *p;
1773 
1775  sizeof (struct cb_decimal));
1776  p->id = id;
1777  return CB_TREE (p);
1778 }
#define CB_TREE(x)
Definition: tree.h:440
int id
Definition: tree.h:610
static void * make_tree(const enum cb_tag tag, const enum cb_category category, const size_t size)
Definition: tree.c:227

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_direct ( const char *  str,
const unsigned int  flagnl 
)

Definition at line 1553 of file tree.c.

References cb_build_comment(), and CB_DIRECT.

Referenced by cb_check_needs_break(), and cb_emit_evaluate().

1554 {
1555  cb_tree x;
1556 
1557  x = cb_build_comment (str);
1558  CB_DIRECT (x)->flag_is_direct = 1;
1559  CB_DIRECT (x)->flag_new_line = flagnl;
1560  return x;
1561 }
cb_tree cb_build_comment(const char *str)
Definition: tree.c:1540
#define CB_DIRECT(x)
Definition: tree.h:488

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_field ( cb_tree  name)

Definition at line 2159 of file tree.c.

References CB_CATEGORY_UNKNOWN, cb_define(), cb_field_id, CB_STORAGE_WORKING, CB_TAG_FIELD, CB_TREE, CB_USAGE_DISPLAY, cb_field::ename, cb_field::id, make_tree(), cb_field::name, NULL, cb_field::occurs_max, cb_field::storage, and cb_field::usage.

Referenced by cb_build_constant(), cb_build_field_tree(), cb_build_implicit_field(), cb_build_index(), cb_build_registers(), cb_validate_program_data(), and finalize_file().

2160 {
2161  struct cb_field *p;
2162 
2164  sizeof (struct cb_field));
2165  p->id = cb_field_id++;
2166  p->name = cb_define (name, CB_TREE (p));
2167  p->ename = NULL;
2168  p->usage = CB_USAGE_DISPLAY;
2170  p->occurs_max = 1;
2171  return CB_TREE (p);
2172 }
const char * name
Definition: tree.h:645
int occurs_max
Definition: tree.h:677
#define CB_TREE(x)
Definition: tree.h:440
int id
Definition: tree.h:671
Definition: tree.h:643
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
static void * make_tree(const enum cb_tag tag, const enum cb_category category, const size_t size)
Definition: tree.c:227
int cb_field_id
Definition: cobc.c:166
const char * ename
Definition: tree.h:646
const char * cb_define(cb_tree name, cb_tree val)
Definition: tree.c:1367
enum cb_usage usage
Definition: tree.h:693
enum cb_storage storage
Definition: tree.h:692

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_field_reference ( struct cb_field f,
cb_tree  ref 
)

Definition at line 2604 of file tree.c.

References cb_tree_common::category, cb_build_reference(), CB_CATEGORY_UNKNOWN, CB_REFERENCE, CB_TREE, and cb_field::name.

Referenced by build_cond_88(), cb_build_identifier(), cb_build_length_1(), cb_emit_read(), cb_emit_return(), cb_emit_set_false(), cb_emit_set_true(), cb_validate_program_data(), emit_corresponding(), emit_move_corresponding(), finalize_file(), output_initial_values(), output_initialize(), output_initialize_compound(), output_param(), and output_screen_init().

2605 {
2606  cb_tree x;
2607  struct cb_word *word;
2608 
2609  x = cb_build_reference (f->name);
2610  word = CB_REFERENCE (x)->word;
2611  if (ref) {
2612  memcpy (x, ref, sizeof (struct cb_reference));
2613  }
2615  CB_REFERENCE (x)->word = word;
2616  CB_REFERENCE (x)->value = CB_TREE (f);
2617  return x;
2618 }
const char * name
Definition: tree.h:645
#define CB_TREE(x)
Definition: tree.h:440
enum cb_category category
Definition: tree.h:430
#define CB_REFERENCE(x)
Definition: tree.h:901
cb_tree cb_build_reference(const char *name)
Definition: tree.c:2572
Definition: tree.h:863

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_filler ( void  )

Definition at line 2591 of file tree.c.

References cb_build_reference(), CB_REFERENCE, cb_source_line, filler_id, and cb_tree_common::source_line.

Referenced by cb_build_debug_item(), cb_build_field_tree(), cb_build_length(), and yyparse().

2592 {
2593  cb_tree x;
2594  char name[20];
2595 
2596  sprintf (name, "FILLER %d", filler_id++);
2597  x = cb_build_reference (name);
2599  CB_REFERENCE (x)->flag_filler_ref = 1;
2600  return x;
2601 }
static int filler_id
Definition: tree.c:87
const char * name
Definition: tree.h:865
int source_line
Definition: tree.h:432
#define CB_REFERENCE(x)
Definition: tree.h:901
cb_tree cb_build_reference(const char *name)
Definition: tree.c:2572
int cb_source_line
Definition: cobc.c:178

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_func_prototype ( const cb_tree  prototype_name,
const cb_tree  ext_name 
)

Definition at line 3265 of file tree.c.

References CB_CATEGORY_UNKNOWN, CB_LITERAL, CB_LITERAL_P, CB_NAME, CB_TAG_FUNC_PROTOTYPE, CB_TREE, check_prototype_seen(), cb_func_prototype::ext_name, make_tree(), and cb_func_prototype::name.

Referenced by set_up_func_prototype().

3266 {
3267  struct cb_func_prototype *func_prototype;
3268 
3270  sizeof (struct cb_func_prototype));
3271 
3272  if (CB_LITERAL_P (prototype_name)) {
3273  func_prototype->name
3274  = (const char *) CB_LITERAL (prototype_name)->data;
3275  } else {
3276  func_prototype->name = (const char *) CB_NAME (prototype_name);
3277  }
3278 
3279  if (ext_name) {
3280  func_prototype->ext_name =
3281  (const char *) CB_LITERAL (ext_name)->data;
3282  } else if (CB_LITERAL_P (prototype_name)) {
3283  func_prototype->ext_name =
3284  (const char *) CB_LITERAL (prototype_name)->data;
3285  } else {
3286  func_prototype->ext_name = CB_NAME (prototype_name);
3287  }
3288 
3289  check_prototype_seen (func_prototype);
3290 
3291  return CB_TREE (func_prototype);
3292 }
#define CB_TREE(x)
Definition: tree.h:440
#define CB_LITERAL(x)
Definition: tree.h:601
static void check_prototype_seen(const struct cb_func_prototype *fp)
Definition: tree.c:3242
const char * name
Definition: tree.h:1334
#define CB_LITERAL_P(x)
Definition: tree.h:602
static void * make_tree(const enum cb_tag tag, const enum cb_category category, const size_t size)
Definition: tree.c:227
#define CB_NAME(x)
Definition: tree.h:904
const char * ext_name
Definition: tree.h:1336

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_funcall ( const char *  name,
const int  argc,
const cb_tree  a1,
const cb_tree  a2,
const cb_tree  a3,
const cb_tree  a4,
const cb_tree  a5,
const cb_tree  a6,
const cb_tree  a7,
const cb_tree  a8,
const cb_tree  a9,
const cb_tree  a10,
const cb_tree  a11 
)

Definition at line 2916 of file tree.c.

References cb_funcall::argc, cb_funcall::argv, CB_CATEGORY_BOOLEAN, CB_TAG_FUNCALL, CB_TREE, gen_screen_ptr, make_tree(), cb_funcall::name, cb_funcall::screenptr, and cb_funcall::varcnt.

2921 {
2922  struct cb_funcall *p;
2923 
2925  sizeof (struct cb_funcall));
2926  p->name = name;
2927  p->argc = argc;
2928  p->varcnt = 0;
2930  p->argv[0] = a1;
2931  p->argv[1] = a2;
2932  p->argv[2] = a3;
2933  p->argv[3] = a4;
2934  p->argv[4] = a5;
2935  p->argv[5] = a6;
2936  p->argv[6] = a7;
2937  p->argv[7] = a8;
2938  p->argv[8] = a9;
2939  p->argv[9] = a10;
2940  p->argv[10] = a11;
2941  return CB_TREE (p);
2942 }
#define CB_TREE(x)
Definition: tree.h:440
const char * name
Definition: tree.h:943
int argc
Definition: tree.h:945
unsigned int screenptr
Definition: tree.h:947
static void * make_tree(const enum cb_tag tag, const enum cb_category category, const size_t size)
Definition: tree.c:227
unsigned int gen_screen_ptr
Definition: tree.c:146
cb_tree argv[11]
Definition: tree.h:944
int varcnt
Definition: tree.h:946

Here is the call graph for this function:

cb_tree cb_build_goto ( const cb_tree  target,
const cb_tree  depending 
)

Definition at line 3118 of file tree.c.

References CB_CATEGORY_UNKNOWN, CB_TAG_GOTO, CB_TREE, cb_goto::depending, make_tree(), and cb_goto::target.

Referenced by cb_emit_exit(), cb_emit_goto(), and yyparse().

3119 {
3120  struct cb_goto *p;
3121 
3123  sizeof (struct cb_goto));
3124  p->target = target;
3125  p->depending = depending;
3126  return CB_TREE (p);
3127 }
#define CB_TREE(x)
Definition: tree.h:440
static void * make_tree(const enum cb_tag tag, const enum cb_category category, const size_t size)
Definition: tree.c:227
cb_tree depending
Definition: tree.h:1076
Definition: tree.h:1073
cb_tree target
Definition: tree.h:1075

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_if ( const cb_tree  test,
const cb_tree  stmt1,
const cb_tree  stmt2,
const unsigned int  is_if 
)

Definition at line 3132 of file tree.c.

References CB_CATEGORY_UNKNOWN, CB_TAG_IF, CB_TREE, cb_if::is_if, make_tree(), cb_if::stmt1, cb_if::stmt2, and cb_if::test.

Referenced by build_evaluate(), cb_build_if_check_break(), cb_emit_if(), and cb_emit_search_all().

3134 {
3135  struct cb_if *p;
3136 
3138  sizeof (struct cb_if));
3139  p->test = test;
3140  p->stmt1 = stmt1;
3141  p->stmt2 = stmt2;
3142  p->is_if = is_if;
3143  return CB_TREE (p);
3144 }
#define CB_TREE(x)
Definition: tree.h:440
Definition: tree.h:88
unsigned int is_if
Definition: tree.h:1089
cb_tree test
Definition: tree.h:1086
cb_tree stmt1
Definition: tree.h:1087
Definition: tree.h:1084
static void * make_tree(const enum cb_tag tag, const enum cb_category category, const size_t size)
Definition: tree.c:227
cb_tree stmt2
Definition: tree.h:1088

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_implicit_field ( cb_tree  name,
const int  len 
)

Definition at line 2175 of file tree.c.

References cb_build_field(), cb_build_picture(), CB_FIELD, CB_PICTURE, cb_validate_field(), and cb_field::pic.

Referenced by cb_validate_program_data(), and finalize_file().

2176 {
2177  cb_tree x;
2178  char pic[32];
2179 
2180  x = cb_build_field (name);
2181  memset (pic, 0, sizeof(pic));
2182  snprintf (pic, sizeof(pic), "X(%d)", len);
2183  CB_FIELD (x)->pic = CB_PICTURE (cb_build_picture (pic));
2185  return x;
2186 }
cb_tree cb_build_field(cb_tree name)
Definition: tree.c:2159
#define CB_PICTURE(x)
Definition: tree.h:631
cb_tree cb_build_picture(const char *str)
Definition: tree.c:1800
void cb_validate_field(struct cb_field *f)
Definition: field.c:1338
#define CB_FIELD(x)
Definition: tree.h:740

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_initialize ( const cb_tree  var,
const cb_tree  val,
const cb_tree  rep,
const unsigned int  def,
const unsigned int  is_statement,
const unsigned int  no_filler_init 
)

Definition at line 3028 of file tree.c.

References CB_CATEGORY_UNKNOWN, CB_TAG_INITIALIZE, CB_TREE, cob_u8_t, cb_initialize::flag_default, cb_initialize::flag_init_statement, cb_initialize::flag_no_filler_init, make_tree(), cb_initialize::rep, cb_initialize::val, and cb_initialize::var.

Referenced by cb_emit_allocate(), cb_emit_initialize(), and output_initial_values().

3032 {
3033  struct cb_initialize *p;
3034 
3036  sizeof (struct cb_initialize));
3037  p->var = var;
3038  p->val = val;
3039  p->rep = rep;
3040  p->flag_default = (cob_u8_t)def;
3041  p->flag_init_statement = (cob_u8_t)is_statement;
3042  p->flag_no_filler_init = (cob_u8_t)no_filler_init;
3043  return CB_TREE (p);
3044 }
#define CB_TREE(x)
Definition: tree.h:440
unsigned char flag_default
Definition: tree.h:1011
unsigned char flag_init_statement
Definition: tree.h:1012
#define cob_u8_t
Definition: common.h:27
static void * make_tree(const enum cb_tag tag, const enum cb_category category, const size_t size)
Definition: tree.c:227
unsigned char flag_no_filler_init
Definition: tree.h:1013
cb_tree val
Definition: tree.h:1009
cb_tree var
Definition: tree.h:1008
cb_tree rep
Definition: tree.h:1010

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_intrinsic ( cb_tree  name,
cb_tree  args,
cb_tree  refmod,
const int  isuser 
)

Definition at line 3304 of file tree.c.

References _, cb_intrinsic_table::args, cb_build_length(), CB_CATEGORY_NUMERIC, CB_CATEGORY_NUMERIC_EDITED, cb_error_node, cb_error_x(), cb_get_int(), CB_INTR_ABS, CB_INTR_ACOS, CB_INTR_ANNUITY, CB_INTR_ASIN, CB_INTR_ATAN, CB_INTR_BOOLEAN_OF_INTEGER, CB_INTR_BYTE_LENGTH, CB_INTR_CHAR, CB_INTR_CHAR_NATIONAL, CB_INTR_COMBINED_DATETIME, CB_INTR_CONCATENATE, CB_INTR_COS, CB_INTR_CURRENCY_SYMBOL, CB_INTR_CURRENT_DATE, CB_INTR_DATE_OF_INTEGER, CB_INTR_DATE_TO_YYYYMMDD, CB_INTR_DAY_OF_INTEGER, CB_INTR_DAY_TO_YYYYDDD, CB_INTR_DISPLAY_OF, CB_INTR_E, CB_INTR_EXCEPTION_FILE, CB_INTR_EXCEPTION_FILE_N, CB_INTR_EXCEPTION_LOCATION, CB_INTR_EXCEPTION_LOCATION_N, CB_INTR_EXCEPTION_STATEMENT, CB_INTR_EXCEPTION_STATUS, CB_INTR_EXP, CB_INTR_EXP10, CB_INTR_FACTORIAL, CB_INTR_FORMATTED_CURRENT_DATE, CB_INTR_FORMATTED_DATE, CB_INTR_FORMATTED_DATETIME, CB_INTR_FORMATTED_TIME, CB_INTR_FRACTION_PART, CB_INTR_HIGHEST_ALGEBRAIC, CB_INTR_INTEGER, CB_INTR_INTEGER_OF_BOOLEAN, CB_INTR_INTEGER_OF_DATE, CB_INTR_INTEGER_OF_DAY, CB_INTR_INTEGER_OF_FORMATTED_DATE, CB_INTR_INTEGER_PART, CB_INTR_LENGTH, CB_INTR_LOCALE_COMPARE, CB_INTR_LOCALE_DATE, CB_INTR_LOCALE_TIME, CB_INTR_LOCALE_TIME_FROM_SECS, CB_INTR_LOG, CB_INTR_LOG10, CB_INTR_LOWER_CASE, CB_INTR_LOWEST_ALGEBRAIC, CB_INTR_MAX, CB_INTR_MEAN, CB_INTR_MEDIAN, CB_INTR_MIDRANGE, CB_INTR_MIN, CB_INTR_MOD, CB_INTR_MODULE_CALLER_ID, CB_INTR_MODULE_DATE, CB_INTR_MODULE_FORMATTED_DATE, CB_INTR_MODULE_ID, CB_INTR_MODULE_PATH, CB_INTR_MODULE_SOURCE, CB_INTR_MODULE_TIME, CB_INTR_MON_DECIMAL_POINT, CB_INTR_MON_THOUSANDS_SEP, CB_INTR_NATIONAL_OF, CB_INTR_NUM_DECIMAL_POINT, CB_INTR_NUM_THOUSANDS_SEP, CB_INTR_NUMVAL, CB_INTR_NUMVAL_C, CB_INTR_NUMVAL_F, CB_INTR_ORD, CB_INTR_ORD_MAX, CB_INTR_ORD_MIN, CB_INTR_PI, CB_INTR_PRESENT_VALUE, CB_INTR_RANDOM, CB_INTR_RANGE, CB_INTR_REM, CB_INTR_REVERSE, CB_INTR_SECONDS_FROM_FORMATTED_TIME, CB_INTR_SECONDS_PAST_MIDNIGHT, CB_INTR_SIGN, CB_INTR_SIN, CB_INTR_SQRT, CB_INTR_STANDARD_COMPARE, CB_INTR_STANDARD_DEVIATION, CB_INTR_STORED_CHAR_LENGTH, CB_INTR_SUBSTITUTE, CB_INTR_SUBSTITUTE_CASE, CB_INTR_SUM, CB_INTR_TAN, CB_INTR_TEST_DATE_YYYYMMDD, CB_INTR_TEST_DAY_YYYYDDD, CB_INTR_TEST_FORMATTED_DATETIME, CB_INTR_TEST_NUMVAL, CB_INTR_TEST_NUMVAL_C, CB_INTR_TEST_NUMVAL_F, CB_INTR_TRIM, CB_INTR_UPPER_CASE, CB_INTR_VARIANCE, CB_INTR_WHEN_COMPILED, cb_intr_whencomp, CB_INTR_YEAR_TO_YYYY, CB_LIST_INIT, cb_list_length(), CB_LITERAL_P, CB_NAME, CB_PAIR_X, CB_PAIR_Y, CB_REF_OR_FIELD_P, cb_tree_category(), CB_VALUE, current_program, cb_intrinsic_table::implemented, cb_intrinsic_table::intr_enum, iso_8601_func(), lookup_intrinsic(), make_intrinsic(), cb_program::max_call_param, cb_intrinsic_table::min_args, cb_intrinsic_table::name, NULL, cb_intrinsic_table::refmod, unlikely, valid_const_date_time_args(), and warn_cannot_get_utc().

Referenced by yyparse().

3306 {
3307  struct cb_intrinsic_table *cbp;
3308  cb_tree x;
3309  int numargs;
3310  enum cb_category catg;
3311 
3312  numargs = cb_list_length (args);
3313 
3314  if (unlikely(isuser)) {
3315  if (refmod && CB_LITERAL_P(CB_PAIR_X(refmod)) &&
3316  cb_get_int (CB_PAIR_X(refmod)) < 1) {
3317  cb_error_x (name, _("FUNCTION '%s' has invalid reference modification"), CB_NAME(name));
3318  return cb_error_node;
3319  }
3320  if (refmod && CB_PAIR_Y(refmod) &&
3321  CB_LITERAL_P(CB_PAIR_Y(refmod)) &&
3322  cb_get_int (CB_PAIR_Y(refmod)) < 1) {
3323  cb_error_x (name, _("FUNCTION '%s' has invalid reference modification"), CB_NAME(name));
3324  return cb_error_node;
3325  }
3326  if (numargs > current_program->max_call_param) {
3327  current_program->max_call_param = numargs;
3328  }
3329  return make_intrinsic (name, &userbp, args, cb_int1, refmod, 1);
3330  }
3331 
3332  cbp = lookup_intrinsic (CB_NAME (name), 0, 1);
3333  if (!cbp) {
3334  cb_error_x (name, _("FUNCTION '%s' unknown"), CB_NAME (name));
3335  return cb_error_node;
3336  }
3337  if (!cbp->implemented) {
3338  cb_error_x (name, _("FUNCTION '%s' not implemented"),
3339  cbp->name);
3340  return cb_error_node;
3341  }
3342  if ((cbp->args == -1)) {
3343  if (numargs < cbp->min_args) {
3344  cb_error_x (name,
3345  _ ("FUNCTION '%s' has wrong number of arguments"),
3346  cbp->name);
3347  return cb_error_node;
3348  }
3349  } else {
3350  if (numargs > cbp->args || numargs < cbp->min_args) {
3351  cb_error_x (name,
3352  _("FUNCTION '%s' has wrong number of arguments"),
3353  cbp->name);
3354  return cb_error_node;
3355  }
3356  }
3357  if (refmod) {
3358  if (!cbp->refmod) {
3359  cb_error_x (name, _("FUNCTION '%s' can not have reference modification"), cbp->name);
3360  return cb_error_node;
3361  }
3362  /* TODO: better check needed, see typeck.c (cb_build_identifier) */
3363  if (CB_LITERAL_P(CB_PAIR_X(refmod)) &&
3364  cb_get_int (CB_PAIR_X(refmod)) < 1) {
3365  cb_error_x (name, _("FUNCTION '%s' has invalid reference modification"), cbp->name);
3366  return cb_error_node;
3367  }
3368  if (CB_PAIR_Y(refmod) && CB_LITERAL_P(CB_PAIR_Y(refmod)) &&
3369  cb_get_int (CB_PAIR_Y(refmod)) < 1) {
3370  cb_error_x (name, _("FUNCTION '%s' has invalid reference modification"), cbp->name);
3371  return cb_error_node;
3372  }
3373  }
3374 
3375  if (iso_8601_func (cbp->intr_enum)) {
3376  if (!valid_const_date_time_args (name, cbp, args)) {
3377  return cb_error_node;
3378  }
3379 #if !defined (COB_STRFTIME) && !defined (COB_TIMEZONE)
3380  warn_cannot_get_utc (name, cbp->intr_enum, args);
3381 #endif
3382  }
3383 
3384  switch (cbp->intr_enum) {
3385  case CB_INTR_LENGTH:
3386  case CB_INTR_BYTE_LENGTH:
3387  x = CB_VALUE (args);
3388  if (CB_LITERAL_P (x)) {
3389  return cb_build_length (x);
3390  } else {
3391  return make_intrinsic (name, cbp, args, NULL, NULL, 0);
3392  }
3393 
3394  case CB_INTR_WHEN_COMPILED:
3395  if (refmod) {
3396  return make_intrinsic (name, cbp,
3397  CB_LIST_INIT (cb_intr_whencomp), NULL, refmod, 0);
3398  } else {
3399  return cb_intr_whencomp;
3400  }
3401 
3402  case CB_INTR_ABS:
3403  case CB_INTR_ACOS:
3404  case CB_INTR_ASIN:
3405  case CB_INTR_ATAN:
3406  case CB_INTR_COS:
3409  case CB_INTR_EXP:
3410  case CB_INTR_EXP10:
3411  case CB_INTR_FACTORIAL:
3412  case CB_INTR_FRACTION_PART:
3413  case CB_INTR_INTEGER:
3416  case CB_INTR_INTEGER_PART:
3417  case CB_INTR_LOG:
3418  case CB_INTR_LOG10:
3419  case CB_INTR_SIGN:
3420  case CB_INTR_SIN:
3421  case CB_INTR_SQRT:
3422  case CB_INTR_TAN:
3425  x = CB_VALUE (args);
3427  cb_error_x (name, _("FUNCTION '%s' has invalid parameter"), cbp->name);
3428  return cb_error_node;
3429  }
3430  return make_intrinsic (name, cbp, args, NULL, refmod, 0);
3431 
3432  case CB_INTR_ANNUITY:
3434  case CB_INTR_CHAR:
3435  case CB_INTR_CHAR_NATIONAL:
3438  case CB_INTR_CURRENT_DATE:
3439  case CB_INTR_E:
3450  case CB_INTR_LOCALE_DATE:
3451  case CB_INTR_LOCALE_TIME:
3453  case CB_INTR_LOWER_CASE:
3454  case CB_INTR_MOD:
3456  case CB_INTR_MODULE_DATE:
3458  case CB_INTR_MODULE_ID:
3459  case CB_INTR_MODULE_PATH:
3460  case CB_INTR_MODULE_SOURCE:
3461  case CB_INTR_MODULE_TIME:
3466  case CB_INTR_NUMVAL:
3467  case CB_INTR_NUMVAL_C:
3468  case CB_INTR_NUMVAL_F:
3469  case CB_INTR_ORD:
3470  case CB_INTR_PI:
3471  case CB_INTR_REM:
3472  case CB_INTR_REVERSE:
3477  case CB_INTR_TEST_NUMVAL:
3478  case CB_INTR_TEST_NUMVAL_C:
3479  case CB_INTR_TEST_NUMVAL_F:
3480  case CB_INTR_TRIM:
3481  case CB_INTR_UPPER_CASE:
3482  return make_intrinsic (name, cbp, args, NULL, refmod, 0);
3483 
3486  x = CB_VALUE (args);
3487  if (!CB_REF_OR_FIELD_P (x)) {
3488  cb_error_x (name, _("FUNCTION '%s' has invalid parameter"), cbp->name);
3489  return cb_error_node;
3490  }
3491  catg = cb_tree_category (x);
3492  if (catg != CB_CATEGORY_NUMERIC &&
3493  catg != CB_CATEGORY_NUMERIC_EDITED) {
3494  cb_error_x (name, _("FUNCTION '%s' has invalid parameter"), cbp->name);
3495  return cb_error_node;
3496  }
3497  return make_intrinsic (name, cbp, args, NULL, refmod, 0);
3498 
3499 
3500  case CB_INTR_CONCATENATE:
3501  case CB_INTR_DISPLAY_OF:
3504  case CB_INTR_NATIONAL_OF:
3505  return make_intrinsic (name, cbp, args, cb_int1, refmod, 0);
3506 
3510  case CB_INTR_MAX:
3511  case CB_INTR_MEAN:
3512  case CB_INTR_MEDIAN:
3513  case CB_INTR_MIDRANGE:
3514  case CB_INTR_MIN:
3515  case CB_INTR_ORD_MAX:
3516  case CB_INTR_ORD_MIN:
3517  case CB_INTR_PRESENT_VALUE:
3518  case CB_INTR_RANDOM:
3519  case CB_INTR_RANGE:
3522  case CB_INTR_SUM:
3523  case CB_INTR_VARIANCE:
3524  case CB_INTR_YEAR_TO_YYYY:
3525  return make_intrinsic (name, cbp, args, cb_int1, NULL, 0);
3526  case CB_INTR_SUBSTITUTE:
3528  if ((numargs % 2) == 0) {
3529  cb_error_x (name, _("FUNCTION '%s' has wrong number of arguments"), cbp->name);
3530  return cb_error_node;
3531  }
3532 #if 0 /* RXWRXW - Substitute param 1 */
3533  x = CB_VALUE (args);
3534  if (!CB_REF_OR_FIELD_P (x)) {
3535  cb_error_x (name, _("FUNCTION '%s' has invalid first parameter"), cbp->name);
3536  return cb_error_node;
3537  }
3538 #endif
3539  return make_intrinsic (name, cbp, args, cb_int1, refmod, 0);
3540 
3541  default:
3542  cb_error_x (name, _("FUNCTION '%s' unknown"), CB_NAME (name));
3543  return cb_error_node;
3544  }
3545 }
#define CB_PAIR_X(x)
Definition: tree.h:1205
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
const char * name
Definition: tree.h:979
cb_tree cb_int1
Definition: tree.c:134
const int implemented
Definition: tree.h:983
cb_tree cb_intr_whencomp
Definition: tree.c:142
const int min_args
Definition: tree.h:985
static cb_tree make_intrinsic(cb_tree name, struct cb_intrinsic_table *cbp, cb_tree args, cb_tree field, cb_tree refmod, const int isuser)
Definition: tree.c:413
int cb_get_int(const cb_tree x)
Definition: tree.c:1101
#define CB_PAIR_Y(x)
Definition: tree.h:1206
struct cb_intrinsic_table * lookup_intrinsic(const char *name, const int checkres, const int checkimpl)
Definition: reserved.c:2976
int max_call_param
Definition: tree.h:1298
cb_category
Definition: tree.h:226
enum cb_category cb_tree_category(cb_tree x)
Definition: tree.c:745
static struct cb_intrinsic_table userbp
Definition: tree.c:112
#define CB_LITERAL_P(x)
Definition: tree.h:602
static int iso_8601_func(const enum cb_intr_enum intr)
Definition: tree.c:507
#define CB_VALUE(x)
Definition: tree.h:1193
int cb_list_length(cb_tree l)
Definition: tree.c:1342
static void warn_cannot_get_utc(const cb_tree tree, const enum cb_intr_enum intr, cb_tree args)
Definition: tree.c:601
const unsigned int refmod
Definition: tree.h:987
#define _(s)
Definition: cobcrun.c:59
#define unlikely(x)
Definition: common.h:437
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
static int valid_const_date_time_args(const cb_tree tree, const struct cb_intrinsic_table *intr, cb_tree args)
Definition: tree.c:566
#define CB_NAME(x)
Definition: tree.h:904
const int args
Definition: tree.h:984
cb_tree cb_error_node
Definition: tree.c:140
struct cb_program * current_program
Definition: parser.c:168
#define CB_LIST_INIT(x)
Definition: tree.h:1851
cb_tree cb_build_length(cb_tree)
Definition: typeck.c:1781
#define CB_REF_OR_FIELD_P(x)
Definition: tree.h:743
enum cb_intr_enum intr_enum
Definition: tree.h:981

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_label ( cb_tree  name,
struct cb_label section 
)

Definition at line 2988 of file tree.c.

References CB_CATEGORY_UNKNOWN, cb_define(), cb_id, CB_TAG_LABEL, CB_TREE, cobc_parse_malloc(), cb_label::id, make_tree(), cb_label::name, cb_para_label::next, cb_label::orig_name, cb_para_label::para, cb_label::para_label, cb_label::section, and cb_label::section_id.

Referenced by emit_entry(), make_constant_label(), and yyparse().

2989 {
2990  struct cb_label *p;
2991  struct cb_para_label *l;
2992 
2994  sizeof (struct cb_label));
2995  p->id = cb_id++;
2996  p->name = cb_define (name, CB_TREE (p));
2997  p->orig_name = p->name;
2998  p->section = section;
2999  if (section) {
3000  l = cobc_parse_malloc (sizeof(struct cb_para_label));
3001  l->next = section->para_label;
3002  l->para= p;
3003  section->para_label = l;
3004  p->section_id = p->section->id;
3005  } else {
3006  p->section_id = p->id;
3007  }
3008  return CB_TREE (p);
3009 }
const char * orig_name
Definition: tree.h:767
#define CB_TREE(x)
Definition: tree.h:440
const char * name
Definition: tree.h:766
void * cobc_parse_malloc(const size_t size)
Definition: cobc.c:809
int cb_id
Definition: cobc.c:163
struct cb_para_label * para_label
Definition: tree.h:770
struct cb_label * section
Definition: tree.h:768
static void * make_tree(const enum cb_tag tag, const enum cb_category category, const size_t size)
Definition: tree.c:227
struct cb_para_label * next
Definition: tree.h:755
Definition: tree.h:764
struct cb_label * para
Definition: tree.h:756
int section_id
Definition: tree.h:774
int id
Definition: tree.h:773
const char * cb_define(cb_tree name, cb_tree val)
Definition: tree.c:1367

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_list ( cb_tree  purpose,
cb_tree  value,
cb_tree  chain 
)

Definition at line 1293 of file tree.c.

References CB_CATEGORY_UNKNOWN, CB_TAG_LIST, CB_TREE, cb_list::chain, make_tree(), cb_list::purpose, value, and cb_list::value.

Referenced by yyparse().

1294 {
1295  struct cb_list *p;
1296 
1297  p = make_tree (CB_TAG_LIST, CB_CATEGORY_UNKNOWN, sizeof (struct cb_list));
1298  p->chain = chain;
1299  p->value = value;
1300  p->purpose = purpose;
1301  return CB_TREE (p);
1302 }
Definition: tree.h:1181
#define CB_TREE(x)
Definition: tree.h:440
cb_tree purpose
Definition: tree.h:1185
strict implicit external value
Definition: warning.def:54
static void * make_tree(const enum cb_tag tag, const enum cb_category category, const size_t size)
Definition: tree.c:227
cb_tree value
Definition: tree.h:1184
cb_tree chain
Definition: tree.h:1183

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_locale_name ( cb_tree  name,
cb_tree  list 
)

Definition at line 1645 of file tree.c.

References _, CB_CATEGORY_UNKNOWN, cb_define(), cb_error(), cb_error_node, CB_LITERAL_P, CB_NUMERIC_LITERAL_P, CB_TAG_LOCALE_NAME, cb_to_cname(), CB_TREE, cb_class_name::cname, cb_class_name::list, make_tree(), cb_class_name::name, and NULL.

Referenced by yyparse().

1646 {
1647  struct cb_class_name *p;
1648 
1649  if (!name || name == cb_error_node) {
1650  return NULL;
1651  }
1652  if (!CB_LITERAL_P (list) || CB_NUMERIC_LITERAL_P (list)) {
1653  cb_error (_("Invalid LOCALE literal"));
1654  return cb_error_node;
1655  }
1657  sizeof (struct cb_locale_name));
1658  p->name = cb_define (name, CB_TREE (p));
1659  p->cname = cb_to_cname (p->name);
1660  p->list = list;
1661  return CB_TREE (p);
1662 }
#define CB_NUMERIC_LITERAL_P(x)
Definition: tree.h:603
#define CB_TREE(x)
Definition: tree.h:440
#define CB_LITERAL_P(x)
Definition: tree.h:602
char * cb_to_cname(const char *s)
Definition: tree.c:705
char * cname
Definition: tree.h:558
#define _(s)
Definition: cobcrun.c:59
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
static void * make_tree(const enum cb_tag tag, const enum cb_category category, const size_t size)
Definition: tree.c:227
cb_tree cb_error_node
Definition: tree.c:140
void cb_error(const char *,...) COB_A_FORMAT12
Definition: error.c:98
const char * name
Definition: tree.h:557
const char * cb_define(cb_tree name, cb_tree val)
Definition: tree.c:1367
cb_tree list
Definition: tree.h:559

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_numeric_literal ( const int  sign,
const void *  data,
const int  scale 
)

Definition at line 1681 of file tree.c.

References build_literal(), CB_CATEGORY_NUMERIC, cb_source_file, cb_source_line, CB_TREE, cb_literal::scale, cb_literal::sign, cb_tree_common::source_file, and cb_tree_common::source_line.

Referenced by cb_build_const_length(), cb_build_length(), cb_emit_allocate(), cb_init_constants(), scan_b(), scan_define_options(), scan_floating_numeric(), scan_h(), scan_numeric(), scan_o(), yylex(), and yyparse().

1682 {
1683  struct cb_literal *p;
1684  cb_tree l;
1685 
1686  p = build_literal (CB_CATEGORY_NUMERIC, data, strlen (data));
1687  p->sign = (short)sign;
1688  p->scale = scale;
1689 
1690  l = CB_TREE (p);
1691 
1694 
1695  return l;
1696 }
struct cb_literal * build_literal(const enum cb_category category, const void *data, const size_t size)
Definition: tree.c:722
#define CB_TREE(x)
Definition: tree.h:440
short sign
Definition: tree.h:597
const char * cb_source_file
Definition: cobc.c:145
const char * source_file
Definition: tree.h:431
int source_line
Definition: tree.h:432
int scale
Definition: tree.h:595
if sign
Definition: flag.def:42
unsigned char * data
Definition: tree.h:593
int cb_source_line
Definition: cobc.c:178

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_numsize_literal ( const void *  data,
const size_t  size,
const int  sign 
)

Definition at line 1699 of file tree.c.

References build_literal(), CB_CATEGORY_NUMERIC, cb_source_file, cb_source_line, CB_TREE, cb_literal::sign, cb_tree_common::source_file, and cb_tree_common::source_line.

Referenced by cb_check_lit_subs().

1700 {
1701  struct cb_literal *p;
1702  cb_tree l;
1703 
1705  p->sign = (short)sign;
1706 
1707  l = CB_TREE (p);
1708 
1711 
1712  return l;
1713 }
struct cb_literal * build_literal(const enum cb_category category, const void *data, const size_t size)
Definition: tree.c:722
#define CB_TREE(x)
Definition: tree.h:440
short sign
Definition: tree.h:597
const char * cb_source_file
Definition: cobc.c:145
const char * source_file
Definition: tree.h:431
int source_line
Definition: tree.h:432
if sign
Definition: flag.def:42
unsigned char * data
Definition: tree.h:593
int cb_source_line
Definition: cobc.c:178
cob_u32_t size
Definition: tree.h:594

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_perform ( const enum cb_perform_type  type)

Definition at line 3149 of file tree.c.

References CB_CATEGORY_UNKNOWN, CB_TAG_PERFORM, CB_TREE, make_tree(), and cb_perform::perform_type.

Referenced by cb_build_perform_exit(), cb_build_perform_forever(), cb_build_perform_once(), cb_build_perform_times(), and cb_build_perform_until().

3150 {
3151  struct cb_perform *p;
3152 
3154  sizeof (struct cb_perform));
3155  p->perform_type = type;
3156  return CB_TREE (p);
3157 }
enum cb_perform_type perform_type
Definition: tree.h:1113
#define CB_TREE(x)
Definition: tree.h:440
static void * make_tree(const enum cb_tag tag, const enum cb_category category, const size_t size)
Definition: tree.c:227

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_perform_varying ( cb_tree  name,
cb_tree  from,
cb_tree  by,
cb_tree  until 
)

Definition at line 3160 of file tree.c.

References cb_build_add(), cb_build_debug(), cb_build_debug_call(), CB_CATEGORY_UNKNOWN, cb_debug_contents, cb_debug_name, CB_FIELD, CB_FIELD_P, CB_FIELD_PTR, cb_list_add(), CB_LIST_INIT, cb_ref(), CB_TAG_PERFORM_VARYING, CB_TREE, current_program, current_statement, cb_program::flag_debugging, cb_statement::flag_in_debug, cb_perform_varying::from, make_tree(), cb_perform_varying::name, NULL, cb_perform_varying::step, and cb_perform_varying::until.

Referenced by yyparse().

3161 {
3162  struct cb_perform_varying *p;
3163  cb_tree x;
3164  cb_tree l;
3165 
3167  sizeof (struct cb_perform_varying));
3168  p->name = name;
3169  p->from = from;
3170  p->until = until;
3171  if (name) {
3172  if (name == cb_error_node) {
3173  p->step = NULL;
3174  return CB_TREE (p);
3175  }
3176  l = cb_ref (name);
3177  x = cb_build_add (name, by, cb_high);
3180  CB_FIELD_P (l) && CB_FIELD (l)->flag_field_debug) {
3181  p->step = CB_LIST_INIT (x);
3182  x = cb_build_debug (cb_debug_name, CB_FIELD_PTR (name)->name,
3183  NULL);
3184  p->step = cb_list_add (p->step, x);
3185  x = cb_build_debug (cb_debug_contents, NULL, name);
3186  p->step = cb_list_add (p->step, x);
3187  x = cb_build_debug_call (CB_FIELD_PTR (name)->debug_section);
3188  p->step = cb_list_add (p->step, x);
3189  } else {
3190  p->step = x;
3191  }
3192  } else {
3193  p->step = NULL;
3194  }
3195  return CB_TREE (p);
3196 }
#define CB_TREE(x)
Definition: tree.h:440
cb_tree step
Definition: tree.h:1101
#define CB_FIELD_PTR(x)
Definition: tree.h:745
cb_tree cb_ref(cb_tree x)
Definition: tree.c:2653
cb_tree cb_build_add(cb_tree, cb_tree, cb_tree)
Definition: typeck.c:4015
unsigned int flag_debugging
Definition: tree.h:1320
unsigned int flag_in_debug
Definition: tree.h:1150
#define CB_FIELD_P(x)
Definition: tree.h:741
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
static void * make_tree(const enum cb_tag tag, const enum cb_category category, const size_t size)
Definition: tree.c:227
cb_tree cb_debug_name
Definition: typeck.c:84
cb_tree from
Definition: tree.h:1100
cb_tree cb_build_debug_call(struct cb_label *target)
Definition: tree.c:1590
cb_tree cb_error_node
Definition: tree.c:140
cb_tree name
Definition: tree.h:1099
struct cb_program * current_program
Definition: parser.c:168
cb_tree cb_high
Definition: tree.c:129
#define CB_LIST_INIT(x)
Definition: tree.h:1851
cb_tree cb_build_debug(const cb_tree target, const char *str, const cb_tree fld)
Definition: tree.c:1566
struct cb_statement * current_statement
Definition: parser.c:169
cb_tree until
Definition: tree.h:1102
cb_tree cb_debug_contents
Definition: typeck.c:88
#define CB_FIELD(x)
Definition: tree.h:740
cb_tree cb_list_add(cb_tree l, cb_tree x)
Definition: tree.c:1315

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_picture ( const char *  str)

Definition at line 1800 of file tree.c.

References _, cb_picture::category, CB_CATEGORY_ALPHABETIC, CB_CATEGORY_ALPHANUMERIC, CB_CATEGORY_ALPHANUMERIC_EDITED, CB_CATEGORY_NUMERIC, CB_CATEGORY_NUMERIC_EDITED, CB_CATEGORY_UNKNOWN, cb_error(), CB_TAG_PICTURE, CB_TREE, COB_MAX_DIGITS, COB_NATIONAL_SIZE, COB_SMALL_BUFF, cob_u32_t, cobc_check_string(), cobc_main_malloc(), cobc_parse_malloc(), cb_program::currency_symbol, current_program, cb_program::decimal_point, cb_picture::digits, cb_picture::have_sign, cb_picture::lenstr, make_tree(), cb_picture::orig, PIC_ALPHABETIC, PIC_ALPHABETIC_EDITED, PIC_ALPHANUMERIC, PIC_ALPHANUMERIC_EDITED, pic_buff, PIC_EDITED, PIC_NATIONAL, PIC_NATIONAL_EDITED, PIC_NUMERIC, PIC_NUMERIC_EDITED, cb_picture::real_digits, cb_picture::scale, cb_picture::size, and cb_picture::str.

Referenced by cb_build_debug_item(), cb_build_implicit_field(), cb_build_registers(), cb_validate_program_data(), check_picture_item(), scan_picture(), setup_parameters(), and validate_field_1().

1801 {
1802  struct cb_picture *pic;
1803  const unsigned char *p;
1804  size_t idx;
1805  size_t buffcnt;
1806  cob_u32_t at_beginning;
1807  cob_u32_t at_end;
1808  cob_u32_t p_char_seen;
1809  cob_u32_t s_char_seen;
1810  cob_u32_t dp_char_seen;
1812  cob_u32_t s_count;
1813  cob_u32_t v_count;
1814  cob_u32_t allocated;
1815  cob_u32_t x_digits;
1816  cob_u32_t digits;
1817  int category;
1818  int size;
1819  int scale;
1820  int i;
1821  int n;
1822  unsigned char c;
1823  unsigned char lastonechar;
1824  unsigned char lasttwochar;
1825 
1827  sizeof (struct cb_picture));
1828  if (strlen (str) > 50) {
1829  goto error;
1830  }
1831  if (!pic_buff) {
1833  }
1834 
1835  idx = 0;
1836  buffcnt = 0;
1837  p_char_seen = 0;
1838  s_char_seen = 0;
1839  dp_char_seen = 0;
1840  category = 0;
1841  size = 0;
1842  allocated = 0;
1843  digits = 0;
1844  x_digits = 0;
1845  real_digits = 0;
1846  scale = 0;
1847  s_count = 0;
1848  v_count = 0;
1849  lastonechar = 0;
1850  lasttwochar = 0;
1851 
1852  for (p = (const unsigned char *)str; *p; p++) {
1853  n = 1;
1854  c = *p;
1855 repeat:
1856  /* Count the number of repeated chars */
1857  while (p[1] == c) {
1858  p++, n++;
1859  }
1860 
1861  /* Add parenthesized numbers */
1862  if (p[1] == '(') {
1863  i = 0;
1864  p += 2;
1865  for (; *p == '0'; p++) {
1866  ;
1867  }
1868  for (; *p != ')'; p++) {
1869  if (!isdigit (*p)) {
1870  goto error;
1871  } else {
1872  allocated++;
1873  if (allocated > 9) {
1874  goto error;
1875  }
1876  i = i * 10 + (*p - '0');
1877  }
1878  }
1879  if (i == 0) {
1880  goto error;
1881  }
1882  n += i - 1;
1883  goto repeat;
1884  }
1885 
1886  /* Check grammar and category */
1887  /* FIXME: need more error checks */
1888  switch (c) {
1889  case 'A':
1890  if (s_char_seen || p_char_seen) {
1891  goto error;
1892  }
1893  category |= PIC_ALPHABETIC;
1894  x_digits += n;
1895  break;
1896 
1897  case 'X':
1898  if (s_char_seen || p_char_seen) {
1899  goto error;
1900  }
1901  category |= PIC_ALPHANUMERIC;
1902  x_digits += n;
1903  break;
1904 
1905  case '9':
1906  category |= PIC_NUMERIC;
1907  digits += n;
1908  real_digits += n;
1909  if (v_count) {
1910  scale += n;
1911  }
1912  break;
1913 
1914  case 'N':
1915  if (s_char_seen || p_char_seen) {
1916  goto error;
1917  }
1918  category |= PIC_NATIONAL;
1919  x_digits += n;
1920  break;
1921 
1922  case 'S':
1923  category |= PIC_NUMERIC;
1924  if (category & PIC_ALPHABETIC) {
1925  goto error;
1926  }
1927  s_count++;
1928  if (s_count > 1 || idx != 0) {
1929  goto error;
1930  }
1931  s_char_seen = 1;
1932  continue;
1933 
1934  case ',':
1935  case '.':
1936  category |= PIC_NUMERIC_EDITED;
1937  if (s_char_seen || p_char_seen) {
1938  goto error;
1939  }
1940  if (c != current_program->decimal_point) {
1941  break;
1942  }
1943  dp_char_seen = 1;
1944  /* fall through */
1945  case 'V':
1946  category |= PIC_NUMERIC;
1947  if (category & PIC_ALPHABETIC) {
1948  goto error;
1949  }
1950  v_count++;
1951  if (v_count > 1) {
1952  goto error;
1953  }
1954  break;
1955 
1956  case 'P':
1957  category |= PIC_NUMERIC;
1958  if (category & PIC_ALPHABETIC) {
1959  goto error;
1960  }
1961  if (p_char_seen || dp_char_seen) {
1962  goto error;
1963  }
1964  at_beginning = 0;
1965  at_end = 0;
1966  switch (buffcnt) {
1967  case 0:
1968  /* P..... */
1969  at_beginning = 1;
1970  break;
1971  case 1:
1972  /* VP.... */
1973  /* SP.... */
1974  if (lastonechar == 'V' || lastonechar == 'S') {
1975  at_beginning = 1;
1976  }
1977  break;
1978  case 2:
1979  /* SVP... */
1980  if (lasttwochar == 'S' && lastonechar == 'V') {
1981  at_beginning = 1;
1982  }
1983  break;
1984  default:
1985  break;
1986  }
1987  if (p[1] == 0 || (p[1] == 'V' && p[2] == 0)) {
1988  /* .....P */
1989  /* ....PV */
1990  at_end = 1;
1991  }
1992  if (!at_beginning && !at_end) {
1993  goto error;
1994  }
1995  p_char_seen = 1;
1996  if (at_beginning) {
1997  /* Implicit V */
1998  v_count++;
1999  }
2000  digits += n;
2001  if (v_count) {
2002  scale += n;
2003  } else {
2004  scale -= n;
2005  }
2006  break;
2007 
2008  case '0':
2009  case 'B':
2010  case '/':
2011  category |= PIC_EDITED;
2012  if (s_char_seen || p_char_seen) {
2013  goto error;
2014  }
2015  break;
2016 
2017  case '*':
2018  case 'Z':
2019  category |= PIC_NUMERIC_EDITED;
2020  if (category & PIC_ALPHABETIC) {
2021  goto error;
2022  }
2023  if (s_char_seen || p_char_seen) {
2024  goto error;
2025  }
2026  digits += n;
2027  if (v_count) {
2028  scale += n;
2029  }
2030  break;
2031 
2032  case '+':
2033  case '-':
2034  category |= PIC_NUMERIC_EDITED;
2035  if (category & PIC_ALPHABETIC) {
2036  goto error;
2037  }
2038  if (s_char_seen || p_char_seen) {
2039  goto error;
2040  }
2041  digits += n - 1;
2042  s_count++;
2043  /* FIXME: need more check */
2044  break;
2045 
2046  case 'C':
2047  category |= PIC_NUMERIC_EDITED;
2048  if (!(p[1] == 'R' && p[2] == 0)) {
2049  goto error;
2050  }
2051  if (s_char_seen || p_char_seen) {
2052  goto error;
2053  }
2054  p++;
2055  s_count++;
2056  break;
2057 
2058  case 'D':
2059  category |= PIC_NUMERIC_EDITED;
2060  if (!(p[1] == 'B' && p[2] == 0)) {
2061  goto error;
2062  }
2063  if (s_char_seen || p_char_seen) {
2064  goto error;
2065  }
2066  p++;
2067  s_count++;
2068  break;
2069 
2070  default:
2071  if (c == current_program->currency_symbol) {
2072  category |= PIC_NUMERIC_EDITED;
2073  digits += n - 1;
2074  /* FIXME: need more check */
2075  break;
2076  }
2077 
2078  goto error;
2079  }
2080 
2081  /* Calculate size */
2082  if (c != 'V' && c != 'P') {
2083  size += n;
2084  }
2085  if (c == 'C' || c == 'D') {
2086  size += n;
2087  }
2088  if (c == 'N') {
2089  size += n * (COB_NATIONAL_SIZE - 1);
2090  }
2091 
2092  /* Store in the buffer */
2093  pic_buff[idx++] = c;
2094  lasttwochar = lastonechar;
2095  lastonechar = c;
2096  memcpy (&pic_buff[idx], (void *)&n, sizeof(int));
2097  idx += sizeof(int);
2098  ++buffcnt;
2099  }
2100  pic_buff[idx] = 0;
2101 
2102  if (size == 0 && v_count) {
2103  goto error;
2104  }
2105  /* Set picture */
2106  pic->orig = cobc_check_string (str);
2107  pic->size = size;
2108  pic->digits = digits;
2109  pic->scale = scale;
2110  pic->have_sign = s_count;
2111  pic->real_digits = real_digits;
2112 
2113  /* Set picture category */
2114  switch (category) {
2115  case PIC_ALPHABETIC:
2117  break;
2118  case PIC_NUMERIC:
2120  if (digits > COB_MAX_DIGITS) {
2121  cb_error (_("Numeric field cannot be larger than %d digits"), COB_MAX_DIGITS);
2122  }
2123  break;
2124  case PIC_ALPHANUMERIC:
2125  case PIC_NATIONAL:
2127  break;
2128  case PIC_NUMERIC_EDITED:
2129  pic->str = cobc_parse_malloc (idx + 1);
2130  memcpy (pic->str, pic_buff, idx);
2132  pic->lenstr = idx;
2133  break;
2134  case PIC_EDITED:
2135  case PIC_ALPHABETIC_EDITED:
2137  case PIC_NATIONAL_EDITED:
2138  pic->str = cobc_parse_malloc (idx + 1);
2139  memcpy (pic->str, pic_buff, idx);
2141  pic->lenstr = idx;
2142  pic->digits = x_digits;
2143  break;
2144  default:
2145  goto error;
2146  }
2147  goto end;
2148 
2149 error:
2150  cb_error (_("Invalid picture string - '%s'"), str);
2151 
2152 end:
2153  return CB_TREE (pic);
2154 }
#define CB_TREE(x)
Definition: tree.h:440
void * cobc_main_malloc(const size_t size)
Definition: cobc.c:702
int size
Definition: tree.h:622
#define cob_u32_t
Definition: common.h:31
int scale
Definition: tree.h:626
void * cobc_parse_malloc(const size_t size)
Definition: cobc.c:809
int lenstr
Definition: tree.h:623
cob_u32_t real_digits
Definition: tree.h:628
char * str
Definition: tree.h:621
cob_u32_t digits
Definition: tree.h:625
#define COB_SMALL_BUFF
Definition: common.h:540
void * cobc_check_string(const char *dupstr)
Definition: cobc.c:951
char * orig
Definition: tree.h:620
#define COB_MAX_DIGITS
Definition: common.h:562
enum cb_category category
Definition: tree.h:624
#define _(s)
Definition: cobcrun.c:59
static void * make_tree(const enum cb_tag tag, const enum cb_category category, const size_t size)
Definition: tree.c:227
#define PIC_NATIONAL
Definition: tree.c:36
#define PIC_NUMERIC_EDITED
Definition: tree.c:41
#define PIC_ALPHABETIC
Definition: tree.c:34
#define PIC_NUMERIC
Definition: tree.c:35
#define PIC_EDITED
Definition: tree.c:37
#define PIC_ALPHANUMERIC
Definition: tree.c:38
unsigned char currency_symbol
Definition: tree.h:1301
void cb_error(const char *,...) COB_A_FORMAT12
Definition: error.c:98
#define PIC_ALPHABETIC_EDITED
Definition: tree.c:39
struct cb_program * current_program
Definition: parser.c:168
cob_u32_t have_sign
Definition: tree.h:627
static char * pic_buff
Definition: tree.c:86
#define PIC_NATIONAL_EDITED
Definition: tree.c:42
#define PIC_ALPHANUMERIC_EDITED
Definition: tree.c:40
#define COB_NATIONAL_SIZE
Definition: common.h:683
unsigned char decimal_point
Definition: tree.h:1300

Here is the call graph for this function:

Here is the caller graph for this function:

struct cb_program* cb_build_program ( struct cb_program last_program,
const int  nest_level 
)

Definition at line 1400 of file tree.c.

References add_contained_prog(), cb_program::alphabet_name_list, cb_tree_common::category, CB_CATEGORY_UNKNOWN, cb_clear_real_field(), CB_FIELD_PTR, cb_flag_functions_all, cb_reset_78(), cb_reset_global_78(), cb_program::cb_return_code, CB_TAG_PROGRAM, CB_WORD_TABLE_SIZE, cb_program::class_name_list, cb_program::class_spec_list, cb_program::classification, cobc_cs_check, cobc_in_procedure, cobc_in_repository, cobc_parse_malloc(), cb_program::collating_sequence, cb_program::common, cb_program::currency_symbol, cb_program::decimal_point, cb_program::flag_console_is_crt, cb_program::flag_trailing_separate, cb_program::function_spec_list, functions_are_all, cb_program::global_file_list, cb_program::interface_spec_list, cb_program::locale_list, cb_program::mnemonic_spec_list, cb_program::nested_level, cb_program::nested_prog_list, cb_program::next_program, cb_program::numeric_separator, cb_program::program_spec_list, cb_program::property_spec_list, cb_program::symbolic_char_list, cb_tree_common::tag, toplev_count, cb_program::toplev_count, cb_program::user_spec_list, and cb_program::word_table.

Referenced by set_up_program(), and yyparse().

1401 {
1402  struct cb_program *p;
1403  struct cb_program *q;
1404 
1405  if (!last_program) {
1406  toplev_count = 0;
1407  }
1408  cb_reset_78 ();
1409  cobc_in_procedure = 0;
1410  cobc_in_repository = 0;
1411  cobc_cs_check = 0;
1413 
1414  p = cobc_parse_malloc (sizeof (struct cb_program));
1416 
1417  p->common.tag = CB_TAG_PROGRAM;
1419 
1420  p->next_program = last_program;
1421  p->nested_level = nest_level;
1422  p->decimal_point = '.';
1423  p->currency_symbol = '$';
1424  p->numeric_separator = ',';
1425  /* Save current program as actual at it's level */
1426  container_progs[nest_level] = p;
1427  if (nest_level
1428  && last_program /* <- silence warnings */) {
1429  /* Contained program */
1430  /* Inherit from upper level */
1431  p->global_file_list = last_program->global_file_list;
1432  p->collating_sequence = last_program->collating_sequence;
1433  p->classification = last_program->classification;
1434  p->mnemonic_spec_list = last_program->mnemonic_spec_list;
1435  p->class_spec_list = last_program->class_spec_list;
1436  p->interface_spec_list = last_program->interface_spec_list;
1437  p->function_spec_list = last_program->function_spec_list;
1438  p->user_spec_list = last_program->user_spec_list;
1439  p->program_spec_list = last_program->program_spec_list;
1440  p->property_spec_list = last_program->property_spec_list;
1441  p->alphabet_name_list = last_program->alphabet_name_list;
1442  p->symbolic_char_list = last_program->symbolic_char_list;
1443  p->class_name_list = last_program->class_name_list;
1444  p->locale_list = last_program->locale_list;
1445  p->decimal_point = last_program->decimal_point;
1446  p->numeric_separator = last_program->numeric_separator;
1447  p->currency_symbol = last_program->currency_symbol;
1449  p->flag_console_is_crt = last_program->flag_console_is_crt;
1450  /* RETURN-CODE is global for contained programs */
1451  p->cb_return_code = last_program->cb_return_code;
1452  CB_FIELD_PTR (last_program->cb_return_code)->flag_is_global = 1;
1453  p->toplev_count = last_program->toplev_count;
1454  /* Add program to itself for possible recursion */
1456  /* Add contained program to it's parent */
1457  q = container_progs[nest_level - 1];
1459  } else {
1460  /* Top level program */
1461  p->toplev_count = toplev_count++;
1463  cb_reset_global_78 ();
1464  }
1465  return p;
1466 }
static struct cb_program * container_progs[64]
Definition: tree.c:91
cb_tree mnemonic_spec_list
Definition: tree.h:1268
int toplev_count
Definition: tree.h:1297
void * cobc_parse_malloc(const size_t size)
Definition: cobc.c:809
cb_tree program_spec_list
Definition: tree.h:1273
static struct nested_list * add_contained_prog(struct nested_list *parent_list, struct cb_program *child_prog)
Definition: tree.c:1383
#define CB_FIELD_PTR(x)
Definition: tree.h:745
cb_tree property_spec_list
Definition: tree.h:1274
cb_tree global_file_list
Definition: tree.h:1282
int nested_level
Definition: tree.h:1295
enum cb_category category
Definition: tree.h:430
cb_tree interface_spec_list
Definition: tree.h:1270
cb_tree function_spec_list
Definition: tree.h:1271
int cb_flag_functions_all
Definition: cobc.c:170
unsigned int cobc_in_repository
Definition: parser.c:180
cb_tree cb_return_code
Definition: tree.h:1265
cb_tree locale_list
Definition: tree.h:1260
struct cb_program * next_program
Definition: tree.h:1242
enum cb_tag tag
Definition: tree.h:429
cb_tree alphabet_name_list
Definition: tree.h:1256
struct cb_tree_common common
Definition: tree.h:1239
unsigned int flag_console_is_crt
Definition: tree.h:1319
static int toplev_count
Definition: tree.c:89
unsigned char currency_symbol
Definition: tree.h:1301
cb_tree class_name_list
Definition: tree.h:1258
int functions_are_all
Definition: parser.c:177
struct cb_word ** word_table
Definition: tree.h:1247
cb_tree collating_sequence
Definition: tree.h:1284
cb_tree classification
Definition: tree.h:1285
unsigned int cobc_in_procedure
Definition: parser.c:179
struct nested_list * nested_prog_list
Definition: tree.h:1249
cb_tree class_spec_list
Definition: tree.h:1269
void cb_reset_global_78(void)
Definition: scanner.c:4794
unsigned char numeric_separator
Definition: tree.h:1302
unsigned int flag_trailing_separate
Definition: tree.h:1318
void cb_reset_78(void)
Definition: scanner.c:4771
unsigned int cobc_cs_check
Definition: parser.c:182
cb_tree user_spec_list
Definition: tree.h:1272
#define CB_WORD_TABLE_SIZE
Definition: tree.h:871
void cb_clear_real_field(void)
Definition: field.c:1439
cb_tree symbolic_char_list
Definition: tree.h:1257
unsigned char decimal_point
Definition: tree.h:1300

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_reference ( const char *  name)

Definition at line 2572 of file tree.c.

References CB_CATEGORY_UNKNOWN, cb_source_file, cb_source_line, CB_TAG_REFERENCE, CB_TREE, lookup_word(), make_tree(), cb_tree_common::source_file, and cb_tree_common::source_line.

Referenced by build_nested_special(), cb_add_const_var(), cb_build_debug_item(), cb_build_field_reference(), cb_build_filler(), cb_build_identifier(), cb_build_registers(), cb_define_system_name(), cb_validate_program_data(), emit_entry(), finalize_file(), make_constant_label(), set_up_func_prototype(), yylex(), and yyparse().

2573 {
2574  struct cb_reference *p;
2575  cb_tree r;
2576 
2578  sizeof (struct cb_reference));
2579  /* Look up / insert word into hash list */
2580  lookup_word (p, name);
2581 
2582  r = CB_TREE (p);
2583 
2586 
2587  return r;
2588 }
#define CB_TREE(x)
Definition: tree.h:440
const char * cb_source_file
Definition: cobc.c:145
const char * source_file
Definition: tree.h:431
int source_line
Definition: tree.h:432
static void * make_tree(const enum cb_tag tag, const enum cb_category category, const size_t size)
Definition: tree.c:227
static void lookup_word(struct cb_reference *p, const char *name)
Definition: tree.c:170
int cb_source_line
Definition: cobc.c:178

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_search ( const int  flag_all,
const cb_tree  table,
const cb_tree  var,
const cb_tree  end_stmt,
const cb_tree  whens 
)

Definition at line 3049 of file tree.c.

References CB_CATEGORY_UNKNOWN, CB_TAG_SEARCH, CB_TREE, cb_search::end_stmt, cb_search::flag_all, make_tree(), cb_search::table, cb_search::var, and cb_search::whens.

Referenced by cb_emit_search(), and cb_emit_search_all().

3051 {
3052  struct cb_search *p;
3053 
3055  sizeof (struct cb_search));
3056  p->flag_all = flag_all;
3057  p->table = table;
3058  p->var = var;
3059  p->end_stmt = end_stmt;
3060  p->whens = whens;
3061  return CB_TREE (p);
3062 }
#define CB_TREE(x)
Definition: tree.h:440
cb_tree end_stmt
Definition: tree.h:1026
int flag_all
Definition: tree.h:1028
cb_tree table
Definition: tree.h:1024
static void * make_tree(const enum cb_tag tag, const enum cb_category category, const size_t size)
Definition: tree.c:227
cb_tree var
Definition: tree.h:1025
cb_tree whens
Definition: tree.h:1027

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_set_attribute ( const struct cb_field fld,
const int  val_on,
const int  val_off 
)

Definition at line 3226 of file tree.c.

References CB_CATEGORY_UNKNOWN, CB_TAG_SET_ATTR, CB_TREE, cb_set_attr::fld, make_tree(), cb_set_attr::val_off, and cb_set_attr::val_on.

Referenced by cb_emit_set_attribute().

3228 {
3229  struct cb_set_attr *p;
3230 
3232  sizeof (struct cb_set_attr));
3233  p->fld = (struct cb_field *)fld;
3234  p->val_on = val_on;
3235  p->val_off = val_off;
3236  return CB_TREE (p);
3237 }
#define CB_TREE(x)
Definition: tree.h:440
int val_off
Definition: tree.h:1173
Definition: tree.h:643
static void * make_tree(const enum cb_tag tag, const enum cb_category category, const size_t size)
Definition: tree.c:227
struct cb_field * fld
Definition: tree.h:1171
int val_on
Definition: tree.h:1172

Here is the call graph for this function:

Here is the caller graph for this function:

struct cb_statement* cb_build_statement ( const char *  name)

Definition at line 3201 of file tree.c.

References CB_CATEGORY_UNKNOWN, CB_TAG_STATEMENT, make_tree(), and cb_statement::name.

Referenced by begin_implicit_statement(), and begin_statement().

3202 {
3203  struct cb_statement *p;
3204 
3206  sizeof (struct cb_statement));
3207  p->name = name;
3208  return p;
3209 }
const char * name
Definition: tree.h:1137
static void * make_tree(const enum cb_tag tag, const enum cb_category category, const size_t size)
Definition: tree.c:227

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_string ( const void *  data,
const size_t  size 
)

Definition at line 1526 of file tree.c.

References CB_CATEGORY_ALPHANUMERIC, CB_TAG_STRING, CB_TREE, cb_string::data, make_tree(), and cb_string::size.

Referenced by cb_build_move_literal().

1527 {
1528  struct cb_string *p;
1529 
1531  sizeof (struct cb_string));
1532  p->size = size;
1533  p->data = data;
1534  return CB_TREE (p);
1535 }
#define CB_TREE(x)
Definition: tree.h:440
static void * make_tree(const enum cb_tag tag, const enum cb_category category, const size_t size)
Definition: tree.c:227
size_t size
Definition: tree.h:530
const unsigned char * data
Definition: tree.h:529

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_build_symbolic_chars ( const cb_tree  sym_list,
const cb_tree  alphabet 
)

Definition at line 2289 of file tree.c.

References cb_alphabet_name::alphachr, CB_ALPHABET_NAME, cb_build_alphanumeric_literal(), cb_build_constant(), CB_CHAIN, CB_FIELD, cb_get_int(), CB_LITERAL, CB_PURPOSE, cb_validate_78_item(), CB_VALUE, and NULL.

Referenced by cb_validate_program_environment().

2290 {
2291  cb_tree l;
2292  cb_tree x;
2293  cb_tree x2;
2294  struct cb_alphabet_name *ap;
2295  int n;
2296  unsigned char buff[4];
2297 
2298  if (alphabet) {
2299  ap = CB_ALPHABET_NAME (alphabet);
2300  } else {
2301  ap = NULL;
2302  }
2303  for (l = sym_list; l; l = CB_CHAIN (l)) {
2304  n = cb_get_int (CB_PURPOSE (l)) - 1;
2305  if (ap) {
2306  buff[0] = (unsigned char)ap->alphachr[n];
2307  } else {
2308  buff[0] = (unsigned char)n;
2309  }
2310  buff[1] = 0;
2311  x2 = cb_build_alphanumeric_literal (buff, (size_t)1);
2312  CB_LITERAL (x2)->all = 1;
2313  x = cb_build_constant (CB_VALUE (l), x2);
2314  CB_FIELD (x)->flag_item_78 = 1;
2315  CB_FIELD (x)->flag_is_global = 1;
2316  CB_FIELD (x)->level = 1;
2317  (void)cb_validate_78_item (CB_FIELD (x), 0);
2318  }
2319 }
cb_tree cb_build_constant(cb_tree name, cb_tree value)
Definition: tree.c:2189
#define CB_LITERAL(x)
Definition: tree.h:601
int cb_get_int(const cb_tree x)
Definition: tree.c:1101
#define CB_PURPOSE(x)
Definition: tree.h:1192
#define CB_VALUE(x)
Definition: tree.h:1193
int alphachr[256]
Definition: tree.h:547
cb_tree cb_build_alphanumeric_literal(const void *data, const size_t size)
Definition: tree.c:1716
#define CB_ALPHABET_NAME(x)
Definition: tree.h:550
#define CB_CHAIN(x)
Definition: tree.h:1194
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
struct cb_field * cb_validate_78_item(struct cb_field *f, const cob_u32_t no78add)
Definition: field.c:1415
#define CB_FIELD(x)
Definition: tree.h:740

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_system_name ( const enum cb_system_name_category  category,
const int  token 
)

Definition at line 1667 of file tree.c.

References cb_system_name::category, CB_CATEGORY_UNKNOWN, CB_TAG_SYSTEM_NAME, CB_TREE, make_tree(), and cb_system_name::token.

Referenced by lookup_system_name().

1668 {
1669  struct cb_system_name *p;
1670 
1672  sizeof (struct cb_system_name));
1673  p->category = category;
1674  p->token = token;
1675  return CB_TREE (p);
1676 }
#define CB_TREE(x)
Definition: tree.h:440
static void * make_tree(const enum cb_tag tag, const enum cb_category category, const size_t size)
Definition: tree.c:227
enum cb_system_name_category category
Definition: tree.h:582
int token
Definition: tree.h:583

Here is the call graph for this function:

Here is the caller graph for this function:

int cb_category_is_alpha ( cb_tree  x)

Definition at line 843 of file tree.c.

References category_is_alphanumeric, and CB_TREE_CATEGORY.

Referenced by cb_emit_allocate(), and yyparse().

844 {
846 }
#define CB_TREE_CATEGORY(x)
Definition: tree.h:443
static int category_is_alphanumeric[]
Definition: tree.c:62

Here is the caller graph for this function:

cb_tree cb_concat_literals ( const cb_tree  x1,
const cb_tree  x2 
)

Definition at line 1729 of file tree.c.

References _, cb_tree_common::category, CB_CATEGORY_ALPHANUMERIC, cb_error_node, cb_error_x(), CB_TREE, concat_literals(), cb_literal::data, NULL, cb_literal::size, cb_tree_common::source_file, and cb_tree_common::source_line.

Referenced by yyparse().

1730 {
1731  struct cb_literal *p;
1732  cb_tree l;
1733  char lit_out[39];
1734 
1735  if (x1 == cb_error_node || x2 == cb_error_node) {
1736  return cb_error_node;
1737  }
1738 
1739  if ((x1->category != CB_CATEGORY_ALPHANUMERIC)
1740  || (x2->category != CB_CATEGORY_ALPHANUMERIC)) {
1741  cb_error_x (x1, _("Non-alphanumeric literals cannot be concatenated"));
1742  return cb_error_node;
1743  }
1744 
1745  p = concat_literals (x1, x2);
1746  if (p == NULL) {
1747  return cb_error_node;
1748  }
1749  if (p->size > cb_lit_length) {
1750  /* shorten literal for output */
1751  strncpy (lit_out, (char *)p->data, 38);
1752  strcpy (lit_out + 35, "...");
1753  cb_error_x (x1, _("Invalid literal: '%s'"), lit_out);
1754  cb_error_x (x1, _("Literal length %d exceeds %d characters"),
1755  p->size, cb_lit_length);
1756  return cb_error_node;
1757  }
1758 
1759  l = CB_TREE (p);
1760 
1761  l->source_file = x1->source_file;
1762  l->source_line = x1->source_line;
1763 
1764  return l;
1765 }
#define CB_TREE(x)
Definition: tree.h:440
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
const char * source_file
Definition: tree.h:431
enum cb_category category
Definition: tree.h:430
static struct cb_literal * concat_literals(const cb_tree left, const cb_tree right)
Definition: tree.c:677
int source_line
Definition: tree.h:432
#define _(s)
Definition: cobcrun.c:59
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
unsigned char * data
Definition: tree.h:593
cb_tree cb_error_node
Definition: tree.c:140
cob_u32_t size
Definition: tree.h:594

Here is the call graph for this function:

Here is the caller graph for this function:

const char* cb_define ( cb_tree  name,
cb_tree  val 
)

Definition at line 1367 of file tree.c.

References cb_list_add(), CB_REFERENCE, cb_word::count, cb_word::items, cb_word::name, cb_tree_common::source_file, and cb_tree_common::source_line.

Referenced by build_file(), build_nested_special(), build_report(), cb_build_alphabet_name(), cb_build_class_name(), cb_build_field(), cb_build_label(), cb_build_locale_name(), cb_define_system_name(), set_up_func_prototype(), set_up_program(), and yyparse().

1368 {
1369  struct cb_word *w;
1370 
1371  w = CB_REFERENCE (name)->word;
1372  w->items = cb_list_add (w->items, val);
1373  w->count++;
1374  val->source_file = name->source_file;
1375  val->source_line = name->source_line;
1376  CB_REFERENCE (name)->value = val;
1377  return w->name;
1378 }
const char * source_file
Definition: tree.h:431
const char * name
Definition: tree.h:865
int count
Definition: tree.h:867
int source_line
Definition: tree.h:432
#define CB_REFERENCE(x)
Definition: tree.h:901
cb_tree items
Definition: tree.h:866
Definition: tree.h:863
cb_tree cb_list_add(cb_tree l, cb_tree x)
Definition: tree.c:1315

Here is the call graph for this function:

Here is the caller graph for this function:

static void cb_define_system_name ( const char *  name)
static

Definition at line 2621 of file tree.c.

References cb_build_reference(), cb_define(), CB_WORD_COUNT, and lookup_system_name().

Referenced by cb_set_system_names().

2622 {
2623  cb_tree x;
2624  cb_tree y;
2625 
2626  x = cb_build_reference (name);
2627  if (CB_WORD_COUNT (x) == 0) {
2628  y = lookup_system_name (name);
2629  /* Paranoid */
2630  if (y) {
2631  cb_define (x, y);
2632  }
2633  }
2634 }
const char * name
Definition: tree.h:865
cb_tree lookup_system_name(const char *name)
Definition: reserved.c:2860
cb_tree cb_build_reference(const char *name)
Definition: tree.c:2572
#define CB_WORD_COUNT(x)
Definition: tree.h:905
const char * cb_define(cb_tree name, cb_tree val)
Definition: tree.c:1367

Here is the call graph for this function:

Here is the caller graph for this function:

struct cb_field* cb_field_add ( struct cb_field f,
struct cb_field p 
)

Definition at line 2212 of file tree.c.

References NULL, and cb_field::sister.

2213 {
2214  struct cb_field *t;
2215 
2216  if (f == NULL) {
2217  return p;
2218  }
2219  for (t = f; t->sister; t = t->sister) {
2220  ;
2221  }
2222  t->sister = p;
2223  return f;
2224 }
struct cb_field * sister
Definition: tree.h:653
Definition: tree.h:643
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
struct cb_field* cb_field_founder ( const struct cb_field f)

Definition at line 2227 of file tree.c.

References cb_field::parent.

Referenced by cb_build_field_tree(), cb_build_identifier(), cb_check_overlapping(), cb_ref(), check_valid_key(), finalize_file(), and global_check().

2228 {
2229  const struct cb_field *ff;
2230 
2231  ff = f;
2232  while (ff->parent) {
2233  ff = ff->parent;
2234  }
2235  return (struct cb_field *)ff;
2236 }
Definition: tree.h:643
struct cb_field * parent
Definition: tree.h:651

Here is the caller graph for this function:

int cb_field_subordinate ( const struct cb_field pfld,
const struct cb_field f 
)

Definition at line 2274 of file tree.c.

References cb_field::parent.

Referenced by output_size().

2275 {
2276  struct cb_field *p;
2277 
2278  for (p = pfld->parent; p; p = p->parent) {
2279  if (p == f) {
2280  return 1;
2281  }
2282  }
2283  return 0;
2284 }
Definition: tree.h:643
struct cb_field * parent
Definition: tree.h:651

Here is the caller graph for this function:

unsigned int cb_field_variable_address ( const struct cb_field fld)

Definition at line 2255 of file tree.c.

References cb_field_variable_size(), cb_field::children, cb_field::depending, cb_field::parent, and cb_field::sister.

2256 {
2257  const struct cb_field *p;
2258  const struct cb_field *f;
2259 
2260  f = fld;
2261  for (p = f->parent; p; f = f->parent, p = f->parent) {
2262  for (p = p->children; p != f; p = p->sister) {
2263  if (p->depending || cb_field_variable_size (p)) {
2264  return 1;
2265  }
2266  }
2267  }
2268  return 0;
2269 }
struct cb_field * sister
Definition: tree.h:653
struct cb_field * children
Definition: tree.h:652
struct cb_field * cb_field_variable_size(const struct cb_field *f)
Definition: tree.c:2239
cb_tree depending
Definition: tree.h:647
Definition: tree.h:643
struct cb_field * parent
Definition: tree.h:651

Here is the call graph for this function:

struct cb_field* cb_field_variable_size ( const struct cb_field f)

Definition at line 2239 of file tree.c.

References cb_field_variable_size(), cb_field::children, cb_field::depending, NULL, and cb_field::sister.

Referenced by cb_build_const_length(), cb_build_length(), cb_build_length_1(), cb_build_move_field(), cb_build_move_literal(), cb_check_overlapping(), cb_chk_alpha_cond(), cb_field_variable_address(), cb_field_variable_size(), finalize_file(), and validate_field_1().

2240 {
2241  struct cb_field *p;
2242  struct cb_field *fc;
2243 
2244  for (fc = f->children; fc; fc = fc->sister) {
2245  if (fc->depending) {
2246  return fc;
2247  } else if ((p = cb_field_variable_size (fc)) != NULL) {
2248  return p;
2249  }
2250  }
2251  return NULL;
2252 }
struct cb_field * sister
Definition: tree.h:653
struct cb_field * children
Definition: tree.h:652
struct cb_field * cb_field_variable_size(const struct cb_field *f)
Definition: tree.c:2239
cb_tree depending
Definition: tree.h:647
Definition: tree.h:643
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95

Here is the call graph for this function:

Here is the caller graph for this function:

int cb_fits_int ( const cb_tree  x)

Definition at line 914 of file tree.c.

References CB_FIELD, cb_fits_int(), CB_LITERAL, CB_REFERENCE, CB_TAG_FIELD, CB_TAG_INTEGER, CB_TAG_LITERAL, CB_TAG_REFERENCE, CB_TREE_TAG, CB_USAGE_BINARY, CB_USAGE_COMP_5, CB_USAGE_COMP_6, CB_USAGE_COMP_X, CB_USAGE_DISPLAY, CB_USAGE_INDEX, CB_USAGE_LENGTH, CB_USAGE_PACKED, cb_field::children, cb_literal::data, cb_picture::digits, cb_field::pic, cb_literal::scale, cb_picture::scale, cb_literal::sign, cb_literal::size, cb_field::size, cb_field::usage, and value.

Referenced by cb_build_add(), cb_build_move_literal(), cb_build_sub(), cb_fits_int(), output_bin_field(), output_call(), and output_integer().

915 {
916  struct cb_literal *l;
917  struct cb_field *f;
918  const char *s;
919  const unsigned char *p;
920  size_t size;
921 
922  switch (CB_TREE_TAG (x)) {
923  case CB_TAG_LITERAL:
924  l = CB_LITERAL (x);
925  if (l->scale > 0) {
926  return 0;
927  }
928  for (size = 0, p = l->data; size < l->size; ++size, ++p) {
929  if (*p != (unsigned char)'0') {
930  break;
931  }
932  }
933  size = l->size - size;
934  if (size < 10) {
935  return 1;
936  }
937  if (size > 10) {
938  return 0;
939  }
940  if (l->sign < 0) {
941  s = "2147483648";
942  } else {
943  s = "2147483647";
944  }
945  if (memcmp (p, s, (size_t)10) > 0) {
946  return 0;
947  }
948  return 1;
949  case CB_TAG_FIELD:
950  f = CB_FIELD (x);
951  if (f->children) {
952  return 0;
953  }
954  switch (f->usage) {
955  case CB_USAGE_INDEX:
956  case CB_USAGE_LENGTH:
957  return 1;
958  case CB_USAGE_BINARY:
959  case CB_USAGE_COMP_5:
960  case CB_USAGE_COMP_X:
961  if (f->pic->scale <= 0 && f->size <= (int)sizeof (int)) {
962  return 1;
963  }
964  return 0;
965  case CB_USAGE_DISPLAY:
966  if (f->size < 10) {
967  if (!f->pic || f->pic->scale <= 0) {
968  return 1;
969  }
970  }
971  return 0;
972  case CB_USAGE_PACKED:
973  case CB_USAGE_COMP_6:
974  if (f->pic->scale <= 0 && f->pic->digits < 10) {
975  return 1;
976  }
977  return 0;
978  default:
979  return 0;
980  }
981  case CB_TAG_REFERENCE:
982  return cb_fits_int (CB_REFERENCE (x)->value);
983  case CB_TAG_INTEGER:
984  return 1;
985  default:
986  return 0;
987  }
988 }
short sign
Definition: tree.h:597
int scale
Definition: tree.h:626
struct cb_field * children
Definition: tree.h:652
#define CB_LITERAL(x)
Definition: tree.h:601
struct cb_picture * pic
Definition: tree.h:659
cob_u32_t digits
Definition: tree.h:625
strict implicit external value
Definition: warning.def:54
Definition: tree.h:643
int scale
Definition: tree.h:595
#define CB_TREE_TAG(x)
Definition: tree.h:441
#define CB_REFERENCE(x)
Definition: tree.h:901
int cb_fits_int(const cb_tree x)
Definition: tree.c:914
int size
Definition: tree.h:672
unsigned char * data
Definition: tree.h:593
cob_u32_t size
Definition: tree.h:594
enum cb_usage usage
Definition: tree.h:693
#define CB_FIELD(x)
Definition: tree.h:740

Here is the call graph for this function:

Here is the caller graph for this function:

int cb_fits_long_long ( const cb_tree  x)

Definition at line 991 of file tree.c.

References CB_FIELD, cb_fits_long_long(), CB_LITERAL, CB_REFERENCE, CB_TAG_FIELD, CB_TAG_INTEGER, CB_TAG_LITERAL, CB_TAG_REFERENCE, CB_TREE_TAG, CB_USAGE_BINARY, CB_USAGE_COMP_5, CB_USAGE_COMP_6, CB_USAGE_COMP_X, CB_USAGE_DISPLAY, CB_USAGE_INDEX, CB_USAGE_LENGTH, CB_USAGE_PACKED, cb_field::children, cob_s64_t, cb_literal::data, cb_picture::digits, cb_field::pic, cb_literal::scale, cb_picture::scale, cb_literal::sign, cb_literal::size, cb_field::size, cb_field::usage, and value.

Referenced by cb_build_cond(), cb_build_optim_cond(), cb_fits_long_long(), and output_long_integer().

992 {
993  struct cb_literal *l;
994  struct cb_field *f;
995  const char *s;
996  const unsigned char *p;
997  size_t size;
998 
999  switch (CB_TREE_TAG (x)) {
1000  case CB_TAG_LITERAL:
1001  l = CB_LITERAL (x);
1002  if (l->scale > 0) {
1003  return 0;
1004  }
1005  for (size = 0, p = l->data; size < l->size; ++size, ++p) {
1006  if (*p != (unsigned char)'0') {
1007  break;
1008  }
1009  }
1010  size = l->size - size;
1011  if (size < 19) {
1012  return 1;
1013  }
1014  if (size > 19) {
1015  return 0;
1016  }
1017  if (l->sign < 0) {
1018  s = "9223372036854775808";
1019  } else {
1020  s = "9223372036854775807";
1021  }
1022  if (memcmp (p, s, (size_t)19) > 0) {
1023  return 0;
1024  }
1025  return 1;
1026  case CB_TAG_FIELD:
1027  f = CB_FIELD (x);
1028  if (f->children) {
1029  return 0;
1030  }
1031  switch (f->usage) {
1032  case CB_USAGE_INDEX:
1033  case CB_USAGE_LENGTH:
1034  return 1;
1035  case CB_USAGE_BINARY:
1036  case CB_USAGE_COMP_5:
1037  case CB_USAGE_COMP_X:
1038  if (f->pic->scale <= 0 &&
1039  f->size <= (int)sizeof (cob_s64_t)) {
1040  return 1;
1041  }
1042  return 0;
1043  case CB_USAGE_DISPLAY:
1044  if (f->pic->scale <= 0 && f->size < 19) {
1045  return 1;
1046  }
1047  return 0;
1048  case CB_USAGE_PACKED:
1049  case CB_USAGE_COMP_6:
1050  if (f->pic->scale <= 0 && f->pic->digits < 19) {
1051  return 1;
1052  }
1053  return 0;
1054  default:
1055  return 0;
1056  }
1057  case CB_TAG_REFERENCE:
1058  return cb_fits_long_long (CB_REFERENCE (x)->value);
1059  case CB_TAG_INTEGER:
1060  return 1;
1061  default:
1062  return 0;
1063  }
1064 }
short sign
Definition: tree.h:597
int scale
Definition: tree.h:626
struct cb_field * children
Definition: tree.h:652
#define CB_LITERAL(x)
Definition: tree.h:601
struct cb_picture * pic
Definition: tree.h:659
cob_u32_t digits
Definition: tree.h:625
int cb_fits_long_long(const cb_tree x)
Definition: tree.c:991
#define cob_s64_t
Definition: common.h:51
strict implicit external value
Definition: warning.def:54
Definition: tree.h:643
int scale
Definition: tree.h:595
#define CB_TREE_TAG(x)
Definition: tree.h:441
#define CB_REFERENCE(x)
Definition: tree.h:901
int size
Definition: tree.h:672
unsigned char * data
Definition: tree.h:593
cob_u32_t size
Definition: tree.h:594
enum cb_usage usage
Definition: tree.h:693
#define CB_FIELD(x)
Definition: tree.h:740

Here is the call graph for this function:

Here is the caller graph for this function:

int cb_get_int ( const cb_tree  x)

Definition at line 1101 of file tree.c.

References _, cb_error(), CB_LITERAL, CB_LITERAL_P, check_lit_length(), COBC_ABORT, cobc_abort_pr(), cb_literal::data, cb_literal::sign, cb_literal::size, and unlikely.

Referenced by cb_build_identifier(), cb_build_intrinsic(), cb_build_move_literal(), cb_build_symbolic_chars(), cb_build_write_advancing_lines(), cb_check_overlapping(), cb_emit_call(), cb_field_size(), get_value(), literal_value(), output_call(), output_index(), output_integer(), validate_inspect(), and yyparse().

1102 {
1103  struct cb_literal *l;
1104  const char *s;
1105  size_t size;
1106  size_t i;
1107  int val;
1108 
1109  if (!CB_LITERAL_P (x)) {
1110  cobc_abort_pr (_("Invalid literal cast - Aborting"));
1111  COBC_ABORT ();
1112  }
1113  l = CB_LITERAL (x);
1114 
1115  /* Skip leading zeroes */
1116  for (i = 0; i < l->size; i++) {
1117  if (l->data[i] != '0') {
1118  break;
1119  }
1120  }
1121 
1122  size = l->size - i;
1123  /* Check numeric literal length, postponed from scanner.l (scan_numeric) */
1124  check_lit_length(size, (const char *)l->data + i);
1125  /* Check numeric literal length matching requested output type */
1126 #if INT_MAX >= 9223372036854775807
1127  if (unlikely(size >= 19U)) {
1128  if (l->sign < 0) {
1129  s = "9223372036854775808";
1130  } else {
1131  s = "9223372036854775807";
1132  }
1133  if (size > 19U || memcmp (&l->data[i], s, (size_t)19) > 0) {
1134  cb_error (_("Numeric literal '%s' exceeds limit '%s'"), &l->data[i], s);
1135  return INT_MAX;
1136  }
1137  }
1138 #elif INT_MAX >= 2147483647
1139  if (unlikely(size >= 10U)) {
1140  if (l->sign < 0) {
1141  s = "2147483648";
1142  } else {
1143  s = "2147483647";
1144  }
1145  if (size > 10U || memcmp (&l->data[i], s, (size_t)10) > 0) {
1146  cb_error (_ ("Numeric literal '%s' exceeds limit '%s'"), &l->data[i], s);
1147  return INT_MAX;
1148  }
1149  }
1150 #else
1151  if (unlikely(size >= 5U)) {
1152  if (l->sign < 0) {
1153  s = "32768";
1154  } else {
1155  s = "32767";
1156  }
1157  if (size == 5U || memcmp (&l->data[i], s, (size_t)5) > 0) {
1158  cb_error (_ ("Numeric literal '%s' exceeds limit '%s'"), &l->data[i], s);
1159  return INT_MAX;
1160  }
1161  }
1162 #endif
1163 
1164  val = 0;
1165  for (; i < l->size; i++) {
1166  val = val * 10 + l->data[i] - '0';
1167  }
1168  if (val && l->sign < 0) {
1169  val = -val;
1170  }
1171  return val;
1172 }
short sign
Definition: tree.h:597
void cobc_abort_pr(const char *fmt,...)
Definition: cobc.c:587
#define CB_LITERAL(x)
Definition: tree.h:601
#define CB_LITERAL_P(x)
Definition: tree.h:602
static void check_lit_length(const int size, const char *lit)
Definition: tree.c:1084
#define _(s)
Definition: cobcrun.c:59
#define unlikely(x)
Definition: common.h:437
#define COBC_ABORT()
Definition: cobc.h:61
unsigned char * data
Definition: tree.h:593
void cb_error(const char *,...) COB_A_FORMAT12
Definition: error.c:98
cob_u32_t size
Definition: tree.h:594

Here is the call graph for this function:

Here is the caller graph for this function:

cob_s64_t cb_get_long_long ( const cb_tree  x)

Definition at line 1175 of file tree.c.

References _, cb_error(), CB_LITERAL, CB_LITERAL_P, check_lit_length(), cob_s64_t, COBC_ABORT, cobc_abort_pr(), cb_literal::data, cb_literal::sign, cb_literal::size, and unlikely.

Referenced by cb_emit_call(), output_call(), output_call_by_value_args(), output_long_integer(), and validate_move().

1176 {
1177  struct cb_literal *l;
1178  const char *s;
1179  size_t i;
1180  size_t size;
1181  cob_s64_t val;
1182 
1183  if (!CB_LITERAL_P (x)) {
1184  cobc_abort_pr (_("Invalid literal cast - Aborting"));
1185  COBC_ABORT ();
1186  }
1187  l = CB_LITERAL (x);
1188 
1189  /* Skip leading zeroes */
1190  for (i = 0; i < l->size; i++) {
1191  if (l->data[i] != '0') {
1192  break;
1193  }
1194  }
1195 
1196  size = l->size - i;
1197  /* Check numeric literal length, postponed from scanner.l (scan_numeric) */
1198  check_lit_length(size, (const char *)l->data + i);
1199  /* Check numeric literal length matching requested output type */
1200  if (unlikely (size >= 19U)) {
1201  if (l->sign < 0) {
1202  s = "9223372036854775808";
1203  } else {
1204  s = "9223372036854775807";
1205  }
1206  if (size == 19U || memcmp (&(l->data[i]), s, (size_t)19) > 0) {
1207  cb_error (_ ("Numeric literal '%s' exceeds limit '%s'"), &l->data[i], s);
1208  return LLONG_MAX;
1209  }
1210  }
1211 
1212  val = 0;
1213  for (; i < l->size; i++) {
1214  val = val * 10 + (l->data[i] & 0x0F);
1215  }
1216  if (val && l->sign < 0) {
1217  val = -val;
1218  }
1219  return val;
1220 }
short sign
Definition: tree.h:597
void cobc_abort_pr(const char *fmt,...)
Definition: cobc.c:587
#define CB_LITERAL(x)
Definition: tree.h:601
#define cob_s64_t
Definition: common.h:51
#define CB_LITERAL_P(x)
Definition: tree.h:602
static void check_lit_length(const int size, const char *lit)
Definition: tree.c:1084
#define _(s)
Definition: cobcrun.c:59
#define unlikely(x)
Definition: common.h:437
#define COBC_ABORT()
Definition: cobc.h:61
unsigned char * data
Definition: tree.h:593
void cb_error(const char *,...) COB_A_FORMAT12
Definition: error.c:98
cob_u32_t size
Definition: tree.h:594

Here is the call graph for this function:

Here is the caller graph for this function:

cob_u64_t cb_get_u_long_long ( const cb_tree  x)

Definition at line 1223 of file tree.c.

References _, cb_error(), CB_LITERAL, check_lit_length(), cob_u64_t, cb_literal::data, cb_literal::size, and unlikely.

Referenced by output_call(), and output_call_by_value_args().

1224 {
1225  struct cb_literal *l;
1226  const char *s;
1227  size_t i;
1228  size_t size;
1229  cob_u64_t val;
1230 
1231  l = CB_LITERAL (x);
1232 
1233  /* Skip leading zeroes */
1234  for (i = 0; i < l->size; i++) {
1235  if (l->data[i] != '0') {
1236  break;
1237  }
1238  }
1239 
1240  size = l->size - i;
1241  /* Check numeric literal length, postponed from scanner.l (scan_numeric) */
1242  check_lit_length(size, (const char *)l->data + i);
1243  /* Check numeric literal length matching requested output type */
1244  if (unlikely(size >= 20U)) {
1245  s = "18446744073709551615";
1246  if (size == 20U || memcmp (&(l->data[i]), s, (size_t)20) > 0) {
1247  cb_error (_ ("Numeric literal '%s' exceeds limit '%s'"), &l->data[i], s);
1248  return ULLONG_MAX;
1249  }
1250  }
1251  val = 0;
1252  for (; i < l->size; i++) {
1253  val = val * 10 + (l->data[i] & 0x0F);
1254  }
1255  return val;
1256 }
#define CB_LITERAL(x)
Definition: tree.h:601
static void check_lit_length(const int size, const char *lit)
Definition: tree.c:1084
#define _(s)
Definition: cobcrun.c:59
#define unlikely(x)
Definition: common.h:437
unsigned char * data
Definition: tree.h:593
void cb_error(const char *,...) COB_A_FORMAT12
Definition: error.c:98
#define cob_u64_t
Definition: common.h:52
cob_u32_t size
Definition: tree.h:594

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_init_constants ( void  )

Definition at line 1259 of file tree.c.

References cb_build_numeric_literal(), CB_CATEGORY_ALPHANUMERIC, CB_CATEGORY_BOOLEAN, CB_CATEGORY_DATA_POINTER, CB_CATEGORY_NUMERIC, CB_CATEGORY_UNKNOWN, cb_const_subs, cb_high, cb_int(), CB_LABEL, cb_low, COB_MAX_SUBSCRIPTS, make_constant(), make_constant_label(), and NULL.

Referenced by process_translate().

1260 {
1261  int i;
1262 
1268  cb_zero = make_constant (CB_CATEGORY_NUMERIC, "&cob_all_zero");
1269  cb_space = make_constant (CB_CATEGORY_ALPHANUMERIC, "&cob_all_space");
1270  cb_low = make_constant (CB_CATEGORY_ALPHANUMERIC, "&cob_all_low");
1271  cb_norm_low = cb_low;
1272  cb_high = make_constant (CB_CATEGORY_ALPHANUMERIC, "&cob_all_high");
1274  cb_quote = make_constant (CB_CATEGORY_ALPHANUMERIC, "&cob_all_quote");
1275  cb_one = cb_build_numeric_literal (0, "1", 0);
1276  cb_int0 = cb_int (0);
1277  cb_int1 = cb_int (1);
1278  cb_int2 = cb_int (2);
1279  cb_int3 = cb_int (3);
1280  cb_int4 = cb_int (4);
1281  cb_int5 = cb_int (5);
1282  for (i = 0; i < COB_MAX_SUBSCRIPTS; i++) {
1284  }
1285  cb_standard_error_handler = make_constant_label ("Default Error Handler");
1286  CB_LABEL (cb_standard_error_handler)->flag_default_handler = 1;
1287  memset (container_progs, 0, sizeof(container_progs));
1288 }
cb_tree cb_true
Definition: tree.c:122
#define CB_LABEL(x)
Definition: tree.h:801
static struct cb_program * container_progs[64]
Definition: tree.c:91
cb_tree cb_int1
Definition: tree.c:134
cb_tree cb_norm_high
Definition: tree.c:131
cb_tree cb_norm_low
Definition: tree.c:130
cb_tree cb_zero
Definition: tree.c:125
cb_tree cb_i[16]
Definition: tree.c:139
cb_tree cb_false
Definition: tree.c:123
cb_tree cb_any
Definition: tree.c:121
cb_tree cb_quote
Definition: tree.c:132
cb_tree cb_space
Definition: tree.c:127
cb_tree cb_build_numeric_literal(const int sign, const void *data, const int scale)
Definition: tree.c:1681
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cb_tree cb_int4
Definition: tree.c:137
cb_tree cb_standard_error_handler
Definition: tree.c:144
static cb_tree make_constant_label(const char *name)
Definition: tree.c:249
cb_tree cb_int0
Definition: tree.c:133
cb_tree cb_one
Definition: tree.c:126
cb_tree cb_int3
Definition: tree.c:136
cb_tree cb_int(const int n)
Definition: tree.c:1488
cb_tree cb_error_node
Definition: tree.c:140
static cb_tree make_constant(const enum cb_category category, const char *val)
Definition: tree.c:239
cb_tree cb_int5
Definition: tree.c:138
cb_tree cb_null
Definition: tree.c:124
#define COB_MAX_SUBSCRIPTS
Definition: codegen.c:44
cb_tree cb_high
Definition: tree.c:129
static const char *const cb_const_subs[]
Definition: tree.c:92
cb_tree cb_low
Definition: tree.c:128
cb_tree cb_int2
Definition: tree.c:135

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_insert_common_prog ( struct cb_program prog,
struct cb_program comprog 
)

Definition at line 1479 of file tree.c.

References add_contained_prog(), and cb_program::nested_prog_list.

Referenced by process_translate().

1480 {
1482  comprog);
1483 }
static struct nested_list * add_contained_prog(struct nested_list *parent_list, struct cb_program *child_prog)
Definition: tree.c:1383
struct nested_list * nested_prog_list
Definition: tree.h:1249

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_int ( const int  n)

Definition at line 1488 of file tree.c.

References cb_tree_common::category, CB_CATEGORY_NUMERIC, CB_TAG_INTEGER, CB_TREE, cobc_main_malloc(), cb_integer::common, int_node_table, int_node::n, int_node::next, int_node::node, cb_tree_common::tag, and cb_integer::val.

Referenced by build_store_option(), cb_build_cond(), cb_build_identifier(), cb_build_length_1(), cb_build_memset(), cb_build_move_literal(), cb_build_optim_cond(), cb_build_write_advancing_lines(), cb_check_field_debug(), cb_define_switch_name(), cb_emit_accept(), cb_emit_accept_line_or_col(), cb_emit_open(), cb_emit_read(), cb_emit_rewrite(), cb_emit_set_on_off(), cb_emit_sort_init(), cb_emit_unstring(), cb_emit_write(), cb_gen_field_accept(), cb_init_constants(), cb_int_hex(), emit_field_display(), and yyparse().

1489 {
1490  struct cb_integer *x;
1491  struct int_node *p;
1492 
1493  for (p = int_node_table; p; p = p->next) {
1494  if (p->n == n) {
1495  return p->node;
1496  }
1497  }
1498 
1499  /* Do not use make_tree here */
1500  x = cobc_main_malloc (sizeof (struct cb_integer));
1501  x->common.tag = CB_TAG_INTEGER;
1503  x->val = n;
1504 
1505  p = cobc_main_malloc (sizeof (struct int_node));
1506  p->n = n;
1507  p->node = CB_TREE (x);
1508  p->next = int_node_table;
1509  int_node_table = p;
1510  return CB_TREE (x);
1511 }
#define CB_TREE(x)
Definition: tree.h:440
void * cobc_main_malloc(const size_t size)
Definition: cobc.c:702
int n
Definition: tree.c:81
cb_tree node
Definition: tree.c:80
enum cb_category category
Definition: tree.h:430
int val
Definition: tree.h:518
struct cb_tree_common common
Definition: tree.h:517
struct int_node * next
Definition: tree.c:79
static struct int_node * int_node_table
Definition: tree.c:84
enum cb_tag tag
Definition: tree.h:429
Definition: tree.c:78

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_int_hex ( const int  n)

Definition at line 1514 of file tree.c.

References cb_int(), and CB_INTEGER.

Referenced by cb_build_write_advancing_lines(), cb_build_write_advancing_mnemonic(), cb_build_write_advancing_page(), and cb_emit_write().

1515 {
1516  cb_tree x;
1517 
1518  x = cb_int (n);
1519  CB_INTEGER (x)->hexval = 1;
1520  return x;
1521 }
#define CB_INTEGER(x)
Definition: tree.h:522
int n
Definition: tree.c:81
cb_tree cb_int(const int n)
Definition: tree.c:1488

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_list_append ( cb_tree  l1,
cb_tree  l2 
)

Definition at line 1305 of file tree.c.

References CB_CHAIN, get_last_elt(), and NULL.

Referenced by build_decimal_assign(), cb_build_alter(), cb_list_add(), cb_pair_add(), emit_entry(), and yyparse().

1306 {
1307  if (l1 == NULL) {
1308  return l2;
1309  }
1310  CB_CHAIN (get_last_elt (l1)) = l2;
1311  return l1;
1312 }
static cb_tree get_last_elt(cb_tree l)
Definition: tree.c:591
#define CB_CHAIN(x)
Definition: tree.h:1194
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95

Here is the call graph for this function:

Here is the caller graph for this function:

int cb_list_length ( cb_tree  l)

Definition at line 1342 of file tree.c.

References CB_CHAIN.

Referenced by cb_build_address(), cb_build_identifier(), cb_build_intrinsic(), cb_emit_call(), cb_emit_display(), cb_emit_move(), cb_emit_sort_giving(), cb_emit_sort_init(), cb_emit_unstring(), contains_only_screen_field(), output_error_handler(), output_internal_function(), output_param(), and yyparse().

1343 {
1344  int n;
1345 
1346  if (l == cb_error_node) {
1347  return 0;
1348  }
1349  n = 0;
1350  for (; l; l = CB_CHAIN (l)) {
1351  n++;
1352  }
1353  return n;
1354 }
int n
Definition: tree.c:81
#define CB_CHAIN(x)
Definition: tree.h:1194
cb_tree cb_error_node
Definition: tree.c:140

Here is the caller graph for this function:

void cb_list_map ( cb_tree(*)(cb_tree x)  func,
cb_tree  l 
)

Definition at line 1357 of file tree.c.

References CB_CHAIN, and CB_VALUE.

Referenced by cb_emit_arithmetic().

1358 {
1359  for (; l; l = CB_CHAIN (l)) {
1360  CB_VALUE (l) = func (CB_VALUE (l));
1361  }
1362 }
#define CB_VALUE(x)
Definition: tree.h:1193
#define CB_CHAIN(x)
Definition: tree.h:1194

Here is the caller graph for this function:

cb_tree cb_list_reverse ( cb_tree  l)

Definition at line 1327 of file tree.c.

References CB_CHAIN, and NULL.

Referenced by build_decimal_assign(), cb_build_cond(), cb_build_identifier(), cb_check_field_debug(), cb_emit_search(), cb_name_1(), cb_validate_program_body(), cb_validate_program_data(), process_translate(), and yyparse().

1328 {
1329  cb_tree next;
1330  cb_tree last;
1331 
1332  last = NULL;
1333  for (; l; l = next) {
1334  next = CB_CHAIN (l);
1335  CB_CHAIN (l) = last;
1336  last = l;
1337  }
1338  return last;
1339 }
struct int_node * next
Definition: tree.c:79
#define CB_CHAIN(x)
Definition: tree.h:1194
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95

Here is the caller graph for this function:

static size_t cb_name_1 ( char *  s,
cb_tree  x 
)
static

Definition at line 259 of file tree.c.

References _, cb_funcall::argc, cb_funcall::argv, CB_ALPHABET_NAME, CB_BINARY_OP, CB_CHAIN, CB_CLASS_NAME, CB_CLASS_NUMERIC, CB_FIELD, CB_FILE, CB_FUNCALL, CB_INTRINSIC, CB_LABEL, cb_list_reverse(), CB_LITERAL, CB_LOCALE_NAME, CB_REFERENCE, CB_TAG_ALPHABET_NAME, CB_TAG_BINARY_OP, CB_TAG_CLASS_NAME, CB_TAG_CONST, CB_TAG_FIELD, CB_TAG_FILE, CB_TAG_FUNCALL, CB_TAG_INTRINSIC, CB_TAG_LABEL, CB_TAG_LITERAL, CB_TAG_LOCALE_NAME, CB_TAG_REFERENCE, CB_TREE_CLASS, CB_TREE_TAG, CB_VALUE, cb_reference::chain, cb_field::flag_filler, cb_reference::flag_filler_ref, cb_intrinsic::intr_tab, cb_intrinsic::isuser, cb_reference::length, cb_field::name, cb_word::name, cb_funcall::name, cb_intrinsic_table::name, cb_intrinsic::name, cb_reference::offset, cb_binary_op::op, cb_reference::subs, cb_reference::word, cb_binary_op::x, and cb_binary_op::y.

Referenced by cb_name().

260 {
261  char *orig;
262  struct cb_funcall *cbip;
263  struct cb_binary_op *cbop;
264  struct cb_reference *p;
265  struct cb_field *f;
266  struct cb_intrinsic *cbit;
267  cb_tree l;
268  int i;
269 
270  orig = s;
271  if (!x) {
272  strcpy (s, "(void pointer)");
273  return strlen (orig);
274  }
275  switch (CB_TREE_TAG (x)) {
276  case CB_TAG_CONST:
277  if (x == cb_any) {
278  strcpy (s, "ANY");
279  } else if (x == cb_true) {
280  strcpy (s, "TRUE");
281  } else if (x == cb_false) {
282  strcpy (s, "FALSE");
283  } else if (x == cb_null) {
284  strcpy (s, "NULL");
285  } else if (x == cb_zero) {
286  strcpy (s, "ZERO");
287  } else if (x == cb_space) {
288  strcpy (s, "SPACE");
289  } else if (x == cb_low || x == cb_norm_low) {
290  strcpy (s, "LOW-VALUE");
291  } else if (x == cb_high || x == cb_norm_high) {
292  strcpy (s, "HIGH-VALUE");
293  } else if (x == cb_quote) {
294  strcpy (s, "QUOTE");
295  } else if (x == cb_error_node) {
296  strcpy (s, _("Internal error node"));
297  } else {
298  strcpy (s, _("Unknown constant"));
299  }
300  break;
301 
302  case CB_TAG_LITERAL:
303  if (CB_TREE_CLASS (x) == CB_CLASS_NUMERIC) {
304  strcpy (s, (char *)CB_LITERAL (x)->data);
305  } else {
306  sprintf (s, "\"%s\"", (char *)CB_LITERAL (x)->data);
307  }
308  break;
309 
310  case CB_TAG_FIELD:
311  f = CB_FIELD (x);
312  if (f->flag_filler) {
313  strcpy (s, "FILLER");
314  } else {
315  strcpy (s, f->name);
316  }
317  break;
318 
319  case CB_TAG_REFERENCE:
320  p = CB_REFERENCE (x);
321  if (p->flag_filler_ref) {
322  s += sprintf (s, "FILLER");
323  } else {
324  s += sprintf (s, "%s", p->word->name);
325  }
326  if (p->subs) {
327  s += sprintf (s, " (");
328  p->subs = cb_list_reverse (p->subs);
329  for (l = p->subs; l; l = CB_CHAIN (l)) {
330  s += cb_name_1 (s, CB_VALUE (l));
331  s += sprintf (s, CB_CHAIN (l) ? ", " : ")");
332  }
333  p->subs = cb_list_reverse (p->subs);
334  }
335  if (p->offset) {
336  s += sprintf (s, " (");
337  s += cb_name_1 (s, p->offset);
338  s += sprintf (s, ":");
339  if (p->length) {
340  s += cb_name_1 (s, p->length);
341  }
342  strcpy (s, ")");
343  }
344  if (p->chain) {
345  s += sprintf (s, " in ");
346  s += cb_name_1 (s, p->chain);
347  }
348  break;
349 
350  case CB_TAG_LABEL:
351  sprintf (s, "%s", (char *)(CB_LABEL (x)->name));
352  break;
353 
355  sprintf (s, "%s", CB_ALPHABET_NAME (x)->name);
356  break;
357 
358  case CB_TAG_CLASS_NAME:
359  sprintf (s, "%s", CB_CLASS_NAME (x)->name);
360  break;
361 
362  case CB_TAG_LOCALE_NAME:
363  sprintf (s, "%s", CB_LOCALE_NAME (x)->name);
364  break;
365 
366  case CB_TAG_BINARY_OP:
367  cbop = CB_BINARY_OP (x);
368  if (cbop->op == '@') {
369  s += sprintf (s, "(");
370  s += cb_name_1 (s, cbop->x);
371  s += sprintf (s, ")");
372  } else if (cbop->op == '!') {
373  s += sprintf (s, "!");
374  s += cb_name_1 (s, cbop->x);
375  } else {
376  s += sprintf (s, "(");
377  s += cb_name_1 (s, cbop->x);
378  s += sprintf (s, " %c ", cbop->op);
379  s += cb_name_1 (s, cbop->y);
380  strcpy (s, ")");
381  }
382  break;
383 
384  case CB_TAG_FUNCALL:
385  cbip = CB_FUNCALL (x);
386  s += sprintf (s, "%s", cbip->name);
387  for (i = 0; i < cbip->argc; i++) {
388  s += sprintf (s, (i == 0) ? "(" : ", ");
389  s += cb_name_1 (s, cbip->argv[i]);
390  }
391  s += sprintf (s, ")");
392  break;
393 
394  case CB_TAG_INTRINSIC:
395  cbit = CB_INTRINSIC (x);
396  if (cbit->isuser) {
397  sprintf (s, "USER FUNCTION");
398  } else {
399  sprintf (s, "FUNCTION %s", cbit->intr_tab->name);
400  }
401  break;
402  case CB_TAG_FILE:
403  sprintf (s, "FILE %s", CB_FILE (x)->name);
404  break;
405  default:
406  sprintf (s, _("<Unexpected tree tag %d>"), (int)CB_TREE_TAG (x));
407  }
408 
409  return strlen (orig);
410 }
const char * name
Definition: tree.h:645
cb_tree cb_true
Definition: tree.c:122
#define CB_LABEL(x)
Definition: tree.h:801
const char * name
Definition: tree.h:979
unsigned int flag_filler
Definition: tree.h:714
cb_tree cb_norm_high
Definition: tree.c:131
int isuser
Definition: tree.h:998
#define CB_LITERAL(x)
Definition: tree.h:601
#define CB_INTRINSIC(x)
Definition: tree.h:1001
unsigned int flag_filler_ref
Definition: tree.h:897
cb_tree cb_norm_low
Definition: tree.c:130
const char * name
Definition: tree.h:943
int argc
Definition: tree.h:945
cb_tree cb_zero
Definition: tree.c:125
cb_tree cb_false
Definition: tree.c:123
cb_tree cb_any
Definition: tree.c:121
cb_tree cb_quote
Definition: tree.c:132
cb_tree cb_space
Definition: tree.c:127
#define CB_FILE(x)
Definition: tree.h:858
#define CB_FUNCALL(x)
Definition: tree.h:951
#define CB_VALUE(x)
Definition: tree.h:1193
const char * name
Definition: tree.h:865
#define CB_TREE_CLASS(x)
Definition: tree.h:442
struct cb_intrinsic_table * intr_tab
Definition: tree.h:995
cb_tree chain
Definition: tree.h:875
#define CB_ALPHABET_NAME(x)
Definition: tree.h:550
#define _(s)
Definition: cobcrun.c:59
#define CB_LOCALE_NAME(x)
Definition: tree.h:574
Definition: tree.h:643
#define CB_CHAIN(x)
Definition: tree.h:1194
int op
Definition: tree.h:932
#define CB_TREE_TAG(x)
Definition: tree.h:441
cb_tree offset
Definition: tree.h:878
#define CB_REFERENCE(x)
Definition: tree.h:901
cb_tree cb_error_node
Definition: tree.c:140
cb_tree y
Definition: tree.h:931
cb_tree cb_null
Definition: tree.c:124
cb_tree cb_high
Definition: tree.c:129
cb_tree x
Definition: tree.h:930
cb_tree argv[11]
Definition: tree.h:944
#define CB_BINARY_OP(x)
Definition: tree.h:936
cb_tree subs
Definition: tree.h:877
static size_t cb_name_1(char *s, cb_tree x)
Definition: tree.c:259
#define CB_CLASS_NAME(x)
Definition: tree.h:562
cb_tree length
Definition: tree.h:879
cb_tree cb_list_reverse(cb_tree l)
Definition: tree.c:1327
cb_tree name
Definition: tree.h:992
cb_tree cb_low
Definition: tree.c:128
#define CB_FIELD(x)
Definition: tree.h:740
struct cb_word * word
Definition: tree.h:881

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_pair_add ( cb_tree  l,
cb_tree  x,
cb_tree  y 
)

Definition at line 1321 of file tree.c.

References CB_BUILD_PAIR, and cb_list_append().

1322 {
1323  return cb_list_append (l, CB_BUILD_PAIR (x, y));
1324 }
cb_tree cb_list_append(cb_tree l1, cb_tree l2)
Definition: tree.c:1305
#define CB_BUILD_PAIR(x, y)
Definition: tree.h:1853

Here is the call graph for this function:

cb_tree cb_ref ( cb_tree  x)

Definition at line 2653 of file tree.c.

References ambiguous_error(), CB_CHAIN, cb_error_node, CB_FIELD, cb_field_founder(), CB_FIELD_P, CB_FILE, CB_FILE_P, CB_INVALID_TREE, CB_LABEL, CB_LABEL_P, CB_NAME, cb_ref(), CB_REFERENCE, CB_TAG_FIELD, CB_TAG_LABEL, CB_TREE_TAG, CB_VALUE, CB_WORD_COUNT, cb_reference::chain, current_program, cb_word::error, file, cb_reference::flag_alter_code, cb_program::flag_gen_error, global_check(), cb_reference::hashval, cb_word::items, likely, cb_field::name, cb_label::name, cb_word::name, cb_program::nested_level, cb_word::next, cb_program::next_program, NULL, cb_reference::offset, cb_field::parent, undefined_error(), cb_reference::value, cb_reference::word, and cb_program::word_table.

Referenced by cb_build_address(), cb_build_binary_op(), cb_build_cond(), cb_build_const_length(), cb_build_display_mnemonic(), cb_build_expr(), cb_build_identifier(), cb_build_length(), cb_build_length_1(), cb_build_perform_varying(), cb_build_ppointer(), cb_build_write_advancing_mnemonic(), cb_check_field_debug(), cb_check_group_name(), cb_check_integer_value(), cb_check_numeric_edited_name(), cb_check_numeric_name(), cb_emit_accept(), cb_emit_accept_mnemonic(), cb_emit_close(), cb_emit_delete(), cb_emit_delete_file(), cb_emit_display(), cb_emit_open(), cb_emit_read(), cb_emit_release(), cb_emit_return(), cb_emit_rewrite(), cb_emit_set_attribute(), cb_emit_set_on_off(), cb_emit_set_to(), cb_emit_sort_finish(), cb_emit_sort_giving(), cb_emit_sort_init(), cb_emit_sort_using(), cb_emit_start(), cb_emit_unlock(), cb_emit_write(), cb_ref(), cb_validate_collating(), cb_validate_one(), cb_validate_program_body(), cb_validate_program_data(), cb_validate_program_environment(), check_for_duplicate_prototype(), check_not_88_level(), check_valid_key(), emit_default_displays_for_x_list(), emit_entry(), finalize_file(), global_check(), is_screen_field(), output(), output_call(), output_goto(), output_goto_1(), output_module_init(), output_param(), output_perform(), output_perform_once(), output_perform_until(), output_search_whens(), validate_inspect(), and yyparse().

2654 {
2655  struct cb_reference *r;
2656  struct cb_field *p;
2657  struct cb_label *s;
2658  cb_tree candidate;
2659  cb_tree items;
2660  cb_tree cb1;
2661  cb_tree cb2;
2662  cb_tree v;
2663  cb_tree c;
2664  struct cb_program *prog;
2665  struct cb_word *w;
2666  size_t val;
2667  size_t ambiguous;
2668 
2669  if (CB_INVALID_TREE (x)) {
2670  return cb_error_node;
2671  }
2672  r = CB_REFERENCE (x);
2673  /* If this reference has already been resolved (and the value
2674  has been cached), then just return the value */
2675  if (r->value) {
2676  return r->value;
2677  }
2678 
2679  /* Resolve the value */
2680 
2681  candidate = NULL;
2682  ambiguous = 0;
2683  items = r->word->items;
2684  for (; items; items = CB_CHAIN (items)) {
2685  /* Find a candidate value by resolving qualification */
2686  v = CB_VALUE (items);
2687  c = r->chain;
2688  switch (CB_TREE_TAG (v)) {
2689  case CB_TAG_FIELD:
2690  /* In case the value is a field, it might be qualified
2691  by its parent names and a file name */
2692  if (CB_FIELD (v)->flag_indexed_by) {
2693  p = CB_FIELD (v)->index_qual;
2694  } else {
2695  p = CB_FIELD (v)->parent;
2696  }
2697  /* Resolve by parents */
2698  for (; p; p = p->parent) {
2699  if (c && strcasecmp (CB_NAME (c), p->name) == 0) {
2700  c = CB_REFERENCE (c)->chain;
2701  }
2702  }
2703 
2704  /* Resolve by file */
2705  if (c && CB_REFERENCE (c)->chain == NULL) {
2706  if (CB_WORD_COUNT (c) == 1 &&
2707  CB_FILE_P (cb_ref (c)) &&
2708  (CB_FILE (cb_ref (c)) == cb_field_founder (CB_FIELD (v))->file)) {
2709  c = CB_REFERENCE (c)->chain;
2710  }
2711  }
2712 
2713  break;
2714  case CB_TAG_LABEL:
2715  /* In case the value is a label, it might be qualified
2716  by its section name */
2717  s = CB_LABEL (v)->section;
2718 
2719  /* Unqualified paragraph name referenced within the section
2720  is resolved without ambiguity check if not duplicated */
2721  if (c == NULL && r->offset && s == CB_LABEL (r->offset)) {
2722  for (cb1 = CB_CHAIN (items); cb1; cb1 = CB_CHAIN (cb1)) {
2723  cb2 = CB_VALUE (cb1);
2724  if (s == CB_LABEL (cb2)->section) {
2725  ambiguous_error (x);
2726  goto error;
2727  }
2728  }
2729  candidate = v;
2730  goto end;
2731  }
2732 
2733  /* Resolve by section name */
2734  if (c && s && strcasecmp (CB_NAME (c), (char *)s->name) == 0) {
2735  c = CB_REFERENCE (c)->chain;
2736  }
2737 
2738  break;
2739  default:
2740  /* Other values cannot be qualified */
2741  break;
2742  }
2743 
2744  /* A well qualified value is a good candidate */
2745  if (c == NULL) {
2746  if (candidate == NULL) {
2747  /* Keep the first candidate */
2748  candidate = v;
2749  } else {
2750  /* Multiple candidates and possibly ambiguous */
2751  ambiguous = 1;
2752  /* Continue search because the reference might not
2753  be ambiguous and exit loop by "goto end" later */
2754  }
2755  }
2756  }
2757 
2758  /* There is no candidate */
2759  if (candidate == NULL) {
2760  if (likely(current_program->nested_level <= 0)) {
2761  goto undef_error;
2762  }
2763  /* Nested program - check parents for GLOBAL candidate */
2764  ambiguous = 0;
2765 /* RXWRXW
2766  val = hash ((const unsigned char *)r->word->name);
2767 */
2768  val = r->hashval;
2769  prog = current_program->next_program;
2770  for (; prog; prog = prog->next_program) {
2771  if (prog->nested_level >= current_program->nested_level) {
2772  continue;
2773  }
2774  for (w = prog->word_table[val]; w; w = w->next) {
2775  if (strcasecmp (r->word->name, w->name) == 0) {
2776  candidate = global_check (r, w->items, &ambiguous);
2777  if (candidate) {
2778  if (ambiguous) {
2779  ambiguous_error (x);
2780  goto error;
2781  }
2782  if (CB_FILE_P(candidate)) {
2784  }
2785  goto end;
2786  }
2787  }
2788  }
2789  if (prog->nested_level == 0) {
2790  break;
2791  }
2792  }
2793  goto undef_error;
2794  }
2795 
2796  /* Reference is ambiguous */
2797  if (ambiguous) {
2798  ambiguous_error (x);
2799  goto error;
2800  }
2801 
2802 end:
2803  if (CB_FIELD_P (candidate)) {
2804  CB_FIELD (candidate)->count++;
2805  if (CB_FIELD (candidate)->flag_invalid) {
2806  goto error;
2807  }
2808  } else if (CB_LABEL_P (candidate) && r->flag_alter_code) {
2809  CB_LABEL (candidate)->flag_alter = 1;
2810  }
2811 
2812  r->value = candidate;
2813  return r->value;
2814 
2815 undef_error:
2816  undefined_error (x);
2817  /* Fall through */
2818 
2819 error:
2820  r->value = cb_error_node;
2821  return cb_error_node;
2822 }
const char * name
Definition: tree.h:645
#define CB_LABEL(x)
Definition: tree.h:801
const char * name
Definition: tree.h:766
cb_tree value
Definition: tree.h:876
cb_tree cb_ref(cb_tree x)
Definition: tree.c:2653
int nested_level
Definition: tree.h:1295
static cb_tree global_check(struct cb_reference *r, cb_tree items, size_t *ambiguous)
Definition: tree.c:453
#define CB_LABEL_P(x)
Definition: tree.h:802
#define CB_FILE(x)
Definition: tree.h:858
if fold fold static computed alternate extra correct stack on syntax debugging source implicit stack syntax write single recursive relax optional file
Definition: flag.def:129
#define CB_VALUE(x)
Definition: tree.h:1193
const char * name
Definition: tree.h:865
size_t hashval
Definition: tree.h:885
void ambiguous_error(cb_tree x)
Definition: error.c:341
cb_tree chain
Definition: tree.h:875
#define CB_FIELD_P(x)
Definition: tree.h:741
Definition: tree.h:643
struct cb_word * next
Definition: tree.h:864
#define CB_CHAIN(x)
Definition: tree.h:1194
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_TREE_TAG(x)
Definition: tree.h:441
cb_tree offset
Definition: tree.h:878
int error
Definition: tree.h:868
struct cb_program * next_program
Definition: tree.h:1242
#define CB_NAME(x)
Definition: tree.h:904
#define CB_REFERENCE(x)
Definition: tree.h:901
void undefined_error(cb_tree x)
Definition: error.c:317
cb_tree items
Definition: tree.h:866
#define CB_FILE_P(x)
Definition: tree.h:859
cb_tree cb_error_node
Definition: tree.c:140
struct cb_field * parent
Definition: tree.h:651
#define CB_INVALID_TREE(x)
Definition: tree.h:446
struct cb_word ** word_table
Definition: tree.h:1247
struct cb_program * current_program
Definition: parser.c:168
unsigned int flag_alter_code
Definition: tree.h:891
#define CB_WORD_COUNT(x)
Definition: tree.h:905
Definition: tree.h:764
Definition: tree.h:863
unsigned int flag_gen_error
Definition: tree.h:1314
#define likely(x)
Definition: common.h:436
struct cb_field * cb_field_founder(const struct cb_field *f)
Definition: tree.c:2227
#define CB_FIELD(x)
Definition: tree.h:740
struct cb_word * word
Definition: tree.h:881

Here is the call graph for this function:

void cb_set_system_names ( void  )

Definition at line 2637 of file tree.c.

References cb_define_system_name().

Referenced by yyparse().

2638 {
2639  cb_define_system_name ("CONSOLE");
2640  cb_define_system_name ("SYSIN");
2641  cb_define_system_name ("SYSIPT");
2642  cb_define_system_name ("STDIN");
2643  cb_define_system_name ("SYSOUT");
2644  cb_define_system_name ("STDOUT");
2645  cb_define_system_name ("SYSERR");
2646  cb_define_system_name ("STDERR");
2647  cb_define_system_name ("SYSLST");
2648  cb_define_system_name ("SYSLIST");
2649  cb_define_system_name ("FORMFEED");
2650 }
static void cb_define_system_name(const char *name)
Definition: tree.c:2621

Here is the call graph for this function:

Here is the caller graph for this function:

char* cb_to_cname ( const char *  s)

Definition at line 705 of file tree.c.

References cob_u8_t, cobc_parse_strdup(), and copy.

Referenced by build_file(), build_report(), cb_build_alphabet_name(), cb_build_class_name(), cb_build_locale_name(), and yyparse().

706 {
707  char *copy;
708  unsigned char *p;
709 
710  copy = cobc_parse_strdup (s);
711  for (p = (unsigned char *)copy; *p; p++) {
712  if (*p == '-' || *p == ' ') {
713  *p = '_';
714  } else {
715  *p = (cob_u8_t)toupper (*p);
716  }
717  }
718  return copy;
719 }
if fold copy
Definition: flag.def:45
void * cobc_parse_strdup(const char *dupstr)
Definition: cobc.c:827
#define cob_u8_t
Definition: common.h:27

Here is the call graph for this function:

Here is the caller graph for this function:

enum cb_category cb_tree_category ( cb_tree  x)

Definition at line 745 of file tree.c.

References _, cb_cast::cast_type, cb_tree_common::category, cb_picture::category, CB_CAST, CB_CAST_ADDR_OF_ADDR, CB_CAST_ADDRESS, CB_CAST_PROGRAM_POINTER, CB_CATEGORY_ALPHANUMERIC, CB_CATEGORY_BOOLEAN, CB_CATEGORY_DATA_POINTER, CB_CATEGORY_PROGRAM_POINTER, CB_CATEGORY_UNKNOWN, CB_FIELD, CB_INTRINSIC, CB_REFERENCE, CB_TAG_ALPHABET_NAME, CB_TAG_BINARY_OP, CB_TAG_CAST, CB_TAG_FIELD, CB_TAG_INTRINSIC, CB_TAG_LOCALE_NAME, CB_TAG_REFERENCE, CB_TREE, cb_tree_category(), CB_TREE_TAG, CB_USAGE_POINTER, CB_USAGE_PROGRAM_POINTER, cb_field::children, COBC_ABORT, cobc_abort_pr(), cb_field::level, cb_reference::offset, cb_field::pic, cb_field::redefines, cb_field::rename_thru, cb_field::usage, and cb_reference::value.

Referenced by cb_build_constant(), cb_build_intrinsic(), cb_tree_category(), and yyparse().

746 {
747  struct cb_cast *p;
748  struct cb_reference *r;
749  struct cb_field *f;
750 
751  if (x == cb_error_node) {
752  return (enum cb_category)0;
753  }
754  if (x->category != CB_CATEGORY_UNKNOWN) {
755  return x->category;
756  }
757 
758  switch (CB_TREE_TAG (x)) {
759  case CB_TAG_CAST:
760  p = CB_CAST (x);
761  switch (p->cast_type) {
762  case CB_CAST_ADDRESS:
765  break;
768  break;
769  default:
770  cobc_abort_pr (_("Unexpected cast type -> %d"),
771  (int)(p->cast_type));
772  COBC_ABORT ();
773  }
774  break;
775  case CB_TAG_REFERENCE:
776  r = CB_REFERENCE (x);
777  if (r->offset) {
779  } else {
780  x->category = cb_tree_category (r->value);
781  }
782  break;
783  case CB_TAG_FIELD:
784  f = CB_FIELD (x);
785  if (f->children) {
787  } else if (f->usage == CB_USAGE_POINTER && f->level != 88) {
789  } else if (f->usage == CB_USAGE_PROGRAM_POINTER && f->level != 88) {
791  } else {
792  switch (f->level) {
793  case 66:
794  if (f->rename_thru) {
796  } else {
798  }
799  break;
800  case 88:
802  break;
803  default:
804  if (f->pic) {
805  x->category = f->pic->category;
806  } else {
807  x->category = (enum cb_category)0;
808  }
809  break;
810  }
811  }
812  break;
814  case CB_TAG_LOCALE_NAME:
816  break;
817  case CB_TAG_BINARY_OP:
819  break;
820  case CB_TAG_INTRINSIC:
821  x->category = CB_INTRINSIC(x)->intr_tab->category;
822  break;
823  default:
824 #if 0 /* RXWRXW - Tree tag */
825  cobc_abort_pr (_("Unknown tree tag %d Category %d"),
826  (int)CB_TREE_TAG (x), (int)x->category);
827  COBC_ABORT ();
828 #endif
829  return CB_CATEGORY_UNKNOWN;
830  }
831 
832  return x->category;
833 }
#define CB_TREE(x)
Definition: tree.h:440
void cobc_abort_pr(const char *fmt,...)
Definition: cobc.c:587
struct cb_field * children
Definition: tree.h:652
#define CB_INTRINSIC(x)
Definition: tree.h:1001
cb_tree value
Definition: tree.h:876
#define CB_CAST(x)
Definition: tree.h:962
struct cb_picture * pic
Definition: tree.h:659
cb_category
Definition: tree.h:226
enum cb_category cb_tree_category(cb_tree x)
Definition: tree.c:745
enum cb_category category
Definition: tree.h:430
int level
Definition: tree.h:673
enum cb_category category
Definition: tree.h:624
#define _(s)
Definition: cobcrun.c:59
Definition: tree.h:643
#define CB_TREE_TAG(x)
Definition: tree.h:441
cb_tree offset
Definition: tree.h:878
#define COBC_ABORT()
Definition: cobc.h:61
#define CB_REFERENCE(x)
Definition: tree.h:901
Definition: tree.h:956
struct cb_field * rename_thru
Definition: tree.h:655
cb_tree cb_error_node
Definition: tree.c:140
enum cb_cast_type cast_type
Definition: tree.h:959
struct cb_field * redefines
Definition: tree.h:654
enum cb_usage usage
Definition: tree.h:693
#define CB_FIELD(x)
Definition: tree.h:740

Here is the call graph for this function:

Here is the caller graph for this function:

enum cb_class cb_tree_class ( cb_tree  x)

Definition at line 836 of file tree.c.

References category_to_class_table, and CB_TREE_CATEGORY.

Referenced by cb_emit_set_to().

837 {
838 
840 }
#define CB_TREE_CATEGORY(x)
Definition: tree.h:443
static enum cb_class category_to_class_table[]
Definition: tree.c:46

Here is the caller graph for this function:

int cb_tree_type ( const cb_tree  x,
const struct cb_field f 
)

Definition at line 849 of file tree.c.

References _, CB_CATEGORY_ALPHABETIC, CB_CATEGORY_ALPHANUMERIC, CB_CATEGORY_ALPHANUMERIC_EDITED, CB_CATEGORY_DATA_POINTER, CB_CATEGORY_NUMERIC, CB_CATEGORY_NUMERIC_EDITED, CB_CATEGORY_OBJECT_REFERENCE, CB_CATEGORY_PROGRAM_POINTER, CB_TREE_CATEGORY, CB_USAGE_BINARY, CB_USAGE_COMP_5, CB_USAGE_COMP_6, CB_USAGE_COMP_X, CB_USAGE_DISPLAY, CB_USAGE_DOUBLE, CB_USAGE_FLOAT, CB_USAGE_FP_BIN128, CB_USAGE_FP_BIN32, CB_USAGE_FP_BIN64, CB_USAGE_FP_DEC128, CB_USAGE_FP_DEC64, CB_USAGE_INDEX, CB_USAGE_LENGTH, CB_USAGE_LONG_DOUBLE, CB_USAGE_PACKED, cb_field::children, COB_TYPE_ALPHANUMERIC, COB_TYPE_ALPHANUMERIC_EDITED, COB_TYPE_GROUP, COB_TYPE_NUMERIC_BINARY, COB_TYPE_NUMERIC_DISPLAY, COB_TYPE_NUMERIC_DOUBLE, COB_TYPE_NUMERIC_EDITED, COB_TYPE_NUMERIC_FLOAT, COB_TYPE_NUMERIC_FP_BIN128, COB_TYPE_NUMERIC_FP_BIN32, COB_TYPE_NUMERIC_FP_BIN64, COB_TYPE_NUMERIC_FP_DEC128, COB_TYPE_NUMERIC_FP_DEC64, COB_TYPE_NUMERIC_L_DOUBLE, COB_TYPE_NUMERIC_PACKED, COBC_ABORT, cobc_abort_pr(), COBC_DUMB_ABORT, and cb_field::usage.

Referenced by initialize_type(), initialize_uniform_char(), and output_attr().

850 {
851  if (f->children) {
852  return COB_TYPE_GROUP;
853  }
854 
855  switch (CB_TREE_CATEGORY (x)) {
858  return COB_TYPE_ALPHANUMERIC;
861  case CB_CATEGORY_NUMERIC:
862  switch (f->usage) {
863  case CB_USAGE_DISPLAY:
865  case CB_USAGE_BINARY:
866  case CB_USAGE_COMP_5:
867  case CB_USAGE_COMP_X:
868  case CB_USAGE_INDEX:
869  case CB_USAGE_LENGTH:
871  case CB_USAGE_FLOAT:
872  return COB_TYPE_NUMERIC_FLOAT;
873  case CB_USAGE_DOUBLE:
875  case CB_USAGE_PACKED:
876  case CB_USAGE_COMP_6:
880  case CB_USAGE_FP_BIN32:
882  case CB_USAGE_FP_BIN64:
884  case CB_USAGE_FP_BIN128:
886  case CB_USAGE_FP_DEC64:
888  case CB_USAGE_FP_DEC128:
890  default:
891  cobc_abort_pr (_("Unexpected numeric usage -> %d"),
892  (int)f->usage);
893  COBC_ABORT ();
894  }
901  default:
902  cobc_abort_pr (_("Unexpected category -> %d"),
903  (int)CB_TREE_CATEGORY (x));
904  /* Use dumb variant */
905  COBC_DUMB_ABORT ();
906  }
907  /* NOT REACHED */
908 #ifndef _MSC_VER
909  return 0;
910 #endif
911 }
#define CB_TREE_CATEGORY(x)
Definition: tree.h:443
void cobc_abort_pr(const char *fmt,...)
Definition: cobc.c:587
#define COB_TYPE_NUMERIC_PACKED
Definition: common.h:609
struct cb_field * children
Definition: tree.h:652
#define COB_TYPE_ALPHANUMERIC
Definition: common.h:621
#define COB_TYPE_NUMERIC_FP_BIN32
Definition: common.h:615
#define COB_TYPE_GROUP
Definition: common.h:603
#define COB_TYPE_NUMERIC_FP_BIN64
Definition: common.h:616
#define COB_TYPE_NUMERIC_FP_DEC64
Definition: common.h:613
#define COB_TYPE_NUMERIC_FLOAT
Definition: common.h:610
#define _(s)
Definition: cobcrun.c:59
#define COBC_ABORT()
Definition: cobc.h:61
#define COB_TYPE_NUMERIC_BINARY
Definition: common.h:608
#define COB_TYPE_ALPHANUMERIC_EDITED
Definition: common.h:623
#define COB_TYPE_NUMERIC_DISPLAY
Definition: common.h:607
#define COB_TYPE_NUMERIC_FP_BIN128
Definition: common.h:617
#define COB_TYPE_NUMERIC_DOUBLE
Definition: common.h:611
#define COBC_DUMB_ABORT()
Definition: cobc.h:62
#define COB_TYPE_NUMERIC_FP_DEC128
Definition: common.h:614
enum cb_usage usage
Definition: tree.h:693
#define COB_TYPE_NUMERIC_EDITED
Definition: common.h:619
#define COB_TYPE_NUMERIC_L_DOUBLE
Definition: common.h:612

Here is the call graph for this function:

Here is the caller graph for this function:

static void check_lit_length ( const int  size,
const char *  lit 
)
static

Definition at line 1084 of file tree.c.

References _, COB_MAX_DIGITS, COB_MINI_MAX, err_msg, error_numeric_literal(), and unlikely.

Referenced by cb_get_int(), cb_get_long_long(), and cb_get_u_long_long().

1085 {
1086  if (unlikely(size > COB_MAX_DIGITS)) {
1087  /* Absolute limit */
1088  snprintf (err_msg, COB_MINI_MAX,
1089  _("Literal length %d exceeds maximum of %d digits"),
1090  size, COB_MAX_DIGITS);
1091  error_numeric_literal (lit);
1092  } else if (unlikely(size > cb_numlit_length)) {
1093  snprintf (err_msg, COB_MINI_MAX,
1094  _("Literal length %d exceeds %d digits"),
1095  size, cb_numlit_length);
1096  error_numeric_literal (lit);
1097  }
1098 }
static void error_numeric_literal(const char *literal)
Definition: tree.c:1067
#define COB_MAX_DIGITS
Definition: common.h:562
#define _(s)
Definition: cobcrun.c:59
#define unlikely(x)
Definition: common.h:437
int size
Definition: tree.h:672
static char err_msg[COB_MINI_BUFF]
Definition: tree.c:90
#define COB_MINI_MAX
Definition: common.h:545

Here is the call graph for this function:

Here is the caller graph for this function:

static void check_prototype_seen ( const struct cb_func_prototype fp)
static

Definition at line 3242 of file tree.c.

References _, cb_find_defined_program_by_id(), CB_TREE, cb_warning_x(), cb_func_prototype::ext_name, and cb_func_prototype::name.

Referenced by cb_build_func_prototype().

3243 {
3244  struct cb_program *program;
3245 
3246  program = cb_find_defined_program_by_id (fp->ext_name);
3247  if (program) {
3248  return;
3249  }
3250 
3251  if (cb_warn_prototypes) {
3252  if (strcmp (fp->name, fp->ext_name) == 0) {
3253  cb_warning_x (CB_TREE (fp),
3254  _("No definition/prototype seen for function '%s'"),
3255  fp->name);
3256  } else {
3257  cb_warning_x (CB_TREE (fp),
3258  _("No definition/prototype seen for function with external name '%s'"),
3259  fp->ext_name);
3260  }
3261  }
3262 }
#define CB_TREE(x)
Definition: tree.h:440
void cb_warning_x(cb_tree x, const char *fmt,...)
Definition: error.c:222
const char * name
Definition: tree.h:1334
#define _(s)
Definition: cobcrun.c:59
struct cb_program * cb_find_defined_program_by_id(const char *orig_id)
Definition: scanner.c:4905
const char * ext_name
Definition: tree.h:1336

Here is the call graph for this function:

Here is the caller graph for this function:

static struct cb_literal* concat_literals ( const cb_tree  left,
const cb_tree  right 
)
static

Definition at line 677 of file tree.c.

References cb_tree_common::category, CB_TAG_LITERAL, cobc_parse_malloc(), cb_literal::data, get_data_and_size_from_lit(), make_tree(), NULL, and cb_literal::size.

Referenced by cb_concat_literals().

678 {
679  struct cb_literal *p;
680  unsigned char *ldata;
681  unsigned char *rdata;
682  size_t lsize;
683  size_t rsize;
684 
685  if (get_data_and_size_from_lit (left, &ldata, &lsize)) {
686  return NULL;
687  }
688  if (get_data_and_size_from_lit (right, &rdata, &rsize)) {
689  return NULL;
690  }
691 
692  p = make_tree (CB_TAG_LITERAL, left->category, sizeof (struct cb_literal));
693  p->data = cobc_parse_malloc (lsize + rsize + 1U);
694  p->size = lsize + rsize;
695 
696  memcpy (p->data, ldata, lsize);
697  memcpy (p->data + lsize, rdata, rsize);
698 
699  return p;
700 }
void * cobc_parse_malloc(const size_t size)
Definition: cobc.c:809
enum cb_category category
Definition: tree.h:430
static int get_data_and_size_from_lit(cb_tree x, unsigned char **data, size_t *size)
Definition: tree.c:659
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
static void * make_tree(const enum cb_tag tag, const enum cb_category category, const size_t size)
Definition: tree.c:227
unsigned char * data
Definition: tree.h:593
cob_u32_t size
Definition: tree.h:594

Here is the call graph for this function:

Here is the caller graph for this function:

static void error_numeric_literal ( const char *  literal)
static

Definition at line 1067 of file tree.c.

References _, cb_error(), and err_msg.

Referenced by check_lit_length().

1068 {
1069  char lit_out[39];
1070 
1071  /* snip literal for output, if too long */
1072  strncpy (lit_out, literal, 38);
1073  if (strlen (literal) > 38) {
1074  strcpy (lit_out + 35, "...");
1075  } else {
1076  lit_out[38] = '\0';
1077  }
1078  cb_error (_("Invalid numeric literal: '%s'"), lit_out);
1079  cb_error (err_msg);
1080 }
#define _(s)
Definition: cobcrun.c:59
void cb_error(const char *,...) COB_A_FORMAT12
Definition: error.c:98
static char err_msg[COB_MINI_BUFF]
Definition: tree.c:90

Here is the call graph for this function:

Here is the caller graph for this function:

static void file_error ( cb_tree  name,
const char *  clause,
const char  errtype 
)
static

Definition at line 206 of file tree.c.

References _, cb_error_x(), CB_FILE_ERR_INVALID, CB_FILE_ERR_INVALID_FT, CB_FILE_ERR_REQUIRED, and CB_NAME.

Referenced by validate_file().

207 {
208  switch (errtype) {
210  cb_error_x (name, _("%s clause is required for file '%s'"),
211  clause, CB_NAME (name));
212  break;
214  cb_error_x (name, _("%s clause is invalid for file '%s' (file type)"),
215  clause, CB_NAME (name));
216  break;
217  case CB_FILE_ERR_INVALID:
218  cb_error_x (name, _("%s clause is invalid for file '%s'"),
219  clause, CB_NAME (name));
220  break;
221  }
222 }
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
#define CB_FILE_ERR_INVALID_FT
Definition: tree.c:202
#define _(s)
Definition: cobcrun.c:59
#define CB_FILE_ERR_INVALID
Definition: tree.c:203
#define CB_FILE_ERR_REQUIRED
Definition: tree.c:201
#define CB_NAME(x)
Definition: tree.h:904

Here is the call graph for this function:

Here is the caller graph for this function:

void finalize_file ( struct cb_file f,
struct cb_field records 
)

Definition at line 2409 of file tree.c.

References _, cb_file::alt_key_list, cb_file::assign, cb_build_alphanumeric_literal(), cb_build_field(), cb_build_field_reference(), cb_build_implicit_field(), cb_build_reference(), CB_CHAIN, cb_error(), CB_FIELD, CB_FIELD_ADD, cb_field_founder(), CB_FIELD_PTR, cb_field_variable_size(), CB_FILE, CB_LIST_INIT, cb_ref(), CB_USAGE_UNSIGNED_INT, cb_validate_field(), CB_VALUE, COB_MINI_BUFF, COB_MINI_MAX, COB_ORG_INDEXED, COB_ORG_LINE_SEQUENTIAL, cobc_main_malloc(), cb_field::count, current_program, cb_field::file, cb_program::file_list, cb_field::flag_external, cb_file::flag_external, cb_file::flag_fileid, cb_file::flag_finalized, cb_program::flag_has_external, cb_field::flag_is_global, cb_file::flag_line_adv, cb_alt_key::key, cb_file::key, cb_file::linage, cb_file::linage_ctr, MAX_FD_RECORD, cb_field::name, cb_file::name, cb_alt_key::next, NULL, cb_field::occurs_min, cb_field::offset, cb_file::organization, cb_file::record, cb_file::record_max, cb_file::record_min, cb_field::redefines, cb_file::same_clause, scratch_buff, cb_field::sister, cb_field::size, cb_file::special, and cb_program::working_storage.

Referenced by cb_validate_program_data(), and yyparse().

2410 {
2411  struct cb_field *p;
2412  struct cb_field *v;
2413  struct cb_alt_key *cbak;
2414  cb_tree l;
2415  cb_tree x;
2416 
2417  /* stdin/stderr and LINE ADVANCING are L/S */
2418  if (f->special || f->flag_line_adv) {
2420  }
2421  if (f->flag_fileid && !f->assign) {
2423  strlen (f->name));
2424  }
2425 
2426  if (f->key && f->organization == COB_ORG_INDEXED &&
2427  (l = cb_ref (f->key)) != cb_error_node) {
2428  v = cb_field_founder (CB_FIELD_PTR (l));
2429  for (p = records; p; p = p->sister) {
2430  if (p == v) {
2431  break;
2432  }
2433  }
2434  if (!p) {
2435  cb_error (_("Invalid KEY item '%s'"),
2436  CB_FIELD_PTR (l)->name);
2437  }
2438  }
2439  if (f->alt_key_list) {
2440  for (cbak = f->alt_key_list; cbak; cbak = cbak->next) {
2441  l = cb_ref (cbak->key);
2442  if (l == cb_error_node) {
2443  continue;
2444  }
2445  v = cb_field_founder (CB_FIELD_PTR (l));
2446  for (p = records; p; p = p->sister) {
2447  if (p == v) {
2448  break;
2449  }
2450  }
2451  if (!p) {
2452  cb_error (_("Invalid KEY item '%s'"),
2453  CB_FIELD_PTR (l)->name);
2454  }
2455  }
2456  }
2457 
2458  /* Check the record size if it is limited */
2459  for (p = records; p; p = p->sister) {
2460  if (f->record_min > 0) {
2461  if (p->size < f->record_min) {
2462  cb_error (_("Record size too small '%s' (%d)"),
2463  p->name, p->size);
2464  }
2465  }
2466  if (f->record_max > 0) {
2467  if (p->size > f->record_max) {
2468  cb_error (_("Record size too large '%s' (%d)"),
2469  p->name, p->size);
2470  }
2471  }
2472  }
2473 
2474  /* Compute the record size */
2475  if (f->record_min == 0) {
2476  if (records) {
2477  f->record_min = records->size;
2478  } else {
2479  f->record_min = 0;
2480  }
2481  }
2482  for (p = records; p; p = p->sister) {
2483  v = cb_field_variable_size (p);
2484  if (v && v->offset + v->size * v->occurs_min < f->record_min) {
2485  f->record_min = v->offset + v->size * v->occurs_min;
2486  }
2487  if (p->size < f->record_min) {
2488  f->record_min = p->size;
2489  }
2490  if (p->size > f->record_max) {
2491  f->record_max = p->size;
2492  }
2493  }
2494 
2495  if (f->record_max > MAX_FD_RECORD) {
2496  cb_error (_("Record size exceeds maximum allowed (%d) - File '%s'"),
2497  MAX_FD_RECORD, f->name);
2498  }
2499 
2500  if (f->same_clause) {
2501  for (l = current_program->file_list; l; l = CB_CHAIN (l)) {
2502  if (CB_FILE (CB_VALUE (l))->same_clause == f->same_clause) {
2503  if (CB_FILE (CB_VALUE (l))->flag_finalized) {
2504  if (f->record_max > CB_FILE (CB_VALUE (l))->record->memory_size) {
2505  CB_FILE (CB_VALUE (l))->record->memory_size =
2506  f->record_max;
2507  }
2508  f->record = CB_FILE (CB_VALUE (l))->record;
2509  for (p = records; p; p = p->sister) {
2510  p->file = f;
2511  p->redefines = f->record;
2512  }
2513  for (p = f->record->sister; p; p = p->sister) {
2514  if (!p->sister) {
2515  p->sister = records;
2516  break;
2517  }
2518  }
2519  f->flag_finalized = 1;
2520  return;
2521  }
2522  }
2523  }
2524  }
2525  /* Create record */
2526  if (f->record_max == 0) {
2527  f->record_max = 32;
2528  f->record_min = 32;
2529  }
2531  f->record_min = 0;
2532  }
2533  if (!scratch_buff) {
2535  }
2536  snprintf (scratch_buff, (size_t)COB_MINI_MAX, "%s Record", f->name);
2538  f->record_max));
2539  f->record->sister = records;
2540  f->record->count++;
2541  if (f->flag_external) {
2543  f->record->flag_external = 1;
2544  }
2545 
2546  for (p = records; p; p = p->sister) {
2547  p->file = f;
2548  p->redefines = f->record;
2549 #if 1 /* RXWRXW - Global/External */
2550  if (p->flag_is_global) {
2551  f->record->flag_is_global = 1;
2552  }
2553 #endif
2554  }
2555  f->flag_finalized = 1;
2556  if (f->linage) {
2557  snprintf (scratch_buff, (size_t)COB_MINI_MAX,
2558  "LINAGE-COUNTER %s", f->name);
2560  CB_FIELD (x)->usage = CB_USAGE_UNSIGNED_INT;
2561  CB_FIELD (x)->values = CB_LIST_INIT (cb_zero);
2562  CB_FIELD (x)->count++;
2566  }
2567 }
const char * name
Definition: tree.h:645
void * cobc_main_malloc(const size_t size)
Definition: cobc.c:702
int record_max
Definition: tree.h:842
unsigned int flag_line_adv
Definition: tree.h:855
const char * name
Definition: tree.h:820
#define CB_FIELD_ADD(x, y)
Definition: tree.h:1856
struct cb_field * sister
Definition: tree.h:653
#define MAX_FD_RECORD
Definition: common.h:556
int same_clause
Definition: tree.h:848
cb_tree cb_build_implicit_field(cb_tree name, const int len)
Definition: tree.c:2175
int occurs_min
Definition: tree.h:676
#define CB_FIELD_PTR(x)
Definition: tree.h:745
cb_tree cb_build_field_reference(struct cb_field *f, cb_tree ref)
Definition: tree.c:2604
cb_tree cb_ref(cb_tree x)
Definition: tree.c:2653
unsigned int flag_fileid
Definition: tree.h:852
cb_tree cb_build_field(cb_tree name)
Definition: tree.c:2159
cb_tree cb_zero
Definition: tree.c:125
#define COB_ORG_INDEXED
Definition: common.h:745
#define COB_MINI_BUFF
Definition: common.h:539
struct cb_alt_key * next
Definition: tree.h:812
cb_tree linage
Definition: tree.h:832
cb_tree file_list
Definition: tree.h:1252
struct cb_field * cb_field_variable_size(const struct cb_field *f)
Definition: tree.c:2239
unsigned char flag_is_global
Definition: tree.h:699
#define CB_FILE(x)
Definition: tree.h:858
#define CB_VALUE(x)
Definition: tree.h:1193
cb_tree cb_build_alphanumeric_literal(const void *data, const size_t size)
Definition: tree.c:1716
int record_min
Definition: tree.h:841
struct cb_file * file
Definition: tree.h:657
int offset
Definition: tree.h:675
#define _(s)
Definition: cobcrun.c:59
Definition: tree.h:643
#define CB_CHAIN(x)
Definition: tree.h:1194
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
unsigned int flag_external
Definition: tree.h:850
int count
Definition: tree.h:680
static char * scratch_buff
Definition: tree.c:85
cb_tree linage_ctr
Definition: tree.h:833
int size
Definition: tree.h:672
cb_tree cb_build_reference(const char *name)
Definition: tree.c:2572
cb_tree cb_error_node
Definition: tree.c:140
void cb_error(const char *,...) COB_A_FORMAT12
Definition: error.c:98
int special
Definition: tree.h:847
cb_tree assign
Definition: tree.h:823
struct cb_program * current_program
Definition: parser.c:168
cb_tree key
Definition: tree.h:813
struct cb_field * record
Definition: tree.h:829
int organization
Definition: tree.h:844
#define CB_LIST_INIT(x)
Definition: tree.h:1851
#define COB_ORG_LINE_SEQUENTIAL
Definition: common.h:743
struct cb_field * working_storage
Definition: tree.h:1276
void cb_validate_field(struct cb_field *f)
Definition: field.c:1338
cb_tree key
Definition: tree.h:826
struct cb_field * redefines
Definition: tree.h:654
unsigned int flag_finalized
Definition: tree.h:849
struct cb_alt_key * alt_key_list
Definition: tree.h:827
unsigned int flag_has_external
Definition: tree.h:1316
struct cb_field * cb_field_founder(const struct cb_field *f)
Definition: tree.c:2227
#define CB_FIELD(x)
Definition: tree.h:740
#define COB_MINI_MAX
Definition: common.h:545
unsigned char flag_external
Definition: tree.h:697

Here is the call graph for this function:

Here is the caller graph for this function:

static int get_data_and_size_from_lit ( cb_tree  x,
unsigned char **  data,
size_t *  size 
)
static

Definition at line 659 of file tree.c.

References CB_CONST_P, CB_LITERAL, CB_LITERAL_P, and get_data_from_const().

Referenced by concat_literals().

660 {
661  if (CB_LITERAL_P (x)) {
662  *data = CB_LITERAL (x)->data;
663  *size = CB_LITERAL (x)->size;
664  } else if (CB_CONST_P (x)) {
665  *size = 1;
666  if (get_data_from_const (x, data)) {
667  return 1;
668  }
669  } else {
670  return 1;
671  }
672 
673  return 0;
674 }
#define CB_CONST_P(x)
Definition: tree.h:477
#define CB_LITERAL(x)
Definition: tree.h:601
#define CB_LITERAL_P(x)
Definition: tree.h:602
static int get_data_from_const(cb_tree const_val, unsigned char **data)
Definition: tree.c:633

Here is the call graph for this function:

Here is the caller graph for this function:

static int get_data_from_const ( cb_tree  const_val,
unsigned char **  data 
)
static

Definition at line 633 of file tree.c.

Referenced by get_data_and_size_from_lit().

634 {
635  if (const_val == cb_space) {
636  *data = (unsigned char *)" ";
637  } else if (const_val == cb_zero) {
638  *data = (unsigned char *)"0";
639  } else if (const_val == cb_quote) {
640  if (cb_flag_apostrophe) {
641  *data = (unsigned char *)"'";
642  } else {
643  *data = (unsigned char *)"\"";
644  }
645  } else if (const_val == cb_norm_low) {
646  *data = (unsigned char *)"\0";
647  } else if (const_val == cb_norm_high) {
648  *data = (unsigned char *)"\255";
649  } else if (const_val == cb_null) {
650  *data = (unsigned char *)"\0";
651  } else {
652  return 1;
653  }
654 
655  return 0;
656 }
cb_tree cb_norm_high
Definition: tree.c:131
cb_tree cb_norm_low
Definition: tree.c:130
cb_tree cb_zero
Definition: tree.c:125
cb_tree cb_quote
Definition: tree.c:132
cb_tree cb_space
Definition: tree.c:127
cb_tree cb_null
Definition: tree.c:124

Here is the caller graph for this function:

static cb_tree get_last_elt ( cb_tree  l)
static

Definition at line 591 of file tree.c.

References CB_CHAIN.

Referenced by cb_list_append(), and warn_cannot_get_utc().

592 {
593  while (CB_CHAIN (l)) {
594  l = CB_CHAIN (l);
595  }
596  return l;
597 }
#define CB_CHAIN(x)
Definition: tree.h:1194

Here is the caller graph for this function:

static cb_tree global_check ( struct cb_reference r,
cb_tree  items,
size_t *  ambiguous 
)
static

Definition at line 453 of file tree.c.

References CB_CHAIN, CB_FIELD, cb_field_founder(), CB_FIELD_P, CB_FILE, CB_FILE_P, CB_NAME, cb_ref(), CB_REFERENCE, CB_VALUE, CB_WORD_COUNT, cb_reference::chain, file, cb_field::flag_indexed_by, cb_field::flag_is_global, cb_field::name, NULL, and cb_field::parent.

Referenced by cb_ref().

454 {
455  cb_tree candidate;
456  struct cb_field *p;
457  cb_tree v;
458  cb_tree c;
459 
460  candidate = NULL;
461  for (; items; items = CB_CHAIN (items)) {
462  /* Find a candidate value by resolving qualification */
463  v = CB_VALUE (items);
464  c = r->chain;
465  if (CB_FIELD_P (v)) {
466  if (!CB_FIELD (v)->flag_is_global) {
467  continue;
468  }
469  /* In case the value is a field, it might be qualified
470  by its parent names and a file name */
471  if (CB_FIELD (v)->flag_indexed_by) {
472  p = CB_FIELD (v)->index_qual;
473  } else {
474  p = CB_FIELD (v)->parent;
475  }
476  /* Resolve by parents */
477  for (; p; p = p->parent) {
478  if (c && strcasecmp (CB_NAME (c), p->name) == 0) {
479  c = CB_REFERENCE (c)->chain;
480  }
481  }
482 
483  /* Resolve by file */
484  if (c && CB_REFERENCE (c)->chain == NULL) {
485  if (CB_WORD_COUNT (c) == 1 &&
486  CB_FILE_P (cb_ref (c)) &&
487  (CB_FILE (cb_ref (c)) == cb_field_founder (CB_FIELD (v))->file)) {
488  c = CB_REFERENCE (c)->chain;
489  }
490  }
491  }
492  /* A well qualified value is a good candidate */
493  if (c == NULL) {
494  if (candidate == NULL) {
495  /* Keep the first candidate */
496  candidate = v;
497  } else {
498  /* Multiple candidates and possibly ambiguous */
499  *ambiguous = 1;
500  }
501  }
502  }
503  return candidate;
504 }
const char * name
Definition: tree.h:645
cb_tree cb_ref(cb_tree x)
Definition: tree.c:2653
unsigned char flag_is_global
Definition: tree.h:699
#define CB_FILE(x)
Definition: tree.h:858
if fold fold static computed alternate extra correct stack on syntax debugging source implicit stack syntax write single recursive relax optional file
Definition: flag.def:129
#define CB_VALUE(x)
Definition: tree.h:1193
cb_tree chain
Definition: tree.h:875
#define CB_FIELD_P(x)
Definition: tree.h:741
Definition: tree.h:643
#define CB_CHAIN(x)
Definition: tree.h:1194
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
unsigned int flag_indexed_by
Definition: tree.h:721
#define CB_NAME(x)
Definition: tree.h:904
#define CB_REFERENCE(x)
Definition: tree.h:901
#define CB_FILE_P(x)
Definition: tree.h:859
struct cb_field * parent
Definition: tree.h:651
#define CB_WORD_COUNT(x)
Definition: tree.h:905
struct cb_field * cb_field_founder(const struct cb_field *f)
Definition: tree.c:2227
#define CB_FIELD(x)
Definition: tree.h:740

Here is the call graph for this function:

Here is the caller graph for this function:

static size_t hash ( const unsigned char *  s)
static

Definition at line 151 of file tree.c.

References CB_WORD_HASH_MASK, and CB_WORD_HASH_SIZE.

Referenced by lookup_word().

152 {
153  size_t val;
154  size_t pos;
155 
156  /* Hash a name */
157  /* We multiply by position to get a better distribution */
158  val = 0;
159  pos = 1;
160  for (; *s; s++, pos++) {
161  val += pos * toupper (*s);
162  }
163 #if 0 /* RXWRXW - Hash remainder */
164  return val % CB_WORD_HASH_SIZE;
165 #endif
166  return val & CB_WORD_HASH_MASK;
167 }
#define CB_WORD_HASH_SIZE
Definition: tree.h:57
#define CB_WORD_HASH_MASK
Definition: tree.h:58

Here is the caller graph for this function:

static void lookup_word ( struct cb_reference p,
const char *  name 
)
static

Definition at line 170 of file tree.c.

References cobc_parse_malloc(), cobc_parse_strdup(), current_program, cb_reference::flag_duped, hash(), cb_reference::hashval, likely, cb_word::name, cb_word::next, cb_reference::word, and cb_program::word_table.

Referenced by cb_build_reference().

171 {
172  struct cb_word *w;
173  size_t val;
174 
175  val = hash ((const unsigned char *)name);
176  /* Find an existing word */
177  if (likely(current_program)) {
178  for (w = current_program->word_table[val]; w; w = w->next) {
179  if (strcasecmp (w->name, name) == 0) {
180  p->word = w;
181  p->hashval = val;
182  p->flag_duped = 1;
183  return;
184  }
185  }
186  }
187 
188  /* Create new word */
189  w = cobc_parse_malloc (sizeof (struct cb_word));
190  w->name = cobc_parse_strdup (name);
191 
192  /* Insert it into the table */
193  if (likely(current_program)) {
194  w->next = current_program->word_table[val];
195  current_program->word_table[val] = w;
196  }
197  p->word = w;
198  p->hashval = val;
199 }
void * cobc_parse_malloc(const size_t size)
Definition: cobc.c:809
static size_t hash(const unsigned char *s)
Definition: tree.c:151
void * cobc_parse_strdup(const char *dupstr)
Definition: cobc.c:827
const char * name
Definition: tree.h:865
size_t hashval
Definition: tree.h:885
struct cb_word * next
Definition: tree.h:864
unsigned int flag_duped
Definition: tree.h:898
struct cb_word ** word_table
Definition: tree.h:1247
struct cb_program * current_program
Definition: parser.c:168
Definition: tree.h:863
#define likely(x)
Definition: common.h:436
struct cb_word * word
Definition: tree.h:881

Here is the call graph for this function:

Here is the caller graph for this function:

static cb_tree make_constant ( const enum cb_category  category,
const char *  val 
)
static

Definition at line 239 of file tree.c.

References CB_TAG_CONST, CB_TREE, make_tree(), and cb_const::val.

Referenced by cb_init_constants().

240 {
241  struct cb_const *p;
242 
243  p = make_tree (CB_TAG_CONST, category, sizeof (struct cb_const));
244  p->val = val;
245  return CB_TREE (p);
246 }
#define CB_TREE(x)
Definition: tree.h:440
const char * val
Definition: tree.h:473
static void * make_tree(const enum cb_tag tag, const enum cb_category category, const size_t size)
Definition: tree.c:227
Definition: tree.h:471

Here is the call graph for this function:

Here is the caller graph for this function:

static cb_tree make_constant_label ( const char *  name)
static

Definition at line 249 of file tree.c.

References cb_build_label(), cb_build_reference(), CB_LABEL, CB_TREE, cb_label::flag_begin, and NULL.

Referenced by cb_init_constants().

250 {
251  struct cb_label *p;
252 
254  p->flag_begin = 1;
255  return CB_TREE (p);
256 }
#define CB_TREE(x)
Definition: tree.h:440
#define CB_LABEL(x)
Definition: tree.h:801
const char * name
Definition: tree.h:766
cb_tree cb_build_label(cb_tree name, struct cb_label *section)
Definition: tree.c:2988
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cb_tree cb_build_reference(const char *name)
Definition: tree.c:2572
Definition: tree.h:764
unsigned int flag_begin
Definition: tree.h:779

Here is the call graph for this function:

Here is the caller graph for this function:

static cb_tree make_intrinsic ( cb_tree  name,
struct cb_intrinsic_table cbp,
cb_tree  args,
cb_tree  field,
cb_tree  refmod,
const int  isuser 
)
static

Definition at line 413 of file tree.c.

References _, cb_intrinsic::args, cb_intrinsic_table::category, CB_CHAIN, cb_error(), cb_error_node, CB_PAIR_X, CB_PAIR_Y, CB_TAG_CONST, CB_TAG_DECIMAL, CB_TAG_FIELD, CB_TAG_INTEGER, CB_TAG_INTRINSIC, CB_TAG_LITERAL, CB_TAG_REFERENCE, CB_TREE, CB_TREE_TAG, CB_VALUE, cb_intrinsic::intr_field, cb_intrinsic::intr_tab, cb_intrinsic::isuser, cb_intrinsic::length, make_tree(), cb_intrinsic_table::name, cb_intrinsic::name, and cb_intrinsic::offset.

Referenced by cb_build_any_intrinsic(), and cb_build_intrinsic().

415 {
416  struct cb_intrinsic *x;
417 
418 #if 0 /* RXWRXW Leave in, we may need this */
419  cb_tree l;
420  for (l = args; l; l = CB_CHAIN(l)) {
421  switch (CB_TREE_TAG (CB_VALUE(l))) {
422  case CB_TAG_CONST:
423  case CB_TAG_INTEGER:
424  case CB_TAG_LITERAL:
425  case CB_TAG_DECIMAL:
426  case CB_TAG_FIELD:
427  case CB_TAG_REFERENCE:
428  case CB_TAG_INTRINSIC:
429  break;
430  default:
431  cb_error (_("FUNCTION %s has invalid/not supported arguments - Tag %d"),
432  cbp->name, CB_TREE_TAG(l));
433  return cb_error_node;
434 
435  }
436  }
437 #endif
438 
439  x = make_tree (CB_TAG_INTRINSIC, cbp->category, sizeof (struct cb_intrinsic));
440  x->name = name;
441  x->args = args;
442  x->intr_tab = cbp;
443  x->intr_field = field;
444  x->isuser = isuser;
445  if (refmod) {
446  x->offset = CB_PAIR_X (refmod);
447  x->length = CB_PAIR_Y (refmod);
448  }
449  return CB_TREE (x);
450 }
#define CB_PAIR_X(x)
Definition: tree.h:1205
#define CB_TREE(x)
Definition: tree.h:440
cb_tree intr_field
Definition: tree.h:994
const char * name
Definition: tree.h:979
int isuser
Definition: tree.h:998
#define CB_PAIR_Y(x)
Definition: tree.h:1206
#define CB_VALUE(x)
Definition: tree.h:1193
struct cb_intrinsic_table * intr_tab
Definition: tree.h:995
cb_tree args
Definition: tree.h:993
#define _(s)
Definition: cobcrun.c:59
#define CB_CHAIN(x)
Definition: tree.h:1194
cb_tree length
Definition: tree.h:997
#define CB_TREE_TAG(x)
Definition: tree.h:441
static void * make_tree(const enum cb_tag tag, const enum cb_category category, const size_t size)
Definition: tree.c:227
enum cb_category category
Definition: tree.h:986
cb_tree cb_error_node
Definition: tree.c:140
void cb_error(const char *,...) COB_A_FORMAT12
Definition: error.c:98
cb_tree offset
Definition: tree.h:996
cb_tree name
Definition: tree.h:992

Here is the call graph for this function:

Here is the caller graph for this function:

static void* make_tree ( const enum cb_tag  tag,
const enum cb_category  category,
const size_t  size 
)
static
static const char* try_get_constant_data ( cb_tree  val)
static

Definition at line 552 of file tree.c.

References CB_CONST, CB_CONST_P, CB_LITERAL, CB_LITERAL_P, and NULL.

Referenced by valid_const_date_time_args(), and warn_cannot_get_utc().

553 {
554  if (val == NULL) {
555  return NULL;
556  } else if (CB_LITERAL_P (val)) {
557  return (char *) CB_LITERAL (val)->data;
558  } else if (CB_CONST_P (val)) {
559  return CB_CONST (val)->val;
560  } else {
561  return NULL;
562  }
563 }
#define CB_CONST_P(x)
Definition: tree.h:477
#define CB_LITERAL(x)
Definition: tree.h:601
#define CB_LITERAL_P(x)
Definition: tree.h:602
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_CONST(x)
Definition: tree.h:476

Here is the caller graph for this function:

static int valid_const_date_time_args ( const cb_tree  tree,
const struct cb_intrinsic_table intr,
cb_tree  args 
)
static

Definition at line 566 of file tree.c.

References _, cb_error_x(), CB_VALUE, cb_warning_x(), cb_intrinsic_table::intr_enum, cb_intrinsic_table::name, NULL, try_get_constant_data(), and valid_format().

Referenced by cb_build_intrinsic().

568 {
569  cb_tree arg = CB_VALUE (args);
570  const char *data;
571  int error_found = 0;
572 
573  /* Precondition: iso_8601_func (intr->intr_enum) */
574 
575  data = try_get_constant_data (arg);
576  if (data != NULL) {
577  if (!valid_format (intr->intr_enum, data)) {
578  cb_error_x (tree, _("FUNCTION '%s' has invalid date/time format"),
579  intr->name);
580  error_found = 1;
581  }
582  } else {
583  cb_warning_x (tree, _("FUNCTION '%s' has format in variable"),
584  intr->name);
585  }
586 
587  return !error_found;
588 }
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
const char * name
Definition: tree.h:979
void cb_warning_x(cb_tree x, const char *fmt,...)
Definition: error.c:222
static int valid_format(const enum cb_intr_enum intr, const char *format)
Definition: tree.c:519
#define CB_VALUE(x)
Definition: tree.h:1193
static const char * try_get_constant_data(cb_tree val)
Definition: tree.c:552
#define _(s)
Definition: cobcrun.c:59
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
enum cb_intr_enum intr_enum
Definition: tree.h:981

Here is the call graph for this function:

Here is the caller graph for this function:

static int valid_format ( const enum cb_intr_enum  intr,
const char *  format 
)
static

Definition at line 519 of file tree.c.

References _, cb_error(), CB_INTR_FORMATTED_CURRENT_DATE, CB_INTR_FORMATTED_DATE, CB_INTR_FORMATTED_DATETIME, CB_INTR_FORMATTED_TIME, CB_INTR_INTEGER_OF_FORMATTED_DATE, CB_INTR_SECONDS_FROM_FORMATTED_TIME, CB_INTR_TEST_FORMATTED_DATETIME, cob_valid_date_format(), cob_valid_datetime_format(), cob_valid_time_format(), current_program, and cb_program::decimal_point.

Referenced by valid_const_date_time_args().

520 {
521  char decimal_point = current_program->decimal_point;
522 
523  /* Precondition: iso_8601_func (intr) */
524 
525  switch (intr) {
527  return cob_valid_datetime_format (format, decimal_point);
529  return cob_valid_date_format (format);
531  return cob_valid_datetime_format (format, decimal_point);
533  return cob_valid_time_format (format, decimal_point);
535  return cob_valid_date_format (format)
536  || cob_valid_datetime_format (format, decimal_point);
538  return cob_valid_time_format (format, decimal_point)
539  || cob_valid_datetime_format (format, decimal_point);
541  return cob_valid_time_format (format, decimal_point)
542  || cob_valid_date_format (format)
543  || cob_valid_datetime_format (format, decimal_point);
544  default:
545  cb_error (_("Invalid date/time function - '%d'"), intr);
546  /* Ignore the content of the format */
547  return 1;
548  }
549 }
int cob_valid_date_format(const char *)
Definition: intrinsic.c:3355
#define _(s)
Definition: cobcrun.c:59
int cob_valid_datetime_format(const char *, const char)
Definition: intrinsic.c:3402
void cb_error(const char *,...) COB_A_FORMAT12
Definition: error.c:98
int cob_valid_time_format(const char *, const char)
Definition: intrinsic.c:3366
struct cb_program * current_program
Definition: parser.c:168
unsigned char decimal_point
Definition: tree.h:1300

Here is the call graph for this function:

Here is the caller graph for this function:

void validate_file ( struct cb_file f,
cb_tree  name 
)

Definition at line 2360 of file tree.c.

References cb_file::access_mode, cb_file::alt_key_list, cb_file::assign, CB_FILE_ERR_INVALID, CB_FILE_ERR_INVALID_FT, CB_FILE_ERR_REQUIRED, COB_ACCESS_DYNAMIC, COB_ACCESS_RANDOM, COB_ACCESS_SEQUENTIAL, COB_ORG_INDEXED, COB_ORG_RELATIVE, COB_ORG_SORT, file_error(), cb_file::flag_fileid, cb_file::key, NULL, and cb_file::organization.

Referenced by yyparse().

2361 {
2362  /* Check ASSIGN clause
2363  Currently break's GnuCOBOL's extension for SORT FILEs having no need
2364  for an ASSIGN clause (tested in run_extensions "SORT ASSIGN ..."
2365  According to the Programmer's Guide for 1.1 the ASSIGN is totally
2366  ignored as the SORT is either done in memory (if there's enough space)
2367  or in a temporary disk file.
2368  For supporting this f->organization = COB_ORG_SORT is done when we
2369  see an SD in FILE SECTION for the file, while validate_file is called
2370  in INPUT-OUTPUT Section.
2371  */
2372  if (!f->assign && f->organization != COB_ORG_SORT && !f->flag_fileid) {
2373  file_error (name, "ASSIGN", CB_FILE_ERR_REQUIRED);
2374  }
2375  /* Check RECORD/RELATIVE KEY clause */
2376  switch (f->organization) {
2377  case COB_ORG_INDEXED:
2378  if (f->key == NULL) {
2379  file_error (name, "RECORD KEY", CB_FILE_ERR_REQUIRED);
2380  }
2381  break;
2382  case COB_ORG_RELATIVE:
2383  if (f->key == NULL && f->access_mode != COB_ACCESS_SEQUENTIAL) {
2384  file_error (name, "RELATIVE KEY", CB_FILE_ERR_REQUIRED);
2385  }
2386  if (f->alt_key_list) {
2387  file_error (name, "ALTERNATE", CB_FILE_ERR_INVALID_FT);
2388  f->alt_key_list = NULL;
2389  }
2390  break;
2391  default:
2392  if (f->key) {
2393  file_error (name, "RECORD", CB_FILE_ERR_INVALID_FT);
2394  f->key = NULL;
2395  }
2396  if (f->alt_key_list) {
2397  file_error (name, "ALTERNATE", CB_FILE_ERR_INVALID_FT);
2398  f->alt_key_list = NULL;
2399  }
2400  if (f->access_mode == COB_ACCESS_DYNAMIC ||
2402  file_error (name, "ORGANIZATION", CB_FILE_ERR_INVALID);
2403  }
2404  break;
2405  }
2406 }
unsigned int flag_fileid
Definition: tree.h:852
#define COB_ORG_INDEXED
Definition: common.h:745
#define CB_FILE_ERR_INVALID_FT
Definition: tree.c:202
#define COB_ACCESS_DYNAMIC
Definition: common.h:752
#define CB_FILE_ERR_INVALID
Definition: tree.c:203
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_FILE_ERR_REQUIRED
Definition: tree.c:201
#define COB_ORG_RELATIVE
Definition: common.h:744
#define COB_ACCESS_SEQUENTIAL
Definition: common.h:751
int access_mode
Definition: tree.h:845
cb_tree assign
Definition: tree.h:823
int organization
Definition: tree.h:844
#define COB_ORG_SORT
Definition: common.h:746
#define COB_ACCESS_RANDOM
Definition: common.h:753
static void file_error(cb_tree name, const char *clause, const char errtype)
Definition: tree.c:206
cb_tree key
Definition: tree.h:826
struct cb_alt_key * alt_key_list
Definition: tree.h:827

Here is the call graph for this function:

Here is the caller graph for this function:

static void warn_cannot_get_utc ( const cb_tree  tree,
const enum cb_intr_enum  intr,
cb_tree  args 
)
static

Definition at line 601 of file tree.c.

References cb_error_x(), CB_INTR_FORMATTED_CURRENT_DATE, CB_INTR_FORMATTED_DATETIME, CB_INTR_FORMATTED_TIME, CB_TAG_INTEGER, CB_VALUE, cb_warning_x(), ERR_MSG, get_last_elt(), NULL, cb_tree_common::tag, and try_get_constant_data().

Referenced by cb_build_intrinsic().

603 {
604  const char *data = try_get_constant_data (CB_VALUE (args));
605  int is_variable_format = data == NULL;
606  int is_constant_utc_format
607  = data != NULL && strchr (data, 'Z') != NULL;
608  int is_formatted_current_date
610  cb_tree last_arg = get_last_elt (args);
611  int has_system_offset_arg
612  = (intr == CB_INTR_FORMATTED_DATETIME
613  || intr == CB_INTR_FORMATTED_TIME)
614  && last_arg->tag == CB_TAG_INTEGER
615  && ((struct cb_integer *) last_arg)->val == 1;
616  #define ERR_MSG _("Cannot find the UTC offset on this system")
617 
618  if (!is_formatted_current_date && !has_system_offset_arg) {
619  return;
620  }
621 
622  if (is_variable_format) {
623  cb_warning_x (tree, ERR_MSG);
624  } else if (is_constant_utc_format) {
625  cb_error_x (tree, ERR_MSG);
626  }
627 
628  #undef ERR_MSG
629 }
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
static cb_tree get_last_elt(cb_tree l)
Definition: tree.c:591
#define ERR_MSG
void cb_warning_x(cb_tree x, const char *fmt,...)
Definition: error.c:222
#define CB_VALUE(x)
Definition: tree.h:1193
static const char * try_get_constant_data(cb_tree val)
Definition: tree.c:552
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
enum cb_tag tag
Definition: tree.h:429

Here is the call graph for this function:

Here is the caller graph for this function:

Variable Documentation

int category_is_alphanumeric[]
static
Initial value:
= {
0,
1,
1,
1,
0,
0,
1,
1,
0,
1,
0,
0,
0
}

Definition at line 62 of file tree.c.

Referenced by cb_category_is_alpha().

cb_tree cb_any

Definition at line 121 of file tree.c.

Referenced by cb_build_cond(), evaluate_test(), and yyparse().

const char* const cb_const_subs[]
static
Initial value:
= {
"i0",
"i1",
"i2",
"i3",
"i4",
"i5",
"i6",
"i7",
"i8",
"i9",
"i10",
"i11",
"i12",
"i13",
"i14",
"i15",
((void*)0)
}

Definition at line 92 of file tree.c.

Referenced by cb_init_constants().

cb_tree cb_error_node

Definition at line 140 of file tree.c.

Referenced by build_cond_88(), build_evaluate(), cb_build_address(), cb_build_assignment_name(), cb_build_binary_op(), cb_build_cond(), cb_build_const_length(), cb_build_display_mnemonic(), cb_build_display_name(), cb_build_field_tree(), cb_build_identifier(), cb_build_intrinsic(), cb_build_length(), cb_build_locale_name(), cb_build_move(), cb_build_perform_forever(), cb_build_perform_once(), cb_build_perform_times(), cb_build_ppointer(), cb_build_section_name(), cb_build_unstring_delimited(), cb_build_unstring_into(), cb_build_write_advancing_mnemonic(), cb_check_data_incompat(), cb_check_field_debug(), cb_check_group_name(), cb_check_integer_value(), cb_check_lit_subs(), cb_check_numeric_edited_name(), cb_check_numeric_name(), cb_check_numeric_value(), cb_concat_literals(), cb_define_switch_name(), cb_emit_accept_mnemonic(), cb_emit_alter(), cb_emit_arithmetic(), cb_emit_call(), cb_emit_close(), cb_emit_delete(), cb_emit_delete_file(), cb_emit_display(), cb_emit_goto(), cb_emit_open(), cb_emit_perform(), cb_emit_read(), cb_emit_return(), cb_emit_rewrite(), cb_emit_search(), cb_emit_search_all(), cb_emit_set_false(), cb_emit_set_to(), cb_emit_set_true(), cb_emit_sort_init(), cb_emit_start(), cb_emit_unlock(), cb_emit_write(), cb_expr_finish(), cb_ref(), cb_validate_one(), cb_validate_program_body(), cb_validate_program_data(), cb_validate_program_environment(), check_not_88_level(), check_picture_item(), check_valid_key(), emit_entry(), expr_reduce(), make_intrinsic(), output_move(), output_stmt(), scan_b(), scan_floating_numeric(), scan_h(), scan_numeric(), scan_o(), scan_x(), scan_z(), search_set_keys(), validate_inspect(), yylex(), and yyparse().

cb_tree cb_false

Definition at line 123 of file tree.c.

Referenced by cb_build_cond(), evaluate_test(), output_cond(), and yyparse().

cb_tree cb_i[16]

Definition at line 139 of file tree.c.

Referenced by output_initialize(), output_initialize_compound(), and output_initialize_one().

cb_tree cb_int2

Definition at line 135 of file tree.c.

Referenced by cb_emit_read(), and yyparse().

cb_tree cb_int3

Definition at line 136 of file tree.c.

Referenced by cb_emit_read(), and yyparse().

cb_tree cb_int4

Definition at line 137 of file tree.c.

Referenced by cb_emit_read(), and yyparse().

cb_tree cb_int5

Definition at line 138 of file tree.c.

cb_tree cb_intr_whencomp = ((void*)0)

Definition at line 142 of file tree.c.

Referenced by cb_build_intrinsic(), and cb_build_registers().

cb_tree cb_one

Definition at line 126 of file tree.c.

Referenced by cb_build_address(), cb_build_identifier(), and yyparse().

cb_tree cb_standard_error_handler = ((void*)0)

Definition at line 144 of file tree.c.

Referenced by output_error_handler(), and output_section_info().

int class_id = 0
static

Definition at line 88 of file tree.c.

Referenced by cb_build_class_name().

struct cb_program* container_progs[64]
static

Definition at line 91 of file tree.c.

char err_msg[COB_MINI_BUFF]
static

Definition at line 90 of file tree.c.

Referenced by check_lit_length(), and error_numeric_literal().

int filler_id = 1
static

Definition at line 87 of file tree.c.

Referenced by cb_build_filler().

unsigned int gen_screen_ptr = 0

Definition at line 146 of file tree.c.

Referenced by cb_build_funcall(), cb_emit_accept(), and cb_emit_display().

struct int_node* int_node_table = ((void*)0)
static

Definition at line 84 of file tree.c.

Referenced by cb_int().

char* pic_buff = ((void*)0)
static

Definition at line 86 of file tree.c.

Referenced by cb_build_picture().

char* scratch_buff = ((void*)0)
static

Definition at line 85 of file tree.c.

Referenced by cb_build_class_name(), and finalize_file().

int toplev_count
static

Definition at line 89 of file tree.c.

Referenced by cb_build_program().

struct cb_intrinsic_table userbp
static
Initial value:
=
{ "USER FUNCTION", "cob_user_function", -1, 1,
0, 0, 0 }

Definition at line 112 of file tree.c.