OpenCOBOL 1.1pre-rel
Data Structures | Defines | Typedefs | Enumerations | Functions | Variables
tree.h File Reference
This graph shows which files directly or indirectly include this file:

Go to the source code of this file.

Data Structures

struct  cb_tree_common
struct  cb_const
struct  cb_integer
struct  cb_string
struct  cb_alphabet_name
struct  cb_class_name
struct  cb_locale_name
struct  cb_system_name
struct  cb_literal
struct  cb_decimal
struct  cb_picture
struct  cb_field
struct  cb_field::cb_key
struct  cb_label
struct  handler_struct
struct  cb_alt_key
struct  cb_file
struct  cb_word
struct  cb_reference
struct  cb_binary_op
struct  cb_funcall
struct  cb_cast
struct  cb_assign
struct  cb_intrinsic_table
struct  cb_intrinsic
struct  cb_initialize
struct  cb_search
struct  cb_call
struct  cb_goto
struct  cb_if
struct  cb_perform_varying
struct  cb_perform
struct  cb_statement
struct  cb_continue
struct  cb_list
struct  cb_program

Defines

#define YYSTYPE   cb_tree
#define CB_BEFORE   cb_int0
#define CB_AFTER   cb_int1
#define COB_MAX_SUBSCRIPTS   16
#define CB_PREFIX_ATTR   "a_"
#define CB_PREFIX_BASE   "b_"
#define CB_PREFIX_CONST   "c_"
#define CB_PREFIX_DECIMAL   "d_"
#define CB_PREFIX_FIELD   "f_"
#define CB_PREFIX_FILE   "h_"
#define CB_PREFIX_KEYS   "k_"
#define CB_PREFIX_LABEL   "l_"
#define CB_PREFIX_SEQUENCE   "s_"
#define CB_PROGRAM_TYPE   0
#define CB_FUNCTION_TYPE   1
#define CB_TREE(x)   ((struct cb_tree_common *) (x))
#define CB_TREE_TAG(x)   (CB_TREE (x)->tag)
#define CB_TREE_CLASS(x)   cb_tree_class (CB_TREE (x))
#define CB_TREE_CATEGORY(x)   cb_tree_category (CB_TREE (x))
#define CB_TREE_CAST(tg, ty, x)   ((ty *) (x))
#define CB_CONST(x)   (CB_TREE_CAST (CB_TAG_CONST, struct cb_const, x))
#define CB_CONST_P(x)   (CB_TREE_TAG (x) == CB_TAG_CONST)
#define CB_INTEGER(x)   (CB_TREE_CAST (CB_TAG_INTEGER, struct cb_integer, x))
#define CB_INTEGER_P(x)   (CB_TREE_TAG (x) == CB_TAG_INTEGER)
#define CB_STRING(x)   (CB_TREE_CAST (CB_TAG_STRING, struct cb_string, x))
#define CB_STRING_P(x)   (CB_TREE_TAG (x) == CB_TAG_STRING)
#define cb_build_string0(str)   cb_build_string (str, strlen ((char *)str))
#define CB_ALPHABET_NAME(x)   (CB_TREE_CAST (CB_TAG_ALPHABET_NAME, struct cb_alphabet_name, x))
#define CB_ALPHABET_NAME_P(x)   (CB_TREE_TAG (x) == CB_TAG_ALPHABET_NAME)
#define CB_CLASS_NAME(x)   (CB_TREE_CAST (CB_TAG_CLASS_NAME, struct cb_class_name, x))
#define CB_CLASS_NAME_P(x)   (CB_TREE_TAG (x) == CB_TAG_CLASS_NAME)
#define CB_LOCALE_NAME(x)   (CB_TREE_CAST (CB_TAG_LOCALE_NAME, struct cb_locale_name, x))
#define CB_LOCALE_NAME_P(x)   (CB_TREE_TAG (x) == CB_TAG_LOCALE_NAME)
#define CB_SYSTEM_NAME(x)   (CB_TREE_CAST (CB_TAG_SYSTEM_NAME, struct cb_system_name, x))
#define CB_SYSTEM_NAME_P(x)   (CB_TREE_TAG (x) == CB_TAG_SYSTEM_NAME)
#define CB_LITERAL(x)   (CB_TREE_CAST (CB_TAG_LITERAL, struct cb_literal, x))
#define CB_LITERAL_P(x)   (CB_TREE_TAG (x) == CB_TAG_LITERAL)
#define CB_NUMERIC_LITERAL_P(x)   (CB_LITERAL_P (x) && CB_TREE_CATEGORY (x) == CB_CATEGORY_NUMERIC)
#define CB_DECIMAL(x)   (CB_TREE_CAST (CB_TAG_DECIMAL, struct cb_decimal, x))
#define CB_DECIMAL_P(x)   (CB_TREE_TAG (x) == CB_TAG_DECIMAL)
#define CB_PICTURE(x)   (CB_TREE_CAST (CB_TAG_PICTURE, struct cb_picture, x))
#define CB_PICTURE_P(x)   (CB_TREE_TAG (x) == CB_TAG_PICTURE)
#define CB_FIELD(x)   (CB_TREE_CAST (CB_TAG_FIELD, struct cb_field, x))
#define CB_FIELD_P(x)   (CB_TREE_TAG (x) == CB_TAG_FIELD)
#define CB_REF_OR_FIELD_P(x)   ((CB_FIELD_P (x) || CB_REFERENCE_P (x)))
#define CB_INDEX_P(x)
#define CB_LABEL(x)   (CB_TREE_CAST (CB_TAG_LABEL, struct cb_label, x))
#define CB_LABEL_P(x)   (CB_TREE_TAG (x) == CB_TAG_LABEL)
#define CB_FILE(x)   (CB_TREE_CAST (CB_TAG_FILE, struct cb_file, x))
#define CB_FILE_P(x)   (CB_TREE_TAG (x) == CB_TAG_FILE)
#define CB_WORD_HASH_SIZE   133
#define CB_REFERENCE(x)   (CB_TREE_CAST (CB_TAG_REFERENCE, struct cb_reference, x))
#define CB_REFERENCE_P(x)   (CB_TREE_TAG (x) == CB_TAG_REFERENCE)
#define CB_NAME(x)   (CB_REFERENCE (x)->word->name)
#define CB_BINARY_OP(x)   (CB_TREE_CAST (CB_TAG_BINARY_OP, struct cb_binary_op, x))
#define CB_BINARY_OP_P(x)   (CB_TREE_TAG (x) == CB_TAG_BINARY_OP)
#define cb_build_parenthesis(x)   cb_build_binary_op (x, '@', NULL)
#define cb_build_negation(x)   cb_build_binary_op (x, '!', NULL)
#define CB_FUNCALL(x)   (CB_TREE_CAST (CB_TAG_FUNCALL, struct cb_funcall, x))
#define CB_FUNCALL_P(x)   (CB_TREE_TAG (x) == CB_TAG_FUNCALL)
#define cb_build_funcall_0(f)   cb_build_funcall(f, 0, NULL, NULL, NULL, NULL, NULL, NULL, NULL)
#define cb_build_funcall_1(f, a1)   cb_build_funcall(f, 1, a1, NULL, NULL, NULL, NULL, NULL, NULL)
#define cb_build_funcall_2(f, a1, a2)   cb_build_funcall(f, 2, a1, a2, NULL, NULL, NULL, NULL, NULL)
#define cb_build_funcall_3(f, a1, a2, a3)   cb_build_funcall(f, 3, a1, a2, a3, NULL, NULL, NULL, NULL)
#define cb_build_funcall_4(f, a1, a2, a3, a4)   cb_build_funcall(f, 4, a1, a2, a3, a4, NULL, NULL, NULL)
#define cb_build_funcall_5(f, a1, a2, a3, a4, a5)   cb_build_funcall(f, 5, a1, a2, a3, a4, a5, NULL, NULL)
#define cb_build_funcall_6(f, a1, a2, a3, a4, a5, a6)   cb_build_funcall(f, 6, a1, a2, a3, a4, a5, a6, NULL)
#define cb_build_funcall_7(f, a1, a2, a3, a4, a5, a6, a7)   cb_build_funcall(f, 7, a1, a2, a3, a4, a5, a6, a7)
#define CB_CAST(x)   (CB_TREE_CAST (CB_TAG_CAST, struct cb_cast, x))
#define CB_CAST_P(x)   (CB_TREE_TAG (x) == CB_TAG_CAST)
#define cb_build_cast_integer(x)   cb_build_cast (CB_CAST_INTEGER, x)
#define cb_build_cast_address(x)   cb_build_cast (CB_CAST_ADDRESS, x)
#define cb_build_cast_addr_of_addr(x)   cb_build_cast (CB_CAST_ADDR_OF_ADDR, x)
#define cb_build_cast_length(x)   cb_build_cast (CB_CAST_LENGTH, x)
#define cb_build_cast_ppointer(x)   cb_build_cast (CB_CAST_PROGRAM_POINTER, x)
#define CB_ASSIGN(x)   (CB_TREE_CAST (CB_TAG_ASSIGN, struct cb_assign, x))
#define CB_ASSIGN_P(x)   (CB_TREE_TAG (x) == CB_TAG_ASSIGN)
#define CB_INTRINSIC(x)   (CB_TREE_CAST (CB_TAG_INTRINSIC, struct cb_intrinsic, x))
#define CB_INTRINSIC_P(x)   (CB_TREE_TAG (x) == CB_TAG_INTRINSIC)
#define CB_INITIALIZE(x)   (CB_TREE_CAST (CB_TAG_INITIALIZE, struct cb_initialize, x))
#define CB_INITIALIZE_P(x)   (CB_TREE_TAG (x) == CB_TAG_INITIALIZE)
#define CB_SEARCH(x)   (CB_TREE_CAST (CB_TAG_SEARCH, struct cb_search, x))
#define CB_SEARCH_P(x)   (CB_TREE_TAG (x) == CB_TAG_SEARCH)
#define CB_CALL_BY_REFERENCE   1
#define CB_CALL_BY_CONTENT   2
#define CB_CALL_BY_VALUE   3
#define CB_CALL(x)   (CB_TREE_CAST (CB_TAG_CALL, struct cb_call, x))
#define CB_CALL_P(x)   (CB_TREE_TAG (x) == CB_TAG_CALL)
#define CB_GOTO(x)   (CB_TREE_CAST (CB_TAG_GOTO, struct cb_goto, x))
#define CB_GOTO_P(x)   (CB_TREE_TAG (x) == CB_TAG_GOTO)
#define CB_IF(x)   (CB_TREE_CAST (CB_TAG_IF, struct cb_if, x))
#define CB_IF_P(x)   (CB_TREE_TAG (x) == CB_TAG_IF)
#define CB_PERFORM_VARYING(x)   (CB_TREE_CAST (CB_TAG_PERFORM_VARYING, struct cb_perform_varying, x))
#define CB_PERFORM(x)   (CB_TREE_CAST (CB_TAG_PERFORM, struct cb_perform, x))
#define CB_PERFORM_P(x)   (CB_TREE_TAG (x) == CB_TAG_PERFORM)
#define CB_STATEMENT(x)   (CB_TREE_CAST (CB_TAG_STATEMENT, struct cb_statement, x))
#define CB_STATEMENT_P(x)   (CB_TREE_TAG (x) == CB_TAG_STATEMENT)
#define CB_CONTINUE(x)   (CB_TREE_CAST (CB_TAG_CONTINUE, struct cb_continue, x))
#define CB_CONTINUE_P(x)   (CB_TREE_TAG (x) == CB_TAG_CONTINUE)
#define CB_LIST(x)   (CB_TREE_CAST (CB_TAG_LIST, struct cb_list, x))
#define CB_LIST_P(x)   (CB_TREE_TAG (x) == CB_TAG_LIST)
#define CB_PURPOSE(x)   (CB_LIST (x)->purpose)
#define CB_VALUE(x)   (CB_LIST (x)->value)
#define CB_CHAIN(x)   (CB_LIST (x)->chain)
#define CB_SIZES(x)   (CB_LIST (x)->sizes)
#define CB_PURPOSE_INT(x)   (CB_INTEGER (CB_PURPOSE (x))->val)
#define CB_SIZE_AUTO   0
#define CB_SIZE_1   1
#define CB_SIZE_2   2
#define CB_SIZE_4   3
#define CB_SIZE_8   4
#define CB_SIZE_UNSIGNED   8
#define CB_SIZES_INT(x)   ((CB_LIST (x)->sizes) & 0x07)
#define CB_SIZES_INT_UNSIGNED(x)   ((CB_LIST (x)->sizes) & CB_SIZE_UNSIGNED)
#define cb_list_init(x)   cb_build_list (NULL, x, NULL)
#define cb_cons(x, l)   cb_build_list (NULL, x, l)
#define CB_PAIR_P(x)   (CB_LIST_P (x) && CB_PAIR_X (x))
#define CB_PAIR_X(x)   CB_PURPOSE (x)
#define CB_PAIR_Y(x)   CB_VALUE (x)
#define cb_build_pair(x, y)   cb_build_list (x, y, NULL)

Typedefs

typedef struct cb_tree_commoncb_tree

Enumerations

enum  cb_tag {
  CB_TAG_CONST, CB_TAG_INTEGER, CB_TAG_STRING, CB_TAG_ALPHABET_NAME,
  CB_TAG_CLASS_NAME, CB_TAG_LOCALE_NAME, CB_TAG_SYSTEM_NAME, CB_TAG_LITERAL,
  CB_TAG_DECIMAL, CB_TAG_FIELD, CB_TAG_FILE, CB_TAG_REFERENCE,
  CB_TAG_BINARY_OP, CB_TAG_FUNCALL, CB_TAG_CAST, CB_TAG_INTRINSIC,
  CB_TAG_LABEL, CB_TAG_ASSIGN, CB_TAG_INITIALIZE, CB_TAG_SEARCH,
  CB_TAG_CALL, CB_TAG_GOTO, CB_TAG_IF, CB_TAG_PERFORM,
  CB_TAG_STATEMENT, CB_TAG_CONTINUE, CB_TAG_PERFORM_VARYING, CB_TAG_PICTURE,
  CB_TAG_LIST
}
enum  cb_alphabet_name_type {
  CB_ALPHABET_NATIVE, CB_ALPHABET_STANDARD_1, CB_ALPHABET_STANDARD_2, CB_ALPHABET_EBCDIC,
  CB_ALPHABET_CUSTOM
}
enum  cb_system_name_category {
  CB_CALL_CONVENTION_NAME, CB_CODE_NAME, CB_COMPUTER_NAME, CB_DEVICE_NAME,
  CB_ENTRY_CONVENTION_NAME, CB_EXTERNAL_LOCALE_NAME, CB_FEATURE_NAME, CB_LIBRARY_NAME,
  CB_SWITCH_NAME, CB_TEXT_NAME
}
enum  cb_device_name { CB_DEVICE_SYSIN, CB_DEVICE_SYSOUT, CB_DEVICE_SYSERR, CB_DEVICE_CONSOLE }
enum  cb_feature_name {
  CB_FEATURE_FORMFEED, CB_FEATURE_C01, CB_FEATURE_C02, CB_FEATURE_C03,
  CB_FEATURE_C04, CB_FEATURE_C05, CB_FEATURE_C06, CB_FEATURE_C07,
  CB_FEATURE_C08, CB_FEATURE_C09, CB_FEATURE_C10, CB_FEATURE_C11,
  CB_FEATURE_C12
}
enum  cb_switch_name {
  CB_SWITCH_1, CB_SWITCH_2, CB_SWITCH_3, CB_SWITCH_4,
  CB_SWITCH_5, CB_SWITCH_6, CB_SWITCH_7, CB_SWITCH_8
}
enum  cb_class {
  CB_CLASS_UNKNOWN, CB_CLASS_ALPHABETIC, CB_CLASS_ALPHANUMERIC, CB_CLASS_BOOLEAN,
  CB_CLASS_INDEX, CB_CLASS_NATIONAL, CB_CLASS_NUMERIC, CB_CLASS_OBJECT,
  CB_CLASS_POINTER
}
enum  cb_category {
  CB_CATEGORY_UNKNOWN, CB_CATEGORY_ALPHABETIC, CB_CATEGORY_ALPHANUMERIC, CB_CATEGORY_ALPHANUMERIC_EDITED,
  CB_CATEGORY_BOOLEAN, CB_CATEGORY_INDEX, CB_CATEGORY_NATIONAL, CB_CATEGORY_NATIONAL_EDITED,
  CB_CATEGORY_NUMERIC, CB_CATEGORY_NUMERIC_EDITED, CB_CATEGORY_OBJECT_REFERENCE, CB_CATEGORY_DATA_POINTER,
  CB_CATEGORY_PROGRAM_POINTER
}
enum  cb_storage {
  CB_STORAGE_CONSTANT, CB_STORAGE_FILE, CB_STORAGE_WORKING, CB_STORAGE_LOCAL,
  CB_STORAGE_LINKAGE, CB_STORAGE_SCREEN, CB_STORAGE_REPORT, CB_STORAGE_COMMUNICATION
}
enum  cb_usage {
  CB_USAGE_BINARY, CB_USAGE_BIT, CB_USAGE_COMP_5, CB_USAGE_COMP_X,
  CB_USAGE_DISPLAY, CB_USAGE_FLOAT, CB_USAGE_DOUBLE, CB_USAGE_INDEX,
  CB_USAGE_NATIONAL, CB_USAGE_OBJECT, CB_USAGE_PACKED, CB_USAGE_POINTER,
  CB_USAGE_PROGRAM, CB_USAGE_LENGTH, CB_USAGE_PROGRAM_POINTER, CB_USAGE_UNSIGNED_CHAR,
  CB_USAGE_SIGNED_CHAR, CB_USAGE_UNSIGNED_SHORT, CB_USAGE_SIGNED_SHORT, CB_USAGE_UNSIGNED_INT,
  CB_USAGE_SIGNED_INT, CB_USAGE_UNSIGNED_LONG, CB_USAGE_SIGNED_LONG
}
enum  cb_operand_type { CB_SENDING_OPERAND, CB_RECEIVING_OPERAND }
enum  cb_cast_type {
  CB_CAST_INTEGER, CB_CAST_ADDRESS, CB_CAST_ADDR_OF_ADDR, CB_CAST_LENGTH,
  CB_CAST_PROGRAM_POINTER
}
enum  cb_intr_enum {
  CB_INTR_ABS = 1, CB_INTR_ACOS, CB_INTR_ANNUITY, CB_INTR_ASIN,
  CB_INTR_ATAN, CB_INTR_BOOLEAN_OF_INTEGER, CB_INTR_BYTE_LENGTH, CB_INTR_CHAR,
  CB_INTR_CHAR_NATIONAL, CB_INTR_COMBINED_DATETIME, CB_INTR_CONCATENATE, CB_INTR_COS,
  CB_INTR_CURRENT_DATE, CB_INTR_DATE_OF_INTEGER, CB_INTR_DATE_TO_YYYYMMDD, CB_INTR_DAY_OF_INTEGER,
  CB_INTR_DAY_TO_YYYYDDD, CB_INTR_DISPLAY_OF, CB_INTR_E, CB_INTR_EXCEPTION_FILE,
  CB_INTR_EXCEPTION_FILE_N, CB_INTR_EXCEPTION_LOCATION, CB_INTR_EXCEPTION_LOCATION_N, CB_INTR_EXCEPTION_STATEMENT,
  CB_INTR_EXCEPTION_STATUS, CB_INTR_EXP, CB_INTR_EXP10, CB_INTR_FACTORIAL,
  CB_INTR_FRACTION_PART, CB_INTR_HIGHEST_ALGEBRAIC, CB_INTR_INTEGER, CB_INTR_INTEGER_OF_BOOLEAN,
  CB_INTR_INTEGER_OF_DATE, CB_INTR_INTEGER_OF_DAY, CB_INTR_INTEGER_PART, CB_INTR_LENGTH,
  CB_INTR_LOCALE_COMPARE, CB_INTR_LOCALE_DATE, CB_INTR_LOCALE_TIME, CB_INTR_LOCALE_TIME_FROM_SECS,
  CB_INTR_LOG, CB_INTR_LOG10, CB_INTR_LOWER_CASE, CB_INTR_LOWEST_ALGEBRAIC,
  CB_INTR_MAX, CB_INTR_MEAN, CB_INTR_MEDIAN, CB_INTR_MIDRANGE,
  CB_INTR_MIN, CB_INTR_MOD, CB_INTR_NATIONAL_OF, CB_INTR_NUMVAL,
  CB_INTR_NUMVAL_C, CB_INTR_NUMVAL_F, CB_INTR_ORD, CB_INTR_ORD_MAX,
  CB_INTR_ORD_MIN, CB_INTR_PI, CB_INTR_PRESENT_VALUE, CB_INTR_RANDOM,
  CB_INTR_RANGE, CB_INTR_REM, CB_INTR_REVERSE, CB_INTR_SECONDS_FROM_FORMATTED_TIME,
  CB_INTR_SECONDS_PAST_MIDNIGHT, CB_INTR_SIGN, CB_INTR_SIN, CB_INTR_SQRT,
  CB_INTR_STANDARD_COMPARE, CB_INTR_STANDARD_DEVIATION, CB_INTR_STORED_CHAR_LENGTH, CB_INTR_SUBSTITUTE,
  CB_INTR_SUBSTITUTE_CASE, CB_INTR_SUM, CB_INTR_TAN, CB_INTR_TEST_DATE_YYYYMMDD,
  CB_INTR_TEST_DAY_YYYYDDD, CB_INTR_TEST_NUMVAL, CB_INTR_TEST_NUMVAL_C, CB_INTR_TEST_NUMVAL_F,
  CB_INTR_TRIM, CB_INTR_UPPER_CASE, CB_INTR_VARIANCE, CB_INTR_WHEN_COMPILED,
  CB_INTR_YEAR_TO_YYYY
}
enum  cb_perform_type {
  CB_PERFORM_EXIT, CB_PERFORM_ONCE, CB_PERFORM_TIMES, CB_PERFORM_UNTIL,
  CB_PERFORM_FOREVER
}

Functions

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_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)
cb_tree cb_build_label (cb_tree name, struct cb_label *section)
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_filler (void)
cb_tree cb_build_reference (const char *name)
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_assign (cb_tree var, cb_tree val)
struct cb_intrinsic_tablelookup_intrinsic (const char *name, const int checkres)
cb_tree cb_build_intrinsic (cb_tree name, cb_tree args, cb_tree refmod)
cb_tree cb_build_any_intrinsic (cb_tree args)
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 step, cb_tree until)
struct cb_statementcb_build_statement (const char *name)
cb_tree cb_build_continue (void)
cb_tree cb_build_list (cb_tree purpose, cb_tree value, cb_tree rest)
cb_tree cb_list_add (cb_tree l, cb_tree x)
cb_tree cb_list_append (cb_tree l1, cb_tree l2)
cb_tree cb_list_reverse (cb_tree l)
int cb_list_length (cb_tree l)
struct cb_programcb_build_program (struct cb_program *last_program, int nest_level)
cb_tree lookup_system_name (const char *name)
int lookup_reserved_word (const char *name)
void cb_list_reserved (void)
void cb_list_intrinsics (void)
void cb_list_mnemonics (void)
void cb_init_reserved (void)
void cb_list_map (cb_tree(*func)(cb_tree x), cb_tree l)
void cb_warning_x (cb_tree x, const char *fmt,...)
void cb_error_x (cb_tree x, const char *fmt,...)
char * check_filler_name (char *name)
void redefinition_error (cb_tree x)
void redefinition_warning (cb_tree x, cb_tree y)
void undefined_error (cb_tree x)
void ambiguous_error (cb_tree x)
void group_error (cb_tree x, const char *clause)
void level_redundant_error (cb_tree x, const char *clause)
void level_require_error (cb_tree x, const char *clause)
void level_except_error (cb_tree x, const char *clause)
struct cb_literalbuild_literal (enum cb_category category, const unsigned char *data, size_t size)
int cb_get_level (cb_tree x)
cb_tree cb_build_field_tree (cb_tree level, cb_tree name, struct cb_field *last_field, enum cb_storage storage, struct cb_file *fn)
struct cb_fieldcb_resolve_redefines (struct cb_field *field, cb_tree redefines)
void cb_validate_field (struct cb_field *p)
void cb_validate_88_item (struct cb_field *p)
struct cb_fieldcb_validate_78_item (struct cb_field *p)
void cb_clear_real_field (void)
cb_tree cb_check_numeric_value (cb_tree x)
void cb_build_registers (void)
char * cb_encode_program_id (const char *name)
const char * cb_build_program_id (cb_tree name, cb_tree alt_name)
void cb_define_switch_name (cb_tree name, cb_tree sname, cb_tree flag, cb_tree ref)
cb_tree cb_build_section_name (cb_tree name, int sect_or_para)
cb_tree cb_build_assignment_name (struct cb_file *curfile, cb_tree name)
cb_tree cb_build_index (cb_tree name, cb_tree values, int indexed_by, struct cb_field *qual)
cb_tree cb_build_identifier (cb_tree x)
cb_tree cb_build_length (cb_tree x)
cb_tree cb_build_const_length (cb_tree x)
cb_tree cb_build_address (cb_tree x)
cb_tree cb_build_ppointer (cb_tree x)
void cb_validate_program_environment (struct cb_program *prog)
void cb_validate_program_data (struct cb_program *prog)
void cb_validate_program_body (struct cb_program *prog)
cb_tree cb_build_expr (cb_tree list)
cb_tree cb_build_cond (cb_tree x)
void cb_emit_arithmetic (cb_tree vars, int op, cb_tree val)
cb_tree cb_build_add (cb_tree v, cb_tree n, cb_tree round_opt)
cb_tree cb_build_sub (cb_tree v, cb_tree n, cb_tree round_opt)
void cb_emit_corresponding (cb_tree(*func)(cb_tree f1, cb_tree f2, cb_tree f3), cb_tree x1, cb_tree x2, cb_tree opt)
void cb_emit_move_corresponding (cb_tree x1, cb_tree x2)
void cb_emit_accept (cb_tree var, cb_tree pos, cb_tree fgc, cb_tree bgc, cb_tree scroll, int dispattrs)
void cb_emit_accept_line_or_col (cb_tree var, const int l_or_c)
void cb_emit_accept_date (cb_tree var)
void cb_emit_accept_date_yyyymmdd (cb_tree var)
void cb_emit_accept_day (cb_tree var)
void cb_emit_accept_day_yyyyddd (cb_tree var)
void cb_emit_accept_day_of_week (cb_tree var)
void cb_emit_accept_time (cb_tree var)
void cb_emit_accept_command_line (cb_tree var)
void cb_emit_get_environment (cb_tree envvar, cb_tree envval)
void cb_emit_accept_environment (cb_tree var)
void cb_emit_accept_mnemonic (cb_tree var, cb_tree mnemonic)
void cb_emit_accept_name (cb_tree var, cb_tree name)
void cb_emit_accept_arg_number (cb_tree var)
void cb_emit_accept_arg_value (cb_tree var)
void cb_emit_allocate (cb_tree target1, cb_tree target2, cb_tree size, cb_tree initialize)
void cb_emit_free (cb_tree vars)
void cb_emit_call (cb_tree prog, cb_tree using, cb_tree returning, cb_tree on_exception, cb_tree not_on_exception)
void cb_emit_cancel (cb_tree prog)
void cb_emit_close (cb_tree file, cb_tree opt)
void cb_emit_commit (void)
void cb_emit_continue (void)
void cb_emit_delete (cb_tree file)
void cb_emit_display (cb_tree values, cb_tree upon, cb_tree no_adv, cb_tree pos, cb_tree fgc, cb_tree bgc, cb_tree scroll, int dispattrs)
cb_tree cb_build_display_upon (cb_tree x)
cb_tree cb_build_display_upon_direct (cb_tree x)
void cb_emit_env_name (cb_tree value)
void cb_emit_env_value (cb_tree value)
void cb_emit_arg_number (cb_tree value)
void cb_emit_command_line (cb_tree value)
void cb_emit_divide (cb_tree dividend, cb_tree divisor, cb_tree quotient, cb_tree remainder)
void cb_emit_evaluate (cb_tree subject_list, cb_tree case_list)
void cb_emit_goto (cb_tree target, cb_tree depending)
void cb_emit_exit (size_t goback)
void cb_emit_if (cb_tree cond, cb_tree stmt1, cb_tree stmt2)
void cb_emit_initialize (cb_tree vars, cb_tree fillinit, cb_tree value, cb_tree replacing, cb_tree def)
void cb_emit_inspect (cb_tree var, cb_tree body, cb_tree replacing, int replconv)
void cb_init_tarrying (void)
cb_tree cb_build_tarrying_data (cb_tree x)
cb_tree cb_build_tarrying_characters (cb_tree l)
cb_tree cb_build_tarrying_all (void)
cb_tree cb_build_tarrying_leading (void)
cb_tree cb_build_tarrying_trailing (void)
cb_tree cb_build_tarrying_value (cb_tree x, cb_tree l)
cb_tree cb_build_replacing_characters (cb_tree x, cb_tree l)
cb_tree cb_build_replacing_all (cb_tree x, cb_tree y, cb_tree l)
cb_tree cb_build_replacing_leading (cb_tree x, cb_tree y, cb_tree l)
cb_tree cb_build_replacing_first (cb_tree x, cb_tree y, cb_tree l)
cb_tree cb_build_replacing_trailing (cb_tree x, cb_tree y, cb_tree l)
cb_tree cb_build_converting (cb_tree x, cb_tree y, cb_tree l)
cb_tree cb_build_inspect_region_start (void)
cb_tree cb_build_inspect_region (cb_tree l, cb_tree pos, cb_tree x)
int validate_move (cb_tree src, cb_tree dst, size_t is_value)
cb_tree cb_build_move (cb_tree src, cb_tree dst)
void cb_emit_move (cb_tree src, cb_tree dsts)
void cb_emit_open (cb_tree file, cb_tree mode, cb_tree sharing)
void cb_emit_perform (cb_tree perform, cb_tree body)
cb_tree cb_build_perform_once (cb_tree body)
cb_tree cb_build_perform_times (cb_tree count)
cb_tree cb_build_perform_until (cb_tree condition, cb_tree varying)
cb_tree cb_build_perform_forever (cb_tree body)
cb_tree cb_build_perform_exit (struct cb_label *label)
void cb_emit_read (cb_tree ref, cb_tree next, cb_tree into, cb_tree key, cb_tree lock_opts)
void cb_emit_rewrite (cb_tree record, cb_tree from, cb_tree lockopt)
void cb_emit_release (cb_tree ref, cb_tree from)
void cb_emit_return (cb_tree ref, cb_tree into)
void cb_emit_rollback (void)
void cb_emit_search (cb_tree table, cb_tree varying, cb_tree at_end, cb_tree whens)
void cb_emit_search_all (cb_tree table, cb_tree at_end, cb_tree when, cb_tree stmts)
void cb_emit_setenv (cb_tree x, cb_tree y)
void cb_emit_set_to (cb_tree l, cb_tree x)
void cb_emit_set_up_down (cb_tree l, cb_tree flag, cb_tree x)
void cb_emit_set_on_off (cb_tree l, cb_tree flag)
void cb_emit_set_true (cb_tree l)
void cb_emit_set_false (cb_tree l)
void cb_emit_sort_init (cb_tree name, cb_tree keys, cb_tree col)
void cb_emit_sort_using (cb_tree file, cb_tree l)
void cb_emit_sort_input (cb_tree proc)
void cb_emit_sort_giving (cb_tree file, cb_tree l)
void cb_emit_sort_output (cb_tree proc)
void cb_emit_sort_finish (cb_tree file)
void cb_emit_start (cb_tree file, cb_tree op, cb_tree key)
void cb_emit_stop_run (cb_tree x)
void cb_emit_string (cb_tree items, cb_tree into, cb_tree pointer)
void cb_emit_unlock (cb_tree ref)
void cb_emit_unstring (cb_tree name, cb_tree delimited, cb_tree into, cb_tree pointer, cb_tree tallying)
cb_tree cb_build_unstring_delimited (cb_tree all, cb_tree value)
cb_tree cb_build_unstring_into (cb_tree name, cb_tree delimiter, cb_tree count)
void cb_emit_write (cb_tree record, cb_tree from, cb_tree opt, cb_tree lockopt)
cb_tree cb_build_write_advancing_lines (cb_tree pos, cb_tree lines)
cb_tree cb_build_write_advancing_mnemonic (cb_tree pos, cb_tree mnemonic)
cb_tree cb_build_write_advancing_page (cb_tree pos)
void cobc_tree_cast_error (cb_tree x, const char *filen, const int linenum, const int tagnum)
void codegen (struct cb_program *prog, int nested)
void cb_set_in_procedure (void)
void cb_reset_in_procedure (void)
void cb_add_78 (struct cb_field *f)
void cb_reset_78 (void)
struct cb_fieldcheck_level_78 (const char *name)

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
int non_const_word
size_t cb_needs_01

