|
OpenCOBOL 1.1pre-rel
|
|
OpenCOBOL 1.1pre-rel
|
#include "config.h"#include <stdio.h>#include <stdlib.h>#include <string.h>#include <ctype.h>#include "cobc.h"#include "tree.h"
Go to the source code of this file.
| #define PIC_ALPHANUMERIC_EDITED (PIC_ALPHANUMERIC | PIC_EDITED) |
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;
}
| 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;
}
| 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);
}
| cb_tree cb_build_alphanumeric_literal | ( | const unsigned char * | data, |
| size_t | size | ||
| ) |
Definition at line 999 of file tree.c.
{
return CB_TREE (build_literal (CB_CATEGORY_ALPHANUMERIC, data, size));
}
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);
}
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);
}
| 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);
}
| 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);
}
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);
}
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;
}
| 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);
}
| 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);
}
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);
}
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;
}
| 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;
}
| 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);
}
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;
}
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);
}
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;
}
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);
}
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);
}
| 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);
}
| 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);
}
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);
}
| 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);
}
| 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;
}
| 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);
}
| 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);
}
| 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 | ||
| ) |
| 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);
}
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;
}
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;
}
| 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));
}
}
| 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;
}
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;
}
| 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;
}
}
| 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;
}
}
| 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;
}
| 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;
}
| 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");
}
| 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;
}
Definition at line 798 of file tree.c.
{
return cb_list_append (l, cb_list_init (x));
}
| int cb_list_length | ( | cb_tree | l | ) |
| 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;
}
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;
}
| 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;
}
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;
}
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));
}
}
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;
}
}
| size_t gen_screen_ptr = 0 |
1.7.4