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

Go to the source code of this file.

Classes

struct  int_node

Defines

#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)

Functions

struct cb_literalbuild_literal (enum cb_category category, const unsigned char *data, size_t size)
char * cb_name (cb_tree x)
enum cb_class cb_tree_class (cb_tree x)
enum cb_category cb_tree_category (cb_tree x)
int cb_tree_type (cb_tree x)
int cb_fits_int (cb_tree x)
int cb_fits_long_long (cb_tree x)
int cb_get_int (cb_tree x)
long long cb_get_long_long (cb_tree x)
void cb_init_constants (void)
cb_tree cb_build_list (cb_tree purpose, cb_tree value, cb_tree rest)
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_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)
struct cb_programcb_build_program (struct cb_program *last_program, int nest_level)
cb_tree cb_int (int n)
cb_tree cb_build_string (const unsigned char *data, size_t size)
cb_tree cb_build_alphabet_name (cb_tree name, enum cb_alphabet_name_type type)
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 (enum cb_system_name_category category, int token)
cb_tree cb_build_numeric_literal (int sign, const unsigned char *data, int scale)
cb_tree cb_build_alphanumeric_literal (const unsigned char *data, size_t size)
cb_tree cb_concat_literals (cb_tree x1, cb_tree x2)
cb_tree cb_build_decimal (int id)
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, int len)
cb_tree cb_build_constant (cb_tree name, cb_tree value)
struct cb_fieldcb_field (cb_tree x)
struct cb_fieldcb_field_add (struct cb_field *f, struct cb_field *p)
int cb_field_size (cb_tree x)
struct cb_fieldcb_field_founder (struct cb_field *f)
struct cb_fieldcb_field_variable_size (struct cb_field *f)
struct cb_fieldcb_field_variable_address (struct cb_field *f)
int cb_field_subordinate (struct cb_field *p, struct cb_field *f)
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)
const char * cb_define (cb_tree name, cb_tree val)
void cb_define_system_name (const char *name)
cb_tree cb_ref (cb_tree x)
cb_tree cb_build_binary_op (cb_tree x, int op, cb_tree y)
cb_tree cb_build_binary_list (cb_tree l, int op)
cb_tree cb_build_funcall (const char *name, int argc, cb_tree a1, cb_tree a2, cb_tree a3, cb_tree a4, cb_tree a5, cb_tree a6, cb_tree a7)
cb_tree cb_build_cast (enum cb_cast_type type, cb_tree val)
cb_tree cb_build_label (cb_tree name, struct cb_label *section)
cb_tree cb_build_assign (cb_tree var, cb_tree val)
cb_tree cb_build_initialize (cb_tree var, cb_tree val, cb_tree rep, cb_tree def, int flag)
cb_tree cb_build_search (int flag_all, cb_tree table, cb_tree var, cb_tree end_stmt, cb_tree whens)
cb_tree cb_build_call (cb_tree name, cb_tree args, cb_tree stmt1, cb_tree stmt2, cb_tree returning, int is_system_call)
cb_tree cb_build_goto (cb_tree target, cb_tree depending)
cb_tree cb_build_if (cb_tree test, cb_tree stmt1, cb_tree stmt2)
cb_tree cb_build_perform (int 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_any_intrinsic (cb_tree args)
cb_tree cb_build_intrinsic (cb_tree name, cb_tree args, cb_tree refmod)

Variables

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 [8]
cb_tree cb_error_node
cb_tree cb_intr_whencomp
cb_tree cb_intr_pi
cb_tree cb_intr_e
cb_tree cb_standard_error_handler
size_t gen_screen_ptr = 0

Define Documentation

#define PIC_ALPHABETIC   0x01

Definition at line 31 of file tree.c.

#define PIC_ALPHABETIC_EDITED   (PIC_ALPHABETIC | PIC_EDITED)

Definition at line 36 of file tree.c.

#define PIC_ALPHANUMERIC   (PIC_ALPHABETIC | PIC_NUMERIC)

Definition at line 35 of file tree.c.

#define PIC_ALPHANUMERIC_EDITED   (PIC_ALPHANUMERIC | PIC_EDITED)

Definition at line 37 of file tree.c.

#define PIC_EDITED   0x08

Definition at line 34 of file tree.c.

#define PIC_NATIONAL   0x04

Definition at line 33 of file tree.c.

#define PIC_NATIONAL_EDITED   (PIC_NATIONAL | PIC_EDITED)

Definition at line 39 of file tree.c.

#define PIC_NUMERIC   0x02

Definition at line 32 of file tree.c.

#define PIC_NUMERIC_EDITED   (PIC_NUMERIC | PIC_EDITED)

Definition at line 38 of file tree.c.


Function Documentation

struct cb_file* build_file ( cb_tree  name) [read]

Definition at line 1577 of file tree.c.

{
        struct cb_file *p;

        p = make_tree (CB_TAG_FILE, CB_CATEGORY_UNKNOWN, sizeof (struct cb_file));
        p->name = cb_define (name, CB_TREE (p));
        p->cname = to_cname (p->name);

        p->organization = COB_ORG_SEQUENTIAL;
        p->access_mode = COB_ACCESS_SEQUENTIAL;
        p->handler = CB_LABEL (cb_standard_error_handler);
        p->handler_prog = current_program;
        return p;
}

Here is the call graph for this function:

struct cb_literal* build_literal ( enum cb_category  category,
const unsigned char *  data,
size_t  size 
) [read]

Definition at line 426 of file tree.c.

{
        struct cb_literal *p;

        p = make_tree (CB_TAG_LITERAL, category, sizeof (struct cb_literal));
        p->data = cobc_malloc ((size_t) (size + 1));
        p->size = size;
        memcpy (p->data, data, (size_t) size);
        /* RXW - malloc zeroes
        p->data[size] = 0;
        */
        return p;
}

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,
enum cb_alphabet_name_type  type 
)

Definition at line 923 of file tree.c.

{
        struct cb_alphabet_name *p;

        p = make_tree (CB_TAG_ALPHABET_NAME, CB_CATEGORY_UNKNOWN, sizeof (struct cb_alphabet_name));
        p->name = cb_define (name, CB_TREE (p));
        p->cname = to_cname (p->name);
        p->type = type;
        return CB_TREE (p);
}

Here is the call graph for this function:

cb_tree cb_build_alphanumeric_literal ( const unsigned char *  data,
size_t  size 
)

Definition at line 999 of file tree.c.

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 2253 of file tree.c.

{
        struct cb_intrinsic_table       *cbp;

        cbp = lookup_intrinsic ("LENGTH", 0);
        return make_intrinsic (NULL, cbp, args, NULL, NULL);
}

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_assign ( cb_tree  var,
cb_tree  val 
)

Definition at line 2098 of file tree.c.

{
        struct cb_assign *p;

        p = make_tree (CB_TAG_ASSIGN, CB_CATEGORY_UNKNOWN, sizeof (struct cb_assign));
        p->var = var;
        p->val = val;
        return CB_TREE (p);
}

Here is the caller graph for this function:

cb_tree cb_build_binary_list ( cb_tree  l,
int  op 
)

Definition at line 2019 of file tree.c.

{
        cb_tree e;

        e = CB_VALUE (l);
        for (l = CB_CHAIN (l); l; l = CB_CHAIN (l)) {
                e = cb_build_binary_op (e, op, CB_VALUE (l));
        }
        return e;
}

Here is the call graph for this function:

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

Definition at line 1954 of file tree.c.