Define Documentation

#define CB_AFTER   cb_int1

Definition at line 27 of file tree.h.

#define CB_ALPHABET_NAME (   x)    (CB_TREE_CAST (CB_TAG_ALPHABET_NAME, struct cb_alphabet_name, x))

Definition at line 338 of file tree.h.

#define CB_ALPHABET_NAME_P (   x)    (CB_TREE_TAG (x) == CB_TAG_ALPHABET_NAME)

Definition at line 339 of file tree.h.

#define CB_ASSIGN (   x)    (CB_TREE_CAST (CB_TAG_ASSIGN, struct cb_assign, x))

Definition at line 799 of file tree.h.

#define CB_ASSIGN_P (   x)    (CB_TREE_TAG (x) == CB_TAG_ASSIGN)

Definition at line 800 of file tree.h.

#define CB_BEFORE   cb_int0

Definition at line 26 of file tree.h.

#define CB_BINARY_OP (   x)    (CB_TREE_CAST (CB_TAG_BINARY_OP, struct cb_binary_op, x))

Definition at line 711 of file tree.h.

#define CB_BINARY_OP_P (   x)    (CB_TREE_TAG (x) == CB_TAG_BINARY_OP)

Definition at line 712 of file tree.h.

#define cb_build_cast_addr_of_addr (   x)    cb_build_cast (CB_CAST_ADDR_OF_ADDR, x)

Definition at line 784 of file tree.h.

#define cb_build_cast_address (   x)    cb_build_cast (CB_CAST_ADDRESS, x)

Definition at line 783 of file tree.h.

#define cb_build_cast_integer (   x)    cb_build_cast (CB_CAST_INTEGER, x)

Definition at line 782 of file tree.h.

#define cb_build_cast_length (   x)    cb_build_cast (CB_CAST_LENGTH, x)

Definition at line 785 of file tree.h.

#define cb_build_cast_ppointer (   x)    cb_build_cast (CB_CAST_PROGRAM_POINTER, x)

Definition at line 786 of file tree.h.

#define cb_build_funcall_0 (   f)    cb_build_funcall(f, 0, NULL, NULL, NULL, NULL, NULL, NULL, NULL)

Definition at line 741 of file tree.h.

#define cb_build_funcall_1 (   f,
  a1 
)    cb_build_funcall(f, 1, a1, NULL, NULL, NULL, NULL, NULL, NULL)

Definition at line 743 of file tree.h.

#define cb_build_funcall_2 (   f,
  a1,
  a2 
)    cb_build_funcall(f, 2, a1, a2, NULL, NULL, NULL, NULL, NULL)

Definition at line 745 of file tree.h.

#define cb_build_funcall_3 (   f,
  a1,
  a2,
  a3 
)    cb_build_funcall(f, 3, a1, a2, a3, NULL, NULL, NULL, NULL)

Definition at line 747 of file tree.h.

#define cb_build_funcall_4 (   f,
  a1,
  a2,
  a3,
  a4 
)    cb_build_funcall(f, 4, a1, a2, a3, a4, NULL, NULL, NULL)

Definition at line 749 of file tree.h.

#define cb_build_funcall_5 (   f,
  a1,
  a2,
  a3,
  a4,
  a5 
)    cb_build_funcall(f, 5, a1, a2, a3, a4, a5, NULL, NULL)

Definition at line 751 of file tree.h.

#define cb_build_funcall_6 (   f,
  a1,
  a2,
  a3,
  a4,
  a5,
  a6 
)    cb_build_funcall(f, 6, a1, a2, a3, a4, a5, a6, NULL)

Definition at line 753 of file tree.h.

#define cb_build_funcall_7 (   f,
  a1,
  a2,
  a3,
  a4,
  a5,
  a6,
  a7 
)    cb_build_funcall(f, 7, a1, a2, a3, a4, a5, a6, a7)

Definition at line 755 of file tree.h.

#define cb_build_negation (   x)    cb_build_binary_op (x, '!', NULL)

Definition at line 715 of file tree.h.

#define cb_build_pair (   x,
 
)    cb_build_list (x, y, NULL)

Definition at line 1147 of file tree.h.

#define cb_build_parenthesis (   x)    cb_build_binary_op (x, '@', NULL)

Definition at line 714 of file tree.h.

#define cb_build_string0 (   str)    cb_build_string (str, strlen ((char *)str))

Definition at line 319 of file tree.h.

#define CB_CALL (   x)    (CB_TREE_CAST (CB_TAG_CALL, struct cb_call, x))

Definition at line 984 of file tree.h.

#define CB_CALL_BY_CONTENT   2

Definition at line 971 of file tree.h.

#define CB_CALL_BY_REFERENCE   1

Definition at line 970 of file tree.h.

#define CB_CALL_BY_VALUE   3

Definition at line 972 of file tree.h.

#define CB_CALL_P (   x)    (CB_TREE_TAG (x) == CB_TAG_CALL)

Definition at line 985 of file tree.h.

#define CB_CAST (   x)    (CB_TREE_CAST (CB_TAG_CAST, struct cb_cast, x))

Definition at line 777 of file tree.h.

#define CB_CAST_P (   x)    (CB_TREE_TAG (x) == CB_TAG_CAST)

Definition at line 778 of file tree.h.

#define CB_CHAIN (   x)    (CB_LIST (x)->chain)

Definition at line 1117 of file tree.h.

#define CB_CLASS_NAME (   x)    (CB_TREE_CAST (CB_TAG_CLASS_NAME, struct cb_class_name, x))

Definition at line 355 of file tree.h.

#define CB_CLASS_NAME_P (   x)    (CB_TREE_TAG (x) == CB_TAG_CLASS_NAME)

Definition at line 356 of file tree.h.

#define cb_cons (   x,
 
)    cb_build_list (NULL, x, l)

Definition at line 1139 of file tree.h.

#define CB_CONST (   x)    (CB_TREE_CAST (CB_TAG_CONST, struct cb_const, x))

Definition at line 285 of file tree.h.

#define CB_CONST_P (   x)    (CB_TREE_TAG (x) == CB_TAG_CONST)

Definition at line 286 of file tree.h.

#define CB_CONTINUE (   x)    (CB_TREE_CAST (CB_TAG_CONTINUE, struct cb_continue, x))

Definition at line 1094 of file tree.h.

#define CB_CONTINUE_P (   x)    (CB_TREE_TAG (x) == CB_TAG_CONTINUE)

Definition at line 1095 of file tree.h.

#define CB_DECIMAL (   x)    (CB_TREE_CAST (CB_TAG_DECIMAL, struct cb_decimal, x))

Definition at line 426 of file tree.h.

#define CB_DECIMAL_P (   x)    (CB_TREE_TAG (x) == CB_TAG_DECIMAL)

Definition at line 427 of file tree.h.

#define CB_FIELD (   x)    (CB_TREE_CAST (CB_TAG_FIELD, struct cb_field, x))

Definition at line 534 of file tree.h.

#define CB_FIELD_P (   x)    (CB_TREE_TAG (x) == CB_TAG_FIELD)

Definition at line 535 of file tree.h.

#define CB_FILE (   x)    (CB_TREE_CAST (CB_TAG_FILE, struct cb_file, x))

Definition at line 634 of file tree.h.

#define CB_FILE_P (   x)    (CB_TREE_TAG (x) == CB_TAG_FILE)

Definition at line 635 of file tree.h.

#define CB_FUNCALL (   x)    (CB_TREE_CAST (CB_TAG_FUNCALL, struct cb_funcall, x))

Definition at line 734 of file tree.h.

#define CB_FUNCALL_P (   x)    (CB_TREE_TAG (x) == CB_TAG_FUNCALL)

Definition at line 735 of file tree.h.

#define CB_FUNCTION_TYPE   1

Definition at line 42 of file tree.h.

#define CB_GOTO (   x)    (CB_TREE_CAST (CB_TAG_GOTO, struct cb_goto, x))

Definition at line 1001 of file tree.h.

#define CB_GOTO_P (   x)    (CB_TREE_TAG (x) == CB_TAG_GOTO)

Definition at line 1002 of file tree.h.

#define CB_IF (   x)    (CB_TREE_CAST (CB_TAG_IF, struct cb_if, x))

Definition at line 1018 of file tree.h.

#define CB_IF_P (   x)    (CB_TREE_TAG (x) == CB_TAG_IF)

Definition at line 1019 of file tree.h.

#define CB_INDEX_P (   x)
Value:

Definition at line 553 of file tree.h.

#define CB_INITIALIZE (   x)    (CB_TREE_CAST (CB_TAG_INITIALIZE, struct cb_initialize, x))

Definition at line 941 of file tree.h.

#define CB_INITIALIZE_P (   x)    (CB_TREE_TAG (x) == CB_TAG_INITIALIZE)

Definition at line 942 of file tree.h.

#define CB_INTEGER (   x)    (CB_TREE_CAST (CB_TAG_INTEGER, struct cb_integer, x))

Definition at line 300 of file tree.h.

#define CB_INTEGER_P (   x)    (CB_TREE_TAG (x) == CB_TAG_INTEGER)

Definition at line 301 of file tree.h.

#define CB_INTRINSIC (   x)    (CB_TREE_CAST (CB_TAG_INTRINSIC, struct cb_intrinsic, x))

Definition at line 917 of file tree.h.

#define CB_INTRINSIC_P (   x)    (CB_TREE_TAG (x) == CB_TAG_INTRINSIC)

Definition at line 918 of file tree.h.

#define CB_LABEL (   x)    (CB_TREE_CAST (CB_TAG_LABEL, struct cb_label, x))

Definition at line 578 of file tree.h.

#define CB_LABEL_P (   x)    (CB_TREE_TAG (x) == CB_TAG_LABEL)

Definition at line 579 of file tree.h.

#define CB_LIST (   x)    (CB_TREE_CAST (CB_TAG_LIST, struct cb_list, x))

Definition at line 1112 of file tree.h.

#define cb_list_init (   x)    cb_build_list (NULL, x, NULL)

Definition at line 1138 of file tree.h.

#define CB_LIST_P (   x)    (CB_TREE_TAG (x) == CB_TAG_LIST)

Definition at line 1113 of file tree.h.

#define CB_LITERAL (   x)    (CB_TREE_CAST (CB_TAG_LITERAL, struct cb_literal, x))

Definition at line 407 of file tree.h.

#define CB_LITERAL_P (   x)    (CB_TREE_TAG (x) == CB_TAG_LITERAL)

Definition at line 408 of file tree.h.

#define CB_LOCALE_NAME (   x)    (CB_TREE_CAST (CB_TAG_LOCALE_NAME, struct cb_locale_name, x))

Definition at line 372 of file tree.h.

#define CB_LOCALE_NAME_P (   x)    (CB_TREE_TAG (x) == CB_TAG_LOCALE_NAME)

Definition at line 373 of file tree.h.

#define CB_NAME (   x)    (CB_REFERENCE (x)->word->name)

Definition at line 672 of file tree.h.

#define CB_NUMERIC_LITERAL_P (   x)    (CB_LITERAL_P (x) && CB_TREE_CATEGORY (x) == CB_CATEGORY_NUMERIC)

Definition at line 409 of file tree.h.

#define CB_PAIR_P (   x)    (CB_LIST_P (x) && CB_PAIR_X (x))

Definition at line 1143 of file tree.h.

#define CB_PAIR_X (   x)    CB_PURPOSE (x)

Definition at line 1144 of file tree.h.

#define CB_PAIR_Y (   x)    CB_VALUE (x)

Definition at line 1145 of file tree.h.

#define CB_PERFORM (   x)    (CB_TREE_CAST (CB_TAG_PERFORM, struct cb_perform, x))

Definition at line 1057 of file tree.h.

#define CB_PERFORM_P (   x)    (CB_TREE_TAG (x) == CB_TAG_PERFORM)

Definition at line 1058 of file tree.h.

#define CB_PERFORM_VARYING (   x)    (CB_TREE_CAST (CB_TAG_PERFORM_VARYING, struct cb_perform_varying, x))

Definition at line 1055 of file tree.h.

#define CB_PICTURE (   x)    (CB_TREE_CAST (CB_TAG_PICTURE, struct cb_picture, x))

Definition at line 449 of file tree.h.

#define CB_PICTURE_P (   x)    (CB_TREE_TAG (x) == CB_TAG_PICTURE)

Definition at line 450 of file tree.h.

#define CB_PREFIX_ATTR   "a_"

Definition at line 31 of file tree.h.

#define CB_PREFIX_BASE   "b_"

Definition at line 32 of file tree.h.

#define CB_PREFIX_CONST   "c_"

Definition at line 33 of file tree.h.

#define CB_PREFIX_DECIMAL   "d_"

Definition at line 34 of file tree.h.

#define CB_PREFIX_FIELD   "f_"

Definition at line 35 of file tree.h.

#define CB_PREFIX_FILE   "h_"

Definition at line 36 of file tree.h.

#define CB_PREFIX_KEYS   "k_"

Definition at line 37 of file tree.h.

#define CB_PREFIX_LABEL   "l_"

Definition at line 38 of file tree.h.

#define CB_PREFIX_SEQUENCE   "s_"

Definition at line 39 of file tree.h.

#define CB_PROGRAM_TYPE   0

Definition at line 41 of file tree.h.

#define CB_PURPOSE (   x)    (CB_LIST (x)->purpose)

Definition at line 1115 of file tree.h.

#define CB_PURPOSE_INT (   x)    (CB_INTEGER (CB_PURPOSE (x))->val)

Definition at line 1120 of file tree.h.

#define CB_REF_OR_FIELD_P (   x)    ((CB_FIELD_P (x) || CB_REFERENCE_P (x)))

Definition at line 549 of file tree.h.

#define CB_REFERENCE (   x)    (CB_TREE_CAST (CB_TAG_REFERENCE, struct cb_reference, x))

Definition at line 669 of file tree.h.

#define CB_REFERENCE_P (   x)    (CB_TREE_TAG (x) == CB_TAG_REFERENCE)

Definition at line 670 of file tree.h.

#define CB_SEARCH (   x)    (CB_TREE_CAST (CB_TAG_SEARCH, struct cb_search, x))

Definition at line 960 of file tree.h.

#define CB_SEARCH_P (   x)    (CB_TREE_TAG (x) == CB_TAG_SEARCH)

Definition at line 961 of file tree.h.

#define CB_SIZE_1   1

Definition at line 1123 of file tree.h.

#define CB_SIZE_2   2

Definition at line 1124 of file tree.h.

#define CB_SIZE_4   3

Definition at line 1125 of file tree.h.

#define CB_SIZE_8   4

Definition at line 1126 of file tree.h.

#define CB_SIZE_AUTO   0

Definition at line 1122 of file tree.h.

#define CB_SIZE_UNSIGNED   8

Definition at line 1127 of file tree.h.

#define CB_SIZES (   x)    (CB_LIST (x)->sizes)

Definition at line 1118 of file tree.h.

#define CB_SIZES_INT (   x)    ((CB_LIST (x)->sizes) & 0x07)

Definition at line 1129 of file tree.h.

#define CB_SIZES_INT_UNSIGNED (   x)    ((CB_LIST (x)->sizes) & CB_SIZE_UNSIGNED)

Definition at line 1130 of file tree.h.

#define CB_STATEMENT (   x)    (CB_TREE_CAST (CB_TAG_STATEMENT, struct cb_statement, x))

Definition at line 1080 of file tree.h.

#define CB_STATEMENT_P (   x)    (CB_TREE_TAG (x) == CB_TAG_STATEMENT)

Definition at line 1081 of file tree.h.

#define CB_STRING (   x)    (CB_TREE_CAST (CB_TAG_STRING, struct cb_string, x))

Definition at line 316 of file tree.h.

#define CB_STRING_P (   x)    (CB_TREE_TAG (x) == CB_TAG_STRING)

Definition at line 317 of file tree.h.

#define CB_SYSTEM_NAME (   x)    (CB_TREE_CAST (CB_TAG_SYSTEM_NAME, struct cb_system_name, x))

Definition at line 387 of file tree.h.

#define CB_SYSTEM_NAME_P (   x)    (CB_TREE_TAG (x) == CB_TAG_SYSTEM_NAME)

Definition at line 388 of file tree.h.

#define CB_TREE (   x)    ((struct cb_tree_common *) (x))

Definition at line 219 of file tree.h.

#define CB_TREE_CAST (   tg,
  ty,
 
)    ((ty *) (x))

Definition at line 235 of file tree.h.

#define CB_TREE_CATEGORY (   x)    cb_tree_category (CB_TREE (x))

Definition at line 222 of file tree.h.

#define CB_TREE_CLASS (   x)    cb_tree_class (CB_TREE (x))

Definition at line 221 of file tree.h.

#define CB_TREE_TAG (   x)    (CB_TREE (x)->tag)

Definition at line 220 of file tree.h.

#define CB_VALUE (   x)    (CB_LIST (x)->value)

Definition at line 1116 of file tree.h.

#define CB_WORD_HASH_SIZE   133

Definition at line 646 of file tree.h.

#define COB_MAX_SUBSCRIPTS   16

Definition at line 29 of file tree.h.

#define YYSTYPE   cb_tree

Definition at line 24 of file tree.h.


Typedef Documentation

typedef struct cb_tree_common* cb_tree

Definition at line 217 of file tree.h.


Enumeration Type Documentation

Enumerator:
CB_ALPHABET_NATIVE 
CB_ALPHABET_STANDARD_1 
CB_ALPHABET_STANDARD_2 
CB_ALPHABET_EBCDIC 
CB_ALPHABET_CUSTOM 

Definition at line 80 of file tree.h.

Enumerator:
CB_CAST_INTEGER 
CB_CAST_ADDRESS 
CB_CAST_ADDR_OF_ADDR 
CB_CAST_LENGTH 
CB_CAST_PROGRAM_POINTER 

Definition at line 763 of file tree.h.

Enumerator:
CB_CATEGORY_UNKNOWN 
CB_CATEGORY_ALPHABETIC 
CB_CATEGORY_ALPHANUMERIC 
CB_CATEGORY_ALPHANUMERIC_EDITED 
CB_CATEGORY_BOOLEAN 
CB_CATEGORY_INDEX 
CB_CATEGORY_NATIONAL 
CB_CATEGORY_NATIONAL_EDITED 
CB_CATEGORY_NUMERIC 
CB_CATEGORY_NUMERIC_EDITED 
CB_CATEGORY_OBJECT_REFERENCE 
CB_CATEGORY_DATA_POINTER 
CB_CATEGORY_PROGRAM_POINTER 

Definition at line 147 of file tree.h.

enum cb_class
Enumerator:
CB_CLASS_UNKNOWN 
CB_CLASS_ALPHABETIC 
CB_CLASS_ALPHANUMERIC 
CB_CLASS_BOOLEAN 
CB_CLASS_INDEX 
CB_CLASS_NATIONAL 
CB_CLASS_NUMERIC 
CB_CLASS_OBJECT 
CB_CLASS_POINTER 

Definition at line 135 of file tree.h.

Enumerator:
CB_DEVICE_SYSIN 
CB_DEVICE_SYSOUT 
CB_DEVICE_SYSERR 
CB_DEVICE_CONSOLE 

Definition at line 101 of file tree.h.

Enumerator:
CB_FEATURE_FORMFEED 
CB_FEATURE_C01 
CB_FEATURE_C02 
CB_FEATURE_C03 
CB_FEATURE_C04 
CB_FEATURE_C05 
CB_FEATURE_C06 
CB_FEATURE_C07 
CB_FEATURE_C08 
CB_FEATURE_C09 
CB_FEATURE_C10 
CB_FEATURE_C11 
CB_FEATURE_C12 

Definition at line 108 of file tree.h.

Enumerator:
CB_INTR_ABS 
CB_INTR_ACOS 
CB_INTR_ANNUITY 
CB_INTR_ASIN 
CB_INTR_ATAN 
CB_INTR_BOOLEAN_OF_INTEGER 
CB_INTR_BYTE_LENGTH 
CB_INTR_CHAR 
CB_INTR_CHAR_NATIONAL 
CB_INTR_COMBINED_DATETIME 
CB_INTR_CONCATENATE 
CB_INTR_COS 
CB_INTR_CURRENT_DATE 
CB_INTR_DATE_OF_INTEGER 
CB_INTR_DATE_TO_YYYYMMDD 
CB_INTR_DAY_OF_INTEGER 
CB_INTR_DAY_TO_YYYYDDD 
CB_INTR_DISPLAY_OF 
CB_INTR_E 
CB_INTR_EXCEPTION_FILE 
CB_INTR_EXCEPTION_FILE_N 
CB_INTR_EXCEPTION_LOCATION 
CB_INTR_EXCEPTION_LOCATION_N 
CB_INTR_EXCEPTION_STATEMENT 
CB_INTR_EXCEPTION_STATUS 
CB_INTR_EXP 
CB_INTR_EXP10 
CB_INTR_FACTORIAL 
CB_INTR_FRACTION_PART 
CB_INTR_HIGHEST_ALGEBRAIC 
CB_INTR_INTEGER 
CB_INTR_INTEGER_OF_BOOLEAN 
CB_INTR_INTEGER_OF_DATE 
CB_INTR_INTEGER_OF_DAY 
CB_INTR_INTEGER_PART 
CB_INTR_LENGTH 
CB_INTR_LOCALE_COMPARE 
CB_INTR_LOCALE_DATE 
CB_INTR_LOCALE_TIME 
CB_INTR_LOCALE_TIME_FROM_SECS 
CB_INTR_LOG 
CB_INTR_LOG10 
CB_INTR_LOWER_CASE 
CB_INTR_LOWEST_ALGEBRAIC 
CB_INTR_MAX 
CB_INTR_MEAN 
CB_INTR_MEDIAN 
CB_INTR_MIDRANGE 
CB_INTR_MIN 
CB_INTR_MOD 
CB_INTR_NATIONAL_OF 
CB_INTR_NUMVAL 
CB_INTR_NUMVAL_C 
CB_INTR_NUMVAL_F 
CB_INTR_ORD 
CB_INTR_ORD_MAX 
CB_INTR_ORD_MIN 
CB_INTR_PI 
CB_INTR_PRESENT_VALUE 
CB_INTR_RANDOM 
CB_INTR_RANGE 
CB_INTR_REM 
CB_INTR_REVERSE 
CB_INTR_SECONDS_FROM_FORMATTED_TIME 
CB_INTR_SECONDS_PAST_MIDNIGHT 
CB_INTR_SIGN 
CB_INTR_SIN 
CB_INTR_SQRT 
CB_INTR_STANDARD_COMPARE 
CB_INTR_STANDARD_DEVIATION 
CB_INTR_STORED_CHAR_LENGTH 
CB_INTR_SUBSTITUTE 
CB_INTR_SUBSTITUTE_CASE 
CB_INTR_SUM 
CB_INTR_TAN 
CB_INTR_TEST_DATE_YYYYMMDD 
CB_INTR_TEST_DAY_YYYYDDD 
CB_INTR_TEST_NUMVAL 
CB_INTR_TEST_NUMVAL_C 
CB_INTR_TEST_NUMVAL_F 
CB_INTR_TRIM 
CB_INTR_UPPER_CASE 
CB_INTR_VARIANCE 
CB_INTR_WHEN_COMPILED 
CB_INTR_YEAR_TO_YYYY 

Definition at line 809 of file tree.h.

                  {
        CB_INTR_ABS = 1,
        CB_INTR_ACOS,
        CB_INTR_ANNUITY,
        CB_INTR_ASIN,
        CB_INTR_ATAN,
        CB_INTR_BOOLEAN_OF_INTEGER,
        CB_INTR_BYTE_LENGTH,
        CB_INTR_CHAR,
        CB_INTR_CHAR_NATIONAL,
        CB_INTR_COMBINED_DATETIME,
        CB_INTR_CONCATENATE,
        CB_INTR_COS,
        CB_INTR_CURRENT_DATE,
        CB_INTR_DATE_OF_INTEGER,
        CB_INTR_DATE_TO_YYYYMMDD,
        CB_INTR_DAY_OF_INTEGER,
        CB_INTR_DAY_TO_YYYYDDD,
        CB_INTR_DISPLAY_OF,
        CB_INTR_E,
        CB_INTR_EXCEPTION_FILE,
        CB_INTR_EXCEPTION_FILE_N,
        CB_INTR_EXCEPTION_LOCATION,
        CB_INTR_EXCEPTION_LOCATION_N,
        CB_INTR_EXCEPTION_STATEMENT,
        CB_INTR_EXCEPTION_STATUS,
        CB_INTR_EXP,
        CB_INTR_EXP10,
        CB_INTR_FACTORIAL,
        CB_INTR_FRACTION_PART,
        CB_INTR_HIGHEST_ALGEBRAIC,
        CB_INTR_INTEGER,
        CB_INTR_INTEGER_OF_BOOLEAN,
        CB_INTR_INTEGER_OF_DATE,
        CB_INTR_INTEGER_OF_DAY,
        CB_INTR_INTEGER_PART,
        CB_INTR_LENGTH,
        CB_INTR_LOCALE_COMPARE,
        CB_INTR_LOCALE_DATE,
        CB_INTR_LOCALE_TIME,
        CB_INTR_LOCALE_TIME_FROM_SECS,
        CB_INTR_LOG,
        CB_INTR_LOG10,
        CB_INTR_LOWER_CASE,
        CB_INTR_LOWEST_ALGEBRAIC,
        CB_INTR_MAX,
        CB_INTR_MEAN,
        CB_INTR_MEDIAN,
        CB_INTR_MIDRANGE,
        CB_INTR_MIN,
        CB_INTR_MOD,
        CB_INTR_NATIONAL_OF,
        CB_INTR_NUMVAL,
        CB_INTR_NUMVAL_C,
        CB_INTR_NUMVAL_F,
        CB_INTR_ORD,
        CB_INTR_ORD_MAX,
        CB_INTR_ORD_MIN,
        CB_INTR_PI,
        CB_INTR_PRESENT_VALUE,
        CB_INTR_RANDOM,
        CB_INTR_RANGE,
        CB_INTR_REM,
        CB_INTR_REVERSE,
        CB_INTR_SECONDS_FROM_FORMATTED_TIME,
        CB_INTR_SECONDS_PAST_MIDNIGHT,
        CB_INTR_SIGN,
        CB_INTR_SIN,
        CB_INTR_SQRT,
        CB_INTR_STANDARD_COMPARE,
        CB_INTR_STANDARD_DEVIATION,
        CB_INTR_STORED_CHAR_LENGTH,
        CB_INTR_SUBSTITUTE,
        CB_INTR_SUBSTITUTE_CASE,
        CB_INTR_SUM,
        CB_INTR_TAN,
        CB_INTR_TEST_DATE_YYYYMMDD,
        CB_INTR_TEST_DAY_YYYYDDD,
        CB_INTR_TEST_NUMVAL,
        CB_INTR_TEST_NUMVAL_C,
        CB_INTR_TEST_NUMVAL_F,
        CB_INTR_TRIM,
        CB_INTR_UPPER_CASE,
        CB_INTR_VARIANCE,
        CB_INTR_WHEN_COMPILED,
        CB_INTR_YEAR_TO_YYYY
};
Enumerator:
CB_SENDING_OPERAND 
CB_RECEIVING_OPERAND 

Definition at line 200 of file tree.h.

