GnuCOBOL  2.0
A free COBOL compiler
 All Data Structures Files Functions Variables Typedefs Enumerations Enumerator Macros
Data Structures | Macros | 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  cobc_reserved
 
struct  cb_tree_common
 
struct  cb_const
 
struct  cb_direct
 
struct  cb_debug
 
struct  cb_debug_call
 
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_key
 
struct  cb_field
 
struct  cb_para_label
 
struct  cb_alter_id
 
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_cancel
 
struct  cb_alter
 
struct  cb_goto
 
struct  cb_if
 
struct  cb_perform_varying
 
struct  cb_perform
 
struct  cb_attr_struct
 
struct  cb_statement
 
struct  cb_continue
 
struct  cb_set_attr
 
struct  cb_list
 
struct  cb_report
 
struct  nested_list
 
struct  cb_program
 

Macros

#define CB_BEFORE   cb_int0
 
#define CB_AFTER   cb_int1
 
#define COB_MAX_SUBSCRIPTS   16
 
#define CB_PREFIX_ATTR   "a_" /* Field attribute (cob_field_attr) */
 
#define CB_PREFIX_BASE   "b_" /* Base address (unsigned char *) */
 
#define CB_PREFIX_CONST   "c_" /* Constant or literal (cob_field) */
 
#define CB_PREFIX_DECIMAL   "d_" /* Decimal number (cob_decimal) */
 
#define CB_PREFIX_FIELD   "f_" /* Field (cob_field) */
 
#define CB_PREFIX_FILE   "h_" /* File (cob_file) */
 
#define CB_PREFIX_KEYS   "k_" /* File keys (cob_file_key []) */
 
#define CB_PREFIX_LABEL   "l_" /* Label */
 
#define CB_PREFIX_SEQUENCE   "s_" /* Collating sequence */
 
#define CB_PREFIX_STRING   "st_" /* String */
 
#define CB_PROGRAM_TYPE   0
 
#define CB_FUNCTION_TYPE   1
 
#define CB_CALL_BY_REFERENCE   1
 
#define CB_CALL_BY_CONTENT   2
 
#define CB_CALL_BY_VALUE   3
 
#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_WORD_HASH_SIZE   (1U << 11)
 
#define CB_WORD_HASH_MASK   (CB_WORD_HASH_SIZE - 1U)
 
#define CB_ALPHABET_NATIVE   0
 
#define CB_ALPHABET_ASCII   1
 
#define CB_ALPHABET_EBCDIC   2
 
#define CB_ALPHABET_CUSTOM   3
 
#define CB_CONV_L_TO_R   (1 << 0)
 
#define CB_CONV_CALLEE_STACK   (1 << 1)
 
#define CB_CONV_NO_RET_UPD   (1 << 2)
 
#define CB_CONV_STATIC_LINK   (1 << 3)
 
#define CB_CONV_OPT_LINK   (1 << 4)
 
#define CB_CONV_THUNK_16   (1 << 5)
 
#define CB_CONV_STDCALL   (1 << 6)
 
#define CB_DEVICE_SYSIN   0
 
#define CB_DEVICE_SYSOUT   1
 
#define CB_DEVICE_SYSERR   2
 
#define CB_DEVICE_CONSOLE   3
 
#define CB_SWITCH_0   0
 
#define CB_SWITCH_1   1
 
#define CB_SWITCH_2   2
 
#define CB_SWITCH_3   3
 
#define CB_SWITCH_4   4
 
#define CB_SWITCH_5   5
 
#define CB_SWITCH_6   6
 
#define CB_SWITCH_7   7
 
#define CB_SWITCH_8   8
 
#define CB_SWITCH_9   9
 
#define CB_SWITCH_10   10
 
#define CB_SWITCH_11   11
 
#define CB_SWITCH_12   12
 
#define CB_SWITCH_13   13
 
#define CB_SWITCH_14   14
 
#define CB_SWITCH_15   15
 
#define CB_FEATURE_FORMFEED   0
 
#define CB_FEATURE_CONVENTION   1
 
#define CB_FEATURE_C01   2
 
#define CB_FEATURE_C02   3
 
#define CB_FEATURE_C03   4
 
#define CB_FEATURE_C04   5
 
#define CB_FEATURE_C05   6
 
#define CB_FEATURE_C06   7
 
#define CB_FEATURE_C07   8
 
#define CB_FEATURE_C08   9
 
#define CB_FEATURE_C09   10
 
#define CB_FEATURE_C10   11
 
#define CB_FEATURE_C11   12
 
#define CB_FEATURE_C12   13
 
#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_VALID_TREE(x)   (x && CB_TREE (x) != cb_error_node)
 
#define CB_INVALID_TREE(x)   (!(x) || CB_TREE (x) == cb_error_node)
 
#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_DIRECT(x)   (CB_TREE_CAST (CB_TAG_DIRECT, struct cb_direct, x))
 
#define CB_DIRECT_P(x)   (CB_TREE_TAG (x) == CB_TAG_DIRECT)
 
#define CB_DEBUG(x)   (CB_TREE_CAST (CB_TAG_DEBUG, struct cb_debug, x))
 
#define CB_DEBUG_P(x)   (CB_TREE_TAG (x) == CB_TAG_DEBUG)
 
#define CB_DEBUG_CALL(x)   (CB_TREE_CAST (CB_TAG_DEBUG_CALL, struct cb_debug_call, x))
 
#define CB_DEBUG_CALL_P(x)   (CB_TREE_TAG (x) == CB_TAG_DEBUG_CALL)
 
#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_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_REFERENCE_P (x) || CB_FIELD_P (x))
 
#define CB_FIELD_PTR(x)   (CB_REFERENCE_P (x) ? CB_FIELD (cb_ref (x)) : CB_FIELD (x))
 
#define CB_INDEX_P(x)   cb_check_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_TABLE_SIZE   (CB_WORD_HASH_SIZE * sizeof (struct cb_word))
 
#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_WORD_COUNT(x)   (CB_REFERENCE (x)->word->count)
 
#define CB_WORD_ITEMS(x)   (CB_REFERENCE (x)->word->items)
 
#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_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_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_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(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_CANCEL(x)   (CB_TREE_CAST (CB_TAG_CANCEL, struct cb_cancel, x))
 
#define CB_CANCEL_P(x)   (CB_TREE_TAG (x) == CB_TAG_CANCEL)
 
#define CB_ALTER(x)   (CB_TREE_CAST (CB_TAG_ALTER, struct cb_alter, x))
 
#define CB_ALTER_P(x)   (CB_TREE_TAG (x) == CB_TAG_ALTER)
 
#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_SET_ATTR(x)   (CB_TREE_CAST (CB_TAG_SET_ATTR, struct cb_set_attr, x))
 
#define CB_SET_ATTR_P(x)   (CB_TREE_TAG (x) == CB_TAG_SET_ATTR)
 
#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_SIZES_INT(x)   ((CB_LIST (x)->sizes) & 0x07)
 
#define CB_SIZES_INT_UNSIGNED(x)   ((CB_LIST (x)->sizes) & CB_SIZE_UNSIGNED)
 
#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_REPORT(x)   (CB_TREE_CAST (CB_TAG_REPORT, struct cb_report, x))
 
#define CB_REPORT_P(x)   (CB_TREE_TAG (x) == CB_TAG_REPORT)
 
#define CB_BUILD_FUNCALL_0(f)
 
#define CB_BUILD_FUNCALL_1(f, a1)
 
#define CB_BUILD_FUNCALL_2(f, a1, a2)
 
#define CB_BUILD_FUNCALL_3(f, a1, a2, a3)
 
#define CB_BUILD_FUNCALL_4(f, a1, a2, a3, a4)
 
#define CB_BUILD_FUNCALL_5(f, a1, a2, a3, a4, a5)
 
#define CB_BUILD_FUNCALL_6(f, a1, a2, a3, a4, a5, a6)
 
#define CB_BUILD_FUNCALL_7(f, a1, a2, a3, a4, a5, a6, a7)
 
#define CB_BUILD_FUNCALL_8(f, a1, a2, a3, a4, a5, a6, a7, a8)
 
#define CB_BUILD_FUNCALL_9(f, a1, a2, a3, a4, a5, a6, a7, a8, a9)
 
#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_BUILD_PARENTHESIS(x)   cb_build_binary_op (x, '@', NULL)
 
#define CB_BUILD_NEGATION(x)   cb_build_binary_op (x, '!', NULL)
 
#define CB_BUILD_STRING0(str)   cb_build_string (str, strlen ((char *)(str)))
 
#define CB_LIST_INIT(x)   cb_build_list (NULL, x, NULL)
 
#define CB_BUILD_CHAIN(x, y)   cb_build_list (NULL, x, y)
 
#define CB_BUILD_PAIR(x, y)   cb_build_list (x, y, NULL)
 
#define CB_ADD_TO_CHAIN(x, y)   y = CB_BUILD_CHAIN (x, y)
 
#define CB_CHAIN_PAIR(x, y, z)   x = cb_pair_add (x, y, z)
 
#define CB_FIELD_ADD(x, y)   x = cb_field_add (x, y)
 
#define CB_BEFORE   cb_int0
 
#define CB_AFTER   cb_int1
 
#define COB_MAX_SUBSCRIPTS   16
 
#define CB_PREFIX_ATTR   "a_" /* Field attribute (cob_field_attr) */
 
#define CB_PREFIX_BASE   "b_" /* Base address (unsigned char *) */
 
#define CB_PREFIX_CONST   "c_" /* Constant or literal (cob_field) */
 
#define CB_PREFIX_DECIMAL   "d_" /* Decimal number (cob_decimal) */
 
#define CB_PREFIX_FIELD   "f_" /* Field (cob_field) */
 
#define CB_PREFIX_FILE   "h_" /* File (cob_file) */
 
#define CB_PREFIX_KEYS   "k_" /* File keys (cob_file_key []) */
 
#define CB_PREFIX_LABEL   "l_" /* Label */
 
#define CB_PREFIX_SEQUENCE   "s_" /* Collating sequence */
 
#define CB_PREFIX_STRING   "st_" /* String */
 
#define CB_PROGRAM_TYPE   0
 
#define CB_FUNCTION_TYPE   1
 
#define CB_CALL_BY_REFERENCE   1
 
#define CB_CALL_BY_CONTENT   2
 
#define CB_CALL_BY_VALUE   3
 
#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_WORD_HASH_SIZE   (1U << 11)
 
#define CB_WORD_HASH_MASK   (CB_WORD_HASH_SIZE - 1U)
 
#define CB_ALPHABET_NATIVE   0
 
#define CB_ALPHABET_ASCII   1
 
#define CB_ALPHABET_EBCDIC   2
 
#define CB_ALPHABET_CUSTOM   3
 
#define CB_CONV_L_TO_R   (1 << 0)
 
#define CB_CONV_CALLEE_STACK   (1 << 1)
 
#define CB_CONV_NO_RET_UPD   (1 << 2)
 
#define CB_CONV_STATIC_LINK   (1 << 3)
 
#define CB_CONV_OPT_LINK   (1 << 4)
 
#define CB_CONV_THUNK_16   (1 << 5)
 
#define CB_CONV_STDCALL   (1 << 6)
 
#define CB_DEVICE_SYSIN   0
 
#define CB_DEVICE_SYSOUT   1
 
#define CB_DEVICE_SYSERR   2
 
#define CB_DEVICE_CONSOLE   3
 
#define CB_SWITCH_0   0
 
#define CB_SWITCH_1   1
 
#define CB_SWITCH_2   2
 
#define CB_SWITCH_3   3
 
#define CB_SWITCH_4   4
 
#define CB_SWITCH_5   5
 
#define CB_SWITCH_6   6
 
#define CB_SWITCH_7   7
 
#define CB_SWITCH_8   8
 
#define CB_SWITCH_9   9
 
#define CB_SWITCH_10   10
 
#define CB_SWITCH_11   11
 
#define CB_SWITCH_12   12
 
#define CB_SWITCH_13   13
 
#define CB_SWITCH_14   14
 
#define CB_SWITCH_15   15
 
#define CB_FEATURE_FORMFEED   0
 
#define CB_FEATURE_CONVENTION   1
 
#define CB_FEATURE_C01   2
 
#define CB_FEATURE_C02   3
 
#define CB_FEATURE_C03   4
 
#define CB_FEATURE_C04   5
 
#define CB_FEATURE_C05   6
 
#define CB_FEATURE_C06   7
 
#define CB_FEATURE_C07   8
 
#define CB_FEATURE_C08   9
 
#define CB_FEATURE_C09   10
 
#define CB_FEATURE_C10   11
 
#define CB_FEATURE_C11   12
 
#define CB_FEATURE_C12   13
 
#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_VALID_TREE(x)   (x && CB_TREE (x) != cb_error_node)
 
#define CB_INVALID_TREE(x)   (!(x) || CB_TREE (x) == cb_error_node)
 
#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_DIRECT(x)   (CB_TREE_CAST (CB_TAG_DIRECT, struct cb_direct, x))
 
#define CB_DIRECT_P(x)   (CB_TREE_TAG (x) == CB_TAG_DIRECT)
 
#define CB_DEBUG(x)   (CB_TREE_CAST (CB_TAG_DEBUG, struct cb_debug, x))
 
#define CB_DEBUG_P(x)   (CB_TREE_TAG (x) == CB_TAG_DEBUG)
 
#define CB_DEBUG_CALL(x)   (CB_TREE_CAST (CB_TAG_DEBUG_CALL, struct cb_debug_call, x))
 
#define CB_DEBUG_CALL_P(x)   (CB_TREE_TAG (x) == CB_TAG_DEBUG_CALL)
 
#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_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_REFERENCE_P (x) || CB_FIELD_P (x))
 
#define CB_FIELD_PTR(x)   (CB_REFERENCE_P (x) ? CB_FIELD (cb_ref (x)) : CB_FIELD (x))
 
#define CB_INDEX_P(x)   cb_check_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_TABLE_SIZE   (CB_WORD_HASH_SIZE * sizeof (struct cb_word))
 
#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_WORD_COUNT(x)   (CB_REFERENCE (x)->word->count)
 
#define CB_WORD_ITEMS(x)   (CB_REFERENCE (x)->word->items)
 
#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_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_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_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(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_CANCEL(x)   (CB_TREE_CAST (CB_TAG_CANCEL, struct cb_cancel, x))
 
#define CB_CANCEL_P(x)   (CB_TREE_TAG (x) == CB_TAG_CANCEL)
 
#define CB_ALTER(x)   (CB_TREE_CAST (CB_TAG_ALTER, struct cb_alter, x))
 
#define CB_ALTER_P(x)   (CB_TREE_TAG (x) == CB_TAG_ALTER)
 
#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_SET_ATTR(x)   (CB_TREE_CAST (CB_TAG_SET_ATTR, struct cb_set_attr, x))
 
#define CB_SET_ATTR_P(x)   (CB_TREE_TAG (x) == CB_TAG_SET_ATTR)
 
#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_SIZES_INT(x)   ((CB_LIST (x)->sizes) & 0x07)
 
#define CB_SIZES_INT_UNSIGNED(x)   ((CB_LIST (x)->sizes) & CB_SIZE_UNSIGNED)
 
#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_REPORT(x)   (CB_TREE_CAST (CB_TAG_REPORT, struct cb_report, x))
 
#define CB_REPORT_P(x)   (CB_TREE_TAG (x) == CB_TAG_REPORT)
 
#define CB_BUILD_FUNCALL_0(f)
 
#define CB_BUILD_FUNCALL_1(f, a1)
 
#define CB_BUILD_FUNCALL_2(f, a1, a2)
 
#define CB_BUILD_FUNCALL_3(f, a1, a2, a3)
 
#define CB_BUILD_FUNCALL_4(f, a1, a2, a3, a4)
 
#define CB_BUILD_FUNCALL_5(f, a1, a2, a3, a4, a5)
 
#define CB_BUILD_FUNCALL_6(f, a1, a2, a3, a4, a5, a6)
 
#define CB_BUILD_FUNCALL_7(f, a1, a2, a3, a4, a5, a6, a7)
 
#define CB_BUILD_FUNCALL_8(f, a1, a2, a3, a4, a5, a6, a7, a8)
 
#define CB_BUILD_FUNCALL_9(f, a1, a2, a3, a4, a5, a6, a7, a8, a9)
 
#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_BUILD_PARENTHESIS(x)   cb_build_binary_op (x, '@', NULL)
 
#define CB_BUILD_NEGATION(x)   cb_build_binary_op (x, '!', NULL)
 
#define CB_BUILD_STRING0(str)   cb_build_string (str, strlen ((char *)(str)))
 
#define CB_LIST_INIT(x)   cb_build_list (NULL, x, NULL)
 
#define CB_BUILD_CHAIN(x, y)   cb_build_list (NULL, x, y)
 
#define CB_BUILD_PAIR(x, y)   cb_build_list (x, y, NULL)
 
#define CB_ADD_TO_CHAIN(x, y)   y = CB_BUILD_CHAIN (x, y)
 
#define CB_CHAIN_PAIR(x, y, z)   x = cb_pair_add (x, y, z)
 
#define CB_FIELD_ADD(x, y)   x = cb_field_add (x, y)
 
#define CB_BEFORE   cb_int0
 
#define CB_AFTER   cb_int1
 
#define COB_MAX_SUBSCRIPTS   16
 
#define CB_PREFIX_ATTR   "a_" /* Field attribute (cob_field_attr) */
 
#define CB_PREFIX_BASE   "b_" /* Base address (unsigned char *) */
 
#define CB_PREFIX_CONST   "c_" /* Constant or literal (cob_field) */
 
#define CB_PREFIX_DECIMAL   "d_" /* Decimal number (cob_decimal) */
 
#define CB_PREFIX_FIELD   "f_" /* Field (cob_field) */
 
#define CB_PREFIX_FILE   "h_" /* File (cob_file) */
 
#define CB_PREFIX_KEYS   "k_" /* File keys (cob_file_key []) */
 
#define CB_PREFIX_LABEL   "l_" /* Label */
 
#define CB_PREFIX_SEQUENCE   "s_" /* Collating sequence */
 
#define CB_PREFIX_STRING   "st_" /* String */
 
#define CB_PROGRAM_TYPE   0
 
#define CB_FUNCTION_TYPE   1
 
#define CB_CALL_BY_REFERENCE   1
 
#define CB_CALL_BY_CONTENT   2
 
#define CB_CALL_BY_VALUE   3
 
#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_WORD_HASH_SIZE   (1U << 11)
 
#define CB_WORD_HASH_MASK   (CB_WORD_HASH_SIZE - 1U)
 
#define CB_ALPHABET_NATIVE   0
 
#define CB_ALPHABET_ASCII   1
 
#define CB_ALPHABET_EBCDIC   2
 
#define CB_ALPHABET_CUSTOM   3
 
#define CB_CONV_L_TO_R   (1 << 0)
 
#define CB_CONV_CALLEE_STACK   (1 << 1)
 
#define CB_CONV_NO_RET_UPD   (1 << 2)
 
#define CB_CONV_STATIC_LINK   (1 << 3)
 
#define CB_CONV_OPT_LINK   (1 << 4)
 
#define CB_CONV_THUNK_16   (1 << 5)
 
#define CB_CONV_STDCALL   (1 << 6)
 
#define CB_DEVICE_SYSIN   0
 
#define CB_DEVICE_SYSOUT   1
 
#define CB_DEVICE_SYSERR   2
 
#define CB_DEVICE_CONSOLE   3
 
#define CB_SWITCH_0   0
 
#define CB_SWITCH_1   1
 
#define CB_SWITCH_2   2
 
#define CB_SWITCH_3   3
 
#define CB_SWITCH_4   4
 
#define CB_SWITCH_5   5
 
#define CB_SWITCH_6   6
 
#define CB_SWITCH_7   7
 
#define CB_SWITCH_8   8
 
#define CB_SWITCH_9   9
 
#define CB_SWITCH_10   10
 
#define CB_SWITCH_11   11
 
#define CB_SWITCH_12   12
 
#define CB_SWITCH_13   13
 
#define CB_SWITCH_14   14
 
#define CB_SWITCH_15   15
 
#define CB_FEATURE_FORMFEED   0
 
#define CB_FEATURE_CONVENTION   1
 
#define CB_FEATURE_C01   2
 
#define CB_FEATURE_C02   3
 
#define CB_FEATURE_C03   4
 
#define CB_FEATURE_C04   5
 
#define CB_FEATURE_C05   6
 
#define CB_FEATURE_C06   7
 
#define CB_FEATURE_C07   8
 
#define CB_FEATURE_C08   9
 
#define CB_FEATURE_C09   10
 
#define CB_FEATURE_C10   11
 
#define CB_FEATURE_C11   12
 
#define CB_FEATURE_C12   13
 
#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_VALID_TREE(x)   (x && CB_TREE (x) != cb_error_node)
 
#define CB_INVALID_TREE(x)   (!(x) || CB_TREE (x) == cb_error_node)
 
#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_DIRECT(x)   (CB_TREE_CAST (CB_TAG_DIRECT, struct cb_direct, x))
 
#define CB_DIRECT_P(x)   (CB_TREE_TAG (x) == CB_TAG_DIRECT)
 
#define CB_DEBUG(x)   (CB_TREE_CAST (CB_TAG_DEBUG, struct cb_debug, x))
 
#define CB_DEBUG_P(x)   (CB_TREE_TAG (x) == CB_TAG_DEBUG)
 
#define CB_DEBUG_CALL(x)   (CB_TREE_CAST (CB_TAG_DEBUG_CALL, struct cb_debug_call, x))
 
#define CB_DEBUG_CALL_P(x)   (CB_TREE_TAG (x) == CB_TAG_DEBUG_CALL)
 
#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_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_REFERENCE_P (x) || CB_FIELD_P (x))
 
#define CB_FIELD_PTR(x)   (CB_REFERENCE_P (x) ? CB_FIELD (cb_ref (x)) : CB_FIELD (x))
 
#define CB_INDEX_P(x)   cb_check_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_TABLE_SIZE   (CB_WORD_HASH_SIZE * sizeof (struct cb_word))
 
#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_WORD_COUNT(x)   (CB_REFERENCE (x)->word->count)
 
#define CB_WORD_ITEMS(x)   (CB_REFERENCE (x)->word->items)
 
#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_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_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_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(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_CANCEL(x)   (CB_TREE_CAST (CB_TAG_CANCEL, struct cb_cancel, x))
 
#define CB_CANCEL_P(x)   (CB_TREE_TAG (x) == CB_TAG_CANCEL)
 
#define CB_ALTER(x)   (CB_TREE_CAST (CB_TAG_ALTER, struct cb_alter, x))
 
#define CB_ALTER_P(x)   (CB_TREE_TAG (x) == CB_TAG_ALTER)
 
#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_SET_ATTR(x)   (CB_TREE_CAST (CB_TAG_SET_ATTR, struct cb_set_attr, x))
 
#define CB_SET_ATTR_P(x)   (CB_TREE_TAG (x) == CB_TAG_SET_ATTR)
 
#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_SIZES_INT(x)   ((CB_LIST (x)->sizes) & 0x07)
 
#define CB_SIZES_INT_UNSIGNED(x)   ((CB_LIST (x)->sizes) & CB_SIZE_UNSIGNED)
 
#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_REPORT(x)   (CB_TREE_CAST (CB_TAG_REPORT, struct cb_report, x))
 
#define CB_REPORT_P(x)   (CB_TREE_TAG (x) == CB_TAG_REPORT)
 
#define CB_BUILD_FUNCALL_0(f)
 
#define CB_BUILD_FUNCALL_1(f, a1)
 
#define CB_BUILD_FUNCALL_2(f, a1, a2)
 
#define CB_BUILD_FUNCALL_3(f, a1, a2, a3)
 
#define CB_BUILD_FUNCALL_4(f, a1, a2, a3, a4)
 
#define CB_BUILD_FUNCALL_5(f, a1, a2, a3, a4, a5)
 
#define CB_BUILD_FUNCALL_6(f, a1, a2, a3, a4, a5, a6)
 
#define CB_BUILD_FUNCALL_7(f, a1, a2, a3, a4, a5, a6, a7)
 
#define CB_BUILD_FUNCALL_8(f, a1, a2, a3, a4, a5, a6, a7, a8)
 
#define CB_BUILD_FUNCALL_9(f, a1, a2, a3, a4, a5, a6, a7, a8, a9)
 
#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_BUILD_PARENTHESIS(x)   cb_build_binary_op (x, '@', NULL)
 
#define CB_BUILD_NEGATION(x)   cb_build_binary_op (x, '!', NULL)
 
#define CB_BUILD_STRING0(str)   cb_build_string (str, strlen ((char *)(str)))
 
#define CB_LIST_INIT(x)   cb_build_list (NULL, x, NULL)
 
#define CB_BUILD_CHAIN(x, y)   cb_build_list (NULL, x, y)
 
#define CB_BUILD_PAIR(x, y)   cb_build_list (x, y, NULL)
 
#define CB_ADD_TO_CHAIN(x, y)   y = CB_BUILD_CHAIN (x, y)
 
#define CB_CHAIN_PAIR(x, y, z)   x = cb_pair_add (x, y, z)
 
#define CB_FIELD_ADD(x, y)   x = cb_field_add (x, y)
 

Typedefs

typedef struct cb_tree_common * cb_tree
 

Enumerations

enum  cb_tag {
  CB_TAG_CONST = 0, 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_REPORT,
  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_CANCEL,
  CB_TAG_ALTER, CB_TAG_SET_ATTR, CB_TAG_PERFORM_VARYING, CB_TAG_PICTURE,
  CB_TAG_LIST, CB_TAG_DIRECT, CB_TAG_DEBUG, CB_TAG_DEBUG_CALL,
  CB_TAG_CONST = 0, 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_REPORT,
  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_CANCEL,
  CB_TAG_ALTER, CB_TAG_SET_ATTR, CB_TAG_PERFORM_VARYING, CB_TAG_PICTURE,
  CB_TAG_LIST, CB_TAG_DIRECT, CB_TAG_DEBUG, CB_TAG_DEBUG_CALL,
  CB_TAG_CONST = 0, 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_REPORT,
  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_CANCEL,
  CB_TAG_ALTER, CB_TAG_SET_ATTR, CB_TAG_PERFORM_VARYING, CB_TAG_PICTURE,
  CB_TAG_LIST, CB_TAG_DIRECT, CB_TAG_DEBUG, CB_TAG_DEBUG_CALL
}
 
enum  cb_system_name_category {
  CB_DEVICE_NAME = 0, CB_SWITCH_NAME, CB_FEATURE_NAME, CB_CALL_CONVENTION_NAME,
  CB_CODE_NAME, CB_COMPUTER_NAME, CB_ENTRY_CONVENTION_NAME, CB_EXTERNAL_LOCALE_NAME,
  CB_LIBRARY_NAME, CB_TEXT_NAME, CB_DEVICE_NAME = 0, CB_SWITCH_NAME,
  CB_FEATURE_NAME, CB_CALL_CONVENTION_NAME, CB_CODE_NAME, CB_COMPUTER_NAME,
  CB_ENTRY_CONVENTION_NAME, CB_EXTERNAL_LOCALE_NAME, CB_LIBRARY_NAME, CB_TEXT_NAME,
  CB_DEVICE_NAME = 0, CB_SWITCH_NAME, CB_FEATURE_NAME, CB_CALL_CONVENTION_NAME,
  CB_CODE_NAME, CB_COMPUTER_NAME, CB_ENTRY_CONVENTION_NAME, CB_EXTERNAL_LOCALE_NAME,
  CB_LIBRARY_NAME, CB_TEXT_NAME
}
 
enum  cb_class {
  CB_CLASS_UNKNOWN = 0, CB_CLASS_ALPHABETIC, CB_CLASS_ALPHANUMERIC, CB_CLASS_BOOLEAN,
  CB_CLASS_INDEX, CB_CLASS_NATIONAL, CB_CLASS_NUMERIC, CB_CLASS_OBJECT,
  CB_CLASS_POINTER, CB_CLASS_UNKNOWN = 0, CB_CLASS_ALPHABETIC, CB_CLASS_ALPHANUMERIC,
  CB_CLASS_BOOLEAN, CB_CLASS_INDEX, CB_CLASS_NATIONAL, CB_CLASS_NUMERIC,
  CB_CLASS_OBJECT, CB_CLASS_POINTER, CB_CLASS_UNKNOWN = 0, 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 = 0, 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, CB_CATEGORY_UNKNOWN = 0, 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, CB_CATEGORY_UNKNOWN = 0, 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 = 0, CB_STORAGE_FILE, CB_STORAGE_WORKING, CB_STORAGE_LOCAL,
  CB_STORAGE_LINKAGE, CB_STORAGE_SCREEN, CB_STORAGE_REPORT, CB_STORAGE_COMMUNICATION,
  CB_STORAGE_CONSTANT = 0, CB_STORAGE_FILE, CB_STORAGE_WORKING, CB_STORAGE_LOCAL,
  CB_STORAGE_LINKAGE, CB_STORAGE_SCREEN, CB_STORAGE_REPORT, CB_STORAGE_COMMUNICATION,
  CB_STORAGE_CONSTANT = 0, 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 = 0, 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, CB_USAGE_COMP_6,
  CB_USAGE_FP_DEC64, CB_USAGE_FP_DEC128, CB_USAGE_FP_BIN32, CB_USAGE_FP_BIN64,
  CB_USAGE_FP_BIN128, CB_USAGE_LONG_DOUBLE, CB_USAGE_BINARY = 0, 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, CB_USAGE_COMP_6, CB_USAGE_FP_DEC64, CB_USAGE_FP_DEC128,
  CB_USAGE_FP_BIN32, CB_USAGE_FP_BIN64, CB_USAGE_FP_BIN128, CB_USAGE_LONG_DOUBLE,
  CB_USAGE_BINARY = 0, 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, CB_USAGE_COMP_6,
  CB_USAGE_FP_DEC64, CB_USAGE_FP_DEC128, CB_USAGE_FP_BIN32, CB_USAGE_FP_BIN64,
  CB_USAGE_FP_BIN128, CB_USAGE_LONG_DOUBLE
}
 
enum  cb_cast_type {
  CB_CAST_INTEGER = 0, CB_CAST_LONG_INT, CB_CAST_ADDRESS, CB_CAST_ADDR_OF_ADDR,
  CB_CAST_LENGTH, CB_CAST_PROGRAM_POINTER, CB_CAST_INTEGER = 0, CB_CAST_LONG_INT,
  CB_CAST_ADDRESS, CB_CAST_ADDR_OF_ADDR, CB_CAST_LENGTH, CB_CAST_PROGRAM_POINTER,
  CB_CAST_INTEGER = 0, CB_CAST_LONG_INT, 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_CURRENCY_SYMBOL, CB_INTR_CURRENT_DATE, CB_INTR_DATE_OF_INTEGER, CB_INTR_DATE_TO_YYYYMMDD,
  CB_INTR_DAY_OF_INTEGER, CB_INTR_DAY_TO_YYYYDDD, CB_INTR_DISPLAY_OF, CB_INTR_E,
  CB_INTR_EXCEPTION_FILE, CB_INTR_EXCEPTION_FILE_N, CB_INTR_EXCEPTION_LOCATION, CB_INTR_EXCEPTION_LOCATION_N,
  CB_INTR_EXCEPTION_STATEMENT, CB_INTR_EXCEPTION_STATUS, CB_INTR_EXP, CB_INTR_EXP10,
  CB_INTR_FACTORIAL, CB_INTR_FORMATTED_CURRENT_DATE, CB_INTR_FORMATTED_DATE, CB_INTR_FORMATTED_DATETIME,
  CB_INTR_FORMATTED_TIME, CB_INTR_FRACTION_PART, CB_INTR_HIGHEST_ALGEBRAIC, CB_INTR_INTEGER,
  CB_INTR_INTEGER_OF_BOOLEAN, CB_INTR_INTEGER_OF_DATE, CB_INTR_INTEGER_OF_DAY, CB_INTR_INTEGER_OF_FORMATTED_DATE,
  CB_INTR_INTEGER_PART, CB_INTR_LENGTH, CB_INTR_LOCALE_COMPARE, CB_INTR_LOCALE_DATE,
  CB_INTR_LOCALE_TIME, CB_INTR_LOCALE_TIME_FROM_SECS, CB_INTR_LOG, CB_INTR_LOG10,
  CB_INTR_LOWER_CASE, CB_INTR_LOWEST_ALGEBRAIC, CB_INTR_MAX, CB_INTR_MEAN,
  CB_INTR_MEDIAN, CB_INTR_MIDRANGE, CB_INTR_MIN, CB_INTR_MOD,
  CB_INTR_MODULE_CALLER_ID, CB_INTR_MODULE_DATE, CB_INTR_MODULE_FORMATTED_DATE, CB_INTR_MODULE_ID,
  CB_INTR_MODULE_PATH, CB_INTR_MODULE_SOURCE, CB_INTR_MODULE_TIME, CB_INTR_MON_DECIMAL_POINT,
  CB_INTR_MON_THOUSANDS_SEP, CB_INTR_NATIONAL_OF, CB_INTR_NUM_DECIMAL_POINT, CB_INTR_NUM_THOUSANDS_SEP,
  CB_INTR_NUMVAL, CB_INTR_NUMVAL_C, CB_INTR_NUMVAL_F, CB_INTR_ORD,
  CB_INTR_ORD_MAX, CB_INTR_ORD_MIN, CB_INTR_PI, CB_INTR_PRESENT_VALUE,
  CB_INTR_RANDOM, CB_INTR_RANGE, CB_INTR_REM, CB_INTR_REVERSE,
  CB_INTR_SECONDS_FROM_FORMATTED_TIME, CB_INTR_SECONDS_PAST_MIDNIGHT, CB_INTR_SIGN, CB_INTR_SIN,
  CB_INTR_SQRT, CB_INTR_STANDARD_COMPARE, CB_INTR_STANDARD_DEVIATION, CB_INTR_STORED_CHAR_LENGTH,
  CB_INTR_SUBSTITUTE, CB_INTR_SUBSTITUTE_CASE, CB_INTR_SUM, CB_INTR_TAN,
  CB_INTR_TEST_DATE_YYYYMMDD, CB_INTR_TEST_DAY_YYYYDDD, CB_INTR_TEST_FORMATTED_DATETIME, CB_INTR_TEST_NUMVAL,
  CB_INTR_TEST_NUMVAL_C, CB_INTR_TEST_NUMVAL_F, CB_INTR_TRIM, CB_INTR_UPPER_CASE,
  CB_INTR_USER_FUNCTION, CB_INTR_VARIANCE, CB_INTR_WHEN_COMPILED, CB_INTR_YEAR_TO_YYYY,
  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_CURRENCY_SYMBOL, CB_INTR_CURRENT_DATE, CB_INTR_DATE_OF_INTEGER, CB_INTR_DATE_TO_YYYYMMDD,
  CB_INTR_DAY_OF_INTEGER, CB_INTR_DAY_TO_YYYYDDD, CB_INTR_DISPLAY_OF, CB_INTR_E,
  CB_INTR_EXCEPTION_FILE, CB_INTR_EXCEPTION_FILE_N, CB_INTR_EXCEPTION_LOCATION, CB_INTR_EXCEPTION_LOCATION_N,
  CB_INTR_EXCEPTION_STATEMENT, CB_INTR_EXCEPTION_STATUS, CB_INTR_EXP, CB_INTR_EXP10,
  CB_INTR_FACTORIAL, CB_INTR_FORMATTED_CURRENT_DATE, CB_INTR_FORMATTED_DATE, CB_INTR_FORMATTED_DATETIME,
  CB_INTR_FORMATTED_TIME, CB_INTR_FRACTION_PART, CB_INTR_HIGHEST_ALGEBRAIC, CB_INTR_INTEGER,
  CB_INTR_INTEGER_OF_BOOLEAN, CB_INTR_INTEGER_OF_DATE, CB_INTR_INTEGER_OF_DAY, CB_INTR_INTEGER_OF_FORMATTED_DATE,
  CB_INTR_INTEGER_PART, CB_INTR_LENGTH, CB_INTR_LOCALE_COMPARE, CB_INTR_LOCALE_DATE,
  CB_INTR_LOCALE_TIME, CB_INTR_LOCALE_TIME_FROM_SECS, CB_INTR_LOG, CB_INTR_LOG10,
  CB_INTR_LOWER_CASE, CB_INTR_LOWEST_ALGEBRAIC, CB_INTR_MAX, CB_INTR_MEAN,
  CB_INTR_MEDIAN, CB_INTR_MIDRANGE, CB_INTR_MIN, CB_INTR_MOD,
  CB_INTR_MODULE_CALLER_ID, CB_INTR_MODULE_DATE, CB_INTR_MODULE_FORMATTED_DATE, CB_INTR_MODULE_ID,
  CB_INTR_MODULE_PATH, CB_INTR_MODULE_SOURCE, CB_INTR_MODULE_TIME, CB_INTR_MON_DECIMAL_POINT,
  CB_INTR_MON_THOUSANDS_SEP, CB_INTR_NATIONAL_OF, CB_INTR_NUM_DECIMAL_POINT, CB_INTR_NUM_THOUSANDS_SEP,
  CB_INTR_NUMVAL, CB_INTR_NUMVAL_C, CB_INTR_NUMVAL_F, CB_INTR_ORD,
  CB_INTR_ORD_MAX, CB_INTR_ORD_MIN, CB_INTR_PI, CB_INTR_PRESENT_VALUE,
  CB_INTR_RANDOM, CB_INTR_RANGE, CB_INTR_REM, CB_INTR_REVERSE,
  CB_INTR_SECONDS_FROM_FORMATTED_TIME, CB_INTR_SECONDS_PAST_MIDNIGHT, CB_INTR_SIGN, CB_INTR_SIN,
  CB_INTR_SQRT, CB_INTR_STANDARD_COMPARE, CB_INTR_STANDARD_DEVIATION, CB_INTR_STORED_CHAR_LENGTH,
  CB_INTR_SUBSTITUTE, CB_INTR_SUBSTITUTE_CASE, CB_INTR_SUM, CB_INTR_TAN,
  CB_INTR_TEST_DATE_YYYYMMDD, CB_INTR_TEST_DAY_YYYYDDD, CB_INTR_TEST_FORMATTED_DATETIME, CB_INTR_TEST_NUMVAL,
  CB_INTR_TEST_NUMVAL_C, CB_INTR_TEST_NUMVAL_F, CB_INTR_TRIM, CB_INTR_UPPER_CASE,
  CB_INTR_USER_FUNCTION, CB_INTR_VARIANCE, CB_INTR_WHEN_COMPILED, CB_INTR_YEAR_TO_YYYY,
  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_CURRENCY_SYMBOL, CB_INTR_CURRENT_DATE, CB_INTR_DATE_OF_INTEGER, CB_INTR_DATE_TO_YYYYMMDD,
  CB_INTR_DAY_OF_INTEGER, CB_INTR_DAY_TO_YYYYDDD, CB_INTR_DISPLAY_OF, CB_INTR_E,
  CB_INTR_EXCEPTION_FILE, CB_INTR_EXCEPTION_FILE_N, CB_INTR_EXCEPTION_LOCATION, CB_INTR_EXCEPTION_LOCATION_N,
  CB_INTR_EXCEPTION_STATEMENT, CB_INTR_EXCEPTION_STATUS, CB_INTR_EXP, CB_INTR_EXP10,
  CB_INTR_FACTORIAL, CB_INTR_FORMATTED_CURRENT_DATE, CB_INTR_FORMATTED_DATE, CB_INTR_FORMATTED_DATETIME,
  CB_INTR_FORMATTED_TIME, CB_INTR_FRACTION_PART, CB_INTR_HIGHEST_ALGEBRAIC, CB_INTR_INTEGER,
  CB_INTR_INTEGER_OF_BOOLEAN, CB_INTR_INTEGER_OF_DATE, CB_INTR_INTEGER_OF_DAY, CB_INTR_INTEGER_OF_FORMATTED_DATE,
  CB_INTR_INTEGER_PART, CB_INTR_LENGTH, CB_INTR_LOCALE_COMPARE, CB_INTR_LOCALE_DATE,
  CB_INTR_LOCALE_TIME, CB_INTR_LOCALE_TIME_FROM_SECS, CB_INTR_LOG, CB_INTR_LOG10,
  CB_INTR_LOWER_CASE, CB_INTR_LOWEST_ALGEBRAIC, CB_INTR_MAX, CB_INTR_MEAN,
  CB_INTR_MEDIAN, CB_INTR_MIDRANGE, CB_INTR_MIN, CB_INTR_MOD,
  CB_INTR_MODULE_CALLER_ID, CB_INTR_MODULE_DATE, CB_INTR_MODULE_FORMATTED_DATE, CB_INTR_MODULE_ID,
  CB_INTR_MODULE_PATH, CB_INTR_MODULE_SOURCE, CB_INTR_MODULE_TIME, CB_INTR_MON_DECIMAL_POINT,
  CB_INTR_MON_THOUSANDS_SEP, CB_INTR_NATIONAL_OF, CB_INTR_NUM_DECIMAL_POINT, CB_INTR_NUM_THOUSANDS_SEP,
  CB_INTR_NUMVAL, CB_INTR_NUMVAL_C, CB_INTR_NUMVAL_F, CB_INTR_ORD,
  CB_INTR_ORD_MAX, CB_INTR_ORD_MIN, CB_INTR_PI, CB_INTR_PRESENT_VALUE,
  CB_INTR_RANDOM, CB_INTR_RANGE, CB_INTR_REM, CB_INTR_REVERSE,
  CB_INTR_SECONDS_FROM_FORMATTED_TIME, CB_INTR_SECONDS_PAST_MIDNIGHT, CB_INTR_SIGN, CB_INTR_SIN,
  CB_INTR_SQRT, CB_INTR_STANDARD_COMPARE, CB_INTR_STANDARD_DEVIATION, CB_INTR_STORED_CHAR_LENGTH,
  CB_INTR_SUBSTITUTE, CB_INTR_SUBSTITUTE_CASE, CB_INTR_SUM, CB_INTR_TAN,
  CB_INTR_TEST_DATE_YYYYMMDD, CB_INTR_TEST_DAY_YYYYDDD, CB_INTR_TEST_FORMATTED_DATETIME, CB_INTR_TEST_NUMVAL,
  CB_INTR_TEST_NUMVAL_C, CB_INTR_TEST_NUMVAL_F, CB_INTR_TRIM, CB_INTR_UPPER_CASE,
  CB_INTR_USER_FUNCTION, CB_INTR_VARIANCE, CB_INTR_WHEN_COMPILED, CB_INTR_YEAR_TO_YYYY
}
 
enum  cb_perform_type {
  CB_PERFORM_EXIT = 0, CB_PERFORM_ONCE, CB_PERFORM_TIMES, CB_PERFORM_UNTIL,
  CB_PERFORM_FOREVER, CB_PERFORM_EXIT = 0, CB_PERFORM_ONCE, CB_PERFORM_TIMES,
  CB_PERFORM_UNTIL, CB_PERFORM_FOREVER, CB_PERFORM_EXIT = 0, CB_PERFORM_ONCE,
  CB_PERFORM_TIMES, CB_PERFORM_UNTIL, CB_PERFORM_FOREVER
}
 

Functions

char * cb_name (cb_tree)
 
enum cb_class cb_tree_class (cb_tree)
 
enum cb_category cb_tree_category (cb_tree)
 
int cb_tree_type (const cb_tree, const struct cb_field *)
 
int cb_category_is_alpha (cb_tree)
 
int cb_fits_int (const cb_tree)
 
int cb_fits_long_long (const cb_tree)
 
int cb_get_int (const cb_tree)
 
cob_s64_t cb_get_long_long (const cb_tree)
 
cob_u64_t cb_get_u_long_long (const cb_tree)
 
void cb_init_constants (void)
 
cb_tree cb_int (const int)
 
cb_tree cb_int_hex (const int)
 
cb_tree cb_build_string (const void *, const size_t)
 
cb_tree cb_build_class_name (cb_tree, cb_tree)
 
cb_tree cb_build_locale_name (cb_tree, cb_tree)
 
cb_tree cb_build_numeric_literal (const int, const void *, const int)
 
cb_tree cb_build_alphanumeric_literal (const void *, const size_t)
 
cb_tree cb_build_numsize_literal (const void *, const size_t, const int)
 
cb_tree cb_concat_literals (const cb_tree, const cb_tree)
 
cb_tree cb_build_decimal (const int)
 
cb_tree cb_build_picture (const char *)
 
cb_tree cb_build_comment (const char *)
 
cb_tree cb_build_direct (const char *, const unsigned int)
 
cb_tree cb_build_debug (const cb_tree, const char *, const cb_tree)
 
cb_tree cb_build_debug_call (struct cb_label *)
 
struct cb_picture * cb_build_binary_picture (const char *, const cob_u32_t, const cob_u32_t)
 
cb_tree cb_build_field (cb_tree)
 
cb_tree cb_build_implicit_field (cb_tree, const int)
 
cb_tree cb_build_constant (cb_tree, cb_tree)
 
void cb_build_symbolic_chars (const cb_tree, const cb_tree)
 
struct cb_field * cb_field_add (struct cb_field *, struct cb_field *)
 
struct cb_field * cb_field_founder (const struct cb_field *)
 
struct cb_field * cb_field_variable_size (const struct cb_field *)
 
unsigned int cb_field_variable_address (const struct cb_field *)
 
int cb_field_subordinate (const struct cb_field *, const struct cb_field *)
 
cb_tree cb_build_label (cb_tree, struct cb_label *)
 
struct cb_file * build_file (cb_tree)
 
void validate_file (struct cb_file *, cb_tree)
 
void finalize_file (struct cb_file *, struct cb_field *)
 
cb_tree cb_build_filler (void)
 
cb_tree cb_build_reference (const char *)
 
cb_tree cb_build_field_reference (struct cb_field *, cb_tree)
 
const char * cb_define (cb_tree, cb_tree)
 
char * cb_to_cname (const char *)
 
void cb_set_system_names (void)
 
cb_tree cb_ref (cb_tree)
 
cb_tree cb_build_binary_op (cb_tree, const int, cb_tree)
 
cb_tree cb_build_binary_list (cb_tree, const int)
 
cb_tree cb_build_funcall (const char *, const int, const cb_tree, const cb_tree, const cb_tree, const cb_tree, const cb_tree, const cb_tree, const cb_tree, const cb_tree, const cb_tree, const cb_tree)
 
cb_tree cb_build_cast (const enum cb_cast_type, const cb_tree)
 
cb_tree cb_build_cast_int (const cb_tree)
 
cb_tree cb_build_cast_llint (const cb_tree)
 
cb_tree cb_build_assign (const cb_tree, const cb_tree)
 
cb_tree cb_build_intrinsic (cb_tree, cb_tree, cb_tree, const int)
 
cb_tree cb_build_any_intrinsic (cb_tree)
 
cb_tree cb_build_search (const int, const cb_tree, const cb_tree, const cb_tree, const cb_tree)
 
cb_tree cb_build_call (const cb_tree, const cb_tree, const cb_tree, const cb_tree, const cb_tree, const cob_u32_t, const int)
 
cb_tree cb_build_alter (const cb_tree, const cb_tree)
 
cb_tree cb_build_cancel (const cb_tree)
 
cb_tree cb_build_goto (const cb_tree, const cb_tree)
 
cb_tree cb_build_if (const cb_tree, const cb_tree, const cb_tree, const unsigned int)
 
cb_tree cb_build_perform (const enum cb_perform_type)
 
cb_tree cb_build_perform_varying (cb_tree, cb_tree, cb_tree, cb_tree)
 
struct cb_statement * cb_build_statement (const char *)
 
cb_tree cb_build_continue (void)
 
cb_tree cb_build_list (cb_tree, cb_tree, cb_tree)
 
cb_tree cb_list_add (cb_tree, cb_tree)
 
cb_tree cb_pair_add (cb_tree, cb_tree, cb_tree)
 
cb_tree cb_list_append (cb_tree, cb_tree)
 
cb_tree cb_list_reverse (cb_tree)
 
int cb_list_length (cb_tree)
 
struct cb_report * build_report (cb_tree)
 
void cb_add_common_prog (struct cb_program *)
 
void cb_insert_common_prog (struct cb_program *, struct cb_program *)
 
struct cb_intrinsic_table * lookup_intrinsic (const char *, const int, const int)
 
cb_tree cb_build_alphabet_name (cb_tree)
 
cb_tree cb_build_initialize (const cb_tree, const cb_tree, const cb_tree, const unsigned int, const unsigned int, const unsigned int)
 
struct cb_literal * build_literal (enum cb_category, const void *, const size_t)
 
cb_tree cb_build_system_name (const enum cb_system_name_category, const int)
 
struct cobc_reserved * lookup_reserved_word (const char *)
 
cb_tree lookup_system_name (const char *)
 
void cb_list_reserved (void)
 
void cb_list_intrinsics (void)
 
void cb_list_mnemonics (void)
 
void cb_list_system (void)
 
void cb_list_map (cb_tree(*)(cb_tree), cb_tree)
 
void cb_warning_x (cb_tree, const char *,...) COB_A_FORMAT23
 
void cb_error_x (cb_tree, const char *,...) COB_A_FORMAT23
 
void redefinition_error (cb_tree)
 
void redefinition_warning (cb_tree, cb_tree)
 
void undefined_error (cb_tree)
 
void ambiguous_error (cb_tree)
 
void group_error (cb_tree, const char *)
 
void level_redundant_error (cb_tree, const char *)
 
void level_require_error (cb_tree, const char *)
 
void level_except_error (cb_tree, const char *)
 
int cb_get_level (cb_tree)
 
cb_tree cb_build_field_tree (cb_tree, cb_tree, struct cb_field *, enum cb_storage, struct cb_file *, const int)
 
struct cb_field * cb_resolve_redefines (struct cb_field *, cb_tree)
 
void cb_validate_field (struct cb_field *)
 
void cb_validate_88_item (struct cb_field *)
 
struct cb_field * cb_validate_78_item (struct cb_field *, const cob_u32_t)
 
struct cb_field * cb_get_real_field (void)
 
void cb_clear_real_field (void)
 
struct cb_program * cb_build_program (struct cb_program *, const int)
 
cb_tree cb_check_numeric_value (cb_tree)
 
size_t cb_check_index_p (cb_tree x)
 
void cb_build_registers (void)
 
void cb_build_debug_item (void)
 
void cb_check_field_debug (cb_tree)
 
char * cb_encode_program_id (const char *)
 
char * cb_build_program_id (cb_tree, cb_tree, const cob_u32_t)
 
cb_tree cb_define_switch_name (cb_tree, cb_tree, const int)
 
cb_tree cb_build_section_name (cb_tree, const int)
 
cb_tree cb_build_assignment_name (struct cb_file *, cb_tree)
 
cb_tree cb_build_index (cb_tree, cb_tree, const unsigned int, struct cb_field *)
 
cb_tree cb_build_identifier (cb_tree, const int)
 
cb_tree cb_build_length (cb_tree)
 
cb_tree cb_build_const_length (cb_tree)
 
cb_tree cb_build_address (cb_tree)
 
cb_tree cb_build_ppointer (cb_tree)
 
void cb_validate_program_environment (struct cb_program *)
 
void cb_validate_program_data (struct cb_program *)
 
void cb_validate_program_body (struct cb_program *)
 
cb_tree cb_build_expr (cb_tree)
 
cb_tree cb_build_cond (cb_tree)
 
void cb_emit_arithmetic (cb_tree, const int, cb_tree)
 
cb_tree cb_build_add (cb_tree, cb_tree, cb_tree)
 
cb_tree cb_build_sub (cb_tree, cb_tree, cb_tree)
 
void cb_emit_corresponding (cb_tree(*)(cb_tree, cb_tree, cb_tree), cb_tree, cb_tree, cb_tree)
 
void cb_emit_move_corresponding (cb_tree, cb_tree)
 
void cb_emit_accept (cb_tree, cb_tree, struct cb_attr_struct *)
 
void cb_emit_accept_line_or_col (cb_tree, const int)
 
void cb_emit_accept_escape_key (cb_tree)
 
void cb_emit_accept_exception_status (cb_tree)
 
void cb_emit_accept_user_name (cb_tree)
 
void cb_emit_accept_date (cb_tree)
 
void cb_emit_accept_date_yyyymmdd (cb_tree)
 
void cb_emit_accept_day (cb_tree)
 
void cb_emit_accept_day_yyyyddd (cb_tree)
 
void cb_emit_accept_day_of_week (cb_tree)
 
void cb_emit_accept_time (cb_tree)
 
void cb_emit_accept_command_line (cb_tree)
 
void cb_emit_accept_environment (cb_tree)
 
void cb_emit_accept_mnemonic (cb_tree, cb_tree)
 
void cb_emit_accept_name (cb_tree, cb_tree)
 
void cb_emit_accept_arg_number (cb_tree)
 
void cb_emit_accept_arg_value (cb_tree)
 
void cb_emit_get_environment (cb_tree, cb_tree)
 
void cb_emit_allocate (cb_tree, cb_tree, cb_tree, cb_tree)
 
void cb_emit_alter (cb_tree, cb_tree)
 
void cb_emit_free (cb_tree)
 
void cb_emit_call (cb_tree, cb_tree, cb_tree, cb_tree, cb_tree, cb_tree)
 
void cb_emit_cancel (cb_tree)
 
void cb_emit_close (cb_tree, cb_tree)
 
void cb_emit_commit (void)
 
void cb_emit_continue (void)
 
void cb_emit_delete (cb_tree)
 
void cb_emit_delete_file (cb_tree)
 
void cb_emit_display (cb_tree, cb_tree, cb_tree, cb_tree, struct cb_attr_struct *)
 
cb_tree cb_build_display_mnemonic (cb_tree)
 
cb_tree cb_build_display_name (cb_tree)
 
void cb_emit_env_name (cb_tree)
 
void cb_emit_env_value (cb_tree)
 
void cb_emit_arg_number (cb_tree)
 
void cb_emit_command_line (cb_tree)
 
void cb_emit_divide (cb_tree, cb_tree, cb_tree, cb_tree)
 
void cb_emit_evaluate (cb_tree, cb_tree)
 
void cb_emit_goto (cb_tree, cb_tree)
 
void cb_emit_exit (const unsigned int)
 
void cb_emit_if (cb_tree, cb_tree, cb_tree)
 
cb_tree cb_build_if_check_break (cb_tree, cb_tree)
 
void cb_emit_initialize (cb_tree, cb_tree, cb_tree, cb_tree, cb_tree)
 
void cb_emit_inspect (cb_tree, cb_tree, cb_tree, const unsigned int)
 
void cb_init_tallying (void)
 
cb_tree cb_build_tallying_data (cb_tree)
 
cb_tree cb_build_tallying_characters (cb_tree)
 
cb_tree cb_build_tallying_all (void)
 
cb_tree cb_build_tallying_leading (void)
 
cb_tree cb_build_tallying_trailing (void)
 
cb_tree cb_build_tallying_value (cb_tree, cb_tree)
 
cb_tree cb_build_replacing_characters (cb_tree, cb_tree)
 
cb_tree cb_build_replacing_all (cb_tree, cb_tree, cb_tree)
 
cb_tree cb_build_replacing_leading (cb_tree, cb_tree, cb_tree)
 
cb_tree cb_build_replacing_first (cb_tree, cb_tree, cb_tree)
 
cb_tree cb_build_replacing_trailing (cb_tree, cb_tree, cb_tree)
 
cb_tree cb_build_converting (cb_tree, cb_tree, cb_tree)
 
cb_tree cb_build_inspect_region_start (void)
 
int validate_move (cb_tree, cb_tree, const unsigned int)
 
cb_tree cb_build_move (cb_tree, cb_tree)
 
void cb_emit_move (cb_tree, cb_tree)
 
void cb_emit_open (cb_tree, cb_tree, cb_tree)
 
void cb_emit_perform (cb_tree, cb_tree)
 
cb_tree cb_build_perform_once (cb_tree)
 
cb_tree cb_build_perform_times (cb_tree)
 
cb_tree cb_build_perform_until (cb_tree, cb_tree)
 
cb_tree cb_build_perform_forever (cb_tree)
 
cb_tree cb_build_perform_exit (struct cb_label *)
 
void cb_emit_read (cb_tree, cb_tree, cb_tree, cb_tree, cb_tree)
 
void cb_emit_ready_trace (void)
 
void cb_emit_rewrite (cb_tree, cb_tree, cb_tree)
 
void cb_emit_release (cb_tree, cb_tree)
 
void cb_emit_reset_trace (void)
 
void cb_emit_return (cb_tree, cb_tree)
 
void cb_emit_rollback (void)
 
void cb_emit_search (cb_tree, cb_tree, cb_tree, cb_tree)
 
void cb_emit_search_all (cb_tree, cb_tree, cb_tree, cb_tree)
 
void cb_emit_setenv (cb_tree, cb_tree)
 
void cb_emit_set_to (cb_tree, cb_tree)
 
void cb_emit_set_up_down (cb_tree, cb_tree, cb_tree)
 
void cb_emit_set_on_off (cb_tree, cb_tree)
 
void cb_emit_set_true (cb_tree)
 
void cb_emit_set_false (cb_tree)
 
void cb_emit_set_attribute (cb_tree, const int, const int)
 
cb_tree cb_build_set_attribute (const struct cb_field *, const int, const int)
 
void cb_emit_sort_init (cb_tree, cb_tree, cb_tree)
 
void cb_emit_sort_using (cb_tree, cb_tree)
 
void cb_emit_sort_input (cb_tree)
 
void cb_emit_sort_giving (cb_tree, cb_tree)
 
void cb_emit_sort_output (cb_tree)
 
void cb_emit_sort_finish (cb_tree)
 
void cb_emit_start (cb_tree, cb_tree, cb_tree, cb_tree)
 
void cb_emit_stop_run (cb_tree)
 
void cb_emit_string (cb_tree, cb_tree, cb_tree)
 
void cb_emit_unlock (cb_tree)
 
void cb_emit_unstring (cb_tree, cb_tree, cb_tree, cb_tree, cb_tree)
 
cb_tree cb_build_unstring_delimited (cb_tree, cb_tree)
 
cb_tree cb_build_unstring_into (cb_tree, cb_tree, cb_tree)
 
void cb_emit_write (cb_tree, cb_tree, cb_tree, cb_tree)
 
cb_tree cb_build_write_advancing_lines (cb_tree, cb_tree)
 
cb_tree cb_build_write_advancing_mnemonic (cb_tree, cb_tree)
 
cb_tree cb_build_write_advancing_page (cb_tree)
 
DECLNORET void cobc_tree_cast_error (const cb_tree, const char *, const int, const enum cb_tag) COB_A_NORETURN
 
void codegen (struct cb_program *, const int)
 
void cb_unput_dot (void)
 
void cb_add_78 (struct cb_field *)
 
void cb_reset_78 (void)
 
void cb_reset_global_78 (void)
 
struct cb_field * check_level_78 (const char *)
 

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 [COB_MAX_SUBSCRIPTS]
 
cb_tree cb_error_node
 
cb_tree cb_intr_whencomp
 
cb_tree cb_standard_error_handler
 
cb_tree cb_depend_check
 
unsigned int gen_screen_ptr
 
cb_tree cobc_printer_node
 
int non_const_word
 
unsigned int cobc_in_procedure
 
unsigned int cobc_in_repository
 
unsigned int cobc_force_literal
 
unsigned int cobc_cs_check
 
size_t cb_needs_01
 
cb_tree cb_debug_item
 
cb_tree cb_debug_line
 
cb_tree cb_debug_name
 
cb_tree cb_debug_sub_1
 
cb_tree cb_debug_sub_2
 
cb_tree cb_debug_sub_3
 
cb_tree cb_debug_contents
 

Macro Definition Documentation

#define CB_ADD_TO_CHAIN (   x,
  y 
)    y = CB_BUILD_CHAIN (x, y)

Referenced by cb_build_address(), and cb_build_identifier().

#define CB_ADD_TO_CHAIN (   x,
  y 
)    y = CB_BUILD_CHAIN (x, y)
#define CB_ADD_TO_CHAIN (   x,
  y 
)    y = CB_BUILD_CHAIN (x, y)
#define CB_AFTER   cb_int1

Referenced by output_perform_until().

#define CB_AFTER   cb_int1
#define CB_AFTER   cb_int1
#define CB_ALPHABET_ASCII   1

Referenced by cb_validate_program_environment(), output_file_allocation(), and output_param().

#define CB_ALPHABET_ASCII   1
#define CB_ALPHABET_ASCII   1
#define CB_ALPHABET_CUSTOM   3
#define CB_ALPHABET_CUSTOM   3
#define CB_ALPHABET_CUSTOM   3

Referenced by cb_validate_collating(), output_alphabet_name_definition(), output_file_allocation(), and output_param().

#define CB_ALPHABET_EBCDIC   2
#define CB_ALPHABET_EBCDIC   2
#define CB_ALPHABET_EBCDIC   2

Referenced by cb_validate_program_environment(), output_file_allocation(), and output_param().

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

Referenced by cb_build_symbolic_chars(), cb_name_1(), cb_validate_collating(), cb_validate_program_environment(), output_internal_function(), and output_param().

#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_ALPHABET_NAME_P (   x)    (CB_TREE_TAG (x) == CB_TAG_ALPHABET_NAME)

Referenced by cb_build_move(), cb_validate_collating(), cb_validate_program_environment(), output_param(), validate_inspect(), and validate_move().

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

Referenced by cb_validate_program_environment(), and output_param().

#define CB_ALTER (   x)    (CB_TREE_CAST (CB_TAG_ALTER, struct cb_alter, x))
#define CB_ALTER (   x)    (CB_TREE_CAST (CB_TAG_ALTER, struct cb_alter, x))

Referenced by output_stmt().

#define CB_ALTER (   x)    (CB_TREE_CAST (CB_TAG_ALTER, struct cb_alter, x))
#define CB_ALTER_P (   x)    (CB_TREE_TAG (x) == CB_TAG_ALTER)
#define CB_ALTER_P (   x)    (CB_TREE_TAG (x) == CB_TAG_ALTER)
#define CB_ALTER_P (   x)    (CB_TREE_TAG (x) == CB_TAG_ALTER)
#define CB_ASSIGN (   x)    (CB_TREE_CAST (CB_TAG_ASSIGN, struct cb_assign, x))
#define CB_ASSIGN (   x)    (CB_TREE_CAST (CB_TAG_ASSIGN, struct cb_assign, x))

Referenced by output_stmt().

#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_ASSIGN_P (   x)    (CB_TREE_TAG (x) == CB_TAG_ASSIGN)
#define CB_ASSIGN_P (   x)    (CB_TREE_TAG (x) == CB_TAG_ASSIGN)
#define CB_BEFORE   cb_int0
#define CB_BEFORE   cb_int0

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

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

Referenced by cb_build_cond(), cb_build_identifier(), cb_name_1(), decimal_expand(), expr_expand(), expr_reduce(), output_cond(), output_cond_debug(), output_integer(), output_long_integer(), output_param(), and search_set_keys().

#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_BINARY_OP_P (   x)    (CB_TREE_TAG (x) == CB_TAG_BINARY_OP)

Referenced by cb_build_cond(), cb_build_identifier(), cb_emit_arithmetic(), expr_expand(), expr_reduce(), and output_call().

#define CB_BINARY_OP_P (   x)    (CB_TREE_TAG (x) == CB_TAG_BINARY_OP)
#define CB_BUILD_CAST_ADDR_OF_ADDR (   x)    cb_build_cast (CB_CAST_ADDR_OF_ADDR, x)
#define CB_BUILD_CAST_ADDR_OF_ADDR (   x)    cb_build_cast (CB_CAST_ADDR_OF_ADDR, x)

Referenced by cb_emit_allocate(), and cb_emit_free().

#define CB_BUILD_CAST_ADDR_OF_ADDR (   x)    cb_build_cast (CB_CAST_ADDR_OF_ADDR, x)
#define CB_BUILD_CAST_ADDRESS (   x)    cb_build_cast (CB_CAST_ADDRESS, x)
#define CB_BUILD_CAST_ADDRESS (   x)    cb_build_cast (CB_CAST_ADDRESS, x)

Referenced by cb_build_address(), cb_build_cond(), cb_build_memset(), cb_build_move_copy(), cb_build_move_literal(), cb_build_optim_add(), cb_build_optim_cond(), cb_build_optim_sub(), cb_check_field_debug(), cb_emit_free(), and cb_emit_sort_init().

#define CB_BUILD_CAST_ADDRESS (   x)    cb_build_cast (CB_CAST_ADDRESS, x)
#define CB_BUILD_CAST_LENGTH (   x)    cb_build_cast (CB_CAST_LENGTH, x)
#define CB_BUILD_CAST_LENGTH (   x)    cb_build_cast (CB_CAST_LENGTH, x)

Referenced by cb_build_identifier(), cb_build_memset(), cb_build_move_copy(), cb_build_move_literal(), and cb_check_field_debug().

#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_BUILD_CAST_PPOINTER (   x)    cb_build_cast (CB_CAST_PROGRAM_POINTER, x)

Referenced by cb_build_ppointer().

#define CB_BUILD_CAST_PPOINTER (   x)    cb_build_cast (CB_CAST_PROGRAM_POINTER, x)
#define CB_BUILD_CHAIN (   x,
  y 
)    cb_build_list (NULL, x, y)
#define CB_BUILD_CHAIN (   x,
  y 
)    cb_build_list (NULL, x, y)
#define CB_BUILD_CHAIN (   x,
  y 
)    cb_build_list (NULL, x, y)

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

#define CB_BUILD_FUNCALL_0 (   f)
Value:
cb_build_funcall (f, 0, NULL, NULL, NULL, NULL, NULL, \
NULL, NULL, NULL, NULL, NULL)
#define CB_BUILD_FUNCALL_0 (   f)
Value:
cb_build_funcall (f, 0, NULL, NULL, NULL, NULL, NULL, \
NULL, NULL, NULL, NULL, NULL)

Referenced by cb_build_inspect_region_start(), cb_emit_commit(), cb_emit_display(), cb_emit_inspect(), cb_emit_ready_trace(), cb_emit_reset_trace(), cb_emit_rollback(), cb_emit_string(), and cb_emit_unstring().

#define CB_BUILD_FUNCALL_0 (   f)
Value:
cb_build_funcall (f, 0, NULL, NULL, NULL, NULL, NULL, \
NULL, NULL, NULL, NULL, NULL)
#define CB_BUILD_FUNCALL_1 (   f,
  a1 
)
Value:
cb_build_funcall (f, 1, a1, NULL, NULL, NULL, NULL, \
NULL, NULL, NULL, NULL, NULL)
#define CB_BUILD_FUNCALL_1 (   f,
  a1 
)
Value:
cb_build_funcall (f, 1, a1, NULL, NULL, NULL, NULL, \
NULL, NULL, NULL, NULL, NULL)

Referenced by cb_build_move_num_zero(), cb_build_replacing_characters(), cb_build_tallying_characters(), cb_check_data_incompat(), cb_define_switch_name(), cb_emit_accept(), cb_emit_accept_arg_number(), cb_emit_accept_arg_value(), cb_emit_accept_command_line(), cb_emit_accept_date(), cb_emit_accept_date_yyyymmdd(), cb_emit_accept_day(), cb_emit_accept_day_of_week(), cb_emit_accept_day_yyyyddd(), cb_emit_accept_environment(), cb_emit_accept_escape_key(), cb_emit_accept_exception_status(), cb_emit_accept_mnemonic(), cb_emit_accept_name(), cb_emit_accept_time(), cb_emit_accept_user_name(), cb_emit_arg_number(), cb_emit_command_line(), cb_emit_env_name(), cb_emit_env_value(), cb_emit_move(), cb_emit_release(), cb_emit_return(), cb_emit_sort_finish(), cb_emit_stop_run(), cb_emit_string(), cb_emit_unstring(), cb_expr_shift_class(), and decimal_expand().

#define CB_BUILD_FUNCALL_1 (   f,
  a1 
)
Value:
cb_build_funcall (f, 1, a1, NULL, NULL, NULL, NULL, \
NULL, NULL, NULL, NULL, NULL)
#define CB_BUILD_FUNCALL_2 (   f,
  a1,
  a2 
)
Value:
cb_build_funcall (f, 2, a1, a2, NULL, NULL, NULL, \
NULL, NULL, NULL, NULL, NULL)
#define CB_BUILD_FUNCALL_2 (   f,
  a1,
  a2 
)
Value:
cb_build_funcall (f, 2, a1, a2, NULL, NULL, NULL, \
NULL, NULL, NULL, NULL, NULL)

Referenced by cb_build_cond(), cb_build_converting(), cb_build_identifier(), cb_build_memset(), cb_build_move(), cb_build_move_copy(), cb_build_move_field(), cb_build_move_high(), cb_build_move_literal(), cb_build_move_low(), cb_build_move_num_zero(), cb_build_move_quote(), cb_build_move_space(), cb_build_move_zero(), cb_build_optim_add(), cb_build_optim_cond(), cb_build_optim_sub(), cb_build_replacing_all(), cb_build_replacing_first(), cb_build_replacing_leading(), cb_build_replacing_trailing(), cb_build_tallying_value(), cb_build_unstring_delimited(), cb_check_data_incompat(), cb_emit_accept_line_or_col(), cb_emit_delete(), cb_emit_delete_file(), cb_emit_divide(), cb_emit_free(), cb_emit_get_environment(), cb_emit_inspect(), cb_emit_set_on_off(), cb_emit_setenv(), cb_emit_sort_giving(), cb_emit_sort_init(), cb_emit_sort_using(), cb_emit_string(), cb_emit_unlock(), decimal_compute(), decimal_expand(), output_screen_from(), and output_screen_to().

#define CB_BUILD_FUNCALL_2 (   f,
  a1,
  a2 
)
Value:
cb_build_funcall (f, 2, a1, a2, NULL, NULL, NULL, \
NULL, NULL, NULL, NULL, NULL)
#define CB_BUILD_FUNCALL_3 (   f,
  a1,
  a2,
  a3 
)
Value:
cb_build_funcall (f, 3, a1, a2, a3, NULL, NULL, \
NULL, NULL, NULL, NULL, NULL)
#define CB_BUILD_FUNCALL_3 (   f,
  a1,
  a2,
  a3 
)
Value:
cb_build_funcall (f, 3, a1, a2, a3, NULL, NULL, \
NULL, NULL, NULL, NULL, NULL)

Referenced by cb_build_add(), cb_build_cond(), cb_build_div(), cb_build_memset(), cb_build_move_copy(), cb_build_move_literal(), cb_build_mul(), cb_build_optim_add(), cb_build_optim_sub(), cb_build_sub(), cb_build_unstring_into(), cb_check_field_debug(), cb_emit_display(), cb_emit_read(), cb_emit_sort_init(), cb_emit_unstring(), and decimal_assign().

#define CB_BUILD_FUNCALL_3 (   f,
  a1,
  a2,
  a3 
)
Value:
cb_build_funcall (f, 3, a1, a2, a3, NULL, NULL, \
NULL, NULL, NULL, NULL, NULL)
#define CB_BUILD_FUNCALL_4 (   f,
  a1,
  a2,
  a3,
  a4 
)
Value:
cb_build_funcall (f, 4, a1, a2, a3, a4, NULL, \
NULL, NULL, NULL, NULL, NULL)
#define CB_BUILD_FUNCALL_4 (   f,
  a1,
  a2,
  a3,
  a4 
)
Value:
cb_build_funcall (f, 4, a1, a2, a3, a4, NULL, \
NULL, NULL, NULL, NULL, NULL)

Referenced by cb_build_identifier(), cb_build_optim_cond(), cb_emit_accept(), cb_emit_allocate(), cb_emit_close(), cb_emit_divide(), cb_emit_open(), cb_emit_read(), cb_emit_rewrite(), and cb_emit_sort_init().

#define CB_BUILD_FUNCALL_4 (   f,
  a1,
  a2,
  a3,
  a4 
)
Value:
cb_build_funcall (f, 4, a1, a2, a3, a4, NULL, \
NULL, NULL, NULL, NULL, NULL)
#define CB_BUILD_FUNCALL_5 (   f,
  a1,
  a2,
  a3,
  a4,
  a5 
)
Value:
cb_build_funcall (f, 5, a1, a2, a3, a4, a5, \
NULL, NULL, NULL, NULL, NULL)
#define CB_BUILD_FUNCALL_5 (   f,
  a1,
  a2,
  a3,
  a4,
  a5 
)
Value:
cb_build_funcall (f, 5, a1, a2, a3, a4, a5, \
NULL, NULL, NULL, NULL, NULL)

Referenced by cb_emit_sort_init(), cb_emit_start(), and cb_emit_write().

#define CB_BUILD_FUNCALL_5 (   f,
  a1,
  a2,
  a3,
  a4,
  a5 
)
Value:
cb_build_funcall (f, 5, a1, a2, a3, a4, a5, \
NULL, NULL, NULL, NULL, NULL)
#define CB_BUILD_FUNCALL_6 (   f,
  a1,
  a2,
  a3,
  a4,
  a5,
  a6 
)
Value:
cb_build_funcall (f, 6, a1, a2, a3, a4, a5, a6, \
NULL, NULL, NULL, NULL)
#define CB_BUILD_FUNCALL_6 (   f,
  a1,
  a2,
  a3,
  a4,
  a5,
  a6 
)
Value:
cb_build_funcall (f, 6, a1, a2, a3, a4, a5, a6, \
NULL, NULL, NULL, NULL)
#define CB_BUILD_FUNCALL_6 (   f,
  a1,
  a2,
  a3,
  a4,
  a5,
  a6 
)
Value:
cb_build_funcall (f, 6, a1, a2, a3, a4, a5, a6, \
NULL, NULL, NULL, NULL)
#define CB_BUILD_FUNCALL_7 (   f,
  a1,
  a2,
  a3,
  a4,
  a5,
  a6,
  a7 
)
Value:
cb_build_funcall (f, 7, a1, a2, a3, a4, a5, a6, a7, \
NULL, NULL, NULL)
#define CB_BUILD_FUNCALL_7 (   f,
  a1,
  a2,
  a3,
  a4,
  a5,
  a6,
  a7 
)
Value:
cb_build_funcall (f, 7, a1, a2, a3, a4, a5, a6, a7, \
NULL, NULL, NULL)

Referenced by cb_emit_display().

#define CB_BUILD_FUNCALL_7 (   f,
  a1,
  a2,
  a3,
  a4,
  a5,
  a6,
  a7 
)
Value:
cb_build_funcall (f, 7, a1, a2, a3, a4, a5, a6, a7, \
NULL, NULL, NULL)
#define CB_BUILD_FUNCALL_8 (   f,
  a1,
  a2,
  a3,
  a4,
  a5,
  a6,
  a7,
  a8 
)
Value:
cb_build_funcall (f, 8, a1, a2, a3, a4, a5, a6, a7, a8, \
NULL, NULL)
#define CB_BUILD_FUNCALL_8 (   f,
  a1,
  a2,
  a3,
  a4,
  a5,
  a6,
  a7,
  a8 
)
Value:
cb_build_funcall (f, 8, a1, a2, a3, a4, a5, a6, a7, a8, \
NULL, NULL)
#define CB_BUILD_FUNCALL_8 (   f,
  a1,
  a2,
  a3,
  a4,
  a5,
  a6,
  a7,
  a8 
)
Value:
cb_build_funcall (f, 8, a1, a2, a3, a4, a5, a6, a7, a8, \
NULL, NULL)
#define CB_BUILD_FUNCALL_9 (   f,
  a1,
  a2,
  a3,
  a4,
  a5,
  a6,
  a7,
  a8,
  a9 
)
Value:
cb_build_funcall (f, 9, a1, a2, a3, a4, a5, a6, a7, a8, \
a9, NULL)
#define CB_BUILD_FUNCALL_9 (   f,
  a1,
  a2,
  a3,
  a4,
  a5,
  a6,
  a7,
  a8,
  a9 
)
Value:
cb_build_funcall (f, 9, a1, a2, a3, a4, a5, a6, a7, a8, \
a9, NULL)

Referenced by cb_emit_accept(), and cb_gen_field_accept().

#define CB_BUILD_FUNCALL_9 (   f,
  a1,
  a2,
  a3,
  a4,
  a5,
  a6,
  a7,
  a8,
  a9 
)
Value:
cb_build_funcall (f, 9, a1, a2, a3, a4, a5, a6, a7, a8, \
a9, NULL)
#define CB_BUILD_NEGATION (   x)    cb_build_binary_op (x, '!', NULL)
#define CB_BUILD_NEGATION (   x)    cb_build_binary_op (x, '!', NULL)

Referenced by cb_build_cond(), cb_define_switch_name(), cb_expr_shift_class(), cb_expr_shift_sign(), evaluate_test(), and expr_reduce().

#define CB_BUILD_NEGATION (   x)    cb_build_binary_op (x, '!', NULL)
#define CB_BUILD_PAIR (   x,
  y 
)    cb_build_list (x, y, NULL)
#define CB_BUILD_PAIR (   x,
  y 
)    cb_build_list (x, y, NULL)

Referenced by cb_build_alter(), cb_pair_add(), and emit_entry().

#define CB_BUILD_PAIR (   x,
  y 
)    cb_build_list (x, y, NULL)
#define CB_BUILD_PARENTHESIS (   x)    cb_build_binary_op (x, '@', NULL)

Referenced by cb_expr_shift().

#define CB_BUILD_PARENTHESIS (   x)    cb_build_binary_op (x, '@', NULL)
#define CB_BUILD_PARENTHESIS (   x)    cb_build_binary_op (x, '@', NULL)
#define CB_BUILD_STRING0 (   str)    cb_build_string (str, strlen ((char *)(str)))
#define CB_BUILD_STRING0 (   str)    cb_build_string (str, strlen ((char *)(str)))

Referenced by cb_build_identifier(), cb_check_data_incompat(), and decimal_expand().

#define CB_BUILD_STRING0 (   str)    cb_build_string (str, strlen ((char *)(str)))
#define CB_CALL (   x)    (CB_TREE_CAST (CB_TAG_CALL, struct cb_call, x))
#define CB_CALL (   x)    (CB_TREE_CAST (CB_TAG_CALL, struct cb_call, x))

Referenced by output_stmt().

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

Referenced by output_call(), and output_entry_function().

#define CB_CALL_BY_CONTENT   2
#define CB_CALL_BY_CONTENT   2
#define CB_CALL_BY_REFERENCE   1

Referenced by cb_emit_call(), output_call(), and output_entry_function().

#define CB_CALL_BY_REFERENCE   1
#define CB_CALL_BY_REFERENCE   1
#define CB_CALL_BY_VALUE   3

Referenced by cb_emit_call(), output_call(), and output_entry_function().

#define CB_CALL_BY_VALUE   3
#define CB_CALL_BY_VALUE   3
#define CB_CALL_P (   x)    (CB_TREE_TAG (x) == CB_TAG_CALL)
#define CB_CALL_P (   x)    (CB_TREE_TAG (x) == CB_TAG_CALL)
#define CB_CALL_P (   x)    (CB_TREE_TAG (x) == CB_TAG_CALL)
#define CB_CANCEL (   x)    (CB_TREE_CAST (CB_TAG_CANCEL, struct cb_cancel, x))
#define CB_CANCEL (   x)    (CB_TREE_CAST (CB_TAG_CANCEL, struct cb_cancel, x))

Referenced by output_stmt().

#define CB_CANCEL (   x)    (CB_TREE_CAST (CB_TAG_CANCEL, struct cb_cancel, x))
#define CB_CANCEL_P (   x)    (CB_TREE_TAG (x) == CB_TAG_CANCEL)
#define CB_CANCEL_P (   x)    (CB_TREE_TAG (x) == CB_TAG_CANCEL)
#define CB_CANCEL_P (   x)    (CB_TREE_TAG (x) == CB_TAG_CANCEL)
#define CB_CAST (   x)    (CB_TREE_CAST (CB_TAG_CAST, struct cb_cast, x))
#define CB_CAST (   x)    (CB_TREE_CAST (CB_TAG_CAST, struct cb_cast, x))

Referenced by cb_emit_free(), cb_emit_set_to(), cb_tree_category(), expr_chk_cond(), output_integer(), output_long_integer(), output_param(), and output_stmt().

#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_CAST_P (   x)    (CB_TREE_TAG (x) == CB_TAG_CAST)
#define CB_CAST_P (   x)    (CB_TREE_TAG (x) == CB_TAG_CAST)

Referenced by cb_emit_free(), cb_emit_set_to(), expr_chk_cond(), and output_call().

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

Referenced by ambiguous_error(), build_cond_88(), build_decimal_assign(), build_evaluate(), build_nested_special(), cb_build_binary_list(), cb_build_expr(), cb_build_field_tree(), cb_build_identifier(), cb_build_symbolic_chars(), cb_check_field_debug(), cb_check_lit_subs(), cb_check_needs_break(), cb_emit_arithmetic(), cb_emit_call(), cb_emit_display(), cb_emit_free(), cb_emit_goto(), cb_emit_initialize(), cb_emit_move(), cb_emit_move_corresponding(), cb_emit_set_false(), cb_emit_set_on_off(), cb_emit_set_to(), cb_emit_set_true(), cb_emit_set_up_down(), cb_emit_sort_giving(), cb_emit_sort_init(), cb_emit_sort_using(), cb_emit_string(), cb_list_append(), cb_list_length(), cb_list_map(), cb_list_reverse(), cb_name_1(), cb_ref(), cb_resolve_redefines(), cb_validate_88_item(), cb_validate_list(), cb_validate_program_body(), cb_validate_program_data(), cb_validate_program_environment(), codegen(), emit_entry(), finalize_file(), global_check(), initialize_type(), make_intrinsic(), output_call(), output_class_name_definition(), output_cond(), output_data(), output_entry_function(), output_file_error(), output_funcall(), output_funcall_debug(), output_goto(), output_initialize(), output_initialize_compound(), output_initialize_one(), output_internal_function(), output_param(), output_perform_until(), output_search_whens(), output_stmt(), validate_field_1(), and while().

#define CB_CHAIN (   x)    (CB_LIST (x)->chain)
#define CB_CHAIN_PAIR (   x,
  y,
  z 
)    x = cb_pair_add (x, y, z)
#define CB_CHAIN_PAIR (   x,
  y,
  z 
)    x = cb_pair_add (x, y, z)
#define CB_CHAIN_PAIR (   x,
  y,
  z 
)    x = cb_pair_add (x, y, z)
#define CB_CLASS_NAME (   x)    (CB_TREE_CAST (CB_TAG_CLASS_NAME, struct cb_class_name, x))

Referenced by cb_build_expr(), cb_name_1(), cb_validate_program_environment(), and codegen().

#define CB_CLASS_NAME (   x)    (CB_TREE_CAST (CB_TAG_CLASS_NAME, struct cb_class_name, x))
#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_CLASS_NAME_P (   x)    (CB_TREE_TAG (x) == CB_TAG_CLASS_NAME)
#define CB_CLASS_NAME_P (   x)    (CB_TREE_TAG (x) == CB_TAG_CLASS_NAME)
#define CB_CONST (   x)    (CB_TREE_CAST (CB_TAG_CONST, struct cb_const, x))
#define CB_CONST (   x)    (CB_TREE_CAST (CB_TAG_CONST, struct cb_const, x))

Referenced by output_integer(), output_long_integer(), output_param(), and try_get_constant_data().

#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_CONST_P (   x)    (CB_TREE_TAG (x) == CB_TAG_CONST)

Referenced by cb_concat_literals(), cb_emit_call(), cb_emit_move(), output_initialize_one(), and try_get_constant_data().

#define CB_CONST_P (   x)    (CB_TREE_TAG (x) == CB_TAG_CONST)
#define CB_CONTINUE (   x)    (CB_TREE_CAST (CB_TAG_CONTINUE, struct cb_continue, x))
#define CB_CONTINUE (   x)    (CB_TREE_CAST (CB_TAG_CONTINUE, struct cb_continue, x))
#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_CONTINUE_P (   x)    (CB_TREE_TAG (x) == CB_TAG_CONTINUE)
#define CB_CONTINUE_P (   x)    (CB_TREE_TAG (x) == CB_TAG_CONTINUE)
#define CB_CONV_CALLEE_STACK   (1 << 1)
#define CB_CONV_CALLEE_STACK   (1 << 1)
#define CB_CONV_CALLEE_STACK   (1 << 1)
#define CB_CONV_L_TO_R   (1 << 0)
#define CB_CONV_L_TO_R   (1 << 0)
#define CB_CONV_L_TO_R   (1 << 0)
#define CB_CONV_NO_RET_UPD   (1 << 2)

Referenced by output_call().

#define CB_CONV_NO_RET_UPD   (1 << 2)
#define CB_CONV_NO_RET_UPD   (1 << 2)
#define CB_CONV_OPT_LINK   (1 << 4)
#define CB_CONV_OPT_LINK   (1 << 4)
#define CB_CONV_OPT_LINK   (1 << 4)
#define CB_CONV_STATIC_LINK   (1 << 3)
#define CB_CONV_STATIC_LINK   (1 << 3)
#define CB_CONV_STATIC_LINK   (1 << 3)

Referenced by cb_emit_call(), and output_call().

#define CB_CONV_STDCALL   (1 << 6)

Referenced by cb_emit_call(), and output_call().

#define CB_CONV_STDCALL   (1 << 6)
#define CB_CONV_STDCALL   (1 << 6)
#define CB_CONV_THUNK_16   (1 << 5)
#define CB_CONV_THUNK_16   (1 << 5)
#define CB_CONV_THUNK_16   (1 << 5)
#define CB_DEBUG (   x)    (CB_TREE_CAST (CB_TAG_DEBUG, struct cb_debug, x))
#define CB_DEBUG (   x)    (CB_TREE_CAST (CB_TAG_DEBUG, struct cb_debug, x))

Referenced by output_stmt().

#define CB_DEBUG (   x)    (CB_TREE_CAST (CB_TAG_DEBUG, struct cb_debug, x))
#define CB_DEBUG_CALL (   x)    (CB_TREE_CAST (CB_TAG_DEBUG_CALL, struct cb_debug_call, x))

Referenced by output_stmt().

#define CB_DEBUG_CALL (   x)    (CB_TREE_CAST (CB_TAG_DEBUG_CALL, struct cb_debug_call, x))
#define CB_DEBUG_CALL (   x)    (CB_TREE_CAST (CB_TAG_DEBUG_CALL, struct cb_debug_call, x))
#define CB_DEBUG_CALL_P (   x)    (CB_TREE_TAG (x) == CB_TAG_DEBUG_CALL)
#define CB_DEBUG_CALL_P (   x)    (CB_TREE_TAG (x) == CB_TAG_DEBUG_CALL)
#define CB_DEBUG_CALL_P (   x)    (CB_TREE_TAG (x) == CB_TAG_DEBUG_CALL)
#define CB_DEBUG_P (   x)    (CB_TREE_TAG (x) == CB_TAG_DEBUG)
#define CB_DEBUG_P (   x)    (CB_TREE_TAG (x) == CB_TAG_DEBUG)
#define CB_DEBUG_P (   x)    (CB_TREE_TAG (x) == CB_TAG_DEBUG)
#define CB_DECIMAL (   x)    (CB_TREE_CAST (CB_TAG_DECIMAL, struct cb_decimal, x))
#define CB_DECIMAL (   x)    (CB_TREE_CAST (CB_TAG_DECIMAL, struct cb_decimal, x))

Referenced by output_param().

#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_DECIMAL_P (   x)    (CB_TREE_TAG (x) == CB_TAG_DECIMAL)
#define CB_DECIMAL_P (   x)    (CB_TREE_TAG (x) == CB_TAG_DECIMAL)
#define CB_DEVICE_CONSOLE   3

Referenced by cb_build_display_mnemonic(), cb_build_display_name(), cb_emit_accept_mnemonic(), and cb_emit_accept_name().

#define CB_DEVICE_CONSOLE   3
#define CB_DEVICE_CONSOLE   3
#define CB_DEVICE_SYSERR   2

Referenced by cb_build_display_mnemonic(), and cb_build_display_name().

#define CB_DEVICE_SYSERR   2
#define CB_DEVICE_SYSERR   2
#define CB_DEVICE_SYSIN   0
#define CB_DEVICE_SYSIN   0

Referenced by cb_emit_accept_mnemonic(), and cb_emit_accept_name().

#define CB_DEVICE_SYSIN   0
#define CB_DEVICE_SYSOUT   1

Referenced by cb_build_display_mnemonic(), and cb_build_display_name().

#define CB_DEVICE_SYSOUT   1
#define CB_DEVICE_SYSOUT   1
#define CB_DIRECT (   x)    (CB_TREE_CAST (CB_TAG_DIRECT, struct cb_direct, x))
#define CB_DIRECT (   x)    (CB_TREE_CAST (CB_TAG_DIRECT, struct cb_direct, x))

Referenced by cb_build_direct(), and output_stmt().

#define CB_DIRECT (   x)    (CB_TREE_CAST (CB_TAG_DIRECT, struct cb_direct, x))
#define CB_DIRECT_P (   x)    (CB_TREE_TAG (x) == CB_TAG_DIRECT)
#define CB_DIRECT_P (   x)    (CB_TREE_TAG (x) == CB_TAG_DIRECT)
#define CB_DIRECT_P (   x)    (CB_TREE_TAG (x) == CB_TAG_DIRECT)
#define CB_FEATURE_C01   2
#define CB_FEATURE_C01   2

Referenced by cb_build_write_advancing_mnemonic().

#define CB_FEATURE_C01   2
#define CB_FEATURE_C02   3
#define CB_FEATURE_C02   3

Referenced by cb_build_write_advancing_mnemonic().

#define CB_FEATURE_C02   3
#define CB_FEATURE_C03   4
#define CB_FEATURE_C03   4

Referenced by cb_build_write_advancing_mnemonic().

#define CB_FEATURE_C03   4
#define CB_FEATURE_C04   5

Referenced by cb_build_write_advancing_mnemonic().

#define CB_FEATURE_C04   5
#define CB_FEATURE_C04   5
#define CB_FEATURE_C05   6

Referenced by cb_build_write_advancing_mnemonic().

#define CB_FEATURE_C05   6
#define CB_FEATURE_C05   6
#define CB_FEATURE_C06   7

Referenced by cb_build_write_advancing_mnemonic().

#define CB_FEATURE_C06   7
#define CB_FEATURE_C06   7
#define CB_FEATURE_C07   8
#define CB_FEATURE_C07   8

Referenced by cb_build_write_advancing_mnemonic().

#define CB_FEATURE_C07   8
#define CB_FEATURE_C08   9

Referenced by cb_build_write_advancing_mnemonic().

#define CB_FEATURE_C08   9
#define CB_FEATURE_C08   9
#define CB_FEATURE_C09   10

Referenced by cb_build_write_advancing_mnemonic().

#define CB_FEATURE_C09   10
#define CB_FEATURE_C09   10
#define CB_FEATURE_C10   11

Referenced by cb_build_write_advancing_mnemonic().

#define CB_FEATURE_C10   11
#define CB_FEATURE_C10   11
#define CB_FEATURE_C11   12
#define CB_FEATURE_C11   12

Referenced by cb_build_write_advancing_mnemonic().

#define CB_FEATURE_C11   12
#define CB_FEATURE_C12   13
#define CB_FEATURE_C12   13

Referenced by cb_build_write_advancing_mnemonic().

#define CB_FEATURE_C12   13
#define CB_FEATURE_CONVENTION   1
#define CB_FEATURE_CONVENTION   1
#define CB_FEATURE_CONVENTION   1
#define CB_FEATURE_FORMFEED   0
#define CB_FEATURE_FORMFEED   0

Referenced by cb_build_write_advancing_mnemonic().

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

Referenced by ambiguous_error(), cb_add_const_var(), cb_build_address(), cb_build_binary_op(), cb_build_const_length(), cb_build_constant(), cb_build_debug_item(), cb_build_field_tree(), cb_build_identifier(), cb_build_implicit_field(), cb_build_index(), cb_build_length(), cb_build_length_1(), cb_build_perform_varying(), cb_build_symbolic_chars(), cb_check_field_debug(), cb_check_group_name(), cb_check_integer_value(), cb_emit_accept(), cb_emit_display(), cb_emit_rewrite(), cb_emit_set_to(), cb_emit_sort_init(), cb_emit_write(), cb_field_size(), cb_fits_int(), cb_fits_long_long(), cb_name_1(), cb_ref(), cb_tree_category(), cb_validate_one(), cb_validate_program_body(), cb_validate_program_data(), emit_entry(), evaluate_test(), finalize_file(), global_check(), output(), output_attr(), output_call(), output_data(), output_goto(), output_param(), output_perform(), output_perform_until(), output_size(), and warning_destination().

#define CB_FIELD (   x)    (CB_TREE_CAST (CB_TAG_FIELD, struct cb_field, x))
#define CB_FIELD (   x)    (CB_TREE_CAST (CB_TAG_FIELD, struct cb_field, x))
#define CB_FIELD_ADD (   x,
  y 
)    x = cb_field_add (x, y)
#define CB_FIELD_ADD (   x,
  y 
)    x = cb_field_add (x, y)
#define CB_FIELD_ADD (   x,
  y 
)    x = cb_field_add (x, y)

Referenced by cb_build_debug_item(), cb_build_index(), cb_validate_program_data(), and finalize_file().

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

Referenced by cb_build_address(), cb_build_cond(), cb_build_field_tree(), cb_build_identifier(), cb_build_perform_varying(), cb_check_field_debug(), cb_check_group_name(), cb_check_numeric_edited_name(), cb_check_numeric_name(), cb_emit_call(), cb_emit_display(), cb_emit_set_false(), cb_emit_set_true(), cb_ref(), cb_resolve_redefines(), cb_validate_one(), cb_validate_program_data(), evaluate_test(), global_check(), and output_call().

#define CB_FIELD_P (   x)    (CB_TREE_TAG (x) == CB_TAG_FIELD)
#define CB_FIELD_PTR (   x)    (CB_REFERENCE_P (x) ? CB_FIELD (cb_ref (x)) : CB_FIELD (x))
#define CB_FIELD_PTR (   x)    (CB_REFERENCE_P (x) ? CB_FIELD (cb_ref (x)) : CB_FIELD (x))

Referenced by build_cond_88(), build_store_option(), cb_build_add(), cb_build_cond(), cb_build_debug(), cb_build_div(), cb_build_identifier(), cb_build_move_copy(), cb_build_move_field(), cb_build_move_high(), cb_build_move_literal(), cb_build_move_low(), cb_build_move_num_zero(), cb_build_move_quote(), cb_build_move_space(), cb_build_move_zero(), cb_build_mul(), cb_build_optim_add(), cb_build_optim_cond(), cb_build_optim_sub(), cb_build_perform_varying(), cb_build_ppointer(), cb_build_program(), cb_build_registers(), cb_build_search_all(), cb_build_sub(), cb_check_data_incompat(), cb_check_index_p(), cb_chk_alpha_cond(), cb_chk_num_cond(), cb_emit_accept(), cb_emit_allocate(), cb_emit_call(), cb_emit_free(), cb_emit_release(), cb_emit_rewrite(), cb_emit_set_attribute(), cb_emit_set_false(), cb_emit_set_true(), cb_emit_sort_init(), cb_emit_start(), cb_emit_write(), cb_resolve_redefines(), cb_validate_program_body(), cb_validate_program_data(), check_picture_item(), check_valid_key(), decimal_expand(), emit_corresponding(), emit_move_corresponding(), expr_chk_cond(), finalize_file(), level_except_error(), level_redundant_error(), level_require_error(), output_file_allocation(), search_set_keys(), validate_field_1(), validate_inspect(), and validate_move().

#define CB_FIELD_PTR (   x)    (CB_REFERENCE_P (x) ? CB_FIELD (cb_ref (x)) : CB_FIELD (x))
#define CB_FILE (   x)    (CB_TREE_CAST (CB_TAG_FILE, struct cb_file, x))
#define CB_FILE (   x)    (CB_TREE_CAST (CB_TAG_FILE, struct cb_file, x))
#define CB_FILE (   x)    (CB_TREE_CAST (CB_TAG_FILE, struct cb_file, x))

Referenced by cb_emit_close(), cb_emit_delete(), cb_emit_delete_file(), cb_emit_open(), cb_emit_read(), cb_emit_release(), cb_emit_return(), cb_emit_rewrite(), cb_emit_sort_giving(), cb_emit_sort_init(), cb_emit_sort_using(), cb_emit_start(), cb_emit_unlock(), cb_emit_write(), cb_name_1(), cb_ref(), cb_validate_program_data(), finalize_file(), global_check(), output_ferror_stmt(), output_file_error(), output_internal_function(), output_param(), and output_stmt().

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

Referenced by cb_emit_sort_finish(), cb_emit_sort_init(), cb_ref(), global_check(), output_call(), output_param(), and validate_move().

#define CB_FILE_P (   x)    (CB_TREE_TAG (x) == CB_TAG_FILE)
#define CB_FUNCALL (   x)    (CB_TREE_CAST (CB_TAG_FUNCALL, struct cb_funcall, x))
#define CB_FUNCALL (   x)    (CB_TREE_CAST (CB_TAG_FUNCALL, struct cb_funcall, x))
#define CB_FUNCALL (   x)    (CB_TREE_CAST (CB_TAG_FUNCALL, struct cb_funcall, x))

Referenced by cb_emit_display(), cb_emit_sort_giving(), cb_name_1(), output_funcall(), and output_funcall_debug().

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

Referenced by codegen(), emit_entry(), output_entry_function(), output_goto(), output_internal_function(), output_module_init(), and while().

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

Referenced by output_stmt().

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

Referenced by build_evaluate(), and cb_check_needs_break().

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

Referenced by output_search(), and output_stmt().

#define CB_IF (   x)    (CB_TREE_CAST (CB_TAG_IF, struct cb_if, x))
#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_IF_P (   x)    (CB_TREE_TAG (x) == CB_TAG_IF)
#define CB_IF_P (   x)    (CB_TREE_TAG (x) == CB_TAG_IF)
#define CB_INDEX_P (   x)    cb_check_index_p (x)

Referenced by cb_build_add(), cb_build_cond(), cb_build_div(), cb_build_move(), cb_build_mul(), and cb_build_sub().

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

Referenced by output_stmt().

#define CB_INITIALIZE (   x)    (CB_TREE_CAST (CB_TAG_INITIALIZE, struct cb_initialize, x))
#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_INITIALIZE_P (   x)    (CB_TREE_TAG (x) == CB_TAG_INITIALIZE)
#define CB_INITIALIZE_P (   x)    (CB_TREE_TAG (x) == CB_TAG_INITIALIZE)
#define CB_INTEGER (   x)    (CB_TREE_CAST (CB_TAG_INTEGER, struct cb_integer, x))
#define CB_INTEGER (   x)    (CB_TREE_CAST (CB_TAG_INTEGER, struct cb_integer, x))

Referenced by build_store_option(), cb_build_const_length(), cb_emit_call(), cb_int_hex(), output_index(), output_integer(), and output_long_integer().

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

Referenced by cb_build_const_length(), and cb_emit_call().

#define CB_INTEGER_P (   x)    (CB_TREE_TAG (x) == CB_TAG_INTEGER)
#define CB_INTEGER_P (   x)    (CB_TREE_TAG (x) == CB_TAG_INTEGER)
#define CB_INTRINSIC (   x)    (CB_TREE_CAST (CB_TAG_INTRINSIC, struct cb_intrinsic, x))
#define CB_INTRINSIC (   x)    (CB_TREE_CAST (CB_TAG_INTRINSIC, struct cb_intrinsic, x))
#define CB_INTRINSIC (   x)    (CB_TREE_CAST (CB_TAG_INTRINSIC, struct cb_intrinsic, x))

Referenced by cb_emit_call(), cb_name_1(), cb_tree_category(), output_call_by_value_args(), and output_param().

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

Referenced by cb_build_length(), cb_build_move(), cb_emit_call(), and cb_emit_move().

#define CB_INVALID_TREE (   x)    (!(x) || CB_TREE (x) == cb_error_node)
#define CB_INVALID_TREE (   x)    (!(x) || CB_TREE (x) == cb_error_node)

Referenced by cb_get_level(), cb_ref(), and cb_validate_78_item().

#define CB_INVALID_TREE (   x)    (!(x) || CB_TREE (x) == cb_error_node)
#define CB_LABEL (   x)    (CB_TREE_CAST (CB_TAG_LABEL, struct cb_label, x))
#define CB_LABEL (   x)    (CB_TREE_CAST (CB_TAG_LABEL, struct cb_label, x))
#define CB_LABEL (   x)    (CB_TREE_CAST (CB_TAG_LABEL, struct cb_label, x))

Referenced by ambiguous_error(), build_file(), build_report(), cb_build_section_name(), cb_init_constants(), cb_name_1(), cb_ref(), cb_validate_program_body(), emit_entry(), make_constant_label(), output_alter(), output_entry_function(), output_error_handler(), output_goto_1(), output_internal_function(), output_perform(), output_perform_once(), and output_stmt().

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

Referenced by cb_build_section_name(), cb_ref(), and cb_validate_program_body().

#define CB_LABEL_P (   x)    (CB_TREE_TAG (x) == CB_TAG_LABEL)
#define CB_LIST (   x)    (CB_TREE_CAST (CB_TAG_LIST, struct cb_list, x))
#define CB_LIST (   x)    (CB_TREE_CAST (CB_TAG_LIST, struct cb_list, x))
#define CB_LIST (   x)    (CB_TREE_CAST (CB_TAG_LIST, struct cb_list, x))
#define CB_LIST_INIT (   x)    cb_build_list (NULL, x, NULL)

Referenced by cb_build_constant(), cb_build_debug_item(), cb_build_index(), cb_build_inspect_region_start(), cb_build_intrinsic(), cb_build_length(), cb_build_perform_varying(), cb_emit_read(), cb_list_add(), cb_validate_program_data(), and finalize_file().

#define CB_LIST_INIT (   x)    cb_build_list (NULL, x, NULL)
#define CB_LIST_INIT (   x)    cb_build_list (NULL, x, NULL)
#define CB_LIST_P (   x)    (CB_TREE_TAG (x) == CB_TAG_LIST)

Referenced by cb_emit_accept(), cb_gen_field_accept(), and cb_validate_program_environment().

#define CB_LIST_P (   x)    (CB_TREE_TAG (x) == CB_TAG_LIST)
#define CB_LIST_P (   x)    (CB_TREE_TAG (x) == CB_TAG_LIST)
#define CB_LITERAL (   x)    (CB_TREE_CAST (CB_TAG_LITERAL, struct cb_literal, x))
#define CB_LITERAL (   x)    (CB_TREE_CAST (CB_TAG_LITERAL, struct cb_literal, x))

Referenced by cb_build_length(), cb_build_move_literal(), cb_build_program_id(), cb_build_replacing_characters(), cb_build_symbolic_chars(), cb_check_integer_value(), cb_check_lit_subs(), cb_concat_literals(), cb_emit_accept(), cb_emit_call(), cb_emit_display(), cb_field_size(), cb_fits_int(), cb_fits_long_long(), cb_get_int(), cb_get_long_long(), cb_get_u_long_long(), cb_name_1(), cb_validate_collating(), cb_validate_program_data(), cb_validate_program_environment(), check_78_replace(), check_picture_item(), codegen(), decimal_expand(), get_value(), literal_value(), lookup_literal(), output_attr(), output_bin_field(), output_call(), output_call_by_value_args(), output_cancel(), output_class_name_definition(), output_data(), output_funcall(), output_initialize_one(), output_size(), scan_z(), try_get_constant_data(), validate_inspect(), validate_move(), and while().

#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_LITERAL_P (   x)    (CB_TREE_TAG (x) == CB_TAG_LITERAL)

Referenced by cb_build_identifier(), cb_build_intrinsic(), cb_build_length(), cb_build_locale_name(), cb_build_move(), cb_build_program_id(), cb_build_replacing_characters(), cb_build_write_advancing_lines(), cb_check_lit_subs(), cb_chk_alpha_cond(), cb_concat_literals(), cb_emit_accept(), cb_emit_call(), cb_emit_display(), cb_emit_move(), cb_field_size(), cb_get_int(), cb_get_long_long(), cb_validate_program_environment(), check_78_replace(), move_warning(), output_call(), output_cancel(), output_funcall(), output_initialize_one(), try_get_constant_data(), and validate_inspect().

#define CB_LITERAL_P (   x)    (CB_TREE_TAG (x) == CB_TAG_LITERAL)
#define CB_LOCALE_NAME (   x)    (CB_TREE_CAST (CB_TAG_LOCALE_NAME, struct cb_locale_name, x))
#define CB_LOCALE_NAME (   x)    (CB_TREE_CAST (CB_TAG_LOCALE_NAME, struct cb_locale_name, x))

Referenced by cb_name_1(), and output_param().

#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_LOCALE_NAME_P (   x)    (CB_TREE_TAG (x) == CB_TAG_LOCALE_NAME)

Referenced by cb_validate_program_environment(), and output_param().

#define CB_LOCALE_NAME_P (   x)    (CB_TREE_TAG (x) == CB_TAG_LOCALE_NAME)
#define CB_NAME (   x)    (CB_REFERENCE (x)->word->name)
#define CB_NAME (   x)    (CB_REFERENCE (x)->word->name)
#define CB_NAME (   x)    (CB_REFERENCE (x)->word->name)

Referenced by ambiguous_error(), cb_build_assignment_name(), cb_build_display_name(), cb_build_intrinsic(), cb_build_program_id(), cb_emit_accept_name(), cb_emit_call(), cb_get_level(), cb_ref(), cb_resolve_redefines(), cb_validate_program_data(), file_error(), global_check(), and undefined_error().

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

Referenced by cb_build_locale_name(), cb_emit_call(), cb_validate_program_environment(), check_picture_item(), output_bin_field(), output_call(), and output_class_name_definition().

#define CB_NUMERIC_LITERAL_P (   x)    (CB_LITERAL_P (x) && CB_TREE_CATEGORY (x) == CB_CATEGORY_NUMERIC)
#define CB_PAIR_P (   x)    (CB_LIST_P (x) && CB_PAIR_X (x))

Referenced by build_cond_88(), cb_emit_display(), cb_emit_perform(), cb_emit_set_false(), cb_emit_set_true(), cb_emit_string(), cb_validate_program_environment(), output_class_name_definition(), output_perform_once(), and validate_field_1().

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

Referenced by build_cond_88(), cb_build_intrinsic(), cb_emit_accept(), cb_emit_display(), cb_emit_set_false(), cb_emit_set_true(), cb_emit_string(), cb_gen_field_accept(), cb_validate_program_environment(), evaluate_test(), make_intrinsic(), output_class_name_definition(), and output_perform_once().

#define CB_PAIR_X (   x)    CB_PURPOSE (x)
#define CB_PAIR_Y (   x)    CB_VALUE (x)
#define CB_PAIR_Y (   x)    CB_VALUE (x)

Referenced by build_cond_88(), cb_build_intrinsic(), cb_emit_accept(), cb_emit_display(), cb_gen_field_accept(), cb_validate_program_environment(), evaluate_test(), make_intrinsic(), output_class_name_definition(), and output_perform_once().

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

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

#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_PERFORM_P (   x)    (CB_TREE_TAG (x) == CB_TAG_PERFORM)
#define CB_PERFORM_P (   x)    (CB_TREE_TAG (x) == CB_TAG_PERFORM)
#define CB_PERFORM_VARYING (   x)    (CB_TREE_CAST (CB_TAG_PERFORM_VARYING, struct cb_perform_varying, x))

Referenced by output_perform(), and output_perform_until().

#define CB_PERFORM_VARYING (   x)    (CB_TREE_CAST (CB_TAG_PERFORM_VARYING, struct cb_perform_varying, x))
#define CB_PERFORM_VARYING (   x)    (CB_TREE_CAST (CB_TAG_PERFORM_VARYING, struct cb_perform_varying, x))
#define CB_PICTURE (   x)    (CB_TREE_CAST (CB_TAG_PICTURE, struct cb_picture, x))
#define CB_PICTURE (   x)    (CB_TREE_CAST (CB_TAG_PICTURE, struct cb_picture, x))
#define CB_PICTURE (   x)    (CB_TREE_CAST (CB_TAG_PICTURE, struct cb_picture, x))

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

#define CB_PICTURE_P (   x)    (CB_TREE_TAG (x) == CB_TAG_PICTURE)
#define CB_PICTURE_P (   x)    (CB_TREE_TAG (x) == CB_TAG_PICTURE)
#define CB_PICTURE_P (   x)    (CB_TREE_TAG (x) == CB_TAG_PICTURE)
#define CB_PREFIX_ATTR   "a_" /* Field attribute (cob_field_attr) */

Referenced by codegen(), output_alphabet_name_definition(), output_attr(), and output_bin_field().

#define CB_PREFIX_ATTR   "a_" /* Field attribute (cob_field_attr) */
#define CB_PREFIX_ATTR   "a_" /* Field attribute (cob_field_attr) */
#define CB_PREFIX_BASE   "b_" /* Base address (unsigned char *) */

Referenced by codegen(), output_base(), output_entry_function(), output_integer(), output_internal_function(), and output_long_integer().

#define CB_PREFIX_BASE   "b_" /* Base address (unsigned char *) */
#define CB_PREFIX_BASE   "b_" /* Base address (unsigned char *) */
#define CB_PREFIX_CONST   "c_" /* Constant or literal (cob_field) */
#define CB_PREFIX_CONST   "c_" /* Constant or literal (cob_field) */
#define CB_PREFIX_CONST   "c_" /* Constant or literal (cob_field) */

Referenced by codegen(), and output_param().

#define CB_PREFIX_DECIMAL   "d_" /* Decimal number (cob_decimal) */
#define CB_PREFIX_DECIMAL   "d_" /* Decimal number (cob_decimal) */
#define CB_PREFIX_DECIMAL   "d_" /* Decimal number (cob_decimal) */
#define CB_PREFIX_FIELD   "f_" /* Field (cob_field) */

Referenced by codegen(), output_alphabet_name_definition(), output_internal_function(), output_param(), and output_size().

#define CB_PREFIX_FIELD   "f_" /* Field (cob_field) */
#define CB_PREFIX_FIELD   "f_" /* Field (cob_field) */
#define CB_PREFIX_FILE   "h_" /* File (cob_file) */
#define CB_PREFIX_FILE   "h_" /* File (cob_file) */
#define CB_PREFIX_FILE   "h_" /* File (cob_file) */

Referenced by output_file_allocation(), output_file_initialization(), output_internal_function(), and output_param().

#define CB_PREFIX_KEYS   "k_" /* File keys (cob_file_key []) */
#define CB_PREFIX_KEYS   "k_" /* File keys (cob_file_key []) */

Referenced by output_file_allocation(), output_file_initialization(), and output_internal_function().

#define CB_PREFIX_KEYS   "k_" /* File keys (cob_file_key []) */
#define CB_PREFIX_LABEL   "l_" /* Label */
#define CB_PREFIX_LABEL   "l_" /* Label */

Referenced by cb_emit_evaluate(), output_alter(), output_alter_check(), output_goto_1(), output_internal_function(), output_perform_call(), and output_stmt().

#define CB_PREFIX_LABEL   "l_" /* Label */
#define CB_PREFIX_SEQUENCE   "s_" /* Collating sequence */
#define CB_PREFIX_SEQUENCE   "s_" /* Collating sequence */
#define CB_PREFIX_SEQUENCE   "s_" /* Collating sequence */

Referenced by output_alphabet_name_definition(), and output_param().

#define CB_PREFIX_STRING   "st_" /* String */
#define CB_PREFIX_STRING   "st_" /* String */

Referenced by codegen(), output_internal_function(), output_section_info(), output_stmt(), and output_trace_info().

#define CB_PREFIX_STRING   "st_" /* String */
#define CB_PROGRAM_TYPE   0
#define CB_PROGRAM_TYPE   0

Referenced by codegen(), output_internal_function(), and output_perform_exit().

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

Referenced by build_decimal_assign(), build_nested_special(), cb_build_symbolic_chars(), cb_check_field_debug(), cb_emit_arithmetic(), cb_emit_divide(), cb_emit_sort_init(), cb_validate_program_body(), cb_validate_program_environment(), emit_entry(), output_entry_function(), and output_internal_function().

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

Referenced by cb_build_expr(), cb_emit_call(), evaluate_test(), initialize_type(), output_call(), output_entry_function(), and output_initialize_one().

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

Referenced by cb_build_add(), cb_build_binary_op(), cb_build_cond(), cb_build_div(), cb_build_intrinsic(), cb_build_length(), cb_build_mul(), cb_build_optim_add(), cb_build_optim_cond(), cb_build_optim_sub(), cb_build_sub(), cb_check_data_incompat(), cb_check_index_p(), cb_chk_alpha_cond(), cb_chk_num_cond(), cb_emit_accept(), cb_emit_display(), cb_emit_free(), cb_emit_release(), cb_emit_rewrite(), cb_emit_set_attribute(), cb_emit_write(), cb_validate_program_data(), expr_chk_cond(), output_call(), output_cond_debug(), output_funcall_debug(), search_set_keys(), and validate_inspect().

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

Referenced by ambiguous_error(), cb_build_address(), cb_build_const_length(), cb_build_field_reference(), cb_build_field_tree(), cb_build_filler(), cb_build_identifier(), cb_build_length(), cb_build_move(), cb_check_field_debug(), cb_check_group_name(), cb_check_overlapping(), cb_define(), cb_emit_alter(), cb_emit_call(), cb_emit_display(), cb_emit_move(), cb_emit_set_false(), cb_emit_set_true(), cb_field_size(), cb_fits_int(), cb_fits_long_long(), cb_name_1(), cb_ref(), cb_resolve_redefines(), cb_tree_category(), cb_validate_program_body(), evaluate_test(), global_check(), output(), output_alter(), output_attr(), output_call(), output_data(), output_figurative(), output_initialize(), output_initialize_compound(), output_initialize_literal(), output_initialize_one(), output_initialize_uniform(), output_param(), output_size(), output_stmt(), redefinition_error(), redefinition_warning(), undefined_error(), validate_inspect(), validate_move(), and warning_destination().

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

Referenced by cb_build_address(), cb_build_const_length(), cb_build_length(), cb_build_move(), cb_build_ppointer(), cb_check_group_name(), cb_check_numeric_edited_name(), cb_check_numeric_name(), cb_check_overlapping(), cb_emit_allocate(), cb_emit_call(), cb_emit_move(), cb_emit_set_false(), cb_emit_set_to(), cb_emit_set_true(), cb_validate_one(), cb_validate_program_data(), evaluate_test(), output(), output_call(), output_figurative(), output_initialize_literal(), output_initialize_uniform(), search_set_keys(), and validate_move().

#define CB_REPORT (   x)    (CB_TREE_CAST (CB_TAG_REPORT, struct cb_report, x))
#define CB_REPORT (   x)    (CB_TREE_CAST (CB_TAG_REPORT, struct cb_report, x))
#define CB_REPORT (   x)    (CB_TREE_CAST (CB_TAG_REPORT, struct cb_report, x))

Referenced by cb_validate_program_data().

#define CB_REPORT_P (   x)    (CB_TREE_TAG (x) == CB_TAG_REPORT)
#define CB_REPORT_P (   x)    (CB_TREE_TAG (x) == CB_TAG_REPORT)
#define CB_REPORT_P (   x)    (CB_TREE_TAG (x) == CB_TAG_REPORT)
#define CB_SEARCH (   x)    (CB_TREE_CAST (CB_TAG_SEARCH, struct cb_search, x))

Referenced by output_stmt().

#define CB_SEARCH (   x)    (CB_TREE_CAST (CB_TAG_SEARCH, struct cb_search, x))
#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_SEARCH_P (   x)    (CB_TREE_TAG (x) == CB_TAG_SEARCH)
#define CB_SEARCH_P (   x)    (CB_TREE_TAG (x) == CB_TAG_SEARCH)
#define CB_SET_ATTR (   x)    (CB_TREE_CAST (CB_TAG_SET_ATTR, struct cb_set_attr, x))
#define CB_SET_ATTR (   x)    (CB_TREE_CAST (CB_TAG_SET_ATTR, struct cb_set_attr, x))

Referenced by output_stmt().

#define CB_SET_ATTR (   x)    (CB_TREE_CAST (CB_TAG_SET_ATTR, struct cb_set_attr, x))
#define CB_SET_ATTR_P (   x)    (CB_TREE_TAG (x) == CB_TAG_SET_ATTR)
#define CB_SET_ATTR_P (   x)    (CB_TREE_TAG (x) == CB_TAG_SET_ATTR)
#define CB_SET_ATTR_P (   x)    (CB_TREE_TAG (x) == CB_TAG_SET_ATTR)
#define CB_SIZE_1   1
#define CB_SIZE_1   1

Referenced by cb_emit_call(), output_call_by_value_args(), and output_entry_function().

#define CB_SIZE_1   1
#define CB_SIZE_2   2

Referenced by cb_emit_call(), output_call_by_value_args(), and output_entry_function().

#define CB_SIZE_2   2
#define CB_SIZE_2   2
#define CB_SIZE_4   3
#define CB_SIZE_4   3
#define CB_SIZE_4   3

Referenced by cb_emit_call(), output_call_by_value_args(), and output_entry_function().

#define CB_SIZE_8   4
#define CB_SIZE_8   4

Referenced by cb_emit_call(), output_call_by_value_args(), and output_entry_function().

#define CB_SIZE_8   4
#define CB_SIZE_AUTO   0
#define CB_SIZE_AUTO   0

Referenced by cb_emit_call(), and output_call_by_value_args().

#define CB_SIZE_AUTO   0
#define CB_SIZE_UNSIGNED   8

Referenced by output_entry_function().

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

Referenced by output_entry_function().

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

Referenced by cb_emit_call(), output_call_by_value_args(), and output_entry_function().

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

Referenced by cb_emit_call(), and output_call_by_value_args().

#define CB_SIZES_INT_UNSIGNED (   x)    ((CB_LIST (x)->sizes) & CB_SIZE_UNSIGNED)
#define CB_STATEMENT (   x)    (CB_TREE_CAST (CB_TAG_STATEMENT, struct cb_statement, x))
#define CB_STATEMENT (   x)    (CB_TREE_CAST (CB_TAG_STATEMENT, struct cb_statement, x))

Referenced by build_evaluate(), cb_check_needs_break(), and output_stmt().

#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_STATEMENT_P (   x)    (CB_TREE_TAG (x) == CB_TAG_STATEMENT)
#define CB_STATEMENT_P (   x)    (CB_TREE_TAG (x) == CB_TAG_STATEMENT)

Referenced by build_evaluate(), and cb_check_needs_break().

#define CB_STRING (   x)    (CB_TREE_CAST (CB_TAG_STRING, struct cb_string, x))
#define CB_STRING (   x)    (CB_TREE_CAST (CB_TAG_STRING, struct cb_string, x))
#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_STRING_P (   x)    (CB_TREE_TAG (x) == CB_TAG_STRING)
#define CB_STRING_P (   x)    (CB_TREE_TAG (x) == CB_TAG_STRING)
#define CB_SWITCH_0   0
#define CB_SWITCH_0   0
#define CB_SWITCH_0   0
#define CB_SWITCH_1   1
#define CB_SWITCH_1   1
#define CB_SWITCH_1   1
#define CB_SWITCH_10   10
#define CB_SWITCH_10   10
#define CB_SWITCH_10   10
#define CB_SWITCH_11   11
#define CB_SWITCH_11   11
#define CB_SWITCH_11   11
#define CB_SWITCH_12   12
#define CB_SWITCH_12   12
#define CB_SWITCH_12   12
#define CB_SWITCH_13   13
#define CB_SWITCH_13   13
#define CB_SWITCH_13   13
#define CB_SWITCH_14   14
#define CB_SWITCH_14   14
#define CB_SWITCH_14   14
#define CB_SWITCH_15   15
#define CB_SWITCH_15   15
#define CB_SWITCH_15   15
#define CB_SWITCH_2   2
#define CB_SWITCH_2   2
#define CB_SWITCH_2   2
#define CB_SWITCH_3   3
#define CB_SWITCH_3   3
#define CB_SWITCH_3   3
#define CB_SWITCH_4   4
#define CB_SWITCH_4   4
#define CB_SWITCH_4   4
#define CB_SWITCH_5   5
#define CB_SWITCH_5   5
#define CB_SWITCH_5   5
#define CB_SWITCH_6   6
#define CB_SWITCH_6   6
#define CB_SWITCH_6   6
#define CB_SWITCH_7   7
#define CB_SWITCH_7   7
#define CB_SWITCH_7   7
#define CB_SWITCH_8   8
#define CB_SWITCH_8   8
#define CB_SWITCH_8   8
#define CB_SWITCH_9   9
#define CB_SWITCH_9   9
#define CB_SWITCH_9   9
#define CB_SYSTEM_NAME (   x)    (CB_TREE_CAST (CB_TAG_SYSTEM_NAME, struct cb_system_name, x))

Referenced by cb_build_display_mnemonic(), cb_build_display_name(), cb_build_write_advancing_mnemonic(), cb_define_switch_name(), cb_emit_accept_mnemonic(), cb_emit_accept_name(), and cb_emit_set_on_off().

#define CB_SYSTEM_NAME (   x)    (CB_TREE_CAST (CB_TAG_SYSTEM_NAME, struct cb_system_name, x))
#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_SYSTEM_NAME_P (   x)    (CB_TREE_TAG (x) == CB_TAG_SYSTEM_NAME)
#define CB_SYSTEM_NAME_P (   x)    (CB_TREE_TAG (x) == CB_TAG_SYSTEM_NAME)

Referenced by build_nested_special(), and while().

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

Referenced by ambiguous_error(), begin_implicit_statement(), begin_statement(), build_file(), build_report(), cb_build_alphabet_name(), cb_build_alphanumeric_literal(), cb_build_alter(), cb_build_assign(), cb_build_binary_op(), cb_build_call(), cb_build_cancel(), cb_build_cast(), cb_build_cast_int(), cb_build_cast_llint(), cb_build_class_name(), cb_build_comment(), cb_build_cond(), cb_build_continue(), cb_build_debug(), cb_build_debug_call(), cb_build_decimal(), cb_build_field(), cb_build_field_reference(), cb_build_field_tree(), cb_build_funcall(), cb_build_goto(), cb_build_if(), cb_build_initialize(), cb_build_label(), cb_build_list(), cb_build_locale_name(), cb_build_move(), cb_build_numeric_literal(), cb_build_numsize_literal(), cb_build_perform(), cb_build_perform_exit(), cb_build_perform_varying(), cb_build_picture(), cb_build_reference(), cb_build_replacing_characters(), cb_build_search(), cb_build_set_attribute(), cb_build_string(), cb_build_system_name(), cb_build_tallying_all(), cb_build_tallying_characters(), cb_build_tallying_leading(), cb_build_tallying_trailing(), cb_concat_literals(), cb_emit_allocate(), cb_emit_call(), cb_emit_close(), cb_emit_delete(), cb_emit_delete_file(), cb_emit_free(), cb_emit_goto(), cb_emit_inspect(), cb_emit_move(), cb_emit_open(), cb_emit_read(), cb_emit_release(), cb_emit_rewrite(), cb_emit_set_attribute(), cb_emit_set_to(), cb_emit_sort_giving(), cb_emit_sort_using(), cb_emit_start(), cb_emit_write(), cb_int(), cb_resolve_redefines(), cb_tree_category(), cb_validate_78_item(), cb_validate_88_item(), cb_validate_program_data(), check_valid_key(), compute_size(), emit_entry(), evaluate_test(), initialize_type(), initialize_uniform_char(), make_constant(), make_constant_label(), make_intrinsic(), output_file_initialization(), output_screen_from(), output_screen_to(), output_section_info(), search_set_keys(), setup_use_file(), terminator_error(), validate_field_1(), validate_field_value(), validate_inspect(), and warning_destination().

#define CB_TREE (   x)    ((struct cb_tree_common *) (x))
#define CB_TREE (   x)    ((struct cb_tree_common *) (x))
#define CB_TREE_CAST (   tg,
  ty,
  x 
)    ((ty *) (x))
#define CB_TREE_CAST (   tg,
  ty,
  x 
)    ((ty *) (x))
#define CB_TREE_CAST (   tg,
  ty,
  x 
)    ((ty *) (x))
#define CB_TREE_CATEGORY (   x)    cb_tree_category (CB_TREE (x))

Referenced by cb_build_binary_op(), cb_build_cond(), cb_build_move(), cb_build_move_field(), cb_build_move_high(), cb_build_move_literal(), cb_build_move_low(), cb_build_move_quote(), cb_build_move_space(), cb_build_move_zero(), cb_category_is_alpha(), cb_check_data_incompat(), cb_check_integer_value(), cb_check_numeric_edited_name(), cb_check_numeric_name(), cb_check_numeric_value(), cb_chk_alpha_cond(), cb_chk_num_cond(), cb_emit_inspect(), cb_tree_class(), cb_tree_type(), initialize_type(), output_call(), output_initialize_one(), and validate_move().

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

Referenced by cb_build_add(), cb_build_binary_op(), cb_build_cond(), cb_build_move(), cb_build_sub(), cb_chk_num_cond(), cb_emit_allocate(), cb_emit_call(), cb_emit_free(), cb_emit_set_to(), cb_name_1(), cb_validate_88_item(), codegen(), expr_reduce(), get_value(), literal_value(), lookup_literal(), output_attr(), output_call(), output_call_by_value_args(), output_data(), output_entry_function(), output_initialize_one(), output_stmt(), and validate_move().

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

Referenced by ambiguous_error(), cb_build_assignment_name(), cb_build_cond(), cb_check_integer_value(), cb_emit_display(), cb_emit_inspect(), cb_field_size(), cb_fits_int(), cb_fits_long_long(), cb_name_1(), cb_ref(), cb_tree_category(), cb_validate_program_body(), cobc_tree_cast_error(), decimal_expand(), make_intrinsic(), output_attr(), output_call(), output_call_by_value_args(), output_cond(), output_cond_debug(), output_data(), output_index(), output_integer(), output_long_integer(), output_param(), output_size(), output_stmt(), validate_inspect(), and validate_move().

#define CB_VALID_TREE (   x)    (x && CB_TREE (x) != cb_error_node)
#define CB_VALID_TREE (   x)    (x && CB_TREE (x) != cb_error_node)
#define CB_VALID_TREE (   x)    (x && CB_TREE (x) != cb_error_node)

Referenced by cb_validate_88_item(), cb_validate_program_data(), and emit_entry().

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

Referenced by ambiguous_error(), build_cond_88(), build_decimal_assign(), build_evaluate(), build_nested_special(), cb_add_78(), cb_add_const_var(), cb_build_binary_list(), cb_build_expr(), cb_build_field_tree(), cb_build_identifier(), cb_build_intrinsic(), cb_build_section_name(), cb_build_symbolic_chars(), cb_check_field_debug(), cb_check_lit_subs(), cb_check_needs_break(), cb_emit_arithmetic(), cb_emit_call(), cb_emit_display(), cb_emit_divide(), cb_emit_free(), cb_emit_goto(), cb_emit_initialize(), cb_emit_move(), cb_emit_move_corresponding(), cb_emit_set_false(), cb_emit_set_on_off(), cb_emit_set_to(), cb_emit_set_true(), cb_emit_set_up_down(), cb_emit_sort_giving(), cb_emit_sort_init(), cb_emit_sort_using(), cb_emit_string(), cb_list_map(), cb_name_1(), cb_ref(), cb_resolve_redefines(), cb_validate_78_item(), cb_validate_88_item(), cb_validate_list(), cb_validate_program_body(), cb_validate_program_data(), cb_validate_program_environment(), check_picture_item(), codegen(), emit_entry(), evaluate_test(), finalize_file(), global_check(), make_intrinsic(), output_call(), output_class_name_definition(), output_cond(), output_data(), output_entry_function(), output_file_error(), output_funcall(), output_funcall_debug(), output_goto(), output_initialize_one(), output_internal_function(), output_param(), output_perform(), output_perform_until(), output_search_all(), output_search_whens(), output_stmt(), redefinition_error(), redefinition_warning(), valid_const_date_time_args(), validate_field_1(), validate_field_value(), and while().

#define CB_VALUE (   x)    (CB_LIST (x)->value)
#define CB_VALUE (   x)    (CB_LIST (x)->value)
#define CB_WORD_COUNT (   x)    (CB_REFERENCE (x)->word->count)
#define CB_WORD_COUNT (   x)    (CB_REFERENCE (x)->word->count)

Referenced by cb_build_section_name(), cb_check_field_debug(), cb_define_system_name(), cb_ref(), cb_validate_program_data(), global_check(), and while().

#define CB_WORD_COUNT (   x)    (CB_REFERENCE (x)->word->count)
#define CB_WORD_HASH_MASK   (CB_WORD_HASH_SIZE - 1U)
#define CB_WORD_HASH_MASK   (CB_WORD_HASH_SIZE - 1U)
#define CB_WORD_HASH_MASK   (CB_WORD_HASH_SIZE - 1U)

Referenced by hash().

#define CB_WORD_HASH_SIZE   (1U << 11)
#define CB_WORD_HASH_SIZE   (1U << 11)
#define CB_WORD_HASH_SIZE   (1U << 11)

Referenced by hash().

#define CB_WORD_ITEMS (   x)    (CB_REFERENCE (x)->word->items)
#define CB_WORD_ITEMS (   x)    (CB_REFERENCE (x)->word->items)
#define CB_WORD_ITEMS (   x)    (CB_REFERENCE (x)->word->items)

Referenced by cb_build_section_name(), cb_check_field_debug(), and while().

#define CB_WORD_TABLE_SIZE   (CB_WORD_HASH_SIZE * sizeof (struct cb_word))
#define CB_WORD_TABLE_SIZE   (CB_WORD_HASH_SIZE * sizeof (struct cb_word))
#define CB_WORD_TABLE_SIZE   (CB_WORD_HASH_SIZE * sizeof (struct cb_word))

Referenced by cb_build_program().

#define COB_MAX_SUBSCRIPTS   16
#define COB_MAX_SUBSCRIPTS   16
#define COB_MAX_SUBSCRIPTS   16

Typedef Documentation

typedef struct cb_tree_common* cb_tree

Enumeration Type Documentation

enum cb_cast_type
Enumerator
CB_CAST_INTEGER 
CB_CAST_LONG_INT 
CB_CAST_ADDRESS 
CB_CAST_ADDR_OF_ADDR 
CB_CAST_LENGTH 
CB_CAST_PROGRAM_POINTER 
CB_CAST_INTEGER 
CB_CAST_LONG_INT 
CB_CAST_ADDRESS 
CB_CAST_ADDR_OF_ADDR 
CB_CAST_LENGTH 
CB_CAST_PROGRAM_POINTER 
CB_CAST_INTEGER 
CB_CAST_LONG_INT 
CB_CAST_ADDRESS 
CB_CAST_ADDR_OF_ADDR 
CB_CAST_LENGTH 
CB_CAST_PROGRAM_POINTER 
267  {
268  CB_CAST_INTEGER = 0, /* 0 */
269  CB_CAST_LONG_INT, /* 1 */
270  CB_CAST_ADDRESS, /* 2 */
271  CB_CAST_ADDR_OF_ADDR, /* 3 */
272  CB_CAST_LENGTH, /* 4 */
273  CB_CAST_PROGRAM_POINTER /* 5 */
274 };
enum cb_category
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 
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 
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 
203  {
204  CB_CATEGORY_UNKNOWN = 0, /* 0 */
205  CB_CATEGORY_ALPHABETIC, /* 1 */
206  CB_CATEGORY_ALPHANUMERIC, /* 2 */
207  CB_CATEGORY_ALPHANUMERIC_EDITED, /* 3 */
208  CB_CATEGORY_BOOLEAN, /* 4 */
209  CB_CATEGORY_INDEX, /* 5 */
210  CB_CATEGORY_NATIONAL, /* 6 */
211  CB_CATEGORY_NATIONAL_EDITED, /* 7 */
212  CB_CATEGORY_NUMERIC, /* 8 */
213  CB_CATEGORY_NUMERIC_EDITED, /* 9 */
214  CB_CATEGORY_OBJECT_REFERENCE, /* 10 */
215  CB_CATEGORY_DATA_POINTER, /* 11 */
216  CB_CATEGORY_PROGRAM_POINTER /* 12 */
217 };
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 
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 
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 
190  {
191  CB_CLASS_UNKNOWN = 0, /* 0 */
192  CB_CLASS_ALPHABETIC, /* 1 */
193  CB_CLASS_ALPHANUMERIC, /* 2 */
194  CB_CLASS_BOOLEAN, /* 3 */
195  CB_CLASS_INDEX, /* 4 */
196  CB_CLASS_NATIONAL, /* 5 */
197  CB_CLASS_NUMERIC, /* 6 */
198  CB_CLASS_OBJECT, /* 7 */
199  CB_CLASS_POINTER /* 8 */
200 };
enum cb_intr_enum
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_CURRENCY_SYMBOL 
CB_INTR_CURRENT_DATE 
CB_INTR_DATE_OF_INTEGER 
CB_INTR_DATE_TO_YYYYMMDD 
CB_INTR_DAY_OF_INTEGER 
CB_INTR_DAY_TO_YYYYDDD 
CB_INTR_DISPLAY_OF 
CB_INTR_E 
CB_INTR_EXCEPTION_FILE 
CB_INTR_EXCEPTION_FILE_N 
CB_INTR_EXCEPTION_LOCATION 
CB_INTR_EXCEPTION_LOCATION_N 
CB_INTR_EXCEPTION_STATEMENT 
CB_INTR_EXCEPTION_STATUS 
CB_INTR_EXP 
CB_INTR_EXP10 
CB_INTR_FACTORIAL 
CB_INTR_FORMATTED_CURRENT_DATE 
CB_INTR_FORMATTED_DATE 
CB_INTR_FORMATTED_DATETIME 
CB_INTR_FORMATTED_TIME 
CB_INTR_FRACTION_PART 
CB_INTR_HIGHEST_ALGEBRAIC 
CB_INTR_INTEGER 
CB_INTR_INTEGER_OF_BOOLEAN 
CB_INTR_INTEGER_OF_DATE 
CB_INTR_INTEGER_OF_DAY 
CB_INTR_INTEGER_OF_FORMATTED_DATE 
CB_INTR_INTEGER_PART 
CB_INTR_LENGTH 
CB_INTR_LOCALE_COMPARE 
CB_INTR_LOCALE_DATE 
CB_INTR_LOCALE_TIME 
CB_INTR_LOCALE_TIME_FROM_SECS 
CB_INTR_LOG 
CB_INTR_LOG10 
CB_INTR_LOWER_CASE 
CB_INTR_LOWEST_ALGEBRAIC 
CB_INTR_MAX 
CB_INTR_MEAN 
CB_INTR_MEDIAN 
CB_INTR_MIDRANGE 
CB_INTR_MIN 
CB_INTR_MOD 
CB_INTR_MODULE_CALLER_ID 
CB_INTR_MODULE_DATE 
CB_INTR_MODULE_FORMATTED_DATE 
CB_INTR_MODULE_ID 
CB_INTR_MODULE_PATH 
CB_INTR_MODULE_SOURCE 
CB_INTR_MODULE_TIME 
CB_INTR_MON_DECIMAL_POINT 
CB_INTR_MON_THOUSANDS_SEP 
CB_INTR_NATIONAL_OF 
CB_INTR_NUM_DECIMAL_POINT 
CB_INTR_NUM_THOUSANDS_SEP 
CB_INTR_NUMVAL 
CB_INTR_NUMVAL_C 
CB_INTR_NUMVAL_F 
CB_INTR_ORD 
CB_INTR_ORD_MAX 
CB_INTR_ORD_MIN 
CB_INTR_PI 
CB_INTR_PRESENT_VALUE 
CB_INTR_RANDOM 
CB_INTR_RANGE 
CB_INTR_REM 
CB_INTR_REVERSE 
CB_INTR_SECONDS_FROM_FORMATTED_TIME 
CB_INTR_SECONDS_PAST_MIDNIGHT 
CB_INTR_SIGN 
CB_INTR_SIN 
CB_INTR_SQRT 
CB_INTR_STANDARD_COMPARE 
CB_INTR_STANDARD_DEVIATION 
CB_INTR_STORED_CHAR_LENGTH 
CB_INTR_SUBSTITUTE 
CB_INTR_SUBSTITUTE_CASE 
CB_INTR_SUM 
CB_INTR_TAN 
CB_INTR_TEST_DATE_YYYYMMDD 
CB_INTR_TEST_DAY_YYYYDDD 
CB_INTR_TEST_FORMATTED_DATETIME 
CB_INTR_TEST_NUMVAL 
CB_INTR_TEST_NUMVAL_C 
CB_INTR_TEST_NUMVAL_F 
CB_INTR_TRIM 
CB_INTR_UPPER_CASE 
CB_INTR_USER_FUNCTION 
CB_INTR_VARIANCE 
CB_INTR_WHEN_COMPILED 
CB_INTR_YEAR_TO_YYYY 
CB_INTR_ABS 
CB_INTR_ACOS 
CB_INTR_ANNUITY 
CB_INTR_ASIN 
CB_INTR_ATAN 
CB_INTR_BOOLEAN_OF_INTEGER 
CB_INTR_BYTE_LENGTH 
CB_INTR_CHAR 
CB_INTR_CHAR_NATIONAL 
CB_INTR_COMBINED_DATETIME 
CB_INTR_CONCATENATE 
CB_INTR_COS 
CB_INTR_CURRENCY_SYMBOL 
CB_INTR_CURRENT_DATE 
CB_INTR_DATE_OF_INTEGER 
CB_INTR_DATE_TO_YYYYMMDD 
CB_INTR_DAY_OF_INTEGER 
CB_INTR_DAY_TO_YYYYDDD 
CB_INTR_DISPLAY_OF 
CB_INTR_E 
CB_INTR_EXCEPTION_FILE 
CB_INTR_EXCEPTION_FILE_N 
CB_INTR_EXCEPTION_LOCATION 
CB_INTR_EXCEPTION_LOCATION_N 
CB_INTR_EXCEPTION_STATEMENT 
CB_INTR_EXCEPTION_STATUS 
CB_INTR_EXP 
CB_INTR_EXP10 
CB_INTR_FACTORIAL 
CB_INTR_FORMATTED_CURRENT_DATE 
CB_INTR_FORMATTED_DATE 
CB_INTR_FORMATTED_DATETIME 
CB_INTR_FORMATTED_TIME 
CB_INTR_FRACTION_PART 
CB_INTR_HIGHEST_ALGEBRAIC 
CB_INTR_INTEGER 
CB_INTR_INTEGER_OF_BOOLEAN 
CB_INTR_INTEGER_OF_DATE 
CB_INTR_INTEGER_OF_DAY 
CB_INTR_INTEGER_OF_FORMATTED_DATE 
CB_INTR_INTEGER_PART 
CB_INTR_LENGTH 
CB_INTR_LOCALE_COMPARE 
CB_INTR_LOCALE_DATE 
CB_INTR_LOCALE_TIME 
CB_INTR_LOCALE_TIME_FROM_SECS 
CB_INTR_LOG 
CB_INTR_LOG10 
CB_INTR_LOWER_CASE 
CB_INTR_LOWEST_ALGEBRAIC 
CB_INTR_MAX 
CB_INTR_MEAN 
CB_INTR_MEDIAN 
CB_INTR_MIDRANGE 
CB_INTR_MIN 
CB_INTR_MOD 
CB_INTR_MODULE_CALLER_ID 
CB_INTR_MODULE_DATE 
CB_INTR_MODULE_FORMATTED_DATE 
CB_INTR_MODULE_ID 
CB_INTR_MODULE_PATH 
CB_INTR_MODULE_SOURCE 
CB_INTR_MODULE_TIME 
CB_INTR_MON_DECIMAL_POINT 
CB_INTR_MON_THOUSANDS_SEP 
CB_INTR_NATIONAL_OF 
CB_INTR_NUM_DECIMAL_POINT 
CB_INTR_NUM_THOUSANDS_SEP 
CB_INTR_NUMVAL 
CB_INTR_NUMVAL_C 
CB_INTR_NUMVAL_F 
CB_INTR_ORD 
CB_INTR_ORD_MAX 
CB_INTR_ORD_MIN 
CB_INTR_PI 
CB_INTR_PRESENT_VALUE 
CB_INTR_RANDOM 
CB_INTR_RANGE 
CB_INTR_REM 
CB_INTR_REVERSE 
CB_INTR_SECONDS_FROM_FORMATTED_TIME 
CB_INTR_SECONDS_PAST_MIDNIGHT 
CB_INTR_SIGN 
CB_INTR_SIN 
CB_INTR_SQRT 
CB_INTR_STANDARD_COMPARE 
CB_INTR_STANDARD_DEVIATION 
CB_INTR_STORED_CHAR_LENGTH 
CB_INTR_SUBSTITUTE 
CB_INTR_SUBSTITUTE_CASE 
CB_INTR_SUM 
CB_INTR_TAN 
CB_INTR_TEST_DATE_YYYYMMDD 
CB_INTR_TEST_DAY_YYYYDDD 
CB_INTR_TEST_FORMATTED_DATETIME 
CB_INTR_TEST_NUMVAL 
CB_INTR_TEST_NUMVAL_C 
CB_INTR_TEST_NUMVAL_F 
CB_INTR_TRIM 
CB_INTR_UPPER_CASE 
CB_INTR_USER_FUNCTION 
CB_INTR_VARIANCE 
CB_INTR_WHEN_COMPILED 
CB_INTR_YEAR_TO_YYYY 
CB_INTR_ABS 
CB_INTR_ACOS 
CB_INTR_ANNUITY 
CB_INTR_ASIN 
CB_INTR_ATAN 
CB_INTR_BOOLEAN_OF_INTEGER 
CB_INTR_BYTE_LENGTH 
CB_INTR_CHAR 
CB_INTR_CHAR_NATIONAL 
CB_INTR_COMBINED_DATETIME 
CB_INTR_CONCATENATE 
CB_INTR_COS 
CB_INTR_CURRENCY_SYMBOL 
CB_INTR_CURRENT_DATE 
CB_INTR_DATE_OF_INTEGER 
CB_INTR_DATE_TO_YYYYMMDD 
CB_INTR_DAY_OF_INTEGER 
CB_INTR_DAY_TO_YYYYDDD 
CB_INTR_DISPLAY_OF 
CB_INTR_E 
CB_INTR_EXCEPTION_FILE 
CB_INTR_EXCEPTION_FILE_N 
CB_INTR_EXCEPTION_LOCATION 
CB_INTR_EXCEPTION_LOCATION_N 
CB_INTR_EXCEPTION_STATEMENT 
CB_INTR_EXCEPTION_STATUS 
CB_INTR_EXP 
CB_INTR_EXP10 
CB_INTR_FACTORIAL 
CB_INTR_FORMATTED_CURRENT_DATE 
CB_INTR_FORMATTED_DATE 
CB_INTR_FORMATTED_DATETIME 
CB_INTR_FORMATTED_TIME 
CB_INTR_FRACTION_PART 
CB_INTR_HIGHEST_ALGEBRAIC 
CB_INTR_INTEGER 
CB_INTR_INTEGER_OF_BOOLEAN 
CB_INTR_INTEGER_OF_DATE 
CB_INTR_INTEGER_OF_DAY 
CB_INTR_INTEGER_OF_FORMATTED_DATE 
CB_INTR_INTEGER_PART 
CB_INTR_LENGTH 
CB_INTR_LOCALE_COMPARE 
CB_INTR_LOCALE_DATE 
CB_INTR_LOCALE_TIME 
CB_INTR_LOCALE_TIME_FROM_SECS 
CB_INTR_LOG 
CB_INTR_LOG10 
CB_INTR_LOWER_CASE 
CB_INTR_LOWEST_ALGEBRAIC 
CB_INTR_MAX 
CB_INTR_MEAN 
CB_INTR_MEDIAN 
CB_INTR_MIDRANGE 
CB_INTR_MIN 
CB_INTR_MOD 
CB_INTR_MODULE_CALLER_ID 
CB_INTR_MODULE_DATE 
CB_INTR_MODULE_FORMATTED_DATE 
CB_INTR_MODULE_ID 
CB_INTR_MODULE_PATH 
CB_INTR_MODULE_SOURCE 
CB_INTR_MODULE_TIME 
CB_INTR_MON_DECIMAL_POINT 
CB_INTR_MON_THOUSANDS_SEP 
CB_INTR_NATIONAL_OF 
CB_INTR_NUM_DECIMAL_POINT 
CB_INTR_NUM_THOUSANDS_SEP 
CB_INTR_NUMVAL 
CB_INTR_NUMVAL_C 
CB_INTR_NUMVAL_F 
CB_INTR_ORD 
CB_INTR_ORD_MAX 
CB_INTR_ORD_MIN 
CB_INTR_PI 
CB_INTR_PRESENT_VALUE 
CB_INTR_RANDOM 
CB_INTR_RANGE 
CB_INTR_REM 
CB_INTR_REVERSE 
CB_INTR_SECONDS_FROM_FORMATTED_TIME 
CB_INTR_SECONDS_PAST_MIDNIGHT 
CB_INTR_SIGN 
CB_INTR_SIN 
CB_INTR_SQRT 
CB_INTR_STANDARD_COMPARE 
CB_INTR_STANDARD_DEVIATION 
CB_INTR_STORED_CHAR_LENGTH 
CB_INTR_SUBSTITUTE 
CB_INTR_SUBSTITUTE_CASE 
CB_INTR_SUM 
CB_INTR_TAN 
CB_INTR_TEST_DATE_YYYYMMDD 
CB_INTR_TEST_DAY_YYYYDDD 
CB_INTR_TEST_FORMATTED_DATETIME 
CB_INTR_TEST_NUMVAL 
CB_INTR_TEST_NUMVAL_C 
CB_INTR_TEST_NUMVAL_F 
CB_INTR_TRIM 
CB_INTR_UPPER_CASE 
CB_INTR_USER_FUNCTION 
CB_INTR_VARIANCE 
CB_INTR_WHEN_COMPILED 
CB_INTR_YEAR_TO_YYYY 
277  {
278  CB_INTR_ABS = 1,
279  CB_INTR_ACOS,
280  CB_INTR_ANNUITY,
281  CB_INTR_ASIN,
282  CB_INTR_ATAN,
283  CB_INTR_BOOLEAN_OF_INTEGER,
284  CB_INTR_BYTE_LENGTH,
285  CB_INTR_CHAR,
286  CB_INTR_CHAR_NATIONAL,
287  CB_INTR_COMBINED_DATETIME,
288  CB_INTR_CONCATENATE,
289  CB_INTR_COS,
290  CB_INTR_CURRENCY_SYMBOL,
291  CB_INTR_CURRENT_DATE,
292  CB_INTR_DATE_OF_INTEGER,
293  CB_INTR_DATE_TO_YYYYMMDD,
294  CB_INTR_DAY_OF_INTEGER,
295  CB_INTR_DAY_TO_YYYYDDD,
296  CB_INTR_DISPLAY_OF,
297  CB_INTR_E,
298  CB_INTR_EXCEPTION_FILE,
299  CB_INTR_EXCEPTION_FILE_N,
300  CB_INTR_EXCEPTION_LOCATION,
301  CB_INTR_EXCEPTION_LOCATION_N,
302  CB_INTR_EXCEPTION_STATEMENT,
303  CB_INTR_EXCEPTION_STATUS,
304  CB_INTR_EXP,
305  CB_INTR_EXP10,
306  CB_INTR_FACTORIAL,
307  CB_INTR_FORMATTED_CURRENT_DATE,
308  CB_INTR_FORMATTED_DATE,
309  CB_INTR_FORMATTED_DATETIME,
310  CB_INTR_FORMATTED_TIME,
311  CB_INTR_FRACTION_PART,
312  CB_INTR_HIGHEST_ALGEBRAIC,
313  CB_INTR_INTEGER,
314  CB_INTR_INTEGER_OF_BOOLEAN,
315  CB_INTR_INTEGER_OF_DATE,
316  CB_INTR_INTEGER_OF_DAY,
317  CB_INTR_INTEGER_OF_FORMATTED_DATE,
318  CB_INTR_INTEGER_PART,
319  CB_INTR_LENGTH,
320  CB_INTR_LOCALE_COMPARE,
321  CB_INTR_LOCALE_DATE,
322  CB_INTR_LOCALE_TIME,
323  CB_INTR_LOCALE_TIME_FROM_SECS,
324  CB_INTR_LOG,
325  CB_INTR_LOG10,
326  CB_INTR_LOWER_CASE,
327  CB_INTR_LOWEST_ALGEBRAIC,
328  CB_INTR_MAX,
329  CB_INTR_MEAN,
330  CB_INTR_MEDIAN,
331  CB_INTR_MIDRANGE,
332  CB_INTR_MIN,
333  CB_INTR_MOD,
334  CB_INTR_MODULE_CALLER_ID,
335  CB_INTR_MODULE_DATE,
336  CB_INTR_MODULE_FORMATTED_DATE,
337  CB_INTR_MODULE_ID,
338  CB_INTR_MODULE_PATH,
339  CB_INTR_MODULE_SOURCE,
340  CB_INTR_MODULE_TIME,
341  CB_INTR_MON_DECIMAL_POINT,
342  CB_INTR_MON_THOUSANDS_SEP,
343  CB_INTR_NATIONAL_OF,
344  CB_INTR_NUM_DECIMAL_POINT,
345  CB_INTR_NUM_THOUSANDS_SEP,
346  CB_INTR_NUMVAL,
347  CB_INTR_NUMVAL_C,
348  CB_INTR_NUMVAL_F,
349  CB_INTR_ORD,
350  CB_INTR_ORD_MAX,
351  CB_INTR_ORD_MIN,
352  CB_INTR_PI,
353  CB_INTR_PRESENT_VALUE,
354  CB_INTR_RANDOM,
355  CB_INTR_RANGE,
356  CB_INTR_REM,
357  CB_INTR_REVERSE,
358  CB_INTR_SECONDS_FROM_FORMATTED_TIME,
359  CB_INTR_SECONDS_PAST_MIDNIGHT,
360  CB_INTR_SIGN,
361  CB_INTR_SIN,
362  CB_INTR_SQRT,
363  CB_INTR_STANDARD_COMPARE,
364  CB_INTR_STANDARD_DEVIATION,
365  CB_INTR_STORED_CHAR_LENGTH,
366  CB_INTR_SUBSTITUTE,
367  CB_INTR_SUBSTITUTE_CASE,
368  CB_INTR_SUM,
369  CB_INTR_TAN,
370  CB_INTR_TEST_DATE_YYYYMMDD,
371  CB_INTR_TEST_DAY_YYYYDDD,
372  CB_INTR_TEST_FORMATTED_DATETIME,
373  CB_INTR_TEST_NUMVAL,
374  CB_INTR_TEST_NUMVAL_C,
375  CB_INTR_TEST_NUMVAL_F,
376  CB_INTR_TRIM,
377  CB_INTR_UPPER_CASE,
378  CB_INTR_USER_FUNCTION,
379  CB_INTR_VARIANCE,
380  CB_INTR_WHEN_COMPILED,
381  CB_INTR_YEAR_TO_YYYY
382 };
enum cb_perform_type
Enumerator
CB_PERFORM_EXIT 
CB_PERFORM_ONCE 
CB_PERFORM_TIMES 
CB_PERFORM_UNTIL 
CB_PERFORM_FOREVER 
CB_PERFORM_EXIT 
CB_PERFORM_ONCE 
CB_PERFORM_TIMES 
CB_PERFORM_UNTIL 
CB_PERFORM_FOREVER 
CB_PERFORM_EXIT 
CB_PERFORM_ONCE 
CB_PERFORM_TIMES 
CB_PERFORM_UNTIL 
CB_PERFORM_FOREVER 
385  {
386  CB_PERFORM_EXIT = 0,
387  CB_PERFORM_ONCE,
388  CB_PERFORM_TIMES,
389  CB_PERFORM_UNTIL,
390  CB_PERFORM_FOREVER
391 };
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 
CB_STORAGE_CONSTANT 
CB_STORAGE_FILE 
CB_STORAGE_WORKING 
CB_STORAGE_LOCAL 
CB_STORAGE_LINKAGE 
CB_STORAGE_SCREEN 
CB_STORAGE_REPORT 
CB_STORAGE_COMMUNICATION 
CB_STORAGE_CONSTANT 
CB_STORAGE_FILE 
CB_STORAGE_WORKING 
CB_STORAGE_LOCAL 
CB_STORAGE_LINKAGE 
CB_STORAGE_SCREEN 
CB_STORAGE_REPORT 
CB_STORAGE_COMMUNICATION 
220  {
221  CB_STORAGE_CONSTANT = 0, /* Constants */
222  CB_STORAGE_FILE, /* FILE SECTION */
223  CB_STORAGE_WORKING, /* WORKING-STORAGE SECTION */
224  CB_STORAGE_LOCAL, /* LOCAL-STORAGE SECTION */
225  CB_STORAGE_LINKAGE, /* LINKAGE SECTION */
226  CB_STORAGE_SCREEN, /* SCREEN SECTION */
227  CB_STORAGE_REPORT, /* REPORT SECTION */
228  CB_STORAGE_COMMUNICATION /* COMMUNICATION SECTION */
229 };
enum cb_system_name_category
Enumerator
CB_DEVICE_NAME 
CB_SWITCH_NAME 
CB_FEATURE_NAME 
CB_CALL_CONVENTION_NAME 
CB_CODE_NAME 
CB_COMPUTER_NAME 
CB_ENTRY_CONVENTION_NAME 
CB_EXTERNAL_LOCALE_NAME 
CB_LIBRARY_NAME 
CB_TEXT_NAME 
CB_DEVICE_NAME 
CB_SWITCH_NAME 
CB_FEATURE_NAME 
CB_CALL_CONVENTION_NAME 
CB_CODE_NAME 
CB_COMPUTER_NAME 
CB_ENTRY_CONVENTION_NAME 
CB_EXTERNAL_LOCALE_NAME 
CB_LIBRARY_NAME 
CB_TEXT_NAME 
CB_DEVICE_NAME 
CB_SWITCH_NAME 
CB_FEATURE_NAME 
CB_CALL_CONVENTION_NAME 
CB_CODE_NAME 
CB_COMPUTER_NAME 
CB_ENTRY_CONVENTION_NAME 
CB_EXTERNAL_LOCALE_NAME 
CB_LIBRARY_NAME 
CB_TEXT_NAME 
136  {
137  CB_DEVICE_NAME = 0,
138  CB_SWITCH_NAME,
139  CB_FEATURE_NAME,
140  CB_CALL_CONVENTION_NAME,
141  CB_CODE_NAME,
142  CB_COMPUTER_NAME,
143  CB_ENTRY_CONVENTION_NAME,
144  CB_EXTERNAL_LOCALE_NAME,
145  CB_LIBRARY_NAME,
146  CB_TEXT_NAME
147 };
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_REPORT 
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_CANCEL 
CB_TAG_ALTER 
CB_TAG_SET_ATTR 
CB_TAG_PERFORM_VARYING 
CB_TAG_PICTURE 
CB_TAG_LIST 
CB_TAG_DIRECT 
CB_TAG_DEBUG 
CB_TAG_DEBUG_CALL 
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_REPORT 
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_CANCEL 
CB_TAG_ALTER 
CB_TAG_SET_ATTR 
CB_TAG_PERFORM_VARYING 
CB_TAG_PICTURE 
CB_TAG_LIST 
CB_TAG_DIRECT 
CB_TAG_DEBUG 
CB_TAG_DEBUG_CALL 
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_REPORT 
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_CANCEL 
CB_TAG_ALTER 
CB_TAG_SET_ATTR 
CB_TAG_PERFORM_VARYING 
CB_TAG_PICTURE 
CB_TAG_LIST 
CB_TAG_DIRECT 
CB_TAG_DEBUG 
CB_TAG_DEBUG_CALL 
61  {
62  /* Primitives */
63  CB_TAG_CONST = 0, /* 0 Constant value */
64  CB_TAG_INTEGER, /* 1 Integer constant */
65  CB_TAG_STRING, /* 2 String constant */
66  CB_TAG_ALPHABET_NAME, /* 3 Alphabet-name */
67  CB_TAG_CLASS_NAME, /* 4 Class-name */
68  CB_TAG_LOCALE_NAME, /* 5 Locale-name */
69  CB_TAG_SYSTEM_NAME, /* 6 System-name */
70  CB_TAG_LITERAL, /* 7 Numeric/alphanumeric literal */
71  CB_TAG_DECIMAL, /* 8 Decimal number */
72  CB_TAG_FIELD, /* 9 User-defined variable */
73  CB_TAG_FILE, /* 10 File description */
74  CB_TAG_REPORT, /* 11 Report description */
75  /* Expressions */
76  CB_TAG_REFERENCE, /* 12 Reference to a field, file, or label */
77  CB_TAG_BINARY_OP, /* 13 Binary operation */
78  CB_TAG_FUNCALL, /* 14 Run-time function call */
79  CB_TAG_CAST, /* 15 Type cast */
80  CB_TAG_INTRINSIC, /* 16 Intrinsic function */
81  /* Statements */
82  CB_TAG_LABEL, /* 17 Label statement */
83  CB_TAG_ASSIGN, /* 18 Assignment statement */
84  CB_TAG_INITIALIZE, /* 19 INITIALIZE statement */
85  CB_TAG_SEARCH, /* 20 SEARCH statement */
86  CB_TAG_CALL, /* 21 CALL statement */
87  CB_TAG_GOTO, /* 22 GO TO statement */
88  CB_TAG_IF, /* 23 IF statement */
89  CB_TAG_PERFORM, /* 24 PERFORM statement */
90  CB_TAG_STATEMENT, /* 25 General statement */
91  CB_TAG_CONTINUE, /* 26 CONTINUE statement */
92  CB_TAG_CANCEL, /* 27 CANCEL statement */
93  CB_TAG_ALTER, /* 28 ALTER statement */
94  CB_TAG_SET_ATTR, /* 29 SET ATTRIBUTE statement */
95  /* Miscellaneous */
96  CB_TAG_PERFORM_VARYING, /* 30 PERFORM VARYING parameter */
97  CB_TAG_PICTURE, /* 31 PICTURE clause */
98  CB_TAG_LIST, /* 32 List */
99  CB_TAG_DIRECT, /* 33 Code output or comment */
100  CB_TAG_DEBUG, /* 34 Debug item set */
101  CB_TAG_DEBUG_CALL /* 35 Debug callback */
102 };
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 
CB_USAGE_COMP_6 
CB_USAGE_FP_DEC64 
CB_USAGE_FP_DEC128 
CB_USAGE_FP_BIN32 
CB_USAGE_FP_BIN64 
CB_USAGE_FP_BIN128 
CB_USAGE_LONG_DOUBLE 
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 
CB_USAGE_COMP_6 
CB_USAGE_FP_DEC64 
CB_USAGE_FP_DEC128 
CB_USAGE_FP_BIN32 
CB_USAGE_FP_BIN64 
CB_USAGE_FP_BIN128 
CB_USAGE_LONG_DOUBLE 
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 
CB_USAGE_COMP_6 
CB_USAGE_FP_DEC64 
CB_USAGE_FP_DEC128 
CB_USAGE_FP_BIN32 
CB_USAGE_FP_BIN64 
CB_USAGE_FP_BIN128 
CB_USAGE_LONG_DOUBLE 
232  {
233  CB_USAGE_BINARY = 0, /* 0 */
234  CB_USAGE_BIT, /* 1 */
235  CB_USAGE_COMP_5, /* 2 */
236  CB_USAGE_COMP_X, /* 3 */
237  CB_USAGE_DISPLAY, /* 4 */
238  CB_USAGE_FLOAT, /* 5 */
239  CB_USAGE_DOUBLE, /* 6 */
240  CB_USAGE_INDEX, /* 7 */
241  CB_USAGE_NATIONAL, /* 8 */
242  CB_USAGE_OBJECT, /* 9 */
243  CB_USAGE_PACKED, /* 10 */
244  CB_USAGE_POINTER, /* 11 */
245  CB_USAGE_PROGRAM, /* 12 */
246  CB_USAGE_LENGTH, /* 13 */
247  CB_USAGE_PROGRAM_POINTER, /* 14 */
248  CB_USAGE_UNSIGNED_CHAR, /* 15 */
249  CB_USAGE_SIGNED_CHAR, /* 16 */
250  CB_USAGE_UNSIGNED_SHORT, /* 17 */
251  CB_USAGE_SIGNED_SHORT, /* 18 */
252  CB_USAGE_UNSIGNED_INT, /* 19 */
253  CB_USAGE_SIGNED_INT, /* 20 */
254  CB_USAGE_UNSIGNED_LONG, /* 21 */
255  CB_USAGE_SIGNED_LONG, /* 22 */
256  CB_USAGE_COMP_6, /* 23 */
257  CB_USAGE_FP_DEC64, /* 24 */
258  CB_USAGE_FP_DEC128, /* 25 */
259  CB_USAGE_FP_BIN32, /* 26 */
260  CB_USAGE_FP_BIN64, /* 27 */
261  CB_USAGE_FP_BIN128, /* 28 */
262  CB_USAGE_LONG_DOUBLE /* 29 */
263 };

Function Documentation

void ambiguous_error ( cb_tree  )

References _, CB_CHAIN, cb_error_x(), CB_FIELD, CB_LABEL, CB_NAME, cb_name(), CB_REFERENCE, CB_TAG_FIELD, CB_TAG_LABEL, CB_TREE, CB_TREE_TAG, CB_VALUE, COB_NORMAL_BUFF, COB_NORMAL_MAX, cobc_main_malloc(), errnamebuff, cb_word::error, cb_word::items, cb_label::name, cb_word::name, p, cb_field::parent, and cb_label::section.

Referenced by cb_ref().

290 {
291  struct cb_word *w;
292  struct cb_field *p;
293  struct cb_label *l2;
294  cb_tree l;
295  cb_tree y;
296 
297  w = CB_REFERENCE (x)->word;
298  if (w->error == 0) {
299  if (!errnamebuff) {
300  errnamebuff = cobc_main_malloc ((size_t)COB_NORMAL_BUFF);
301  }
302  /* Display error the first time */
303  snprintf (errnamebuff, (size_t)COB_NORMAL_MAX, "'%s'", CB_NAME (x));
304  for (l = CB_REFERENCE (x)->chain; l; l = CB_REFERENCE (l)->chain) {
305  strcat (errnamebuff, " in '");
306  strcat (errnamebuff, CB_NAME (l));
307  strcat (errnamebuff, "'");
308  }
309  cb_error_x (x, _("%s ambiguous; need qualification"), errnamebuff);
310  w->error = 1;
311 
312  /* Display all fields with the same name */
313  for (l = w->items; l; l = CB_CHAIN (l)) {
314  y = CB_VALUE (l);
315  snprintf (errnamebuff, (size_t)COB_NORMAL_MAX,
316  "'%s' ", w->name);
317  switch (CB_TREE_TAG (y)) {
318  case CB_TAG_FIELD:
319  for (p = CB_FIELD (y)->parent; p; p = p->parent) {
320  strcat (errnamebuff, "in '");
321  strcat (errnamebuff, cb_name (CB_TREE(p)));
322  strcat (errnamebuff, "' ");
323  }
324  break;
325  case CB_TAG_LABEL:
326  l2 = CB_LABEL (y);
327  if (l2->section) {
328  strcat (errnamebuff, "in '");
329  strcat (errnamebuff,
330  (const char *)(l2->section->name));
331  strcat (errnamebuff, "' ");
332  }
333  break;
334  default:
335  break;
336  }
337  strcat (errnamebuff, _("defined here"));
338  cb_error_x (y, errnamebuff);
339  }
340  }
341 }
struct cb_file* build_file ( cb_tree  )
read

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

2203 {
2204  struct cb_file *p;
2205 
2206  p = make_tree (CB_TAG_FILE, CB_CATEGORY_UNKNOWN, sizeof (struct cb_file));
2207  p->name = cb_define (name, CB_TREE (p));
2208  p->cname = cb_to_cname (p->name);
2209 
2210  p->organization = COB_ORG_SEQUENTIAL;
2211  p->access_mode = COB_ACCESS_SEQUENTIAL;
2212  p->handler = CB_LABEL (cb_standard_error_handler);
2213  p->handler_prog = current_program;
2214  return p;
2215 }
struct cb_literal* build_literal ( enum  cb_category,
const void *  ,
const size_t   
)
read

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

631 {
632  struct cb_literal *p;
633 
634  p = make_tree (CB_TAG_LITERAL, category, sizeof (struct cb_literal));
635  p->data = cobc_parse_malloc (size + 1U);
636  p->size = size;
637  memcpy (p->data, data, size);
638  return p;
639 }
struct cb_report* build_report ( cb_tree  )
read

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

2183 {
2184  struct cb_report *p;
2185 
2186  p = make_tree (CB_TAG_REPORT, CB_CATEGORY_UNKNOWN, sizeof (struct cb_report));
2187  p->name = cb_define (name, CB_TREE (p));
2188  p->cname = cb_to_cname (p->name);
2189 
2190 #if 0 /* RXWRXW RP */
2191  p->organization = COB_ORG_SEQUENTIAL;
2192  p->access_mode = COB_ACCESS_SEQUENTIAL;
2193  p->handler = CB_LABEL (cb_standard_error_handler);
2194  p->handler_prog = current_program;
2195 #endif
2196  return p;
2197 }
void cb_add_78 ( struct cb_field *  )

References CB_VALUE, check_78_replace(), cb_level_78::chk_const, cob_u32_t, cobc_malloc(), const78ptr, current_program, cb_field::flag_is_global, cb_level_78::fld78, globlev78ptr, cb_level_78::globnext, cb_level_78::last, lev78ptr, cb_field::name, cb_level_78::name_len, cb_level_78::next, cb_level_78::pic_len, cb_level_78::pic_replace, cb_level_78::prog, and cb_field::values.

4590 {
4591  struct cb_level_78 *p78;
4592 
4593  /* Add a constant (78 level) item */
4594  p78 = cobc_malloc (sizeof(struct cb_level_78));
4595  p78->fld78 = f;
4596  p78->prog = current_program;
4597  p78->pic_replace = check_78_replace (CB_VALUE(f->values));
4598  if (p78->pic_replace) {
4599  p78->pic_len = (cob_u32_t)strlen (p78->pic_replace);
4600  }
4601  p78->name_len = (cob_u32_t)strlen (f->name);
4602  if (f->flag_is_global) {
4603  if (!globlev78ptr) {
4604  p78->last = p78;
4605  } else {
4606  p78->last = globlev78ptr->last;
4607  }
4608  p78->last->globnext = const78ptr;
4609  p78->next = globlev78ptr;
4610  p78->globnext = globlev78ptr;
4611  p78->chk_const = 1;
4612  globlev78ptr = p78;
4613  if (lev78ptr) {
4614  lev78ptr->last->globnext = globlev78ptr;
4615  } else {
4616  top78ptr = globlev78ptr;
4617  }
4618  } else {
4619  if (!lev78ptr) {
4620  p78->last = p78;
4621  } else {
4622  p78->last = lev78ptr->last;
4623  }
4624  if (globlev78ptr) {
4625  p78->last->globnext = globlev78ptr;
4626  } else {
4627  p78->last->globnext = const78ptr;
4628  }
4629  p78->next = lev78ptr;
4630  p78->globnext = lev78ptr;
4631  lev78ptr = p78;
4632  top78ptr = lev78ptr;
4633  }
4634 }
void cb_add_common_prog ( struct cb_program *  )

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

1312 {
1313  struct cb_program *q;
1314 
1315  /* Here we are sure that nested >= 1 */
1316  q = container_progs[prog->nested_level - 1];
1317  q->common_prog_list = add_contained_prog (q->common_prog_list, prog);
1318 }
cb_tree cb_build_add ( cb_tree  ,
cb_tree  ,
cb_tree   
)

References build_store_option(), cb_build_binary_op(), CB_BUILD_FUNCALL_3, cb_build_move(), cb_build_optim_add(), CB_CLASS_POINTER, CB_FIELD_PTR, cb_fits_int(), cb_high, CB_INDEX_P, cb_int0, CB_REF_OR_FIELD_P, CB_TREE_CLASS, cb_field::count, and optimize_defs.

3940 {
3941  cb_tree opt;
3942  struct cb_field *f;
3943 
3944 #ifdef COB_NON_ALIGNED
3945  if (CB_INDEX_P (v)) {
3946  return cb_build_move (cb_build_binary_op (v, '+', n), v);
3947  }
3948  if (CB_TREE_CLASS (v) == CB_CLASS_POINTER) {
3949  optimize_defs[COB_POINTER_MANIP] = 1;
3950  return CB_BUILD_FUNCALL_3 ("cob_pointer_manip", v, n, cb_int0);
3951  }
3952 #else
3953  if (CB_INDEX_P (v) || CB_TREE_CLASS (v) == CB_CLASS_POINTER) {
3954  return cb_build_move (cb_build_binary_op (v, '+', n), v);
3955  }
3956 #endif
3957 
3958  if (CB_REF_OR_FIELD_P (v)) {
3959  f = CB_FIELD_PTR (v);
3960  f->count++;
3961  }
3962  if (CB_REF_OR_FIELD_P (n)) {
3963  f = CB_FIELD_PTR (n);
3964  f->count++;
3965  }
3966  if (round_opt == cb_high) {
3967  /* Short circuit from tree.c for perform */
3968  if (cb_fits_int (n)) {
3969  return cb_build_optim_add (v, n);
3970  } else {
3971  return CB_BUILD_FUNCALL_3 ("cob_add", v, n, cb_int0);
3972  }
3973  }
3974  opt = build_store_option (v, round_opt);
3975  if (opt == cb_int0 && cb_fits_int (n)) {
3976  return cb_build_optim_add (v, n);
3977  }
3978  return CB_BUILD_FUNCALL_3 ("cob_add", v, n, opt);
3979 }
cb_tree cb_build_address ( cb_tree  )

References _, CB_ADD_TO_CHAIN, CB_BUILD_CAST_ADDRESS, cb_error_node, cb_error_x(), CB_FIELD, CB_FIELD_P, cb_list_length(), cb_one, cb_ref(), CB_REFERENCE, CB_REFERENCE_P, cb_warning_x(), cb_word::name, cb_reference::offset, cb_reference::subs, and cb_reference::word.

1329 {
1330  cb_tree v;
1331  struct cb_reference *r;
1332  const char *name;
1333  int numsubs;
1334  int refsubs;
1335 
1336  if (x == cb_error_node) {
1337  return cb_error_node;
1338  }
1339  if (!CB_REFERENCE_P (x)) {
1340  return CB_BUILD_CAST_ADDRESS (x);
1341  }
1342 
1343  r = CB_REFERENCE (x);
1344  name = r->word->name;
1345  v = cb_ref (x);
1346  if (v == cb_error_node) {
1347  return cb_error_node;
1348  }
1349 
1350  refsubs = cb_list_length (r->subs);
1351  if (CB_FIELD_P (v)) {
1352  numsubs = CB_FIELD (v)->indexes;
1353  if (refsubs > numsubs) {
1354  goto subserror;
1355  } else if (refsubs < numsubs) {
1356  if (!cb_relaxed_syntax_check) {
1357  goto subserror;
1358  } else {
1359  cb_warning_x (x,
1360  _("Subscripts missing for '%s' - Defaulting to 1"),
1361  name);
1362  for (; refsubs < numsubs; ++refsubs) {
1363  CB_ADD_TO_CHAIN (cb_one, r->subs);
1364  }
1365  }
1366  }
1367  } else {
1368  numsubs = 0;
1369  if (r->subs) {
1370  goto subserror;
1371  }
1372  if (r->offset) {
1373  cb_error_x (x, _("'%s' cannot be reference modified"), name);
1374  return cb_error_node;
1375  }
1376  }
1377 
1378  return CB_BUILD_CAST_ADDRESS (x);
1379 
1380 subserror:
1381  switch (numsubs) {
1382  case 0:
1383  cb_error_x (x, _("'%s' cannot be subscripted"), name);
1384  break;
1385  case 1:
1386  cb_error_x (x, _("'%s' requires 1 subscript"), name);
1387  break;
1388  default:
1389  cb_error_x (x, _("'%s' requires %d subscripts"),
1390  name, numsubs);
1391  break;
1392  }
1393  return cb_error_node;
1394 }
cb_tree cb_build_alphabet_name ( cb_tree  )

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

1448 {
1449  struct cb_alphabet_name *p;
1450 
1451  if (!name || name == cb_error_node) {
1452  return NULL;
1453  }
1454  p = make_tree (CB_TAG_ALPHABET_NAME, CB_CATEGORY_UNKNOWN,
1455  sizeof (struct cb_alphabet_name));
1456  p->name = cb_define (name, CB_TREE (p));
1457  p->cname = cb_to_cname (p->name);
1458  return CB_TREE (p);
1459 }
cb_tree cb_build_alphanumeric_literal ( const void *  ,
const size_t   
)

References build_literal(), CB_CATEGORY_ALPHANUMERIC, and CB_TREE.

1546 {
1547  return CB_TREE (build_literal (CB_CATEGORY_ALPHANUMERIC, data, size));
1548 }
cb_tree cb_build_alter ( const cb_tree  ,
const cb_tree   
)

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

2952 {
2953  struct cb_alter *p;
2954 
2955  p = make_tree (CB_TAG_ALTER, CB_CATEGORY_UNKNOWN,
2956  sizeof (struct cb_alter));
2957  p->source = source;
2958  p->target = target;
2959  current_program->alter_list =
2960  cb_list_append (current_program->alter_list,
2961  CB_BUILD_PAIR (source, target));
2962  return CB_TREE (p);
2963 }
cb_tree cb_build_any_intrinsic ( cb_tree  )

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

3093 {
3094  struct cb_intrinsic_table *cbp;
3095 
3096  cbp = lookup_intrinsic ("LENGTH", 0, 0);
3097  return make_intrinsic (NULL, cbp, args, NULL, NULL, 0);
3098 }
cb_tree cb_build_assign ( const cb_tree  ,
const cb_tree   
)

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

2865 {
2866  struct cb_assign *p;
2867 
2868  p = make_tree (CB_TAG_ASSIGN, CB_CATEGORY_UNKNOWN,
2869  sizeof (struct cb_assign));
2870  p->var = var;
2871  p->val = val;
2872  return CB_TREE (p);
2873 }
cb_tree cb_build_assignment_name ( struct cb_file *  ,
cb_tree   
)

References _, CB_ASSIGN_IBM, CB_ASSIGN_MF, cb_build_alphanumeric_literal(), cb_error_node, cb_list_add(), CB_NAME, CB_TAG_LITERAL, CB_TAG_REFERENCE, CB_TREE_TAG, cb_warning(), current_program, cb_file::flag_ext_assign, NULL, p, cb_program::reference_list, and warningopt.

1248 {
1249  const char *s;
1250  const char *p;
1251 
1252  if (name == cb_error_node) {
1253  return cb_error_node;
1254  }
1255  /* For special assignment */
1256  if (name == NULL) {
1257  return NULL;
1258  }
1259 
1260  switch (CB_TREE_TAG (name)) {
1261  case CB_TAG_LITERAL:
1262  return name;
1263 
1264  case CB_TAG_REFERENCE:
1265  s = CB_NAME (name);
1266  if (cb_assign_clause == CB_ASSIGN_MF) {
1267  if (cfile->flag_ext_assign) {
1268  p = strrchr (s, '-');
1269  if (p) {
1270  s = p + 1;
1271  }
1272  return cb_build_alphanumeric_literal (s, strlen (s));
1273  }
1274  current_program->reference_list =
1275  cb_list_add (current_program->reference_list, name);
1276  return name;
1277  } else if (cb_assign_clause == CB_ASSIGN_IBM) {
1278  /* Check organization */
1279  if (strncmp (s, "S-", (size_t)2) == 0 ||
1280  strncmp (s, "AS-", (size_t)3) == 0) {
1281  goto org;
1282  }
1283  /* Skip the device label if exists */
1284  if ((p = strchr (s, '-')) != NULL) {
1285  s = p + 1;
1286  }
1287  /* Check organization again */
1288  if (strncmp (s, "S-", (size_t)2) == 0 ||
1289  strncmp (s, "AS-", (size_t)3) == 0) {
1290 org:
1291  /* Skip it for now */
1292  s = strchr (s, '-') + 1;
1293  }
1294  /* Convert the name into literal */
1295  if (warningopt) {
1296  cb_warning (_("ASSIGN interpreted as %s"), s);
1297  }
1298  return cb_build_alphanumeric_literal (s, strlen (s));
1299  }
1300  /* Fall through for CB_ASSIGN_COBOL2002 */
1301  /* To be looked at */
1302  default:
1303  return cb_error_node;
1304  }
1305 }
cb_tree cb_build_binary_list ( cb_tree  ,
const int   
)

References cb_build_binary_op(), CB_CHAIN, and CB_VALUE.

2754 {
2755  cb_tree e;
2756 
2757  e = CB_VALUE (l);
2758  for (l = CB_CHAIN (l); l; l = CB_CHAIN (l)) {
2759  e = cb_build_binary_op (e, op, CB_VALUE (l));
2760  }
2761  return e;
2762 }
cb_tree cb_build_binary_op ( cb_tree  ,
const int  ,
cb_tree   
)

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

2679 {
2680  struct cb_binary_op *p;
2681  enum cb_category category = CB_CATEGORY_UNKNOWN;
2682 
2683  switch (op) {
2684  case '+':
2685  case '-':
2686  case '*':
2687  case '/':
2688  case '^':
2689  /* Arithmetic operators */
2690  if (CB_TREE_CLASS (x) == CB_CLASS_POINTER ||
2691  CB_TREE_CLASS (y) == CB_CLASS_POINTER) {
2692  category = CB_CATEGORY_DATA_POINTER;
2693  break;
2694  }
2695  x = cb_check_numeric_value (x);
2696  y = cb_check_numeric_value (y);
2697  if (x == cb_error_node || y == cb_error_node) {
2698  return cb_error_node;
2699  }
2700  category = CB_CATEGORY_NUMERIC;
2701  break;
2702 
2703  case '=':
2704  case '~':
2705  case '<':
2706  case '>':
2707  case '[':
2708  case ']':
2709  /* Relational operators */
2710  if ((CB_REF_OR_FIELD_P (x)) &&
2711  CB_FIELD (cb_ref (x))->level == 88) {
2712  cb_error_x (x, _("Invalid expression"));
2713  return cb_error_node;
2714  }
2715  if ((CB_REF_OR_FIELD_P (y)) &&
2716  CB_FIELD (cb_ref (y))->level == 88) {
2717  cb_error_x (y, _("Invalid expression"));
2718  return cb_error_node;
2719  }
2720  category = CB_CATEGORY_BOOLEAN;
2721  break;
2722 
2723  case '!':
2724  case '&':
2725  case '|':
2726  /* Logical operators */
2727  if (CB_TREE_CLASS (x) != CB_CLASS_BOOLEAN ||
2728  (y && CB_TREE_CLASS (y) != CB_CLASS_BOOLEAN)) {
2729  cb_error_x (x, _("Invalid expression"));
2730  return cb_error_node;
2731  }
2732  category = CB_CATEGORY_BOOLEAN;
2733  break;
2734 
2735  case '@':
2736  /* Parentheses */
2737  category = CB_TREE_CATEGORY (x);
2738  break;
2739 
2740  default:
2741  cobc_abort_pr (_("Unexpected operator -> %d"), op);
2742  COBC_ABORT ();
2743  }
2744 
2745  p = make_tree (CB_TAG_BINARY_OP, category, sizeof (struct cb_binary_op));
2746  p->op = op;
2747  p->x = x;
2748  p->y = y;
2749  return CB_TREE (p);
2750 }
struct cb_picture* cb_build_binary_picture ( const char *  ,
const cob_u32_t  ,
const cob_u32_t   
)
read

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

1643 {
1644  struct cb_picture *pic;
1645 
1646  pic = make_tree (CB_TAG_PICTURE, CB_CATEGORY_NUMERIC,
1647  sizeof (struct cb_picture));
1648  pic->orig = cobc_check_string (str);
1649  pic->size = size;
1650  pic->digits = size;
1651  pic->scale = 0;
1652  pic->have_sign = sign;
1653  pic->category = CB_CATEGORY_NUMERIC;
1654  return pic;
1655 }
cb_tree cb_build_call ( const cb_tree  ,
const cb_tree  ,
const cb_tree  ,
const cb_tree  ,
const cb_tree  ,
const cob_u32_t  ,
const int   
)

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

2920 {
2921  struct cb_call *p;
2922 
2923  p = make_tree (CB_TAG_CALL, CB_CATEGORY_UNKNOWN,
2924  sizeof (struct cb_call));
2925  p->name = name;
2926  p->args = args;
2927  p->stmt1 = stmt1;
2928  p->stmt2 = stmt2;
2929  p->call_returning = returning;
2930  p->is_system = is_system_call;
2931  p->convention = convention;
2932  return CB_TREE (p);
2933 }
cb_tree cb_build_cancel ( const cb_tree  )

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

2939 {
2940  struct cb_cancel *p;
2941 
2942  p = make_tree (CB_TAG_CANCEL, CB_CATEGORY_UNKNOWN,
2943  sizeof (struct cb_cancel));
2944  p->target = target;
2945  return CB_TREE (p);
2946 }
cb_tree cb_build_cast ( const enum  cb_cast_type,
const cb_tree   
)

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

2798 {
2799  struct cb_cast *p;
2800  enum cb_category category;
2801 
2802  if (type == CB_CAST_INTEGER) {
2803  category = CB_CATEGORY_NUMERIC;
2804  } else {
2805  category = CB_CATEGORY_UNKNOWN;
2806  }
2807  p = make_tree (CB_TAG_CAST, category, sizeof (struct cb_cast));
2808  p->cast_type = type;
2809  p->val = val;
2810  return CB_TREE (p);
2811 }
cb_tree cb_build_cast_int ( const cb_tree  )

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

2815 {
2816  struct cb_cast *p;
2817 
2818  p = make_tree (CB_TAG_CAST, CB_CATEGORY_NUMERIC, sizeof (struct cb_cast));
2819  p->cast_type = CB_CAST_INTEGER;
2820  p->val = val;
2821  return CB_TREE (p);
2822 }
cb_tree cb_build_cast_llint ( const cb_tree  )

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

2826 {
2827  struct cb_cast *p;
2828 
2829  p = make_tree (CB_TAG_CAST, CB_CATEGORY_NUMERIC, sizeof (struct cb_cast));
2830  p->cast_type = CB_CAST_LONG_INT;
2831  p->val = val;
2832  return CB_TREE (p);
2833 }
cb_tree cb_build_class_name ( cb_tree  ,
cb_tree   
)

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

1465 {
1466  struct cb_class_name *p;
1467 
1468  if (!name || name == cb_error_node) {
1469  return NULL;
1470  }
1471  p = make_tree (CB_TAG_CLASS_NAME, CB_CATEGORY_BOOLEAN,
1472  sizeof (struct cb_class_name));
1473  p->name = cb_define (name, CB_TREE (p));
1474  if (!scratch_buff) {
1475  scratch_buff = cobc_main_malloc ((size_t)COB_MINI_BUFF);
1476  }
1477  snprintf (scratch_buff, (size_t)COB_MINI_MAX, "cob_is_%s_%d",
1478  cb_to_cname (p->name), class_id++);
1479  p->cname = cobc_parse_strdup (scratch_buff);
1480  p->list = list;
1481  return CB_TREE (p);
1482 }
cb_tree cb_build_comment ( const char *  )

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

1383 {
1384  struct cb_direct *p;
1385 
1386  p = make_tree (CB_TAG_DIRECT, CB_CATEGORY_ALPHANUMERIC,
1387  sizeof (struct cb_direct));
1388  p->line = str;
1389  CB_TREE (p)->source_file = cb_source_file;
1390  CB_TREE (p)->source_line = cb_source_line;
1391  return CB_TREE (p);
1392 }
cb_tree cb_build_cond ( cb_tree  )

References _, cb_program::alphabet_name_list, build_cond_88(), cb_any, CB_BINARY_OP, CB_BINARY_OP_P, cb_build_binary_op(), CB_BUILD_CAST_ADDRESS, cb_build_cond(), CB_BUILD_FUNCALL_2, CB_BUILD_FUNCALL_3, CB_BUILD_NEGATION, cb_build_optim_cond(), CB_CATEGORY_ALPHABETIC, CB_CATEGORY_ALPHANUMERIC, cb_chk_alpha_cond(), cb_chk_num_cond(), CB_CLASS_NUMERIC, CB_CLASS_POINTER, cb_error_node, cb_error_x(), cb_false, CB_FIELD_P, CB_FIELD_PTR, cb_field_size(), cb_fits_long_long(), cb_high, CB_INDEX_P, cb_int(), cb_list_reverse(), cb_low, cb_ref(), CB_REF_OR_FIELD_P, cb_space, CB_TAG_BINARY_OP, CB_TAG_CONST, CB_TAG_FUNCALL, CB_TAG_REFERENCE, CB_TREE, CB_TREE_CATEGORY, CB_TREE_CLASS, CB_TREE_TAG, cb_true, cb_zero, current_program, current_statement, d1, d2, decimal_alloc(), decimal_expand(), decimal_free(), dpush, cb_program::flag_debugging, cb_field::level, NULL, cb_binary_op::op, p, cb_binary_op::x, and cb_binary_op::y.

3661 {
3662  struct cb_field *f;
3663  struct cb_binary_op *p;
3664  cb_tree d1;
3665  cb_tree d2;
3666  int size1;
3667  int size2;
3668 
3669  if (x == cb_error_node) {
3670  return cb_error_node;
3671  }
3672  switch (CB_TREE_TAG (x)) {
3673  case CB_TAG_CONST:
3674  if (x != cb_any && x != cb_true && x != cb_false) {
3675  cb_error_x (CB_TREE(current_statement),
3676  _("Invalid expression"));
3677  return cb_error_node;
3678  }
3679  return x;
3680  case CB_TAG_FUNCALL:
3681  return x;
3682  case CB_TAG_REFERENCE:
3683  if (!CB_FIELD_P (cb_ref (x))) {
3684  return cb_build_cond (cb_ref (x));
3685  }
3686 
3687  f = CB_FIELD_PTR (x);
3688 
3689  /* Level 88 condition */
3690  if (f->level == 88) {
3691  /* Build an 88 condition at every occurrence */
3692  /* as it may be subscripted */
3693  return cb_build_cond (build_cond_88 (x));
3694  }
3695 
3696  cb_error_x (x, _("Invalid expression"));
3697  return cb_error_node;
3698  case CB_TAG_BINARY_OP:
3699  p = CB_BINARY_OP (x);
3700  if (!p->x || p->x == cb_error_node) {
3701  return cb_error_node;
3702  }
3703  switch (p->op) {
3704  case '!':
3705  return CB_BUILD_NEGATION (cb_build_cond (p->x));
3706  case '&':
3707  case '|':
3708  if (!p->y || p->y == cb_error_node) {
3709  return cb_error_node;
3710  }
3711  return cb_build_binary_op (cb_build_cond (p->x), p->op, cb_build_cond (p->y));
3712  default:
3713  if (!p->y || p->y == cb_error_node) {
3714  return cb_error_node;
3715  }
3716  if (CB_INDEX_P (p->x) || CB_INDEX_P (p->y) ||
3717  CB_TREE_CLASS (p->x) == CB_CLASS_POINTER ||
3718  CB_TREE_CLASS (p->y) == CB_CLASS_POINTER) {
3719  x = cb_build_binary_op (p->x, '-', p->y);
3720  } else if (CB_BINARY_OP_P (p->x) ||
3721  CB_BINARY_OP_P (p->y)) {
3722  /* Decimal comparison */
3723  d1 = decimal_alloc ();
3724  d2 = decimal_alloc ();
3725 
3726  decimal_expand (d1, p->x);
3727  decimal_expand (d2, p->y);
3728  dpush (CB_BUILD_FUNCALL_2 ("cob_decimal_cmp", d1, d2));
3729  decimal_free ();
3730  decimal_free ();
3731  x = cb_list_reverse (decimal_stack);
3732  decimal_stack = NULL;
3733  } else {
3734  /* DEBUG Bypass optimization for PERFORM */
3735  if (current_program->flag_debugging) {
3736  x = CB_BUILD_FUNCALL_2 ("cob_cmp", p->x, p->y);
3737  break;
3738  }
3739  if (cb_chk_num_cond (p->x, p->y)) {
3740  size1 = cb_field_size (p->x);
3741  x = CB_BUILD_FUNCALL_3 ("memcmp",
3742  CB_BUILD_CAST_ADDRESS (p->x),
3743  CB_BUILD_CAST_ADDRESS (p->y),
3744  cb_int (size1));
3745  break;
3746  }
3747  if (CB_TREE_CLASS (p->x) == CB_CLASS_NUMERIC &&
3748  CB_TREE_CLASS (p->y) == CB_CLASS_NUMERIC &&
3749  cb_fits_long_long (p->y)) {
3750  x = cb_build_optim_cond (p);
3751  break;
3752  }
3753 
3754  /* Field comparison */
3755  if ((CB_REF_OR_FIELD_P (p->x)) &&
3756  (CB_TREE_CATEGORY (p->x) == CB_CATEGORY_ALPHANUMERIC ||
3757  CB_TREE_CATEGORY (p->x) == CB_CATEGORY_ALPHABETIC) &&
3758  cb_field_size (p->x) == 1 &&
3759  !current_program->alphabet_name_list &&
3760  (p->y == cb_space || p->y == cb_low ||
3761  p->y == cb_high || p->y == cb_zero)) {
3762  x = CB_BUILD_FUNCALL_2 ("$G", p->x, p->y);
3763  break;
3764  }
3765  if (cb_chk_alpha_cond (p->x) &&
3766  cb_chk_alpha_cond (p->y)) {
3767  size1 = cb_field_size (p->x);
3768  size2 = cb_field_size (p->y);
3769  } else {
3770  size1 = 0;
3771  size2 = 0;
3772  }
3773  if (size1 == 1 && size2 == 1) {
3774  x = CB_BUILD_FUNCALL_2 ("$G", p->x, p->y);
3775  } else if (size1 != 0 && size1 == size2) {
3776  x = CB_BUILD_FUNCALL_3 ("memcmp",
3777  CB_BUILD_CAST_ADDRESS (p->x),
3778  CB_BUILD_CAST_ADDRESS (p->y),
3779  cb_int (size1));
3780  } else {
3781  if (CB_TREE_CLASS (p->x) == CB_CLASS_NUMERIC && p->y == cb_zero) {
3782  x = cb_build_optim_cond (p);
3783  } else {
3784  x = CB_BUILD_FUNCALL_2 ("cob_cmp", p->x, p->y);
3785  }
3786  }
3787  }
3788  }
3789  return cb_build_binary_op (x, p->op, p->y);
3790  default:
3791  break;
3792  }
3793  cb_error_x (x, _("Invalid expression"));
3794  return cb_error_node;
3795 }
cb_tree cb_build_const_length ( cb_tree  )

References _, cb_build_numeric_literal(), cb_error(), cb_error_node, CB_FIELD, cb_field_variable_size(), CB_INTEGER, CB_INTEGER_P, cb_ref(), CB_REFERENCE, CB_REFERENCE_P, cb_validate_field(), cb_field::flag_any_length, cb_field::level, cb_field::memory_size, cb_field::offset, cb_field::redefines, cb_field::rename_thru, and cb_field::size.

1670 {
1671  struct cb_field *f;
1672  char buff[32];
1673 
1674  if (x == cb_error_node) {
1675  return cb_error_node;
1676  }
1677  if (CB_INTEGER_P (x)) {
1678  sprintf (buff, "%d", CB_INTEGER(x)->val);
1679  return cb_build_numeric_literal (0, buff, 0);
1680  }
1681  if (CB_REFERENCE_P (x)) {
1682  if (cb_ref (x) == cb_error_node) {
1683  return cb_error_node;
1684  }
1685  if (CB_REFERENCE (x)->offset) {
1686  cb_error (_("Reference modification not allowed here"));
1687  return cb_error_node;
1688  }
1689  }
1690 
1691  memset (buff, 0, sizeof (buff));
1692  f = CB_FIELD (cb_ref (x));
1693  if (f->flag_any_length) {
1694  cb_error (_("ANY LENGTH item not allowed here"));
1695  return cb_error_node;
1696  }
1697  if (f->level == 88) {
1698  cb_error (_("88 level item not allowed here"));
1699  return cb_error_node;
1700  }
1701  if (cb_field_variable_size (f)) {
1702  cb_error (_("Variable length item not allowed here"));
1703  return cb_error_node;
1704  }
1705  if (f->redefines) {
1706  cb_validate_field (f->redefines);
1707  if (f->rename_thru) {
1708  cb_validate_field (f->rename_thru);
1709  }
1710  cb_validate_field (f);
1711  sprintf (buff, "%d", f->size);
1712  } else {
1713  cb_validate_field (f);
1714  sprintf (buff, "%d", f->memory_size);
1715  }
1716  return cb_build_numeric_literal (0, buff, 0);
1717 }
cb_tree cb_build_constant ( cb_tree  ,
cb_tree   
)

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

2048 {
2049  cb_tree x;
2050 
2051  x = cb_build_field (name);
2052  x->category = cb_tree_category (value);
2053  CB_FIELD (x)->storage = CB_STORAGE_CONSTANT;
2054  CB_FIELD (x)->values = CB_LIST_INIT (value);
2055  return x;
2056 }
cb_tree cb_build_continue ( void  )

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

3065 {
3066  struct cb_continue *p;
3067 
3068  p = make_tree (CB_TAG_CONTINUE, CB_CATEGORY_UNKNOWN,
3069  sizeof (struct cb_continue));
3070  return CB_TREE (p);
3071 }
cb_tree cb_build_converting ( cb_tree  ,
cb_tree  ,
cb_tree   
)

References CB_BUILD_FUNCALL_2, cb_list_add(), and validate_inspect().

5744 {
5745  validate_inspect (x, y, 2);
5746  return cb_list_add (l, CB_BUILD_FUNCALL_2 ("cob_inspect_converting", x, y));
5747 }
cb_tree cb_build_debug ( const cb_tree  ,
const char *  ,
const cb_tree   
)

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

1409 {
1410  struct cb_debug *p;
1411 
1412  p = make_tree (CB_TAG_DEBUG, CB_CATEGORY_ALPHANUMERIC,
1413  sizeof (struct cb_debug));
1414  p->target = target;
1415  if (str) {
1416  p->value = cobc_parse_strdup (str);
1417  p->fld = NULL;
1418  p->size = strlen (str);
1419  } else {
1420  p->value = NULL;
1421  p->fld = fld;
1422  p->size = (size_t)CB_FIELD_PTR (fld)->size;
1423  }
1424  CB_TREE (p)->source_file = cb_source_file;
1425  CB_TREE (p)->source_line = cb_source_line;
1426  return CB_TREE (p);
1427 }
cb_tree cb_build_debug_call ( struct cb_label *  )

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

1433 {
1434  struct cb_debug_call *p;
1435 
1436  p = make_tree (CB_TAG_DEBUG_CALL, CB_CATEGORY_ALPHANUMERIC,
1437  sizeof (struct cb_debug_call));
1438  p->target = target;
1439  CB_TREE (p)->source_file = cb_source_file;
1440  CB_TREE (p)->source_line = cb_source_line;
1441  return CB_TREE (p);
1442 }
void cb_build_debug_item ( void  )

References cb_build_field_tree(), cb_build_filler(), cb_build_picture(), cb_build_reference(), CB_FIELD, CB_FIELD_ADD, CB_LIST_INIT, CB_PICTURE, cb_space, CB_STORAGE_WORKING, cb_validate_field(), current_program, NULL, and cb_program::working_storage.

2183 {
2184  cb_tree l;
2185  cb_tree x;
2186  cb_tree assign;
2187 
2188  /* Set up DEBUG-ITEM */
2189  l = cb_build_reference ("DEBUG-ITEM");
2190  assign = cb_build_field_tree (NULL, l, NULL, CB_STORAGE_WORKING,
2191  NULL, 1);
2192  CB_FIELD (assign)->values = CB_LIST_INIT (cb_space);
2193  cb_debug_item = l;
2194 
2195  l = cb_build_reference ("DEBUG-LINE");
2196  x = cb_build_field_tree (NULL, l, CB_FIELD(assign),
2197  CB_STORAGE_WORKING, NULL, 3);
2198  CB_FIELD (x)->pic = CB_PICTURE (cb_build_picture ("9(6)"));
2199  cb_validate_field (CB_FIELD (x));
2200  cb_debug_line = l;
2201 
2202  l = cb_build_filler ();
2203  x = cb_build_field_tree (NULL, l, CB_FIELD(x),
2204  CB_STORAGE_WORKING, NULL, 3);
2205  CB_FIELD (x)->pic = CB_PICTURE (cb_build_picture ("X"));
2206  CB_FIELD (x)->flag_filler = 1;
2207  cb_validate_field (CB_FIELD (x));
2208 
2209  l = cb_build_reference ("DEBUG-NAME");
2210  x = cb_build_field_tree (NULL, l, CB_FIELD(x),
2211  CB_STORAGE_WORKING, NULL, 3);
2212  CB_FIELD (x)->pic = CB_PICTURE (cb_build_picture ("X(31)"));
2213  cb_validate_field (CB_FIELD (x));
2214  cb_debug_name = l;
2215 
2216  l = cb_build_filler ();
2217  x = cb_build_field_tree (NULL, l, CB_FIELD(x),
2218  CB_STORAGE_WORKING, NULL, 3);
2219  CB_FIELD (x)->pic = CB_PICTURE (cb_build_picture ("X"));
2220  CB_FIELD (x)->flag_filler = 1;
2221  cb_validate_field (CB_FIELD (x));
2222 
2223  l = cb_build_reference ("DEBUG-SUB-1");
2224  x = cb_build_field_tree (NULL, l, CB_FIELD(x),
2225  CB_STORAGE_WORKING, NULL, 3);
2226  CB_FIELD (x)->pic = CB_PICTURE (cb_build_picture ("S9(4)"));
2227  CB_FIELD (x)->flag_sign_leading = 1;
2228  CB_FIELD (x)->flag_sign_separate = 1;
2229  cb_validate_field (CB_FIELD (x));
2230  cb_debug_sub_1 = l;
2231 
2232  l = cb_build_filler ();
2233  x = cb_build_field_tree (NULL, l, CB_FIELD(x),
2234  CB_STORAGE_WORKING, NULL, 3);
2235  CB_FIELD (x)->pic = CB_PICTURE (cb_build_picture ("X"));
2236  CB_FIELD (x)->flag_filler = 1;
2237  cb_validate_field (CB_FIELD (x));
2238 
2239  l = cb_build_reference ("DEBUG-SUB-2");
2240  x = cb_build_field_tree (NULL, l, CB_FIELD(x),
2241  CB_STORAGE_WORKING, NULL, 3);
2242  CB_FIELD (x)->pic = CB_PICTURE (cb_build_picture ("S9(4)"));
2243  CB_FIELD (x)->flag_sign_leading = 1;
2244  CB_FIELD (x)->flag_sign_separate = 1;
2245  cb_validate_field (CB_FIELD (x));
2246  cb_debug_sub_2 = l;
2247 
2248  l = cb_build_filler ();
2249  x = cb_build_field_tree (NULL, l, CB_FIELD(x),
2250  CB_STORAGE_WORKING, NULL, 3);
2251  CB_FIELD (x)->pic = CB_PICTURE (cb_build_picture ("X"));
2252  CB_FIELD (x)->flag_filler = 1;
2253  cb_validate_field (CB_FIELD (x));
2254 
2255  l = cb_build_reference ("DEBUG-SUB-3");
2256  x = cb_build_field_tree (NULL, l, CB_FIELD(x),
2257  CB_STORAGE_WORKING, NULL, 3);
2258  CB_FIELD (x)->pic = CB_PICTURE (cb_build_picture ("S9(4)"));
2259  CB_FIELD (x)->flag_sign_leading = 1;
2260  CB_FIELD (x)->flag_sign_separate = 1;
2261  cb_validate_field (CB_FIELD (x));
2262  cb_debug_sub_3 = l;
2263 
2264  l = cb_build_filler ();
2265  x = cb_build_field_tree (NULL, l, CB_FIELD(x),
2266  CB_STORAGE_WORKING, NULL, 3);
2267  CB_FIELD (x)->pic = CB_PICTURE (cb_build_picture ("X"));
2268  CB_FIELD (x)->flag_filler = 1;
2269  cb_validate_field (CB_FIELD (x));
2270 
2271  l = cb_build_reference ("DEBUG-CONTENTS");
2272  x = cb_build_field_tree (NULL, l, CB_FIELD(x),
2273  CB_STORAGE_WORKING, NULL, 3);
2274  CB_FIELD (x)->pic = CB_PICTURE (cb_build_picture ("X(31)"));
2275  cb_validate_field (CB_FIELD (x));
2276  cb_debug_contents = l;
2277 
2278  cb_validate_field (CB_FIELD (assign));
2279  CB_FIELD_ADD (current_program->working_storage, CB_FIELD (assign));
2280 }
cb_tree cb_build_decimal ( const int  )

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

1629 {
1630  struct cb_decimal *p;
1631 
1632  p = make_tree (CB_TAG_DECIMAL, CB_CATEGORY_NUMERIC,
1633  sizeof (struct cb_decimal));
1634  p->id = id;
1635  return CB_TREE (p);
1636 }
cb_tree cb_build_direct ( const char *  ,
const unsigned  int 
)

References cb_build_comment(), and CB_DIRECT.

1396 {
1397  cb_tree x;
1398 
1399  x = cb_build_comment (str);
1400  CB_DIRECT (x)->flag_is_direct = 1;
1401  CB_DIRECT (x)->flag_new_line = flagnl;
1402  return x;
1403 }
cb_tree cb_build_display_mnemonic ( cb_tree  )

References _, CB_DEVICE_CONSOLE, CB_DEVICE_SYSERR, CB_DEVICE_SYSOUT, cb_error_node, cb_error_x(), cb_int0, cb_int1, cb_ref(), and CB_SYSTEM_NAME.

5138 {
5139  if (x == cb_error_node) {
5140  return cb_int0;
5141  }
5142  if (cb_ref (x) == cb_error_node) {
5143  return cb_int0;
5144  }
5145 
5146  switch (CB_SYSTEM_NAME (cb_ref (x))->token) {
5147  case CB_DEVICE_CONSOLE:
5148  case CB_DEVICE_SYSOUT:
5149  return cb_int0;
5150  case CB_DEVICE_SYSERR:
5151  return cb_int1;
5152  default:
5153  cb_error_x (x, _("Invalid output device"));
5154  return cb_int0;
5155  }
5156 }
cb_tree cb_build_display_name ( cb_tree  )

References _, CB_DEVICE_CONSOLE, CB_DEVICE_SYSERR, CB_DEVICE_SYSOUT, cb_error_node, cb_error_x(), cb_int0, cb_int1, CB_NAME, CB_SYSTEM_NAME, cb_warning_x(), lookup_system_name(), and cb_file::name.

5160 {
5161  const char *name;
5162  cb_tree sys;
5163 
5164  if (x == cb_error_node) {
5165  return cb_error_node;
5166  }
5167  name = CB_NAME (x);
5168  /* Allow direct reference to a device name */
5169  sys = lookup_system_name (name);
5170  if (sys) {
5171  switch (CB_SYSTEM_NAME (sys)->token) {
5172  case CB_DEVICE_CONSOLE:
5173  case CB_DEVICE_SYSOUT:
5174  if (!cb_relaxed_syntax_check) {
5175  cb_warning_x (x, _("'%s' is not defined in SPECIAL-NAMES"), name);
5176  }
5177  return cb_int0;
5178  case CB_DEVICE_SYSERR:
5179  if (!cb_relaxed_syntax_check) {
5180  cb_warning_x (x, _("'%s' is not defined in SPECIAL-NAMES"), name);
5181  }
5182  return cb_int1;
5183  default:
5184  cb_error_x (x, _("'%s' is not an output device"), name);
5185  return cb_error_node;
5186  }
5187  }
5188 
5189  cb_error_x (x, _("'%s' is not defined in SPECIAL-NAMES"), name);
5190  return cb_error_node;
5191 }
cb_tree cb_build_expr ( cb_tree  )

References CB_CHAIN, CB_CLASS_NAME, cb_expr_finish(), cb_expr_init(), cb_expr_shift(), cb_expr_shift_class(), cb_expr_shift_sign(), CB_PURPOSE_INT, cb_ref(), CB_VALUE, current_statement, NULL, cb_statement::null_check, and cb_binary_op::op.

3060 {
3061  cb_tree l;
3062  int op;
3063 
3064  cb_expr_init ();
3065 
3066  for (l = list; l; l = CB_CHAIN (l)) {
3067  op = CB_PURPOSE_INT (l);
3068  switch (op) {
3069  case '9':
3070  /* NUMERIC */
3071  cb_expr_shift_class ("cob_is_numeric");
3072  break;
3073  case 'A':
3074  /* ALPHABETIC */
3075  cb_expr_shift_class ("cob_is_alpha");
3076  break;
3077  case 'L':
3078  /* ALPHABETIC_LOWER */
3079  cb_expr_shift_class ("cob_is_lower");
3080  break;
3081  case 'U':
3082  /* ALPHABETIC_UPPER */
3083  cb_expr_shift_class ("cob_is_upper");
3084  break;
3085  case 'P':
3086  /* POSITIVE */
3087  cb_expr_shift_sign ('>');
3088  break;
3089  case 'N':
3090  /* NEGATIVE */
3091  cb_expr_shift_sign ('<');
3092  break;
3093  case 'O':
3094  /* OMITTED */
3095  if (current_statement) {
3096  current_statement->null_check = NULL;
3097  }
3098  cb_expr_shift_class ("cob_is_omitted");
3099  break;
3100  case 'C':
3101  /* CLASS */
3102  cb_expr_shift_class (CB_CLASS_NAME (cb_ref (CB_VALUE (l)))->cname);
3103  break;
3104  default:
3105  cb_expr_shift (op, CB_VALUE (l));
3106  break;
3107  }
3108  }
3109 
3110  return cb_expr_finish ();
3111 }
cb_tree cb_build_field ( cb_tree  )

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

2018 {
2019  struct cb_field *p;
2020 
2021  p = make_tree (CB_TAG_FIELD, CB_CATEGORY_UNKNOWN,
2022  sizeof (struct cb_field));
2023  p->id = cb_field_id++;
2024  p->name = cb_define (name, CB_TREE (p));
2025  p->ename = NULL;
2026  p->usage = CB_USAGE_DISPLAY;
2027  p->storage = CB_STORAGE_WORKING;
2028  p->occurs_max = 1;
2029  return CB_TREE (p);
2030 }
cb_tree cb_build_field_reference ( struct cb_field *  ,
cb_tree   
)

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

2456 {
2457  cb_tree x;
2458  struct cb_word *word;
2459 
2460  x = cb_build_reference (f->name);
2461  word = CB_REFERENCE (x)->word;
2462  if (ref) {
2463  memcpy (x, ref, sizeof (struct cb_reference));
2464  }
2465  x->category = CB_CATEGORY_UNKNOWN;
2466  CB_REFERENCE (x)->word = word;
2467  CB_REFERENCE (x)->value = CB_TREE (f);
2468  return x;
2469 }
cb_tree cb_build_field_tree ( cb_tree  ,
cb_tree  ,
struct cb_field *  ,
enum  cb_storage,
struct cb_file *  ,
const int   
)

References _, cb_build_field(), cb_build_filler(), CB_CHAIN, cb_error_node, cb_error_x(), CB_FIELD, cb_field_founder(), CB_FIELD_P, cb_get_level(), cb_needs_01, CB_REFERENCE, CB_STORAGE_FILE, CB_TREE, CB_VALUE, cb_warning_x(), cb_field::children, cb_word::count, current_program, cb_field::flag_external, cb_file::flag_external, cb_field::flag_filler, cb_reference::flag_filler_ref, cb_file::flag_global, cb_program::flag_has_external, cb_field::flag_is_global, cb_field::flag_item_78, cb_field::flag_sign_leading, cb_field::flag_sign_separate, cb_field::indexes, cb_word::items, cb_field::level, NULL, p, cb_field::parent, redefinition_warning(), cb_field::sister, cb_field::storage, cb_field::usage, and cb_reference::word.

Referenced by cb_build_debug_item().

93 {
94  struct cb_reference *r;
95  struct cb_field *f;
96  struct cb_field *p;
97  struct cb_field *field_fill;
98  cb_tree dummy_fill;
99  cb_tree l;
100  cb_tree x;
101  int lv;
102 
103  if (!expl_level) {
104  if (level == cb_error_node || name == cb_error_node) {
105  return cb_error_node;
106  }
107  /* Check the level number */
108  lv = cb_get_level (level);
109  if (!lv) {
110  return cb_error_node;
111  }
112  } else {
113  lv = expl_level;
114  }
115 
116  /* Build the field */
117  r = CB_REFERENCE (name);
118  f = CB_FIELD (cb_build_field (name));
119  f->storage = storage;
120  last_real_field = last_field;
121  if (lv == 78) {
122  f->level = 01;
123  f->flag_item_78 = 1;
124  return CB_TREE (f);
125  } else {
126  f->level = lv;
127  }
128  if (f->level == 01 && storage == CB_STORAGE_FILE && fn) {
129  if (fn->flag_external) {
130  f->flag_external = 1;
131  current_program->flag_has_external = 1;
132  } else if (fn->flag_global) {
133  f->flag_is_global = 1;
134  }
135  }
136  if (last_field) {
137  if (last_field->level == 77 && f->level != 01 &&
138  f->level != 77 && f->level != 66 && f->level != 88) {
139  cb_error_x (name, _("Level number must begin with 01 or 77"));
140  return cb_error_node;
141  }
142  }
143 
144  /* Checks for redefinition */
145  if (cb_warn_redefinition && r->word->count > 1 && !r->flag_filler_ref) {
146  if (f->level == 01 || f->level == 77) {
147  redefinition_warning (name, NULL);
148  } else {
149  for (l = r->word->items; l; l = CB_CHAIN (l)) {
150  x = CB_VALUE (l);
151  if (!CB_FIELD_P (x) ||
152  CB_FIELD (x)->level == 01 ||
153  CB_FIELD (x)->level == 77 ||
154  (last_field && f->level == last_field->level &&
155  CB_FIELD (x)->parent == last_field->parent)) {
156  redefinition_warning (name, x);
157  break;
158  }
159  }
160  }
161  }
162 
163  if (last_field && last_field->level == 88) {
164  last_field = last_field->parent;
165  }
166 
167  /* Link the field into the tree */
168  if (f->level == 01 || f->level == 77) {
169  /* Top level */
170  cb_needs_01 = 0;
171  if (last_field) {
172  cb_field_founder (last_field)->sister = f;
173  }
174  } else if (!last_field || cb_needs_01) {
175  /* Invalid top level */
176  cb_error_x (name, _("Level number must begin with 01 or 77"));
177  return cb_error_node;
178  } else if (f->level == 66) {
179  /* Level 66 */
180  f->parent = cb_field_founder (last_field);
181  for (p = f->parent->children; p && p->sister; p = p->sister) ;
182  if (p) {
183  p->sister = f;
184  }
185  } else if (f->level == 88) {
186  /* Level 88 */
187  f->parent = last_field;
188  } else if (f->level > last_field->level) {
189  /* Lower level */
190  last_field->children = f;
191  f->parent = last_field;
192  } else if (f->level == last_field->level) {
193  /* Same level */
194 same_level:
195  last_field->sister = f;
196  f->parent = last_field->parent;
197  } else {
198  /* Upper level */
199  for (p = last_field->parent; p; p = p->parent) {
200  if (p->level == f->level) {
201  last_field = p;
202  goto same_level;
203  }
204  if (cb_relax_level_hierarchy && p->level < f->level) {
205  break;
206  }
207  }
208  if (cb_relax_level_hierarchy) {
209  dummy_fill = cb_build_filler ();
210  field_fill = CB_FIELD (cb_build_field (dummy_fill));
211  cb_warning_x (name,
212  _("No previous data item of level %02d"),
213  f->level);
214  field_fill->level = f->level;
215  field_fill->flag_filler = 1;
216  field_fill->storage = storage;
217  field_fill->children = p->children;
218  field_fill->parent = p;
219  for (p = p->children; p; p = p->sister) {
220  p->parent = field_fill;
221  }
222  field_fill->parent->children = field_fill;
223  field_fill->sister = f;
224  f->parent = field_fill->parent;
225  /* last_field = field_fill; */
226  } else {
227  cb_error_x (name,
228  _("No previous data item of level %02d"),
229  f->level);
230  return cb_error_node;
231  }
232  }
233 
234  /* Inherit parents properties */
235  if (f->parent) {
236  f->usage = f->parent->usage;
237  f->indexes = f->parent->indexes;
238  f->flag_sign_leading = f->parent->flag_sign_leading;
239  f->flag_sign_separate = f->parent->flag_sign_separate;
240  f->flag_is_global = f->parent->flag_is_global;
241  }
242  return CB_TREE (f);
243 }
cb_tree cb_build_filler ( void  )

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

2443 {
2444  cb_tree x;
2445  char name[20];
2446 
2447  sprintf (name, "FILLER %d", filler_id++);
2448  x = cb_build_reference (name);
2449  x->source_line = cb_source_line;
2450  CB_REFERENCE (x)->flag_filler_ref = 1;
2451  return x;
2452 }
cb_tree cb_build_funcall ( const char *  ,
const int  ,
const cb_tree  ,
const cb_tree  ,
const cb_tree  ,
const cb_tree  ,
const cb_tree  ,
const cb_tree  ,
const cb_tree  ,
const cb_tree  ,
const cb_tree  ,
const cb_tree   
)

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

2772 {
2773  struct cb_funcall *p;
2774 
2775  p = make_tree (CB_TAG_FUNCALL, CB_CATEGORY_BOOLEAN,
2776  sizeof (struct cb_funcall));
2777  p->name = name;
2778  p->argc = argc;
2779  p->varcnt = 0;
2780  p->screenptr = gen_screen_ptr;
2781  p->argv[0] = a1;
2782  p->argv[1] = a2;
2783  p->argv[2] = a3;
2784  p->argv[3] = a4;
2785  p->argv[4] = a5;
2786  p->argv[5] = a6;
2787  p->argv[6] = a7;
2788  p->argv[7] = a8;
2789  p->argv[8] = a9;
2790  p->argv[9] = a10;
2791  return CB_TREE (p);
2792 }
cb_tree cb_build_goto ( const cb_tree  ,
const cb_tree   
)

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

2969 {
2970  struct cb_goto *p;
2971 
2972  p = make_tree (CB_TAG_GOTO, CB_CATEGORY_UNKNOWN,
2973  sizeof (struct cb_goto));
2974  p->target = target;
2975  p->depending = depending;
2976  return CB_TREE (p);
2977 }
cb_tree cb_build_identifier ( cb_tree  ,
const int   
)

References _, CB_ADD_TO_CHAIN, CB_BINARY_OP, CB_BINARY_OP_P, cb_build_address(), cb_build_cast_int(), CB_BUILD_CAST_LENGTH, cb_build_field_reference(), CB_BUILD_FUNCALL_2, CB_BUILD_FUNCALL_4, CB_BUILD_STRING0, CB_CHAIN, cb_check_integer_value(), cb_check_lit_subs(), cb_error_node, cb_error_x(), CB_EXCEPTION_ENABLE, CB_FIELD, cb_field_founder(), CB_FIELD_P, CB_FIELD_PTR, cb_get_int(), cb_int(), cb_int1, cb_list_add(), cb_list_length(), cb_list_reverse(), CB_LITERAL_P, cb_one, cb_ref(), CB_REFERENCE, CB_STORAGE_CONSTANT, CB_STORAGE_LINKAGE, CB_USAGE_NATIONAL, CB_VALUE, cb_warning_x(), cb_reference::check, COB_EC_DATA_PTR_NULL, current_statement, cb_field::depending, cb_reference::flag_all, cb_field::flag_any_length, cb_field::flag_is_pdiv_parm, cb_field::flag_item_based, cb_statement::flag_no_based, cb_field::flag_occurs, cb_field::indexes, cb_reference::length, cb_field::name, cb_word::name, NULL, cb_statement::null_check, cb_field::occurs_max, cb_field::occurs_min, cb_field::offset, cb_reference::offset, p, cb_field::parent, cb_field::redefines, cb_field::size, cb_field::storage, cb_reference::subs, cb_field::usage, cb_field::values, and cb_reference::word.

1398 {
1399  struct cb_reference *r;
1400  struct cb_field *f;
1401  struct cb_field *p;
1402  const char *name;
1403  cb_tree v;
1404  cb_tree e1;
1405  cb_tree e2;
1406  cb_tree l;
1407  cb_tree sub;
1408  int offset;
1409  int length;
1410  int n;
1411  int numsubs;
1412  int refsubs;
1413  int pseudosize;
1414 
1415  if (x == cb_error_node) {
1416  return cb_error_node;
1417  }
1418 
1419  r = CB_REFERENCE (x);
1420  name = r->word->name;
1421 
1422  /* Resolve reference */
1423  v = cb_ref (x);
1424  if (v == cb_error_node) {
1425  return cb_error_node;
1426  }
1427 
1428  /* Check if it is a data name */
1429  if (!CB_FIELD_P (v)) {
1430  if (r->subs) {
1431  cb_error_x (x, _("'%s' cannot be subscripted"), name);
1432  return cb_error_node;
1433  }
1434  if (r->offset) {
1435  cb_error_x (x, _("'%s' cannot be reference modified"), name);
1436  return cb_error_node;
1437  }
1438  return x;
1439  }
1440  f = CB_FIELD (v);
1441 
1442  /* BASED check */
1443  if (current_statement && CB_EXCEPTION_ENABLE (COB_EC_DATA_PTR_NULL)) {
1444  p = cb_field_founder (f);
1445  if (p->redefines) {
1446  p = p->redefines;
1447  }
1448  if (!current_statement->flag_no_based) {
1449  if (p->flag_item_based ||
1450  (f->storage == CB_STORAGE_LINKAGE &&
1451  !p->flag_is_pdiv_parm)) {
1452  current_statement->null_check = CB_BUILD_FUNCALL_2 (
1453  "cob_check_based",
1454  cb_build_address (cb_build_field_reference (p, NULL)),
1455  CB_BUILD_STRING0 (name));
1456  }
1457  }
1458  }
1459 
1460  for (l = r->subs; l; l = CB_CHAIN (l)) {
1461  if (CB_BINARY_OP_P (CB_VALUE (l))) {
1462  /* Set special flag for codegen */
1463  CB_BINARY_OP(CB_VALUE(l))->flag = 1;
1464  }
1465  }
1466 
1467  /* Check the number of subscripts */
1468  numsubs = cb_list_length (r->subs);
1469  cb_check_lit_subs (r, numsubs, f->indexes);
1470  if (subchk) {
1471  if (!f->indexes) {
1472  cb_error_x (x, _("'%s' has no OCCURS clause"), name);
1473  return cb_error_node;
1474  }
1475  numsubs = f->indexes - 1;
1476  } else {
1477  numsubs = f->indexes;
1478  }
1479  refsubs = cb_list_length (r->subs);
1480  if (!r->flag_all && refsubs != numsubs) {
1481  if (refsubs > numsubs) {
1482  goto refsubserr;
1483  } else if (refsubs < numsubs) {
1484  if (!cb_relaxed_syntax_check) {
1485  goto refsubserr;
1486  } else {
1487  cb_warning_x (x,
1488  _("Subscripts missing for '%s' - Defaulting to 1"),
1489  name);
1490  for (; refsubs < numsubs; ++refsubs) {
1491  CB_ADD_TO_CHAIN (cb_one, r->subs);
1492  }
1493  }
1494  }
1495  }
1496 
1497  /* Subscript check */
1498  if (!r->flag_all && r->subs) {
1499  l = r->subs;
1500  for (p = f; p; p = p->parent) {
1501  if (!p->flag_occurs) {
1502  continue;
1503  }
1504 
1505 #if 1 /* RXWRXW - Sub check */
1506  if (!l) {
1507  break;
1508  }
1509 #endif
1510  sub = cb_check_integer_value (CB_VALUE (l));
1511  l = CB_CHAIN (l);
1512  if (sub == cb_error_node) {
1513  continue;
1514  }
1515 
1516  /* Compile-time check */
1517  if (CB_LITERAL_P (sub)) {
1518  n = cb_get_int (sub);
1519  if (n < 1 || n > p->occurs_max) {
1520  cb_error_x (x, _("Subscript of '%s' out of bounds: %d"),
1521  name, n);
1522  }
1523  }
1524 
1525  /* Run-time check */
1526  if (CB_EXCEPTION_ENABLE (COB_EC_BOUND_SUBSCRIPT)) {
1527  if (p->depending) {
1528  e1 = CB_BUILD_FUNCALL_4 ("cob_check_odo",
1529  cb_build_cast_int (p->depending),
1530  cb_int (p->occurs_min),
1531  cb_int (p->occurs_max),
1532  CB_BUILD_STRING0
1533  ((CB_FIELD_PTR (p->depending)->name)));
1534  e2 = CB_BUILD_FUNCALL_4 ("cob_check_subscript",
1535  cb_build_cast_int (sub),
1536  cb_int1,
1537  cb_build_cast_int (p->depending),
1538  CB_BUILD_STRING0 (name));
1539  r->check = cb_list_add (r->check, e1);
1540  r->check = cb_list_add (r->check, e2);
1541  } else {
1542  if (!CB_LITERAL_P (sub)) {
1543  e1 = CB_BUILD_FUNCALL_4 ("cob_check_subscript",
1544  cb_build_cast_int (sub),
1545  cb_int1,
1546  cb_int (p->occurs_max),
1547  CB_BUILD_STRING0 (name));
1548  r->check = cb_list_add (r->check, e1);
1549  }
1550  }
1551  }
1552  }
1553  }
1554 
1555  if (subchk) {
1556  r->subs = cb_list_reverse (r->subs);
1557  r->subs = cb_list_add (r->subs, cb_int1);
1558  r->subs = cb_list_reverse (r->subs);
1559  }
1560 
1561  /* Reference modification check */
1562  if ( f->usage == CB_USAGE_NATIONAL ) {
1563  pseudosize = f->size / 2;
1564  } else {
1565  pseudosize = f->size;
1566  }
1567  if (r->offset) {
1568  /* Compile-time check */
1569  if (CB_LITERAL_P (r->offset)) {
1570  offset = cb_get_int (r->offset);
1571  if (f->flag_any_length) {
1572  if (offset < 1) {
1573  cb_error_x (x, _("Offset of '%s' out of bounds: %d"), name, offset);
1574  } else if (r->length && CB_LITERAL_P (r->length)) {
1575  length = cb_get_int (r->length);
1576  if (length < 1) {
1577  cb_error_x (x, _("Length of '%s' out of bounds: %d"),
1578  name, length);
1579  }
1580  }
1581  } else {
1582  if (offset < 1 || offset > pseudosize) {
1583  cb_error_x (x, _("Offset of '%s' out of bounds: %d"), name, offset);
1584  } else if (r->length && CB_LITERAL_P (r->length)) {
1585  length = cb_get_int (r->length);
1586  if (length < 1 || length > pseudosize - offset + 1) {
1587  cb_error_x (x, _("Length of '%s' out of bounds: %d"),
1588  name, length);
1589  }
1590  }
1591  }
1592  }
1593 
1594  /* Run-time check */
1595  if (CB_EXCEPTION_ENABLE (COB_EC_BOUND_REF_MOD)) {
1596  if (f->flag_any_length || !CB_LITERAL_P (r->offset) ||
1597  (r->length && !CB_LITERAL_P (r->length))) {
1598  e1 = CB_BUILD_FUNCALL_4 ("cob_check_ref_mod",
1599  cb_build_cast_int (r->offset),
1600  r->length ?
1601  cb_build_cast_int (r->length) :
1602  cb_int1,
1603  f->flag_any_length ?
1604  CB_BUILD_CAST_LENGTH (v) :
1605  cb_int (pseudosize),
1606  CB_BUILD_STRING0 (f->name));
1607  r->check = cb_list_add (r->check, e1);
1608  }
1609  }
1610  }
1611 
1612  if (f->storage == CB_STORAGE_CONSTANT) {
1613  return CB_VALUE (f->values);
1614  }
1615 
1616  return x;
1617 
1618 refsubserr:
1619  switch (numsubs) {
1620  case 0:
1621  cb_error_x (x, _("'%s' cannot be subscripted"), name);
1622  break;
1623  case 1:
1624  cb_error_x (x, _("'%s' requires 1 subscript"), name);
1625  break;
1626  default:
1627  cb_error_x (x, _("'%s' requires %d subscripts"),
1628  name, f->indexes);
1629  break;
1630  }
1631  return cb_error_node;
1632 }
cb_tree cb_build_if ( const cb_tree  ,
const cb_tree  ,
const cb_tree  ,
const unsigned  int 
)

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

2984 {
2985  struct cb_if *p;
2986 
2987  p = make_tree (CB_TAG_IF, CB_CATEGORY_UNKNOWN,
2988  sizeof (struct cb_if));
2989  p->test = test;
2990  p->stmt1 = stmt1;
2991  p->stmt2 = stmt2;
2992  p->is_if = is_if;
2993  return CB_TREE (p);
2994 }
cb_tree cb_build_if_check_break ( cb_tree  ,
cb_tree   
)

References cb_build_if(), cb_check_needs_break(), and NULL.

5469 {
5470  cb_tree stmt_lis;
5471 
5472  stmt_lis = cb_check_needs_break (stmts);
5473  return cb_build_if (cond, stmt_lis, NULL, 0);
5474 }
cb_tree cb_build_implicit_field ( cb_tree  ,
const int   
)

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

2034 {
2035  cb_tree x;
2036  char pic[32];
2037 
2038  x = cb_build_field (name);
2039  memset (pic, 0, sizeof(pic));
2040  snprintf (pic, sizeof(pic), "X(%d)", len);
2041  CB_FIELD (x)->pic = CB_PICTURE (cb_build_picture (pic));
2042  cb_validate_field (CB_FIELD (x));
2043  return x;
2044 }
cb_tree cb_build_index ( cb_tree  ,
cb_tree  ,
const unsigned  int,
struct cb_field *   
)

References cb_build_field(), CB_FIELD, CB_FIELD_ADD, CB_LIST_INIT, CB_USAGE_INDEX, cb_validate_field(), current_program, cb_field::flag_indexed_by, cb_field::index_qual, cb_field::usage, cb_field::values, and cb_program::working_storage.

1310 {
1311  struct cb_field *f;
1312 
1313  f = CB_FIELD (cb_build_field (x));
1314  f->usage = CB_USAGE_INDEX;
1315  cb_validate_field (f);
1316  if (values) {
1317  f->values = CB_LIST_INIT (values);
1318  }
1319  if (qual) {
1320  f->index_qual = qual;
1321  }
1322  f->flag_indexed_by = !!indexed_by;
1323  CB_FIELD_ADD (current_program->working_storage, f);
1324  return x;
1325 }
cb_tree cb_build_initialize ( const cb_tree  ,
const cb_tree  ,
const cb_tree  ,
const unsigned  int,
const unsigned  int,
const unsigned  int 
)

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

2882 {
2883  struct cb_initialize *p;
2884 
2885  p = make_tree (CB_TAG_INITIALIZE, CB_CATEGORY_UNKNOWN,
2886  sizeof (struct cb_initialize));
2887  p->var = var;
2888  p->val = val;
2889  p->rep = rep;
2890  p->flag_default = (cob_u8_t)def;
2891  p->flag_init_statement = (cob_u8_t)is_statement;
2892  p->flag_no_filler_init = (cob_u8_t)no_filler_init;
2893  return CB_TREE (p);
2894 }
cb_tree cb_build_inspect_region_start ( void  )

References CB_BUILD_FUNCALL_0, and CB_LIST_INIT.

5751 {
5752  return CB_LIST_INIT (CB_BUILD_FUNCALL_0 ("cob_inspect_start"));
5753 }
cb_tree cb_build_intrinsic ( cb_tree  ,
cb_tree  ,
cb_tree  ,
const int   
)

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

3103 {
3104  struct cb_intrinsic_table *cbp;
3105  cb_tree x;
3106  int numargs;
3107  enum cb_category catg;
3108 
3109  numargs = cb_list_length (args);
3110 
3111  if (unlikely(isuser)) {
3112  if (refmod && CB_LITERAL_P(CB_PAIR_X(refmod)) &&
3113  cb_get_int (CB_PAIR_X(refmod)) < 1) {
3114  cb_error_x (name, _("FUNCTION '%s' has invalid reference modification"), CB_NAME(name));
3115  return cb_error_node;
3116  }
3117  if (refmod && CB_PAIR_Y(refmod) &&
3118  CB_LITERAL_P(CB_PAIR_Y(refmod)) &&
3119  cb_get_int (CB_PAIR_Y(refmod)) < 1) {
3120  cb_error_x (name, _("FUNCTION '%s' has invalid reference modification"), CB_NAME(name));
3121  return cb_error_node;
3122  }
3123  if (numargs > current_program->max_call_param) {
3124  current_program->max_call_param = numargs;
3125  }
3126  return make_intrinsic (name, &userbp, args, cb_int1, refmod, 1);
3127  }
3128 
3129  cbp = lookup_intrinsic (CB_NAME (name), 0, 1);
3130  if (!cbp) {
3131  cb_error_x (name, _("FUNCTION '%s' unknown"), CB_NAME (name));
3132  return cb_error_node;
3133  }
3134  if (!cbp->implemented) {
3135  cb_error_x (name, _("FUNCTION '%s' not implemented"),
3136  cbp->name);
3137  return cb_error_node;
3138  }
3139  if ((cbp->args >= 0 && numargs != cbp->args) ||
3140  (cbp->args < 0 && numargs < cbp->min_args)) {
3141  cb_error_x (name,
3142  _("FUNCTION '%s' has wrong number of arguments"),
3143  cbp->name);
3144  return cb_error_node;
3145  }
3146  if (refmod) {
3147  if (!cbp->refmod) {
3148  cb_error_x (name, _("FUNCTION '%s' can not have reference modification"), cbp->name);
3149  return cb_error_node;
3150  }
3151  if (CB_LITERAL_P(CB_PAIR_X(refmod)) &&
3152  cb_get_int (CB_PAIR_X(refmod)) < 1) {
3153  cb_error_x (name, _("FUNCTION '%s' has invalid reference modification"), cbp->name);
3154  return cb_error_node;
3155  }
3156  if (CB_PAIR_Y(refmod) && CB_LITERAL_P(CB_PAIR_Y(refmod)) &&
3157  cb_get_int (CB_PAIR_Y(refmod)) < 1) {
3158  cb_error_x (name, _("FUNCTION '%s' has invalid reference modification"), cbp->name);
3159  return cb_error_node;
3160  }
3161  }
3162 
3163  if (iso_8601_func (cbp->intr_enum)) {
3164  if (!valid_const_date_time_args (name, cbp, args)) {
3165  return cb_error_node;
3166  }
3167  }
3168 
3169  switch (cbp->intr_enum) {
3170  case CB_INTR_LENGTH:
3171  case CB_INTR_BYTE_LENGTH:
3172  x = CB_VALUE (args);
3173  if (CB_LITERAL_P (x)) {
3174  return cb_build_length (x);
3175  } else {
3176  return make_intrinsic (name, cbp, args, NULL, NULL, 0);
3177  }
3178 
3179  case CB_INTR_WHEN_COMPILED:
3180  if (refmod) {
3181  return make_intrinsic (name, cbp,
3182  CB_LIST_INIT (cb_intr_whencomp), NULL, refmod, 0);
3183  } else {
3184  return cb_intr_whencomp;
3185  }
3186 
3187  case CB_INTR_ABS:
3188  case CB_INTR_ACOS:
3189  case CB_INTR_ASIN:
3190  case CB_INTR_ATAN:
3191  case CB_INTR_COS:
3192  case CB_INTR_DATE_OF_INTEGER:
3193  case CB_INTR_DAY_OF_INTEGER:
3194  case CB_INTR_EXP:
3195  case CB_INTR_EXP10:
3196  case CB_INTR_FACTORIAL:
3197  case CB_INTR_FRACTION_PART:
3198  case CB_INTR_INTEGER:
3199  case CB_INTR_INTEGER_OF_DATE:
3200  case CB_INTR_INTEGER_OF_DAY:
3201  case CB_INTR_INTEGER_PART:
3202  case CB_INTR_LOG:
3203  case CB_INTR_LOG10:
3204  case CB_INTR_SIGN:
3205  case CB_INTR_SIN:
3206  case CB_INTR_SQRT:
3207  case CB_INTR_TAN:
3208  case CB_INTR_TEST_DATE_YYYYMMDD:
3209  case CB_INTR_TEST_DAY_YYYYDDD:
3210  x = CB_VALUE (args);
3211  if (cb_tree_category (x) != CB_CATEGORY_NUMERIC) {
3212  cb_error_x (name, _("FUNCTION '%s' has invalid parameter"), cbp->name);
3213  return cb_error_node;
3214  }
3215  return make_intrinsic (name, cbp, args, NULL, refmod, 0);
3216 
3217  case CB_INTR_ANNUITY:
3218  case CB_INTR_BOOLEAN_OF_INTEGER:
3219  case CB_INTR_CHAR:
3220  case CB_INTR_CHAR_NATIONAL:
3221  case CB_INTR_COMBINED_DATETIME:
3222  case CB_INTR_CURRENCY_SYMBOL:
3223  case CB_INTR_CURRENT_DATE:
3224  case CB_INTR_E:
3225  case CB_INTR_EXCEPTION_FILE:
3226  case CB_INTR_EXCEPTION_FILE_N:
3227  case CB_INTR_EXCEPTION_LOCATION:
3228  case CB_INTR_EXCEPTION_LOCATION_N:
3229  case CB_INTR_EXCEPTION_STATUS:
3230  case CB_INTR_EXCEPTION_STATEMENT:
3231  case CB_INTR_FORMATTED_CURRENT_DATE:
3232  case CB_INTR_FORMATTED_DATE:
3233  case CB_INTR_INTEGER_OF_BOOLEAN:
3234  case CB_INTR_INTEGER_OF_FORMATTED_DATE:
3235  case CB_INTR_LOCALE_DATE:
3236  case CB_INTR_LOCALE_TIME:
3237  case CB_INTR_LOCALE_TIME_FROM_SECS:
3238  case CB_INTR_LOWER_CASE:
3239  case CB_INTR_MOD:
3240  case CB_INTR_MODULE_CALLER_ID:
3241  case CB_INTR_MODULE_DATE:
3242  case CB_INTR_MODULE_FORMATTED_DATE:
3243  case CB_INTR_MODULE_ID:
3244  case CB_INTR_MODULE_PATH:
3245  case CB_INTR_MODULE_SOURCE:
3246  case CB_INTR_MODULE_TIME:
3247  case CB_INTR_MON_DECIMAL_POINT:
3248  case CB_INTR_MON_THOUSANDS_SEP:
3249  case CB_INTR_NUM_DECIMAL_POINT:
3250  case CB_INTR_NUM_THOUSANDS_SEP:
3251  case CB_INTR_NUMVAL:
3252  case CB_INTR_NUMVAL_C:
3253  case CB_INTR_NUMVAL_F:
3254  case CB_INTR_ORD:
3255  case CB_INTR_PI:
3256  case CB_INTR_REM:
3257  case CB_INTR_REVERSE:
3258  case CB_INTR_SECONDS_FROM_FORMATTED_TIME:
3259  case CB_INTR_SECONDS_PAST_MIDNIGHT:
3260  case CB_INTR_STORED_CHAR_LENGTH:
3261  case CB_INTR_TEST_FORMATTED_DATETIME:
3262  case CB_INTR_TEST_NUMVAL:
3263  case CB_INTR_TEST_NUMVAL_C:
3264  case CB_INTR_TEST_NUMVAL_F:
3265  case CB_INTR_TRIM:
3266  case CB_INTR_UPPER_CASE:
3267  return make_intrinsic (name, cbp, args, NULL, refmod, 0);
3268 
3269  case CB_INTR_HIGHEST_ALGEBRAIC:
3270  case CB_INTR_LOWEST_ALGEBRAIC:
3271  x = CB_VALUE (args);
3272  if (!CB_REF_OR_FIELD_P (x)) {
3273  cb_error_x (name, _("FUNCTION '%s' has invalid parameter"), cbp->name);
3274  return cb_error_node;
3275  }
3276  catg = cb_tree_category (x);
3277  if (catg != CB_CATEGORY_NUMERIC &&
3278  catg != CB_CATEGORY_NUMERIC_EDITED) {
3279  cb_error_x (name, _("FUNCTION '%s' has invalid parameter"), cbp->name);
3280  return cb_error_node;
3281  }
3282  return make_intrinsic (name, cbp, args, NULL, refmod, 0);
3283 
3284 
3285  case CB_INTR_CONCATENATE:
3286  case CB_INTR_DISPLAY_OF:
3287  case CB_INTR_FORMATTED_DATETIME:
3288  case CB_INTR_FORMATTED_TIME:
3289  case CB_INTR_NATIONAL_OF:
3290  return make_intrinsic (name, cbp, args, cb_int1, refmod, 0);
3291 
3292  case CB_INTR_DATE_TO_YYYYMMDD:
3293  case CB_INTR_DAY_TO_YYYYDDD:
3294  case CB_INTR_LOCALE_COMPARE:
3295  case CB_INTR_MAX:
3296  case CB_INTR_MEAN:
3297  case CB_INTR_MEDIAN:
3298  case CB_INTR_MIDRANGE:
3299  case CB_INTR_MIN:
3300  case CB_INTR_ORD_MAX:
3301  case CB_INTR_ORD_MIN:
3302  case CB_INTR_PRESENT_VALUE:
3303  case CB_INTR_RANDOM:
3304  case CB_INTR_RANGE:
3305  case CB_INTR_STANDARD_COMPARE:
3306  case CB_INTR_STANDARD_DEVIATION:
3307  case CB_INTR_SUM:
3308  case CB_INTR_VARIANCE:
3309  case CB_INTR_YEAR_TO_YYYY:
3310  return make_intrinsic (name, cbp, args, cb_int1, NULL, 0);
3311  case CB_INTR_SUBSTITUTE:
3312  case CB_INTR_SUBSTITUTE_CASE:
3313  if ((numargs % 2) == 0) {
3314  cb_error_x (name, _("FUNCTION '%s' has wrong number of arguments"), cbp->name);
3315  return cb_error_node;
3316  }
3317 #if 0 /* RXWRXW - Substitute param 1 */
3318  x = CB_VALUE (args);
3319  if (!CB_REF_OR_FIELD_P (x)) {
3320  cb_error_x (name, _("FUNCTION '%s' has invalid first parameter"), cbp->name);
3321  return cb_error_node;
3322  }
3323 #endif
3324  return make_intrinsic (name, cbp, args, cb_int1, refmod, 0);
3325 
3326  default:
3327  cb_error_x (name, _("FUNCTION '%s' unknown"), CB_NAME (name));
3328  return cb_error_node;
3329  }
3330 }
cb_tree cb_build_label ( cb_tree  ,
struct cb_label *   
)

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

2839 {
2840  struct cb_label *p;
2841  struct cb_para_label *l;
2842 
2843  p = make_tree (CB_TAG_LABEL, CB_CATEGORY_UNKNOWN,
2844  sizeof (struct cb_label));
2845  p->id = cb_id++;
2846  p->name = cb_define (name, CB_TREE (p));
2847  p->orig_name = p->name;
2848  p->section = section;
2849  if (section) {
2850  l = cobc_parse_malloc (sizeof(struct cb_para_label));
2851  l->next = section->para_label;
2852  l->para= p;
2853  section->para_label = l;
2854  p->section_id = p->section->id;
2855  } else {
2856  p->section_id = p->id;
2857  }
2858  return CB_TREE (p);
2859 }
cb_tree cb_build_length ( cb_tree  )

References cb_build_any_intrinsic(), cb_build_assign(), cb_build_filler(), cb_build_index(), cb_build_length_1(), cb_build_numeric_literal(), cb_emit, cb_error_node, CB_FIELD, cb_field_size(), cb_field_variable_size(), CB_INTRINSIC_P, CB_LIST_INIT, CB_LITERAL, CB_LITERAL_P, cb_ref(), CB_REF_OR_FIELD_P, CB_REFERENCE, CB_REFERENCE_P, CB_USAGE_LENGTH, cb_field::flag_any_length, NULL, and cb_literal::size.

1721 {
1722  struct cb_field *f;
1723  struct cb_literal *l;
1724  cb_tree temp;
1725  char buff[32];
1726 
1727  if (x == cb_error_node) {
1728  return cb_error_node;
1729  }
1730  if (CB_REFERENCE_P (x) && cb_ref (x) == cb_error_node) {
1731  return cb_error_node;
1732  }
1733 
1734  if (CB_LITERAL_P (x)) {
1735  l = CB_LITERAL (x);
1736  sprintf (buff, "%d", (int)l->size);
1737  return cb_build_numeric_literal (0, buff, 0);
1738  }
1739  if (CB_INTRINSIC_P (x)) {
1740  return cb_build_any_intrinsic (CB_LIST_INIT (x));
1741  }
1742  if (CB_REF_OR_FIELD_P (x)) {
1743  if (CB_REFERENCE_P (x) && CB_REFERENCE (x)->offset) {
1744  return cb_build_any_intrinsic (CB_LIST_INIT (x));
1745  }
1746  f = CB_FIELD (cb_ref (x));
1747  if (f->flag_any_length) {
1748  return cb_build_any_intrinsic (CB_LIST_INIT (x));
1749  }
1750  if (cb_field_variable_size (f) == NULL) {
1751  sprintf (buff, "%d", cb_field_size (x));
1752  return cb_build_numeric_literal (0, buff, 0);
1753  }
1754  }
1755  temp = cb_build_index (cb_build_filler (), NULL, 0, NULL);
1756  CB_FIELD (cb_ref (temp))->usage = CB_USAGE_LENGTH;
1757  CB_FIELD (cb_ref (temp))->count++;
1758  cb_emit (cb_build_assign (temp, cb_build_length_1 (x)));
1759  return temp;
1760 }
cb_tree cb_build_list ( cb_tree  ,
cb_tree  ,
cb_tree   
)

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

1134 {
1135  struct cb_list *p;
1136 
1137  p = make_tree (CB_TAG_LIST, CB_CATEGORY_UNKNOWN, sizeof (struct cb_list));
1138  p->chain = chain;
1139  p->value = value;
1140  p->purpose = purpose;
1141  return CB_TREE (p);
1142 }
cb_tree cb_build_locale_name ( cb_tree  ,
cb_tree   
)

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

1488 {
1489  struct cb_class_name *p;
1490 
1491  if (!name || name == cb_error_node) {
1492  return NULL;
1493  }
1494  if (!CB_LITERAL_P (list) || CB_NUMERIC_LITERAL_P (list)) {
1495  cb_error (_("Invalid LOCALE literal"));
1496  return cb_error_node;
1497  }
1498  p = make_tree (CB_TAG_LOCALE_NAME, CB_CATEGORY_UNKNOWN,
1499  sizeof (struct cb_locale_name));
1500  p->name = cb_define (name, CB_TREE (p));
1501  p->cname = cb_to_cname (p->name);
1502  p->list = list;
1503  return CB_TREE (p);
1504 }
cb_tree cb_build_move ( cb_tree  ,
cb_tree   
)

References CB_ALPHABET_NAME_P, cb_build_assign(), cb_build_cast_int(), CB_BUILD_FUNCALL_2, cb_build_move_field(), cb_build_move_high(), cb_build_move_literal(), cb_build_move_low(), cb_build_move_quote(), cb_build_move_space(), cb_build_move_zero(), CB_CATEGORY_NUMERIC, CB_CATEGORY_NUMERIC_EDITED, CB_CLASS_POINTER, cb_error_node, cb_high, CB_INDEX_P, CB_INTRINSIC_P, CB_LITERAL_P, cb_low, cb_null, cb_quote, CB_REFERENCE, CB_REFERENCE_P, cb_space, CB_TREE, CB_TREE_CATEGORY, CB_TREE_CLASS, cb_zero, check, cobc_parse_malloc(), cb_reference::flag_receiving, validate_move(), and value.

7103 {
7104  struct cb_reference *x;
7105 
7106  if (src == cb_error_node || dst == cb_error_node) {
7107  return cb_error_node;
7108  }
7109 
7110  if (validate_move (src, dst, 0) < 0) {
7111  return cb_error_node;
7112  }
7113 
7114 #if 0 /* Flag receiving */
7115  if (CB_REFERENCE_P (src)) {
7116  CB_REFERENCE (src)->flag_receiving = 0;
7117  }
7118 #endif
7119 
7120  if (CB_REFERENCE_P (dst)) {
7121  /* Clone reference */
7122  x = cobc_parse_malloc (sizeof(struct cb_reference));
7123  *x = *CB_REFERENCE (dst);
7124  x->flag_receiving = 1;
7125  dst = CB_TREE (x);
7126  }
7127 
7128  if ((src == cb_space || src == cb_low ||
7129  src == cb_high || src == cb_quote) &&
7130  (CB_TREE_CATEGORY (dst) == CB_CATEGORY_NUMERIC ||
7131  CB_TREE_CATEGORY (dst) == CB_CATEGORY_NUMERIC_EDITED)) {
7132  src = cb_zero;
7133  }
7134 
7135  if (CB_TREE_CLASS (dst) == CB_CLASS_POINTER ||
7136  CB_TREE_CLASS (src) == CB_CLASS_POINTER) {
7137  return cb_build_assign (dst, src);
7138  }
7139 
7140  if (CB_REFERENCE_P (src) &&
7141  CB_ALPHABET_NAME_P(CB_REFERENCE(src)->value)) {
7142  return CB_BUILD_FUNCALL_2 ("cob_move", src, dst);
7143  }
7144  if (CB_INDEX_P (dst)) {
7145  if (src == cb_null) {
7146  return cb_build_assign (dst, cb_zero);
7147  }
7148  return cb_build_assign (dst, src);
7149  }
7150 
7151  if (CB_INDEX_P (src)) {
7152  return CB_BUILD_FUNCALL_2 ("cob_set_int", dst,
7153  cb_build_cast_int (src));
7154  }
7155 
7156  if (CB_INTRINSIC_P (src) || CB_INTRINSIC_P (dst)) {
7157  return CB_BUILD_FUNCALL_2 ("cob_move", src, dst);
7158  }
7159 
7160  if (CB_REFERENCE_P (src) && CB_REFERENCE (src)->check) {
7161  return CB_BUILD_FUNCALL_2 ("cob_move", src, dst);
7162  }
7163  if (CB_REFERENCE_P (dst) && CB_REFERENCE (dst)->check) {
7164  return CB_BUILD_FUNCALL_2 ("cob_move", src, dst);
7165  }
7166 
7167  /* Output optimal code */
7168  if (src == cb_zero) {
7169  return cb_build_move_zero (dst);
7170  } else if (src == cb_space) {
7171  return cb_build_move_space (dst);
7172  } else if (src == cb_high) {
7173  return cb_build_move_high (dst);
7174  } else if (src == cb_low) {
7175  return cb_build_move_low (dst);
7176  } else if (src == cb_quote) {
7177  return cb_build_move_quote (dst);
7178  } else if (CB_LITERAL_P (src)) {
7179  return cb_build_move_literal (src, dst);
7180  }
7181  return cb_build_move_field (src, dst);
7182 }
cb_tree cb_build_numeric_literal ( const int  ,
const void *  ,
const int   
)

References build_literal(), CB_CATEGORY_NUMERIC, CB_TREE, p, cb_literal::scale, and cb_literal::sign.

1525 {
1526  struct cb_literal *p;
1527 
1528  p = build_literal (CB_CATEGORY_NUMERIC, data, strlen (data));
1529  p->sign = (short)sign;
1530  p->scale = scale;
1531  return CB_TREE (p);
1532 }
cb_tree cb_build_numsize_literal ( const void *  ,
const size_t  ,
const int   
)

References build_literal(), CB_CATEGORY_NUMERIC, CB_TREE, p, and cb_literal::sign.

1536 {
1537  struct cb_literal *p;
1538 
1539  p = build_literal (CB_CATEGORY_NUMERIC, data, size);
1540  p->sign = (short)sign;
1541  return CB_TREE (p);
1542 }
cb_tree cb_build_perform ( const enum  cb_perform_type)

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

3000 {
3001  struct cb_perform *p;
3002 
3003  p = make_tree (CB_TAG_PERFORM, CB_CATEGORY_UNKNOWN,
3004  sizeof (struct cb_perform));
3005  p->perform_type = type;
3006  return CB_TREE (p);
3007 }
cb_tree cb_build_perform_exit ( struct cb_label *  )

References cb_build_perform(), CB_PERFORM, CB_PERFORM_EXIT, and CB_TREE.

7344 {
7345  cb_tree x;
7346 
7347  x = cb_build_perform (CB_PERFORM_EXIT);
7348  CB_PERFORM (x)->data = CB_TREE (label);
7349  return x;
7350 }
cb_tree cb_build_perform_forever ( cb_tree  )

References cb_build_perform(), cb_error_node, CB_PERFORM, and CB_PERFORM_FOREVER.

7331 {
7332  cb_tree x;
7333 
7334  if (body == cb_error_node) {
7335  return cb_error_node;
7336  }
7337  x = cb_build_perform (CB_PERFORM_FOREVER);
7338  CB_PERFORM (x)->body = body;
7339  return x;
7340 }
cb_tree cb_build_perform_once ( cb_tree  )

References cb_build_perform(), cb_error_node, CB_PERFORM, and CB_PERFORM_ONCE.

7293 {
7294  cb_tree x;
7295 
7296  if (body == cb_error_node) {
7297  return cb_error_node;
7298  }
7299  x = cb_build_perform (CB_PERFORM_ONCE);
7300  CB_PERFORM (x)->body = body;
7301  return x;
7302 }
cb_tree cb_build_perform_times ( cb_tree  )

References cb_build_perform(), cb_check_integer_value(), cb_error_node, CB_PERFORM, and CB_PERFORM_TIMES.

7306 {
7307  cb_tree x;
7308 
7309  if (cb_check_integer_value (times) == cb_error_node) {
7310  return cb_error_node;
7311  }
7312 
7313  x = cb_build_perform (CB_PERFORM_TIMES);
7314  CB_PERFORM (x)->data = times;
7315  return x;
7316 }
cb_tree cb_build_perform_until ( cb_tree  ,
cb_tree   
)

References cb_build_perform(), CB_PERFORM, and CB_PERFORM_UNTIL.

7320 {
7321  cb_tree x;
7322 
7323  x = cb_build_perform (CB_PERFORM_UNTIL);
7324  CB_PERFORM (x)->test = condition;
7325  CB_PERFORM (x)->varying = varying;
7326  return x;
7327 }
cb_tree cb_build_perform_varying ( cb_tree  ,
cb_tree  ,
cb_tree  ,
cb_tree   
)

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

3011 {
3012  struct cb_perform_varying *p;
3013  cb_tree x;
3014  cb_tree l;
3015 
3016  p = make_tree (CB_TAG_PERFORM_VARYING, CB_CATEGORY_UNKNOWN,
3017  sizeof (struct cb_perform_varying));
3018  p->name = name;
3019  p->from = from;
3020  p->until = until;
3021  if (name) {
3022  if (name == cb_error_node) {
3023  p->step = NULL;
3024  return CB_TREE (p);
3025  }
3026  l = cb_ref (name);
3027  x = cb_build_add (name, by, cb_high);
3028  if (current_program->flag_debugging &&
3029  !current_statement->flag_in_debug &&
3030  CB_FIELD_P (l) && CB_FIELD (l)->flag_field_debug) {
3031  p->step = CB_LIST_INIT (x);
3032  x = cb_build_debug (cb_debug_name, CB_FIELD_PTR (name)->name,
3033  NULL);
3034  p->step = cb_list_add (p->step, x);
3035  x = cb_build_debug (cb_debug_contents, NULL, name);
3036  p->step = cb_list_add (p->step, x);
3037  x = cb_build_debug_call (CB_FIELD_PTR (name)->debug_section);
3038  p->step = cb_list_add (p->step, x);
3039  } else {
3040  p->step = x;
3041  }
3042  } else {
3043  p->step = NULL;
3044  }
3045  return CB_TREE (p);
3046 }
cb_tree cb_build_picture ( const char *  )

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

1659 {
1660  struct cb_picture *pic;
1661  const unsigned char *p;
1662  size_t idx;
1663  size_t buffcnt;
1664  cob_u32_t at_beginning;
1665  cob_u32_t at_end;
1666  cob_u32_t p_char_seen;
1667  cob_u32_t s_char_seen;
1668  cob_u32_t dp_char_seen;
1669  cob_u32_t real_digits;
1670  cob_u32_t s_count;
1671  cob_u32_t v_count;
1672  cob_u32_t allocated;
1673  cob_u32_t x_digits;
1674  cob_u32_t digits;
1675  int category;
1676  int size;
1677  int scale;
1678  int i;
1679  int n;
1680  unsigned char c;
1681  unsigned char lastonechar;
1682  unsigned char lasttwochar;
1683 
1684  pic = make_tree (CB_TAG_PICTURE, CB_CATEGORY_UNKNOWN,
1685  sizeof (struct cb_picture));
1686  if (strlen (str) > 50) {
1687  goto error;
1688  }
1689  if (!pic_buff) {
1690  pic_buff = cobc_main_malloc ((size_t)COB_SMALL_BUFF);
1691  }
1692 
1693  idx = 0;
1694  buffcnt = 0;
1695  p_char_seen = 0;
1696  s_char_seen = 0;
1697  dp_char_seen = 0;
1698  category = 0;
1699  size = 0;
1700  allocated = 0;
1701  digits = 0;
1702  x_digits = 0;
1703  real_digits = 0;
1704  scale = 0;
1705  s_count = 0;
1706  v_count = 0;
1707  lastonechar = 0;
1708  lasttwochar = 0;
1709 
1710  for (p = (const unsigned char *)str; *p; p++) {
1711  n = 1;
1712  c = *p;
1713 repeat:
1714  /* Count the number of repeated chars */
1715  while (p[1] == c) {
1716  p++, n++;
1717  }
1718 
1719  /* Add parenthesized numbers */
1720  if (p[1] == '(') {
1721  i = 0;
1722  p += 2;
1723  for (; *p == '0'; p++) {
1724  ;
1725  }
1726  for (; *p != ')'; p++) {
1727  if (!isdigit (*p)) {
1728  goto error;
1729  } else {
1730  allocated++;
1731  if (allocated > 9) {
1732  goto error;
1733  }
1734  i = i * 10 + (*p - '0');
1735  }
1736  }
1737  if (i == 0) {
1738  goto error;
1739  }
1740  n += i - 1;
1741  goto repeat;
1742  }
1743 
1744  /* Check grammar and category */
1745  /* FIXME: need more error checks */
1746  switch (c) {
1747  case 'A':
1748  if (s_char_seen || p_char_seen) {
1749  goto error;
1750  }
1751  category |= PIC_ALPHABETIC;
1752  x_digits += n;
1753  break;
1754 
1755  case 'X':
1756  if (s_char_seen || p_char_seen) {
1757  goto error;
1758  }
1759  category |= PIC_ALPHANUMERIC;
1760  x_digits += n;
1761  break;
1762 
1763  case '9':
1764  category |= PIC_NUMERIC;
1765  digits += n;
1766  real_digits += n;
1767  if (v_count) {
1768  scale += n;
1769  }
1770  break;
1771 
1772  case 'N':
1773  if (s_char_seen || p_char_seen) {
1774  goto error;
1775  }
1776  category |= PIC_NATIONAL;
1777  x_digits += n;
1778  break;
1779 
1780  case 'S':
1781  category |= PIC_NUMERIC;
1782  if (category & PIC_ALPHABETIC) {
1783  goto error;
1784  }
1785  s_count++;
1786  if (s_count > 1 || idx != 0) {
1787  goto error;
1788  }
1789  s_char_seen = 1;
1790  continue;
1791 
1792  case ',':
1793  case '.':
1794  category |= PIC_NUMERIC_EDITED;
1795  if (s_char_seen || p_char_seen) {
1796  goto error;
1797  }
1798  if (c != current_program->decimal_point) {
1799  break;
1800  }
1801  dp_char_seen = 1;
1802  /* fall through */
1803  case 'V':
1804  category |= PIC_NUMERIC;
1805  if (category & PIC_ALPHABETIC) {
1806  goto error;
1807  }
1808  v_count++;
1809  if (v_count > 1) {
1810  goto error;
1811  }
1812  break;
1813 
1814  case 'P':
1815  category |= PIC_NUMERIC;
1816  if (category & PIC_ALPHABETIC) {
1817  goto error;
1818  }
1819  if (p_char_seen || dp_char_seen) {
1820  goto error;
1821  }
1822  at_beginning = 0;
1823  at_end = 0;
1824  switch (buffcnt) {
1825  case 0:
1826  /* P..... */
1827  at_beginning = 1;
1828  break;
1829  case 1:
1830  /* VP.... */
1831  /* SP.... */
1832  if (lastonechar == 'V' || lastonechar == 'S') {
1833  at_beginning = 1;
1834  }
1835  break;
1836  case 2:
1837  /* SVP... */
1838  if (lasttwochar == 'S' && lastonechar == 'V') {
1839  at_beginning = 1;
1840  }
1841  break;
1842  default:
1843  break;
1844  }
1845  if (p[1] == 0 || (p[1] == 'V' && p[2] == 0)) {
1846  /* .....P */
1847  /* ....PV */
1848  at_end = 1;
1849  }
1850  if (!at_beginning && !at_end) {
1851  goto error;
1852  }
1853  p_char_seen = 1;
1854  if (at_beginning) {
1855  /* Implicit V */
1856  v_count++;
1857  }
1858  digits += n;
1859  if (v_count) {
1860  scale += n;
1861  } else {
1862  scale -= n;
1863  }
1864  break;
1865 
1866  case '0':
1867  case 'B':
1868  case '/':
1869  category |= PIC_EDITED;
1870  if (s_char_seen || p_char_seen) {
1871  goto error;
1872  }
1873  break;
1874 
1875  case '*':
1876  case 'Z':
1877  category |= PIC_NUMERIC_EDITED;
1878  if (category & PIC_ALPHABETIC) {
1879  goto error;
1880  }
1881  if (s_char_seen || p_char_seen) {
1882  goto error;
1883  }
1884  digits += n;
1885  if (v_count) {
1886  scale += n;
1887  }
1888  break;
1889 
1890  case '+':
1891  case '-':
1892  category |= PIC_NUMERIC_EDITED;
1893  if (category & PIC_ALPHABETIC) {
1894  goto error;
1895  }
1896  if (s_char_seen || p_char_seen) {
1897  goto error;
1898  }
1899  digits += n - 1;
1900  s_count++;
1901  /* FIXME: need more check */
1902  break;
1903 
1904  case 'C':
1905  category |= PIC_NUMERIC_EDITED;
1906  if (!(p[1] == 'R' && p[2] == 0)) {
1907  goto error;
1908  }
1909  if (s_char_seen || p_char_seen) {
1910  goto error;
1911  }
1912  p++;
1913  s_count++;
1914  break;
1915 
1916  case 'D':
1917  category |= PIC_NUMERIC_EDITED;
1918  if (!(p[1] == 'B' && p[2] == 0)) {
1919  goto error;
1920  }
1921  if (s_char_seen || p_char_seen) {
1922  goto error;
1923  }
1924  p++;
1925  s_count++;
1926  break;
1927 
1928  default:
1929  if (c == current_program->currency_symbol) {
1930  category |= PIC_NUMERIC_EDITED;
1931  digits += n - 1;
1932  /* FIXME: need more check */
1933  break;
1934  }
1935 
1936  goto error;
1937  }
1938 
1939  /* Calculate size */
1940  if (c != 'V' && c != 'P') {
1941  size += n;
1942  }
1943  if (c == 'C' || c == 'D') {
1944  size += n;
1945  }
1946  if (c == 'N') {
1947  size += n * (COB_NATIONAL_SIZE - 1);
1948  }
1949 
1950  /* Store in the buffer */
1951  pic_buff[idx++] = c;
1952  lasttwochar = lastonechar;
1953  lastonechar = c;
1954  memcpy (&pic_buff[idx], (void *)&n, sizeof(int));
1955  idx += sizeof(int);
1956  ++buffcnt;
1957  }
1958  pic_buff[idx] = 0;
1959 
1960  if (size == 0 && v_count) {
1961  goto error;
1962  }
1963  /* Set picture */
1964  pic->orig = cobc_check_string (str);
1965  pic->size = size;
1966  pic->digits = digits;
1967  pic->scale = scale;
1968  pic->have_sign = s_count;
1969  pic->real_digits = real_digits;
1970 
1971  /* Set picture category */
1972  switch (category) {
1973  case PIC_ALPHABETIC:
1974  pic->category = CB_CATEGORY_ALPHABETIC;
1975  break;
1976  case PIC_NUMERIC:
1977  pic->category = CB_CATEGORY_NUMERIC;
1978  if (digits > COB_MAX_DIGITS) {
1979  cb_error (_("Numeric field cannot be larger than %d digits"), COB_MAX_DIGITS);
1980  }
1981  break;
1982  case PIC_ALPHANUMERIC:
1983  case PIC_NATIONAL:
1984  pic->category = CB_CATEGORY_ALPHANUMERIC;
1985  break;
1986  case PIC_NUMERIC_EDITED:
1987  pic->str = cobc_parse_malloc (idx + 1);
1988  memcpy (pic->str, pic_buff, idx);
1989  pic->category = CB_CATEGORY_NUMERIC_EDITED;
1990  pic->lenstr = idx;
1991  break;
1992  case PIC_EDITED:
1993  case PIC_ALPHABETIC_EDITED:
1994  case PIC_ALPHANUMERIC_EDITED:
1995  case PIC_NATIONAL_EDITED:
1996  pic->str = cobc_parse_malloc (idx + 1);
1997  memcpy (pic->str, pic_buff, idx);
1998  pic->category = CB_CATEGORY_ALPHANUMERIC_EDITED;
1999  pic->lenstr = idx;
2000  pic->digits = x_digits;
2001  break;
2002  default:
2003  goto error;
2004  }
2005  goto end;
2006 
2007 error:
2008  cb_error (_("Invalid picture string - '%s'"), str);
2009 
2010 end:
2011  return CB_TREE (pic);
2012 }
cb_tree cb_build_ppointer ( cb_tree  )

References CB_BUILD_CAST_PPOINTER, cb_error_node, CB_FIELD_PTR, cb_ref(), CB_REFERENCE_P, and cb_field::count.

1764 {
1765  struct cb_field *f;
1766 
1767  if (x == cb_error_node ||
1768  (CB_REFERENCE_P (x) && cb_ref (x) == cb_error_node)) {
1769  return cb_error_node;
1770  }
1771 
1772  if (CB_REFERENCE_P (x)) {
1773  f = CB_FIELD_PTR (cb_ref(x));
1774  f->count++;
1775  }
1776  return CB_BUILD_CAST_PPOINTER (x);
1777 }
struct cb_program* cb_build_program ( struct cb_program *  ,
const int   
)
read

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

1247 {
1248  struct cb_program *p;
1249  struct cb_program *q;
1250 
1251  if (!last_program) {
1252  toplev_count = 0;
1253  }
1254  cb_reset_78 ();
1255  cobc_in_procedure = 0;
1256  cobc_in_repository = 0;
1257  cobc_cs_check = 0;
1258  cb_clear_real_field ();
1259 
1260  p = cobc_parse_malloc (sizeof (struct cb_program));
1261  p->word_table = cobc_parse_malloc (CB_WORD_TABLE_SIZE);
1262 
1263  p->next_program = last_program;
1264  p->nested_level = nest_level;
1265  p->decimal_point = '.';
1266  p->currency_symbol = '$';
1267  p->numeric_separator = ',';
1268  /* Save current program as actual at it's level */
1269  container_progs[nest_level] = p;
1270  if (nest_level) {
1271  /* Contained program */
1272  /* Inherit from upper level */
1273  p->global_file_list = last_program->global_file_list;
1274  p->collating_sequence = last_program->collating_sequence;
1275  p->classification = last_program->classification;
1276  p->mnemonic_spec_list = last_program->mnemonic_spec_list;
1277  p->class_spec_list = last_program->class_spec_list;
1278  p->interface_spec_list = last_program->interface_spec_list;
1279  p->function_spec_list = last_program->function_spec_list;
1280  p->user_spec_list = last_program->user_spec_list;
1281  p->program_spec_list = last_program->program_spec_list;
1282  p->property_spec_list = last_program->property_spec_list;
1283  p->alphabet_name_list = last_program->alphabet_name_list;
1284  p->symbolic_char_list = last_program->symbolic_char_list;
1285  p->class_name_list = last_program->class_name_list;
1286  p->locale_list = last_program->locale_list;
1287  p->decimal_point = last_program->decimal_point;
1288  p->numeric_separator = last_program->numeric_separator;
1289  p->currency_symbol = last_program->currency_symbol;
1290  p->flag_trailing_separate = last_program->flag_trailing_separate;
1291  p->flag_console_is_crt = last_program->flag_console_is_crt;
1292  /* RETURN-CODE is global for contained programs */
1293  p->cb_return_code = last_program->cb_return_code;
1294  CB_FIELD_PTR (last_program->cb_return_code)->flag_is_global = 1;
1295  p->toplev_count = last_program->toplev_count;
1296  /* Add program to itself for possible recursion */
1297  p->nested_prog_list = add_contained_prog (p->nested_prog_list, p);
1298  /* Add contained program to it's parent */
1299  q = container_progs[nest_level - 1];
1300  q->nested_prog_list = add_contained_prog (q->nested_prog_list, p);
1301  } else {
1302  /* Top level program */
1303  p->toplev_count = toplev_count++;
1304  functions_are_all = cb_flag_functions_all;
1305  cb_reset_global_78 ();
1306  }
1307  return p;
1308 }
char* cb_build_program_id ( cb_tree  ,
cb_tree  ,
const cob_u32_t   
)

References cb_encode_program_id(), CB_LITERAL, CB_LITERAL_P, CB_NAME, cob_u8_t, cobc_check_string(), cobc_check_valid_name(), current_program, cb_program::orig_program_id, and p.

1170 {
1171  char *s;
1172  unsigned char *p;
1173 
1174  if (alt_name) {
1175  current_program->orig_program_id =
1176  cobc_check_string ((char *)CB_LITERAL (alt_name)->data);
1177  s = cb_encode_program_id ((char *)CB_LITERAL (alt_name)->data);
1178  } else if (CB_LITERAL_P (name)) {
1179  current_program->orig_program_id =
1180  cobc_check_string ((char *)CB_LITERAL (name)->data);
1181  s = cb_encode_program_id ((char *)CB_LITERAL (name)->data);
1182  } else {
1183  current_program->orig_program_id =
1184  cobc_check_string (CB_NAME (name));
1185  s = cb_encode_program_id (CB_NAME (name));
1186  }
1187  (void)cobc_check_valid_name (current_program->orig_program_id, 2U);
1188  if (is_func) {
1189  for (p = (unsigned char *)s; *p; ++p) {
1190  if (islower ((int)*p)) {
1191  *p = (cob_u8_t)toupper ((int)*p);
1192  }
1193  }
1194  }
1195  return s;
1196 }
cb_tree cb_build_reference ( const char *  )

References CB_CATEGORY_UNKNOWN, CB_TAG_REFERENCE, CB_TREE, lookup_word(), make_tree(), and p.

2431 {
2432  struct cb_reference *p;
2433 
2434  p = make_tree (CB_TAG_REFERENCE, CB_CATEGORY_UNKNOWN,
2435  sizeof (struct cb_reference));
2436  /* Look up / insert word into hash list */
2437  lookup_word (p, name);
2438  return CB_TREE (p);
2439 }
void cb_build_registers ( void  )

References cb_build_alphanumeric_literal(), cb_build_constant(), cb_build_index(), cb_build_reference(), cb_program::cb_call_params, CB_FIELD_PTR, cb_intr_whencomp, cb_program::cb_return_code, cb_program::cb_sort_return, cb_zero, current_program, cb_program::nested_level, and NULL.

1045 {
1046 #if !defined(__linux__) && !defined(__CYGWIN__) && defined(HAVE_TIMEZONE)
1047  long contz;
1048 #endif
1049  cb_tree x;
1050  struct tm *tlt;
1051  time_t t;
1052  char buff[48];
1053 
1054  /* RETURN-CODE */
1055  if (!current_program->nested_level) {
1056  x = cb_build_index (cb_build_reference ("RETURN-CODE"),
1057  cb_zero, 0, NULL);
1058  CB_FIELD_PTR (x)->special_index = 1;
1059  current_program->cb_return_code = x;
1060  }
1061 
1062  /* SORT-RETURN */
1063  x = cb_build_index (cb_build_reference ("SORT-RETURN"),
1064  cb_zero, 0, NULL);
1065  CB_FIELD_PTR (x)->flag_no_init = 1;
1066  current_program->cb_sort_return = x;
1067 
1068  /* NUMBER-OF-CALL-PARAMETERS */
1069  x = cb_build_index (cb_build_reference ("NUMBER-OF-CALL-PARAMETERS"),
1070  cb_zero, 0, NULL);
1071  CB_FIELD_PTR (x)->flag_no_init = 1;
1072  CB_FIELD_PTR (x)->flag_local = 1;
1073  CB_FIELD_PTR (x)->special_index = 2;
1074  current_program->cb_call_params = x;
1075 
1076  t = time (NULL);
1077  tlt = localtime (&t);
1078  /* Leap seconds ? */
1079  if (tlt->tm_sec >= 60) {
1080  tlt->tm_sec = 59;
1081  }
1082 
1083  /* WHEN-COMPILED */
1084  memset (buff, 0, sizeof (buff));
1085  strftime (buff, (size_t)17, "%m/%d/%y%H.%M.%S", tlt);
1086  cb_build_constant (cb_build_reference ("WHEN-COMPILED"),
1087  cb_build_alphanumeric_literal (buff, (size_t)16));
1088 
1089  /* FUNCTION WHEN-COMPILED */
1090  memset (buff, 0, sizeof (buff));
1091 #if defined(__linux__) || defined(__CYGWIN__)
1092  strftime (buff, (size_t)22, "%Y%m%d%H%M%S00%z", tlt);
1093 #elif defined(HAVE_TIMEZONE)
1094  strftime (buff, (size_t)17, "%Y%m%d%H%M%S00", tlt);
1095  if (timezone <= 0) {
1096  contz = -timezone;
1097  buff[16] = '+';
1098  } else {
1099  contz = timezone;
1100  buff[16] = '-';
1101  }
1102  sprintf (&buff[17], "%2.2ld%2.2ld", contz / 3600, contz % 60);
1103 #else
1104  strftime (buff, (size_t)22, "%Y%m%d%H%M%S0000000", tlt);
1105 #endif
1106  cb_intr_whencomp = cb_build_alphanumeric_literal (buff, (size_t)21);
1107 
1108 }
cb_tree cb_build_replacing_all ( cb_tree  ,
cb_tree  ,
cb_tree   
)

References CB_BUILD_FUNCALL_2, cb_list_add(), and validate_inspect().

5716 {
5717  validate_inspect (x, y, 1);
5718  return cb_list_add (l, CB_BUILD_FUNCALL_2 ("cob_inspect_all", y, x));
5719 }
cb_tree cb_build_replacing_characters ( cb_tree  ,
cb_tree   
)

References _, CB_BUILD_FUNCALL_1, cb_error_x(), cb_list_add(), CB_LITERAL, CB_LITERAL_P, CB_TREE, and current_statement.

5706 {
5707  if (CB_LITERAL_P (x) && CB_LITERAL(x)->size != 1) {
5708  cb_error_x (CB_TREE (current_statement),
5709  _("Operand has wrong size"));
5710  }
5711  return cb_list_add (l, CB_BUILD_FUNCALL_1 ("cob_inspect_characters", x));
5712 }
cb_tree cb_build_replacing_first ( cb_tree  ,
cb_tree  ,
cb_tree   
)

References CB_BUILD_FUNCALL_2, cb_list_add(), and validate_inspect().

5730 {
5731  validate_inspect (x, y, 1);
5732  return cb_list_add (l, CB_BUILD_FUNCALL_2 ("cob_inspect_first", y, x));
5733 }
cb_tree cb_build_replacing_leading ( cb_tree  ,
cb_tree  ,
cb_tree   
)

References CB_BUILD_FUNCALL_2, cb_list_add(), and validate_inspect().

5723 {
5724  validate_inspect (x, y, 1);
5725  return cb_list_add (l, CB_BUILD_FUNCALL_2 ("cob_inspect_leading", y, x));
5726 }
cb_tree cb_build_replacing_trailing ( cb_tree  ,
cb_tree  ,
cb_tree   
)

References CB_BUILD_FUNCALL_2, cb_list_add(), and validate_inspect().

5737 {
5738  validate_inspect (x, y, 1);
5739  return cb_list_add (l, CB_BUILD_FUNCALL_2 ("cob_inspect_trailing", y, x));
5740 }
cb_tree cb_build_search ( const int  ,
const cb_tree  ,
const cb_tree  ,
const cb_tree  ,
const cb_tree   
)

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

2901 {
2902  struct cb_search *p;
2903 
2904  p = make_tree (CB_TAG_SEARCH, CB_CATEGORY_UNKNOWN,
2905  sizeof (struct cb_search));
2906  p->flag_all = flag_all;
2907  p->table = table;
2908  p->var = var;
2909  p->end_stmt = end_stmt;
2910  p->whens = whens;
2911  return CB_TREE (p);
2912 }
cb_tree cb_build_section_name ( cb_tree  ,
const int   
)

References cb_error_node, CB_LABEL, CB_LABEL_P, CB_VALUE, CB_WORD_COUNT, CB_WORD_ITEMS, and redefinition_error().

1223 {
1224  cb_tree x;
1225 
1226  if (name == cb_error_node) {
1227  return cb_error_node;
1228  }
1229 
1230  if (CB_WORD_COUNT (name) > 0) {
1231  x = CB_VALUE (CB_WORD_ITEMS (name));
1232  /* Used as a non-label name or used as a section name.
1233  Duplicate paragraphs are allowed if not referenced;
1234  Checked in typeck.c */
1235  if (!CB_LABEL_P (x) || sect_or_para == 0 ||
1236  (sect_or_para && CB_LABEL_P (x) &&
1237  CB_LABEL (x)->flag_section)) {
1238  redefinition_error (name);
1239  return cb_error_node;
1240  }
1241  }
1242 
1243  return name;
1244 }
cb_tree cb_build_set_attribute ( const struct cb_field *  ,
const int  ,
const int   
)

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

3078 {
3079  struct cb_set_attr *p;
3080 
3081  p = make_tree (CB_TAG_SET_ATTR, CB_CATEGORY_UNKNOWN,
3082  sizeof (struct cb_set_attr));
3083  p->fld = (struct cb_field *)fld;
3084  p->val_on = val_on;
3085  p->val_off = val_off;
3086  return CB_TREE (p);
3087 }
struct cb_statement* cb_build_statement ( const char *  )
read

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

3052 {
3053  struct cb_statement *p;
3054 
3055  p = make_tree (CB_TAG_STATEMENT, CB_CATEGORY_UNKNOWN,
3056  sizeof (struct cb_statement));
3057  p->name = name;
3058  return p;
3059 }
cb_tree cb_build_string ( const void *  ,
const size_t   
)

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

1369 {
1370  struct cb_string *p;
1371 
1372  p = make_tree (CB_TAG_STRING, CB_CATEGORY_ALPHANUMERIC,
1373  sizeof (struct cb_string));
1374  p->size = size;
1375  p->data = data;
1376  return CB_TREE (p);
1377 }
cb_tree cb_build_sub ( cb_tree  ,
cb_tree  ,
cb_tree   
)

References build_store_option(), cb_build_binary_op(), CB_BUILD_FUNCALL_3, cb_build_move(), cb_build_optim_sub(), CB_CLASS_POINTER, CB_FIELD_PTR, cb_fits_int(), CB_INDEX_P, cb_int0, cb_int1, CB_REF_OR_FIELD_P, CB_TREE_CLASS, cb_field::count, and optimize_defs.

3983 {
3984  cb_tree opt;
3985  struct cb_field *f;
3986 
3987 #ifdef COB_NON_ALIGNED
3988  if (CB_INDEX_P (v)) {
3989  return cb_build_move (cb_build_binary_op (v, '-', n), v);
3990  }
3991  if (CB_TREE_CLASS (v) == CB_CLASS_POINTER) {
3992  optimize_defs[COB_POINTER_MANIP] = 1;
3993  return CB_BUILD_FUNCALL_3 ("cob_pointer_manip", v, n, cb_int1);
3994  }
3995 #else
3996  if (CB_INDEX_P (v) || CB_TREE_CLASS (v) == CB_CLASS_POINTER) {
3997  return cb_build_move (cb_build_binary_op (v, '-', n), v);
3998  }
3999 #endif
4000 
4001  if (CB_REF_OR_FIELD_P (v)) {
4002  f = CB_FIELD_PTR (v);
4003  f->count++;
4004  }
4005  if (CB_REF_OR_FIELD_P (n)) {
4006  f = CB_FIELD_PTR (n);
4007  f->count++;
4008  }
4009  opt = build_store_option (v, round_opt);
4010  if (opt == cb_int0 && cb_fits_int (n)) {
4011  return cb_build_optim_sub (v, n);
4012  }
4013  return CB_BUILD_FUNCALL_3 ("cob_sub", v, n, opt);
4014 }
void cb_build_symbolic_chars ( const cb_tree  ,
const cb_tree   
)

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

2148 {
2149  cb_tree l;
2150  cb_tree x;
2151  cb_tree x2;
2152  struct cb_alphabet_name *ap;
2153  int n;
2154  unsigned char buff[4];
2155 
2156  if (alphabet) {
2157  ap = CB_ALPHABET_NAME (alphabet);
2158  } else {
2159  ap = NULL;
2160  }
2161  for (l = sym_list; l; l = CB_CHAIN (l)) {
2162  n = cb_get_int (CB_PURPOSE (l)) - 1;
2163  if (ap) {
2164  buff[0] = (unsigned char)ap->alphachr[n];
2165  } else {
2166  buff[0] = (unsigned char)n;
2167  }
2168  buff[1] = 0;
2169  x2 = cb_build_alphanumeric_literal (buff, (size_t)1);
2170  CB_LITERAL (x2)->all = 1;
2171  x = cb_build_constant (CB_VALUE (l), x2);
2172  CB_FIELD (x)->flag_item_78 = 1;
2173  CB_FIELD (x)->flag_is_global = 1;
2174  CB_FIELD (x)->level = 1;
2175  (void)cb_validate_78_item (CB_FIELD (x), 0);
2176  }
2177 }
cb_tree cb_build_system_name ( const enum  cb_system_name_category,
const int   
)

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

1510 {
1511  struct cb_system_name *p;
1512 
1513  p = make_tree (CB_TAG_SYSTEM_NAME, CB_CATEGORY_UNKNOWN,
1514  sizeof (struct cb_system_name));
1515  p->category = category;
1516  p->token = token;
1517  return CB_TREE (p);
1518 }
cb_tree cb_build_tallying_all ( void  )

References _, cb_error_x(), CB_TREE, current_statement, inspect_func, and NULL.

5664 {
5665  if (inspect_data == NULL) {
5666  cb_error_x (CB_TREE (current_statement),
5667  _("Data name expected before ALL"));
5668  }
5669  inspect_func = "cob_inspect_all";
5670  return NULL;
5671 }
cb_tree cb_build_tallying_characters ( cb_tree  )

References _, CB_BUILD_FUNCALL_1, cb_error_x(), cb_list_add(), CB_TREE, current_statement, inspect_func, and NULL.

5653 {
5654  if (inspect_data == NULL) {
5655  cb_error_x (CB_TREE (current_statement),
5656  _("Data name expected before CHARACTERS"));
5657  }
5658  inspect_func = NULL;
5659  return cb_list_add (l, CB_BUILD_FUNCALL_1 ("cob_inspect_characters", inspect_data));
5660 }
cb_tree cb_build_tallying_data ( cb_tree  )

References NULL.

5646 {
5647  inspect_data = x;
5648  return NULL;
5649 }
cb_tree cb_build_tallying_leading ( void  )

References _, cb_error_x(), CB_TREE, current_statement, inspect_func, and NULL.

5675 {
5676  if (inspect_data == NULL) {
5677  cb_error_x (CB_TREE (current_statement),
5678  _("Data name expected before LEADING"));
5679  }
5680  inspect_func = "cob_inspect_leading";
5681  return NULL;
5682 }
cb_tree cb_build_tallying_trailing ( void  )

References _, cb_error_x(), CB_TREE, current_statement, inspect_func, and NULL.

5686 {
5687  if (inspect_data == NULL) {
5688  cb_error_x (CB_TREE (current_statement),
5689  _("Data name expected before TRAILING"));
5690  }
5691  inspect_func = "cob_inspect_trailing";
5692  return NULL;
5693 }
cb_tree cb_build_tallying_value ( cb_tree  ,
cb_tree   
)

References _, CB_BUILD_FUNCALL_2, cb_error_x(), cb_list_add(), cb_name(), inspect_func, and NULL.

5697 {
5698  if (inspect_func == NULL) {
5699  cb_error_x (x, _("ALL, LEADING or TRAILING expected before '%s'"), cb_name (x));
5700  }
5701  return cb_list_add (l, CB_BUILD_FUNCALL_2 (inspect_func, inspect_data, x));
5702 }
cb_tree cb_build_unstring_delimited ( cb_tree  ,
cb_tree   
)

References CB_BUILD_FUNCALL_2, cb_error_node, and cb_validate_one().

8342 {
8343  if (cb_validate_one (value)) {
8344  return cb_error_node;
8345  }
8346  return CB_BUILD_FUNCALL_2 ("cob_unstring_delimited", value, all);
8347 }
cb_tree cb_build_unstring_into ( cb_tree  ,
cb_tree  ,
cb_tree   
)

References CB_BUILD_FUNCALL_3, cb_error_node, cb_int0, cb_validate_one(), and NULL.

8351 {
8352  if (cb_validate_one (name)) {
8353  return cb_error_node;
8354  }
8355  if (delimiter == NULL) {
8356  delimiter = cb_int0;
8357  }
8358  if (count == NULL) {
8359  count = cb_int0;
8360  }
8361  return CB_BUILD_FUNCALL_3 ("cob_unstring_into", name, delimiter, count);
8362 }
cb_tree cb_build_write_advancing_lines ( cb_tree  ,
cb_tree   
)

References CB_BEFORE, cb_build_binary_op(), cb_build_cast_int(), cb_get_int(), cb_int(), cb_int_hex(), CB_LITERAL_P, COB_WRITE_AFTER, COB_WRITE_BEFORE, and COB_WRITE_LINES.

8449 {
8450  cb_tree e;
8451  int opt;
8452 
8453  opt = (pos == CB_BEFORE) ? COB_WRITE_BEFORE : COB_WRITE_AFTER;
8454  opt |= COB_WRITE_LINES;
8455  if (CB_LITERAL_P (lines)) {
8456  opt |= cb_get_int (lines);
8457  return cb_int_hex (opt);
8458  }
8459  e = cb_build_binary_op (cb_int (opt), '+', lines);
8460  return cb_build_cast_int (e);
8461 }
cb_tree cb_build_write_advancing_mnemonic ( cb_tree  ,
cb_tree   
)

References _, CB_BEFORE, cb_error_node, cb_error_x(), 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, CB_FEATURE_FORMFEED, cb_int0, cb_int_hex(), cb_ref(), CB_SYSTEM_NAME, COB_WRITE_AFTER, COB_WRITE_BEFORE, COB_WRITE_CHANNEL, and COB_WRITE_PAGE.

8465 {
8466  int opt;
8467  int token;
8468 
8469  if (mnemonic == cb_error_node) {
8470  return cb_int0;
8471  }
8472  if (cb_ref (mnemonic) == cb_error_node) {
8473  return cb_int0;
8474  }
8475  token = CB_SYSTEM_NAME (cb_ref (mnemonic))->token;
8476  switch (token) {
8477  case CB_FEATURE_FORMFEED:
8478  opt = (pos == CB_BEFORE) ? COB_WRITE_BEFORE : COB_WRITE_AFTER;
8479  return cb_int_hex (opt | COB_WRITE_PAGE);
8480  case CB_FEATURE_C01:
8481  case CB_FEATURE_C02:
8482  case CB_FEATURE_C03:
8483  case CB_FEATURE_C04:
8484  case CB_FEATURE_C05:
8485  case CB_FEATURE_C06:
8486  case CB_FEATURE_C07:
8487  case CB_FEATURE_C08:
8488  case CB_FEATURE_C09:
8489  case CB_FEATURE_C10:
8490  case CB_FEATURE_C11:
8491  case CB_FEATURE_C12:
8492  opt = (pos == CB_BEFORE) ? COB_WRITE_BEFORE : COB_WRITE_AFTER;
8493  return cb_int_hex (opt | COB_WRITE_CHANNEL | COB_WRITE_PAGE | token);
8494  default:
8495  cb_error_x (mnemonic, _("Invalid mnemonic name"));
8496  return cb_int0;
8497  }
8498 }
cb_tree cb_build_write_advancing_page ( cb_tree  )

References CB_BEFORE, cb_int_hex(), COB_WRITE_AFTER, COB_WRITE_BEFORE, and COB_WRITE_PAGE.

8502 {
8503  int opt = (pos == CB_BEFORE) ? COB_WRITE_BEFORE : COB_WRITE_AFTER;
8504 
8505  return cb_int_hex (opt | COB_WRITE_PAGE);
8506 }
int cb_category_is_alpha ( cb_tree  )

References category_is_alphanumeric, and CB_TREE_CATEGORY.

751 {
752  return category_is_alphanumeric[CB_TREE_CATEGORY (x)];
753 }
void cb_check_field_debug ( cb_tree  )

References CB_BUILD_CAST_ADDRESS, CB_BUILD_CAST_LENGTH, cb_build_debug(), cb_build_debug_call(), CB_BUILD_FUNCALL_3, cb_build_move(), CB_CHAIN, cb_error_node, CB_FIELD, CB_FIELD_P, cb_int(), cb_list_add(), cb_list_reverse(), CB_PURPOSE, cb_ref(), CB_REFERENCE, CB_VALUE, CB_WORD_COUNT, CB_WORD_ITEMS, COB_MINI_BUFF, current_program, current_statement, cb_statement::debug_check, cb_program::debug_list, cb_statement::debug_nodups, cb_field::debug_section, cb_field::flag_all_debug, found, cb_field::name, NULL, and cb_field::size.

898 {
899  cb_tree l;
900  cb_tree x;
901  cb_tree z;
902  size_t size;
903  size_t found;
904  char buff[COB_MINI_BUFF];
905 
906  /* Basic reference check */
907  if (CB_WORD_COUNT (fld) > 0) {
908  if (!CB_WORD_ITEMS (fld)) {
909  return;
910  }
911  z = CB_VALUE(CB_WORD_ITEMS (fld));
912  if (!CB_FIELD_P (z)) {
913  return;
914  }
915  x = cb_ref (fld);
916  if (x == cb_error_node) {
917  return;
918  }
919  } else {
920  return;
921  }
922 
923  found = 0;
924  /* Check if reference is being debugged */
925  for (l = current_program->debug_list; l; l = CB_CHAIN (l)) {
926  if (!CB_PURPOSE (l)) {
927  continue;
928  }
929  if (x == CB_PURPOSE (l)) {
930  if (CB_REFERENCE (fld)->flag_target ||
931  CB_REFERENCE (CB_VALUE (l))->flag_all_debug) {
932  found = 1;
933  }
934  break;
935  }
936  }
937  if (!found) {
938  return;
939  }
940 
941  found = 0;
942  /* Found it - check if it is already in the statement list */
943  for (l = current_statement->debug_nodups; l; l = CB_CHAIN (l)) {
944  if (CB_VALUE (l) == x) {
945  found = 1;
946  break;
947  }
948  }
949  if (found) {
950  return;
951  }
952 
953  /* Set up debug info */
954  strcpy (buff, CB_FIELD(x)->name);
955  size = strlen (buff);
956  for (l = CB_REFERENCE (fld)->chain; l; l = CB_REFERENCE (l)->chain) {
957  z = cb_ref (l);
958  if (z != cb_error_node) {
959  size += strlen (CB_FIELD (z)->name);
960  size += 4;
961  if (size >= sizeof(buff)) {
962  break;
963  }
964  strcat (buff, " OF ");
965  strcat (buff, CB_FIELD (z)->name);
966  }
967  }
968  current_statement->debug_nodups =
969  cb_list_add (current_statement->debug_nodups, x);
970  current_statement->debug_check =
971  cb_list_add (current_statement->debug_check,
972  cb_build_debug (cb_debug_name, buff, NULL));
973  current_statement->debug_check =
974  cb_list_add (current_statement->debug_check,
975  cb_build_debug (cb_debug_contents, NULL, fld));
976  found = 0;
977  CB_REFERENCE (fld)->subs = cb_list_reverse (CB_REFERENCE (fld)->subs);
978  l = CB_REFERENCE (fld)->subs;
979  for (; l && found < 3; l = CB_CHAIN (l), ++found) {
980  switch (found) {
981  case 0:
982  current_statement->debug_check =
983  cb_list_add (current_statement->debug_check,
984  cb_build_move (CB_VALUE (l),
985  cb_debug_sub_1));
986  break;
987  case 1:
988  current_statement->debug_check =
989  cb_list_add (current_statement->debug_check,
990  cb_build_move (CB_VALUE (l),
991  cb_debug_sub_2));
992  break;
993  case 2:
994  current_statement->debug_check =
995  cb_list_add (current_statement->debug_check,
996  cb_build_move (CB_VALUE (l),
997  cb_debug_sub_3));
998  break;
999  default:
1000  break;
1001  }
1002  }
1003  CB_REFERENCE (fld)->subs = cb_list_reverse (CB_REFERENCE (fld)->subs);
1004 
1005  for (; found < 3; ++found) {
1006  switch (found) {
1007  case 0:
1008  current_statement->debug_check =
1009  cb_list_add (current_statement->debug_check,
1010  CB_BUILD_FUNCALL_3 ("memset",
1011  CB_BUILD_CAST_ADDRESS (cb_debug_sub_1),
1012  cb_int (' '),
1013  CB_BUILD_CAST_LENGTH (cb_debug_sub_1)));
1014  break;
1015  case 1:
1016  current_statement->debug_check =
1017  cb_list_add (current_statement->debug_check,
1018  CB_BUILD_FUNCALL_3 ("memset",
1019  CB_BUILD_CAST_ADDRESS (cb_debug_sub_2),
1020  cb_int (' '),
1021  CB_BUILD_CAST_LENGTH (cb_debug_sub_2)));
1022  break;
1023  case 2:
1024  current_statement->debug_check =
1025  cb_list_add (current_statement->debug_check,
1026  CB_BUILD_FUNCALL_3 ("memset",
1027  CB_BUILD_CAST_ADDRESS (cb_debug_sub_3),
1028  cb_int (' '),
1029  CB_BUILD_CAST_LENGTH (cb_debug_sub_3)));
1030  break;
1031  default:
1032  break;
1033  }
1034  }
1035 
1036  current_statement->debug_check =
1037  cb_list_add (current_statement->debug_check,
1038  cb_build_debug_call (CB_FIELD(x)->debug_section));
1039 }
size_t cb_check_index_p ( cb_tree  x)

References CB_FIELD_PTR, CB_REF_OR_FIELD_P, CB_USAGE_INDEX, cb_field::children, and cb_field::usage.

881 {
882  struct cb_field *f;
883 
884  if (!CB_REF_OR_FIELD_P (x)) {
885  return 0;
886  }
887  f = CB_FIELD_PTR (x);
888  if (f->usage == CB_USAGE_INDEX && !f->children) {
889  return 1;
890  }
891  return 0;
892 }
cb_tree cb_check_numeric_value ( cb_tree  )

References _, CB_CATEGORY_NUMERIC, cb_error_node, cb_error_x(), cb_name(), and CB_TREE_CATEGORY.

645 {
646  if (x == cb_error_node) {
647  return cb_error_node;
648  }
649 
650  if (CB_TREE_CATEGORY (x) == CB_CATEGORY_NUMERIC) {
651  return x;
652  }
653 
654  cb_error_x (x, _("'%s' is not a numeric value"), cb_name (x));
655  return cb_error_node;
656 }
void cb_clear_real_field ( void  )

References NULL.

Referenced by cb_build_program().

1437 {
1438  last_real_field = NULL;
1439 }
cb_tree cb_concat_literals ( const cb_tree  ,
const cb_tree   
)

References CB_CATEGORY_ALPHANUMERIC, CB_CONST_P, cb_error_node, CB_LITERAL, CB_LITERAL_P, CB_TAG_LITERAL, CB_TREE, cobc_parse_malloc(), cb_literal::data, make_tree(), p, and cb_literal::size.

1552 {
1553  unsigned char *data1;
1554  unsigned char *data2;
1555  struct cb_literal *p;
1556  size_t size1;
1557  size_t size2;
1558 
1559  if (x1 == cb_error_node || x2 == cb_error_node) {
1560  return cb_error_node;
1561  }
1562  if (CB_LITERAL_P (x1)) {
1563  data1 = CB_LITERAL (x1)->data;
1564  size1 = CB_LITERAL (x1)->size;
1565  } else if (CB_CONST_P (x1)) {
1566  size1 = 1;
1567  if (x1 == cb_space) {
1568  data1 = (unsigned char *)" ";
1569  } else if (x1 == cb_zero) {
1570  data1 = (unsigned char *)"0";
1571  } else if (x1 == cb_quote) {
1572  if (cb_flag_apostrophe) {
1573  data1 = (unsigned char *)"'";
1574  } else {
1575  data1 = (unsigned char *)"\"";
1576  }
1577  } else if (x1 == cb_norm_low) {
1578  data1 = (unsigned char *)"\0";
1579  } else if (x1 == cb_norm_high) {
1580  data1 = (unsigned char *)"\255";
1581  } else if (x1 == cb_null) {
1582  data1 = (unsigned char *)"\0";
1583  } else {
1584  return cb_error_node;
1585  }
1586  } else {
1587  return cb_error_node;
1588  }
1589  if (CB_LITERAL_P (x2)) {
1590  data2 = CB_LITERAL (x2)->data;
1591  size2 = CB_LITERAL (x2)->size;
1592  } else if (CB_CONST_P (x2)) {
1593  size2 = 1;
1594  if (x2 == cb_space) {
1595  data2 = (unsigned char *)" ";
1596  } else if (x2 == cb_zero) {
1597  data2 = (unsigned char *)"0";
1598  } else if (x2 == cb_quote) {
1599  if (cb_flag_apostrophe) {
1600  data2 = (unsigned char *)"'";
1601  } else {
1602  data2 = (unsigned char *)"\"";
1603  }
1604  } else if (x2 == cb_norm_low) {
1605  data2 = (unsigned char *)"\0";
1606  } else if (x2 == cb_norm_high) {
1607  data2 = (unsigned char *)"\255";
1608  } else if (x2 == cb_null) {
1609  data2 = (unsigned char *)"\0";
1610  } else {
1611  return cb_error_node;
1612  }
1613  } else {
1614  return cb_error_node;
1615  }
1616  p = make_tree (CB_TAG_LITERAL, CB_CATEGORY_ALPHANUMERIC,
1617  sizeof (struct cb_literal));
1618  p->data = cobc_parse_malloc (size1 + size2 + 1U);
1619  p->size = size1 + size2;
1620  memcpy (p->data, data1, size1);
1621  memcpy (p->data + size1, data2, size2);
1622  return CB_TREE (p);
1623 }
const char* cb_define ( cb_tree  ,
cb_tree   
)

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

1214 {
1215  struct cb_word *w;
1216 
1217  w = CB_REFERENCE (name)->word;
1218  w->items = cb_list_add (w->items, val);
1219  w->count++;
1220  val->source_file = name->source_file;
1221  val->source_line = name->source_line;
1222  CB_REFERENCE (name)->value = val;
1223  return w->name;
1224 }
cb_tree cb_define_switch_name ( cb_tree  ,
cb_tree  ,
const int   
)

References _, cb_build_constant(), CB_BUILD_FUNCALL_1, CB_BUILD_NEGATION, cb_error_node, cb_error_x(), cb_int(), CB_SWITCH_NAME, CB_SYSTEM_NAME, NULL, and value.

1200 {
1201  cb_tree switch_id;
1202  cb_tree value;
1203 
1204  if (!name || name == cb_error_node) {
1205  return NULL;
1206  }
1207  if (!sname || sname == cb_error_node ||
1208  CB_SYSTEM_NAME (sname)->category != CB_SWITCH_NAME) {
1209  cb_error_x (name, _("ON/OFF usage requires a SWITCH name"));
1210  return NULL;
1211  }
1212  switch_id = cb_int (CB_SYSTEM_NAME (sname)->token);
1213  value = CB_BUILD_FUNCALL_1 ("cob_get_switch", switch_id);
1214  if (flag == 0) {
1215  value = CB_BUILD_NEGATION (value);
1216  }
1217  cb_build_constant (name, value);
1218  return value;
1219 }
void cb_emit_accept ( cb_tree  ,
cb_tree  ,
struct cb_attr_struct *   
)

References _, cb_attr_struct::bgc, CB_BUILD_FUNCALL_1, CB_BUILD_FUNCALL_4, CB_BUILD_FUNCALL_9, cb_emit, cb_error_x(), CB_FIELD, CB_FIELD_PTR, cb_gen_field_accept(), cb_int(), CB_LIST_P, CB_LITERAL, CB_LITERAL_P, cb_null, CB_PAIR_X, CB_PAIR_Y, cb_ref(), CB_REF_OR_FIELD_P, CB_STORAGE_SCREEN, cb_validate_one(), cb_program::crt_status, current_program, cb_attr_struct::dispattrs, cb_attr_struct::fgc, cb_program::flag_screen, gen_screen_ptr, line, NULL, output_screen_from(), output_screen_to(), cb_attr_struct::prompt, cb_attr_struct::scroll, cb_field::size, cb_field::storage, and cb_attr_struct::timeout.

4196 {
4197  cb_tree line;
4198  cb_tree column;
4199  cb_tree fgc;
4200  cb_tree bgc;
4201  cb_tree scroll;
4202  cb_tree timeout;
4203  cb_tree prompt;
4204  int dispattrs;
4205 
4206  if (attr_ptr) {
4207  fgc = attr_ptr->fgc;
4208  bgc = attr_ptr->bgc;
4209  scroll = attr_ptr->scroll;
4210  timeout = attr_ptr->timeout;
4211  prompt = attr_ptr->prompt;
4212  dispattrs = attr_ptr->dispattrs;
4213  } else {
4214  fgc = NULL;
4215  bgc = NULL;
4216  scroll = NULL;
4217  timeout = NULL;
4218  prompt = NULL;
4219  dispattrs = 0;
4220  }
4221 
4222  if (cb_validate_one (var)) {
4223  return;
4224  }
4225  if (cb_validate_one (pos)) {
4226  return;
4227  }
4228  if (cb_validate_one (fgc)) {
4229  return;
4230  }
4231  if (cb_validate_one (bgc)) {
4232  return;
4233  }
4234  if (cb_validate_one (scroll)) {
4235  return;
4236  }
4237  if (cb_validate_one (timeout)) {
4238  return;
4239  }
4240  if (cb_validate_one (prompt)) {
4241  return;
4242  }
4243 
4244  if (prompt) {
4245  /* PROMPT character - 1 character identifier or literal */
4246  if (CB_LITERAL_P (prompt)) {
4247  if (CB_LITERAL (prompt)->size != 1) {
4248  cb_error_x (prompt, _("Invalid PROMPT literal"));
4249  return;
4250  }
4251  } else {
4252  if (CB_FIELD_PTR (prompt)->size != 1) {
4253  cb_error_x (prompt, _("Invalid PROMPT identifier"));
4254  return;
4255  }
4256  }
4257  }
4258 
4259 #if 0 /* RXWRXW - Screen */
4260  if ((CB_REF_OR_FIELD_P (var)) &&
4261  CB_FIELD (cb_ref (var))->storage == CB_STORAGE_SCREEN) {
4262  current_program->flag_screen = 1;
4263  }
4264 #endif
4265 
4266  if (current_program->flag_screen) {
4267  /* Bump ref count to force CRT STATUS field generation */
4268  if (current_program->crt_status) {
4269  CB_FIELD_PTR (current_program->crt_status)->count++;
4270  }
4271  if ((CB_REF_OR_FIELD_P (var)) &&
4272  CB_FIELD (cb_ref (var))->storage == CB_STORAGE_SCREEN) {
4273  output_screen_from (CB_FIELD (cb_ref (var)), 0);
4274  gen_screen_ptr = 1;
4275  if (pos) {
4276  if (CB_LIST_P (pos)) {
4277  line = CB_PAIR_X (pos);
4278  column = CB_PAIR_Y (pos);
4279  cb_emit (CB_BUILD_FUNCALL_4 ("cob_screen_accept",
4280  var, line, column, timeout));
4281  } else {
4282  cb_emit (CB_BUILD_FUNCALL_4 ("cob_screen_accept",
4283  var, pos, NULL, timeout));
4284  }
4285  } else {
4286  cb_emit (CB_BUILD_FUNCALL_4 ("cob_screen_accept",
4287  var, NULL, NULL, timeout));
4288  }
4289  gen_screen_ptr = 0;
4290  output_screen_to (CB_FIELD (cb_ref (var)), 0);
4291  } else {
4292  if (var == cb_null) {
4293  var = NULL;
4294  }
4295  if (pos || fgc || bgc || scroll || dispattrs) {
4296  cb_gen_field_accept (var, pos, fgc, bgc, scroll,
4297  timeout, prompt, dispattrs);
4298  } else {
4299  cb_emit (CB_BUILD_FUNCALL_9 ("cob_field_accept",
4300  var, NULL, NULL, fgc, bgc,
4301  scroll, timeout, prompt,
4302  cb_int (dispattrs)));
4303  }
4304  }
4305  } else if (pos || fgc || bgc || scroll || dispattrs) {
4306  /* Bump ref count to force CRT STATUS field generation */
4307  if (current_program->crt_status) {
4308  CB_FIELD_PTR (current_program->crt_status)->count++;
4309  }
4310  if (var == cb_null) {
4311  var = NULL;
4312  }
4313  cb_gen_field_accept (var, pos, fgc, bgc, scroll,
4314  timeout, prompt, dispattrs);
4315  } else {
4316  if (var == cb_null) {
4317  var = NULL;
4318  }
4319  cb_emit (CB_BUILD_FUNCALL_1 ("cob_accept", var));
4320  }
4321 }
void cb_emit_accept_arg_number ( cb_tree  )

References CB_BUILD_FUNCALL_1, cb_emit, and cb_validate_one().

4445 {
4446  if (cb_validate_one (var)) {
4447  return;
4448  }
4449  cb_emit (CB_BUILD_FUNCALL_1 ("cob_accept_arg_number", var));
4450 }
void cb_emit_accept_arg_value ( cb_tree  )

References CB_BUILD_FUNCALL_1, cb_emit, and cb_validate_one().

4454 {
4455  if (cb_validate_one (var)) {
4456  return;
4457  }
4458  cb_emit (CB_BUILD_FUNCALL_1 ("cob_accept_arg_value", var));
4459 }
void cb_emit_accept_command_line ( cb_tree  )

References CB_BUILD_FUNCALL_1, cb_emit, and cb_validate_one().

4415 {
4416  if (cb_validate_one (var)) {
4417  return;
4418  }
4419  cb_emit (CB_BUILD_FUNCALL_1 ("cob_accept_command_line", var));
4420 }
void cb_emit_accept_date ( cb_tree  )

References CB_BUILD_FUNCALL_1, cb_emit, and cb_validate_one().

4361 {
4362  if (cb_validate_one (var)) {
4363  return;
4364  }
4365  cb_emit (CB_BUILD_FUNCALL_1 ("cob_accept_date", var));
4366 }
void cb_emit_accept_date_yyyymmdd ( cb_tree  )

References CB_BUILD_FUNCALL_1, cb_emit, and cb_validate_one().

4370 {
4371  if (cb_validate_one (var)) {
4372  return;
4373  }
4374  cb_emit (CB_BUILD_FUNCALL_1 ("cob_accept_date_yyyymmdd", var));
4375 }
void cb_emit_accept_day ( cb_tree  )

References CB_BUILD_FUNCALL_1, cb_emit, and cb_validate_one().

4379 {
4380  if (cb_validate_one (var)) {
4381  return;
4382  }
4383  cb_emit (CB_BUILD_FUNCALL_1 ("cob_accept_day", var));
4384 }
void cb_emit_accept_day_of_week ( cb_tree  )

References CB_BUILD_FUNCALL_1, cb_emit, and cb_validate_one().

4397 {
4398  if (cb_validate_one (var)) {
4399  return;
4400  }
4401  cb_emit (CB_BUILD_FUNCALL_1 ("cob_accept_day_of_week", var));
4402 }
void cb_emit_accept_day_yyyyddd ( cb_tree  )

References CB_BUILD_FUNCALL_1, cb_emit, and cb_validate_one().

4388 {
4389  if (cb_validate_one (var)) {
4390  return;
4391  }
4392  cb_emit (CB_BUILD_FUNCALL_1 ("cob_accept_day_yyyyddd", var));
4393 }
void cb_emit_accept_environment ( cb_tree  )

References CB_BUILD_FUNCALL_1, cb_emit, and cb_validate_one().

4436 {
4437  if (cb_validate_one (var)) {
4438  return;
4439  }
4440  cb_emit (CB_BUILD_FUNCALL_1 ("cob_accept_environment", var));
4441 }
void cb_emit_accept_escape_key ( cb_tree  )

References CB_BUILD_FUNCALL_1, cb_emit, and cb_validate_one().

4334 {
4335  if (cb_validate_one (var)) {
4336  return;
4337  }
4338  cb_emit (CB_BUILD_FUNCALL_1 ("cob_accept_escape_key", var));
4339 }
void cb_emit_accept_exception_status ( cb_tree  )

References CB_BUILD_FUNCALL_1, cb_emit, and cb_validate_one().

4343 {
4344  if (cb_validate_one (var)) {
4345  return;
4346  }
4347  cb_emit (CB_BUILD_FUNCALL_1 ("cob_accept_exception_status", var));
4348 }
void cb_emit_accept_line_or_col ( cb_tree  ,
const int   
)

References CB_BUILD_FUNCALL_2, cb_emit, cb_int(), and cb_validate_one().

4325 {
4326  if (cb_validate_one (var)) {
4327  return;
4328  }
4329  cb_emit (CB_BUILD_FUNCALL_2 ("cob_screen_line_col", var, cb_int (l_or_c)));
4330 }
void cb_emit_accept_mnemonic ( cb_tree  ,
cb_tree   
)

References _, CB_BUILD_FUNCALL_1, CB_DEVICE_CONSOLE, CB_DEVICE_SYSIN, cb_emit, cb_error_node, cb_error_x(), cb_name(), cb_ref(), CB_SYSTEM_NAME, and cb_validate_one().

4463 {
4464  if (cb_validate_one (var)) {
4465  return;
4466  }
4467  if (cb_ref (mnemonic) == cb_error_node) {
4468  return;
4469  }
4470  switch (CB_SYSTEM_NAME (cb_ref (mnemonic))->token) {
4471  case CB_DEVICE_CONSOLE:
4472  case CB_DEVICE_SYSIN:
4473  cb_emit (CB_BUILD_FUNCALL_1 ("cob_accept", var));
4474  break;
4475  default:
4476  cb_error_x (mnemonic, _("Invalid input device '%s'"),
4477  cb_name (mnemonic));
4478  break;
4479  }
4480 }
void cb_emit_accept_name ( cb_tree  ,
cb_tree   
)

References _, CB_BUILD_FUNCALL_1, CB_DEVICE_CONSOLE, CB_DEVICE_SYSIN, cb_emit, cb_error_x(), CB_NAME, cb_name(), CB_SYSTEM_NAME, cb_validate_one(), cb_warning_x(), and lookup_system_name().

4484 {
4485  cb_tree sys;
4486 
4487  if (cb_validate_one (var)) {
4488  return;
4489  }
4490 
4491  /* Allow direct reference to a device name */
4492  sys = lookup_system_name (CB_NAME (name));
4493  if (sys) {
4494  switch (CB_SYSTEM_NAME (sys)->token) {
4495  case CB_DEVICE_CONSOLE:
4496  case CB_DEVICE_SYSIN:
4497  if (!cb_relaxed_syntax_check) {
4498  cb_warning_x (name, _("'%s' is not defined in SPECIAL-NAMES"), CB_NAME (name));
4499  }
4500  cb_emit (CB_BUILD_FUNCALL_1 ("cob_accept", var));
4501  return;
4502  default:
4503  cb_error_x (name, _("Invalid input device '%s'"),
4504  cb_name (name));
4505  return;
4506  }
4507  }
4508 
4509  cb_error_x (name, _("'%s' is not defined in SPECIAL-NAMES"),
4510  CB_NAME (name));
4511 }
void cb_emit_accept_time ( cb_tree  )

References CB_BUILD_FUNCALL_1, cb_emit, and cb_validate_one().

4406 {
4407  if (cb_validate_one (var)) {
4408  return;
4409  }
4410  cb_emit (CB_BUILD_FUNCALL_1 ("cob_accept_time", var));
4411 }
void cb_emit_accept_user_name ( cb_tree  )

References CB_BUILD_FUNCALL_1, cb_emit, and cb_validate_one().

4352 {
4353  if (cb_validate_one (var)) {
4354  return;
4355  }
4356  cb_emit (CB_BUILD_FUNCALL_1 ("cob_accept_user_name", var));
4357 }
void cb_emit_allocate ( cb_tree  ,
cb_tree  ,
cb_tree  ,
cb_tree   
)

References _, CB_BUILD_CAST_ADDR_OF_ADDR, CB_BUILD_FUNCALL_4, cb_build_initialize(), cb_build_numeric_literal(), cb_category_is_alpha(), CB_CLASS_NUMERIC, CB_CLASS_POINTER, cb_emit, cb_error_x(), CB_FIELD_PTR, CB_REFERENCE_P, CB_TREE, CB_TREE_CLASS, cb_true, cb_validate_one(), current_statement, cb_field::flag_item_based, cb_statement::handler2, cb_field::memory_size, and NULL.

4518 {
4519  cb_tree x;
4520  char buff[32];
4521 
4522  if (cb_validate_one (target1)) {
4523  return;
4524  }
4525  if (cb_validate_one (target2)) {
4526  return;
4527  }
4528  if (cb_validate_one (size)) {
4529  return;
4530  }
4531  if (cb_validate_one (initialize)) {
4532  return;
4533  }
4534  if (target1) {
4535  if (!(CB_REFERENCE_P(target1) &&
4536  CB_FIELD_PTR (target1)->flag_item_based)) {
4537  cb_error_x (CB_TREE(current_statement),
4538  _("Target of ALLOCATE is not a BASED item"));
4539  return;
4540  }
4541  }
4542  if (target2) {
4543  if (!(CB_REFERENCE_P(target2) &&
4544  CB_TREE_CLASS (target2) == CB_CLASS_POINTER)) {
4545  cb_error_x (CB_TREE(current_statement),
4546  _("Target of RETURNING is not a data pointer"));
4547  return;
4548  }
4549  }
4550  if (size) {
4551  if (CB_TREE_CLASS (size) != CB_CLASS_NUMERIC) {
4552  cb_error_x (CB_TREE(current_statement),
4553  _("The CHARACTERS field of ALLOCATE must be numeric"));
4554  return;
4555  }
4556  }
4557  if (target1) {
4558  sprintf (buff, "%d", CB_FIELD_PTR (target1)->memory_size);
4559  x = cb_build_numeric_literal (0, buff, 0);
4560  cb_emit (CB_BUILD_FUNCALL_4 ("cob_allocate",
4561  CB_BUILD_CAST_ADDR_OF_ADDR (target1),
4562  target2, x, NULL));
4563  } else {
4564  if (initialize && !cb_category_is_alpha (initialize)) {
4565  cb_error_x (CB_TREE(current_statement),
4566  _("INITIALIZED TO item is not alphanumeric"));
4567  }
4568  cb_emit (CB_BUILD_FUNCALL_4 ("cob_allocate",
4569  NULL, target2, size, initialize));
4570  }
4571  if (initialize && target1) {
4572  current_statement->handler2 =
4573  cb_build_initialize (target1, cb_true, NULL, 1, 0, 0);
4574  }
4575 }
void cb_emit_alter ( cb_tree  ,
cb_tree   
)

References cb_build_alter(), cb_emit, cb_error_node, and CB_REFERENCE.

4582 {
4583  if (source == cb_error_node) {
4584  return;
4585  }
4586  if (target == cb_error_node) {
4587  return;
4588  }
4589  CB_REFERENCE(source)->flag_alter_code = 1;
4590  cb_emit (cb_build_alter (source, target));
4591 }
void cb_emit_arg_number ( cb_tree  )

References CB_BUILD_FUNCALL_1, cb_emit, and cb_validate_one().

4973 {
4974  if (cb_validate_one (value)) {
4975  return;
4976  }
4977  cb_emit (CB_BUILD_FUNCALL_1 ("cob_display_arg_number", value));
4978 }
void cb_emit_arithmetic ( cb_tree  ,
const int  ,
cb_tree   
)

References build_decimal_assign(), CB_BINARY_OP_P, cb_build_add(), cb_build_div(), cb_build_mul(), cb_build_sub(), CB_CHAIN, cb_check_data_incompat(), cb_check_numeric_edited_name(), cb_check_numeric_name(), cb_check_numeric_value(), cb_emit_list, cb_error_node, cb_list_map(), CB_PURPOSE, cb_validate_list(), cb_validate_one(), and CB_VALUE.

3389 {
3390  cb_tree l;
3391  cb_tree x;
3392 
3393  x = cb_check_numeric_value (val);
3394 
3395  if (op) {
3396  cb_list_map (cb_check_numeric_name, vars);
3397  } else {
3398  cb_list_map (cb_check_numeric_edited_name, vars);
3399  }
3400 
3401  if (cb_validate_one (x)) {
3402  return;
3403  }
3404  if (cb_validate_list (vars)) {
3405  return;
3406  }
3407 
3408  if (!CB_BINARY_OP_P (x)) {
3409  if (op == '+' || op == '-' || op == '*' || op == '/') {
3410  cb_check_data_incompat (x);
3411  for (l = vars; l; l = CB_CHAIN (l)) {
3412  cb_check_data_incompat (CB_VALUE (l));
3413  switch (op) {
3414  case '+':
3415  CB_VALUE (l) = cb_build_add (CB_VALUE (l), x, CB_PURPOSE (l));
3416  break;
3417  case '-':
3418  CB_VALUE (l) = cb_build_sub (CB_VALUE (l), x, CB_PURPOSE (l));
3419  break;
3420  case '*':
3421  CB_VALUE (l) = cb_build_mul (CB_VALUE (l), x, CB_PURPOSE (l));
3422  break;
3423  case '/':
3424  CB_VALUE (l) = cb_build_div (CB_VALUE (l), x, CB_PURPOSE (l));
3425  break;
3426  }
3427  }
3428  cb_emit_list (vars);
3429  return;
3430  }
3431  }
3432  if (x == cb_error_node) {
3433  return;
3434  }
3435 
3436  cb_emit_list (build_decimal_assign (vars, op, x));
3437 }
void cb_emit_call ( cb_tree  ,
cb_tree  ,
cb_tree  ,
cb_tree  ,
cb_tree  ,
cb_tree   
)

References _, cb_build_call(), CB_CALL_BY_REFERENCE, CB_CALL_BY_VALUE, CB_CATEGORY_ALPHANUMERIC, CB_CHAIN, CB_CLASS_NUMERIC, CB_CLASS_POINTER, CB_CONST_P, CB_CONV_STATIC_LINK, CB_CONV_STDCALL, cb_emit, cb_error_node, cb_error_x(), CB_FIELD_P, CB_FIELD_PTR, cb_get_int(), cb_get_long_long(), CB_INTEGER, CB_INTEGER_P, CB_INTRINSIC, CB_INTRINSIC_P, cb_list_length(), CB_LITERAL, CB_LITERAL_P, CB_NAME, cb_null, CB_NUMERIC_LITERAL_P, CB_PURPOSE_INT, CB_REFERENCE, CB_REFERENCE_P, CB_SIZE_1, CB_SIZE_2, CB_SIZE_4, CB_SIZE_8, CB_SIZE_AUTO, CB_SIZES_INT, CB_SIZES_INT_UNSIGNED, CB_TREE, CB_TREE_CLASS, CB_VALUE, cb_warning(), cb_warning_x(), cob_s64_t, cob_u32_t, current_program, current_statement, cb_field::flag_any_length, cb_field::level, cb_program::max_call_param, NULL, p, sign, system_table::syst_name, system_table::syst_params, value, and warningopt.

4599 {
4600  cb_tree l;
4601  cb_tree x;
4602  struct cb_field *f;
4603  const struct system_table *psyst;
4604  const char *p;
4605  const char *entry;
4606  cob_s64_t val;
4607  cob_s64_t valmin;
4608  cob_s64_t valmax;
4609  cob_u32_t is_sys_call;
4610  cob_u32_t is_sys_idx;
4611  int error_ind;
4612  int call_conv;
4613  int numargs;
4614 
4615  if (CB_INTRINSIC_P (prog)) {
4616  if (CB_INTRINSIC(prog)->intr_tab->category != CB_CATEGORY_ALPHANUMERIC) {
4617  cb_error_x (CB_TREE (current_statement),
4618  _("Only alphanumeric FUNCTION types are allowed here"));
4619  return;
4620  }
4621  }
4622  if (returning && returning != cb_null) {
4623  if (CB_TREE_CLASS(returning) != CB_CLASS_NUMERIC &&
4624  CB_TREE_CLASS(returning) != CB_CLASS_POINTER) {
4625  cb_error_x (CB_TREE (current_statement),
4626  _("Invalid RETURNING field"));
4627  return;
4628  }
4629  }
4630 
4631  error_ind = 0;
4632  numargs = 0;
4633 
4634  if (convention) {
4635  if (CB_INTEGER_P (convention)) {
4636  call_conv = CB_INTEGER (convention)->val;
4637  } else {
4638  call_conv = cb_get_int (convention);
4639  }
4640  } else {
4641  call_conv = 0;
4642  }
4643 #ifndef _WIN32
4644  if (call_conv & CB_CONV_STDCALL) {
4645  call_conv &= ~CB_CONV_STDCALL;
4646  if (warningopt) {
4647  cb_warning (_("STDCALL not available on this platform"));
4648  }
4649  }
4650 #elif defined(_WIN64)
4651  if (call_conv & CB_CONV_STDCALL) {
4652  if (warningopt) {
4653  cb_warning (_("STDCALL used on 64-bit Windows platform"));
4654  }
4655  }
4656 #endif
4657  if ((call_conv & CB_CONV_STATIC_LINK) && !CB_LITERAL_P (prog)) {
4658  cb_error_x (CB_TREE (current_statement),
4659  _("STATIC CALL convention requires a literal program name"));
4660  error_ind = 1;
4661  }
4662 
4663  for (l = par_using; l; l = CB_CHAIN (l), numargs++) {
4664  x = CB_VALUE (l);
4665  if (x == cb_error_node) {
4666  error_ind = 1;
4667  continue;
4668  }
4669  if (CB_NUMERIC_LITERAL_P (x)) {
4670  if (CB_PURPOSE_INT (l) != CB_CALL_BY_VALUE) {
4671  continue;
4672  }
4673  if (CB_SIZES_INT_UNSIGNED(l) &&
4674  CB_LITERAL (x)->sign < 0) {
4675  cb_error_x (x, _("Numeric literal is negative"));
4676  error_ind = 1;
4677  continue;
4678  }
4679  val = 0;
4680  valmin = 0;
4681  valmax = 0;
4682  switch (CB_SIZES_INT (l)) {
4683  case CB_SIZE_1:
4684  val = cb_get_long_long (x);
4685  if (CB_SIZES_INT_UNSIGNED(l)) {
4686  valmin = 0;
4687  valmax = UCHAR_MAX;
4688  } else {
4689  valmin = CHAR_MIN;
4690  valmax = CHAR_MAX;
4691  }
4692  break;
4693  case CB_SIZE_2:
4694  val = cb_get_long_long (x);
4695  if (CB_SIZES_INT_UNSIGNED(l)) {
4696  valmin = 0;
4697  valmax = USHRT_MAX;
4698  } else {
4699  valmin = SHRT_MIN;
4700  valmax = SHRT_MAX;
4701  }
4702  break;
4703  case CB_SIZE_4:
4704  val = cb_get_long_long (x);
4705  if (CB_SIZES_INT_UNSIGNED(l)) {
4706  valmin = 0;
4707  valmax = UINT_MAX;
4708  } else {
4709  valmin = INT_MIN;
4710  valmax = INT_MAX;
4711  }
4712  break;
4713  case CB_SIZE_8:
4714  case CB_SIZE_AUTO:
4715  if (CB_SIZES_INT_UNSIGNED(l)) {
4716  if (CB_LITERAL (x)->size < 20) {
4717  break;
4718  }
4719  if (CB_LITERAL (x)->size > 20) {
4720  valmin = 1;
4721  break;
4722  }
4723  if (memcmp (CB_LITERAL (x)->data,
4724  "18446744073709551615",
4725  (size_t)20) > 0) {
4726  valmin = 1;
4727  break;
4728  }
4729  } else {
4730  if (CB_LITERAL (x)->size < 19) {
4731  break;
4732  }
4733  if (CB_LITERAL (x)->size > 19) {
4734  valmin = 1;
4735  break;
4736  }
4737  if (memcmp (CB_LITERAL (x)->data,
4738  "9223372036854775807",
4739  (size_t)19) > 0) {
4740  valmin = 1;
4741  break;
4742  }
4743  }
4744  break;
4745  default:
4746  break;
4747  }
4748  if (!valmin && !valmax) {
4749  continue;
4750  }
4751  if (val < valmin || val > valmax) {
4752  cb_error_x (x, _("Numeric literal exceeds size limits"));
4753  error_ind = 1;
4754  }
4755  continue;
4756  }
4757  if (CB_CONST_P (x) && x != cb_null) {
4758  cb_error_x (x, _("Figurative constant invalid here"));
4759  error_ind = 1;
4760  continue;
4761  }
4762  if ((CB_REFERENCE_P (x) && CB_FIELD_P(CB_REFERENCE(x)->value)) ||
4763  CB_FIELD_P (x)) {
4764  f = CB_FIELD_PTR (x);
4765  if (f->level == 88) {
4766  cb_error_x (x, _("'%s' is not a valid data name"), CB_NAME (x));
4767  error_ind = 1;
4768  continue;
4769  }
4770  if (f->flag_any_length &&
4771  CB_PURPOSE_INT (l) != CB_CALL_BY_REFERENCE) {
4772  cb_error_x (x, _("'%s' ANY LENGTH item not passed BY REFERENCE"), CB_NAME (x));
4773  error_ind = 1;
4774  continue;
4775  }
4776  if (cb_warn_call_params &&
4777  CB_PURPOSE_INT (l) == CB_CALL_BY_REFERENCE) {
4778  if (f->level != 01 && f->level != 77) {
4779  cb_warning_x (x, _("'%s' is not a 01 or 77 level item"), CB_NAME (x));
4780  }
4781  }
4782  }
4783  }
4784 
4785  is_sys_call = 0;
4786  if (CB_LITERAL_P(prog)) {
4787  entry = NULL;
4788  p = (const char *)CB_LITERAL(prog)->data;
4789  for (; *p; ++p) {
4790  if (*p == '/' || *p == '\\') {
4791  entry = p + 1;
4792  }
4793  }
4794  if (!entry) {
4795  entry = (const char *)CB_LITERAL(prog)->data;
4796  }
4797  is_sys_idx = 1;
4798  for (psyst = system_tab; psyst->syst_name; psyst++, is_sys_idx++) {
4799  if (!strcmp(entry, (const char *)psyst->syst_name)) {
4800  if (psyst->syst_params > cb_list_length (par_using)) {
4801  cb_error_x (CB_TREE (current_statement),
4802  _("Wrong number of CALL parameters for '%s'"),
4803  (char *)psyst->syst_name);
4804  return;
4805  }
4806  is_sys_call = is_sys_idx;
4807  break;
4808  }
4809  }
4810  }
4811 
4812  if (error_ind) {
4813  return;
4814  }
4815  if (numargs > current_program->max_call_param) {
4816  current_program->max_call_param = numargs;
4817  }
4818  cb_emit (cb_build_call (prog, par_using, on_exception, not_on_exception,
4819  returning, is_sys_call, call_conv));
4820 }
void cb_emit_cancel ( cb_tree  )

References cb_build_cancel(), cb_emit, and cb_validate_one().

4826 {
4827  if (cb_validate_one (prog)) {
4828  return;
4829  }
4830  cb_emit (cb_build_cancel (prog));
4831 }
void cb_emit_close ( cb_tree  ,
cb_tree   
)

References _, cb_build_debug(), cb_build_debug_call(), CB_BUILD_FUNCALL_4, cb_build_move(), cb_emit, cb_error_node, cb_error_x(), CB_FILE, cb_int0, cb_ref(), cb_space, CB_TREE, COB_ORG_SORT, current_program, current_statement, cb_file::debug_section, file, cb_statement::file, cb_file::file_status, cb_program::flag_debugging, cb_file::flag_fl_debug, cb_statement::flag_in_debug, cb_file::name, NULL, and cb_file::organization.

4837 {
4838  struct cb_file *f;
4839 
4840  if (file == cb_error_node) {
4841  return;
4842  }
4843  file = cb_ref (file);
4844  if (file == cb_error_node) {
4845  return;
4846  }
4847  current_statement->file = file;
4848  f = CB_FILE (file);
4849 
4850  if (f->organization == COB_ORG_SORT) {
4851  cb_error_x (CB_TREE (current_statement),
4852  _("Operation not allowed on SORT files"));
4853  }
4854 
4855  cb_emit (CB_BUILD_FUNCALL_4 ("cob_close", file,
4856  f->file_status, opt, cb_int0));
4857 
4858  /* Check for file debugging */
4859  if (current_program->flag_debugging &&
4860  !current_statement->flag_in_debug &&
4861  CB_FILE(file)->flag_fl_debug) {
4862  cb_emit (cb_build_debug (cb_debug_name, f->name, NULL));
4863  cb_emit (cb_build_move (cb_space, cb_debug_contents));
4864  cb_emit (cb_build_debug_call (f->debug_section));
4865  }
4866 }
void cb_emit_command_line ( cb_tree  )

References CB_BUILD_FUNCALL_1, cb_emit, and cb_validate_one().

4982 {
4983  if (cb_validate_one (value)) {
4984  return;
4985  }
4986  cb_emit (CB_BUILD_FUNCALL_1 ("cob_display_command_line", value));
4987 }
void cb_emit_commit ( void  )

References CB_BUILD_FUNCALL_0, and cb_emit.

4872 {
4873  cb_emit (CB_BUILD_FUNCALL_0 ("cob_commit"));
4874 }
void cb_emit_continue ( void  )

References cb_build_continue(), and cb_emit.

4880 {
4881  cb_emit (cb_build_continue ());
4882 }
void cb_emit_corresponding ( cb_tree(*)(cb_tree, cb_tree, cb_tree)  ,
cb_tree  ,
cb_tree  ,
cb_tree   
)
void cb_emit_delete ( cb_tree  )

References _, CB_BUILD_FUNCALL_2, cb_emit, cb_error_node, cb_error_x(), CB_FILE, cb_ref(), CB_TREE, COB_ORG_LINE_SEQUENTIAL, COB_ORG_SORT, current_program, current_statement, file, cb_statement::file, cb_file::file_status, cb_statement::flag_callback, cb_program::flag_debugging, cb_file::flag_fl_debug, cb_statement::flag_in_debug, and cb_file::organization.

4888 {
4889  struct cb_file *f;
4890 
4891  if (file == cb_error_node) {
4892  return;
4893  }
4894  file = cb_ref (file);
4895  if (file == cb_error_node) {
4896  return;
4897  }
4898  current_statement->file = file;
4899  f = CB_FILE (file);
4900 
4901  if (f->organization == COB_ORG_SORT) {
4902  cb_error_x (CB_TREE (current_statement),
4903  _("Operation not allowed on SORT files"));
4904  return;
4905  } else if (f->organization == COB_ORG_LINE_SEQUENTIAL) {
4906  cb_error_x (CB_TREE (current_statement),
4907  _("Operation not allowed on LINE SEQUENTIAL files"));
4908  return;
4909  }
4910 
4911  /* Check for file debugging */
4912  if (current_program->flag_debugging &&
4913  !current_statement->flag_in_debug &&
4914  f->flag_fl_debug) {
4915  /* Gen callback after delete but before exception test */
4916  current_statement->flag_callback = 1;
4917  }
4918 
4919  cb_emit (CB_BUILD_FUNCALL_2 ("cob_delete", file,
4920  f->file_status));
4921 }
void cb_emit_delete_file ( cb_tree  )

References _, CB_BUILD_FUNCALL_2, cb_emit, cb_error_node, cb_error_x(), CB_FILE, cb_ref(), CB_TREE, COB_ORG_SORT, current_program, current_statement, cb_file::file_status, cb_statement::flag_callback, cb_program::flag_debugging, cb_file::flag_fl_debug, cb_statement::flag_in_debug, and cb_file::organization.

4925 {
4926  if (file == cb_error_node) {
4927  return;
4928  }
4929  file = cb_ref (file);
4930  if (file == cb_error_node) {
4931  return;
4932  }
4933  if (CB_FILE (file)->organization == COB_ORG_SORT) {
4934  cb_error_x (CB_TREE (current_statement),
4935  _("Operation not allowed on SORT files"));
4936  return;
4937  }
4938 
4939  /* Check for file debugging */
4940  if (current_program->flag_debugging &&
4941  !current_statement->flag_in_debug &&
4942  CB_FILE(file)->flag_fl_debug) {
4943  /* Gen callback after delete but before exception test */
4944  current_statement->flag_callback = 1;
4945  }
4946 
4947  cb_emit (CB_BUILD_FUNCALL_2 ("cob_delete_file", file,
4948  CB_FILE(file)->file_status));
4949 }
void cb_emit_display ( cb_tree  ,
cb_tree  ,
cb_tree  ,
cb_tree  ,
struct cb_attr_struct *   
)

References _, cb_attr_struct::bgc, CB_BUILD_FUNCALL_0, CB_BUILD_FUNCALL_3, CB_BUILD_FUNCALL_7, CB_CHAIN, cb_emit, cb_error_node, cb_error_x(), CB_FIELD, CB_FIELD_P, CB_FUNCALL, cb_int(), cb_int0, cb_list_length(), CB_LITERAL, CB_LITERAL_P, cb_low, cb_name(), cb_null, CB_PAIR_P, CB_PAIR_X, CB_PAIR_Y, cb_ref(), CB_REF_OR_FIELD_P, CB_REFERENCE, cb_space, CB_STORAGE_SCREEN, CB_TAG_CONST, CB_TAG_INTEGER, CB_TAG_INTRINSIC, CB_TAG_LITERAL, CB_TAG_REFERENCE, CB_TAG_STRING, CB_TREE_TAG, cb_validate_list(), cb_validate_one(), CB_VALUE, COB_SCREEN_BELL, COB_SCREEN_ERASE_EOL, COB_SCREEN_ERASE_EOS, COB_SCREEN_NO_DISP, cb_attr_struct::dispattrs, cb_attr_struct::fgc, gen_screen_ptr, line, NULL, output_screen_from(), p, cb_attr_struct::scroll, and value.

4992 {
4993  cb_tree l;
4994  cb_tree x;
4995  cb_tree line;
4996  cb_tree column;
4997  cb_tree p;
4998  cb_tree fgc;
4999  cb_tree bgc;
5000  cb_tree scroll;
5001  int dispattrs;
5002 
5003  if (attr_ptr) {
5004  fgc = attr_ptr->fgc;
5005  bgc = attr_ptr->bgc;
5006  scroll = attr_ptr->scroll;
5007  dispattrs = attr_ptr->dispattrs;
5008  } else {
5009  fgc = NULL;
5010  bgc = NULL;
5011  scroll = NULL;
5012  dispattrs = 0;
5013  }
5014 
5015  if (cb_validate_list (values)) {
5016  return;
5017  }
5018  if (cb_validate_one (pos)) {
5019  return;
5020  }
5021  if (cb_validate_one (fgc)) {
5022  return;
5023  }
5024  if (cb_validate_one (bgc)) {
5025  return;
5026  }
5027  if (cb_validate_one (scroll)) {
5028  return;
5029  }
5030  for (l = values; l; l = CB_CHAIN (l)) {
5031  x = CB_VALUE (l);
5032  if (x == cb_error_node) {
5033  return;
5034  }
5035 
5036  switch (CB_TREE_TAG (x)) {
5037  case CB_TAG_LITERAL:
5038  case CB_TAG_INTRINSIC:
5039  case CB_TAG_CONST:
5040  case CB_TAG_STRING:
5041  case CB_TAG_INTEGER:
5042  break;
5043  case CB_TAG_REFERENCE:
5044  if (!CB_FIELD_P(CB_REFERENCE(x)->value)) {
5045  cb_error_x (x, _("'%s' is an invalid type for DISPLAY operand"), cb_name (x));
5046  return;
5047  }
5048  break;
5049  default:
5050  cb_error_x (x, _("Invalid type for DISPLAY operand"));
5051  return;
5052  }
5053  }
5054  if (upon == cb_error_node) {
5055  return;
5056  }
5057 
5058  x = CB_VALUE (values);
5059  if ((CB_REF_OR_FIELD_P (x)) &&
5060  CB_FIELD (cb_ref (x))->storage == CB_STORAGE_SCREEN) {
5061  output_screen_from (CB_FIELD (cb_ref (x)), 0);
5062  gen_screen_ptr = 1;
5063  if (pos) {
5064  if (CB_PAIR_P (pos)) {
5065  line = CB_PAIR_X (pos);
5066  column = CB_PAIR_Y (pos);
5067  if (line == cb_int0) {
5068  line = NULL;
5069  }
5070  cb_emit (CB_BUILD_FUNCALL_3 ("cob_screen_display",
5071  x, line, column));
5072  } else {
5073  cb_emit (CB_BUILD_FUNCALL_3 ("cob_screen_display",
5074  x, pos, NULL));
5075  }
5076  } else {
5077  cb_emit (CB_BUILD_FUNCALL_3 ("cob_screen_display", x,
5078  NULL, NULL));
5079  }
5080  gen_screen_ptr = 0;
5081  } else if (pos || fgc || bgc || scroll || dispattrs || upon == cb_null) {
5082  for (l = values; l; l = CB_CHAIN (l)) {
5083  x = CB_VALUE (l);
5084  if (x == cb_space) {
5085  dispattrs |= COB_SCREEN_ERASE_EOS;
5086  dispattrs |= COB_SCREEN_NO_DISP;
5087  } else if (x == cb_low) {
5088  dispattrs |= COB_SCREEN_NO_DISP;
5089  } else if (CB_LITERAL_P (x) && CB_LITERAL (x)->all &&
5090  CB_LITERAL (x)->size == 1) {
5091  if (CB_LITERAL (x)->data[0] == 1) {
5092  dispattrs |= COB_SCREEN_ERASE_EOL;
5093  dispattrs |= COB_SCREEN_NO_DISP;
5094  } else if (CB_LITERAL (x)->data[0] == 2) {
5095  cb_emit (CB_BUILD_FUNCALL_0 ("cob_sys_clear_screen"));
5096  return;
5097  } else if (CB_LITERAL (x)->data[0] == 7) {
5098  dispattrs |= COB_SCREEN_BELL;
5099  dispattrs |= COB_SCREEN_NO_DISP;
5100  }
5101  }
5102  if (!pos) {
5103  cb_emit (CB_BUILD_FUNCALL_7 ("cob_field_display",
5104  x, NULL, NULL, fgc, bgc,
5105  scroll, cb_int (dispattrs)));
5106  } else if (CB_PAIR_P (pos)) {
5107  line = CB_PAIR_X (pos);
5108  column = CB_PAIR_Y (pos);
5109  if (line == cb_int0) {
5110  line = NULL;
5111  }
5112  cb_emit (CB_BUILD_FUNCALL_7 ("cob_field_display",
5113  x, line, column, fgc, bgc,
5114  scroll, cb_int (dispattrs)));
5115  } else {
5116  cb_emit (CB_BUILD_FUNCALL_7 ("cob_field_display",
5117  x, pos, NULL, fgc, bgc,
5118  scroll, cb_int (dispattrs)));
5119  }
5120  }
5121  } else {
5122  /* DISPLAY x ... [UPON device-name] */
5123  p = CB_BUILD_FUNCALL_3 ("cob_display", upon, no_adv, values);
5124  CB_FUNCALL(p)->varcnt = cb_list_length (values);
5125  CB_FUNCALL(p)->nolitcast = 1;
5126  cb_emit (p);
5127  for (l = values; l; l = CB_CHAIN (l)) {
5128  x = CB_VALUE (l);
5129  if (CB_FIELD_P (x)) {
5130  CB_FIELD (cb_ref (x))->count++;
5131  }
5132  }
5133  }
5134 }
void cb_emit_divide ( cb_tree  ,
cb_tree  ,
cb_tree  ,
cb_tree   
)

References build_store_option(), CB_BUILD_FUNCALL_2, CB_BUILD_FUNCALL_4, cb_check_numeric_edited_name(), cb_emit, cb_int0, CB_PURPOSE, cb_validate_one(), and CB_VALUE.

5198 {
5199  if (cb_validate_one (dividend)) {
5200  return;
5201  }
5202  if (cb_validate_one (divisor)) {
5203  return;
5204  }
5205  CB_VALUE (quotient) = cb_check_numeric_edited_name (CB_VALUE (quotient));
5206  CB_VALUE (remainder) = cb_check_numeric_edited_name (CB_VALUE (remainder));
5207 
5208  if (cb_validate_one (CB_VALUE (quotient))) {
5209  return;
5210  }
5211  if (cb_validate_one (CB_VALUE (remainder))) {
5212  return;
5213  }
5214 
5215  cb_emit (CB_BUILD_FUNCALL_4 ("cob_div_quotient", dividend, divisor,
5216  CB_VALUE (quotient),
5217  build_store_option (CB_VALUE (quotient),
5218  CB_PURPOSE (quotient))));
5219  cb_emit (CB_BUILD_FUNCALL_2 ("cob_div_remainder", CB_VALUE (remainder),
5220  build_store_option (CB_VALUE (remainder),
5221  cb_int0)));
5222 }
void cb_emit_env_name ( cb_tree  )

References CB_BUILD_FUNCALL_1, cb_emit, and cb_validate_one().

4955 {
4956  if (cb_validate_one (value)) {
4957  return;
4958  }
4959  cb_emit (CB_BUILD_FUNCALL_1 ("cob_display_environment", value));
4960 }
void cb_emit_env_value ( cb_tree  )

References CB_BUILD_FUNCALL_1, cb_emit, and cb_validate_one().

4964 {
4965  if (cb_validate_one (value)) {
4966  return;
4967  }
4968  cb_emit (CB_BUILD_FUNCALL_1 ("cob_display_env_value", value));
4969 }
void cb_emit_evaluate ( cb_tree  ,
cb_tree   
)

References build_evaluate(), cb_build_comment(), cb_build_direct(), cb_emit, cb_id, CB_PREFIX_LABEL, and cobc_parse_strdup().

5369 {
5370  cb_tree x;
5371  char sbuf[16];
5372 
5373  snprintf (sbuf, sizeof(sbuf), "goto %s%d;", CB_PREFIX_LABEL, cb_id);
5374  x = cb_build_direct (cobc_parse_strdup (sbuf), 0);
5375  build_evaluate (subject_list, case_list, x);
5376  snprintf (sbuf, sizeof(sbuf), "%s%d:;", CB_PREFIX_LABEL, cb_id);
5377  cb_emit (cb_build_comment ("End EVALUATE"));
5378  cb_emit (cb_build_direct (cobc_parse_strdup (sbuf), 0));
5379  cb_id++;
5380 }
void cb_emit_exit ( const unsigned  int)

References cb_build_goto(), cb_emit, cb_int1, and NULL.

5451 {
5452  if (goback) {
5453  cb_emit (cb_build_goto (cb_int1, NULL));
5454  } else {
5455  cb_emit (cb_build_goto (NULL, NULL));
5456  }
5457 }
void cb_emit_free ( cb_tree  )

References _, CB_BUILD_CAST_ADDR_OF_ADDR, CB_BUILD_CAST_ADDRESS, CB_BUILD_FUNCALL_2, CB_CAST, CB_CAST_P, CB_CHAIN, CB_CLASS_POINTER, cb_emit, cb_error_x(), CB_FIELD_PTR, CB_REF_OR_FIELD_P, CB_TREE, CB_TREE_CLASS, cb_validate_list(), CB_VALUE, current_statement, cb_field::flag_item_based, and NULL.

5386 {
5387  cb_tree l;
5388  struct cb_field *f;
5389  int i;
5390 
5391  if (cb_validate_list (vars)) {
5392  return;
5393  }
5394  for (l = vars, i = 1; l; l = CB_CHAIN (l), i++) {
5395  if (CB_TREE_CLASS (CB_VALUE (l)) == CB_CLASS_POINTER) {
5396  if (CB_CAST_P (CB_VALUE (l))) {
5397  f = CB_FIELD_PTR (CB_CAST (CB_VALUE(l))->val);
5398  if (!f->flag_item_based) {
5399  cb_error_x (CB_TREE (current_statement),
5400  _("Target %d of FREE is not a BASED data item"), i);
5401  }
5402  cb_emit (CB_BUILD_FUNCALL_2 ("cob_free_alloc",
5403  CB_BUILD_CAST_ADDRESS (CB_VALUE (l)), NULL));
5404  } else {
5405  cb_emit (CB_BUILD_FUNCALL_2 ("cob_free_alloc",
5406  NULL, CB_BUILD_CAST_ADDRESS (CB_VALUE (l))));
5407  }
5408  } else if (CB_REF_OR_FIELD_P (CB_VALUE (l))) {
5409  f = CB_FIELD_PTR (CB_VALUE (l));
5410  if (!f->flag_item_based) {
5411  cb_error_x (CB_TREE (current_statement),
5412  _("Target %d of FREE is not a BASED data item"), i);
5413  }
5414  cb_emit (CB_BUILD_FUNCALL_2 ("cob_free_alloc",
5415  CB_BUILD_CAST_ADDR_OF_ADDR (CB_VALUE (l)), NULL));
5416  } else {
5417  cb_error_x (CB_TREE (current_statement),
5418  _("Target %d of FREE must be a data pointer"), i);
5419  }
5420  }
5421 }
void cb_emit_get_environment ( cb_tree  ,
cb_tree   
)

References CB_BUILD_FUNCALL_2, cb_emit, and cb_validate_one().

4424 {
4425  if (cb_validate_one (envvar)) {
4426  return;
4427  }
4428  if (cb_validate_one (envval)) {
4429  return;
4430  }
4431  cb_emit (CB_BUILD_FUNCALL_2 ("cob_get_environment", envvar, envval));
4432 }
void cb_emit_goto ( cb_tree  ,
cb_tree   
)

References _, cb_build_goto(), CB_CHAIN, cb_check_data_incompat(), cb_check_numeric_value(), cb_emit, cb_error_node, cb_error_x(), CB_TREE, CB_VALUE, cb_verify(), current_statement, and NULL.

5427 {
5428  if (target == cb_error_node) {
5429  return;
5430  }
5431  if (target == NULL) {
5432  cb_verify (cb_goto_statement_without_name, "GO TO without procedure-name");
5433  } else if (depending) {
5434  /* GO TO procedure-name ... DEPENDING ON identifier */
5435  if (cb_check_numeric_value (depending) == cb_error_node) {
5436  return;
5437  }
5438  cb_check_data_incompat (depending);
5439  cb_emit (cb_build_goto (target, depending));
5440  } else if (CB_CHAIN (target)) {
5441  cb_error_x (CB_TREE (current_statement),
5442  _("GO TO with multiple procedure-names"));
5443  } else {
5444  /* GO TO procedure-name */
5445  cb_emit (cb_build_goto (CB_VALUE (target), NULL));
5446  }
5447 }
void cb_emit_if ( cb_tree  ,
cb_tree  ,
cb_tree   
)

References cb_build_if(), and cb_emit.

5463 {
5464  cb_emit (cb_build_if (cond, stmt1, stmt2, 1));
5465 }
void cb_emit_initialize ( cb_tree  ,
cb_tree  ,
cb_tree  ,
cb_tree  ,
cb_tree   
)

References cb_build_initialize(), CB_CHAIN, cb_emit, cb_true, cb_validate_list(), CB_VALUE, and NULL.

5481 {
5482  cb_tree l;
5483  unsigned int no_fill_init;
5484  unsigned int def_init;
5485 
5486  if (cb_validate_list (vars)) {
5487  return;
5488  }
5489  if (value == NULL && replacing == NULL) {
5490  def = cb_true;
5491  }
5492  no_fill_init = (fillinit == NULL);
5493  def_init = (def != NULL);
5494  for (l = vars; l; l = CB_CHAIN (l)) {
5495  cb_emit (cb_build_initialize (CB_VALUE (l), value, replacing,
5496  def_init, 1, no_fill_init));
5497  }
5498 }
void cb_emit_inspect ( cb_tree  ,
cb_tree  ,
cb_tree  ,
const unsigned  int 
)

References _, CB_BUILD_FUNCALL_0, CB_BUILD_FUNCALL_2, CB_CATEGORY_ALPHABETIC, CB_CATEGORY_ALPHANUMERIC, CB_CATEGORY_NATIONAL, cb_emit, cb_emit_list, cb_error_x(), CB_TAG_INTRINSIC, CB_TAG_LITERAL, CB_TAG_REFERENCE, CB_TREE, CB_TREE_CATEGORY, CB_TREE_TAG, and current_statement.

5596 {
5597  switch (CB_TREE_TAG(var)) {
5598  case CB_TAG_REFERENCE:
5599  break;
5600  case CB_TAG_INTRINSIC:
5601  if (replconv) {
5602  goto rep_error;
5603  }
5604  switch (CB_TREE_CATEGORY(var)) {
5605  case CB_CATEGORY_ALPHABETIC:
5606  case CB_CATEGORY_ALPHANUMERIC:
5607  case CB_CATEGORY_NATIONAL:
5608  break;
5609  default:
5610  cb_error_x (CB_TREE (current_statement),
5611  _("Invalid target for INSPECT"));
5612  return;
5613  }
5614  break;
5615  case CB_TAG_LITERAL:
5616  if (replconv) {
5617  goto rep_error;
5618  }
5619  break;
5620  default:
5621  goto rep_error;
5622  }
5623  cb_emit (CB_BUILD_FUNCALL_2 ("cob_inspect_init", var, replacing));
5624  cb_emit_list (body);
5625  cb_emit (CB_BUILD_FUNCALL_0 ("cob_inspect_finish"));
5626  return;
5627 rep_error:
5628  if (replconv == 1) {
5629  cb_error_x (CB_TREE (current_statement),
5630  _("Invalid target for %s"), "REPLACING");
5631  } else {
5632  cb_error_x (CB_TREE (current_statement),
5633  _("Invalid target for %s"), "CONVERTING");
5634  }
5635 }
void cb_emit_move ( cb_tree  ,
cb_tree   
)

References _, CB_BUILD_FUNCALL_1, cb_build_move(), CB_CHAIN, cb_check_data_incompat(), CB_CONST_P, cb_emit, cb_error_x(), CB_INTRINSIC_P, cb_list_length(), CB_LITERAL_P, cb_name(), CB_REFERENCE, CB_REFERENCE_P, CB_TREE, cb_validate_list(), cb_validate_one(), CB_VALUE, current_statement, cb_reference::offset, and cb_reference::subs.

7186 {
7187  cb_tree l;
7188  cb_tree x;
7189  cb_tree m;
7190  unsigned int tempval;
7191 
7192  if (cb_validate_one (src)) {
7193  return;
7194  }
7195  if (cb_validate_list (dsts)) {
7196  return;
7197  }
7198 
7199  cb_check_data_incompat (src);
7200 
7201  tempval = 0;
7202  if (cb_list_length (dsts) > 1) {
7203  if (CB_INTRINSIC_P (src) || (CB_REFERENCE_P (src) &&
7204  (CB_REFERENCE (src)->subs || CB_REFERENCE (src)->offset))) {
7205  tempval = 1;
7206  cb_emit (CB_BUILD_FUNCALL_1 ("cob_put_indirect_field",
7207  src));
7208  }
7209  }
7210 
7211  for (l = dsts; l; l = CB_CHAIN (l)) {
7212  x = CB_VALUE (l);
7213  if (CB_LITERAL_P (x) || CB_CONST_P (x)) {
7214  cb_error_x (CB_TREE (current_statement),
7215  _("Invalid MOVE target - %s"), cb_name (x));
7216  continue;
7217  }
7218  if (!tempval) {
7219  m = cb_build_move (src, x);
7220  } else {
7221  m = CB_BUILD_FUNCALL_1 ("cob_get_indirect_field", x);
7222  }
7223  cb_emit (m);
7224  }
7225 }
void cb_emit_move_corresponding ( cb_tree  ,
cb_tree   
)

References _, CB_CHAIN, cb_check_group_name(), cb_validate_one(), CB_VALUE, cb_warning_x(), and emit_move_corresponding().

4100 {
4101  cb_tree l;
4102  cb_tree v;
4103 
4104  x1 = cb_check_group_name (x1);
4105  if (cb_validate_one (x1)) {
4106  return;
4107  }
4108  for (l = x2; l; l = CB_CHAIN(l)) {
4109  v = CB_VALUE(l);
4110  v = cb_check_group_name (v);
4111  if (cb_validate_one (v)) {
4112  return;
4113  }
4114  if (!emit_move_corresponding (x1, v)) {
4115  if (cb_warn_corresponding) {
4116  cb_warning_x (v, _("No CORRESPONDING items found"));
4117  }
4118  }
4119  }
4120 }
void cb_emit_open ( cb_tree  ,
cb_tree  ,
cb_tree   
)

References _, cb_build_debug(), cb_build_debug_call(), CB_BUILD_FUNCALL_4, cb_build_move(), cb_emit, cb_error_node, cb_error_x(), CB_FILE, cb_int(), cb_int0, cb_ref(), cb_space, CB_TREE, COB_OPEN_I_O, COB_ORG_LINE_SEQUENTIAL, COB_ORG_SORT, current_program, current_statement, cb_file::debug_section, file, cb_statement::file, cb_file::file_status, cb_program::flag_debugging, cb_file::flag_fl_debug, cb_statement::flag_in_debug, cb_file::name, NULL, cb_file::organization, and cb_file::sharing.

7231 {
7232  struct cb_file *f;
7233 
7234  if (file == cb_error_node) {
7235  return;
7236  }
7237  file = cb_ref (file);
7238  if (file == cb_error_node) {
7239  return;
7240  }
7241  current_statement->file = file;
7242  f = CB_FILE (file);
7243 
7244  if (f->organization == COB_ORG_SORT) {
7245  cb_error_x (CB_TREE (current_statement),
7246  _("Operation not allowed on SORT files"));
7247  return;
7248  } else if (f->organization == COB_ORG_LINE_SEQUENTIAL &&
7249  mode == cb_int (COB_OPEN_I_O)) {
7250  cb_error_x (CB_TREE (current_statement),
7251  _("OPEN I-O not allowed on LINE SEQUENTIAL files"));
7252  return;
7253  }
7254  if (sharing == NULL) {
7255  if (f->sharing) {
7256  sharing = f->sharing;
7257  } else {
7258  sharing = cb_int0;
7259  }
7260  }
7261 
7262  cb_emit (CB_BUILD_FUNCALL_4 ("cob_open", file, mode,
7263  sharing, f->file_status));
7264 
7265  /* Check for file debugging */
7266  if (current_program->flag_debugging &&
7267  !current_statement->flag_in_debug &&
7268  f->flag_fl_debug) {
7269  cb_emit (cb_build_debug (cb_debug_name, f->name, NULL));
7270  cb_emit (cb_build_move (cb_space, cb_debug_contents));
7271  cb_emit (cb_build_debug_call (f->debug_section));
7272  }
7273 }
void cb_emit_perform ( cb_tree  ,
cb_tree   
)

References cb_build_debug(), cb_emit, cb_error_node, CB_PAIR_P, CB_PERFORM, current_program, current_statement, cb_program::flag_debugging, cb_statement::flag_in_debug, and NULL.

7279 {
7280  if (perform == cb_error_node) {
7281  return;
7282  }
7283  if (current_program->flag_debugging &&
7284  !current_statement->flag_in_debug && CB_PAIR_P (body)) {
7285  cb_emit (cb_build_debug (cb_debug_contents, "PERFORM LOOP", NULL));
7286  }
7287  CB_PERFORM (perform)->body = body;
7288  cb_emit (perform);
7289 }
void cb_emit_read ( cb_tree  ,
cb_tree  ,
cb_tree  ,
cb_tree  ,
cb_tree   
)

References _, cb_file::access_mode, cb_build_debug(), cb_build_debug_call(), cb_build_field_reference(), CB_BUILD_FUNCALL_3, CB_BUILD_FUNCALL_4, cb_build_move(), cb_emit, cb_error_node, cb_error_x(), CB_FILE, cb_int(), cb_int1, cb_int2, cb_int3, cb_int4, cb_list_add(), CB_LIST_INIT, cb_ref(), CB_TREE, cb_warning(), COB_ACCESS_DYNAMIC, COB_ACCESS_SEQUENTIAL, COB_ORG_INDEXED, COB_ORG_RELATIVE, COB_ORG_SORT, COB_READ_IGNORE_LOCK, COB_READ_LOCK, COB_READ_NEXT, COB_READ_NO_LOCK, COB_READ_PREVIOUS, COB_READ_WAIT_LOCK, current_program, current_statement, cb_file::debug_section, file, cb_statement::file, cb_file::file_status, cb_program::flag_debugging, cb_file::flag_fl_debug, cb_statement::flag_in_debug, cb_statement::handler3, cb_statement::handler_id, cb_file::key, cb_file::name, NULL, cb_file::organization, and cb_file::record.

7357 {
7358  cb_tree file;
7359  cb_tree rec;
7360  cb_tree x;
7361  struct cb_file *f;
7362  int read_opts;
7363 
7364  read_opts = 0;
7365  if (lock_opts == cb_int1) {
7366  read_opts = COB_READ_LOCK;
7367  } else if (lock_opts == cb_int2) {
7368  read_opts = COB_READ_NO_LOCK;
7369  } else if (lock_opts == cb_int3) {
7370  read_opts = COB_READ_IGNORE_LOCK;
7371  } else if (lock_opts == cb_int4) {
7372  read_opts = COB_READ_WAIT_LOCK;
7373  }
7374  if (ref == cb_error_node) {
7375  return;
7376  }
7377  file = cb_ref (ref);
7378  if (file == cb_error_node) {
7379  return;
7380  }
7381  f = CB_FILE (file);
7382 
7383  rec = cb_build_field_reference (f->record, ref);
7384  if (f->organization == COB_ORG_SORT) {
7385  cb_error_x (CB_TREE (current_statement),
7386  _("Operation not allowed on SORT files"));
7387  return;
7388  }
7389  if (next == cb_int1 || next == cb_int2 ||
7390  f->access_mode == COB_ACCESS_SEQUENTIAL) {
7391  /* READ NEXT/PREVIOUS */
7392  if (next == cb_int2) {
7393  switch (f->organization) {
7394  case COB_ORG_INDEXED:
7395  case COB_ORG_RELATIVE:
7396  break;
7397  default:
7398  cb_error_x (CB_TREE (current_statement),
7399  _("READ PREVIOUS not allowed for this file type"));
7400  return;
7401  }
7402  read_opts |= COB_READ_PREVIOUS;
7403  } else {
7404  read_opts |= COB_READ_NEXT;
7405  }
7406  if (key) {
7407  cb_warning (_("KEY ignored with sequential READ"));
7408  }
7409  cb_emit (CB_BUILD_FUNCALL_3 ("cob_read_next", file,
7410  f->file_status,
7411  cb_int (read_opts)));
7412  } else {
7413  /* READ */
7414  /* DYNAMIC with [NOT] AT END */
7415  if (f->access_mode == COB_ACCESS_DYNAMIC &&
7416  current_statement->handler_id == COB_EC_I_O_AT_END) {
7417  read_opts |= COB_READ_NEXT;
7418  cb_emit (CB_BUILD_FUNCALL_3 ("cob_read_next", file,
7419  f->file_status,
7420  cb_int (read_opts)));
7421  } else if (key || f->key) {
7422  cb_emit (CB_BUILD_FUNCALL_4 ("cob_read",
7423  file, key ? key : f->key,
7424  f->file_status, cb_int (read_opts)));
7425  } else {
7426  cb_emit (CB_BUILD_FUNCALL_3 ("cob_read_next", file,
7427  f->file_status,
7428  cb_int (read_opts)));
7429  }
7430  }
7431  if (into) {
7432  current_statement->handler3 = cb_build_move (rec, into);
7433  }
7434 
7435  /* Check for file debugging */
7436  if (current_program->flag_debugging &&
7437  !current_statement->flag_in_debug &&
7438  f->flag_fl_debug) {
7439  if (into) {
7440  current_statement->handler3 =
7441  CB_LIST_INIT (current_statement->handler3);
7442  }
7443  x = cb_build_debug (cb_debug_name, f->name, NULL);
7444  current_statement->handler3 =
7445  cb_list_add (current_statement->handler3, x);
7446  x = cb_build_move (rec, cb_debug_contents);
7447  current_statement->handler3 =
7448  cb_list_add (current_statement->handler3, x);
7449  x = cb_build_debug_call (f->debug_section);
7450  current_statement->handler3 =
7451  cb_list_add (current_statement->handler3, x);
7452  }
7453  current_statement->file = file;
7454 }
void cb_emit_ready_trace ( void  )

References CB_BUILD_FUNCALL_0, and cb_emit.

7460 {
7461  cb_emit (CB_BUILD_FUNCALL_0 ("cob_ready_trace"));
7462 }
void cb_emit_release ( cb_tree  ,
cb_tree   
)

References _, CB_BUILD_FUNCALL_1, cb_build_move(), cb_emit, cb_error_x(), CB_FIELD_PTR, CB_FILE, cb_ref(), CB_REF_OR_FIELD_P, CB_STORAGE_FILE, CB_TREE, cb_validate_one(), COB_ORG_SORT, current_statement, file, cb_field::file, cb_statement::file, and cb_field::storage.

7550 {
7551  struct cb_field *f;
7552  cb_tree file;
7553 
7554  if (cb_validate_one (record)) {
7555  return;
7556  }
7557  if (cb_validate_one (from)) {
7558  return;
7559  }
7560  if (!CB_REF_OR_FIELD_P (cb_ref (record))) {
7561  cb_error_x (CB_TREE (current_statement),
7562  _("RELEASE requires a record name as subject"));
7563  return;
7564  }
7565  f = CB_FIELD_PTR (record);
7566  if (f->storage != CB_STORAGE_FILE) {
7567  cb_error_x (CB_TREE (current_statement),
7568  _("RELEASE subject does not refer to a record name"));
7569  return;
7570  }
7571  file = CB_TREE (f->file);
7572  if (CB_FILE (file)->organization != COB_ORG_SORT) {
7573  cb_error_x (CB_TREE (current_statement),
7574  _("RELEASE not allowed on this record item"));
7575  return;
7576  }
7577  current_statement->file = file;
7578  if (from) {
7579  cb_emit (cb_build_move (from, record));
7580  }
7581  cb_emit (CB_BUILD_FUNCALL_1 ("cob_file_release", file));
7582 }
void cb_emit_reset_trace ( void  )

References CB_BUILD_FUNCALL_0, and cb_emit.

7469 {
7470  cb_emit (CB_BUILD_FUNCALL_0 ("cob_reset_trace"));
7471 }
void cb_emit_return ( cb_tree  ,
cb_tree   
)

References cb_build_field_reference(), CB_BUILD_FUNCALL_1, cb_build_move(), cb_emit, cb_error_node, CB_FILE, cb_ref(), cb_validate_one(), current_statement, file, cb_statement::file, and cb_statement::handler3.

7588 {
7589  cb_tree file;
7590  cb_tree rec;
7591 
7592  if (cb_validate_one (ref)) {
7593  return;
7594  }
7595  if (cb_validate_one (into)) {
7596  return;
7597  }
7598  file = cb_ref (ref);
7599  if (file == cb_error_node) {
7600  return;
7601  }
7602  rec = cb_build_field_reference (CB_FILE (file)->record, ref);
7603  cb_emit (CB_BUILD_FUNCALL_1 ("cob_file_return", file));
7604  if (into) {
7605  current_statement->handler3 = cb_build_move (rec, into);
7606  }
7607  current_statement->file = file;
7608 }
void cb_emit_rewrite ( cb_tree  ,
cb_tree  ,
cb_tree   
)

References _, cb_build_debug(), cb_build_debug_call(), CB_BUILD_FUNCALL_4, cb_build_move(), cb_emit, cb_error_node, cb_error_x(), CB_FIELD, CB_FIELD_PTR, CB_FILE, cb_int(), cb_int1, cb_ref(), CB_REF_OR_FIELD_P, CB_STORAGE_FILE, CB_TREE, cb_validate_one(), COB_EC_I_O_INVALID_KEY, COB_LOCK_AUTOMATIC, COB_ORG_INDEXED, COB_ORG_LINE_SEQUENTIAL, COB_ORG_RELATIVE, COB_ORG_SORT, COB_WRITE_LOCK, current_program, current_statement, cb_file::debug_section, file, cb_statement::file, cb_file::file_status, cb_program::flag_debugging, cb_statement::flag_in_debug, cb_statement::handler_id, cb_file::lock_mode, cb_file::name, NULL, and cb_file::organization.

7477 {
7478  cb_tree file;
7479  struct cb_file *f;
7480  int opts;
7481 
7482  if (cb_validate_one (record)) {
7483  return;
7484  }
7485  if (cb_validate_one (from)) {
7486  return;
7487  }
7488  if (!CB_REF_OR_FIELD_P (cb_ref (record))) {
7489  cb_error_x (CB_TREE (current_statement),
7490  _("REWRITE requires a record name as subject"));
7491  return;
7492  }
7493  if (CB_FIELD_PTR (record)->storage != CB_STORAGE_FILE) {
7494  cb_error_x (CB_TREE (current_statement),
7495  _("REWRITE subject does not refer to a record name"));
7496  return;
7497  }
7498 
7499  file = CB_TREE (CB_FIELD (cb_ref (record))->file);
7500  if (!file || file == cb_error_node) {
7501  return;
7502  }
7503  current_statement->file = file;
7504  f = CB_FILE (file);
7505  opts = 0;
7506 
7507  if (f->organization == COB_ORG_SORT) {
7508  cb_error_x (CB_TREE (current_statement),
7509  _("Operation not allowed on SORT files"));
7510  return;
7511  } else if (f->organization == COB_ORG_LINE_SEQUENTIAL) {
7512  cb_error_x (CB_TREE (current_statement),
7513  _("Operation not allowed on LINE SEQUENTIAL files"));
7514  return;
7515  } else if (current_statement->handler_id == COB_EC_I_O_INVALID_KEY &&
7516  (f->organization != COB_ORG_RELATIVE &&
7517  f->organization != COB_ORG_INDEXED)) {
7518  cb_error_x (CB_TREE(current_statement),
7519  _("INVALID KEY clause invalid with this file type"));
7520  return;
7521  } else if ((f->lock_mode & COB_LOCK_AUTOMATIC) && lockopt) {
7522  cb_error_x (CB_TREE (current_statement),
7523  _("LOCK clause invalid with file LOCK AUTOMATIC"));
7524  return;
7525  } else if (lockopt == cb_int1) {
7526  opts = COB_WRITE_LOCK;
7527  }
7528 
7529  if (from) {
7530  cb_emit (cb_build_move (from, record));
7531  }
7532 
7533  /* Check debugging on record name */
7534  if (current_program->flag_debugging &&
7535  !current_statement->flag_in_debug &&
7536  CB_FIELD_PTR (record)->flag_field_debug) {
7537  cb_emit (cb_build_debug (cb_debug_name,
7538  CB_FIELD_PTR (record)->name, NULL));
7539  cb_emit (cb_build_move (record, cb_debug_contents));
7540  cb_emit (cb_build_debug_call (CB_FIELD_PTR (record)->debug_section));
7541  }
7542  cb_emit (CB_BUILD_FUNCALL_4 ("cob_rewrite", file, record,
7543  cb_int (opts), f->file_status));
7544 }
void cb_emit_rollback ( void  )

References CB_BUILD_FUNCALL_0, and cb_emit.

7614 {
7615  cb_emit (CB_BUILD_FUNCALL_0 ("cob_rollback"));
7616 }
void cb_emit_search ( cb_tree  ,
cb_tree  ,
cb_tree  ,
cb_tree   
)

References cb_build_search(), cb_check_needs_break(), cb_emit, cb_error_node, cb_list_reverse(), and cb_validate_one().

7735 {
7736  if (cb_validate_one (table)) {
7737  return;
7738  }
7739  if (cb_validate_one (varying)) {
7740  return;
7741  }
7742  if (table == cb_error_node) {
7743  return;
7744  }
7745  if (whens == cb_error_node) {
7746  return;
7747  }
7748  whens = cb_list_reverse (whens);
7749  cb_emit (cb_build_search (0, table, varying,
7750  cb_check_needs_break (at_end), whens));
7751 }
void cb_emit_search_all ( cb_tree  ,
cb_tree  ,
cb_tree  ,
cb_tree   
)

References cb_build_if(), cb_build_search(), cb_build_search_all(), cb_check_needs_break(), cb_emit, cb_error_node, cb_validate_one(), and NULL.

7755 {
7756  cb_tree x;
7757  cb_tree stmt_lis;
7758 
7759  if (cb_validate_one (table)) {
7760  return;
7761  }
7762  if (table == cb_error_node) {
7763  return;
7764  }
7765  if (when == cb_error_node) {
7766  return;
7767  }
7768  x = cb_build_search_all (table, when);
7769  if (!x) {
7770  return;
7771  }
7772 
7773  stmt_lis = cb_check_needs_break (stmts);
7774  cb_emit (cb_build_search (1, table, NULL,
7775  cb_check_needs_break (at_end),
7776  cb_build_if (x, stmt_lis, NULL, 0)));
7777 }
void cb_emit_set_attribute ( cb_tree  ,
const int  ,
const int   
)

References _, cb_build_set_attribute(), cb_emit, cb_error_x(), CB_FIELD_PTR, cb_ref(), CB_REF_OR_FIELD_P, CB_STORAGE_SCREEN, CB_TREE, cb_validate_one(), current_statement, and cb_field::storage.

7977 {
7978  struct cb_field *f;
7979 
7980  if (cb_validate_one (x)) {
7981  return;
7982  }
7983  if (!CB_REF_OR_FIELD_P (cb_ref (x))) {
7984  cb_error_x (CB_TREE (current_statement),
7985  _("SET ATTRIBUTE requires a screen item as subject"));
7986  return;
7987  }
7988  f = CB_FIELD_PTR (x);
7989  if (f->storage != CB_STORAGE_SCREEN) {
7990  cb_error_x (CB_TREE (current_statement),
7991  _("SET ATTRIBUTE subject does not refer to a screen item"));
7992  return;
7993  }
7994  cb_emit (cb_build_set_attribute (f, val_on, val_off));
7995 }
void cb_emit_set_false ( cb_tree  )

References _, cb_build_field_reference(), cb_build_move(), CB_CHAIN, cb_emit, cb_error_node, cb_error_x(), CB_FIELD_P, CB_FIELD_PTR, CB_PAIR_P, CB_PAIR_X, CB_REFERENCE, CB_REFERENCE_P, CB_VALUE, cb_field::false_88, cb_field::level, cb_field::parent, and value.

7941 {
7942  cb_tree x;
7943  struct cb_field *f;
7944  cb_tree ref;
7945  cb_tree val;
7946 
7947  for (; l; l = CB_CHAIN (l)) {
7948  x = CB_VALUE (l);
7949  if (x == cb_error_node) {
7950  return;
7951  }
7952  if (!(CB_REFERENCE_P (x) && CB_FIELD_P(CB_REFERENCE(x)->value)) &&
7953  !CB_FIELD_P (x)) {
7954  cb_error_x (x, _("Invalid SET statement"));
7955  return;
7956  }
7957  f = CB_FIELD_PTR (x);
7958  if (f->level != 88) {
7959  cb_error_x (x, _("Invalid SET statement"));
7960  return;
7961  }
7962  if (!f->false_88) {
7963  cb_error_x (x, _("Field does not have FALSE clause"));
7964  return;
7965  }
7966  ref = cb_build_field_reference (f->parent, x);
7967  val = CB_VALUE (f->false_88);
7968  if (CB_PAIR_P (val)) {
7969  val = CB_PAIR_X (val);
7970  }
7971  cb_emit (cb_build_move (val, ref));
7972  }
7973 }
void cb_emit_set_on_off ( cb_tree  ,
cb_tree   
)

References CB_BUILD_FUNCALL_2, CB_CHAIN, cb_emit, cb_int(), cb_ref(), CB_SYSTEM_NAME, cb_validate_list(), CB_VALUE, and cb_system_name::token.

7894 {
7895  struct cb_system_name *s;
7896 
7897  if (cb_validate_list (l)) {
7898  return;
7899  }
7900  for (; l; l = CB_CHAIN (l)) {
7901  s = CB_SYSTEM_NAME (cb_ref (CB_VALUE (l)));
7902  cb_emit (CB_BUILD_FUNCALL_2 ("cob_set_switch",
7903  cb_int (s->token), flag));
7904  }
7905 }
void cb_emit_set_to ( cb_tree  ,
cb_tree   
)

References _, cb_cast::cast_type, cb_build_move(), CB_CAST, CB_CAST_ADDRESS, CB_CAST_P, CB_CAST_PROGRAM_POINTER, CB_CHAIN, cb_check_data_incompat(), CB_CLASS_INDEX, CB_CLASS_NUMERIC, CB_CLASS_POINTER, CB_CLASS_UNKNOWN, cb_emit, cb_error_node, cb_error_x(), CB_FIELD, cb_name(), cb_ref(), CB_REFERENCE_P, CB_STORAGE_LINKAGE, CB_TREE, CB_TREE_CLASS, cb_tree_class(), CB_USAGE_PROGRAM_POINTER, cb_validate_list(), cb_validate_one(), CB_VALUE, current_statement, p, and cb_cast::val.

7789 {
7790  cb_tree l;
7791  cb_tree v;
7792  struct cb_cast *p;
7793  enum cb_class class;
7794 
7795  if (cb_validate_one (x)) {
7796  return;
7797  }
7798  if (cb_validate_list (vars)) {
7799  return;
7800  }
7801 
7802 #if 0 /* RXWRXW - target check */
7803  /* Determine class of targets */
7804  for (l = vars; l; l = CB_CHAIN (l)) {
7805  if (CB_TREE_CLASS (CB_VALUE (l)) != CB_CLASS_UNKNOWN) {
7806  if (class == CB_CLASS_UNKNOWN) {
7807  class = CB_TREE_CLASS (CB_VALUE (l));
7808  } else if (class != CB_TREE_CLASS (CB_VALUE (l))) {
7809  break;
7810  }
7811  }
7812  }
7813  if (l || (class != CB_CLASS_INDEX && class != CB_CLASS_POINTER)) {
7814  cb_error_x (CB_TREE (current_statement),
7815  _("The targets of SET must be either indexes or pointers"));
7816  return;
7817  }
7818 #endif
7819 
7820  if (CB_CAST_P (x)) {
7821  p = CB_CAST (x);
7822  if (p->cast_type == CB_CAST_PROGRAM_POINTER) {
7823  for (l = vars; l; l = CB_CHAIN (l)) {
7824  v = CB_VALUE (l);
7825  if (!CB_REFERENCE_P (v)) {
7826  cb_error_x (CB_TREE (current_statement),
7827  _("SET targets must be PROGRAM-POINTER"));
7828  CB_VALUE (l) = cb_error_node;
7829  } else if (CB_FIELD(cb_ref(v))->usage != CB_USAGE_PROGRAM_POINTER) {
7830  cb_error_x (CB_TREE (current_statement),
7831  _("SET targets must be PROGRAM-POINTER"));
7832  CB_VALUE (l) = cb_error_node;
7833  }
7834  }
7835  }
7836  }
7837  /* Validate the targets */
7838  for (l = vars; l; l = CB_CHAIN (l)) {
7839  v = CB_VALUE (l);
7840  if (!CB_CAST_P (v)) {
7841  continue;
7842  }
7843  p = CB_CAST (v);
7844  if (p->cast_type == CB_CAST_ADDRESS &&
7845  !CB_FIELD (cb_ref (p->val))->flag_item_based &&
7846  CB_FIELD (cb_ref (p->val))->storage != CB_STORAGE_LINKAGE) {
7847  cb_error_x (p->val, _("The address of '%s' cannot be changed"),
7848  cb_name (p->val));
7849  CB_VALUE (l) = cb_error_node;
7850  }
7851  }
7852  if (cb_validate_list (vars)) {
7853  return;
7854  }
7855 
7856  for (l = vars; l; l = CB_CHAIN (l)) {
7857  class = cb_tree_class (CB_VALUE (l));
7858  switch (class) {
7859  case CB_CLASS_INDEX:
7860  case CB_CLASS_NUMERIC:
7861  case CB_CLASS_POINTER:
7862  cb_check_data_incompat (x);
7863  cb_emit (cb_build_move (x, CB_VALUE (l)));
7864  break;
7865  default:
7866  cb_error_x (CB_TREE (current_statement),
7867  _("SET target is invalid - '%s'"),
7868  cb_name (CB_VALUE(l)));
7869  break;
7870  }
7871  }
7872 }
void cb_emit_set_true ( cb_tree  )

References _, cb_build_field_reference(), cb_build_move(), CB_CHAIN, cb_emit, cb_error_node, cb_error_x(), CB_FIELD_P, CB_FIELD_PTR, CB_PAIR_P, CB_PAIR_X, CB_REFERENCE, CB_REFERENCE_P, CB_VALUE, cb_field::level, cb_field::parent, value, and cb_field::values.

7909 {
7910  cb_tree x;
7911  struct cb_field *f;
7912  cb_tree ref;
7913  cb_tree val;
7914 
7915  for (; l; l = CB_CHAIN (l)) {
7916  x = CB_VALUE (l);
7917  if (x == cb_error_node) {
7918  return;
7919  }
7920  if (!(CB_REFERENCE_P (x) && CB_FIELD_P(CB_REFERENCE(x)->value)) &&
7921  !CB_FIELD_P (x)) {
7922  cb_error_x (x, _("Invalid SET statement"));
7923  return;
7924  }
7925  f = CB_FIELD_PTR (x);
7926  if (f->level != 88) {
7927  cb_error_x (x, _("Invalid SET statement"));
7928  return;
7929  }
7930  ref = cb_build_field_reference (f->parent, x);
7931  val = CB_VALUE (f->values);
7932  if (CB_PAIR_P (val)) {
7933  val = CB_PAIR_X (val);
7934  }
7935  cb_emit (cb_build_move (val, ref));
7936  }
7937 }
void cb_emit_set_up_down ( cb_tree  ,
cb_tree  ,
cb_tree   
)

References cb_build_add(), cb_build_sub(), CB_CHAIN, cb_emit, cb_int0, cb_validate_list(), cb_validate_one(), and CB_VALUE.

7876 {
7877  if (cb_validate_one (x)) {
7878  return;
7879  }
7880  if (cb_validate_list (l)) {
7881  return;
7882  }
7883  for (; l; l = CB_CHAIN (l)) {
7884  if (flag == cb_int0) {
7885  cb_emit (cb_build_add (CB_VALUE (l), x, cb_int0));
7886  } else {
7887  cb_emit (cb_build_sub (CB_VALUE (l), x, cb_int0));
7888  }
7889  }
7890 }
void cb_emit_setenv ( cb_tree  ,
cb_tree   
)

References CB_BUILD_FUNCALL_2, and cb_emit.

7783 {
7784  cb_emit (CB_BUILD_FUNCALL_2 ("cob_set_environment", x, y));
7785 }
void cb_emit_sort_finish ( cb_tree  )

References CB_BUILD_FUNCALL_1, cb_emit, CB_FILE_P, and cb_ref().

8120 {
8121  if (CB_FILE_P (cb_ref (file))) {
8122  cb_emit (CB_BUILD_FUNCALL_1 ("cob_file_sort_close", cb_ref (file)));
8123  }
8124 }
void cb_emit_sort_giving ( cb_tree  ,
cb_tree   
)

References _, CB_BUILD_FUNCALL_2, CB_CHAIN, cb_emit, cb_error_x(), CB_FILE, CB_FUNCALL, cb_list_length(), cb_ref(), CB_TREE, cb_validate_list(), CB_VALUE, COB_ORG_SORT, current_statement, and p.

8083 {
8084  cb_tree p;
8085  int listlen;
8086 
8087  if (cb_validate_list (l)) {
8088  return;
8089  }
8090  for (p = l; p; p = CB_CHAIN (p)) {
8091  if (CB_FILE (cb_ref(CB_VALUE(p)))->organization == COB_ORG_SORT) {
8092  cb_error_x (CB_TREE (current_statement),
8093  _("Invalid SORT GIVING parameter"));
8094  }
8095  }
8096  listlen = cb_list_length (l);
8097  p = CB_BUILD_FUNCALL_2 ("cob_file_sort_giving", cb_ref (file), l);
8098  CB_FUNCALL(p)->varcnt = listlen;
8099  cb_emit (p);
8100 }
void cb_emit_sort_init ( cb_tree  ,
cb_tree  ,
cb_tree   
)

References _, CB_BUILD_CAST_ADDRESS, cb_build_cast_int(), CB_BUILD_FUNCALL_2, CB_BUILD_FUNCALL_3, CB_BUILD_FUNCALL_4, CB_BUILD_FUNCALL_5, CB_CHAIN, cb_emit, cb_error_node, cb_error_x(), CB_FIELD, CB_FIELD_PTR, CB_FILE, CB_FILE_P, cb_int(), cb_list_length(), CB_PURPOSE, cb_ref(), cb_program::cb_sort_return, cb_validate_list(), CB_VALUE, COB_ORG_SORT, current_program, cb_field::depending, cb_field::name, NULL, cb_field::occurs_max, cb_field::offset, and cb_field::parent.

8001 {
8002  cb_tree l;
8003  struct cb_field *f;
8004 
8005  if (cb_validate_list (keys)) {
8006  return;
8007  }
8008  if (cb_ref (name) == cb_error_node) {
8009  return;
8010  }
8011  for (l = keys; l; l = CB_CHAIN (l)) {
8012  if (CB_VALUE (l) == NULL) {
8013  CB_VALUE (l) = name;
8014  }
8015  cb_ref (CB_VALUE (l));
8016  }
8017 
8018  if (CB_FILE_P (cb_ref (name))) {
8019  if (CB_FILE (cb_ref (name))->organization != COB_ORG_SORT) {
8020  cb_error_x (name, _("Invalid SORT filename"));
8021  }
8022  CB_FIELD_PTR (current_program->cb_sort_return)->count++;
8023  cb_emit (CB_BUILD_FUNCALL_5 ("cob_file_sort_init", cb_ref (name),
8024  cb_int (cb_list_length (keys)), col,
8025  CB_BUILD_CAST_ADDRESS (current_program->cb_sort_return),
8026  CB_FILE(cb_ref (name))->file_status));
8027  for (l = keys; l; l = CB_CHAIN (l)) {
8028  cb_emit (CB_BUILD_FUNCALL_4 ("cob_file_sort_init_key",
8029  cb_ref (name),
8030  CB_VALUE (l),
8031  CB_PURPOSE (l),
8032  cb_int (CB_FIELD_PTR (CB_VALUE(l))->offset)));
8033  }
8034  } else {
8035  if (keys == NULL) {
8036  cb_error_x (name, _("Table sort without keys not implemented yet"));
8037  }
8038  cb_emit (CB_BUILD_FUNCALL_2 ("cob_table_sort_init",
8039  cb_int (cb_list_length (keys)), col));
8040  for (l = keys; l; l = CB_CHAIN (l)) {
8041  cb_emit (CB_BUILD_FUNCALL_3 ("cob_table_sort_init_key",
8042  CB_VALUE (l),
8043  CB_PURPOSE (l),
8044  cb_int(CB_FIELD_PTR (CB_VALUE(l))->offset
8045  - CB_FIELD_PTR (CB_VALUE(l))->parent->offset)));
8046  }
8047  f = CB_FIELD (cb_ref (name));
8048  cb_emit (CB_BUILD_FUNCALL_2 ("cob_table_sort", name,
8049  (f->depending
8050  ? cb_build_cast_int (f->depending)
8051  : cb_int (f->occurs_max))));
8052  }
8053 }
void cb_emit_sort_input ( cb_tree  )

References cb_build_debug(), cb_build_perform_once(), cb_emit, current_program, current_statement, cb_program::flag_debugging, cb_statement::flag_in_debug, and NULL.

8073 {
8074  if (current_program->flag_debugging &&
8075  !current_statement->flag_in_debug) {
8076  cb_emit (cb_build_debug (cb_debug_contents, "SORT INPUT", NULL));
8077  }
8078  cb_emit (cb_build_perform_once (proc));
8079 }
void cb_emit_sort_output ( cb_tree  )

References cb_build_debug(), cb_build_perform_once(), cb_emit, current_program, current_statement, cb_program::flag_debugging, cb_statement::flag_in_debug, cb_statement::flag_merge, and NULL.

8104 {
8105  if (current_program->flag_debugging &&
8106  !current_statement->flag_in_debug) {
8107  if (current_statement->flag_merge) {
8108  cb_emit (cb_build_debug (cb_debug_contents,
8109  "MERGE OUTPUT", NULL));
8110  } else {
8111  cb_emit (cb_build_debug (cb_debug_contents,
8112  "SORT OUTPUT", NULL));
8113  }
8114  }
8115  cb_emit (cb_build_perform_once (proc));
8116 }
void cb_emit_sort_using ( cb_tree  ,
cb_tree   
)

References _, CB_BUILD_FUNCALL_2, CB_CHAIN, cb_emit, cb_error_x(), CB_FILE, cb_ref(), CB_TREE, cb_validate_list(), CB_VALUE, COB_ORG_SORT, and current_statement.

8057 {
8058  if (cb_validate_list (l)) {
8059  return;
8060  }
8061  for (; l; l = CB_CHAIN (l)) {
8062  if (CB_FILE (cb_ref(CB_VALUE(l)))->organization == COB_ORG_SORT) {
8063  cb_error_x (CB_TREE (current_statement),
8064  _("Invalid SORT USING parameter"));
8065  }
8066  cb_emit (CB_BUILD_FUNCALL_2 ("cob_file_sort_using",
8067  cb_ref (file), cb_ref (CB_VALUE (l))));
8068  }
8069 }
void cb_emit_start ( cb_tree  ,
cb_tree  ,
cb_tree  ,
cb_tree   
)

References _, cb_file::access_mode, CB_BUILD_FUNCALL_5, cb_emit, cb_error_node, cb_error_x(), CB_FIELD_PTR, CB_FILE, cb_ref(), CB_TREE, cb_validate_one(), check_valid_key(), COB_ACCESS_RANDOM, COB_ORG_INDEXED, COB_ORG_RELATIVE, current_program, current_statement, cb_statement::file, cb_file::file_status, cb_statement::flag_callback, cb_program::flag_debugging, cb_file::flag_fl_debug, cb_statement::flag_in_debug, cb_file::key, and cb_file::organization.

8178 {
8179  cb_tree kfld;
8180  cb_tree fl;
8181  cb_tree cbtkey;
8182  struct cb_file *f;
8183 
8184  if (cb_validate_one (key)) {
8185  return;
8186  }
8187  if (cb_validate_one (keylen)) {
8188  return;
8189  }
8190  if (file == cb_error_node) {
8191  return;
8192  }
8193  fl = cb_ref (file);
8194  if (fl == cb_error_node) {
8195  return;
8196  }
8197  f = CB_FILE (fl);
8198 
8199  if (f->organization != COB_ORG_INDEXED &&
8200  f->organization != COB_ORG_RELATIVE) {
8201  cb_error_x (CB_TREE (current_statement),
8202  _("START not allowed on SEQUENTIAL files"));
8203  return;
8204  }
8205  if (keylen && f->organization != COB_ORG_INDEXED) {
8206  cb_error_x (CB_TREE (current_statement),
8207  _("LENGTH/SIZE clause only allowed on INDEXED files"));
8208  return;
8209  }
8210  if (f->access_mode == COB_ACCESS_RANDOM) {
8211  cb_error_x (CB_TREE (current_statement),
8212  _("START not allowed with ACCESS MODE RANDOM"));
8213  return;
8214  }
8215 
8216  current_statement->file = fl;
8217  if (key) {
8218  kfld = cb_ref (key);
8219  if (kfld == cb_error_node) {
8220  return;
8221  }
8222  if (check_valid_key (f, CB_FIELD_PTR (kfld))) {
8223  return;
8224  }
8225  cbtkey = key;
8226  } else {
8227  cbtkey = f->key;
8228  }
8229 
8230  /* Check for file debugging */
8231  if (current_program->flag_debugging &&
8232  !current_statement->flag_in_debug &&
8233  f->flag_fl_debug) {
8234  /* Gen callback after start but before exception test */
8235  current_statement->flag_callback = 1;
8236  }
8237 
8238  cb_emit (CB_BUILD_FUNCALL_5 ("cob_start", fl, op, cbtkey, keylen,
8239  f->file_status));
8240 }
void cb_emit_stop_run ( cb_tree  )

References cb_build_cast_int(), CB_BUILD_FUNCALL_1, and cb_emit.

8246 {
8247  cb_emit (CB_BUILD_FUNCALL_1 ("cob_stop_run", cb_build_cast_int (x)));
8248 }
void cb_emit_string ( cb_tree  ,
cb_tree  ,
cb_tree   
)

References CB_BUILD_FUNCALL_0, CB_BUILD_FUNCALL_1, CB_BUILD_FUNCALL_2, CB_CHAIN, cb_emit, cb_int0, CB_PAIR_P, CB_PAIR_X, cb_validate_one(), CB_VALUE, and NULL.

8254 {
8255  cb_tree start;
8256  cb_tree l;
8257  cb_tree end;
8258  cb_tree dlm;
8259 
8260  if (cb_validate_one (into)) {
8261  return;
8262  }
8263  if (cb_validate_one (pointer)) {
8264  return;
8265  }
8266  start = items;
8267  cb_emit (CB_BUILD_FUNCALL_2 ("cob_string_init", into, pointer));
8268  while (start) {
8269 
8270  /* Find DELIMITED item */
8271  for (end = start; end; end = CB_CHAIN (end)) {
8272  if (CB_PAIR_P (CB_VALUE (end))) {
8273  break;
8274  }
8275  }
8276 
8277  /* cob_string_delimited */
8278  dlm = end ? CB_PAIR_X (CB_VALUE (end)) : NULL;
8279  if (dlm == cb_int0) {
8280  dlm = NULL;
8281  }
8282  cb_emit (CB_BUILD_FUNCALL_1 ("cob_string_delimited", dlm));
8283 
8284  /* cob_string_append */
8285  for (l = start; l != end; l = CB_CHAIN (l)) {
8286  cb_emit (CB_BUILD_FUNCALL_1 ("cob_string_append",
8287  CB_VALUE (l)));
8288  }
8289 
8290  start = end ? CB_CHAIN (end) : NULL;
8291  }
8292  cb_emit (CB_BUILD_FUNCALL_0 ("cob_string_finish"));
8293 }
void cb_emit_unlock ( cb_tree  )

References CB_BUILD_FUNCALL_2, cb_emit, cb_error_node, CB_FILE, cb_ref(), current_statement, file, cb_statement::file, and cb_file::file_status.

8299 {
8300  cb_tree file;
8301 
8302  if (ref != cb_error_node) {
8303  file = cb_ref (ref);
8304  if (file != cb_error_node) {
8305  cb_emit (CB_BUILD_FUNCALL_2 ("cob_unlock_file",
8306  file, CB_FILE(file)->file_status));
8307  current_statement->file = file;
8308  }
8309  }
8310 }
void cb_emit_unstring ( cb_tree  ,
cb_tree  ,
cb_tree  ,
cb_tree  ,
cb_tree   
)

References CB_BUILD_FUNCALL_0, CB_BUILD_FUNCALL_1, CB_BUILD_FUNCALL_3, cb_emit, cb_emit_list, cb_int(), cb_list_length(), cb_validate_list(), and cb_validate_one().

8317 {
8318  if (cb_validate_one (name)) {
8319  return;
8320  }
8321  if (cb_validate_one (tallying)) {
8322  return;
8323  }
8324  if (cb_validate_list (delimited)) {
8325  return;
8326  }
8327  if (cb_validate_list (into)) {
8328  return;
8329  }
8330  cb_emit (CB_BUILD_FUNCALL_3 ("cob_unstring_init", name, pointer,
8331  cb_int (cb_list_length (delimited))));
8332  cb_emit_list (delimited);
8333  cb_emit_list (into);
8334  if (tallying) {
8335  cb_emit (CB_BUILD_FUNCALL_1 ("cob_unstring_tallying", tallying));
8336  }
8337  cb_emit (CB_BUILD_FUNCALL_0 ("cob_unstring_finish"));
8338 }
void cb_emit_write ( cb_tree  ,
cb_tree  ,
cb_tree  ,
cb_tree   
)

References _, cb_build_debug(), cb_build_debug_call(), CB_BUILD_FUNCALL_5, cb_build_move(), cb_emit, cb_error_node, cb_error_x(), CB_FIELD, CB_FIELD_PTR, CB_FILE, cb_int(), cb_int0, cb_int1, cb_int_hex(), cb_ref(), CB_REF_OR_FIELD_P, CB_STORAGE_FILE, CB_TREE, cb_validate_one(), COB_EC_I_O_EOP, COB_EC_I_O_INVALID_KEY, COB_LOCK_AUTOMATIC, COB_ORG_INDEXED, COB_ORG_LINE_SEQUENTIAL, COB_ORG_RELATIVE, COB_ORG_SORT, COB_WRITE_AFTER, COB_WRITE_BEFORE, COB_WRITE_LINES, COB_WRITE_LOCK, current_program, current_statement, cb_file::debug_section, file, cb_statement::file, cb_file::file_status, cb_program::flag_debugging, cb_statement::flag_in_debug, cb_file::flag_line_adv, cb_statement::handler1, cb_statement::handler_id, cb_file::lock_mode, cb_file::name, NULL, and cb_file::organization.

8368 {
8369  cb_tree file;
8370  cb_tree check_eop;
8371  struct cb_file *f;
8372 
8373  if (cb_validate_one (record)) {
8374  return;
8375  }
8376  if (cb_validate_one (from)) {
8377  return;
8378  }
8379  if (!CB_REF_OR_FIELD_P (cb_ref (record))) {
8380  cb_error_x (CB_TREE (current_statement),
8381  _("WRITE requires a record name as subject"));
8382  return;
8383  }
8384  if (CB_FIELD_PTR (record)->storage != CB_STORAGE_FILE) {
8385  cb_error_x (CB_TREE (current_statement),
8386  _("WRITE subject does not refer to a record name"));
8387  return;
8388  }
8389  file = CB_TREE (CB_FIELD (cb_ref (record))->file);
8390  if (!file || file == cb_error_node) {
8391  return;
8392  }
8393  current_statement->file = file;
8394  f = CB_FILE (file);
8395 
8396  if (f->organization == COB_ORG_SORT) {
8397  cb_error_x (CB_TREE (current_statement),
8398  _("Operation not allowed on SORT files"));
8399  } else if (current_statement->handler_id == COB_EC_I_O_INVALID_KEY &&
8400  (f->organization != COB_ORG_RELATIVE &&
8401  f->organization != COB_ORG_INDEXED)) {
8402  cb_error_x (CB_TREE(current_statement),
8403  _("INVALID KEY clause invalid with this file type"));
8404  } else if (lockopt) {
8405  if (f->lock_mode & COB_LOCK_AUTOMATIC) {
8406  cb_error_x (CB_TREE (current_statement),
8407  _("LOCK clause invalid with file LOCK AUTOMATIC"));
8408  } else if (opt != cb_int0) {
8409  cb_error_x (CB_TREE (current_statement),
8410  _("LOCK clause invalid here"));
8411  } else if (lockopt == cb_int1) {
8412  opt = cb_int (COB_WRITE_LOCK);
8413  }
8414  }
8415 
8416  if (from) {
8417  cb_emit (cb_build_move (from, record));
8418  }
8419 
8420  /* Check debugging on record name */
8421  if (current_program->flag_debugging &&
8422  !current_statement->flag_in_debug &&
8423  CB_FIELD_PTR (record)->flag_field_debug) {
8424  cb_emit (cb_build_debug (cb_debug_name,
8425  CB_FIELD_PTR (record)->name, NULL));
8426  cb_emit (cb_build_move (record, cb_debug_contents));
8427  cb_emit (cb_build_debug_call (CB_FIELD_PTR (record)->debug_section));
8428  }
8429  if (f->organization == COB_ORG_LINE_SEQUENTIAL &&
8430  opt == cb_int0) {
8431  if (cb_flag_write_after || CB_FILE (file)->flag_line_adv) {
8432  opt = cb_int_hex (COB_WRITE_AFTER | COB_WRITE_LINES | 1);
8433  } else {
8434  opt = cb_int_hex (COB_WRITE_BEFORE | COB_WRITE_LINES | 1);
8435  }
8436  }
8437  if (current_statement->handler_id == COB_EC_I_O_EOP &&
8438  current_statement->handler1) {
8439  check_eop = cb_int1;
8440  } else {
8441  check_eop = cb_int0;
8442  }
8443  cb_emit (CB_BUILD_FUNCALL_5 ("cob_write", file, record, opt,
8444  f->file_status, check_eop));
8445 }
char* cb_encode_program_id ( const char *  )

References COB_FOLD_LOWER, COB_FOLD_UPPER, COB_MINI_BUFF, cob_u8_t, cobc_check_string(), hexval, likely, NULL, p, unlikely, and valid_char.

1112 {
1113  unsigned char *p;
1114  const unsigned char *s;
1115  const unsigned char *t;
1116  unsigned char buff[COB_MINI_BUFF];
1117 
1118  s = NULL;
1119  for (t = (const unsigned char *)name; *t; t++) {
1120  if (*t == (unsigned char)'/' || *t == (unsigned char)'\\') {
1121  s = t + 1;
1122  }
1123  }
1124  if (!s) {
1125  s = (const unsigned char *)name;
1126  }
1127  p = buff;
1128  /* Encode the initial digit */
1129  if (*s <= (unsigned char)'9' && *s >= (unsigned char)'0') {
1130  *p++ = (unsigned char)'_';
1131  }
1132  /* Encode invalid letters */
1133  for (; *s; s++) {
1134  if (likely(valid_char[*s])) {
1135  *p++ = *s;
1136  } else {
1137  *p++ = (unsigned char)'_';
1138  if (*s == (unsigned char)'-') {
1139  *p++ = (unsigned char)'_';
1140  } else {
1141  *p++ = hexval[*s / 16U];
1142  *p++ = hexval[*s % 16U];
1143  }
1144  }
1145  }
1146  *p = 0;
1147 
1148  /* Check case folding */
1149  if (unlikely(cb_fold_call)) {
1150  if (cb_fold_call == COB_FOLD_UPPER) {
1151  for (p = buff; *p; p++) {
1152  if (islower (*p)) {
1153  *p = (cob_u8_t)toupper (*p);
1154  }
1155  }
1156  } else if (cb_fold_call == COB_FOLD_LOWER) {
1157  for (p = buff; *p; p++) {
1158  if (isupper (*p)) {
1159  *p = (cob_u8_t)tolower (*p);
1160  }
1161  }
1162  }
1163  }
1164 
1165  return cobc_check_string ((char *)buff);
1166 }
void cb_error_x ( cb_tree  ,
const char *  ,
  ... 
)

References _, cobc_too_many_errors(), errorcount, print_error(), cb_tree_common::source_file, and cb_tree_common::source_line.

Referenced by ambiguous_error(), cb_build_address(), cb_build_binary_op(), cb_build_cond(), cb_build_display_mnemonic(), cb_build_display_name(), cb_build_field_tree(), cb_build_identifier(), cb_build_intrinsic(), cb_build_replacing_characters(), cb_build_tallying_all(), cb_build_tallying_characters(), cb_build_tallying_leading(), cb_build_tallying_trailing(), cb_build_tallying_value(), cb_build_write_advancing_mnemonic(), cb_check_group_name(), cb_check_integer_value(), cb_check_numeric_edited_name(), cb_check_numeric_name(), cb_check_numeric_value(), cb_define_switch_name(), cb_emit_accept(), cb_emit_accept_mnemonic(), cb_emit_accept_name(), cb_emit_allocate(), cb_emit_call(), cb_emit_close(), cb_emit_delete(), cb_emit_delete_file(), cb_emit_display(), cb_emit_free(), cb_emit_goto(), cb_emit_inspect(), cb_emit_move(), cb_emit_open(), cb_emit_read(), cb_emit_release(), cb_emit_rewrite(), cb_emit_set_attribute(), cb_emit_set_false(), cb_emit_set_to(), cb_emit_set_true(), cb_emit_sort_giving(), cb_emit_sort_init(), cb_emit_sort_using(), cb_emit_start(), cb_emit_write(), cb_get_level(), cb_resolve_redefines(), cb_validate_88_item(), cb_validate_collating(), cb_validate_one(), cb_validate_program_body(), cb_validate_program_data(), cb_validate_program_environment(), check_picture_item(), check_valid_key(), compute_size(), emit_entry(), evaluate_test(), file_error(), group_error(), level_except_error(), level_redundant_error(), level_require_error(), redefinition_error(), search_set_keys(), terminator_error(), undefined_error(), valid_const_date_time_args(), validate_field_1(), validate_field_clauses(), validate_inspect(), and validate_move().

185 {
186  va_list ap;
187 
188  va_start (ap, fmt);
189  print_error (x->source_file, x->source_line, _("Error: "), fmt, ap);
190  va_end (ap);
191  if (++errorcount > 100) {
192  cobc_too_many_errors ();
193  }
194 }
struct cb_field* cb_field_add ( struct cb_field *  ,
struct cb_field *   
)
read

References NULL, p, and cb_field::sister.

2071 {
2072  struct cb_field *t;
2073 
2074  if (f == NULL) {
2075  return p;
2076  }
2077  for (t = f; t->sister; t = t->sister) {
2078  ;
2079  }
2080  t->sister = p;
2081  return f;
2082 }
struct cb_field* cb_field_founder ( const struct cb_field *  )
read

References cb_field::parent.

2086 {
2087  const struct cb_field *ff;
2088 
2089  ff = f;
2090  while (ff->parent) {
2091  ff = ff->parent;
2092  }
2093  return (struct cb_field *)ff;
2094 }
int cb_field_subordinate ( const struct cb_field *  ,
const struct cb_field *   
)

References p, and cb_field::parent.

2133 {
2134  struct cb_field *p;
2135 
2136  for (p = pfld->parent; p; p = p->parent) {
2137  if (p == f) {
2138  return 1;
2139  }
2140  }
2141  return 0;
2142 }
unsigned int cb_field_variable_address ( const struct cb_field *  )

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

2114 {
2115  const struct cb_field *p;
2116  const struct cb_field *f;
2117 
2118  f = fld;
2119  for (p = f->parent; p; f = f->parent, p = f->parent) {
2120  for (p = p->children; p != f; p = p->sister) {
2121  if (p->depending || cb_field_variable_size (p)) {
2122  return 1;
2123  }
2124  }
2125  }
2126  return 0;
2127 }
struct cb_field* cb_field_variable_size ( const struct cb_field *  )
read

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

2098 {
2099  struct cb_field *p;
2100  struct cb_field *fc;
2101 
2102  for (fc = f->children; fc; fc = fc->sister) {
2103  if (fc->depending) {
2104  return fc;
2105  } else if ((p = cb_field_variable_size (fc)) != NULL) {
2106  return p;
2107  }
2108  }
2109  return NULL;
2110 }
int cb_fits_int ( const cb_tree  )

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

822 {
823  struct cb_literal *l;
824  struct cb_field *f;
825  const char *s;
826  const unsigned char *p;
827  size_t size;
828 
829  switch (CB_TREE_TAG (x)) {
830  case CB_TAG_LITERAL:
831  l = CB_LITERAL (x);
832  if (l->scale > 0) {
833  return 0;
834  }
835  for (size = 0, p = l->data; size < l->size; ++size, ++p) {
836  if (*p != (unsigned char)'0') {
837  break;
838  }
839  }
840  size = l->size - size;
841  if (size < 10) {
842  return 1;
843  }
844  if (size > 10) {
845  return 0;
846  }
847  if (l->sign < 0) {
848  s = "2147483648";
849  } else {
850  s = "2147483647";
851  }
852  if (memcmp (p, s, (size_t)10) > 0) {
853  return 0;
854  }
855  return 1;
856  case CB_TAG_FIELD:
857  f = CB_FIELD (x);
858  if (f->children) {
859  return 0;
860  }
861  switch (f->usage) {
862  case CB_USAGE_INDEX:
863  case CB_USAGE_LENGTH:
864  return 1;
865  case CB_USAGE_BINARY:
866  case CB_USAGE_COMP_5:
867  case CB_USAGE_COMP_X:
868  if (f->pic->scale <= 0 && f->size <= (int)sizeof (int)) {
869  return 1;
870  }
871  return 0;
872  case CB_USAGE_DISPLAY:
873  if (f->size < 10) {
874  if (!f->pic || f->pic->scale <= 0) {
875  return 1;
876  }
877  }
878  return 0;
879  case CB_USAGE_PACKED:
880  case CB_USAGE_COMP_6:
881  if (f->pic->scale <= 0 && f->pic->digits < 10) {
882  return 1;
883  }
884  return 0;
885  default:
886  return 0;
887  }
888  case CB_TAG_REFERENCE:
889  return cb_fits_int (CB_REFERENCE (x)->value);
890  case CB_TAG_INTEGER:
891  return 1;
892  default:
893  return 0;
894  }
895 }
int cb_fits_long_long ( const cb_tree  )

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

899 {
900  struct cb_literal *l;
901  struct cb_field *f;
902  const char *s;
903  const unsigned char *p;
904  size_t size;
905 
906  switch (CB_TREE_TAG (x)) {
907  case CB_TAG_LITERAL:
908  l = CB_LITERAL (x);
909  if (l->scale > 0) {
910  return 0;
911  }
912  for (size = 0, p = l->data; size < l->size; ++size, ++p) {
913  if (*p != (unsigned char)'0') {
914  break;
915  }
916  }
917  size = l->size - size;
918  if (size < 19) {
919  return 1;
920  }
921  if (size > 19) {
922  return 0;
923  }
924  if (l->sign < 0) {
925  s = "9223372036854775808";
926  } else {
927  s = "9223372036854775807";
928  }
929  if (memcmp (p, s, (size_t)19) > 0) {
930  return 0;
931  }
932  return 1;
933  case CB_TAG_FIELD:
934  f = CB_FIELD (x);
935  if (f->children) {
936  return 0;
937  }
938  switch (f->usage) {
939  case CB_USAGE_INDEX:
940  case CB_USAGE_LENGTH:
941  return 1;
942  case CB_USAGE_BINARY:
943  case CB_USAGE_COMP_5:
944  case CB_USAGE_COMP_X:
945  if (f->pic->scale <= 0 &&
946  f->size <= (int)sizeof (cob_s64_t)) {
947  return 1;
948  }
949  return 0;
950  case CB_USAGE_DISPLAY:
951  if (f->pic->scale <= 0 && f->size < 19) {
952  return 1;
953  }
954  return 0;
955  case CB_USAGE_PACKED:
956  case CB_USAGE_COMP_6:
957  if (f->pic->scale <= 0 && f->pic->digits < 19) {
958  return 1;
959  }
960  return 0;
961  default:
962  return 0;
963  }
964  case CB_TAG_REFERENCE:
965  return cb_fits_long_long (CB_REFERENCE (x)->value);
966  case CB_TAG_INTEGER:
967  return 1;
968  default:
969  return 0;
970  }
971 }
int cb_get_int ( const cb_tree  )

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

975 {
976  struct cb_literal *l;
977 #if 0 /* RXWRXW Fixme SZ */
978  const char *s;
979  size_t size;
980 #endif
981  size_t i;
982  int val;
983 
984  if (!CB_LITERAL_P (x)) {
985  cobc_abort_pr (_("Invalid literal cast - Aborting"));
986  COBC_ABORT ();
987  }
988  l = CB_LITERAL (x);
989  for (i = 0; i < l->size; i++) {
990  if (l->data[i] != '0') {
991  break;
992  }
993  }
994 
995 #if 0 /* RXWRXW Fixme SZ */
996  if (l->sign < 0) {
997  s = "2147483648";
998  } else {
999  s = "2147483647";
1000  }
1001  size = l->size - i;
1002  if (size > 10U || (size == 10U && memcmp (&l->data[i], s, 10) > 0)) {
1003  cobc_abort_pr (_("Numeric literal exceeds limit - Aborting"));
1004  COBC_ABORT ();
1005  }
1006 #endif
1007 
1008  val = 0;
1009  for (; i < l->size; i++) {
1010  val = val * 10 + l->data[i] - '0';
1011  }
1012  if (val && l->sign < 0) {
1013  val = -val;
1014  }
1015  return val;
1016 }
int cb_get_level ( cb_tree  )

References _, cb_error_x(), CB_INVALID_TREE, CB_NAME, cb_field::level, cb_field::name, and p.

Referenced by cb_build_field_tree().

47 {
48  const unsigned char *p;
49  const char *name;
50  int level;
51 
52  if (CB_INVALID_TREE (x)) {
53  return 0;
54  }
55  name = CB_NAME (x);
56  level = 0;
57  /* Get level */
58  for (p = (const unsigned char *)name; *p; p++) {
59  if (!isdigit ((int)(*p))) {
60  goto level_error;
61  }
62  level = level * 10 + (*p - '0');
63  if (level > 88) {
64  goto level_error;
65  }
66  }
67 
68  /* Check level */
69  switch (level) {
70  case 66:
71  case 77:
72  case 78:
73  case 88:
74  break;
75  default:
76  if (level < 1 || level > 49) {
77  goto level_error;
78  }
79  break;
80  }
81 
82  return level;
83 
84 level_error:
85  cb_error_x (x, _("Invalid level number '%s'"), name);
86  return 0;
87 }
cob_s64_t cb_get_long_long ( const cb_tree  )

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

1020 {
1021  struct cb_literal *l;
1022  const char *s;
1023  size_t i;
1024  size_t size;
1025  cob_s64_t val;
1026 
1027  if (!CB_LITERAL_P (x)) {
1028  cobc_abort_pr (_("Invalid literal cast - Aborting"));
1029  COBC_ABORT ();
1030  }
1031  l = CB_LITERAL (x);
1032  for (i = 0; i < l->size; i++) {
1033  if (l->data[i] != '0') {
1034  break;
1035  }
1036  }
1037 
1038  size = l->size - i;
1039  if (size > 19U) {
1040  cobc_abort_pr (_("Numeric literal exceeds limit - Aborting"));
1041  COBC_ABORT ();
1042  }
1043  if (size == 19U) {
1044  if (l->sign < 0) {
1045  s = "9223372036854775808";
1046  } else {
1047  s = "9223372036854775807";
1048  }
1049  if (memcmp (&(l->data[i]), s, (size_t)19) > 0) {
1050  cobc_abort_pr (_("Numeric literal exceeds limit - Aborting"));
1051  COBC_ABORT ();
1052  }
1053  }
1054 
1055  val = 0;
1056  for (; i < l->size; i++) {
1057  val = val * 10 + (l->data[i] & 0x0F);
1058  }
1059  if (val && l->sign < 0) {
1060  val = -val;
1061  }
1062  return val;
1063 }
struct cb_field* cb_get_real_field ( void  )
read

References last_real_field.

1443 {
1444  return last_real_field;
1445 }
cob_u64_t cb_get_u_long_long ( const cb_tree  )

References _, CB_LITERAL, cob_u64_t, COBC_ABORT, cobc_abort_pr(), cb_literal::data, and cb_literal::size.

1067 {
1068  struct cb_literal *l;
1069  size_t i;
1070  size_t size;
1071  cob_u64_t val;
1072 
1073  l = CB_LITERAL (x);
1074  for (i = 0; i < l->size; i++) {
1075  if (l->data[i] != '0') {
1076  break;
1077  }
1078  }
1079 
1080  size = l->size - i;
1081  if (size > 20U) {
1082  cobc_abort_pr (_("Numeric literal exceeds limit - Aborting"));
1083  COBC_ABORT ();
1084  }
1085  if (size == 20U) {
1086  if (memcmp (&(l->data[i]), "18446744073709551615", (size_t)20) > 0) {
1087  cobc_abort_pr (_("Numeric literal exceeds limit - Aborting"));
1088  COBC_ABORT ();
1089  }
1090  }
1091  val = 0;
1092  for (; i < l->size; i++) {
1093  val = val * 10 + (l->data[i] & 0x0F);
1094  }
1095  return val;
1096 }
void cb_init_constants ( void  )

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

1100 {
1101  int i;
1102 
1103  cb_error_node = make_constant (CB_CATEGORY_UNKNOWN, NULL);
1104  cb_any = make_constant (CB_CATEGORY_UNKNOWN, NULL);
1105  cb_true = make_constant (CB_CATEGORY_BOOLEAN, "1");
1106  cb_false = make_constant (CB_CATEGORY_BOOLEAN, "0");
1107  cb_null = make_constant (CB_CATEGORY_DATA_POINTER, "0");
1108  cb_zero = make_constant (CB_CATEGORY_NUMERIC, "&cob_all_zero");
1109  cb_space = make_constant (CB_CATEGORY_ALPHANUMERIC, "&cob_all_space");
1110  cb_low = make_constant (CB_CATEGORY_ALPHANUMERIC, "&cob_all_low");
1111  cb_norm_low = cb_low;
1112  cb_high = make_constant (CB_CATEGORY_ALPHANUMERIC, "&cob_all_high");
1113  cb_norm_high = cb_high;
1114  cb_quote = make_constant (CB_CATEGORY_ALPHANUMERIC, "&cob_all_quote");
1115  cb_one = cb_build_numeric_literal (0, "1", 0);
1116  cb_int0 = cb_int (0);
1117  cb_int1 = cb_int (1);
1118  cb_int2 = cb_int (2);
1119  cb_int3 = cb_int (3);
1120  cb_int4 = cb_int (4);
1121  cb_int5 = cb_int (5);
1122  for (i = 0; i < COB_MAX_SUBSCRIPTS; i++) {
1123  cb_i[i] = make_constant (CB_CATEGORY_NUMERIC, cb_const_subs[i]);
1124  }
1125  cb_standard_error_handler = make_constant_label ("Default Error Handler");
1126  CB_LABEL (cb_standard_error_handler)->flag_default_handler = 1;
1127  memset (container_progs, 0, sizeof(container_progs));
1128 }
void cb_init_tallying ( void  )

References inspect_func, and NULL.

5639 {
5640  inspect_func = NULL;
5641  inspect_data = NULL;
5642 }
void cb_insert_common_prog ( struct cb_program *  ,
struct cb_program *   
)

References add_contained_prog(), and cb_program::nested_prog_list.

1322 {
1323  prog->nested_prog_list = add_contained_prog (prog->nested_prog_list,
1324  comprog);
1325 }
cb_tree cb_int ( const int  )

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

1331 {
1332  struct cb_integer *x;
1333  struct int_node *p;
1334 
1335  for (p = int_node_table; p; p = p->next) {
1336  if (p->n == n) {
1337  return p->node;
1338  }
1339  }
1340 
1341  /* Do not use make_tree here */
1342  x = cobc_main_malloc (sizeof (struct cb_integer));
1343  x->common.tag = CB_TAG_INTEGER;
1344  x->common.category = CB_CATEGORY_NUMERIC;
1345  x->val = n;
1346 
1347  p = cobc_main_malloc (sizeof (struct int_node));
1348  p->n = n;
1349  p->node = CB_TREE (x);
1350  p->next = int_node_table;
1351  int_node_table = p;
1352  return CB_TREE (x);
1353 }
cb_tree cb_int_hex ( const int  )

References cb_int(), and CB_INTEGER.

1357 {
1358  cb_tree x;
1359 
1360  x = cb_int (n);
1361  CB_INTEGER (x)->hexval = 1;
1362  return x;
1363 }
cb_tree cb_list_add ( cb_tree  ,
cb_tree   
)

References cb_list_append(), and CB_LIST_INIT.

1162 {
1163  return cb_list_append (l, CB_LIST_INIT (x));
1164 }
cb_tree cb_list_append ( cb_tree  ,
cb_tree   
)

References CB_CHAIN, and NULL.

1146 {
1147  cb_tree l;
1148 
1149  if (l1 == NULL) {
1150  return l2;
1151  }
1152  l = l1;
1153  while (CB_CHAIN (l)) {
1154  l = CB_CHAIN (l);
1155  }
1156  CB_CHAIN (l) = l2;
1157  return l1;
1158 }
void cb_list_intrinsics ( void  )

References _, and NUM_INTRINSICS.

2726 {
2727  const char *s;
2728  const char *t;
2729  size_t i;
2730  size_t n;
2731 
2732  putchar ('\n');
2733  puts (_("Intrinsic Function\t\tImplemented\tParameters"));
2734  for (i = 0; i < NUM_INTRINSICS; ++i) {
2735  n = strlen (function_list[i].name);
2736  switch (n / 8) {
2737  case 0:
2738  s = "\t\t\t\t";
2739  break;
2740  case 1:
2741  s = "\t\t\t";
2742  break;
2743  case 2:
2744  s = "\t\t";
2745  break;
2746  default:
2747  s = "\t";
2748  break;
2749  }
2750  if (function_list[i].implemented) {
2751  t = _("Y");
2752  } else {
2753  t = _("N");
2754  }
2755  if (function_list[i].args < 0) {
2756  printf ("%s%s%s\t\tVariable\n", function_list[i].name,
2757  s, t);
2758  } else {
2759  printf ("%s%s%s\t\t%d\n", function_list[i].name,
2760  s, t, function_list[i].args);
2761  }
2762  }
2763 }
int cb_list_length ( cb_tree  )

References CB_CHAIN.

1189 {
1190  int n;
1191 
1192  if (l == cb_error_node) {
1193  return 0;
1194  }
1195  n = 0;
1196  for (; l; l = CB_CHAIN (l)) {
1197  n++;
1198  }
1199  return n;
1200 }
void cb_list_map ( cb_tree(*)(cb_tree)  ,
cb_tree   
)
void cb_list_mnemonics ( void  )

References _, EXT_SYSTEM_TAB_SIZE, res_get_feature(), and SYSTEM_TAB_SIZE.

2767 {
2768  const char *tabs;
2769  const char *feature;
2770  size_t i;
2771 
2772  putchar ('\n');
2773  puts (_("Mnemonic names"));
2774  for (i = 0; i < SYSTEM_TAB_SIZE; ++i) {
2775  if (strlen (system_table[i].name) < 8) {
2776  tabs = "\t\t";
2777  } else {
2778  tabs = "\t";
2779  }
2780  feature = res_get_feature (system_table[i].category);
2781  printf ("%s%s%s\n", system_table[i].name, tabs, feature);
2782  }
2783  putchar ('\n');
2784  puts (_("Extended mnemonic names (with -fsyntax-extension)"));
2785  for (i = 0; i < EXT_SYSTEM_TAB_SIZE; ++i) {
2786  if (strlen (ext_system_table[i].name) < 8) {
2787  tabs = "\t\t";
2788  } else {
2789  tabs = "\t";
2790  }
2791  feature = res_get_feature (ext_system_table[i].category);
2792  printf ("%s%s%s\n", ext_system_table[i].name, tabs, feature);
2793  }
2794 }
void cb_list_reserved ( void  )

References _, NUM_RESERVED_WORDS, and p.

2664 {
2665  const char *s;
2666  const char *p;
2667  size_t i;
2668  size_t n;
2669 
2670  putchar ('\n');
2671  printf (_("Reserved Words\t\t\tImplemented (Y/N)"));
2672  puts ("\n");
2673  for (i = 0; i < NUM_RESERVED_WORDS; ++i) {
2674  n = strlen (reserved_words[i].name);
2675  switch (n / 8) {
2676  case 0:
2677  s = "\t\t\t\t";
2678  break;
2679  case 1:
2680  s = "\t\t\t";
2681  break;
2682  case 2:
2683  s = "\t\t";
2684  break;
2685  default:
2686  s = "\t";
2687  break;
2688  }
2689  if (reserved_words[i].token == 0) {
2690  p = _("N (85 obsolete)");
2691  } else if (reserved_words[i].token > 0) {
2692  if (reserved_words[i].context_sens) {
2693  p = _("Y (Context sensitive)");
2694  } else {
2695  p = _("Y");
2696  }
2697  } else {
2698  if (reserved_words[i].context_sens) {
2699  p = _("N (Context sensitive)");
2700  } else {
2701  p = _("N");
2702  }
2703  }
2704  printf ("%s%s%s\n", reserved_words[i].name, s, p);
2705  }
2706  putchar ('\n');
2707  puts (_("Extra (obsolete) context sensitive words"));
2708  puts ("AUTHOR");
2709  puts ("DATE-COMPILED");
2710  puts ("DATE-MODIFIED");
2711  puts ("DATE-WRITTEN");
2712  puts ("INSTALLATION");
2713  puts ("REMARKS");
2714  puts ("SECURITY");
2715  putchar ('\n');
2716  puts (_("Extra internal registers\tDefinition"));
2717  puts ("RETURN-CODE\t\t\tUSAGE BINARY-LONG");
2718  puts ("SORT-RETURN\t\t\tUSAGE BINARY-LONG");
2719  puts ("NUMBER-OF-CALL-PARAMETERS\tUSAGE BINARY-LONG");
2720  puts ("COB-CRT-STATUS\t\t\tPIC 9(4)");
2721  puts ("'LENGTH OF' phrase\t\tUSAGE BINARY-LONG");
2722 }
cb_tree cb_list_reverse ( cb_tree  )

References CB_CHAIN, next, and NULL.

1174 {
1175  cb_tree next;
1176  cb_tree last;
1177 
1178  last = NULL;
1179  for (; l; l = next) {
1180  next = CB_CHAIN (l);
1181  CB_CHAIN (l) = last;
1182  last = l;
1183  }
1184  return last;
1185 }
void cb_list_system ( void  )

References _, system_table::syst_name, and system_table::syst_params.

827 {
828  const struct system_table *psyst;
829  const char *s;
830  size_t n;
831 
832  putchar ('\n');
833  printf (_("System routine\t\t\tParameters"));
834  puts ("\n");
835  for (psyst = system_tab; psyst->syst_name; psyst++) {
836  switch (*(unsigned char *)(psyst->syst_name)) {
837  case 'C':
838  case 'S':
839  printf ("%s", psyst->syst_name);
840  break;
841  case 0xF4:
842  printf ("X\"F4\"");
843  break;
844  case 0xF5:
845  printf ("X\"F5\"");
846  break;
847  case 0x91:
848  printf ("X\"91\"");
849  break;
850  case 0xE4:
851  printf ("X\"E4\"");
852  break;
853  case 0xE5:
854  printf ("X\"E5\"");
855  break;
856  default:
857  break;
858  }
859  n = strlen (psyst->syst_name);
860  switch (n / 8) {
861  case 0:
862  s = "\t\t\t\t";
863  break;
864  case 1:
865  s = "\t\t\t";
866  break;
867  case 2:
868  s = "\t\t";
869  break;
870  default:
871  s = "\t";
872  break;
873  }
874  printf ("%s%d\n", s, psyst->syst_params);
875  }
876 }
char* cb_name ( cb_tree  )

References cb_name_1(), COB_NORMAL_BUFF, and cobc_parse_malloc().

643 {
644  char *s;
645 
646  s = cobc_parse_malloc ((size_t)COB_NORMAL_BUFF);
647  (void)cb_name_1 (s, x);
648  return s;
649 }
cb_tree cb_pair_add ( cb_tree  ,
cb_tree  ,
cb_tree   
)

References CB_BUILD_PAIR, and cb_list_append().

1168 {
1169  return cb_list_append (l, CB_BUILD_PAIR (x, y));
1170 }
cb_tree cb_ref ( cb_tree  )

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

2505 {
2506  struct cb_reference *r;
2507  struct cb_field *p;
2508  struct cb_label *s;
2509  cb_tree candidate;
2510  cb_tree items;
2511  cb_tree cb1;
2512  cb_tree cb2;
2513  cb_tree v;
2514  cb_tree c;
2515  struct cb_program *prog;
2516  struct cb_word *w;
2517  size_t val;
2518  size_t ambiguous;
2519 
2520  if (CB_INVALID_TREE (x)) {
2521  return cb_error_node;
2522  }
2523  r = CB_REFERENCE (x);
2524  /* If this reference has already been resolved (and the value
2525  has been cached), then just return the value */
2526  if (r->value) {
2527  return r->value;
2528  }
2529 
2530  /* Resolve the value */
2531 
2532  candidate = NULL;
2533  ambiguous = 0;
2534  items = r->word->items;
2535  for (; items; items = CB_CHAIN (items)) {
2536  /* Find a candidate value by resolving qualification */
2537  v = CB_VALUE (items);
2538  c = r->chain;
2539  switch (CB_TREE_TAG (v)) {
2540  case CB_TAG_FIELD:
2541  /* In case the value is a field, it might be qualified
2542  by its parent names and a file name */
2543  if (CB_FIELD (v)->flag_indexed_by) {
2544  p = CB_FIELD (v)->index_qual;
2545  } else {
2546  p = CB_FIELD (v)->parent;
2547  }
2548  /* Resolve by parents */
2549  for (; p; p = p->parent) {
2550  if (c && strcasecmp (CB_NAME (c), p->name) == 0) {
2551  c = CB_REFERENCE (c)->chain;
2552  }
2553  }
2554 
2555  /* Resolve by file */
2556  if (c && CB_REFERENCE (c)->chain == NULL) {
2557  if (CB_WORD_COUNT (c) == 1 &&
2558  CB_FILE_P (cb_ref (c)) &&
2559  (CB_FILE (cb_ref (c)) == cb_field_founder (CB_FIELD (v))->file)) {
2560  c = CB_REFERENCE (c)->chain;
2561  }
2562  }
2563 
2564  break;
2565  case CB_TAG_LABEL:
2566  /* In case the value is a label, it might be qualified
2567  by its section name */
2568  s = CB_LABEL (v)->section;
2569 
2570  /* Unqualified paragraph name referenced within the section
2571  is resolved without ambiguity check if not duplicated */
2572  if (c == NULL && r->offset && s == CB_LABEL (r->offset)) {
2573  for (cb1 = CB_CHAIN (items); cb1; cb1 = CB_CHAIN (cb1)) {
2574  cb2 = CB_VALUE (cb1);
2575  if (s == CB_LABEL (cb2)->section) {
2576  ambiguous_error (x);
2577  goto error;
2578  }
2579  }
2580  candidate = v;
2581  goto end;
2582  }
2583 
2584  /* Resolve by section name */
2585  if (c && s && strcasecmp (CB_NAME (c), (char *)s->name) == 0) {
2586  c = CB_REFERENCE (c)->chain;
2587  }
2588 
2589  break;
2590  default:
2591  /* Other values cannot be qualified */
2592  break;
2593  }
2594 
2595  /* A well qualified value is a good candidate */
2596  if (c == NULL) {
2597  if (candidate == NULL) {
2598  /* Keep the first candidate */
2599  candidate = v;
2600  } else {
2601  /* Multiple candidates and possibly ambiguous */
2602  ambiguous = 1;
2603  /* Continue search because the reference might not
2604  be ambiguous and exit loop by "goto end" later */
2605  }
2606  }
2607  }
2608 
2609  /* There is no candidate */
2610  if (candidate == NULL) {
2611  if (likely(current_program->nested_level <= 0)) {
2612  goto undef_error;
2613  }
2614  /* Nested program - check parents for GLOBAL candidate */
2615  ambiguous = 0;
2616 /* RXWRXW
2617  val = hash ((const unsigned char *)r->word->name);
2618 */
2619  val = r->hashval;
2620  prog = current_program->next_program;
2621  for (; prog; prog = prog->next_program) {
2622  if (prog->nested_level >= current_program->nested_level) {
2623  continue;
2624  }
2625  for (w = prog->word_table[val]; w; w = w->next) {
2626  if (strcasecmp (r->word->name, w->name) == 0) {
2627  candidate = global_check (r, w->items, &ambiguous);
2628  if (candidate) {
2629  if (ambiguous) {
2630  ambiguous_error (x);
2631  goto error;
2632  }
2633  if (CB_FILE_P(candidate)) {
2634  current_program->flag_gen_error = 1;
2635  }
2636  goto end;
2637  }
2638  }
2639  }
2640  if (prog->nested_level == 0) {
2641  break;
2642  }
2643  }
2644  goto undef_error;
2645  }
2646 
2647  /* Reference is ambiguous */
2648  if (ambiguous) {
2649  ambiguous_error (x);
2650  goto error;
2651  }
2652 
2653 end:
2654  if (CB_FIELD_P (candidate)) {
2655  CB_FIELD (candidate)->count++;
2656  if (CB_FIELD (candidate)->flag_invalid) {
2657  goto error;
2658  }
2659  } else if (CB_LABEL_P (candidate) && r->flag_alter_code) {
2660  CB_LABEL (candidate)->flag_alter = 1;
2661  }
2662 
2663  r->value = candidate;
2664  return r->value;
2665 
2666 undef_error:
2667  undefined_error (x);
2668  /* Fall through */
2669 
2670 error:
2671  r->value = cb_error_node;
2672  return cb_error_node;
2673 }
void cb_reset_78 ( void  )

References cobc_free(), const78ptr, globlev78ptr, cb_level_78::next, cb_level_78::not_const, and NULL.

4551 {
4552  struct cb_level_78 *p78;
4553  struct cb_level_78 *p782;
4554 
4555  /* Remove constant (78 level) items for current program */
4556  for (p78 = lev78ptr; p78; ) {
4557  p782 = p78->next;
4558  cobc_free (p78);
4559  p78 = p782;
4560  }
4561  lev78ptr = NULL;
4562  for (p78 = globlev78ptr; p78; p78 = p78->next) {
4563  p78->not_const = 0;
4564  }
4565  if (globlev78ptr) {
4566  top78ptr = globlev78ptr;
4567  } else {
4568  top78ptr = const78ptr;
4569  }
4570 }
void cb_reset_global_78 ( void  )

References cobc_free(), const78ptr, cb_level_78::next, and NULL.

4574 {
4575  struct cb_level_78 *p78;
4576  struct cb_level_78 *p782;
4577 
4578  /* Remove constant (78 level) items for top program */
4579  for (p78 = globlev78ptr; p78; ) {
4580  p782 = p78->next;
4581  cobc_free (p78);
4582  p78 = p782;
4583  }
4584  globlev78ptr = NULL;
4585  top78ptr = const78ptr;
4586 }
struct cb_field* cb_resolve_redefines ( struct cb_field *  ,
cb_tree   
)
read

References _, CB_CHAIN, cb_error_x(), CB_FIELD_P, CB_FIELD_PTR, CB_NAME, CB_REFERENCE, CB_TREE, CB_VALUE, cb_reference::chain, cb_field::children, cb_word::items, cb_field::level, cb_field::name, NULL, cb_field::parent, cb_field::redefines, cb_field::sister, cb_reference::subs, undefined_error(), and cb_reference::word.

247 {
248  struct cb_field *f;
249  struct cb_reference *r;
250  const char *name;
251  cb_tree x;
252  cb_tree candidate;
253  cb_tree items;
254 
255  r = CB_REFERENCE (redefines);
256  name = CB_NAME (redefines);
257  x = CB_TREE (field);
258 
259  /* Check qualification */
260  if (r->chain) {
261  cb_error_x (x, _("'%s' cannot be qualified here"), name);
262  return NULL;
263  }
264 
265  /* Check subscripts */
266  if (r->subs) {
267  cb_error_x (x, _("'%s' cannot be subscripted here"), name);
268  return NULL;
269  }
270 
271  /* Resolve the name in the current group (if any) */
272  if (field->parent && field->parent->children) {
273  for (f = field->parent->children; f; f = f->sister) {
274  if (strcasecmp (f->name, name) == 0) {
275  break;
276  }
277  }
278  if (f == NULL) {
279  cb_error_x (x, _("'%s' is not defined in '%s'"), name, field->parent->name);
280  return NULL;
281  }
282  } else {
283  /* Get last defined name */
284  candidate = NULL;
285  items = r->word->items;
286  for (; items; items = CB_CHAIN (items)) {
287  if (CB_FIELD_P (CB_VALUE (items))) {
288  candidate = CB_VALUE (items);
289  }
290  }
291  if (!candidate) {
292  undefined_error (redefines);
293  return NULL;
294  }
295  f = CB_FIELD_PTR (candidate);
296  }
297 
298  /* Check level number */
299  if (f->level != field->level) {
300  cb_error_x (x, _("Level number of REDEFINES entries must be identical"));
301  return NULL;
302  }
303  if (f->level == 66 || f->level == 88) {
304  cb_error_x (x, _("Level number of REDEFINES entry cannot be 66 or 88"));
305  return NULL;
306  }
307 
308  if (!cb_indirect_redefines && f->redefines) {
309  cb_error_x (x, _("'%s' not the original definition"), f->name);
310  return NULL;
311  }
312 
313  /* Return the original definition */
314  while (f->redefines) {
315  f = f->redefines;
316  }
317  return f;
318 }
void cb_set_system_names ( void  )

References cb_define_system_name().

2489 {
2490  cb_define_system_name ("CONSOLE");
2491  cb_define_system_name ("SYSIN");
2492  cb_define_system_name ("SYSIPT");
2493  cb_define_system_name ("STDIN");
2494  cb_define_system_name ("SYSOUT");
2495  cb_define_system_name ("STDOUT");
2496  cb_define_system_name ("SYSERR");
2497  cb_define_system_name ("STDERR");
2498  cb_define_system_name ("SYSLST");
2499  cb_define_system_name ("SYSLIST");
2500  cb_define_system_name ("FORMFEED");
2501 }
char* cb_to_cname ( const char *  )

References cob_u8_t, cobc_parse_strdup(), copy, and p.

613 {
614  char *copy;
615  unsigned char *p;
616 
617  copy = cobc_parse_strdup (s);
618  for (p = (unsigned char *)copy; *p; p++) {
619  if (*p == '-' || *p == ' ') {
620  *p = '_';
621  } else {
622  *p = (cob_u8_t)toupper (*p);
623  }
624  }
625  return copy;
626 }
enum cb_category cb_tree_category ( cb_tree  )

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

653 {
654  struct cb_cast *p;
655  struct cb_reference *r;
656  struct cb_field *f;
657 
658  if (x == cb_error_node) {
659  return (enum cb_category)0;
660  }
661  if (x->category != CB_CATEGORY_UNKNOWN) {
662  return x->category;
663  }
664 
665  switch (CB_TREE_TAG (x)) {
666  case CB_TAG_CAST:
667  p = CB_CAST (x);
668  switch (p->cast_type) {
669  case CB_CAST_ADDRESS:
670  case CB_CAST_ADDR_OF_ADDR:
671  x->category = CB_CATEGORY_DATA_POINTER;
672  break;
673  case CB_CAST_PROGRAM_POINTER:
674  x->category = CB_CATEGORY_PROGRAM_POINTER;
675  break;
676  default:
677  cobc_abort_pr (_("Unexpected cast type -> %d"),
678  (int)(p->cast_type));
679  COBC_ABORT ();
680  }
681  break;
682  case CB_TAG_REFERENCE:
683  r = CB_REFERENCE (x);
684  if (r->offset) {
685  x->category = CB_CATEGORY_ALPHANUMERIC;
686  } else {
687  x->category = cb_tree_category (r->value);
688  }
689  break;
690  case CB_TAG_FIELD:
691  f = CB_FIELD (x);
692  if (f->children) {
693  x->category = CB_CATEGORY_ALPHANUMERIC;
694  } else if (f->usage == CB_USAGE_POINTER && f->level != 88) {
695  x->category = CB_CATEGORY_DATA_POINTER;
696  } else if (f->usage == CB_USAGE_PROGRAM_POINTER && f->level != 88) {
697  x->category = CB_CATEGORY_PROGRAM_POINTER;
698  } else {
699  switch (f->level) {
700  case 66:
701  if (f->rename_thru) {
702  x->category = CB_CATEGORY_ALPHANUMERIC;
703  } else {
704  x->category = cb_tree_category (CB_TREE (f->redefines));
705  }
706  break;
707  case 88:
708  x->category = CB_CATEGORY_BOOLEAN;
709  break;
710  default:
711  if (f->pic) {
712  x->category = f->pic->category;
713  } else {
714  x->category = (enum cb_category)0;
715  }
716  break;
717  }
718  }
719  break;
720  case CB_TAG_ALPHABET_NAME:
721  case CB_TAG_LOCALE_NAME:
722  x->category = CB_CATEGORY_ALPHANUMERIC;
723  break;
724  case CB_TAG_BINARY_OP:
725  x->category = CB_CATEGORY_BOOLEAN;
726  break;
727  case CB_TAG_INTRINSIC:
728  x->category = CB_INTRINSIC(x)->intr_tab->category;
729  break;
730  default:
731 #if 0 /* RXWRXW - Tree tag */
732  cobc_abort_pr (_("Unknown tree tag %d Category %d"),
733  (int)CB_TREE_TAG (x), (int)x->category);
734  COBC_ABORT ();
735 #endif
736  return CB_CATEGORY_UNKNOWN;
737  }
738 
739  return x->category;
740 }
enum cb_class cb_tree_class ( cb_tree  )

References category_to_class_table, and CB_TREE_CATEGORY.

744 {
745 
746  return category_to_class_table[CB_TREE_CATEGORY (x)];
747 }
int cb_tree_type ( const cb_tree  ,
const struct cb_field *   
)

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

757 {
758  if (f->children) {
759  return COB_TYPE_GROUP;
760  }
761 
762  switch (CB_TREE_CATEGORY (x)) {
763  case CB_CATEGORY_ALPHABETIC:
764  case CB_CATEGORY_ALPHANUMERIC:
765  return COB_TYPE_ALPHANUMERIC;
766  case CB_CATEGORY_ALPHANUMERIC_EDITED:
767  return COB_TYPE_ALPHANUMERIC_EDITED;
768  case CB_CATEGORY_NUMERIC:
769  switch (f->usage) {
770  case CB_USAGE_DISPLAY:
771  return COB_TYPE_NUMERIC_DISPLAY;
772  case CB_USAGE_BINARY:
773  case CB_USAGE_COMP_5:
774  case CB_USAGE_COMP_X:
775  case CB_USAGE_INDEX:
776  case CB_USAGE_LENGTH:
777  return COB_TYPE_NUMERIC_BINARY;
778  case CB_USAGE_FLOAT:
779  return COB_TYPE_NUMERIC_FLOAT;
780  case CB_USAGE_DOUBLE:
781  return COB_TYPE_NUMERIC_DOUBLE;
782  case CB_USAGE_PACKED:
783  case CB_USAGE_COMP_6:
784  return COB_TYPE_NUMERIC_PACKED;
785  case CB_USAGE_LONG_DOUBLE:
786  return COB_TYPE_NUMERIC_L_DOUBLE;
787  case CB_USAGE_FP_BIN32:
788  return COB_TYPE_NUMERIC_FP_BIN32;
789  case CB_USAGE_FP_BIN64:
790  return COB_TYPE_NUMERIC_FP_BIN64;
791  case CB_USAGE_FP_BIN128:
792  return COB_TYPE_NUMERIC_FP_BIN128;
793  case CB_USAGE_FP_DEC64:
794  return COB_TYPE_NUMERIC_FP_DEC64;
795  case CB_USAGE_FP_DEC128:
796  return COB_TYPE_NUMERIC_FP_DEC128;
797  default:
798  cobc_abort_pr (_("Unexpected numeric usage -> %d"),
799  (int)f->usage);
800  COBC_ABORT ();
801  }
802  case CB_CATEGORY_NUMERIC_EDITED:
803  return COB_TYPE_NUMERIC_EDITED;
804  case CB_CATEGORY_OBJECT_REFERENCE:
805  case CB_CATEGORY_DATA_POINTER:
806  case CB_CATEGORY_PROGRAM_POINTER:
807  return COB_TYPE_NUMERIC_BINARY;
808  default:
809  cobc_abort_pr (_("Unexpected category -> %d"),
810  (int)CB_TREE_CATEGORY (x));
811  /* Use dumb variant */
812  COBC_DUMB_ABORT ();
813  }
814  /* NOT REACHED */
815 #ifndef _MSC_VER
816  return 0;
817 #endif
818 }
void cb_unput_dot ( void  )

References unput.

4545 {
4546  unput ('.');
4547 }
struct cb_field* cb_validate_78_item ( struct cb_field *  ,
const cob_u32_t   
)
read

References cb_add_78(), CB_INVALID_TREE, CB_TREE, CB_VALUE, cob_u32_t, cb_field::flag_occurs, last_real_field, level_except_error(), level_require_error(), cb_field::pic, and cb_field::values.

Referenced by cb_add_const_var(), and cb_build_symbolic_chars().

1413 {
1414  cb_tree x;
1415  cob_u32_t noadd;
1416 
1417  x = CB_TREE (f);
1418  noadd = no78add;
1419  if (CB_INVALID_TREE(f->values) ||
1420  CB_INVALID_TREE(CB_VALUE(f->values))) {
1421  level_require_error (x, "VALUE");
1422  noadd = 1;
1423  }
1424 
1425  if (f->pic || f->flag_occurs) {
1426  level_except_error (x, "VALUE");
1427  noadd = 1;
1428  }
1429  if (!noadd) {
1430  cb_add_78 (f);
1431  }
1432  return last_real_field;
1433 }
void cb_validate_88_item ( struct cb_field *  )

References _, CB_CHAIN, CB_CLASS_NUMERIC, cb_error_x(), cb_high, cb_low, cb_quote, cb_space, CB_TREE, CB_TREE_CLASS, CB_VALID_TREE, CB_VALUE, cb_field::flag_occurs, level_except_error(), level_require_error(), cb_field::parent, cb_field::pic, and cb_field::values.

1384 {
1385  cb_tree x;
1386  cb_tree l;
1387  cb_tree t;
1388 
1389  x = CB_TREE (f);
1390  if (!f->values) {
1391  level_require_error (x, "VALUE");
1392  return;
1393  }
1394 
1395  if (f->pic || f->flag_occurs) {
1396  level_except_error (x, "VALUE");
1397  return;
1398  }
1399  if (CB_VALID_TREE(f->parent) &&
1400  CB_TREE_CLASS (f->parent) == CB_CLASS_NUMERIC) {
1401  for (l = f->values; l; l = CB_CHAIN (l)) {
1402  t = CB_VALUE (l);
1403  if (t == cb_space || t == cb_low ||
1404  t == cb_high || t == cb_quote) {
1405  cb_error_x (x, _("Literal type does not match data type"));
1406  }
1407  }
1408  }
1409 }
void cb_validate_field ( struct cb_field *  )

References CB_STORAGE_LINKAGE, CB_STORAGE_LOCAL, cb_field::children, compute_size(), cb_field::count, cb_field::flag_base, cb_field::flag_invalid, cb_field::flag_is_global, cb_field::flag_is_verified, cb_field::flag_item_78, cb_field::flag_item_based, cb_field::flag_local, cb_field::memory_size, occur_align_size, cb_field::occurs_max, cb_field::redefines, setup_parameters(), cb_field::sister, cb_field::size, cb_field::storage, validate_field_1(), and validate_field_value().

Referenced by cb_build_const_length(), cb_build_debug_item(), cb_build_implicit_field(), cb_build_index(), cb_validate_program_data(), and finalize_file().

1336 {
1337  struct cb_field *c;
1338 
1339  if (f->flag_is_verified) {
1340  return;
1341  }
1342  if (validate_field_1 (f) != 0) {
1343  f->flag_invalid = 1;
1344  return;
1345  }
1346  if (f->flag_item_78) {
1347  f->flag_is_verified = 1;
1348  return;
1349  }
1350 
1351  /* Set up parameters */
1352  if (f->storage == CB_STORAGE_LOCAL ||
1353  f->storage == CB_STORAGE_LINKAGE ||
1354  f->flag_item_based) {
1355  f->flag_local = 1;
1356  }
1357  if (f->storage == CB_STORAGE_LINKAGE || f->flag_item_based) {
1358  f->flag_base = 1;
1359  }
1360  setup_parameters (f);
1361 
1362  /* Compute size */
1363  occur_align_size = 1;
1364  compute_size (f);
1365  if (!f->redefines) {
1366  f->memory_size = f->size * f->occurs_max;
1367  } else if (f->redefines->memory_size < f->size * f->occurs_max) {
1368  f->redefines->memory_size = f->size * f->occurs_max;
1369  }
1370 
1371  validate_field_value (f);
1372  if (f->flag_is_global) {
1373  f->count++;
1374  for (c = f->children; c; c = c->sister) {
1375  c->flag_is_global = 1;
1376  c->count++;
1377  }
1378  }
1379  f->flag_is_verified = 1;
1380 }
void cb_validate_program_body ( struct cb_program *  )

References _, cb_program::all_procedure, cb_label::alter_gotos, cb_program::alter_gotos, cb_program::alter_list, CB_CHAIN, cb_error_node, cb_error_x(), CB_FIELD, CB_FIELD_PTR, CB_LABEL, CB_LABEL_P, cb_list_reverse(), cb_name(), CB_PURPOSE, cb_ref(), CB_REFERENCE, CB_TAG_FIELD, CB_TAG_FILE, CB_TAG_LABEL, CB_TREE_TAG, CB_VALUE, cb_warning_x(), cobc_cs_check, cobc_parse_malloc(), current_paragraph, current_program, current_section, cb_program::debug_list, cb_program::exec_list, cb_program::file_list, cb_program::flag_debugging, cb_label::flag_first_is_goto, cb_alter_id::goto_id, cb_label::id, cb_program::label_list, cb_field::memory_size, cb_field::name, cb_label::name, cb_alter_id::next, cb_field::size, and value.

2483 {
2484  cb_tree l;
2485  cb_tree x;
2486  cb_tree v;
2487  struct cb_label *save_section;
2488  struct cb_label *save_paragraph;
2489  struct cb_alter_id *aid;
2490  struct cb_label *l1;
2491  struct cb_label *l2;
2492  struct cb_field *f;
2493  int size;
2494 
2495  /* Resolve all labels */
2496  save_section = current_section;
2497  save_paragraph = current_paragraph;
2498  for (l = cb_list_reverse (prog->label_list); l; l = CB_CHAIN (l)) {
2499  x = CB_VALUE (l);
2500  current_section = CB_REFERENCE (x)->section;
2501  current_paragraph = CB_REFERENCE (x)->paragraph;
2502  v = cb_ref (x);
2503  /* Check refs in to / out of DECLARATIVES */
2504  if (CB_LABEL_P (v)) {
2505  if (CB_REFERENCE (x)->flag_in_decl &&
2506  !CB_LABEL (v)->flag_declaratives) {
2507  if (!cb_relaxed_syntax_check) {
2508  cb_error_x (x, _("'%s' is not in DECLARATIVES"),
2509  CB_LABEL (v)->name);
2510  } else {
2511  cb_warning_x (x, _("'%s' is not in DECLARATIVES"),
2512  CB_LABEL (v)->name);
2513  }
2514  }
2515  if (CB_LABEL (v)->flag_declaratives &&
2516  !CB_REFERENCE (x)->flag_in_decl &&
2517  !CB_REFERENCE (x)->flag_decl_ok) {
2518  cb_error_x (x, _("Invalid reference to '%s' (In DECLARATIVES)"), CB_LABEL (v)->name);
2519  }
2520  CB_LABEL (v)->flag_begin = 1;
2521  if (CB_REFERENCE (x)->length) {
2522  CB_LABEL (v)->flag_return = 1;
2523  }
2524  } else if (v != cb_error_node) {
2525  cb_error_x (x, _("'%s' not a procedure name"), cb_name (x));
2526  }
2527  }
2528 
2529  /* Resolve DEBUG references */
2530  /* For data items, we may need to adjust the size of DEBUG-CONTENTS */
2531  /* Basic size of DEBUG-CONTENTS is 31 */
2532  size = 31;
2533  for (l = prog->debug_list; l; l = CB_CHAIN (l)) {
2534  x = CB_VALUE (l);
2535  current_section = CB_REFERENCE (x)->section;
2536  current_paragraph = CB_REFERENCE (x)->paragraph;
2537  v = cb_ref (x);
2538  if (v == cb_error_node) {
2539  continue;
2540  }
2541  switch (CB_TREE_TAG (v)) {
2542  case CB_TAG_LABEL:
2543  if (current_program->all_procedure) {
2544  cb_error_x (x, _("'%s' - DEBUGGING target invalid with ALL PROCEDURES"),
2545  cb_name (x));
2546  }
2547  if (!CB_LABEL (v)->flag_real_label) {
2548  cb_error_x (x, _("'%s' - DEBUGGING target invalid"),
2549  cb_name (x));
2550  }
2551  CB_LABEL (v)->debug_section =
2552  CB_REFERENCE (x)->debug_section;
2553  CB_LABEL (v)->flag_debugging_mode = 1;
2554  break;
2555  case CB_TAG_FILE:
2556  break;
2557  case CB_TAG_FIELD:
2558  if (CB_FIELD (v)->size > size) {
2559  size = CB_FIELD (v)->size;
2560  }
2561  break;
2562  default:
2563  cb_error_x (x, _("'%s' is not a valid DEBUGGING target"),
2564  cb_name (x));
2565  break;
2566  }
2567  }
2568  /* If necessary, adjust size of DEBUG-CONTENTS (and DEBUG-ITEM) */
2569  if (current_program->flag_debugging) {
2570  if (size != 31) {
2571  f = CB_FIELD_PTR (cb_debug_contents);
2572  f->size = size;
2573  f->memory_size = size;
2574  size -= 31;
2575  f = CB_FIELD_PTR (cb_debug_item);
2576  f->size += size;
2577  f->memory_size += size;
2578  }
2579  }
2580 
2581  /* Build ALTER ids - We need to remove duplicates */
2582  for (l = prog->alter_list; l; l = CB_CHAIN (l)) {
2583  if (CB_PURPOSE (l) == cb_error_node) {
2584  continue;
2585  }
2586  if (CB_VALUE (l) == cb_error_node) {
2587  continue;
2588  }
2589  x = CB_PURPOSE (l);
2590  v = CB_VALUE (l);
2591  if (CB_REFERENCE (x)->value == cb_error_node) {
2592  continue;
2593  }
2594  if (CB_REFERENCE (v)->value == cb_error_node) {
2595  continue;
2596  }
2597  l1 = CB_LABEL (CB_REFERENCE (x)->value);
2598  l2 = CB_LABEL (CB_REFERENCE (v)->value);
2599  current_section = CB_REFERENCE (x)->section;
2600  current_paragraph = CB_REFERENCE (x)->paragraph;
2601  /* First statement in paragraph must be a GO TO */
2602  if (!l1->flag_first_is_goto) {
2603  cb_error_x (x, _("'%s' is not an alterable paragraph"),
2604  l1->name);
2605  continue;
2606  }
2607  for (aid = l1->alter_gotos; aid; aid = aid->next) {
2608  if (aid->goto_id == l2->id) {
2609  break;
2610  }
2611  }
2612  if (!aid) {
2613  aid = cobc_parse_malloc (sizeof(struct cb_alter_id));
2614  aid->next = l1->alter_gotos;
2615  aid->goto_id = l2->id;
2616  l1->alter_gotos = aid;
2617  }
2618  for (aid = prog->alter_gotos; aid; aid = aid->next) {
2619  if (aid->goto_id == l1->id) {
2620  break;
2621  }
2622  }
2623  if (!aid) {
2624  aid = cobc_parse_malloc (sizeof(struct cb_alter_id));
2625  aid->next = prog->alter_gotos;
2626  aid->goto_id = l1->id;
2627  prog->alter_gotos = aid;
2628  }
2629  }
2630 
2631  current_section = save_section;
2632  current_paragraph = save_paragraph;
2633  cobc_cs_check = 0;
2634 
2635  prog->file_list = cb_list_reverse (prog->file_list);
2636  prog->exec_list = cb_list_reverse (prog->exec_list);
2637 }
void cb_validate_program_data ( struct cb_program *  )

References _, build_literal(), CB_ASSIGN_MF, cb_build_field(), cb_build_field_reference(), cb_build_implicit_field(), cb_build_picture(), cb_build_reference(), CB_CATEGORY_ALPHANUMERIC, CB_CHAIN, cb_depend_check, cb_error(), cb_error_node, cb_error_x(), CB_FIELD, CB_FIELD_ADD, CB_FIELD_P, CB_FIELD_PTR, CB_FILE, CB_LIST_INIT, cb_list_reverse(), CB_LITERAL, CB_NAME, cb_name(), cb_needs_01, CB_PICTURE, cb_ref(), CB_REF_OR_FIELD_P, CB_REFERENCE_P, CB_REPORT, CB_STORAGE_LINKAGE, CB_STORAGE_LOCAL, CB_STORAGE_WORKING, CB_TREE, CB_USAGE_DISPLAY, CB_USAGE_UNSIGNED_INT, CB_VALID_TREE, cb_validate_field(), CB_VALUE, cb_warning(), CB_WORD_COUNT, cb_zero, check_level_78(), cb_report::cname, COB_MINI_BUFF, COB_MINI_MAX, COB_SMALL_BUFF, cb_program::crt_status, current_program, cb_program::cursor_pos, cb_field::depending, cb_program::file_list, finalize_file(), cb_file::flag_finalized, cb_field::flag_is_global, cb_field::flag_no_init, cb_field::flag_odo_item, cb_report::line_counter, cb_field::name, cb_report::name, NULL, p, cb_report::page_counter, cb_field::parent, cb_field::pic, cb_file::record_depending, cb_field::redefines, redefinition_error(), cb_program::reference_list, cb_program::report_list, cb_field::sister, cb_field::storage, cb_field::usage, cb_field::values, and cb_program::working_storage.

2284 {
2285  cb_tree l;
2286  cb_tree x;
2287  cb_tree assign;
2288  struct cb_field *p;
2289  struct cb_field *q;
2290  struct cb_field *depfld;
2291  struct cb_file *f;
2292  struct cb_report *rep;
2293  unsigned char *c;
2294  char buff[COB_MINI_BUFF];
2295 
2296  for (l = current_program->report_list; l; l = CB_CHAIN (l)) {
2297  /* Set up LINE-COUNTER / PAGE-COUNTER */
2298  rep = CB_REPORT (CB_VALUE (l));
2299  snprintf (buff, (size_t)COB_MINI_MAX,
2300  "LINE-COUNTER %s", rep->cname);
2301  x = cb_build_field (cb_build_reference (buff));
2302  CB_FIELD (x)->usage = CB_USAGE_UNSIGNED_INT;
2303  CB_FIELD (x)->values = CB_LIST_INIT (cb_zero);
2304  CB_FIELD (x)->count++;
2305  cb_validate_field (CB_FIELD (x));
2306  rep->line_counter = cb_build_field_reference (CB_FIELD (x), NULL);
2307  CB_FIELD_ADD (current_program->working_storage, CB_FIELD (x));
2308  snprintf (buff, (size_t)COB_MINI_MAX,
2309  "PAGE-COUNTER %s", rep->cname);
2310  x = cb_build_field (cb_build_reference (buff));
2311  CB_FIELD (x)->usage = CB_USAGE_UNSIGNED_INT;
2312  CB_FIELD (x)->values = CB_LIST_INIT (cb_zero);
2313  CB_FIELD (x)->count++;
2314  cb_validate_field (CB_FIELD (x));
2315  rep->page_counter = cb_build_field_reference (CB_FIELD (x), NULL);
2316  CB_FIELD_ADD (current_program->working_storage, CB_FIELD (x));
2317  }
2318 
2319  for (l = current_program->file_list; l; l = CB_CHAIN (l)) {
2320  f = CB_FILE (CB_VALUE (l));
2321  if (!f->flag_finalized) {
2322  finalize_file (f, NULL);
2323  }
2324  }
2325 
2326  /* Build undeclared assignment name now */
2327  if (cb_assign_clause == CB_ASSIGN_MF) {
2328  for (l = current_program->file_list; l; l = CB_CHAIN (l)) {
2329  assign = CB_FILE (CB_VALUE (l))->assign;
2330  if (!assign) {
2331  continue;
2332  }
2333  if (CB_REFERENCE_P (assign)) {
2334  for (x = current_program->file_list; x; x = CB_CHAIN (x)) {
2335  if (!strcmp (CB_FILE (CB_VALUE (x))->name,
2336  CB_NAME (assign))) {
2337  redefinition_error (assign);
2338  }
2339  }
2340  p = check_level_78 (CB_NAME (assign));
2341  if (p) {
2342  c = (unsigned char *)CB_LITERAL(CB_VALUE(p->values))->data;
2343  assign = CB_TREE (build_literal (CB_CATEGORY_ALPHANUMERIC, c, strlen ((char *)c)));
2344  CB_FILE (CB_VALUE (l))->assign = assign;
2345  }
2346  }
2347  if (CB_REFERENCE_P (assign) &&
2348  CB_WORD_COUNT (assign) == 0) {
2349  if (cb_warn_implicit_define) {
2350  cb_warning (_("'%s' will be implicitly defined"), CB_NAME (assign));
2351  }
2352  x = cb_build_implicit_field (assign, COB_SMALL_BUFF);
2353  CB_FIELD (x)->count++;
2354  p = current_program->working_storage;
2355  if (p) {
2356  while (p->sister) {
2357  p = p->sister;
2358  }
2359  p->sister = CB_FIELD (x);
2360  } else {
2361  current_program->working_storage = CB_FIELD (x);
2362  }
2363  }
2364  if (CB_REFERENCE_P (assign)) {
2365  x = cb_ref (assign);
2366  if (CB_FIELD_P (x) && CB_FIELD (x)->level == 88) {
2367  cb_error_x (assign, _("ASSIGN data item '%s' invalid"), CB_NAME (assign));
2368  }
2369  }
2370  }
2371  }
2372 
2373  if (prog->cursor_pos) {
2374  x = cb_ref (prog->cursor_pos);
2375  if (x == cb_error_node) {
2376  prog->cursor_pos = NULL;
2377  } else if (CB_FIELD(x)->size != 6 && CB_FIELD(x)->size != 4) {
2378  cb_error_x (prog->cursor_pos, _("'%s' CURSOR is not 4 or 6 characters long"),
2379  cb_name (prog->cursor_pos));
2380  prog->cursor_pos = NULL;
2381  }
2382  }
2383  if (prog->crt_status) {
2384  x = cb_ref (prog->crt_status);
2385  if (x == cb_error_node) {
2386  prog->crt_status = NULL;
2387  } else if (CB_FIELD(x)->size != 4) {
2388  cb_error_x (prog->crt_status, _("'%s' CRT STATUS is not 4 characters long"),
2389  cb_name (prog->crt_status));
2390  prog->crt_status = NULL;
2391  }
2392  } else {
2393  l = cb_build_reference ("COB-CRT-STATUS");
2394  p = CB_FIELD (cb_build_field (l));
2395  p->usage = CB_USAGE_DISPLAY;
2396  p->pic = CB_PICTURE (cb_build_picture ("9(4)"));
2397  cb_validate_field (p);
2398  p->flag_no_init = 1;
2399  /* Do not initialize/bump ref count here
2400  p->values = CB_LIST_INIT (cb_zero);
2401  p->count++;
2402  */
2403  CB_FIELD_ADD (current_program->working_storage, p);
2404  prog->crt_status = l;
2405  }
2406 
2407  /* Resolve all references so far */
2408  for (l = cb_list_reverse (prog->reference_list); l; l = CB_CHAIN (l)) {
2409  cb_ref (CB_VALUE (l));
2410  }
2411 
2412  /* Check ODO items */
2413  for (l = cb_depend_check; l; l = CB_CHAIN (l)) {
2414  x = CB_VALUE(l);
2415  if (x == cb_error_node) {
2416  continue;
2417  }
2418  q = CB_FIELD_PTR (x);
2419  if (cb_ref (q->depending) != cb_error_node) {
2420  depfld = CB_FIELD_PTR (q->depending);
2421  } else {
2422  depfld = NULL;
2423  }
2424  /* The data item that contains a OCCURS DEPENDING clause must be
2425  the last data item in the group */
2426  for (p = q; p->parent; p = p->parent) {
2427  for (; p->sister; p = p->sister) {
2428  if (p->sister == depfld) {
2429  cb_error_x (x,
2430  _("'%s' ODO field item invalid here"),
2431  p->sister->name);
2432  }
2433  if (!p->sister->redefines) {
2434  if (!cb_complex_odo) {
2435  cb_error_x (x,
2436  _("'%s' cannot have OCCURS DEPENDING"),
2437  cb_name (x));
2438  break;
2439  }
2440  p->flag_odo_item = 1;
2441  }
2442  }
2443  }
2444  /* If the field is GLOBAL, then the ODO must also be GLOBAL */
2445  if (q->flag_is_global && depfld) {
2446  if (!depfld->flag_is_global) {
2447  cb_error_x (x, _("'%s' ODO item must have GLOBAL attribute"),
2448  depfld->name);
2449  }
2450  }
2451  }
2452  cb_depend_check = NULL;
2453  cb_needs_01 = 0;
2454 
2455  for (l = current_program->file_list; l; l = CB_CHAIN (l)) {
2456  f = CB_FILE (CB_VALUE (l));
2457  if (CB_VALID_TREE(f->record_depending)) {
2458  x = f->record_depending;
2459  if (cb_ref (x) != cb_error_node) {
2460 #if 0 /* RXWRXW - This breaks old legacy programs */
2461  if (CB_REF_OR_FIELD_P(x)) {
2462  p = CB_FIELD_PTR (x);
2463  switch (p->storage) {
2464  case CB_STORAGE_WORKING:
2465  case CB_STORAGE_LOCAL:
2466  case CB_STORAGE_LINKAGE:
2467  break;
2468  default:
2469  cb_error (_("RECORD DEPENDING item must be in WORKING/LOCAL/LINKAGE section"));
2470  }
2471  } else {
2472 #endif
2473  if (!CB_REF_OR_FIELD_P(x)) {
2474  cb_error (_("Invalid RECORD DEPENDING item"));
2475  }
2476  }
2477  }
2478  }
2479 }
void cb_validate_program_environment ( struct cb_program *  )

References _, cb_program::alphabet_name_list, cb_alphabet_name::alphabet_type, cb_alphabet_name::alphachr, CB_ALPHABET_ASCII, CB_ALPHABET_EBCDIC, CB_ALPHABET_NAME, CB_ALPHABET_NAME_P, CB_ALPHABET_NATIVE, cb_build_symbolic_chars(), CB_CHAIN, CB_CLASS_NAME, cb_error_node, cb_error_x(), cb_high, cb_int1, CB_LIST_P, CB_LITERAL, CB_LITERAL_P, CB_LOCALE_NAME_P, cb_low, cb_name(), cb_norm_high, cb_norm_low, CB_NUMERIC_LITERAL_P, CB_PAIR_P, CB_PAIR_X, CB_PAIR_Y, CB_PURPOSE, cb_ref(), cb_validate_collating(), CB_VALUE, cb_warning_x(), cb_program::class_name_list, cb_program::classification, cob_refer_ascii, cob_refer_ebcdic, cb_program::collating_sequence, current_program, cb_alphabet_name::custom_list, get_value(), cb_alphabet_name::high_val_char, cb_class_name::list, cb_alphabet_name::low_val_char, NULL, cb_program::symbolic_char_list, and cb_alphabet_name::values.

1831 {
1832  cb_tree x;
1833  cb_tree y;
1834  cb_tree l;
1835  cb_tree ls;
1836  struct cb_alphabet_name *ap;
1837  struct cb_class_name *cp;
1838  unsigned char *data;
1839  size_t dupls;
1840  size_t unvals;
1841  size_t count;
1842  int lower;
1843  int upper;
1844  int size;
1845  int n;
1846  int i;
1847  int lastval;
1848  int tableval;
1849  int values[256];
1850  int charvals[256];
1851 
1852  /* Check ALPHABET clauses */
1853  /* Complicated by difference between code set and collating sequence */
1854  for (l = current_program->alphabet_name_list; l; l = CB_CHAIN (l)) {
1855  ap = CB_ALPHABET_NAME (CB_VALUE (l));
1856 
1857  /* Native */
1858  if (ap->alphabet_type == CB_ALPHABET_NATIVE) {
1859  for (n = 0; n < 256; n++) {
1860  ap->values[n] = n;
1861  ap->alphachr[n] = n;
1862  }
1863  continue;
1864  }
1865 
1866  /* ASCII */
1867  if (ap->alphabet_type == CB_ALPHABET_ASCII) {
1868  for (n = 0; n < 256; n++) {
1869 #ifdef COB_EBCDIC_MACHINE
1870  ap->values[n] = (int)cob_refer_ascii[n];
1871  ap->alphachr[n] = (int)cob_refer_ascii[n];
1872 #else
1873  ap->values[n] = n;
1874  ap->alphachr[n] = n;
1875 #endif
1876  }
1877  continue;
1878  }
1879 
1880  /* EBCDIC */
1881  if (ap->alphabet_type == CB_ALPHABET_EBCDIC) {
1882  for (n = 0; n < 256; n++) {
1883 #ifdef COB_EBCDIC_MACHINE
1884  ap->values[n] = n;
1885  ap->alphachr[n] = n;
1886 #else
1887  ap->values[n] = (int)cob_refer_ebcdic[n];
1888  ap->alphachr[n] = (int)cob_refer_ebcdic[n];
1889 #endif
1890  }
1891  continue;
1892  }
1893 
1894  /* Custom alphabet */
1895  dupls = 0;
1896  unvals = 0;
1897  count = 0;
1898  lastval = 0;
1899  tableval = 0;
1900  for (n = 0; n < 256; n++) {
1901  values[n] = -1;
1902  charvals[n] = -1;
1903  ap->values[n] = -1;
1904  ap->alphachr[n] = -1;
1905  }
1906  ap->low_val_char = 0;
1907  ap->high_val_char = 255;
1908  for (y = ap->custom_list; y; y = CB_CHAIN (y)) {
1909  if (count > 255) {
1910  unvals = 1;
1911  break;
1912  }
1913  x = CB_VALUE (y);
1914  if (CB_PAIR_P (x)) {
1915  /* X THRU Y */
1916  lower = get_value (CB_PAIR_X (x));
1917  upper = get_value (CB_PAIR_Y (x));
1918  lastval = upper;
1919  if (!count) {
1920  ap->low_val_char = lower;
1921  }
1922  if (lower < 0 || lower > 255) {
1923  unvals = 1;
1924  continue;
1925  }
1926  if (upper < 0 || upper > 255) {
1927  unvals = 1;
1928  continue;
1929  }
1930  if (lower <= upper) {
1931  for (i = lower; i <= upper; i++) {
1932  if (values[i] != -1) {
1933  dupls = 1;
1934  }
1935  values[i] = i;
1936  charvals[i] = i;
1937  ap->alphachr[tableval] = i;
1938  ap->values[i] = tableval++;
1939  count++;
1940  }
1941  } else {
1942  for (i = lower; i >= upper; i--) {
1943  if (values[i] != -1) {
1944  dupls = 1;
1945  }
1946  values[i] = i;
1947  charvals[i] = i;
1948  ap->alphachr[tableval] = i;
1949  ap->values[i] = tableval++;
1950  count++;
1951  }
1952  }
1953  } else if (CB_LIST_P (x)) {
1954  /* X ALSO Y ... */
1955  if (!count) {
1956  ap->low_val_char = get_value (CB_VALUE (x));
1957  }
1958  for (ls = x; ls; ls = CB_CHAIN (ls)) {
1959  n = get_value (CB_VALUE (ls));
1960  if (!CB_CHAIN (ls)) {
1961  lastval = n;
1962  }
1963  if (n < 0 || n > 255) {
1964  unvals = 1;
1965  continue;
1966  }
1967  if (values[n] != -1) {
1968  dupls = 1;
1969  }
1970  values[n] = n;
1971  ap->values[n] = tableval;
1972  if (ls == x) {
1973  ap->alphachr[tableval] = n;
1974  charvals[n] = n;
1975  }
1976  count++;
1977  }
1978  tableval++;
1979  } else {
1980  /* Literal */
1981  if (CB_NUMERIC_LITERAL_P (x)) {
1982  n = get_value (x);
1983  lastval = n;
1984  if (!count) {
1985  ap->low_val_char = n;
1986  }
1987  if (n < 0 || n > 255) {
1988  unvals = 1;
1989  continue;
1990  }
1991  if (values[n] != -1) {
1992  dupls = 1;
1993  }
1994  values[n] = n;
1995  charvals[n] = n;
1996  ap->alphachr[tableval] = n;
1997  ap->values[n] = tableval++;
1998  count++;
1999  } else if (CB_LITERAL_P (x)) {
2000  size = (int)CB_LITERAL (x)->size;
2001  data = CB_LITERAL (x)->data;
2002  if (!count) {
2003  ap->low_val_char = data[0];
2004  }
2005  lastval = data[size - 1];
2006  for (i = 0; i < size; i++) {
2007  n = data[i];
2008  if (values[n] != -1) {
2009  dupls = 1;
2010  }
2011  values[n] = n;
2012  charvals[n] = n;
2013  ap->alphachr[tableval] = n;
2014  ap->values[n] = tableval++;
2015  count++;
2016  }
2017  } else {
2018  n = get_value (x);
2019  lastval = n;
2020  if (!count) {
2021  ap->low_val_char = n;
2022  }
2023  if (n < 0 || n > 255) {
2024  unvals = 1;
2025  continue;
2026  }
2027  if (values[n] != -1) {
2028  dupls = 1;
2029  }
2030  values[n] = n;
2031  charvals[n] = n;
2032  ap->alphachr[tableval] = n;
2033  ap->values[n] = tableval++;
2034  count++;
2035  }
2036  }
2037  }
2038  if (dupls || unvals) {
2039  if (dupls) {
2040  cb_error_x (l, _("Duplicate character values in alphabet '%s'"),
2041  cb_name (CB_VALUE(l)));
2042  }
2043  if (unvals) {
2044  cb_error_x (l, _("Invalid character values in alphabet '%s'"),
2045  cb_name (CB_VALUE(l)));
2046  }
2047  ap->low_val_char = 0;
2048  ap->high_val_char = 255;
2049  continue;
2050  }
2051  /* Calculate HIGH-VALUE */
2052  /* If all 256 values have been specified, */
2053  /* HIGH-VALUE is the last one */
2054  /* Otherwise if HIGH-VALUE has been specified, find the highest */
2055  /* value that has not been used */
2056  if (count == 256) {
2057  ap->high_val_char = lastval;
2058  } else if (values[255] != -1) {
2059  for (n = 254; n >= 0; n--) {
2060  if (values[n] == -1) {
2061  ap->high_val_char = n;
2062  break;
2063  }
2064  }
2065  }
2066 
2067  /* Get rest of code set */
2068  for (n = tableval; n < 256; ++n) {
2069  for (i = 0; i < 256; ++i) {
2070  if (charvals[i] < 0) {
2071  charvals[i] = 0;
2072  ap->alphachr[n] = i;
2073  break;
2074  }
2075  }
2076  }
2077 
2078  /* Fill in missing characters */
2079  for (n = 0; n < 256; n++) {
2080  if (ap->values[n] < 0) {
2081  ap->values[n] = tableval++;
2082  }
2083  }
2084  }
2085 
2086  /* Reset HIGH/LOW-VALUES */
2087  cb_low = cb_norm_low;
2088  cb_high = cb_norm_high;
2089 
2090  /* Check and generate SYMBOLIC clauses */
2091  for (l = current_program->symbolic_char_list; l; l = CB_CHAIN (l)) {
2092  if (CB_VALUE (l)) {
2093  y = cb_ref (CB_VALUE (l));
2094  if (y == cb_error_node) {
2095  continue;
2096  }
2097  if (!CB_ALPHABET_NAME_P (y)) {
2098  cb_error_x (y, _("Invalid ALPHABET name"));
2099  continue;
2100  }
2101  } else {
2102  y = NULL;
2103  }
2104  cb_build_symbolic_chars (CB_PURPOSE (l), y);
2105  }
2106 
2107  /* Check CLASS clauses */
2108  for (l = current_program->class_name_list; l; l = CB_CHAIN (l)) {
2109  dupls = 0;
2110  memset (values, 0, sizeof(values));
2111  cp = CB_CLASS_NAME (CB_VALUE (l));
2112  for (y = cp->list; y; y = CB_CHAIN (y)) {
2113  x = CB_VALUE (y);
2114  if (CB_PAIR_P (x)) {
2115  /* X THRU Y */
2116  lower = get_value (CB_PAIR_X (x));
2117  upper = get_value (CB_PAIR_Y (x));
2118  for (i = lower; i <= upper; i++) {
2119  if (values[i]) {
2120  dupls = 1;
2121  }
2122  values[i] = 1;
2123  }
2124  } else {
2125  if (CB_NUMERIC_LITERAL_P (x)) {
2126  n = get_value (x);
2127  if (values[n]) {
2128  dupls = 1;
2129  }
2130  values[n] = 1;
2131  } else if (CB_LITERAL_P (x)) {
2132  size = (int)CB_LITERAL (x)->size;
2133  data = CB_LITERAL (x)->data;
2134  for (i = 0; i < size; i++) {
2135  n = data[i];
2136  if (values[n]) {
2137  dupls = 1;
2138  }
2139  values[n] = 1;
2140  }
2141  } else {
2142  n = get_value (x);
2143  if (values[n]) {
2144  dupls = 1;
2145  }
2146  values[n] = 1;
2147  }
2148  }
2149  }
2150  if (dupls) {
2151  if (!cb_relaxed_syntax_check) {
2152  cb_error_x (CB_VALUE(l),
2153  _("Duplicate values in class '%s'"),
2154  cb_name (CB_VALUE(l)));
2155  } else {
2156  cb_warning_x (CB_VALUE(l),
2157  _("Duplicate values in class '%s'"),
2158  cb_name (CB_VALUE(l)));
2159  }
2160  }
2161  }
2162 
2163  /* Resolve the program collating sequence */
2164  if (prog->collating_sequence) {
2165  cb_validate_collating (prog);
2166  }
2167 
2168  /* Resolve the program classification */
2169  if (prog->classification && prog->classification != cb_int1) {
2170  x = cb_ref (prog->classification);
2171  if (!CB_LOCALE_NAME_P (x)) {
2172  cb_error_x (prog->classification,
2173  _("'%s' is not a locale name"),
2174  cb_name (prog->classification));
2175  prog->classification = NULL;
2176  return;
2177  }
2178  }
2179 }
void cb_warning_x ( cb_tree  ,
const char *  ,
  ... 
)

References _, print_error(), cb_tree_common::source_file, cb_tree_common::source_line, and warningcount.

Referenced by cb_build_address(), cb_build_display_name(), cb_build_field_tree(), cb_build_identifier(), cb_check_overlapping(), cb_emit_accept_name(), cb_emit_call(), cb_emit_corresponding(), cb_emit_move_corresponding(), cb_validate_program_body(), cb_validate_program_environment(), check_picture_item(), compute_size(), move_warning(), redefinition_warning(), terminator_warning(), undefined_error(), valid_const_date_time_args(), validate_field_1(), validate_move(), and warning_destination().

174 {
175  va_list ap;
176 
177  va_start (ap, fmt);
178  print_error (x->source_file, x->source_line, _("Warning: "), fmt, ap);
179  va_end (ap);
180  warningcount++;
181 }
struct cb_field* check_level_78 ( const char *  )
read

References cb_level_78::fld78, cb_field::name, cb_level_78::next, and NULL.

4638 {
4639  const struct cb_level_78 *p78;
4640 
4641  /* Check against a current constant (78 level) */
4642  for (p78 = lev78ptr; p78; p78 = p78->next) {
4643  if (strcasecmp (name, p78->fld78->name) == 0) {
4644  return p78->fld78;
4645  }
4646  }
4647  /* Check against a global constant (78 level) */
4648  for (p78 = globlev78ptr; p78; p78 = p78->next) {
4649  if (strcasecmp (name, p78->fld78->name) == 0) {
4650  return p78->fld78;
4651  }
4652  }
4653  return NULL;
4654 }
DECLNORET void cobc_tree_cast_error ( const cb_tree  ,
const char *  ,
const int  ,
const enum  cb_tag 
)

References _, cb_name(), CB_TREE_TAG, cobc_abort_pr(), cobc_abort_terminate(), and cobc_enum_explain().

621 {
622  cobc_abort_pr (_("%s:%d Invalid cast from '%s' type %s to type %s"),
623  filename, linenum,
624  x ? cb_name (x) : "NULL",
625  x ? cobc_enum_explain (CB_TREE_TAG(x)) : "None",
626  cobc_enum_explain (tagnum));
627  cobc_abort_terminate ();
628 }
void codegen ( struct cb_program *  ,
const int   
)

References _, cb_program::alphabet_name_list, attr_list_reverse(), base_cache_cmp(), call_list::callname, CB_CHAIN, CB_CLASS_NAME, CB_CLASS_NUMERIC, CB_FUNCTION_TYPE, cb_list_add(), CB_LITERAL, cb_local_file, CB_NEED_HIGH, CB_NEED_LOW, CB_NEED_QUOTE, CB_NEED_SPACE, CB_NEED_ZERO, CB_PREFIX_ATTR, CB_PREFIX_BASE, CB_PREFIX_CONST, CB_PREFIX_FIELD, CB_PREFIX_STRING, CB_PROGRAM_TYPE, cb_source_file, cb_storage_file, cb_storage_file_name, CB_TREE_CLASS, CB_VALUE, CB_XSTRINGIFY, cb_program::class_name_list, COB_ALIGN, cob_gen_optim(), COB_INSIDE_SIZE, COB_KEYWORD_INLINE, COB_MAX_SUBSCRIPTS, COB_MINI_BUFF, COB_MINI_MAX, COB_OPTIM_MAX, COB_OPTIM_MIN, COB_TYPE_ALPHANUMERIC, COB_TYPE_ALPHANUMERIC_ALL, cob_u32_t, cobc_flag_main, cobc_main_malloc(), codegen(), field_list::curr_prog, base_list::curr_prog, cb_literal::data, attr_list::digits, cb_program::entry_list, excp_current_paragraph, excp_current_program_id, excp_current_section, field_list::f, base_list::f, field_cache_cmp(), cb_program::flag_chained, cb_program::flag_debugging, cb_field::flag_filler, cb_program::flag_global_use, cb_field::flag_local, cb_program::flag_main, cb_program::flag_recursive, attr_list::flags, found, gen_alt_ebcdic, gen_custom, gen_dynamic, gen_ebcdic_ascii, gen_figurative, gen_full_ebcdic, gen_if_level, gen_native, gen_nested_tab, i_counters, string_list::id, attr_list::id, literal_list::id, cb_field::id, inside_check, inside_stack, last_line, last_segment, list_cache_sort(), literal_list_reverse(), cb_literal::llit, local_filename::local_fp, cb_program::local_include, local_mem, cb_program::local_storage, local_working_mem, lookup_attr(), loop_counter, cb_program::max_call_param, cb_field::memory_size, cb_field::name, need_save_exception, needs_exit_prog, needs_unifunc, cb_program::nested_level, nested_list::nested_prog, cb_program::nested_prog_list, string_list::next, attr_list::next, literal_list::next, field_list::next, call_list::next, base_list::next, nested_list::next, cb_program::next_program, non_nested_count, NULL, num_cob_fields, optimize_defs, cb_program::orig_program_id, output(), output_attr(), output_class_name_definition(), output_entry_function(), output_field(), output_header(), output_indent_level, output_internal_function(), output_local(), output_main_function(), output_newline(), output_size(), output_storage(), output_string(), output_target, PACKAGE_VERSION, param_id, cb_program::parameter_list, PATCH_LEVEL, attr_list::pic, cb_program::prog_type, progid, cb_program::program_id, attr_list::scale, cb_literal::sign, cb_literal::size, cb_field::special_index, stack_id, string_buffer, string_id, string_list_reverse(), string_list::text, cb_program::toplev_count, attr_list::type, working_mem, literal_list::x, field_list::x, and yyout.

Referenced by codegen(), and process_translate().

7340 {
7341  cb_tree l;
7342  struct attr_list *j;
7343  struct literal_list *m;
7344  struct field_list *k;
7345  struct string_list *stp;
7346  struct call_list *clp;
7347  struct base_list *blp;
7348  unsigned char *s;
7349  struct nested_list *nlp;
7350  struct cb_program *cp;
7351 #if 0 /* RXWRXW - Const */
7352  struct cb_literal *lp;
7353 #endif
7354  cb_tree l1;
7355  cb_tree l2;
7356  const char *prevprog;
7357  struct tm *loctime;
7358  cob_u32_t inc;
7359 #if 0 /* RXWRXW - Sticky */
7360  int save_sticky;
7361 #endif
7362  int i;
7363  int found;
7364  enum cb_optim optidx;
7365  time_t sectime;
7366 
7367  /* Clear local program stuff */
7368  current_prog = prog;
7369  param_id = 0;
7370  stack_id = 0;
7371  num_cob_fields = 0;
7372  progid = 0;
7373  loop_counter = 0;
7374  output_indent_level = 0;
7375  last_line = 0;
7376  needs_exit_prog = 0;
7377  gen_custom = 0;
7378  gen_nested_tab = 0;
7379  gen_dynamic = 0;
7380  gen_if_level = 0;
7381  local_mem = 0;
7382  local_working_mem = 0;
7383  need_save_exception = 0;
7384  last_segment = 0;
7385  last_section = NULL;
7386  call_cache = NULL;
7387  func_call_cache = NULL;
7388  label_cache = NULL;
7389  local_base_cache = NULL;
7390  local_field_cache = NULL;
7391  inside_check = 0;
7392  for (i = 0; i < COB_INSIDE_SIZE; ++i) {
7393  inside_stack[i] = 0;
7394  }
7395  excp_current_program_id = prog->orig_program_id;
7396  excp_current_section = NULL;
7397  excp_current_paragraph = NULL;
7398  memset ((void *)i_counters, 0, sizeof (i_counters));
7399 #if 0 /* RXWRXW - Sticky */
7400  save_sticky = cb_sticky_linkage;
7401 #endif
7402 
7403  output_target = yyout;
7404  cb_local_file = current_prog->local_include->local_fp;
7405 
7406  if (!nested) {
7407  /* First iteration */
7408  gen_alt_ebcdic = 0;
7409  gen_ebcdic_ascii = 0;
7410  gen_full_ebcdic = 0;
7411  gen_native = 0;
7412  gen_figurative = 0;
7413  non_nested_count = 0;
7414  working_mem = 0;
7415  attr_cache = NULL;
7416  base_cache = NULL;
7417  globext_cache = NULL;
7418  literal_cache = NULL;
7419  field_cache = NULL;
7420  string_cache = NULL;
7421  string_id = 1;
7422  if (!string_buffer) {
7423  string_buffer = cobc_main_malloc ((size_t)COB_MINI_BUFF);
7424  }
7425 
7426  sectime = time (NULL);
7427  loctime = localtime (&sectime);
7428  /* Leap seconds ? */
7429  if (loctime->tm_sec >= 60) {
7430  loctime->tm_sec = 59;
7431  }
7432  if (loctime) {
7433  strftime (string_buffer, (size_t)COB_MINI_MAX,
7434  "%b %d %Y %H:%M:%S", loctime);
7435  } else {
7436  strcpy (string_buffer, _("Unknown"));
7437  }
7438  output_header (output_target, string_buffer, NULL);
7439  output_header (cb_storage_file, string_buffer, NULL);
7440  for (cp = prog; cp; cp = cp->next_program) {
7441  output_header (cp->local_include->local_fp,
7442  string_buffer, cp);
7443  }
7444 
7445 #ifndef _GNU_SOURCE
7446 #ifdef _XOPEN_SOURCE_EXTENDED
7447  output ("#ifndef\t_XOPEN_SOURCE_EXTENDED\n");
7448  output ("#define\t_XOPEN_SOURCE_EXTENDED 1\n");
7449  output ("#endif\n");
7450 #endif
7451 #endif
7452  output ("#include <stdio.h>\n");
7453  output ("#include <stdlib.h>\n");
7454  output ("#include <stddef.h>\n");
7455  output ("#include <string.h>\n");
7456  output ("#include <math.h>\n");
7457 #ifdef WORDS_BIGENDIAN
7458  output ("#define WORDS_BIGENDIAN 1\n");
7459 #endif
7460 #ifdef COB_KEYWORD_INLINE
7461  output ("#define COB_KEYWORD_INLINE %s\n",
7462  CB_XSTRINGIFY(COB_KEYWORD_INLINE));
7463 #endif
7464  output ("#include <libcob.h>\n\n");
7465 
7466  output ("#define COB_SOURCE_FILE\t\t\"%s\"\n",
7467  cb_source_file);
7468  output ("#define COB_PACKAGE_VERSION\t\t\"%s\"\n",
7469  PACKAGE_VERSION);
7470  output ("#define COB_PATCH_LEVEL\t\t%d\n",
7471  PATCH_LEVEL);
7472  /* string_buffer has formatted date from above */
7473  output ("#define COB_MODULE_FORMATTED_DATE\t\"%s\"\n",
7474  string_buffer);
7475  if (loctime) {
7476  i = ((loctime->tm_year + 1900) * 10000) +
7477  ((loctime->tm_mon + 1) * 100) +
7478  loctime->tm_mday;
7479  output ("#define COB_MODULE_DATE\t\t%d\n", i);
7480  i = (loctime->tm_hour * 10000) +
7481  (loctime->tm_min * 100) +
7482  loctime->tm_sec;
7483  output ("#define COB_MODULE_TIME\t\t%d\n", i);
7484  } else {
7485  output ("#define COB_MODULE_DATE\t\t0\n");
7486  output ("#define COB_MODULE_TIME\t\t0\n");
7487  }
7488 
7489  output_newline ();
7490  output ("/* Global variables */\n");
7491  output ("#include \"%s\"\n\n", cb_storage_file_name);
7492 
7493  output ("/* Function prototypes */\n\n");
7494  for (cp = prog; cp; cp = cp->next_program) {
7495  /* Build parameter list */
7496  for (l = cp->entry_list; l; l = CB_CHAIN (l)) {
7497  for (l1 = CB_VALUE (l); l1; l1 = CB_CHAIN (l1)) {
7498  for (l2 = cp->parameter_list; l2; l2 = CB_CHAIN (l2)) {
7499  if (strcasecmp (cb_code_field (CB_VALUE (l1))->name,
7500  cb_code_field (CB_VALUE (l2))->name) == 0) {
7501  break;
7502  }
7503  }
7504  if (l2 == NULL) {
7505  cp->parameter_list = cb_list_add (cp->parameter_list, CB_VALUE (l1));
7506  }
7507  }
7508  }
7509  if (cp->flag_main) {
7510  if (!cp->flag_recursive) {
7511  output ("static int\t\t%s ();\n",
7512  cp->program_id);
7513  } else {
7514  output ("int\t\t\t%s ();\n",
7515  cp->program_id);
7516  }
7517  } else {
7518  for (l = cp->entry_list; l; l = CB_CHAIN (l)) {
7519  output_entry_function (cp, l, cp->parameter_list, 0);
7520  }
7521  }
7522  if (cp->prog_type == CB_FUNCTION_TYPE) {
7523  non_nested_count++;
7524 #if 0 /* RXWRXW USERFUNC */
7525  output ("static cob_field\t*%s_ (const int, cob_field **",
7526 #else
7527  output ("static cob_field\t*%s_ (const int",
7528 #endif
7529  cp->program_id);
7530  } else if (!cp->nested_level) {
7531  non_nested_count++;
7532  output ("static int\t\t%s_ (const int",
7533  cp->program_id);
7534  } else {
7535  output ("static int\t\t%s_%d_ (const int",
7536  cp->program_id, cp->toplev_count);
7537  }
7538 #if 0 /* RXWRXW USERFUNC */
7539  if (!cp->flag_chained && cp->prog_type != CB_FUNCTION_TYPE) {
7540 #else
7541  if (!cp->flag_chained) {
7542 #endif
7543  for (l = cp->parameter_list; l; l = CB_CHAIN (l)) {
7544  output (", cob_u8_t *");
7545  if (cb_sticky_linkage) {
7546  output_storage ("static cob_u8_t\t\t\t*cob_parm_%d = NULL;\n",
7547  cb_code_field (CB_VALUE (l))->id);
7548  }
7549  }
7550  }
7551 #if 0 /* RXWRXW - NOINLINE */
7552  if (cb_flag_stack_check) {
7553  output (") COB_NOINLINE;\n");
7554  } else {
7555 #endif
7556  output (");\n");
7557 #if 0 /* RXWRXW - NOINLINE */
7558  }
7559 #endif
7560  }
7561  output ("\n");
7562  }
7563 
7564  /* Class-names */
7565  if (!prog->nested_level && prog->class_name_list) {
7566  output ("/* Class names */\n");
7567  for (l = prog->class_name_list; l; l = CB_CHAIN (l)) {
7568  output_class_name_definition (CB_CLASS_NAME (CB_VALUE (l)));
7569  }
7570  }
7571 
7572  /* Main function */
7573  if (prog->flag_main) {
7574  output_main_function (prog);
7575  }
7576 
7577  /* Functions */
7578  if (!nested) {
7579  output ("/* Functions */\n\n");
7580  }
7581 
7582  if (prog->prog_type == CB_FUNCTION_TYPE) {
7583  output ("/* FUNCTION-ID '%s' */\n\n", prog->orig_program_id);
7584  } else {
7585  output ("/* PROGRAM-ID '%s' */\n\n", prog->orig_program_id);
7586  }
7587 
7588  for (l = prog->entry_list; l; l = CB_CHAIN (l)) {
7589  output_entry_function (prog, l, prog->parameter_list, 1);
7590  }
7591 
7592  output_internal_function (prog, prog->parameter_list);
7593 
7594  if (!prog->next_program) {
7595  output ("/* End functions */\n\n");
7596  }
7597 
7598  if (gen_native || gen_full_ebcdic ||
7599  gen_ebcdic_ascii || prog->alphabet_name_list) {
7600  (void)lookup_attr (COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL, 0);
7601  }
7602 
7603  output_target = cb_storage_file;
7604 
7605  /* Program local stuff */
7606 
7607  /* CALL cache */
7608  if (needs_unifunc || call_cache || func_call_cache) {
7609  output_local ("\n/* Call pointers */\n");
7610  }
7611  if (needs_unifunc) {
7612  output_local ("cob_call_union\t\tcob_unifunc;\n");
7613  }
7614  for (clp = call_cache; clp; clp = clp->next) {
7615  output_local ("static cob_call_union\tcall_%s;\n",
7616  clp->callname);
7617  }
7618  for (clp = func_call_cache; clp; clp = clp->next) {
7619  output_local ("static cob_call_union\tfunc_%s;\n",
7620  clp->callname);
7621  }
7622  needs_unifunc = 0;
7623 
7624  /* Nested / contained list */
7625  if (prog->nested_prog_list && gen_nested_tab) {
7626  /* Generate contained program list */
7627  output_local ("\n/* Nested call table */\n");
7628  output_local ("static struct cob_call_struct\tcob_nest_tab[] = {\n");
7629  nlp = prog->nested_prog_list;
7630  for (; nlp; nlp = nlp->next) {
7631  if (nlp->nested_prog == prog) {
7632 #if 0 /* RXWRXW Fix recursive */
7633  if (!prog->flag_recursive) {
7634  continue;
7635  }
7636 #endif
7637  output_local ("\t{ \"%s\", { (void *(*)())%s_%d__ }, { NULL } },\n",
7638  nlp->nested_prog->orig_program_id,
7639  nlp->nested_prog->program_id,
7640  nlp->nested_prog->toplev_count);
7641  } else {
7642  output_local ("\t{ \"%s\", { (void *(*)())%s_%d__ }, { (void *(*)())%s_%d_ } },\n",
7643  nlp->nested_prog->orig_program_id,
7644  nlp->nested_prog->program_id,
7645  nlp->nested_prog->toplev_count,
7646  nlp->nested_prog->program_id,
7647  nlp->nested_prog->toplev_count);
7648  }
7649  }
7650  output_local ("\t{ NULL, { NULL }, { NULL } }\n");
7651  output_local ("};\n");
7652  }
7653 
7654  /* Local indexes */
7655  found = 0;
7656  for (i = 0; i < COB_MAX_SUBSCRIPTS; i++) {
7657  if (i_counters[i]) {
7658  if (!found) {
7659  found = 1;
7660  output_local ("\n/* Subscripts */\n");
7661  }
7662  output_local ("int\t\ti%d;\n", i);
7663  }
7664  }
7665 
7666  /* PERFORM TIMES counters */
7667  if (loop_counter) {
7668  output_local ("\n/* Loop counters */\n");
7669  for (i = 0; i < loop_counter; i++) {
7670  output_local ("cob_s64_t\tn%d = 0;\n", i);
7671  }
7672  output_local ("\n");
7673  }
7674 
7675  /* Local implicit fields */
7676  if (num_cob_fields) {
7677  output_local ("\n/* Local cob_field items */\n");
7678  for (i = 0; i < num_cob_fields; i++) {
7679  output_local ("cob_field\t\tf%d;\n", i);
7680  }
7681  output_local ("\n");
7682  }
7683 
7684  /* Debugging fields */
7685  if (prog->flag_debugging) {
7686  output_local ("\n/* DEBUG runtime switch */\n");
7687  output_local ("static int\tcob_debugging_mode = 0;\n");
7688  }
7689  if (need_save_exception) {
7690  output_local ("\n/* DEBUG exception code save */\n");
7691  output_local ("int\t\tsave_exception_code = 0;\n");
7692  }
7693 
7694  /* LOCAL storage pointer */
7695  if (prog->local_storage && local_mem) {
7696  output_local ("\n/* LOCAL storage pointer */\n");
7697  output_local ("unsigned char\t\t*cob_local_ptr = NULL;\n");
7698  if (current_prog->flag_global_use) {
7699  output_local ("static unsigned char\t*cob_local_save = NULL;\n");
7700  }
7701  }
7702 
7703  /* Call parameter stack */
7704  output_local ("\n/* Call parameters */\n");
7705  if (cb_flag_stack_on_heap || prog->flag_recursive) {
7706  output_local ("cob_field\t\t**cob_procedure_params;\n");
7707  } else {
7708  if (prog->max_call_param) {
7709  i = prog->max_call_param;
7710  } else {
7711  i = 1;
7712  }
7713  output_local ("cob_field\t\t*cob_procedure_params[%d];\n", i);
7714  }
7715 
7716  /* Frame stack */
7717  output_local ("\n/* Perform frame stack */\n");
7718  if (cb_perform_osvs && current_prog->prog_type == CB_PROGRAM_TYPE) {
7719  output_local ("struct cob_frame\t*temp_index;\n");
7720  }
7721  if (cb_flag_stack_check) {
7722  output_local ("struct cob_frame\t*frame_overflow;\n");
7723  }
7724  output_local ("struct cob_frame\t*frame_ptr;\n");
7725  if (cb_flag_stack_on_heap || prog->flag_recursive) {
7726  output_local ("struct cob_frame\t*frame_stack;\n\n");
7727  } else {
7728  output_local ("struct cob_frame\tframe_stack[%d];\n\n",
7729  cb_stack_size);
7730  }
7731 
7732  if (gen_dynamic) {
7733  output_local ("\n/* Dynamic field FUNCTION-ID pointers */\n");
7734  for (inc = 0; inc < gen_dynamic; inc++) {
7735  output_local ("cob_field\t*cob_dyn_%u = NULL;\n",
7736  inc);
7737  }
7738  }
7739 
7740  if (local_base_cache) {
7741  output_local ("\n/* Data storage */\n");
7742  local_base_cache = list_cache_sort (local_base_cache,
7743  &base_cache_cmp);
7744  for (blp = local_base_cache; blp; blp = blp->next) {
7745  if (blp->f->special_index > 1) {
7746  output_local ("int %s%d;",
7747  CB_PREFIX_BASE, blp->f->id);
7748  } else if (blp->f->special_index) {
7749  output_local ("static int %s%d;",
7750  CB_PREFIX_BASE, blp->f->id);
7751  } else {
7752  output_local ("static cob_u8_t %s%d[%d]%s;",
7753  CB_PREFIX_BASE, blp->f->id,
7754  blp->f->memory_size, COB_ALIGN);
7755  }
7756  output_local ("\t/* %s */\n", blp->f->name);
7757  }
7758  output_local ("\n/* End of data storage */\n\n");
7759  }
7760 
7761  if (local_field_cache) {
7762  /* Switch to local storage file */
7763  output_target = current_prog->local_include->local_fp;
7764  output_local ("\n/* Fields */\n");
7765  local_field_cache = list_cache_sort (local_field_cache,
7766  &field_cache_cmp);
7767  for (k = local_field_cache; k; k = k->next) {
7768  output ("static cob_field %s%d\t= ", CB_PREFIX_FIELD,
7769  k->f->id);
7770  if (!k->f->flag_local) {
7771  output_field (k->x);
7772  } else {
7773  output ("{");
7774  output_size (k->x);
7775  output (", NULL, ");
7776  output_attr (k->x);
7777  output ("}");
7778  }
7779  if (k->f->flag_filler) {
7780  output (";\t/* Implicit FILLER */\n");
7781  } else {
7782  output (";\t/* %s */\n", k->f->name);
7783  }
7784  }
7785  output_local ("\n/* End of fields */\n\n");
7786  /* Switch to main storage file */
7787  output_target = cb_storage_file;
7788  }
7789 
7790  /* Skip to next nested program */
7791 
7792  if (prog->next_program) {
7793  codegen (prog->next_program, 1);
7794  return;
7795  }
7796 
7797  /* Finalize the main include file */
7798 
7799 #if 0 /* RXWRXW - GLOBPTR */
7800  output_storage ("\n/* Global variable pointer */\n");
7801  output_storage ("static cob_global\t\t*cob_glob_ptr = NULL;\n");
7802 #endif
7803 
7804  if (!cobc_flag_main && non_nested_count > 1) {
7805  output_storage ("\n/* Module reference count */\n");
7806  output_storage ("static unsigned int\t\tcob_reference_count = 0;\n");
7807  }
7808 
7809  output_storage ("\n/* Module path */\n");
7810  output_storage ("static const char\t\t*cob_module_path = NULL;\n");
7811 
7812  if (globext_cache) {
7813  output_storage ("\n/* GLOBAL EXTERNAL pointers */\n");
7814  globext_cache = list_cache_sort (globext_cache, &base_cache_cmp);
7815  for (blp = globext_cache; blp; blp = blp->next) {
7816  output_storage ("static unsigned char\t\t*%s%d = NULL;",
7817  CB_PREFIX_BASE, blp->f->id);
7818  output_storage ("\t/* %s */\n", blp->f->name);
7819  }
7820  }
7821 
7822  if (base_cache) {
7823  output_storage ("\n/* Data storage */\n");
7824  base_cache = list_cache_sort (base_cache, &base_cache_cmp);
7825  prevprog = NULL;
7826  for (blp = base_cache; blp; blp = blp->next) {
7827  if (blp->curr_prog != prevprog) {
7828  prevprog = blp->curr_prog;
7829  output_storage ("\n/* PROGRAM-ID : %s */\n",
7830  prevprog);
7831  }
7832  if (blp->f->special_index) {
7833  output_storage ("static int %s%d;",
7834  CB_PREFIX_BASE, blp->f->id);
7835  } else {
7836  output_storage ("static cob_u8_t %s%d[%d]%s;",
7837  CB_PREFIX_BASE, blp->f->id,
7838  blp->f->memory_size, COB_ALIGN);
7839  }
7840  output_storage ("\t/* %s */\n", blp->f->name);
7841  }
7842  output_storage ("\n/* End of data storage */\n\n");
7843  }
7844 
7845  /* Attributes */
7846  if (attr_cache || gen_figurative) {
7847  output_storage ("\n/* Attributes */\n\n");
7848  attr_cache = attr_list_reverse (attr_cache);
7849  for (j = attr_cache; j; j = j->next) {
7850  output_storage ("static const cob_field_attr %s%d =\t",
7851  CB_PREFIX_ATTR, j->id);
7852  output_storage ("{0x%02x, %3u, %3d, 0x%04x, ",
7853  j->type, j->digits,
7854  j->scale, j->flags);
7855  if (j->pic) {
7856  output_storage ("\"");
7857  for (s = j->pic; *s; s += 5) {
7858  output_storage ("%c\\%03o\\%03o\\%03o\\%03o",
7859  s[0], s[1], s[2], s[3], s[4]);
7860  }
7861  output_storage ("\"");
7862  } else {
7863  output_storage ("NULL");
7864  }
7865  output_storage ("};\n");
7866  }
7867  if (gen_figurative) {
7868  output_storage ("\nstatic const cob_field_attr cob_all_attr = ");
7869  output_storage ("{0x%02x, 0, 0, 0, NULL};\n",
7870  COB_TYPE_ALPHANUMERIC_ALL);
7871  }
7872  output_storage ("\n");
7873  }
7874 
7875  if (field_cache) {
7876  output_storage ("\n/* Fields */\n");
7877  field_cache = list_cache_sort (field_cache, &field_cache_cmp);
7878  prevprog = NULL;
7879  for (k = field_cache; k; k = k->next) {
7880  if (k->curr_prog != prevprog) {
7881  prevprog = k->curr_prog;
7882  output_storage ("\n/* PROGRAM-ID : %s */\n",
7883  prevprog);
7884  }
7885  output ("static cob_field %s%d\t= ", CB_PREFIX_FIELD,
7886  k->f->id);
7887  if (!k->f->flag_local) {
7888  output_field (k->x);
7889  } else {
7890  output ("{");
7891  output_size (k->x);
7892  output (", NULL, ");
7893  output_attr (k->x);
7894  output ("}");
7895  }
7896  if (k->f->flag_filler) {
7897  output (";\t/* Implicit FILLER */\n");
7898  } else {
7899  output (";\t/* %s */\n", k->f->name);
7900  }
7901  }
7902  output_storage ("\n/* End of fields */\n\n");
7903  }
7904 
7905  /* Literals, figuratives, constants */
7906  if (literal_cache || gen_figurative) {
7907  output_storage ("\n/* Constants */\n");
7908  literal_cache = literal_list_reverse (literal_cache);
7909  for (m = literal_cache; m; m = m->next) {
7910 #if 0 /* RXWRXW - Const */
7911  output ("static const cob_fld_union %s%d\t= ",
7912  CB_PREFIX_CONST, m->id);
7913  output ("{");
7914  output_size (m->x);
7915  output (", ");
7916  lp = CB_LITERAL (m->x);
7917  if (CB_TREE_CLASS (m->x) == CB_CLASS_NUMERIC) {
7918  output ("\"%s%s\"", (char *)lp->data,
7919  (lp->sign < 0) ? "-" : (lp->sign > 0) ? "+" : "");
7920  } else {
7921  output_string (lp->data, (int) lp->size, lp->llit);
7922  }
7923  output (", ");
7924  output_attr (m->x);
7925  output ("}");
7926 #else
7927  output ("static const cob_field %s%d\t= ",
7928  CB_PREFIX_CONST, m->id);
7929  output_field (m->x);
7930 #endif
7931  output (";\n");
7932  }
7933  if (gen_figurative) {
7934  output ("\n");
7935  if (gen_figurative & CB_NEED_LOW) {
7936  output ("static cob_field cob_all_low\t= ");
7937  output ("{1, ");
7938  output ("(cob_u8_ptr)\"\\0\", ");
7939  output ("&cob_all_attr};\n");
7940  }
7941  if (gen_figurative & CB_NEED_HIGH) {
7942  output ("static cob_field cob_all_high\t= ");
7943  output ("{1, ");
7944  output ("(cob_u8_ptr)\"\\xff\", ");
7945  output ("&cob_all_attr};\n");
7946  }
7947  if (gen_figurative & CB_NEED_QUOTE) {
7948  output ("static cob_field cob_all_quote\t= ");
7949  output ("{1, ");
7950  if (cb_flag_apostrophe) {
7951  output ("(cob_u8_ptr)\"'\", ");
7952  } else {
7953  output ("(cob_u8_ptr)\"\\\"\", ");
7954  }
7955  output ("&cob_all_attr};\n");
7956  }
7957  if (gen_figurative & CB_NEED_SPACE) {
7958  output ("static cob_field cob_all_space\t= ");
7959  output ("{1, ");
7960  output ("(cob_u8_ptr)\" \", ");
7961  output ("&cob_all_attr};\n");
7962  }
7963  if (gen_figurative & CB_NEED_ZERO) {
7964  output ("static cob_field cob_all_zero\t= ");
7965  output ("{1, ");
7966  output ("(cob_u8_ptr)\"0\", ");
7967  output ("&cob_all_attr};\n");
7968  }
7969  }
7970  output ("\n");
7971  }
7972 
7973  /* Collating tables */
7974  if (gen_alt_ebcdic) {
7975  output_storage ("\n/* ASCII to EBCDIC translate table (restricted) */\n");
7976  output ("static const unsigned char\tcob_a2e[256] = {\n");
7977  /* Restricted table */
7978  output ("\t0x00, 0x01, 0x02, 0x03, 0x1D, 0x19, 0x1A, 0x1B,\n");
7979  output ("\t0x0F, 0x04, 0x16, 0x06, 0x07, 0x08, 0x09, 0x0A,\n");
7980  output ("\t0x0B, 0x0C, 0x0D, 0x0E, 0x1E, 0x1F, 0x1C, 0x17,\n");
7981  output ("\t0x10, 0x11, 0x20, 0x18, 0x12, 0x13, 0x14, 0x15,\n");
7982  output ("\t0x21, 0x27, 0x3A, 0x36, 0x28, 0x30, 0x26, 0x38,\n");
7983  output ("\t0x24, 0x2A, 0x29, 0x25, 0x2F, 0x2C, 0x22, 0x2D,\n");
7984  output ("\t0x73, 0x74, 0x75, 0x76, 0x77, 0x78, 0x79, 0x7A,\n");
7985  output ("\t0x7B, 0x7C, 0x35, 0x2B, 0x23, 0x39, 0x32, 0x33,\n");
7986  output ("\t0x37, 0x57, 0x58, 0x59, 0x5A, 0x5B, 0x5C, 0x5D,\n");
7987  output ("\t0x5E, 0x5F, 0x61, 0x62, 0x63, 0x64, 0x65, 0x66,\n");
7988  output ("\t0x67, 0x68, 0x69, 0x6B, 0x6C, 0x6D, 0x6E, 0x6F,\n");
7989  output ("\t0x70, 0x71, 0x72, 0x7D, 0x6A, 0x7E, 0x7F, 0x31,\n");
7990  output ("\t0x34, 0x3B, 0x3C, 0x3D, 0x3E, 0x3F, 0x40, 0x41,\n");
7991  output ("\t0x42, 0x43, 0x44, 0x45, 0x46, 0x47, 0x48, 0x49,\n");
7992  output ("\t0x4A, 0x4B, 0x4C, 0x4E, 0x4F, 0x50, 0x51, 0x52,\n");
7993  output ("\t0x53, 0x54, 0x55, 0x56, 0x2E, 0x60, 0x4D, 0x05,\n");
7994  output ("\t0x80, 0x81, 0x82, 0x83, 0x84, 0x85, 0x86, 0x87,\n");
7995  output ("\t0x88, 0x89, 0x8A, 0x8B, 0x8C, 0x8D, 0x8E, 0x8F,\n");
7996  output ("\t0x90, 0x91, 0x92, 0x93, 0x94, 0x95, 0x96, 0x97,\n");
7997  output ("\t0x98, 0x99, 0x9A, 0x9B, 0x9C, 0x9D, 0x9E, 0x9F,\n");
7998  output ("\t0xA0, 0xA1, 0xA2, 0xA3, 0xA4, 0xA5, 0xA6, 0xA7,\n");
7999  output ("\t0xA8, 0xA9, 0xAA, 0xAB, 0xAC, 0xAD, 0xAE, 0xAF,\n");
8000  output ("\t0xB0, 0xB1, 0xB2, 0xB3, 0xB4, 0xB5, 0xB6, 0xB7,\n");
8001  output ("\t0xB8, 0xB9, 0xBA, 0xBB, 0xBC, 0xBD, 0xBE, 0xBF,\n");
8002  output ("\t0xC0, 0xC1, 0xC2, 0xC3, 0xC4, 0xC5, 0xC6, 0xC7,\n");
8003  output ("\t0xC8, 0xC9, 0xCA, 0xCB, 0xCC, 0xCD, 0xCE, 0xCF,\n");
8004  output ("\t0xD0, 0xD1, 0xD2, 0xD3, 0xD4, 0xD5, 0xD6, 0xD7,\n");
8005  output ("\t0xD8, 0xD9, 0xDA, 0xDB, 0xDC, 0xDD, 0xDE, 0xDF,\n");
8006  output ("\t0xE0, 0xE1, 0xE2, 0xE3, 0xE4, 0xE5, 0xE6, 0xE7,\n");
8007  output ("\t0xE8, 0xE9, 0xEA, 0xEB, 0xEC, 0xED, 0xEE, 0xEF,\n");
8008  output ("\t0xF0, 0xF1, 0xF2, 0xF3, 0xF4, 0xF5, 0xF6, 0xF7,\n");
8009  output ("\t0xF8, 0xF9, 0xFA, 0xFB, 0xFC, 0xFD, 0xFE, 0xFF\n");
8010  output ("};\n");
8011  output_storage ("\n");
8012  }
8013  if (gen_full_ebcdic) {
8014  output_storage ("\n/* ASCII to EBCDIC table */\n");
8015  output ("static const unsigned char\tcob_ascii_ebcdic[256] = {\n");
8016  output ("\t0x00, 0x01, 0x02, 0x03, 0x37, 0x2D, 0x2E, 0x2F,\n");
8017  output ("\t0x16, 0x05, 0x25, 0x0B, 0x0C, 0x0D, 0x0E, 0x0F,\n");
8018  output ("\t0x10, 0x11, 0x12, 0x13, 0x3C, 0x3D, 0x32, 0x26,\n");
8019  output ("\t0x18, 0x19, 0x3F, 0x27, 0x1C, 0x1D, 0x1E, 0x1F,\n");
8020  output ("\t0x40, 0x5A, 0x7F, 0x7B, 0x5B, 0x6C, 0x50, 0x7D,\n");
8021  output ("\t0x4D, 0x5D, 0x5C, 0x4E, 0x6B, 0x60, 0x4B, 0x61,\n");
8022  output ("\t0xF0, 0xF1, 0xF2, 0xF3, 0xF4, 0xF5, 0xF6, 0xF7,\n");
8023  output ("\t0xF8, 0xF9, 0x7A, 0x5E, 0x4C, 0x7E, 0x6E, 0x6F,\n");
8024  output ("\t0x7C, 0xC1, 0xC2, 0xC3, 0xC4, 0xC5, 0xC6, 0xC7,\n");
8025  output ("\t0xC8, 0xC9, 0xD1, 0xD2, 0xD3, 0xD4, 0xD5, 0xD6,\n");
8026  output ("\t0xD7, 0xD8, 0xD9, 0xE2, 0xE3, 0xE4, 0xE5, 0xE6,\n");
8027  output ("\t0xE7, 0xE8, 0xE9, 0xAD, 0xE0, 0xBD, 0x5F, 0x6D,\n");
8028  output ("\t0x79, 0x81, 0x82, 0x83, 0x84, 0x85, 0x86, 0x87,\n");
8029  output ("\t0x88, 0x89, 0x91, 0x92, 0x93, 0x94, 0x95, 0x96,\n");
8030  output ("\t0x97, 0x98, 0x99, 0xA2, 0xA3, 0xA4, 0xA5, 0xA6,\n");
8031  output ("\t0xA7, 0xA8, 0xA9, 0xC0, 0x6A, 0xD0, 0xA1, 0x07,\n");
8032  output ("\t0x68, 0xDC, 0x51, 0x42, 0x43, 0x44, 0x47, 0x48,\n");
8033  output ("\t0x52, 0x53, 0x54, 0x57, 0x56, 0x58, 0x63, 0x67,\n");
8034  output ("\t0x71, 0x9C, 0x9E, 0xCB, 0xCC, 0xCD, 0xDB, 0xDD,\n");
8035  output ("\t0xDF, 0xEC, 0xFC, 0xB0, 0xB1, 0xB2, 0x3E, 0xB4,\n");
8036  output ("\t0x45, 0x55, 0xCE, 0xDE, 0x49, 0x69, 0x9A, 0x9B,\n");
8037  output ("\t0xAB, 0x9F, 0xBA, 0xB8, 0xB7, 0xAA, 0x8A, 0x8B,\n");
8038  output ("\t0xB6, 0xB5, 0x62, 0x4F, 0x64, 0x65, 0x66, 0x20,\n");
8039  output ("\t0x21, 0x22, 0x70, 0x23, 0x72, 0x73, 0x74, 0xBE,\n");
8040  output ("\t0x76, 0x77, 0x78, 0x80, 0x24, 0x15, 0x8C, 0x8D,\n");
8041  output ("\t0x8E, 0x41, 0x06, 0x17, 0x28, 0x29, 0x9D, 0x2A,\n");
8042  output ("\t0x2B, 0x2C, 0x09, 0x0A, 0xAC, 0x4A, 0xAE, 0xAF,\n");
8043  output ("\t0x1B, 0x30, 0x31, 0xFA, 0x1A, 0x33, 0x34, 0x35,\n");
8044  output ("\t0x36, 0x59, 0x08, 0x38, 0xBC, 0x39, 0xA0, 0xBF,\n");
8045  output ("\t0xCA, 0x3A, 0xFE, 0x3B, 0x04, 0xCF, 0xDA, 0x14,\n");
8046  output ("\t0xE1, 0x8F, 0x46, 0x75, 0xFD, 0xEB, 0xEE, 0xED,\n");
8047  output ("\t0x90, 0xEF, 0xB3, 0xFB, 0xB9, 0xEA, 0xBB, 0xFF\n");
8048  output ("};\n");
8049  if (gen_full_ebcdic > 1) {
8050  i = lookup_attr (COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL, 0);
8051  output
8052  ("static cob_field f_ascii_ebcdic = { 256, (cob_u8_ptr)cob_ascii_ebcdic, &%s%d };\n",
8053  CB_PREFIX_ATTR, i);
8054  }
8055  output_storage ("\n");
8056  }
8057  if (gen_ebcdic_ascii) {
8058  output_storage ("\n/* EBCDIC to ASCII table */\n");
8059  output ("static const unsigned char\tcob_ebcdic_ascii[256] = {\n");
8060  output ("\t0x00, 0x01, 0x02, 0x03, 0xEC, 0x09, 0xCA, 0x7F,\n");
8061  output ("\t0xE2, 0xD2, 0xD3, 0x0B, 0x0C, 0x0D, 0x0E, 0x0F,\n");
8062  output ("\t0x10, 0x11, 0x12, 0x13, 0xEF, 0xC5, 0x08, 0xCB,\n");
8063  output ("\t0x18, 0x19, 0xDC, 0xD8, 0x1C, 0x1D, 0x1E, 0x1F,\n");
8064  output ("\t0xB7, 0xB8, 0xB9, 0xBB, 0xC4, 0x0A, 0x17, 0x1B,\n");
8065  output ("\t0xCC, 0xCD, 0xCF, 0xD0, 0xD1, 0x05, 0x06, 0x07,\n");
8066  output ("\t0xD9, 0xDA, 0x16, 0xDD, 0xDE, 0xDF, 0xE0, 0x04,\n");
8067  output ("\t0xE3, 0xE5, 0xE9, 0xEB, 0x14, 0x15, 0x9E, 0x1A,\n");
8068  output ("\t0x20, 0xC9, 0x83, 0x84, 0x85, 0xA0, 0xF2, 0x86,\n");
8069  output ("\t0x87, 0xA4, 0xD5, 0x2E, 0x3C, 0x28, 0x2B, 0xB3,\n");
8070  output ("\t0x26, 0x82, 0x88, 0x89, 0x8A, 0xA1, 0x8C, 0x8B,\n");
8071  output ("\t0x8D, 0xE1, 0x21, 0x24, 0x2A, 0x29, 0x3B, 0x5E,\n");
8072  output ("\t0x2D, 0x2F, 0xB2, 0x8E, 0xB4, 0xB5, 0xB6, 0x8F,\n");
8073  output ("\t0x80, 0xA5, 0x7C, 0x2C, 0x25, 0x5F, 0x3E, 0x3F,\n");
8074  output ("\t0xBA, 0x90, 0xBC, 0xBD, 0xBE, 0xF3, 0xC0, 0xC1,\n");
8075  output ("\t0xC2, 0x60, 0x3A, 0x23, 0x40, 0x27, 0x3D, 0x22,\n");
8076  output ("\t0xC3, 0x61, 0x62, 0x63, 0x64, 0x65, 0x66, 0x67,\n");
8077  output ("\t0x68, 0x69, 0xAE, 0xAF, 0xC6, 0xC7, 0xC8, 0xF1,\n");
8078  output ("\t0xF8, 0x6A, 0x6B, 0x6C, 0x6D, 0x6E, 0x6F, 0x70,\n");
8079  output ("\t0x71, 0x72, 0xA6, 0xA7, 0x91, 0xCE, 0x92, 0xA9,\n");
8080  output ("\t0xE6, 0x7E, 0x73, 0x74, 0x75, 0x76, 0x77, 0x78,\n");
8081  output ("\t0x79, 0x7A, 0xAD, 0xA8, 0xD4, 0x5B, 0xD6, 0xD7,\n");
8082  output ("\t0x9B, 0x9C, 0x9D, 0xFA, 0x9F, 0xB1, 0xB0, 0xAC,\n");
8083  output ("\t0xAB, 0xFC, 0xAA, 0xFE, 0xE4, 0x5D, 0xBF, 0xE7,\n");
8084  output ("\t0x7B, 0x41, 0x42, 0x43, 0x44, 0x45, 0x46, 0x47,\n");
8085  output ("\t0x48, 0x49, 0xE8, 0x93, 0x94, 0x95, 0xA2, 0xED,\n");
8086  output ("\t0x7D, 0x4A, 0x4B, 0x4C, 0x4D, 0x4E, 0x4F, 0x50,\n");
8087  output ("\t0x51, 0x52, 0xEE, 0x96, 0x81, 0x97, 0xA3, 0x98,\n");
8088  output ("\t0x5C, 0xF0, 0x53, 0x54, 0x55, 0x56, 0x57, 0x58,\n");
8089  output ("\t0x59, 0x5A, 0xFD, 0xF5, 0x99, 0xF7, 0xF6, 0xF9,\n");
8090  output ("\t0x30, 0x31, 0x32, 0x33, 0x34, 0x35, 0x36, 0x37,\n");
8091  output ("\t0x38, 0x39, 0xDB, 0xFB, 0x9A, 0xF4, 0xEA, 0xFF\n");
8092  output ("};\n");
8093  if (gen_ebcdic_ascii > 1) {
8094  i = lookup_attr (COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL, 0);
8095  output
8096  ("static cob_field f_ebcdic_ascii = { 256, (cob_u8_ptr)cob_ebcdic_ascii, &%s%d };\n",
8097  CB_PREFIX_ATTR, i);
8098  }
8099  output_storage ("\n");
8100  }
8101  if (gen_native) {
8102  output_storage ("\n/* NATIVE table */\n");
8103  output ("static const unsigned char\tcob_native[256] = {\n");
8104  output ("\t0, 1, 2, 3, 4, 5, 6, 7,\n");
8105  output ("\t8, 9, 10, 11, 12, 13, 14, 15,\n");
8106  output ("\t16, 17, 18, 19, 20, 21, 22, 23,\n");
8107  output ("\t24, 25, 26, 27, 28, 29, 30, 31,\n");
8108  output ("\t32, 33, 34, 35, 36, 37, 38, 39,\n");
8109  output ("\t40, 41, 42, 43, 44, 45, 46, 47,\n");
8110  output ("\t48, 49, 50, 51, 52, 53, 54, 55,\n");
8111  output ("\t56, 57, 58, 59, 60, 61, 62, 63,\n");
8112  output ("\t64, 65, 66, 67, 68, 69, 70, 71,\n");
8113  output ("\t72, 73, 74, 75, 76, 77, 78, 79,\n");
8114  output ("\t80, 81, 82, 83, 84, 85, 86, 87,\n");
8115  output ("\t88, 89, 90, 91, 92, 93, 94, 95,\n");
8116  output ("\t96, 97, 98, 99, 100, 101, 102, 103,\n");
8117  output ("\t104, 105, 106, 107, 108, 109, 110, 111,\n");
8118  output ("\t112, 113, 114, 115, 116, 117, 118, 119,\n");
8119  output ("\t120, 121, 122, 123, 124, 125, 126, 127,\n");
8120  output ("\t128, 129, 130, 131, 132, 133, 134, 135,\n");
8121  output ("\t136, 137, 138, 139, 140, 141, 142, 143,\n");
8122  output ("\t144, 145, 146, 147, 148, 149, 150, 151,\n");
8123  output ("\t152, 153, 154, 155, 156, 157, 158, 159,\n");
8124  output ("\t160, 161, 162, 163, 164, 165, 166, 167,\n");
8125  output ("\t168, 169, 170, 171, 172, 173, 174, 175,\n");
8126  output ("\t176, 177, 178, 179, 180, 181, 182, 183,\n");
8127  output ("\t184, 185, 186, 187, 188, 189, 190, 191,\n");
8128  output ("\t192, 193, 194, 195, 196, 197, 198, 199,\n");
8129  output ("\t200, 201, 202, 203, 204, 205, 206, 207,\n");
8130  output ("\t208, 209, 210, 211, 212, 213, 214, 215,\n");
8131  output ("\t216, 217, 218, 219, 220, 221, 222, 223,\n");
8132  output ("\t224, 225, 226, 227, 228, 229, 230, 231,\n");
8133  output ("\t232, 233, 234, 235, 236, 237, 238, 239,\n");
8134  output ("\t240, 241, 242, 243, 244, 245, 246, 247,\n");
8135  output ("\t248, 249, 250, 251, 252, 253, 254, 255\n");
8136  output ("};\n");
8137  if (gen_native > 1) {
8138  i = lookup_attr (COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL, 0);
8139  output
8140  ("static cob_field f_native = { 256, (cob_u8_ptr)cob_native, &%s%d };\n",
8141  CB_PREFIX_ATTR, i);
8142  }
8143  output_storage ("\n");
8144  }
8145 
8146  /* Strings */
8147  if (string_cache) {
8148  output_storage ("\n/* Strings */\n");
8149  string_cache = string_list_reverse (string_cache);
8150  for (stp = string_cache; stp; stp = stp->next) {
8151  output ("static const char %s%d[]\t= \"%s\";\n",
8152  CB_PREFIX_STRING, stp->id, stp->text);
8153  }
8154  output_storage ("\n");
8155  }
8156 
8157  /* Optimizer output */
8158  for (optidx = COB_OPTIM_MIN; optidx < COB_OPTIM_MAX; ++optidx) {
8159  if (optimize_defs[optidx]) {
8160  cob_gen_optim (optidx);
8161  output_storage ("\n");
8162  }
8163  }
8164 }
void finalize_file ( struct cb_file *  ,
struct cb_field *   
)

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

2268 {
2269  struct cb_field *p;
2270  struct cb_field *v;
2271  struct cb_alt_key *cbak;
2272  cb_tree l;
2273  cb_tree x;
2274 
2275  /* stdin/stderr and LINE ADVANCING are L/S */
2276  if (f->special || f->flag_line_adv) {
2277  f->organization = COB_ORG_LINE_SEQUENTIAL;
2278  }
2279  if (f->flag_fileid && !f->assign) {
2280  f->assign = cb_build_alphanumeric_literal (f->name,
2281  strlen (f->name));
2282  }
2283 
2284  if (f->key && f->organization == COB_ORG_INDEXED &&
2285  (l = cb_ref (f->key)) != cb_error_node) {
2286  v = cb_field_founder (CB_FIELD_PTR (l));
2287  for (p = records; p; p = p->sister) {
2288  if (p == v) {
2289  break;
2290  }
2291  }
2292  if (!p) {
2293  cb_error (_("Invalid KEY item '%s'"),
2294  CB_FIELD_PTR (l)->name);
2295  }
2296  }
2297  if (f->alt_key_list) {
2298  for (cbak = f->alt_key_list; cbak; cbak = cbak->next) {
2299  l = cb_ref (cbak->key);
2300  if (l == cb_error_node) {
2301  continue;
2302  }
2303  v = cb_field_founder (CB_FIELD_PTR (l));
2304  for (p = records; p; p = p->sister) {
2305  if (p == v) {
2306  break;
2307  }
2308  }
2309  if (!p) {
2310  cb_error (_("Invalid KEY item '%s'"),
2311  CB_FIELD_PTR (l)->name);
2312  }
2313  }
2314  }
2315 
2316  /* Check the record size if it is limited */
2317  for (p = records; p; p = p->sister) {
2318  if (f->record_min > 0) {
2319  if (p->size < f->record_min) {
2320  cb_error (_("Record size too small '%s'"),
2321  p->name);
2322  }
2323  }
2324  if (f->record_max > 0) {
2325  if (p->size > f->record_max) {
2326  cb_error (_("Record size too large '%s' (%d)"),
2327  p->name, p->size);
2328  }
2329  }
2330  }
2331 
2332  /* Compute the record size */
2333  if (f->record_min == 0) {
2334  if (records) {
2335  f->record_min = records->size;
2336  } else {
2337  f->record_min = 0;
2338  }
2339  }
2340  for (p = records; p; p = p->sister) {
2341  v = cb_field_variable_size (p);
2342  if (v && v->offset + v->size * v->occurs_min < f->record_min) {
2343  f->record_min = v->offset + v->size * v->occurs_min;
2344  }
2345  if (p->size < f->record_min) {
2346  f->record_min = p->size;
2347  }
2348  if (p->size > f->record_max) {
2349  f->record_max = p->size;
2350  }
2351  }
2352 
2353  if (f->record_max > MAX_FD_RECORD) {
2354  cb_error (_("Record size exceeds maximum allowed (%d) - File '%s'"),
2355  MAX_FD_RECORD, f->name);
2356  }
2357 
2358  if (f->same_clause) {
2359  for (l = current_program->file_list; l; l = CB_CHAIN (l)) {
2360  if (CB_FILE (CB_VALUE (l))->same_clause == f->same_clause) {
2361  if (CB_FILE (CB_VALUE (l))->flag_finalized) {
2362  if (f->record_max > CB_FILE (CB_VALUE (l))->record->memory_size) {
2363  CB_FILE (CB_VALUE (l))->record->memory_size =
2364  f->record_max;
2365  }
2366  f->record = CB_FILE (CB_VALUE (l))->record;
2367  for (p = records; p; p = p->sister) {
2368  p->file = f;
2369  p->redefines = f->record;
2370  }
2371  for (p = f->record->sister; p; p = p->sister) {
2372  if (!p->sister) {
2373  p->sister = records;
2374  break;
2375  }
2376  }
2377  f->flag_finalized = 1;
2378  return;
2379  }
2380  }
2381  }
2382  }
2383  /* Create record */
2384  if (f->record_max == 0) {
2385  f->record_max = 32;
2386  f->record_min = 32;
2387  }
2388  if (f->organization == COB_ORG_LINE_SEQUENTIAL) {
2389  f->record_min = 0;
2390  }
2391  if (!scratch_buff) {
2392  scratch_buff = cobc_main_malloc ((size_t)COB_MINI_BUFF);
2393  }
2394  snprintf (scratch_buff, (size_t)COB_MINI_MAX, "%s Record", f->name);
2395  f->record = CB_FIELD (cb_build_implicit_field (cb_build_reference (scratch_buff),
2396  f->record_max));
2397  f->record->sister = records;
2398  f->record->count++;
2399  if (f->flag_external) {
2400  current_program->flag_has_external = 1;
2401  f->record->flag_external = 1;
2402  }
2403 
2404  for (p = records; p; p = p->sister) {
2405  p->file = f;
2406  p->redefines = f->record;
2407 #if 1 /* RXWRXW - Global/External */
2408  if (p->flag_is_global) {
2409  f->record->flag_is_global = 1;
2410  }
2411 #endif
2412  }
2413  f->flag_finalized = 1;
2414  if (f->linage) {
2415  snprintf (scratch_buff, (size_t)COB_MINI_MAX,
2416  "LINAGE-COUNTER %s", f->name);
2417  x = cb_build_field (cb_build_reference (scratch_buff));
2418  CB_FIELD (x)->usage = CB_USAGE_UNSIGNED_INT;
2419  CB_FIELD (x)->values = CB_LIST_INIT (cb_zero);
2420  CB_FIELD (x)->count++;
2421  cb_validate_field (CB_FIELD (x));
2422  f->linage_ctr = cb_build_field_reference (CB_FIELD (x), NULL);
2423  CB_FIELD_ADD (current_program->working_storage, CB_FIELD (x));
2424  }
2425 }
void group_error ( cb_tree  ,
const char *   
)

References _, cb_error_x(), and cb_name().

Referenced by validate_field_1().

345 {
346  cb_error_x (x, _("Group item '%s' cannot have %s clause"),
347  cb_name (x), clause);
348 }
void level_except_error ( cb_tree  ,
const char *   
)

References _, cb_error_x(), CB_FIELD_PTR, cb_name(), cb_field::flag_item_78, and cb_field::level.

Referenced by cb_validate_78_item(), cb_validate_88_item(), and validate_field_1().

388 {
389  const char *s;
390  const struct cb_field *f;
391 
392  s = cb_name (x);
393  f = CB_FIELD_PTR (x);
394  if (f->flag_item_78) {
395  cb_error_x (x, _("Constant item '%s' can only have a %s clause"),
396  s, clause);
397  } else {
398  cb_error_x (x, _("Level %02d item '%s' can only have a %s clause"),
399  f->level,
400  s, clause);
401  }
402 }
void level_redundant_error ( cb_tree  ,
const char *   
)

References _, cb_error_x(), CB_FIELD_PTR, cb_name(), cb_field::flag_item_78, and cb_field::level.

Referenced by validate_field_1().

352 {
353  const char *s;
354  const struct cb_field *f;
355 
356  s = cb_name (x);
357  f = CB_FIELD_PTR (x);
358  if (f->flag_item_78) {
359  cb_error_x (x, _("Constant item '%s' cannot have a %s clause"),
360  s, clause);
361  } else {
362  cb_error_x (x, _("Level %02d item '%s' cannot have a %s clause"),
363  f->level,
364  s, clause);
365  }
366 }
void level_require_error ( cb_tree  ,
const char *   
)

References _, cb_error_x(), CB_FIELD_PTR, cb_name(), cb_field::flag_item_78, and cb_field::level.

Referenced by cb_validate_78_item(), cb_validate_88_item(), check_picture_item(), and validate_field_1().

370 {
371  const char *s;
372  const struct cb_field *f;
373 
374  s = cb_name (x);
375  f = CB_FIELD_PTR (x);
376  if (f->flag_item_78) {
377  cb_error_x (x, _("Constant item '%s' requires a %s clause"),
378  s, clause);
379  } else {
380  cb_error_x (x, _("Level %02d item '%s' requires a %s clause"),
381  f->level,
382  s, clause);
383  }
384 }
struct cb_intrinsic_table* lookup_intrinsic ( const char *  ,
const int  ,
const int   
)
read

References cobc_nores_base, cb_intrinsic_table::implemented, intrinsic_comp(), noreserve::next, noreserve::noresword, NULL, NUM_INTRINSICS, and unlikely.

2643 {
2644  struct cb_intrinsic_table *cbp;
2645  struct noreserve *nr;
2646 
2647  if (unlikely(cobc_nores_base && checkres)) {
2648  for (nr = cobc_nores_base; nr; nr = nr->next) {
2649  if (strcasecmp (name, nr->noresword) == 0) {
2650  return NULL;
2651  }
2652  }
2653  }
2654  cbp = bsearch (name, function_list, NUM_INTRINSICS,
2655  sizeof (struct cb_intrinsic_table), intrinsic_comp);
2656  if (cbp && (checkimpl || cbp->implemented)) {
2657  return cbp;
2658  }
2659  return NULL;
2660 }
struct cobc_reserved* lookup_reserved_word ( const char *  )
read

References _, CB_CS_PROGRAM_ID, cb_error(), cobc_cs_check, cobc_force_literal, cobc_in_procedure, cobc_in_repository, cobc_nores_base, cobc_reserved::context_sens, cobc_reserved::context_set, cobc_reserved::context_test, FUNCTION_ID, INTRINSIC, noreserve::next, noreserve::noresword, NULL, NUM_RESERVED_WORDS, p, PROGRAM_ID, REPOSITORY, reserve_comp(), cobc_reserved::token, and unlikely.

2568 {
2569  struct cobc_reserved *p;
2570  struct noreserve *nr;
2571 
2572  p = bsearch (name, reserved_words, NUM_RESERVED_WORDS,
2573  sizeof (struct cobc_reserved), reserve_comp);
2574  if (!p) {
2575  return NULL;
2576  }
2577 
2578  /* Allow obsolete/unimplemented 85 keywords as user names */
2579  if (!p->token && !cb_cobol85_reserved) {
2580  return NULL;
2581  }
2582 
2583  /* Check if the configuration has unreserved the word */
2584  for (nr = cobc_nores_base; nr; nr = nr->next) {
2585  if (strcasecmp (name, nr->noresword) == 0) {
2586  return NULL;
2587  }
2588  }
2589 
2590  /* Check word is implemented */
2591  if (unlikely(p->token <= 0)) {
2592  /* Not implemented - If context sensitive, no error */
2593  if (!p->context_sens) {
2594  cb_error (_("'%s' reserved word, but not supported"), name);
2595  }
2596  return NULL;
2597  }
2598 
2599  /* Special actions / Context sensitive */
2600  if (p->context_set) {
2601  if (unlikely(p->context_test)) {
2602  /* Dependent words */
2603  if (!(cobc_cs_check & p->context_test)) {
2604  return p;
2605  }
2606  }
2607  cobc_cs_check |= p->context_set;
2608  return p;
2609  }
2610 
2611  if (p->context_test) {
2612 #if 0 /* RXWRXW - CS check */
2613  if (!(cobc_cs_check & p->context_test)) {
2614 #endif
2615  if ((cobc_cs_check & p->context_test) != p->context_test) {
2616  return NULL;
2617  }
2618  if (!cobc_in_procedure) {
2619  cobc_cs_check = 0;
2620  }
2621  return p;
2622  }
2623 
2624  if (p->token == FUNCTION_ID) {
2625  cobc_cs_check = 0;
2626  cobc_force_literal = 1;
2627  } else if (p->token == INTRINSIC) {
2628  if (!cobc_in_repository) {
2629  return NULL;
2630  }
2631  } else if (p->token == PROGRAM_ID) {
2632  cobc_cs_check = CB_CS_PROGRAM_ID;
2633  cobc_force_literal = 1;
2634  } else if (p->token == REPOSITORY) {
2635  cobc_in_repository = 1;
2636  }
2637 
2638  return p;
2639 }
cb_tree lookup_system_name ( const char *  )

References cb_intrinsic_table::category, cb_build_system_name(), cob_strcasecmp(), EXT_SYSTEM_TAB_SIZE, NULL, SYSTEM_TAB_SIZE, and cb_intrinsic_table::token.

2546 {
2547  size_t i;
2548 
2549  for (i = 0; i < SYSTEM_TAB_SIZE; ++i) {
2550  if (cob_strcasecmp (name, system_table[i].name) == 0) {
2551  return cb_build_system_name (system_table[i].category,
2552  system_table[i].token);
2553  }
2554  }
2555  if (cb_flag_syntax_extension) {
2556  for (i = 0; i < EXT_SYSTEM_TAB_SIZE; ++i) {
2557  if (cob_strcasecmp (name, ext_system_table[i].name) == 0) {
2558  return cb_build_system_name (ext_system_table[i].category,
2559  ext_system_table[i].token);
2560  }
2561  }
2562  }
2563  return NULL;
2564 }
void redefinition_error ( cb_tree  )

References _, cb_error_x(), CB_REFERENCE, CB_VALUE, cb_word::items, and cb_word::name.

Referenced by cb_build_section_name(), and cb_validate_program_data().

234 {
235  struct cb_word *w;
236 
237  w = CB_REFERENCE (x)->word;
238  cb_error_x (x, _("Redefinition of '%s'"), w->name);
239  if (w->items) {
240  cb_error_x (CB_VALUE (w->items),
241  _("'%s' previously defined here"), w->name);
242  }
243 }
void redefinition_warning ( cb_tree  ,
cb_tree   
)

References _, CB_REFERENCE, CB_VALUE, cb_warning_x(), cb_word::items, cb_word::name, and NULL.

Referenced by cb_build_field_tree().

247 {
248  struct cb_word *w;
249  cb_tree z;
250 
251  w = CB_REFERENCE (x)->word;
252  cb_warning_x (x, _("Redefinition of '%s'"), w->name);
253  z = NULL;
254  if (y) {
255  z = y;
256  } else if (w->items) {
257  z = CB_VALUE (w->items);
258  }
259 
260  if (z) {
261  cb_warning_x (z, _("'%s' previously defined here"), w->name);
262  }
263 }
void undefined_error ( cb_tree  )

References _, cb_error_x(), CB_NAME, CB_REFERENCE, cb_warning_x(), cb_reference::chain, COB_NORMAL_BUFF, COB_NORMAL_MAX, cobc_main_malloc(), errnamebuff, and cb_reference::flag_optional.

Referenced by cb_ref(), and cb_resolve_redefines().

267 {
268  struct cb_reference *r;
269  cb_tree c;
270 
271  if (!errnamebuff) {
272  errnamebuff = cobc_main_malloc ((size_t)COB_NORMAL_BUFF);
273  }
274  r = CB_REFERENCE (x);
275  snprintf (errnamebuff, (size_t)COB_NORMAL_MAX, "'%s'", CB_NAME (x));
276  for (c = r->chain; c; c = CB_REFERENCE (c)->chain) {
277  strcat (errnamebuff, " in '");
278  strcat (errnamebuff, CB_NAME (c));
279  strcat (errnamebuff, "'");
280  }
281  if (r->flag_optional) {
282  cb_warning_x (x, _("%s is not defined"), errnamebuff);
283  } else {
284  cb_error_x (x, _("%s is not defined"), errnamebuff);
285  }
286 }
void validate_file ( struct cb_file *  ,
cb_tree   
)

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

2219 {
2220  /* Check ASSIGN clause
2221  Currently break's GNU COBOL's extension for SORT FILEs having no need
2222  for an ASSIGN clause (tested in run_extensions "SORT ASSIGN ..."
2223  According to the Programmer's Guide for 1.1 the ASSIGN is totally
2224  ignored as the SORT is either done in memory (if there's enough space)
2225  or in a temporary disk file.
2226  For supporting this f->organization = COB_ORG_SORT is done when we
2227  see an SD in FILE SECTION for the file, while validate_file is called
2228  in INPUT-OUTPUT Section.
2229  */
2230  if (!f->assign && f->organization != COB_ORG_SORT && !f->flag_fileid) {
2231  file_error (name, "ASSIGN", CB_FILE_ERR_REQUIRED);
2232  }
2233  /* Check RECORD/RELATIVE KEY clause */
2234  switch (f->organization) {
2235  case COB_ORG_INDEXED:
2236  if (f->key == NULL) {
2237  file_error (name, "RECORD KEY", CB_FILE_ERR_REQUIRED);
2238  }
2239  break;
2240  case COB_ORG_RELATIVE:
2241  if (f->key == NULL && f->access_mode != COB_ACCESS_SEQUENTIAL) {
2242  file_error (name, "RELATIVE KEY", CB_FILE_ERR_REQUIRED);
2243  }
2244  if (f->alt_key_list) {
2245  file_error (name, "ALTERNATE", CB_FILE_ERR_INVALID_FT);
2246  f->alt_key_list = NULL;
2247  }
2248  break;
2249  default:
2250  if (f->key) {
2251  file_error (name, "RECORD", CB_FILE_ERR_INVALID_FT);
2252  f->key = NULL;
2253  }
2254  if (f->alt_key_list) {
2255  file_error (name, "ALTERNATE", CB_FILE_ERR_INVALID_FT);
2256  f->alt_key_list = NULL;
2257  }
2258  if (f->access_mode == COB_ACCESS_DYNAMIC ||
2259  f->access_mode == COB_ACCESS_RANDOM) {
2260  file_error (name, "ORGANIZATION", CB_FILE_ERR_INVALID);
2261  }
2262  break;
2263  }
2264 }
int validate_move ( cb_tree  ,
cb_tree  ,
const unsigned  int 
)

References _, cb_literal::all, CB_ALPHABET_NAME_P, CB_CATEGORY_ALPHABETIC, CB_CATEGORY_ALPHANUMERIC, CB_CATEGORY_ALPHANUMERIC_EDITED, CB_CATEGORY_BOOLEAN, CB_CATEGORY_NUMERIC, CB_CATEGORY_NUMERIC_EDITED, cb_check_overlapping(), CB_CLASS_NUMERIC, CB_CLASS_POINTER, CB_ERROR, cb_error_x(), CB_FIELD_PTR, cb_field_size(), CB_FILE_P, cb_get_long_long(), cb_high, CB_LITERAL, cb_low, cb_quote, CB_REFERENCE, CB_REFERENCE_P, cb_space, CB_TAG_BINARY_OP, CB_TAG_CONST, CB_TAG_FIELD, CB_TAG_FUNCALL, CB_TAG_INTEGER, CB_TAG_INTRINSIC, CB_TAG_LITERAL, CB_TAG_REFERENCE, CB_TREE_CATEGORY, CB_TREE_CLASS, CB_TREE_TAG, CB_USAGE_BINARY, CB_USAGE_COMP_5, CB_USAGE_COMP_X, CB_USAGE_DOUBLE, CB_USAGE_FLOAT, CB_USAGE_FP_BIN128, CB_USAGE_FP_BIN32, CB_USAGE_FP_BIN64, CB_USAGE_FP_DEC128, CB_USAGE_FP_DEC64, CB_USAGE_LONG_DOUBLE, cb_warning_x(), cb_zero, cb_field::children, COB_S64_C, cob_s64_t, COBC_ABORT, cobc_abort_pr(), count_pic_alphanumeric_edited(), cb_literal::data, cb_picture::digits, cb_field::flag_real_binary, cb_picture::have_sign, move_warning(), overlapping, p, cb_field::pic, cb_literal::scale, cb_picture::scale, cb_literal::sign, cb_literal::size, cb_picture::size, cb_field::size, cb_tree_common::source_line, suppress_warn, cb_field::usage, value, and warningopt.

5939 {
5940  struct cb_field *fdst;
5941  struct cb_field *fsrc;
5942  struct cb_literal *l;
5943  unsigned char *p;
5944  cb_tree loc;
5945  cob_s64_t val;
5946  size_t i;
5947  size_t is_numeric_edited;
5948  int src_scale_mod;
5949  int dst_scale_mod;
5950  int dst_size_mod;
5951  int size;
5952  int most_significant;
5953  int least_significant;
5954 
5955  loc = src->source_line ? src : dst;
5956  is_numeric_edited = 0;
5957  overlapping = 0;
5958  if (CB_REFERENCE_P (dst)) {
5959  if (CB_ALPHABET_NAME_P(CB_REFERENCE(dst)->value)) {
5960  goto invalid;
5961  }
5962  if (CB_FILE_P(CB_REFERENCE(dst)->value)) {
5963  goto invalid;
5964  }
5965  }
5966  if (CB_TREE_CATEGORY (dst) == CB_CATEGORY_BOOLEAN) {
5967  cb_error_x (loc, _("Invalid destination for MOVE"));
5968  return -1;
5969  }
5970 
5971  if (CB_TREE_CLASS (dst) == CB_CLASS_POINTER) {
5972  if (CB_TREE_CLASS (src) == CB_CLASS_POINTER) {
5973  return 0;
5974  } else {
5975  goto invalid;
5976  }
5977  }
5978 
5979  fdst = CB_FIELD_PTR (dst);
5980  switch (CB_TREE_TAG (src)) {
5981  case CB_TAG_CONST:
5982  if (src == cb_space) {
5983  if (CB_TREE_CATEGORY (dst) == CB_CATEGORY_NUMERIC ||
5984  (CB_TREE_CATEGORY (dst) == CB_CATEGORY_NUMERIC_EDITED && !is_value)) {
5985  if (!cb_relaxed_syntax_check || is_value) {
5986  goto invalid;
5987  }
5988  cb_warning_x (loc, _("Source is non-numeric - substituting zero"));
5989  }
5990  } else if (src == cb_zero) {
5991  if (CB_TREE_CATEGORY (dst) == CB_CATEGORY_ALPHABETIC) {
5992  goto invalid;
5993  }
5994  } else if (src == cb_low || src == cb_high || src == cb_quote) {
5995  if (CB_TREE_CATEGORY (dst) == CB_CATEGORY_NUMERIC ||
5996  CB_TREE_CATEGORY (dst) == CB_CATEGORY_NUMERIC_EDITED) {
5997  if (!cb_relaxed_syntax_check || is_value) {
5998  goto invalid;
5999  }
6000  cb_warning_x (loc, _("Source is non-numeric - substituting zero"));
6001  }
6002  }
6003  break;
6004  case CB_TAG_LITERAL:
6005  l = CB_LITERAL (src);
6006  if (CB_TREE_CLASS (src) == CB_CLASS_NUMERIC) {
6007  /* Numeric literal */
6008  if (l->all) {
6009  goto invalid;
6010  }
6011  if (fdst->usage == CB_USAGE_DOUBLE ||
6012  fdst->usage == CB_USAGE_FLOAT ||
6013  fdst->usage == CB_USAGE_LONG_DOUBLE ||
6014  fdst->usage == CB_USAGE_FP_BIN32 ||
6015  fdst->usage == CB_USAGE_FP_BIN64 ||
6016  fdst->usage == CB_USAGE_FP_BIN128 ||
6017  fdst->usage == CB_USAGE_FP_DEC64 ||
6018  fdst->usage == CB_USAGE_FP_DEC128) {
6019  break;
6020  }
6021  most_significant = -999;
6022  least_significant = 999;
6023 
6024  /* Compute the most significant figure place */
6025  for (i = 0; i < l->size; i++) {
6026  if (l->data[i] != '0') {
6027  break;
6028  }
6029  }
6030  if (i != l->size) {
6031  most_significant = (int) (l->size - l->scale - i - 1);
6032  }
6033 
6034  /* Compute the least significant figure place */
6035  for (i = 0; i < l->size; i++) {
6036  if (l->data[l->size - i - 1] != '0') {
6037  break;
6038  }
6039  }
6040  if (i != l->size) {
6041  least_significant = (int) (-l->scale + i);
6042  }
6043 
6044  /* Value check */
6045  switch (CB_TREE_CATEGORY (dst)) {
6046  case CB_CATEGORY_ALPHANUMERIC:
6047  case CB_CATEGORY_ALPHANUMERIC_EDITED:
6048  if (is_value) {
6049  goto expect_alphanumeric;
6050  }
6051  if (l->scale == 0) {
6052  goto expect_alphanumeric;
6053  }
6054  goto non_integer_move;
6055  case CB_CATEGORY_NUMERIC:
6056  if (fdst->pic->scale < 0) {
6057  /* Check for PIC 9(n)P(m) */
6058  if (least_significant < -fdst->pic->scale) {
6059  goto value_mismatch;
6060  }
6061  } else if (fdst->pic->scale > fdst->pic->size) {
6062  /* Check for PIC P(n)9(m) */
6063  if (most_significant >= fdst->pic->size - fdst->pic->scale) {
6064  goto value_mismatch;
6065  }
6066  }
6067  break;
6068  case CB_CATEGORY_NUMERIC_EDITED:
6069  if (is_value) {
6070  goto expect_alphanumeric;
6071  }
6072 
6073  /* TODO */
6074  break;
6075  case CB_CATEGORY_ALPHABETIC:
6076  if (is_value) {
6077  goto expect_alphanumeric;
6078  }
6079  /* Coming from codegen */
6080  if (!suppress_warn) {
6081  goto invalid;
6082  }
6083 #if 1 /* RXWRXW - Initialize warn */
6084  if (warningopt) {
6085  cb_warning_x (loc, _("Numeric move to ALPHABETIC"));
6086  }
6087 #endif
6088  break;
6089  default:
6090  if (is_value) {
6091  goto expect_alphanumeric;
6092  }
6093  goto invalid;
6094  }
6095 
6096  /* Sign check */
6097  if (l->sign != 0 && !fdst->pic->have_sign) {
6098  if (is_value) {
6099  cb_error_x (loc, _("Data item not signed"));
6100  return -1;
6101  }
6102  if (cb_warn_constant) {
6103  cb_warning_x (loc, _("Ignoring sign"));
6104  }
6105  }
6106 
6107  /* Size check */
6108  if (fdst->flag_real_binary ||
6109  ((fdst->usage == CB_USAGE_COMP_5 ||
6110  fdst->usage == CB_USAGE_COMP_X ||
6111  fdst->usage == CB_USAGE_BINARY) &&
6112  fdst->pic->scale == 0)) {
6113  p = l->data;
6114  for (i = 0; i < l->size; i++) {
6115  if (l->data[i] != '0') {
6116  p = &l->data[i];
6117  break;
6118  }
6119  }
6120  i = l->size - i;
6121  switch (fdst->size) {
6122  case 1:
6123  if (i > 18) {
6124  goto numlit_overflow;
6125  }
6126  val = cb_get_long_long (src);
6127  if (fdst->pic->have_sign) {
6128  if (val < COB_S64_C(-128) ||
6129  val > COB_S64_C(127)) {
6130  goto numlit_overflow;
6131  }
6132  } else {
6133  if (val > COB_S64_C(255)) {
6134  goto numlit_overflow;
6135  }
6136  }
6137  break;
6138  case 2:
6139  if (i > 18) {
6140  goto numlit_overflow;
6141  }
6142  val = cb_get_long_long (src);
6143  if (fdst->pic->have_sign) {
6144  if (val < COB_S64_C(-32768) ||
6145  val > COB_S64_C(32767)) {
6146  goto numlit_overflow;
6147  }
6148  } else {
6149  if (val > COB_S64_C(65535)) {
6150  goto numlit_overflow;
6151  }
6152  }
6153  break;
6154  case 3:
6155  if (i > 18) {
6156  goto numlit_overflow;
6157  }
6158  val = cb_get_long_long (src);
6159  if (fdst->pic->have_sign) {
6160  if (val < COB_S64_C(-8388608) ||
6161  val > COB_S64_C(8388607)) {
6162  goto numlit_overflow;
6163  }
6164  } else {
6165  if (val > COB_S64_C(16777215)) {
6166  goto numlit_overflow;
6167  }
6168  }
6169  break;
6170  case 4:
6171  if (i > 18) {
6172  goto numlit_overflow;
6173  }
6174  val = cb_get_long_long (src);
6175  if (fdst->pic->have_sign) {
6176  if (val < COB_S64_C(-2147483648) ||
6177  val > COB_S64_C(2147483647)) {
6178  goto numlit_overflow;
6179  }
6180  } else {
6181  if (val > COB_S64_C(4294967295)) {
6182  goto numlit_overflow;
6183  }
6184  }
6185  break;
6186  case 5:
6187  if (i > 18) {
6188  goto numlit_overflow;
6189  }
6190  val = cb_get_long_long (src);
6191  if (fdst->pic->have_sign) {
6192  if (val < COB_S64_C(-549755813888) ||
6193  val > COB_S64_C(549755813887)) {
6194  goto numlit_overflow;
6195  }
6196  } else {
6197  if (val > COB_S64_C(1099511627775)) {
6198  goto numlit_overflow;
6199  }
6200  }
6201  break;
6202  case 6:
6203  if (i > 18) {
6204  goto numlit_overflow;
6205  }
6206  val = cb_get_long_long (src);
6207  if (fdst->pic->have_sign) {
6208  if (val < COB_S64_C(-140737488355328) ||
6209  val > COB_S64_C(140737488355327)) {
6210  goto numlit_overflow;
6211  }
6212  } else {
6213  if (val > COB_S64_C(281474976710655)) {
6214  goto numlit_overflow;
6215  }
6216  }
6217  break;
6218  case 7:
6219  if (i > 18) {
6220  goto numlit_overflow;
6221  }
6222  val = cb_get_long_long (src);
6223  if (fdst->pic->have_sign) {
6224  if (val < COB_S64_C(-36028797018963968) ||
6225  val > COB_S64_C(36028797018963967)) {
6226  goto numlit_overflow;
6227  }
6228  } else {
6229  if (val > COB_S64_C(72057594037927935)) {
6230  goto numlit_overflow;
6231  }
6232  }
6233  break;
6234  default:
6235  if (fdst->pic->have_sign) {
6236  if (i < 19) {
6237  break;
6238  }
6239  if (i > 19) {
6240  goto numlit_overflow;
6241  }
6242  if (memcmp (p, "9223372036854775807", (size_t)19) > 0) {
6243  goto numlit_overflow;
6244  }
6245  } else {
6246  if (i < 20) {
6247  break;
6248  }
6249  if (i > 20) {
6250  goto numlit_overflow;
6251  }
6252  if (memcmp (p, "18446744073709551615", (size_t)20) > 0) {
6253  goto numlit_overflow;
6254  }
6255  }
6256  break;
6257  }
6258  return 0;
6259  }
6260  if (least_significant < -fdst->pic->scale) {
6261  goto size_overflow;
6262  }
6263  if (fdst->pic->scale > 0) {
6264  size = fdst->pic->digits - fdst->pic->scale;
6265  } else {
6266  size = fdst->pic->digits;
6267  }
6268  if (most_significant >= size) {
6269  goto size_overflow;
6270  }
6271  } else {
6272  /* Alphanumeric literal */
6273 
6274  /* Value check */
6275  switch (CB_TREE_CATEGORY (dst)) {
6276  case CB_CATEGORY_ALPHABETIC:
6277  for (i = 0; i < l->size; i++) {
6278  if (!isalpha (l->data[i]) &&
6279  l->data[i] != ' ') {
6280  goto value_mismatch;
6281  }
6282  }
6283  break;
6284  case CB_CATEGORY_NUMERIC:
6285  goto expect_numeric;
6286  case CB_CATEGORY_NUMERIC_EDITED:
6287  if (!is_value) {
6288  goto expect_numeric;
6289  }
6290 
6291  /* TODO: validate the value */
6292  break;
6293  default:
6294  break;
6295  }
6296 
6297  /* Size check */
6298  size = cb_field_size (dst);
6299  if (size > 0 && (int)l->size > size) {
6300  goto size_overflow;
6301  }
6302  }
6303  break;
6304  case CB_TAG_FIELD:
6305  case CB_TAG_REFERENCE:
6306  if (CB_REFERENCE_P(src) &&
6307  CB_ALPHABET_NAME_P(CB_REFERENCE(src)->value)) {
6308  break;
6309  }
6310  if (CB_REFERENCE_P(src) &&
6311  CB_FILE_P(CB_REFERENCE(src)->value)) {
6312  goto invalid;
6313  }
6314  fsrc = CB_FIELD_PTR (src);
6315  size = cb_field_size (src);
6316  if (size < 0) {
6317  size = fsrc->size;
6318  }
6319 
6320  /* Check basic overlapping */
6321  overlapping = cb_check_overlapping (src, dst, fsrc, fdst);
6322 
6323  /* Non-elementary move */
6324  if (fsrc->children || fdst->children) {
6325  if (size > fdst->size) {
6326  goto size_overflow_1;
6327  }
6328  break;
6329  }
6330 
6331  /* Elementary move */
6332  switch (CB_TREE_CATEGORY (src)) {
6333  case CB_CATEGORY_ALPHANUMERIC:
6334  switch (CB_TREE_CATEGORY (dst)) {
6335  case CB_CATEGORY_NUMERIC:
6336  case CB_CATEGORY_NUMERIC_EDITED:
6337  if (size > (int)fdst->pic->digits) {
6338  goto size_overflow_2;
6339  }
6340  break;
6341  case CB_CATEGORY_ALPHANUMERIC_EDITED:
6342  if (size > count_pic_alphanumeric_edited (fdst)) {
6343  goto size_overflow_1;
6344  }
6345  break;
6346  default:
6347  if (size > fdst->size) {
6348  goto size_overflow_1;
6349  }
6350  break;
6351  }
6352  break;
6353  case CB_CATEGORY_ALPHABETIC:
6354  case CB_CATEGORY_ALPHANUMERIC_EDITED:
6355  switch (CB_TREE_CATEGORY (dst)) {
6356  case CB_CATEGORY_NUMERIC:
6357  case CB_CATEGORY_NUMERIC_EDITED:
6358  goto invalid;
6359  case CB_CATEGORY_ALPHANUMERIC_EDITED:
6360  if (size > count_pic_alphanumeric_edited(fdst)) {
6361  goto size_overflow_1;
6362  }
6363  break;
6364  default:
6365  if (size > fdst->size) {
6366  goto size_overflow_1;
6367  }
6368  break;
6369  }
6370  break;
6371  case CB_CATEGORY_NUMERIC:
6372  case CB_CATEGORY_NUMERIC_EDITED:
6373  switch (CB_TREE_CATEGORY (dst)) {
6374  case CB_CATEGORY_ALPHABETIC:
6375  goto invalid;
6376  case CB_CATEGORY_ALPHANUMERIC_EDITED:
6377  is_numeric_edited = 1;
6378  /* Drop through */
6379  case CB_CATEGORY_ALPHANUMERIC:
6380  if (!fsrc->pic) {
6381  return -1;
6382  }
6383  if (is_numeric_edited) {
6384  dst_size_mod = count_pic_alphanumeric_edited (fdst);
6385  } else {
6386  dst_size_mod = fdst->size;
6387  }
6388  if (CB_TREE_CATEGORY (src) == CB_CATEGORY_NUMERIC &&
6389  fsrc->pic->scale > 0) {
6390  goto non_integer_move;
6391  }
6392  if (CB_TREE_CATEGORY (src) == CB_CATEGORY_NUMERIC &&
6393  (int)fsrc->pic->digits > dst_size_mod) {
6394  goto size_overflow_2;
6395  }
6396  if (CB_TREE_CATEGORY (src) == CB_CATEGORY_NUMERIC_EDITED &&
6397  fsrc->size > dst_size_mod) {
6398  goto size_overflow_1;
6399  }
6400  break;
6401  default:
6402  if (!fsrc->pic) {
6403  return -1;
6404  }
6405  if (!fdst->pic) {
6406  return -1;
6407  }
6408  src_scale_mod = fsrc->pic->scale < 0 ?
6409  0 : fsrc->pic->scale;
6410  dst_scale_mod = fdst->pic->scale < 0 ?
6411  0 : fdst->pic->scale;
6412  if (fsrc->pic->digits - src_scale_mod >
6413  fdst->pic->digits - dst_scale_mod ||
6414  src_scale_mod > dst_scale_mod) {
6415  goto size_overflow_2;
6416  }
6417  break;
6418  }
6419  break;
6420  default:
6421  cb_error_x (loc, _("Invalid source for MOVE"));
6422  return -1;
6423  }
6424  break;
6425  case CB_TAG_INTEGER:
6426  case CB_TAG_BINARY_OP:
6427  case CB_TAG_INTRINSIC:
6428  case CB_TAG_FUNCALL:
6429  /* TODO: check this */
6430  break;
6431  default:
6432  cobc_abort_pr (_("Unexpected tree tag %d"),
6433  (int)CB_TREE_TAG (src));
6434  COBC_ABORT ();
6435  }
6436  return 0;
6437 
6438 invalid:
6439  if (is_value) {
6440  cb_error_x (loc, _("Invalid VALUE clause"));
6441  } else {
6442  cb_error_x (loc, _("Invalid MOVE statement"));
6443  }
6444  return -1;
6445 
6446 numlit_overflow:
6447  if (is_value) {
6448  cb_error_x (loc, _("Invalid VALUE clause - literal exceeds data size"));
6449  return -1;
6450  }
6451  if (cb_warn_constant && !suppress_warn) {
6452  cb_warning_x (loc, _("Numeric literal exceeds data size"));
6453  }
6454  return 0;
6455 
6456 non_integer_move:
6457  if (!suppress_warn) {
6458  if (cb_move_noninteger_to_alphanumeric == CB_ERROR) {
6459  goto invalid;
6460  }
6461  cb_warning_x (loc, _("Move non-integer to alphanumeric"));
6462  }
6463  return 0;
6464 
6465 expect_numeric:
6466  move_warning (src, dst, is_value, cb_warn_strict_typing, 0,
6467  _("Numeric value is expected"));
6468  return 0;
6469 
6470 expect_alphanumeric:
6471  move_warning (src, dst, is_value, cb_warn_strict_typing, 0,
6472  _("Alphanumeric value is expected"));
6473  return 0;
6474 
6475 value_mismatch:
6476  move_warning (src, dst, is_value, cb_warn_constant, 0,
6477  _("Value does not fit the picture string"));
6478  return 0;
6479 
6480 size_overflow:
6481  move_warning (src, dst, is_value, cb_warn_constant, 0,
6482  _("Value size exceeds data size"));
6483  return 0;
6484 
6485 size_overflow_1:
6486  move_warning (src, dst, is_value, cb_warn_truncate, 1,
6487  _("Sending field larger than receiving field"));
6488  return 0;
6489 
6490 size_overflow_2:
6491  move_warning (src, dst, is_value, cb_warn_truncate, 1,
6492  _("Some digits may be truncated"));
6493  return 0;
6494 }

Variable Documentation

cb_tree cb_any
cb_tree cb_debug_contents
cb_tree cb_debug_item
cb_tree cb_debug_line
cb_tree cb_debug_name
cb_tree cb_debug_sub_1
cb_tree cb_debug_sub_2
cb_tree cb_debug_sub_3
cb_tree cb_depend_check

Referenced by cb_validate_program_data().

cb_tree cb_error_node
cb_tree cb_false
cb_tree cb_high
cb_tree cb_i[COB_MAX_SUBSCRIPTS]
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_intr_whencomp
cb_tree cb_low
size_t cb_needs_01

Referenced by cb_build_field_tree(), and cb_validate_program_data().

cb_tree cb_norm_high
cb_tree cb_norm_low
cb_tree cb_null
cb_tree cb_one
cb_tree cb_quote
cb_tree cb_space
cb_tree cb_standard_error_handler
cb_tree cb_true
cb_tree cb_zero
unsigned int cobc_cs_check

Referenced by cb_build_program(), cb_error(), cb_validate_program_body(), lookup_reserved_word(), and while().

unsigned int cobc_force_literal

Referenced by clear_initial_values(), lookup_reserved_word(), and while().

unsigned int cobc_in_procedure

Referenced by cb_build_program(), clear_initial_values(), lookup_reserved_word(), and while().

unsigned int cobc_in_repository

Referenced by cb_build_program(), cb_error(), clear_initial_values(), lookup_reserved_word(), and while().

cb_tree cobc_printer_node
unsigned int gen_screen_ptr
int non_const_word

Referenced by clear_initial_values(), and while().