{
        struct cb_binary_op     *p;
        enum cb_category        category = CB_CATEGORY_UNKNOWN;

        switch (op) {
        case '+':
        case '-':
        case '*':
        case '/':
        case '^':
                /* arithmetic operators */
                if (CB_TREE_CLASS (x) == CB_CLASS_POINTER ||
                    CB_TREE_CLASS (y) == CB_CLASS_POINTER) {
                        category = CB_CATEGORY_DATA_POINTER;
                        break;
                }
                x = cb_check_numeric_value (x);
                y = cb_check_numeric_value (y);
                if (x == cb_error_node || y == cb_error_node) {
                        return cb_error_node;
                }
                category = CB_CATEGORY_NUMERIC;
                break;

        case '=':
        case '~':
        case '<':
        case '>':
        case '[':
        case ']':
                /* relational operators */
                category = CB_CATEGORY_BOOLEAN;
                break;

        case '!':
        case '&':
        case '|':
                /* logical operators */
                if (CB_TREE_CLASS (x) != CB_CLASS_BOOLEAN ||
                    (y && CB_TREE_CLASS (y) != CB_CLASS_BOOLEAN)) {
                        cb_error (_("Invalid expression"));
                        return cb_error_node;
                }
                category = CB_CATEGORY_BOOLEAN;
                break;

        case '@':
                /* parentheses */
                category = CB_TREE_CATEGORY (x);
                break;

        default:
                fprintf (stderr, "Unexpected operator -> %d\n", op);
                ABORT ();
        }

        p = make_tree (CB_TAG_BINARY_OP, category, sizeof (struct cb_binary_op));
        p->op = op;
        p->x = x;
        p->y = y;
        return CB_TREE (p);
}

Here is the call graph for this function:

Here is the caller graph for this function:

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

Definition at line 2149 of file tree.c.

{
        struct cb_call *p;

        p = make_tree (CB_TAG_CALL, CB_CATEGORY_UNKNOWN, sizeof (struct cb_call));
        p->name = name;
        p->args = args;
        p->stmt1 = stmt1;
        p->stmt2 = stmt2;
        p->returning = returning;
        p->is_system = is_system_call;
        return CB_TREE (p);
}

Here is the caller graph for this function:

cb_tree cb_build_cast ( enum cb_cast_type  type,
cb_tree  val 
)

Definition at line 2060 of file tree.c.

{
        struct cb_cast          *p;
        enum cb_category        category;

        if (type == CB_CAST_INTEGER) {
                category = CB_CATEGORY_NUMERIC;
        } else {
                category = CB_CATEGORY_UNKNOWN;
        }
        p = make_tree (CB_TAG_CAST, category, sizeof (struct cb_cast));
        p->type = type;
        p->val = val;
        return CB_TREE (p);
}
cb_tree cb_build_class_name ( cb_tree  name,
cb_tree  list 
)

Definition at line 939 of file tree.c.

{
        struct cb_class_name    *p;
        char                    buff[COB_MINI_BUFF];

        p = make_tree (CB_TAG_CLASS_NAME, CB_CATEGORY_BOOLEAN, sizeof (struct cb_class_name));
        p->name = cb_define (name, CB_TREE (p));
        snprintf (buff, COB_MINI_MAX, "is_%s", to_cname (p->name));
        p->cname = strdup (buff);
        p->list = list;
        return CB_TREE (p);
}

Here is the call graph for this function:

cb_tree cb_build_constant ( cb_tree  name,
cb_tree  value 
)

Definition at line 1446 of file tree.c.

{
        cb_tree x;

        x = cb_build_field (name);
        x->category = cb_tree_category (value);
        CB_FIELD (x)->storage = CB_STORAGE_CONSTANT;
        CB_FIELD (x)->values = cb_list_init (value);
        return x;
}

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 2240 of file tree.c.

{
        struct cb_continue *p;

        p = make_tree (CB_TAG_CONTINUE, CB_CATEGORY_UNKNOWN, sizeof (struct cb_continue));
        return CB_TREE (p);
}

Here is the caller graph for this function:

cb_tree cb_build_decimal ( int  id)

Definition at line 1076 of file tree.c.

{
        struct cb_decimal *p;

        p = make_tree (CB_TAG_DECIMAL, CB_CATEGORY_NUMERIC, sizeof (struct cb_decimal));
        p->id = id;
        return CB_TREE (p);
}
cb_tree cb_build_field ( cb_tree  name)

Definition at line 1417 of file tree.c.

{
        struct cb_field *p;

        p = make_tree (CB_TAG_FIELD, CB_CATEGORY_UNKNOWN, sizeof (struct cb_field));
        p->id = cb_field_id++;
        p->name = cb_define (name, CB_TREE (p));
        p->ename = NULL;
        p->usage = CB_USAGE_DISPLAY;
        p->storage = CB_STORAGE_WORKING;
        p->occurs_max = 1;
        return CB_TREE (p);
}

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 1752 of file tree.c.

{
        cb_tree         x;
        struct cb_word  *word;

        x = cb_build_reference (f->name);
        word = CB_REFERENCE (x)->word;
        if (ref) {
                memcpy (x, ref, sizeof (struct cb_reference));
        }
        x->category = CB_CATEGORY_UNKNOWN;
        CB_REFERENCE (x)->word = word;
        CB_REFERENCE (x)->value = CB_TREE (f);
        return x;
}

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 1740 of file tree.c.

{
        cb_tree         x;
        char            name[16];

        sprintf (name, "WORK$%d", filler_id++);
        x = cb_build_reference (name);
        x->source_line = cb_source_line;
        return x;
}

Here is the call graph for this function:

Here is the caller graph for this function:

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

Definition at line 2035 of file tree.c.

{
        struct cb_funcall *p;

        p = make_tree (CB_TAG_FUNCALL, CB_CATEGORY_BOOLEAN, sizeof (struct cb_funcall));
        p->name = name;
        p->argc = argc;
        p->varcnt = 0;
        p->screenptr = gen_screen_ptr;
        p->argv[0] = a1;
        p->argv[1] = a2;
        p->argv[2] = a3;
        p->argv[3] = a4;
        p->argv[4] = a5;
        p->argv[5] = a6;
        p->argv[6] = a7;
        return CB_TREE (p);
}
cb_tree cb_build_goto ( cb_tree  target,
cb_tree  depending 
)

Definition at line 2168 of file tree.c.

{
        struct cb_goto *p;

        p = make_tree (CB_TAG_GOTO, CB_CATEGORY_UNKNOWN, sizeof (struct cb_goto));
        p->target = target;
        p->depending = depending;
        return CB_TREE (p);
}

Here is the caller graph for this function:

cb_tree cb_build_if ( cb_tree  test,
cb_tree  stmt1,
cb_tree  stmt2 
)

Definition at line 2183 of file tree.c.

{
        struct cb_if *p;

        p = make_tree (CB_TAG_IF, CB_CATEGORY_UNKNOWN, sizeof (struct cb_if));
        p->test = test;
        p->stmt1 = stmt1;
        p->stmt2 = stmt2;
        return CB_TREE (p);
}

Here is the caller graph for this function:

cb_tree cb_build_implicit_field ( cb_tree  name,
int  len 
)

Definition at line 1432 of file tree.c.

{
        cb_tree x;
        char    pic[32];

        x = cb_build_field (name);
        memset (pic, 0, sizeof(pic));
        sprintf (pic, "X(%d)", len);
        CB_FIELD (x)->pic = CB_PICTURE (cb_build_picture (pic));
        cb_validate_field (CB_FIELD (x));
        return x;
}

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_initialize ( cb_tree  var,
cb_tree  val,
cb_tree  rep,
cb_tree  def,
int  flag 
)

Definition at line 2113 of file tree.c.

{
        struct cb_initialize *p;

        p = make_tree (CB_TAG_INITIALIZE, CB_CATEGORY_UNKNOWN, sizeof (struct cb_initialize));
        p->var = var;
        p->val = val;
        p->rep = rep;
        p->def = def;
        p->flag_statement = flag;
        return CB_TREE (p);
}

Here is the caller graph for this function:

cb_tree cb_build_intrinsic ( cb_tree  name,
cb_tree  args,
cb_tree  refmod 
)

Definition at line 2262 of file tree.c.