Enumerator:
CB_PERFORM_EXIT 
CB_PERFORM_ONCE 
CB_PERFORM_TIMES 
CB_PERFORM_UNTIL 
CB_PERFORM_FOREVER 

Definition at line 1028 of file tree.h.

enum cb_storage
Enumerator:
CB_STORAGE_CONSTANT 
CB_STORAGE_FILE 
CB_STORAGE_WORKING 
CB_STORAGE_LOCAL 
CB_STORAGE_LINKAGE 
CB_STORAGE_SCREEN 
CB_STORAGE_REPORT 
CB_STORAGE_COMMUNICATION 

Definition at line 163 of file tree.h.

                {
        CB_STORAGE_CONSTANT,            /* Constants */
        CB_STORAGE_FILE,                /* FILE SECTION */
        CB_STORAGE_WORKING,             /* WORKING-STORAGE SECTION */
        CB_STORAGE_LOCAL,               /* LOCAL-STORAGE SECTION */
        CB_STORAGE_LINKAGE,             /* LINKAGE SECTION */
        CB_STORAGE_SCREEN,              /* SCREEN SECTION */
        CB_STORAGE_REPORT,              /* REPORT SECTION */
        CB_STORAGE_COMMUNICATION        /* COMMUNICATION SECTION */
};
Enumerator:
CB_SWITCH_1 
CB_SWITCH_2 
CB_SWITCH_3 
CB_SWITCH_4 
CB_SWITCH_5 
CB_SWITCH_6 
CB_SWITCH_7 
CB_SWITCH_8 

Definition at line 124 of file tree.h.

Enumerator:
CB_CALL_CONVENTION_NAME 
CB_CODE_NAME 
CB_COMPUTER_NAME 
CB_DEVICE_NAME 
CB_ENTRY_CONVENTION_NAME 
CB_EXTERNAL_LOCALE_NAME 
CB_FEATURE_NAME 
CB_LIBRARY_NAME 
CB_SWITCH_NAME 
CB_TEXT_NAME 

Definition at line 88 of file tree.h.

enum cb_tag
Enumerator:
CB_TAG_CONST 
CB_TAG_INTEGER 
CB_TAG_STRING 
CB_TAG_ALPHABET_NAME 
CB_TAG_CLASS_NAME 
CB_TAG_LOCALE_NAME 
CB_TAG_SYSTEM_NAME 
CB_TAG_LITERAL 
CB_TAG_DECIMAL 
CB_TAG_FIELD 
CB_TAG_FILE 
CB_TAG_REFERENCE 
CB_TAG_BINARY_OP 
CB_TAG_FUNCALL 
CB_TAG_CAST 
CB_TAG_INTRINSIC 
CB_TAG_LABEL 
CB_TAG_ASSIGN 
CB_TAG_INITIALIZE 
CB_TAG_SEARCH 
CB_TAG_CALL 
CB_TAG_GOTO 
CB_TAG_IF 
CB_TAG_PERFORM 
CB_TAG_STATEMENT 
CB_TAG_CONTINUE 
CB_TAG_PERFORM_VARYING 
CB_TAG_PICTURE 
CB_TAG_LIST 

Definition at line 44 of file tree.h.

            {
        /* primitives */
        CB_TAG_CONST,           /* 0 constant value */
        CB_TAG_INTEGER,         /* 1 integer constant */
        CB_TAG_STRING,          /* 2 string constant */
        CB_TAG_ALPHABET_NAME,   /* 3 alphabet-name */
        CB_TAG_CLASS_NAME,      /* 4 class-name */
        CB_TAG_LOCALE_NAME,     /* 5 locale-name */
        CB_TAG_SYSTEM_NAME,     /* 6 system-name */
        CB_TAG_LITERAL,         /* 7 numeric/alphanumeric literal */
        CB_TAG_DECIMAL,         /* 8 decimal number */
        CB_TAG_FIELD,           /* 9 user-defined variable */
        CB_TAG_FILE,            /* 10 file description */
        /* expressions */
        CB_TAG_REFERENCE,       /* 11 reference to a field, file, or label */
        CB_TAG_BINARY_OP,       /* 12 binary operation */
        CB_TAG_FUNCALL,         /* 13 run-time function call */
        CB_TAG_CAST,            /* 14 type cast */
        CB_TAG_INTRINSIC,       /* 15 intrinsic function */
        /* statements */
        CB_TAG_LABEL,           /* 16 label statement */
        CB_TAG_ASSIGN,          /* 17 assignment statement */
        CB_TAG_INITIALIZE,      /* 18 INITIALIZE statement */
        CB_TAG_SEARCH,          /* 19 SEARCH statement */
        CB_TAG_CALL,            /* 20 CALL statement */
        CB_TAG_GOTO,            /* 21 GO TO statement */
        CB_TAG_IF,              /* 22 IF statement */
        CB_TAG_PERFORM,         /* 23 PERFORM statement */
        CB_TAG_STATEMENT,       /* 24 general statement */
        CB_TAG_CONTINUE,        /* 25 CONTINUE statement */
        /* miscellaneous */
        CB_TAG_PERFORM_VARYING, /* 26 PERFORM VARYING parameter */
        CB_TAG_PICTURE,         /* 27 PICTURE clause */
        CB_TAG_LIST             /* 28 list */
};
enum cb_usage
Enumerator:
CB_USAGE_BINARY 
CB_USAGE_BIT 
CB_USAGE_COMP_5 
CB_USAGE_COMP_X 
CB_USAGE_DISPLAY 
CB_USAGE_FLOAT 
CB_USAGE_DOUBLE 
CB_USAGE_INDEX 
CB_USAGE_NATIONAL 
CB_USAGE_OBJECT 
CB_USAGE_PACKED 
CB_USAGE_POINTER 
CB_USAGE_PROGRAM 
CB_USAGE_LENGTH 
CB_USAGE_PROGRAM_POINTER 
CB_USAGE_UNSIGNED_CHAR 
CB_USAGE_SIGNED_CHAR 
CB_USAGE_UNSIGNED_SHORT 
CB_USAGE_SIGNED_SHORT 
CB_USAGE_UNSIGNED_INT 
CB_USAGE_SIGNED_INT 
CB_USAGE_UNSIGNED_LONG 
CB_USAGE_SIGNED_LONG 

Definition at line 174 of file tree.h.


Function Documentation

void ambiguous_error ( cb_tree  x)

Definition at line 197 of file error.c.

{
        struct cb_word  *w;
        struct cb_field *p;
        struct cb_label *l2;
        cb_tree         l;
        cb_tree         y;

        w = CB_REFERENCE (x)->word;
        if (w->error == 0) {
                if (!errnamebuff) {
                        errnamebuff = cobc_malloc (COB_NORMAL_BUFF);
                }
                /* display error on the first time */
                snprintf (errnamebuff, COB_NORMAL_MAX, "'%s'", CB_NAME (x));
                for (l = CB_REFERENCE (x)->chain; l; l = CB_REFERENCE (l)->chain) {
                        strcat (errnamebuff, " in '");
                        strcat (errnamebuff, CB_NAME (l));
                        strcat (errnamebuff, "'");
                }
                cb_error_x (x, _("%s ambiguous; need qualification"), errnamebuff);
                w->error = 1;

                /* display all fields with the same name */
                for (l = w->items; l; l = CB_CHAIN (l)) {
                        y = CB_VALUE (l);
                        snprintf (errnamebuff, COB_NORMAL_MAX, "'%s' ", w->name);
                        switch (CB_TREE_TAG (y)) {
                        case CB_TAG_FIELD:
                                for (p = CB_FIELD (y)->parent; p; p = p->parent) {
                                        strcat (errnamebuff, "in '");
                                        strcat (errnamebuff, p->name);
                                        strcat (errnamebuff, "' ");
                                }
                                break;
                        case CB_TAG_LABEL:
                                l2 = CB_LABEL (y);
                                if (l2->section) {
                                        strcat (errnamebuff, "in '");
                                        strcat (errnamebuff, (const char *)(l2->section->name));
                                        strcat (errnamebuff, "' ");
                                }
                                break;
                        default:
                                break;
                        }
                        strcat (errnamebuff, _("defined here"));
                        cb_error_x (y, errnamebuff);
                }
        }
}

Here is the call graph for this function:

Here is the caller graph for this function:

struct cb_file* build_file ( cb_tree  name) [read]

Definition at line 1577 of file tree.c.

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:

void cb_add_78 ( struct cb_field f)

Here is the caller graph for this function:

cb_tree cb_build_add ( cb_tree  v,
cb_tree  n,
cb_tree  round_opt 
)

Definition at line 2591 of file typeck.c.

{
        cb_tree         opt;
        struct cb_field *f;

#ifdef  COB_NON_ALIGNED
        if (CB_INDEX_P (v)) {
                return cb_build_move (cb_build_binary_op (v, '+', n), v);
        }
        if (CB_TREE_CLASS (v) == CB_CLASS_POINTER) {
                current_program->gen_ptrmanip = 1;
                return cb_build_funcall_3 ("cob_pointer_manip", v, n, cb_int0);
        }
#else
        if (CB_INDEX_P (v) || CB_TREE_CLASS (v) == CB_CLASS_POINTER) {
                return cb_build_move (cb_build_binary_op (v, '+', n), v);
        }
#endif

        if (CB_REF_OR_FIELD_P (v)) {
                f = cb_field (v);
                f->count++;
        }
        if (CB_REF_OR_FIELD_P (n)) {
                f = cb_field (n);
                f->count++;
        }
        if (round_opt == cb_high) {
                if (cb_fits_int (n)) {
                        return cb_build_optim_add (v, n);
                } else {
                        return cb_build_funcall_3 ("cob_add", v, n, cb_int0);
                }
        }
        opt = build_store_option (v, round_opt);
        if (opt == cb_int0 && cb_fits_int (n)) {
                return cb_build_optim_add (v, n);
        }
        return cb_build_funcall_3 ("cob_add", v, n, opt);
}

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_address ( cb_tree  x)

Definition at line 1027 of file typeck.c.

{
        if (x == cb_error_node ||
            (CB_REFERENCE_P (x) && cb_ref (x) == cb_error_node)) {
                return cb_error_node;
        }

        return cb_build_cast_address (x);
}

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 call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_assignment_name ( struct cb_file curfile,
cb_tree  name 
)

Definition at line 677 of file typeck.c.

{
        const char      *s;
        const char      *p;

        if (name == cb_error_node) {
                return cb_error_node;
        }

        switch (CB_TREE_TAG (name)) {
        case CB_TAG_LITERAL:
                if (strcmp ((char *)(CB_LITERAL(name)->data), "$#@DUMMY@#$") == 0) {
                        cfile->special = 2;
                }
                return name;

        case CB_TAG_REFERENCE:
                s = CB_REFERENCE (name)->word->name;
                if (strcasecmp (s, "KEYBOARD") == 0) {
                        s = "#DUMMY#";
                        cfile->special = 1;
                        return cb_build_alphanumeric_literal ((ucharptr)s, strlen (s));
                }
                switch (cb_assign_clause) {
                case CB_ASSIGN_COBOL2002:
                        /* TODO */
                        return cb_error_node;

                case CB_ASSIGN_MF:
                        if (cfile->external_assign) {
                                p = strrchr (s, '-');
                                if (p) {
                                        s = p + 1;
                                }
                                return cb_build_alphanumeric_literal ((ucharptr)s, strlen (s));
                        }
                        current_program->reference_list =
                            cb_list_add (current_program->reference_list, name);
                        return name;

                case CB_ASSIGN_IBM:
                        /* check organization */
                        if (strncmp (s, "S-", 2) == 0 ||
                            strncmp (s, "AS-", 3) == 0) {
                                goto org;
                        }
                        /* skip the device label if exists */
                        if ((p = strchr (s, '-')) != NULL) {
                                s = p + 1;
                        }
                        /* check organization again */
                        if (strncmp (s, "S-", 2) == 0 ||
                            strncmp (s, "AS-", 3) == 0) {
org:
                                /* skip it for now */
                                s = strchr (s, '-') + 1;
                        }
                        /* convert the name into literal */
                        return cb_build_alphanumeric_literal ((ucharptr)s, strlen (s));
                }

        default:
                return cb_error_node;
        }
}

Here is the call 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 call graph for this function:

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);
}

Here is the call graph for this function:

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_cond ( cb_tree  x)

Definition at line 2354 of file typeck.c.

{
        int                     size1;
        int                     size2;
        struct cb_field         *f;
        struct cb_binary_op     *p;
        cb_tree                 d1;
        cb_tree                 d2;

        switch (CB_TREE_TAG (x)) {
        case CB_TAG_CONST:
        case CB_TAG_FUNCALL:
                return x;
        case CB_TAG_REFERENCE:
                if (!CB_FIELD_P (cb_ref (x))) {
                        return cb_build_cond (cb_ref (x));
                }

                f = cb_field (x);

                /* level 88 condition */
                if (f->level == 88) {
                        /* We need to build a 88 condition at every occurrence
                           instead of once at the beginning because a 88 item
                           may be subscripted (i.e., it is not a constant tree). */
                        return cb_build_cond (build_cond_88 (x));
                }

                cb_error_x (x, _("Invalid expression"));
                return cb_error_node;
        case CB_TAG_BINARY_OP:
                p = CB_BINARY_OP (x);
                switch (p->op) {
                case '!':
                        return cb_build_negation (cb_build_cond (p->x));
                case '&':
                case '|':
                        return cb_build_binary_op (cb_build_cond (p->x), p->op, cb_build_cond (p->y));
                default:
                        if (CB_INDEX_P (p->x) || CB_INDEX_P (p->y)
                            || CB_TREE_CLASS (p->x) == CB_CLASS_POINTER
                            || CB_TREE_CLASS (p->y) == CB_CLASS_POINTER) {
                                x = cb_build_binary_op (p->x, '-', p->y);
                        } else if (CB_BINARY_OP_P (p->x) || CB_BINARY_OP_P (p->y)) {
                                /* decimal comparison */
                                d1 = decimal_alloc ();
                                d2 = decimal_alloc ();

                                decimal_expand (d1, p->x);
                                decimal_expand (d2, p->y);
                                dpush (cb_build_funcall_2 ("cob_decimal_cmp", d1, d2));
                                decimal_free ();
                                decimal_free ();
                                x = cb_list_reverse (decimal_stack);
                                decimal_stack = NULL;
                        } else {
                                if (cb_chk_num_cond (p->x, p->y)) {
                                        size1 = cb_field_size (p->x);
                                        x = cb_build_funcall_3 ("memcmp",
                                                cb_build_cast_address (p->x),
                                                cb_build_cast_address (p->y),
                                                cb_int (size1));
                                        break;
                                }
                                if (CB_TREE_CLASS (p->x) == CB_CLASS_NUMERIC
                                    && CB_TREE_CLASS (p->y) == CB_CLASS_NUMERIC
                                    && cb_fits_int (p->y)) {
                                        x = cb_build_optim_cond (p);
                                        break;
                                }

                                /* field comparison */
                                if ((CB_REF_OR_FIELD_P (p->x))
                                   && (CB_TREE_CATEGORY (p->x) == CB_CATEGORY_ALPHANUMERIC ||
                                       CB_TREE_CATEGORY (p->x) == CB_CATEGORY_ALPHABETIC)
                                   && (cb_field_size (p->x) == 1)
                                   && (!current_program->alphabet_name_list)
                                   && (p->y == cb_space || p->y == cb_low ||
                                       p->y == cb_high || p->y == cb_zero)) {
                                        x = cb_build_funcall_2 ("$G", p->x, p->y);
                                        break;
                                }
                                if (cb_chk_alpha_cond (p->x) && cb_chk_alpha_cond (p->y)) {
                                        size1 = cb_field_size (p->x);
                                        size2 = cb_field_size (p->y);
                                } else {
                                        size1 = 0;
                                        size2 = 0;
                                }
                                if (size1 == 1 && size2 == 1) {
                                        x = cb_build_funcall_2 ("$G", p->x, p->y);
                                } else if (size1 != 0 && size1 == size2) {
                                        x = cb_build_funcall_3 ("memcmp",
                                                cb_build_cast_address (p->x),
                                                cb_build_cast_address (p->y),
                                                cb_int (size1));
                                } else {
                                        if (CB_TREE_CLASS (p->x) == CB_CLASS_NUMERIC && p->y == cb_zero) {
                                                x = cb_build_optim_cond (p);
                                        } else {
                                                x = cb_build_funcall_2 ("cob_cmp", p->x, p->y);
                                        }
                                }
                        }
                }
                return cb_build_binary_op (x, p->op, p->y);
        default:
                cb_error_x (x, _("Invalid expression"));
                return cb_error_node;
        }
/* NOT REACHED */
        return x;
}

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_const_length ( cb_tree  x)

Definition at line 956 of file typeck.c.

{
        struct cb_field         *f;
        char                    buff[64];

        if (x == cb_error_node) {
                return cb_error_node;
        }
        if (CB_REFERENCE_P (x) && cb_ref (x) == cb_error_node) {
                return cb_error_node;
        }

        memset (buff, 0, sizeof (buff));
        f = CB_FIELD (cb_ref (x));
        if (f->flag_any_length) {
                cb_error (_("ANY LENGTH item not allowed here"));
                return cb_error_node;
        }
        if (f->level == 88) {
                cb_error (_("88 level item not allowed here"));
                return cb_error_node;
        }
        if (!f->flag_is_verified) {
                cb_validate_field (f);
        }
        sprintf (buff, "%d", f->memory_size);
        return cb_build_numeric_literal (0, (ucharptr)buff, 0);
}

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 call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_converting ( cb_tree  x,
cb_tree  y,
cb_tree  l 
)

Definition at line 3847 of file typeck.c.

{
        return cb_list_add (l, cb_build_funcall_2 ("cob_inspect_converting", x, y));
}

Here is the call 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);
}

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_display_upon ( cb_tree  x)

Definition at line 3406 of file typeck.c.

{
        if (x == cb_error_node) {
                return cb_error_node;
        }

        switch (CB_SYSTEM_NAME (cb_ref (x))->token) {
        case CB_DEVICE_CONSOLE:
        case CB_DEVICE_SYSOUT:
                return cb_int0;
        case CB_DEVICE_SYSERR:
                return cb_int1;
        default:
                cb_error_x (x, _("Invalid output stream"));
                return cb_error_node;
        }
}

Here is the call graph for this function:

cb_tree cb_build_display_upon_direct ( cb_tree  x)

Definition at line 3425 of file typeck.c.

{
        const char      *name;
        cb_tree         sys;

        if (x == cb_error_node) {
                return cb_error_node;
        }
        name = CB_NAME (x);
        if (CB_REFERENCE (x)->word->count == 0) {
                sys = lookup_system_name (CB_NAME (x));
                if (sys != cb_error_node) {
                        switch (CB_SYSTEM_NAME (sys)->token) {
                        case CB_DEVICE_CONSOLE:
                        case CB_DEVICE_SYSOUT:
                                cb_warning_x (x, _("'%s' undefined in SPECIAL-NAMES"), name);
                                return cb_int0;
                        case CB_DEVICE_SYSERR:
                                cb_warning_x (x, _("'%s' undefined in SPECIAL-NAMES"), name);
                                return cb_int1;
                        default:
                                break;
                        }
                }
        }

        cb_error_x (x, _("'%s' undefined in SPECIAL-NAMES"), name);
        return cb_error_node;
}

Here is the call graph for this function:

cb_tree cb_build_expr ( cb_tree  list)

Definition at line 1820 of file typeck.c.

{
        cb_tree l;
/* RXW
        cb_tree x;
*/
        int     op;

        cb_expr_init ();

        for (l = list; l; l = CB_CHAIN (l)) {
                op = CB_PURPOSE_INT (l);
                switch (op) {
                case '9': /* NUMERIC */
                        cb_expr_shift_class ("cob_is_numeric");
                        break;
                case 'A': /* ALPHABETIC */
                        cb_expr_shift_class ("cob_is_alpha");
                        break;
                case 'L': /* ALPHABETIC_LOWER */
                        cb_expr_shift_class ("cob_is_lower");
                        break;
                case 'U': /* ALPHABETIC_UPPER */
                        cb_expr_shift_class ("cob_is_upper");
                        break;
                case 'P': /* POSITIVE */
                        cb_expr_shift_sign ('>');
                        break;
                case 'N': /* NEGATIVE */
                        cb_expr_shift_sign ('<');
                        break;
                case 'O': /* OMITTED */
                        current_statement->null_check = NULL;
                        cb_expr_shift_class ("cob_is_omitted");
                        break;
/* RXW
                case 'x':
                        if (CB_VALUE (l) && CB_REFERENCE_P (CB_VALUE (l))) {
                                x = CB_CHAIN (l);
                                if (x && cb_field (CB_VALUE (l))->level == 88) {
                                        switch (CB_PURPOSE_INT (x)) {
                                        case '&':
                                        case '|':
                                        case '(':
                                        case ')':
                                                break;
                                        default:
                                                cb_error (_("Invalid condition"));
                                                break;
                                        }
                                }
                        }
                        cb_expr_shift (op, CB_VALUE (l));
                        break;
*/
                default:
                        cb_expr_shift (op, CB_VALUE (l));
                        break;
                }
        }

        return cb_expr_finish ();
}

Here is the call graph for this function:

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_field_tree ( cb_tree  level,
cb_tree  name,
struct cb_field last_field,
enum cb_storage  storage,
struct cb_file fn 
)

Definition at line 78 of file field.c.

{
        struct cb_reference     *r;
        struct cb_field         *f;
        struct cb_field         *p;
        struct cb_field         *field_fill;
        cb_tree                 dummy_fill;
        cb_tree                 l;
        cb_tree                 x;
        int                     lv;

        if (level == cb_error_node || name == cb_error_node) {
                return cb_error_node;
        }

        /* check the level number */
        lv = cb_get_level (level);
        if (!lv) {
                return cb_error_node;
        }

        /* build the field */
        r = CB_REFERENCE (name);
        f = CB_FIELD (cb_build_field (name));
        f->storage = storage;
        last_real_field = last_field;
        if (lv == 78) {
                f->level = 01;
                f->flag_item_78 = 1;
                return CB_TREE (f);
        } else {
                f->level = lv;
        }
        if (f->level == 01 && storage == CB_STORAGE_FILE) {
                if (fn->external) {
                        f->flag_external = 1;
                        has_external = 1;
                } else if (fn->global) {
                        f->flag_is_global = 1;
                }
        }
        if (last_field) {
                if (last_field->level == 77 && f->level != 01 &&
                    f->level != 77 && f->level != 66 && f->level != 88) {
                        cb_error_x (name, _("Level number must begin with 01 or 77"));
                        return cb_error_node;
                }
        }

        /* checks for redefinition */
        if (cb_warn_redefinition) {
                if (r->word->count > 1) {
                        if (f->level == 01 || f->level == 77) {
                                redefinition_warning (name, NULL);
                        } else {
                                for (l = r->word->items; l; l = CB_CHAIN (l)) {
                                        x = CB_VALUE (l);
                                        if (!CB_FIELD_P (x)
                                            || CB_FIELD (x)->level == 01
                                            || CB_FIELD (x)->level == 77
                                            || (f->level == last_field->level
                                                && CB_FIELD (x)->parent == last_field->parent)) {
                                                redefinition_warning (name, x);
                                                break;
                                        }
                                }
                        }
                }
        }

        if (last_field && last_field->level == 88) {
                last_field = last_field->parent;
        }

        /* link the field into the tree */
        if (f->level == 01 || f->level == 77) {
                /* top level */
                cb_needs_01 = 0;
                if (last_field) {
/*
                        cb_field_add (cb_field_founder (last_field), f);
*/
                        cb_field_founder (last_field)->sister = f;
                }
        } else if (!last_field || cb_needs_01) {
                /* invalid top level */
                cb_error_x (name, _("Level number must begin with 01 or 77"));
                return cb_error_node;
        } else if (f->level == 66) {
                /* level 66 */
                f->parent = cb_field_founder (last_field);
                for (p = f->parent->children; p && p->sister; p = p->sister) ;
                if (p) {
                        p->sister = f;
                }
        } else if (f->level == 88) {
                /* level 88 */
                f->parent = last_field;
        } else if (f->level > last_field->level) {
                /* lower level */
                last_field->children = f;
                f->parent = last_field;
        } else if (f->level == last_field->level) {
                /* same level */
same_level:
                last_field->sister = f;
                f->parent = last_field->parent;
        } else {
                /* upper level */
                for (p = last_field->parent; p; p = p->parent) {
                        if (p->level == f->level) {
                                last_field = p;
                                goto same_level;
                        }
                        if (cb_relax_level_hierarchy && p->level < f->level) {
                                break;
                        }
                }
                if (cb_relax_level_hierarchy) {
                        dummy_fill = cb_build_filler ();
                        field_fill = CB_FIELD (cb_build_field (dummy_fill));
                        cb_warning_x (name, _("No previous data item of level %02d"), f->level);
                        field_fill->level = f->level;
                        field_fill->storage = storage;
                        field_fill->children = p->children;
                        field_fill->parent = p;
                        for (p = p->children; p != NULL; p = p->sister) {
                                p->parent = field_fill;
                        }
                        field_fill->parent->children = field_fill;
                        field_fill->sister = f;
                        f->parent = field_fill->parent;
                        last_field = field_fill;
                } else {
                        cb_error_x (name, _("No previous data item of level %02d"), f->level);
                        return cb_error_node;
                }
        }

        /* inherit parent's properties */
        if (f->parent) {
                f->usage = f->parent->usage;
                f->indexes = f->parent->indexes;
                f->flag_sign_leading = f->parent->flag_sign_leading;
                f->flag_sign_separate = f->parent->flag_sign_separate;
                f->flag_is_global = f->parent->flag_is_global;
        }
        return CB_TREE (f);
}

Here is the call 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);
}

Here is the call graph for this function:

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 call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_identifier ( cb_tree  x)

Definition at line 763 of file typeck.c.

{
        struct cb_reference     *r;
        struct cb_field         *f;
        struct cb_field         *p;
        const char              *name;
        cb_tree                 v;
        cb_tree                 e1;
        cb_tree                 e2;
        cb_tree                 l;
        cb_tree                 sub;
        int                     offset;
        int                     length;
        int                     n;

        if (x == cb_error_node) {
                return cb_error_node;
        }

        r = CB_REFERENCE (x);
        name = r->word->name;

        /* resolve reference */
        v = cb_ref (x);
        if (v == cb_error_node) {
                return cb_error_node;
        }

        /* check if it is a data name */
        if (!CB_FIELD_P (v)) {
                if (r->subs) {
                        cb_error_x (x, _("'%s' cannot be subscripted"), name);
                        return cb_error_node;
                }
                if (r->offset) {
                        cb_error_x (x, _("'%s' cannot be reference modified"), name);
                        return cb_error_node;
                }
                return x;
        }
        f = CB_FIELD (v);

        /* BASED check */
        if (CB_EXCEPTION_ENABLE (COB_EC_BOUND_PTR)) {
                for (p = f; p->parent; p = p->parent) {
                        ;
                }
                if (current_statement) {
                        if (p->flag_item_based ||
                           (f->storage == CB_STORAGE_LINKAGE &&
                            !p->flag_is_pdiv_parm)) {
                                current_statement->null_check = cb_build_funcall_2 (
                                        "cob_check_based",
                                        cb_build_address (cb_build_field_reference (p, NULL)),
                                        cb_build_string0 ((ucharptr)name));
                        }
                }
        }

        /* check the number of subscripts */
        if (!r->all && cb_list_length (r->subs) != f->indexes) {
                switch (f->indexes) {
                case 0:
                        cb_error_x (x, _("'%s' cannot be subscripted"), name);
                        return cb_error_node;
                case 1:
                        cb_error_x (x, _("'%s' requires 1 subscript"), name);
                        return cb_error_node;
                default:
                        cb_error_x (x, _("'%s' requires %d subscripts"), name, f->indexes);
                        return cb_error_node;
                }
        }

        /* subscript check */
        if (!r->all && r->subs) {
                l = r->subs;
                for (p = f; p; p = p->parent) {
                        if (p->flag_occurs) {
                                sub = cb_check_integer_value (CB_VALUE (l));

                                l = CB_CHAIN (l);

                                if (sub == cb_error_node) {
                                        continue;
                                }

                                /* compile-time check */
                                if (CB_LITERAL_P (sub)) {
                                        n = cb_get_int (sub);
                                        if (n < 1 || n > p->occurs_max) {
                                                cb_error_x (x, _("Subscript of '%s' out of bounds: %d"),
                                                            name, n);
                                        }
                                }

                                /* run-time check */
                                if (CB_EXCEPTION_ENABLE (COB_EC_BOUND_SUBSCRIPT)) {
                                        if (p->occurs_depending) {
                                                e1 = cb_build_funcall_4 ("cob_check_odo",
                                                         cb_build_cast_integer (p->occurs_depending),
                                                         cb_int (p->occurs_min),
                                                         cb_int (p->occurs_max),
                                                         cb_build_string0
                                                         ((ucharptr)(cb_field (p->occurs_depending)->name)));
                                                e2 = cb_build_funcall_4 ("cob_check_subscript",
                                                         cb_build_cast_integer (sub),
                                                         cb_int1,
                                                         cb_build_cast_integer (p->occurs_depending),
                                                         cb_build_string0 ((ucharptr)name));
                                                r->check = cb_list_add (r->check, e1);
                                                r->check = cb_list_add (r->check, e2);
                                        } else {
                                                if (!CB_LITERAL_P (sub)) {
                                                        e1 = cb_build_funcall_4 ("cob_check_subscript",
                                                                cb_build_cast_integer (sub),
                                                                cb_int1,
                                                                cb_int (p->occurs_max),
                                                                cb_build_string0 ((ucharptr)name));
                                                        r->check = cb_list_add (r->check, e1);
                                                }
                                        }
                                }
                        }
                }
        }

        /* reference modification check */
        if (r->offset) {
                /* compile-time check */
                if (CB_LITERAL_P (r->offset)) {
                        offset = cb_get_int (r->offset);
                        if (offset < 1 || offset > f->size) {
                                cb_error_x (x, _("Offset of '%s' out of bounds: %d"), name, offset);
                        } else if (r->length && CB_LITERAL_P (r->length)) {
                                length = cb_get_int (r->length);
                                if (length < 1 || length > f->size - offset + 1) {
                                        cb_error_x (x, _("Length of '%s' out of bounds: %d"),
                                                    name, length);
                                }
                        }
                }

                /* run-time check */
                if (CB_EXCEPTION_ENABLE (COB_EC_BOUND_REF_MOD)) {
                        if (!CB_LITERAL_P (r->offset)
                            || (r->length && !CB_LITERAL_P (r->length))) {
                                e1 = cb_build_funcall_4 ("cob_check_ref_mod",
                                                         cb_build_cast_integer (r->offset),
                                                         r->length ? cb_build_cast_integer (r->length) :
                                                         cb_int1, cb_int (f->size),
                                                         cb_build_string0 ((ucharptr)f->name));
                                r->check = cb_list_add (r->check, e1);
                        }
                }
        }

        if (f->storage == CB_STORAGE_CONSTANT) {
                return CB_VALUE (f->values);
        }

        return x;
}

Here is the call 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 call graph for this function:

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_index ( cb_tree  name,
cb_tree  values,
int  indexed_by,
struct cb_field qual 
)

Definition at line 744 of file typeck.c.

{
        struct cb_field *f;

        f = CB_FIELD (cb_build_field (x));
        f->usage = CB_USAGE_INDEX;
        cb_validate_field (f);
        if (values) {
                f->values = cb_list_init (values);
        }
        if (qual) {
                f->index_qual = qual;
        }
        f->flag_indexed_by = indexed_by;
        current_program->working_storage = cb_field_add (current_program->working_storage, f);
        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 call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_inspect_region ( cb_tree  l,
cb_tree  pos,
cb_tree  x 
)

Definition at line 3859 of file typeck.c.

{
        if (pos == CB_BEFORE) {
                return cb_list_add (l, cb_build_funcall_1 ("cob_inspect_before", x));
        } else {
                return cb_list_add (l, cb_build_funcall_1 ("cob_inspect_after", x));
        }
}

Here is the call graph for this function:

cb_tree cb_build_inspect_region_start ( void  )

Definition at line 3853 of file typeck.c.

{
        return cb_list_init (cb_build_funcall_0 ("cob_inspect_start"));
}
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:

Here is the caller graph for this function:

cb_tree cb_build_length ( cb_tree  x)

Definition at line 986 of file typeck.c.

{
        struct cb_field         *f;
        struct cb_literal       *l;
        cb_tree                 temp;
        char                    buff[64];

        if (x == cb_error_node) {
                return cb_error_node;
        }
        if (CB_REFERENCE_P (x) && cb_ref (x) == cb_error_node) {
                return cb_error_node;
        }

        memset (buff, 0, sizeof (buff));
        if (CB_LITERAL_P (x)) {
                l = CB_LITERAL (x);
                sprintf (buff, "%d", (int)l->size);
                return cb_build_numeric_literal (0, (ucharptr)buff, 0);
        }
        if (CB_REF_OR_FIELD_P (x)) {
                f = CB_FIELD (cb_ref (x));
                if (f->flag_any_length) {
                        return cb_build_any_intrinsic (cb_list_init (x));
                }
                if (cb_field_variable_size (f) == NULL) {
                        sprintf (buff, "%d", cb_field_size (x));
                        return cb_build_numeric_literal (0, (ucharptr)buff, 0);
                }
        }
        if (CB_INTRINSIC_P (x)) {
                return cb_build_any_intrinsic (cb_list_init (x));
        }
        temp = cb_build_index (cb_build_filler (), NULL, 0, NULL);
        CB_FIELD (cb_ref (temp))->usage = CB_USAGE_LENGTH;
        CB_FIELD (cb_ref (temp))->count++;
        cb_emit (cb_build_assign (temp, cb_build_length_1 (x)));
        return temp;
}

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_list ( cb_tree  purpose,
cb_tree  value,
cb_tree  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);
}

Here is the call graph for this function:

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_move ( cb_tree  src,
cb_tree  dst 
)

Definition at line 4964 of file typeck.c.

{
        struct cb_field *f;
        struct cb_field *p;

        if (src == cb_error_node || dst == cb_error_node) {
                return cb_error_node;
        }

        if (validate_move (src, dst, 0) < 0) {
                return cb_error_node;
        }

        if (CB_REFERENCE_P (src)) {
                CB_REFERENCE (src)->type = CB_SENDING_OPERAND;
        }
        if (CB_REFERENCE_P (dst)) {
                CB_REFERENCE (dst)->type = CB_RECEIVING_OPERAND;
        }

        if (CB_TREE_CLASS (dst) == CB_CLASS_POINTER) {
                return cb_build_assign (dst, src);
        }

        if (CB_REFERENCE_P (src) && CB_ALPHABET_NAME_P(CB_REFERENCE(src)->value)) {
                return cb_build_move_call (src, dst);
        }
        if (CB_INDEX_P (dst)) {
                if (src == cb_null) {
                        return cb_build_assign (dst, cb_zero);
                }
                return cb_build_assign (dst, src);
        }

        if (CB_INDEX_P (src)) {
                return cb_build_funcall_2 ("cob_set_int", dst, cb_build_cast_integer (src));
        }

        if (CB_INTRINSIC_P (src) || CB_INTRINSIC_P (dst)) {
                return cb_build_move_call (src, dst);
        }

        f = cb_field (dst);

        if (CB_EXCEPTION_ENABLE (COB_EC_BOUND_SUBSCRIPT)) {
                for (p = f; p; p = p->parent) {
                        if (p->flag_occurs) {
                                return cb_build_move_call (src, dst);
                        }
                }
                if (CB_REF_OR_FIELD_P (src)) {
                        for (p = cb_field (src); p; p = p->parent) {
                                if (p->flag_occurs) {
                                        return cb_build_move_call (src, dst);
                                }
                        }
                }
        }

        /* output optimal code */
        if (src == cb_zero) {
                return cb_build_move_zero (dst);
        } else if (src == cb_space) {
                return cb_build_move_space (dst);
        } else if (src == cb_high) {
                return cb_build_move_high (dst);
        } else if (src == cb_low) {
                return cb_build_move_low (dst);
        } else if (src == cb_quote) {
                return cb_build_move_quote (dst);
        } else if (CB_LITERAL_P (src)) {
                return cb_build_move_literal (src, dst);
        }
        return cb_build_move_field (src, dst);
}

Here is the call graph for this function:

Here is the caller 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 call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_perform_exit ( struct cb_label label)

Definition at line 5156 of file typeck.c.

{
        cb_tree x;

        x = cb_build_perform (CB_PERFORM_EXIT);
        CB_PERFORM (x)->data = CB_TREE (label);
        return x;
}

Here is the call graph for this function:

cb_tree cb_build_perform_forever ( cb_tree  body)

Definition at line 5143 of file typeck.c.

{
        cb_tree x;

        if (body == cb_error_node) {
                return cb_error_node;
        }
        x = cb_build_perform (CB_PERFORM_FOREVER);
        CB_PERFORM (x)->body = body;
        return x;
}

Here is the call graph for this function:

cb_tree cb_build_perform_once ( cb_tree  body)

Definition at line 5105 of file typeck.c.

{
        cb_tree x;

        if (body == cb_error_node) {
                return cb_error_node;
        }
        x = cb_build_perform (CB_PERFORM_ONCE);
        CB_PERFORM (x)->body = body;
        return x;
}

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_perform_times ( cb_tree  count)

Definition at line 5118 of file typeck.c.

{
        cb_tree x;

        if (cb_check_integer_value (times) == cb_error_node) {
                return cb_error_node;
        }

        x = cb_build_perform (CB_PERFORM_TIMES);
        CB_PERFORM (x)->data = times;
        return x;
}

Here is the call graph for this function:

cb_tree cb_build_perform_until ( cb_tree  condition,
cb_tree  varying 
)

Definition at line 5132 of file typeck.c.

{
        cb_tree x;

        x = cb_build_perform (CB_PERFORM_UNTIL);
        CB_PERFORM (x)->test = condition;
        CB_PERFORM (x)->varying = varying;
        return x;
}

Here is the call graph for this function:

cb_tree cb_build_perform_varying ( cb_tree  name,
cb_tree  from,
cb_tree  step,
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:

cb_tree cb_build_ppointer ( cb_tree  x)

Definition at line 1038 of file typeck.c.

{
        struct cb_field *f;

        if (x == cb_error_node ||
            (CB_REFERENCE_P (x) && cb_ref (x) == cb_error_node)) {
                return cb_error_node;
        }

        if (CB_REFERENCE_P (x)) {
                f = cb_field (cb_ref(x));
                f->count++;
        }
        return cb_build_cast_ppointer (x);
}

Here is the call 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:

const char* cb_build_program_id ( cb_tree  name,
cb_tree  alt_name 
)

Definition at line 591 of file typeck.c.

{
        const char      *s;

/* This needs some more thought, should we generate an entry
        point per program source name ?
        if (alt_name) {
                s = (char *)CB_LITERAL (alt_name)->data;
        } else if (CB_LITERAL_P (name)) {
                s = (char *)CB_LITERAL (name)->data;
        } else {
                s = (char *)CB_NAME (name);
        }

        if (!cb_flag_main && strcmp (s, source_name)) {
                cb_warning (_("Source name '%s' differs from PROGRAM-ID '%s'"),
                                source_name, s);
                current_program->source_name = strdup (source_name);
        }
 End comment out */

        if (alt_name) {
                current_program->orig_source_name = strdup ((char *)CB_LITERAL (alt_name)->data);
                s = (char *)CB_LITERAL (alt_name)->data;
        } else if (CB_LITERAL_P (name)) {
                current_program->orig_source_name = strdup ((char *)CB_LITERAL (name)->data);
                s = cb_encode_program_id ((char *)CB_LITERAL (name)->data);
        } else {
                current_program->orig_source_name = strdup (CB_NAME (name));
                s = cb_encode_program_id (CB_NAME (name));
        }
        if (cobc_check_valid_name (current_program->orig_source_name)) {
                cb_error (_("PROGRAM-ID '%s' invalid"), current_program->orig_source_name);
        }
        return s;
}

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 call graph for this function:

Here is the caller graph for this function:

void cb_build_registers ( void  )

Definition at line 494 of file typeck.c.

{
#if !defined(__linux__) && !defined(__CYGWIN__) && defined(HAVE_TIMEZONE)
        long    contz;
#endif
        time_t  t;
        char    buff[48];

        /* RETURN-CODE */
        if (!current_program->nested_level) {
                current_program->cb_return_code =
                        cb_build_index (cb_build_reference ("RETURN-CODE"),
                                        cb_zero, 0, NULL);
                cb_field (current_program->cb_return_code)->flag_is_global = 1;
        }

        /* SORT-RETURN */
        current_program->cb_sort_return =
                cb_build_index (cb_build_reference ("SORT-RETURN"), cb_zero, 0, NULL);
        cb_field (current_program->cb_sort_return)->flag_no_init = 1;

        /* NUMBER-OF-CALL-PARAMETERS */
        current_program->cb_call_params =
                cb_build_index (cb_build_reference ("NUMBER-OF-CALL-PARAMETERS"), cb_zero, 0, NULL);
        cb_field (current_program->cb_call_params)->flag_no_init = 1;

        /* TALLY */
        /* 01 TALLY GLOBAL PICTURE 9(9) USAGE COMP-5 VALUE ZERO. */
        /* TALLY/EXAMINE  not standard/supported */

        t = time (NULL);

        /* WHEN-COMPILED */
        memset (buff, 0, sizeof (buff));
        strftime (buff, 17, "%m/%d/%y%H.%M.%S", localtime (&t));
        cb_build_constant (cb_build_reference ("WHEN-COMPILED"),
                           cb_build_alphanumeric_literal ((ucharptr)buff, 16));

        /* FUNCTION WHEN-COMPILED */
        memset (buff, 0, sizeof (buff));
#if defined(__linux__) || defined(__CYGWIN__)
        strftime (buff, 22, "%Y%m%d%H%M%S00%z", localtime (&t));
#elif defined(HAVE_TIMEZONE)
        strftime (buff, 17, "%Y%m%d%H%M%S00", localtime (&t));
        if (timezone <= 0) {
                contz = -timezone;
                buff[16] = '+';
        } else {
                contz = timezone;
                buff[16] = '-';
        }
        sprintf (&buff[17], "%2.2ld%2.2ld", contz / 3600, contz % 60);
#else
        strftime (buff, 22, "%Y%m%d%H%M%S0000000", localtime (&t));
#endif
        cb_intr_whencomp = cb_build_alphanumeric_literal ((ucharptr)buff, 21);

        /* FUNCTION PI */
        memset (buff, 0, sizeof (buff));
        strcpy (buff, "31415926535897932384626433832795029");
        cb_intr_pi = cb_build_numeric_literal (0, (ucharptr)buff, 34);

        /* FUNCTION E */
        memset (buff, 0, sizeof (buff));
        strcpy (buff, "27182818284590452353602874713526625");
        cb_intr_e = cb_build_numeric_literal (0, (ucharptr)buff, 34);
}

Here is the call graph for this function:

cb_tree cb_build_replacing_all ( cb_tree  x,
cb_tree  y,
cb_tree  l 
)

Definition at line 3823 of file typeck.c.

{
        return cb_list_add (l, cb_build_funcall_2 ("cob_inspect_all", y, x));
}

Here is the call graph for this function:

cb_tree cb_build_replacing_characters ( cb_tree  x,
cb_tree  l 
)

Definition at line 3817 of file typeck.c.

{
        return cb_list_add (l, cb_build_funcall_1 ("cob_inspect_characters", x));
}

Here is the call graph for this function:

cb_tree cb_build_replacing_first ( cb_tree  x,
cb_tree  y,
cb_tree  l 
)

Definition at line 3835 of file typeck.c.

{
        return cb_list_add (l, cb_build_funcall_2 ("cob_inspect_first", y, x));
}

Here is the call graph for this function:

cb_tree cb_build_replacing_leading ( cb_tree  x,
cb_tree  y,
cb_tree  l 
)

Definition at line 3829 of file typeck.c.

{
        return cb_list_add (l, cb_build_funcall_2 ("cob_inspect_leading", y, x));
}

Here is the call graph for this function:

cb_tree cb_build_replacing_trailing ( cb_tree  x,
cb_tree  y,
cb_tree  l 
)

Definition at line 3841 of file typeck.c.

{
        return cb_list_add (l, cb_build_funcall_2 ("cob_inspect_trailing", y, x));
}

Here is the call 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 call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_section_name ( cb_tree  name,
int  sect_or_para 
)

Definition at line 653 of file typeck.c.

{
        cb_tree x;

        if (name == cb_error_node) {
                return cb_error_node;
        }

        if (CB_REFERENCE (name)->word->count > 0) {
                x = CB_VALUE (CB_REFERENCE (name)->word->items);
                /* Used as a non-label name or used as a section name.
                   Duplicate paragraphs are allowed if not referenced;
                   Checked in typeck.c */
                if (!CB_LABEL_P (x) || sect_or_para == 0
                    || (sect_or_para && CB_LABEL_P (x) && CB_LABEL (x)->is_section)) {
                        redefinition_error (name);
                        return cb_error_node;
                }
        }

        return name;
}

Here is the call 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;
}

Here is the call graph for this function:

Here is the caller graph for this function:

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);
}

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_sub ( cb_tree  v,
cb_tree  n,
cb_tree  round_opt 
)

Definition at line 2633 of file typeck.c.

{
        cb_tree         opt;
        struct cb_field *f;

#ifdef  COB_NON_ALIGNED
        if (CB_INDEX_P (v)) {
                return cb_build_move (cb_build_binary_op (v, '-', n), v);
        }
        if (CB_TREE_CLASS (v) == CB_CLASS_POINTER) {
                current_program->gen_ptrmanip = 1;
                return cb_build_funcall_3 ("cob_pointer_manip", v, n, cb_int1);
        }
#else
        if (CB_INDEX_P (v) || CB_TREE_CLASS (v) == CB_CLASS_POINTER) {
                return cb_build_move (cb_build_binary_op (v, '-', n), v);
        }
#endif

        if (CB_REF_OR_FIELD_P (v)) {
                f = cb_field (v);
                f->count++;
        }
        if (CB_REF_OR_FIELD_P (n)) {
                f = cb_field (n);
                f->count++;
        }
        opt = build_store_option (v, round_opt);
        if (opt == cb_int0 && cb_fits_int (n)) {
                return cb_build_optim_sub (v, n);
        }
        return cb_build_funcall_3 ("cob_sub", v, n, opt);
}

Here is the call graph for this function:

Here is the caller graph for this function:

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 call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_tarrying_all ( void  )

Definition at line 3778 of file typeck.c.

{
        if (inspect_data == NULL) {
                cb_error (_("Data name expected before ALL"));
        }
        inspect_func = "cob_inspect_all";
        return NULL;
}

Here is the call graph for this function:

cb_tree cb_build_tarrying_characters ( cb_tree  l)

Definition at line 3768 of file typeck.c.

{
        if (inspect_data == NULL) {
                cb_error (_("Data name expected before CHARACTERS"));
        }
        inspect_func = NULL;
        return cb_list_add (l, cb_build_funcall_1 ("cob_inspect_characters", inspect_data));
}

Here is the call graph for this function:

cb_tree cb_build_tarrying_data ( cb_tree  x)

Definition at line 3761 of file typeck.c.

{
        inspect_data = x;
        return NULL;
}
cb_tree cb_build_tarrying_leading ( void  )

Definition at line 3788 of file typeck.c.

{
        if (inspect_data == NULL) {
                cb_error (_("Data name expected before LEADING"));
        }
        inspect_func = "cob_inspect_leading";
        return NULL;
}

Here is the call graph for this function:

cb_tree cb_build_tarrying_trailing ( void  )

Definition at line 3798 of file typeck.c.

{
        if (inspect_data == NULL) {
                cb_error (_("Data name expected before TRAILING"));
        }
        inspect_func = "cob_inspect_trailing";
        return NULL;
}

Here is the call graph for this function:

cb_tree cb_build_tarrying_value ( cb_tree  x,
cb_tree  l 
)

Definition at line 3808 of file typeck.c.

{
        if (inspect_func == NULL) {
                cb_error_x (x, _("ALL, LEADING or TRAILING expected before '%s'"), cb_name (x));
        }
        return cb_list_add (l, cb_build_funcall_2 (inspect_func, inspect_data, x));
}

Here is the call graph for this function:

cb_tree cb_build_unstring_delimited ( cb_tree  all,
cb_tree  value 
)

Definition at line 5866 of file typeck.c.

{
        if (cb_validate_one (value)) {
                return cb_error_node;
        }
        return cb_build_funcall_2 ("cob_unstring_delimited", value, all);
}

Here is the call graph for this function:

cb_tree cb_build_unstring_into ( cb_tree  name,
cb_tree  delimiter,
cb_tree  count 
)

Definition at line 5875 of file typeck.c.

{
        if (cb_validate_one (name)) {
                return cb_error_node;
        }
        if (delimiter == NULL) {
                delimiter = cb_int0;
        }
        if (count == NULL) {
                count = cb_int0;
        }
        return cb_build_funcall_3 ("cob_unstring_into", name, delimiter, count);
}

Here is the call graph for this function:

cb_tree cb_build_write_advancing_lines ( cb_tree  pos,
cb_tree  lines 
)

Definition at line 5957 of file typeck.c.

{
        cb_tree e;
        int     opt;

        opt = (pos == CB_BEFORE) ? COB_WRITE_BEFORE : COB_WRITE_AFTER;
        e = cb_build_binary_op (cb_int (opt | COB_WRITE_LINES), '+', lines);
        return cb_build_cast_integer (e);
}

Here is the call graph for this function:

cb_tree cb_build_write_advancing_mnemonic ( cb_tree  pos,
cb_tree  mnemonic 
)

Definition at line 5968 of file typeck.c.

{
        int     opt;
        int     token;

        token = CB_SYSTEM_NAME (cb_ref (mnemonic))->token;
        switch (token) {
        case CB_FEATURE_FORMFEED:
                opt = (pos == CB_BEFORE) ? COB_WRITE_BEFORE : COB_WRITE_AFTER;
                return cb_int (opt | COB_WRITE_PAGE);
        case CB_FEATURE_C01:
        case CB_FEATURE_C02:
        case CB_FEATURE_C03:
        case CB_FEATURE_C04:
        case CB_FEATURE_C05:
        case CB_FEATURE_C06:
        case CB_FEATURE_C07:
        case CB_FEATURE_C08:
        case CB_FEATURE_C09:
        case CB_FEATURE_C10:
        case CB_FEATURE_C11:
        case CB_FEATURE_C12:
                opt = (pos == CB_BEFORE) ? COB_WRITE_BEFORE : COB_WRITE_AFTER;
                return cb_int (opt | COB_WRITE_CHANNEL | COB_WRITE_PAGE | token);
        default:
                cb_error_x (mnemonic, _("Invalid mnemonic name"));
                return cb_error_node;
        }
}

Here is the call graph for this function:

cb_tree cb_build_write_advancing_page ( cb_tree  pos)

Definition at line 5999 of file typeck.c.

{
        int opt = (pos == CB_BEFORE) ? COB_WRITE_BEFORE : COB_WRITE_AFTER;

        return cb_int (opt | COB_WRITE_PAGE);
}

Here is the call graph for this function:

cb_tree cb_check_numeric_value ( cb_tree  x)

Definition at line 426 of file typeck.c.

{
        if (x == cb_error_node) {
                return cb_error_node;
        }

        if (CB_TREE_CATEGORY (x) == CB_CATEGORY_NUMERIC) {
                return x;
        }

        cb_error_x (x, _("'%s' is not a numeric value"), cb_name (x));
        return cb_error_node;
}

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_clear_real_field ( void  )

Definition at line 1050 of file field.c.

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_switch_name ( cb_tree  name,
cb_tree  sname,
cb_tree  flag,
cb_tree  ref 
)

Definition at line 629 of file typeck.c.

{
        cb_tree switch_id;
        cb_tree value;

        if (name == cb_error_node) {
                return;
        }
        if (sname == cb_error_node) {
                return;
        }
        if (CB_SYSTEM_NAME (sname)->category != CB_SWITCH_NAME) {
                cb_error_x (ref, _("Switch-name is expected '%s'"), CB_NAME (ref));
        } else {
                switch_id = cb_int (CB_SYSTEM_NAME (sname)->token);
                value = cb_build_funcall_1 ("cob_get_switch", switch_id);
                if (flag == cb_int0) {
                        value = cb_build_negation (value);
                }
                cb_build_constant (name, value);
        }
}

Here is the call 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:

void cb_emit_accept ( cb_tree  var,
cb_tree  pos,
cb_tree  fgc,
cb_tree  bgc,
cb_tree  scroll,
int  dispattrs 
)

Definition at line 2802 of file typeck.c.

{
        cb_tree line;
        cb_tree column;

        if (cb_validate_one (var)) {
                return;
        }
        if (cb_validate_one (pos)) {
                return;
        }
        if (cb_validate_one (fgc)) {
                return;
        }
        if (cb_validate_one (bgc)) {
                return;
        }
        if (cb_validate_one (scroll)) {
                return;
        }
        if (current_program->flag_screen) {
                /* Bump ref count to force CRT STATUS field generation */
                cb_field (current_program->crt_status)->count++;
                if ((CB_REF_OR_FIELD_P (var)) &&
                     CB_FIELD (cb_ref (var))->storage == CB_STORAGE_SCREEN) {
                        output_screen_from (CB_FIELD (cb_ref (var)), 0);
                        gen_screen_ptr = 1;
                        if (pos) {
                                if (CB_PAIR_P (pos)) {
                                        line = CB_PAIR_X (pos);
                                        column = CB_PAIR_Y (pos);
                                        cb_emit (cb_build_funcall_3 ("cob_screen_accept",
                                                var, line, column));
                                } else {
                                        cb_emit (cb_build_funcall_3 ("cob_screen_accept",
                                                var, pos, NULL));
                                }
                        } else {
                                cb_emit (cb_build_funcall_3 ("cob_screen_accept",
                                        var, NULL, NULL));
                        }
                        gen_screen_ptr = 0;
                        output_screen_to (CB_FIELD (cb_ref (var)), 0);
                } else {
                        if (pos || fgc || bgc) {
                                if (!pos) {
                                        cb_emit (cb_build_funcall_7 ("cob_field_accept",
                                                var, NULL, NULL, fgc, bgc,
                                                scroll, cb_int (dispattrs)));
                                } else if (CB_PAIR_P (pos)) {
                                        line = CB_PAIR_X (pos);
                                        column = CB_PAIR_Y (pos);
                                        cb_emit (cb_build_funcall_7 ("cob_field_accept",
                                                var, line, column, fgc, bgc,
                                                scroll, cb_int (dispattrs)));
                                } else {
                                        cb_emit (cb_build_funcall_7 ("cob_field_accept",
                                                var, pos, NULL, fgc, bgc,
                                                scroll, cb_int (dispattrs)));
                                }
                        } else {
                                cb_emit (cb_build_funcall_7 ("cob_field_accept",
                                        var, NULL, NULL, fgc, bgc,
                                        scroll, cb_int (dispattrs)));
                        }
                }
        } else if (pos || fgc || bgc || scroll) {
                /* Bump ref count to force CRT STATUS field generation */
                cb_field (current_program->crt_status)->count++;
                if (!pos) {
                        cb_emit (cb_build_funcall_7 ("cob_field_accept",
                                var, NULL, NULL, fgc, bgc, scroll,
                                cb_int (dispattrs)));
                } else if (CB_PAIR_P (pos)) {
                        line = CB_PAIR_X (pos);
                        column = CB_PAIR_Y (pos);
                        cb_emit (cb_build_funcall_7 ("cob_field_accept",
                                var, line, column, fgc, bgc, scroll,
                                cb_int (dispattrs)));
                } else {
                        cb_emit (cb_build_funcall_7 ("cob_field_accept",
                                var, pos, NULL, fgc, bgc, scroll,
                                cb_int (dispattrs)));
                }
        } else {
                cb_emit (cb_build_funcall_1 ("cob_accept", var));
        }
}

Here is the call graph for this function:

void cb_emit_accept_arg_number ( cb_tree  var)

Definition at line 2986 of file typeck.c.

{
        if (cb_validate_one (var)) {
                return;
        }
        cb_emit (cb_build_funcall_1 ("cob_accept_arg_number", var));
}

Here is the call graph for this function:

void cb_emit_accept_arg_value ( cb_tree  var)

Definition at line 2995 of file typeck.c.

{
        if (cb_validate_one (var)) {
                return;
        }
        cb_emit (cb_build_funcall_1 ("cob_accept_arg_value", var));
}

Here is the call graph for this function:

void cb_emit_accept_command_line ( cb_tree  var)

Definition at line 2956 of file typeck.c.

{
        if (cb_validate_one (var)) {
                return;
        }
        cb_emit (cb_build_funcall_1 ("cob_accept_command_line", var));
}

Here is the call graph for this function:

void cb_emit_accept_date ( cb_tree  var)

Definition at line 2902 of file typeck.c.

{
        if (cb_validate_one (var)) {
                return;
        }
        cb_emit (cb_build_funcall_1 ("cob_accept_date", var));
}

Here is the call graph for this function:

void cb_emit_accept_date_yyyymmdd ( cb_tree  var)

Definition at line 2911 of file typeck.c.

{
        if (cb_validate_one (var)) {
                return;
        }
        cb_emit (cb_build_funcall_1 ("cob_accept_date_yyyymmdd", var));
}

Here is the call graph for this function:

void cb_emit_accept_day ( cb_tree  var)

Definition at line 2920 of file typeck.c.

{
        if (cb_validate_one (var)) {
                return;
        }
        cb_emit (cb_build_funcall_1 ("cob_accept_day", var));
}

Here is the call graph for this function:

void cb_emit_accept_day_of_week ( cb_tree  var)

Definition at line 2938 of file typeck.c.

{
        if (cb_validate_one (var)) {
                return;
        }
        cb_emit (cb_build_funcall_1 ("cob_accept_day_of_week", var));
}

Here is the call graph for this function:

void cb_emit_accept_day_yyyyddd ( cb_tree  var)

Definition at line 2929 of file typeck.c.

{
        if (cb_validate_one (var)) {
                return;
        }
        cb_emit (cb_build_funcall_1 ("cob_accept_day_yyyyddd", var));
}

Here is the call graph for this function:

void cb_emit_accept_environment ( cb_tree  var)

Definition at line 2977 of file typeck.c.

{
        if (cb_validate_one (var)) {
                return;
        }
        cb_emit (cb_build_funcall_1 ("cob_accept_environment", var));
}

Here is the call graph for this function:

void cb_emit_accept_line_or_col ( cb_tree  var,
const int  l_or_c 
)

Definition at line 2893 of file typeck.c.

{
        if (cb_validate_one (var)) {
                return;
        }
        cb_emit (cb_build_funcall_2 ("cob_screen_line_col", var, cb_int (l_or_c)));
}

Here is the call graph for this function:

void cb_emit_accept_mnemonic ( cb_tree  var,
cb_tree  mnemonic 
)

Definition at line 3004 of file typeck.c.

{
        if (cb_validate_one (var)) {
                return;
        }
        switch (CB_SYSTEM_NAME (cb_ref (mnemonic))->token) {
        case CB_DEVICE_CONSOLE:
        case CB_DEVICE_SYSIN:
                cb_emit (cb_build_funcall_1 ("cob_accept", var));
                break;
        default:
                cb_error_x (mnemonic, _("Invalid input stream '%s'"),
                            cb_name (mnemonic));
                break;
        }
}

Here is the call graph for this function:

void cb_emit_accept_name ( cb_tree  var,
cb_tree  name 
)

Definition at line 3022 of file typeck.c.