{
        struct cb_intrinsic_table       *cbp;
        cb_tree                         x;
        int                             numargs;

        numargs = cb_list_length (args);

        cbp = lookup_intrinsic (CB_NAME (name), 0);
        if (cbp) {
                if ((cbp->args != -1 && numargs != cbp->args) ||
                    (cbp->args == -1 && cbp->intr_enum != CB_INTR_RANDOM && numargs < 1)) {
                        cb_error_x (name, _("FUNCTION %s has wrong number of arguments"), cbp->name);
                        return cb_error_node;
                }
                if (refmod) {
                        if (!cbp->refmod) {
                                cb_error_x (name, _("FUNCTION %s can not have reference modification"), cbp->name);
                                return cb_error_node;
                        }
                        if (CB_LITERAL_P(CB_PAIR_X(refmod)) &&
                            cb_get_int (CB_PAIR_X(refmod))< 1) {
                                cb_error_x (name, _("FUNCTION %s has invalid reference modification"), cbp->name);
                                return cb_error_node;
                        }
                        if (CB_PAIR_Y(refmod) && CB_LITERAL_P(CB_PAIR_Y(refmod)) &&
                            cb_get_int (CB_PAIR_Y(refmod))< 1) {
                                cb_error_x (name, _("FUNCTION %s has invalid reference modification"), cbp->name);
                                return cb_error_node;
                        }
                }
                /* cb_tree      x; */
                switch (cbp->intr_enum) {
                case CB_INTR_LENGTH:
                case CB_INTR_BYTE_LENGTH:
                        x = CB_VALUE (args);
                        if (CB_INTRINSIC_P (x)) {
                                return make_intrinsic (name, cbp, args, NULL, NULL);
                        } else if ((CB_FIELD_P (x) || CB_REFERENCE_P (x)) &&
                                    cb_field(x)->flag_any_length) {
                                return make_intrinsic (name, cbp, args, NULL, NULL);
                        } else {
                                return cb_build_length (CB_VALUE (args));
                        }

                case CB_INTR_WHEN_COMPILED:
                        if (refmod) {
                                return make_intrinsic (name, cbp,
                                        cb_list_init (cb_intr_whencomp), NULL, refmod);
                        } else {
                                return cb_intr_whencomp;
                        }
                case CB_INTR_PI:
                        return cb_intr_pi;
                case CB_INTR_E:
                        return cb_intr_e;

                case CB_INTR_LOWER_CASE:
                case CB_INTR_UPPER_CASE:
                case CB_INTR_REVERSE:
/* RXW Why did I do this ? - still do not know
                        if (CB_INTRINSIC_P (CB_VALUE (args))) {
                                return make_intrinsic (name, cbp, args, cb_int0);
                        } else {
                                return make_intrinsic (name, cbp, args,
                                                       cb_build_length (CB_VALUE (args)));
                        }
RXW */

                case CB_INTR_ABS:
                case CB_INTR_ACOS:
                case CB_INTR_ANNUITY:
                case CB_INTR_ASIN:
                case CB_INTR_ATAN:
                case CB_INTR_CHAR:
                case CB_INTR_COMBINED_DATETIME:
                case CB_INTR_COS:
                case CB_INTR_CURRENT_DATE:
                case CB_INTR_DATE_OF_INTEGER:
                case CB_INTR_DAY_OF_INTEGER:
                case CB_INTR_EXCEPTION_FILE:
                case CB_INTR_EXCEPTION_LOCATION:
                case CB_INTR_EXCEPTION_STATUS:
                case CB_INTR_EXCEPTION_STATEMENT:
                case CB_INTR_EXP:
                case CB_INTR_EXP10:
                case CB_INTR_FACTORIAL:
                case CB_INTR_FRACTION_PART:
                case CB_INTR_INTEGER:
                case CB_INTR_INTEGER_OF_DATE:
                case CB_INTR_INTEGER_OF_DAY:
                case CB_INTR_INTEGER_PART:
                case CB_INTR_LOCALE_DATE:
                case CB_INTR_LOCALE_TIME:
                case CB_INTR_LOCALE_TIME_FROM_SECS:
                case CB_INTR_LOG:
                case CB_INTR_LOG10:
                case CB_INTR_MOD:
                case CB_INTR_NUMVAL:
                case CB_INTR_NUMVAL_C:
                case CB_INTR_ORD:
                case CB_INTR_REM:
                case CB_INTR_SECONDS_FROM_FORMATTED_TIME:
                case CB_INTR_SECONDS_PAST_MIDNIGHT:
                case CB_INTR_SIGN:
                case CB_INTR_SIN:
                case CB_INTR_SQRT:
                case CB_INTR_STORED_CHAR_LENGTH:
                case CB_INTR_TAN:
                case CB_INTR_TEST_DATE_YYYYMMDD:
                case CB_INTR_TEST_DAY_YYYYDDD:
                case CB_INTR_TRIM:
                        return make_intrinsic (name, cbp, args, NULL, refmod);

                case CB_INTR_CONCATENATE:
                        return make_intrinsic (name, cbp, args, cb_int1, refmod);
                case CB_INTR_DATE_TO_YYYYMMDD:
                case CB_INTR_DAY_TO_YYYYDDD:
                case CB_INTR_MAX:
                case CB_INTR_MEAN:
                case CB_INTR_MEDIAN:
                case CB_INTR_MIDRANGE:
                case CB_INTR_MIN:
                case CB_INTR_ORD_MAX:
                case CB_INTR_ORD_MIN:
                case CB_INTR_PRESENT_VALUE:
                case CB_INTR_RANDOM:
                case CB_INTR_RANGE:
                case CB_INTR_STANDARD_DEVIATION:
                case CB_INTR_SUM:
                case CB_INTR_VARIANCE:
                case CB_INTR_YEAR_TO_YYYY:
                        return make_intrinsic (name, cbp, args, cb_int1, NULL);
                case CB_INTR_SUBSTITUTE:
                case CB_INTR_SUBSTITUTE_CASE:
                        if (numargs < 3 || (numargs % 2) == 0) {
                                cb_error_x (name, _("FUNCTION %s has wrong number of arguments"), cbp->name);
                                return cb_error_node;
                        }
                        return make_intrinsic (name, cbp, args, cb_int1, refmod);

                default:
                        break;
                }
        }
        cb_error_x (name, _("FUNCTION %s not implemented"), CB_NAME (name));
        return cb_error_node;
}

Here is the call graph for this function:

cb_tree cb_build_label ( cb_tree  name,
struct cb_label section 
)

Definition at line 2081 of file tree.c.

{
        struct cb_label *p;

        p = make_tree (CB_TAG_LABEL, CB_CATEGORY_UNKNOWN, sizeof (struct cb_label));
        p->id = cb_id++;
        p->name = (const unsigned char *)cb_define (name, CB_TREE (p));
        p->orig_name = p->name;
        p->section = section;
        return CB_TREE (p);
}

Here is the call graph for this function:

cb_tree cb_build_list ( cb_tree  purpose,
cb_tree  value,
cb_tree  rest 
)

Definition at line 769 of file tree.c.

{
        struct cb_list *p;

        p = make_tree (CB_TAG_LIST, CB_CATEGORY_UNKNOWN, sizeof (struct cb_list));
        p->purpose = purpose;
        p->value = value;
        p->chain = rest;
        return CB_TREE (p);
}
cb_tree cb_build_locale_name ( cb_tree  name,
cb_tree  list 
)

Definition at line 957 of file tree.c.

{
        struct cb_class_name    *p;

        p = make_tree (CB_TAG_LOCALE_NAME, CB_CATEGORY_UNKNOWN, sizeof (struct cb_locale_name));
        p->name = cb_define (name, CB_TREE (p));
        p->cname = to_cname (p->name);
        p->list = list;
        return CB_TREE (p);
}

Here is the call graph for this function:

cb_tree cb_build_numeric_literal ( int  sign,
const unsigned char *  data,
int  scale 
)

Definition at line 988 of file tree.c.

{
        struct cb_literal *p;

        p = build_literal (CB_CATEGORY_NUMERIC, data, strlen ((char *)data));
        p->sign = (char)sign;
        p->scale = (char)scale;
        return CB_TREE (p);
}

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_perform ( int  type)

Definition at line 2199 of file tree.c.

{
        struct cb_perform *p;

        p = make_tree (CB_TAG_PERFORM, CB_CATEGORY_UNKNOWN, sizeof (struct cb_perform));
        p->type = type;
        return CB_TREE (p);
}

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 2209 of file tree.c.

{
        struct cb_perform_varying *p;

        p = make_tree (CB_TAG_PERFORM_VARYING, CB_CATEGORY_UNKNOWN, sizeof (struct cb_perform_varying));
        p->name = name;
        p->from = from;
        p->step = name ? cb_build_add (name, by, cb_high) : NULL;
        p->until = until;
        return CB_TREE (p);
}

Here is the call graph for this function:

cb_tree cb_build_picture ( const char *  str)

Definition at line 1090 of file tree.c.

{
        struct cb_picture       *pic;
        const char              *p;
        size_t                  idx = 0;
        size_t                  buffcnt = 0;
        size_t                  at_beginning;
        size_t                  at_end;
        size_t                  p_char_seen;
        size_t                  s_char_seen;
        int                     category = 0;
        int                     size = 0;
        int                     allocated = 0;
        int                     digits = 0;
        int                     scale = 0;
        int                     s_count = 0;
        int                     v_count = 0;
        int                     i;
        int                     n;
        unsigned char           c;
        unsigned char           lastonechar = 0;
        unsigned char           lasttwochar = 0;
        unsigned char           buff[COB_SMALL_BUFF];

        pic = make_tree (CB_TAG_PICTURE, CB_CATEGORY_UNKNOWN, sizeof (struct cb_picture));
        if (strlen (str) > 50) {
                goto error;
        }
        memset (buff, 0, sizeof (buff));
        p_char_seen = 0;
        s_char_seen = 0;
        for (p = str; *p; p++) {
                n = 1;
                c = *p;
repeat:
                /* count the number of repeated chars */
                while (p[1] == c) {
                        p++, n++;
                }

                /* add parenthesized numbers */
                if (p[1] == '(') {
                        i = 0;
                        p += 2;
                        for (; *p == '0'; p++) {
                                ;
                        }
                        for (; *p != ')'; p++) {
                                if (!isdigit (*p)) {
                                        goto error;
                                } else {
                                        allocated++;
                                        if (allocated > 9) {
                                                goto error;
                                        }
                                        i = i * 10 + (*p - '0');
                                }
                        }
                        if (i == 0) {
                                goto error;
                        }
                        n += i - 1;
                        goto repeat;
                }

                /* check grammar and category */
                /* FIXME: need more error check */
                switch (c) {
                case 'A':
                        if (s_char_seen || p_char_seen) {
                                goto error;
                        }
                        category |= PIC_ALPHABETIC;
                        break;

                case 'X':
                        if (s_char_seen || p_char_seen) {
                                goto error;
                        }
                        category |= PIC_ALPHANUMERIC;
                        break;

                case '9':
                        category |= PIC_NUMERIC;
                        digits += n;
                        if (v_count) {
                                scale += n;
                        }
                        break;

                case 'N':
                        if (s_char_seen || p_char_seen) {
                                goto error;
                        }
                        category |= PIC_NATIONAL;
                        break;

                case 'S':
                        category |= PIC_NUMERIC;
                        if (category & PIC_ALPHABETIC) {
                                goto error;
                        }
                        s_count += n;
                        if (s_count > 1 || idx != 0) {
                                goto error;
                        }
                        s_char_seen = 1;
                        continue;

                case ',':
                case '.':
                        category |= PIC_NUMERIC_EDITED;
                        if (s_char_seen || p_char_seen) {
                                goto error;
                        }
                        if (c != current_program->decimal_point) {
                                break;
                        }
                        /* fall through */
                case 'V':
                        category |= PIC_NUMERIC;
                        if (category & PIC_ALPHABETIC) {
                                goto error;
                        }
                        v_count += n;
                        if (v_count > 1) {
                                goto error;
                        }
                        break;

                case 'P':
                        category |= PIC_NUMERIC;
                        if (category & PIC_ALPHABETIC) {
                                goto error;
                        }
                        if (p_char_seen) {
                                goto error;
                        }
                        at_beginning = 0;
                        at_end = 0;
                        switch (buffcnt) {
                        case 0:
                                /* P..... */
                                at_beginning = 1;
                                break;
                        case 1:
                                /* VP.... */
                                /* SP.... */
                                if (lastonechar == 'V' || lastonechar == 'S') {
                                        at_beginning = 1;
                                }
                                break;
                        case 2:
                                /* SVP... */
                                if (lasttwochar == 'S' && lastonechar == 'V') {
                                        at_beginning = 1;
                                }
                                break;
                        }
                        if (p[1] == 0 || (p[1] == 'V' && p[2] == 0)) {
                                /* .....P */
                                /* ....PV */
                                at_end = 1;
                        }
                        if (!at_beginning && !at_end) {
                                goto error;
                        }
                        p_char_seen = 1;
                        if (at_beginning) {
                                v_count++;      /* implicit V */
                        }
                        digits += n;
                        if (v_count) {
                                scale += n;
                        } else {
                                scale -= n;
                        }
                        break;

                case '0':
                case 'B':
                case '/':
                        category |= PIC_EDITED;
                        if (s_char_seen || p_char_seen) {
                                goto error;
                        }
                        break;

                case '*':
                case 'Z':
                        category |= PIC_NUMERIC_EDITED;
                        if (category & PIC_ALPHABETIC) {
                                goto error;
                        }
                        if (s_char_seen || p_char_seen) {
                                goto error;
                        }
                        digits += n;
                        if (v_count) {
                                scale += n;
                        }
                        break;

                case '+':
                case '-':
                        category |= PIC_NUMERIC_EDITED;
                        if (category & PIC_ALPHABETIC) {
                                goto error;
                        }
                        if (s_char_seen || p_char_seen) {
                                goto error;
                        }
                        digits += n - 1;
                        s_count++;
                        /* FIXME: need more check */
                        break;

                case 'C':
                        category |= PIC_NUMERIC_EDITED;
                        if (!(p[1] == 'R' && p[2] == 0)) {
                                goto error;
                        }
                        if (s_char_seen || p_char_seen) {
                                goto error;
                        }
                        p++;
                        s_count++;
                        break;

                case 'D':
                        category |= PIC_NUMERIC_EDITED;
                        if (!(p[1] == 'B' && p[2] == 0)) {
                                goto error;
                        }
                        if (s_char_seen || p_char_seen) {
                                goto error;
                        }
                        p++;
                        s_count++;
                        break;

                default:
                        if (c == current_program->currency_symbol) {
                                category |= PIC_NUMERIC_EDITED;
                                digits += n - 1;
                                /* FIXME: need more check */
                                break;
                        }

                        goto error;
                }

                /* calculate size */
                if (c != 'V' && c != 'P') {
                        size += n;
                }
                if (c == 'C' || c == 'D' || c == 'N') {
                        size += n;
                }

                /* store in the buffer */
                buff[idx++] = c;
                lasttwochar = lastonechar;
                lastonechar = c;
                memcpy (&buff[idx], (unsigned char *)&n, sizeof(int));
                idx += sizeof(int);
                ++buffcnt;
        }
        buff[idx] = 0;

        if (size == 0 && v_count) {
                goto error;
        }
        /* set picture */
        pic->orig = strdup (str);
        pic->size = size;
        pic->digits = (unsigned char)digits;
        pic->scale = (signed char)scale;
        pic->have_sign = (unsigned char)s_count;

        /* set picture category */
        switch (category) {
        case PIC_ALPHABETIC:
                pic->category = CB_CATEGORY_ALPHABETIC;
                break;
        case PIC_NUMERIC:
                pic->category = CB_CATEGORY_NUMERIC;
                if (digits > 36) {
                        cb_error (_("Numeric field cannot be larger than 36 digits"));
                }
                break;
        case PIC_ALPHANUMERIC:
        case PIC_NATIONAL:
                pic->category = CB_CATEGORY_ALPHANUMERIC;
                break;
        case PIC_NUMERIC_EDITED:
                pic->str = cobc_malloc (idx + 1);
                memcpy (pic->str, buff, idx);
                pic->category = CB_CATEGORY_NUMERIC_EDITED;
                pic->lenstr = idx;
                break;
        case PIC_EDITED:
        case PIC_ALPHABETIC_EDITED:
        case PIC_ALPHANUMERIC_EDITED:
        case PIC_NATIONAL_EDITED:
                pic->str = cobc_malloc (idx + 1);
                memcpy (pic->str, buff, idx);
                pic->category = CB_CATEGORY_ALPHANUMERIC_EDITED;
                pic->lenstr = idx;
                break;
        default:
                goto error;
        }
        goto end;

error:
        cb_error (_("Invalid picture string - '%s'"), str);

end:
        return CB_TREE (pic);
}

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,
int  nest_level 
) [read]