{
        cb_tree sys;

        if (cb_validate_one (var)) {
                return;
        }
        if (CB_REFERENCE (name)->word->count == 0) {
                sys = lookup_system_name (CB_NAME (name));

                if (sys != cb_error_node) {
                        switch (CB_SYSTEM_NAME (sys)->token) {
                        case CB_DEVICE_CONSOLE:
                        case CB_DEVICE_SYSIN:
                                cb_warning_x (name, _("'%s' undefined in SPECIAL-NAMES"), CB_NAME (name));
                                cb_emit (cb_build_funcall_1 ("cob_accept", var));
                                return;
                        default:
                                break;
                        }
                }
        }

        cb_error_x (name, _("'%s' undefined in SPECIAL-NAMES"), CB_NAME (name));
}

Here is the call graph for this function:

void cb_emit_accept_time ( cb_tree  var)

Definition at line 2947 of file typeck.c.

{
        if (cb_validate_one (var)) {
                return;
        }
        cb_emit (cb_build_funcall_1 ("cob_accept_time", var));
}

Here is the call graph for this function:

void cb_emit_allocate ( cb_tree  target1,
cb_tree  target2,
cb_tree  size,
cb_tree  initialize 
)

Definition at line 3053 of file typeck.c.

{
        cb_tree x;
        char    buff[32];

        if (cb_validate_one (target1)) {
                return;
        }
        if (cb_validate_one (target2)) {
                return;
        }
        if (cb_validate_one (size)) {
                return;
        }
        if (target1) {
                if (!(CB_REFERENCE_P(target1) &&
                      cb_field (target1)->flag_item_based)) {
                        cb_error_x (CB_TREE(current_statement),
                                _("Target of ALLOCATE is not a BASED item"));
                }
        }
        if (target2) {
                if (!(CB_REFERENCE_P(target2) &&
                      CB_TREE_CLASS (target2) == CB_CLASS_POINTER)) {
                        cb_error_x (CB_TREE(current_statement),
                                _("Target of RETURNING is not a data pointer"));
                }
        }
        if (size) {
                if (CB_TREE_CLASS (size) != CB_CLASS_NUMERIC) {
                        cb_error_x (CB_TREE(current_statement),
                                _("The CHARACTERS field of ALLOCATE must be numeric"));
                }
        }
        if (target1) {
                sprintf (buff, "%d", cb_field (target1)->memory_size);
                x = cb_build_numeric_literal (0, (ucharptr)buff, 0);
                cb_emit (cb_build_funcall_3 ("cob_allocate",
                         cb_build_cast_addr_of_addr (target1), target2, x));
        } else {
                cb_emit (cb_build_funcall_3 ("cob_allocate",
                         NULL, target2, size));
        }
        if (initialize && target1) {
                current_statement->handler2 =
                        cb_build_initialize (target1, cb_true, NULL, cb_true, 0);
        }
}

Here is the call graph for this function:

void cb_emit_arg_number ( cb_tree  value)

Definition at line 3273 of file typeck.c.

{
        if (cb_validate_one (value)) {
                return;
        }
        cb_emit (cb_build_funcall_1 ("cob_display_arg_number", value));
}

Here is the call graph for this function:

void cb_emit_arithmetic ( cb_tree  vars,
int  op,
cb_tree  val 
)

Definition at line 2094 of file typeck.c.

{
        cb_tree         l;
        struct cb_field *f;

        val = cb_check_numeric_value (val);
        if (op) {
                cb_list_map (cb_check_numeric_name, vars);
        } else {
                cb_list_map (cb_check_numeric_edited_name, vars);
        }

        if (cb_validate_one (val)) {
                return;
        }
        if (cb_validate_list (vars)) {
                return;
        }

        if (!CB_BINARY_OP_P (val)) {
                if (op == '+' || op == '-') {
                        if (CB_EXCEPTION_ENABLE (COB_EC_DATA_INCOMPATIBLE) &&
                           (CB_REF_OR_FIELD_P (val))) {
                                f = cb_field (val);
                                if (f->usage == CB_USAGE_DISPLAY ||
                                    f->usage == CB_USAGE_PACKED) {
                                        cb_emit (cb_build_funcall_2 ("cob_check_numeric",
                                                        val,
                                                        cb_build_string0 ((ucharptr)(f->name))));
                                }
                        }
                        for (l = vars; l; l = CB_CHAIN (l)) {
                                if (CB_EXCEPTION_ENABLE (COB_EC_DATA_INCOMPATIBLE) &&
                                   (CB_REF_OR_FIELD_P (CB_VALUE(l)))) {
                                        f = cb_field (CB_VALUE(l));
                                        if (f->usage == CB_USAGE_DISPLAY ||
                                            f->usage == CB_USAGE_PACKED) {
                                                cb_emit (cb_build_funcall_2 ("cob_check_numeric",
                                                        CB_VALUE(l),
                                                        cb_build_string0 ((ucharptr)(f->name))));
                                        }
                                }
                                if (op == '+') {
                                        CB_VALUE (l) = cb_build_add (CB_VALUE (l), val, CB_PURPOSE (l));
                                } else {
                                        CB_VALUE (l) = cb_build_sub (CB_VALUE (l), val, CB_PURPOSE (l));
                                }
                        }
                        cb_emit_list (vars);
                        return;
                }
        }

        cb_emit (build_decimal_assign (vars, op, val));
}

Here is the call graph for this function:

void cb_emit_call ( cb_tree  prog,
cb_tree  using,
cb_tree  returning,
cb_tree  on_exception,
cb_tree  not_on_exception 
)

Definition at line 3108 of file typeck.c.

{
        cb_tree                         l;
        cb_tree                         x;
        const struct system_table       *psyst;
        int                             is_sys_call = 0;

        if (CB_INTRINSIC_P (prog)) {
                if (CB_INTRINSIC(prog)->intr_tab->category != CB_CATEGORY_ALPHANUMERIC) {
                        cb_error (_("Only alphanumeric FUNCTION types are allowed here"));
                        return;
                }
        }
        if (returning) {
                if (CB_TREE_CLASS(returning) != CB_CLASS_NUMERIC &&
                    CB_TREE_CLASS(returning) != CB_CLASS_POINTER) {
                        cb_error (_("Invalid RETURNING field"));
                        return;
                }
        }
        for (l = using; l; l = CB_CHAIN (l)) {
                x = CB_VALUE (l);
                if (x == cb_error_node) {
                        continue;
                }
                if (CB_CONST_P (x) && x != cb_null) {
                        cb_error_x (x, _("Figurative constant invalid here"));
                }
                if ((CB_REFERENCE_P (x) && CB_FIELD_P(CB_REFERENCE(x)->value))
                     || CB_FIELD_P (x)) {
                        if (cb_field (x)->level == 88) {
                                cb_error_x (x, _("'%s' Not a data name"), CB_NAME (x));
                                return;
                        }
                        if (cb_warn_call_params &&
                            CB_PURPOSE_INT (l) == CB_CALL_BY_REFERENCE) {
                                if (cb_field (x)->level != 01 &&
                                    cb_field (x)->level != 77) {
                                        cb_warning_x (x, _("'%s' is not 01 or 77 level item"), CB_NAME (x));
                                }
                        }
                }
        }

        if (CB_LITERAL_P(prog)) {
                for (psyst = (const struct system_table *)&system_tab[0]; psyst->syst_name; psyst++) {
                        if (!strcmp((const char *)CB_LITERAL(prog)->data,
                             (const char *)psyst->syst_name)) {
                                if (psyst->syst_params > cb_list_length (using)) {
                                        cb_error (_("Wrong number of CALL parameters for '%s'"),
                                                    (char *)psyst->syst_name);
                                        return;
                                }
                                is_sys_call = 1;
                                break;
                        }
                }
        }

        cb_emit (cb_build_call (prog, using, on_exception, not_on_exception,
                 returning, is_sys_call));
}

Here is the call graph for this function:

void cb_emit_cancel ( cb_tree  prog)

Definition at line 3177 of file typeck.c.

{
        if (cb_validate_one (prog)) {
                return;
        }
        cb_emit (cb_build_funcall_1 ("cob_field_cancel", prog));
}

Here is the call graph for this function:

void cb_emit_close ( cb_tree  file,
cb_tree  opt 
)

Definition at line 3190 of file typeck.c.

{
        if (file == cb_error_node) {
                return;
        }
        file = cb_ref (file);
        if (file == cb_error_node) {
                return;
        }
        current_statement->file = file;
        if (CB_FILE (file)->organization == COB_ORG_SORT) {
                cb_error_x (CB_TREE (current_statement),
                _("Operation not allowed on SORT files"));
        }
        cb_emit (cb_build_funcall_3 ("cob_close", file, opt,
                CB_FILE(file)->file_status));
}

Here is the call graph for this function:

void cb_emit_command_line ( cb_tree  value)

Definition at line 3282 of file typeck.c.

{
        if (cb_validate_one (value)) {
                return;
        }
        cb_emit (cb_build_funcall_1 ("cob_display_command_line", value));
}

Here is the call graph for this function:

void cb_emit_commit ( void  )

Definition at line 3213 of file typeck.c.

{
        cb_emit (cb_build_funcall_0 ("cob_commit"));
}
void cb_emit_continue ( void  )

Definition at line 3223 of file typeck.c.

Here is the call graph for this function:

void cb_emit_corresponding ( cb_tree(*)(cb_tree f1, cb_tree f2, cb_tree f3)  func,
cb_tree  x1,
cb_tree  x2,
cb_tree  opt 
)

Definition at line 2695 of file typeck.c.

{
        x1 = cb_check_group_name (x1);
        x2 = cb_check_group_name (x2);

        if (cb_validate_one (x1)) {
                return;
        }
        if (cb_validate_one (x2)) {
                return;
        }

        emit_corresponding (func, x1, x2, opt);
}

Here is the call graph for this function:

void cb_emit_delete ( cb_tree  file)

Definition at line 3233 of file typeck.c.

{
        if (file == cb_error_node) {
                return;
        }
        file = cb_ref (file);
        if (file == cb_error_node) {
                return;
        }
        current_statement->file = file;
        if (CB_FILE (file)->organization == COB_ORG_SORT) {
                cb_error_x (CB_TREE (current_statement),
                _("Operation not allowed on SORT files"));
        }
        cb_emit (cb_build_funcall_2 ("cob_delete", file, CB_FILE(file)->file_status));
}

Here is the call graph for this function:

void cb_emit_display ( cb_tree  values,
cb_tree  upon,
cb_tree  no_adv,
cb_tree  pos,
cb_tree  fgc,
cb_tree  bgc,
cb_tree  scroll,
int  dispattrs 
)

Definition at line 3291 of file typeck.c.

{
        cb_tree l;
        cb_tree x;
        cb_tree line;
        cb_tree column;
        cb_tree p;

        if (cb_validate_list (values)) {
                return;
        }
        if (cb_validate_one (pos)) {
                return;
        }
        if (cb_validate_one (fgc)) {
                return;
        }
        if (cb_validate_one (bgc)) {
                return;
        }
        if (cb_validate_one (scroll)) {
                return;
        }
        for (l = values; l; l = CB_CHAIN (l)) {
                x = CB_VALUE (l);
                if (x == cb_error_node) {
                        return;
                }

                switch (CB_TREE_TAG (x)) {
                case CB_TAG_LITERAL:
                case CB_TAG_INTRINSIC:
                case CB_TAG_CONST:
                case CB_TAG_STRING:
                case CB_TAG_INTEGER:
                        break;
                case CB_TAG_REFERENCE:
                        if (!CB_FIELD_P(CB_REFERENCE(x)->value)) {
                                cb_error_x (x, _("'%s' is an invalid type for DISPLAY operand"), cb_name (x));
                                return;
                        }
                        break;
                default:
                        cb_error_x (x, _("Invalid type for DISPLAY operand"));
                        return;
                }
        }
        if (upon == cb_error_node) {
                return;
        }
        
        x = CB_VALUE (values);
        if ((CB_REF_OR_FIELD_P (x)) &&
             CB_FIELD (cb_ref (x))->storage == CB_STORAGE_SCREEN) {
                output_screen_from (CB_FIELD (cb_ref (x)), 0);
                gen_screen_ptr = 1;
                if (pos) {
                        if (CB_PAIR_P (pos)) {
                                line = CB_PAIR_X (pos);
                                column = CB_PAIR_Y (pos);
                                if (line == NULL) {
                                        line = cb_one;
                                }
                                if (column == NULL) {
                                        column = cb_one;
                                }
                                cb_emit (cb_build_funcall_3 ("cob_screen_display", x,
                                        line, column));
                        } else {
                                cb_emit (cb_build_funcall_3 ("cob_screen_display", x,
                                        pos, NULL));
                        }
                } else {
                        cb_emit (cb_build_funcall_3 ("cob_screen_display", x,
                                NULL, NULL));
                }
                gen_screen_ptr = 0;
        } else if (pos || fgc || bgc || scroll || dispattrs) {
                if (!pos) {
                        cb_emit (cb_build_funcall_7 ("cob_field_display",
                                CB_VALUE (values), NULL, NULL, fgc, bgc,
                                scroll, cb_int (dispattrs)));
                } else if (CB_PAIR_P (pos)) {
                        line = CB_PAIR_X (pos);
                        column = CB_PAIR_Y (pos);
                        if (line == NULL) {
                                line = cb_one;
                        }
                        if (column == NULL) {
                                column = cb_one;
                        }
                        cb_emit (cb_build_funcall_7 ("cob_field_display",
                                CB_VALUE (values), line, column, fgc, bgc,
                                scroll, cb_int (dispattrs)));
                } else {
                        cb_emit (cb_build_funcall_7 ("cob_field_display",
                                CB_VALUE (values), pos, NULL, fgc, bgc,
                                scroll, cb_int (dispattrs)));
                }
        } else {
                /* DISPLAY x ... [UPON device-name] */
                p = cb_build_funcall_3 ("cob_display", upon, no_adv, values);
                CB_FUNCALL(p)->varcnt = cb_list_length (values);
                cb_emit (p);
                for (l = values; l; l = CB_CHAIN (l)) {
                        x = CB_VALUE (l);
                        if (CB_FIELD_P (x)) {
                                CB_FIELD (cb_ref (x))->count++;
                        }
                }
        }
}

Here is the call graph for this function:

void cb_emit_divide ( cb_tree  dividend,
cb_tree  divisor,
cb_tree  quotient,
cb_tree  remainder 
)

Definition at line 3460 of file typeck.c.

{
        if (cb_validate_one (dividend)) {
                return;
        }
        if (cb_validate_one (divisor)) {
                return;
        }
        CB_VALUE (quotient) = cb_check_numeric_edited_name (CB_VALUE (quotient));
        CB_VALUE (remainder) = cb_check_numeric_edited_name (CB_VALUE (remainder));

        if (cb_validate_one (CB_VALUE (quotient))) {
                return;
        }
        if (cb_validate_one (CB_VALUE (remainder))) {
                return;
        }

        cb_emit (cb_build_funcall_4 ("cob_div_quotient", dividend, divisor,
                                     CB_VALUE (quotient),
                                     build_store_option (CB_VALUE (quotient), CB_PURPOSE (quotient))));
        cb_emit (cb_build_funcall_2 ("cob_div_remainder", CB_VALUE (remainder),
                                     build_store_option (CB_VALUE (remainder), cb_int0)));
}

Here is the call graph for this function:

void cb_emit_env_name ( cb_tree  value)

Definition at line 3255 of file typeck.c.

{
        if (cb_validate_one (value)) {
                return;
        }
        cb_emit (cb_build_funcall_1 ("cob_display_environment", value));
}

Here is the call graph for this function:

void cb_emit_env_value ( cb_tree  value)

Definition at line 3264 of file typeck.c.

{
        if (cb_validate_one (value)) {
                return;
        }
        cb_emit (cb_build_funcall_1 ("cob_display_env_value", value));
}

Here is the call graph for this function:

void cb_emit_evaluate ( cb_tree  subject_list,
cb_tree  case_list 
)

Definition at line 3601 of file typeck.c.

{
        cb_emit (build_evaluate (subject_list, case_list));
}

Here is the call graph for this function:

void cb_emit_exit ( size_t  goback)

Definition at line 3675 of file typeck.c.

{
        if (goback) {
                cb_emit (cb_build_goto (cb_int1, NULL));
        } else {
                cb_emit (cb_build_goto (NULL, NULL));
        }
}

Here is the call graph for this function:

void cb_emit_free ( cb_tree  vars)

Definition at line 3611 of file typeck.c.

{
        cb_tree         l;
        struct cb_field *f;
        int             i;

        if (cb_validate_list (vars)) {
                return;
        }
        for (l = vars, i = 1; l; l = CB_CHAIN (l), i++) {
                if (CB_TREE_CLASS (CB_VALUE (l)) == CB_CLASS_POINTER) {
                        if (CB_CAST_P (CB_VALUE (l))) {
                                f = cb_field (CB_CAST (CB_VALUE(l))->val);
                                if (!f->flag_item_based) {
                                        cb_error_x (CB_TREE (current_statement),
                                                _("Target %d of FREE, a data address identifier, must address a BASED data item"), i);
                                }
                                cb_emit (cb_build_funcall_2 ("cob_free_alloc",
                                        cb_build_cast_address (CB_VALUE (l)), NULL));
                        } else {
                                cb_emit (cb_build_funcall_2 ("cob_free_alloc",
                                        NULL, cb_build_cast_address (CB_VALUE (l))));
                        }
                } else if (CB_REF_OR_FIELD_P (CB_VALUE (l))) {
                                f = cb_field (CB_VALUE (l));
                                if (!f->flag_item_based) {
                                        cb_error_x (CB_TREE (current_statement),
                                                _("Target %d of FREE, a data address identifier, must address a BASED data item"), i);
                                }
                                cb_emit (cb_build_funcall_2 ("cob_free_alloc",
                                        cb_build_cast_addr_of_addr (CB_VALUE (l)), NULL));
                } else {
                        cb_error_x (CB_TREE (current_statement),
                                _("Target %d of FREE must be a data pointer"), i);
                }
        }
}

Here is the call graph for this function:

void cb_emit_get_environment ( cb_tree  envvar,
cb_tree  envval 
)

Definition at line 2965 of file typeck.c.

{
        if (cb_validate_one (envvar)) {
                return;
        }
        if (cb_validate_one (envval)) {
                return;
        }
        cb_emit (cb_build_funcall_2 ("cob_get_environment", envvar, envval));
}

Here is the call graph for this function:

void cb_emit_goto ( cb_tree  target,
cb_tree  depending 
)

Definition at line 3654 of file typeck.c.

{
        if (target == cb_error_node) {
                return;
        }
        if (depending) {
                /* GO TO procedure-name ... DEPENDING ON identifier */
                cb_emit (cb_build_goto (target, depending));
        } else {
                /* GO TO procedure-name */
                if (target == NULL) {
                        cb_verify (cb_goto_statement_without_name, "GO TO without procedure-name");
                } else if (CB_CHAIN (target)) {
                        cb_error (_("GO TO with multiple procedure-names"));
                } else {
                        cb_emit (cb_build_goto (CB_VALUE (target), NULL));
                }
        }
}

Here is the call graph for this function:

void cb_emit_if ( cb_tree  cond,
cb_tree  stmt1,
cb_tree  stmt2 
)

Definition at line 3689 of file typeck.c.

{
        cb_emit (cb_build_if (cond, stmt1, stmt2));
}

Here is the call graph for this function:

void cb_emit_initialize ( cb_tree  vars,
cb_tree  fillinit,
cb_tree  value,
cb_tree  replacing,
cb_tree  def 
)

Definition at line 3699 of file typeck.c.

{
        cb_tree l;
        int fill_init = 1;

        if (cb_validate_list (vars)) {
                return;
        }
        if (value == NULL && replacing == NULL) {
                def = cb_true;
        }
        if (fillinit == cb_true) {
                fill_init = 0;
        }
        for (l = vars; l; l = CB_CHAIN (l)) {
                cb_emit (cb_build_initialize (CB_VALUE (l), value, replacing, def, fill_init));
        }
}

Here is the call graph for this function:

void cb_emit_inspect ( cb_tree  var,
cb_tree  body,
cb_tree  replacing,
int  replconv 
)

Definition at line 3723 of file typeck.c.

{
        switch (CB_TREE_TAG(var)) {
        case CB_TAG_REFERENCE:
                break;
        case CB_TAG_INTRINSIC:
                switch (CB_TREE_CATEGORY(var)) {
                case CB_CATEGORY_ALPHABETIC:
                case CB_CATEGORY_ALPHANUMERIC:
                case CB_CATEGORY_NATIONAL:
                        break;
                default:
                        cb_error (_("Invalid target for INSPECT"));
                        return;
                }
                break;
        case CB_TAG_LITERAL:
                break;
        default:
                cb_error (_("Invalid target for REPLACING/CONVERTING"));
                return;
        }
        if (replconv && sending_id) {
                cb_error (_("Invalid target for REPLACING/CONVERTING"));
        }
        cb_emit (cb_build_funcall_2 ("cob_inspect_init", var, replacing));
        cb_emit_list (body);
        cb_emit (cb_build_funcall_0 ("cob_inspect_finish"));
}

Here is the call graph for this function:

void cb_emit_move ( cb_tree  src,
cb_tree  dsts 
)

Definition at line 5041 of file typeck.c.

{
        cb_tree l;

        if (cb_validate_one (src)) {
                return;
        }
        if (cb_validate_list (dsts)) {
                return;
        }

        for (l = dsts; l; l = CB_CHAIN (l)) {
                cb_emit (cb_build_move (src, CB_VALUE (l)));
        }
}

Here is the call graph for this function:

void cb_emit_move_corresponding ( cb_tree  x1,
cb_tree  x2 
)

Definition at line 2738 of file typeck.c.

{
        cb_tree         l;
        cb_tree         v;

        x1 = cb_check_group_name (x1);
        if (cb_validate_one (x1)) {
                return;
        }
        for (l = x2; l; l = CB_CHAIN(l)) {
                v = CB_VALUE(l);
                v = cb_check_group_name (v);
                if (cb_validate_one (v)) {
                        return;
                }
                emit_move_corresponding (x1, v);
        }
}

Here is the call graph for this function:

void cb_emit_open ( cb_tree  file,
cb_tree  mode,
cb_tree  sharing 
)

Definition at line 5062 of file typeck.c.

{
        if (file == cb_error_node) {
                return;
        }
        file = cb_ref (file);
        if (file == cb_error_node) {
                return;
        }
        current_statement->file = file;

        if (CB_FILE (file)->organization == COB_ORG_SORT) {
                cb_error_x (CB_TREE (current_statement),
                _("Operation not allowed on SORT files"));
        }
        if (sharing == NULL) {
                sharing = CB_FILE (file)->sharing ? CB_FILE (file)->sharing : cb_int0;
        }

        /* READ ONLY */
        if (sharing == cb_int0 && CB_INTEGER (mode)->val != COB_OPEN_INPUT) {
                sharing = cb_int1;
        }

        cb_emit (cb_build_funcall_4 ("cob_open", file, mode,
                 sharing, CB_FILE(file)->file_status));
}

Here is the call graph for this function:

void cb_emit_perform ( cb_tree  perform,
cb_tree  body 
)

Definition at line 5095 of file typeck.c.

{
        if (perform == cb_error_node) {
                return;
        }
        CB_PERFORM (perform)->body = body;
        cb_emit (perform);
}
void cb_emit_read ( cb_tree  ref,
cb_tree  next,
cb_tree  into,
cb_tree  key,
cb_tree  lock_opts 
)

Definition at line 5170 of file typeck.c.

{
        int     read_opts = 0;
        cb_tree file;
        cb_tree rec;

        if (lock_opts == cb_int1) {
                read_opts = COB_READ_LOCK;
        } else if (lock_opts == cb_int2) {
                read_opts = COB_READ_NO_LOCK;
        } else if (lock_opts == cb_int3) {
                read_opts = COB_READ_IGNORE_LOCK;
        } else if (lock_opts == cb_int4) {
                read_opts = COB_READ_WAIT_LOCK;
        }
        if (ref == cb_error_node) {
                return;
        }
        file = cb_ref (ref);
        if (file == cb_error_node) {
                return;
        }
        rec = cb_build_field_reference (CB_FILE (file)->record, ref);
        if (CB_FILE (file)->organization == COB_ORG_SORT) {
                cb_error_x (CB_TREE (current_statement),
                _("Operation not allowed on SORT files"));
        }
        if (next == cb_int1 || next == cb_int2 ||
            CB_FILE (file)->access_mode == COB_ACCESS_SEQUENTIAL) {
                /* READ NEXT/PREVIOUS */
                if (next == cb_int2) {
                        if (CB_FILE (file)->organization != COB_ORG_INDEXED) {
                                cb_error_x (CB_TREE (current_statement),
                                _("READ PREVIOUS only allowed for INDEXED SEQUENTIAL files"));
                        }
                        read_opts |= COB_READ_PREVIOUS;
                } else {
                        read_opts |= COB_READ_NEXT;
                }
                if (key) {
                        cb_warning (_("KEY ignored with sequential READ"));
                }
                cb_emit (cb_build_funcall_4 ("cob_read", file, cb_int0,
                         CB_FILE(file)->file_status,
                         cb_int (read_opts)));
        } else {
                /* READ */
                cb_emit (cb_build_funcall_4 ("cob_read",
                         file, key ? key : CB_FILE (file)->key,
                         CB_FILE(file)->file_status, cb_int (read_opts)));
        }
        if (into) {
                current_statement->handler3 = cb_build_move (rec, into);
        }
        current_statement->file = file;
}

Here is the call graph for this function:

void cb_emit_release ( cb_tree  ref,
cb_tree  from 
)

Definition at line 5278 of file typeck.c.

{
        struct cb_field *f;
        cb_tree         file;

        if (record == cb_error_node) {
                return;
        }
        if (from == cb_error_node) {
                return;
        }
        if (cb_ref (record) == cb_error_node) {
                return;
        }
        if (!CB_REF_OR_FIELD_P (cb_ref (record))) {
                cb_error_x (CB_TREE (current_statement),
                        _("RELEASE requires a record name as subject"));
                return;
        }
        if (cb_field (record)->storage != CB_STORAGE_FILE) {
                cb_error_x (CB_TREE (current_statement),
                        _("RELEASE subject does not refer to a record name"));
                return;
        }
        f = CB_FIELD (cb_ref (record));
        file = CB_TREE (f->file);
        if (CB_FILE (file)->organization != COB_ORG_SORT) {
                cb_error_x (CB_TREE (current_statement),
                        _("RELEASE not allowed on this record item"));
                return;
        }
        current_statement->file = file;
        if (from) {
                cb_emit (cb_build_move (from, record));
        }
        cb_emit (cb_build_funcall_1 ("cob_file_release", file));
}

Here is the call graph for this function:

void cb_emit_return ( cb_tree  ref,
cb_tree  into 
)

Definition at line 5321 of file typeck.c.

{
        cb_tree file;
        cb_tree rec;

        if (ref == cb_error_node) {
                return;
        }
        if (into == cb_error_node) {
                return;
        }
        file = cb_ref (ref);
        if (file == cb_error_node) {
                return;
        }
        rec = cb_build_field_reference (CB_FILE (file)->record, ref);
        cb_emit (cb_build_funcall_1 ("cob_file_return", file));
        if (into) {
                current_statement->handler3 = cb_build_move (rec, into);
        }
        current_statement->file = file;
}

Here is the call graph for this function:

void cb_emit_rewrite ( cb_tree  record,
cb_tree  from,
cb_tree  lockopt 
)

Definition at line 5232 of file typeck.c.

{
        cb_tree file;
        int     opts = 0;

        if (record == cb_error_node || cb_ref (record) == cb_error_node) {
                return;
        }
        if (!CB_REF_OR_FIELD_P (cb_ref (record))) {
                cb_error_x (CB_TREE (current_statement),
                        _("REWRITE requires a record name as subject"));
                return;
        }
        if (cb_field (record)->storage != CB_STORAGE_FILE) {
                cb_error_x (CB_TREE (current_statement),
                        _("REWRITE subject does not refer to a record name"));
                return;
        }
        file = CB_TREE (CB_FIELD (cb_ref (record))->file);
        current_statement->file = file;
        if (CB_FILE (file)->organization == COB_ORG_SORT) {
                cb_error_x (CB_TREE (current_statement),
                _("Operation not allowed on SORT files"));
        } else if (current_statement->handler_id == COB_EC_I_O_INVALID_KEY &&
                  (CB_FILE(file)->organization != COB_ORG_RELATIVE &&
                   CB_FILE(file)->organization != COB_ORG_INDEXED)) {
                        cb_error_x (CB_TREE(current_statement),
                        _("INVALID KEY clause invalid with this file type"));
        } else if ((CB_FILE (file)->lock_mode & COB_LOCK_AUTOMATIC) && lockopt) {
                cb_error_x (CB_TREE (current_statement),
                _("LOCK clause invalid with file LOCK AUTOMATIC"));
        } else if (lockopt == cb_int1) {
                opts = COB_WRITE_LOCK;
        }
        if (from) {
                cb_emit (cb_build_move (from, record));
        }
        cb_emit (cb_build_funcall_4 ("cob_rewrite", file, record,
                        cb_int (opts), CB_FILE(file)->file_status));
}

Here is the call graph for this function:

void cb_emit_rollback ( void  )

Definition at line 5349 of file typeck.c.

{
        cb_emit (cb_build_funcall_0 ("cob_rollback"));
}
void cb_emit_search ( cb_tree  table,
cb_tree  varying,
cb_tree  at_end,
cb_tree  whens 
)

Definition at line 5427 of file typeck.c.

{
        if (cb_validate_one (table)) {
                return;
        }
        if (cb_validate_one (varying)) {
                return;
        }
        if (table == cb_error_node) {
                return;
        }
        cb_emit (cb_build_search (0, table, varying, at_end, whens));
}

Here is the call graph for this function:

void cb_emit_search_all ( cb_tree  table,
cb_tree  at_end,
cb_tree  when,
cb_tree  stmts 
)

Definition at line 5442 of file typeck.c.

{
        if (cb_validate_one (table)) {
                return;
        }
        if (table == cb_error_node) {
                return;
        }
        cb_emit (cb_build_search (1, table, NULL, at_end,
                                  cb_build_if (cb_build_search_all (table, when), stmts, NULL)));
}

Here is the call graph for this function:

void cb_emit_set_false ( cb_tree  l)

Definition at line 5604 of file typeck.c.

{
        cb_tree         x;
        struct cb_field *f;
        cb_tree         ref;
        cb_tree         val;

        for (; l; l = CB_CHAIN (l)) {
                x = CB_VALUE (l);
                if (x == cb_error_node) {
                        return;
                }
                if (!(CB_REFERENCE_P (x) && CB_FIELD_P(CB_REFERENCE(x)->value))
                     && !CB_FIELD_P (x)) {
                        cb_error_x (x, _("Invalid SET statement"));
                        return;
                }
                f = cb_field (x);
                if (f->level != 88) {
                        cb_error_x (x, _("Invalid SET statement"));
                        return;
                }
                if (!f->false_88) {
                        cb_error_x (x, _("Field does not have FALSE clause"));
                        return;
                }
                ref = cb_build_field_reference (f->parent, x);
                val = CB_VALUE (f->false_88);
                if (CB_PAIR_P (val)) {
                        val = CB_PAIR_X (val);
                }
                cb_emit (cb_build_move (val, ref));
        }
}

Here is the call graph for this function:

void cb_emit_set_on_off ( cb_tree  l,
cb_tree  flag 
)

Definition at line 5558 of file typeck.c.

{
        struct cb_system_name *s;

        if (cb_validate_list (l)) {
                return;
        }
        for (; l; l = CB_CHAIN (l)) {
                s = CB_SYSTEM_NAME (cb_ref (CB_VALUE (l)));
                cb_emit (cb_build_funcall_2 ("cob_set_switch", cb_int (s->token), flag));
        }
}

Here is the call graph for this function:

void cb_emit_set_to ( cb_tree  l,
cb_tree  x 
)

Definition at line 5465 of file typeck.c.

{
        cb_tree         l;
        cb_tree         v;
        struct cb_cast  *p;
#if 0
        enum cb_class class = CB_CLASS_UNKNOWN;
#endif

        if (cb_validate_one (x)) {
                return;
        }
        if (cb_validate_list (vars)) {
                return;
        }

#if 0
        /* determine the class of targets */
        for (l = vars; l; l = CB_CHAIN (l)) {
                if (CB_TREE_CLASS (CB_VALUE (l)) != CB_CLASS_UNKNOWN) {
                        if (class == CB_CLASS_UNKNOWN) {
                                class = CB_TREE_CLASS (CB_VALUE (l));
                        } else if (class != CB_TREE_CLASS (CB_VALUE (l))) {
                                break;
                        }
                }
        }
        if (l || (class != CB_CLASS_INDEX && class != CB_CLASS_POINTER)) {
                cb_error_x (CB_TREE (current_statement),
                            _("The targets of SET must be either indexes or pointers"));
                return;
        }
#endif

        if (CB_CAST_P (x)) {
                p = CB_CAST (x);
                if (p->type == CB_CAST_PROGRAM_POINTER) {
                        for (l = vars; l; l = CB_CHAIN (l)) {
                                v = CB_VALUE (l);
                                if (!CB_REFERENCE_P (v)) {
                                        cb_error_x (CB_TREE (current_statement),
                                        _("SET targets must be PROGRAM-POINTER"));
                                        CB_VALUE (l) = cb_error_node;
                                } else if (CB_FIELD(cb_ref(v))->usage != CB_USAGE_PROGRAM_POINTER) {
                                        cb_error_x (CB_TREE (current_statement),
                                        _("SET targets must be PROGRAM-POINTER"));
                                        CB_VALUE (l) = cb_error_node;
                                }
                        }
                }
        }
        /* validate the targets */
        for (l = vars; l; l = CB_CHAIN (l)) {
                v = CB_VALUE (l);
                if (CB_CAST_P (v)) {
                        p = CB_CAST (v);
                        if (p->type == CB_CAST_ADDRESS
                            && !CB_FIELD (cb_ref (p->val))->flag_item_based
                            && CB_FIELD (cb_ref (p->val))->storage != CB_STORAGE_LINKAGE) {
                                cb_error_x (p->val, _("The address of '%s' cannot be changed"),
                                            cb_name (p->val));
                                CB_VALUE (l) = cb_error_node;
                        }
                }
        }
        if (cb_validate_list (vars)) {
                return;
        }

        for (l = vars; l; l = CB_CHAIN (l)) {
                cb_emit (cb_build_move (x, CB_VALUE (l)));
        }
}

Here is the call graph for this function:

void cb_emit_set_true ( cb_tree  l)

Definition at line 5572 of file typeck.c.

{
        cb_tree         x;
        struct cb_field *f;
        cb_tree         ref;
        cb_tree         val;

        for (; l; l = CB_CHAIN (l)) {
                x = CB_VALUE (l);
                if (x == cb_error_node) {
                        return;
                }
                if (!(CB_REFERENCE_P (x) && CB_FIELD_P(CB_REFERENCE(x)->value))
                     && !CB_FIELD_P (x)) {
                        cb_error_x (x, _("Invalid SET statement"));
                        return;
                }
                f = cb_field (x);
                if (f->level != 88) {
                        cb_error_x (x, _("Invalid SET statement"));
                        return;
                }
                ref = cb_build_field_reference (f->parent, x);
                val = CB_VALUE (f->values);
                if (CB_PAIR_P (val)) {
                        val = CB_PAIR_X (val);
                }
                cb_emit (cb_build_move (val, ref));
        }
}

Here is the call graph for this function:

void cb_emit_set_up_down ( cb_tree  l,
cb_tree  flag,
cb_tree  x 
)

Definition at line 5540 of file typeck.c.

{
        if (cb_validate_one (x)) {
                return;
        }
        if (cb_validate_list (l)) {
                return;
        }
        for (; l; l = CB_CHAIN (l)) {
                if (flag == cb_int0) {
                        cb_emit (cb_build_add (CB_VALUE (l), x, cb_int0));
                } else {
                        cb_emit (cb_build_sub (CB_VALUE (l), x, cb_int0));
                }
        }
}

Here is the call graph for this function:

void cb_emit_setenv ( cb_tree  x,
cb_tree  y 
)

Definition at line 5459 of file typeck.c.

{
        cb_emit (cb_build_funcall_2 ("cob_set_environment", x, y));
}
void cb_emit_sort_finish ( cb_tree  file)

Definition at line 5741 of file typeck.c.

{
        if (CB_FILE_P (cb_ref (file))) {
                cb_emit (cb_build_funcall_1 ("cob_file_sort_close", cb_ref (file)));
        }
}

Here is the call graph for this function:

void cb_emit_sort_giving ( cb_tree  file,
cb_tree  l 
)

Definition at line 5715 of file typeck.c.

{
        cb_tree         p;
        int             listlen;

        if (cb_validate_list (l)) {
                return;
        }
        for (p = l; p; p = CB_CHAIN (p)) {
                if (CB_FILE (cb_ref(CB_VALUE(p)))->organization == COB_ORG_SORT) {
                        cb_error (_("Invalid SORT GIVING parameter"));
                }
        }
        listlen = cb_list_length (l);
        p = cb_build_funcall_2 ("cob_file_sort_giving", cb_ref (file), l);
        CB_FUNCALL(p)->varcnt = listlen;
        cb_emit (p);
}

Here is the call graph for this function:

void cb_emit_sort_init ( cb_tree  name,
cb_tree  keys,
cb_tree  col 
)

Definition at line 5644 of file typeck.c.

{
        cb_tree         l;
        struct cb_field *f;

        if (cb_validate_list (keys)) {
                return;
        }
        for (l = keys; l; l = CB_CHAIN (l)) {
                if (CB_VALUE (l) == NULL) {
                        CB_VALUE (l) = name;
                }
                cb_ref (CB_VALUE (l));
        }

        if (CB_FILE_P (cb_ref (name))) {
                if (CB_FILE (cb_ref (name))->organization != COB_ORG_SORT) {
                        cb_error_x (name, _("Invalid SORT filename"));
                }
                cb_field (current_program->cb_sort_return)->count++;
                cb_emit (cb_build_funcall_5 ("cob_file_sort_init", cb_ref (name),
                                             cb_int (cb_list_length (keys)), col,
                                             cb_build_cast_address (current_program->cb_sort_return),
                                             CB_FILE(cb_ref (name))->file_status));
                for (l = keys; l; l = CB_CHAIN (l)) {
                        cb_emit (cb_build_funcall_4 ("cob_file_sort_init_key", cb_ref (name),
                                        CB_PURPOSE (l),
                                        CB_VALUE (l),
                                        cb_int (cb_field (CB_VALUE(l))->offset)));
                }
        } else {
                f = CB_FIELD (cb_ref (name));
                if (keys == NULL) {
                        cb_error_x (name, _("Table sort without keys not implemented yet"));
                }
                cb_emit (cb_build_funcall_2 ("cob_table_sort_init", cb_int (cb_list_length (keys)), col));
                for (l = keys; l; l = CB_CHAIN (l)) {
                        cb_emit (cb_build_funcall_3 ("cob_table_sort_init_key",
                                        CB_PURPOSE (l),
                                        CB_VALUE (l),
                                        cb_int (cb_field (CB_VALUE(l))->offset)));
                }
                cb_emit (cb_build_funcall_2 ("cob_table_sort", name,
                                             (f->occurs_depending
                                              ? cb_build_cast_integer (f->occurs_depending)
                                              : cb_int (f->occurs_max))));
        }
}

Here is the call graph for this function:

void cb_emit_sort_input ( cb_tree  proc)

Definition at line 5709 of file typeck.c.

Here is the call graph for this function:

void cb_emit_sort_output ( cb_tree  proc)

Definition at line 5735 of file typeck.c.

Here is the call graph for this function:

void cb_emit_sort_using ( cb_tree  file,
cb_tree  l 
)

Definition at line 5694 of file typeck.c.

{
        if (cb_validate_list (l)) {
                return;
        }
        for (; l; l = CB_CHAIN (l)) {
                if (CB_FILE (cb_ref(CB_VALUE(l)))->organization == COB_ORG_SORT) {
                        cb_error (_("Invalid SORT USING parameter"));
                }
                cb_emit (cb_build_funcall_2 ("cob_file_sort_using",
                        cb_ref (file), cb_ref (CB_VALUE (l))));
        }
}

Here is the call graph for this function:

void cb_emit_start ( cb_tree  file,
cb_tree  op,
cb_tree  key 
)

Definition at line 5753 of file typeck.c.

{
        if (cb_validate_one (key)) {
                return;
        }
        if (file != cb_error_node) {
                current_statement->file = cb_ref (file);
                cb_emit (cb_build_funcall_4 ("cob_start", cb_ref (file), op,
                                             key ? key : CB_FILE (cb_ref (file))->key,
                                                CB_FILE(cb_ref(file))->file_status));
        }
}

Here is the call graph for this function:

void cb_emit_stop_run ( cb_tree  x)

Definition at line 5771 of file typeck.c.

{
        cb_emit (cb_build_funcall_1 ("cob_stop_run", cb_build_cast_integer (x)));
}
void cb_emit_string ( cb_tree  items,
cb_tree  into,
cb_tree  pointer 
)

Definition at line 5781 of file typeck.c.

{
        cb_tree start;
        cb_tree l;
        cb_tree end;
        cb_tree dlm;

        if (cb_validate_one (into)) {
                return;
        }
        if (cb_validate_one (pointer)) {
                return;
        }
        start = items;
        cb_emit (cb_build_funcall_2 ("cob_string_init", into, pointer));
        while (start) {

                /* find DELIMITED item */
                for (end = start; end; end = CB_CHAIN (end)) {
                        if (CB_PAIR_P (CB_VALUE (end))) {
                                break;
                        }
                }

                /* cob_string_delimited */
                dlm = end ? CB_PAIR_X (CB_VALUE (end)) : cb_int0;
                cb_emit (cb_build_funcall_1 ("cob_string_delimited", dlm));

                /* cob_string_append */
                for (l = start; l != end; l = CB_CHAIN (l)) {
                        cb_emit (cb_build_funcall_1 ("cob_string_append", CB_VALUE (l)));
                }

                start = end ? CB_CHAIN (end) : NULL;
        }
        cb_emit (cb_build_funcall_0 ("cob_string_finish"));
}

Here is the call graph for this function:

void cb_emit_unlock ( cb_tree  ref)

Definition at line 5824 of file typeck.c.

{
        cb_tree file;

        if (ref != cb_error_node) {
                file = cb_ref (ref);
                cb_emit (cb_build_funcall_2 ("cob_unlock_file",
                         file, CB_FILE(file)->file_status));
                current_statement->file = file;
        }
}

Here is the call graph for this function:

void cb_emit_unstring ( cb_tree  name,
cb_tree  delimited,
cb_tree  into,
cb_tree  pointer,
cb_tree  tallying 
)

Definition at line 5841 of file typeck.c.

{
        if (cb_validate_one (name)) {
                return;
        }
        if (cb_validate_one (tallying)) {
                return;
        }
        if (cb_validate_list (delimited)) {
                return;
        }
        if (cb_validate_list (into)) {
                return;
        }
        cb_emit (cb_build_funcall_3 ("cob_unstring_init", name, pointer,
                cb_int (cb_list_length (delimited))));
        cb_emit_list (delimited);
        cb_emit_list (into);
        if (tallying) {
                cb_emit (cb_build_funcall_1 ("cob_unstring_tallying", tallying));
        }
        cb_emit (cb_build_funcall_0 ("cob_unstring_finish"));
}

Here is the call graph for this function:

void cb_emit_write ( cb_tree  record,
cb_tree  from,
cb_tree  opt,
cb_tree  lockopt 
)

Definition at line 5894 of file typeck.c.

{
        cb_tree         file;
        int             val;

        if (record != cb_error_node && cb_ref (record) != cb_error_node) {
                if (!CB_REF_OR_FIELD_P (cb_ref (record))) {
                        cb_error_x (CB_TREE (current_statement),
                                _("WRITE requires a record name as subject"));
                        return;
                }
                if (cb_field (record)->storage != CB_STORAGE_FILE) {
                        cb_error_x (CB_TREE (current_statement),
                                _("WRITE subject does not refer to a record name"));
                        return;
                }
                file = CB_TREE (CB_FIELD (cb_ref (record))->file);
                current_statement->file = file;
                if (CB_FILE (file)->organization == COB_ORG_SORT) {
                        cb_error_x (CB_TREE (current_statement),
                        _("Operation not allowed on SORT files"));
                } else if (current_statement->handler_id == COB_EC_I_O_INVALID_KEY &&
                          (CB_FILE(file)->organization != COB_ORG_RELATIVE &&
                           CB_FILE(file)->organization != COB_ORG_INDEXED)) {
                                cb_error_x (CB_TREE(current_statement),
                                _("INVALID KEY clause invalid with this file type"));
                } else if (lockopt) {
                        if ((CB_FILE (file)->lock_mode & COB_LOCK_AUTOMATIC)) {
                                cb_error_x (CB_TREE (current_statement),
                                _("LOCK clause invalid with file LOCK AUTOMATIC"));
                        } else if (opt != cb_int0) {
                                cb_error_x (CB_TREE (current_statement),
                                _("LOCK clause invalid here"));
                        } else if (lockopt == cb_int1) {
                                opt = cb_int (COB_WRITE_LOCK);
                        }
                }
                if (from) {
                        cb_emit (cb_build_move (from, record));
                }
                if (CB_FILE (file)->organization == COB_ORG_LINE_SEQUENTIAL &&
                    opt == cb_int0) {
                        opt = cb_int (COB_WRITE_BEFORE | COB_WRITE_LINES | 1);
                }
                /* RXW - This is horrible */
                if (current_statement->handler_id == COB_EC_I_O_EOP &&
                    current_statement->handler1) {
                        if (CB_CAST_P(opt)) {
                                val = CB_INTEGER(CB_BINARY_OP(CB_CAST(opt)->val)->x)->val;
                                val |= COB_WRITE_EOP;
                                CB_BINARY_OP(CB_CAST(opt)->val)->x = cb_int (val);
                        } else {
                                val = CB_INTEGER(opt)->val;
                                val |= COB_WRITE_EOP;
                                opt = cb_int (val);
                        }
                }
                cb_emit (cb_build_funcall_4 ("cob_write", file, record, opt,
                                        CB_FILE(file)->file_status));
        }
}

Here is the call graph for this function:

char* cb_encode_program_id ( const char *  name)

Definition at line 563 of file typeck.c.

{
        unsigned char           *p;
        const unsigned char     *s;
        unsigned char           buff[COB_SMALL_BUFF];

        p = buff;
        s = (const unsigned char *)name;
        /* encode the initial digit */
        if (isdigit (*s)) {
                p += sprintf ((char *)p, "_%02X", *s++);
        }
        /* encode invalid letters */
        for (; *s; s++) {
                if (isalnum (*s) || *s == '_') {
                        *p++ = *s;
                } else if (*s == '-') {
                        *p++ = '_';
                        *p++ = '_';
                } else {
                        p += sprintf ((char *)p, "_%02X", *s);
                }
        }
        *p = 0;
        return strdup ((char *)buff);
}

Here is the caller graph for this function:

void cb_error_x ( cb_tree  x,
const char *  fmt,
  ... 
)

Definition at line 110 of file error.c.

{
        va_list ap;

        va_start (ap, fmt);
        print_error ((char *)(x->source_file), x->source_line, "Error: ", fmt, ap);
        va_end (ap);

        errorcount++;
}

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;
}

Here is the caller graph for this function:

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:

Here is the caller 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:

int cb_get_level ( cb_tree  x)

Definition at line 41 of file field.c.

{
        const char      *p;
        const char      *name;
        int             level = 0;

        name = CB_NAME (x);
        /* get level */
        for (p = name; *p; p++) {
                if (!isdigit (*p)) {
                        goto level_error;
                }
                level = level * 10 + (*p - '0');
        }

        /* check level */
        switch (level) {
        case 66:
        case 77:
        case 78:
        case 88:
                break;
        default:
                if (level < 1 || level > 49) {
                        goto level_error;
                }
                break;
        }

        return level;

level_error:
        cb_error_x (x, _("Invalid level number '%s'"), name);
        return 0;
}

Here is the call graph for this function:

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.

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_init_reserved ( void  )

Definition at line 1019 of file reserved.c.

{
        int     i;

        /* build system-name table */
        for (i = 0; system_table[i].name != NULL; ++i) {
                system_table[i].node =
                  cb_build_system_name (system_table[i].category, system_table[i].token);
        }
}

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_init_tarrying ( void  )

Definition at line 3754 of file typeck.c.

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:

void cb_list_intrinsics ( void  )

Definition at line 979 of file reserved.c.

{
        const char      *s;
        size_t          i;
        size_t          n;

        printf ("Intrinsic Function (Implemented Y/N)\n\n");
        for (i = 0; i < NUM_INTRINSICS; ++i) {
                n = strlen (function_list[i].name);
                switch (n / 8) {
                case 0:
                        s = "\t\t\t\t";
                        break;
                case 1:
                        s = "\t\t\t";
                        break;
                case 2:
                        s = "\t\t";
                        break;
                default:
                        s = "\t";
                        break;
                }
                printf ("%s%s(%s)\n", function_list[i].name, s,
                        function_list[i].implemented ? "Y" : "N");
        }
}

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:

void cb_list_mnemonics ( void  )

Definition at line 1008 of file reserved.c.

{
        size_t          i;

        printf ("Mnemonic names\n\n");
        for (i = 0; system_table[i].name != NULL; ++i) {
                printf ("%s\n", system_table[i].name);
        }
}

Here is the caller graph for this function:

void cb_list_reserved ( void  )

Definition at line 950 of file reserved.c.

{
        const char      *s;
        size_t  i;
        size_t  n;

        printf ("Reserved Words (Parsed Y/N)\n\n");
        for (i = 0; i < NUM_RESERVED_WORDS; ++i) {
                n = strlen (reserved_words[i].name);
                switch (n / 8) {
                case 0:
                        s = "\t\t\t\t";
                        break;
                case 1:
                        s = "\t\t\t";
                        break;
                case 2:
                        s = "\t\t";
                        break;
                default:
                        s = "\t";
                        break;
                }
                printf ("%s%s(%s)\n", reserved_words[i].name, s,
                        reserved_words[i].token != -1 ? "Y" : "N");
        }
}

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.

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:

void cb_reset_78 ( void  )

Here is the caller graph for this function:

void cb_reset_in_procedure ( void  )

Here is the caller graph for this function:

struct cb_field* cb_resolve_redefines ( struct cb_field field,
cb_tree  redefines 
) [read]

Definition at line 231 of file field.c.

{
        struct cb_field         *f;
        struct cb_reference     *r;
        const char              *name;
        cb_tree                 x;

        r = CB_REFERENCE (redefines);
        name = CB_NAME (redefines);
        x = CB_TREE (field);

        /* check qualification */
        if (r->chain) {
                cb_error_x (x, _("'%s' cannot be qualified here"), name);
                return NULL;
        }

        /* check subscripts */
        if (r->subs) {
                cb_error_x (x, _("'%s' cannot be subscripted here"), name);
                return NULL;
        }

        /* resolve the name in the current group (if any) */
        if (field->parent && field->parent->children) {
                for (f = field->parent->children; f; f = f->sister) {
                        if (strcasecmp (f->name, name) == 0) {
                                break;
                        }
                }
                if (f == NULL) {
                        cb_error_x (x, _("'%s' undefined in '%s'"), name, field->parent->name);
                        return NULL;
                }
        } else {
                if (cb_ref (redefines) == cb_error_node) {
                        return NULL;
                }
                f = cb_field (redefines);
        }

        /* check level number */
        if (f->level != field->level) {
                cb_error_x (x, _("Level number of REDEFINES entries must be identical"));
                return NULL;
        }
        if (f->level == 66 || f->level == 88) {
                cb_error_x (x, _("Level number of REDEFINES entry cannot be 66 or 88"));
                return NULL;
        }

        if (!cb_indirect_redefines && f->redefines) {
                cb_error_x (x, _("'%s' not the original definition"), f->name);
                return NULL;
        }

        /* return the original definition */
        while (f->redefines) {
                f = f->redefines;
        }
        return f;
}

Here is the call graph for this function:

void cb_set_in_procedure ( void  )
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.

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:

Here is the caller graph for this function:

struct cb_field* cb_validate_78_item ( struct cb_field p) [read]

Definition at line 1033 of file field.c.

{
        cb_tree x;

        x = CB_TREE (f);
        if (!f->values) {
                level_require_error (x, "VALUE");
        }

        if (f->pic || f->flag_occurs) {
                level_except_error (x, "VALUE");
        }
        cb_add_78 (f);
        return last_real_field;
}

Here is the call graph for this function:

void cb_validate_88_item ( struct cb_field p)

Definition at line 1018 of file field.c.

{
        cb_tree x;

        x = CB_TREE (f);
        if (!f->values) {
                level_require_error (x, "VALUE");
        }

        if (f->pic || f->flag_occurs) {
                level_except_error (x, "VALUE");
        }
}

Here is the call graph for this function:

void cb_validate_field ( struct cb_field p)

Definition at line 973 of file field.c.

{
        struct cb_field         *c;

        if (validate_field_1 (f) != 0) {
                f->flag_invalid = 1;
                return;
        }
        /* RXW - Remove */
        if (f->flag_item_78) {
                f->flag_is_verified = 1;
                return;
        }

        /* setup parameters */
        if (f->storage == CB_STORAGE_LOCAL ||
            f->storage == CB_STORAGE_LINKAGE ||
            f->flag_item_based) {
                f->flag_local = 1;
        }
        if (f->storage == CB_STORAGE_LINKAGE || f->flag_item_based) {
                f->flag_base = 1;
        }
        setup_parameters (f);

        /* compute size */
        compute_size (f);
        if (!f->redefines) {
                f->memory_size = f->size * f->occurs_max;
        } else if (f->redefines->memory_size < f->size * f->occurs_max) {
                f->redefines->memory_size = f->size * f->occurs_max;
        }

        validate_field_value (f);
        if (f->flag_is_global) {
                f->count++;
                for (c = f->children; c; c = c->sister) {
                        c->flag_is_global = 1;
                        c->count++;
                }
        }
        f->flag_is_verified = 1;
}

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_validate_program_body ( struct cb_program prog)

Definition at line 1416 of file typeck.c.

{
        /* resolve all labels */
        cb_tree l;
        cb_tree x;
        cb_tree v;

        for (l = cb_list_reverse (prog->label_list); l; l = CB_CHAIN (l)) {
                x = CB_VALUE (l);
                v = cb_ref (x);
                if (CB_LABEL_P (v)) {
                        CB_LABEL (v)->need_begin = 1;
                        if (CB_REFERENCE (x)->length) {
                                CB_LABEL (v)->need_return = 1;
                        }
                } else if (v != cb_error_node) {
                        cb_error_x (x, _("'%s' not procedure name"), cb_name (x));
                }
        }

        prog->file_list = cb_list_reverse (prog->file_list);
        prog->exec_list = cb_list_reverse (prog->exec_list);
}

Here is the call graph for this function:

void cb_validate_program_data ( struct cb_program prog)

Definition at line 1286 of file typeck.c.

{
        cb_tree         l;
        cb_tree         x;
        cb_tree         assign;
        struct cb_field *p;
        struct cb_file  *f;
        unsigned char   *c;

        for (l = current_program->file_list; l; l = CB_CHAIN (l)) {
                f = CB_FILE (CB_VALUE (l));
                if (!f->finalized) {
                        finalize_file (f, NULL);
                }
        }
        /* build undeclared assignment name now */
        if (cb_assign_clause == CB_ASSIGN_MF) {
                for (l = current_program->file_list; l; l = CB_CHAIN (l)) {
                        assign = CB_FILE (CB_VALUE (l))->assign;
                        if (!assign) {
                                continue;
                        }
                        if (CB_REFERENCE_P (assign)) {
                                for (x = current_program->file_list; x; x = CB_CHAIN (x)) {
                                        if (!strcmp (CB_FILE (CB_VALUE (x))->name,
                                             CB_REFERENCE (assign)->word->name)) {
                                                redefinition_error (assign);
                                        }
                                }
                                p = check_level_78 (CB_REFERENCE (assign)->word->name);
                                if (p) {
                                        c = (unsigned char *)CB_LITERAL(CB_VALUE(p->values))->data;
                                        assign = CB_TREE (build_literal (CB_CATEGORY_ALPHANUMERIC, c, strlen ((char *)c)));
                                        CB_FILE (CB_VALUE (l))->assign = assign;
                                }
                        }
                        if (CB_REFERENCE_P (assign) && CB_REFERENCE (assign)->word->count == 0) {
                                if (cb_warn_implicit_define) {
                                        cb_warning (_("'%s' will be implicitly defined"), CB_NAME (assign));
                                }
                                x = cb_build_implicit_field (assign, COB_SMALL_BUFF);
                                p = current_program->working_storage;
                                CB_FIELD (x)->count++;
                                if (p) {
                                        while (p->sister) {
                                                p = p->sister;
                                        }
                                        p->sister = CB_FIELD (x);
                                } else {
                                        current_program->working_storage = CB_FIELD (x);
                                }
                        }
                        if (CB_REFERENCE_P (assign)) {
                                x = cb_ref (assign);
                                if (CB_FIELD_P (x) && CB_FIELD (x)->level == 88) {
                                        cb_error_x (assign, _("ASSIGN data item '%s' invalid"), CB_NAME (assign));
                                }
                        }
                }
        }

        if (prog->cursor_pos) {
                x = cb_ref (prog->cursor_pos);
                if (x == cb_error_node) {
                        prog->cursor_pos = NULL;
                } else if (CB_FIELD(x)->size != 6 && CB_FIELD(x)->size != 4) {
                        cb_error_x (prog->cursor_pos, _("'%s' CURSOR is not 4 or 6 characters long"),
                                    cb_name (prog->cursor_pos));
                        prog->cursor_pos = NULL;
                }
        }
        if (prog->crt_status) {
                x = cb_ref (prog->crt_status);
                if (x == cb_error_node) {
                        prog->crt_status = NULL;
                } else if (CB_FIELD(x)->size != 4) {
                        cb_error_x (prog->crt_status, _("'%s' CRT STATUS is not 4 characters long"),
                                    cb_name (prog->crt_status));
                        prog->crt_status = NULL;
                }
        } else {
                l = cb_build_reference ("COB-CRT-STATUS");
                p = CB_FIELD (cb_build_field (l));
                p->usage = CB_USAGE_DISPLAY;
                p->pic = CB_PICTURE (cb_build_picture ("9(4)"));
                cb_validate_field (p);
                p->flag_no_init = 1;
                /* Do not initialize/bump ref count here
                p->values = cb_list_init (cb_zero);
                p->count++;
                */
                current_program->working_storage =
                        cb_field_add (current_program->working_storage, p);
                prog->crt_status = l;
                /* RXWRXW - Maybe better
                prog->crt_status = cb_build_index (cb_build_reference ("COB-CRT-STATUS"), cb_zero, 0, NULL);
                */
        }

        /* resolve all references so far */
        for (l = cb_list_reverse (prog->reference_list); l; l = CB_CHAIN (l)) {
                cb_ref (CB_VALUE (l));
        }
        for (l = current_program->file_list; l; l = CB_CHAIN (l)) {
                f = CB_FILE (CB_VALUE (l));
                if (f->record_depending && f->record_depending != cb_error_node) {
                        x = f->record_depending;
                        if (cb_ref (x) != cb_error_node) {
/* RXW - This breaks old legacy programs
                                if (CB_REF_OR_FIELD_P(x)) {
                                        p = cb_field (x);
                                        switch (p->storage) {
                                        case CB_STORAGE_WORKING:
                                        case CB_STORAGE_LOCAL:
                                        case CB_STORAGE_LINKAGE:
                                                break;
                                        default:
                                                cb_error (_("RECORD DEPENDING item must be in WORKING/LOCAL/LINKAGE section"));
                                        }
                                } else {
*/
                                if (!CB_REFERENCE_P(x) && !CB_FIELD_P(x)) {
                                        cb_error (_("Invalid RECORD DEPENDING item"));
                                }
                        }
                }
        }
}

Here is the call graph for this function:

void cb_validate_program_environment ( struct cb_program prog)

Definition at line 1079 of file typeck.c.

{
        cb_tree                 x;
        cb_tree                 y;
        cb_tree                 l;
        cb_tree                 ls;
        struct cb_alphabet_name *ap;
        unsigned char           *data;
        size_t                  dupls;
        size_t                  unvals;
        size_t                  count;
        int                     lower;
        int                     upper;
        int                     size;
        int                     n;
        int                     i;
        int                     lastval;
        int                     values[256];

        /* Check ALPHABET clauses */
        for (l = current_program->alphabet_name_list; l; l = CB_CHAIN (l)) {
                ap = CB_ALPHABET_NAME (CB_VALUE (l));
                if (ap->type != CB_ALPHABET_CUSTOM) {
                        continue;
                }
                ap->low_val_char = 0;
                ap->high_val_char = 255;
                dupls = 0;
                unvals = 0;
                count = 0;
                lastval = 0;
                for (n = 0; n < 256; n++) {
                        values[n] = -1;
                }
                for (y = ap->custom_list; y; y = CB_CHAIN (y)) {
                        if (count > 255) {
                                unvals = 1;
                                break;
                        }
                        x = CB_VALUE (y);
                        if (CB_PAIR_P (x)) {
                                /* X THRU Y */
                                lower = get_value (CB_PAIR_X (x));
                                upper = get_value (CB_PAIR_Y (x));
                                lastval = upper;
                                if (!count) {
                                        ap->low_val_char = lower;
                                }
                                if (lower < 0 || lower > 255) {
                                        unvals = 1;
                                        continue;
                                }
                                if (upper < 0 || upper > 255) {
                                        unvals = 1;
                                        continue;
                                }
                                if (lower <= upper) {
                                        for (i = lower; i <= upper; i++) {
                                                if (values[i] != -1) {
                                                        dupls = 1;
                                                }
                                                values[i] = i;
                                                count++;
                                        }
                                } else {
                                        for (i = lower; i >= upper; i--) {
                                                if (values[i] != -1) {
                                                        dupls = 1;
                                                }
                                                values[i] = i;
                                                count++;
                                        }
                                }
                        } else if (CB_LIST_P (x)) {
                                /* X ALSO Y ... */
                                if (!count) {
                                        ap->low_val_char = get_value (CB_VALUE (x));
                                }
                                for (ls = x; ls; ls = CB_CHAIN (ls)) {
                                        n = get_value (CB_VALUE (ls));
                                        if (!CB_CHAIN (ls)) {
                                                lastval = n;
                                        }
                                        if (n < 0 || n > 255) {
                                                unvals = 1;
                                                continue;
                                        }
                                        if (values[n] != -1) {
                                                dupls = 1;
                                        }
                                        values[n] = n;
                                        count++;
                                }
                        } else {
                                /* literal */
                                if (CB_TREE_CLASS (x) == CB_CLASS_NUMERIC) {
                                        n = get_value (x);
                                        lastval = n;
                                        if (!count) {
                                                ap->low_val_char = n;
                                        }
                                        if (n < 0 || n > 255) {
                                                unvals = 1;
                                                continue;
                                        }
                                        if (values[n] != -1) {
                                                dupls = 1;
                                        }
                                        values[n] = n;
                                        count++;
                                } else if (CB_LITERAL_P (x)) {
                                        size = (int)CB_LITERAL (x)->size;
                                        data = CB_LITERAL (x)->data;
                                        if (!count) {
                                                ap->low_val_char = data[0];
                                        }
                                        lastval = data[size - 1];
                                        for (i = 0; i < size; i++) {
                                                n = data[i];
                                                if (values[n] != -1) {
                                                        dupls = 1;
                                                }
                                                values[n] = n;
                                                count++;
                                        }
                                } else {
                                        n = get_value (x);
                                        lastval = n;
                                        if (!count) {
                                                ap->low_val_char = n;
                                        }
                                        if (n < 0 || n > 255) {
                                                unvals = 1;
                                                continue;
                                        }
                                        if (values[n] != -1) {
                                                dupls = 1;
                                        }
                                        values[n] = n;
                                        count++;
                                }
                        }
                }
                if (dupls || unvals) {
                        if (dupls) {
                                cb_error_x (l, _("Duplicate character values in alphabet '%s'"),
                                            cb_name (CB_VALUE(l)));
                        }
                        if (unvals) {
                                cb_error_x (l, _("Invalid character values in alphabet '%s'"),
                                            cb_name (CB_VALUE(l)));
                        }
                        ap->low_val_char = 0;
                        ap->high_val_char = 255;
                        continue;
                }
                /* Calculate HIGH-VALUE */
                /* If all 256 values have been specified, HIGH-VALUE is the last one */
                /* Otherwise if HIGH-VALUE has been specified, find the highest */
                /* value that has not been used */
                if (count == 256) {
                        ap->high_val_char = lastval;
                } else if (values[255] != -1) {
                        for (n = 254; n >= 0; n--) {
                                if (values[n] == -1) {
                                        ap->high_val_char = n;
                                        break;
                                }
                        }
                }
        }
        /* Rest HIGH/LOW-VALUES */
        cb_low = cb_norm_low;
        cb_high = cb_norm_high;
        /* resolve the program collating sequence */
        if (!prog->collating_sequence) {
                return;
        }
        x = cb_ref (prog->collating_sequence);
/* RXWRXW
        if (x == cb_error_node) {
                prog->collating_sequence = NULL;
                return;
        }
*/
        if (!CB_ALPHABET_NAME_P (x)) {
                cb_error_x (prog->collating_sequence, _("'%s' not alphabet name"),
                            cb_name (prog->collating_sequence));
                prog->collating_sequence = NULL;
                return;
        }
        if (CB_ALPHABET_NAME (x)->type != CB_ALPHABET_CUSTOM) {
                return;
        }
        if (CB_ALPHABET_NAME (x)->low_val_char) {
                cb_low = cb_build_alphanumeric_literal ((ucharptr)"\0", 1);
                CB_LITERAL(cb_low)->data[0] = CB_ALPHABET_NAME (x)->low_val_char;
                CB_LITERAL(cb_low)->all = 1;
        }
        if (CB_ALPHABET_NAME (x)->high_val_char != 255){
                cb_high = cb_build_alphanumeric_literal ((ucharptr)"\0", 1);
                CB_LITERAL(cb_high)->data[0] = CB_ALPHABET_NAME (x)->high_val_char;
                CB_LITERAL(cb_high)->all = 1;
        }
}

Here is the call graph for this function:

void cb_warning_x ( cb_tree  x,
const char *  fmt,
  ... 
)

Definition at line 98 of file error.c.

{
        va_list ap;

        va_start (ap, fmt);
        print_error ((char *)(x->source_file), x->source_line, "Warning: ", fmt, ap);
        va_end (ap);

        warningcount++;
}

Here is the call graph for this function:

Here is the caller graph for this function:

char* check_filler_name ( char *  name)

Definition at line 64 of file error.c.

{
        if (!memcmp (name, "WORK$", 5)) {
                name = (char *)"FILLER";
        }
        return name;
}

Here is the caller graph for this function:

struct cb_field* check_level_78 ( const char *  name) [read]

Here is the caller graph for this function:

void cobc_tree_cast_error ( cb_tree  x,
const char *  filen,
const int  linenum,
const int  tagnum 
)

Definition at line 317 of file cobc.c.

{
        fprintf (stderr, "%s:%d: Invalid type cast from '%s'\n",
                filen, linenum, x ? cb_name (x) : "null");
        fprintf (stderr, "Tag 1 %d Tag 2 %d\n", x ? CB_TREE_TAG(x) : 0,
                tagnum);
        (void)longjmp (cob_jmpbuf, 1);
}

Here is the call graph for this function:

void codegen ( struct cb_program prog,
int  nested 
)

Definition at line 4683 of file codegen.c.

{
        int                     i;
        cb_tree                 l;
        struct attr_list        *j;
        struct literal_list     *m;
        struct field_list       *k;
        struct call_list        *clp;
        struct base_list        *blp;
        unsigned char           *s;
        struct cb_program       *cp;
        cb_tree                 l1;
        cb_tree                 l2;
        const char              *prevprog;
        time_t                  loctime;
        char                    locbuff[48];

        current_prog = prog;
        param_id = 0;
        stack_id = 0;
        num_cob_fields = 0;
        progid = 0;
        loop_counter = 0;
        output_indent_level = 0;
        last_line = 0;
        needs_exit_prog = 0;
        gen_custom = 0;
        call_cache = NULL;
        label_cache = NULL;
        local_cache = NULL;
        excp_current_program_id = prog->orig_source_name;
        excp_current_section = NULL;
        excp_current_paragraph = NULL;
        memset ((char *)i_counters, 0, sizeof (i_counters));

        output_target = yyout;

        if (!nested) {
                gen_ebcdic = 0;
                gen_ebcdic_ascii = 0;
                gen_full_ebcdic = 0;
                gen_native = 0;
                attr_cache = NULL;
                base_cache = NULL;
                literal_cache = NULL;
                field_cache = NULL;

                loctime = time (NULL);
                strftime (locbuff, sizeof(locbuff) - 1, "%b %d %Y %H:%M:%S %Z",
                        localtime (&loctime));
                output_header (output_target, locbuff);
                output_header (cb_storage_file, locbuff);
                for (cp = prog; cp; cp = cp->next_program) {
                        output_header (cp->local_storage_file, locbuff);
                }

                output_storage ("/* Frame stack declaration */\n");
                output_storage ("struct cob_frame {\n");
                output_storage ("\tint\tperform_through;\n");
#ifndef __GNUC__
                output_storage ("\tint\treturn_address;\n");
#elif   COB_USE_SETJMP
                output_storage ("\tjmp_buf\treturn_address;\n");
#else
                output_storage ("\tvoid\t*return_address;\n");
#endif
                output_storage ("};\n\n");
                output_storage ("/* Union for CALL statement */\n");
                output_storage ("union cob_call_union {\n");
                output_storage ("\tvoid *(*funcptr)();\n");
                output_storage ("\tint  (*funcint)();\n");
                output_storage ("\tvoid *func_void;\n");
                output_storage ("};\n");
                output_storage ("union cob_call_union\tcob_unifunc;\n\n");

                output ("#define  __USE_STRING_INLINES 1\n");
#ifdef  _XOPEN_SOURCE_EXTENDED
                output ("#ifndef        _XOPEN_SOURCE_EXTENDED\n");
                output ("#define  _XOPEN_SOURCE_EXTENDED 1\n");
                output ("#endif\n");
#endif
                output ("#include <stdio.h>\n");
                output ("#include <stdlib.h>\n");
                output ("#include <string.h>\n");
                output ("#include <math.h>\n");
#if     COB_USE_SETJMP
                output ("#include <setjmp.h>\n");
#endif
#ifdef  WORDS_BIGENDIAN
                output ("#define WORDS_BIGENDIAN 1\n");
#endif
#ifdef  HAVE_BUILTIN_EXPECT
                output ("#define HAVE_BUILTIN_EXPECT\n");
#endif
                if (optimize_flag) {
                        output ("#define COB_LOCAL_INLINE\n");
                }
                output ("#include <libcob.h>\n\n");

                output ("#define COB_SOURCE_FILE                \"%s\"\n", cb_source_file);
                output ("#define COB_PACKAGE_VERSION    \"%s\"\n", PACKAGE_VERSION);
                output ("#define COB_PATCH_LEVEL                %d\n\n", PATCH_LEVEL);
                output ("/* Global variables */\n");
                output ("#include \"%s\"\n\n", cb_storage_file_name);

                for (cp = prog; cp; cp = cp->next_program) {
                        if (cp->gen_decset) {
                                output("static void\n");
                                output("cob_decimal_set_int (cob_decimal *d, const int n)\n");
                                output("{\n");
                                output("        mpz_set_si (d->value, n);\n");
                                output("        d->scale = 0;\n");
                                output("}\n\n");
                                break;
                        }
                }
                for (cp = prog; cp; cp = cp->next_program) {
                        if (cp->gen_udecset) {
                                output("static void\n");
                                output("cob_decimal_set_uint (cob_decimal *d, const unsigned int n)\n");
                                output("{\n");
                                output("        mpz_set_ui (d->value, n);\n");
                                output("        d->scale = 0;\n");
                                output("}\n\n");
                                break;
                        }
                }
                for (cp = prog; cp; cp = cp->next_program) {
                        if (cp->gen_ptrmanip) {
                                output("static void\n");
                                output("cob_pointer_manip (cob_field *f1, cob_field *f2, size_t addsub)\n");
                                output("{\n");
                                output("        unsigned char   *tmptr;\n");
                                output("        memcpy (&tmptr, f1->data, sizeof(void *));\n");
                                output("        if (addsub) {\n");
                                output("                tmptr -= cob_get_int (f2);\n");
                                output("        } else {\n");
                                output("                tmptr += cob_get_int (f2);\n");
                                output("        }\n");
                                output("        memcpy (f1->data, &tmptr, sizeof(void *));\n");
                                output("}\n\n");
                                break;
                        }
                }
                output ("/* Function prototypes */\n\n");
                for (cp = prog; cp; cp = cp->next_program) {
                        /* Build parameter list */
                        for (l = cp->entry_list; l; l = CB_CHAIN (l)) {
                                for (l1 = CB_VALUE (l); l1; l1 = CB_CHAIN (l1)) {
                                        for (l2 = cp->parameter_list; l2; l2 = CB_CHAIN (l2)) {
                                                if (strcasecmp (cb_field (CB_VALUE (l1))->name,
                                                                cb_field (CB_VALUE (l2))->name) == 0) {
                                                        break;
                                                }
                                        }
                                        if (l2 == NULL) {
                                                cp->parameter_list = cb_list_add (cp->parameter_list, CB_VALUE (l1));
                                        }
                                }
                        }
                        if (cp->flag_main) {
                                output ("int %s ();\n", cp->program_id);
                        } else {
                                for (l = cp->entry_list; l; l = CB_CHAIN (l)) {
                                        output_entry_function (cp, l, cp->parameter_list, 0);
                                }
                        }
                        output ("static int %s_ (const int", cp->program_id);
                        if (!cp->flag_chained) {
                                for (l = cp->parameter_list; l; l = CB_CHAIN (l)) {
                                        output (", unsigned char *");
                                }
                        }
                        output (");\n");
                }
                output ("\n");
        }

        /* Class-names */
        if (!prog->nested_level && prog->class_name_list) {
                output ("/* Class names */\n");
                for (l = prog->class_name_list; l; l = CB_CHAIN (l)) {
                        output_class_name_definition (CB_CLASS_NAME (CB_VALUE (l)));
                }
        }

        /* Main function */
        if (prog->flag_main) {
                output_main_function (prog);
        }

        /* Functions */
        if (!nested) {
                output ("/* Functions */\n\n");
        }
        for (l = prog->entry_list; l; l = CB_CHAIN (l)) {
                output_entry_function (prog, l, prog->parameter_list, 1);
        }
        output_internal_function (prog, prog->parameter_list);

        if (!prog->next_program) {
                output ("/* End functions */\n\n");
        }

        if (gen_native || gen_full_ebcdic || gen_ebcdic_ascii || prog->alphabet_name_list) {
                (void)lookup_attr (COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL, 0);
        }

        output_target = cb_storage_file;

        /* Program local stuff */
        if (call_cache) {
                output_local ("\n/* Call pointers */\n");
                for (clp = call_cache; clp; clp = clp->next) {
                        output_local ("static union cob_call_union\tcall_%s = { NULL };\n", clp->callname);
                }
                output_local ("\n");
        }

        for (i = 0; i < COB_MAX_SUBSCRIPTS; i++) {
                if (i_counters[i]) {
                        output_local ("int\t\ti%d;\n", i);
                }
        }

        if (num_cob_fields) {
                output_local ("\n/* Local cob_field items */\n");
                for (i = 0; i < num_cob_fields; i++) {
                        output_local ("cob_field\tf%d;\n", i);
                }
                output_local ("\n");
        }

        /* Skip to next nested program */

        if (prog->next_program) {
                codegen (prog->next_program, 1);
                return;
        }

        /* Finalize the storage file */

        if (base_cache) {
                output_storage ("\n/* Storage */\n");
                base_cache = list_cache_sort (base_cache, &base_cache_cmp);
                prevprog = NULL;
                for (blp = base_cache; blp; blp = blp->next) {
                        if (blp->curr_prog != prevprog) {
                                prevprog = blp->curr_prog;
                                output_storage ("\n/* PROGRAM-ID : %s */\n", prevprog);
                        }
#ifdef HAVE_ATTRIBUTE_ALIGNED
                        output_storage ("static unsigned char %s%d[%d] __attribute__((aligned));",
#else
                        output_storage ("static unsigned char %s%d[%d];",
#endif
                                        CB_PREFIX_BASE, blp->f->id,
                                        blp->f->memory_size);
                        output_storage ("\t/* %s */\n", blp->f->name);
                }
                output_storage ("\n/* End of storage */\n\n");
        }

        if (attr_cache) {
                output_storage ("\n/* Attributes */\n\n");
                attr_cache = attr_list_reverse (attr_cache);
                for (j = attr_cache; j; j = j->next) {
                        output_storage ("static const cob_field_attr %s%d = ",
                                        CB_PREFIX_ATTR, j->id);
                        output_storage ("{%d, %d, %d, %d, ", j->type, j->digits,
                                        j->scale, j->flags);
                        if (j->pic) {
                                output_storage ("\"");
                                for (s = j->pic; *s; s += 5) {
                                        output_storage ("%c\\%03o\\%03o\\%03o\\%03o",
                                                s[0], s[1], s[2], s[3], s[4]);
                                }
                                output_storage ("\"");
                        } else {
                                output_storage ("NULL");
                        }
                        output_storage ("};\n");
                }
        }

        if (field_cache) {
                output_storage ("\n/* Fields */\n");
                field_cache = list_cache_sort (field_cache, &field_cache_cmp);
                prevprog = NULL;
                for (k = field_cache; k; k = k->next) {
                        if (k->curr_prog != prevprog) {
                                prevprog = k->curr_prog;
                                output_storage ("\n/* PROGRAM-ID : %s */\n", prevprog);
                        }
                        output ("static cob_field %s%d\t= ", CB_PREFIX_FIELD, k->f->id);
                        if (!k->f->flag_local && !k->f->flag_item_external) {
                                output_field (k->x);
                        } else {
                                output ("{");
                                output_size (k->x);
                                output (", NULL, ");
                                output_attr (k->x);
                                output ("}");
                        }
                        output (";\t/* %s */\n", k->f->name);
                }
                output_storage ("\n/* End of fields */\n\n");
        }
        if (literal_cache) {
                output_storage ("/* Constants */\n");
                literal_cache = literal_list_reverse (literal_cache);
                for (m = literal_cache; m; m = m->next) {
                        output ("static cob_field %s%d\t= ", CB_PREFIX_CONST, m->id);
                        output_field (m->x);
                        output (";\n");
                }
                output ("\n");
        }

        if (gen_ebcdic) {
                output_storage ("/* EBCDIC translate table */\n");
                output ("static const unsigned char\tcob_a2e[256] = {\n");
                if (alt_ebcdic) {
                        output ("\t0x00, 0x01, 0x02, 0x03, 0x37, 0x2D, 0x2E, 0x2F,\n");
                        output ("\t0x16, 0x05, 0x25, 0x0B, 0x0C, 0x0D, 0x0E, 0x0F,\n");
                        output ("\t0x10, 0x11, 0x12, 0x13, 0x3C, 0x3D, 0x32, 0x26,\n");
                        output ("\t0x18, 0x19, 0x3F, 0x27, 0x1C, 0x1D, 0x1E, 0x1F,\n");
                        output ("\t0x40, 0x5A, 0x7F, 0x7B, 0x5B, 0x6C, 0x50, 0x7D,\n");
                        output ("\t0x4D, 0x5D, 0x5C, 0x4E, 0x6B, 0x60, 0x4B, 0x61,\n");
                        output ("\t0xF0, 0xF1, 0xF2, 0xF3, 0xF4, 0xF5, 0xF6, 0xF7,\n");
                        output ("\t0xF8, 0xF9, 0x7A, 0x5E, 0x4C, 0x7E, 0x6E, 0x6F,\n");
                        output ("\t0x7C, 0xC1, 0xC2, 0xC3, 0xC4, 0xC5, 0xC6, 0xC7,\n");
                        output ("\t0xC8, 0xC9, 0xD1, 0xD2, 0xD3, 0xD4, 0xD5, 0xD6,\n");
                        output ("\t0xD7, 0xD8, 0xD9, 0xE2, 0xE3, 0xE4, 0xE5, 0xE6,\n");
                        output ("\t0xE7, 0xE8, 0xE9, 0xAD, 0xE0, 0xBD, 0x5F, 0x6D,\n");
                        output ("\t0x79, 0x81, 0x82, 0x83, 0x84, 0x85, 0x86, 0x87,\n");
                        output ("\t0x88, 0x89, 0x91, 0x92, 0x93, 0x94, 0x95, 0x96,\n");
                        output ("\t0x97, 0x98, 0x99, 0xA2, 0xA3, 0xA4, 0xA5, 0xA6,\n");
                        output ("\t0xA7, 0xA8, 0xA9, 0xC0, 0x6A, 0xD0, 0xA1, 0x07,\n");
                        output ("\t0x68, 0xDC, 0x51, 0x42, 0x43, 0x44, 0x47, 0x48,\n");
                        output ("\t0x52, 0x53, 0x54, 0x57, 0x56, 0x58, 0x63, 0x67,\n");
                        output ("\t0x71, 0x9C, 0x9E, 0xCB, 0xCC, 0xCD, 0xDB, 0xDD,\n");
                        output ("\t0xDF, 0xEC, 0xFC, 0xB0, 0xB1, 0xB2, 0x3E, 0xB4,\n");
                        output ("\t0x45, 0x55, 0xCE, 0xDE, 0x49, 0x69, 0x9A, 0x9B,\n");
                        output ("\t0xAB, 0x9F, 0xBA, 0xB8, 0xB7, 0xAA, 0x8A, 0x8B,\n");
                        output ("\t0xB6, 0xB5, 0x62, 0x4F, 0x64, 0x65, 0x66, 0x20,\n");
                        output ("\t0x21, 0x22, 0x70, 0x23, 0x72, 0x73, 0x74, 0xBE,\n");
                        output ("\t0x76, 0x77, 0x78, 0x80, 0x24, 0x15, 0x8C, 0x8D,\n");
                        output ("\t0x8E, 0x41, 0x06, 0x17, 0x28, 0x29, 0x9D, 0x2A,\n");
                        output ("\t0x2B, 0x2C, 0x09, 0x0A, 0xAC, 0x4A, 0xAE, 0xAF,\n");
                        output ("\t0x1B, 0x30, 0x31, 0xFA, 0x1A, 0x33, 0x34, 0x35,\n");
                        output ("\t0x36, 0x59, 0x08, 0x38, 0xBC, 0x39, 0xA0, 0xBF,\n");
                        output ("\t0xCA, 0x3A, 0xFE, 0x3B, 0x04, 0xCF, 0xDA, 0x14,\n");
                        output ("\t0xE1, 0x8F, 0x46, 0x75, 0xFD, 0xEB, 0xEE, 0xED,\n");
                        output ("\t0x90, 0xEF, 0xB3, 0xFB, 0xB9, 0xEA, 0xBB, 0xFF\n");
                } else {
                        /* MF */
                        output ("\t0x00, 0x01, 0x02, 0x03, 0x1D, 0x19, 0x1A, 0x1B,\n");
                        output ("\t0x0F, 0x04, 0x16, 0x06, 0x07, 0x08, 0x09, 0x0A,\n");
                        output ("\t0x0B, 0x0C, 0x0D, 0x0E, 0x1E, 0x1F, 0x1C, 0x17,\n");
                        output ("\t0x10, 0x11, 0x20, 0x18, 0x12, 0x13, 0x14, 0x15,\n");
                        output ("\t0x21, 0x27, 0x3A, 0x36, 0x28, 0x30, 0x26, 0x38,\n");
                        output ("\t0x24, 0x2A, 0x29, 0x25, 0x2F, 0x2C, 0x22, 0x2D,\n");
                        output ("\t0x73, 0x74, 0x75, 0x76, 0x77, 0x78, 0x79, 0x7A,\n");
                        output ("\t0x7B, 0x7C, 0x35, 0x2B, 0x23, 0x39, 0x32, 0x33,\n");
                        output ("\t0x37, 0x57, 0x58, 0x59, 0x5A, 0x5B, 0x5C, 0x5D,\n");
                        output ("\t0x5E, 0x5F, 0x61, 0x62, 0x63, 0x64, 0x65, 0x66,\n");
                        output ("\t0x67, 0x68, 0x69, 0x6B, 0x6C, 0x6D, 0x6E, 0x6F,\n");
                        output ("\t0x70, 0x71, 0x72, 0x7D, 0x6A, 0x7E, 0x7F, 0x31,\n");
                        output ("\t0x34, 0x3B, 0x3C, 0x3D, 0x3E, 0x3F, 0x40, 0x41,\n");
                        output ("\t0x42, 0x43, 0x44, 0x45, 0x46, 0x47, 0x48, 0x49,\n");
                        output ("\t0x4A, 0x4B, 0x4C, 0x4E, 0x4F, 0x50, 0x51, 0x52,\n");
                        output ("\t0x53, 0x54, 0x55, 0x56, 0x2E, 0x60, 0x4D, 0x05,\n");
                        output ("\t0x80, 0x81, 0x82, 0x83, 0x84, 0x85, 0x86, 0x87,\n");
                        output ("\t0x88, 0x89, 0x8A, 0x8B, 0x8C, 0x8D, 0x8E, 0x8F,\n");
                        output ("\t0x90, 0x91, 0x92, 0x93, 0x94, 0x95, 0x96, 0x97,\n");
                        output ("\t0x98, 0x99, 0x9A, 0x9B, 0x9C, 0x9D, 0x9E, 0x9F,\n");
                        output ("\t0xA0, 0xA1, 0xA2, 0xA3, 0xA4, 0xA5, 0xA6, 0xA7,\n");
                        output ("\t0xA8, 0xA9, 0xAA, 0xAB, 0xAC, 0xAD, 0xAE, 0xAF,\n");
                        output ("\t0xB0, 0xB1, 0xB2, 0xB3, 0xB4, 0xB5, 0xB6, 0xB7,\n");
                        output ("\t0xB8, 0xB9, 0xBA, 0xBB, 0xBC, 0xBD, 0xBE, 0xBF,\n");
                        output ("\t0xC0, 0xC1, 0xC2, 0xC3, 0xC4, 0xC5, 0xC6, 0xC7,\n");
                        output ("\t0xC8, 0xC9, 0xCA, 0xCB, 0xCC, 0xCD, 0xCE, 0xCF,\n");
                        output ("\t0xD0, 0xD1, 0xD2, 0xD3, 0xD4, 0xD5, 0xD6, 0xD7,\n");
                        output ("\t0xD8, 0xD9, 0xDA, 0xDB, 0xDC, 0xDD, 0xDE, 0xDF,\n");
                        output ("\t0xE0, 0xE1, 0xE2, 0xE3, 0xE4, 0xE5, 0xE6, 0xE7,\n");
                        output ("\t0xE8, 0xE9, 0xEA, 0xEB, 0xEC, 0xED, 0xEE, 0xEF,\n");
                        output ("\t0xF0, 0xF1, 0xF2, 0xF3, 0xF4, 0xF5, 0xF6, 0xF7,\n");
                        output ("\t0xF8, 0xF9, 0xFA, 0xFB, 0xFC, 0xFD, 0xFE, 0xFF\n");
                }
                output ("};\n");
                output_storage ("\n");
        }
        if (gen_full_ebcdic) {
                output ("static const unsigned char\tcob_ebcdic[256] = {\n");
                output ("\t0x00, 0x01, 0x02, 0x03, 0x37, 0x2D, 0x2E, 0x2F,\n");
                output ("\t0x16, 0x05, 0x25, 0x0B, 0x0C, 0x0D, 0x0E, 0x0F,\n");
                output ("\t0x10, 0x11, 0x12, 0x13, 0x3C, 0x3D, 0x32, 0x26,\n");
                output ("\t0x18, 0x19, 0x3F, 0x27, 0x1C, 0x1D, 0x1E, 0x1F,\n");
                output ("\t0x40, 0x5A, 0x7F, 0x7B, 0x5B, 0x6C, 0x50, 0x7D,\n");
                output ("\t0x4D, 0x5D, 0x5C, 0x4E, 0x6B, 0x60, 0x4B, 0x61,\n");
                output ("\t0xF0, 0xF1, 0xF2, 0xF3, 0xF4, 0xF5, 0xF6, 0xF7,\n");
                output ("\t0xF8, 0xF9, 0x7A, 0x5E, 0x4C, 0x7E, 0x6E, 0x6F,\n");
                output ("\t0x7C, 0xC1, 0xC2, 0xC3, 0xC4, 0xC5, 0xC6, 0xC7,\n");
                output ("\t0xC8, 0xC9, 0xD1, 0xD2, 0xD3, 0xD4, 0xD5, 0xD6,\n");
                output ("\t0xD7, 0xD8, 0xD9, 0xE2, 0xE3, 0xE4, 0xE5, 0xE6,\n");
                output ("\t0xE7, 0xE8, 0xE9, 0xAD, 0xE0, 0xBD, 0x5F, 0x6D,\n");
                output ("\t0x79, 0x81, 0x82, 0x83, 0x84, 0x85, 0x86, 0x87,\n");
                output ("\t0x88, 0x89, 0x91, 0x92, 0x93, 0x94, 0x95, 0x96,\n");
                output ("\t0x97, 0x98, 0x99, 0xA2, 0xA3, 0xA4, 0xA5, 0xA6,\n");
                output ("\t0xA7, 0xA8, 0xA9, 0xC0, 0x6A, 0xD0, 0xA1, 0x07,\n");
                output ("\t0x68, 0xDC, 0x51, 0x42, 0x43, 0x44, 0x47, 0x48,\n");
                output ("\t0x52, 0x53, 0x54, 0x57, 0x56, 0x58, 0x63, 0x67,\n");
                output ("\t0x71, 0x9C, 0x9E, 0xCB, 0xCC, 0xCD, 0xDB, 0xDD,\n");
                output ("\t0xDF, 0xEC, 0xFC, 0xB0, 0xB1, 0xB2, 0x3E, 0xB4,\n");
                output ("\t0x45, 0x55, 0xCE, 0xDE, 0x49, 0x69, 0x9A, 0x9B,\n");
                output ("\t0xAB, 0x9F, 0xBA, 0xB8, 0xB7, 0xAA, 0x8A, 0x8B,\n");
                output ("\t0xB6, 0xB5, 0x62, 0x4F, 0x64, 0x65, 0x66, 0x20,\n");
                output ("\t0x21, 0x22, 0x70, 0x23, 0x72, 0x73, 0x74, 0xBE,\n");
                output ("\t0x76, 0x77, 0x78, 0x80, 0x24, 0x15, 0x8C, 0x8D,\n");
                output ("\t0x8E, 0x41, 0x06, 0x17, 0x28, 0x29, 0x9D, 0x2A,\n");
                output ("\t0x2B, 0x2C, 0x09, 0x0A, 0xAC, 0x4A, 0xAE, 0xAF,\n");
                output ("\t0x1B, 0x30, 0x31, 0xFA, 0x1A, 0x33, 0x34, 0x35,\n");
                output ("\t0x36, 0x59, 0x08, 0x38, 0xBC, 0x39, 0xA0, 0xBF,\n");
                output ("\t0xCA, 0x3A, 0xFE, 0x3B, 0x04, 0xCF, 0xDA, 0x14,\n");
                output ("\t0xE1, 0x8F, 0x46, 0x75, 0xFD, 0xEB, 0xEE, 0xED,\n");
                output ("\t0x90, 0xEF, 0xB3, 0xFB, 0xB9, 0xEA, 0xBB, 0xFF\n");
                output ("};\n");
                i = lookup_attr (COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL, 0);
                output
                    ("static cob_field f_ebcdic = { 256, (unsigned char *)cob_ebcdic, &%s%d };\n",
                     CB_PREFIX_ATTR, i);
                output_storage ("\n");
        }
        if (gen_ebcdic_ascii) {
                output ("static const unsigned char\tcob_ebcdic_ascii[256] = {\n");
                output ("\t0x00, 0x01, 0x02, 0x03, 0xEC, 0x09, 0xCA, 0x7F,\n");
                output ("\t0xE2, 0xD2, 0xD3, 0x0B, 0x0C, 0x0D, 0x0E, 0x0F,\n");
                output ("\t0x10, 0x11, 0x12, 0x13, 0xEF, 0xC5, 0x08, 0xCB,\n");
                output ("\t0x18, 0x19, 0xDC, 0xD8, 0x1C, 0x1D, 0x1E, 0x1F,\n");
                output ("\t0xB7, 0xB8, 0xB9, 0xBB, 0xC4, 0x0A, 0x17, 0x1B,\n");
                output ("\t0xCC, 0xCD, 0xCF, 0xD0, 0xD1, 0x05, 0x06, 0x07,\n");
                output ("\t0xD9, 0xDA, 0x16, 0xDD, 0xDE, 0xDF, 0xE0, 0x04,\n");
                output ("\t0xE3, 0xE5, 0xE9, 0xEB, 0x14, 0x15, 0x9E, 0x1A,\n");
                output ("\t0x20, 0xC9, 0x83, 0x84, 0x85, 0xA0, 0xF2, 0x86,\n");
                output ("\t0x87, 0xA4, 0xD5, 0x2E, 0x3C, 0x28, 0x2B, 0xB3,\n");
                output ("\t0x26, 0x82, 0x88, 0x89, 0x8A, 0xA1, 0x8C, 0x8B,\n");
                output ("\t0x8D, 0xE1, 0x21, 0x24, 0x2A, 0x29, 0x3B, 0x5E,\n");
                output ("\t0x2D, 0x2F, 0xB2, 0x8E, 0xB4, 0xB5, 0xB6, 0x8F,\n");
                output ("\t0x80, 0xA5, 0x7C, 0x2C, 0x25, 0x5F, 0x3E, 0x3F,\n");
                output ("\t0xBA, 0x90, 0xBC, 0xBD, 0xBE, 0xF3, 0xC0, 0xC1,\n");
                output ("\t0xC2, 0x60, 0x3A, 0x23, 0x40, 0x27, 0x3D, 0x22,\n");
                output ("\t0xC3, 0x61, 0x62, 0x63, 0x64, 0x65, 0x66, 0x67,\n");
                output ("\t0x68, 0x69, 0xAE, 0xAF, 0xC6, 0xC7, 0xC8, 0xF1,\n");
                output ("\t0xF8, 0x6A, 0x6B, 0x6C, 0x6D, 0x6E, 0x6F, 0x70,\n");
                output ("\t0x71, 0x72, 0xA6, 0xA7, 0x91, 0xCE, 0x92, 0xA9,\n");
                output ("\t0xE6, 0x7E, 0x73, 0x74, 0x75, 0x76, 0x77, 0x78,\n");
                output ("\t0x79, 0x7A, 0xAD, 0xA8, 0xD4, 0x5B, 0xD6, 0xD7,\n");
                output ("\t0x9B, 0x9C, 0x9D, 0xFA, 0x9F, 0xB1, 0xB0, 0xAC,\n");
                output ("\t0xAB, 0xFC, 0xAA, 0xFE, 0xE4, 0x5D, 0xBF, 0xE7,\n");
                output ("\t0x7B, 0x41, 0x42, 0x43, 0x44, 0x45, 0x46, 0x47,\n");
                output ("\t0x48, 0x49, 0xE8, 0x93, 0x94, 0x95, 0xA2, 0xED,\n");
                output ("\t0x7D, 0x4A, 0x4B, 0x4C, 0x4D, 0x4E, 0x4F, 0x50,\n");
                output ("\t0x51, 0x52, 0xEE, 0x96, 0x81, 0x97, 0xA3, 0x98,\n");
                output ("\t0x5C, 0xF0, 0x53, 0x54, 0x55, 0x56, 0x57, 0x58,\n");
                output ("\t0x59, 0x5A, 0xFD, 0xF5, 0x99, 0xF7, 0xF6, 0xF9,\n");
                output ("\t0x30, 0x31, 0x32, 0x33, 0x34, 0x35, 0x36, 0x37,\n");
                output ("\t0x38, 0x39, 0xDB, 0xFB, 0x9A, 0xF4, 0xEA, 0xFF\n");
                output ("};\n");
                i = lookup_attr (COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL, 0);
                output
                    ("static cob_field f_ebcdic_ascii = { 256, (unsigned char *)cob_ebcdic_ascii, &%s%d };\n",
                     CB_PREFIX_ATTR, i);
                output_storage ("\n");
        }
        if (gen_native) {
                output ("static const unsigned char\tcob_native[256] = {\n");
                output ("\t0, 1, 2, 3, 4, 5, 6, 7,\n");
                output ("\t8, 9, 10, 11, 12, 13, 14, 15,\n");
                output ("\t16, 17, 18, 19, 20, 21, 22, 23,\n");
                output ("\t24, 25, 26, 27, 28, 29, 30, 31,\n");
                output ("\t32, 33, 34, 35, 36, 37, 38, 39,\n");
                output ("\t40, 41, 42, 43, 44, 45, 46, 47,\n");
                output ("\t48, 49, 50, 51, 52, 53, 54, 55,\n");
                output ("\t56, 57, 58, 59, 60, 61, 62, 63,\n");
                output ("\t64, 65, 66, 67, 68, 69, 70, 71,\n");
                output ("\t72, 73, 74, 75, 76, 77, 78, 79,\n");
                output ("\t80, 81, 82, 83, 84, 85, 86, 87,\n");
                output ("\t88, 89, 90, 91, 92, 93, 94, 95,\n");
                output ("\t96, 97, 98, 99, 100, 101, 102, 103,\n");
                output ("\t104, 105, 106, 107, 108, 109, 110, 111,\n");
                output ("\t112, 113, 114, 115, 116, 117, 118, 119,\n");
                output ("\t120, 121, 122, 123, 124, 125, 126, 127,\n");
                output ("\t128, 129, 130, 131, 132, 133, 134, 135,\n");
                output ("\t136, 137, 138, 139, 140, 141, 142, 143,\n");
                output ("\t144, 145, 146, 147, 148, 149, 150, 151,\n");
                output ("\t152, 153, 154, 155, 156, 157, 158, 159,\n");
                output ("\t160, 161, 162, 163, 164, 165, 166, 167,\n");
                output ("\t168, 169, 170, 171, 172, 173, 174, 175,\n");
                output ("\t176, 177, 178, 179, 180, 181, 182, 183,\n");
                output ("\t184, 185, 186, 187, 188, 189, 190, 191,\n");
                output ("\t192, 193, 194, 195, 196, 197, 198, 199,\n");
                output ("\t200, 201, 202, 203, 204, 205, 206, 207,\n");
                output ("\t208, 209, 210, 211, 212, 213, 214, 215,\n");
                output ("\t216, 217, 218, 219, 220, 221, 222, 223,\n");
                output ("\t224, 225, 226, 227, 228, 229, 230, 231,\n");
                output ("\t232, 233, 234, 235, 236, 237, 238, 239,\n");
                output ("\t240, 241, 242, 243, 244, 245, 246, 247,\n");
                output ("\t248, 249, 250, 251, 252, 253, 254, 255\n");
                output ("};\n");
                i = lookup_attr (COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL, 0);
                output
                    ("static cob_field f_native = { 256, (unsigned char *)cob_native, &%s%d };\n",
                     CB_PREFIX_ATTR, i);
                output_storage ("\n");
        }
}

Here is the call graph for this function:

Here is the caller graph for this function:

void finalize_file ( struct cb_file f,
struct cb_field records 
)

Definition at line 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 group_error ( cb_tree  x,
const char *  clause 
)

Definition at line 250 of file error.c.

{
        cb_error_x (x, _("Group item '%s' cannot have %s clause"), check_filler_name (cb_name (x)), clause);
}

Here is the call graph for this function:

Here is the caller graph for this function:

void level_except_error ( cb_tree  x,
const char *  clause 
)

Definition at line 270 of file error.c.

{
        cb_error_x (x, _("Level %02d item '%s' cannot have other than %s clause"),
                    cb_field (x)->level, check_filler_name (cb_name (x)), clause);
}

Here is the call graph for this function:

Here is the caller graph for this function:

void level_redundant_error ( cb_tree  x,
const char *  clause 
)

Definition at line 256 of file error.c.

{
        cb_error_x (x, _("Level %02d item '%s' cannot have %s clause"),
                    cb_field (x)->level, check_filler_name (cb_name (x)), clause);
}

Here is the call graph for this function:

Here is the caller graph for this function:

void level_require_error ( cb_tree  x,
const char *  clause 
)

Definition at line 263 of file error.c.

{
        cb_error_x (x, _("Level %02d item '%s' requires %s clause"),
                    cb_field (x)->level, check_filler_name (cb_name (x)), clause);
}

Here is the call graph for this function:

Here is the caller graph for this function:

struct cb_intrinsic_table* lookup_intrinsic ( const char *  name,
const int  checkres 
) [read]

Definition at line 929 of file reserved.c.

{
        struct cb_intrinsic_table       *cbp;
        struct noreserve                *noresptr;

        if (checkres) {
                for (noresptr = norestab; noresptr; noresptr = noresptr->next) {
                        if (strcasecmp (name, noresptr->noresword) == 0) {
                                return NULL;
                        }
                }
        }
        cbp = bsearch (name, function_list, NUM_INTRINSICS,
                        sizeof (struct cb_intrinsic_table), intrinsic_comp);
        if (cbp && cbp->implemented) {
                return cbp;
        }
        return NULL;
}

Here is the call graph for this function:

Here is the caller graph for this function:

int lookup_reserved_word ( const char *  name)

Definition at line 906 of file reserved.c.

{
        struct reserved *p;
        struct noreserve        *noresptr;

        p = bsearch (name, reserved_words, NUM_RESERVED_WORDS,
                        sizeof (struct reserved), reserve_comp);
        if (!p) {
                return 0;
        }
        for (noresptr = norestab; noresptr; noresptr = noresptr->next) {
                if (strcasecmp (name, noresptr->noresword) == 0) {
                        return 0;
                }
        }
        if (p->token != -1) {
                return p->token;
        }
        cb_error (_("'%s' reserved word, but not supported yet"), name);
        return 0;
}

Here is the call graph for this function:

cb_tree lookup_system_name ( const char *  name)

Definition at line 893 of file reserved.c.

{
        int     i;

        for (i = 0; system_table[i].name != NULL; ++i) {
                if (strcasecmp (name, system_table[i].name) == 0) {
                        return system_table[i].node;
                }
        }
        return cb_error_node;
}

Here is the caller graph for this function:

void redefinition_error ( cb_tree  x)

Definition at line 154 of file error.c.

{
        struct cb_word  *w;

        w = CB_REFERENCE (x)->word;
        cb_error_x (x, _("Redefinition of '%s'"), w->name);
        cb_error_x (CB_VALUE (w->items), _("'%s' previously defined here"), w->name);
}

Here is the call graph for this function:

Here is the caller graph for this function:

void redefinition_warning ( cb_tree  x,
cb_tree  y 
)

Definition at line 164 of file error.c.

{
        struct cb_word  *w;

        w = CB_REFERENCE (x)->word;
        cb_warning_x (x, _("Redefinition of '%s'"), w->name);
        if (y) {
                cb_warning_x (y, _("'%s' previously defined here"), w->name);
        } else {
                cb_warning_x (CB_VALUE (w->items), _("'%s' previously defined here"), w->name);
        }
}

Here is the call graph for this function:

Here is the caller graph for this function:

void undefined_error ( cb_tree  x)

Definition at line 178 of file error.c.

{
        struct cb_reference     *r;
        cb_tree                 c;

        if (!errnamebuff) {
                errnamebuff = cobc_malloc (COB_NORMAL_BUFF);
        }
        r = CB_REFERENCE (x);
        snprintf (errnamebuff, COB_NORMAL_MAX, "'%s'", CB_NAME (x));
        for (c = r->chain; c; c = CB_REFERENCE (c)->chain) {
                strcat (errnamebuff, " in '");
                strcat (errnamebuff, CB_NAME (c));
                strcat (errnamebuff, "'");
        }
        cb_error_x (x, _("%s undefined"), errnamebuff);
}

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;
        }
}