Definition at line 841 of file tree.c.

{
        struct cb_program *p;

        cb_reset_78 ();
        cb_reset_in_procedure ();
        cb_clear_real_field ();
        p = cobc_malloc (sizeof (struct cb_program));
        p->next_program = last_program;
        p->nested_level = nest_level;
        p->decimal_point = '.';
        p->currency_symbol = '$';
        p->numeric_separator = ',';
        if (nest_level) {
                p->global_file_list = last_program->global_file_list;
                p->collating_sequence = last_program->collating_sequence;
                p->function_spec_list = last_program->function_spec_list;
                p->class_spec_list = last_program->class_spec_list;
                p->interface_spec_list = last_program->interface_spec_list;
                p->program_spec_list = last_program->program_spec_list;
                p->property_spec_list = last_program->property_spec_list;
                p->alphabet_name_list = last_program->alphabet_name_list;
                p->class_name_list = last_program->class_name_list;
                p->locale_list = last_program->locale_list;
                p->symbolic_list = last_program->symbolic_list;
                p->decimal_point = last_program->decimal_point;
                p->numeric_separator = last_program->numeric_separator;
                p->currency_symbol = last_program->currency_symbol;
                p->cb_return_code = last_program->cb_return_code;
        } else {
                functions_are_all = cb_flag_functions_all;
        }
        return p;
}

Here is the call graph for this function:

cb_tree cb_build_reference ( const char *  name)

Definition at line 1730 of file tree.c.

{
        struct cb_reference *p;

        p = make_tree (CB_TAG_REFERENCE, CB_CATEGORY_UNKNOWN, sizeof (struct cb_reference));
        p->word = lookup_word (name);
        return CB_TREE (p);
}

Here is the caller graph for this function:

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

Definition at line 2131 of file tree.c.

{
        struct cb_search *p;

        p = make_tree (CB_TAG_SEARCH, CB_CATEGORY_UNKNOWN, sizeof (struct cb_search));
        p->flag_all = flag_all;
        p->table = table;
        p->var = var;
        p->end_stmt = end_stmt;
        p->whens = whens;
        return CB_TREE (p);
}

Here is the caller graph for this function:

struct cb_statement* cb_build_statement ( const char *  name) [read]

Definition at line 2226 of file tree.c.

{
        struct cb_statement *p;

        p = make_tree (CB_TAG_STATEMENT, CB_CATEGORY_UNKNOWN, sizeof (struct cb_statement));
        p->name = name;
        return p;
}
cb_tree cb_build_string ( const unsigned char *  data,
size_t  size 
)

Definition at line 908 of file tree.c.

{
        struct cb_string *p;

        p = make_tree (CB_TAG_STRING, CB_CATEGORY_ALPHANUMERIC, sizeof (struct cb_string));
        p->size = size;
        p->data = data;
        return CB_TREE (p);
}
cb_tree cb_build_system_name ( enum cb_system_name_category  category,
int  token 
)

Definition at line 973 of file tree.c.

{
        struct cb_system_name *p;

        p = make_tree (CB_TAG_SYSTEM_NAME, CB_CATEGORY_UNKNOWN, sizeof (struct cb_system_name));
        p->category = category;
        p->token = token;
        return CB_TREE (p);
}

Here is the caller graph for this function:

cb_tree cb_concat_literals ( cb_tree  x1,
cb_tree  x2 
)

Definition at line 1005 of file tree.c.

{
        unsigned char           *buff;
        cb_tree                 x;
        unsigned char           *data1;
        unsigned char           *data2;
        size_t                  size1;
        size_t                  size2;

        if (x1 == cb_error_node || x2 == cb_error_node) {
                return cb_error_node;
        }
        if (CB_LITERAL_P (x1)) {
                data1 = CB_LITERAL (x1)->data;
                size1 = CB_LITERAL (x1)->size;
        } else if (CB_CONST_P (x1)) {
                size1 = 1;
                if (x1 == cb_space) {
                        data1 = (unsigned char *)" ";
                } else if (x1 == cb_zero) {
                        data1 = (unsigned char *)"0";
                } else if (x1 == cb_quote) {
                        data1 = (unsigned char *)"\"";
                } else if (x1 == cb_norm_low) {
                        data1 = (unsigned char *)"\0";
                } else if (x1 == cb_norm_high) {
                        data1 = (unsigned char *)"\255";
                } else if (x1 == cb_null) {
                        data1 = (unsigned char *)"\0";
                } else {
                        return cb_error_node;
                }
        } else {
                return cb_error_node;
        }
        if (CB_LITERAL_P (x2)) {
                data2 = CB_LITERAL (x2)->data;
                size2 = CB_LITERAL (x2)->size;
        } else if (CB_CONST_P (x2)) {
                size2 = 1;
                if (x2 == cb_space) {
                        data2 = (unsigned char *)" ";
                } else if (x2 == cb_zero) {
                        data2 = (unsigned char *)"0";
                } else if (x2 == cb_quote) {
                        data2 = (unsigned char *)"\"";
                } else if (x2 == cb_norm_low) {
                        data2 = (unsigned char *)"\0";
                } else if (x2 == cb_norm_high) {
                        data2 = (unsigned char *)"\255";
                } else if (x2 == cb_null) {
                        data2 = (unsigned char *)"\0";
                } else {
                        return cb_error_node;
                }
        } else {
                return cb_error_node;
        }
        buff = cobc_malloc (size1 + size2 + 3);
        memcpy (buff, data1, size1);
        memcpy (buff + size1, data2, size2);
        x = cb_build_alphanumeric_literal (buff, size1 + size2);
        free (buff);
        return x;
}

Here is the call graph for this function:

const char* cb_define ( cb_tree  name,
cb_tree  val 
)

Definition at line 1769 of file tree.c.

{
        struct cb_word *w;

        w = CB_REFERENCE (name)->word;
        w->items = cb_list_add (w->items, val);
        w->count++;
        val->source_file = name->source_file;
        val->source_line = name->source_line;
        CB_REFERENCE (name)->value = val;
        return w->name;
}

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_define_system_name ( const char *  name)

Definition at line 1783 of file tree.c.

{
        cb_tree x;

        x = cb_build_reference (name);
        if (CB_REFERENCE (x)->word->count == 0) {
                cb_define (x, lookup_system_name (name));
        }
}

Here is the call graph for this function:

struct cb_field* cb_field ( cb_tree  x) [read]

Definition at line 1458 of file tree.c.

{
        if (CB_REFERENCE_P (x)) {
                return CB_FIELD (cb_ref (x));
        } else {
                return CB_FIELD (x);
        }
}

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 
) [read]

Definition at line 1468 of file tree.c.

{
        struct cb_field *t;

        if (f == NULL) {
                return p;
        }
        for (t = f; t->sister; t = t->sister) {
                ;
        }
        t->sister = p;
        return f;
}

Here is the caller graph for this function:

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

Definition at line 1521 of file tree.c.

{
        while (f->parent) {
                f = f->parent;
        }
        return f;
}

Here is the caller graph for this function:

int cb_field_size ( cb_tree  x)

Definition at line 1483 of file tree.c.

{
        struct cb_reference     *r;
        struct cb_field         *f;

        switch (CB_TREE_TAG (x)) {
        case CB_TAG_LITERAL:
                return CB_LITERAL (x)->size;
        case CB_TAG_FIELD:
                return CB_FIELD (x)->size;
        case CB_TAG_REFERENCE:
                r = CB_REFERENCE (x);
                f = CB_FIELD (r->value);

                if (r->length) {
                        if (CB_LITERAL_P (r->length)) {
                                return cb_get_int (r->length);
                        } else {
                                return -1;
                        }
                } else if (r->offset) {
                        if (CB_LITERAL_P (r->offset)) {
                                return f->size - cb_get_int (r->offset) + 1;
                        } else {
                                return -1;
                        }
                } else {
                        return f->size;
                }
        default:
                fprintf (stderr, "Unexpected tree tag %d\n", CB_TREE_TAG (x));
                ABORT ();
        }
/* NOT REACHED */
        return 0;
}

Here is the call graph for this function:

Here is the caller graph for this function:

int cb_field_subordinate ( struct cb_field p,
struct cb_field f 
)

Definition at line 1562 of file tree.c.

{
        for (p = p->parent; p; p = p->parent) {
                if (p == f) {
                        return 1;
                }
        }
        return 0;
}
struct cb_field* cb_field_variable_address ( struct cb_field f) [read]

Definition at line 1545 of file tree.c.

{
        struct cb_field *p;

        for (p = f->parent; p; f = f->parent, p = f->parent) {
                for (p = p->children; p != f; p = p->sister) {
                        if (p->occurs_depending || cb_field_variable_size (p)) {
                                return p;
                        }
                }
        }
        return NULL;
}

Here is the call graph for this function:

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

Definition at line 1530 of file tree.c.

{
        struct cb_field *p;

        for (f = f->children; f; f = f->sister) {
                if (f->occurs_depending) {
                        return f;
                } else if ((p = cb_field_variable_size (f)) != NULL) {
                        return p;
                }
        }
        return NULL;
}

Here is the call graph for this function:

Here is the caller graph for this function:

int cb_fits_int ( cb_tree  x)

Definition at line 587 of file tree.c.

{
        struct cb_literal       *l;
        struct cb_field         *f;

        switch (CB_TREE_TAG (x)) {
        case CB_TAG_LITERAL:
                l = CB_LITERAL (x);
                if (l->scale <= 0 && l->size < 10) {
                        return 1;
                }
                return 0;
        case CB_TAG_FIELD:
                f = CB_FIELD (x);
                switch (f->usage) {
                case CB_USAGE_INDEX:
                case CB_USAGE_LENGTH:
                        return 1;
                case CB_USAGE_BINARY:
                case CB_USAGE_COMP_5:
                case CB_USAGE_COMP_X:
                        if (f->pic->scale <= 0 && f->size <= (int)sizeof (int)) {
                                return 1;
                        }
                        return 0;
                case CB_USAGE_DISPLAY:
                        if (f->size < 10) {
                                if (!f->pic || f->pic->scale <= 0) {
                                        return 1;
                                }
                        }
                        return 0;
                case CB_USAGE_PACKED:
                        if (f->pic->scale <= 0 && f->pic->digits < 10) {
                                return 1;
                        }
                        return 0;
                default:
                        return 0;
                }
        case CB_TAG_REFERENCE:
                return cb_fits_int (CB_REFERENCE (x)->value);
        default:
                return 0;
        }
}

Here is the call graph for this function:

Here is the caller graph for this function:

int cb_fits_long_long ( cb_tree  x)

Definition at line 635 of file tree.c.

{
        struct cb_literal       *l;
        struct cb_field         *f;

        switch (CB_TREE_TAG (x)) {
        case CB_TAG_LITERAL:
                l = CB_LITERAL (x);
                if (l->scale <= 0 && l->size < 19) {
                        return 1;
                }
                return 0;
        case CB_TAG_FIELD:
                f = CB_FIELD (x);
                switch (f->usage) {
                case CB_USAGE_INDEX:
                case CB_USAGE_LENGTH:
                        return 1;
                case CB_USAGE_BINARY:
                case CB_USAGE_COMP_5:
                case CB_USAGE_COMP_X:
                        if (f->pic->scale <= 0 && f->size <= (int)sizeof (long long)) {
                                return 1;
                        }
                        return 0;
                case CB_USAGE_DISPLAY:
                        if (f->pic->scale <= 0 && f->size < 19) {
                                return 1;
                        }
                        return 0;
                default:
                        return 0;
                }
        case CB_TAG_REFERENCE:
                return cb_fits_long_long (CB_REFERENCE (x)->value);
        default:
                return 0;
        }
}

Here is the call graph for this function:

Here is the caller graph for this function:

int cb_get_int ( cb_tree  x)

Definition at line 676 of file tree.c.

{
        struct cb_literal       *l;
        size_t                  i;
        int                     val = 0;

        l = CB_LITERAL (x);
        for (i = 0; i < l->size; i++) {
                if (l->data[i] != '0') {
                        break;
                }
        }

/* RXWRXW
        if (l->size - i >= 10) {
                ABORT ();
        }
*/

        for (; i < l->size; i++) {
                val = val * 10 + l->data[i] - '0';
        }
        if (l->sign < 0) {
                val = -val;
        }
        return val;
}

Here is the caller graph for this function:

long long cb_get_long_long ( cb_tree  x)

Definition at line 705 of file tree.c.

{
        struct cb_literal       *l;
        size_t                  i;
        long long               val = 0;

        l = CB_LITERAL (x);
        for (i = 0; i < l->size; i++) {
                if (l->data[i] != '0') {
                        break;
                }
        }

        if (l->size - i >= 19) {
                ABORT ();
        }

        for (; i < l->size; i++) {
                val = val * 10 + l->data[i] - '0';
        }
        if (l->sign < 0) {
                val = -val;
        }
        return val;
}

Here is the caller graph for this function:

void cb_init_constants ( void  )

Definition at line 732 of file tree.c.

{
        char    *s;
        int     i;

        cb_error_node = make_constant (CB_CATEGORY_UNKNOWN, NULL);
        cb_any = make_constant (CB_CATEGORY_UNKNOWN, NULL);
        cb_true = make_constant (CB_CATEGORY_BOOLEAN, "1");
        cb_false = make_constant (CB_CATEGORY_BOOLEAN, "0");
        cb_null = make_constant (CB_CATEGORY_DATA_POINTER, "0");
        cb_zero = make_constant (CB_CATEGORY_NUMERIC, "&cob_zero");
        cb_one = make_constant (CB_CATEGORY_NUMERIC, "&cob_one");
        cb_space = make_constant (CB_CATEGORY_ALPHANUMERIC, "&cob_space");
        cb_low = make_constant (CB_CATEGORY_ALPHANUMERIC, "&cob_low");
        cb_norm_low = cb_low;
        cb_high = make_constant (CB_CATEGORY_ALPHANUMERIC, "&cob_high");
        cb_norm_high = cb_high;
        cb_quote = make_constant (CB_CATEGORY_ALPHANUMERIC, "&cob_quote");
        cb_int0 = cb_int (0);
        cb_int1 = cb_int (1);
        cb_int2 = cb_int (2);
        cb_int3 = cb_int (3);
        cb_int4 = cb_int (4);
        cb_int5 = cb_int (5);
        for (i = 1; i < 8; i++) {
                s = cobc_malloc (4);
                sprintf (s, "i%d", i);
                cb_i[i] = make_constant (CB_CATEGORY_NUMERIC, s);
        }
        cb_standard_error_handler = make_constant_label ("Default Error Handler");
}

Here is the call graph for this function:

cb_tree cb_int ( int  n)

Definition at line 881 of file tree.c.

{
        struct cb_integer       *x;
        struct int_node         *p;

        for (p = int_node_table; p; p = p->next) {
                if (p->n == n) {
                        return p->node;
                }
        }

        x = make_tree (CB_TAG_INTEGER, CB_CATEGORY_NUMERIC, sizeof (struct cb_integer));
        x->val = n;

        p = cobc_malloc (sizeof (struct int_node));
        p->n = n;
        p->node = CB_TREE (x);
        p->next = int_node_table;
        int_node_table = p;
        return p->node;
}

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_list_add ( cb_tree  l,
cb_tree  x 
)

Definition at line 798 of file tree.c.