Here is the call graph for this function:

int validate_move ( cb_tree  src,
cb_tree  dst,
size_t  is_value 
)

Definition at line 3944 of file typeck.c.

{
        struct cb_field         *f;
        struct cb_literal       *l;
        unsigned char           *p;
        cb_tree                 loc;
        long long               val;
        size_t                  i;
        size_t                  is_numeric_edited = 0;
        int                     src_scale_mod;
        int                     dst_scale_mod;
        int                     dst_size_mod;
        int                     size;
        int                     most_significant;
        int                     least_significant;

        loc = src->source_line ? src : dst;
        if (CB_REFERENCE_P(dst) && CB_ALPHABET_NAME_P(CB_REFERENCE(dst)->value)) {
                goto invalid;
        }
        if (CB_REFERENCE_P(dst) && CB_FILE_P(CB_REFERENCE(dst)->value)) {
                goto invalid;
        }
        if (CB_TREE_CATEGORY (dst) == CB_CATEGORY_BOOLEAN) {
                cb_error_x (loc, _("Invalid destination for MOVE"));
                return -1;
        }

        if (CB_TREE_CLASS (dst) == CB_CLASS_POINTER) {
                if (CB_TREE_CLASS (src) == CB_CLASS_POINTER) {
                        return 0;
                } else {
                        goto invalid;
                }
        }

        f = cb_field (dst);
        switch (CB_TREE_TAG (src)) {
        case CB_TAG_CONST:
                if (src == cb_space) {
                        if (CB_TREE_CATEGORY (dst) == CB_CATEGORY_NUMERIC
                            || (CB_TREE_CATEGORY (dst) == CB_CATEGORY_NUMERIC_EDITED && !is_value)) {
                                goto invalid;
                        }
                } else if (src == cb_zero) {
                        if (CB_TREE_CATEGORY (dst) == CB_CATEGORY_ALPHABETIC) {
                                goto invalid;
                        }
                }
                break;
        case CB_TAG_LITERAL:
                /* TODO: ALL literal */

                l = CB_LITERAL (src);
                if (CB_TREE_CLASS (src) == CB_CLASS_NUMERIC) {
                        /* Numeric literal */
                        if (l->all) {
                                goto invalid;
                        }
                        most_significant = -999;
                        least_significant = 999;

                        /* compute the most significant figure place */
                        for (i = 0; i < l->size; i++) {
                                if (l->data[i] != '0') {
                                        break;
                                }
                        }
                        if (i != l->size) {
                                most_significant = (int) (l->size - l->scale - i - 1);
                        }

                        /* compute the least significant figure place */
                        for (i = 0; i < l->size; i++) {
                                if (l->data[l->size - i - 1] != '0') {
                                        break;
                                }
                        }
                        if (i != l->size) {
                                least_significant = (int) (-l->scale + i);
                        }

                        /* value check */
                        switch (CB_TREE_CATEGORY (dst)) {
                        case CB_CATEGORY_ALPHANUMERIC:
                        case CB_CATEGORY_ALPHANUMERIC_EDITED:
                                if (is_value) {
                                        goto expect_alphanumeric;
                                }

                                if (l->scale == 0) {
                                        goto expect_alphanumeric;
                                } else {
                                        goto invalid;
                                }
                        case CB_CATEGORY_NUMERIC:
                                if (f->pic->scale < 0) {
                                        /* check for PIC 9(n)P(m) */
                                        if (least_significant < -f->pic->scale) {
                                                goto value_mismatch;
                                        }
                                } else if (f->pic->scale > f->pic->size) {
                                        /* check for PIC P(n)9(m) */
                                        if (most_significant >= f->pic->size - f->pic->scale) {
                                                goto value_mismatch;
                                        }
                                }
                                break;
                        case CB_CATEGORY_NUMERIC_EDITED:
                                if (is_value) {
                                        goto expect_alphanumeric;
                                }

                                /* TODO */
                                break;
                        default:
                                if (is_value) {
                                        goto expect_alphanumeric;
                                }
                                goto invalid;
                        }

                        /* sign check */
                        if (l->sign != 0 && !f->pic->have_sign) {
                                if (is_value) {
                                        cb_error_x (loc, _("Data item not signed"));
                                        return -1;
                                }
                                if (cb_warn_constant) {
                                        cb_warning_x (loc, _("Ignoring negative sign"));
                                }
                        }

                        /* size check */
                        if (f->flag_real_binary || 
                            ((f->usage == CB_USAGE_COMP_5 ||
                              f->usage == CB_USAGE_COMP_X ||
                              f->usage == CB_USAGE_BINARY) &&
                              f->pic->scale == 0)) {
                                p = l->data;
                                for (i = 0; i < l->size; i++) {
                                        if (l->data[i] != '0') {
                                                p = &l->data[i];
                                                break;
                                        }
                                }
                                i = l->size - i;
                                switch (f->size) {
                                case 1:
                                        if (i > 18) {
                                                goto numlit_overflow;
                                        }
                                        val = cb_get_long_long (src);
                                        if (f->pic->have_sign) {
                                                if (val < -128LL ||
                                                    val > 127LL) {
                                                        goto numlit_overflow;
                                                }
                                        } else {
                                                if (val > 255LL) {
                                                        goto numlit_overflow;
                                                }
                                        }
                                        break;
                                case 2:
                                        if (i > 18) {
                                                goto numlit_overflow;
                                        }
                                        val = cb_get_long_long (src);
                                        if (f->pic->have_sign) {
                                                if (val < -32768LL ||
                                                    val > 32767LL) {
                                                        goto numlit_overflow;
                                                }
                                        } else {
                                                if (val > 65535LL) {
                                                        goto numlit_overflow;
                                                }
                                        }
                                        break;
                                case 3:
                                        if (i > 18) {
                                                goto numlit_overflow;
                                        }
                                        val = cb_get_long_long (src);
                                        if (f->pic->have_sign) {
                                                if (val < -8388608LL ||
                                                    val > 8388607LL) {
                                                        goto numlit_overflow;
                                                }
                                        } else {
                                                if (val > 16777215LL) {
                                                        goto numlit_overflow;
                                                }
                                        }
                                        break;
                                case 4:
                                        if (i > 18) {
                                                goto numlit_overflow;
                                        }
                                        val = cb_get_long_long (src);
                                        if (f->pic->have_sign) {
                                                if (val < -2147483648LL ||
                                                    val > 2147483647LL) {
                                                        goto numlit_overflow;
                                                }
                                        } else {
                                                if (val > 4294967295LL) {
                                                        goto numlit_overflow;
                                                }
                                        }
                                        break;
                                case 5:
                                        if (i > 18) {
                                                goto numlit_overflow;
                                        }
                                        val = cb_get_long_long (src);
                                        if (f->pic->have_sign) {
                                                if (val < -549755813888LL ||
                                                    val > 549755813887LL) {
                                                        goto numlit_overflow;
                                                }
                                        } else {
                                                if (val > 1099511627775LL) {
                                                        goto numlit_overflow;
                                                }
                                        }
                                        break;
                                case 6:
                                        if (i > 18) {
                                                goto numlit_overflow;
                                        }
                                        val = cb_get_long_long (src);
                                        if (f->pic->have_sign) {
                                                if (val < -140737488355328LL ||
                                                    val > 140737488355327LL) {
                                                        goto numlit_overflow;
                                                }
                                        } else {
                                                if (val > 281474976710655LL) {
                                                        goto numlit_overflow;
                                                }
                                        }
                                        break;
                                case 7:
                                        if (i > 18) {
                                                goto numlit_overflow;
                                        }
                                        val = cb_get_long_long (src);
                                        if (f->pic->have_sign) {
                                                if (val < -36028797018963968LL ||
                                                    val > 36028797018963967LL) {
                                                        goto numlit_overflow;
                                                }
                                        } else {
                                                if (val > 72057594037927935LL) {
                                                        goto numlit_overflow;
                                                }
                                        }
                                        break;
                                default:
                                        if (f->pic->have_sign) {
                                                if (i < 19) {
                                                        break;
                                                }
                                                if (i > 19) {
                                                        goto numlit_overflow;
                                                }
                                                if (memcmp (p, "9223372036854775807", 19) > 0) {
                                                        goto numlit_overflow;
                                                }
                                        } else {
                                                if (i < 20) {
                                                        break;
                                                }
                                                if (i > 20) {
                                                        goto numlit_overflow;
                                                }
                                                if (memcmp (p, "18446744073709551615", 20) > 0) {
                                                        goto numlit_overflow;
                                                }
                                        }
                                        break;
                                }
                                return 0;
                        }
                        if (least_significant < -f->pic->scale) {
                                goto size_overflow;
                        }
                        if (f->pic->scale > 0) {
                                size = f->pic->digits - f->pic->scale;
                        } else {
                                size = f->pic->digits;
                        }
                        if (most_significant >= size) {
                                goto size_overflow;
                        }
                } else {
                        /* Alphanumeric literal */

                        /* value check */
                        switch (CB_TREE_CATEGORY (dst)) {
                        case CB_CATEGORY_ALPHABETIC:
                                for (i = 0; i < l->size; i++) {
                                        if (!isalpha (l->data[i]) && !isspace (l->data[i])) {
                                                goto value_mismatch;
                                        }
                                }
                                break;
                        case CB_CATEGORY_NUMERIC:
                                goto expect_numeric;
                        case CB_CATEGORY_NUMERIC_EDITED:
                                if (!is_value) {
                                        goto expect_numeric;
                                }

                                /* TODO: validate the value */
                                break;
                        default:
                                break;
                        }

                        /* size check */
                        size = cb_field_size (dst);
                        if (size >= 0 && (int)l->size > size) {
                                goto size_overflow;
                        }
                }
                break;
        case CB_TAG_FIELD:
        case CB_TAG_REFERENCE:
                if (CB_REFERENCE_P(src) &&
                    CB_ALPHABET_NAME_P(CB_REFERENCE(src)->value)) {
                        break;
                }
                if (CB_REFERENCE_P(src) &&
                    CB_FILE_P(CB_REFERENCE(src)->value)) {
                        goto invalid;
                }
                size = cb_field_size (src);
                if (size < 0) {
                        size = cb_field (src)->size;
                }
                /* non-elementary move */
                if (cb_field (src)->children || cb_field (dst)->children) {
                        if (size > cb_field (dst)->size) { 
                                goto size_overflow_1;
                        }
                        break;
                }

                /* elementary move */
                switch (CB_TREE_CATEGORY (src)) {
                case CB_CATEGORY_ALPHANUMERIC:
                        switch (CB_TREE_CATEGORY (dst)) {
                        case CB_CATEGORY_NUMERIC:
                        case CB_CATEGORY_NUMERIC_EDITED:
                                if (size > cb_field (dst)->pic->digits) {
                                        goto size_overflow_2;
                                }
                                break;
                        case CB_CATEGORY_ALPHANUMERIC_EDITED:
                                if (size >
                                    count_pic_alphanumeric_edited (cb_field (dst))) { 
                                        goto size_overflow_1;
                                }
                                break;
                        default:
                                if (size > cb_field (dst)->size) { 
                                        goto size_overflow_1;
                                }
                                break;
                        }
                        break;
                case CB_CATEGORY_ALPHABETIC:
                case CB_CATEGORY_ALPHANUMERIC_EDITED:
                        switch (CB_TREE_CATEGORY (dst)) {
                        case CB_CATEGORY_NUMERIC:
                        case CB_CATEGORY_NUMERIC_EDITED:
                                goto invalid;
                        case CB_CATEGORY_ALPHANUMERIC_EDITED:
                                if (size >
                                    count_pic_alphanumeric_edited(cb_field (dst))) { 
                                        goto size_overflow_1;
                                }
                                break;
                        default:
                                if (size > cb_field (dst)->size) { 
                                        goto size_overflow_1;
                                }
                                break;
                        }
                        break;
                case CB_CATEGORY_NUMERIC:
                case CB_CATEGORY_NUMERIC_EDITED:
                        switch (CB_TREE_CATEGORY (dst)) {
                        case CB_CATEGORY_ALPHABETIC:
                                goto invalid;
                        case CB_CATEGORY_ALPHANUMERIC_EDITED:
                                is_numeric_edited = 1;
                                /* Drop through */
                        case CB_CATEGORY_ALPHANUMERIC:
                                if (is_numeric_edited) {
                                        dst_size_mod = count_pic_alphanumeric_edited (cb_field (dst));
                                } else {
                                        dst_size_mod = cb_field (dst)->size;
                                }
                                if (CB_TREE_CATEGORY (src) == CB_CATEGORY_NUMERIC
                                    && cb_field (src)->pic->scale > 0) {
                                        if (cb_move_noninteger_to_alphanumeric == CB_ERROR) {
                                                goto invalid;
                                        }
                                        cb_warning_x (loc, _("Move non-integer to alphanumeric"));
                                        break;
                                }
                                if (CB_TREE_CATEGORY (src) == CB_CATEGORY_NUMERIC
                                    && cb_field (src)->pic->digits > dst_size_mod) {
                                        goto size_overflow_2;
                                }
                                if (CB_TREE_CATEGORY (src) == CB_CATEGORY_NUMERIC_EDITED
                                    && cb_field (src)->size > dst_size_mod) {
                                        goto size_overflow_1;
                                }
                                break;
                        default:
                                src_scale_mod = cb_field (src)->pic->scale < 0 ?
                                                0 : cb_field (src)->pic->scale;
                                dst_scale_mod = cb_field (dst)->pic->scale < 0 ?
                                                0 : cb_field (dst)->pic->scale;
                                if (cb_field (src)->pic->digits - src_scale_mod > 
                                    cb_field (dst)->pic->digits - dst_scale_mod  ||
                                    src_scale_mod > dst_scale_mod) { 
                                        goto size_overflow_2;
                                }
                                break;
                        }
                        break;
                default:
                        cb_error_x (loc, _("Invalid source for MOVE"));
                        return -1;
                }
                break;
        case CB_TAG_INTEGER:
        case CB_TAG_BINARY_OP:
        case CB_TAG_INTRINSIC:
                /* TODO: check this */
                break;
        default:
                fprintf (stderr, "Invalid tree tag %d\n", CB_TREE_TAG (src));
                ABORT ();
        }
        return 0;

invalid:
        if (is_value) {
                cb_error_x (loc, _("Invalid VALUE clause"));
        } else {
                cb_error_x (loc, _("Invalid MOVE statement"));
        }
        return -1;

numlit_overflow:
        if (is_value) {
                cb_error_x (loc, _("Invalid VALUE clause - literal exceeds data size"));
                return -1;
        }
        if (cb_warn_constant) {
                cb_warning_x (loc, _("Numeric literal exceeds data size"));
        }
        return 0;

expect_numeric:
        return move_error (src, dst, is_value, cb_warn_strict_typing, 0,
                           _("Numeric value is expected"));

expect_alphanumeric:
        return move_error (src, dst, is_value, cb_warn_strict_typing, 0,
                           _("Alphanumeric value is expected"));

value_mismatch:
        return move_error (src, dst, is_value, cb_warn_constant, 0,
                           _("Value does not fit the picture string"));

size_overflow:
        return move_error (src, dst, is_value, cb_warn_constant, 0,
                           _("Value size exceeds data size"));

size_overflow_1:
        return move_error (src, dst, is_value, cb_warn_truncate, 1,
                           _("Sending field larger than receiving field"));

size_overflow_2:
        return move_error (src, dst, is_value, cb_warn_truncate, 1,
                           _("Some digits may be truncated"));
}

Here is the call graph for this function:

Here is the caller graph for this function:


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.

size_t cb_needs_01

Definition at line 33 of file field.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.

Definition at line 101 of file tree.c.

Definition at line 988 of file parser.c.

 All Data Structures Files Functions Variables Typedefs Enumerations Enumerator Defines