{
        return cb_list_append (l, cb_list_init (x));
}

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 781 of file tree.c.

{
        cb_tree l;

        if (l1 == NULL) {
                return l2;
        } else {
                l = l1;
                while (CB_CHAIN (l)) {
                        l = CB_CHAIN (l);
                }
                CB_CHAIN (l) = l2;
                return l1;
        }
}

Here is the caller graph for this function:

int cb_list_length ( cb_tree  l)

Definition at line 818 of file tree.c.

{
        int n = 0;

        for (; l; l = CB_CHAIN (l)) {
                n++;
        }
        return n;
}

Here is the caller graph for this function:

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

Definition at line 829 of file tree.c.

{
        for (; l; l = CB_CHAIN (l)) {
                CB_VALUE (l) = func (CB_VALUE (l));
        }
}

Here is the caller graph for this function:

cb_tree cb_list_reverse ( cb_tree  l)

Definition at line 804 of file tree.c.

{
        cb_tree next;
        cb_tree last = NULL;

        for (; l; l = next) {
                next = CB_CHAIN (l);
                CB_CHAIN (l) = last;
                last = l;
        }
        return last;
}

Here is the caller graph for this function:

char* cb_name ( cb_tree  x)

Definition at line 441 of file tree.c.

{
        if (!treenamebuff) {
                treenamebuff = cobc_malloc (COB_NORMAL_BUFF);
        }
        cb_name_1 (treenamebuff, x);
        return treenamebuff;
}

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_ref ( cb_tree  x)

Definition at line 1794 of file tree.c.

{
        struct cb_reference     *r;
        struct cb_field         *p;
        struct cb_label         *s;
        cb_tree                 candidate = NULL;
        cb_tree                 items;
        cb_tree                 cb1;
        cb_tree                 cb2;
        cb_tree                 v;
        cb_tree                 c;
        struct cb_program       *prog;
        struct cb_word          *w;
        size_t                  val;
        size_t                  ambiguous = 0;

        r = CB_REFERENCE (x);
        /* if this reference has already been resolved (and the value
           has been cached), then just return the value */
        if (r->value) {
                return r->value;
        }
        /* resolve the value */

        items = r->word->items;
        for (; items; items = CB_CHAIN (items)) {
                /* find a candidate value by resolving qualification */
                v = CB_VALUE (items);
                c = r->chain;
                switch (CB_TREE_TAG (v)) {
                case CB_TAG_FIELD:
                        /* in case the value is a field, it might be qualified
                           by its parent names and a file name */
                        if (CB_FIELD (v)->flag_indexed_by) {
                                p = CB_FIELD (v)->index_qual;
                        } else {
                                p = CB_FIELD (v)->parent;
                        }
                        /* resolve by parents */
                        for (; p; p = p->parent) {
                                if (c && strcasecmp (CB_NAME (c), p->name) == 0) {
                                        c = CB_REFERENCE (c)->chain;
                                }
                        }

                        /* resolve by file */
                        if (c && CB_REFERENCE (c)->chain == NULL) {
                                if (CB_REFERENCE (c)->word->count == 1 && CB_FILE_P (cb_ref (c))
                                    && (CB_FILE (cb_ref (c)) == cb_field_founder (CB_FIELD (v))->file)) {
                                        c = CB_REFERENCE (c)->chain;
                                }
                        }

                        break;
                case CB_TAG_LABEL:
                        /* in case the value is a label, it might be qualified
                           by its section name */
                        s = CB_LABEL (v)->section;

                        /* unqualified paragraph name referenced within the section
                           is resolved without ambiguity check if not duplicated */
                        if (c == NULL && r->offset && s == CB_LABEL (r->offset)) {
                                for (cb1 = CB_CHAIN (items); cb1; cb1 = CB_CHAIN (cb1)) {
                                        cb2 = CB_VALUE (cb1);
                                        if (s == CB_LABEL (cb2)->section) {
                                                ambiguous_error (x);
                                                goto error;
                                        }
                                }
                                candidate = v;
                                goto end;
                        }

                        /* resolve by section name */
                        if (c && s && strcasecmp (CB_NAME (c), (char *)s->name) == 0) {
                                c = CB_REFERENCE (c)->chain;
                        }

                        break;
                default:
                        /* other values cannot be qualified */
                        break;
                }

                /* a well qualified value is a good candidate */
                if (c == NULL) {
                        if (candidate == NULL) {
                                /* keep the first candidate */
                                candidate = v;
                        } else {
                                /* multiple candidates and possibly ambiguous */
                                ambiguous = 1;
                                /* continue search because the reference might not
                                   be ambiguous and exit loop by "goto end" later */
                        }
                }
        }

        /* there is no candidate */
        if (candidate == NULL) {
                if (current_program->nested_level > 0) {
                        /* Nested program - check parents for GLOBAL candidate */
                        ambiguous = 0;
                        val = hash ((const unsigned char *)r->word->name);
                        prog = current_program->next_program;
                        for (; prog; prog = prog->next_program) {
                                if (prog->nested_level >= current_program->nested_level) {
                                        continue;
                                }
                                for (w = prog->word_table[val]; w; w = w->next) {
                                        if (strcasecmp (r->word->name, w->name) == 0) {
                                                candidate = global_check (r, w->items, &ambiguous);
                                                if (candidate) {
                                                        if (ambiguous) {
                                                                ambiguous_error (x);
                                                                goto error;
                                                        }
                                                        if (CB_FILE_P(candidate)) {
                                                                current_program->gen_file_error = 1;
                                                        }
                                                        goto end;
                                                }
                                        }
                                }
                                if (prog->nested_level == 0) {
                                        break;
                                }
                        }
                }
                undefined_error (x);
                goto error;
        }

        /* the reference is ambiguous */
        if (ambiguous) {
                ambiguous_error (x);
                goto error;
        }

end:
        if (CB_FIELD_P (candidate)) {
                CB_FIELD (candidate)->count++;
                if (CB_FIELD (candidate)->flag_invalid) {
                        goto error;
                }
        }

        r->value = candidate;
        return r->value;

error:
        r->value = cb_error_node;
        return cb_error_node;
}

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 458 of file tree.c.

{
        struct cb_cast          *p;
        struct cb_reference     *r;
        struct cb_field         *f;

        if (x == cb_error_node) {
                return 0;
        }
        if (x->category != CB_CATEGORY_UNKNOWN) {
                return x->category;
        }

        switch (CB_TREE_TAG (x)) {
        case CB_TAG_CAST:
                p = CB_CAST (x);
                switch (p->type) {
                case CB_CAST_ADDRESS:
                case CB_CAST_ADDR_OF_ADDR:
                        x->category = CB_CATEGORY_DATA_POINTER;
                        break;
                case CB_CAST_PROGRAM_POINTER:
                        x->category = CB_CATEGORY_PROGRAM_POINTER;
                        break;
                default:
                        fprintf (stderr, "Unexpected cast type -> %d\n", p->type);
                        ABORT ();
                }
                break;
        case CB_TAG_REFERENCE:
                r = CB_REFERENCE (x);
                if (r->offset) {
                        x->category = CB_CATEGORY_ALPHANUMERIC;
                } else {
                        x->category = cb_tree_category (r->value);
                }
                break;
        case CB_TAG_FIELD:
                f = CB_FIELD (x);
                if (f->children) {
                        x->category = CB_CATEGORY_ALPHANUMERIC;
                } else if (f->usage == CB_USAGE_POINTER && f->level != 88) {
                        x->category = CB_CATEGORY_DATA_POINTER;
                } else if (f->usage == CB_USAGE_PROGRAM_POINTER && f->level != 88) {
                        x->category = CB_CATEGORY_PROGRAM_POINTER;
                } else {
                        switch (f->level) {
                        case 66:
                                if (f->rename_thru) {
                                        x->category = CB_CATEGORY_ALPHANUMERIC;
                                } else {
                                        x->category = cb_tree_category (CB_TREE (f->redefines));
                                }
                                break;
                        case 88:
                                x->category = CB_CATEGORY_BOOLEAN;
                                break;
                        default:
                                x->category = f->pic->category;
                                break;
                        }
                }
                break;
        case CB_TAG_ALPHABET_NAME:
        case CB_TAG_LOCALE_NAME:
                x->category = CB_CATEGORY_ALPHANUMERIC;
                break;
        case CB_TAG_BINARY_OP:
                x->category = CB_CATEGORY_BOOLEAN;
                break;
        default:
                fprintf (stderr, "Unknown tree tag %d Category %d\n", CB_TREE_TAG (x), x->category);
                ABORT ();
        }

        return x->category;
}

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 451 of file tree.c.

{

        return category_to_class_table[CB_TREE_CATEGORY (x)];
}
int cb_tree_type ( cb_tree  x)

Definition at line 537 of file tree.c.

{
        struct cb_field *f;

        f = cb_field (x);
        if (f->children) {
                return COB_TYPE_GROUP;
        }

        switch (CB_TREE_CATEGORY (x)) {
        case CB_CATEGORY_ALPHABETIC:
        case CB_CATEGORY_ALPHANUMERIC:
                return COB_TYPE_ALPHANUMERIC;
        case CB_CATEGORY_ALPHANUMERIC_EDITED:
                return COB_TYPE_ALPHANUMERIC_EDITED;
        case CB_CATEGORY_NUMERIC:
                switch (f->usage) {
                case CB_USAGE_DISPLAY:
                        return COB_TYPE_NUMERIC_DISPLAY;
                case CB_USAGE_BINARY:
                case CB_USAGE_COMP_5:
                case CB_USAGE_COMP_X:
                case CB_USAGE_INDEX:
                case CB_USAGE_LENGTH:
                        return COB_TYPE_NUMERIC_BINARY;
                case CB_USAGE_FLOAT:
                        return COB_TYPE_NUMERIC_FLOAT;
                case CB_USAGE_DOUBLE:
                        return COB_TYPE_NUMERIC_DOUBLE;
                case CB_USAGE_PACKED:
                        return COB_TYPE_NUMERIC_PACKED;
                default:
                        fprintf (stderr, "Unexpected numeric usage -> %d\n", f->usage);
                        ABORT ();
                }
        case CB_CATEGORY_NUMERIC_EDITED:
                return COB_TYPE_NUMERIC_EDITED;
        case CB_CATEGORY_OBJECT_REFERENCE:
        case CB_CATEGORY_DATA_POINTER:
        case CB_CATEGORY_PROGRAM_POINTER:
                return COB_TYPE_NUMERIC_BINARY;
        default:
                fprintf (stderr, "Unexpected category -> %d\n", CB_TREE_CATEGORY (x));
                ABORT ();
        }
/* NOT REACHED */
        return 0;
}

Here is the call graph for this function:

void finalize_file ( struct cb_file f,
struct cb_field records 
)

Definition at line 1611 of file tree.c.

{
        struct cb_field *p;
        struct cb_field *v;
        cb_tree         l;
        cb_tree         x;
        char            buff[COB_MINI_BUFF];

        if (f->special) {
                f->organization = COB_ORG_LINE_SEQUENTIAL;
        }
        if (f->fileid_assign && !f->assign) {
                f->assign = cb_build_alphanumeric_literal ((unsigned char *)f->name,
                                                            strlen (f->name));
        }

        /* check the record size if it is limited */
        for (p = records; p; p = p->sister) {
                if (f->record_min > 0) {
                        if (p->size < f->record_min) {
                                cb_error (_("Record size too small '%s'"), p->name);
                        }
                }
                if (f->record_max > 0) {
                        if (p->size > f->record_max) {
                                cb_error (_("Record size too large '%s' (%d)"),
                                             p->name, p->size);
                        }
                }
        }

        /* compute the record size */
        if (f->record_min == 0) {
                if (records) {
                        f->record_min = records->size;
                } else {
                        f->record_min = 0;
                }
        }
        for (p = records; p; p = p->sister) {
                v = cb_field_variable_size (p);
                if (v && v->offset + v->size * v->occurs_min < f->record_min) {
                        f->record_min = v->offset + v->size * v->occurs_min;
                }
                if (p->size < f->record_min) {
                        f->record_min = p->size;
                }
                if (p->size > f->record_max) {
                        f->record_max = p->size;
                }
        }

        if (f->same_clause) {
                for (l = current_program->file_list; l; l = CB_CHAIN (l)) {
                        if (CB_FILE (CB_VALUE (l))->same_clause == f->same_clause) {
                                if (CB_FILE (CB_VALUE (l))->finalized) {
                                        if (f->record_max > CB_FILE (CB_VALUE (l))->record->memory_size) {
                                                CB_FILE (CB_VALUE (l))->record->memory_size =
                                                    f->record_max;
                                        }
                                        f->record = CB_FILE (CB_VALUE (l))->record;
                                        for (p = records; p; p = p->sister) {
                                                p->file = f;
                                                p->redefines = f->record;
                                        }
                                        for (p = f->record->sister; p; p = p->sister) {
                                                if (!p->sister) {
                                                        p->sister = records;
                                                        break;
                                                }
                                        }
                                        f->finalized = 1;
                                        return;
                                }
                        }
                }
        }
        /* create record */
        snprintf (buff, COB_MINI_MAX, "%s_record", f->name);
        if (f->record_max == 0) {
                f->record_max = 32;
                f->record_min = 32;
        }
        if (f->organization == COB_ORG_LINE_SEQUENTIAL) {
                f->record_min = 0;
        }
        f->record = CB_FIELD (cb_build_implicit_field (cb_build_reference (buff),
                                f->record_max));
        f->record->sister = records;
        f->record->count++;
        if (f->external) {
                has_external = 1;
                f->record->flag_external = 1;
        }

        for (p = records; p; p = p->sister) {
                p->file = f;
                p->redefines = f->record;
        }
        f->finalized = 1;
        if (f->linage) {
                snprintf (buff, COB_MINI_MAX, "LC_%s", f->name);
                x = cb_build_field (cb_build_reference (buff));
                CB_FIELD (x)->pic = CB_PICTURE (cb_build_picture ("9(9)"));
                CB_FIELD (x)->usage = CB_USAGE_COMP_5;
                CB_FIELD (x)->values = cb_list_init (cb_zero);
                CB_FIELD (x)->count++;
                cb_validate_field (CB_FIELD (x));
                f->linage_ctr = cb_build_field_reference (CB_FIELD (x), NULL);
                current_program->working_storage =
                    cb_field_add (current_program->working_storage, CB_FIELD (x));
        }
}

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 1593 of file tree.c.

{
        /* check RECORD/RELATIVE KEY clause */
        switch (f->organization) {
        case COB_ORG_INDEXED:
                if (f->key == NULL) {
                        file_error (name, "RECORD KEY");
                }
                break;
        case COB_ORG_RELATIVE:
                if (f->key == NULL && f->access_mode != COB_ACCESS_SEQUENTIAL) {
                        file_error (name, "RELATIVE KEY");
                }
                break;
        }
}

Variable Documentation

Definition at line 74 of file tree.c.

Definition at line 93 of file tree.c.

Definition at line 76 of file tree.c.

Definition at line 82 of file tree.c.

Definition at line 92 of file tree.c.

Definition at line 86 of file tree.c.

Definition at line 87 of file tree.c.

Definition at line 88 of file tree.c.

Definition at line 89 of file tree.c.

Definition at line 90 of file tree.c.

Definition at line 91 of file tree.c.

Definition at line 97 of file tree.c.

Definition at line 96 of file tree.c.

Definition at line 95 of file tree.c.

Definition at line 81 of file tree.c.

Definition at line 84 of file tree.c.

Definition at line 83 of file tree.c.

Definition at line 77 of file tree.c.

Definition at line 79 of file tree.c.

Definition at line 85 of file tree.c.

Definition at line 80 of file tree.c.

Definition at line 99 of file tree.c.

Definition at line 75 of file tree.c.

Definition at line 78 of file tree.c.

size_t gen_screen_ptr = 0

Definition at line 101 of file tree.c.

 All Classes Files Functions Variables Typedefs Enumerations Enumerator Defines